; ... SF ... ; Show File ; --------------- ; A program to display the contents of CP/M text files ; Written by John Gill, Route 5, Box 370, Blountville, TN 37167 ; Version 1.1 dated March 18, 1984. ; Permission is granted for unrestricted copying and use ; of this program for non-commercial use only. ; Use for profit requires permission of the author. FALSE EQU 00H ;Value of False TRUE EQU NOT FALSE ;Value of True STANDARD EQU TRUE ;Standard released version DISK$BUFF EQU 80H ;Transient program buffer TFCB EQU 5CH ;Transient program FCB CPM EQU 05H ;BDOS entry point CPM$EOF EQU 1AH ;End of file marker CR EQU 0DH ;Carriage Return LF EQU 0AH ;Line feed FF EQU 0CH ;Form Feeds are ignored TAB EQU 09H ;Tab character SPACE EQU 20H ;Space character ESC EQU 1BH ;Escape code for cursor control BAKSPACE EQU 08H ;Back space key code BELL EQU 'G'-40H ;To ring console bell MAX$LINES EQU 23 ;Maximum display lines per page MAX$COL EQU 79 ;Maximum columns on CRT MAX$STR EQU 10 ;Maximum string length for Find CLR$CRT EQU 'Z'-40H ;Byte to clear the CRT IF STANDARD QUIT EQU 'K'-40H ;Quit if this byte entered UP$ARROW EQU 'E'-40H ;Move up in file one line DOWN$ARROW EQU 'X'-40H ;Move down in file one line PAGE$UP EQU 'R'-40H ;Move screen up 1 page PAGE$DOWN EQU 'C'-40H ;Move screen down 1 page SCROL$KEY EQU 'S'-40H ;To scroll screen ENDIF IF NOT STANDARD ; These are my Function keys or arrow keys for the TeleVideo 920. QUIT EQU 'C'-40H ;Quit if this byte entered UP$ARROW EQU 'K'-40H ;Move up in file one line DOWN$ARROW EQU 'J'-40H ;Move down in file one line PAGE$UP EQU 0C1H ;F2 to move screen up 1 page PAGE$DOWN EQU 0C0H ;F1 to move screen down 1 page SCROL$KEY EQU 0C2H ;F3 to scroll screen ENDIF ORG 100H JP START ;Skip over revision data ; SF is a utility program that displays a text in a better manner ; than that provided by CP/M's TYPE command. ; This version requires a Z-80 cpu and CP/M 2.2 or higher. ; --------------------------------------------------------- DEFB ' SF by John Gill, Rt 5, Box 370,' DEFB ' Blountville, TN. 37617 ' DEFB ' Version 1.1 -- 03/18/84 ' START: LD (OLD$STACK),SP ;Save old stack pointer LD SP,STACK ;Set new stack pointer CALL OPEN$FILE ;Open file CALL CLEAR$TABLE ;Clear working table ; ...... Main loop ...... LOOP: LD SP,STACK ;Reset stack pointer CALL SHOW$PAGE ;Display one page CALL GET$COMND ;Read next command JR LOOP ;Repeat ; -------------------------------------------------------------- ; This routine displays one page on the CRT. SHOW$PAGE: CALL CLR$SCREEN ;Clear the screen LD HL,(CURR$LINE) ;Get last current line INC HL ;To next line no. LD (TOP$LINE),HL ;Save as top screen line SHOW1: CALL GET$BYTE ;Get next byte from buffer RET C ;Return if end of file LD C,A ;Put output char in C CP LF ;See if end of line marker JR NZ,SHOW5 ;If not CALL PRT$BYTE ;Issue line feed SUB A ;Get a zero LD (CRT$COL),A ;Clear column counter LD A,(CRT$LINE) ;Get current line INC A ;Bump by 1 CP MAX$LINE ;See if at end of screen RET Z ;Return if done LD (CRT$LINE),A ;Put line counter back JR SHOW1 ;Get next character SHOW5: CP TAB ;Is it a tab character? JR Z,SHOW6 CALL PRT$BYTE ;Display the character JR SHOW1 SHOW6: LD C,SPACE ;Display character LD A,(OPTION) ;Get option byte CP 'N' ;See if line numbers wanted LD B,0 ;Assume no line numbers JR NZ,SHOW7 ;If assumed correct LD B,6 ;To make tabs come out right SHOW7: PUSH BC ;Save values on stack CALL PRT$BYTE POP BC ;Restore values LD A,(CRT$COL) ;Get column no. SUB B ;Adjust for line number usage AND 07H ;Modulo 8 JR NZ,SHOW7 ;If not at tab stop, keep going JR SHOW1 ; Display the character in register C. PRT$BYTE: LD A,(CRT$COL) ;Get current column number INC A ;To add this character LD B,A ;Save in B LD HL,PRT1$FLAG ;See if 1st char on line LD A,(HL) OR A JR Z,PRT4 ;If not 1st LD (HL),0 ;Turn off flag LD A,(TOP$FLAG) ;To adjust TOP$LINE OR A ;Zero = don't adjust JR Z,PRT2 LD HL,(TOP$LINE) ;Now adjust top line number INC HL ;Add 1 to the value LD (TOP$LINE),HL ;Put back PRT2: LD A,(OPTION) ;Get option byte CP 'N' ;See if line numbers wanted LD B,1 ;Reset CRT$COL just in case CALL Z,PRT$NUMBER ;Print line numbers PRT4: LD A,C ;Get output char back CP SPACE ;See if a control char LD A,B ;Get column number into A JR NC,PRT6 ;If >= space DEC A ;Don't count LD (CRT$COL),A ;Put old count back LD A,C ;Get character back again CP FF ;Ignore Form Feeds JP NZ,CONOUT ;Send non-displayable char & return RET PRT6: LD (CRT$COL),A ;Put updated count back CP MAX$COL+1 ;See if at end of line CALL C,CONOUT ;Send to CRT if space on line RET ; Routine to read a byte from the buffer area. ; on exit: A = byte from buffer; Carry set = end of file GET$BYTE: LD HL,(DISK$ADDR) ;Current buffer pointer LD A,L CP DISK$BUFF+128 AND 00FFH ;Ck if past end JR NZ,GETB4 ;Zero = Yes, read CALL READ$SEQ ;Read next Sequential rec RET C ;Return if carry set GETB4: LD A,(HL) ;Get byte into B CP CPM$EOF ;End of file? SCF ;Set carry flag just in case RET Z ;Quit if end of file LD (SAVE$CHAR),A ;Save it in memory INC HL ;Bump pointer LD (DISK$ADDR),HL ;Save buffer address LD HL,PRT1$FLAG ;Flag to mark 1st print byte LD (HL),0 ;Set to off LD HL,BYTE1 ;1st byte of line flag LD A,(HL) ;1st byte of a new line? OR A ;Zero = no JR Z,GETB6 ;Jump if not a 1st byte LD (HL),0 ;Clear flag LD HL,PRT1$FLAG ;Set flag to mark 1st print byte LD (HL),0FFH LD HL,(CURR$LINE) ;Get current line no. INC HL ;Bump by one LD (CURR$LINE),HL ;Put back LD A,L ;Get low line number byte AND 3FH ;Mask off low 6 bits JR NZ,GETB6 ;Bits 0-5 off = multiple of 64 CALL TBL$POSITION ;Get position in table JR NZ,GETB6 ;Table already has an entry CALL GET$RECNO ;Get RAN current record no. LD HL,(FCB$RECNO) ;Get it into DE LD (IX+0),H ;Put record no. in table LD (IX+1),L LD HL,(DISK$ADDR) ;Get address of next buffer byte DEC HL ;Backup to current byte LD (IX+2),H ;Put high buffer address in table LD (IX+3),L ;Now low address byte GETB6: LD A,(SAVE$CHAR) ;Get orig character back CP LF ;Is byte a Line Feed JR NZ,GETB8 ;If not LD HL,BYTE1 ;Set 1st byte flag for next char LD (HL),0FFH GETB8: OR A ;Reset carry RET READ$ERROR: SCF RET ; Routine to get the next command from the console. GET$COMND: CALL CLR$BOTTOM ;Clear bottom line SUB A ;Zero command string length LD (C$LENGTH),A CALL CONIN ;Get 1st byte CP 'a' ;Check for low case value JR C,GC0 ;If < "a" CP 'z'+1 JR NC,GC0 ;If not a lower case alpha AND 0DFH ;Turn off bit 5 to make upper case GC0: LD (SIGN),A ;Put in sign byte CP QUIT ;Should we quit? JP Z,FINISH CP SCROL$KEY ;Should we scroll the screen? JP Z,SCROLL CP UP$ARROW ;To move up one line JP Z,UP$1LINE CP DOWN$ARROW ;To move down one line JP Z,DOWN$1LINE CP PAGE$DOWN ;To process next page JP Z,DOWN$PAGE CP PAGE$UP ;To go back one page JP Z,UP$PAGE CP SPACE ;Space bar hit? JP Z,DOWN$PAGE CP CR ;Carriage returm? JP Z,DOWN$PAGE CP 'N' ;Toggle option byte? JP Z,TOG$OPTION LD HL,CON$BUFF ;Point to start of Con Buff CP 'F' ;Find a string? JP Z,GC1 CP '+' ;A plus sign ? JR Z,GC1 CP '-' ;A minus sign JR Z,GC1 CALL VALIDATE ;See if valid ascii digit JR C,GET$COMND ;Start over if bad character LD (HL),A ;Put 1st digit in buffer INC HL ;Move to next byte GC1: LD (CB$ADDR),HL ;Save as current address LD HL,SIGN ;Point to 1st byte LD C,(HL) ;Echo byte to screen CALL CONOUT GC2: CALL CONIN ;Read next char LD HL,(CB$ADDR) ;Get con buff address CP 'U'-40H ;Check for a line delete JR Z,GET$COMND ;Start over CP CR ;Check for Carriage Return JR NZ,GC4 ;CR = all done LD (HL),A ;Put CR in buffer JR CONVERT ;Convert to 16 bit number GC4: CP BAKSPACE ;Chk if to delete last char JR NZ,GC6 LD C,A ;Store character in C LD A,CON$BUFF AND 0FFH CP L ;Is this 1st character? JR Z,GET$COMND ;If deleted 1st byte DEC HL ;Reduce pointer by 1 LD (CB$ADDR),HL ;Put Con buff address away CALL CONOUT ;Display back-space LD C,SPACE ;Get a space CALL CONOUT LD C,BAKSPACE CALL CONOUT JR GC2 GC6: LD C,A ;Save byte in C LD A,(SIGN) ;See if on a Find String CP 'F' JR NZ,GC8 ;If not on a find LD A,C ;Get character back into A CP SPACE ;See if control char JR C,GC88 ;No control char allowed LD A,(C$LENGTH) ;Get current string length INC A ;Add this one to counter CP MAX$STR+1 ;Too big? JR NC,GC88 ;If too big LD (C$LENGTH),A ;Put count back LD (HL),C ;Put character in buffer INC HL ;Bump buffer pointer LD (CB$ADDR),HL ;Put address back CALL CONOUT ;Now echo char JR GC2 ;Go get next character GC8: LD A,C ;Get input character back CALL VALIDATE ;See if valid digit JR C,GC2 ;If no good LD B,A ;Save hex nibble in B LD A,CON$BUFF+4 AND 0FFH CP L ;Is this 5TH character? JR NZ,GC9 ;If OK GC88: LD C,BELL ;Ring bell CALL CONOUT JR GC2 GC9: LD (HL),B ;Put digit in buffer INC HL ;Bump buffer pointer LD (CB$ADDR),HL ;Put address back CALL CONOUT ;Now echo char JR GC2 ;Go get next character ; Routine to convert the binary string to a 16 bit number. ; On entry: The data is in CON$BUFF in hex nibble format. ; The string ends with a carriage return. ; On exit: HL contain the binary number. CONVERT: LD A,(SIGN) ;See if on a Find String CP 'F' JP Z,FIND$STRING ;Go do it LD DE,CON$BUFF ;Point to start of buffer LD HL,0 ;Zero counter CONV2: LD A,(DE) ;Get byte from buffer CP CR ;Are we done? JR NZ,CONV3 ;If not LD A,H ;Check for zero entry OR L JR NZ,CALC$LINE ;With number in HL LD HL,1 ;Set to 1 LD A,(SIGN) ;Was a sign entered CP '+' ;Assume +1 wanted JR Z,CALC$LINE ;With a 1 in HL CP '-' ;Assume -1 wanted JR Z,CALC$LINE ;With a 1 in HL JP GET$COMND ;To get a vaild number CONV3: LD B,H ;Move HL to BC LD C,L LD A,9 ;Add ten times CONV4: ADD HL,BC ;Add BC to HL DEC A JR NZ,CONV4 ;Added ten times ?? LD A,(DE) ;Get byte back again LD C,A ;Move number to BC LD B,0 ADD HL,BC ;Put number in BC INC DE JR CONV2 ;Get next digit of number ; Routine to calculate the new line to go to. ; On entry: HL contains the increment or absolute line ; number to start the next display screen with. ; Note: The computer line numbers start at line zero. CALC$LINE: LD A,(SIGN) ;See what direction to move CP '+' ;"+" = forward in file JR NZ,CALC4 PUSH HL ;Save increment on stack OR A ;Clear carry LD DE,MAX$LINES ;See if full page or less SBC HL,DE POP DE ;Line increment now in DE JR NC,CALC2 ;If more than a full page LD A,E ;Put increment in A OR A ;Might be zero? JP Z,GET$COMND LD B,A ;Move increment to B CALL SHOW$LINE ;Show next B lines JP GET$COMND ;All done here CALC2: LD HL,(TOP$LINE) ;Get top line no. on screen ADD HL,DE ;HL now has new line no. JR CALC7 CALC4: CP '-' ;"-" = backward in file JR NZ,CALC6 ;Must contain absolute line no. EX DE,HL ;Put line increment in DE CALC5: LD HL,(TOP$LINE) ;Get current top line no. SUB A ;Clear carry flag SBC HL,DE ;HL now has new line no. JR C,CAL5 ;If negative line no. JR Z,CAL5 ;If zero line no. JR CALC7 ;If valid line number CAL5: CALL BAK1 ;Backup to line 1 CALL READ$RAN ;Read 1st random record RET ;To display 1st page CALC6: DEC HL ;Absolute line not wanted LD A,H ;Line numbers start at zero OR L JR Z,CAL5 ;if line zero wanted CALC7: LD (LINE$NO),HL ;Put line no. wanted in ram CALL TBL$POSITION ;Get position in table JR NZ,CALC8 ;If previously processed CALL BACKUP ;Backup to last record processed JR CALC9 CALC8: CALL BAK4 ;To put values in memory CALC9: CALL READ$RAN ;Read this random record JP FIND$LINE ;Move to start of wanted line ; and display the page. ; Routine to continuously scroll the screen until a ; key is pressed. SCROLL: SUB A ;Get a zero LD (CRT$COL),A ;Zero column number CALL CLR$BOTTOM ;Clear bottom line LD A,0FFH ;Turn on the flag to LD (TOP$FLAG),A ; adjust the top line. SCRL2: LD A,MAX$LINES-1 ;Set the line count for LD (CRT$LINE),A ; one line processing CALL SHOW1 ;Use routine in SHOW$PAGE JR C,SCRL4 ;If end of file CALL CONST ;Check console status OR A ;Zero = no data available JR Z,SCRL2 ;Do next line CALL CONIN ;Get byte from console SCRL4: SUB A ;Get a zero LD (TOP$FLAG),A ;Turn off top line counter JP GET$COMND ; Routine to move the dispaly one line toward the end ; of the file. The program actually scrolls one line. DOWN$1LINE: LD B,1 ;To show 1 line CALL SHOW$LINE ;Display next line from file JP GET$COMND ; Routine to move the entire screen down one page. ; The screen is moved forward (toward the end of file) one page. ; No special logic is needed as this is the default action. DOWN$PAGE: RET ; Routine to toggle the option byte. ; If it is an "N", it will be converted to a null byte ; else it will be converted to an "N". TOG$OPTION: LD HL,OPTION ;Point to option byte LD A,'N' ;Get the option value XOR (HL) ;With the option byte LD (HL),A ;Put byte back JP GET$COMND ;Go get next commmand ; Routine to move the display 1 line toward the front ; of the file. UP$1LINE: LD DE,1 ;To move -1 line JR CALC5 ;In CALC$LINE routine ; Routine to move the entire screen up one page. ; The screen is moved backward (toward the front of file) one page. UP$PAGE: LD DE,MAX$LINES ;To move all lines JR CALC5 ;In CALC$LINE routine ; Routine to display 1 line at the bottom of the screen and ; scroll up one line. ; On entry: B contains the number of lines to display. SHOW$LINE: SUB A ;Get a zero LD (CRT$COL),A ;Preset CRT column no. LD A,MAX$LINES ;Preset CRT line no. SUB B ;Number of lines to process LD (CRT$LINE),A CALL CLR$BOTTOM ;Clear bottom line LD A,0FFH ;Set TOP$FLAG on LD (TOP$FLAG),A CALL SHOW1 ;Use part of SHOW$PAGE SUB A ;Set TOP$FLAG off LD (TOP$FLAG),A RET ; ----------------------------------------------------------------- ; This routine searches forward and looks for the string in the ; file to match the one in CON$BUFF. FIND$STRING: LD A,(C$LENGTH) ;Get command length into A OR A JR NZ,FSTR1 ;If a string was entered LD A,(S$LENGTH) ;See if previous string active OR A JP Z,GET$COMND ;Ignore this command JR NZ,FSTR2 ;Use previous string FSTR1: LD (S$LENGTH),A ;Save string length LD B,A ;Move string from CON$BUFF LD HL,CON$BUFF ; to STR$BUFF LD DE,STR$BUFF CALL MOVE FSTR2: LD HL,LINE$BUFF ;Set buffer input address LD (LINE$ADDR),HL CALL GET$LINE ;Get next line into buffer JP C,GET$COMND ;If at end of file LD DE,LINE$BUFF ;Put to input line buffer FSTR3: LD A,(S$LENGTH) ;Get string length LD B,A ;Move to B LD HL,STR$BUFF ;Where string is located FSTR4: LD A,(DE) ;Get byte from line CP LF ;LF = end of line JR Z,FSTR2 ;If not in this line CP (HL) ;Match one in con buffer? INC DE ;Bump line address JR NZ,FSTR3 DEC B ;Reduce bytes to match JR Z,FSTR5 INC HL ;Bump string pointer JR FSTR4 FSTR5: CALL CLR$SCREEN ;Clear the CRT LD A,0FFH ;Turn 1st byte flag on LD (PRT1$FLAG),A LD HL,(CURR$LINE) ;Get current line no. DEC HL ;Reduce by 1 LD (TOP$LINE),HL ;Make it the top line LD HL,LINE$BUFF FSTR6: LD C,(HL) ;Get character PUSH HL ;Save address CALL PRT$BYTE POP HL ;Restore the address LD A,(HL) ;Get byte back CP LF ;Line feed = end of line JR Z,FSTR7 INC HL JR FSTR6 ;continue FSTR7: LD A,1 ;Set for line no. 1 LD (CRT$LINE),A SUB A ;Set for column zero LD (CRT$COL),A CALL SHOW1 ;Show rest of page JP GET$COMND ; This routine reads the next logical line from the disk and ; moves it to the LINE$BUFFER. GET$LINE: CALL GET$BYTE ;Get next byte from buffer JR NC,GETL4 ;Carry set = end of file LD HL,(CURR$LINE) ;Get current line ; DEC HL LD (TOP$LINE),HL ;Make it the top line CALL CLR$SCREEN ;Clear the CRT screen SCF ;Set carry RET GETL4: LD HL,(LINE$ADDR) ;Get address in line LD (HL),A ;Put byte in buffer INC HL ;Bump buffer pointer LD (LINE$ADDR),HL ;Put back CP LF ;Is next byte a new line? JR NZ,GET$LINE ;If not at end of line RET ; ----------------------------------------------------------------- ; This routine finds the position in the table that corresponds ; to the record number of the line number wanted. ; On entry: HL contain the Line Number. ; On exit: IX has the row address of the desired record no. ; DE contain the start address within the disk buffer. ; Zero flag set = This table element was empty. ; Each row of the table contains four bytes: ; Byte 1 = High byte of FCB record number - Goes in reg. B ; Byte 2 = Low byte of FCB record number - Goes in reg. C ; Byte 3 = High byte of disk buffer start address - Goes in reg. D ; Byte 4 = Low byte of disk buffer start address - Goes in reg. E TBL$POSITION: LD B,6 ;Divide HL by 64 TPOS2: SRL H ;Shift right logical RR L ;Rotate right with carry DJNZ TPOS2 ;6 shifts = divide by 64 ADD HL,HL ;Mulitply by 4 ADD HL,HL ; to calc table offset LD DE,TABLE ;Address of table ADD HL,DE ;Now over high byte of rec no. PUSH HL ;Put this address in IX register POP IX LD D,(IX+2) ;Get high buffer address into D LD E,(IX+3) ;Get low buffer address into E LD A,D ;Check if address is empty OR E ;DE = zero if empty row RET ; This routine reads through the file until it comes to the ; start of the desired line number. ; On entry: Current line number is in CURR$LINE. ; Desired line number is in LINE$NO. ; On exit: Carry set = end of file found. FIND$LINE: LD DE,(CURR$LINE) ;Get where we are INC DE ;For next new line LD HL,(LINE$NO) ;Get line number wanted SUB A ;Clear carry flag SBC HL,DE ;See if all done RET Z ;Zero set = all done FND2: CALL GET$BYTE ;Get next byte from buffer JR NC,FND4 ;Carry set = end of file LD HL,(CURR$LINE) ;Get current line DEC HL LD (TOP$LINE),HL ;Make it the top line CALL CLR$SCREEN ;Clear the CRT screen JP GET$COMND FND4: CP LF ;Is next byte a new line? JR NZ,FND2 ;If not at end of line JR FIND$LINE ; This routine goes backup the table until it finds a non-zero ; record number or reaches the start of the table: ; On entry: IX contains the address of the empty record number. BACKUP: PUSH IX ;Save table address on stack POP HL ;Copy address to HL LD DE,TABLE ;Address of head of table OR A ;Clear carry SBC HL,DE ;See if at top of table JR NZ,BAK2 ;If not at top BAK1: LD DE,DISK$BUFF ;Initialize to 1st position LD HL,0FFFFH ; of 1st record. LD BC,0 ;Next FCB record no. LD A,0FFH ;Turn on 1st print byte flag LD (PRT1$FLAG),A LD IX,TABLE ;Top table row number JR BAK6 ; Now move up 4 bytes to the start of the next entry BAK2: DEC IX ;Over low buffer address byte DEC IX ;Over high buffer address byte DEC IX ;Over low FCB record number DEC IX ;Over high FCB record number LD D,(IX+2) ;Get high buffer address into D LD E,(IX+3) ;Get low buffer address into E LD A,D ;Check if address is empty OR E ;DE = zero if empty row JR Z,BACKUP ;Try next slot upward in table BAK4: PUSH IX ;Copy IX register to HL POP HL ;Both have table address LD BC,TABLE ;Calc distance from top SUB A ;Clear carry SBC HL,BC ;HL has distance * 4 ADD HL,HL ;Shift left 4 times to ADD HL,HL ; multiply value by 64 ADD HL,HL ADD HL,HL ;HL now has starting line no. DEC HL ;It is incremented in GET$BYTE LD B,(IX+0) ;Get high FCB record number LD C,(IX+1) ;Get low FCB record number BAK6: LD (DISK$ADDR),DE ;Put in start position LD (FCB$RECNO),BC ;Put next record no. in FCB LD (CURR$LINE),HL ;And line number in memory RET ; ------------------ SCREEN HANDLING ROUTINES -------------------- CLR$SCREEN: LD C,CLR$CRT ;Get clear screen byte CALL CONOUT ;Send to CRT SUB A ;Get a zero LD (CRT$LINE),A ;Initialize CRT position LD (CRT$COL),A LD A,0FFH ;Set 1st print byte flag LD (PRT1$FLAG),A RET ; This routine sets the bottom line to spaces and positions the ; cursor back at the start of the line. CLR$BOTTOM: CALL LINE$24 ;Move cursor to start of line CALL CLR$LINE ;Clear line to spaces CALL LINE$24 ;Move cursor to start of line RET ; Position the cursor at the start of bottom line. LINE$24: LD HL,LINE24 ;Issue cursor position sequence JP DISPLAY ;Display sequence and return ; Clear the current line to spaces. CLR$LINE: LD C,ESC ;Issue clear line sequence CALL CONOUT LD C,'T' JP CONOUT ;and return to caller ; -------------------------------------------------------------- ; This routine clears the working table. CLEAR$TABLE: LD HL,TABLE ;Address of working table LD BC,160*4 ;160 rows with 4 bytes per row CLEAR2: LD (HL),0 ;Set to zero INC HL ;Bump pointer DEC BC ;Check for end LD A,B OR C JR NZ,CLEAR2 ;Continue until all zero RET ; Routine to check the charater in A to see if it is ; a valid ASCII digit 0-9. ; On exit: carry flag set = not a valid digit. VALIDATE: SUB 30H ;Change from ASCII to number JR C,VAL$ERR ;Error if less than ASCII '0' CP 10 ;See if more than number 9 CCF ;Reverse carry flag RET NC ;If OK VAL$ERR: LD C,BELL ;Ring bell CALL CONOUT SCF ;Carry flag set = error RET ; Routine to fill an area with a constant. ; On entry: HL point the the area to be filled. ; B contains the number of bytes to be filled. ; C contains the constant. FILL: LD (HL),C ;Put constant in memory INC HL ;Bump pointer DJNZ FILL RET ; Routine to move data from one area to another. ; On entry: HL contains the source address. ; DE contains the destination address, ; B contains the number of bytes to be moved. MOVE: LD A,(HL) ;Get byte from source LD (DE),A ;Put in destination INC HL ;Bump pointers INC DE DJNZ MOVE RET ; Routine to add the contents of register A to that of HL. ADD$HL: ADD L ;Add low byte LD L,A ;Put back RET NC ;If no carry generated INC HL RET ; Routine to open a disk file. OPEN$FILE: LD HL,TFCB ;Move the transient FCB to LD DE,FCB ; working RAM. LD B,16 ;16 bytes long CALL MOVE INC HL ;Move to option code LD A,(HL) ;Get any option code CP 'N' ;Line numbers wanted JR NZ,OPEN2 ;If not LD (OPTION),A ;Save for later use OPEN2: LD DE,FCB ;Now open the file LD C,15 ;Open code CALL CPM ;Issue open CP 0FFH ;Error? JP Z,ERROR ;If error, exit LD HL,0 ;Clear FCB record numbers LD (FCB+32),HL LD (FCB+34),HL CALL READ$SEQ ;Read first record JP C,FINISH LD HL,-1 ;Set current line to -1 LD (CURR$LINE),HL RET ; Routine to read the Sequential record. READ$SEQ: LD C,20 ;Sequential read code LD DE,FCB ;FCB address CALL CPM ;Issue read to CPM OR A ;Error? JR NZ,RDSEQ4 ;Zero = OK LD HL,DISK$BUFF ;Reset buffer pointer LD (DISK$ADDR),HL RET RDSEQ4: SCF ;Set carry to indicate error RET ; Routine to read the Random record. READ$RAN: LD C,33 ;Random read code LD DE,FCB ;FCB address CALL CPM ;Issue read to CPM OR A ;Error? JR NZ,RDRAN4 ;Zero = OK LD HL,FCB$CR ;Bump current recno for INC (HL) ;next sequential read RET RDRAN4: SCF ;Set carry to indicate error RET ; This routine calls CPM to establish what the current ; record number is. GET$RECNO: PUSH HL ;Save registers LD HL,FCB$CR ;FCB$CR contained sequential DEC (HL) ; record no. of next record LD C,36 ;Code to get record no. LD DE,FCB ;FCB address CALL CPM LD HL,FCB$CR ;Restore FCB$CR to the value INC (HL) ; before this routine. POP HL ;Restore registers RET ; ------------------------------------------------------------ ; This routine prints the line number and a colon before the ; actual line is printed. ; The actual length of the data line is 6 bytes less when the ; line number option is used. ; The binary value in CURR$LINE is converted to decimal and ; then displayed on the CRT. PRT$NUMBER: PUSH BC ;Save orig char in stack LD HL,LNUMBER ;Start of line number buffer LD DE,(CURR$LINE) ;Get number of this line INC DE ;Computer starts at line zero LD (HL),'0' ;Insert a zero SUB A ;Set 1st digit switch to off LD (DIGIT1),A LD BC,1000 ;High order digit CALL SUB ;Divide DE by 1000 LD BC,100 CALL SUB ;Divide DE by 100 LD BC,10 CALL SUB ;10'S digit LD A,E ;Get units value ADD (HL) LD (HL),A ;Put in line LD HL,LNUMBER ;Now display the line number CALL DISPLAY POP BC ;Restore orig output char LD B,7 ;Next column is 7 RET ;All done ; This routine is called by PRT$NUMBER and it subtracts the value ; in BC from the value in DE in order to calc the decimal value ; for that position. SUB: EX DE,HL ;Put line no. in HL LD (TEMP1),HL ;Save it in memory SUB A ;Clear carry SBC HL,BC ;Subtract BC from line no. JR C,SUB2 ;If too much EX DE,HL ;Get prt address back into HL INC (HL) ;Bump ascii value JR SUB ;Again SUB2: EX DE,HL ;Swap back to orig position LD DE,(TEMP1) ;Get prev value LD A,(DIGIT1) ;Ck for 1 non-zero digit OR A JR NZ,SUB6 ;Ok to display LD A,'0' ;Get an ascii zero CP (HL) ;Save as stored in line JR NZ,SUB4 ;If not LD (HL),' ' ;Blank out leading zero JR SUB6 SUB4: LD A,1 ;Set leading indicator LD (DIGIT1),A SUB6: INC HL ;Next pos in line LD (HL),'0' ;Insert an ascii zero RET ; ------------------------------------------------------------ ; This routine processes the fatal error messages. ; On entry: HL contain the address of the error message. ERROR: LD HL,OPEN$MSG ;Display opening message CALL DISPLAY LD HL,OPN$ERR ;Set error message CALL DISPLAY ;Write msg LD HL,STOP$MSG CALL DISPLAY FINISH: LD SP,(OLD$STACK) ;Restore old stack pointer RET ; Routine to display a message pointed to by the HL registers. ; The line must end with a binary zero. DISPLAY: LD A,(HL) ;Get character OR A ;Zero = end of msg RET Z PUSH HL ;Save address LD C,A ;Display the character CALL CONOUT POP HL ;Restore the address INC HL JR DISPLAY ;continue ; Check console status routine. ; On exit: A = 0 if not data available. CONST: LD HL,(0001H) ;Get the base address LD L,06H ;Modify low byte JP (HL) ;Let BIOS output the byte ; Console input routine. ; On exit: input character in register C. CONIN: LD HL,(0001H) ;Get the base address LD L,09H ;Modify low byte JP (HL) ;Let BIOS output the byte ; Console output routine. ; On entry: output character in register C. CONOUT: LD HL,(0001H) ;Get the base address LD L,0CH ;Modify low byte JP (HL) ;Let BIOS output the byte ; ==================== Data Areas ============================= CRT$COL DEFB 0 ;Column counter CRT$LINE: DEFB 0 ;Line counter TEMP1: DEFW 0 ;Temporary storage field OPTION: DEFB 0 ;N = display leading line numbers DIGIT1: DEFB 0 ;Flag to zero suppress line no. LNUMBER: DEFB '0000: ',0 ;Display line number SIGN: DEFB 0 ;Sign byte or 1st byte of command CON$BUFF: DEFB 0,0,0,0,0,0 ;Console input buffer DEFB 0,0,0,0,0,0 CB$ADDR DEFW CON$BUFF ;Current address within CON$BUFF BYTE1: DEFB 0FFH ;Non-zero = next byte is 1st of line PRT1$FLAG: DEFB 0 ;Non-zero = 1 byte to print on line SAVE$CHAR: DEFB 0 ;1 character save area CURR$LINE: DEFW 0FFFFH ;Current line number LINE$NO: DEFW 0 ;Line number wanted TOP$LINE: DEFW 0 ;Top line number on screen TOP$FLAG: DEFB 0 ;Non-zero = adjust TOP$LINE DISK$ADDR: DEFW 0 ;Disk Input buffer address LINE$ADDR: DEFW 0 ;Address within line buffer C$LENGTH: DEFB 0 ;String length in command input S$LENGTH: DEFB 0 ;String length in Find command OLD$STACK: DEFW 0 ;Old stack pointer OPEN$MSG: DEFB CLR$CRT,'Program to SHOW a File. 1/25/84' DEFB CR,LF,'Usage is: SF Progname.Typ option' DEFB CR,LF,'Option = N if line numbers wanted' DEFB CR,LF,0 OPN$ERR: DEFB CR,LF,'*** CANNOT OPEN FILE ***',0 RD$ERR: DEFB CR,LF,'** READ ERROR **',0 STOP$MSG: DEFB CR,LF,'Program terminated.',CR,LF,0 LINE24: DEFB ESC,'=7 ',0 ;Escape sequence for line 24 FCB DEFS 36 ;Working File Contol block FCB$CR EQU FCB+32 ;FCB current record FCB$RECNO EQU FCB+33 ;FCB random record number STR$BUFF: DEFS 20 ;Buffer to hold string being searched for LINE$BUFF DEFS 250 ;Buffer to hold current line TABLE DEFS 160*4 ;Table for line storage DEFS 48 STACK EQU $ END 100H