CPU 8080 ; Specify architecture for ASL assembler RELAXED ON ; Accept $BEEF for hex: default Intel is 0BEEFH PAGE 0 ;------------------------------------------------------------------------- ; ALTMON.ASM - FLASH monitor for the JWD 8080 Microcomputer System ; ; This monitor is based on the ALTMON monitor which was derived from ; from the Vector Graphic monitor version 2.0C. ALTMON has been ; reverted to use a single serial port for console and file transfer. ; ; This code is to be saved in the boot flash of the 8080 Micro ; starting at 0000h. ; ;------------------------------------------------------------------------- ; ; Following is a summary of changes from the original VG 2.0c monitor: ; ; All commands immediately echo a full command name as soon as the ; first command letter is typed (e.g., typing "M" immediately ; displays "MOVE"). This makes it easier to identify commands ; without a list of commands present. ; ; The ESC key can be pressed to abort input or commands as in ; the later 4.x monitors from VG. The original ctrl-c abort is ; still present as well. ; ; The B (boot) command runs the CP/M disk boot loader routine for ; my 8080 Microcomputer System. JWD change. ; ; A (ASCII dump) command removed and D (hex dump) updated to display ; both hex and ASCII. ; ; F Made this the fill with constant. JWD change. ; ; X (exchange) command changed to the E command. ; ; H command removed. JWD change. ; ; K Made this the two-byte sequence search. JWD change. ; ; L Reverted to use console port only. JWD change. ; ; J treated as jump (i.e., go to) command instead of jump to North ; Star DOS. ; ; K treated as fill memory with "K"onstant instead of jump to zero ; (was the Z command which has been removed). ; ; R command removed. Memory test on the 8080 not needed. JWD change. ; ; The Y command (Vector Graphic relocating loader) command has been ; removed. ; ; The T test memory command is removed. JWD change. ; ;------------------------------------------------------------------------- ; ; Command Summary: ; ; B jump to CP/M disk boot loader ; C SSSS FFFF CCCC compare blocks ; D SSSS FFFF dump in hex and ASCII ; E SSSS FFFF DDDD exchange block ; F SSSS FFFF DD fill memory with constant ; G SSSS go to and execute ; I PP in from 8080 I/O port ; J SSSS go to and execute (G) ; K SSSS FFFF DD DD find two byte sequence ; L Load Intel hex file from console port ; M SSSS FFFF DDDD move block ; O PP DD out to 8080 I/O port ; P LLLL program memory ; Q SSSS FFFF compute checksum ; S SSSS FFFF DD search for single byte sequence ; ;------------------------------------------------------------------------- ; ; Equates for I/O mapped 8250 or 16450 serial port ; S16450 equ $00 ;base of 16450 UART RXR equ 0 ;Receiver buffer register TXR equ 0 ;Transmitter buffer register IER equ 1 ;Interrupt enable register LCR equ 3 ;Line control register MCR equ 4 ;Modem control register LSR equ 5 ;Line status register ; ; Define console serial port ; SER_STATUS equ S16450+LSR SER_DATA equ S16450+RXR SER_RXRDY equ 1 ; MASK FOR RX BUFFER FULL SER_TXRDY equ 32 ; MASK FOR TX BUFFER EMPTY ; ; ATA Drive Definitions ; ATA_CS1 equ 40h ;ATA Drive CS1 address ATA_CS2 equ 80h ;ATA Drive CS2 address ATA_DATA equ ATA_CS1 ;ATA Drive Data Register ATA_ERROR equ ATA_CS1+1 ;ATA Drive Error Register (Read Only) ATA_FEATURES equ ATA_CS1+1 ;ATA Drive Feature Register (Write Only) ATA_SEC_COUNT equ ATA_CS1+2 ;ATA Drive Sector Count Register ATA_SEC equ ATA_CS1+3 ;ATA Drive Sector Number Register ATA_CYL_LOW equ ATA_CS1+4 ;ATA Drive Cylinder LSB Register ATA_CYL_HI equ ATA_CS1+5 ;ATA Drive Cylinder MSB Register ATA_DRV_HEAD equ ATA_CS1+6 ;ATA Drive Device/Head Register ATA_STATUS equ ATA_CS1+7 ;ATA Drive Status Register (Read Only) ATA_COMMAND equ ATA_CS1+7 ;ATA Drive Command Register (Write Only) ; ATA_LBA_BYTE1 equ ATA_CS1+3 ;ATA Bytes 0 through 7 in LBA mode ATA_LBA_BYTE2 equ ATA_CS1+4 ;ATA Bytes 8 through 15 in LBA mode ATA_LBA_BYTE3 equ ATA_CS1+5 ;ATA Bytes 16 through 23 in LBA mode ATA_LBA_BYTE4 equ ATA_CS1+6 ;ATA Bytes 24 through 27 in LBA mode ; ATA_ALT_STATUS equ ATA_CS2+6 ;ATA Drive Alternate Status Register ATA_DEV_CTRL equ ATA_CS2+6 ;ATA Drive Control Register ATA_DEV_ADDRESS equ ATA_CS2+7 ;ATA Drive Address Register ; ATA_LBA0_7 equ ATA_CS1+3 ;ATA Drive LBA Bits 0-7 ATA_LBA8_15 equ ATA_CS1+4 ;ATA Drive LBA Bits 8-15 ATA_LBA16_23 equ ATA_CS1+5 ;ATA Drive LBA Bits 16-23 ATA_LBA24_27 equ ATA_CS1+6 ;ATA Drive LBA Bits 24-27 ; ; ATA Command Options ; CMD_RETRY equ 0 CMD_NO_RETRY equ 1 ; ; ATA Read/Write Commands ; CMD_READ_SECTOR_RETRY equ 20h ;Read sectors in sector count register - retry enabled CMD_READ_SECTOR_NORETRY equ 21h ;Read sectors in sector count register - retry disabled CMD_READ_LONG_RETRY equ 22h ;Reads one sector with ECC bytes, retry enabled CMD_READ_LONG_NORETRY equ 23h ;Reads one sector with ECC bytes, retry disabled CMD_WRITE_SECTOR_RETRY equ 30h ;Write sectors in sector count register - retry enabled CMD_WRITE_SECTOR_NORETRY equ 31h ;Write sectors in sector count register - retry disabled CMD_WRITE_LONG_RETRY equ 32h ;Writes one sector with ECC bytes, retry enabled CMD_WRITE_LONG_NORETRY equ 33h ;Writes one sector with ECC bytes, retry disabled CMD_WRITE_VERIFY equ 3Ch ;Write sectors in sector count register - verify after writing CMD_VERIFY_SECTOR_RETRY equ 40h ;Verify sectors in sector count register - retry enabled, no data CMD_VERIFY_SECTOR_NORETRY equ 41h ;Verify sectors in sector count register - retry disabled, no data CMD_READ_MULTIPLE equ 0C4h ;Read multiple sectors - interrupt when finished CMD_WRITE_MULTIPLE equ 0C5h ;Write multiple sectors - interrupt when finished CMD_READ_BUFFER equ 0E4h ;Read contents of sector buffer CMD_WRITE_BUFFER equ 0E8h ;Write to sector buffer ; ;ATA Control Commands ; CMD_REQUEST_SENSE equ 3 ;Gets extended error for previous command CMD_RECALIBRATE equ 10h ;Reinitialize ATA controller (does nothing with CF) CMD_SEEK equ 70h ;Moves head to track specified (does nothing with CF) CMD_DIAGNOSTIC equ 90h ;Check power mode of the card CMD_INITIALIZE equ 91h ;Allows change to sectors per track and heads per cylinder CMD_STANDBY_IMMEDIATE equ 94h ;Puts card in standby mode without idle timer CMD_STANDBY equ 96h ;Puts card in standby mode after idle until timer expired CMD_CHECK_POWER equ 98h ;Returns power status of the card CMD_SLEEP equ 99h ;Puts card in sleep mode until hardware/software reset CMD_MULTIPLE equ 0C6h ;Enable read/write multiple operations CMD_IDENTIFY equ 0ECh ;Performs self diagnostics on the card CMD_SET_FEATURES equ 0EFh ;Set card features (aka 8-bit mode) ; ;ATA Control Settings ; DEV_CONTROL_SRST equ 04h ;Device Control Register Software Reset DEV_CONTROL_NIEN equ 02h ;Device Control Register Interrupt Enable ; DHR_SLAVE_SELECT equ 10h ;DHR Register select slave (default is master) DHR_LBA_MODE equ 40h ;DHR Register enable LBA mode (default is CHS) ; ;ATA Error Register Flags ; ERROR_BBK equ 80h ;Bad Block Mark (Always 0, not supported on CF) ERROR_UNC equ 40h ;Uncorrectable Data Error ERROR_MC equ 20h ;Media Changed (Always 0) ERROR_IDNF equ 10h ;Sector ID Field Not Found ERROR_MCR equ 08h ;Media Change Requested (Always 0) ERROR_ABRT equ 04h ;Status error or Invalid Command Aborted ERROR_TKN0NF equ 02h ;Track 0 Not Found (Not supported on CF) ERROR_AMNF equ 01h ;Address Mark Not Found (Not supported on CF) ; ;ATA Status Register Flage ; STATUS_BSY equ 80h ;Device Busy STATUS_DRDY equ 40h ;Device Ready STATUS_DWF equ 20h ;Device Write Fault STATUS_DSC equ 10h ;Device Seek Complete STATUS_DRQ equ 08h ;Data Request STATUS_CORR equ 04h ;Corrected Data STATUS_IDX equ 02h ;Index (Not used on CF, Always 0) STATUS_ERR equ 01h ;Command Error ; ;ATA Feature Codes ; FEATURE_8BIT_ON equ 01h ;Enable 8-bit transfers in LBA mode FEATURE_LOOKAHEAD_OFF equ 55h ;Disable read lookahead FEATURE_DEFAULTS_OFF equ 66h ;Disable power-on defaults FEATURE_8BIT_OFF equ 81h ;Disable 8-bit transfers in LBA mode FEATURE_ECC_ON equ 0BBh ;Enable 4 bytes ECC on read/write long FEATURE_DEFAULTS_ON equ 0CCh ;Enable power-on defaults ; ; Misc Equates ; CR equ 13 ;ASCII carriage return LF equ 10 ;ASCII line feed CTRLC equ 3 ;ASCII control-c ESC equ 27 ;ASCII ESCAPE ; ; Memory location equates ; ROM_START equ $0000 ;START OF MONITOR CODE RAM0_INIT equ $8000 ;INITIAL START OF RAM0 MON_END equ $0800 ;END OF MONITOR PAGE ; ; Monitor stack pointer ; SPTR equ 0ffffh ;stack pointer (use 256 byte boundary) ;--------------------------------------------------------- ; reset - Memory initialization ;--------------------------------------------------------- org 0000h ;Monitor reset reset: di ; Copy the monitor code to RAM0 lxi H,ROM_START ;start of monitor code lxi D,RAM0_INIT ;start of initial RAM0 lxi B,MON_END ;number of bytes I10: mov A,M stax D inx H inx D dcr C jnz I10 dcr B jnz I10 I20: mov A,M stax D inx H inx D dcr C jnz I20 mov A,M stax D ;Switch out the ROM with RAM0 and enable RAM1 out $FF jmp monit org 0100h ;Monitor location ;--------------------------------------------------------- ; monit - monitor entry point ;--------------------------------------------------------- ; Initialize S16450 UART ; ;access baud generator, no parity, 1 stop bit, 8 data bits monit mvi a,$83 ;B'10000011 out S16450+LCR ; ;fixed baud rate of 19200: crystal is 1.843200 Mhz. ;Divisor is 1843200/(16*19200) = 6 mvi a,6 ;fix at 19.2 kbaud out S16450+RXR ;lsb xra a out S16450+RXR+1 ;msb=0 ; ;access data registers, no parity, 1 stop bits, 8 data bits mvi a,$03 ;B'00000011 out S16450+LCR ; ;no loopback, OUT2 on, OUT1 on, RTS on, DTR (LED) on mvi a,$0F ;B'00001111 out S16450+MCR ; ;disable all interrupts: modem, receive error, transmit, and receive mvi a,$00 ;B'00000000 out S16450+IER ;display welcome banner ;Stack contains return address. ;Print routine moves HL to end of string and then loads program counter from HL. ;80h added to last character signals end of string. lxi sp,SPTR call dspMsg db CR,LF,LF,'JWD 8080 Monitor 1.','0'+80h ; start - command processing loop start lxi sp,SPTR ;re-init stack pointer lxi h,start ;RET's go back to start push h call crlf ;display '*' prompt after CR/LF mvi a,'*' call ptcn call getCon ;read command from keyboard ani 05FH ;lower case to upper case cpi 'B' rc ;too small cpi 'T' rnc ;too large lxi h,cmdTbl+100h-2*'B' ;'B' indexes to start of cmdtbl add a ;2 bytes per entry add l mov l,a mov e,m ;e=lsb of jump address inx h mov d,m ;d=high byte of jump address xchg pchl ;away we go ; Command Table cmdTbl dw doboot ;B jump to Altair disk boot loader dw compr ;C SSSS FFFF CCCC compare blocks dw disp ;D SSSS FFFF dump in hex dw exchg ;E SSSS FFFF DDDD exchange block dw fill ;F SSSS FFFF DD fill RAM with constant dw exec ;G SSSS go to and execute dw execnull ;H does nothing dw pinpt ;I PP input from I/O port dw exec ;J SSSS jump to and execute (G) dw srch2 ;K SSSS FFFF DD DD two byte search dw hexLoad ;L Load Intel hex file from port dw moveb ;M SSSS FFFF DDDD move block dw execnull ;N does nothing dw poutp ;O PP DD output to port dw pgm ;P LLLL program memory dw chksum ;Q SSSS FFFF compute checksum dw execnull ;R does nothing dw srch1 ;S SSSS FFFF DD search for single byte ;-------------------------------------------------------------------------- ; exec (H, N, R) - Null routines ;-------------------------------------------------------------------------- execnull ret ;-------------------------------------------------------------------------- ; exec (G or J) - execute the program at the address ;-------------------------------------------------------------------------- exec call dspMsg db 'GOT','O'+80h call ahex ;read address from keyboard xchg pchl ;-------------------------------------------------------------------------- ; doBoot (B) - CP/M boot ;-------------------------------------------------------------------------- doBoot call dspMsg db 'CP/M BOO','T'+80h call crlf call crlf jmp loader ;-------------------------------------------------------------------------- ; chksum (Q) - compute checksum ;-------------------------------------------------------------------------- chksum call dspMsg db 'CSU','M'+80h call tahex mvi b,0 ;start checksum = 0 csloop mov a,m ;get data from memory add b ;add to checksum mov b,a call bmp jnz csloop ;repeat loop mov a,b ;a=checksum jmp pt2 ;print checksum and exit ;-------------------------------------------------------------------------- ; disp (D) - display memory contents ;-------------------------------------------------------------------------- disp call dspMsg db 'DUM','P'+80h call tahex ;read addresses dmpLine push h ;save address at start of line mvi c,16 ;16 locations per line call ptad ;print current address ; dump line in hex dmpHex mov a,m ;a=byte to display call pt2 ;display it call spce inx h dcr c ;decrement line byte count jnz dmpHex ;loop until 16 bytes done ; dump line in ASCII call spce pop h ;hl->start of line mvi c,16 ;16 locations per line dmpAsc mov a,m ;a=byte to display cpi 7Fh ;test if >= 7Fh jnc dspDot ;non printable, show '.' cpi ' ' ;displayable character? jnc dspAsc ;yes, go display it dspDot mvi a,'.' ;display '.' instead dspAsc call ptcn ;display the character call bmp ;increment hl, possibly de dcr c ;decrement line byte count jnz dmpAsc ;loop until 16 bytes done call bmp ;done? rz ;yes dcx h ;undo extra bump of hl jmp dmpLine ;do another line ;-------------------------------------------------------------------------- ; pgm (P) - program memory ;-------------------------------------------------------------------------- pgm call dspMsg db 'PRO','G'+80h call ahex ;read address xchg call crlf pglp mov a,m ;read memory call pt2 ;print 2 digits mvi a,'-' ;load dash call ptcn ;print dash crig call rdcn ;get user input cpi ' ' ;space jz con2 ;skip if space cpi CR ;skip if CR jnz con1 call crlf ;print CR,LF jmp crig ;back for more con1 xchg ;HL->DE lxi h,0 ;get 16 bit zero mvi c,2 ;count 2 digits call ahexNr ;convert to hex (no read) mov m,e con2 inx h jmp pglp ;-------------------------------------------------------------------------- ; fill (F) - fill memory with a constant ;-------------------------------------------------------------------------- fill call dspMsg db 'FIL','L'+80h call tahex ;read addresses push h ;start addr on stack mvi c,2 ;reading 2 digits call ahe0 ;input fill byte xchg ;byte to write from e to l xthl ;hl=start addr, stack=fill byte pop b ;c=fill byte from stack zloop mov m,c ;write into memory call bmp ;compare address, increment h rz jmp zloop ;-------------------------------------------------------------------------- ; moveb (M) - move a block of memory ; exchg (E) - exhange block of memory ;-------------------------------------------------------------------------- moveb call dspMsg db 'MOV','E'+80h xra a ;a=0 means "move" command jmp doMove exchg call dspMsg db 'EXC','H'+80h ;a returned <> 0 means "exchange" command doMove mov b,a ;save move/exchange flag in b call tahex ;read addresses push h call ahex xchg xthl ;HL->start, DE->end, stack has dest mloop mov c,m ;c=byte from source xthl ;hl->destination mov a,b ;move or exchange? ora a jz nexch ;0 means move only mov a,m ;a=from destination xthl ;hl->source mov m,a ;move destination to source xthl ;hl->destination nexch mov m,c ;move source to destination inx h ;increment destination xthl ;hl->source call bmp ;increment source and compare to end jnz mloop pop h ;remove temp pointer from stack ret ;and exit ;-------------------------------------------------------------------------- ; compr (C) - compare two blocks of memory ;-------------------------------------------------------------------------- compr call dspMsg db 'COM','P'+80h call tahex ;read addresses push h ;source start on stack call ahex xchg ;de=source end, hl=compare start vmlop mov a,m ;a=compare byte inx h xthl ;hl->source byte cmp m ;same? mov b,m ;b=source byte cnz err ;display the error call bmp ;increment pointers xthl ;hl->compare byte jnz vmlop pop h ;remove temp pointer from stack ret ;and exit ;-------------------------------------------------------------------------- ; srch1 (S) - search for one byte ; srch2 (K) - search for two bytes ;-------------------------------------------------------------------------- srch1 call dspMsg db 'FIND','1'+80h xra a ;zero flag means one byte search jmp doSrch srch2 call dspMsg db 'FIND','2'+80h ;a returned <> 0 means two byte search doSrch push psw ;save 1/2 byte flag on stack call tahex push h ;save h, getting 1st byte to find mvi c,2 ;reading 2 hex digits call ahe0 xchg ;h=code, d=f mov b,l ;put code in b pop h ;restore h pop psw ;a=one/two byte flag ora a ;zero true if one byte search push psw jz cont push h ;save h, getting 2nd byte to find mvi c,2 call ahe0 xchg mov c,l pop h cont mov a,m ;read memory cmp b ;compare to code jnz skp ;skip if no compare pop psw ;a=one/two byte flag ora a ;zero true if one byte serach push psw jz obcp inx h ;two byte search mov a,m dcx h cmp c jnz skp obcp inx h mov a,m ;read next byte dcx h ;decr address call err ;print data found skp call bmp ;check if done jnz cont ;back for more pop psw ;remove flag saved on stack ret ;-------------------------------------------------------------------------- ; poutp (O) - output data to a port ;-------------------------------------------------------------------------- poutp call dspMsg db 'OU','T'+80h mvi c,2 call ahe0 ;port number in e mvi c,2 call ahe0 ;port to l, data in e mov d,l ;d=port lxi h,SPTR-30h ;form OUT nn, RET in memory at h mvi m,0c9h ;RET opcode dcx h mov m,d ;output port for OUT instruction dcx h mvi m,0D3H ;OUT opcode mov a,e pchl ;call OUT, RET ;-------------------------------------------------------------------------- ; pinpt (I) - input data from a port ;-------------------------------------------------------------------------- pinpt call dspMsg db 'I','N'+80h mvi c,2 call ahe0 ;port number to e lxi h,SPTR-30H ;form IN nn, RET in memory at h mvi m,0C9H ;RET opcode dcx h mov m,e ;input port of IN instruction dcx h mvi m,0DBH ;IN opcode call SPTR-32H jmp pt2 ;--------------------------------------------------------------------- ; hexLoad (L) - load intel hex through console port ;--------------------------------------------------------------------- hexload call dspMsg db 'HEXLOA','D'+80h ; rcvLine - receive a hex file line rcvLine call crlf mvi c,0 ;clear echo character flag wtMark call getChar ;read next character sui ':' ;record marker? jnz wtMark ;no, keep looking ; Have start of new record. Save the byte count and load address. ; The load address is echoed to the screen so the user can ; see the file load progress. mov d,a ;init checksum in D to zero call iByte ;input two hex digits (byte count) mov a,e ;test for zero byte count ora a jz flush ;count of 0 means end mov b,e ;B = byte count on line inr c ;set echo flag for address bytes call iByte ;get MSB of address mov h,e ;H = address MSB call iByte ;get LSB of address mov l,e ;L = address LSB dcr c ;clear echo flag call iByte ;ignore/discard record type ; Receive the data bytes of the record and move to memory data call iByte ;read a data byte (2 hex digits) mov m,e ;store in memory inx h dcr b jnz data ; Validate checksum call iByte ;read and add checksum jz rcvLine ;checksum good, receive next line call dspMsg ;display error message db ' ER','R'+80h ;fall into flush ; flush - flush rest of file as it comes in until no characters ; received for about 1/4 second to prevent incoming file ; data looking like typed monitor commands. Only the console ; port needs to be flushed. flush in SER_DATA ;clear possible received char lxi d,10417 ;.25s timeout for 48 cycle loop flshLp in SER_STATUS ;(10) look for character on console rrc ;(4) data flag in carry jc flush ;(10) data received, restart dcx d ;(5) decrement timeout mov a,d ;(5) ora e ;(4) jnz flshLp ;(10) loop until zero ret ;done ;----------------------------------------------------------- ; iByte - read two ascii hex bytes and return binary ; value in e. ;----------------------------------------------------------- iByte call getChar ;get a character call asc2Bin ;ascii hex digit to binary add a ;put in msn, zero lsn add a add a add a mov e,a ;save byte with MSN in E ; 2nd byte (LSN) call getChar ;get a character call asc2Bin ;ascii hex digit to binary add e ;combine msn and lsn mov e,a ;save in EH add d ;add character to checksum mov d,a ret ;------------------------------------------------------------- ; asc2Bin - ASCII hex digit to binary conversion. Digit ; passed in a, returned in a. Errors ignored as checksum ; will eventually kick this out. ;------------------------------------------------------------- asc2Bin sui '0' ;'0' to 0 cpi 10 ;0-9 ? rc sui 7 ;'A-F' to A-F ret ;------------------------------------------------------------- ; getChar - read a character from the console port. ; The character is also echoed to the console port ; if the echo flag (c) is set (non-zero) ;------------------------------------------------------------- getChar push b ;save b,c inWait0 call cntlc ;test for character from console jz inWait0 jmp haveChr ; process new character in a. Echo to console if c is non-zero haveChr mov b,a ;save character in b mov a,c ;echo flag (c) set? ora a jz noEcho ;no echo mov a,b ;a=character to send pop b ;restore b,c jmp ptcn ;display character and exit noEcho mov a,b ;a=byte read pop b ;restore b,c ret ;******************************************************************** ; ; Type conversion, input, output subroutines ; ;******************************************************************** ;------------------------------------------------------------ ; tahex - read two 16 bit addresses. 1st returned in HL, 2nd in DE ;------------------------------------------------------------ tahex call ahex ;get first address param ;fall into ahex to get 2nd param ;------------------------------------------------------------ ; ahex - read up to 4 hex digits to binary, return in de ;------------------------------------------------------------ ahex mvi c,4 ;count of 4 digits ahe0 lxi h,0 ;16 bit zero ahe1 call rdcn ;read a byte ahexNr cpi '0' jc start ;below '0', abort cpi ':' cnc alph dad h dad h dad h dad h sui '0' ;ascii bias cpi 10 ;digit 0-10 jc alf sui 7 ;alpha bias alf add l mov l,a dcr c jnz ahe1 ;keep reading xchg ;result in de ;fall through to print a space ;------------------------------------------------------------ ; spce - print a space ; ptcn - print character passed in a ;------------------------------------------------------------ spce mvi a,' ' ;print space ptcn push psw ptlop in SER_STATUS ;wait for OK to transmit ani SER_TXRDY jz ptlop pop psw ;recover a ani 07fh ;get rid of msbit out SER_DATA ;and print it ret ;return from ptcn ;------------------------------------------------------------ ; alph - verify valid hex digit, abort to command loop if not ;------------------------------------------------------------ alph cpi 'A' jc start ani 05fh cpi 'G' jnc start ret ;------------------------------------------------------------ ; crlf - print CR/LF ;------------------------------------------------------------ crlf mvi a,CR call ptcn mvi a,LF jmp ptcn ;------------------------------------------------------------ ; err - display the address in hl followed by the value ; in b, then the value in a. ;------------------------------------------------------------ err push psw ;save A call ptad ;print address mov a,b ;print B call pt2 call spce pop psw ;print A pt2 push psw call binh pop psw jmp binl ;------------------------------------------------------------ ; ptad - display the address in h ;------------------------------------------------------------ ptad call crlf ;print cr,lf call pause mov a,h ;print call pt2 ;ascii mov a,l ;codes call pt2 ;for call spce ;address ret ;------------------------------------------------------------ ; binh - print MSN of byte passed in A ; binl - print LSN of byte passed in A ;------------------------------------------------------------ binh rar rar rar rar binl ani 0fh ;low 4 bits adi '0' ;ascii bias cpi 03ah ;digit 0-9 jc ptcn adi 7 ;digit A-F jmp ptcn ;------------------------------------------------------------ ; dspMsg - display in-line message. String terminated by byte ; with msbit set. ;------------------------------------------------------------ dspMsg pop h ;hl->string to display dspLoop mov a,m ;a=next character to display call ptcn ;display character ora m ;MSB set? (last byte) inx h ;point to next character jp dspLoop ;no, keep looping call spce ;display a trailing space pchl ;return past the string ;------------------------------------------------------------ ; rdcn - read from console to A with echo to screen ; getCon - read from console to A without echo ;------------------------------------------------------------ rdcn call getCon ;get character from console cpi ESC ;ESC confuses smart terminals rz ; so don't echo escape jmp ptcn ;echo onto printer getCon in SER_STATUS ;read keyboard status rrc ;data available flag in carry jnc getCon in SER_DATA ;read from keyboard ani 07fh ;strip off msb ret ;------------------------------------------------------------ ; pause - pause/resume with spacebar. Also look for a ctrl-c ; or ESC to abort. ;------------------------------------------------------------ pause call cntlc ;look for abort or other character cpi ' ' rnz ;return if not space or abort ploop call cntlc ;loop here until space or abort pressed cpi ' ' jnz ploop ret ;------------------------------------------------------------ ; cntlc - see if a character has been typed. If not, return ; zero true. If ctrl-c or ESC typed, abort and return to ; the command loop. Otherwise, return the character typed. ;------------------------------------------------------------ cntlc in SER_STATUS ;anything typed? ani SER_RXRDY rz ;no, exit with zero true in SER_DATA ;get the typed character ani 07fh cpi CTRLC ;abort with ctrl-c (2.0 style) jz start cpi ESC ;or ESC (4.x style) jz start ret ;------------------------------------------------------------ ; bmp - compare address and increment h. Return zero true ; if hl=de. Once hl=de, then de is incremented each time ; so the comparison remains true for subsequent calls. ;------------------------------------------------------------ bmp mov a,e ;compare lsb's of hl,de sub l jnz goon ;not equal mov a,d ;compare msb's of hl,de sbb h ;gives zero true if equal goon inx h ;increment hl rnz ;exit if hl <> de yet inx d ;increase de as well so it will ret ; still be equal next time ;------------------------------------------------------------ ; loader - Load CP/M boot loader from physical sector 0 ; and jump to address 1000h ;------------------------------------------------------------ secbuf equ $1000 ;Where to put boot loader loader: ; Set up the drive for LBA mode and 8-bit I/O in ATA_DRV_HEAD ;Get current DHR bits ori DHR_LBA_MODE ;Set the LBA mode bit out ATA_DRV_HEAD ;Write bits to the DHR register mvi a, FEATURE_8BIT_ON ;Get feature code for 8-bit mode out ATA_FEATURES ;Write 8-bit feature code to features register mvi a, CMD_SET_FEATURES ;Get ready for Features command out ATA_COMMAND ;Request Set Features command call drivebusy ;Wait for command completion st001: mvi a, 01h ;Write one sector out ATA_SEC_COUNT mvi a, 00h ;Set up for LBA 0 (first sector) out ATA_LBA0_7 out ATA_LBA8_15 out ATA_LBA16_23 in ATA_LBA24_27 ;Get LBA and Drive Control bits ani 0f0h ;Mask off LBA bits out ATA_LBA24_27 ;Save Drive Control bits mvi a, CMD_READ_SECTOR_RETRY ;Set up for sector read with retry out ATA_COMMAND ;Execute read sector with retry call drivebusy ;Wait for command completion call dataready ;Wait for data buffer ready lxi b, secbuf ;Point to sector buffer st002: in ATA_DATA ;Get sector data byte stax b ;Store sector data in sector buffer inx b ;Point to next buffer byte in ATA_STATUS ;Check card status ani STATUS_DRQ ;Get data ready status bit jnz st002 ;Get another sector byte from the card st003: jmp secbuf ;Return to monitor drivebusy: push psw ;Waits for drive to complete a command db001: in ATA_STATUS ani STATUS_BSY jnz db001 pop psw ret dataready: push psw ;Waits for data to be written to disk dr001: in ATA_STATUS ani STATUS_DRDY jz dr001 pop psw ret end