Building CP/M on the C128

[Blacklord]

The "making of" CP/M 3.0 Plus for a Commodore C128

The following procedure is necessary to build your own CPM+.SYS file for the Commodore 128:

rmac cxkrnl $$pz-s
rmac cxio $$pz-s
rmac cxintr $$pz-s
rmac cxramdsk $$pz-s
rmac cxkey $$pz-s
rmac cxem $$pz-s
rmac cxvt $$pz-s
rmac cx80 $$pz-s
rmac cxprinte $$pz-s
rmac cxdisk $$pz-s
rmac cxext $$pz-s
rmac cxscb $$pz-s
mac cxkycode $$pz-s
mac fast8502 $$pz-s
link bnkbios3=cxkrnl,cxio,cxintr,cxkey,cxem,cxvt,cx80,cxprinte,cxdisk,cxramdsk,cxext,cxscb
gencpm auto
addbios fast8502

This will build on a real 128 (a 1581 or 2 1571's are required) or under VICE.

The files for generating the ROM are named similar to CXROM*.ASM, but are not necessary to generate the CPM+.SYS file. All files were copied from the 1581 disk image just with PIP ( e.g. PIP M:=A:*.*[G1] to copy it from the USER area 1 to M: )


To start the generation, type in "SUBMIT CZ" or more simple, just "CZ.SUB" (SUBMIT should be loaded automatically).
Of course you should have all needed utilities online, too. That means with CP/M 3 as the bootstrap system, use the SETDEF command to "point" to your second drive (similar to the PATH command in MS-DOS).
On that second drive MAC, RMAC, LINK, GENCPM and the compiled ADDBIOS command should be present.


What's about generating the CCP (commandline processor) ?

You need the CCP3.ASM source file, LOADER3.ASM, CCPDATE.ASM (referred as DATE.ASM originally) and MAKEDATE.LIB.

To automate the procedure, the following text (from dotted line to dotted line) should be saved as MAKECCP.SUB:
- - - - - - - - - - - - - - -
RMAC LOADER3
LINK LOADER3[OP]
MAC CCP3
MAC CCPDATE
GET FILE SIDCMDS.TXT [SYSTEM]
- - - - - - - - - - - - - - -
You need a second text file named SIDCMDS.TXT, save the following to a file also:
- - - - - - - - - - - - - - -
SID LOADER3.PRL
M200,500,100
D380,400
F400,1000,0
ECCP3.HEX
ECCPDATE.HEX
WCCP.COM,100,D80
G0
- - - - - - - - - - - - - - -
SIDCMDS.TXT will be used with the GET-command of CP/M 3 as redirected input for the console.

[Blacklord]

ccp3.asm

Code Select Expand

title 'CP/M 3 - Console Command Processor - November 1982'
; version 3.00  Nov 30 1982 - Doug Huskey


;  Copyright (C) 1982
;  Digital Research
;  P.O. Box 579
;  Pacific Grove, CA 93950

;  Revised: John Elliott, 25-5-1998, to include DRI patches and multiple
;          error checking ability:
;
;          If the sequence
;               COMMAND
;               :C1
;               :C2
;
;           was executed under DRI's CCP, and COMMAND returned an error,
;           then C1 would not be executed but C2 would. Under this CCP
;           C2 would not be.
;
; ****************************************************
; *****  The following equates must be set to 100H ***
; *****  + the addresses specified in LOADER.PRN   ***
; *****                                            ***
equ1 equ rsxstart  ;does this adr match loader's?
equ2 equ fixchain  ;does this adr match loader's?
equ3 equ fixchain1 ;does this adr match loader's?
equ4 equ fixchain2 ;does this adr match loader's?
equ5 equ rsx$chain ;does this adr match loader's?
equ6 equ reloc     ;does this adr match loader's?
equ7 equ calcdest  ;does this adr match loader's?
equ8 equ scbaddr   ;does this adr match loader's?
equ9 equ banked    ;does this adr match loader's?
equ10 equ rsxend    ;does this adr match loader's?
equ11 equ ccporg    ;does this adr match loader's?
equ12 equ ccpend    ;This should be 0D80h
rsxstart equ 0100h
fixchain equ 01D0h
fixchain1 equ 01EBh
fixchain2 equ 01F0h
rsx$chain equ 0200h
reloc equ 02CAh
calcdest equ 030Fh
scbaddr equ 038Dh
banked equ 038Fh
rsxend equ 0394h
ccporg equ 040Ah ;[JCE] was 041Ah, but reduced
;      to incorporate patches
; ****************************************************
; NOTE: THE ABOVE EQUATES MUST BE CORRECTED IF NECESSARY
; AND THE JUMP TO START AT THE BEGINNING OF THE LOADER
; MUST BE SET TO THE ORIGIN ADDRESS BELOW:

org ccporg ;LOADER is at 100H to 3??H

; (BE SURE THAT THIS LEAVES ENOUGH ROOM FOR THE LOADER BIT MAP)


;  Conditional Assembly toggles:

true equ 0ffffh
false equ 0h
newdir equ true
newera equ true ;confirm any ambiguous file name
dayfile equ true
prompts equ false
func152 equ true
multi equ true ;multiple command lines
;also shares code with loader (100-2??h)
;
;************************************************************************
;
; GLOBAL EQUATES
;
;************************************************************************
;
;
; CP/M BASE PAGE
;
wstart equ 0 ;warm start entry point
defdrv equ 4 ;default user & disk
bdos equ 5 ;CP/M BDOS entry point
osbase equ bdos+1 ;base of CP/M BDOS
cmdrv equ 050h ;command drive
dfcb equ 05ch ;1st default fcb
dufcb equ dfcb-1 ;1st default fcb user number
pass0 equ 051h ;1st default fcb password addr
len0 equ 053h ;1st default fcb password length
dfcb1 equ 06ch ;2nd default fcb
dufcb1 equ dfcb1-1 ;2nd default fcb user number
pass1 equ 054h ;2nd default fcb password addr
len1 equ 056h ;2nd default fcb password length
buf equ 80h ;default buffer
tpa equ 100h ;transient program area
if multi
comlen equ 100h-19h ;maximum size of multiple command
;RSX buffer with 16 byte header &
;terminating zero
else
comlen equ tpa-buf
endif
;
; BDOS FUNCTIONS
;
vers equ 31h ;BDOS vers 3.1
cinf equ 1 ;console input
coutf equ 2 ;console output
crawf equ 6 ;raw console input
pbuff equ 9 ;print buffer to console
rbuff equ 10 ;read buffer from console
cstatf equ 11 ;console status
resetf equ 13 ;disk system reset
self equ 14 ;select drive
openf equ 15 ;open file
closef equ 16 ;close file
searf equ 17 ;search first
searnf equ 18 ;search next
delf equ 19 ;delete file
readf equ 20 ;read file
makef equ 22 ;make file
renf equ 23 ;rename file
dmaf equ 26 ;set DMA address
userf equ 32 ;set/get user number
rreadf equ 33 ;read file
flushf equ 48 ;flush buffers
scbf equ 49 ;set/get SCB value
loadf equ 59 ;program load
allocf equ 98 ;reset allocation vector
trunf equ 99 ;read file
parsef equ 152 ;parse file
;
; ASCII characters
;
ctrlc: equ 'C'-40h
cr: equ 'M'-40h
lf: equ 'J'-40h
tab: equ 'I'-40h
eof: equ 'Z'-40h
;
;
; RSX MEMORY MANAGEMENT EQUATES
;
;     RSX header equates
;
entry equ 06h ;RSX contain jump to start
nextadd equ 0bh ;address of next RXS in chain
prevadd equ 0ch ;address of previous RSX in chain
warmflg equ 0eh ;remove on wboot flag
endchain equ 18h ;end of RSX chain flag
;
; LOADER.RSX equates
;
module equ 100h ;module address
;
; COM file header equates
;
comsize equ tpa+1h ;size of the COM file
rsxoff equ tpa+10h ;offset of the RSX in COM file
rsxlen equ tpa+12h ;length of the RSX
;
;
; SYSTEM CONTROL BLOCK OFFSETS
;
pag$off equ 09ch
;
olog equ pag$off-0ch ; removeable media open vector
rlog equ pag$off-0ah ; removeable media login vector
bdosbase equ pag$off-004h ; real BDOS entry point
hashl equ pag$off+000h ; system variable
hash equ pag$off+001h ; hash code
bdos$version equ pag$off+005h ; BDOS version number
util$flgs equ pag$off+006h ; utility flags
dspl$flgs equ pag$off+00ah ; display flags
clp$flgs equ pag$off+00eh ; CLP flags
clp$drv equ pag$off+00fh ; submit file drive
prog$ret$code equ pag$off+010h ; program return code
multi$rsx$pg equ pag$off+012h ; multiple command buffer page
ccpdrv equ pag$off+013h ; ccp default drive
ccpusr equ pag$off+014h ; ccp default user number
ccpconbuf equ pag$off+015h ; ccp console buffer address
ccpflag1 equ pag$off+017h ; ccp flags byte 1
ccpflag2 equ pag$off+018h ; ccp flags byte 2
ccpflag3 equ pag$off+019h ; ccp flags byte 3
conwidth equ pag$off+01ah ; console width
concolumn equ pag$off+01bh ; console column position
conpage equ pag$off+01ch ; console page length (lines)
conline equ pag$off+01dh ; current console line number
conbuffer equ pag$off+01eh ; console input buffer address
conbuffl equ pag$off+020h ; console input buffer length
conin$rflg equ pag$off+022h ; console input redirection flag
conout$rflg equ pag$off+024h ; console output redirection flag
auxin$rflg equ pag$off+026h ; auxillary input redirection flag
auxout$rflg equ pag$off+028h ; auxillary output redirection flag
listout$rflg equ pag$off+02ah ; list output redirection flag
page$mode equ pag$off+02ch ; page mode flag 0=on, 0ffH=off
page$def equ pag$off+02dh ; page mode default
ctlh$act equ pag$off+02eh ; ctl-h active
rubout$act equ pag$off+02fh ; rubout active (boolean)
type$ahead equ pag$off+030h ; type ahead active
contran equ pag$off+031h ; console translation subroutine
con$mode equ pag$off+033h ; console mode (raw/cooked)
ten$buffer equ pag$off+035h ; 128 byte buffer available
; to banked BIOS
outdelim equ pag$off+037h ; output delimiter
listcp equ pag$off+038h ; list output flag (ctl-p)
q$flag equ pag$off+039h ; queue flag for type ahead
scbad equ pag$off+03ah ; system control block address
dmaad equ pag$off+03ch ; dma address
seldsk equ pag$off+03eh ; current disk
info equ pag$off+03fh ; BDOS variable "info"
resel equ pag$off+041h ; disk reselect flag
relog equ pag$off+042h ; relog flag
fx equ pag$off+043h ; function number
usrcode equ pag$off+044h ; current user number
dcnt equ pag$off+045h ; directory record number
searcha equ pag$off+047h ; fcb address for searchn function
searchl equ pag$off+049h ; scan length for search functions
multcnt equ pag$off+04ah ; multi-sector I/O count
errormode equ pag$off+04bh ; BDOS error mode
drv0 equ pag$off+04ch ; search chain - 1st drive
drv1 equ pag$off+04dh ; search chain - 2nd drive
drv2 equ pag$off+04eh ; search chain - 3rd drive
drv3 equ pag$off+04fh ; search chain - 4th drive
tempdrv equ pag$off+050h ; temporary file drive
patch$flag equ pag$off+051h ; patch flags
date equ pag$off+058h ; date stamp
com$base equ pag$off+05dh ; common memory base address
error equ pag$off+05fh ; error jump...all BDOS errors
top$tpa equ pag$off+062h ; top of user TPA (address at 6,7)
;
; CCP FLAG 1 BIT MASKS
; (used with getflg, setflg and resetflg routines)
;
chainflg equ 080h ; program chain (funct 49)
not$chainflg equ 03fh ; mask to reset chain flags
chainenv equ 040h ; preserve usr/drv for chained prog
comredirect equ 0b320h ; command line redirection active
menu equ 0b310h ; execute ccp.ovl for menu systems
echo equ 0b308h ; echo commands in batch mode
userparse equ 0b304h ; parse user numbers in commands
subfile equ 0b301h ; $$$.SUB file found or active
subfilemask equ subfile-0b300h
rsx$only$set equ 02h ; RSX only load (null COM file)
rsx$only$clr equ 0FDh ; reset RSX only flag
;
; CCP FLAG 2 BIT MASKS
; (used with getflg, setflg and resetflg routines)
;
ccp10 equ 0b4a0h ; CCP function 10 call (2 bits)
ccpsub equ 0b420h ; CCP present (for SUBMIT, PUT, GET)
ccpbdos equ 0b480h ; CCP present (for BDOS buffer save)
dskreset equ 20h ; CCP does disk reset on ^C from prompt
submit equ 0b440h ; input redirection active
submitflg equ 40h ; input redirection flag value
order equ 0b418h ; command order
;  0 - COM only
;  1 - COM,SUB
;  2 - SUB,COM
;  3 - reserved
datetime equ 0b404h ; display date & time of load
display equ 0b403h ; display filename & user/drive
filename equ 02h ; display filename loaded
location equ 01h ; display user & drive loaded from

;
; CCP FLAG 3 BIT MASKS
; (used with getflg, setflg and resetflg routines)
;
rsxload equ 1h ; load RSX, don't fix chain
coldboot equ 2h ; try to exec profile.sub
;
;   CONMODE BIT MASKS
;
ctlc$stat equ 0cf01h ;conmode CTL-C status

;
;
;************************************************************************
;
; Console Command Processor - Main Program
;
;************************************************************************
;
;
;
start:
;
lxi sp,stack
lxi h,ccpret ;push CCPRET on stack, in case of
push h ; profile error we will go there
lxi d,scbadd
mvi c,scbf
call bdos
shld scbaddr ;save SCB address
mvi l,com$base+1
mov a,m ;high byte of commonbase
sta banked ;save in loader
mvi l,bdosbase+1 ;HL addresses real BDOS page
mov a,m ;BDOS base in H
sta realdos ;save it for use in XCOM routine
;
lda osbase+1 ;is the LOADER in memory?
sub m ;compare link at 6 with real BDOS
jnz reset$alloc ;skip move if loader already present
;
;
movldr:
lxi b,rsxend-rsxstart ;length of loader RSX
call calcdest ;calculate destination and (bias+200h)
mov h,e ;set to zero
mov l,e
; lxi h,module-100h ;base of loader RSX (less 100h)
call reloc ;relocate loader
lhld osbase ;HL = BDOS entry, DE = LOADER base
mov l,e ;set L=0
mvi c,6
call move ;move the serial number down
mvi e,nextadd
call fixchain1
;
;
reset$alloc:
mvi c,allocf
call bdos
;
;
;
;************************************************************************
;
; INITIALIZE SYSTEM CONTROL BLOCK
;
;************************************************************************
;
;
scbinit:
;
; # dir columns, page size & function 9 delimiter
;
mvi b,conwidth
call getbyte
inr a ;get console width (rel 1)
rrc
rrc
rrc
rrc
ani 0fh ;divide by 16
lxi d,dircols
stax d ;dircols = conwidth/16
mvi l,conpage
mov a,m
dcr a ;subtract 1 for space before prompt
inx d
stax d ;pgsize = conpage
xra a
inx d
stax d ;line=0
mvi a,'$'
inx d
stax d ;pgmode = nopage (>0)
mvi l,outdelim
mov m,a ;set function 9 delimiter
;
; multisector count, error mode, console mode
; & BDOS version no.
;
mvi l,multcnt
mvi m,1 ;set multisector I/O count = 1
inx h ;.errormode
xra a
mov m,a ;set return error mode = 0
mvi l,con$mode
mvi m,1 ;set ^C status mode
inx h
mov m,a ;zero 2nd conmode byte
mvi l,bdos$version
mvi m,vers ;set BDOS version no.
;
; disk reset check
;
mvi l,ccpflag2
mov a,m
ani dskreset ;^C at CCP prompt?
mvi c,resetf
push h
cnz bdos ;perform disk reset if so
pop h
;
; remove temporary RSXs (those with remove flag on)
;
rsxck:
mvi l,ccpflag1 ;check CCP flag for RSX only load
mov a,m
ani rsx$only$set ;bit = 1 if only RSX has been loaded
push h
cz rsx$chain ;don't fix-up RSX chain if so
pop h
mov a,m
ani rsx$only$clr ;clear RSX only loader flag
mov m,a ;replace it
;
; chaining environment
;
ani chain$env ;non-zero if we preserve programs
push h ;user & drive for next transient
;
; user number
;
mvi l,ccpusr ; HL = .CCP USER (saved in SCB)
lxi b,usernum ; BC = .CCP'S DEFAULT USER
mov d,h
mvi e,usrcode ; DE = .BDOS USER CODE
ldax d
stax b ; usernum = bdos user number
mov a,m ; ccp user
jnz scb1 ; jump if chaining env preserved
stax b ; usernum = ccp default user
scb1: stax d ; bdos user = ccp default user
;
; transient program's current disk
;
inx b ;.CHAINDSK
mvi e,seldsk ;.BDOS CURRENT DISK
ldax d
jnz scb2 ; jump if chaining env preserved
mvi a,0ffh
; cma ; make an invalid disk
scb2: stax b ; chaindsk = bdos disk (or invalid)
;
; current disk
;
dcx h ;.CCP's DISK (saved in SCB)
inx b ;.CCP's CURRENT DISK
mov a,m
stax b
stax d ; BDOS current disk
;
; $$$.SUB drive
;
mvi l,tempdrv
inx b ;.SUBFCB
mov a,m
stax b ; $$$.SUB drive = temporary drive
;
; check for program chain
;
pop h ;HL =.ccpflag1
mov a,m
ani chainflg ;is it a chain function (47)
jz ckboot ;jump if not
lxi h,buf
chain: lxi d,cbufl
mvi c,tpa-buf-1
mov a,c
stax d
inx d
call move ;hl = source, de = dest, c = count
jmp ccpparse
;
; execute profile.sub ?
;
ckboot: mvi l,ccpflag3
mov a,m
ani coldboot ;is this a cold start
jnz ccpcr ;jump if not
mov a,m
ori coldboot ;set flag for next time
mov m,a
sta errflg ;set to ignore errors
lxi h,profile
jmp chain ;attempt to exec profile.sub
profile:
db 'PROFILE.S',0
;
;
;
;************************************************************************
;
; BUILT-IN COMMANDS (and errors) RETURN HERE
;
;************************************************************************
;
;
ccpcr:
; enter here on each command or error condition
call setccpflg
call crlf
ccpret:
lxi h,stack-2 ;reset stack in case of error
sphl ;preserve CCPRET on stack
xra a
sta line
lxi h,ccpret ;return for next builtin
push h
call setccpflg
dcx h ;.CCPFLAG1
mov a,m
ani subfilemask ;check for $$$.SUB submit
jz prompt
;
;
;
;************************************************************************
;
; $$$.SUB file processing
;
;************************************************************************
;
;
lxi d,cbufl ;set DMA to command buffer
call setbuf
mvi c,openf
call sudos ;open it if flag on
mvi c,cstatf ;check for break if successful open
cz sudos ;^C typed?
jnz subclose ;delete $$$.SUB if break or open failed
lxi h,subrr2
mov m,a ;zero high random record #
dcx h
mov m,a ;zero middle random record #
dcx h
push h
lda subrc
dcr a
mov m,a ;set to read last record of file
mvi c,rreadf
cp sudos
pop h
dcr m ;record count (truncate last record)
mvi c,delf
cm sudos
ora a ;error on read?
;
;
subclose:
push psw
mvi c,trunf ;truncate file (& close it)
call sudos
pop psw ;any errors ?
jz ccpparse ;parse command if not
;
;
subkill:
lxi b,subfile
call resetflg ;turn off submit flag
mvi c,delf
call sudos ;kill submit
;
;
;
;************************************************************************
;
; GET NEXT COMMAND
;
;************************************************************************
;
;
;
; prompt user
;
prompt:
lda usernum
ora a
cnz pdb ;print user # if non-zero
call dirdrv1
mvi a,'>'
call putc
;
if multi
;move ccpconbuf addr to conbuffer addr
lxi d,ccpconbuf*256+conbuffer
call wordmov ;process multiple command, unless in submit
ora a ;non-zero => multiple commands active
push psw ;save A=high byte of ccpconbuf
lxi b,ccpbdos
cnz resetflg ;turn off BDOS flag if multiple commands
endif ;multi
call rcln ;get command line from console
call resetccpflg ;turn off BDOS, SUBMIT & GET ccp flags
if multi
pop psw ;D=high byte of ccpconbuf
cnz multisave ;save multiple command buffer
endif ;multi
;
;
;
;************************************************************************
;
; PARSE COMMAND
;
;************************************************************************
;
;
ccpparse:
;
; reset default page mode
; (in case submit terminated)
;
call subtest ;non-zero if submit is active
jnz get$pg$mode ;skip, if so
set$pg$mode:
mvi l,page$def
mov a,m ;pick up default
dcx h
mov m,a ;place in mode
get$pg$mode:
mvi l,page$mode
mov a,m
sta pgmode
;
;check for multiple commands
;convert to upper case
;reset ccp flag, in case entered from a CHAIN (or profile)
;
call uc ;convert to upper case, ck if multiple command
rz ;get another line if null or comment
;
;transient or built-in command?
;
lxi d,ufcb ;include user number byte in front of FCB
call gcmd ;parse command name
lda fcb+9 ;file type specified?
cpi ' '
jnz ccpdisk2 ;execute from disk, if so
lxi h,ufcb ;user or drive specified?
mov a,m ;user number
inx h
ora m ;drive
inx h
mov a,m ;get 1st character of filename
jnz ccpdisk3 ;jump if so
;
;BUILT-IN HANDLER
;
ccpbuiltin:
lxi h,ctbl ;search table of internal commands
lxi d,fcb+1
lda fcb+3
cpi ' '+1 ;is it shorter that 3 characters?
cnc tbls ;is it a built-in?
jnz ccpdisk0 ;load from disk if not
lda option ;[ in command line?
ora a ;options specified?
mov a,b ;built-in index from tbls
lhld parsep
shld errsav ;save beginning of command tail
lxi h,ptbl ;jump to processor if options not
jz tblj ;specified
cpi 4
jc trycom
lxi h,fcb+4
jnz ccpdisk0 ;if DIRS then look for DIR.COM
mvi m,' '
;
;LOAD TRANSIENT (file type unspecified)
;
ccpdisk0:
lxi b,order
call getflg ;0=COM   8=COM,SUB  16=SUB,COM
jz ccpdisk2 ;search for COM file only
mvi b,8 ;=> 2nd choice is SUB
sub b ;now a=0 (COM first) or 8 (SUB first)
jz ccpdisk1 ;search for COM first then SUB
mvi b,0 ;search for SUB first then COM

ccpdisk1:
push b ;save 2nd type to try
call settype ; A = offset of type in type table
call exec ;try to execute, return if unsuccessful
pop psw ;try 2nd type
call settype
;
;LOAD TRANSIENT (file type specified)
;
ccpdisk2:
call exec
jmp perror ;error if can't find it
;
;DRIVE SPECIFIED (check for change drives/users command)
;
ccpdisk3:
cpi ' ' ;check for filename
jnz ccpdisk0 ;execute from disk if specified
call eoc ;error if not end of command
lda ufcb ;user specified?
sui 1
jc ccpdrive

ccpuser:
sta usernum ;CCP's user number
mvi b,ccpusr
call setbyte ;save it in SCB
call setuser ;set current user

ccpdrive:
lda fcb ;drive specified?
dcr a
rm ;return if not
push psw
call select
pop psw
sta disk ;CCP's drive
mvi b,ccpdrv
jmp setbyte ;save it in SCB

;;
;
;************************************************************************
;
; BUILT-IN COMMANDS
;
;************************************************************************
;
;
; Table of internal ccp commands
;
;
ctbl: db 'DIR '
db 'TYPE '
db 'ERASE '
db 'RENAME '
db 'DIRSYS '
db 'USER '
db 0
;
ptbl: dw dir
dw type
dw era
dw ren
dw dirs
dw user
;;
;;-----------------------------------------------------------------------
;;
;; DIR Command
;;
;; DIR list directory of current default user/drive
;; DIR : list directory of user/drive
;; DIR list all files on the current default user/drive
;; with names that match
;; DIR : list all files on user/drive with names that
;; match
;;
;;-----------------------------------------------------------------------
;;
;
if newdir
dirdrv:
lda dfcb ;get disk number
endif ;newdir

dirdrv0:
dcr a
jp dirdrv2

dirdrv1:
lda disk ;get current disk
dirdrv2:
adi 'A'
jmp pfc ;print it (save BC,DE)
;
;
if newdir
dir:
mvi c,0 ;flag for DIR (normal)
lxi d,sysfiles
jmp dirs1
;
;
dirs:
mvi c,080h ;flag for DIRS (system)
lxi d,dirfiles

dirs1: push d
; [JCE] Patch 15
xra a ;Reset "anyfiles" before starting
sta anyfiles ; - it might not have been cleared
call direct
pop d ;de = .system files message
jz nofile ;jump if no files found
mov a,l ;A = number of columns
cmp b ;did we print any files?
cnc crlf ;print crlf if so
lxi h,anyfiles
dcr m
inr m
rz ;return if no files
;except those requested
dcr m ;set to zero
jmp pmsgnl ;tell the operator other files exist
;
;
direct:
push b ;save DIR/DIRS flag
call sbuf80 ;set DMA = 80h
call gfn ;parse file name
lxi d,dfcb+1
ldax d
cpi ' '
mvi b,11
cz setmatch ;use "????????.???" if none
call eoc ;make sure there's nothing else
call srchf ;search for first directory entry
pop b
rz ;if no files found
dir0:
lda dircols ;number of columns for dir
mov l,a
mov b,a
inr b ;set # names to print per line (+1)
dir1:
push h ;L=#cols, B=curent col, C=dir/dirs
lxi h,10 ;get byte with SYS bit
dad d
mov a,m
pop h
ani 80h ;look at SYS bit
cmp c ;DIR/DIRS flag in C
jz dir2 ;display, if modes agree
mvi a,1 ;set anyfiles true
sta anyfiles
jmp dir3 ;don't print anything
;
; display the filename
;
dir2:
dcr b
cz dirln ;sets no. of columns, puts crlf
mov a,b ;number left to print on line
cmp l ;is current col = number of cols
cz dirdrv ;display the drive, if so
mvi a,':'
call pfc ;print colon
call space
call pfn ;print file name
call space ;pad with space
dir3:
push b ;save current col(B), DIR/DIRS(C)
push h ;save number of columns(L)
call break ;drop out if keyboard struck
call srchn ;search for another match
pop h
pop b
jnz dir1
direx:
inr a ;clear zero flag
ret

else ;newdir

dirs: ; display system files only
mvi a,0d2h ; JNC instruction
sta dir11 ; skip on non-system files
;
dir: ; display non-system files only
lxi h,ccpcr
push h ; push return address
call gfn ;parse file name
inx d
ldax d
cpi ' '
mvi b,11
cz setmatch ;use "????????.???" if none
call eoc ;make sure there's nothing else
call findone ;search for first directory entry
jz dir4
mvi b,5 ;set # names to print per line
dir1: lxi h,10 ;get byte with SYS bit
dad d
mov a,m
ral ;look at SYS bit
dir11: jc dir3 ;don't print it if SYS bit set
mov a,b
push b
dir2: lxi h,9 ;get byte with R/O bit
dad d
mov a,m
ral ;look at R/O bit
mvi a,' ' ;print space if not R/O
jnc dir21 ;jump if not R/O
mvi a,'*' ;print star if R/O
dir21: call pfc ;print character
call pfn ;print file name
mvi a,13 ;figure out how much padding is needed
sub c
dir25: push psw
call space ;pad it out with spaces
pop psw
dcr a
jnz dir25 ;loop if more required
pop b
dcr b ;decrement # names left on line
jnz dir3
call crlf ;go to new line
mvi b,5 ;set # names to print on new line
dir3: push b
call break ;drop out if keyboard struck
call srchn ;search for another match
pop b
jnz dir1

dir4: mvi a,0dah ;JC instruction
sta dir11 ;restore normal dir mode (skip system files)
jmp ccpcr

endif ;newdir

;;
;;-----------------------------------------------------------------------
;;
;; TYPE command
;;
;; TYPE Print the contents of text file on
;; the console.
;;
;;-----------------------------------------------------------------------
;;
type: lxi h,ccpcr
push h ;push return address
call getfn ;get and parse filename
mvi a,127 ;initialize buffer pointer
sta bufp
mvi c,openf
call sbdosf ;open file if a filename was typed
type1: call break ;exit if keyboard struck
call getb ;read byte from file
rnz ;exit if physical eof or read error
cpi eof ;check for eof character
rz ;exit if so
call putc ;print character on console
jmp type1 ;loop
;
;;-----------------------------------------------------------------------
;;
;; USER command
;;
;; USER Set the user number
;;
;;-----------------------------------------------------------------------
;;
user:
lxi d,unmsg ;Enter User #:
call getprm
call gdn ;convert to binary
rz ;return if nothing typed
jmp ccpuser ;set user number
;
;;-----------------------------------------------------------------------
;;
;; ERA command
;;
;; ERA Erase all file on the current user/drive
;; which match .
;; ERA : Erase all files on user/drive which
;; match .
;;
;;-----------------------------------------------------------------------
;;
era: call getfn ;get and parse filename
jz era1
call ckafn ;is it ambiguous?
jnz era1
lxi d,eramsg
call pmsg
lhld errorp
mvi c,' ' ;stop at exclamation mark or 0
call pstrg ;echo command
lxi d,confirm
call getc
call crlf
mov a,l ;character in L after CRLF routine
ani 5fh ;convert to U/C
cpi 'Y' ;Y (yes) typed?
rnz ;return, if not
ora a ;reset zero flag
era1: mvi c,delf
jmp sbdosf

;;-----------------------------------------------------------------------
;;
;;
;; REN command
;;
;;-----------------------------------------------------------------------
;;
ren: call gfn ;zero flag set if nothing entered
push psw
lxi h,16
dad d
xchg
push d ;DE = .dfcb+16
push h ;HL = .dfcb
mvi c,16
call move ;DE = dest, HL = source
call gfn
pop h ;HL=.dfcb
pop d ;DE=.dfcb+16
call drvok
mvi c,renf ;make rename call
pop psw ;zero flag set if nothing entered
;
;;-----------------------------------------------------------------------
;;
;; BUILT-IN COMMAND BDOS CALL & ERROR HANDLERS
;;
;;-----------------------------------------------------------------------
;
sbdosf:
push psw
cnz eoc ;make sure there's nothing else
pop psw
lxi d,dfcb
mvi b,0ffh
mvi h,1 ;execute disk command if we don't call
cnz bdosf ;call if something was entered
rnz ;return if successful

ferror:
dcr h ;was it an extended error?
jm nofile
lhld errsav
shld parsep
trycom: call exec
call pfn
lxi d,required
jmp builtin$err
;
;;-----------------------------------------------------------------------
;
;
; check for drive conflict
; HL =  FCB
; DE =  FCB+16
;
drvok: ldax d ;get byte from 2nd fcb
cmp m ;ok if they match
rz
ora a ;ok if 2nd is 0
rz
inr m ;error if the 1st one's not 0
dcr m
jnz perror
mov m,a ;copy from 2nd to 1st
ret
;;-----------------------------------------------------------------------
;;
;; check for ambiguous reference in file name/type
;;
;; entry: b  = length of string to check (ckafn0)
;; de = fcb area to check (ckafn0) - 1
;; exit: z  = set if any ? in file reference (ambiguous)
;; z  = clear if unambiguous file reference
;;
ckafn:
mvi b,11 ;check entire name and type
ckafn0: inx d
ldax d
cpi '?' ;is it an ambiguous file name
if newera
rz ;return true if any afn
else ;newera
rnz ;return true only if *.*
endif ;newera
dcr b
jnz ckafn0
if newera
dcr b ;clear zero flag to return false
endif ;newera
ret ;remove above DCR to return true
;;
;;-----------------------------------------------------------------------
;;
;; get parameter (generally used to get a missing one)
;;
getprm:
call skps ;see if already there
rnz ;return if so
getp0:
if prompts
push d
lxi d,enter
call pmsg
pop d
endif
call pmsg ;print prompt
call rcln ;get response
jmp uc ;convert to upper case
;
;;
;;-----------------------------------------------------------------------
if not newdir
;;
;; search for first file, print "No File" if none
;;
findone:
call srchf
rnz ;found
endif ;not newdir
;;-----------------------------------------------------------------------

nofile:
lxi d,nomsg ;tell user no file found
builtin$err:
call pmsgnl
jmp ccpret

;
;
;************************************************************************
;
; EXECUTE DISK RESIDENT COMMAND
;
;************************************************************************
;
;
xfcb: db 0,'SUBMIT  COM' ;processor fcb
;
;
; execute submit file  (or any other processor)
;
xsub: ;DE = .fcb
ldax d
mvi b,clp$drv
call setbyte ;save submit file drive
lxi h,xfcb
mvi c,12
call move ;copy processor into fcb
lxi h,cbufl ;set parser pointer back to beginning
mvi m,' '
inx h ;move past blank
shld parsep
; execute SUBMIT.COM
;
;
; execute disk resident command (return if not found or error)
;
exec:
;try to open and execute fcb
lxi d,fcb+9
lxi h,typtbl
call tbls ;search for type in type table
rnz ;return if no match
lxi d,ufcb
ldax d ;check to see if user specified
ora a
rnz ;return if so
inx d
ldax d ;check if drive specified
mov c,a
push b ;save type (B) and drive (C)
mvi c,0 ;try only 1 open if drive specified
ora a
jnz exec1 ;try to open as specified
lxi b,(drv0-1)*256+4;try upto four opens from drv chain
lda disk
inr a
mov h,a ;save default disk in H
mvi l,1 ;allow only 1 match to default disk
exec0: inr b ;next drive to try in SCB drv chain
dcr c ;any more tries?
mov a,c
push h
cp getbyte
pop h
ora a
jm exec3
jz exec01 ;jump if drive is 0 (default drive)
cmp h ;is it the default drive
jnz exec02 ;jump if not
exec01: mov a,h ;set drive explicitly
dcr l ;is it the 2nd reference
jm exec0 ;skip, if so
exec02: stax d ;put drive in FCB
exec1: push b ;save drive offset(B) & count(C)
push h
call opencom ;on default drive & user
pop h
pop b
jz exec0 ;try next if open unsuccessful
;
; successful open, now jump to processor
;
exec2:
if dayfile
lxi b,display
call getflg
jz exec21
ldax d
call dirdrv0
mvi a,':'
call pfc
push d
call pfn
pop d
push d
lxi h,8
dad d
mov a,m
ani 80h
lxi d,userzero
cnz pmsg
call crlf
pop d
endif ;dayfile
exec21: pop psw ;recover saved command type
lxi h,xptbl
;
; table jump
;
; entry: hl = address of table of addresses
; a  = entry # (0 thru n-1)
;
tblj: add a ;adjust for two byte entries
call addhla ;compute address of entry
push d
mov e,m ;fetch entry
inx h
mov d,m
xchg
pop d
pchl ;jump to it
;
typtbl: db 'COM '
db 'SUB '
db 'PRL '
db 0
;
xptbl: dw xcom
dw xsub
dw xcom


;
; unsuccessful attempt to open command file
;
exec3: pop b ;recover drive
mov a,c
stax d ;replace in fcb
ret
;
;
settype:
;set file type specified from type table
;a = offset (x2) of desired type (in bytes)
rrc
lxi h,typtbl
call addhla ;hl = type in type table
lxi d,fcb+9
mvi c,3
jmp move ;move type into fcb
;
;
;
; EXECUTE COM FILE
;
xcom: ;DE = .fcb
;
; set up FCB for loader to use
;
lxi h,tpa
shld fcbrr ;set load address to 100h
lhld realdos-1 ;put fcb in the loader's stack
dcr h ;page below LOADER (or bottom RSX)
mvi l,0C0h ;offset for FCB in page below the BDOS
push h ;save for LOADER call
ldax d ;get drive from fcb(0)
sta cmdrv ;set command drive field in base page
xchg
mvi c,35
call move ;now move FCB to the top of the TPA
;
; set up base page
;
lxi h,errflg ;tell parser to ignore errors
inr m
xcom3: lhld parsep
dcx h ;backup over delimiter
lxi d,buf+1
xchg
shld parsep ;set parser to 81h
call copy0 ;copy command tail to 81h with
;terminating 0 (returns A=length)
sta buf ;put command tail length at 80h
xcom5: call gfn ;parse off first argument
shld pass0
mov a,b
sta len0
lxi d,dfcb1
call gfn0 ;parse off second argument
shld pass1
mov a,b
sta len1
xcom7: lxi h,chaindsk ;.CHAINDSK
mov a,m
ora a
cp select
lda usernum
call setuser ;set default user, returns H=SCB
add a ;shift user to high nibble
add a
add a
add a
mvi l,seldsk
ora m ;put disk in low nibble
sta defdrv ;set location 4
;
; initialize stack
;
xcom8: pop d ;DE = .fcb
lhld realdos-1 ;base page of BDOS
xra a
mov l,a ;top of stack below BDOS
sphl ;change the stack pointer for CCP
mov h,a ;push warm start address on stack
push h ;for programs returning to the CCP
inr h ;Loader will return to TPA
push h ;after loading a transient program
;
; initialize fcb0(CR), console mode, program return code
; & removable media open and login vectors
;
xcom9: sta 7ch ;clear next record to read
mvi b,con$mode
call setbyte ;set to zero (turn off ^C status)
mvi l,olog
mov m,a ;zero removable open login vector
inx h
mov m,a
inx h
mov m,a ;zero removable media login vector
inx h
mov m,a
mvi l,ccpflag1
mov a,m
ani chain$flg ;chaining?
jnz loader ;load program without clearing
mvi l,prog$ret$code ;the program return code
mov m,a ;A=0
inx h
mov m,a ;set program return = 0000h
;
; call loader
;
loader:
mov a,m ;reset chain flag if set,
ani not$chainflg ;has no effect if we fell through
mov m,a
mvi c,loadf ;use load RSX to load file
jmp bdos ;now load it
;
;
;
;
;************************************************************************
;
; BDOS FUNCTION INTERFACE - Non FCB functions
;
;************************************************************************
;
;
;
;;-----------------------------------------------------------------------
;;
;;
;;
;; print character on terminal
;; pause if screen is full
;; (BDOS function #2)
;;
;; entry: a  = character (putc entry)
;; e  = character (putc2 entry)
;;

putc: cpi lf ;end of line?
jnz putc1 ;jump if not
lxi h,pgsize ;.pgsize
mov a,m ;check page size
inx h ;.line
inr m ;line=line+1
sub m ;line=page?
jnz putc0
mov m,a ;reset line=0 if so
inx h ;.pgmode
mov a,m ;is page mode off?
ora a ;page=0 if so
lxi d,more
cz getc ;wait for input if page mode on
cpi ctrlc
jz ccpcr
mvi e,cr
call putc2 ;print a cr
putc0: mvi a,lf ;print the end of line char
putc1: mov e,a
putc2: mvi c,coutf
jmp bdos

;;
;;-----------------------------------------------------------------------
;;
;; get character from console
;; (BDOS function #1)
;;
getc: call pmsg
getc1: mvi c,cinf
jmp bdos
;;
;;-----------------------------------------------------------------------
;;
;; print message string on terminal
;; (BDOS function #9)
;;
pmsg: mvi c,pbuff
jmp bdos
;;
;;-----------------------------------------------------------------------
;;
;; read line from console
;; (calls BDOS function #10)
;;
;; exit: z  = set if null line
;;
;; This function uses the buffer "cbuf" (see definition of
;; function 10 for a description of the buffer).  All input
;; is converted to upper case after reading and the pointer
;; "parsep" is set to the begining of the first non-white
;; character string.
;;
rcln: lxi h,cbufmx ;get line from terminal
mvi m,comlen ;set maximum buffer size
xchg
mvi c,rbuff
call bdos
lxi h,cbufl ;terminate line with zero byte
mov a,m
inx h
call addhla
mvi m,0 ;put zero at the end
jmp crlf ;advance to next line
;
;;
;;-----------------------------------------------------------------------
;;
;; exit routine if keyboard struck
;; (calls BDOS function #11)
;;
;; Control is returned to the caller unless the console
;; keyboard has a character ready, in which case control
;; is transfer to the main program of the CCP.
;;
break: call break1
rz
jmp ccpcr

break1: mvi c,cstatf
call rw
rz
mvi c,cinf
jmp rw


;;
;;-----------------------------------------------------------------------
;;
;; set disk buffer address
;; (BDOS function #26)
;;
;; entry: de -> buffer ("setbuf" only)
;;
sbuf80: lxi d,buf
setbuf: mvi c,dmaf
jmp bdos
;;
;;-----------------------------------------------------------------------
;;
;; select disk
;; (BDOS function #14)
;;
;; entry: a  = drive
;;
select:
mov e,a
mvi c,self
jmp bdos
;
;;
;;-----------------------------------------------------------------------
;;
;; set user number
;; (BDOS function #32)
;;
;; entry: a  = user #
;; exit: H  = SCB page
;;
setuser:
mvi b,usrcode
jmp set$byte
;
;
;
;************************************************************************
;
; BDOS FUNCTION INTERFACE - Functions with a FCB Parameter
;
;************************************************************************
;
;
;;
;; open file
;; (BDOS function #15)
;;
;; exit: z  = set if file not found
;;
;;
opencom: ;open command file (SUB, COM or PRL)
lxi b,openf ;b=0 => return error mode of 0
lxi d,fcb ;use internal FCB

;; BDOS CALL ENTRY POINT   (used by built-ins)
;;
;; entry: b  = return error mode (must be 0 or 0ffh)
;; c  = function no.
;; de = .fcb
;; exit: z  = set if error
;; de = .fcb
;;
bdosf: lxi h,32 ;offset to current record
dad d ;HL = .current record
mvi m,0 ;set to zero for read/write
push b ;save function(C) & error mode(B)
push d ;save .fcb
ldax d ;was a disk specified?
ana b ;and with 0 or 0ffh
dcr a ;if so, select it in case
cp select ;of permanent error (if errmode = 0ffh)
lxi d,passwd
call setbuf ;set dma to password
pop d ;restore .fcb
pop b ;restore function(C) & error mode(B)
push d
lhld scbaddr
mvi l,errormode
mov m,b ;set error mode
push h ;save .errormode
call bdos
pop d ;.errormode
xra a
stax d ;reset error mode to 0
lda disk
mvi e,seldsk
stax d ;reset current disk to default
push h ;save bdos return values
call sbuf80
pop h ;bdos return
inr l ;set z flag if error
pop d ;restore .fcb
ret
;;
;;-----------------------------------------------------------------------
;;
;; close file
;; (BDOS function #16)
;;
;; exit: z  = set if close error
;;
;;close: mvi c,closef
;; jmp oc
;;
;;-----------------------------------------------------------------------
;;
;; delete file
;;
;; exit: z  = set if file not found
;;
;; The match any character "?" may be used without restriction
;; for this function.  All matched files will be deleted.
;;
;;
;;delete:
;; mvi c,delf
;; jmp oc
;;
;;-----------------------------------------------------------------------
;;
;; create file
;; (BDOS function #22)
;;
;; exit: z  = set if create error
;;
;;make: mvi c,makef
;; jmp oc
;;-----------------------------------------------------------------------
;;
;; search for first filename match (using "DFCB" and "BUF")
;; (BDOS function #17)
;;
;; exit: z  = set if no match found
;; z  = clear if match found
;; de -> directory entry in buffer
;;
srchf: mvi c,searf ;set search first function
jmp srch
;;
;;-----------------------------------------------------------------------
;;
;; search for next filename match (using "DFCB" and "BUF")
;; (BDOS function #18)
;;
;; exit: z  = set if no match found
;; z  = clear if match found
;; de -> directory entry in buffer
;;
srchn: mvi c,searnf ;set search next function
srch: lxi d,dfcb ;use default fcb
call bdos
inr a ;return if not found
rz
dcr a ;restore original return value
add a ;shift to compute buffer pos'n
add a
add a
add a
add a
lxi h,buf ;add to buffer start address
call addhla
xchg ;de -> entry in buffer
xra a ;may be needed to clear z flag
dcr a ;depending of value of "buf"
ret
;;
;;-----------------------------------------------------------------------
;;
;; read file
;; (BDOS function #20)
;;
;; entry: hl = buffer address (readb only)
;; exit z  = set if read ok
;;
read: xra a ;clear getc pointer
sta bufp
mvi c,readf
lxi d,dfcb
rw: call bdos
ora a
ret
;
;;
;;-----------------------------------------------------------------------
;;
;; $$$.SUB interface
;;
;; entry: c = bdos function number
;; exit z  = set if successful

sudos: lxi d,subfcb
jmp rw
;
;
;
;************************************************************************
;
; COMMAND LINE PARSING SUBROUTINES
;
;************************************************************************
;
;------------------------------------------------------------------------
;
; COMMAND LINE PREPARSER
; reset function 10 flag
; set up parser
; convert to upper case
;
; All input is converted to upper case and the pointer
; "parsep" is set to the begining of the first non-blank
; character string.  If the line begins with a ; or :, it
; is treated specially:
;
; ; comment the line is ignored
; : conditional the line is ignored if a fatal
; error occured during the previous
; command, otherwise the : is
; ignored
;
; An exclamation point is used to separate multiple commands on a
; a line.  Two adjacent exclaimation points translates into a single
; exclaimation point in the command tail for compatibility.
;------------------------------------------------------------------------
;
;
uc:
call resetccpflg
xchg ;DE = .SCB
xra a
sta option ;zero option flag
lxi h,cbuf
call skps1 ;skip leading spaces/tabs
xchg
cpi ';' ;HL = .scb
rz
cpi '!'
jz uc0
cpi ':'
jnz uc1
;
;[JCE] this fragment rewritten not to trash the program return code when
;      reading it.
;
mvi l,prog$ret$code
mov a,m ;[JCE]
inr a ;[JCE]
inr a ;[JCE]
;;; inr m
;;; inr m ;was ^C typed? (low byte 0FEh)
jz uc0 ;successful, if so
inx h
mov a,m ;[JCE]
inr a ;[JCE]
;;; inr m ;is high byte 0FFh?
rz ;skip command, if so
uc0: inx d ;skip over 1st character
uc1: xchg ;HL=.command line
shld parsep ;set parse pointer to beginning of line
uc3: mov a,m ;convert lower case to upper
cpi '['
jnz uc4
sta option ;'[' is the option delimiter => command option
uc4: cpi 'a'
jc uc5
cpi 'z'+1
jnc uc5
sui 'a'-'A'
mov m,a
uc5:
if multi
cpi '!'
cz multistart ;HL=.char, A=char
endif ;multi
inx h ;advance to next character
ora a ;loop if not end of line
jnz uc3
;
; skip spaces
; return with zero flag set if end of line
;
skps: lhld parsep ;get current position
skps1: shld parsep ;save position
shld errorp ;save position for error message
mov a,m
ora a ;return if end of command
rz
cpi ' '
jz skps2
cpi tab ;skip spaces & tabs
rnz
skps2: inx h ;advance past space/tab
jmp skps1 ;loop
;
;-----------------------------------------------------------------------
;
; MULTIPLE COMMANDS PER LINE HANDLER
;
;-----------------------------------------------------------------------
if multi

multistart:
;
; A  = current character in command line
; HL = address of current character in command line
;
;double exclaimation points become one
mov e,l
mov d,h
inx d
ldax d
cpi '!' ;double exclaimation points
push psw
push h
cz copy0 ;convert to one, if so
pop h
pop psw
rz
;we have a valid multiple command line
mvi m,0 ;terminate command line here
xchg
;multiple commands not allowed in submits
;NOTE: submit unravels multiple commands making the
;following test unnecessary.  However, with GET[system]
;or CP/M 2.2 SUBMIT multiple commands will be posponed
;until the entire submit completes...  
; call subtest ;submit active
; mvi a,0
; rnz ;return with A=0, if so
;set up the RSX buffer
lhld osbase ;get high byte of TPA address
dcr h ;subtract 1 page for buffer
mvi l,endchain ;HL = RSX buffer base-1
mov m,a ;set end of chain flag to 0
push h ;save it
multi0: inx h
inx d
ldax d ;get character from cbuf
mov m,a ;place in RSX
cpi '!'
jnz multi1
mvi m,cr ;change exclaimation point to cr
multi1: ora a
jnz multi0
mvi m,cr ;end last command with cr
inx h
mov m,a ;terminate with a zero
;set up RSX prefix
mvi l,6 ;entry point
mvi m,jmp ;put a jump instruction there
inx h
mvi m,9 ;make it a jump to base+9 (RSX exit)
inx h
mov m,h
inx h ;HL = RSX exit point
mvi m,jmp ;put a jump instruction there
mvi l,warmflg ;HL = remove on warm start flag
mov m,a ;set (0) for RSX to remain resident
mov l,a ;set low byte to 0 for fixchain
xchg ;DE = RSX base
call fixchain ;add the RSX to the chain
;save buffer address
lhld scbaddr
mvi l,ccpconbuf ;save buffer address in CCP conbuf field
pop d ;DE = RSX base
inx d
mov m,e
inx h
mov m,d
mvi l,multi$rsx$pg
mov m,d ;save the RSX base
xra a ;zero in a to fall out of uc
ret
;
;
; save the BDOS conbuffer address and
; terminate RSX if necessary.
;
multisave:
lxi d,conbuffer*256+ccpconbuf
call wordmov ;first copy conbuffer in case SUBMIT
ora a ;and/or GET are active
lxi d,conbuffl*256+ccpconbuf
cz wordmov ;if conbuff is zero then conbufl has the
push h ;next address
call break1
pop h ;H = SCB page
mvi l,ccpconbuf
jnz multiend
mov e,m
inx h
mov d,m ;DE = next conbuffer address
inr m
dcr m ;is high byte zero?
dcx h ;HL = .ccpconbuf
jz multiend ;remove multicmd RSX if so
ldax d ;check for terminating zero
ora a
rnz ;return if not
;
; we have exhausted all the commands
multiend:
; HL = .ccpconbuf
xra a
mov m,a ;set buffer to zero
inx h
mov m,a
mvi l,multi$rsx$pg
mov h,m
mvi l,0eh ;HL=RSX remove on warmstart flag
dcr m ;set to true for removal
jmp rsx$chain ;remove the multicmd rsx buffer

endif ;multi
;;
;************************************************************************
;
; FILE NAME PARSER
;
;************************************************************************
;
;
;
; get file name (read in if none present)
;
;
;; The file-name parser in this CCP implements
;; a user/drive specification as an extension of the normal
;; CP/M drive selection feature.  The syntax of the
;; user/drive specification is given below.  Note that a
;; colon must follow the user/drive specification.
;;
;; : is an alphabetic character A-P specifing one
;; of the CP/M disk drives.
;;
;; : is a decimal number 0-15 specifying one of the
;; user areas.
;;
;; : A specification of both user area and drive.
;;
;; : Synonymous with above.
;;
;; Note that the user specification cannot be included
;; in the parameters of transient programs or precede a file
;; name.  The above syntax is parsed by gcmd (get command).
;;
;; ************************************************************

getfn:
if prompts
lxi d,fnmsg
getfn0:
call getprm
endif ;prompts
gfn: lxi d,dfcb
gfn0: call skps ;sets zero flag if eol
push psw
call gfn2
pop psw
ret
;
; BDOS FUNCTION 152 INTERFACE
;
;entry: DE = .FCB
; HL = .buffer
;flags/A reg preserved
;exit:  DE = .FCB
;
;
gfn2: shld parsep
shld errorp
push d ;save .fcb
lxi d,pfncb
mvi c,parsef
if func152
call bdos
else ;func152
call parse
endif ;func152
pop d ;.fcb
mov a,h
ora l ;end of command? (HL = 0)
mov b,m ;get delimiter
inx h ;move past delimiter
jnz gfn3
lxi h,zero+2 ;set HL = .0
gfn3: mov a,h
ora l ;parse error? (HL = 0ffffh)
jnz gfn4
lxi h,zero+2
call perror
gfn4: mov a,b
cpi '.'
jnz gfn6
dcx h
gfn6: shld parsep ;update parse pointer
gfnpwd: mvi c,16
lxi h,pfcb
push d
call move
lxi d,passwd ;HL = .disk map in pfcb
mvi c,10
call move ;copy to passwd
pop d ;HL = .password len
mov a,m
zero: lxi h,0 ;must be an "lxi h,0"
ora a ;is there a password?
mov b,a
jz gfn8
lhld errorp ;HL = .filename
gfn7: mov a,m
cpi ';'
inx h
jnz gfn7
gfn8: ret ;B = len, HL = .password

;
; PARSE CP/M 3 COMMAND
; entry: DE  = .UFCB  (user no. byte in front of FCB)
; PARSEP = .command line
gcmd:
push d
xra a
stax d ;clear user byte
inx d
stax d ;clear drive byte
inx d
call skps ;skip leading spaces
;
; Begin by looking for user/drive-spec.  If none if found,
; fall through to main file-name parsing section.  If one is found
; then branch to the section that handles them.  If an error occurs
; in the user/drive spec; treat it as a filename for compatibility
; with CP/M 2.2.  (e.g. STAT VAL: etc.)
;
lhld parsep ;get pointer to current parser position
pop d
push d ;DE = .UFCB
mvi b,4 ;maximum length of user/drive spec
gcmd1: mov a,m ;get byte
cpi ':' ;end of user/drive-spec?
jz gcmd2 ;parse user/drive if so
ora a ;end of command?
jz gcmd8 ;parse filename (Func 152), if so
cpi 9 ;[JCE] Patch 12, bug in "P B:" type commands
jz gcmd8 ;[JCE]
cpi ' ' ;[JCE]
jz gcmd8 ;[JCE]
dcr b ;maximum user/drive spec length exceeded?
inx h
jnz gcmd1 ;loop if not
;
; Parse filename, type and password
;
gcmd8:
pop d
xra a
stax d ;set user = default
lhld parsep
gcmd9: inx d ;past user number byte
ldax d ;A=drive
push psw
call gfn2 ;BDOS function 152 interface
pop psw
stax d
ret
;
; Parse the user/drive-spec
;
gcmd2:
lhld parsep ;get pointer to beginning of spec
mov a,m ;get character
gcmd3: cpi '0' ;check for user number
jc gcmd4 ;jump if not numeric
cpi '9'+1
jnc gcmd4
call gdns ;get the user # (returned in B)
pop d
push d
ldax d ;see if we already have a user #
ora a
jnz gcmd8 ;skip if we do
mov a,b ;A = specified user number
inr a ;save it as the user-spec
stax d
jmp gcmd5
gcmd4: cpi 'A' ;check for drive-spec
jc gcmd8 ;skip if not a valid drive character
cpi 'P'+1
jnc gcmd8
pop d
push d
inx d
ldax d ;see if we already have a drive
ora a
jnz gcmd8 ;skip if so
mov a,m
sui '@' ;convert to a drive-spec
stax d
inx h
gcmd5: mov a,m ;get next character
cpi ':' ;end of user/drive-spec?
jnz gcmd3 ;loop if not
inx h
pop d ;.ufcb
jmp gcmd9 ;parse the file name


;
;************************************************************************
;
; TEMPORARY PARSE CODE
;
;************************************************************************
;
if not func152
; version 3.0b  Oct 08 1982 - Doug Huskey
;
;

passwords equ true

parse: ; DE->.(.filename,.fcb)
;
; filename = [d:]file[.type][;password]
;            
; fcb assignments
;
;   0     => drive, 0 = default, 1 = A, 2 = B, ...
;   1-8   => file, converted to upper case,
;            padded with blanks (left justified)
;   9-11  => type, converted to upper case,
;     padded with blanks (left justified)
;   12-15 => set to zero
;   16-23 => password, converted to upper case,
;     padded with blanks
;   26    => length of password (0 - 8)
;
; Upon return, HL is set to FFFFH if DE locates
;            an invalid file name;
; otherwise, HL is set to 0000H if the delimiter
;            following the file name is a 00H (NULL)
;     or a 0DH (CR);
; otherwise, HL is set to the address of the delimiter
;            following the file name.
;
xchg
mov e,m ;get first parameter
inx h
mov d,m
push d ;save .filename
inx h
mov e,m ;get second parameter
inx h
mov d,m
pop h ;DE=.fcb  HL=.filename
xchg
parse0:
push h ;save .fcb
xra a
mov m,a ;clear drive byte
inx h
lxi b,20h*256+11
call pad ;pad name and type w/ blanks
lxi b,4
call pad ;EXT, S1, S2, RC = 0
lxi b,20h*256+8
call pad ;pad password field w/ blanks
lxi b,12
call pad
call skip
;
; check for drive
;
ldax d
cpi ':' ;is this a drive?
dcx d
pop h
push h ;HL = .fcb
jnz parse$name
;
; Parse the drive-spec
;
parsedrv:
ldax d ;get character
ani 5fh ;convert to upper case
sui 'A'
jc perr1
cpi 16
jnc perr1
inx d
inx d ;past the ':'
inr a ;set drive relative to 1
mov m,a ;store the drive in FCB(0)
;
; Parse the file-name
;
parse$name:
inx h ;HL = .fcb(1)
call delim
jz parse$ok
if passwords
lxi b,7*256
else ;passwords
mvi b,7
endif ;passwords
parse6: ldax d ;get a character
cpi '.' ;file-type next?
jz parse$type ;branch to file-type processing
cpi ';'
jz parsepw
call gfc ;process one character
jnz parse6 ;loop if not end of name
jmp parse$ok
;
; Parse the file-type
;
parse$type:
inx d ;advance past dot
pop h
push h ;HL =.fcb
lxi b,9
dad b ;HL =.fcb(9)
if passwords
lxi b,2*256
else ;passwords
mvi b,2
endif ;passwords
parse8: ldax d
cpi ';'
jz parsepw
call gfc ;process one character
jnz parse8 ;loop if not end of type
;
parse$ok:
pop b
push d
call skip
call delim
pop h
rnz
lxi h,0
ora a
rz
cpi cr
rz
xchg
ret
;
; handle parser error
;
perr:
pop b ;throw away return addr
perr1:
pop b
lxi h,0ffffh
ret
;
if passwords
;
; Parse the password
;
parsepw:
inx d
pop h
push h
lxi b,16
dad b
lxi b,7*256+1
parsepw1:
call gfc
jnz parsepw1
mvi a,7
sub b
pop h
push h
lxi b,26
dad b
mov m,a
ldax d ;delimiter in A
jmp parse$ok
else
;
; skip over password
;
parsepw:
inx d
call delim
jnz parsepw
jmp parse$ok
endif ;passwords
;
; get next character of name, type or password
;
gfc: call delim ;check for end of filename
rz ;return if so
cpi ' ' ;check for control characters
inx d
jc perr ;error if control characters encountered
inr b ;error if too big for field
dcr b
jm perr
if passwords
inr c
dcr c
jnz gfc1
endif
cpi '*' ;trap "match rest of field" character
jz setwild
gfc1: mov m,a ;put character in fcb
inx h
dcr b ;decrement field size counter
ora a ;clear zero flag
ret
;;
setwild:
mvi m,'?' ;set match one character
inx h
dcr b
jp setwild
ret
;
; skip spaces
;
skip0: inx d
skip: ldax d
cpi ' ' ;skip spaces & tabs
jz skip0
cpi tab
jz skip0
ret
;
; check for delimiter
;
; entry: A = character
; exit: z = set if char is a delimiter
;
delimiters: db cr,tab,' .,:;[]=<>|',0

delim: ldax d ;get character
push h
lxi h,delimiters
delim1: cmp m ;is char in table
jz delim2
inr m
dcr m ;end of table? (0)
inx h
jnz delim1
ora a ;reset zero flag
delim2: pop h
rz
;
; not a delimiter, convert to upper case
;
cpi 'a'
rc
cpi 'z'+1
jnc delim3
ani 05fh
delim3: ani 07fh
ret ;return with zero set if so
;
; pad with blanks
;
pad: mov m,b
inx h
dcr c
jnz pad
ret
;
endif
;
;
;************************************************************************
;
; SUBROUTINES
;
;************************************************************************
;
if multi
;
; copy SCB memory word
; d = source offset e = destination offset
;
wordmov:
lhld scbaddr
mov l,d
mov d,h
mvi c,2
;
endif ;multi
;
; copy memory bytes
; de = destination  hl = source  c = count
;
move:
mov a,m
stax d ;move byte to destination
inx h
inx d ;advance pointers
dcr c ;loop if non-zero
jnz move
ret
;
; copy memory bytes with terminating zero
; hl = destination  de = source  
; returns c=length

copy0: mvi c,0
copy1: ldax d
mov m,a
ora a
mov a,c
rz
inx h
inx d
inx b
jmp copy1

;;
;;-----------------------------------------------------------------------
;;
;; get byte from file
;;
;; exit: z  = set if byte gotten
;; a  = byte read
;; z  = clear if error or eof
;; a  = return value of bdos read call
;;
getb: xra a ;clear accumulator
lxi h,bufp ;advance buffer pointer
inr m
cm read ;read sector if buffer empty
ora a
rnz ;return if read error or eof
lda bufp ;compute pointer into buffer
lxi h,buf
call addhla
xra a ;set zero flag
mov a,m ;get byte
ret
;;
;;-----------------------------------------------------------------------
;;
;;
;; system control block flag routines
;;
;; entry: c  = bit mask (1 bit on)
;; b  = scb byte offset
;;
subtest:
lxi b,submit
getflg:
; return flag value
; exit: zero flag set if flag reset
; c  = bit mask
; hl = flag byte address
;
lhld scbaddr
mov l,b
mov a,m
ana c ; a = bit
ret
;
setccpflg:
lxi b,ccp10

;
setflg:
; set flag on (bit = 1)
;
call getflg
mov a,c
ora m
mov m,a
ret
;
resetccpflg:
lxi b,ccp10
;
resetflg:
; reset flag off (bit = 0)
;
call getflg
mov a,c
cma
ana m
mov m,a
ret
;;
;;
;; SET/GET SCB BYTE
;;
;; entry: A  = byte ("setbyte" only)
;; B  = SCB byte offset from page
;;
;; exit: A  = byte ("getbyte" only)
;;
setbyte:
lhld scbaddr
mov l,b
mov m,a
ret
;
getbyte:
lhld scbaddr
mov l,b
mov a,m
ret
;



;;-----------------------------------------------------------------------
;;
;;
;; print message followed by newline
;;
;; entry: de -> message string
;;
pmsgnl: call pmsg
;
; print crlf
;
dirln: mov b,l ;number of columns for DIR
crlf: mvi a,cr
call pfc
mvi a,lf
jmp pfc
;;
;;-----------------------------------------------------------------------
;;
;; print decimal byte
;;
pdb: sui 10
jc pdb2
mvi e,'0'
pdb1: inr e
sui 10
jnc pdb1
push psw
call putc2
pop psw
pdb2: adi 10+'0'
jmp putc
;;-----------------------------------------------------------------------
;;
;;
;; print string terminated by 0 or char in c
;;
pstrg: mov a,m ;get character
ora a
rz
cmp c
rz
call pfc ;print character
inx h ;advance pointer
jmp pstrg ;loop
;;
;;-----------------------------------------------------------------------
;;
;; check for end of command (error if extraneous parameters)
;;
eoc: call skps
rz
;
; handle parser error
;
perror:
lxi h,errflg
mov a,m
ora a ;ignore error????
mvi m,0 ;clear error flag
rnz ;yes...just return to CCPRET
lhld errorp ;get pointer to what we're parsing
mvi c,' '
call pstrg
perr2: mvi a,'?' ;print question mark
call putc
jmp ccpcr
;
;;-----------------------------------------------------------------------
;;
;;
;; print error message and exit processor
;;
;; entry: bc -> error message
;;
;;msgerr: push b
;; call crlf
;; pop d
;; jmp pmsgnl
;;
;;-----------------------------------------------------------------------
;;
;; get decimal number (0 <= N <= 255)
;;
;; exit: a  = number
;;
gdn: call skps ;skip initial spaces
lhld parsep ;get pointer to current character
shld errorp ;save in case of parsing error
rz ;return if end of command
mov a,m ;get it
cpi '0' ;error if non-numeric
jc perror
cpi '9'+1
jnc perror
call gdns ;convert number
shld parsep ;save new position
ori 1 ;clear zero and carry flags
mov a,b
ret
;
gdns: mvi b,0
gdns1: mov a,m
sui '0'
rc
cpi 10
rnc
push psw
mov a,b ;multiply current accumulator by 10
add a
add a
add b
add a
mov b,a
pop psw
inx h ;advance to next character
add b ;add it in to the current accumulation
mov b,a
cpi 16
jc gdns1 ;loop unless >=16
jmp perror ;error if invalid user number
;;
;;-----------------------------------------------------------------------
;;
;; print file name
;;
if newdir
pfn: inx d ;point to file name
mvi h,8 ;set # characters to print, clear # printed
call pfn1 ;print name field
call space
mvi h,3 ;set # characters to print
pfn1: ldax d ;get character
ani 7fh
call pfc ;print it if not
inx d ;advance pointer
dcr h ;loop if more to print
jnz pfn1
ret
;
space: mvi a,' '
;
pfc: push b
push d
push h
call putc
pop h
pop d
pop b
ret

else

pfn: inx d ;point to file name
lxi b,8*256 ;set # characters to print, clear # printed
call pfn1 ;print name field
ldax d ;see if there's a type
ani 7fh
cpi ' '
rz ;return if not
mvi a,'.' ;print dot
call pfc
mvi b,3 ;set # characters to print
pfn1: ldax d ;get character
ani 7fh
cpi ' ' ;is it a space?
cnz pfc ;print it if not
inx d ;advance pointer
dcr b ;loop if more to print
jnz pfn1
ret
;
space: mvi a,' '
;
pfc: inr c ;increment # characters printed
push b
push d
call putc
pop d
pop b
ret
endif
;;
;;-----------------------------------------------------------------------
;;
;; add a to hl
;;
addhla: add l
mov l,a
rnc
inr h
ret
;;
;;-----------------------------------------------------------------------
;;
;; set match-any string into fcb
;;
;; entry: de -> fcb area
;; b  = # bytes to set
;;
setmatch:
mvi a,'?' ;set match one character
setm1: stax d ;fill rest of field with match one
inx d
dcr b ;loop if more to fill
jnz setm1
ora a
ret
;;
;;-----------------------------------------------------------------------
;;
;; table search
;;
;; Search table of strings separated by spaces and terminated
;; by 0.  Accept abbreviations, but set string = matched string
;; on exit so that we don't try to execute abbreviation.
;;
;; entry: de -> string to search for
;; hl -> table of strings to match (terminate table with 0)
;; exit: z  = set if match found
;; a  = entry # (0 thru n-1)
;; z  = not set if no match found
;;
tbls: lxi b,0ffh ;clear entry & entry length counters
tbls0: push d ;save match string addr
push h ;save table string addr
tbls1: ldax d ;compare bytes
ani 7fh ;kill upper bit (so SYS + R/O match)
cpi ' '+1 ;end of search string?
jc tbls2 ;skip compare, if so
cmp m
jnz tbls3 ;jump if no match
tbls2: inx d ;advance string pointer
inr c ;increment entry length counter
mvi a,' '
cmp m
inx h ;advance table pointer
jnz tbls1 ;continue with this entry if more
pop h ;HL = matched string in table
pop d ;DE = string address
call move ; C = length of string in table
mov a,b ;return current entry counter value
ret
;
tbls3: mvi a,' ' ;advance hl past current string
tbls4: cmp m
inx h
jnz tbls4
pop d ;throw away last table address
pop d ;DE = string address
inr b ;increment entry counter
mvi c,0ffh
mov a,m ;check for end of table
sui 1
jnc tbls0 ;loop if more entries to test
ret
;
;************************************************************************
;************************************************************************
;
;************************************************************************
;
; DATA AREA
;
;************************************************************************
; ;Note uninitialized data placed at the end (DS)
;
;
if prompts
enter: db 'Enter $'
unmsg: db 'User #: $'
fnmsg: db 'File: $'
else
unmsg: db 'Enter User #: $'
endif
nomsg: db 'No File$'
required:
db ' required$'
eramsg:
db 'ERASE $'
confirm:
db ' (Y/N)? $'
more: db cr,lf,cr,lf,'Press RETURN to Continue $'
if dayfile
userzero db '  (User 0)$'
endif
;
;
;
if newdir
anyfiles: db 0 ;flag for SYS or DIR files exist
dirfiles: db 'NON-'
sysfiles: db 'SYSTEM FILE(S) EXIST$'
endif

errflg: db 0 ;parse error flag
if multi
multibufl:
dw 0 ;multiple commands buffer length
endif
scbadd: db scbad-pag$off,0
;********** CAUTION FOLLOWING DATA MUST BE IN THIS ORDER *********
pfncb: ;BDOS func 152 (parse filename)
parsep: dw 0 ;pointer to current position in command
pfnfcb: dw pfcb ;.fcb for func 152
usernum: ;CCP current user
db 0
chaindsk:
db 0 ;transient's current disk
disk: db 0 ;CCP current disk
subfcb: db 1,'$$$     SUB',0
ccpend: ;end of file (on disk)
ds 1
submod: ds 1
subrc: ds 1
ds 16
subcr: ds 1
subrr: ds 2
subrr2: ds 1

dircols:
ds 1 ;number of columns for DIR/DIRS
pgsize: ds 1 ;console page size
line: ds 1 ;console line #
pgmode: ds 1 ;console page mode
;*****************************************************************
errorp: ds 2 ;pointer to beginning of current param.
errsav: ds 2 ;pointer to built-in command tail
bufp: ds 1 ;buffer pointer for getb
realdos:
ds 1 ;base page of BDOS
;
option: ds 1 ;'[' in line?
passwd: ds 10 ;password
ufcb: ds 1 ;user number (must procede fcb)
FCB:
ds 1 ; drive code
ds 8 ; file name
ds 3 ; file type
ds 4 ; control info
ds 16 ; disk map
fcbcr: ds 1 ; current record
fcbrr: ds 2 ; random record
pfcb: ds 36 ; fcb for parsing
;
;
;
;
; command line buffer
;
cbufmx: ds 1
cbufl: ds 1
cbuf: ds comlen
ds 50h
stack:
ccptop: ;top page of CCP
end

[Blacklord]

loader3.asm

Code Select Expand

title 'CP/M 3 - PROGRAM LOADER RSX - November 1982'
; version 3.0b  Nov 04 1982 - Kathy Strutynski
; version 3.0c  Nov 23 1982 - Doug Huskey
;              Dec 22 1982 - Bruce Skidmore
;
;
; copyright (c) 1982
; digital research
; box 579
; pacific grove, ca.
; 93950
;
  ****************************************************
  *****  The following values must be placed in    ***
  *****  equates at the front of CCP3.ASM.         ***
  *****                                            ***
  *****  Note: Due to placement at the front these ***
  *****  equates cause PHASE errors which can be   ***
  *****  ignored.                                  ***
equ1 equ rsxstart +0100h  ;set this equate in the CCP
equ2 equ fixchain +0100h  ;set this equate in the CCP
equ3 equ fixchain1+0100h  ;set this equate in the CCP
equ4 equ fixchain2+0100h  ;set this equate in the CCP
equ5 equ rsx$chain+0100h  ;set this equate in the CCP
equ6 equ reloc    +0100h  ;set this equate in the CCP
equ7 equ calcdest +0100h  ;set this equate in the CCP
equ8 equ scbaddr +0100h  ;set this equate in the CCP
equ9 equ banked +0100h  ;set this equate in the CCP
equ10 equ rsxend +0100h  ;set this equate in the CCP
ccporg equ CCP ;set origin to this in CCP
patch equ patcharea+0100h  ;LOADER patch area

CCP equ 40Ah ;ORIGIN OF CCP3.ASM


  ****************************************************

; conditional assembly toggles:

true equ 0ffffh
false equ 0h
spacesaver equ true

stacksize equ 32 ;16 levels of stack
version equ 30h
tpa equ 100h
ccptop equ 0Fh ;top page of CCP
osbase equ 06h ;base page in BDOS jump
off$nxt equ 10 ;address in next jmp field
currec equ 32 ;current record field in fcb
ranrec equ 33 ;random record field in fcb



;
;
;     dsect for SCB
;
bdosbase equ 98h ; offset from page boundary
ccpflag1 equ 0b3h ; offset from page boundary
multicnt equ 0e6h ; offset from page boundary
rsx$only$clr equ 0FDh ;clear load RSX flag
rsx$only$set equ 002h
rscbadd equ 3ah ;offset of scbadd in SCB
dmaad equ 03ch ;offset of DMA address in SCB
bdosadd equ 62h ;offset of bdosadd in SCB
;
loadflag equ 02H ;flag for LOADER in memory
;
;     dsect for RSX
entry equ 06h ;RSX contain jump to start
;
nextadd equ 0bh ;address of next RXS in chain
prevadd equ 0ch ;address of previous RSX in chain
warmflg equ 0eh ;remove on wboot flag
endchain equ 18h ;end of RSX chain flag
;
;
readf equ 20 ;sequential read
dmaf equ 26 ;set DMA address
scbf equ 49 ;get/set SCB info
loadf equ 59 ;load function
;
;
maxread equ 64 ;maximum of 64 pages in MULTIO
;
;
wboot equ 0000h ;BIOS warm start
bdos equ 0005h ;bdos entry point
print equ 9 ;bdos print function
vers equ 12 ;get version number
module equ 200h ;module address
;
; DSECT for COM file header
;
comsize equ tpa+1h
scbcode equ tpa+3h
rsxoff equ tpa+10h
rsxlen equ tpa+12h
;
;
cr equ 0dh
lf equ 0ah
;
;
cseg
;
;
;     ********* LOADER  RSX HEADER ***********
;
rsxstart:
jmp ccp ;the ccp will move this loader to
db 0,0,0 ;high memory, these first 6 bytes
;will receive the serial number from
;the 6 bytes prior to the BDOS entry
;point
tojump:
jmp begin
next db 0c3h ;jump to next module
nextjmp dw 06
prevjmp dw 07
db 0 ;warm start flag
db 0 ;bank flag
db 'LOADER  ' ;RSX name
db 0ffh ;end of RSX chain flag
db 0 ;reserved
db 0 ;patch version number

;     ********* LOADER  RSX ENTRY POINT ***********

begin:
mov a,c
cpi loadf
jnz next
beginlod:
pop b
push b ;BC = return address
lxi h,0 ;switch stacks
dad sp
lxi sp,stack ;our stack
shld ustack ;save user stack address
push b ;save return address
xchg ;save address of user's FCB
shld usrfcb
mov a,h ;is .fcb = 0000h
ora l
push psw
cz rsx$chain ;if so , remove RSXs with remove flag on
pop psw
cnz loadfile
pop d ;return address
lxi h,tpa
mov a,m
cpi ret
jz rsxfile
mov a,d ;check return address
dcr a ; if CCP is calling
ora e ; it will be 100H
jnz retuser1 ;jump if not CCP
retuser:
lda prevjmp+1 ;get high byte
ora a ;is it the zero page (i.e. no RSXs present)
jnz retuser1 ;jump if not
lhld nextjmp ;restore five....don't stay arround
shld osbase
  shld newjmp
call setmaxb
retuser1:
lhld ustack ;restore the stack
sphl
xra a
mov l,a
mov h,a ;A,HL=0 (successful return)
ret ;CCP pushed 100H on stack
;
;
; BDOS FUNC 59 error return
;
reterror:
lxi d,0feh
reterror1:
;DE = BDOS error return
lhld ustack
sphl
pop h ;get return address
push h
dcr h ;is it 100H?
mov a,h
ora l
xchg ;now HL = BDOS error return
mov a,l
mov b,h
rnz ;return if not the CCP
;
;
loaderr:
mvi c,print
lxi d,nogo ;cannot load program
call bdos ;to print the message
jmp wboot ;warm boot

;
;
;;
;************************************************************************
;
; MOVE RSXS TO HIGH MEMORY
;
;************************************************************************
;
;
;      RSX files are present
;

rsxf1: inx h
mov c,m
inx h
mov b,m ;BC contains RSX length
lda banked
ora a ;is this the non-banked system?
jz rsxf2 ;jump if so
inx h ;HL = banked/non-banked flag
inr m ;is this RSX only for non-banked?
jz rsxf3 ;skip if so
rsxf2: push d ;save offset
call calcdest ;calculate destination address and bias
pop h ;rsx offset in file
call reloc ;move and relocate file
call fixchain ;fix up rsx address chain
rsxf3: pop h ;RSX length field in header


rsxfile:
;HL = .RSX (n-1) descriptor
lxi d,10h ;length of RSX descriptor in header
dad d ;HL = .RSX (n) descriptor
push h ;RSX offset field in COM header
mov e,m
inx h
mov d,m ;DE = RSX offset
mov a,e
ora d
jnz rsxf1 ;jump if RSX offset is non-zero
;
;
;
comfile:
;RSXs are in place, now call SCB setting code
call scbcode ;set SCB flags for this com file
;is there a real COM file?
lda module ;is this an RSX only
cpi ret
jnz comfile2 ;jump if real COM file
lhld scbaddr
mvi l,ccpflag1
mov a,m
ori rsx$only$set ;set if RSX only
  mov m,a
comfile2:
lhld comsize ;move COM module to 100H
mov b,h
mov c,l ;BC contains length of COM module
lxi h,tpa+100h ;address of source for COM move to 100H
lxi d,tpa ;destination address
call move
jmp retuser1 ;restore stack and return
;;
;************************************************************************
;
; ADD AN RSX TO THE CHAIN
;
;************************************************************************
;
;
fixchain:
lhld osbase ;next RSX link
mvi l,0
lxi b,6
call move ;move serial number down
mvi e,endchain
stax d ;set loader flag=0
mvi e,prevadd+1
stax d ;set previous field to 0007H
dcx d
mvi a,7
stax d ;low byte = 7H
mov l,e ;HL address previous field in next RSX
mvi e,nextadd ;change previous field in link
mov m,e
inx h
mov m,d ;current <-- next
;
fixchain1:
;entry: H=next RSX page,
; DE=.(high byte of next RSX field) in current RSX
xchg ;HL-->current  DE-->next
mov m,d ;put page of next RSX in high(next field)
dcx h
mvi m,6
;
fixchain2:
;entry: H=page of lowest active RSX in the TPA
;this routine resets the BDOS address @ 6H and in the SCB
mvi l,6
shld osbase ;change base page BDOS vector
shld newjmp ;change SCB value for BDOS vector
;
;
setmaxb:
lxi d,scbadd2
scbfun:
mvi c,scbf
jmp bdos
;
;
;;
;************************************************************************
;
; REMOVE TEMPORARY RSXS
;
;************************************************************************
;
;
;
rsx$chain:
;
; Chase up RSX chain, removing RSXs with the
; remove flag on (0FFH)
;
lhld osbase ;base of RSX chain
mov b,h

rsx$chain1:
;B  = current RSX
mov h,b
mvi l,endchain
inr m
dcr m ;is this the loader?
rnz ;return if so (m=0ffh)
mvi l,nextadd ;address of next node
mov b,m ;DE -> next link
;
;
check$remove:
;
mvi l,warmflg ;check remove flag
  mov a,m ;warmflag in A
ora a ;FF if remove on warm start
jz rsx$chain1 ;check next RSX if not
;
remove:
;remove this RSX from chain
;
;first change next field of prior link to point to next RSX
;HL = current  B = next
;
mvi l,prevadd
mov e,m ;address of previous RSX link
inx h
mov d,m
mov a,b ;A = next (high byte)
stax d ;store in previous link
dcx d ;previous RSX chains to next RSX
mvi a,6 ;initialize low byte to 6
stax d ;
inx d ;DE = .next (high byte)
;
;now change previous field of next link to address previous RSX
mov h,b ;next in HL...previous in DE
mvi l,prevadd
mov m,e
inx h
mov m,d ;next chained back to previous RSX
mov a,d ;check to see if this is the bottom
ora a ;RSX...
push b
cz fixchain2 ;reset BDOS BASE to page in H
pop b
jmp rsx$chain1 ;check next RSX in the chain
;
;
;;
;************************************************************************
;
; PROGRAM LOADER
;
;************************************************************************
;
;
;
loadfile:
; entry: HL = .FCB
push h
lxi d,scbdma
call scbfun
xchg
pop h ;.fcb
push h ;save .fcb
lxi b,currec
dad b
mvi m,0 ;set current record to 0
inx h
mov c,m ;load address
inx h
mov h,m
mov l,c
dcr h
inr h
jz reterror ;Load address < 100h
push h ;now save load address
push d ;save the user's DMA
push h
call multio1 ;returns A=multio
pop h
push psw ;save A = user's multisector I/O
mvi e,128 ;read 16k

;stack: |return address|
; |.FCB          |
; |Load address  |
; |users DMA     |
; |users Multio  |
;

loadf0:
;HL= next load address (DMA)
; E= number of records to read
lda osbase+1 ;calculate maximum number of pages
dcr a
sub h
jc endload ;we have used all we can
inr a
cpi maxread ;can we read 16k?
jnc loadf2
rlc ;change to sectors
mov e,a ;save for multi i/o call
mov a,l ;A = low(load address)
ora a
jz loadf2 ;load on a page boundary
mvi b,2 ;(to subtract from # of sectors)
dcr a ;is it greater than 81h?
jm subtract ;080h < l(adr) <= 0FFh (subtract 2)
dcr b ;000h < l(adr) <= 080h (subtract 1)
subtract:
mov a,e ;reduce the number of sectors to
sub b ;compensate for non-page aligned
;load address
jz endload ;can't read zero sectors
mov e,a
;
loadf2:
;read the file
push d ;save number of records to read
push h ;save load address
call multio ;set multi-sector i/o
pop h
push h
call readb ;read sector
pop h
pop d ;restore number of records
push psw ;zero flag set if no error
mov a,e ;number of records in A
inr a
rar ;convert to pages
add h
mov h,a ;add to load address
shld loadtop ;save next free page address
pop psw
jz loadf0 ;loop if more to go

loadf4:
;FINISHED load  A=1 if successful (eof)
; A>1 if a I/O error occured
;
pop b ;B=multisector I/O count
dcr a ;not eof error?
mov e,b ;user's multisector count
call multio
mvi c,dmaf ;restore the user's DMA address
pop d
push psw ;zero flag => successful load
call bdos ; user's DMA now restored
pop psw
lhld bdosret ;BDOS error return
xchg
jnz reterror1
pop d ;load address
pop h ;.fcb
lxi b,9 ;is it a PRL?
dad b ;.fcb(type)
mov a,m
ani 7fh ;get rid of attribute bit
cpi 'P' ;is it a P?
rnz ;return if not
inx h
mov a,m
ani 7fh
cpi 'R' ;is it a R
rnz ;return if not
inx h
mov a,m
ani 7fh
sui 'L' ;is it a L?
rnz ;return if not
;load PRL file
mov a,e
ora a ;is load address on a page boundary
jnz reterror ;error, if not
mov h,d
mov l,e ;HL,DE = load address
inx h
mov c,m
inx h
mov b,m
mov l,e ;HL,DE = load address BC = length
; jmp reloc ;relocate PRL file at load address
;
;;
;************************************************************************
;
; PAGE RELOCATOR
;
;************************************************************************
;
;
reloc:
; HL,DE = load address (of PRL header)
; BC    = length of program (offset of bit map)
inr h ;offset by 100h to skip header
push d ;save destination address
push b ;save length in bc
call move ;move rsx to correct memory location
pop b
pop d
push d ;save DE for fixchain...base of RSX
mov e,d ;E will contain the BIAS from 100h
dcr e ;base address is now 100h
;after move HL addresses bit map
;
;storage moved, ready for relocation
; HL addresses beginning of the bit map for relocation
; E contains relocation bias
; D contain relocation address
; BC contains length of code
rel0: push h ;save bit map base in stack
mov h,e ;relocation bias is in e
mvi e,0
;
rel1: mov a,b ;bc=0?
ora c
jz endrel
;
; not end of the relocation, may be into next byte of bit map
  dcx b ;count length down
mov a,e
ani 111b ;0 causes fetch of next byte
jnz rel2
; fetch bit map from stacked address
xthl
mov a,m ;next 8 bits of map
inx h
xthl ;base address goes back to stack
mov l,a ;l holds the map as we process 8 locations
rel2: mov a,l
ral ;cy set to 1 if relocation necessary
mov l,a ;back to l for next time around
jnc rel3 ;skip relocation if cy=0
;
; current address requires relocation
ldax d
add h ;apply bias in h
stax d
rel3: inx d ;to next address
jmp rel1 ;for another byte to relocate
;
endrel: ;end of relocation
pop d ;clear stacked address
pop d ;restore DE to base of PRL
ret


;
;;
;************************************************************************
;
; PROGRAM LOAD TERMINATION
;
;************************************************************************
;
;;
;;
endload:
call multio1 ;try to read after memory is filled
lxi h,80h ;set load address = default buffer
call readb
jnz loadf4 ;eof => successful
lxi h,0feh ;set BDOSRET to indicate an error
shld bdosret
jmp loadf4 ;unsuccessful (file to big)
;
;;
;
;;
;************************************************************************
;
; SUBROUTINES
;
;************************************************************************
;
;
;
; Calculate RSX base in the top of the TPA
;
calcdest:
;
; calcdest returns destination in DE
; BC contains length of RSX
;
lda osbase+1 ;a has high order address of memory top
dcr a ;page directly below bdos
dcx b ;subtract 1 to reflect last byte of code
sub b ;a has high order address of reloc area
inx b ;add 1 back get bit map offset
cpi ccptop ;are we below the CCP
jc loaderr
lhld loadtop
cmp h ;are we below top of this module
jc loaderr
mov d,a
mvi e,0 ;d,e addresses base of reloc area
ret
;
;;
;;-----------------------------------------------------------------------
;;
;; move memory routine

move:
; move source to destination
; where source is in HL and destination is in DE
; and length is in BC
;
mov a,b ;bc=0?
ora c
rz
dcx b ;count module size down to zero
mov a,m ;get next absolute location
stax d ;place it into the reloc area
inx d
inx h
jmp move
;;
;;-----------------------------------------------------------------------
;;
;; Multi-sector I/O
;; (BDOS function #44)
;
multio1:
mvi e,1 ;set to read 1 sector
;
multio:
;entry: E = new multisector count
;exit: A = old multisector count
lhld scbaddr
mvi l,multicnt
mov a,m
mov m,e
ret
;;
;;-----------------------------------------------------------------------
;;
;; read file
;; (BDOS function #20)
;;
;; entry: hl = buffer address (readb only)
;; exit z  = set if read ok
;;
readb: xchg
setbuf: mvi c,dmaf
push h ;save number of records
call bdos
mvi c,readf
lhld usrfcb
xchg
call bdos
shld bdosret ;save bdos return
pop d ;restore number of records
ora a
rz ;no error on read
mov e,h ;change E to number records read
ret
;
;
;************************************************************************
;
; DATA AREA
;
;************************************************************************
;

nogo db cr,lf,'Cannot load Program$'

patcharea:
ds 36 ;36 byte patch area

scbaddr dw 0
banked db 0

scbdma db dmaad
db 00h ;getting the value
scbadd2 db bdosadd ;current top of TPA
db 0feh ;set the value
;

if not spacesaver

newjmp ds 2 ;new BDOS vector
loadtop ds 2 ;page above loaded program
usrfcb ds 2 ;contains user FCB add
ustack: ds 2 ; user stack on entry
bdosret ds 2 ;bdos error return
;
rsxend :
stack equ rsxend+stacksize

else

rsxend:
newjmp equ rsxend
loadtop equ rsxend+2
usrfcb equ rsxend+4
ustack equ rsxend+6
bdosret equ rsxend+8
stack equ rsxend+10+stacksize

endif
end

[Blacklord]

ccpdate.asm

Code Select Expand

org 368h

maclib makedate
db ' '
@BDATE ;[JCE] Copyright & build date now in MAKEDATE.LIB
db ' '
@SCOPY

[Blacklord]

makedate.lib

Code Select Expand

;
; [JCE] Have the date and copyright messages in only one source file
;
@BDATE MACRO
db '101198'
ENDM

@LCOPY MACRO
db 'Copyright 1998, '
db 'Caldera, Inc.   '
ENDM

@SCOPY MACRO
db '(c) 98 Caldera'
ENDM

[Blacklord]

cx80.asm

Code Select Expand

title 'CX40 & CX80   40 and 80 column drivers    18 Feb 86'

maclib cxequ

maclib z80


lines equ 24

; public ?fundir ; function direct

public ?int40,?int80
public ?stat,?save,?recov,@st40

extrn ADM31,setadm
; extrn setvt

page
;
;**
;** This is the entry point to get to the function module
;**
;
;
; This code will perform the functions that the emulation
; code will need to do to complete function.
;
;
;
;
; enable  cursor,  then set foreground and background colors  
;
DSEG
?int80:
call setadm
lhld key$tbl ; logical color assignments at end of
lxi d,11*4*8 ; ..key$table, (key$tbl size=11*4*8)
dad d
shld color$tbl$ptr ; setup color table ptr

mvi a,80h
sta current$atr

;
; program the 8563 for full flashing cursor
;
mvi a,10 ; point to cursor start line#
call R$wait ;  and mode register
mvi a,40h ; start at line zero, cursor 1/16
outp a
mvi a,11 ; point to cursor end line#
call R$wait
mvi a,7
outp a
ret

page
;
;
;
DSEG
?int40:
lxi h,screen$40
shld char$adr$40

mvi a,24
sta paint$size ; set 40 column repaint to 24 lines

lxi b,VIC+18h ; point to address register
mvi a,vic$screen*4/256+6 ; upper and lower case set (+6)
outp a ; move screen
ret


;**
;** The following code is used to maintain the status line on
;** both the 80 and 40 column displays
;**
;
; save characters on the status line (80 column only) to buffer
; reverse video the data area cleared (40 and 80 column screens)
;
; C=start column # B=number of characters to save
;
DSEG
?save:
mov a,c
cpi 40
jrnc do$save$80

push b
;;;***
mov a,b
lxi h,stat$line$40
mvi b,0
dad b

clear$loop$40:
mvi m,' '+80h ; set reverse video
inx h
dcr a
jrnz clear$loop$40
call paint$40$status
;;;***
pop b

do$save$80:
mov a,b
lxi h,lines*80 ; point to status line
lxi d,buffer$80$col ; point to save buffer
mvi b,0 ; zero MSB
dad b ; point to char position to save

save$loop:
push psw ; save count
push d ; save buffer address
call R$read$memory ; read char(B) and attribute(A)
pop d ; recover buffer pointer
stax d ; save character
inx d ; advance buffer
mov a,b ; get atrb to A
stax d ; save atrb
inx d ; advance buffer
push d

mvi a,01000000b ; reverse video only
call get$atr$color ; returned in A
mvi d,' ' ; get character
call R$write$memory

pop d
pop psw ; recover count
inx h
dcr a ; adjust count
jrnz save$loop ; loop if not done
ret

page
;
; recover characters to the status line (80 column only)
; for the 40 column screen just clear status line (with spaces)
;
; C=start column # B=number of characters to restore
;
DSEG
?recov:
mov a,c
cpi 40
jrnc recove$80 ; skip 40 column if C>40

push b
;;;***
lxi h,stat$line$40
mov a,b
mvi b,0
dad b
mov b,a

recov$40$loop:
mvi m,' '
inx h
djnz recov$40$loop
call paint$40$status
;;;***
pop b

recove$80:
mov a,b
lxi h,lines*80 ; point to status line
lxi d,buffer$80$col ; point to save buffer
mvi b,0 ; zero MSB
dad b ; point to char position to save

recov$80$loop:
push psw ; save count
ldax d ; get attribute
inx d ; advance pointer
mov b,a ; save attribute in B
ldax d ; get character in A
inx d ; advance pointer
push d ; save buffer address
mov d,a ; move character to D
mov a,b ; move attribute to A
call R$write$memory ; write char(D) and attribute(A)
pop d ; recover buffer pointer
pop psw ; recover count
inx h
dcr a ; adjust count
jrnz recov$80$loop ; loop if not done
ret

page
;
; Places data on the system status line
;
; for the 80 column screen a number of character attributes
; are available: flash, underline, reverse video
;
; for the 40 column screen only reverse video is available
;
; INPUT:
; A=attribute  (7654 3210)
; 6-reverse video
; 5-underline
; 4-blink
; B=character to write (ASCII)
; C=column number to write
; (>40 does nothing to 40 column screen)
;
DSEG
?stat:
push psw
push b ; save for 80 column display
mov e,a ; save attribute in E
mov a,c
cpi 40
jrnc not$40$col$wr

;;;***
;
; display on 40 column display 1st
;
RCALL FR$ASCII$to$pet ; char to convert is in B
; returned in A
mov b,a
mov a,e ; get attribute byte
ani 01000000b ; check for reverse video
mov a,b ; get pet ascii character
jrz char$not$rev
ori 80h ; set MSB for reverse video
char$not$rev:
mvi b,0
lxi h,stat$line$40
dad b ; point to status position
mov m,a
call paint$40$status
;;;***

;
; display on 80 column display now
;
not$40$col$wr:
pop d ; D=character  E=position
pop psw ; get new attribute
call get$atr$color

mov b,d ; save character to write in B
lxi h,lines*80
mvi d,0
dad d ; point to character location
mov d,b ; place character to write in D
jmp R$write$memory


;
; using attribute in A add color to it and return in A
;
; destroys BC
;
DSEG
get$atr$color:
push h
push psw
lda bg$color$80
mov c,a
mvi b,0
lxi h,status$color$tbl
dad b ; point to status color
pop psw
ani 01110000b ; limit good attr
mov b,a ; save in E
mov a,m ; get status color
ani 0fh ; only want 80 column status color
ora b ; merge with new attr
ori 80h ; select alternate character set
pop h
ret

;
;
;
DSEG
paint$40$status:
lxi h,stat$line$40
lxi d,vic$screen+24*40
lxi b,40
ldir

lda bg$color$40
mov c,a
mvi b,0
lxi h,status$color$tbl
dad b
mov a,m
rrc
rrc ; move status color to LSB
rrc ; no need to mask it
rrc ; color RAM only 4 bits wide

lxi h,vic$color+24*40
lxi d,vic$color+24*40+1
lxi b,40
jmp paint$common

;
;
;
CSEG
paint$common:
sta io$0
mov m,a
ldir
sta bank$0
ret

page
;
;
;
@st40:
stat$line$40:
; 12345678901234567890   character locations
db '                    '
db '                    '

;
; MSB is 40 column status color, LSB is 80 column status color
;
status$color$tbl:
db 05eh ; status color #1
db 0f6h ; status color #2
db 0a6h ; status color #3
db 0b7h ; status color #4
db 0d7h ; status color #5
  db 0d4h ; status color #6
db 0e7h ; status color #7
db 083h ; status color #8
db 097h ; status color #9
db 0a8h ; status color #10
db 09eh ; status color #11
db 0ffh ; status color #12
db 0bdh ; status color #13
db 058h ; status color #14
db 06fh ; status color #15
db 0ceh ; status color #16

[Blacklord]

cxdisk.asm

Code Select Expand

;
; *****************************************
; * *
; * Commodore Disk Controller *
; * Module for CP/M 3.0 BIOS *
; * *
; *****************************************
;
;
;
title 'CXDISK   Commodore C-128 Disk Controller    15 Apr 86'




; CP/M 3 Disk definition macros

maclib cpm3

maclib z80

; C-128 system equates

maclib cxequ

page

; Disk drive dispatching tables for linked BIOS

public cmdsk0,cmdsk1,cmdsk2,cmdsk3,cmdsk4

; System Control Block variables
extrn @ermde ; BDOS error mode

; Utility routines in standard BIOS
extrn ?wboot ; warm boot vector
extrn ?pmsg ; print message @ up to 00
; saves &
extrn ?pdec ; print binary number in from 0 to 65535
extrn ?pderr ; print BIOS disk error header
extrn ?conin,?cono ; con in and out
extrn ?const ; get console status
extrn ?sctrn ; sector translation routine
extrn @covec

; status line calls

extrn ?save,?recov,?stat

; System function call
extrn ?kyscn
extrn ?fun65
extrn ?bank
extrn ?di$int

public ?dskst
public ?dkmov
extrn ?stat,@st40

page
;
; Initialization entry point.
; called for first time initialization.
;
DSEG
init$154X:
xra a
sta fast
lxi h,MFM$table
shld MFM$tbl$ptr
ret


page
;
; This entry is called when a logical drive is about to
;  be logged into for the purpose of density and type determination.
;  It may adjust the parameters contained in the disk
;  parameter header pointed to by
;
DSEG
;
; if disk type GCR or drive type 1541 or 1581(reports as GCR)
;   if sector size is 256 bytes
;      if 1st sector has 'CBM' (1st 3 bytes)
;         if last byte = -1 (0FFh)
;            set C128 double sided
;         else
;            set C128 single sided
;         endif
;      else
;         set C64 type
;      endif
;   else  (512 byte sector size)
;      set C1581 type
;   endif
; else (must be MFM)
;   TEST MFM
; endif
;
login$154X:
call get$drv$info ; set the drive to check (DPH$pointer set)

mvi a,vic$test
; ***** add code to reset 1581 drive *****
call ?fun65
mov b,a
ani 0ch
cpi 0ch ; fast drive ?
jrz commodore$type ; no, must be 1541 type
mov a,b ; yes, is a 1571 or 1581
rlc ; MSB=1 if NON-Commodore disk
jrc MFM$type ; 1571 NON-Commodore disk is MFM type

page
;
; Commodore Type disk is a disk that is in GCR format (1571)
; Or Standard Commodore format for 1581 (Has a Commodore dir track)
;
commodore$type:
lhld DPH$pointer
dcx h
  if use$1581
mov a,b ; get the status byte
ani 30h ; save only the sector size info
cpi 20h ; 512 byte sectors?
jrnz set$15x1$type ; no, set up as 1571 or 1541
; yes, set 1581 type drive
;
;
;
set$1581$type:
mvi m,dsk$1581 ; yes, set up as 1581 double sided
lxi d,dpb$1581
jr set$dpb$only

  endif

set$15x1$type:
mvi m,dsk$c64
lxi d,dpb$c64$cpm ; set DPB to C64
call set$dpb$only

xra a
sta vic$sect ; set track 1 sector 0 (1st sector
inr a ; on the disk)
sta vic$trk

lxi h,@buffer
shld local$DMA ; move DMA pointer to disk buffer
call login$rd
ana a ; read error ?
rnz ; yes, just return

RCALL FR$check$CBM
rnz ; return if not 'CBM'
; A=0FFh if double sided
inr a
lhld DPH$pointer
dcx h ; does not affect flags
mvi m,dsk$c128

lxi d,dpb$c128$SS
jrnz set$dpb$only

lxi d,dpb$c128$DS

page
;
;
;
set$dpb$only:
lxi b,0 ; set sector translation to zero
set$format:
lhld DPH$pointer
mov m,c
inx h
mov m,b ; install sector translation
lxi b,25-1 ; ofset to DPB
dad b ; HL points to DPB now
lxi b,17 ; dpb size
xchg ; move to DPB location
ldir
ret

page
;
;    TEST MFM()
; save number bytes/sector
;   if double sided
;      mark two sided
;   endif
;   find start and end sector numbers
;   scan table of disk for match (if more then 1 match ask user)
;
MFM$type:
mvi c,01100000b
ana c ; A = status(trk1) shifted left 1
push psw ; save in case bad query
push b ; save BC

call get$max$num$B ; used to set the pointer only
mov b,m ; get size, and disk lock flag
inx h
mov a,m
inx h
mov h,m ; get last MFM$mactch$ptr
mov l,a
mov a,b ; get lock flag in A
ani 80h ; lock bit set ?
sta lock$flag ;   (save old lock status)
shld last$match ; save last match pointer
jrz not$$locked$entry ; yes, then set same disk type
; set$locked$entry
xra a
sta lock$flag
mvi c,0B0h
lda vic$data ; get sector size info
ana c
mov b,a ; save disk sector size info
xchg ; save HL
lhld DPH$pointer
dcx h
mov a,c
ana m ; get old disk sector size
cmp b ; are they the same?
jrnz not$locked$entry ; no, then unlock disk anyway

xchg ; get last match pointer (in DE)
pop psw ; yes, remove two data elements
pop psw ; ..save on stack
jr set$this$entry

not$locked$entry:
lxi h,MFM$match$tbl ; clear Match table
shld MFM$cur$ptr
lxi d,MFM$match$tbl+1
mvi m,0
lxi b,(MFM$tbl$entries*2)-1+1+1 ; table, offset and count
ldir
mvi a,4
sta vic$trk ; do query on track 4
mvi a,vic$query
call ?fun65
pop b ; recover BC
ani 0eh ; query error ?
jrnz query$error ; yes, use only bits 5 and 6
lda @buffer ; get trk 4 status
mov b,a ; save in B
ani 0eh ; trk 4 status error ?
jrnz query$error ; yes, use only bits 5 and 6
mov a,b ; recover B (trk 4 status)
add a ; shift left
ana c ; mask sector size bits
mov b,a
pop psw ; get trk 1 sector size bits
cmp b ; same as trk 4 sector size?
mvi c,01111111b
jrz trk$1$trk$4 ; yes, (then test for mult format)
mvi a,80h ; set MSB to mean mult format
add b ; ..(track 0 different sector size
; ..then track 4)
mov b,a ; save in B
mvi c,11111111b
trk$1$trk$4:
lda @buffer+1 ; get number of sectors/track
sui 4 ; remove 4 to extend the range
add a ; shift left
add b ; combine with rest of mask
mov b,a ; save in B for now

lda @buffer+3 ; minimum sector number
add b ; add in start sector #
push psw ; save on stack for a moment

query$error:
pop psw ; get value to match
ana c ; test only those bits in the mask

lhld MFM$tbl$ptr
mvi b,MFM$tbl$entries
check$next:
push b ; save BC for a moment
mov b,a ; move compare value to
mov a,m ; get type info
ana c ; test only the good info
cmp b ; match the current type byte
mov a,b ;   (recover A)
pop b ;   (recover BC)
jrnz not$found ; no, do not queue data
; yes queue table entry address

xchg ; save adr in DE
lhld MFM$cur$ptr
mov m,e
inx h
mov m,d
inx h
shld MFM$cur$ptr
lxi h,MFM$count
inr m ; add one to counter
xchg

page
;
;
not$found:
lxi d,32 ; table entry size
dad d
djnz check$next

lda MFM$count ; number of matches in table
ana a ; test for zero
jz tell$user$no$entry ; none, tell the user

dcr a ; only one ?
jrnz user$select ; no, go check with user (which one)
lhld MFM$match$tbl ; yes, use the only one found

;
; install data from pointer in HL
;
set$this$entry:
push h ; save table pointer
inx h
mov a,m ; get type info.
xchg ; save table address in DE
lhld DPH$pointer
dcx h
mov m,a ; save type code
xchg ; get table adr to HL
inx h ; HL points to sector translation table
mov c,m ; ..zero if none
inx h
mov b,m
inx h ; HL points to DPB
xchg ; DE points to DPB (HL trash)
call set$format
mov b,m ; get the number of sect/trk from MFM table
lda lock$flag ; get the current lock flag value
ora b ; combine with sect/trk
xchg ; HL=to adr,  DE=from adr
mov m,a ; install sect/trk and lock flag
pop d ; recover table pointer
inx h
mov m,e
inx h
mov m,d ; save MFM table pointer at end of DPH
ret

page
;
; let the user select the Disk type (s)he wants
;
user$select:
inr a ; number of entries to try to match
mov b,a ; set in B as loop count
lhld last$match ; get value to match with
mov d,h
mov e,l ; last match pointer is in DE

lxi h,MFM$match$tbl
shld MFM$cur$ptr
mvi c,0 ; start offset at zero

try$next$format:
mov a,e
cmp m
inx h
jrnz not$last$match
mov a,d
cmp m
jrnz not$last$match
;
; match, set pointer
;
mov a,c ; get offset in A
push psw
call save$dsk$window
pop psw
jr set$offset

not$last$match:
inx h ; each pointer uses two bytes
inr c ; advance the index
djnz try$next$format ; test for more, loop if so

call save$dsk$window

lhld MFM$cur$ptr
user$loop:
mov e,m ; HL=(MFM$cur$ptr)
inx h
mov d,m
lxi h,22 ; offset to NAME field
dad d ; point to Disk name
call dsk$window$old

dsk$user$sel$wait:
call ?kyscn
inr b ; test for key pressed
jrz dsk$user$sel$wait
dcr b ; adjust back
mov a,b ; move matrix position to A
cpi SF$exit
jrnz CK$dsk$user$rt

mov a,c
ani 4 ; control key down ?
jrz no$cntr$key ; no, don't lock this selection
mvi a,80h ; yes, lock disk type to this drive
no$cntr$key:
sta lock$flag ;
call dsk$window$remove
lhld MFM$cur$ptr
mov e,m
inx h
mov d,m
xchg
jr set$this$entry

page
;
;
;
CK$dsk$user$rt:
cpi SF$right ;
jrnz CK$dsk$user$lf

; move window down
lda MFM$count ; get number of items in list
mov b,a ; save in B
lda MFM$offset ; get current position
inr a ; advance position
cmp b ; at last position ? (n-1+1 =count)
jrnz set$offset ; no, then use A as new position
xra a ; yes, move back to start
jr set$offset

CK$dsk$user$lf:
cpi SF$left ;
jrnz dsk$user$sel$wait

; move window up
lda MFM$offset
dcr a ; back up offset (under flow?)
jp set$offset ; result positive, jump
lda MFM$count ; get last item number
dcr a ; pointer is 0 to n-1 (not 1 to n)
set$offset:
sta MFM$offset ; set new list offset
inr a ; add one to adjust for DCR below
lxi h,MFM$match$tbl ; set to the beginning

adjust$dsk$loop:
shld MFM$cur$ptr ; set pointer here !
dcr a ; at offset yet?
jrz user$loop ; yes, go display name
inx h
inx h
jr adjust$dsk$loop

page
;
;
;
tell$user$no$entry:
lda vic$data ; get disk test status
ani 0b0h ; save only sector size and MFM flag
lhld DPH$pointer
dcx h
mov m,a ; set disk size and Type0 (MFM)

lxi h,dsk$window*256+buff$pos
lxi d,no$dsk$msg
disp$msg$DE$HL:
call dsk$window$new
dsk$no$entry$wait:
call ?kyscn
inr b
jrz dsk$no$entry$wait
dcr b
mov a,b
cpi SF$exit
jrnz dsk$no$entry$wait
; jr dsk$window$remove

page
;
;
;
dsk$window$remove:
lhld window$info
mov b,h
mov c,l
jmp ?recov
;
;
;
save$dsk$window:
lxi h,dsk$window*256+buff$pos ; H=size l=pos
shld window$info
mov b,h
mov c,l
jmp ?save
;
;
;
dsk$window$new:
shld window$info
xchg
mov b,d
mov c,e
push h
call ?save
pop h

dsk$window$old:
lda window$info ; get start index
inr a
mov c,a ; place in C

dsk$out$next:
push h
lhld window$info
mov a,h
add l ; compute max index (start+size)
dcr a ; ..less 1
pop h
cmp c
rz
mov b,m
call dsk$B$out
inx h
jr dsk$out$next

;
;
;
dsk$B$out:
mvi a,01000000b ; set reverse video attr
push b
push h
call ?stat ; display space
pop h
pop b ; recover count
inr c
ret

page
;
; disk READ and WRITE entry points.
; These entries are called with the following arguments:
; relative drive number in @rdrv (8 bits)
; absolute drive number in @adrv (8 bits)
; disk transfer address in @dma (16 bits)
; disk transfer bank in @dbnk (8 bits)
; disk track address in @trk (16 bits)
; disk sector address in @sect (16 bits)
; pointer to XDPH in
;
;   return with an error code in
; A=0 no errors
; A=1 non-recoverable error
; A=2 disk write protected
; A=FF media change detected
;
DSEG
read$154X:
call get$drv$info
jm mfm$rd
call set$up$GCR ; compute effective track and sector
login$rd:
lda vic$drv
mov b,a
lda fast ; get fast flags
ana b ; isolate fast bit for this drive
jrnz rd$fast ; go handle fast drive
rd$slow:
mvi a,vicrd ; read a sector of data (A=1)
call dsk$fun ; a=0 if no errors
jnz test$error ; check for disk error or media change
;
;
;
buf$move:
xra a ; set direction to read
call ?dkmov ; go move buffer to DMA
lda sect$cnt
ana a
rz ; a=0 means not read errors
call set$up$next
jr rd$slow

page
;
; A=drive type info
;
mfm$rd:
call set$up$MFM

rd$fast:
mvi a,vic$rd$f
call dsk$fun ; go read the disk

ani 0eh ; mask off error bits
jrnz test$error

call get$sector$size
inr d
inr e ; adjust count for pre-decrement

call ?di$int
lxi b,0DD00h ; D2PRA
inp a ; get current clock polarity
xri 10h ; toggle clk$bit
outp a ; to have status sent (extra clock
; supplied by rd$1571$data for multi
; sector transfers)
lda vic$count
rd$multi$sect:
push psw
push d ; save the sector size
call rd$1571$data ; read disk data to DMA address
pop d

lda vic$data
ani 0eh
jrnz test$error$pop ; A=0 if no errors
pop psw
dcr a
jrnz rd$multi$sect
ei
lda sect$cnt
ana a ; any sectors left to read
jrz done$rd$1571

call set$up$next
jr rd$fast

done$rd$1571:
lxi b,0DD00h ;   D2PRA
inp a
ani not(10h) ; set clk$bit hi
outp a
xra a ; A=0 for no errors
ret


page
;
;
;
write$154X:
call get$drv$info
jm mfm$wr
call set$up$GCR
lda vic$drv
mov b,a
lda fast ; get fast flags
ana b ; isolate fast bit for this drive
jrnz wr$fast$drive ; go handle fast drive
wr$slow:
mvi a,-1 ; set direction to write
call ?dkmov ; go move DMA to buffer

mvi a,vicwr ; write a sector of data
call dsk$fun ; a=0 if no errors
ani 0eh
jrnz test$error
lda sect$cnt
ana a
rz
call set$up$next
jr wr$slow

test$error$pop:
pop psw
test$error:
ei
lda vic$data
ani 0fh ; check for disk error or media change
cpi 0bh ; disk change ?
jrz change$error
cpi 08h ; test for write protect error
jrz write$prot$error

mvi a,1 ;  get general error flag
ret

;
;
write$prot$error:
mvi a,2
ret

;
;
change$error:
mvi a,-1
ret

page
;
;
;
mfm$wr:
call set$up$MFM
wr$fast$drive:
mvi a,vic$wr$f
call dsk$fun ; go send the write command

call get$sector$size ; setup DMA adr and transfer count
lda vic$count
wr$multi$sect:
push psw
push d ; save sector size
call wr$1571$data ; write data to disk from DMA address
pop d
ani 0eh
jrnz test$error$pop
pop psw
dcr a
jrnz wr$multi$sect

ei
lda sect$cnt
ana a
rz ; return if no errors (A=0)
call set$up$next
jr wr$fast$drive

page
;
;
;
get$drv$info:
lhld @dma
shld local$dma
xchg
shld DPH$pointer

lda @adrv ; get drive number (0 to F)
ana a
cz drive$A$E
cpi 'E'-'A' ; test if drive E
cz drive$A$E
dcx h ; point at drive mask
dcx h
mov a,m ; get drive mask
mov b,a ; save in B
sta vic$drv ; save vic drive # (values 1,2,4,8)

inx h ; point at disk type
xra a
sta sect$cnt ; clear the count
inr a
sta vic$count
mov a,m ; get disk type
ana a
ret

;
; drive A and E share the same physical disk drive (unit 8)
;
drive$A$E:
mov b,a
lda curdrv ; get the current drive def
cmp b ; curdrv = requested drive ?
rz ; yes, return
; no, tell the user to swap disk
push h
push d
push b
send$messg:
mov a,b ; get requested drive # to A
sta curdrv ; make this the current drive
adi 'A' ; compute drive letter
sta msg$drv

RCALL FR$bell ; ring BELL to alert user
lxi h,swap$msg$lng*256+buff$pos
lxi d,swap$msg
call disp$msg$DE$HL ; disp and wait for CR

mvi a,vic$test
call ?fun65
; ani 0fh
; cpi 0ch ; not fast ERROR ?
; jrz exit$drv$A$E ; yes, return that's not a problem
; ani 0eh ; other error type ?
; jrnz send$messg
exit$drv$A$E:
pop b
pop d
pop h
mov a,b
ret

swap$msg: db 'Insert Disk '
msg$drv: db 'X in Drive A'

swap$msg$lng equ $-swap$msg+2 ; +2 for leading and trailing spaces

page
;
;
;
get$max$num$b:
lhld DPH$pointer
lxi b,42 ; offset to number of sectors on track
dad b
mov a,m ; get number sectors/track/side
ani 1fh
mov b,a
ret
;
;
;
get$sector$size:
lhld DPH$pointer
dcx h
mov a,m ; disk type in B (bit 5,4 size info)
rrc ; ..00 = 080h byte sectors
rrc ; ..01 = 100h byte sectors
rrc ; ..10 = 200h byte sectors
rrc ; ..11 = 400h byte sectors
ani 3
jrz set$128
jpo not$3 ; jump if (A=) 01b or 10b
inr a ; make A = 4
not$3:
mvi e,0 ; set E to zero
mov d,a ; set sector size (1,2 or 4)
get$DMA:
lhld local$DMA ; get the current DMA pointer
ret

set$128:
lxi d,128
jr get$DMA

page
;
;
;
DSEG
set$up$GCR:
cpi dsk$c128
jnz tst$next

mvi a,4
sta sect$cnt
lxi h,sect$buffer
shld sect$buf$ptr

lhld @trk ; 1 K sector pointer
dad h
dad h ; make 256 byte pointer
;
; build a list of tracks and sectors
;
next$sect:
shld @trk
RCALL FR$trk$sect
lhld vic$trk ; get trk(L) and sector(H) to HL
xchg
lhld sect$buf$ptr
mov m,e
inx h
mov m,d
inx h
shld sect$buf$ptr
lhld @trk
inr l ; update saved above at next$sect
mov a,l
ani 3
jrnz next$sect
;
; check list of trk-sectors for number of sectors on this trk
;
lxi h,sect$buffer
shld sect$buf$ptr
lda vic$drv
mov b,a
lda fast
ana b ; drive type 1571
jrz handle$1541 ; no, handle as 1541

lda sect$cnt ; number of sectors to rd/wr
mov b,a
inx h
mov a,m ; get 1st sector #
sta vic$sect
dcx h
mov a,m ; get 1st track #
sta vic$trk

try$next:
cmp m ; test for same trk #
jrnz exit$no$match
inx h
inx h ; advance to next trk
shld sect$buf$ptr
djnz try$next

exit$no$match:
lda sect$cnt ; number of sectors to rd/wr
sub b ; remove number left
; (leaving number matched)
sta vic$count ; save number to read
mov a,b ; get remaining count
sta sect$cnt ; save remaining count
ret


set$up$next:
lda vic$count ; get number of sectors read
lhld local$DMA ; get current DMA pointer
add h ; advance pointer by number of
mov h,a ; sectors read
shld local$DMA
handle$1541:
lhld sect$buf$ptr
mov a,m
sta vic$trk
inx h
mov a,m
sta vic$sect
inx h
shld sect$buf$ptr
lda vic$drv
mov b,a
lda fast
ana b
jrz set$up$next$slow
lda sect$cnt
sta vic$count
xra a ; two reads max with fast drive
jr set$up$next$exit

set$up$next$slow:
lda sect$cnt
dcr a
set$up$next$exit:
sta sect$cnt
ret
;
;
;
tst$next:
  if use$1581
cpi dsk$1581
jrz c1581$adj
  endif
tst$c64:
mvi b,dir$track ; set the dir track number
cpi dsk$c64 ; C64 type disk?
lda @sect ;   get sector # to set
jrz set$up$c64 ; yes, go set up for C64 CP/M disk format
; no, set up as no type(direct addressing)
;
; This format is for direct track and sector addressing
;
do$type$7:
mvi b,255 ; no dir sector
;
; this routine will adjust the track number if necessary.
; The C64 CP/M disk has the C64 directory in the center
; of the disk. This routine checks and adds one to the track
; number if we have reached or passed the directory track.
;
set$up$c64:
sta VIC$sect ;
lda @trk ;
cmp b ; carry=1 if A < dir$track
cmc ; add one if dir$track or more (carry not set)
aci 0 ; add the carry bit in
sta vic$trk
ret

  if use$1581
;
;****** adjust to read multi-512 byte sectors (system sees 1K sector size)
;
c1581$adj:
mvi a,2 ; 2 512 byte sectors equ 1 1K sector
sta vic$count

lda @trk ;
cpi C1581$dir$trk*2 ; carry=1 if A < dir$track
cmc ; add one if dir$track or more (carry not set)
aci 0 ; add the carry bit in
rar ; track=@trk/2 ; carry set if odd
sta vic$trk ;

lda @sect ; sector # are 0 to 9 (10 sector/trk)
mov b,a ;
jrnc bottom$1581 ;
adi 80h ; set top of 1581
bottom$1581:
add b ; make 0 to 8
inr a ; adjust to 1 to 9 (odd numbers only)
sta VIC$sect ;
ret ;

  endif


page
;
; A=dsk$info on entry
;
set$up$MFM:
mvi d,0 ; D=side # (0)
mov e,a ; save dsk$info in E
ani TypeX ; look at Type0 to Type7
jrz do$type$0 ;
cpi Type2
lda @trk ; used by Type1, Type2 and Type3
jrz do$type$2
jrc do$type$1

; cpi Type6
; jrz do$type$6
; jnc do$type$7 ; MSB of sector(byte) set for 2nd side of disk

cpi Type7
jz do$type$7 ; MSB of sector(byte) set for 2nd side of disk
;
; only types 0 to 2 and 7 are currenty defined
; Type3 to Type6 will do Type2
;do$type$3:
;do$type$6:

do$type$2:
mov b,a ; save a copy in B
sui 40
jrc do$type$0 ; jump if still on side 0
mvi a,79 ; on back side count 39,38,37,...,0
sub b
set$trk:
mvi d,80h ; D=side # (1)
sta @trk
jr do$type$0

page
;
; divide the track number by two and if Head=1
; add #sect/side to @sect
;
do$type$1:
cmc ; carry was set clear it
rar ; divide track by 2 (carry gets LSB)
sta @trk
jrnc do$type$0
call get$max$num$b ; HL and C changed
lda @sect
add b
sta @sect

do$type$0:
lda @trk
sta vic$trk
call get$max$num$b ; B=number of sectors per track per side
lda @sect ; ..HL and C changed
cmp b
jrc is$side$0
mvi d,80h ; D=side # (1)
bit C1$bit,e ; dsk$info in E
; sector numbering continues on side 1 ?
jrnz is$side$0 ; yes, do not remove side one bias
sub b ; no, remove side one bias
is$side$0:
mov c,a ; hold @sect in C
mov a,e ; get dsk$info to A
ani S1 ; A=Starting  sector number (0 or 1)
add c ; add back @sect
ora d ; add in the side bit
sta vic$sect
ret

page
;
; input:
; DE = number bytes to read
; HL = DMA address
;
CSEG
rd$1571$data:
lda @dbnk ; get the disk DMA bank
call ?bank ; set it

lxi b,0DC0Dh ; D1ICR
rd$1571$stat$wait:
inp a
ani 8 ; data ready bit set?
jrz rd$1571$stat$wait ; no, loop

mvi c,0ch ; D1SDR
inp a ; read the status byte
sta vic$data ; save it
ani 0eh ; any errors ?
jrnz rd$1571$exit ; yes, exit

lxi b,0DD00h
inp a ; get current clock polarity

rd$1571$next:
lxi b,0DD00h ; D2PRA
xri 10h ; toggle clk$bit
outp a ; clock the 1571 for a byte

dcr e ; DE=count
jnz rd$1571$more ; leave as normal jump to keep
dcr d ; the transfer speed at it's max
jrz rd$1571$exit ; ...

;
rd$1571$more:
dcr b
rd$1571$wait:
mvi c,0dh ; D1ICR (DC0Dh)
inp c
bit 3,c
jz rd$1571$wait
mvi c,0ch ; D1SDR
ini ; (hl) <- (bc) ; hl <- hl+1 ; b <- b-1
jmp rd$1571$next


rd$1571$exit:
sta bank$0 ; restore current mem config
ret

page

clk$in equ 40h
;
; input:
; DE = number of bytes to write
; HL = DMA address
;
wr$1571$data:
call ?di$int
; do spout inline
lxi b,mode$reg
mvi a,fast$wr$en
sta io$0
outp a ; set data direction to output
sta bank$0

lxi b,0dc05h ; low (D1T1h)
xra a
outp a
dcr c ; low(D1T1l)
mvi a,3 ; clk = osc/3
outp a ;

mvi c,0eh ; D1CRA
inp a
ani 80h
ori 55h
outp a
dcr c ; D1ICR
inp a

lda @dbnk ; get the disk DMA bank
call ?bank ; set it

mvi a,clk$in
sta cur$clk

page
;
;
clk$wait:
lxi b,0dd00h ; D2PRA
inp a
inp c ; debounce
cmp c
jrnz clk$wait

lda cur$clk ; get old clk value
xra c ; check if changed
ani clk$in ; (only clock in bit)
jrz clk$wait ; loop if not

mov a,c ;
sta cur$clk ; make this the current clk value
lxi b,0dc0ch ; D1SDR
mov a,m
outp a ; send character to drive
inx h ; advance pointer
dcx d ; dec the char count

inr c ; D1ICR
send$wait:
inp a
ani 8
jz send$wait

mov a,d
ora e
jnz clk$wait ; go send the next byte

; do spin
lxi b,0DC0Eh ; D1CRA
inp a
ani 80h
ori 8
outp a
lxi b,mode$reg
mvi a,fast$rd$en
sta io$0 ; enable the MMU
outp a ; set data direction to input
sta bank$0 ; disable MMU
; spin done

page

lxi b,0DC0Dh ; D1ICR
inp a ; clear data pending flag

lxi b,0DD00h ; D2PRA
inp a
ori 10h ; set clk$bit low (hardware inverted)
outp a ;

lxi b,0DC0Dh ; D1ICR
wait$status:
inp a
ani 8
jrz wait$status

lxi b,0DC0Ch ; D1SDR
inp d

lxi b,0DD00h ; D2PRA
inp a
ani not(10h) ; set clk$bit hi (hardware inverted)
outp a ;

mov a,d ; recover the status byte
sta vic$data

ei
ret

page
;
; This routine is used to move a sector of data
; to/from the sector buffer and the DMA pointer.
;     A=0 for buffer to DMA  (disk read)
;     A<>0 for DMA to buffer (disk write)
;
CSEG
?dkmov:
lhld local$DMA ; current DMA adr
lxi d,@buffer ; location of disk read/write buffer
lxi b,256 ; sector size
;
;
dk$cont:
ora a
jrnz dsk$read ; swap pointer for read
xchg
;
;
dsk$read:
lda @dbnk ; get the disk bank
call ?bank
ldir ; do the data move
sta bank$0 ; current bank will ALWAYS be 0
ret

;
;
;
DSEG
dsk$fun:
sta vic$cmd
lda stat$enable
ani 1 ; display of disk info enabled?
cnz disp$dsk$info ; yes, go display disk info
jmp ?fun65+3 ; go do the function

page
;
;
;
DSEG
?dskst:
disp$dsk$info:
mvi a,72 ; r/w in col 72 (col 0-79)
sta offset
lda vic$cmd
mvi b,'R'
dcr a ; ?1 normal$rd
jrz out$cmd$rd
dcr a ; ?2 normal$wr
jrz out$cmd$wr
dcr a ; ?3 fast$rd
jrz out$cmd$rd
dcr a ; ?4 fast$wr
rnz
out$cmd$wr:
mvi b,'W'
out$cmd$rd:
call disp$B
call disp$space
mvi b,'A'-1
lda vic$drv
next$drv:
inr b
rrc
jrnc next$drv

call disp$B
lda vic$trk
call disp$dec
lda vic$sect
ani 80h
cz disp$space
mvi b,'-'
cnz disp$B
lda vic$sect
ani 7fh

page
;
;
;
disp$dec:
mvi b,'0'-1

conv$loop:
inr b
sui 10
jrnc conv$loop

adi '0'+10
push psw
call disp$B
pop psw
disp$A:
mov b,a
disp$B:
lxi h,@st40-72+40-8
lda offset
mov e,a
mvi d,0
dad d ; add the offset
mov m,b ; save on 40 col display

mov a,e
mov c,a ; col # in C
inr a
sta offset ; advance cursor position
xra a ; no attribute to write
call ?stat

lxi h,@st40
lxi d,vic$screen+40*24 ; update 40 column screen
lxi b,40
ldir
xra a
ret

disp$space:
mvi b,' '
jr disp$B

page
;
; Extended Disk Parameter Headers (XDPHs)
;
CSEG ; place tables in common
;
; 1st disk drive on the system
;
dw write$154X
dw read$154X
dw login$154X
dw init$154X
db 1 ; bit 0 set (drive 0)
db dsk$c128 ; format type byte
cmdsk0:
dph 0,dpb$0

dpb$0:
dpb 1024,5,159,2048,128,0
db 0 ; max sector number and lock flag
dw 0 ; MFM table pointer

page
;
; 2nd disk Drive on the system
;
dw write$154X
dw read$154X
dw login$154X
dw init$154X
db 2 ; bit 1 set (drive 1)
db dsk$c128 ; format type byte
cmdsk1:
dph 0,dpb$1

dpb$1:
dpb 1024,5,159,2048,128,0
db 0 ; max sector number and lock flag
dw 0 ; MFM table pointer

page
;
; 3rd disk drive on the system
;
dw write$154X
dw read$154X
dw login$154X
dw init$154X
db 4 ; bit 2 set (drive 2)
db dsk$c128 ; format type byte
cmdsk2:
dph 0,dpb$2

dpb$2:
dpb 1024,5,159,2048,128,0
db 0 ; max sector number and lock flag
dw 0 ; MFM table pointer

page
;
; 4th disk drive on the system
;
dw write$154X
dw read$154X
dw login$154X
dw init$154X
db 8 ; bit 3 set (drive 3)
db dsk$c128 ; format type byte
cmdsk3:
dph 0,dpb$3

dpb$3:
dpb 1024,5,159,2048,128,0
db 0 ; max sector number and lock flag
dw 0 ; MFM table pointer

page
;
; Drive E: shared with 1st drive (A:)
;
dw write$154X
dw read$154X
dw login$154X
dw init$154X
db 1 ; bit 0 set (drive 0)
db dsk$c128 ; format type byte
cmdsk4:
dph 0,dpb$4

dpb$4:
dpb 1024,5,159,2048,128,0
db 0 ; max sector number and lock flag
dw 0 ; MFM table pointer

page
;
; NOTE: The blocking factor for all of these formats is
; 1K (2K for double sided), thus the fractional
; parts are unusable by CP/M.  They can be accessed
; by absolute sector addressing.
;
; NOTE: 1571 and 1541 disk drives use track numbers
; of 1 to 35 and sector numbers of 0 to nn

;
; The method used to access the full disk
; is to tell the system that there is 1 sector
; per track and then to use the track # as an
; absolute sector address and do conversion in BIOS.
;
;
; DPB FOR C128 CP/M 3.0 disk ( 170K, 34K larger then C64 CP/M)
; 256 byte sectors ( 170.75K )
; 1 sectors/track
; up to 21 physical sectors (0 to 16,17,18 or 20)
; 680 tracks/disk (usable, 683 real)
; 35 physical tracks (0 to 34)
; 1K allocation blocks
; 64 directory entries
; track offset of 0
;
DSEG ; these tables are moved to common when used
dpb$c128$SS: ; (170 allocation units)
dpb 1024,1,170,1024,64,0

page
;
; DPB FOR C128 CP/M 3.0 double sided disk ( 340K )
; 1024 byte sectors (phy=256) ( 341.5K )
; 1 sectors/track
; up to 21 physical sectors (0 to 16,17,18 or 20)
; 340 tracks/disk (usable, 1366 real)
; 70 physical tracks (0 to 34 side 0, 35 to 69 side 1)
; 2K allocation units
; 128 directory entrys
; track offset of 0
;
dpb$c128$DS: ; (170 allocation units)
dpb 1024,1,340,2048,128,0

page
;
; DPB FOR C64 CP/M 2.2 disk -- ( 136K )
; 256 byte sectors
; 17 sectors / tracks (sector numbering 0-16)
; sector 18 to n on the outer tracks are unused
; 34 tracks / disk
; tracks track 2 to 16    (track numbering 0-34)
; track 17 is the C128 directory track (not counted)
; track 19 to 34
; 1K allocation blocks
; 64 directory entrys
; track offset of 3 (1st two tracks used for CP/M 2.2 boot) plus
; one sector to adjust for sector numbering of 1 to 35 (not 0 to 34)
;
dpb$c64$cpm: ; (144 allocation units)
dpb 256,17,34,1024,64,3
               
page
;
; DPB FOR C128 CP/M 3.0 C1581 DSDD (3.5") (    K )
; 512 byte sectors ( 720K )
; 10 sectors/track
; 159 tracks/disk
; 160 physical tracks 80 on top, 79 on bottom, 1 used for
; BAM and disk directory (1581 DOS) (10 sectors per track)
; 2K allocation units
; 128 directory entrys (2 allocation units)
;
  if use$1581
dpb$1581: ; (xxx allocation units)
dpb 1024,5,159,2048,128,0
  endif

page
;
DSEG
MFM$table:
db S256*2+(16*2-8)+1 ; 256 byte sect, 16 sect/trk
db MFM+S256+Type0+C0+S1 ; DSDD
dw 0 ; start on track 2 sect 1 (2 alc)
dpb 256,32,40,2048,128,2 ; sect# 1 to 16
db 16 ; (top and bottom numbered the same)
db 'Epson QX10' ;1 Epson QX10
; 160 allocation units




db 80h+S512*2+(10*2-8)+1 ; 512 byte sect, 10 sect/trk
; db S256*2 ; track 0 is 256 bytes/sector
db MFM+S512+Type0+C0+S1 ; DSDD
dw 0 ; start on track 2 sect 1 (2 alc)
dpb 512,20,40,2048,128,2 ; sect# 1 to 10
db 10 ; (top and bottom numbered the same)
db 'Epson QX10' ;2
; 200 allocation units

page

db S512*2+(8*2-8)+1 ; 512 byte sect 8 sect/trk
db MFM+S512+Type2+C0+S1 ; SSDD
dw 0 ; start on track 1 sector 1 (2 alc)
dpb 512,8,40,1024,64,1 ; sect# 1 to 8
db 8 ;
db ' IBM-8 SS ' ;3
; 160 allocation units




db S512*2+(8*2-8)+1 ; 512 byte sect 8 sect/trk
db MFM+S512+Type2+C0+S1 ; DSDD
dw 0 ; start on track 1 sector 1 (1 alc)
dpb 512,8,80,2048,64,1 ; sect# 1 to 8
db 8 ; (top and bottom numbered the same)
db ' IBM-8 DS ' ;4
; 160 allocation units

page

db S512*2+(10*2-8)+0 ; 512 byte sector, 10 sect/trk
db MFM+S512+Type1+C1+S0 ; DSDD
dw 0 ; start on track 0 sector 10 (2 alc)
dpb 512,10,80,2048,128,1 ; sect# 0 to 9 on top (even tracks)
db 10 ; sect# 10 to 19 on bottom (odd tracks)
db 'KayPro IV ' ;5
; 200 allocation units




db S512*2+(10*2-8)+0 ; 512 byte sect, 10 sect/trk
db MFM+S512+Type0+C1+S0 ; SSDD
dw 0 ; start on track 1 sector 0 (4 alc)
dpb 512,10,40,1024,64,1 ; sect# 0 to 9
db 10 ;
db 'KayPro II ' ;6
; 200 allocation units

page

db S1024*2+(5*2-8)+1 ; 1024 byte sect, 5 sect/trk
db MFM+S1024+Type0+C0+S1 ; SSDD
dw 0 ; start on track 3 sector 1 (2 alc)
dpb 1024,5,40,1024,64,3 ; sect# 1 to 5
db 5 ;
db 'Osborne DD' ;7
; 200 allocation units


db S512*2+(9*2-8)+1 ; 512 byte sect 9 sect/track (uses 8)
db MFM+S512+Type1+C0+S1 ; DSDD
dw 0 ; start on trk 0, sect 1, hd 1 (1 alc)
dpb 512,8,80,2048,64,1 ; sect# 1 to 9
db 8 ; (top and bottom numbered the same)
db '  Slicer  ' ;8
; 160 allocation units

page

db S256*2+(16*2-8)+1 ; 256 byte sect, 16 sect/trk
db MFM+S256+Type0+C0+S1 ; DSDD
dw 0 ; start on track 4 sect 1 (2 alc)
dpb 256,32,40,2048,128,4 ; sect# 1 to 16
db 16 ; (top and bottom numbered the same)
db 'Epson Euro' ;9 Epson European (MFCP/M ?)
; 160 allocation units



db -1
db MFM ;
dw 0 ;
dpb 512,20,40,2048,128,2 ;
db 8 ;
db '   None   ' ;10

page

db -1
db MFM ;
dw 0 ;
dpb 512,20,40,2048,128,2 ;
db 8 ;
db '   None   ' ;11

db -1
db MFM ;
dw 0 ;
dpb 512,20,40,2048,128,2 ;
db 8 ;
db '   None   ' ;12

page

db -1
db MFM ;
dw 0 ;
dpb 512,20,40,2048,128,2 ;
db 8 ;
db '   None   ' ;13

db -1
db MFM ;
dw 0 ;
dpb 512,20,40,2048,128,2 ;
db 8 ;
db '   None   ' ;14

page

db -1
db MFM ;
dw 0 ;
dpb 512,20,40,2048,128,2 ;
db 8 ;
db '   None   ' ;15

db -1
db MFM ;
dw 0 ;
dpb 512,20,40,2048,128,2 ;
db 8 ;
db '   None   ' ;16


page
;
; not functional yet
;

; db S1024*2+(5*2-8)+1 ; 1024 byte sect 5 sect/track
; db MFM+S1024+Type0+C0+S1 ; SSDD
; dw 0 ; start on trk 2, sect 1 (2 alc)
; dpb 1024,5,40,2048,128,2 ; sect# 1 to 5
; db 5 ;
; db 'Morrow MD2' ;





; db S1024*2+(5*2-8)+1 ; 1024 byte sect  5 sect/trk
; db MFM+S1024+Type0+C0+S1 ; DSDD
; dw 0 ; start on trk 1, sect 1, hd 0 (3 alc)
; dpb 1024,10,40,2048,192,1 ; sect# 1 to 5
; db 5 ;
; db 'Morrow MD3' ;


MFM$tbl$entries equ ($-MFM$table)/32

db -1 ; mark end of table
db -1

page

cseg
cur$clk: ds 1

dseg
lock$flag ds 1
last$match ds 2
window$info: ds 2

dsk$window equ 12

no$dsk$msg:
;1234567890
db ' Missing  '


MFM$match$tbl:
ds 2*MFM$tbl$entries ; MFM$count MUST follow this parm
MFM$count:
ds 1 ; MFM$offset MUST follow this parm
MFM$offset:
ds 1

MFM$cur$ptr:
ds 2

DPH$pointer:
ds 2

sect$cnt:
ds 1
sect$buf$ptr:
ds 2
sect$buffer:
ds 4*2

local$DMA:
ds 2

status$atr equ 0
offset: db 0

end

[Blacklord]

cxem.asm

Code Select Expand

title 'Terminal Emulation (ADM-31 with K-Pro support)   21 May 86'


maclib z80

maclib cxequ

lines equ 24

public ?out40,?out80,ADM31

;
; ADM3A
;
;
; ESC = row col cursor position
; ESC ESC ESC color set color ; added for C128 CP/M
; ^H cursor left
; ^L cursor right
; ^J cursor down
; ^K cursor up
; ^Z home and clear screen
; ^M carrage return
; ^G bell

;
; ADM31
;
;
; ESC = row col cursor position
; ESC ESC ESC color set color ; added for C128 CP/M
; ESC T clear to end of line
; ESC t clear to end of line
; ESC Y clear to end of screen
; ESC y clear to end of screen
; ESC : home & clear screen
; ESC * home & clear screen
; ESC ) Half intensity on
; ESC ( Half intensity off
; ESC G 4 Reverse video on
; ESC G 2 Blinking on
; ESC G 0 Rev. video and blinking off
; ESC E Insert line
; ESC Q Insert Character
; ESC R Delete Line
; ESC W Delete Character
; ^H cursor left
; ^L cursor right
; ^J cursor down
; ^K cursor up
; ^Z home and clear screen
; ^M carriage return
; ^G bell
;
page
;
; KPRO II Terminal control sequences
;
;
; Cursor Control
;
; ^H cursor left (bs)
; ^L cursor right
; ^J cursor down
; ^K cursor up
; ^^ home cursor
; ^Z home cursor & clear screen
; ^M carriage return
;
; Cursor Positioning
;
; ESC = R C (R & C =' '+position)
;
; Line Insert/Delete
;
; ESC E Line Insert
; ESC R Line Delete
;
; Clear to End of Screen/Line
;
; ^X Clear to End of Line
; ^W Clear to End of Screen
;
; Set Greek or ASCII (not supported)
;
; ESC A Set ASCII
; ESC G Set Greek (lower case letters print as Greek Alphabet)
;
; KAYPRO 84 (???) screen commands
;
; ESC B turn attrubute on
; ESC C turn attrubute off
;
; where is defined as:
; 0=reverse video
; 1=
; 2=
; 3=
;
;
;
; The following two sequences are
; use but I do not know what function
; they perform.  (added 21 May 86)
;
; ESC D
; ESC L
;
page

dseg
;
;
;
?out40:
mvi a,FR$40
lxi h,parm$area$40
jr out$cont

;
;
;
?out$80:
xra a ; 80 column offset is 0
lxi h,parm$area$80
out$cont:
sta fun$offset
mvi a,7fh
ana c
mov c,a
shld parm$base
lhld emulation$adr
pchl

page
;
; ADM-31 terminal emulation
;
ADM31:
lhld parm$base ; 1st parm is exec adr (2 bytes)
mov a,m
inx h
mov h,m
mov l,a

ora h ; L is in A already, test HL=0
mov a,c ; C is char to output
jrz start$checking
pchl

;
;
;
start$checking:
lxi h,control$table
lxi b,cnt$tbl$lng
ccir
lxi h,control$exec$adr
jrz find$exec$adr

cpi 20h
rc

do$direct:
mov d,a
TJMP FR$wr$char

page
;
;
;
char$esc: ; ESC
call cont$later
;
; ESC char look for char in the ESC table
;
call remove$exec$adr
lxi h,esc$table
lxi b,esc$tbl$lng
ccir
rnz ; bad esc sequence
lxi h,esc$exec$adr

find$exec$adr:
dad b
dad b
mov a,m
inx h
mov h,m
mov l,a
pchl



page
;
;
;
cont$later:
pop h ; get address to cont at in H
jr save$exec$adr ; save it
;
;
;
remove$exec$adr:
lxi h,0
save$exec$adr:
xchg
lhld parm$base
mov m,e
inx h
mov m,d
ret


;
;
;
esc$esc:
call cont$later
;
; check for ESC ESC ESC
;
cpi esc ; check if 3rd char is an ESC
jrnz remove$exec$adr
call cont$later
;
; set current character as the attr
;
mov b,a
TCALL FR$color
jr remove$exec$adr

page
;
;
;
esc$equ:
call cont$later
;
; ESC = R
;
lhld parm$base
inx h
inx h
sui ' ' ; remove ascii bias
mov m,a
cpi '8'-' ' ; test for line 25 (A=24?)
jrnz not$status$line ; no, jmp
inr a ; yes, A=25
sta paint$size ; set 40 column repaint to 25 lines
not$status$line:
call cont$later
;
; ESC = R C (go do it)
;
sui ' '
mov e,a ; column # to E

lhld parm$base
inx h
inx h
mov d,m ; row # to D
TCALL FR$cursor$pos
jr remove$exec$adr

page
;
;
;
char$cnt$z: ; ^Z home and clear screen
lxi d,lines*256+0 ; B=24(row) C=0(col)
TCALL FR$cursor$pos
call esc$t ; clear the status line
lxi d,0
TCALL FR$cursor$pos
esc$y:
TJMP FR$CES ; clear to end of screen

home$cursor:
lxi d,0
TJMP FR$cursor$pos

esc$t:
TJMP FR$CEL ; clear to end of line

;
;
;
do$cr:
TJMP FR$do$cr

;
;
;
cursor$rt:
TJMP FR$cursor$rt

;
;
;
cursor$up:
TJMP FR$cursor$up

;
;
;
cursor$down:
TJMP FR$cursor$down

;
;
;
cursor$left:
TJMP FR$cursor$left

page

;
; placed in common so that link and gencpm will not
; cause this code to show up at address 0D000h to 0DFFFh
;
char$cnt$g: ; ^G bell
RJMP FR$bell

;
; delete character
;
esc$W:
TJMP FR$char$del

;
; delete line
;
esc$R:
TJMP FR$line$del

;
; insert character
;
esc$Q:
TJMP FR$char$ins

;
; insert line
;
esc$E:
TJMP FR$line$ins

page
;
; ESC C atribute off
;
esc$C:
call cont$later
lxi b,4*256+4 ; max+1 num, offset
jr esc$num$cont

;
; ESC B atribute on
;
esc$B:
call cont$later
lxi b,4*256+0 ; max+1 num, offset
jr esc$num$cont
;
; Set Attribute sequence
;
esc$G:
call cont$later
lxi b,5*256+8 ; max+1 num, table offset
esc$num$cont:
call remove$exec$adr
sui '0' ; remove ascii bias
cmp b ; number of functions
rnc
add c ; get offset
mov c,a
mvi b,0
lxi h,esc$num$tbl
jmp find$exec$adr

page
;
;
;
esc$D:
esc$L:
call cont$later ; wait for num1
call cont$later ; wait for num2
call cont$later ; wait for num3
call cont$later ; wait for num4
jmp remove$exec$adr

page
;
; Half Intensity Off
;
esc$lfp:
mvi b,00000001b ; turn intensity up
jr set$atr$on
;
; Half Intensity On
;
esc$rtp:
mvi b,00000001b ; turn intensity down
jr set$atr$off

;
; Rev. Video, blink, atl char set, and underline  off
;
esc$G$0:
mvi c,10000000b ; turn attributes off
mvi b,11110000b ; attribute bit to change
jr set$FR$attr

;
; Select alt character set
;
esc$G$1:
mvi b,10000000b ; select alt character set
jr set$atr$off

;
; Blinking On
;
esc$B$2: ; turn flash ON ???
esc$G$2:
mvi b,00010000b ; turn on blink attr
jr set$atr$on
;
;
;
esc$C$2: ; turn flash OFF ???
mvi b,00010000b
jr set$atr$off
;
; Under line
;
esc$B$3: ; turn underline ON ???
esc$G$3:
mvi b,00100000b ; turn on underline bit
jr set$atr$on
;
;
;
esc$C$3: ; turn under line OFF  ???
mvi b,00100000b
jr set$atr$off
;
; Reverse Video On
;
esc$B$0:
esc$G$4:
mvi b,01000000b ; turn attributes on

set$atr$on:
mov c,b ; reverse attr
set$FR$attr:
TJMP FR$attr

;
;
;
esc$C$1: ; turn half bright OFF ???
mvi b,00000001b
jr set$atr$on

;
;
;
esc$B$1: ; set half bright ON ???
mvi b,00000001b
jr set$atr$off

;
; turn reverse video off
;
esc$C$0:
mvi b,01000000b ; attribute to turn off
set$atr$off:
mov a,b
cma
ana b
mov c,a
TJMP FR$attr

page
;
; table scanned top to bottom
;
control$table:
db 07h ; ^G bell
db bs ; ^H cursor left
db lf ; ^J cursor down
db 0Bh ; ^K cursor up
db 0Ch ; ^L cursor right
db cr ; ^M carrage return
db 1Ah ; ^Z home and clear screen
db esc ; ESC
db 18h ; ^X Clear to End of Line (K-Pro)
db 17h ; ^W Clear to End of Screen (K-Pro)
db 1Eh ; ^^ home cursor (K-Pro)

cnt$tbl$lng equ $-control$table

;
; table scanned bottom to top
;
control$exec$adr:
dw home$cursor ; ^^ home cursor (K-Pro)
dw esc$y ; ^W CES (K-Pro)
dw esc$t ; ^X CEL (K-Pro)
dw char$esc ; ESC
dw char$cnt$z ; ^Z home and clear screen
dw do$cr ; ^M carriage return
dw cursor$rt ; ^L cursor right
dw cursor$up ; ^K cursor up
dw cursor$down ; ^J cursor down
dw cursor$left ; ^H cursor left
dw char$cnt$g ; ^G bell


page
;
; table scanned top to bottom
;
esc$table:
db '=' ; ESC = R C

db 'T' ; ESC T  clear to end of line
db 't' ; ESC t   clear to end of line
db 'Y' ; ESC Y   clear to end of screen
db 'y' ; ESC y   clear to end of screen
db ':' ; ESC :   home & clear screen
db '*' ; ESC *   home & clear screen

db 'E' ; ESC E   Insert line
db 'Q' ; ESC Q   Insert Character
db 'R' ; ESC R   Delete Line
db 'W' ; ESC W   Delete Character

db ')' ; ESC )   Half intensity on
db '(' ; ESC (   Half intensity off
db 'G' ; ESC G 4 Reverse video on
; ESC G 2 Blinking on
; ESC G 0 Rev. video and blinking off
db 'B' ; ESC B atribute on
db 'C' ; ESC C atribute off
db esc ; ESC ESC
db 'D' ; ESC D   ???
db 'L' ; ESC L   ???

esc$tbl$lng equ $-esc$table


;
; table scanned bottom to top
;
esc$exec$adr:
dw esc$L ; ESC L   A kaypro function ???
dw esc$D ; ESC D   A kaypro function ???
dw esc$esc ; ESC ESC ESC color
dw esc$C ; ESC C atribute off
dw esc$B ; ESC B atribute on
dw esc$G ; ESC G 4 Reverse video on
; ESC G 2 Blinking on
; ESC G 0 Rev. video and blinking off
dw esc$lfp ; ESC (   Half intensity off
dw esc$rtp ; ESC )   Half intensity on

dw esc$W ; ESC W   Delete Character
dw esc$R ; ESC R   Delete Line
dw esc$Q ; ESC Q   Insert Character
dw esc$E ; ESC E   Insert line

dw char$cnt$z ; ESC *   home & clear screen
dw char$cnt$z ; ESC :   home & clear screen
dw esc$y ; ESC y   clear to end of screen
dw esc$y ; ESC Y   clear to end of screen
dw esc$t ; ESC t   clear to end of line
dw esc$t ; ESC T  clear to end of line

dw esc$equ ; ESC = RC
;
;
;
esc$num$tbl:
dw esc$b$0 ; ESC B0 reverse video ON
dw esc$b$1 ; ESC B1 ??? half bright ON
dw esc$b$2 ; ESC B2 ??? blink ON
dw esc$b$3 ; ESC B3 ??? under line ON

dw esc$c$0 ; ESC C0 reverse video OFF
dw esc$c$1 ; ESC C1 ??? half bright OFF
dw esc$c$2 ; ESC C2 ??? blink OFF
dw esc$c$3 ; ESC C3 ??? under line OFF

dw esc$g$0 ; ESC G0 clear attributes (all G functions)
dw esc$g$1 ; ESC G1 alt char set
dw esc$g$2 ; ESC G2 blink attr on
dw esc$g$3 ; ESC G3 underline attr on
dw esc$g$4 ; ESC G4 reverse video on

[Blacklord]

cxext.asm

Code Select Expand

;
title 'C128 external Disk drive support  28 Apr 86'

;
; This program contains the stubs for bringing up the C128 CP/M
; for the first time.
;
; The method used to stub the system I/O is to send the
; operation request to the serial port as a command and
; recieve responce from the serial channel.
;
; The commands supported are:
;
; CMD: 'I' ; input keyboard char
; RSP: xx ; returns keybord char or 00 if none
;
; CMD 'O'xx ; send char xx to display
; RSP: xx ; echo character
;
; CMD: Rttss ; read sector of data  adr by track (tt) sector (ss)
; RSP: xx..yy ; returns 128 bytes of data plus a check sum
;
; CMD: Wttssxx..yy ; write sector of data, sent with a check sum
; ; to (xx..yy) adr by track (tt) sector (ss)
; RSP: xx ; xx=00 if no error
;
page

maclib cpm3

maclib z80

maclib cxequ

[Blacklord]

cxintr.asm

Code Select Expand

title 'Interrupt handler    29 Apr 86'


maclib z80

maclib cxequ

public ?sysint


done$scan: equ 11110111b

clear$TxD$bit: equ 10010111b ; 2nd byte of   res  2,a
set$TxD$bit: equ 11010111b ; 2nd byte of   setb 2,a

buf$end equ low(RxD$buffer+RxD$buf$size)

page
;
; The DE register is not changed by the interrupt handler
;
; maximun of     T states advaliable per interrupt
; DMA uses about 10 % (or   ) leaving only
; interrupt vectoring use a few more.
;
; if both recv$state and send$state are in idle
; T states   209+82++ (191max,38min) = (482max,329min)
;
;
; if ether recv$state and send$state are active
; T states   209+++ (289max, 82min) = (498max,291min)
;
CSEG
?sysint:
push psw ;11
push b ;11
push h ;11
;
lxi b,CIA$1+int$ctrl ;10
inp a ;12  clear CIA$1 interrupts
;
   if not use$6551
lxi b,CIA2+data$a ;10
inp a ;12
out$rs232$cia equ $+1
setb 2,a ;8   this instruction gets modified
outp a ;12

inr c ;4   point to data$b (C=1)
inp a ;12
mov h,c ;4   set H=1
recv$state:
call recv$idle ;17+(153max,54min)

send$state:
call send$idle ;17+(136max,28min)

dcr h ;4     did H=1 ?
lxi h,current$key$delay ;10
jnz skip$keyboard ;10

page
;
; T states  32 if not done
; T states  56+ if key scan done
;
vector$key$state:
dcr m ;11
jrnz exit$int ;7/12
lda int$rate ;13
mov m,a ;7
   endif
key$state:
call key$scan$state ;17+(191max,38min)
   if not use$6551
db 21h ; lxi h,(mvi m,1)
skip$keyboard:
mvi m,1 ;
   endif
exit$int:
pop h
pop b
pop psw
ei
ret

   if not use$6551
RxD$count:
db 0 ; number of bits left to receive
TxD$count:
db 0 ; number of bits left to transmit

current$key$delay:
db 1

page
;
; T states  52 start bit
; T states   no start bit, que inactive
; T states   no start bit, que active, DAV set
; T states no start bit, que active, DAV cleared
;
recv$idle:
rar ;4
jrnc set$test$start$bit ;7/(12+36)

;11+12+31=54
;
RxD$unque: ;(36)+12+(105) = 153 max
jr test$que ;12

;
; T states  31 no process required
; T states  91 que count adjusted (not empty)
; t states 105 que count adjusted (empty)
;
test$que:
lda RS232$status ;13 no processing req if QUE
ani 00100000b ;7 bit (5) is clear
rz ;5/11

mvi a,que$to$data-test$que ;7
sta RxD$unque+1 ;13 set next sub state

lxi h,RxD$buf$get ;10
inr m ;11
mov a,m ;7
cpi buf$end ;7
rnz ;5/11
mvi m,low(RxD$buffer) ;10
ret ;10

;
set$test$start$bit:
lxi h,test$start$bit ;10
shld recv$state+1 ;16
ret ;10

page
;
; T states  28 if DAV still set
; T states  89 to move char from que to recv$data
;
que$to$data:
lda RS232$status ;13
rrc ;4
rc ;5/11

lxi h,RxD$buf$get ;10
mov l,m ;7
mov a,m ;7
sta recv$data ;13

mvi a,adjust$cnt-test$que ;7
sta RxD$unque+1 ;13 set next sub state
ret ;10

;
; T states  82 count not zero
; T states  99 count becomes zero
;
adjust$cnt:
xra a ;4
lxi h,RxD$buf$count ;10
dcr m ;11
mvi l,low(RS232$status) ;7
setb 0,m ;15 set DAV flag
jrnz adj$cont ;7/12
res 5,m ;15 que empty turn QUE bit(5) off
mvi a,que$empty-test$que ;7
adj$cont:
sta RxD$unque+1 ;13
ret ;10
;
; T states  52/94
;
que$empty:
xra a ;4 offset of zero for JR
sta RxD$unque+1 ;13 (to get to test$que)
lxi h,xon$xoff$flag ;10
mvi a,XON ;7
cmp m ;7
rz ;5/11
mov m,a ;7
mvi a,send$x-send$norm ;7
sta send$idle+1 ;13
ret ;10


page
;
; test for false start
;
; T states  72 if valid start
; T states  52 if false start
;
test$start$bit:
rar ;4
jrc set$recv$idle ;7/(12+36) RxD in carry bit
lxi h,RS232$status ;10
setb 1,m ;15 set receiving data flag
lxi h,start$idle$1 ;10
shld recv$state+1 ;16
ret ;10

;
; T states  36
;
set$recv$idle:
lxi h,recv$idle ;10
shld recv$state+1 ;16
ret ;10


;
; T states  93
;
start$idle$1:
xra a ;4
sta recv$bit+2 ;13
lda XxD$config ;13
ani 1 ;7
adi 7 ;7
sta RxD$count ;13
lxi h,que$full$test ;10
shld recv$state+1 ;16
ret ;10

page
;
; T states  57 RxD buffer not full
; T states 117 RxD buffer full (send XOFF)
; T states  86 RxD buffer full (XOFF sent already)
;
que$full$test:
lxi h,recv$bit ;10
shld recv$state+1 ;16
lda RxD$buf$count ;13
cpi RxD$buf$size-16 ;7
rc ;5/11
lxi h,xon$xoff$flag ;10
mvi a,XOFF ;7
cmp m ;7
rz ;5/11
mov m,a ;7 set mode to send Xoff
mvi a,send$x-send$norm ;7
sta send$idle+1 ;13
ret ;10

;
; T states  64
;
recv$bit:
rar ;4
mvi a,00 ;7 RxD in carry bit
rar ;4 move data bit into MSB
sta recv$bit+2 ;13
lxi h,recv$bit$done$test ;10
shld recv$state+1 ;16
ret ;10

;
; T states   69 if bits still remaining
; T states  
;
recv$bit$done$test:
lxi h,RxD$count ;10
dcr m ;11
jrnz enter$recv$bit$idle ;7/(12+36)

lda XxD$config ;13
rlc ;4
lxi h,enter$RxD$stop ;10
jrnc do$test$stop ;7/12
lxi h,enter$RxD$parity ;10
do$test$stop:
shld recv$state+1 ;16

ani 1*2 ;7 A=0 if 7 bits else 8 bits
lda recv$bit+2 ;13
jrnz done$adj ;7/12
rrc ;4
done$adj:
sta RxD$data ;13
ret ;10

;
; T states  36
;
enter$recv$bit$idle:
lxi h,recv$bit$idle ;10
shld recv$state+1 ;16
ret ;10

;
; T states  36+(28/105)
;
recv$bit$idle:
lxi h,recv$bit ;10
shld recv$state+1 ;16
jmp RxD$unque ;10

page
;
; T states  36+(28/105)
;
enter$RxD$parity:
lxi h,test$RxD$parity ;10
shld recv$state+1 ;16
jmp RxD$unque ;10

;
; T states   bit hi
; T states   bit low
;
test$RxD$parity:
lxi h,RxD$parity$idle ;10 RxD data bit in carry
shld recv$state+1 ;16
rar ;4
lda XxD$config ;13
jrc RxD$parity$hi ;7/12
rlc ;4
rlc ;4 mark space mode ?
jrnc test$parity$space ;7/(12+15/46) yes, go test it
rlc ;4 get odd even mode
jr test$odd$even ;12+35/54

;
test$parity$space: ;15/
rlc ;4
rnc ;5/11
jr parity$error ;12+25

;
test$parity$mark: ;15/
rlc ;4
rc ;5/11
jr parity$error ;12+25

page
;
RxD$parity$hi: ;4
rlc ;4
rlc ;4 mark/space mode ?
jrnc test$parity$mark ;7/12 yes, go test it
rlc ;4 get odd/even flag
cmc ;4 toggle it
test$odd$even: ;35/
lda recv$bit+2 ;13
aci 0 ;7
ana a ;4
rpe ;5/11
parity$error: ;35
lxi h,RS232$status ;10
setb 4,m ;15 set parity error
ret ;10

;
; T states  36
;
RxD$parity$idle:
lxi h,enter$RxD$stop ;10
shld recv$state+1 ;16
jmp RxD$unque ;10

page
;
; T states   90 if que not in use and DAV is cleared
; T states 149/151 if data placed in que
;
enter$RxD$stop:
lda RS232$status ;13
ani 00100001b ;7 DAV set or data in que?
jrnz place$in$que ;7/12 yes, place new char in que
lda RxD$data ;13 no, place char in data reg.
sta recv$data ;13
lxi h,test$RxD$stop$dav ;10
shld recv$state+1 ;16
ret ;10

;
place$in$que: ;116/118
lxi h,RxD$buf$count ;10
inr m ;11
inr l ;4
mov a,m ;7
inr a ;4
cpi buf$end ;7
jrnz put$buf$ok ;7/12
mvi a,low(RxD$buffer) ;7
put$buf$ok:
mov m,a ;7
mov l,a ;4
RxD$data equ $+1
mvi a,00 ;7
mov m,a ;7
lxi h,test$RxD$stop$que ;10
shld recv$state+1 ;16
ret

page
;
; T states   no errors
; T states   framing error
;
test$RxD$stop$que:
rar ;4
mvi a,00100000b ;7
jmp test$RxD$cont ;10

;
; T states   no errors
; T states   framing error
;
test$RxD$stop$dav:
rar ;4
mvi a,00000001b ;7
test$RxD$cont:
jrc good$RxD$stop ;7/12
ori 00001000b ;7 set framing error
good$RxD$stop:
lxi h,RS232$status ;10
ora m ;7
ani 11111101b ;7 clear recv active flag bit
mov m,a ;7
lxi h,recv$idle ;10
shld recv$state+1 ;16
ret ;10

page
;*
;* T states   stay in idle state
;* T states   exit idle state (recv buffer not full)
;* T states   exit idle state (recv buffer full)
;*
send$idle:
jr send$norm ;12

send$norm:
lda RS232$status ;13
rlc ;4
rnc ;5/11

lxi h,start$send$1 ;10
shld send$state+1 ;16
mvi a,clear$TxD$bit ;7
sta out$rs232$cia ;13 send the start bit
ret ;10

;
; T states   12+118
;
send$x:
xon$xoff$flag equ $+1
mvi a,XON ;7
sta send$bits+1 ;13
xra a ;4
sta send$idle+1 ;13
mvi a,clear$TxD$bit ;7
sta out$rs232$cia ;13 send the start bit
lxi h,RS232$status ;10
setb 6,m ;15 flag send bussy
lxi h,start$xon$xoff ;10
shld send$state+1 ;16
ret ;10

page

;
; T states  107
;
start$send$1:
lda xmit$data ;13
sta send$bits+1 ;13
lxi h,RS232$status ;10
mov a,m ;7
xri 0C0h ;7 clear bit 7 and set bit 6
mov m,a ;7
start$xon$xoff:
lda XxD$config ;13
ani 1 ;7
adi 7 ;7
sta TxD$count ;13
enter$send$bits:
lxi h,start$bit$idle ;10
shld send$state+1 ;16
ret ;10

;
; T states  36
;
start$bit$idle:
lxi h,send$bits ;10
shld send$state+1 ;16
ret ;10

;
; T states  94 data bit low
; T states  92 data bit hi
;
send$bits:
mvi a,00 ;7
rrc ;4
sta send$bits+1 ;13
lxi h,count$TxD ;10
shld send$state+1 ;16
send$TxD: ;42/44
mvi a,set$TxD$bit ;7
jrc send$hi$bit ;7/12
mvi a,clear$TxD$bit ;7
send$hi$bit:
sta out$rs232$cia ;13
ret ;10

;
; T states   if more data bits to send
; T states   if done sending bits
;
count$TxD:
lxi h,TxD$count ;10
dcr m ;11
jrnz enter$send$bits ;7/12
lxi h,TxD$parity$wait ;10
shld send$state+1 ;16
ret ;10

page
;
; T states  36
;
TxD$parity$wait:
lxi h,TxD$parity ;10
shld send$state+1 ;16
ret ;10

;
;
; T states   85 if no parity
; T states  124 if mark parity
; T states  126 if space parity
; T states  136 if even parity
; T states  129 if odd parity
;
TxD$parity:
lda XxD$config ;13
rlc ;4
jrnc TxD$stop ;7/(12+56)
lxi h,TxD$parity$idle$1 ;10
shld send$state+1 ;16
rlc ;4
jrnc send$mark$space ;7/(12+16+42/44)
rlc ;4
lda send$bits+1 ;13
aci 0 ;7
ana a ;4
mvi a,set$TxD$bit ;7
jpo send$TxD$parity ;10
mvi a,clear$TxD$bit ;7
send$TxD$parity:
sta out$rs232$cia ;13
ret ;10
;
send$mark$space:
rlc ;4
jr send$TxD ;12+42/44

;
; T states  36
;
TxD$parity$idle$1:
lxi h,TxD$parity$idle$2 ;10
shld send$state+1 ;16
ret ;10

;
; T states  36
;
TxD$parity$idle$2:
lxi h,TxD$stop ;10
shld send$state+1 ;16
ret ;10

page
;
; T states   103/101
;
TxD$stop:
lxi h,TxD$stop$idle ;10
shld send$state+1 ;16

mvi a,set$TxD$bit ;7
sta out$rs232$cia ;13

lda XxD$config ;13
ani 2 ;7
jrnz one$stop$bit ;7/12
mvi a,5 ;7
one$stop$bit:
inx h ;6
mov m,a ;7
ret ;10

;
; T states  35/90
;
TxD$stop$idle:
mvi a,00 ;7
dcr a ;4
sta TxD$stop$idle+1 ;13
rnz ;5/11
lxi h,RS232$status ;10
res 6,m ;15
lxi h,send$idle ;10
shld send$state+1 ;16
ret ;10

   endif
page
;
;
;
Key$Scan$State:
jr scan$CIA ;12

;
; T states no new key down
; T states state change
; T states   new key down
;
scan$CIA:
stc ;4
mvi a,11111110b ;7    data field updated by code
lxi b,key$row ;10
outp a ;12
cpi 11111111b ;7
jrz extra$3 ;7/12 carry=0 if A=11111111
ral ;4
sta scan$CIA+1+1 ;13
lxi h,key$scan$tbl ;10   get current new table pointer
inr c ;4    point to KEY$COL (input)
jmp cont$read ;10
;
extra$3:
ral ;4
sta scan$CIA+1+1 ;13
mvi a,scan$VIC-scan$CIA ;7
sta Key$Scan$State+1 ;13
ret ;10

page
;
; T states   no new key and no state change
;
scan$VIC:
mvi a,11101110b ;7
lxi h,key$scan$tbl ;10   get current new table pointer
lxi b,vic$key$row ;10
outp a ;12
rlc ;4
sta scan$VIC+1 ;13
jrnc normal$8 ;7/12
lxi b,key$col ;10
cont$read:
inp a ;12   0FFh if no key down
inr m ;11
mov l,m ;7
mov b,m ;7    get old value in B
mov m,a ;7    save new value
xra b ;4    get differances
ana b ;4    test for only new keys down
rz ;5/11
sta matrix$byte ;13
lxi h,key$found ;10
shld key$state+1 ;16
ret ;10
;
;
normal$8:
; mvi a,scan$CIA-scan$CIA ;7
xra a ;4
sta Key$Scan$State+1 ;13
mov m,l ;7    reset current table pointer
lxi h,Key$Repeat$State ;10
shld key$state+1 ;16
ret ;10

page
;
; T states   48 repeat not active
; T states  124 testing repeat (key realeased)
; T states  110 testing repeat (not found)
; T states  109 testing repeat (found)
;
Key$Repeat$State:
lxi h,flash$wait ;10
shld key$state+1 ;16
repeat$count equ $+1
mvi a,00 ;7
ora a ;4
rz ;5/11
lxi h,repeat$count ;10
dcr a ;4    yes, test for repeat yet
jrnz not$repeat$yet ;7/(12+(42/56))
;
; the following 4 lines of code may NOT be changed.
; CONF.COM looks for them to change the repeat rate.
; also looks for RET ; MVI A,xx ; STA xxxx (see set$key$parm)
;
mvi m,3 ;10
lxi h,save$key ;10
shld key$state+1 ;16
ret ;10
;
not$repeat$yet: ;42/56
mov m,a ;7
matrix$pos equ $+1
lda Key$scan$tbl ;13
repeat$mask equ $+1
mvi b,00 ;7
ana b ;4    key still down? (A=0)
rz ;5/11 yes, exit for now
mvi m,0 ;10
ret ;10

page
;
; T states  101 flash
; T states   72 no flash
;
flash$wait:
mvi a,01 ;7
dcr a ;4
sta flash$wait+1 ;13
jrnz no$flash ;7/(13+36)

mvi a,5 ;7
sta flash$wait+1 ;13
lxi h,flash ;10
shld key$state+1 ;16
ret ;10

;*
;*
;* T states 135 if cursor off screen
;* T states 119 if cursor  on screen
;*
flash:
lda force$map ;13
sta bank$0 ;13
mov b,a ;4
;
; toggle 40 column screen cursor on/off
;
lhld flash$pos ;16
xra a ;4 clear A
ora h ;4 return if H=0
jrz exit$flash ;7/12
mov a,m ;7
xri 80h ;7
mov m,a ;7
exit$flash:
mov a,b ;4
sta force$map ;13
no$flash:
lxi h,Key$Scan$State ;10
shld key$state+1 ;16
ret ;10

page
;
;
;
key$found: ;148/138/157/147/166/156/161/167
matrix$byte equ $+1
mvi b,00 ;7
mov a,b ;4
ani 11110000b ;7
jz check$low$4 ;10+(138/128/133/139)
ani 11000000b ;7
jrz check$5$and$4 ;7/(12+(110/100))
ani 10000000b ;7
mvi c,6 ;7
jrnz is$add$1 ;7/(12+70)
mvi a,01000000b ;7
jr is$common ;12+66
;
check$5$and$4: ;110/100
mov a,b ;4
ani 00100000b ;7
mvi c,4 ;7
jrnz is$add$1 ;7/(12+70)
mvi a,00010000b ;7
jr is$common ;12+66
;
;
check$low$4: ;138/128/133/139
mov a,b ;4
ani 00001111b ;7
jrz exit$found ;7/12
ani 00001100b ;7
jrz check$1$and$0 ;7/12+(96/102)
ani 00001000b ;7
mvi c,2 ;7
jrnz is$add$1 ;7/(12+70)
mvi a,00000100b ;7
jr is$common ;12+66
;
check$1$and$0: ;
mov a,b ;4
ani 00000010b ;7
mvi c,0 ;7
jrnz is$add$1 ;7/(12+70)
inr a ;4    set A=1
jr is$common ;12+66
;
;
is$add$1: ;70
inr c ;4
is$common: ;66
sta mask$value ;13
mov a,c ;4
sta bit$value ;13
lxi h,key$found$2 ;10
shld key$state+1 ;16
ret ;10
;
exit$found:
lxi h,Key$Scan$state ;10
shld key$state+1 ;16
ret ;10

page
;
; T states
;
key$found$2:
lxi h,matrix$byte ;10
mask$value equ $+1
mvi a,00 ;7
xra m ;7   clear current bit
mov m,a ;7
bit$value equ $+1
mvi b,00 ;7
lxi h,key$scan$tbl ;10  get the pointer
mov a,m ;7
sub l ;4   remove the bias
dcr a ;4   then one extra (pointer)
add a ;4
add a ;4
add a ;4   shift left 3 bits
add b ;4   add in bit position
sta key$code ;13  save as the key code
lxi h,remove$special$keys ;10
shld key$state+1 ;16
ret ;10

page
;
; T states   if not a shift of control key
; T states  68/82/96 if cntr / rt_shift / lf_shift
;
remove$special$keys:
lxi h,key$found ;10
lda key$code ;13
cpi 38h+2 ;7    control key pressed ?
jrz bad$key ;7/12
cpi 30h+4 ;7
jrz bad$key ;7/12
cpi 08h+7 ;7
jrz bad$key ;7/12

lxi h,set$key$parm ;10
bad$key:
shld key$state+1 ;16
ret ;10

;
; T states
;
; do not change the next 2 lines. CONF uses them to
; the set repeat rate. (also RET above here)
;
set$key$parm:
mvi a,8 ;7
sta repeat$count ;13  number of counts for repeat
lda key$scan$tbl ;13
sta matrix$pos ;13
lda mask$value ;13
sta repeat$mask ;13
lxi h,build$cntr$byte ;10
shld key$state+1 ;16
ret ;10

;
; T states  
;
build$cntr$byte:
lda key$scan$tbl+1+7 ;13  get control byte row
cma ;4
ani 04h ;7   test control key bit
jrz not$control ;7/12
mvi a,7 ;7
not$control:
mov b,a ;4
lda key$scan$tbl+1+6 ;13  get rigth shift byte row
cma ;4
ani 10h ;7   test right key bit
ora b ;4
mov b,a ;4
lda key$scan$tbl+1+1 ;13  get left shift byte row
cma ;4
ani 80h ;7   test left key bit
ora b ;4
mov b,a ;4
ani 90h ;7   either shift key down?
mov a,b ;4
jrz no$shift ;7/12 no, jump
ori 2 ;7    yes, set shift control bit
no$shift:
sta ctrl$byte ;13
lxi h,save$key ;10
shld key$state+1 ;16
ret ;10

page
;
;
; NOTE: character buffer MUST be on one page
; (and have even number of bytes)
;
; buffer is FULL when data at put pointer does not equal 0ffh
; insert new character at (put pointer)
; and character control byte at (put pointer)+1
;
; T states 38 if buffer is full
; T states 146/148
;
save$key:
lhld key$put$ptr ;16   get put pointer
mov a,m ;7    get byte from buffer
inr a ;4    room in buffer? (-1 if so)
rnz ;5/11 no, wait for room in buffer
key$code equ $+1
mvi m,00 ;10   get matrix position
inr l ;4
ctrl$byte equ $+1
mvi a,00 ;7
mov m,a ;7
inr l ;4
mov a,l ;4
cpi low(key$buffer+key$buf$size) ;7
jrnz put$ptr$ok ;7/12
mvi a,low(key$buffer) ;7
put$ptr$ok:
sta key$put$ptr ;13  adjust the low byte of the put ptr
lxi h,Key$tick ;10
shld key$state+1 ;16
ret ;10
;
; T states
;
key$tick:
lxi b,sid+24 ;10
lda tick$vol ;13
outp a ;12
mvi c,low(sid+11) ;7
mvi a,80h ;7
outp a ;12
inr a ;4
outp a ;12
lxi h,key$scan$state ;10
shld key$state+1 ;16
ret ;10

page

;
;_____      _____ _____ _____ _____ _____ _____ _____ _____ _____ __________
;    |     |     |     |     |     |     |     |     |     |     |    |    |
;    |  S  |  0  |  1  |  2  |  3  |  4  |  5  |  6  |  7  |  P  |   stop  |
;    |_____|_____|_____|_____|_____|_____|_____|_____|_____|_____|    |    |_
;
;
;  Reciever State Machine
;
;
;_____      _____ _____ _____ _____ _____ _____ _____ _____ _____ __________
;    |     |     |     |     |     |     |     |     |     |     |    |    |
;    |  S  |  0  |  1  |  2  |  3  |  4  |  5  |  6  |  7  |  P  |   stop  |
;    |_____|_____|_____|_____|_____|_____|_____|_____|_____|_____|    |    |_
;
;
;  Transmitter State Machine (TSM)
;
;

;
;  Keyboard Scan State Machine (KSSM)
;


[Blacklord]

cxio.asm

Code Select Expand

;
title 'C128 BIOS, main I/O and sys functions     28 Apr 86'

;
; This module contains CXIO,CXINIT,CXMOVE and CXTIME.
;
maclib cpm3

maclib z80

maclib cxequ

maclib modebaud


public ?init,?ldccp,?rlccp

public ?user,?di$int

extrn ?sysint

bdos equ 5

extrn @civec,@covec,@aivec,@aovec,@lovec
extrn ?bnksl

public ?cinit,?ci,?co,?cist,?cost
public @ctbl
extrn ?kyscn

; Utility routines in standard BIOS
extrn ?wboot ; warm boot vector
extrn ?pmsg ; print message @ up to 00
; saves &
extrn ?pdec ; print binary number in from 0 to 99.
extrn ?pderr ; print BIOS disk error header
extrn ?conin,?cono ; con in and out
extrn ?const ; get console status

extrn @hour,@min,@sec,@date,?bnksl
public ?time

page
;
; keyboard scanning routine
;
extrn ?get$key,?int$cia
extrn Fx$V$tbl
;
; links to 80 column display
;
extrn ?out80,?int80
extrn ?out40,?int40

extrn ?pt$i$1101,?pt$o$1,?pt$o$2
extrn ?convt
; extrn ?pt$s$1101

;
; bios8502 function routines
;
public ?fun65

;
;
;
public ?intbd
extrn ?int65,?in65,?ins65,?out65,?outs65

; cseg
;trace:
; xthl ; save hl on stack
; push psw
; call ?pmsg ; DE and BC saved by ?pmsg
; pop psw
; xthl
; ret
;
; CSEG
;disp$A:
; push psw ;;;test
; ani 0fh ;;;test
; adi 90h ;;;test
; daa ;;;test
; aci 40h ;;;test
; daa ;;;test
; sta low$test ;;;test
; pop psw ;;;test
; rar ;;;test
; rar ;;;test
; rar ;;;test
; rar ;;;test
; ani 0fh ;;;test
; adi 90h ;;;test
; daa ;;;test
; aci 40h ;;;test
; daa ;;;test
; sta hi$test ;;;test
; call trace ;;;test
;hi$test: ;;;test
; db 31 ;;;test
;low$test: ;;;test
; db 31 ;;;test
; db ' ' ;;;test
; db 0 ;;;test
; ret ;;;test
;
page

DSEG
?fun65:
sta vic$cmd ; save the command passed in A
   if not use$6551
fun$di$wait:
lda RS232$status
ani 11000010b ; char to Xmit, Xmiting or receiving ?
jrnz fun$di$wait ; yes, wait for int to clean up
   endif
di
lda force$map ; get current MMU configuration
push psw ; save it
sta io$0 ; make I/O 0 current

lxi d,1 ; D=0,  E=1
   if use$fast
lxi b,VIC$speed
inp a
sta sys$speed
outp d ; set slow mode (1 2 MHz Z80)
   endif
lxi b,page$1$h
outp d
dcr c
outp e ; page 1, 0-1
dcr c
outp d
dcr c
outp d ; page 0, 0-0
call enable$6502+6 ; go run the 8502
mvi c,low(page$1$h)
outp e
dcr c
outp e ; page 1, 1-1
dcr c
outp e
dcr c
outp d ; page 0, 1-0
   if use$fast
lxi b,VIC$speed
lda sys$speed ; get desired system speed
outp a ; set speed (2 or 4 MHz Z80)
   endif
pop psw ; recover the MMU config.
sta force$map ; restore it
ei ; turn interrupts back on
lda vic$data ; get command results
ora a ; set the zero flag if A=0
ret

?di$int:
   if not use$6551
push psw
di$int$1:
lda RS232$status ; character to Xmit or currently
ani 11000010b ; ..transmitting or receiving ?
jrnz di$int$1 ; yes, wait for int to clean up
pop psw
   endif
di
ret

page
;
; set up the MMU for CP/M Plus
;
DSEG ; init done from banked memory
?init:
mvi a,3eh ; force MMU into I/O space
sta force$map ;
lxi h,mmu$table+11-1 ; table of 11 values
lxi b,mmu$start+11-1 ; to to MMU registers
mvi d,11 ; move all 11 bytes to the MMU

init$mmu$loop:
mov a,m
outp a
dcx h
dcx b
dcr d
jrnz init$mmu$loop

mvi a,1 ; enable track and sector status
sta stat$enable ; on the status line
; mvi a,1 ; no parity, 8 bits, 1 stop bit
sta XxD$config
;
   if use$6551
lxi h,int$6551
   else
lxi h,usart
   endif
shld usart$adr

lxi h,?convt
shld prt$conv$1
shld prt$conv$2

lxi h,Fx$V$tbl
shld key$FX$function
;
; install I/O assignments
;
lxi h,4000h+2000h ; 80 and 40 column drivers
shld @covec
mvi h,80h
shld @civec ; assign console input to keys
mvi h,10h
shld @lovec ; assign printer to LPT:
mvi h,00h
shld @aivec
shld @aovec ; assign rdr/pun port

page
;
; print sign on message
;
call prt$msg ; print signon message
db 'Z'-'@' ; initialize screen pointers
db esc,esc,esc
db purple+50h ; set character color
db esc,esc,esc
db black+60h ; set background (BG) color
db esc,esc,esc
db brown+70h ; set border color
db 'Z'-'@' ; home and clear screen (to BG color)

db lf,lf,lf
    if use$fast
db 'Fast '
    endif

    if use$6551
db '/w 6551 '
    endif

db 'CP/M 3.0'
    if not banked
db ' Non-Banked'
    endif
db ' On the Commodore 128 '
date
warning
db cr,lf
db '          ',0

;
; set CONOUT driver to correct screen
;
lxi h,4000h ; 80 column screen vector
call read$d505
ral
jrnc set$screen
mvi a,'4'
sta screen$num
mvi h,20h ; 40 column screen vector

set$screen:
call prt$msg ; HL saved
screen$num:
db '80 column display',cr,lf,lf,lf,lf,0
shld @covec ; assign console output to CRT: (40/80)

page

;
;
mvi a,-1 ; set block move to NORMAL mode
sta source$bnk
;
; install mode 2 page vectors
;
mvi a,JMP
sta INT$vector ; install a JMP at vector location
lxi h,?sysint
shld INT$vector+1 ; install int$handler adr
;
; A software fix is  required for the lack of hardware to force the
; LSB of the INT vector to 0. If the bus floats INT VECT could be
; read as 0FFh; thus ADRh=I (I=0FCh) ADRl=FF for first read, and
; ADRh=I+1 ADRl=00 for second, to ensure that control is retained
; 0FD00h will also have FDh in it.
;
lxi h,int$block ; FC00h
lxi d,int$block+1 ; FC01h
lxi b,256-1+1 ; interrupt pointer block
mvi m,INT$vector/256 ; high and low are equal (FD)
ldir
mvi a,INT$block/256
stai ; set interrupt page pointer
im2 ; enable mode 2 interrupts

page
;
;
mvi a,vicinit ; null command just to setup BIOS8502
call ?fun65
;
;
;
lda sys$freq ; 0=60Hz 0FFh=50Hz
ani 80h ; 0=60Hz 080h=50Hz
mov l,a ; save in L
lxi b,cia$1+0eh ; point to CRA
inp a ; get old config
ani 7fh ; clear freq bit
ora l ; add in new freq bit
outp a ; set new config

mvi c,8 ; start RTC
outp a

lxi h,date$hex
shld @date ; set date to system data

;
; setup the sound variables
;
lhld key$tbl
lxi d,58*4
dad d
mov e,m
inx h
mov d,m
inx h
xchg
shld sound1 ; H=SID reg 24, L=SID reg 5
xchg
mov e,m
inx h
mov d,m
xchg
shld sound2 ; H=SID reg 6, L=SID reg 1
lxi h,9
dad d
mov e,m
inx h
mov d,m
xchg
shld sound3 ; H=SID reg 4 then L=SID reg 4
;
; set-up key click sound registers
;
lxi b,sid+7
lxi h,0040h
outp l ; (sid+7)=40h
inr c
outp l ; (sid+8)=40h
mvi c,low(sid+12)
outp h ; (sid+12)=0  Attack=2ms, Decay=6ms
inr c
outp h ; (sid+13)=0  Sustain=0,  Release=6ms
mvi a,6
sta tick$vol ; set keyclick volumn level
;
; set up interrupts for key scan (not software usart)
;
   if use$6551
lxi d,2273 ; int at 150 BAUD rate
lxi b,CIA1+timer$b$low ;
outp e ;
inr c ; point to timer$b$high
outp d ;

mvi a,11h ;
mvi c,CIA$ctrl$b ; turn on timer B
outp a ;

lxi b,CIA2+data$b ; setup user port for RS232
inp a ; get old data
ori 6 ; set CTS and DTR
outp a ; update it
   endif
  ret


mmu$table:
mmu$tbl$M

page
;
;
;
CSEG
prt$msg:
xthl
call ?pmsg
xthl
ret


;
; placed in common memory to keep IO from stepping on this code
; always called from bank 0
;
CSEG
read$d505:
sta io$0 ; enable MMU (not RAM)
lxi b,0d505h
inp a ; read 40/80 column screen
sta bank$0 ; re-enable RAM
ret

page
;
;
;
DSEG
   if not use$6551
init$RS232:
di

xra a
sta RS232$status
lxi h,RxD$buf$count ; clear the count
mvi m,0
inr l ; point to RxD$buf$put
mvi m,low(RxD$buffer)
inr l ; point to RxD$buf$get
mvi m,low(RxD$buffer)

lxi h,NTSC$baud$table
lda sys$freq
ora a
jrz use$NTSC
lxi h,PAL$baud$table
use$NTSC:
lda RS232$baud
cpi baud$1200 ; baud rate less then 1200 baud
jrc baud$ok ; yes, go set it
mvi a,baud$1200 ; no, 1200 baud is the max
sta RS232$baud ; (change to 1200 baud)

baud$ok:
mov e,a
mvi d,0
dad d ; +1X
dad d ; +1X
dad d ; +1X = +3X
mov e,m
inx h
mov d,m
inx h ;
mov a,m ; get rate #
sta int$rate ;
lxi b,CIA1+timer$b$low ;
outp e ;
inr c ; point to timer$b$high
outp d ;

mvi a,11h ;
mvi c,CIA$ctrl$b ; turn on timer B
outp a ;

lxi b,CIA2+data$b ; setup user port for RS232
inp a ; get old data
ori 6 ; set CTS and DTR
outp a ; update it
ei
ret

page
;
; NTSC rates (1.02273 MHz)
;
NTSC$baud$table:
dw 6818 ; no baud rate (6666.47)
db 1
dw 6818 ; 50 6666.7us (6666.47)
db 1
dw 4545 ; 75 4444.4us (4443.99)
db 1
dw 3099 ; 110 3030.3us (3030.13)
db 1
dw 2544 ; 134 2487.6us (2487.46)
db 1
dw 2273 ; 150 2222.2us (2222.48)
db 2
dw 1136 ; 300 1111.1us (1110.75)
db 3
dw 568 ; 600 555.6us ( 555.38)
db 6
dw 284 ; 1200 277.8us ( 277.69)
db 12

;
; PAL rates (0.98525 MHz)
;
PAL$baud$table:
dw 6568 ; no baud rate  (6666.32)
db 1
dw 6568 ; 50 6666.7us (6666.32)
db 1
dw 4379 ; 75 4444.4us (4444.56)
db 1
dw 2986 ; 110 3030.3us (3030.70)
db 1
dw 2451 ; 134 2487.6us (2487.69)
db 1
dw 2189 ; 150 2222.2us (2221.77)
db 2
dw 1095 ; 300 1111.1us (1111.39)  300*3
db 3
dw 547 ; 600  555.6us ( 555.19)  600*3
db 6
dw 274 ; 1200    277.8us ( 278.10) 1200*3
db 12

page
;
;
;
out$RS232:
call out$st$RS232
jrz out$RS232
mov a,c
sta xmit$data ; get character to send in A
lxi h,RS232$status
setb 7,m ; set Xmit request bit
ret

;
;
;
out$st$RS232:
lda RS232$status
ani 80h ; bit 8 set if busy
xri 80h ; A cleared if busy (=80h if not)
rz
ori 0ffh ; A=ff if ready (not busy)
ret

;
;
;
in$RS232:
call in$st$RS232
jrz in$RS232
lda recv$data
lxi h,RS232$status
res 0,m
ret

;
;
;
in$st$RS232:
lda RS232$status
ani 1
rz
ori 0ffh ; set data ready (-1)
ret
   endif
page
;
; this routine is used to provide the user with a method
; of interfacing with low level system functions
;
CSEG
;
; input:
; all registers except HL and A are passed to function
;
; output:
; all resisters from function are preserved
;
?user:
shld user$hl$temp
xchg
shld de$temp ; save DE for called function

mov e,a ; place function number in E
mvi a,num$user$fun-1 ; last legal function number

call vector ; function
usr$tb: dw read$mem$0 ; 0
dw write$mem$0 ; 1
dw ?kyscn ; 2
dw do$rom$fun ; 3  (L=function #)
dw do$6502$fun ; 4  (L=function #)
dw read$d505 ; 5  returns MMU reg in A
dw code$error ; not 0 to 5 ret version number in HL

num$user$fun equ ($-usr$tb)/2

page
;
; address in DE is read and returned in C
; A=0 if no error
;
DSEG
read$mem$0:
ldax d ; read location addressed by DE
mov c,a ; value returned in C
xra a ; clear error flag
ret

;
; address in DE is written to with value in C
; A=0 if no errors
;
write$mem$0:
mvi a,-1 ; get error flag and 0ffh value
cmp d ; do not allow write from FF00 to FFFF
;   this is 8502 space, MMU direct reg.
rz
mov a,d
cpi 10h ; do not allow write from 0000 to 0FFF
;   this is ROM space
mvi a,-1 ; get error flag
rc ; return if 00h to 0fh
mov a,c
stax d
xra a ; clear error flag
ret

page
;
; This is the function code entry point for direct execution
; of driver functions. If the MSB of the function number is
; set, the 40 column driver is used; else the 80 column drive
; is used.
;
do$rom$fun:
lhld user$hl$temp ; get HL (L=fun #)

mvi a,7eh ; only allow even functions
ana l
cpi 79h
jrc no$hl$req
lhld @dma ; HL will be passed in @dma by
push h ; ..the user
no$hl$req:
mov l,a
rst 5 ; call rom functon (RCALL) L=fun #
ret

; mvi a,7eh ; only allow even functions
; ana l
; sta no$hl$req+1
; cpi 79h
; jrc no$hl$req
; lhld @dma ; HL will be passed in @dma by
; push h ; ..the user
;no$hl$req:
; will be changed to RCALL xx   RET for next release (ROM FN 7A, 7C
; and 7E will not function with current code, they expect
; a return address on the stack
;
; RJMP 5Eh ; unused function, real fun# installed
; ..above

do$6502$fun:
lhld user$hl$temp
mov a,l
jmp ?fun65
;
;
;
code$error:
lxi h,date$hex
mvi a,-1
ret

page
;
;
;
CSEG
?rlccp:
lxi h,ccp$buffer
lxi b,0c80h

load$ccp:
sta bank$0
mov a,m
sta bank$1
lxi d,-ccp$buffer+100h
dad d
mov m,a
lxi d,ccp$buffer-100h+1
dad d
dcx b
mov a,b
ora c
jrnz load$ccp
ret

page
;
;
;
CSEG
?ldccp:
xra a
sta ccp$fcb+15 ; zero extent
lxi h,0
shld fcb$nr ; start at beginning of file
lxi d,ccp$fcb
call open ; open file containing CCP
inr a
jrz no$CCP ; error if no file...
lxi d,0100h
call setdma ; start of TPA
Š lxi d,128
call setmulti ; allow up to 16K bytes
lxi d,ccp$fcb
call read

lxi h,0100h
lxi b,0c80h
lda force$map
push psw

;
;
save$ccp:
sta bank$1
mov a,m
sta bank$0
lxi d,ccp$buffer-100h
dad d
mov m,a
lxi d,-ccp$buffer+100h+1
dad d
dcx b
mov a,b
ora c
jrnz save$ccp

pop psw
sta force$map
ret

page
;
; The following code does not work with the NEW MMU
;
;?ldccp:
; xra a
; sta ccp$fcb+15 ; zero extent
; lxi h,0
; shld fcb$nr ; start at beginning of file
; lxi d,ccp$fcb
; call open ; open file containing CCP
; inr a
;
;; trace jz below should be jrz
; jz no$CCP ; error if no file...
;
; lda fcb$rc ; get the record count
; sta ccp$count ; save for later
; lxi d,0100h
; call setdma ; start of TPA
Š; lxi d,128
; call setmulti ; allow up to 16K bytes
; lxi d,ccp$fcb
; call read
;
; lxi d,1f0h ; point to buffer
; ; bank 1, page F0
;; lxi h,101h ; point to CCP (in TPA)
; ; bank 1, page 01
; mov h,d
; mov l,d
; jr save$ccp
;
;
;
;
;?rlccp:
; lda ccp$count ;
; sui 30 ; we can only save 30 records
; jp ?ldccp
;
; lxi h,1F0h ; point to buffer
; ; bank 1, page F0
;; lxi d,101h ; point to TPA space
; ; bank 1, page 01
; mov d,h
; mov e,h
;
;save$ccp:
; mvi b,15 ; number of pages in buffer
;ccp$move$loop:
; push h
; push d
; push b
; call do$move$0$to$1
; pop b
; pop d
; pop h
; inx h
; inx d
; djnz ccp$move$loop
;
; ret
;
;
;do$move$0$to$1:
; call set$0$and$1
; call move$0$to$1
; lxi h,100h ; bank 1 page 0
;; lxi d,101h ; bank 1 page 1
; mov d,h
; mov e,h
;;
;;
;;
;set$0$and$1:
; lda force$map ; get current map
; sta io ; force to i/o in bank 0
; lxi b,page$0$l ; point to 1st page register
; outp l ; set page 0 low
; inr c
; outp h ; set page 0 high
; inr c
; outp e ; set page 1 low
; inr c
; outp d ; set page 1 high
; sta force$map
; ret
;
;;
;;
;;
;move$0$to$1:
; lda force$map
; sta bank$1 ; force bank 1 memory
; lxi h,000h ; source
; lxi d,100h ; dest.
;; lxi b,100h
; mov b,d
; mov c,e ; count
; ldir
; sta force$map
; ret
;
page
;
;
;
no$CCP: ; here if we couldn't find the file
call prtmsg ; report this...
db cr,lf,'BIOS Err on A: No CCP.COM file',0
call ?conin ; get a response
jr ?ldccp ; and try again

;
; CP/M BDOS Function Interfaces
;
CSEG
open:
mvi c,15 ; open file control block

db 21h ; lxi h,(mvi c,26)
setdma:
mvi c,26 ; set data transfer address

db 21h ; lxi h,(mvi c,44)
setmulti:
mvi c,44 ; set record count

db 21h ; lxi h,(mvi c,20)
read:
mvi c,20 ; read records
jmp bdos

;   12345678901
ccp$fcb db 1,'CCP     COM',0,0,0
fcb$rc db 0
ds 16
fcb$nr db 0,0,0


page
;
; CXIO.ASM and CXEM.ASM
;
;==========================================================
; ROUITINE TO VECTOR TO HANDLER
;==========================================================
; CP/M IO routines b=device : c=output char : a=input char
;
CSEG
;
;
;
?cinit: ; initialize usarts
mov b,c
call vector$io ; jump with table adr on stack
number$drivers:
dw ?int$cia ; keys
dw ?int80 ; 80col
dw ?int40 ; 40col
dw ?pt$i$1101 ; prt1
dw ?pt$i$1101 ; prt2
dw ?int65 ; 6551
   if not use$6551
dw init$RS232 ; software RS232
   endif
dw rret ;
max$devices equ (($-number$drivers)/2)-1

;
;
;
?ciº » characteò input
call vector$io ; jump with table adr on stack
dw key$board$in ; keys
dw rret ; 80col
dw rret ; 40col
dw rret ; ptr1
dw rret ; prt2
dw ?in65 ; 6551
   if not use$6551
dw in$RS232 ; software RS232
   endif
dw null$input

;
;
;
?cist: ; character input status
call vector$io ; jump with table adr on stack
dw key$board$stat ; keys
dw rret ; 80col
dw rret ; 40col
dw rret ; prt1
dw rret ; prt2
dw ?ins65 ; 6551
   if not use$6551
dw in$st$RS232 ; software RS232
   endif
dw rret

;
;
;
?co: ; character output
call vector$io ; jump with table adr on stack
dw rret ; keys
dw ?out80 ; 80col
dw ?out40 ; 40col
dw ?pt$o$1 ; prt1
dw ?pt$o$2 ; prt2
dw ?out65 ; 6551
   if not use$6551
dw out$RS232 ; software RS232
   endif
dw rret

;
;
;
?cost: ; character output status
call vector$io ; jump with table adr on stack
dw ret$true ; keys
dw ret$true ; 80col
dw ret$true ; 40col
dw ret$true ; prt1 ?pt$s$1101
dw ret$true ; prt2
dw ?outs65 ; 6551
   if not use$6551
dw out$st$RS232 ; software RS232
   endif
dw ret$true

page
;
; This entry does not care about values of DE
;
vector$io:
mvi a,max$devices ; check for device # to high
mov e,b ; get devive # in E
;
;
; INPUT:
; Vector # in E, Max device in A
; passes value in DE$TEMP in DE
; HL has routine's address in it on entering routine
;
; OUTPUT:
; ALL registers of returning routine are passed
;
vector:
pop h ; get address vector list
mvi d,0 ; zero out the MSB
cmp e ; is it too high?
jrnc exist ; no, go get the handler address

mov e,a ; yes, set to max$dev$handler(last one)
exist:
dad d ;
dad d ; point into table

  mov a,m
inx h
mov h,m
mov l,a ; get routine adr in HL

    if banked
shld hl$temp ; save exec adr
lxi h,0
dad sp
lxi sp,bios$stack
push h ; save old stack

lhld de$temp
xchg
lhld hl$temp ; recover exec adr

lda force$map ; get current bank
push psw ; save on stack
sta bank$0 ; set bank 0 as current

call ipchl

sta a$temp ; save value to return
pop psw
sta force$map ; set old bank back
lda a$temp ; recover value to return

shld hl$temp
pop h ; recover old stack
sphl ; set new stack
lhld hl$temp
ret

ipchl:
pchl ; jmp to handler

ds 30h
bios$stack:

    else
lda a$temp
xchg
lhld de$temp
xchg
pchl
    endif

page
;==========================================================
; CHARACTER INPUT ROUTINES
;==========================================================

DSEG
;
;
;
key$board$in:
call key$board$stat ; test if key is available
jrz key$board$in

lda key$buf
push psw ; save on stack
xra a ; clear key
sta key$buf
;
;** the tracking of the display should be able to be turned off
;** this could be done with one of the keyboard's Fx codes
;
lda stat$enable
bit 6,a
jrnz no$update
lda char$col$40
mov b,a
lda @off40
cmp b
jrnc do$update
adi 39-1
cmp b
jrnc no$update
do$update:
mvi a,80h
sta old$offset ; store 80h to demand update
no$update:
pop psw ; recover current key
rret:
ret

;
;
;
null$input: ; return a ctl-Z for no device
mvi a,1Ah
ret


page

;==========================================================
; CHARACTER DEVICE INPUT STATUS
;==========================================================

DSEG
;
;
;
key$board$stat:
lda key$buf
ora a
jrnz ret$true

call ?get$key
ora a ; =0 if none
rz ; return character not advailable

sta key$buf ; was one, save in key buffer

ret$true:
ori 0ffh ; and return true
ret

page

cseg
@ctbl
db 'KEYS  ' ; device 0, internal keyboard
db mb$input
db baud$none

db '80COL ' ; device 1, 80 column display
db mb$output
db baud$none

db '40COL ' ; device 2, 40 column display
db mb$output
db baud$none

db 'PRT1  ' ; device 3, serial bus printer (device 4)
db mb$output
db baud$none

db 'PRT2  ' ; device 4, serial bus printer (device 5)
db mb$output
db baud$none

db '6551  ' ; device 5, EXT CRT
db mb$in$out+mb$serial+mb$softbaud+mb$xonxoff
?intbd:
db baud$1200
   if not use$6551
db 'RS232 ' ; device 6, software RS232 device
db mb$in$out+mb$serial+mb$xonxoff+mb$softbaud
RS232$baud:
db baud$300
   endif
db 0 ; mark end of table

page
;
; TIME.ASM
;
cseg
;
; HL and DE must be presevered
;
?time:
inr c
lxi b,cia$hours
jrz set$time
;
; update SCB time  (READ THE TIME)
;
inp a ; read HR (sets sign flag)
jp is$am ; jmp if AM (positive)
ani 7fh
adi 12h ; noon=24(PM), midnight=12(AM)
daa
cpi 24h ; check for noon (12+12 PM)
jrnz set$hr
mvi a,12h
jr set$hr

is$am:
cpi 12h ; check for midnight (AM)
jrnz set$hr
xra a ; becomes 00:00
set$hr:
sta @hour
mov b,a
lda old$hr
mov c,a
mov a,b
sta old$hr
cmp c ; if @hour jrnc same$day
 
push h
lhld @date
inx h
shld @date
pop h

same$day:
lxi b,cia$hours-1
inp a ; read MIN
sta @min

dcr c
inp a ; read SEC
sta @sec

dcr c
inp a ; read 1/10 of SEC (a must to free
ret ; the holding register)

old$hr:
ds 1

page
;
;
;
set$time
lda @hour
sta old$hr
cpi 12h ; test for noon
jrz set$as$is
ana a ; test for 00:xx
jrnz not$zero$hundred
mvi a,80h+12h ; set to midnight
jr set$as$is

not$zero$hundred:
  cpi 11h+1 ; test for 1 to 11 AM
jrc set$as$is
sui 12h
daa ; decimal adjust
set$msb:
ori 80h ; set PM

set$as$is:
outp a
dcr c
lda @min
outp a
dcr c
lda @sec
outp a
dcr c
xra a
outp a
ret

page
;
; CXMOVE.ASM
;
public ?move,?xmove,?bank

;
; Move a block of data from DE to HL
; count is in BC (within current bank)
;
;
cseg ; place code in common
?move:
xchg ;*
lda source$bnk ; =FFh if normal block move
inr a ;
jrnz inter$bank$move

LDIR ;* do block move
xchg ;*
ret


;
;
;
?xmove: ; can be in bank 0
mov a,c
sta source$bnk
mov a,b
sta dest$bnk
ret ;*

page
;
;
;
inter$bank$move:
shld @buffer ; save HL TEMP
lxi h,0
dad sp
lxi sp,bios$stack
push h ; save old stack  ;**1
lhld @buffer

inter$bank$move$1:
mov a,b ; get msb of count
ora a
jrz count$less$than$256
push b ; save the count  ;**2
push d ; save the dest   ;**3
lxi d,@buffer ; make buffer the dest
lxi b,256 ; move 256 bytes
lda source$bnk
call ?bank
ldir ; move source to buffer

pop d ; recover dest    ;**2
push h ; save updated source ;**3
lxi h,@buffer ; make the buffer the source
lxi b,256 ; move 256 bytes
lda dest$bnk
call ?bank
ldir ; move buffer to dest
 
pop h ; recover updated source ;**2
pop b ; recover count          ;**1
dcr b ; subtract 256 from count
jr inter$bank$move$1

page
;
;
;
count$less$than$256:
ora c ; BC=0  [A (0) or'ed with C]
  jrz exit$move

push d ; save count for 2nd half  ;**2
push b ; save dest adr            ;**3
lxi d,@buffer
lda source$bnk
call ?bank
ldir ; move source to buffer

pop b ; recover count  ;**2
pop d ; recover dest  ;**1
push h ; save updated dest  ;**2
lxi h,@buffer
lda dest$bnk
call ?bank
ldir ; move buffer to dest
pop h   ;**1
;
;
;
exit$move:
xchg
mvi a,-1
sta source$bnk ; set MOVE back to normal
lda @cbnk

shld @buffer
pop h ; recover old stack ;**0
sphl
lhld @buffer

; call ?bank ; set current bank
; ret

page
;
; switch bank to bank number in A
;
cseg ; (must be in common)
?bank:
   if banked
ora a ; bank 0 ?
jrnz not$bank$0 ; go check for bank 1

sta bank$0 ; set bank 0
ret

;
;
not$bank$0:
dcr a ; bank 1 ?
rnz ; if not a valid bank just return
sta bank$1 ; set bank 1
   endif
ret

end

[Blacklord]

cxkey.asm

Code Select Expand

title 'C128 keyboard handler   18 Feb 86'

maclib cxequ

maclib z80

public ?get$key,?int$cia,?kyscn
public Fx$V$tbl

extrn ?stat,?save,?recov
extrn ?dskst

extrn ?di$int

extrn cmdsk0,cmdsk1,cmdsk2,cmdsk3,cmdsk4

extrn @pageM

extrn adm31
public setadm

  if use$VT100
extrn vt100
public setvt
  endif

page

DSEG
;
;
;
?int$cia:
lxi b,key$row ; point to CIA 1st register
mvi a,0ffh
outp a
inr c
inr c
outp a
inr c
xra a
sta commodore$mode ; clear commodore shift mode
outp a


lxi h,key$scan$tbl ; init key scan tbl pointer
mov m,l ; ..to the begining
;
; initialize keyboard buffer and pointers
;
lxi h,key$buffer
shld key$get$ptr
shld key$put$ptr
mvi m,0ffh
lxi d,key$buffer+1
lxi b,key$buf$size-1
ldir
ret

page
;==========================================================
; KEYBOARD SCANNING FUNCTION
;==========================================================
;
;
;
;
?get$key:
lhld msgptr
mov a,h
ora l
jrnz mess$cont

;
;
;
re$scan:
call scan$keys
push psw

mov a,c
ani special
cpi special ; control and rt. shift key
jrnz not$special

mov a,b ; get the matrix position
cpi rt$arrow
jz prog$fun

cpi lf$arrow
jz prog$key

cpi alt$key
jz toggle$plain$keys

;
;
;
not$special:
pop psw
mov d,a
lda stat$enable
ani 80h ; mask off plain keys bit
mov a,d ; recover input character
rnz ; return if plain keys bit is set

page
;
;
;
test$function:
cpi 080h ; check for MSB set
rc ; return if not

cpi 0A0h ; 80-9F are function keys
jrnc not$8x

;
;
find$mess:
ani 1fh ; 32 messages
mov b,a ; place Function # in B for search
call get$fun$adr

;
;
mess$cont:
mov b,m ; get char to B
inx h
mov a,m
ora a
jrnz more$mess

lxi h,0

more$mess:
shld msg$ptr
mov a,b
mvi c,0 ; no control keys
mvi b,0f0h ; tell user this is a function key
ora a ; check character (maybe 1st is 0)
jrz re$scan ; scan keys (no valid function key)

jrnz test$function ; test for local function

page
;
;
;
get$fun$adr:
lhld fun$tbl ; get adr of msg table
dcx h
; lxi h,msgtbl-1 ; point to start of funtions (less one)
inr b ; adjust function # (to test for 0)
xra a ; get a zero in A
check$fun$num:
inx h ; advance pointer to point at text
shld msg$ptr ; save message adr for caller
dcr b ; requested function ?
rz ; yes, exit with HL=string adr

find$end$marker:
cmp m ; end of text marker ? (0=EOTM)
jrz check$fun$num ; yes, go see if required fun #

inx h ; advance to next char
jr find$end$marker ; go find EOTM

page
;
; A0-AF Set char color (80 col)
; B0-B1 Set background color (80 col)
;
not$8x:
cpi 0C0h ;
jrnc not$80col$color

sui 0A0h-20h ; remove key bias
mov b,a
RCALL FR$color
jr ?get$key

;
; C0-CF Set char color (40 col)
; D0-DF Set background color (40 col)
; E0-EF Set border color (40 col)
;
not$80col$color:
cpi 0F0h
jrnc must$be$Fx
;
;
;
sui 0C0h-20h ; remove key bias
mov b,a
RCALL FR$color+FR$40
jr ?get$key

page
;
; F0-FF special code functions
;                  
must$be$Fx:
lxi h,?get$key
push h ; save as the return adr
ani 0fh
add a ; double
lhld key$FX$function
mov e,a
mvi d,0
dad d ; HL points to the function
mov e,m
inx h
mov d,m
xchg
pchl

;
;
;
FX$V$tbl:
dw toggle$dsk$stat ; F0
dw display$pause ; F1
dw toggle$track$40 ; F2
dw cur$lf ; F3
dw cur$rt ; F4
dw reset$mfm ; F5
  if use$VT100
dw set$adm ; F6
dw set$VT ; F7
  else
dw empty ; F6
dw empty ; F7
  endif
dw empty ; F8
dw empty ; F9
dw empty ; FA
dw empty ; FB
dw empty ; FC
dw empty ; FD
dw empty ; FE

dw 0 ; FF go restart the C128 BASIC
; mode (or C64)


; dw screen$print$40 ; would be nice later
; dw screen$print$80

page
;
; Function F0
;
toggle$dsk$stat:
lda stat$enable
xri 1
sta stat$enable

ani 1
jnz ?dskst ; go paint the disk status line

;
; erase 80 column window from display
;
mvi e,8
lxi b,20h*256+(80-8) ; get a space start in col 80-8
erase$loop:
push d ; save count
push b ; save space and position
xra a ; get no attributes
call ?stat ; update screen
pop b ; recover space and position
inr c ; advance position
pop d ; recover count
dcr e ; decrement count
jrnz erase$loop ; loop until done

;
; erase 40 column window from display
;
RJMP FR$screen$paint

page
;
; Function F1
;
display$pause:
mvi a,-1
sta cur$pos ; move cursor out of window

lxi b,buff$small*256+buff$pos ; B=size C=pos
call ?save
mvi a,buff$pos+1
sta offset
mvi b,5
lxi h,pause$MSG

pause$disp$loop:
mov a,m
push h
push b
call disp$status
pop b
pop h
inx h
djnz pause$disp$loop

pause$loop:
call scan$keys
jrz pause$loop
cpi cr ; pause key function code
jrnz pause$loop
jmp recov$small


pause$MSG:
db 'Pause'


page
;
; Function F2
;
; A Zero in bit 6 of STAT$ENABLE will enable tracking
; the cursor on data input with the 40 column display
;
toggle$track$40:
lda stat$enable
xri 40h
sta stat$enable
empty:
ret



page
;
; Function F3
;
; Move 40 column window left one positions
;
cur$lf:
lda @off40
ora a
rz

dcr a
jr cur$update$cont







;
; Function F4
;
; Move 40 column window right one position
;
cur$rt:
lda @off40
cpi 40
rz
inr a
cur$update$cont:
sta @off40
RCALL FR$set$cur$40
RJMP FR$screen$paint

;
; Function F5
;
; Unlock MFM selection for ALL drives in the system
;
reset$mfm:
lda cmdsk0+42 ; 42 is the offset from drive pointer
ani 7fh ; MSB cleared to unlock the drive
sta cmdsk0+42 ; unlock drive A
lda cmdsk1+42
ani 7fh
sta cmdsk1+42 ; unlock drive B
lda cmdsk2+42
ani 7fh
sta cmdsk2+42 ; unlock drive C
lda cmdsk3+42
ani 7fh
sta cmdsk3+42 ; unlock drive D
lda cmdsk4+42
ani 7fh
sta cmdsk4+42 ; unlock drive E
ret

;
; Function F6
;
set$adm:
lxi h,ADM31
  if use$vt100
jr set$emulation

;
; Function F7
;
set$VT:
lxi h,VT100
set$emulation:
  endif
shld emulation$adr
ret

;
;
; THIS CODE IS NOT FUNCTIONAL YET
;
;toggle$page$break:
; lda @pageM
; xri 0ffh
; sta @pageM
; rz
; mvi a,-1
; sta @pageM


page
;
; A zero in the MSB of the STAT$ENABLE byte will allow
; special keyboard function. (codes above 80h)
; A one will force the key value to be returned without
; any special functions being executed.
;
toggle$plain$keys:
pop psw ; remove garbage

lda stat$enable
xri 80h
sta stat$enable
jmp re$scan

page
;
;
;
prog$key:
pop psw ; remove garbage

lxi b,buff$small*256+buff$pos ; B=size, C=position
call ?save

mvi a,buff$pos+1
sta offset
call read$key ; get key to re-program
push h ; save key's address
mov a,m
call disp$hex$byte
mvi a,buff$pos+4
sta offset
call get$byte
pop h
jrc restore$buf$small
mov m,a
;
;
restore$buf$small:
call delay
recov$small:
lxi b,buff$small*256+buff$pos ; B=size, C=position
jmp ?recov

page
;
;
;
prog$fun:
pop psw ; remove garbage

lxi b,buff$large*256+buff$pos ; b=size, c=pos
call ?save

call read$key ; get function key to program
cpi 80h
jrc restore$buf$large ; error, exit

cpi 0A0h
jrnc restore$buf$large

ani 1fh ; 32 keys defined
mov b,a
call get$fun$adr ; get pointer to function code

xra a
sta string$index ; start at start of string

call edit$fun

lxi h,0
shld msg$ptr ; clear message pointer

restore$buf$large:
call delay
lxi b,buff$large*256+buff$pos ; B=size, C=position
jmp ?recov

page
;
;
;
delay:
lxi h,0
delay$loop:
dcx h
mov a,h
ora l
jrnz delay$loop
ret
;
;
;
edit$fun:
lxi h,edit$fun
push h ; set return to here
call disp$fun$key
call read$key ; B=matrix position
mov d,a ; save ASCII char in D
mov a,c ; get attr (C=cntr codes)
ani special
cpi special ; check for cntr shift
jnz not$cntr$shift


;
;
;
check$exit:
mov a,b ; get matrix position
cpi SF$exit
jrnz check$delete

pop h ; remover return adr
ret ; go back to normal keyboard fun

page
;
;
;
check$delete:
cpi SF$delete
jrnz check$insert
;
; delete the character at current cursor position
;
call compute$adr ; HL= current position
rz ; don't want to delete end markers

xchg ; save in DE
lhld key$tbl ; get next table adr (keytbl)
dcx h
; lxi h,msgtbl$end-1 ; end adr
xra a ; clear the carry flag
dsbc DE ; compute number of bytes to move
mov b,h
mov c,l ; place count in BC
mov h,d
mov l,e ; HL=DE
inx h ;
ldir

dcx h ; point to insert point
mvi m,-1 ; fill table end with -1
ret

page
;
;
;
check$insert:
cpi SF$insert
jrnz check$right
;
; insert a space into string
;
call compute$adr
;
; HL=address to insert a space at
; value of HL is the same on return
;
insert$space:
xchg
lhld key$tbl ; get start of next table
dcx h ; point to end of msg table
; lxi h,msgtbl$end-1
xra a
cmp m ; last char=0 (end of string)
rz ; yes, don't insert

xra a ; clear the carry flag
dsbc DE ; compute number of bytes to move
mov b,h
mov c,l ; place count in BC

lhld key$tbl
dcx h
mov d,h
mov e,l
; lxi d,msgtbl$end-1 ; dest adr
dcx h
; lxi h,msgtbl$end-2 ; source adr
lddr ; move the data
inx h ; point to insert point
adi ' ' ; A was equ to zero, add a space to
mov m,a ; ..clear the zero flag
ret ; insert a space at the new location

page
;
;
;
check$right
cpi SF$right
jrnz check$left
;
; move cursor right
; if past right end go back to left end
;
call compute$adr
lda string$index
jrnz move$rt

mvi a,-1
move$rt:
inr a
sta string$index
ret

;
;
;
check$left:
cpi SF$left
rnz
;
; move cursor left
; if past left end go to right end
;
lda string$index
ora a
jrz at$left$end

dcr a
sta string$index
ret


page
;
;
;
at$left$end:
call compute$adr
rz ; return if at right end

lda string$index
inr a
sta string$index ; move right one position
jr at$left$end ;



;
;
;
not$cntr$shift:
call compute$adr ; HL=function adr (A=0 if string end)
jrnz no$insert

push d ; save char to insert
call insert$space
pop d ; recover character
rz ; no room if zero flag set

no$insert:
mov m,d ; install key's value
lda string$index
inr a
sta string$index
ret

page
;
;
;
compute$adr:
lhld msg$ptr ; get start of memory pointer
lda string$index ; get current offset
add l
mov l,a
mov a,h
aci 0
mov h,a ; point to update location
mov a,m
ora a
ret

;
;
;
disp$fun$key:
mvi a,buff$pos
sta offset
mvi a,'>' ; display start prompt '>'
call disp$status

lhld msg$ptr
lda string$index

try$again:
cpi buff$large-2
jrc parameters$ok

inx h
dcr a
jr try$again

page
;
;
;
parameters$ok:
adi buff$pos+1
sta cur$pos

disp$fun$loop:
mov a,m
ora a
inx h ; advance function pointer
jrz disp$fun$end

push h
call disp$status ; display on status line
pop h
lda offset ; get current cursor position
cpi buff$pos+buff$large-1 ; to end of window?
jrnz disp$fun$loop ; no, display next character


disp$fun$end:
mvi a,'<' ; display end prompt '<'
disp$space$fill:
call disp$status
lda offset ; get current cursor position
cpi buff$pos+buff$large ; to end of window?
rz

mvi a,' ' ; fill to the end with spaces
jr disp$space$fill

page
;
;
;
disp$hex$byte:
push psw
rar
rar
rar
rar
call disp$hex$nibble
pop psw

disp$hex$nibble:
ani 0fh
adi '0'
cpi '9'+1
jrc disp$status

adi 7

disp$status:
mov b,a
lda offset
mov c,a
inr a
sta offset
lda cur$pos
cmp c
mvi a,01000000b ; set reverse video attributes
jrnz not$cur$pos

mvi a,00010000b ; set normal video and blink
not$cur$pos:
jmp ?stat


page
;
;
;
get$byte:
mvi e,0
call read$nibble
rc

add a
add a
add a
add a
mov e,a

read$nibble:
push d
call read$key
mov a,b ; get matrix position
lxi h,hex$key$tbl
lxi b,16
ccir

mov a,c
pop d
stc
rnz

add e
push d
push psw
call disp$hex$nibble
pop psw
pop d
stc
cmc
ret

;
;
;
read$key:
call scan$keys
inr b
jrz read$key ; no, wait for one
dcr b
ret

page
;
;
;
do$alpha$toggle:
mvi m,0ffh ; mark buffer position free
lda commodore$mode
xri 00100001b
ani 00100001b
sta commodore$mode
;
; output:
; B=FF if no key pressed
; A=00 if no key code assigned
; else A=ASCII key code
; B=matrix position (0-57)
; C=control code (bits 1,0)
; 00=lower case (lowest)
; 01=upper case
; 10=shift
; 11=control (highest)
;  (bit 2) control key
;  (bit 4) rt. shift key
;  (bit 5) commodore key
;  (bit 7) lf. shift key
;
; HL= address of ASCII key location
;
?kyscn:
scan$keys:
lhld key$get$ptr
mov a,m ; M=-1 if buffer empty
mov b,a ; B=-1 if no character
inr a
rz ; return if no key is pressed
;
; there is a character in the buffer,
; advance key$get$ptr to next character.
;
mov a,l
adi 2
cpi low(key$buffer+key$buf$size)
jrnz not$buf$end
mvi a,low(key$buffer)
not$buf$end:
sta key$get$ptr ; update low byte of pointer

page
;
; test for commodore key, if found toggle commodore mode
;
mov a,b ; get buffered matrix position to A
cpi alpha$toggle
jrz do$alpha$toggle
;
; if normal mode(00), or in commodore mode bit
;
inr l ; point to control byte
lda commodore$mode
ani 00100000b ; save commodore key set bit
ora m ; get rest of control byte
mov c,a
ani 3
mov a,c
jrnz is$control$or$shift
lda commodore$mode
ora c

is$control$or$shift:
dcr l
mvi m,0ffh ; mark buffer position free

mov l,b ; save matrix position in HL
mvi h,0
dad h
dad h ; mult. matrix position by 4
mov c,a ; save the control code in C for caller
ani 3
add l ; add the offset
mov l,a ; update the pointer
xchg
lhld key$tbl ; get the start of the ASCII table
dad d ; HL now points to the ASCII value
mov a,m ; for the input key.
ora a ; set zero flag if A=0
ret

page
;
; used to convert a keyboard matrix position into it's HEX
; value (keys caps labelled with 0 to 9 and A to F)
;
hex$key$tbl:
db 15h ; F
db 0eh ; E
db 12h ; D
db 14h ; C
db 1ch ; B
db 0ah ; A
db 20h ; 9
db 1bh ; 8
db 18h ; 7
db 13h ; 6
db 10h ; 5
db 0bh ; 4
db 08h ; 3
db 3bh ; 2
db 38h ; 1
db 23h ; 0

[Blacklord]

cxkrnl.asm

Code Select Expand

title 'Root module of relocatable BIOS for CP/M 3.0 28 Aug 85'

; version 1.0 5 Sept 84


maclib cxequ ; C128 equates lib

maclib modebaud ; define mode bits

maclib Z80

;  Copyright (C), 1982
; Digital Research, Inc
;     P.O. Box 579
; Pacific Grove, CA  93950
;
;
;   This is the invariant portion of the modular BIOS and is
; distributed as source for informational purposes only.
; All desired modifications should be performed by
; adding or changing externally defined modules.
; This allows producing "standard" I/O modules that
; can be combined to support a particular system
; configuration.

bell equ 7
ctlQ equ 'Q'-'@'
ctlS equ 'S'-'@'

ccp equ 0100h ; Console Command Processor
; gets loaded into the TPA

page

cseg ; GENCPM puts CSEG stuff in
; common memory

; variables in system data page

extrn @covec,@civec
extrn @aovec
extrn @aivec,@lovec ; I/O redirection vectors
extrn @mxtpa ; addr of system entry point
extrn @bnkbf ; 128 byte scratch buffer

; initialization

extrn ?init ; general initialization and signon
extrn ?ldccp,?rlccp ; load & reload CCP for BOOT & WBOOT

; user defined character I/O routines

extrn ?ci,?co,?cist,?cost ; each take device in
extrn ?cinit ; (re)initialize device in
extrn @ctbl ; physical character device table

; disk communication data items

extrn @dtbl ; table of pointers to XDPHs

; memory control

extrn ?xmove,?move ; select move bank, and block move
extrn ?bank ; select CPU bank

; clock support

extrn ?time ; signal time operation

;; user function

extrn ?user ; special functions

; general utility routines

public ?pmsg ; print message
public ?pdec ; print number from 0 to 65535
public ?pderr ; print BIOS disk error message header


page

; External names for BIOS entry points

public ?boot,?wboot,?const,?conin,?cono,?list,?auxo,?auxi
public ?home,?sldsk,?sttrk,?stsec,?stdma,?read,?write
public ?lists,?sctrn
public ?conos,?auxis,?auxos,?dvtbl,?devin,?drtbl
public ?mltio,?flush,?mov,?tim,?bnksl,?stbnk,?xmov


; BIOS Jump vector.
;
; All BIOS routines are invoked by calling these
; entry points.

?boot: jmp boot ; initial entry on cold start
?wboot: jmp wboot ; reentry on program exit, warm start

?const: jmp const ; return console input status
?conin: jmp conin ; return console input character
?cono: jmp conout ; send console output character
?list: jmp list ; send list output character
?auxo: jmp auxout ; send auxilliary output character
?auxi: jmp auxin ; return auxilliary input character

?home: jmp home ; set disks to logical home
?sldsk: jmp seldsk ; select disk drive, return disk parameter info
?sttrk: jmp settrk ; set disk track
?stsec: jmp setsec ; set disk sector
?stdma: jmp setdma ; set disk I/O memory address
?read: jmp read ; read physical block(s)
?write: jmp write ; write physical block(s)

?lists: jmp listst ; return list device status
?sctrn: jmp sectrn ; translate logical to physical sector

?conos: jmp conost ; return console output status
?auxis: jmp auxist ; return aux input status
?auxos: jmp auxost ; return aux output status
?dvtbl: jmp devtbl ; return address of device def table
?devin: jmp ?cinit ; change baud rate of device

?drtbl: jmp getdrv ; return address of disk drive table
?mltio: jmp multio ; set multiple record count for disk I/O
?flush: jmp flush ; flush BIOS maintained disk caching

?mov: jmp ?move ; block move memory to memory
?tim: jmp ?time ; Signal Time and Date operation
?bnksl: jmp bnksel ; select bank for code execution
; and default DMA
?stbnk: jmp setbnk ; select different bank for disk
; I/O DMA operations.
?xmov: jmp ?xmove ; set source and destination banks
; for one operation

jmp ?user ; reserved for future expansion
jmp 0 ; reserved for future expansion
jmp 0 ; reserved for future expansion

page
;
; BOOT
; Initial entry point for system startup.

dseg ; this part can be banked
boot:
lxi sp,boot$stack
mvi c,15 ; initialize all 16 character devices
c$init$loop:
push b
call ?cinit
pop b
dcr c
jp c$init$loop

call ?init ; perform any additional system initialization
; and print signon message
lxi b,16*256+0
lxi h,@dtbl ; init all 16 logical disk drives
d$init$loop:
push b ; save remaining count and abs drive
mov e,m
inx h
mov d,m
inx h ; grab @drv entry
mov a,e
ora d
jrz d$init$next ; if null, no drive

push h ; save @drv pointer
xchg ; XDPH address in
dcx h
dcx h
mov a,m
sta @RDRV ; get relative drive code
mov a,c
sta @ADRV ; get absolute drive code
dcx h ; point to init pointer
mov d,m
dcx h
mov e,m ; get init pointer
xchg
call ipchl ; call init routine
pop h ; recover @drv pointer
d$init$next:
pop b ; recover counter and drive #
inr c
djnz d$init$loop ; and loop for each drive
jmp boot$1

cseg ; following in resident memory
boot$1:
call set$jumps
call ?ldccp ; fetch CCP for first time
jmp ccp

page

; WBOOT
; Entry for system restarts.

wboot:
lxi sp,boot$stack
call set$jumps ; initialize page zero
call ?rlccp ; reload CCP
jmp ccp ; then reset jmp vectors and exit to ccp


set$jumps:

 if banked
mvi a,1
call ?bnksl
 endif

mvi a,JMP
sta 0
sta 5 ; set up jumps in page zero
lxi h,?wboot
shld 1 ; BIOS warm start entry
lhld @MXTPA
shld 6 ; BDOS system call entry
ret


ds 64
boot$stack equ $

page
;
; DEVTBL
; Return address of character device table
devtbl:
lxi h,@ctbl
ret

;
; GETDRV
; Return address of drive table
getdrv:
lxi h,@dtbl
ret


;
; CONOUT
; Console Output.  Send character in
; to all selected devices
conout:
lhld @covec ; fetch console output bit vector
jmp out$scan


;
; AUXOUT
; Auxiliary Output. Send character in
; to all selected devices
auxout:
lhld @aovec ; fetch aux output bit vector
jmp out$scan


;
; LIST
; List Output.  Send character in
; to all selected devices.
list:
lhld @lovec ; fetch list output bit vector

out$scan:
mvi b,0 ; start with device 0
co$next:
dad h ; shift out next bit
jrnc not$out$device
push h ; save the vector
push b ; save the count and character
not$out$ready:
call coster
ora a
jrz not$out$ready
pop b
push b ; restore and resave the character and device
call ?co ; if device selected, print it
pop b ; recover count and character
pop h ; recover the rest of the vector
not$out$device:
inr b ; next device number
mov a,h
ora l ; see if any devices left
jrnz co$next ; and go find them...
ret

page
;
; CONOST
; Console Output Status.  Return true if
; all selected console output devices
; are ready.
conost:
lhld @covec ; get console output bit vector
jr ost$scan


;
; AUXOST
; Auxiliary Output Status.  Return true if
; all selected auxiliary output devices
; are ready.
auxost:
lhld @aovec ; get aux output bit vector
jr ost$scan


;
; LISTST
; List Output Status.  Return true if
; all selected list output devices
; are ready.
listst:
lhld @lovec ; get list output bit vector

ost$scan:
mvi b,0 ; start with device 0
cos$next:
dad h ; check next bit
push h ; save the vector
push b ; save the count
mvi a,0FFh ; assume device ready
cc coster ; check status for this device
pop b ; recover count
pop h ; recover bit vector
ora a ; see if device ready
rz ; if any not ready, return false
inr b ; drop device number
mov a,h
ora l ; see if any more selected devices
jrnz cos$next
ori 0FFh ; all selected were ready, return true
ret

coster: ; check for output device ready,
; including optional xon/xoff support
mov l,b
mvi h,0 ; make device code 16 bits
push h ; save it in stack
dad h
dad h ; create offset into device
dad h ; characteristics tbl
lxi d,@ctbl+6
dad d ; make address of mode byte
mov a,m
ani mb$xonxoff
pop h ; recover console number in
jz ?cost ; not a xon device, go get output status direct
lxi d,xofflist
dad d ; make pointer to proper xon/xoff flag
call cist1 ; see if this keyboard has character
mov a,m
cnz ci1 ; get flag or read key if any
cpi ctlq
jrnz not$q ; if its a ctl-Q,
mvi a,0FFh ; set the flag ready
not$q:
cpi ctls
jrnz not$s ; if its a ctl-S,
mvi a,00h ; clear the flag
not$s:
mov m,a ; save the flag
call cost1 ; get the actual output status,
ana m ; and mask with ctl-Q/ctl-S flag
ret ; return this as the status

cist1: ; get input status with and saved
push b
push h
call ?cist
pop h
pop b
ora a
ret

cost1: ; get output status, saving &
push b
push h
call ?cost
pop h
pop b
ora a
ret

ci1: ; get input, saving &
push b
push h
call ?ci
pop h
pop b
ret

page
;
; CONST
; Console Input Status.  Return true if
; any selected console input device
; has an available character.
const:
lhld @civec ; get console input bit vector
jr ist$scan


;
; AUXIST
; Auxiliary Input Status.  Return true if
; any selected auxiliary input device
; has an available character.
auxist:
lhld @aivec ; get aux input bit vector

ist$scan:
mvi b,0 ; start with device 0
cis$next:
dad h ; check next bit
mvi a,0 ; assume device not ready
cc cist1 ; check status for this device
ora a
rnz ; if any ready, return true
inr b ; drop device number
mov a,h
ora l ; see if any more selected devices
jrnz cis$next
xra a ; all selected were not ready, return false
ret

page
;
; CONIN
; Console Input.  Return character from first
; ready console input device.
conin:
lhld @civec
jr in$scan


; AUXIN
; Auxiliary Input.  Return character from first
; ready auxiliary input device.
auxin:
lhld @aivec

in$scan:
push h ; save bit vector
mvi b,0
ci$next:
dad h ; shift out next bit
mvi a,0 ; insure zero a  (nonexistant device not ready).
cc cist1 ; see if the device has a character
ora a
jrnz ci$rdy ; this device has a character
inr b ; else, next device
mov a,h
ora l ; see if any more devices
jrnz ci$next ; go look at them
pop h ; recover bit vector
jr in$scan ; loop til we find a character

ci$rdy:
pop h ; discard extra stack
jmp ?ci

page

; Utility Subroutines


?pmsg: ; print message @ up to a null
; saves &
push b
push d
pmsg$loop:
mov a,m
ora a
jrz pmsg$exit
mov c,a
push h
call ?cono
pop h
inx h
jr pmsg$loop
pmsg$exit:
pop d
pop b
ret

?pdec: ; print binary number 0-65535 from
lxi b,table10
lxi d,-10000
next:
mvi a,'0'-1
pdecl:
push h
inr a
dad d
jrnc stoploop
inx sp
inx sp
jr pdecl
stoploop:
push d
push b
mov c,a
call ?cono
pop b
pop d
nextdigit:
pop h
ldax b
mov e,a
inx b
ldax b
mov d,a
inx b
mov a,e
ora d
jrnz next
ret

table10:
dw -1000,-100,-10,-1,0


?pderr:
lxi h,drive$msg
call ?pmsg ; error header
lda @adrv
adi 'A'
mov c,a
call ?cono ; drive code
lxi h,track$msg
call ?pmsg ; track header
lhld @trk
call ?pdec ; track number
lxi h,sector$msg
call ?pmsg ; sector header
lhld @sect
jr ?pdec ; sector number (call/ret)


;
; BNKSEL
; Bank Select.  Select CPU bank for further execution.
bnksel:
sta @cbnk ; remember current bank
jmp ?bank ; and go exit through users
; physical bank select routine


xofflist:
db -1,-1,-1,-1,-1,-1,-1,-1 ; ctl-s clears to zero
db -1,-1,-1,-1,-1,-1,-1,-1



dseg ; following resides in banked memory



; Disk I/O interface routines
;
; SELDSK
; Select Disk Drive.  Drive code in .
; Invoke login procedure for drive
; if this is first select.  Return
; address of disk parameter header
; in
seldsk:
mov a,c
sta @adrv ; save drive select code
mov l,c
mvi h,0
dad h ; create index from drive code
lxi b,@dtbl
dad b ; get pointer to dispatch table
mov a,m
inx h
mov h,m
mov l,a ; point at disk descriptor
ora h
rz ; if no entry in table, no disk
mov a,e
ani 1
jrnz not$first$select ; examine login bit
push h
xchg ; put pointer in stack &
lxi h,-2
dad d
mov a,m
sta @RDRV ; get relative drive
lxi h,-6
dad d ; find LOGIN addr
mov a,m
inx h
mov h,m
mov l,a ; get address of LOGIN routine
call ipchl ; call LOGIN
pop h ; recover DPH pointer
not$first$select:
ret

page
;
; HOME
; Home selected drive.  Treated as SETTRK(0).
home:
lxi b,0 ; same as set track zero


;
; SETTRK
; Set Track. Saves track address from
; in @TRK for further operations.
settrk:
mov l,c
mov h,b
shld @trk
ret


;
; SETSEC
; Set Sector.  Saves sector number from
; in @sect for further operations.
setsec:
mov l,c
mov h,b
shld @sect
ret


;
; SETDMA
; Set Disk Memory Address.  Saves DMA address
; from in @DMA and sets @DBNK to @CBNK
; so that further disk operations take place
; in current bank.
setdma:
mov l,c
mov h,b
shld @dma
lda @cbnk ; default DMA bank is current bank
; fall through to set DMA bank

;
; SETBNK
; Set Disk Memory Bank.  Saves bank number
; in @DBNK for future disk data
; transfers.
setbnk:
sta @dbnk
ret

page
;
;
; SECTRN
; Sector Translate.  Indexes skew table in
; with sector in .  Returns physical sector
; in .  If no skew table (=0) then
; returns physical=logical.
sectrn:
mov l,c
mov h,b
mov a,d
ora e
rz
xchg
dad b
mov l,m
mvi h,0
ret

page
;
; READ
; Read physical record from currently selected drive.
; Finds address of proper read routine from
; extended disk parameter header (XDPH).
read:
lhld @adrv
mvi h,0
dad h ; get drive code and double it
lxi d,@dtbl
dad d ; make address of table entry
mov a,m
inx h
mov h,m
mov l,a ; fetch table entry
push h ; save address of table
lxi d,-8
dad d ; point to read routine address
jr rw$common ; use common code


;
; WRITE
; Write physical sector from currently selected drive.
; Finds address of proper write routine from
; extended disk parameter header (XDPH).
write:
lhld @adrv
mvi h,0
dad h ; get drive code and double it
lxi d,@dtbl
dad d ; make address of table entry
mov a,m
inx h
mov h,m
mov l,a ; fetch table entry
push h ; save address of table
lxi d,-10
dad d ; point to write routine address

rw$common:
mov a,m
inx h
mov h,m
mov l,a ; get address of routine
pop d ; recover address of table
dcx d
dcx d ; point to relative drive
ldax d
sta @rdrv ; get relative drive code and post it
inx d
inx d ; point to DPH again
ipchl:
pchl ; leap to driver

page
;
; MULTIO
; Set multiple sector count. Saves passed count in
; @CNT
multio:
sta @cnt
ret

;
; FLUSH
; BIOS deblocking buffer flush.  Not implemented.
flush:
xra a
ret ; return with no error


;
; error message components
;
drive$msg: db cr,lf,bell,'BIOS Error on ',0
track$msg: db ': T-',0
sector$msg: db ', S-',0


end

[Blacklord]

cxkycode.asm

Code Select Expand

title 'CXKYCODE-  function and key def file   26 May 85'


maclib cxequ

number$blks equ 4 ; 256 byte blocks
def$per$key equ 4
key$tbl$size equ 11*8*def$per$key
color$tbl$size equ 16

;
; default Function keys and key definition
;
org sys$key$area

dw ascii$tbl-2

msgtbl: db 'F1',0
db 'F2',0
db 'dir',cr,0
db 'dir ',0
db 'F5',0
db 'F6',0
db 'F7',0
date
db 5,18h,cr,0 ; ^E ^X ^D
db 'F9',0
db 'F10',0
db 'F11',0
db 0f3h,0f3h,0f3h,0f3h,0f3h,0f3h,0f3h,0f3h,0f3h,0f3h
db 0f3h,0f3h,0f3h,0f3h,0f3h,0f3h,0f3h,0f3h,0f3h,0f3h,0
db 0f4h,0f4h,0f4h,0f4h,0f4h,0f4h,0f4h,0f4h,0f4h,0f4h
db 0f4h,0f4h,0f4h,0f4h,0f4h,0f4h,0f4h,0f4h,0f4h,0f4h,0
db 0f3h,0f3h,0f3h,0f3h,0
db 0f4h,0f4h,0f4h,0f4h,0
db 'F16',0
db 'F17',0
db 'F18',0
db 'F19',0
db 'F20',0
db 'F21',0
db 'F22',0
db 'F23',0
db 'F24',0
db 'F25',0
db 'F26',0
db 'F27',0
db 'F28',0
db 'F29',0
db 'F30',0
db 'F31',0
db 'Help ',0


msg$size equ $-msgtbl

rept (number$blks*256)-msg$size-key$tbl$size-color$tbl$size
db 0ffh
endm

page

ascii$tbl:
db 7fh,7fh,7fh,16h ; INS DEL
db 0dh,0dh,0dh,0dh ; RETURN
db 06h,06h,01h,01h ; LF RT
db 86h,86h,87h,87h ; F7 F8
db 80h,80h,81h,81h ; F1 F2
db 82h,82h,83h,83h ; F3 F4
db 84h,84h,85h,85h ; F5 F6
db 17h,17h,17h,1ah ; UP DOWN

db 33h,33h,23h,0A2h ; 3 #
db 77h,57h,57h,17h ; W
db 61h,41h,41h,01h ; A
db 34h,34h,24h,0A3h ; 4 $
db 7ah,5ah,5ah,1ah ; Z
db 73h,53h,53h,13h ; S
db 65h,45h,45h,05h ; E
db 00h,00h,00h,00h ; (lf shift)

db 35h,35h,25h,0A4h ; 5 %
db 72h,52h,52h,12h ; R
db 64h,44h,44h,04h ; D
db 36h,36h,26h,0A5h ; 6 &
db 63h,43h,43h,03h ; C
db 66h,46h,46h,06h ; F
db 74h,54h,54h,14h ; T
db 78h,58h,58h,18h ; X

db 37h,37h,27h,0A6h ; 7 '
db 79h,59h,59h,19h ; Y
db 67h,47h,47h,07h ; G
db 38h,38h,28h,0A7h ; 8 (
db 62h,42h,42h,02h ; B
db 68h,48h,48h,08h ; H
db 75h,55h,55h,15h ; U
db 76h,56h,56h,16h ; V

db 39h,39h,29h,00h ; 9 )
db 69h,49h,49h,09h ; I
db 6ah,4ah,4ah,0ah ; J
db 30h,30h,30h,00h ; 0
db 6dh,4dh,4dh,0dh ; M
db 6bh,4bh,4bh,0bh ; K
db 6fh,4fh,4fh,0fh ; O
db 6eh,4eh,4eh,0eh ; N

db 2bh,2bh,2bh,00h ; +
db 70h,50h,50h,10h ; P
db 6ch,4ch,4ch,0ch ; L
db 2dh,2dh,2dh,00h ; -
db 2eh,2eh,3eh,00h ; . >
db 3ah,3ah,5bh,7bh ; : [ {
db 40h,40h,40h,00h ; @
db 2ch,2ch,3ch,00h ; , <

db 23h,23h,23h,60h ; pound `
db 2ah,2ah,2ah,00h ; *
db 3bh,3bh,5dh,7dh ; ; ] }
db 00h,00h,00h,0f5h ; clear/home
db 00h,00h,00h,00h ; (rt shift)
db 3dh,3dh,3dh,7eh ; = ~
db 5eh,5eh,7ch,7ch ; ^ PI |
db 2fh,2fh,3fh,5ch ; / ? \

db 31h,31h,21h,0A0h ; 1
db 5fh,5fh,5fh,7fh ; <-
db 09h,15h,30h,00h ; (CONTROL) sound1 sound2
db 32h,32h,22h,0A1h ; 2 "
db 20h,20h,20h,00h ; Space
db 21h,20h,00h,00h ; (Commodore) sound3
db 71h,51h,51h,11h ; Q
db 00h,00h,00h,0f0h ; RUN STOP

db 9fh,9fh,9fh,9fh ; /HELP/
db 38h,38h,38h,0B7h ; /8/
db 35h,35h,35h,0B4h ; /5/
db 09h,09h,09h,00h ; /TAB/
db 32h,32h,32h,0B1h ; /2/
db 34h,34h,34h,0B3h ; /4/
db 37h,37h,37h,0B6h ; /7/
db 31h,31h,31h,0B0h ; /1/

db 1bh,1bh,1bh,00h ; /ESC/
db 2bh,2bh,2bh,0F7h ; /+/   (select VT100)
db 2dh,2dh,2dh,0F6h ; /-/ (select ADM31)
db 0Ah,0Ah,0Ah,0Ah ; /Line Feed/
db 0dh,0dh,0dh,0ffh ; /ENTR/
db 36h,36h,36h,0B5h ; /6/
db 39h,39h,39h,00h ; /9/
db 33h,33h,33h,0B2h ; /3/

db 00h,00h,00h,00h ; /Alt/
db 30h,30h,30h,00h ; /0/
db 2eh,2eh,2eh,00h ; /./
db 05h,05h,05h,12h ; /UP/
db 18h,18h,18h,03h ; /DN/
db 13h,13h,13h,08dh ; /LF/
db 04h,04h,04h,08eh ; /RT/
db 0f1h,0f1h,0f1h,0f2h ; /no scroll/

;
; logical color table (used with ESC ESC ESC char)
; (where char is 50h to 7fh)
;
db 000h,011h,022h,033h
db 044h,055h,066h,077h
db 088h,099h,0aah,0bbh
db 0cch,0ddh,0eeh,0ffh

[Blacklord]

cxprinte.asm

Code Select Expand

title 'CXPRINTER    Commodore printer drivers    4 Dec 85'

maclib z80

maclib cxequ

public ?PT$I$1101,?PT$O$1,?pt$o$2
public ?convt
; public ?PT$S$1101

extrn ?fun65

;
; printer output in register C
;
dseg
?pt$o$2:
lhld prt$conv$2
call do$convt ; C must be unchanged A=desired code
lxi h,prt$buf$2
mvi b,5
jr prt$cont

do$convt:
mov a,c ; A=desired code
mvi c,7 ; C=secondary address
pchl ; HL,DE and B may be used

?pt$o$1:
lhld prt$conv$1
call do$convt
lxi h,prt$buf$1
mvi b,4
;
;
;
prt$cont:
inr m
mov e,m
mvi d,0
xchg
dad d ; index into buffer
mov m,a
xchg
; ani 7Fh ; strip MSB
cpi lf ; data a CR ?
jrz print$it ; yes, go print this line
mov a,m ; no, get current line length
cpi prt$buf$lng-1 ; reach end yet ?
rnz ; no, exit
; yes, print line of data
print$it:
mov a,m
sta vic$count ; set number of bytes to send
mvi m,0 ; set count back to zero
inx h
shld @buffer ; save location to print from

mov a,b
sta vic$drv ; pass device # in Vic$drv
mov a,c
sta vic$trk ; pass secondary adr in Vic$trk

mvi a,vic$prt
jmp ?fun65
;
;
;
?convt$none:
mvi c,0 ; set secondary adr to 0
ret
;
;
;
?convt:
ani 7fh ; only allow real ASCII values for now
cpi cr
jrz set$msb
cpi '"'
jrz is$quote
cpi '@'
rc

cpi 60h
jrc make$upper$case
;
; if it is a lower case letter subtract 20h
;
cpi 'z'+1
jrnc lower$symbols

sui 20h
ret

lower$symbols:
adi 60h
ret
;
;
make$upper$case:
cpi 'Z'+1
jrnc upper$symbols
set$msb:
adi 80h
ret

;
;
is$quote:
mvi a,27h ; convert to tick (shifted 7)
ret

;
;
upper$symbols:
cpi '\'
rnz ;
mvi a,0ffh
;
; printer initialization code
;
?pt$i$1101:
ret


;
; printer status code
;
dseg
;?pt$s$1101:
; ret


prt$buf$lng equ 81

prt$buf$1: ds prt$buf$lng
prt$buf$2: ds prt$buf$lng

[Blacklord]

cxramdsk.asm

Code Select Expand

;
title 'C128 Ram Disk support  14 Oct 85'


; maclib cpm3

maclib z80

maclib cxequ



; Utility routines in standard BIOS
extrn ?pmsg ; print message @ up to 00
; saves &
extrn ?pdec ; print binary number in from 0 to 99.
extrn ?pderr ; print BIOS disk error header
extrn ?conin,?cono ; con in and out
extrn ?const ; get console status
extrn @dtbl ; DMA ram bank

public RMdsk

extrn ?fun65
extrn ?dkmov

page
;
CSEG ; place code in common memory

;
; Extended Disk Parameter Headers (XPDHs)
;
dw RM$write
dw RM$read
dw RM$login
dw RM$init
db 0 ; relative drive zero
db 0 ; format type byte
RMdsk: ; dph 0,dpb$RM$512
dw 0 ; TRANSLATE TABLE ADDRESS
db 0,0,0,0,0,0,0,0,0 ; BDOS SCRATCH AREA
      db 0 ; MEDIA FLAG
DPB$ptr:
dw dpb$RM$512 ; DISK PARAMETER BLOCK
dw 00000h ; CHECKSUM VECTOR ALLOCATED BY
dw 0FFFEh ; ALLOC VECTOR ALLOCATED BY GENCPM
dw 0FFFEh ; DIRBCB
dw 0FFFEh ; DTABCB
dw 0FFFEh ; HASH ALLOC'D
db 0 ; HASH BANK


                ;
                ; DPB FOR RAM disk
                ;

dpb$RM$128: ; dpb 256,1,512,1024,64,0
DW 0002 ; 128 BYTE RECORDS PER TRACK
DB 03,07 ; BLOCK SHIFT AND MASK
DB 00 ; EXTENT MASK
DW 007Fh ; MAXIMUM BLOCK NUMBER
DW 003Fh ; MAXIMUM DIRECTORY ENTRY NUMBER
DB 0C0h,00h ; ALLOC VECTOR FOR DIRECTORY
DW 8000h ; CHECKSUM SIZE
DW 0 ; OFFSET FOR SYSTEM TRACKS
DB 1,1 ; PHYSICAL SECTOR SIZE SHIFT

dpb$RM$512: ; dpb 256,1,2048,2048,128,0
DW 0002 ; 128 BYTE RECORDS PER TRACK
DB 04,0Fh ; BLOCK SHIFT AND MASK
DB 01 ; EXTENT MASK
DW 00FFh ; MAXIMUM BLOCK NUMBER
DW 007Fh ; MAXIMUM DIRECTORY ENTRY NUMBER
DB 0C0h,00h ; ALLOC VECTOR FOR DIRECTORY
DW 8000h ; CHECKSUM SIZE
DW 0 ; OFFSET FOR SYSTEM TRACKS
DB 1,1 ; PHYSICAL SECTOR SIZE SHIFT

page
;
;
;
dseg
RM$write:
mvi d,VIC$RM$wr
lda @dbnk ; get disk bank
ana a
lhld @dma
jrz RM$do$rd$wr
call ?dkmov+3 ; A<>0 transfers data from local$DMA to buffer
mvi d,VIC$RM$wr
jr RM$do$rd$wr$buf
;
;
;
RM$read:
mvi d,VIC$RM$rd
lda @dbnk ; get disk bank
ana a ; is it bank zero
lhld @dma
jrz RM$do$rd$wr ; yes, go read it

call RM$do$rd$wr$buf ; no,  transfer through buffer
lhld @dma
call ?dkmov+3 ; A=0 transfers data from buffer to local$DMA
xra a
ret
;
;
;
RM$do$rd$wr$buf:
lxi h,@buffer
RM$do$rd$wr:
lxi b,RM$128$low
outp l
inr c ; RM$128$mid
outp h
inr c ; RM$ext$low
xra a
outp a
lhld @trk
inr c ; RM$ext$mid
outp l
inr c ; RM$ext$hi
outp h
lxi h,256
inr c ; RM$count$low
outp l
inr c ; RM$count$hi
outp h
mov a,d ; get rd/wr command
call ?fun65
xra a ; set no errors
ret

page
;
;
;
dseg
RM$init:
lxi b,RM$control
xra a
outp a ; increment both addresses
dcr c ; point to interrupt control register
outp a ; disable interrupts

lxi h,0 ; point to track 0
shld @trk
xra a
sta @dbnk ; set DMA bank to zero
lxi h,@buffer ;
shld @dma

test$device$present:
mov m,l ; place a pattern in the directory
inr l ; ..buffer area
jrnz test$device$present ;

call RM$read ; read track 0 to DMA buffer
lxi h,@buffer ; ..(buffer not changed if
lxi d,dir$label ; ..device is not present)
lxi b,12 ; test if KEY has been installed
test$next$key:
ldax d
inx d
cci
jrnz no$match ; KEY missing, test device present
jpe test$next$key
jr set$size ; KEY is in RAM DISK, go set size

page
;
; test if device is present, remove vector if not
;
no$match:
mvi l,0 ; start back at the buffer beginning
test$for$ram$dsk:
mov a,m
cmp l ; buffer changed?
jrnz device$is$present ; yes, then device is present
inr l ; no, buffer end?
jrnz test$for$ram$dsk ; no, test rest of buffer
; yes, L=0
;
; device is missing, remove vector
;
mov h,l ; remove vector to RAM disk
shld @dtbl+('M'-'A')*2 ; .. (drive M:)
ret
;
; initialize directory buffer
;
device$is$present:
call init$buffer ; fill buffer with E5`s
lxi h,dir$label
lxi d,@buffer
lxi b,32
ldir ; install directory label in 1st record
lxi h,0
shld @trk ; set track=0

clear$dir:
call RM$write ; erase director sectors
call init$buffer ; fill buffer with E5`s
lda @trk
inr a
sta @trk
cpi 16 ; 16 for 512K Ram disk
jrnz clear$dir

set$size:
lxi h,dpb$RM$128
lxi b,RM$status
inp a
ani 10h ; mask of size bit (0=128K)
jrz set$128K
lxi h,dpb$RM$512
set$128K:
shld dpb$ptr
RM$login:
ret

page
;
;
;
init$buffer:
lxi h,@buffer
mvi m,0E5h
lxi d,@buffer+1
lxi b,256-1
ldir
ret

;
;
;
dir$label: ;123456789012  3 4 5 6
db ' ERTWINE VON',1,0,0,0
dw 0,0,0,0
dw date$hex,0
dw date$hex,0

[Blacklord]

cxrom02.asm

Code Select Expand

page
; *************************************************
; - -
; - BIOS8502 code (for read only) -
; - -
; *************************************************
;
; 10 May 85
;
;      COMMON EQUATES
;
pointer equ 20h

datchn equ 11 ; use data channel #11
cmdchn equ 15 ; use comand channel #15
;
; KERNAL EQUATES
;
serial equ 00A1Ch
D2PRA equ 0DD00h
D1SDR equ 0DC0Ch
D1ICR equ 0DC0Dh
clk$bit equ 10h


K$set$bnk equ 0FF68h

K$setlfs equ 0FFBAh ; setup a logical file
;I A=logical file #
;  X=device # (0-31)
;  Y=seconday command (FF if nane)

K$setnam equ 0FFBDh ; set up file name for OPEN
;I A=name length
;  X=low byte pointer to name
;  Y=high byte pointer to name

K$open equ 0FFC0h ; open a logical file (after SETLFS & SETNAM)
;O A = error # (1,2,4,5,6,240)

K$chkout equ 0FFC9h ; open a channel for output
;I X = logical file #
;O A = error #(0,3,5,7)

K$clrchn equ 0FFCCh ; clears ALL I/O channel

K$chkin equ 0FFC6h ; open a channel for input
;I X = logical file #
;O A = errors #(0,3,5,6)

K$chrin equ 0FFCFh ; get a character from input channel
;O A=input character

K$chrout equ 0FFD2h ; output a character to output channel
;I A =output char

K$clall equ 0FFE7h ; close all open files

K$close equ 0FFC3h ; close a logical file
;I A = logical channel # to be closed
;O A = error #(0,240)

K$readst equ 0FFB7h ; read status byte
;O A = status
PAGE
;
;
; **** THIS IS THE COMMAND LOOP ****
;
boot$02$code:
@lda 0,# ; turn on the kernal
@sta force$map ;
@jmp (0fffch) ; jmp to its start

boot$size equ $-boot$02$code

BB equ bios$02-$ ; BIOS BIAS

;
bios$65$code:
@lda 0,# ;-K
@sta vic$data ;-K
@JSR VICIO+BB ;-K  go find and do requested operation
CMDLP:
@sei
@lda 3eh,# ;?K  set up Z80 memory map as required
@sta force$map ;-K
@jmp enable$z80 ;-K

PAGE
;
;
;
;
; **** IO COMMAND DISPATCH ROUTINE ****
;
VICIO:
@CLD ;-K  clear to binary mode
@LDA vic$cmd ;-K  get the command
@bne read ;-K   0=initialize
;     1=read
page
;
;
;
initilize: ;   initialize the 8502
@ldx 0,# ;-K
@stx force$map ;-K  enable the kernal
@stx VIC+26 ;+K  turn off VIC interrupts

@ldx low(irqs+BB),#
@ldy high(irqs+BB),#
@stx 314h ;+K  IRQ vector
@sty 315h
@stx 316h ;+K  BRK vector
@sty 317h
@stx 318h ;+K  NMI vector
@sty 319h
@jmp opencm+BB ;+K  go open channel to disk drive

PAGE
;
; **** DISK SECTOR READ ****
;
READ:
@lda @dma ;-K
@sta pointer ;-K
@lda @dma+1 ;-K
@sta pointer+1 ;-K

setdrv:
@lda vic$trk ;-K
@sta F$rd$trk+BB ;-K
@JSR BINASC+BB ;-K
@STX dskcmd$T$h+BB ;-K
@STA dskcmd$T$l+BB ;-K

@lda vic$sect ;-K
@sta F$rd$sect+BB ;-K
@JSR BINASC+BB ;-K
@STX dskcmd$S$h+BB ;-K
@STA dskcmd$S$l+BB ;-K

@lda fast ;-K
@bne read$F ;-K
@sta force$map ;-K A=0 if we did not branch
@ldx datchn,# ;+K
@jsr K$chkin ;+K
@bcs disk$changed ;+K
@jsr K$clrchn ;+K  clear the input channel for now

@JSR SETUP+BB ;+K
@JSR CKINDT+BB ;+K

@ldy 0,# ;+K
READ1:
@JSR K$chrin ;+K  get a byte from the KERNAL
@STA (pointer),y ;-K  save it to the DMA pointer
@iny ;+K  advance the buffer pointer
@BNE READ1 ;+K  loop back if not past buf end
@jmp K$clrchn ;+K  CLEAR CHANNEL


DISK$CHANGED:
@lda 0FFh,# ;?K
@skip2

fst$error:
@lda 0dh,#
@sta vic$data ;?K
@jmp CMDLP+BB

;
;
;
read$F:
@lda 0,# ;-K
@sta force$map ;-K
@ldx cmdchn,# ;+K
@jsr K$chkout ;+K
@bcs fst$error ;+K
; @ldx 0,# ;+K
@ldy Fcmd$lng,# ;+K
sendf:
@lda Fcmd$buf+BB-1,y ;+K
@jsr K$chrout ;+K
; @inx
@dey
@bne sendf

@jsr K$clrchn ;+K
@bit D1ICR ;+K
@ldx F$rd$count+BB ;+K
rd$sector:
@jsr read$byte+BB ;+K
@and 0eh,# ;+K  mask off error bits
@bne fst$error

@ldy 0,#
rd$buffer:
@jsr read$byte+BB ;+K
@sta (pointer),y ;+K
@iny ;+K
@bne rd$buffer ;+K

@inc pointer+1 ;+K
@dex ;+K
@bne rd$sector ;+K

clk$hi:
@lda d2pra ;+K
@and 0ffh-clk$bit,# ;+K
@sta d2pra ;+K
@rts ;+K

;
;  * DEVICE MISSING, CLEAN UP ERROR *
;
MISDSK:
@LDA 00fh,# ;+K  SET ERROR CODE
@STA vic$data ;+K  writes to RAM under ROM
@JMP CMDLP+BB ;+K

PAGE
;
; **** OPEN DISK COMMAND CHANNEL ****
;
opencm:
@LDA cmdchn,# ;+K
@CLC ;+K
@JSR K$close ;+K
@LDA cmdchn,# ;+K
@sta fast ;+K set fast flag
@LDX 8,# ;+K
@TAY ;+K
@JSR K$setlfs ;+K

@LDA 0,# ;+K
@sta serial ;+K clear fast serial indicator
@TAX ;+K
@JSR K$set$bnk ;+K

@LDA 4,# ;+K
@LDX low(U0POINT+BB),# ;+K
@LDY high(U0POINT+BB),# ;+K
@JSR K$setnam ;+K
@JSR K$open ;+K
@bcs misdsk

@jsr K$readst
@ROL A ;+K  GET MSB TO CARRY
@BCS MISDSK ;+K  DEVICE MISSING IF CARRY SET
@bit serial ;+K  test for fast device
@bvs no$dt$open ;+K  do not open data channel if fast

page
;
; **** OPEN DISK DATA CHANNEL ****
;
OPENDT:
@LDA datchn,# ;+K
@CLC ;+K
@JSR K$close ;+K
@LDA datchn,# ;+K
@LDX 8,# ;+K
@LDY 8,# ;+K
@JSR K$setlfs ;+K

@LDA 0,# ;+K
@sta fast ;+K  clear fast flag
@TAX ;+K
@JSR K$set$bnk ;+K

@LDA 1,# ;+K
@LDX low(POUND+BB),# ;+K
@LDY high(POUND+BB),# ;+K
@JSR K$setnam ;+K
@JSR K$open ;+K
@bcs misdsk
no$dt$open:
@rts

PAGE
;
;
SETUP:
@JSR CKOTCM+BB ;+K
@LDY dskcmd$lng,# ;+K
SETUP2:
@LDA DSKCMD+BB-1,y ;+K
@JSR K$chrout ;+K
@DEY ;+K
@BNE SETUP2 ;+K

@JSR K$clrchn ;+K
@JSR CKINCM+BB ;+K
@BEQ SETUP3 ;+K

SETUP5:
@LDA 0dh,# ;+K  get error flag
@STA vic$data ;+K  writes to RAM under ROM
setup3:
@JMP K$clrchn ;+K


page
;
;
;
read$byte:
@sei
@lda d2pra
@eor clk$bit,#
@sta d2pra
@lda 8,#
in$1:
@bit d1icr
@beq in$1
@lda d1sdr
@rts


page
;
; handle all interrupts in BIOS 8502 (throw them away)
;
irqs:
@lda CIA$1+int$ctrl
@lda CIA$2+int$ctrl
@lda 0fh,#
@sta VIC+25

;
; system saved memory config, Y, X and A before getting here
;
@pla
@sta force$map
@pla
@tay
@pla
@tax
@pla
@rti

;
;
PAGE
;
; **** CONVERT BINARY TO ASCII ****
;
BINASC:
@CLD ;-K
@LDX '0',# ;-K
@SEC ;-K
BA0:
@SBC 10,# ;-K
@BCC BA1 ;-K
@INX ;-K
@BCS BA0 ;-K
BA1:
@ADC 3Ah,# ;-K
@RTS ;-K

PAGE
;
; **** SELF CORRECTING CHECK IO ROUTINES ****
;
CKICM:
@JSR OPENCM+BB ;+K
CKINCM:
@LDX cmdchn,# ;+K
@JSR K$chkin ;+K
@BCS CKICM ;+K

@JSR K$chrin ;+K
@CMP '0',# ;+K
@RTS ;+K
;
;
;
CKIDT:
@JSR OPENDT+BB ;+K
CKINDT:
@LDX datchn,# ;+K
@JSR K$chkin ;+K
@BCS CKIDT ;+K
@RTS ;+K

;
;
;
CKOCM:
@jsr OPENCM+BB ;+K
CKOTCM:
@LDX cmdchn,# ;+K
@JSR K$chkout ;+K
@BCS CKOCM ;+K

@RTS ;+K

PAGE


dskcmd: db CR ;
dskcmd$S$l: db 's' ;
dskcmd$S$h: db 's ' ;
dskcmd$T$l: db 't' ;
dskcmd$T$h: db 't 0 8:1'

U0POINT: db 'U' ;
dskcmd$lng equ $-DSKCMD
db '0',4Ch,0 ; reset disk change status (open)

POUND: db '#'

F$cmd$buf:
F$rd$count: db 1 ; 5 1st read always one sector
F$rd$sect: db 0 ; 4 filled in
F$rd$trk: db 0 ; 3 filled in
F$cmd: db 0 ; 2 read=0
db '0U' ; 1
Fcmd$lng equ $-F$cmd$buf

bios$size equ $-bios$65$code

[Blacklord]

cxrom1.asm

Code Select Expand

title 'CP/M 3 ROM loader        13 May 85'


maclib z80

maclib cpm3

maclib cxequ

maclib x6502


boot$8502 equ 1100h
lines equ 24 ; number of user lines on screen(s)


rownum macro row,col
db row+80h,col
    endm



;
; power on location
;
org 00h ; RST 0

mvi a,3eh
sta force$map
jmp power$up ; continue init somewhere else


;
; boot CP/M entry point
;
; org 08h ; RST 1

lxi sp,boot$stack
mvi a,3Fh ; MMU enable RAM bank 0 no I/O
jmp loader$start

page
;
; * TJMP * user to jmp to a Terminal ROM routine
; user code:
; RST 2
; db fun# (0,4,8,C,....,44)
;
; org 10h ; RST 2

pop h
mov l,m
jmp 020h
nop
nop
nop

;
; * RJMP * user to jmp to a ROM routine
; user code:
; RST 3
; db fun#
;
; org 18h ; RST 3

pop h ; get the return address
mov l,m ; get user function # (0,2,...,fe)
jmp 028h ;
nop
nop
nop

page
;
; * TCALL * used to call a Terminal ROM routine
; user code:
; mvi l,fun# (0,4,8,C,....,44)
; RST 4
;
; org 20h ; RST 4

lda fun$offset ; =0 if 80 column, <>0 if 40 column
ana a ; is this an 80 column function?
jrz 28h ; yes, no offset required
inr l ; no, advance to next vector
inr l


;
; * RCALL * used to call a ROM routine
; user code:
; mvi l,fun# (0,2,4,6,.....,7E)
; RST 5
;
; org 28h ; RST 5

mvi h,01h ; vectors on page 1
mov a,m
inx h
mov h,m
mov l,a
pchl
nop

page
;
; RST 6 is NOT defined.. this area is used for the ROM date
; ONLY....
;
; org 30h ; RST 6

db '05/12/85'


; org 38h ; RST 7 (interrupt mode 1 start adr)
jmp 0fdfdh

page
;
;
;
power$up:
lxi b,VIC$key$row
lxi d,0fffch ; D=ff, E=fc
outp d ; set extra 3 scan lines off
inx b ; point to clock speed reg
outp e ; bits 7-2 unused
; bit 1  enable test mode (1)
; bit 0  2 Mhz (1) / 1 MHz (0)  
;
; continue the check to see if a C64 type chartrage is installed
; (EXROM or GAME active) if so we enter C64 mode
;
lxi b,mode$reg ; get EXROM and GAME bits
mvi a,z80$on
outp a ; set bit high
inp a ; see if they went high
cma ; make highs low
ani 30h ; EXROM or GAME enabled?
jrz test$key ; no, now test the commodore key

;
; This is a one way trip, no return flights.
; Thus we do not have to do the transfer from RAM
; (as in C128 mode).  We just enable C64 and run.
;
go$c64:
mvi a,enable$c64
outp a
; should never get here
RST 0 ; unless there are hardware problems

page

test$key:
lxi b,0dc0fh ; D1CRB
mvi a,8h ; turn off timers
outp a
dcr c ; D1CRA
outp a

mvi c,03h ; D1DDRB = inputs
xra a ; A=00
outp a
dcr c ; D1DDRA = outputs
dcr a ; A=FF
outp a
dcr c ; dc01
dcr c ; dc00
mvi a,01111111b ; bit 7 for commodore key
outp a
inx b ; dc01 point to key$col
inp a
ani commodore$key
lxi b,mode$reg
jrz go$c64

go$c128:
;
; set MMU registers to a known state
;
lxi h,mmu$init$data+11-1 ; start at the End
lxi b,mmu$start+11-1 ; and work forward
mvi d,11 ; for all 11 bytes

init$mmu$next:
mov a,m ; get table value
outp a ; send to MMU
dcx h
dcr c
dcr d
jrnz init$mmu$next


;
; install 8502 code that will enable C128 mode and
; execute at the location pointed to by FFFC (reset vector)
;
lxi h,boot$02$code
lxi d,boot$8502
lxi b,boot$size
ldir

lxi h,swap$code
lxi d,enable$z80
lxi b,swap$size
ldir

;
; Get ready to enter C128 mode.  Install vectors in ram that will
; force the processor to execute RAM code in low memory.
; The RAM code in low memory ENABLES the kernal and does
; an indirect JMP to FFFC (reset vector).
;
lxi h,boot$8502 ; C128 start adr
shld 0fffah ; install NMI vector
shld 0fffch ; install RESET vector
shld 0fffeh
shld return$z80+1
jmp enable$6502

page
;
; scan buffer for CPM+.SYS file
;
scan$dir:
call update$buffer ; returns HL=block$buffer
lda block$size ; 32 for 1K block, 64 for 2K block
; ..number director entries/sector

check$next:
shld @dma
lxi d,sys$name ; point to system name
push psw
call name$match
cz found
pop psw
lhld @dma ; get current buffer pointer
lxi d,32
dad d
dcr a
jrnz check$next
ret

page
;
; compare the strings (11 bytes each) pointed to by
; DE and HL. Return with Zero flag set if equal.  
;
name$match:
mvi b,12 ; number of bytes to match
  xchg ; [HL]=search name  [DE]=dir entry

match$next:
ldax d ; get string 1 character
ani 7fh ; remove any attr.
cmp m ; compare to string 2
rnz ; exit if they don't match

inx h
inx d
djnz match$next

lda block$size ;
cpi 64 ; 2K block?
ldax d ; get the dir ext#
jrnz ext$1k ; no, ext # ok
; yes, (carry=0)
rar ; divide by 2, ext could be 0 or 1
; ..for the 1st and 2 or 3 for the
ext$1k: ; ..second entry
sta ext$num
null$code:
xra a ; return with zero flag set
ret

page
;
;
;
sys$name:
;  12345678901
db 0,'CPM+    SYS' ; must be in user 0's space

db 0
;
;
;
; org 0100h-6
cmp$hl$de:
mov a,h
cmp d
rnz
mov a,l
cmp e
ret

page

; org 0100h

dw wr$char$80 ; function # 00
dw wr$char$40 ; function # 02
dw crs$pos$80 ; function # 04
dw crs$pos$40 ; function # 06
dw crs$up$80 ; function # 08
dw crs$up$40 ; function # 0A
dw crs$down$80 ; function # 0C
dw crs$down$40 ; function # 0E

dw crs$left$80 ; function # 10
dw crs$left$40 ; function # 12
dw crs$rt$80 ; function # 14
dw crs$rt$40 ; function # 16
dw crs$cr$80 ; function # 18
dw crs$cr$40 ; function # 1A
dw CEL$80 ; function # 1C
dw CEL$40 ; function # 1E

dw CES$80 ; function # 20
dw CES$40 ; function # 22
dw char$ins$80 ; function # 24
dw char$ins$40 ; function # 26
dw char$del$80 ; function # 28
dw char$del$40 ; function # 2A
dw line$ins$80 ; function # 2C
dw line$ins$40 ; function # 2E

dw line$del$80 ; function # 30
dw line$del$40 ; function # 32
dw set$color$80 ; function # 34
dw set$color$40 ; function # 36
dw set$attr$80 ; function # 38
dw set$attr$40 ; function # 3A
dw rd$chr$80 ; function # 3C
dw rd$chr$40 ; function # 3E

page

dw wr$chr$80 ; function # 40
dw wr$chr$40 ; function # 42
dw rd$color$80 ; function # 44
dw rd$color$40 ; function # 46
dw null$code ; function # 48
dw null$code ; function # 4A
dw null$code ; function # 4C
dw null$code ; function # 4E

dw convert$record ; function # 50
dw check$cbm ; function # 52
dw bell ; function # 54
dw null$code ; function # 56
dw null$code ; function # 58
dw null$code ; function # 5A
dw null$code ; function # 5C
dw null$code ; function # 5E

dw trk$40 ; function # 60
dw set$cursor$40 ; function # 62
dw line$paint ; function # 64
dw screen$paint ; function # 66
dw prt$msg$both ; function # 68
dw prt$de$both ; function # 6A
dw update$it ; function # 6C
dw null$code ; function # 6E

dw ASCII$to$petASCII ; function # 70
dw cur$adr$40$hl$sz$a ; function # 72
dw cur$adr$80$hl$sz$a ; function # 74
dw lookup$color ; function # 76
dw null$code ; function # 78

dw blk$fill ; function # 7A  ret adr, HL on stack
dw blk$move ; function # 7C  ret adr, HL on stack
dw char$install$gp ; function # 7E  ret adr, HL on stack

; the last 3 function are called by 1st pushing HL on the stack
; and then doing the call
; user code as follows:
; lxi h,xyz ; value to be passed in HL
; push h ; extra value on stack
; RCALL ....
; ; stack clean

page
;
; org 180h
;
jmp write$memory
jmp read$memory
jmp set$update$adr
jmp wait

;
;
;
loader$start:
;
; setup the MMU for booting CP/M
;
sta force$map

;
; clear bank 0 RAM 3000h to feffh. This is the system area.
;
lxi h,3000h
lxi d,3001h
lxi b,0ff00h-3000h-1
mov m,l
ldir

;
; move bios and swap code into ram
;
lxi h,bios$65$code
lxi d,bios$02
lxi b,bios$size
ldir

lxi h,swap$code
lxi d,enable$z80
lxi b,swap$size
ldir

mvi a,RET ; get z80 return adr
sta return$6502 ; store the RET

;
; initilize the 8502 bios
;
; xra a ; cleared by memory fill
; sta vic$cmd
call enable$6502

page
;
; set MMU registers to a known state (for CP/M to use)
;
lxi h,mmu$init$data+11-1 ; start at the End
lxi b,mmu$start+11-1 ; and work forward
mvi d,11 ; for all 11 bytes

init$mmu$cpm:
mov a,m ; get table value
outp a ; send to MMU
dcx h
dcr c
dcr d
jrnz init$mmu$cpm
; re-enabled RAM bank 0 (no I/O)
;
; Clear the work area
;
lxi h,1000h
lxi d,1000h+1
lxi b,3000h-1000h-1 ; number of bytes to clear
mov m,l ; clear the 1st one
ldir ; copy 1st to all

page
;
; set 80 column colors and set up Video memory with ASCII char set
;
mvi a,26
call wait
mvi a,90h ; foreground red background black
outp a
mvi a,83h ; set attr and color (lt. blue)
sta current$atr ; ..for 80 column display
mvi a,0eh ; set color (lt. blue)
sta attr$40 ; ..for 40 column display
call install$ASCII ; convert char set to true ASCII

mvi a,25 ; number of lines on the 40 col display
sta paint$size
;
; Let the user know we are booting CP/M
;
call prt$msg$both
db -1 ; clear both screens
rownum 1,10
db 'BOOTING CP/M PLUS',0

;
; point 40 column screen to CP/M screen area
;
lxi b,VIC+24
mvi a,vic$screen*4/256+6 ; upper and lower case set (+6)
outp a

page

call check$dsk ; is this a C128 disk ?
jnz tell$user ; no, tell the user
;
;
;
lxi h,dir$ptrs
shld ld$blk$ptr
call scan$dir ; check 1st block
call scan$dir ; check 2nd block (1K or 2K)

lhld block$ptrs ; 1st pointer <>0 if file
mov a,h ; name exist
ora l ; pointer = 0
jz tell$user ; yes, inform user there is a error
; no, file found, process it
page
; *************************************************
; * *
; * load 1st group to 1K buffer *
; * *
; *************************************************

;
;
;
file$found:
lxi h,block$ptrs
shld ld$blk$ptr
call update$buffer


; *************************************************
; * *
; * extract boot info *
; * *
; *************************************************

;
;
;
get$boot$info:
lxi h,block$buffer
lxi d,info$buffer
lxi b,12
ldir

call prt$msg$both
rownum 10,0
db 0 ; end of string marker
lxi h,block$buffer+80h
call prt$hl$both

lxi h,block$buffer+256 ; set scan pointer
shld blk$unld$ptr

page
; *************************************************
; * *
; * load keyboard data to system RAM *
; * *
; *************************************************

call prt$msg$both
rownum 3,12
; db 'LOADING DATA TABLES',0
db 'DATA TABLES',0
lhld info$buffer+10
shld key$tbl ; install keyboard translation pointer

lxi h,info$buffer+9
call get$size$adr ; HL=adr DE=# (128 btye) records
shld fun$tbl

load$next$forward:
call load$record ; HL =load address (in and out)
lxi d,128 ; move pointer back to buf start
dad d
jrnz load$next$forward


page
; *************************************************
; * *
; * transfer CP/M code to load address *
; * *
; *************************************************
;
;
;
load$common:
call prt$msg$both
rownum 4,12
; db 'LOADING COMMON CODE',0
db 'COMMON CODE',0
lxi h,info$buffer+1 ; load common code
call load$reverse


call prt$msg$both
rownum 5,12
; db 'LOADING BANKED CODE',0
db 'BANKED CODE',0
lxi h,info$buffer+3 ; load banked code
call load$reverse

page
; *************************************************
; * *
; * now load the bios8502 code *
; * *
; *************************************************

call prt$msg$both
rownum 6,12
; db 'LOADING BIOS8502 CODE',0
db 'BIOS8502 CODE',0
lxi h,info$buffer+7 ; load banked code
call load$reverse

lda info$buffer+7 ; get code size (in 256 byte blocks)
mov b,a
lda info$buffer+6 ; get page pointer (pointer to end)
sub b ; find the start

; install jmp adr to BIOS02
sta return$z80+2 ; (jmp) (low) (high)
xra a
sta return$z80+1 ; (jmp) (low) (high)


; *************************************************
; * *
; * now let's start executing CP/M Plus *
; * *
; *************************************************

lhld info$buffer+4 ; get start address
pchl ; transfer control to CP/M

page
; *********************************
; - -
; -   SUBROUTINES -
; - -
; *********************************

;
; returns with zero flag set if bootable disk in drive
;
check$dsk:
lxi h,@buffer
shld @dma
xra a
sta vic$sect ; set track 1 sector 0 (1st sector
inr a ; on the disk)
sta vic$trk
call read$sector ; a=0 if no errors
call check$cbm ; disk have CBM in first sector ?
rnz ; no, exit
inr a ; yes, is it double sided?
lxi h,block$buffer+1024 ;   buffer end address (1K blocks)
mvi a,32 ;   number of dir entries per block
jrnz set$block$size ;  yes, set it
;  no, set 2K block parameters
mvi h,high(block$buffer+2048)
add a ; 64 dir entries

set$block$size
shld block$end
sta block$size ; 32=1K,  64=2K (# dir entries/block)
xra a ; set zero flag (is CP/M disk)
ret

page
; *************************************************
; - -
; - save CPM+.SYS group numbers -
; - -
; *************************************************
;
; found a dir entry that has the right name
; add block pointers to list
;
found:
lxi d,block$ptrs ; point to start of block pointers
lda ext$num
ora a
jrz ext$num$0

lxi d,block$ptrs+16
dcr a
jnz ext$error

ext$num$0:
lhld @dma ; get current pointer

lxi b,16 ; number of bytes to move
dad b ; also advance to block pointers
ldir

lda block$ptrs
ora a ; 1st block present ?
rz ; no, read more dir.

lhld block$ptrs+15 ; extent full?
xra a ; get a zero
cmp l ; cmp to block$prt+15
jrz go$boot$it ; no, this is it then

cmp h ; cmp to block$prt+16
; 2nd block present ?
rz ; no, read more dir.

go$boot$it:
jmp file$found ; two parms are still on the stack
; but at this point who cares

page
;
;
;
load$reverse:
call get$size$adr ; HL=adr DE=# records (128 byte)

load$next:
lxi d,-128 ; move pointer back to buf start
dad d
call load$record
jrnz load$next
ret

;
;
;
get$size$adr:
mov e,m
mvi d,0 ; get buffer size (#256 byte)
mov a,e ; get size to A
ora a
jz table$error ; exit if count=0

xchg
dad h ; HL=#128 byte blocks
shld load$count
xchg
dcx h
mov h,m
mvi l,0
ret

page
;
;
;
load$record:
push h ; save to address
lhld block$end ; get buffer end adr
xchg
lhld blk$unld$ptr
call cmp$hl$de
cz update$buffer
xchg
lxi h,128
dad d
shld blk$unld$ptr
pop h ; recover save address
push h
xchg ; HL=source  DE=dest.
lxi b,128 ; size of move
ldir
lhld load$count
dcx h
shld load$count
mov a,l
ora h
pop h
ret

page
;
;
;
update$buffer:
lxi h,block$buffer
shld @dma
push h ; save block buffer adr for ret
lhld ld$blk$ptr ; get the current block pointer
mvi d,0 ; zero MSB of block pointer
mov e,m ; get LSB of block pointer
inx h ; advance pointer
shld ld$blk$ptr
xchg ; get block number to HL
;
; read the block pointed to by the HL
; into the data buffer
;
dad h ; 2x
dad h ; 4x 256=1K
lda block$size ; =32 for 1K, =64 for 2K
rrc
rrc
rrc ; 32/8=4,  64/8=8
cpi 32/8 ; 1K block size?
jrz is$1K$block
dad h ; 8x 256=2K
is$1K$block:
shld @trk
next$block:
dcr a ; 3 or 7 sectors left to read
sta vic$count ; ..1st sector is read anyway
push psw
mvi a,1
sta F$rd$count+BB ;

call convert$record ; set track, sector (adjust for offset)
lhld @trk
inx h
shld @trk ; save for later
pop psw
jrz rd$1541

lda fast
ana a ; 0=1541,  0<>1571
jrz rd$1541

lhld vic$trk ; get track and sector #
push h ; save on stack
check$next$trk:
call convert$record ; convert next track and sector
pop h ; recover 1st trk and sector #

lda vic$trk ; get trk$number
cmp l ; same trk as 1st sector
jrnz not$same$trk

push h ; resave 1st trk and sect
lhld @trk
inx h
shld @trk
lxi h,F$rd$count+BB
inr m
lxi h,vic$count
dcr m
jrnz check$next$trk
pop h

not$same$trk:
shld vic$trk ; save the 1st track sector #
rd$1541:
call read$sector ; read the sector to the buffer
lxi h,@dma+1 ; point to dma high byte
lda F$rd$count+BB
add m
mov m,a ; adjust for next read
lda vic$count
ana a ; test if all sectors read?
jrnz next$block ; no loop back

pop h ; recover block buffer adr
ret

page
;
; convert block number to sector and track
;
convert$record:
mvi a,35
sta temp$1 ; store a track offset of 35
lhld @trk ; get start block #
lxi d,680 ; 0 to 680 sectors per side
ora a ; clear the carry
dsbc d ; negative if <680
jrnc side$1 ; jump if still positive >=680
xra a ;
sta temp$1 ; store a track offset of 0
dad d ; add it back

side$1:
inx h ; skip 1st sector (both sides)
inx h ; skip 2nd sector (both sides)
lxi d,357 ; get first value to subtract
lxi b,21*256+1-1 ; b=sectors/track c=track offset-1
ora a ; clear the carry bit
dsbc d ;
jrc too$much ;
inx h ; add 1 to skip track 18 sector 0
lxi d,490-357 ; get first value to subtract
lxi b,19*256+18-1 ; b=sectors/track c=track offset-1
dsbc d ;
jrc too$much ;
lxi d,598-490 ; get first value to subtract
lxi b,18*256+25-1 ; b=sectors/track c=track offset-1
dsbc d ;
jrc too$much ;
lxi d,0
lxi b,17*256+31-1 ; b=sectors/track c=track offset-1

page
;
; at this point B= number of sectors/track and C=track offset
; after DE is added back to HL (1st inst), HL is the number of
; sector past the current track (in C).
;
too$much:
dad d ; add back what made sum go negitive
mvi d,0 ; number of sectors/track in DE
mov e,b
ora a ; clear the carry bit
sect$pos:
inr c ; add one to the current track (1-35)
dsbc d ; remove a track's worth of sectors
jrnc sect$pos ; less then one?, no jmp
dad d ; make HL positive again
;
; at this point HL has the remainder (sector # 0-20) and
; C has the track number (1-35), DE and B still has the
; # sectors/track for the current track.
;
lda temp$1 ; get track offset
add c ; add to current track
sta vic$trk ; save it
push h
lxi h,special$skew
lxi b,21 ; number of sectors in 1st region
mov a,e
cmp c
jrz correct$region
dad b ; move past current region
dcx b
dcx b ; 19
adjust$loop:
cmp c
jrz correct$region
dad b
dcx b
jr adjust$loop
;
;
;
correct$region:
pop b ; get logical sector # in BC
dad b
mov a,m ; get translated sector number to A
sta vic$sect ; value from 0 to 20 will be returned
inr a ; A is required to be non-zero on ret
ret

page
;
;
;
read$sector:
mvi a,3
sta retry

read$again:
mvi a,vicrd ; read a sector of data
sta vic$cmd
call disp$dsk$info
call enable$6502
mvi a,3fh ; mmu ram bank 0 (no I/O)
sta force$map
lda vic$data
ora a ; problems?
jrnz read$error ; yes, check for disk error or media change
; no, go move buffer to DMA address
ret

page
;
;
;
check$cbm:
lxi h,@buffer
mov a,m
cpi 'C' ; C ?
rnz ; no, return

inr l ; @buffer+1
mov a,m
cpi 'B' ; B ?
rnz ; no, return

inr l ; @buffer+0
mov a,m
cpi 'M' ; M ?
rnz

mvi l,0ffh ; @buffer+0ffh
; point to the double sided flag
mov a,m ; read it, 0FFh if double sided
ret

page
;
;
;
ext$error:
call prt$msg$both
rownum 19,5
db '32K MAX CPM+.SYS SIZE',0

try$again:
rst 1

;
;
;
read$error:
inr a ; test for -1
jrz try$again

lda retry
dcr a
sta retry
jrnz read$again



call prt$msg$both
rownum 19,5
db 'READ ERROR',0
error$2:
call prt$msg$both
db ' - HIT RETURN TO RETRY'
rownum 20,15
db 'DEL TO ENTER C128 MODE',0

;
;
;
wait$key:
lxi b,key$row
mvi a,11111110b ; bit 0 for RETURN key
outp a
inr c ; point to key$col
inp a
ani 2 ; on bit 1 (0-7)
jrz try$again

inp a
ani 1 ; delete key down
jrnz wait$key ; no, wait for RETURN key

rst 0 ; yes, reboot C128-mode


page
;
; CPM+.SYS file not on this disk test user to install
; a system disk and wait for a CR to continue
;
tell$user:
call prt$msg$both
rownum 19,5
db 'NO',0
error$1:
call prt$msg$both
db ' CPM+.SYS FILE',0
jr error$2

;
;
;
table$error:
call prt$msg$both
rownum 19,5
db 'BAD',0
jr error$1

page

;
;
;
prt$msg$both:
xthl
call prt$hl$both
xthl
ret

update$it:
lxi h,-1
shld old$offset ; force an update
;
;
;
prt$de$both:
push d
;
;
;
prt$hl$both$loop:
pop h
;
;
;
prt$hl$both:
mov d,m
inx h ; advance the pointer
lda prt$flg
ana a
jrz no$flag
xra d
sta prt$flg
mov d,a
no$flag:
mov a,d
ora a
rz

cpi '$'
rz ; yes, return

push h
lxi h,prt$hl$both$loop
push h
cpi LF
rz

page
;
;
;
check$both$CR:
cpi CR
jrnz check$erase$both
;
;
do$crlf$both:
call crs$cr$40
call crs$cr$80
call crs$down$40
RJMP FR$cursor$down ; cursor down 80

;
;
;
check$erase$both:
cpi -1
jrnz check$both$CUR$$POS
;
; Erase both screens
;
lxi d,24*256 ; erase the status line 1st
call curpos$BC$both
call CEL$40
call CEL$80
lxi d,0 ; erase main screen
call curpos$BC$both
call CES$40
RJMP FR$CES


check$both$CUR$POS:
ani 80h
jrz out$d$both
;
curpos$D$both:
pop b ; get return adr in BC
pop h ; get pointer in HL
mov e,m ; E=column #
inx h
push h ; save new pointer
push b ; save return adr
res 7,d ; D=row #

curpos$BC$both:
push d ; save cursor address
call crs$pos$40
pop d
RJMP FR$cursor$pos ; 80 column


page
;
;
;
disp$dsk$info:
lxi d,24*256+80-6
call crs$pos$80
lxi d,24*256+40-6
call crs$pos$40


lda vic$trk
call disp$dec
mvi d,' '
call out$d$both
lda vic$sect

disp$dec:
mvi b,'0'-1

conv$loop:
inr b
sui 10
jrnc conv$loop

adi '0'+10
push psw
mov a,b
call disp$A
pop psw

disp$A:
mov d,a
;
;
;
out$d$both:
push d
call wr$char$40
pop d
RJMP FR$wr$char

[Blacklord]

cxrom80.asm

Code Select Expand

; 13 May 85

;**
;** 80 COLUMN FUNCTION CODE
;**

fixed$8563 equ false

;*
;* Write character in D to current cursor address
;* Advance cursor next position
;*
wr$char$80:
lhld char$adr
call write$char$80
lda char$col ; get cursor column number
cpi 80-1
jrz do$crlf
inr a
sta char$col ; update column number
lhld char$adr ; get cursor address
inx h
shld char$adr ; update cursor address

;
; input:
; HL=current cursor address
;
set$cursor:
mvi a,14 ;
call wait ;
outp h
mvi a,15 ;
call wait ;
outp l
ret

page


;*
;* Set current ROW and COL  (supplied in DE)
;*
;*
crs$pos$80:
mov a,d
cpi 25
rnc
mov a,e
cpi 80
rnc
xchg ; cursor row # in D,column # in C
shld char$col

;
; returns with cursor set and current ROW, COLUMN in BC
; and character screen address in HL
;
compute$adr:
lhld char$col
call cur$adr$hl ; HL=cursor address on return
shld char$adr
jr set$cursor ; call/ret

page
;*
;* Move cursor up one line; do nothing if on the
;* top line
;*
crs$up$80:
lda char$row
ora a
rz
dcr a
set$row$80:
sta char$row
jr compute$adr


do$crlf:
xra a
sta char$col

;*
;*
;*
;*
crs$down$80:
lda char$row
cpi lines-1 ; on bottom line ?
jrz scroll$up ; yes, scroll the screen
jrnc set$24$80 ; past it, set it to line 24
inr a
jr set$row$80

;*
;*
;*
;*
crs$left$80:
lda char$col
ora a
rz
dcr a
set$col$80:
sta char$col
jr compute$adr

page
;*
;*
;*
;*
crs$rt$80:
lda char$col
inr a
cpi 80
jrnz set$col$80
ret

;*
;*
;*
;*
crs$cr$80:
xra a
jr set$col$80

page
;
;
;
set$24$80:
mvi a,lines-1
sta char$row
;
;
;
scroll$up:
 lxi h,80
 lxi d,0
 lxi b,80*(lines-1)
 call block$move$80

;
;
;
clear$bottom$line:
lxi h,80*(lines-1)
lxi b,80
call block$fill$space$80
jr compute$adr

page
;*
;* B= bit position to set or clear
;* C= new bit value
;*
;* attr byte def. (in B and C)
;* bit 7-alternate char set (uper case set)
;* bit 6-reverse video
;* bit 5-underline
;* bit 4-blink
;* bit 0-full intensity
;*
;*
set$attr$80:
lda current$atr
cma ; invert A
ora b ; force new bit to 1
cma ; restore A
ora c
sta current$atr
ret

page
;*
;* ASCII codes(B) 20h to 2Fh set character color
;* 30h to 3Fh set background color
;* 50h to 5Fh set logical character color
;* 60h to 6Fh set logical background color
;* all others code do nothing
;*
;*
set$color$80:
mov a,b ; get color to A
sui 20h ; remove the BIAS
cpi 20h ; physical color ? (00h-1Fh)
jrc ?col$80 ; yes, go set it
mvi c,20h ; max color value+1 (00h-1Fh)
call lookup$color$1 ; convert char in A to color (ret in A)
; C=max color character
rc ; return if error
mov a,m ; get color bytes
ani 0fh ; LSB is 80 column color
add b ; Add color offset back
; 0-f set forground color
; 10-1f set background color

page
;
; set color in A (00-0F sets the character color)
; (10-1F sets the background color)
;
; This routine first calls lookup color to convert the 40 column
; color (normal color) to the 80 column RGBI color
;
?col$80:
sta temp1
mvi c,20h ; max color value+1 (00h-1Fh)
adi 30h ; restore a bias
lxi h,color$convert$tbl ; table to use
call lookup$color$2 ; convert to same color as 40 Column
mov a,m ; get character color
add b ; add color offset back

cpi 10h ; character color? (0-f)
jrc chr$col$80 ; yes, go do it
; no, fall thru and set background
;
; set background color (10-1F)
;
ani 0Fh ; get value of 0 to F
sta bg$color$80
push psw
mvi a,26 ; color register
call wait
pop psw
outp a
ret

;*
;*
;*
rd$color$80:
lda bg$color$80
mov b,a
lda current$atr
mov d,a
lda char$color$80
ret

page
;
; set character color
;
chr$col$80:
mov b,a
lda current$atr
ani 0f0h ; remove old color
ora b ; merge new color
sta current$atr ; save new attr
lda temp1
sta char$color$80
;
; set current char position color to new color
;
lhld char$adr ; get current cursor adr
lxi d,800h ; offset to attr
dad d ; pointing to current char attr
call set$update$adr ; point to attr byte
lda current$atr
outp a
ret

page
;*
;*
;*
;*
CEL$80:
call cur$adr$80$hl$sz$a ; HL=cur adr, DE=line start adr
; BC=count to move, A=BC+1
inx b ; 1 to 80 to fill
jr cont$space$fill


;*
;*
;*
;*
CES$80:
call cur$adr$80$hl$sz$a ; HL=cur adr, DE=line start adr
; BC=count to move, A=BC+1
xchg ; cursor address in DE
lxi h,lines*80
xra a ; clear the carry
dsbc DE ; count will be minus if on status line
rm ; return if on status line
mov b,h
mov c,l ; count to BC
xchg ; cursor address back to HL

cont$space$fill:
jmp block$fill$space$80

page
;*
;*
;*
char$ins$80:
call cur$adr$80$hl$sz$a ; HL=cur adr, DE=line start adr
; BC=count to move, A=BC+1 (1-80)
lxi h,80-1
dad d ; point to end of line
dcr a ; A=1 if at end of line
jrz char$ins$80$end
mov d,h
mov e,l ; HL=DE= end of line address
dcx h ; [HL--] -> [DE--] count BC

push b
push h
push d
call insert$low
lxi b,800h ; attribute offset
pop h
dad b
xchg
pop h
dad b
pop b

insert$low:
push b
call set$update$adr
inp a
xchg
push psw
call set$update$adr
pop psw
outp a
xchg
pop b
dcx h
dcx d
dcx b
mov a,b
ora c
jrnz insert$low

lhld char$adr

char$ins$80$end:
jmp write$space$80

page
;*
;*
;*
;*
char$del$80:
call cur$adr$80$hl$sz$a ; HL=cur adr, DE=line start adr
; BC=count to move, A=BC+1
push d ; save line start address
mov d,h
mov e,l ; DE=HL=cursor address
inx h ; [HL++]->[DE++] count BC
call block$move$80 ; DE points to last position

pop h ; recover line start address
lxi d,80-1
dad d ; point to end of line
jmp write$space$80

page
;*
;*
;* Moves one line at a time, down one line, starting with the next
;* to the bottom line. Once the cursor line is moved down, the
;* cursor line is cleared.
;*
line$ins$80:
lxi d,new$offset
mvi a,lines-1 ; cursor on or past the last line ?
lhld char$col
cmp h
jz clear$bottom$line ; no bottom, clear bottom line
jrc line$ins$cont ; past,
lxi h,(lines-2)*80
lxi d,(lines-1)*80
mvi b,lines
move$next$down:
call move$line$down
lda char$row
cmp b
jrnz move$next$down

call cur$adr$80$hl$sz$a ; HL=cur adr, DE=line start adr
; BC=count to move, A=BC+1
xchg ; get line start adr
lxi b,80
jr block$fill$space$80

;
;
;
line$ins$cont:
inr a
cmp l
rnz
jmp update$it

page
;
; INPUT:
; HL=source
; DE=dest
; B=line number
; OUTPUT:
; HL=source-80
; DE=dest-80
; B=line number - 1
;
move$line$down:
push b
push h
push d
lxi b,80
call block$move$80
lxi b,-80
pop h
dad b
xchg
pop h
dad b
pop b
dcr b
ret

page
;*
;*
;*
line$del$80:
lda char$row
cpi lines ; is the cursor past the bottom line ?
rnc ; yes, exit
call cur$adr$80$hl$sz$a ; HL=cur adr, DE=line start adr
; BC=count to move, A=BC+1
lxi h,80 ; line length
dad d ; HL=start of next line
xchg ; move from address in DE
push h ; save TO address
lxi h,lines*80
xra a ; clear the carry
dsbc DE
mov b,h
mov c,l ; count to BC
pop h ; recover TO address
xchg ; move from address back to HL

call block$move$80 ; DE points to last position
jmp clear$bottom$line

page
;
; user interface point
;
blk$fill:
pop h ; get the return addres
xthl ; get HL, ret adr to stack.
jr block$fill$80
;
; INPUT:
; HL=start address
; BC=count
;
block$fill$space$80:
lda current$atr
mov e,a
mvi d,' '
;
; 80 block fill
;
; INPUT:
; HL=start address
; BC=count
; D=fill character, E=attribute
;
block$fill$80:
mov a,b ; get MSB of count to A
ana a ; is it zero
jrz fill$less$256 ; yes, move less than 256 bytes
block$fill$cont$80:
push h
push d
push b
xra a
call fill$data$80
pop b
pop d
pop h
inr h
djnz block$fill$cont$80

page
;
;
;
fill$less$256:
mov a,c ; get LSB of count to A
ana a ; is it zero ?
rz ; yes, none left to fill, return
;
; count in A (1 to 256) (0=256)
; HL=fill adr
; DE=fill character, and attribute
;
fill$data$80:
push psw ; save count
push h ; save adr
push d ; save fill character
call fill$half$80
pop d ; recover fill character
lxi b,800h ; offset to attributes
pop h ; recover adr
dad b ; HL=attr adr
call do$twice?
pop psw ; recover count
mov d,e ; get the attr to D

page
;
;
fill$half$80:
push psw ; save the count
call set$update$adr ; write address to chip R18,R19
outp d ; write update data (R31)

pop psw
dcr a ; already wrote one above
rz ; return if only one required
push psw

mvi a,24
call wait
inp a ; get old value in reg 24
ani 7fh
outp a ; clear R24(7), enabling block writes

mvi a,30
call wait
pop psw ; recover the count
outp a ; write count to R30
    if fixed$8563
ret
    else
mvi b,0
mov c,a
inx b ; add back the one removed above
dad b
push d ; save fill char (in D)
push h ; HL=end address

mvi a,18
call wait
inp h
mvi a,19
call wait
inp l ; HL=current pointer

pop d ; DE=end adr
pop b ; get fill char (to B)
finish$fill:
call cmp$HL$DE ; compare dest with chip dest
; HL rnc ; return if done

push b ; save fill char
call set$update$adr ; HL&DE NOT changed (BC&A changed)
pop b ; recover fill char
outp b
inx h ; add one to dest pointer
jr finish$fill

    endif

page
;
; user entry point return adr on top of stack
; and HL next
;
blk$move:
pop h ; get return adr
xthl ; get HL save ret adr
;
; block move 80 column chip memory
;
; INPUT:
; HL=source
; DE=dest
; BC=count
;
block$move$80:
mov a,b ; get MSB of count to A
ana a ; is it zero
jrz move$less$256 ; yes, move less than 256 bytes
block$move$cont$80:
push h
push d
push b
xra a
call move$data$80
pop b
pop d
pop h
inr h
inr d
djnz block$move$cont$80

move$less$256:
mov a,c ; get LSB of count to A
ana a ; is it zero ?
rz ; yes, none left to move, return

page
;
; count in A (1 to 256) (0=256)
; HL=source
; DE=dest
;
move$data$80:
xchg ; HL=dest DE=source
push psw ; save count
push h ; save dest
push d ; save source
call move$half$80
lxi b,800h ; offset to attributes
pop h ; recover source addr
dad b ; make attr source
xchg ; DE=attr source
pop h ; recover dest
dad b ; HL=attr dest
call do$twice?
pop psw ; recover count

;
;
move$half$80:
push psw ; save the count
call set$update$adr ; write dest address to chip R18,R19

mvi a,24
call wait
inp a ; get old value in reg 24
ori 80h
outp a ; set R24(7), enabling block copy

; call set$source$adr ; write source address (R32,R33=DE)
;set$source$adr:
mvi a,32
call wait
outp d
mvi a,33
call wait
outp e
; ret

mvi a,30
call wait
pop psw ; recover the count
outp a ; write count to R30
ret

page

;
;
;
do$twice?:
mov a,h ; HL=video memory address
cpi DS$char$def/256 ; Char def area?
rc ; no, return, must be char, attr area
pop psw ; remove return adr
pop psw ; remove old A and psw
ret ; return to org caller

page
;
;
;
write$space$80:
mvi d,' '
write$char$80:
lda current$atr

;
; HL=cursor adr, D=char to write, A=attr to write
;
write$memory:
push h
push d ; save character
lxi d,800h ; offset to attribrute
dad d
mov d,a
call wr$mem
pop d
pop h

wr$mem:
call set$update$adr
outp d
ret

;*
;* input:
;* D=Char ROW, E=Char COLUMN
;* output:
;* B=Char, C=attribute (true RGBI color)
;*
rd$chr$80:
call crs$pos$80
lhld char$adr
call read$memory
mov c,a ; attr was in A
ret

;*
;* input:
;* D=Char ROW, E=Char COLUMN
;* B=Char, C=attribute (true RGBI color)
;* output:
;*
wr$chr$80:
push b ; save Char and attr
call crs$pos$80
lhld char$adr
pop b ; recover Char and attr
mov d,b ; char to D
mov a,c ; attr to A
jr write$memory ; write char and attr to memory

;
;
;
read$memory:
push h
lxi d,800h ; offset to attribute
dad d
call rd$mem
mov a,b
pop h
;
;
rd$mem:
push psw
call set$update$adr
pop psw
inp b
ret

page
;
;
;
wait:
push psw
lxi b,0d600h ; point to adr register
wait$loop:
inp a ; check if chip is ready yet
ral ; (MSB=1 when ready)
jrnc wait$loop ; not ready, loop
pop psw
outp a ; set chip register
inr c ; point to data register
ret

;
;
;
set$update$adr:
mvi a,18
call wait
outp h
mvi a,19
call wait
outp l
mvi a,31
call wait
dcr c

update$wait:
inp a
ral
jrnc update$wait
inr c
ret

page
;**
;** 40 COLUMN TERMINAL FUNCTION CODE
;**
;**

;*
;*
;*
wr$char$40:
mov b,d
call ascii$to$petascii ; convert to pet ASCII
lhld char$adr$40
mov b,a
lda rev$40
ora b
mov m,a
inx h
shld char$adr$40
lxi d,800h-1
dad d ; point to attribute byte
lda attr$40 ; get current attribute
mov m,a ; set it

lda char$col$40
cpi 80-1 ; at end of line?
jrz crlf$40 ; yes, do crlf
inr a
sta char$col$40 ; move cursor right
jmp set$cursor$40 ; set cursor & paint the current ROW

page
;*
;* input:
;* D=Char ROW, E=Char COLUMN
;* output:
;* H=Char ROW, L=Char COLUMN
;* B=Char, C=attribute (40 col attr and color)
;*
rd$chr$40:
call crs$pos$only$40
lhld char$adr$40
mov b,m
lxi d,800h
dad d
mov c,m
ret

;*
;* input:
;* D=Char ROW, E=Char COLUMN
;* B=Char, C=attribute (40 col attr and color)
;* output:
;* H=Char ROW, L=Char COLUMN
;*
wr$chr$40:
push b
call crs$pos$only$40
pop b
lhld char$adr$40
mov a,b
ani 7fh ; remove reverse video bit
bit 6,c
jrz not$rev$vid$bit
adi 80h ; set reverse video
not$rev$vid$bit:
mov m,a
lxi d,800h
dad d
mov m,c
jmp set$cursor$40


;*
;*
;*
crs$pos$40:
lxi h,old$offset
setb 6,m ; force page paint
crs$pos$only$40:
mov a,d
cpi 25
rnc
mov a,e
cpi 80
rnc
xchg
shld char$col$40
;
;
;
compute$adr$40:
lhld char$col$40
call cur$adr$hl ; HL=cursor adr relative to zero
lxi d,screen$40 ; get screen offset
dad d ; true cursor address
shld char$adr$40
jmp set$cursor$40

page
;*
;*
;*
;*
crs$up$40:
lda char$row$40
ora a
rz

dcr a
set$row$40:
sta char$row$40
cont$compute$adr$40:
lxi h,old$offset
setb 6,m
jr compute$adr$40

;
;
;
crlf$40:
xra a
sta char$col$40
;*
;*
;*
;*
crs$down$40:
lda char$row$40
cpi lines-1
jrz scroll$up$40
jrnc set$24$40
inr a
jr set$row$40

page
;
;
;
set$24$40:
mvi a,lines-1
sta char$row$40
;
;
;
scroll$up$40:
lxi h,screen$40+80
lxi d,screen$40
lxi b,80*(24-1)
ldir ; move characters up one line

xchg ; get start of last line in HL
lxi d,screen$40+80*23+1
lxi b,80-1
call space$fill$40 ; clear the bottom line

lxi h,screen$40+800h+80
lxi d,screen$40+800h
lxi b,80*(lines-1)
ldir ; move attributes up one line

xchg ; get start of last line in HL
lxi d,screen$40+800h+80*23+1
lxi b,80-1
lda attr$40
mov m,a
ldir ; set color attribute
jr cont$compute$adr$40

page
;*
;*
;*
;*
crs$left$40
lda char$col$40
ora a
rz

dcr a
set$col$40:
sta char$col$40
jr compute$adr$40

;*
;*
;*
;*
crs$rt$40:
lda char$col$40
inr a
cpi 80
jrnz set$col$40
ret

;*
;*
;*
;*
crs$cr$40:
xra a
jr set$col$40

page
;*
;*
;*
;*
CEL$40:
lxi h,line$paint
push h
call cur$adr$40$hl$sz$a ; HL=cursor adr, DE=start of line adr
; BC=DE+80-HL-1, A=BC+1 (1-80)
lxi d,screen$40 ; get start of screen
dad d ; HL=cursor position in memory
call write$space$40 ; place a space at the cursor adr
mov a,c
ana a
rz
push b
push h
mov d,h
mov e,l ; DE=HL=cursor pos
inx d ; point to next location
ldir ; BC=count (0-79)
jr clear$attr$also

page
;*
;*
;*
;*
CES$40:
lxi h,screen$paint
push h
lxi d,screen$40+80*lines-1 ; DE=end of screen
lhld char$adr$40 ; clear from char$adr to DE
xchg
xra a ; clear the carry bit
DSBC DE ; result is minus if on status line
rm ; return if on status line

xchg
jrz write$space$40 ; at end, clear cursor position

mov b,d
mov c,e ; count in BC
mov d,h
mov e,l ; start adr in HL
inx d ; start adr+1 in DE
push b ; save number of bytes to move
push h ; save start address
call space$fill$40 ; move space thru screen
;
;
;
clear$attr$also:
lxi b,800h
pop h
dad b ; 1st attribute
pop b ; get the count
mov d,h
mov e,l
inx d ; 2nd attribute
lda attr$40
mov m,a
ldir ; move current attribute to screen
ret

page
;*
;*
;*
;*
char$ins$40:
lxi h,line$paint
push h
call cur$adr$40$hl$sz$a ; HL=cur adr, DE=line start adr
; BC=count to move, A=BC+1 (1-80)
lxi h,screen$40-1+80
dad d ; point to end of current line
dcr a ; at right end of screen ?
jrz write$space$40 ; yes, insert a space
mov d,h
mov e,l ; HL=DE= end of line address
dcx h ; [HL--] -> [DE--] count BC
push b
push d
lddr ; DE=cursor position
xchg
call write$space$40 ; write a space at the cursor adr
pop h
lxi b,800h ; now move the attributes
dad b
pop b
mov d,h
mov e,l ; HL=DE= end of line address
dcx h ; [HL--] -> [DE--] count BC
lddr ; DE=cursor position
ret

;
;
;
write$space$40:
lda rev$40
adi ' ' ; clear character, enable cursor
mov m,a
ret

page
;*
;*
;*
;*
char$del$40:
lxi h,line$paint
push h
call cur$adr$40$hl$sz$a ; HL=cur adr, DE=line start adr
; BC=count to move, A=BC+1
lxi d,screen$40
dad d ; point to screen memory location

dcr a ; at end of line ?
jrz write$space$40 ; yes, then just erase cursor pos

mov d,h
mov e,l ; DE=HL=cursor address
push b
push h
inx h ; [HL++]->[DE++] count BC
ldir ; DE points to last position
xchg
call write$space$40 ; place a space at the end of line
pop h
lxi b,800h+1 ; now move the attributes
dad b
pop b
mov d,h
mov e,l ; HL=DE= cursor attr address
inx h ; [HL++] -> [DE++] count BC
ldir ;
ret

page
;*
;*
;*
;*
line$ins$40:
lxi h,screen$paint
push h
lda char$row$40
cpi lines-1
jrz clear$bottom$line$40
rnc ; return if on status line
call cur$adr$40$hl$sz$a ; HL=cur adr, DE=line start adr
; BC=count to move, A=BC+1
lxi h,screen$40
dad d ; point to line start memory location
push h ; save start address
lxi d,80
dad d ; point to start of next line

xchg ; cursor line(+1) start address in DE
lxi h,screen$40+80*lines ; end of screen address
xra a ; clear the carry bit (and A)
dsbc DE ; HL=HL-DE
mov b,h
mov c,l ; count in

lxi h,screen$40+80*(lines-1)-1 ; HL=end of screen-80
lxi d,screen$40+80*lines-1 ; DE=end of screen

push b
lddr

page

pop b
lxi h,screen$40+80*(lines-1)-1+800h
lxi d,screen$40+80*lines-1+800h
lddr ; scroll the attributes
pop h ; get cursor line start address
mov d,h
mov e,l
inx d
lxi b,80-1
jr space$fill$40

;
;
;
clear$bottom$line$40:
lxi h,screen$40+(lines-1)*80
lxi d,screen$40+(lines-1)*80+1
lxi b,80-1
space$fill$40:
lda rev$40
adi ' '
mov m,a
ldir
ret

page
;*
;*
;*
;*
line$del$40:
lxi h,screen$paint
push h
lda char$row$40
cpi lines-1 ; on or past last line ?
jrz clear$bottom$line$40 ; on, just clear it
rnc ; past it, return

call cur$adr$40$hl$sz$a ; HL=cur adr, DE=line start adr
; BC=count to move, A=BC+1
lxi h,screen$40
dad d ; point to line start memory location
push h ; save cursor line start adr
lxi d,80
dad d ; point to start of next line

xchg ; cursor line(+1) start address in DE
lxi h,screen$40+80*lines ; end of screen address
xra a ; clear the carry bit (and A)
dsbc DE ; HL=HL-DE
mov b,h
mov c,l ; count in

xchg ; HL=start of line after cursor line
pop d ; start of cursor line

push b ; save count
push h ; save source
push d ; save dest
ldir

lxi b,800h ; get attribute offset
pop h ; recover dest
dad b ; attr dest
xchg ; dest belongs in DE
pop h ; recover source
dad b ; attr source
pop b ; recover count
ldir
jr clear$bottom$line$40

page
;*
;* B=bits to set or clear
;* C=bits new value
;*
;* attr byte def. (in B)
;* bit 7-
;* bit 6-reverse video *
;* bit 5-underline
;* bit 4-blink
;* bit 0-full intensity (masked off)
;*
;*
set$attr$40:
mov a,b
ani 070h
mov b,a

mov a,c
ani 070h
mov c,a

lda attr$40
cma
ora b
cma ; bits in B cleared A
ora c ; add new value
sta attr$40
ral ; get reverse attr in bit 7
ani 80h
sta rev$40
ret

page
;*
;* ASCII codes 20h to 2Fh set character color
;* 30h to 3Fh set background color
;* 40h to 4Fh set border color
;* 50h to 5Fh set locical character color
;* 60h to 6Fh set logical background color
;* 70h to 7Fh set logical border color
;* all others code do nothing
;*
;* All colors are assigned from color lookup table
;*
set$color$40:
mov a,b
sui 20h
cpi 30h
jrc ?col$40
mvi c,30h ; max color value+1 (00h-2Fh)
call lookup$color$1 ; HL points to table entry on ret
rc ; exit if error
mov a,m ; get table value again
rrc
rrc
rrc
rrc ; get upper 4 bits to lower
ani 0fh
add b ; get old MSB

?col$40:
cpi 10h ; character color? (0-f)
jrc char$color$40 ; yes, go do it
; no, fall thru test background, border
cpi 20h ; background color? (10-1f)
jrc back$color$40 ; yes, go do it
; no, fall thru and set border color
;
; set border color
;
ani 0fh ; color from 0-f
sta bd$color$40
lxi b,VIC+32
outp a
ret

page
;
; set background color (10-1F)
;
back$color$40:
ani 0Fh ; get value of 0 to F
sta bg$color$40
lxi b,VIC+33
outp a
ret

;*
;*
;*
rd$color$40:
lda bg$color$40
mov b,a
lda bd$color$40
mov c,a
lda attr$40
mov d,a
ani 0fh
ret

;
; set character color
;
char$color$40:
mov b,a
lda attr$40
ani 0f0h
ora b
sta attr$40

lhld char$adr$40
lxi d,800h
dad d
mov m,a
; jmp line$paint

page
;
;
;
line$paint:
lda old$offset
mov b,a
ora a
cm trk$40

lda @off40 ;
cmp b
sta old$offset
jrnz screen$paint

call cur$adr$40$hl$sz$a ; DE=start of row adr (REL)
lxi h,screen$40 ; get start of screen
dad d ; HL=row start address (ABS)
xchg ; save in DE
lhld @off40 ; get current screen offset (0-39)
dad d ; screen source adr in HL
push h ; save for later

lda char$row$40 ; get current row #
mov l,a ; HL=row # (H=0)
call Lx40$plus$VIC
xchg ; place screen adr (25X40) in DE
pop h ; recover logical screen adr (25X80)

push h ; save for attr move
push d

mvi a,1 ; one line only

call update$window$fun
pop h ; recover screen pointer (25X40)
lxi b,vic$color-vic$screen
dad b ; point to Vic color memory
xchg ; DE=color memory pointer
pop h ; recover screen pointer (25X80)
lxi b,800h ; offset to attributes
dad b
mvi a,1 ; one line only
jr update$window$fun ;

page
;
; hl=offset (0 to 39)
;
screen$paint:
lhld @off40
lda paint$size ; number of lines to move
push h
push psw ; save the count

lxi d,screen$40
dad d ; point to start of visible screen
lxi d,vic$screen ; place to move it to
call update$window$fun

pop psw
pop h
lxi d,screen$40+800h
dad d ; add the screen offset
lxi d,vic$color
;
; Always called from bank 0, Placed in common so that IO
; will not overlay this code. Can go in ROM
;
update$window$fun:
sta io$0
update$window$loop:
lxi b,40 ; number of bytes to move
ldir
push d
lxi d,80-40 ; advance pointer to next line
dad d
pop d
dcr a
jrnz update$window$loop

sta bank$0
ret


page
;
;
;
trk$40:
lda char$col$40 ; get the current column number
sui 40-8 ; remove 1st 32 columns
jrnc use$offset ; if pass column 32, set an offset
xra a
use$offset:
ani 0f8h ; move
sta @off40
ret

page
;
;
;
set$cursor$40:
call no$cursor
call line$paint ; will do a screen paint if required

lda @off40 ; get screen offset
mov b,a ; save offset (0 to 39)
lhld char$col$40 ; H=row, L=col
mov a,l ; get col # in A
sub b ; remove offset
jrc no$cursor
cpi 40
jrnc no$cursor
  mov c,a
mvi b,0 ; BC=cursor column #
mov l,h ; get row # in L
call Lx40$plus$VIC
dad b
jr set$flash
;
no$cursor:
lxi h,0 ; if H=0 (L=xx) then cursor off
;
set$flash:
shld flash$pos
ret

page
;
;
;
Lx40$plus$VIC:
mvi h,0
dad h ; 2X
dad h ; 4X
dad h ; 8X
mov d,h
mov e,l ; DE=8X
dad h ; 16X
dad h ; 32X
dad d ; 8X+32X=40X
lxi d,vic$screen
dad d ; point to screen area
ret

page
;
; input:
; range 20h to 7fh in B
; output:
; in A
;
ascii$to$petascii:
mov a,b
cpi 40h
jrz is40 ; get at sign
rc ; ret if code was 20h - 3fh

cpi 'Z'+1 ; is it an upper case letter ?
rc ; yes, code was 41h - 5Ah

sui 40h
cpi 60h-40h
jrz was$60 ; 60h converted to 27h

jrc was$5b$to$5f

sui 20h
cpi 'z'+1-60h
rc ; code was 61h - 7Ah

cpi '{'-60h
jrz is$left$brace
cpi '|'-60h
jrz is$vert$bar
cpi '}'-60h
jrz isright$brace
cpi '~'-60h
rnz
mvi a,64 ; commodore horz bar
ret

was$60:
mvi a,126 ; solid upper left corner
ret

is$left$brace:
mvi a,115 ;
ret

is$vert$bar:
mvi a,93 ; commodore vertical bar
ret

is$right$brace:
mvi a,107 ;
ret

was$5b$to$5f:
cpi '\'-40h
jrz is$back$slash
cpi '_'-40h
rnz
mvi a,100 ; commodore under line
ret

is$back$slash:
mvi a,127 ; upper left and lower right corners
ret

is40:
xra a
ret

page
;
;
;
cur$adr$40$hl$sz$a:
lhld char$col$40
jr cur$adr$hl$sz$a
;
;
;
cur$adr$80$hl$sz$a:
lhld char$col

;
; INPUT:
; H=row L=col
;
; OUTPUT:
; HL=cursor address
; DE=cursor line start address
; BC=# character to end of line ( <80 )
; (not counting the cursor position)
; A=BC+1
;
cur$adr$hl$sz$a:
mvi a,80-1 ; get line length
sub l ; A=
mov c,a

cur$adr$hl:
mov b,l ; save column #
mov l,h
mvi h,0 ; HL=row #
dad h ; 2x
dad h ; 4x
dad h ; 8x
dad h ; 16x
mov d,h
mov e,l ; save 16x
dad h ; 32x
dad h ; 64x
dad d ; 64x+16x=80x
xchg ; DE=row start address
mov l,b ; get saved column #
mvi h,0 ; HL=column #
dad d ; HL=cursor address

mvi b,0 ; BC= count (if call to cur$adr$hl$sz$a:)
inr a ; number of bytes to end of line (1-80)
ret

page
;
; destroys DE,HL,B,A
;
lookup$color:
mov a,b ; color supplied in B

lookup$color$1:
lhld color$tbl$ptr
;
; HL=table adr
; A= color input
; C= max allowable color value
;
lookup$color$2:
sui 30h ; remove bias
rc
cmp c ; above limit
cmc
rc ; yes, return input out-of-range
mov b,a ; save adjusted color #
ani 0fh ; get only the color #

mov e,a
mvi d,0
dad d ; get converted color address
mov a,b ; get the ASCII char back
ani 30h ; keep only char/background/borber bits
mov b,a ; save char/background bit
ret

page
;
;
;
bell:
lxi b,sid+24
lhld sound$1
outp h
mvi c,5
outp l

lhld sound$2
inr c
outp h
mvi c,1
outp l

lhld sound$3
mvi c,4
outp h
outp l
ret

[Blacklord]

cxrominit.asm

Code Select Expand

page

chr$move macro xx,yy,zz
lxi h,xx*16+DS$char$def
lxi d,yy*16+DS$char$def
lxi b,zz*16-8
call block$move$80
    endm

chr$fill macro xx,yy,zz
lxi h,xx*16+DS$char$def ; start adr
lxi b,yy*16 ; count
mvi d,zz ; character to fill with
call block$fill$80
    endm

newoffset equ 179*11*2
;
; 1st move pet-asc characters to ASCII positions
;
install$ASCII:
lxi h,100h*16+DS$char$def+4 ; point to center of @ char
call rd$mem ; ..read it to B
inr b ; ..if it is a zero then
dcr b ; ..install$ascii has been done
rz ; ..so just exit

Chr$fill 180h,64,0 ; fill 180-1bf with 0

Chr$move 17ah,18ah,1
Chr$move 169h,189h,1
Chr$move 15eh,18eh,2 ; move  2 character definitions
Chr$move 101h,161h,26 ; move 16 character definitions

Chr$fill 100h,32,0

Chr$move 000h,140h,1
Chr$move 01bh,15bh,3 ; move 3 character definitions
Chr$move 01ch,180h,1
Chr$move 01eh,181h,2
Chr$move 040h,1c0h,64 ; move 16 character definitions

; now install characters that are NOT already defined

lxi d,extra$char$table
lxi h,15ch*16+DS$char$def
call char$install

lxi h,15eh*16+DS$char$def
mvi b,3 ; install 5e, 5f and 60
call char$install$group

lxi h,17bh*16+DS$char$def
mvi b,5
jr char$install$group ; call/ret

page
;
; user function, HL supplied on the stack under the stack
;
char$install$gp:
pop h ; get return address
xthl ; get HL from stack (ret adr to stack)
;
; this routine will install a group of characters form
; system memory into the video (character def) memory.
;
; INPUT:
; DE=system memory character definition
; HL=character code adr to install
; B=number of characters to install (should be > 2)
; OUTPUT:
; DE=eight more then on entry
; HL=character code adr to install + B*16
; B=0
;
char$install$group:
push b
push h
call char$install
pop h
lxi b,16
dad b ; advance to the next character
pop b
djnz char$install$group

ret

page
;
; this routine will install the character pointed to by DE
; into the 8563 ASCII char set, character number pointed
; to by HL.
; INPUT:
; DE=system memory character definition
; HL=character code adr to install
; OUTPUT:
; DE=eight more then on entry
; H=0
;
char$install:
call set$update$adr ;
mvi h,8 ; set the loop count

install$char$loop:
ldax d ; get the input data
outp a ; save to video memory
dcr c ; point to status register
inx d ; advance the input pointer

write$wait:
inp a ; wait for the chip to write
ral ; the data to memory (with auto
jrnc write$wait ; incrment)

inr c ; point to the data register
dcr h ; dec the loop count
jrnz install$char$loop

ret

page

[Blacklord]

cxromk.asm

Code Select Expand

PAGE


swap$code:
@sei ; ffd5
@lda 3eh,# ; ffd0
@sta force$map ; ffd2
@lda z80$on,# ; ffd6
@sta mode$reg ; ffd8
@nop ; ffdb
@jmp bios$02 ; ffdc
@nop ; ffdf

di ; ffe5
mvi a,3eh ; ffe0
sta force$map ; ffe2
lxi b,mode$reg ; ffe6
mvi a,z80$off ; ffe9
outp a ; ffeb
nop ; ffed
rst 1 ; ffee jump to load CP/M

swap$size equ $-swap$code
free$space equ 1000h-230-16-$

page
; *********************************
; * *
; * Fixed data tables *
; * *
; *********************************
;
;

org 1000h-230-16 ; -246
;
; 40 column color to RGBI
;
color$convert$tbl:
db 00h ; 0 black
db 0fh ; 1 white
db 08h ; 2 red
db 07h ; 3 cyan
db 0bh ; 4 purple
db 04h ; 5 green
db 02h ; 6 blue
db 0dh ; 7 yellow
db 0ah ; 8 orange
db 0ch ; 9 brown
db 09h ; A light red
db 06h ; B gray 1
db 01h ; C gray 2
db 05h ; D light green
db 03h ; E light blue
db 0eh ; F gray 3

;
;
org 1000h-86-144 ; 8*18 ; -230
;
extra$char$table:
db 000h,060h,030h,018h,00ch,006h,003h,000h ; 1
db 018h,03ch,066h,000h,000h,000h,000h,000h ; 2
db 000h,000h,000h,000h,000h,000h,07fh,000h ; 3
db 060h,030h,018h,000h,000h,000h,000h,000h ; 4
db 01ch,030h,030h,060h,030h,030h,01ch,000h ; 5
db 018h,018h,018h,018h,018h,018h,018h,000h ; 6
db 038h,00ch,00ch,006h,00ch,00ch,038h,000h ; 7
db 000h,01bh,02ah,066h,000h,000h,000h,000h ; 8
db 000h,000h,000h,000h,000h,041h,07fh,000h ; 9
db 000h,0f2h,05bh,039h,001h,04eh,065h,037h ; 10
db 006h,003h,01eh,007h,00bh,068h,04bh,034h ; 11
db 017h,001h,044h,062h,02dh,018h,012h,00bh ; 12
db 063h,059h,031h,017h,000h,00bh,059h,072h ; 13
db 02bh,018h,00fh,063h,000h,04fh,02bh,005h ; 14
db 04ch,068h,02dh,017h,016h,069h,049h,025h ; 15
db 017h,013h,045h,068h,029h,018h,017h,007h ; 16
db 00ch,068h,04bh,034h,013h,00fh,005h,04bh ; 17
db 070h,031h,00dh,00dh,008h,008h,06ch,00dh ; 18

org 1000h-75-11 ; -86

mmu$init$data:
db 3fh,3fh,7fh,3eh,7eh ; config regs
db z80$on,common$16K
db 00
dir$ptrs: ; part of both MMU data and
db 00,01 ; dir$ptrs
db 00


org 1000h-75 ; -75

special$skew:
skew 21,5,0
skew 19,5,0
skew 18,5,0
skew 17,5,0

org free$space

end

[Blacklord]

cxscb.asm

Code Select Expand

public @civec, @covec, @aivec, @aovec, @lovec, @pageM
public @bnkbf, @crdma, @crdsk, @vinfo, @resel, @fx, @usrcd
public @mltio, @ermde, @erdsk, @media, @bflgs
public @date, @hour, @min, @sec, ?erjmp, @mxtpa



scb$base equ 0FE00H          ; Base of the SCB

@CIVEC   equ     scb$base+22h    ; Console Input Redirection
                               ; Vector (word, r/w)
@COVEC   equ     scb$base+24h    ; Console Output Redirection
                               ; Vector (word, r/w)
@AIVEC   equ     scb$base+26h    ; Auxiliary Input Redirection
                               ; Vector (word, r/w)
@AOVEC   equ     scb$base+28h    ; Auxiliary Output Redirection
                               ; Vector (word, r/w)
@LOVEC   equ     scb$base+2Ah    ; List Output Redirection
                               ; Vector (word, r/w)
@pageM equ scb$base+2Ch ; Page mode. 0=page pause
; none 0 = no page break (byte, r/w)
@BNKBF   equ     scb$base+35h    ; Address of 128 Byte Buffer
                               ; for Banked BIOS (word, r/o)
@CRDMA   equ     scb$base+3Ch    ; Current DMA Address
                               ; (word, r/o)
@CRDSK   equ     scb$base+3Eh    ; Current Disk (byte, r/o)
@VINFO   equ     scb$base+3Fh    ; BDOS Variable "INFO"
                               ; (word, r/o)
@RESEL   equ     scb$base+41h    ; FCB Flag (byte, r/o)
@FX     equ     scb$base+43h    ; BDOS Function for Error
                               ; Messages (byte, r/o)
@USRCD   equ     scb$base+44h    ; Current User Code (byte, r/o)
@MLTIO equ scb$base+4Ah ; Current Multi-Sector Count
; (byte,r/w)
@ERMDE   equ     scb$base+4Bh    ; BDOS Error Mode (byte, r/o)
@ERDSK equ scb$base+51h ; BDOS Error Disk (byte,r/o)
@MEDIA equ scb$base+54h ; Set by BIOS to indicate
; open door (byte,r/w)
@BFLGS   equ     scb$base+57h    ; BDOS Message Size Flag (byte,r/o)  
@DATE   equ     scb$base+58h    ; Date in Days Since 1 Jan 78
                               ; (word, r/w)
@HOUR   equ     scb$base+5Ah    ; Hour in BCD (byte, r/w)
@MIN     equ     scb$base+5Bh    ; Minute in BCD (byte, r/w)
@SEC     equ     scb$base+5Ch    ; Second in BCD (byte, r/w)
?ERJMP   equ     scb$base+5Fh    ; BDOS Error Message Jump
                               ; (word, r/w)
@MXTPA   equ     scb$base+62h    ; Top of User TPA
                               ; (address at 6,7)(word, r/o)
; end of normal SCB equates

[Blacklord]

cxvt.asm

Code Select Expand

title 'Terminal Emulation (VT-100)   18 Feb 86'

maclib cxequ

if  use$VT100

maclib z80

lines equ 24

public VT100

;
; VT-100
;
; NUL 00h ignored
; ENQ 05h transmit answer back message
; BEL 07h ring bell
; BS 08h back space. stop at left margin
; HT 09h do TAB
; LF 0Ah do line feed scroll at bottom
; VT 0Bh same as LF
; FF 0Ch same as LF
; CR 0Dh do CR
; SO 0Eh invoke G1 set
; SI 0Fh invoke G0 set
; XON 11h ignored
; XOFF 13h ignored
; CAN 18h abort ESC seq (disp error character)
; SUB 1Ah same as CAN
; ESC 1Bh control seq
; DEL 7Fh not used
;
;
; ESC = Keypad mode
; ESC > Keypad mode
; ESC 7 Save current cursor post and char set
; ESC 8 Restore cursor position and char set
; ESC D move cursor down one line
; ESC E move cursor to start of next line
; ESC H set horizontal tab
; ESC M move cursor up one line
; ESC Z same as ESC [ Pn c
; ESC c reset
; ESC # 3 Double height line Top
; ESC # 4 Double height line Bottom
; ESC # 5 set single width line
; ESC # 6 Double width line
; ESC # 8 files screen with E's
; ESC [ Pn A cursor up
; ESC [ Pn B cursor down
; ESC [ Pn C cursor right
; ESC [ Pn D cursor left
; ESC [ Pn ; Pn H cursor positioning
; ESC [ Ps J erase display
; ESC [ Ps K erase line
; ESC [ Pn c device attributes request
; ESC [ Pn ; Pn f cursor positioning
; ESC [ Ps g clear tab stop(s)
; ESC [ Ps;..;Ps h set mode
; ESC [ Ps;..;Ps l reset attributes
; ESC [ Ps;..;Ps m set attributes
; ESC [ Ps n Device status report
; ESC [ Ps q set LED's
; ESC [ Pn ; Pn r Set Top and Bottom Margins
; ESC [ 2 ; Ps y invoke confidence test
; ESC [ x Report / Req parameters
;; ESC ( A select char set
;; ESC ( B select char set
;; ESC ( 0 select char set
;; ESC ( 1 select char set
;; ESC ( 2 select char set
;; ESC ) A select char set
;; ESC ) B select char set
;; ESC ) 0 select char set
;; ESC ) 1 select char set
;; ESC ) 2 select char set
;
page

dseg
;
; VT-100 terminal emulation
;
VT100:
lhld parm$base ; 1st parm is exec adr (2 bytes)
mov a,m
inx h
mov h,m
mov l,a
ora h ; L is in A already, test HL=0
mov a,c ; C is char to output
jrz start$checking
pchl
;
;
;
start$checking:
lxi h,control$table
lxi b,cnt$tbl$lng
ccir
lxi h,control$exec$adr
jrz find$exec$adr
cpi 20h
rc

do$direct:
mov d,a
TJMP FR$wr$char

page
;
;
;
do$ESC: ; ESC control seq
call cont$later
;
; ESC char look for char in the ESC table
;
call remove$exec$adr
lxi h,esc$table
lxi b,esc$tbl$lng
ccir
rnz ; bad esc sequence
lxi h,esc$exec$adr

find$exec$adr:
dad b
dad b
mov a,m
inx h
mov h,m
mov l,a
pchl

page
;
; ESC #
;
esc$pn: ; ESC # control seq
call cont$later
;
; ESC # char look for char in the ESC table
;
call remove$exec$adr
lxi h,esc$pnd$table
lxi b,esc$pnd$tbl$lng
ccir
rnz ; bad esc sequence
lxi h,esc$pnd$exec$adr
jr find$exec$adr

page
;
; ESC [
;
esc$br: ; ESC [
call clear$parm
call cont$later
;
; ESC [ char look for char in the ESC table
;
cpi '9'+1 ; input char a parameter
jrc put$buffer ; yes, save parameters in buffer
call remove$exec$adr
lxi h,esc$br$table
lxi b,esc$br$tbl$lng
ccir
rnz ; bad esc sequence
lxi h,esc$br$exec$adr
jr find$exec$adr
;
; put byte in buffer pointed to by the put pointer+1 (advance pointer)
;
put$buffer:
mov c,a ; save character in C
call get$par ; get address of parameter buffer
mov e,m ; get low byte adr of input buffer
inx h
mov d,m ; get high byte adr of input buffer
inx h
inr m ; advance input count
mov l,m ; get current count (with input)
mvi h,0 ;
dad d ; compute adr in buf to place input
mov m,c ; place input character into buffer
; stc
ret
;
; get byte from buffer pointed to by the get pointer+1 (advance pointer)
;
get$buffer:
call get$par
mov e,m
inx h
mov d,m
inx h
mov a,m ; recover put counter
inx h
sub m ; test for end
rz
inr m ; advance get counter
mov l,m ; get the get counter
mvi h,0
dad d
mov a,m
do$DEL: ; DEL not used
ret

page
;
;
;
do$CAN: ; CAN SUB  abort ESC seq (disp error character)

;
; Invoke G0 char set
;
do$SI: ; SI invoke G0 set
ret

;
; Invoke G1 char set
;
do$SO: ; SO invoke G1 set
ret

;
; move cursor to margin on current line
;
do$CR: ; CR do CR
TJMP FR$do$cr

;
;
;
do$LF: ; FF VT LF do line feed scroll at bottom
TJMP FR$cursor$down

;
; move cursor to next tab stop or right margin if none
;
do$HT: ; HT do TAB
ret

;
; move cursor to left but not past left margin
;
do$BS: ; BS back space. stop at left margin
TJMP FR$cursor$left

;
; Sound bell tone
;
do$BEL: ; BEL ring bell
RJMP FR$bell

;
; transmit answerback message
;
do$ENQ: ; ENQ transmit answer back message
ret

;
;
;
esc$pn$8: ; ESC # 8 files screen with E's
lxi d,024*256+0 ; set row (D) and col (E)
mvi c,24 ; set # of rows (C)
out$next$line$E:
mvi b,80 ; set # of col (B)
dcr d ; start with row 0
push d
push b
TCALL FR$cursor$pos
pop b
out$next$E:
push b
mvi d,'E'
TCALL FR$wr$char
pop b
djnz out$next$E
pop d
dcr c
jrnz out$next$line$E
ret

;
;
;
esc$pn$6: ; ESC # 6 Double width line
ret

;
;
;
esc$pn$5: ; ESC # 5 set single width line
ret

;
;
;
esc$pn$4: ; ESC # 4 Double height line Bottom
ret

;
;
;
esc$pn$3: ; ESC # 3 Double height line Top
ret

;
; Set tab at current cursor column
;
esc$HH: ; ESC H set horizontal tab
ret

;
; Move cursor down one line, scroll if on bottom margin
;
esc$DD: ; ESC D move cursor down one line

ret

;
; Move cursor to start of next line, scroll up if cursor
; is on the bottom margin
;
esc$EE: ; ESC E move cursor to start of next line

ret

;
; Move cursor up one line, if on top margin scroll down
;
esc$MM: ; ESC M move cursor up one line

ret

;
; reset VT100 to initial state (causes INIT H to be asserted
; briefly ???)
;
esc$c: ; ESC c reset
ret

;
;
;
esc$8: ; ESC 8 Restore cursor position and char set
ret

;
;
;
esc$7: ; ESC 7 Save current cursor post and char set
ret

;
; place Keypad into Numeric mode
;
esc$gt: ; ESC > Keypad mode
ret

;
; place Keypad into Application mode
;
esc$equ: ; ESC = Keypad mode
ret

;
;
;
esc$br$y: ; ESC [2;Ps y invoke confidence test
ret

;
;
;
esc$br$x: ; ESC [ x Report / Req parameters
ret

;
;
;
esc$br$r: ; ESC [Pn;Pn r Set Top and Bottom Margins
ret

;
; Ps=0 clear all LED's (default)
; PS=1 set LED 1
; Ps=2 set LED 2
; Ps=3 set LED 3
; Ps=4 set LED 4
;
esc$br$q: ; ESC [Ps q set LED's
ret

;
; Ps=5 Status Report
; responce is: ESC [0n (terminal OK)
; ESC [3n (terminal not OK)
; Ps=6 Report cursor position
; responce is: ESC [ Pl ; Pc R
; where Pl is the line number
; and Pc is column number
;
esc$br$n: ; ESC [Ps n Device status report
ret

;
; Ps=0 attributes off (default)
; Ps=1 bold or increased intensity
; Ps=4 underscore
; Ps=5 blink
; Ps=7 reverse video
;
esc$br$m: ; ESC [Ps;;Ps m set character attributes
call get$Pn$def0$init
check$br$m:
dcr c ; check # of parameters used
rz ; exit if None
ana a ; Ps=0 ?
jrz set$atr$off ; set attributes off
dcr a ; Ps=1
jrz bold$on ;
dcr a ; Ps=2
dcr a ; Ps=3
dcr a ; Ps=4
jrz underline$on ;
dcr a ; Ps=5
jrz blink$on ;
dcr a ; Ps=6
dcr a ; Ps=7
jrz reverse$on ;
call get$Pn$def0
jr check$br$m

set$atr$off:
bold$on:
underline$on:
blink$on:
reverse$on:
ret


;
; Ps=1 cursor key (l=cursor ; h=application)
; Ps=2 ANSI/VT52 (l=VT52  not supported)
; Ps=3 Column (l=80 col ; h=132 col) 80 only
; Ps=4 Scrolling (l=jump ; h=smooth) smooth only
; Ps=5 Screen (l=normal ; h=reverse)
; Ps=6 Origin (l=Absolute ; h=Relative)
; Ps=7 Auto wrap (l=off ; h=on)
; Ps=8 Auto Repeat (l=off ; h=on)
; Ps=9 interlace (l=off ; h=on)
; Ps=20 LF/NL (l=line feed ; h=new line)
;
esc$br$l: ; ESC [Ps;;Ps l reset mode
ret
;
; see esc$br$l
;
esc$br$h: ; ESC [Ps;;Ps h set mode
ret

;
; Ps=0 clear tab stop at current column (default)
; Ps=3 clear ALL tab stops
;
esc$br$g: ; ESC [Ps g clear tab stop(s)
ret

;
; Pn default =1 missing Pn uses default value(s)
; position cursor to line (1st) and column (2nd)
; uses DECOM parm to set origin mode (within margin
; or full screen)
;
esc$br$f: ; ESC [Pn;Pn f cursor positioning
esc$br$HH: ; ESC [Pn;Pn H cursor positioning
call get$Pn$def1$init
dcr a
mov d,a
call get$Pn$def1 ; DE are not changed by this call
dcr a
mov e,a
TJMP FR$cursor$pos

;
; What are you
; response is: ESC [?1; Ps c
; where Ps is:
; 0=base VT100, no options
; 1=processor option (STP)
; 2=advanced video option (AVO)
; 3=AVO and STP
; 4=graphics processor option (GPO)
; 5=GPO and STP
; 6=GPO and AVO
; 7=GPO, STP and AVO
;
esc$ZZ: ; ESC Z same as ESC [ Pn c
esc$br$c: ; ESC [Pn c device attributes request
ret

;
; Ps=0 from cursor to end of line (default)
; Ps=1 from start of line to cursor
; Ps=2 all of cursor line
;
esc$br$KK: ; ESC [Ps K erase line
ret

;
; Ps=0 from cursor to end of screen
; Ps=1 from start of screen to cursor
; Ps=2 all of screen (cursor is not moved)
;
esc$br$JJ: ; ESC [Ps J erase display
ret

;
;
;
esc$br$DD: ; ESC [Pn D cursor left
ret

;
;
;
esc$br$CC: ; ESC [Pn C cursor right
ret

;
;
;
esc$br$BB: ; ESC [Pn B cursor down
ret

;
;
;
esc$br$AA: ; ESC [Pn A cursor up
ret

page
;
; convert number to binary
; stop conversion at end or any none number
; (DE may not be changed)
;
get$Pn$def0$init:
call init$get ; set up to read buffer
;
get$Pn$def0:
call get$in$parm
mov a,b ; get input data to A
ret
;
;***** NOTE ESC [ ;4;A is the same as ESC [ 0;4;5A
;
;
; convert number to binary
; stop conversion at end or any none number
; return 1 if input is missing or a zero
; (DE may not changed)
;
get$Pn$def1$init:
call init$get ; set up to read buffer
;
get$Pn$def1:
call get$in$parm
mov a,b ; get input data to A
ora a ; is input =0?
rnz ; no, then use it
inr a ; yes, then use default of 1
ret

;
; B=converted number in binary (from input string)
; C=number of digits converted+1
; A=0 if ran out of input else A=last character read from string
; (DE may not be changed)
;
get$in$parm:
lxi b,1 ; B=0, C=1
get$next$num:
lda save$count
dcr a
rz
sta save$count
lhld buff$pointer ; get input buffer adr
inx h ; PRE incr adr
shld buff$pointer
mov a,m
call test$num
rc
slar b ; 2x
add b ; A=A+2B
slar b ; 4x
slar b ; 8x
add b ; A=A+2B+8B=A+10B
mov b,a ; save in B
inr c ; advance parmeter count
jr get$next$num

;
; return with carry set (Cy=1) if not a number (A=input Char)
; return bianary number in A if it was a number (Cy=0)
;
test$num:
cpi '0'
rc
cpi '9'+1
cmc
rc
sui '0'
ret
;
; set up local values to use buffer parameters
;
init$get:
call get$par ; get pointer to buffer(s)
mov e,m
inx h
mov d,m
inx h
mov a,m
inr a ; adjust for PRE decr
sta save$count
; inx h
; mov a,m
; sta get$count
xchg
shld buff$pointer
ret

save$count:
db 0
buff$pointer:
dw 0

page
;
; set buffer back to start
;
clear$parm:
call get$par
inx h
inx h
mvi m,0 ; zero out the input count
ret
;
;
;
get$par:
lxi h,vt100$par$80
lda fun$offset
ana a
rz
lxi h,vt100$par$40
ret
;
;
;
vt100$par$80:
dw buffer$80
db 0 ; current put pointer into buffer
;
;
;
vt100$par$40:
dw buffer$40
db 0 ; current put pointer into buffer

buffer$80 equ $-1
ds 20
buffer$40 equ $-1
ds 20

page
;
;
;
cont$later:
pop h ; get address to cont at in H
jr save$exec$adr ; save it
;
;
;
remove$exec$adr:
lxi h,0
save$exec$adr:
xchg
lhld parm$base
mov m,e
inx h
mov m,d
ret

page
;
; table scanned top to bottom
;
control$table:
db 05h ; ENQ transmit answer back message
db 07h ; BEL ring bell
db 08h ; BS back space. stop at left margin
db 09h ; HT do TAB
db 0Ah ; LF do line feed scroll at bottom
db 0Bh ; VT same as LF
db 0Ch ; FF same as LF
db 0Dh ; CR do CR
db 0Eh ; SO invoke G1 set
db 0Fh ; SI invoke G0 set
db 18h ; CAN abort ESC seq (disp error character)
db 1Ah ; SUB same as CAN
db 1Bh ; ESC control seq
db 7Fh ; DEL not used

cnt$tbl$lng equ $-control$table

;
; table scanned bottom to top
;
control$exec$adr:
dw do$DEL ; DEL not used
dw do$ESC ; ESC control seq
dw do$CAN ; SUB same as CAN
dw do$CAN ; CAN abort ESC seq (disp error character)
dw do$SI ; SI invoke G0 set
dw do$SO ; SO invoke G1 set
dw do$CR ; CR do CR
dw do$LF ; FF same as LF
dw do$LF ; VT same as LF
dw do$LF ; LF do line feed scroll at bottom
dw do$HT ; HT do TAB
dw do$BS ; BS back space. stop at left margin
dw do$BEL ; BEL ring bell
dw do$ENQ ; ENQ transmit answer back message

page
;
; table scanned top to bottom
;
esc$table:
db '=' ; ESC = Keypad mode
db '>' ; ESC > Keypad mode
db '7' ; ESC 7 Save current cursor post and char set
db '8' ; ESC 8 Restore cursor position and char set
db 'D' ; ESC D move cursor down one line
db 'E' ; ESC E move cursor to start of next line
db 'H' ; ESC H set horizontal tab
db 'M' ; ESC M move cursor up one line
db 'Z' ; ESC Z same as ESC [ Pn c
db 'c' ; ESC c reset
db '#' ; ESC # control seq
db '[' ; ESC [ cursor up
esc$tbl$lng equ $-esc$table

;
; table scanned bottom to top
;
esc$exec$adr:
dw esc$br ; ESC [ cursor up
dw esc$pn ; ESC # control seq
dw esc$c ; ESC c reset
dw esc$ZZ ; ESC Z same as ESC [ Pn c
dw esc$MM ; ESC M move cursor up one line
dw esc$HH ; ESC H set horizontal tab
dw esc$EE ; ESC E move cursor to start of next line
dw esc$DD ; ESC D move cursor down one line
dw esc$8 ; ESC 8 Restore cursor position and char set
dw esc$7 ; ESC 7 Save current cursor post and char set
dw esc$gt ; ESC > Keypad mode
dw esc$equ ; ESC = Keypad mode

;
;
;
esc$pnd$table:
db '3' ; ESC # 3 Double height line Top
db '4' ; ESC # 4 Double height line Bottom
db '5' ; ESC # 5 set single width line
db '6' ; ESC # 6 Double width line
db '8' ; ESC # 8 files screen with E's

esc$pnd$tbl$lng equ $-esc$pnd$table

esc$pnd$exec$adr:
dw esc$pn$8 ; ESC # 8 files screen with E's
dw esc$pn$6 ; ESC # 6 Double width line
dw esc$pn$5 ; ESC # 5 set single width line
dw esc$pn$4 ; ESC # 4 Double height line Bottom
dw esc$pn$3 ; ESC # 3 Double height line Top

;
;
;
esc$br$table:
db 'A' ; ESC [ Pn A cursor up
db 'B' ; ESC [ Pn B cursor down
db 'C' ; ESC [ Pn C cursor right
db 'D' ; ESC [ Pn D cursor left
db 'H' ; ESC [ Pn ; Pn H cursor positioning
db 'J' ; ESC [ Ps J erase display
db 'K' ; ESC [ Ps K erase line
db 'c' ; ESC [ Pn c device attributes request
db 'f' ; ESC [ Pn ; Pn f cursor positioning
db 'g' ; ESC [ Ps g clear tab stop(s)
db 'h' ; ESC [ Ps;..;Ps h set mode
db 'l' ; ESC [ Ps;..;Ps l reset attributes
db 'm' ; ESC [ Ps;..;Ps m set attributes
db 'n' ; ESC [ Ps n Device status report
db 'q' ; ESC [ Ps q set LED's
db 'r' ; ESC [ Pn ; Pn r Set Top and Bottom Margins
db 'x' ; ESC [ x Report / Req parameters
db 'y' ; ESC [ 2 ; Ps y invoke confidence test

esc$br$tbl$lng equ $-esc$br$table

esc$br$exec$adr:
dw esc$br$y ; ESC [2;Ps y invoke confidence test
dw esc$br$x ; ESC [ x Report / Req parameters
dw esc$br$r ; ESC [Pn;Pn r Set Top and Bottom Margins
dw esc$br$q ; ESC [Ps q set LED's
dw esc$br$n ; ESC [Ps n Device status report
dw esc$br$m ; ESC [Ps;;Ps m set attributes
dw esc$br$l ; ESC [Ps;;Ps l reset attributes
dw esc$br$h ; ESC [Ps;;Ps h set mode
dw esc$br$g ; ESC [Ps g clear tab stop(s)
dw esc$br$f ; ESC [Pn;Pn f cursor positioning
dw esc$br$c ; ESC [Pn c device attributes request
dw esc$br$KK ; ESC [Ps K erase line
dw esc$br$JJ ; ESC [Ps J erase display
dw esc$br$HH ; ESC [Pn;Pn H cursor positioning
dw esc$br$DD ; ESC [Pn D cursor left
dw esc$br$CC ; ESC [Pn C cursor right
dw esc$br$BB ; ESC [Pn B cursor down
dw esc$br$AA ; ESC [Pn A cursor up

endif
end

;
;
;
esc$esc:
call cont$later
;
; check for ESC ESC ESC
;
cpi esc ; check if 3rd char is an ESC
jrnz remove$exec$adr
call cont$later
;
; set current character as the attr
;
mov b,a
TCALL FR$color
jr remove$exec$adr


;
;
;
esc$equ:
call cont$later
;
; ESC = R
;
lhld parm$base
inx h
inx h
sui ' ' ; remove ascii bias
mov m,a
cpi '8'-' ' ; test for line 25 (A=24?)
jrnz not$status$line ; no, jmp
inr a ; yes, A=25
sta paint$size ; set 40 column repaint to 25 lines
not$status$line:
call cont$later
;
; ESC = R C (go do it)
;
sui ' '
mov e,a ; column # to E

lhld parm$base
inx h
inx h
mov d,m ; row # to D
TCALL FR$cursor$pos
jr remove$exec$adr

page
;
;
;
char$cnt$z: ; ^Z home and clear screen
lxi d,lines*256+0 ; B=24(row) C=0(col)
TCALL FR$cursor$pos
call esc$t ; clear the status line
lxi d,0
TCALL FR$cursor$pos
esc$y:
TJMP FR$CES ; clear to end of screen

home$cursor:
lxi d,0
TJMP FR$cursor$pos

esc$t:
TJMP FR$CEL ; clear to end of line

;
;
;
cursor$rt:
TJMP FR$cursor$rt

;
;
;
cursor$up:
TJMP FR$cursor$up


page

;
; delete character
;
esc$W:
TJMP FR$char$del

;
; delete line
;
esc$R:
TJMP FR$line$del

;
; insert character
;
esc$Q:
TJMP FR$char$ins

;
; insert line
;
esc$E:
TJMP FR$line$ins

page
;
; Half Intensity Off
;
esc$lfp:
mvi c,00000001b ; turn intensity up
jr set$FR$atr$c
;
; Half Intensity On
;
esc$rtp:
mvi c,00000000b ; turn intensity down
parn$cont:
mvi b,00000001b ; attribute bit to change
jr set$FR$attr

;
; Set Attribute sequence
;
esc$G:
call cont$later
;
; ESC G char
;
call remove$exec$adr
sui '4' ; '4' reverse video on
jrz esc$G$4
inr a ; '3' underline attr on
jrz esc$G$3
inr a ; '2' blink attr on
jrz esc$G$2
inr a ; '1' alt char set
jrz esc$G$1
inr a ; '0' clear attributes
rnz
;
; Rev. Video, blink, atl char set, and underline  off
;
esc$G$0:
mvi c,10000000b ; turn attributes off
mvi b,11110000b ; attribute bit to change
jr set$FR$attr

;
; Select alt character set
;
esc$G$1:
mvi c,00000000b ; select alt character set
mvi b,10000000b
jr set$FR$attr

;
; Blinking On
;
esc$G$2:
mvi c,00010000b ; turn on blink attr
jr set$FR$atr$c

;
; Under line
;
esc$G$3:
mvi c,00100000b ; turn on underline bit
jr set$FR$atr$c

;
; Reverse Video On
;
esc$G$4:
mvi c,01000000b ; turn attributes on

set$FR$atr$c:
mov b,c ; reverse attr
set$FR$attr:
TJMP FR$attr

[Blacklord]

fast8502.asm

Code Select Expand

title '8502 drivers        4 Mar 86'

maclib x6502

maclib z80

maclib cxequ

$-MACRO
;
;      COMMON EQUATES
;
; page 0 variables, from 0a to 8f are usable
;
prtno equ 0000Ah ; 0Ah
second$adr equ prtno+1 ; 0Bh
DATCHN equ second$adr+1 ; 0Ch
CMDCHN equ datchn+1 ; 0Dh
DEVNO equ cmdchn+1 ; 0Eh
adr$1 equ devno+1 ; 0Fh
temp$byte equ adr$1+2 ; 11h
; equ temp$byte+1 ; 12h

pal$nts equ 00a03h ; FF=PAL=50Hz 0=NTSC=60Hz
serial equ 00a1ch
d2pra equ 0dd00h ; serial control port (clk and data)
d1sdr equ 0dc0ch ; Fast serial data reg.
d1icr equ 0dc0dh ; serial channel interrupt control reg

clkbit equ 10h ; d2pra clock bit mask
;
; KERNAL EQUATES
;
K$spin$spout equ 0FF64h ; C=0 spin  C=1 spout

K$setbnk equ 0FF68h ; set the logical bank # for open
;  disk commands
;I A=load and store bank # (C128 type bank)
;  X=file name bank #

K$readst equ 0FFB7h ; read status byte
;O A = status

K$setlfs equ 0FFBAh ; setup a logical file
;I A=logical file #
;  X=device # (0-31)
;  Y=seconday command (FF if nane)

K$setnam equ 0FFBDh ; set up file name for OPEN
;I A=name length
;  X=low byte pointer to name
;  Y=high byte pointer to name

K$open equ 0FFC0h ; open a logical file (after setlfs
; and setnam)
;O A = error # (1,2,4,5,6,240)

K$chkin equ 0FFC6h ; open a channel for input
;I X = logical file #
;O A = errors #(0,3,5,6)

K$chkout equ 0FFC9h ; open a channel for output
;I X = logical file #
;O A = error #(0,3,5,7)

K$clrchn equ 0FFCCh ; clears ALL I/O channel

K$chrin equ 0FFCFh ; get a character from input channel
;O A=input character

K$chrout equ 0FFD2h ; output a character to output channel
;I A =output char

;GETIN equ 0FFE4h

K$clall equ 0FFE7h ; close ALL open logical files

K$close equ 0FFC3h ; close a logical file
;I A = logical channel # to be closed
;O A = error #(0,240)

RESET equ 0FFFCh

PAGE
;
org bios8502
;
; **** THIS IS THE COMMAND LOOP ****
;
start:
  if use$fast
@ldx sys$speed ;-K  get desired system speed
@stx vic$speed ;-K  set system speed
  endif
@ldx -1,# ;-K
@txs ;-K set the stack to the top
@JSR VICIO ;-K  go find and do requested operation
bios$exit:
@sei ;?K  DISABLE INTERRUPTS
@ldx 3eh,# ;?K  set up Z80 memory map as required
@stx force$map ;?K
@ldx 82h,# ;-K
@stx CIA1+int$ctrl ;-K  turn on CIA timer B interrupts
  if use$fast
@ldx 0,# ;-K  get value for 1 MHz mode (slow)
@stx vic$speed ;-K  set system speed
  endif
@jmp enable$z80+6 ;-K

PAGE
;
;
;
iotbl:
dw sys$reset ;-1 reset system (C128)
dw initilize ;0 initialize the 8502
dw READ ;1 Read a sector of data to sector buffer
dw WRITE ;2 Write a "     "   "   "    "      "
dw readf ;3 Set-up for fast read (154X only)
dw writef ;4 Set-up for fast write (154X only)
dw dsktst ;5 test for 154x and diskette type
dw query$dsk ;6 get disk characteristics
dw PRINT ;7 print data character
dw FORMAT ;8 format disk as 1541 disk
dw user$fun ;9 vector to user code (L=viccount,H=vicdata)
dw ram$dsk$rd ;10 RAM disk read
dw ram$dsk$wr ;11 RAM disk write


NUMCMD equ ($-IOTBL)/2 ; NUMBER OF COMMANDS
iotbl$low equ low(iotbl)


;
;
;
sys$reset: ;**CMD ENTRY**
@jsr en$kernal ;-K
@JMP (RESET) ;+K
;
;
;
user$fun: ;**CMD ENTRY**
@jmp (vic$count) ;-K

page
;
; **** IO COMMAND DISPATCH ROUTINE ****
;
VICIO:
@lda vic$cmd ;-K  get the command
@cmp NUMCMD,# ;-K  is this a valid command
@bcs bad$command ;-K  no, exit without doing anything
;-K  yes, get vector to it
@cld ;-K  clear to binary mode
@asl a ;-K  A=2*CMD (carry cleared)
@clc ;-K
@adc iotbl$low+2,# ;-K  add to vector table start address
@sta VICIO2+1 ;-K  modify the JMP instructions ind adr
VICIO2:
@jmp (IOTBL) ;-K  this is the ind adr that
  ; is modified above
;
;
;
input$byte:
@sei
@lda d2pra
@eor clk$bit,#
@sta d2pra
;
@lda 8,#
in$1:
@bit d1icr
@beq in$1
@lda d1sdr
bad$command:
@RTS ;-K

page
;
; initialize the 8502
;
initilize: ;**CMD ENTRY**
@ldx low(irqs),# ;-K
@ldy high(irqs),# ;-K
@stx 314h ;-K  IRQ vector
@sty 315h ;-K
@stx 316h ;-K  BRK vector
@sty 317h ;-K
@stx 318h ;-K  NMI vector
@sty 319h ;-K

@jsr en$kernal ;-K
@lda 0fffeh ;+K
@sta 0fffeh ;+K  write to RAM under ROM
@lda 0ffffh ;+K
@sta 0ffffh ;+K

@lda 6,# ;+K
@sta CIA2+data$dir$b ;+K setup user port for RS232

@lda pal$nts ;+K -1=50Hz(PAL) 0=60Hz(NTSC)
@sta sys$freq ;+K
@jmp K$clall ;+K  close all open files

PAGE
;
; **** DISK SECTOR READ ****
;
READ: ;**CMD ENTRY**
@JSR set$drv ;-K
@jsr en$kernal ;+K
@ldx datchn ;+K
@jsr K$chkin ;+K
@bcs disk$changed ;+K
@jsr K$clrchn ;+K  clear the input channel for now

@LDA '1',# ;+K  read command
@JSR setup ;+K  send it
@JSR CKINDT ;+K
@LDX 0,# ;+K
;
READ1:
@JSR K$chrin ;+K  get a byte from the KERNAL
@STA @BUFFER,X ;+K  save it in the buffer
@INX ;+K  advance the buffer pointer
@BNE READ1 ;+K  loop back if not past buf end
@jmp K$clrchn ;+K  CLEAR CHANNEL
;
;
disk$changed:
@lda 0bh,# ;?K  disk changed error code
@sta vic$data ;?K
@jmp en$K$open ;?K

page
;
; **** DISK SECTOR WRITE ****
;
WRITE: ;**CMD ENTRY**
@jsr set$drv ;-K
@jsr ckotcm ;-K
@LDY setpnt$lng,# ;+K
;
WRITE0:
@LDA SETPNT,X ;+K
@JSR K$chrout ;+K
@INX ;+K
@DEY ;+K
@BNE WRITE0 ;+K

@JSR K$clrchn ;+K
@JSR CKINCM ;+K
@BNE WRITE2 ;+K

@JSR K$clrchn ;+K
@JSR CKOTDT ;+K
@LDX 0,# ;+K
;
WRITE1:
        @sei ;+K  disable interrupts
@ldy 3fh,# ;+K  enable all RAM in bank 0
@sty force$map ;+K
@LDA @BUFFER,X ;-K
@ldy 0,# ;-K  re-enable kernal
@sty force$map ;-K
@JSR K$chrout ;+K  write buffer character
@INX ;+K
@BNE WRITE1 ;+K  write all 256 bytes of buffer

@JSR K$clrchn ;+K  clear the channel
@LDA '2',# ;+K  write command
@JMP setup ;+K
;
WRITE2:
@lda 0ffh,# ;+K
@sta vic$data ;+K  writes thru ROM to RAM
@jmp opencm ;+K

page
;
; Set-up for fast disk write
;
writef: ;**CMD ENTRY**
@lda 2,# ;-K 2=read command
@skip2 ;-K
;
; Set-up for fast disk read
;
readf: ;**CMD ENTRY**
@lda 0,# ;-K 0=read command
@sta f$cmd ;-K
@lda 0,# ;-K
@sta vic$data ;-K
@jsr set$drv$f ;-K
@ldy f$cmd$lng,# ;-K  command set above rd/wr
@jsr send$fast ;-K
@jmp clk$hi ;+K

page
;
; test the format of the disk return code to CP/M
; telling the disk type. Also test for FAST disk drive.
;
dsktst: ;**CMD ENTRY**
@lda vic$drv ;-K
@eor 0ffh,# ;-K
@and fast ;-K
@sta fast ;-K  clear fast indicator bit for current drive

@jsr set$and$open ;-K  set drv close and reopen the channel

@ldx 0,# ;+K  delay to allow drive to reset status
tst$delay:
@nop ;+K
@nop ;+K
@dex ;+K
@bne tst$delay ;+K

@ldy inq$cmd$lng,# ;+K
@ldx inq$cmd,# ;+K
@jsr send$fast$cmd ;+K

@jsr input$byte ;+K
@sta vic$data ;+K
@jsr clk$hi ;+K
@sty io$0 ;+K  2/24
@lda vic$drv ;-K
@ora fast ;-K  set current drive as fast
@sta fast ;-K
@rts ;-K

page
;
;
;
query$dsk: ;**CMD ENTRY**
@jsr set$drv$f ;-K  will query track set by user
@ldy query$cmd$lng,# ;-K  command length is 4
@ldx query$cmd,# ;-K
@jsr send$fast$cmd ;-K
@jsr input$byte ;+K
@sta vic$data ;+K
@bpl clk$hi ;+K  exit if not MFM
@and 0eh,# ;+K  test for error
@bne clk$hi ;+K  exit if error
@jsr input$byte ;+K  read offset sectors status byte
@sta @buffer ;+K
@and 0eh,# ;+K  test for error
@bne clk$hi ;+K  exit if error
@tax ;+K get a zero in X
@ldy 5,# ;+K five info bytes are sent back
query$loop:
@inx
@jsr input$byte
@sta @buffer,X
@dey
@bne query$loop

clk$hi:
@lda d2pra ;+K set clock bit HIGH
@and 0ffh-clkbit,#
@sta d2pra
@rts

PAGE
;
; **** PRINTER OUTPUT ****
;
; this routine will support two printers
; the device number is passed in vic$drv (4,5)
; secondary address in vic$trk
; the logical file number is equal to the device #
; if VIC$count=0 then output character in VIC$data
; if VIC$count<>0 then output characters pointered to by @buffer
;
PRINT: ;**CMD ENTRY**
@lda vic$drv ;-K
@sta prtno ;-K
@lda vic$trk ;-K
;; @sta second$adr ;-K  this line should be deleted and one
@cmp second$adr ;-K  ..below used.
@sta second$adr ;-K  save secondary adr
@bne reopen$prt ;-K

@jsr en$kernal ;-K
print$cont:
@ldx prtno ;+K
@JSR K$chkout ;+K
@BCS PERR0 ;+K  PRINT ERROR IF CARRY SET

@sty io$0 ;+K  2/24
@ldx vic$count ;-K  
@bne print$buffer ;-K
@LDA vic$data ;-K  GET CHARACTER
@sta io$0 ;-K
@JSR K$chrout ;+K  AND PRINT IT
@JMP K$clrchn ;+K  CLEAR CHANNEL

print$buffer:
@stx temp$byte ;-K
@lda @buffer ;-K
@sta adr$1 ;-K
@lda @buffer+1 ;-K
@sta adr$1+1 ;-K
@ldy 0,# ;-K
@ldx 0,# ;-K

print$buf$loop:
@sta bank$0 ;?K enable RAM bank 0 (no I/O)
@lda (adr$1),y ;rK
@stx force$map ;rK
@jsr K$chrout ;+K
@iny ;+K
@dec temp$byte ;+K
@bne print$buf$loop ;+K
@jmp K$clrchn ;+K

;
;
PERR0:
@CMP 3,# ;+K  FILE NOT OPEN?
@BNE PERR1 ;+K  BRANCH IF NO
reopen$prt:
@JSR OPNPRT ;?K  OPEN PRINTER CHANNEL
@BCC print$cont ;+K  IF CARRY CLEAR, OK TO PRINT
PERR1: @LDA 255,# ;+K  NO DEVICE PRESENT
@STA vic$data ;+K  FLAG BAD ATTEMPT writes to ram under ROM
PRTST: @RTS ;+K

PAGE
;
; **** FORMAT DISK ROUTINE ****
;
FORMAT: ;**CMD ENTRY**
@jsr set$drv$num ;-K
@lda fast ;-K
@and vicdrv ;-K
@bne format$fast ;-K

@JSR CKOTCM ;-K  returns X=0
@LDY fmtcmd$lng,# ;+K
FMT1: @LDA FMTCMD,X ;+K
@JSR K$chrout ;+K
@INX ;+K
@DEY ;+K
@BNE FMT1 ;+K
@JSR K$clrchn ;+K
fmt2: @JSR CKINCM ;+K check for errors
@BEQ setup3 ;+K no errors, return good status
@BNE setup5 ;+K error return error status

format$fast:
@ldx @buffer ;-K get command length
fast$F: ;-K
@lda @buffer+1-1,x ;-K
@sta F$cmd-1,x ;-K
@dex ;-K transfer command tail from buffer+1
@bne fast$F
@ldy @buffer ;-K
@iny ;-K
@iny ;-K  count is tail length plus 2
@ldx F$cmd ;-K
@jsr send$fast$cmd ;-K
@jmp fmt2 ;+K

PAGE
;
;
;
ram$dsk$rd: ; RAM disk read
@ldx 81h,# ;-K
@skip$2 ;-K
;
;
;
ram$dsk$wr: ; RAM disk write
@ldx 80h,# ;-K
  if use$fast
@lda 0,# ;-K  0=slow (1 MHz)
@sta vic$speed ;-K  set to slow mode
  endif
@lda 3Fh,#
@stx RM$command ;-K  give command to RAM DISK
  @sta force$map ;    remove I/O area
@rts ;-K


PAGE
;
;
;
setup:
@STA DSKCMD+1 ;?K
@LDA 2,# ;?K  RETRY COUNT
@STA vic$data ;?K  writes to RAM under ROM

@JSR CKOTCM ;?K  returns X=0
@LDY dskcmd$lng,# ;+K
setup2:
@LDA DSKCMD,X ;+K
@JSR K$chrout ;+K
@INX ;+K
@DEY ;+K
@BNE setup2 ;+K

@JSR K$clrchn ;+K
@JSR CKINCM ;+K
@BEQ setup3 ;+K

@sty io$0 ;+K  2/24
@DEC vic$data ;-K
@BEQ setup5 ;-K

@jmp disk$changed ;-k
;
;
setup5:
@LDA 0dh,# ;?K  normal read/write error flag
@skip2 ;?K  ALWAYS
;
;
;
setup3:
@lda 0,# ;?K  get data good flag
setup4:
@STA vic$data ;?K  writes to RAM under ROM
@jsr en$kernal ;?K
@JMP K$clrchn ;+K

page
;
;
;
send$fast$cmd:
@jsr set$cmd ;?K  unit # must have been set already
send$fast:
@ldx 0,# ;?K
@stx force$map ;?K  enable the kernal
@ldx cmdchn ;+K
@jsr K$chkout ;+K
@bcs chan$error ;+K
@ldx 0,# ;+K
sendf:
@lda f$cmd$buf,x ;+K
@jsr K$chrout ;+K
@inx ;+K
@dey ;+K
@bne sendf ;+K
@jsr K$clrchn ;+K
@bit serial ;+K
@bvc not$fast ;+K
@bit d1icr ;+K  clear interrupts from chip
@rts ;+K

chan$error:
@lda 0dh,# ;+K  get error code
@skip2 ;+K
not$fast:
@lda 0ch,# ;+K  get error code
@sta vic$data ;+K
@jsr clk$hi ;+K
@jmp bios$exit ;+K
;
;
;
set$cmd:
@lda dskcmd+5 ;?K check lsb of unit #
@ror a ;?K get lsb to carry bit
@bcc unit$0 ;?K
@inx ;?K  make command for unit 1
unit$0:
@stx F$cmd ;?K
@rts

page
;
; ........not tested........
;
;rd$buff:
; @sei ; disable interrupts
; @lda vic$data
; @sta adr$1+1 ; save hi part of address
; @lda 0,#
; @sta adr$1 ; save low part of address
; @tax ; get a zero for both indexes
; @tay
;
;rd$buf$1:
; @lda (adr$1),y
; @sta @buffer,x
; @inx
; @iny
; @bne rd$buf$1
; @rts

PAGE
;
;
;
set$drv:
@lda vic$trk ;-K
@jsr binasc ;-K
@stx dskcmd+7 ;-K
@sta dskcmd+8 ;-K

@lda vic$sect ;-K
@bmi no$side$1 ;-K
@jsr binasc ;-K
@stx dskcmd+10 ;-K
@sta dskcmd+11 ;-K
@jmp set$drv$num ;-K

no$side$1:
@lda 04h,# ;-K
@sta vic$data ;-K
@jmp bios$exit ;-K

;
;
;
set$drv$f:
@lda vic$count ;-K
@sta f$rd$count ;-K

@lda vic$trk ;-K
@sta f$rd$trk

@lda vic$sect ;-K
@bpl side$0 ;-K
@tax ;-K
@lda f$cmd ;-K
@ora 10h,# ;-K
@sta f$cmd ;-K
@txa ;-K
@and 7fh,# ;-K
side$0:
@sta f$rd$sect ;-K

page
;
; VIC$DRV       dev,dat,cmd
; 00000001 device  #8-0 8,11,15
; 00000010 device  #9-0 9,12,16
; 00000100 device #10-0 10,13,17
; 00001000 device #11-0 11,14,18
; 10000001 device  #8-1 8,11,15
; 10000010 device #9-1 9,12,16
; 10000100 device #10-1 10,13,17
; 10001000 device #11-1 11,14,18
;
set$drv$num:
@ldy 8-1,# ;-K start as drive 8
@ldx '0',# ;-K ..unit 0
@lda vic$drv ;-K get requested drv#
@bpl unit$nu$0
@inx ;-K make unit 1
unit$nu$0:
@iny ;-K add one to the drive #
@lsr a ;-K is drive number correct?
@bcc unit$nu$0 ;-K no, loop back

@stx dskcmd+5 ;-K save unit# to disk cmd string
@stx fmtcmd+1 ;-K save unit# to format cmd string
@txa
@ror a ;-K get lsb to carry bit
@lda F$cmd
@and 0feh,#
@adc 0,# ; set the lsb if carry set (carry cleared)
@sta F$cmd
@tya ;-K get device # to A
@sta devno ;-K save device #
@adc 3,# ;-K make the data chan# (carry cleared above)
@sta datchn ;-K save data chan#
@adc 4,# ;-K make the cmd chan#
@sta cmdchn ;-K save cmd chan#
@lda serial ;-K
@and 0bfh,# ;-K
@sta serial ;-K  clear the fast serial indicator
@rts ;-K

page

;
; **** CONVERT BINARY TO ASCII ****
;
BINASC:
@CLD ;?K
@LDX '0',# ;?K
@SEC ;?K

BA0:
@SBC 10,# ;?K
@BCC BA1 ;?K

@INX ;?K
@BCS BA0 ;?K

BA1:
@ADC 3Ah,# ;?K
@RTS ;?K

PAGE
;
; **** OPEN DISK COMMAND CHANNEL ****
;
set$and$open:
@jsr set$drv$num ;-K
en$K$open:
@jsr en$kernal ;-K
opencm:
@LDA CMDCHN ;+K
@clc ;+K  clear the carry to force true closing
@JSR K$close ;+K

@LDA CMDCHN ;+K
@LDX DEVNO ;+K
@LDY 15,# ;+K
@JSR K$setlfs ;+K

@lda 0,# ;+K  bank (C128 type) for load and store
@sta F$stat ;+K  write status byte value = 0
@tax ;+K  file name bank (C128 type bank#)
@jsr K$setbnk ;+K

@ldx write$stat,# ;+K
@jsr set$cmd ;+K

@lda 4,# ;+K write status command lenght
@ldx low(f$cmd$buf),# ;+K
@ldy high(f$cmd$buf),# ;+K
@JSR K$setnam ;+K

@JSR K$open ;+K
@bcs misdsk

@JSR K$readst
@ROL A ;+K  GET MSB TO CARRY
@BCS MISDSK ;+K  DEVICE MISSING IF CARRY SET

@bit serial ;+K  test for fast device
@bvs no$dt$open ;+K  do not open data channel if fast
;
; **** OPEN DISK DATA CHANNEL ****
;
OPENDT:
@LDA DATCHN ;+K
@clc ;+K  forces true closing of channel
@JSR K$close ;+K
@LDA DATCHN ;+K
@LDX DEVNO ;+K
@LDY 8,# ;+K
@JSR K$setlfs ;+K
@lda 0,# ;+K  bank (C128 type) for load and store
@tax ;+K  file name bank (C128 type bank#)
@jsr K$setbnk ;+K
@LDA 1,# ;+K
@LDX low(POUND),# ;+K
@LDY high(POUND),# ;+K
@JSR K$setnam ;+K
@jsr K$open ;+K
@bcs misdsk
no$dt$open:
@rts

page
;
;
;  * DEVICE MISSING, CLEAN UP ERROR *
;
MISDSK:
@LDA 0fh,# ;+K  SET ERROR CODE for missing drive
@STA vic$data ;+K  writes to RAM under ROM
@LDA CMDCHN ;+K  K$close CHANNEL
@clc ;+K  force true closing of channel
@JSR K$close ;+K
@JMP bios$exit ;+K

PAGE
;
; **** SELF CORRECTING CHECK IO ROUTINES ****
;
CKICM:
@JSR OPENCM ;+K

CKINCM:
@LDX CMDCHN ;+K
@JSR K$chkin ;+K
@BCS CKICM ;+K

@JSR K$chrin ;+K
@CMP '0',# ;+K
@RTS ;+K
;
;
;
CKIDT:
@JSR OPENDT ;+K
CKINDT:
@LDX DATCHN ;+K
@JSR K$chkin ;+K
@BCS CKIDT ;+K

@RTS ;+K
;
;
;
CKODT:
@JSR OPENDT ;+K
CKOTDT:
@LDX DATCHN ;+K
@JSR K$chkout ;+K
@BCS CKODT ;+K

@RTS ;+K
;
;
;
CKOCM:
@jsr OPENCM ;+K
CKOTCM:
@jsr en$kernal ;?K
@LDX CMDCHN ;+K
@JSR K$chkout ;+K
@BCS CKOCM ;+K

@LDX 0,# ;+K
@RTS ;+K

PAGE
;
; **** OPEN PRINTER CHANNEL ****
;
opnprt:
@jsr en$kernal ;-K
@lda prtno ;+K
@clc ;+K
@JSR K$close ;+K

@lda prtno ;+K
@TAX ;+K  LDX #4 (or #5)
@ldy second$adr ;+K secondary adr passed in vic$trk (normaly=7)
@JSR K$setlfs ;+K
@LDA 0,# ;+K
@JSR K$setnam ;+K
@lda 0,# ;+K  bank (C128 type) for load and store
@tax ;+K  file name bank (C128 type bank#)
@jsr K$setbnk ;+K
@JMP K$open ;+K

page
;
; handle all interrupts in BIOS 8502 (throw them away)
;
irqs:
@lda CIA$1+int$ctrl
@lda CIA$2+int$ctrl
@lda 0fh,#
@sta VIC+25

@pla
@sta force$map
@pla
@tay
@pla
@tax
@pla
@rti

;
;
;
en$kernal:
@ldy 0,# ;?K
@sty force$map ;?K
@rts ;+K

page
;
;
;
DSKCMD: db 'U1:8 0 tt ss',CR
dskcmd$lng equ $-dskcmd

POUND: db '#'

FMTCMD: db 'N0:CP/M DISK,65',CR
fmtcmd$lng equ $-FMTCMD

SETPNT: db 'B-P 8 0',CR
setpnt$lng equ $-setpnt
;
; fast command buffer
;
f$cmd$buf: db 'U0' ; not set
f$cmd: db 0 ; byte 3
F$stat:
f$rd$trk: db 1 ; byte 4
f$rd$sect: db 0 ; byte 5
f$rd$count: db 1 ; byte 6
db 0 ; byte 7
db 0 ; byte 8
db 0 ; byte 9
db 0 ; byte 10
db 0 ; byte 11

f$cmd$lng equ 6 ; U0+cmd+track+sector+#sectors

write$stat equ 01001100b
write$stat$lng equ 4 ; U0+cmd+(status to write)

inq$cmd: equ 00000100b
inq$cmd$lng equ 3 ; U0+cmd

query$cmd: equ 10001010b
query$cmd$lng equ 4 ; U0+cmd+(track offset)

[Blacklord]

(more to come)