;================================================ ;MONITOR ; Simple Monitor/Executive program for IMSAI 8080 ; ( 8080 code, Serial interface code specific for IMSAI SIO card ) ; Version 7.2 with LibCard Utilities ; Fixed BIOS entry bug ; Added ability to use directory structure in flash to load new apps without programming an EPROM ; John Garza May 2007 ;================================================ ; Set Memory top in Kbytes (free ram plus monitor) ;TOP EQU 40 ; FOR TESTING: 40 = run @ 9000H; 32 = @ 7000H ;TOP EQU 52 ; FOR 48k AVAIL (runs @ C000H) ;TOP EQU 56 ; FOR 52k AVAIL (runs @ D000H) TOP EQU 60 ; FOR 56k AVAIL (runs @ E000H) Beware EPROM Programmer uses F000H ! SZE EQU 4 ; Size of Monitor, Kbytes ORGIN EQU (TOP-SZE)*1024 ;Origin based on memory size (52-4=48K=C000h, etc.) ORG ORGIN START: ; CPM BIOS EMULATION JMP cldst ; cold start - initializes system JMP wrmst ; warm start - no initialization JMP CST ; CONSOLE STATUS JMP CIN ; CONSOLE IN JMP COT ; CONSOLE OUT JMP LST JMP PUN JMP RDR JMP HME JMP SDK JMP STK JMP SSC JMP SDM JMP REA JMP WRI JMP LSA JMP STR CST: IN TTS ; GET STATUS BYTE FROM USART ANI TTYDA ; MASK BITS FOR "DATA AVAILABLE?" JZ CST1 ; CONSOLE IS NOT READY ORI 0FFH ; CONSOLE IS READY CST1: RET CIN: ;CALL CST ; GET STATUS IN TTS ANI TTYDA JZ CIN ; WAIT FOR IT IN TTI ; GET BYTE ANI 7FH ; STRIP PARITY BIT ;CALL ledout ; JUST FOR WHIMSY - DISPLAY CHAR ON LEDS RET COT: IN TTS ; GET STATUS BYTE FROM USART ANI TTYTR ; MASK BITS FOR "TERMINAL READY?" JZ COT ; NOT READY - LOOP BACK MOV A,C ; DATA WAS PASSED FROM CALL PROGRAM VIA REG C ;CALL ledout ; JUST FOR WHIMSY - DISPLAY CHAR ON LEDS OUT TTO ; SEND THE CHAR OUT RET LST: JMP GBYE PUN: JMP GBYE RDR: JMP GBYE HME: JMP GBYE SDK: JMP GBYE STK: JMP GBYE SSC: JMP GBYE SDM: JMP GBYE REA: JMP GBYE WRI: JMP GBYE LSA: JMP GBYE STR: JMP GBYE GBYE: LXI SP,STACK ; Initialize stack for ilprt CALL ilprt ; Display following message db lf,cr,'MONITOR >>> Application attempted unsupported BIOS call',LF,CR,00h JMP cldst ;------------------ ; STACK & BUFFERS & STORAGE AREA ; - Storage used when running a CPM program BDLOC EQU ORGIN-6 ; Location of BDOS vector written to RAM (Defines top of RAM) oldstk EQU ORGIN-3 ; storage area for users stack pointer 2BYTES (BDOS) ; - Stack area used running the Monitor BFSZE EQU 80H ; 128 BYTES - Buffer space, bytes (also doubles as local stack for bdos) STACK EQU ORGIN-BFSZE ; Stack Location ; - Other storage used when running the Monitor RCVSNO EQU STACK+2 ; SECT # RECEIVED (XMODEM) SECTNO EQU STACK+3 ; CURRENT SECTOR NUMBER (XMODEM) ERRCT EQU STACK+4 ; ERROR COUNT(XMODEM) dest EQU STACK+6 ; destination address pointer 2BYTES (XMODEM) RAM EQU STACK+8 ; Pointer to start of RAM 1K block for EPROM prog 2BYTES ;-- A0 EQU STACK+9 ; FLASH Address (A0-A7) A1 EQU STACK+10 ; FLASH Address (A8-A15) A2 EQU STACK+11 ; FLASH Address (A16-A24) ;-- IBUFP EQU STACK+13 ; Buffer Pointer 2BYTES IBUFC EQU IBUFP+2 ; Buffer Count 2BYTES IBUFF EQU IBUFP+3 ; Input Buffer IBL EQU 32 ; Input Buffer Length (programmatically, not physical size - BFSZE) ;------------------ ;IMSAI 8080 EQUATES LEDS equ 0FFh ;IMSAI front panel output LEDs (top left) SWCH equ 0FFh ;IMSAI front panel input switches (left) TTS equ 03h ;SIO channel A command port TTI equ 02h ;SIO channel A data port (yes input=output) TTO equ 02h ;SIO channel A data port TTYDA equ 02h ;tty data available (ready to receive?) TTYTR equ 01h ;tty terminal ready (ready to transmit?) ;------------------ ;ASCII characters used NUL EQU 0 ; NULL (ZERO) CR EQU 0DH ; Carriage return LF EQU 0AH ; Line feed CTRH EQU 8 ; Ctl H Backspace DEL EQU 127 ; Delete char TAB EQU 9 ; Tab char CTRX EQU 24 ; Ctl X Cancel CTRS EQU 19 ; Ctl S Suspend CTRQ EQU 17 ; Ctl Q Resume APOS EQU (39-'0') AND 0FFH ;apostrophe ;------------------ ;xmdm values SOH EQU 1 ; Start of Header ACK EQU 06H ; Acknowledge NAK EQU 15H ; Negative acknowledge EOF EQU 1AH ; End of file - ^Z EOT EQU 04H ; End of transmission ERRLIM EQU 10 ; Max allowable errors ;------------------ ; FLASH MEMORY EQUATES RWPRT EQU 80h ; Data Read / Write Port A0PRT EQU RWPRT+1 ; Address 0-7 Port A1PRT EQU RWPRT+2 ; Address 8-15 Port A2PRT EQU RWPRT+3 ; Address 16-18 Port ;----------------- ;CPM BDOS EQU 5 ; BDOS entry point DMABUF EQU 80H ; DMA Buffer location TPA EQU 100H ; Transient Program Area (applications load here) FCB EQU 005CH ; File Control Block ;================================================ cldst: ; COLD START LXI SP,STACK ; Initialize stack for welcome msg MVI A,0AAH ;Init SIO board OUT TTS ; MVI A,40H ; OUT TTS ; MVI A,0CEH ; OUT TTS ; MVI A,37H ; OUT TTS ; CALL ilprt ;Display welcome message db lf,cr,'IMSAI 8080 Monitor 7.2 Ready',lf,cr,00h wrmst: LXI SP,STACK ;Re-Initialize stack ? MVI A,0 ;Clear front panel LEDs CALL ledout ; LXI H,wrmst ;Put return addr on stack PUSH H ; so command routines can do a RET CALL inpln ;Get command string CALL getch ;Get first char from command ; Process the command CPI 'E' ; Enter data into memory JZ enter ; CPI 'D' ; Dump memory to console JZ dump ; CPI 'C' ; Call external subroutine (RET to WARM) JZ calls ; CPI 'J' ; Jump - execute external code (no return) JZ go ; CPI 'M' ; Memory - memory test JZ mem ; CPI 'R' ; Run CPM program JZ run ; CPI 'T' ; Text Routines JZ ted ; CPI 'S' ; Second serial port access (SIO Chan B) JZ ser CPI 'X' ; Xmodem receive JZ xmdm CPI '?' ; Help screen JZ help ; ;-- CPI 'F' ; Fill JZ fill ; CPI 'B' ; Block Move JZ block ; ; CPI 'K' ; Stack ; JZ stkdsp ; CPI 'V' ; Verify - compare 2 blocks of mem JZ verm ; CPI 'P' ; Program EPROM JZ prog ; CPI 'L' ; LibCard Flash Memory routines JZ flash ; JMP wrmst ; Go back for another command ;-------------------------------------- ;Command Main Routines ;-------------------------------------- ;------------------ ;Memory Load routine ; Load hex or ascii into mem from console ; Check data was written, apostrophe precedes ascii ; CR passes over a location enter: CALL ilprt db lf,cr,'Memory Load: apostrophe for ASCII, CR skips addr, Ctrl-X exits',lf,cr,00h load: CALL readhl ;Addr load2: CALL outhl ;Print it CALL pasci ;Ascii CALL outsp MOV C,M ;Orig byte CALL outhex ;Hex PUSH H ;Save pointer CALL inpl2 ;Input CALL readhl ; Byte MOV B,L ; To B POP H CPI APOS JZ load6 ;Ascii input MOV A,C ;How many? ORA A ;None? JZ load3 ;Yes load4: CALL chekm ;Into mem load3: INX H ;Pointer JMP load2 ;load ascii char load6: CALL getch MOV B,A JMP load4 ;copy byte from B to memory ; and see that it got there chekm: MOV M,B ;Put in mem MOV A,M ;Read back into A CMP B ;Same? RZ ;Yes errp: POP PSW ;RAISE STACK errb: MVI A,'B' ;'B' = 'BAD' err2: CALL outt CALL outsp JMP outhl ;------------------ dump: CALL rdhlde ;Range dump2: CALL crhl ;New line dump3: MOV C,M ;Get byte CALL outhx ;Print INX H ;Pointer MOV A,L ANI 0FH ;Line end? JZ dump4 ;Yes, ascii ANI 3 ;Space CZ outsp ; 4 bytes JMP dump3 ;Next hex dump4: CALL outsp PUSH D LXI D,-10H ;Reset line DAD D POP D dump5: CALL pasci ;ascii dump CALL tstop ;Done? MOV A,L ;No ANI 0FH ;line end? JNZ dump5 ;No JMP dump2 ;display byte in ascii if possible, otherwise dot pasci: MOV A,M ;Get byte CPI DEL ;High bit on? JNC pasc2 ;Yes CPI ' ' ;Control char? JNC pasc3 ;No pasc2: MVI A,'.' ;Change to dot pasc3: JMP outt ;Send ;get HL and DE from console, check that DE is larger rdhlde: CALL hhlde rdhld2: MOV A,E SUB L ;E - L MOV A,D SBB H ;D - H JC error ;HL is bigger RET ;input HL and DE, check that 2 addr are entered hhlde: CALL readhl ;HL JC error ;Only 1 addr XCHG ;Save in DE CALL readhl ;DE XCHG ;Put back RET ;input HL from console readhl: PUSH D PUSH B ;Save regs LXI H,0 ;Clear rdhl2: CALL getch ;Get char JC rdhl5 ;Line end CALL nib ;To binary JC rdhl4 ;Not hex DAD H ;Times 2 DAD H ;Times 4 DAD H ;Times 8 DAD H ;Times 16 ORA L ;Add new char MOV L,A JMP rdhl2 ;Next ;check for blank at end rdhl4: CPI APOS ;Apostrophe JZ RDHL5 ;Ascii input CPI (' '-'0') AND 0FFH JNZ error ;N0 rdhl5: POP B POP D ;Restore RET ;convert ascii chars to binary nib: SUI '0' ;Ascii bias RC ;<0 CPI 'F'-'0'+1 CMC ;Invert RC ;Error, >F CPI 10 CMC ;Invert RNC ;Number 0-9 SUI 'A'-'9'-1 CPI 10 ;Skip : to RET ;Letter A-F ;print ? on improper input error: MVI A,'?' CALL outt JMP wrmst ;Try again ;start new line, give addr crhl: CALL crlf ;New line outhl: MOV C,H CALL outhx outll: MOV C,L outhex: CALL outhx outsp: MVI A,' ' JMP outt ;output a hex byte from C (ASCII to HEX converter) outhx: MOV A,C RAR ;Rotate RAR ; 4 bits RAR ; to RAR ; the right CALL hex1 ;Upper char MOV A,C ;Lower char hex1: ANI 0FH ;Take 4 bits ADI 90H DAA ;DAA trick ACI 40H DAA JMP OUTT ;check for end, HL minus DE, incr HL tstop: INX H MOV A,E SUB L ;E - L MOV A,D SBB H ;D - H RNC ;Not done POP H ;Raise stack RET ; -- Back ;------------------ ;Routine to go anywhere in memory ; Addr of WARM is on stack, so a RET will work for CALLS go: POP H ;Remove return addr for GO command calls: CALL readhl ;Get addr PCHL ;Go there ;------------------ ;Test block of memory mem: CALL rdhlde ;Get Range (test mem from HL to DE) CALL ilprt db lf,cr,'Memory Test: Addresses of bad bytes will follow',lf,cr,00h DCX H ; adjust pointer for looping mloop: INX H ;Point to next byte MOV A,M ;Get byte CMA ;Complement MOV M,A ;Put back complement CMP M ;Same? JNZ badm ;No - bad memory CMA ;Orig byte MOV M,A ;Restore it mcont: MOV A,H ; Compare HL to DE, at end? CMP D ; JNZ mloop ; MOV A,L ; CMP E ; JNZ mloop ; CALL ilprt db lf,cr,'Memory Test Completed',lf,cr,00h JMP wrmst ; at end badm: CALL outhl ; Display address of bad memory JMP mcont ; continue ;------------------ ;RUN A CPM PROGRAM ; To run a CPM program this code: ; 1) Copies BDOS code to RAM @ BDLOC ; 2) Places a JMP to this code at 0005H ; 3) Places a JMP to wrmst at 0000H ; 4) Loads spaces to FCB (simulating no command line parameters) ; 5) CALLs 0100H ; NOTE: App calls BDLOC that then jumps to lbdos in EPROM ; App thinks BDLOC is real BDOS, but it's just a jump to real bdos in EPROM run: MVI A,0C3H ; put 'JMP lbdos' before monitor STA BDLOC ; so calling apps can determine start of avail mem LXI H,lbdos ; SHLD BDLOC+1 ; MVI A, 0C3H ; put 'JMP BDLOC' @0005H STA BDOS ; LXI H,BDLOC ; SHLD BDOS+1 ; MVI A, 0C3H ; put 'JMP START+3' @0000H (TO ALLOW APPS TO ACCESS BIOS) STA 0H ; LXI H,START+3 ; WARM START IS 2ND BIOS VECTOR, HENCE '+3' SHLD 1H ; MVI A,20H ; put in FCB STA FCB ; STA FCB+1 ; need more? STA FCB+2 ; need more? STA FCB+3 ; need more? STA FCB+4 ; need more? STA FCB+5 ; need more? STA FCB+6 ; need more? STA FCB+7 ; need more? STA FCB+8 ; need more? STA FCB+9 ; need more? STA FCB+10 ; need more? STA FCB+11 ; need more? CALL TPA ; run the CPM program JMP cldst ; for those apps using a 'RET' to exit ;---------------------- ;ASCII TEXT INPUT/DISPLAY ; ted: CALL getch ;get next char CPI 'D' JZ adump CPI 'E' JNZ error CALL readhl ;get address to put text CALL ilprt ;display instruction message db lf,cr,'Enter ASCII Text, Ctl-X to exit...',lf,cr,00h CALL outhl ;display address alod2: CALL intt ;exit within intt via ctl-X CALL outt CPI CTRH ; Backspace? JNZ ted1 ; no, then nornal char DCX H ; yes, then decrement pointer MVI A,' ' ; and blank last char on screen CALL outt ; MVI A,CTRH ; CALL outt ; JMP alod2 ; then go back for more chars ted1: MOV B,A ;Save it in B CPI CR ; CR ? JNZ ted2 MVI A,LF ; ensure CR gets a LF for clean display CALL outt MOV A,B CPI CR CZ outhl ; yes, show current mem address on left margin ted2: CALL chekm ;Needs it in B, as call to outhl above wipes A INX H MOV A,L ; ANI 7Fh ;line end? JNZ alod2 ; no CALL crhl ; yes,new line JMP alod2 adump: CALL rdhlde ;range admp2: MOV A,M ;get byte CPI DEL ;high bit on? JNC admp4 ; yes CPI ' ' ;control? JNC admp3 ; no CPI CR ;carr ret? JZ lfexp ; expand cr to cr lf for clean display ;JZ admp3 ; yes, ok CPI LF ;line feed? JZ admp3 ; yes,ok CPI TAB ; tab? JNZ admp4 ; skip other MVI A,' ' ;space or tab admp3: CALL outt ;send admp4: CALL tstop ;done? JMP admp2 ; no lfexp: CALL outt MVI A,LF JMP admp3 ;---------------------- help: CALL ilprt db lf,cr db 'IMSAI 8080 Monitor 7.2 Commands:',lf,cr db '----------------------------------------------------------------',lf,cr db ' Dxxxx yyyy - Dump memory x to y',lf,cr db ' Exxxx - Enter data at address x',lf,cr db ' Bxxxx yyyy zzzz - Block move x-y to z',lf,cr db ' Fxxxx yyyy bb - Fill memory x-y with byte b',lf,cr ; db ' K - Display Stack Pointer',lf,cr db ' Mxxxx yyyy - Memory Test x-y',lf,cr db ' Vxxxx yyyy zzzz - Verify memory block x-y with block z',lf,cr db ' Cxxxx - Call subroutine at x',lf,cr db ' Jxxxx - Jump to x',lf,cr db ' R - Run CPM Program @0100h',lf,cr db ' TExxxx - Text entry at x',lf,cr db ' TDxxxx yyyy - Text dump from x-y',lf,cr db ' S - Serial port SIO channel B',lf,cr db ' Xxxxx - XMODEM File Receive to memory at x',lf,cr db ' Pxxxx - Program EPROM @F000h with 1K block from x',lf,cr db ' LL - Load from Library Card to RAM',lf,cr db ' LS - Save from RAM to Library Card',lf,cr db ' LE - Erase Sector on Library Card',lf,cr db ' LR - Run a program from Library Card',lf,cr db ' ? - This help screen',lf,cr db 00h JMP wrmst ;---------------------- ser: MVI A,0AAH ;Init SIO board OUT 05H ; (channel B) MVI A,40H ; OUT 05H ; MVI A,0CEH ; OUT 05H ; MVI A,37H ; OUT 05H ; CALL ilprt db lf,cr,'<** NOW ON SIO CHANNEL B - Ctl-X to return **>',lf,cr,00H ; Begin terminal session on B sloop: IN 05H ; any data come in channel B? ANI TTYDA JNZ siob IN TTS ; any keys hit on console (chan A)? ANI TTYDA JNZ sioa JMP sloop sioa: IN TTI CPI CTRX ;Control X to cancel session? JZ wrmst OUT 04H JMP sloop siob: IN 04H OUT TTO JMP sloop ;--------------------- ; XMODEM receive routine ;--------------------- ; Implements basic XMODEM checksum receive function to allow loading larger ; files from PC with fewer errors. Code modified from XMODEM v3.2 source ; by Keith Petersen xmdm: CALL readhl ;set load location via readhl input routine SHLD dest ;save destination address MVI A,0 ; Initialize sector number to zero STA SECTNO ; CALL ilprt db lf,cr,'Ready to receive file to memory...',lf,cr,0 RCVLP: CALL RCVSECT ;GET A SECTOR JC RCVEOT ;GOT EOT? CALL WRSECT ;WRITE THE SECTOR CALL INCRSNO ;BUMP SECTOR # CALL SENDACK ;ACK THE SECTOR JMP RCVLP ;LOOP UNTIL EOF ; ;GOT EOT ON SECTOR - FLUSH BUFFERS, END ; RCVEOT: ;CALL WRSECT ;WRITE THE LAST BLOCK CALL SENDACK ;ACK THE SECTOR ;CALL CLOSFIL ;CLOSE THE FILE ;JMP EXIT ;ALL DONE JMP wrmst ;**** xmodem SUBROUTINES ; ;----> RCVSECT: RECEIVE A SECTOR ; ;RETURNS WITH CARRY SET IF EOT RECEIVED. ; RCVSECT: XRA A ;GET 0 STA ERRCT ;INIT ERROR COUNT ; RCVRPT: MVI B,10 ;10 SEC TIMEOUT CALL RECV ;GET SOH/EOT JC RCVSTOT ;TIMEOUT CPI SOH ;GET SOH? JZ RCVSOH ;..YES ; ;EARLIER VERS. OF MODEM PROG SENT SOME NULLS - ;IGNORE THEM ; ORA A ;00 FROM SPEED CHECK? JZ RCVRPT ;YES, IGNORE IT CPI EOT ;END OF TRANSFER? STC ;RETURN WITH CARRY.. RZ ;..SET IF EOT ; ;DIDN'T GET SOH OR EOT - ; ;DIDN'T GET VALID HEADER - PURGE THE LINE, ;THEN SEND NAK. ; RCVSERR: MVI B,1 ;WAIT FOR 1 SEC.. CALL RECV ;..WITH NO CHARS JNC RCVSERR ;LOOP UNTIL SENDER DONE MVI A,NAK ;SEND.. CALL SEND ;..THE NAK LDA ERRCT ;ABORT IF.. INR A ;..WE HAVE REACHED.. STA ERRCT ;..THE ERROR.. CPI ERRLIM ;..LIMIT? JC RCVRPT ;..NO, TRY AGAIN ; ;10 ERRORS IN A ROW - ; RCVSABT: ;CALL CLOSFIL ;KEEP WHATEVER WE GOT ;CALL ERXIT CALL ilprt DB '++UNABLE TO RECEIVE BLOCK ' DB '- ABORTING++',CR,0 JMP wrmst ; ;TIMEDOUT ON RECEIVE ; RCVSTOT: JMP RCVSERR ;BUMP ERR CT, ETC. ; ;GOT SOH - GET BLOCK #, BLOCK # COMPLEMENTED ; RCVSOH: MVI B,1 ;TIMEOUT = 1 SEC CALL RECV ;GET SECTOR JC RCVSTOT ;GOT TIMEOUT MOV D,A ;D=BLK # MVI B,1 ;TIMEOUT = 1 SEC CALL RECV ;GET CMA'D SECT # JC RCVSTOT ;TIMEOUT CMA ;CALC COMPLEMENT CMP D ;GOOD SECTOR #? JZ RCVDATA ;YES, GET DATA ; ;GOT BAD SECTOR # ; JMP RCVSERR ;BUMP ERROR CT. ; RCVDATA: MOV A,D ;GET SECTOR # STA RCVSNO ;SAVE IT to storage area MVI C,0 ;INIT CKSUM LXI H,DMABUF ;POINT TO BUFFER <--- CPM DMA buffer @ 80H ; RCVCHR: MVI B,1 ;1 SEC TIMEOUT CALL RECV ;GET CHAR JC RCVSTOT ;TIMEOUT MOV M,A ;STORE CHAR INR L ;DONE? JNZ RCVCHR ;NO, LOOP ; ;VERIFY CHECKSUM ; MOV D,C ;SAVE CHECKSUM MVI B,1 ;TIMEOUT LEN. CALL RECV ;GET CHECKSUM JC RCVSTOT ;TIMEOUT CMP D ;CHECKSUM OK? JNZ RCVSERR ;NO, ERROR ; ;GOT A SECTOR, IT'S A DUP IF = PREV, ; OR OK IF = 1 + PREV SECTOR ; LDA RCVSNO ;GET RECEIVED MOV B,A ;SAVE IT LDA SECTNO ;GET PREV CMP B ;PREV REPEATED? JZ RECVACK ;ACK TO CATCH UP INR A ;CALC NEXT SECTOR # CMP B ;MATCH? JNZ ABORT ;NO MATCH - STOP SENDER, EXIT RET ;CARRY OFF - NO ERRORS ; ;PREV SECT REPEATED, DUE TO THE LAST ACK ;BEING GARBAGED. ACK IT SO SENDER WILL CATCH UP ; RECVACK: CALL SENDACK ;SEND THE ACK, JMP RCVSECT ;GET NEXT BLOCK ; ;SEND AN ACK FOR THE SECTOR ; SENDACK: MVI A,ACK ;GET ACK CALL SEND ;..AND SEND IT RET ; ABORT: ;LXI SP,STACK ; ABORTL: MVI B,1 ;1 SEC. W/O CHARS. CALL RECV JNC ABORTL ;LOOP UNTIL SENDER DONE MVI A,CTRX ;CONTROL X CALL SEND ;STOP SENDING END ; ABORTW: MVI B,1 ;1 SEC W/O CHARS. CALL RECV JNC ABORTW ;LOOP UNTIL SENDER DONE MVI A,' ' ;GET A SPACE... CALL SEND ;TO CLEAR OUT CONTROL X ;CALL ERXIT ;EXIT WITH ABORT MSG ;DB 'XMODEM PROGRAM CANCELLED',lf,cr,'$' CALL ilprt db CR,'XMODEM CANCELLED',CR,'0' RET ; <--------exit point ------- ; ;----> INCRSNO: INCREMENT SECTOR # ; INCRSNO: LDA SECTNO ;INCR.. INR A ;..SECT.. STA SECTNO ;..NUMBER RET ; ; ;----> WRSECT: WRITE A SECTOR ; WRSECT: LHLD dest ;load destination address to HL XCHG ;put destination address in DE LXI H,DMABUF ;load CPM dma buffer address to HL CALL MOVE128 ;move 128 bytes to destination XCHG ; get updated dest addr in HL SHLD dest ; store it - update destination pointer RET ; ;----> RECV: RECEIVE A CHARACTER ; ;TIMEOUT TIME IS IN B, IN SECONDS. ; RECV: PUSH D ;SAVE ; ;IF FASTCLK ;4MHZ? ;MOV A,B ;GET TIME REQUEST ;ADD A ;DOUBLE IT ;MOV B,A ;NEW TIME IN B ;ENDIF ; MSEC: LXI D,50000 ;1 SEC DCR COUNT ; MWTI: IN TTS ; IMSAI specific, check input status ANI TTYDA ; "" JNZ MCHAR ;got a char DCR E ;COUNT.. JNZ MWTI ;..DOWN.. DCR D ;..FOR.. JNZ MWTI ;..TIMEOUT DCR B ;MORE SECONDS? JNZ MSEC ;YES, WAIT ; ;MODEM TIMED OUT RECEIVING ; POP D ;RESTORE D,E STC ;CARRY SHOWS TIMEOUT RET ; ;GOT CHAR FROM MODEM ; MCHAR: IN TTI ; IMSAI specific, get input byte POP D ;RESTORE DE ; ;CALC CHECKSUM ; PUSH PSW ;SAVE THE CHAR ADD C ;ADD TO CHECKSUM MOV C,A ;SAVE CHECKSUM POP PSW ;RESTORE CHAR ORA A ;CARRY OFF: NO ERROR RET ;FROM "RECV" ; ; ;----> SEND: SEND A CHARACTER TO THE MODEM ; SEND: PUSH PSW ;SAVE THE CHAR ADD C ;CALC CKSUM MOV C,A ;SAVE CKSUM SENDW: IN TTS ; IMSAI specific, Check Console Output Status ANI TTYTR JZ SENDW ;..NO, WAIT POP PSW ;GET CHAR OUT TTO ; IMSAI specific, Send Data RET ;FROM "SEND" ; ;-----> MOVE 128 CHARACTERS ; MOVE128 MVI B,128 ;SET MOVE COUNT ; ;MOVE FROM (HL) TO (DE) LENGTH IN (B) ; MOVE: MOV A,M ;GET A CHAR STAX D ;STORE IT INX H ;TO NEXT "FROM" INX D ;TO NEXT "TO" DCR B ;MORE? JNZ MOVE ;..YES, LOOP RET ;..NO, RETURN ; ;------------------ ; END XMODEM CODE ;------------------ ;---------------------- ; Display stack pointer **** CURRENTLY UNUSED CODE **** ;stkdsp: ; CALL ilprt ; db lf,cr,'Stack Pointer = ',00h ; ; LXI H,0 ; DAD SP ; CALL outhl ; RET ;---------------------- ; Fill memory fill: CALL hldebc ;GET RANGE, BYTE CPI APOS ; APOSTROPHE? (FOR ASCII CHAR INPUT) JZ fill4 ; YES ASCII MOV B,C fill2: MOV A,H ;FILL BYTE CPI STACK SHR 8 ;TOO FAR? JNC error ;YES fill3: CALL chekm ;PUT, CHECK CALL tstop ;DONE? JMP fill2 ;NEXT fill4: CALL getch ;ASCII CHAR MOV B,A JMP fill3 ; ; get h,l d,e and b,c ; hldebc: CALL hldeck ;RANGE JC error ;NO BYTE PUSH H CALL readhl ;3RD INPUT MOV B,H ;MOVE TO... MOV C,L ;...B,C POP H RET ; ; GET TWO ADDRESSES, CHECK THAT ; ADDITIONAL DATA IS INCLUDED ; hldeck: CALL hhlde ;2 ADDR JC error ; THAT'S ALL JMP rdhld2 ;CHECK ;------------------ ; Block Move block: CALL hldebc ;3 ADDR movdn: CALL movin ;MOVE/CHECK CALL tstop ;DONE? INX B ;NO JMP movdn movin: MOV A,M ;BYTE STAX B ;NEW LOCATION LDAX B ;CHECK CMP M ;IS IT THERE? RZ ;YES MOV H,B ;ERROR MOV L,C ;INTO H,L JMP errp ;SHOW BAD ;---------------- ; Verify 2 blocks of memory verm: CALL hldebc ;3 addresses verm2: LDAX B ;FETCH BYTE CMP M ;SAME AS OTHER? JZ verm3 ; YES PUSH H ;DIFFERENT PUSH B CALL crhl ;PRINT 1ST POINTER MOV C,M ;FIRST BYTE CALL outhex ;PRINT IT MVI A,':' CALL outt POP H ;B,C TO H,L CALL outhl ;SECOND POINTER MOV C,M ;2ND BYTE CALL outhx ;PRINT IT MOV C,L ;RESTORE C MOV B,H ; AND B POP H ; AND H,L verm3: CALL tstop ;DONE? INX B ;2ND POINTER JMP verm2 ;---------------- ; Load & Execute user program **** CURRENTLY UNUSED CODE **** ; 1) Copies 8K block from 56k-64k (EPROM land) to RAM @ 0100h ; 2) Runs the code @ 0100h as CPM program ; ;xeq: ; ; LXI B,0000h ; <-- stop when HL points to this addr (last addr copied is this# -1) ; LXI D,TPA ; <-- destination ; LXI H,ROM ; <-- source ;xeq1: MOV A,M ; ; XCHG ; ; MOV M,A ; ; XCHG ; ; INX H ; ; INX D ; ; MOV A,H ; - CHECK IF DONE ; CMP B ; ; JZ xeq2 ; ; JMP xeq1 ; ;xeq2: MOV A,L ; ; CMP C ; ; JNZ xeq1 ; ; ; JMP run ;do the CPM thing ;---------------- ; Program a 2708 EPROM chip ; This routine designed for SSM PB-1 Programmer PROM EQU 0F000H ; LOCATION OF 2708 PROGRAMMING SOCKET CPORT EQU 0E0H ; CONTROL PORT OF PB1 PROGRAMMER ; CPORT MUST DIFFER FROM HIGH ORDER ADDR OF PROM! prog: CALL readhl SHLD RAM LXI D,PROM LXI B,PROM+400h ;end test at PROM+1K CKE: ; Check if chip is erased (all bits = 1) LDAX D CPI 0FFh ; All bits 1 ? JNZ CKEF ; Failure INX D ; Bump pointer MOV A,B CMP D ; High bits at end address? JNZ CKE ; No, don't bother testing low bits MOV A,C CMP E ; Low bits also at end address? JNZ CKE ; No, keep going JMP PROGZ ; start with the programming CKEF: ; check failure - EPROM is not fully erased CALL ilprt DB CR,LF,'** The EPROM must be erased **',cr,lf,00h JMP wrmst PROGZ: CALL ilprt DB CR,LF,'Now Programming data from ',00h LHLD RAM CALL outhl CALL ilprt DB 'to EPROM at F000...',00h PROG0: MVI A,01 ;01=2708 OUT CPORT MVI B,0FFH ;256 CYCLES FOR 2708 MVI C,03 ;03=2708 {NUM BYTES=256*(C+1)} PROG1: LXI D,PROM LHLD RAM PROG2: MOV A,M STAX D INX D INX H MOV A,D ANA C ORA E JNZ PROG2 DCR B JNZ PROG1 DCX D LDAX D ;RESET PB1 CALL ilprt DB CR,LF,'Now Verifying...',00h ; now begin copy verification MVI C,03 LXI D,PROM LHLD RAM VERF1: MOV B,M LDAX D INX D INX H CMP B JNZ verr MOV A,D ANA C ORA E JNZ VERF1 CALL ilprt DB 'Verification PASSED',CR,LF,00H JMP wrmst verr: CALL ilprt DB 'Verification ** FAILED **',CR,LF,00H JMP wrmst ;---------------- ; FLASH Memory Code ; S - Save ; L - Load ; E - Erase ; R - Run flash: CALL getch ;get next char CPI 'S' JZ zsv CPI 'L' JZ zld CPI 'R' JZ zrun CPI 'E' JNZ error ;------- ; Flash erase sector (4K) ;------- CALL ilprt db cr,lf,'* WARNING * This will erase a 4K sector on the Library Card *',cr,lf db 'Input Sector to erase (0000-0080 hex for one chip): ',00h CALL inpl2 CALL readhl MOV B,L CALL ers CALL ilprt db cr,lf,'Erased',cr,lf,00h JMP wrmst ;------- ; load & execute (run) a program stored in Flash ;------- zrun: jmp ext01 ;jump to first extension area (5th chip) ; display options to user ; CALL ilprt ; db cr,lf,'Select a program to run:',cr,lf ; db 'A - BASIC-80',cr,lf ; db 'B - TREK',cr,lf ; db 'C - ADVENT',cr,lf ; db 00h ; ; ; get user input ; ; CALL ilprt ;first, display custom prompt for Library Card ; db lf,cr,'LibCard>',00h ; ; CALL inpl2 ; call inpl2 instead of inpln to use the above custom prompt ; CALL getch ; get the first character of the input string ; ; CPI 'A' ; JZ zbas ; CPI 'B' ; JZ ztrk ; CPI 'C' ; JZ zlfe ; ; else invalid entry ; JMP wrmst ;------- ; load & execute MBASIC from Flash ;------- ;zbas: ; MVI A,00H ; Load address with 004000 hex (start of 5th 4K sector) ; STA A2 ; ; MVI A,40H ; ; STA A1 ; ; MVI A,00H ; ; STA A0 ; ; MVI B,60H ; 60h = 96 blocks (MBASIC is 24K) ; ;doit: ; (common label to call to execute apps) ; MVI H,01H ; Set RAM destination to 0100 hex (for CPM app) ; MVI L,00H ; ; CALL rl ; Load it ; JMP run ; Run it ; ;ztrk: ; MVI A,00H ; Load address with 00B000 hex ; STA A2 ; ; MVI A,0B0H ; ; STA A1 ; ; MVI A,00H ; ; STA A0 ; ; MVI B,88H ; 88h blocks in length (TREK IS 34K) ; JMP doit ; do it ;zlfe: ; MVI A,01H ; Load address with 014000 hex ; STA A2 ; ; MVI A,40H ; ; STA A1 ; ; MVI A,00H ; ; STA A0 ; ; MVI B,A0H ; A0h blocks in length (ADVENT IS 40K) ; JMP doit ; do it ; ; can add other apps as needed here... ;.... ;.... ;.... ;.... ; ;----------------- ; Flash load code ;----------------- zld: CALL zginp ; GET INPUTS CALL rl ; * to maintain structure and allow rl to be called * ; (autoload MBASIC, for instance) JMP wrmst ; back to the monitor rl: CALL rdb ;READ THE BYTE FROM FLASH CHIP LDA A0 ;LOAD A0 ADDR TO A INR A ;BUMP IT STA A0 ;PUT UPDATED ADDR BACK IN MEM CPI 00H JNZ f2 LDA A1 INR A STA A1 CPI 00H JNZ f2 LDA A2 INR A STA A2 f2: INX H ;BUMP THE POINTER MOV A,L ;MOVE L TO A FOR COMPARISON TEST CPI 00h ;IS L ZERO? (SIGNIFIES 256 BYTES PROCESSED) JNZ rl ;NO- JUMP BACK TO READ LOOP FOR MORE DCR B MOV A,B CPI 00H JNZ rl CALL ilprt db cr,lf,'Loaded',cr,lf,00h RET zsv: ;------ ; Flash save code ;------ CALL zginp ;GET INPUTS wl: CALL wrb ;WRITE THE BYTE TO FLASH CHIP LDA A0 ;LOAD A0 ADDR TO A INR A ;BUMP IT STA A0 ;PUT UPDATED ADDR BACK IN MEM CPI 00H JNZ f3 LDA A1 INR A STA A1 CPI 00H JNZ f3 LDA A2 INR A STA A2 f3: INX H ;BUMP THE POINTER MOV A,L ;MOVE L TO A FOR COMPARISON TEST CPI 00h ;IS L ZERO? (SIGNIFIES 256 BYTES PROCESSED) JNZ wl ;NO- JUMP BACK TO WRITE LOOP FOR MORE DCR B MVI A,cr ; Display progress on screen via changing number on one line CALL outt ; MOV C,B ; CALL outhex ; MOV A,B CPI 00H JNZ wl CALL ilprt db cr,lf,'Saved',cr,lf,00h JMP wrmst ; Back to Monitor ;------------------------------- ; Flash subroutines ;------------------------------- ;========================== ; - Get Inputs from User -- ;========================== zginp: CALL ilprt db cr,lf db 'Input High Flash Address (00XX):',00h CALL inpl2 ; getline without '>' prompt char CALL readhl MOV A,L STA A2 CALL ilprt db 'Input Low Flash Address (XXXX):',00h CALL inpl2 CALL readhl MOV A,L STA A0 MOV A,H STA A1 CALL ilprt db 'Input RAM Address (XXXX):',00h CALL inpl2 CALL readhl PUSH H CALL ilprt db 'Input number of 256 byte blocks (XX hex):',00h CALL inpl2 CALL readhl MOV B,L POP H RET ;========================== ; --- Read a Byte to M ---- ;========================== rdb: LDA A2 ; Set Address OUT A2PRT ; LDA A1 ; OUT A1PRT ; LDA A0 ; OUT A0PRT ; IN RWPRT ; Read the data MOV M,A ; PUT IT IN MEMORY RET ;========================== ; --- Erase Sector in B --- ;========================== ers: ; Cycle 1 of 6 MVI A,00h ; Set Address OUT A2PRT ; MVI A,55h ; OUT A1PRT ; MVI A,55h ; OUT A0PRT ; MVI A,0AAh ; Set Data OUT RWPRT ; ; Cycle 2 of 6 MVI A,00h ; Set Address OUT A2PRT ; MVI A,2Ah ; OUT A1PRT ; MVI A,0AAh ; OUT A0PRT ; MVI A,55h ; Set Data OUT RWPRT ; ; Cycle 3 of 6 MVI A,00h ; Set Address OUT A2PRT ; MVI A,55h ; OUT A1PRT ; MVI A,55h ; OUT A0PRT ; MVI A,80h ; Set Data OUT RWPRT ; ; Cycle 4 of 6 MVI A,00h ; Set Address OUT A2PRT ; MVI A,55h ; OUT A1PRT ; MVI A,55h ; OUT A0PRT ; MVI A,0AAh ; Set Data OUT RWPRT ; ; Cycle 5 of 6 MVI A,00h ; Set Address OUT A2PRT ; MVI A,2Ah ; OUT A1PRT ; MVI A,0AAh ; OUT A0PRT ; MVI A,55h ; Set Data OUT RWPRT ; ; Cycle 6 of 6 MOV A,B ; Set Address (addresses 0-127 sectors via A18 through A12) RRC!RRC!RRC!RRC ; Rotate right 4 times ANI 07h ; Mask the bits to make: 0 0 0 0 0 A18 A17 A16 OUT A2PRT ; MOV A,B ; RLC!RLC!RLC!RLC ; Rotate left 4 times ANI 0F0h ; Mask the bits to make: A15 A14 A13 A12 0 0 0 0 OUT A1PRT ; MVI A,00h ; OUT A0PRT ; MVI A,30h ; Set Data OUT RWPRT ; ;========================== ; Sector Erase Delay routine - 25ms required as per spec ; this routine runs 30ms on 4MHz Z80 and 61ms on 2MHz 8080 ; Individual instruction timings in parentheses (4Mhz executes 4000 cycles/ms) ;========================== MVI C,20h ; outer loop 32 times (7 cycles) sed2: MVI D,0FFh ; inner loop 256 times (7 cycles) sed1: DCR D ; (5 cycles) JNZ sed1 ; (10 cycles) DCR C ; (5 cycles) JNZ sed2 ; (10 cycles) RET ;========================== ; -- Write a Byte from M -- ;========================== wrb: ; Cycle 1 of 4 MVI A,00h ; Set Address OUT A2PRT ; MVI A,55h ; OUT A1PRT ; MVI A,55h ; OUT A0PRT ; MVI A,0AAh ; Set Data OUT RWPRT ; ; Cycle 2 of 4 MVI A,00h ; Set Address OUT A2PRT ; MVI A,2Ah ; OUT A1PRT ; MVI A,0AAh ; OUT A0PRT ; MVI A,55h ; Set Data OUT RWPRT ; ; Cycle 3 of 4 MVI A,00h ; Set Address OUT A2PRT ; MVI A,55h ; OUT A1PRT ; MVI A,55h ; OUT A0PRT ; MVI A,0A0h ; Set Data OUT RWPRT ; ; Cycle 4 of 4 LDA A2 ; Set Address OUT A2PRT ; LDA A1 ; OUT A1PRT ; LDA A0 ; OUT A0PRT ; MOV A,M ; DATA TO BE WRITTEN IS POINTED TO BY HL OUT RWPRT ; ;========================== ; Byte Program Delay routine - 0.020ms (20 microseconds) required as per spec ; this routine runs 0.030ms on 4MHz Z80 and 0.060ms on 2MHz 8080 ; Individual instruction timings in parentheses (4Mhz executes 4000 cycles/ms) ;========================== MVI D,08h ; loop 8 times (7 cycles) dly1: DCR D ; (5 cycles) JNZ dly1 ; (10 cycles) RET ;-------------------------------------- ;Monitor Command Subroutines ;-------------------------------------- ;Inline Print ; ;THE CALL TO ILPRT IS FOLLOWED BY A MESSAGE, ;BINARY 0 AS THE END. ; ilprt: XTHL ;SAVE HL, GET HL=MSG ilplp: MOV A,M ;GET CHAR ORA A ;END OF MSG? JZ ilpret ;..YES, RETURN CALL outt ;TYPE THE MSG INX H ;TO NEXT CHAR JMP ilplp ;LOOP ilpret: XTHL ;RESTORE HL RET ;PAST MSG ;------------------ ledout: ;Display Register A on front panel LEDs CMA OUT LEDS CMA RET ;------------------ ;Input line from console and store in buffer ;Ctl-X cancels line, ,BKSP erases last char, CR enters line inpln: ;Input line from console and CALL ilprt db lf,cr,'>',00h ; * PROMPT CHARACTER * inpl2: LXI H,IBUFF ;Input buffer addr SHLD IBUFP MVI C,0 ;Init count to zero inpli: CALL intt ;Get char from console CPI ' ' ;Control char? JC inplc ;Yes CPI DEL ;Delete char? JZ inplb ;Yes CPI 'Z'+1 ;Upper case? JC inpl3 ;Yes ANI 5Fh ;No - so make upper case inpl3: MOV M,A ;Into buffer MVI A,IBL ;Buffer size CMP C ;Full? JZ inpli ;Yes, loop MOV A,M ;Get char from buffer INX H ;Incr pointer INR C ; and count inple: CALL OUTT ;Show char JMP inpli ;Next char ;Process control chars inplc: CPI CTRH ;Ctl H ? JZ inplb ;Yes CPI CR ;Return? JNZ inpli ;No, ignore ;End of input line MOV A,C ;Count STA IBUFC ;Save it ;CR LF routine crlf: MVI A,CR CALL outt ;Send CR MVI A,LF JMP outt ;Send LF ; MVI A,CR ; JMP outt ;Delete prior char, if any inplb: MOV A,C ;Char count ORA A ;Zero? JZ inpli ;Yes DCX H ;Back pointer DCR C ; and count MVI A,CTRH ;;MVI A,DEL JMP inple ;Send ctrl H ;------------------ ;Get Character from Console Buffer ; Set Carry Bit if empty getch: PUSH H ;Save Regs LHLD IBUFP ;Get Pointer LDA IBUFC ; and Count SUI 1 ;Decr with carry JC getc4 ;No more char STA IBUFC ;Save new count MOV A,M ;Get character INX H ;Incr pointer SHLD IBUFP ; and save getc4: POP H ;Restore Regs RET ;------------------ ; Simplified Core IO Routines ;------------------ ;Console Input intt: CALL instat ;Check status IN TTI ;Get byte ANI DEL CPI CTRX ;Abort? JZ wrmst ; RET ;------------------ ;Console Output outt: PUSH PSW CALL outstat POP PSW OUT TTO ;Send Data RET ;------------------ ;Check Console Input Status instat: IN TTS ANI TTYDA JZ instat RET ;------------------ ;Check Console Output Status outstat: IN TTS ;CHECK FOR USER INPUT CTRL-X ANI TTYDA ; JZ out2 ; IN TTI ; ANI DEL ; CPI CTRX ; JZ wrmst ; out2: IN TTS ;Check Console Output Statuas ANI TTYTR ; JZ outstat ; RET ;------------------- ; Debug Routine ; displays contents of reg A on LEDs ; and waits for 01H on toggles to continue ;debug: ; ; PUSH PSW ;save A ; CALL ledout ;dbg1: ; must see a transition from 00H to 01H on toggles ; IN 0FFH ; ; CPI 00H ; ; JNZ dbg1 ; ;dbg2: ; ; IN 0FFH ; ; CPI 01H ; ; JNZ dbg2 ; ; ; POP PSW ;restore A ; RET ;============================ ; BDOS Emulator Routines ; Input: Reg C function code ;============================ lbdos: ; entry point LXI H,0 ; save user's stack DAD SP ; SHLD oldstk ; LXI SP, STACK ; setup new stack for bdos use MOV A,C ;CALL ledout ;show BDOS fn number on LEDs ;**** ANALYSIS CODE - DISPLAYS BDOS FN# REQUESTED BY CALLING PROGRAM ;PUSH A ;CALL ilprt ;DB CR,LF,'IN BDOS FN# ',00H ;CALL outhex ;POP A ;**** CPI 00h JZ wrmst CPI 01h JZ conin CPI 02h JZ conout CPI 09h JZ prstr CPI 0Bh JZ bconst xbdos: ; exit point LHLD oldstk ; restore user's stack SPHL ; RET ; return to calling program ;----------------------- ; BDOS Main Functions begin here ;----------------------- ; BDOS 01H - Console Input conin: CALL bdinst IN TTI JMP xbdos ;----------------------- ; BDOS 02H - Console Output conout: MOV A,E cout: PUSH PSW CALL bdoutst POP PSW OUT TTO ;Send Data JMP xbdos ;----------------------- ; BDOS 09H - Print String ; POINTER TO STRING ARRIVES IN DE ; STRING IS TERMINATED WITH '$' prstr: PUSH D ;SAVE DE XCHG ;SWAP DE WITH HL PUSH H FN9L: MOV A,M ; cant use LDA M CPI '$' ; IS IT A DOLLAR SIGN? JZ FN9E ; YES - BRANCH TO END PUSH PSW CALL bdoutst POP PSW OUT TTO ;Send Data POP H ; INX H ; must save H for next loop, it gets trashed in bdos?? PUSH H ; JMP FN9L ; LOOP BACK TO PROCESS NEXT CHAR FN9E: POP H XCHG POP D JMP xbdos ;----------------------- ; BDOS 0BH - Get Console Status bconst: IN TTS ANI TTYDA JMP xbdos ;------------------ ;------------------ ; BDOS Subroutines begin here ;------------------ ;------------------ ;Check Console Input Status bdinst: IN TTS ANI TTYDA JZ bdinst RET ;------------------ ;Check Console Output Status bdoutst: IN TTS ;CHECK FOR USER INPUT CTRL-X ANI TTYDA ; JZ bdout2 ; IN TTI ; ANI DEL ; CPI CTRX ; RZ ; bdout2: IN TTS ;Check Console Output Statuas ANI TTYTR ; JZ bdoutst ; RET ;----------- ;Last entry place keeper (for 4K monitor core routines) fini: NOP ;----------- ; Begin extension areas ; ORG START + 5120 ; skips 4K monitor core and a 1K space for eprom programmer card ; assuming monitor core loaded at E000 for 60K system and 1K reserved for eprom programmer card, ; this leaves 3K available for extension coding (3 additional 2708 chips) ext01: ; (first extension area) ; LR command replacement ; This routine loads a directory structure from 1st page of flash ram and ; then displays it to the user and waits for selection of a file to run or load. ; Directory format is: ; A BBBBBBBB CCDDEEFFGH ; A = unique file ID (printable ascii - usually letters or numbers) ; B = file name (8 ascii chars) yes there are spaces surrounding it ; C = address 1 ; D = address 2 ; E = address 3 ; F = length (in 256 byte pages) ; G = file type (P=program, D=data) programs are run, data is loaded) ; H = reserved for future use ; delimits records (record length = 23 bytes) ; marks EOF drsz EQU 23 ;directory record size ;(read block zero into ram) MVI A,00H ; Load address with 000000 hex (start of 1st 4K sector) STA A2 ; MVI A,00H ; STA A1 ; MVI A,00H ; STA A0 ; MVI B,0FH ; 16 x 256 bytes = 4K (max size of dir) MVI H,01H ; Set RAM destination to 0100 hex (CPM standard aka TPA) MVI L,00H ; CALL rl ; Load it ;(display directory text) MVI H,01H ; Set RAM destination to 0100 hex (CPM standard aka TPA) MVI L,00H ; dsdir: MOV A,M ;get byte (assuming HL still set to location) CPI NUL ;are we at EOF? JZ dndir ;yes, jump to "done directory" CALL outt ;otherwise, send char out to display INX H ;bump pointer JMP dsdir ;go back for more dndir: ;end of routine ;(get user selection) CALL ilprt ; display custom prompt for Library Card db lf,cr,'Enter Selection >',00h CALL inpl2 ; call inpl2 instead of inpln to use the above custom prompt CALL getch ; get the first character of the input string ;(process user selection) MOV B,A ; char input in A so save it to B LXI H,TPA ; point to TPA where directory was loaded again: CMP M ; compare M (directory char) with A (user selection) JZ foo1 ; a match was found MVI D,0 ; setup DE MVI E,drsz ; DAD D ; add DE to HL MOV A,M ; put dir char in A CPI NUL ; found EOF marker? JZ foo2 ; if so, then we didn't find the specified file MOV A,B ; restore user input char to A JMP again ; loop back for more foo2: CALL ilprt db lf,cr,'* File Not Found *',00h RET ; just return if file not found foo1: MVI E,11 ; add offset of 11 to HL DAD D ; CALL hex2bin ; convert ASCII HEX to Binary STA A2 ; store the address MVI E,2 ; add offset of 2 to HL DAD D ; CALL hex2bin ; convert ASCII HEX to Binary STA A1 ; store the address MVI E,2 ; add offset of 2 to HL DAD D ; CALL hex2bin ; convert ASCII HEX to Binary STA A0 ; store the address MVI E,2 ; add offset of 2 to HL DAD D ; CALL hex2bin ; convert ASCII HEX to Binary MOV B,A ; put length in B ;(check for file type) MVI E,2 ; add offset of 2 to HL DAD D ; MOV A,M CPI 'P' ; is it a PROGRAM type file? JZ lnr ; if yes, jump to "load n run" ;(load it / run it) MVI H,01H ; Set RAM destination to 0100 hex (for CPM app) MVI L,00H ; CALL rl ; Load it JMP wrmst ; warm start (load only for data files) lnr: MVI H,01H ; Set RAM destination to 0100 hex (for CPM app) MVI L,00H ; CALL rl ; Load it JMP run ; Run it ;useful subroutines-------------- hex2bin: ; generic routine to convert 2 ascii hex chars to a binary byte INX H MOV A,M ; get low char DCX H CALL A2HEX ; convert it MOV B,A ; save value in B MOV A,M ; get high char CALL A2HEX ; convert it RLC!RLC!RLC!RLC ; shift hex value to upper four bits ORA B ; or in low hex value RET A2HEX: SUI '0' ; subtract ASCII offset CPI 10 JC A2HEX1 ; branch if A is decimal digit SUI 7 ; else subtract offset for letters A2HEX1: RET ;================== END ;==================