home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
trs80model4.tar.gz
/
trs80model4.tar
/
m4h191.asm
< prev
next >
Wrap
Assembly Source File
|
1986-10-22
|
15KB
|
584 lines
; M4H191/ASM
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Heath 19 terminal emulation filter
;
; Written By: Gregg Wonderly
;
; This program functions as a TRSDOS 6.2 device filter to emulate
; the h19 terminal. It recognizes most of the features of the
; H19 that are reasonable to implement on the Model 4. The items
; missing are ALT character set, and some of the <ESC>[xy]n
; sequences.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; This filter relocates itself to HIGH memory.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
ORG 3000H
TAB EQU 9 ;Tab character code
ESC EQU 27 ;Tab character code
S_OUT EQU 1 ;Screen on mask
S_IN EQU 0FEH ;Screen off mask
R_ON EQU 8 ;Reverse video on mask
R_OFF EQU 0F7H ;Reverse video off mask
FLAGVAL EQU 17 ;Flags offset from MODDCB
SCR_MASK EQU 14 ;Offset of screen mask in flags
WRINTMASK EQU 22 ;Interrupts mask in FLAGS
BITOFFSET EQU 29
;
*GET M4H19/EQU ;Get the SVC equates
*GET M4H19/MAC ;Get the macros
;
; The system enters the driver here with each character
;
FILTER JR H19EMULATOR ;Go to the start of the driver
DW 0 ;End of module address goes here
DB 6 ;Length of the module name
DB '$HEATH' ;The name
MODDCB DW 0 ;To be filled in later
DW 0 ;Filler
VSCUR DB 95 ;Block cursor character
VECUR DB 95 ;Underscore cursor character
DEF_LEN DB 20 ;Default duration for the bell
BELLFLAG DB 0 ;Visual or audible bell
DEF_FREQ DW 125 ;Default frequency for bell tone
OLDLOW DW 0 ;The address to restore if we
; remove ourselves
OLDHIGH DW 0 ;This is where we are loaded at
WHERE_AT DB 0 ;Flag for high or low mem load
OFFSET DW 0 ;Offset from load to destination
FVAL DB 0 ;No flags to start with
BITVAL DW BITMASK ;Offset to 7-bit mask
;
; Start of actual Filter
;
H19EMULATOR JR Z,ISPUT ;Go to process @PUT requests
JP CHAIN_2 ;Ignore other options
R002 EQU $-2
;
; Do only @PUT requests
;
ISPUT EQU $
LD A,@FLAGS ;Get the flags address into IY
RST 28H
LD A,C ;Character is in A and C now
AND 07FH ;Strip any 8th bit if STRIP8 set
BITMASK EQU $-FILTER-1
LD C,A
LD (NEWCHAR),A ;Save the character to display
R003 EQU $-2
LD HL,(OLDSTATE) ;Get any preexisting state
R004 EQU $-2
LD A,H ;Check for on, NZ means yes
OR L
JR Z,NOSTATE ;Go if no state
PUSH HL ;Put the address on the stack
LD HL,0 ;Wipe out the state value
LD (OLDSTATE),HL ;by storing zero in it
R005 EQU $-2
RET ;Go to the address on the stack
;
; Look for what we should do with the character...
;
NOSTATE LD A,C ;Get the character
CP ESC ;Is it the escape character?
JP Z,DOESCAPE ;Go do it if so
R006 EQU $-2
CP ' ' ;Check for a Control Character
JP C,DOCONTROL ;Go do it if so
R007 EQU $-2
CALL INSERT_A ;Put the character on the screen
R008 EQU $-2
JP RETOUT ;Return to caller
R009 EQU $-2
;
; Process all of the control characters between 0-31 inclusive
;
DOCONTROL EQU $
LD A,(NEWCHAR) ;Get the character
R010 EQU $-2
ADD A,A ;Times 2 for word offset
LD C,A ;Get a copy of A for the offset
LD B,0 ;Make BC a 16 bit offset
LD HL,CTL_JMP_TBL ;Get the jump table
R011 EQU $-2
ADD HL,BC ;Get the address in the table
LD E,(HL) ;Get LSB of the address
INC HL ;Point at next byte of address
LD D,(HL) ;Get the MSB
EX DE,HL ;Swap the jump address into HL
LD A,H ;Is there a special routine?
OR L ;Set the flags
LD A,(NEWCHAR) ;Get the character back
R012 EQU $-2
JP Z,RETOUT ;If not recognized, throw it out.
R013 EQU $-2
JP (HL) ;Go to the special routine
;
; Control character jump table. Each word is the address of a
; routine that processes the specfic character.
;
CTL_JMP_TBL DW 0,0,0,0,0,0,0 ;Throw these out.
DW SET_BELL ;Start the buzzer.
R014 EQU $-2
DW BACK_SPACE ;Backup a character NON-destruct.
R015 EQU $-2
DW SHOW_TAB ;Skip a physical tab.
R016 EQU $-2
DW LINE_FEED ;Down one line.
R017 EQU $-2
DW 0 ;Throw this one out.
DW FORM_FEED ;Clear the screen on FF.
R018 EQU $-2
DW CARRIAGE ;Carriage return.
R019 EQU $-2
DW 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 ;Not used.
;
SET_BELL LD A,(BELLFLAG) ;Is the bell function valid?
R020 EQU $-2
OR A
JP Z,FLASH_SCREEN ;Flash if signaled
R021 EQU $-2
LD A,(DEF_LEN) ;This is the timer value.
R022 EQU $-2
LD L,A
LD DE,(DEF_FREQ)
R023 EQU $-2
BELL01 EQU $
LD A,1
OUT (90H),A
LD B,D
LD C,E
BELL02 EQU $
DEC BC
LD A,B
OR C
JR NZ,BELL02
XOR A
OUT (90H),A
LD B,D
LD C,E
BELL03 EQU $
DEC BC
LD A,B
OR C
JR NZ,BELL03
DEC L
JR NZ,BELL01
JP RETOUT ;Exit without chaining
R024 EQU $-2
;
BACK_SPACE EQU $
LD A,24 ;Non-destructive backspace
JP STORE_CHAIN ;Chain into any filters
R025 EQU $-2
;
SHOW_TAB EQU $
GET_CURSOR ;Get the cursor position
LD A,79 ;Last column to display in
SUB L ;Compute the difference
CP 8 ;Do we have enough?
JP NC,TABOK ;If at least 8 then go do it
R026 EQU $-2
LD A,29 ;Send simulated <CR><LF> to *DO
CALL CHAIN_IN
R028 EQU $-2
LD A,26
JP CHAIN_IN ;No return
R029 EQU $-2
TABOK EQU $
LD A,L ;Must truncate to even 8 chars
ADD A,8
AND 0F8H
LD L,A ;Get the column back into L
NOSCROLL EQU $
PUT_CURSOR ;Set the cursor to what is in HL
JP RETOUT ;Return
R030 EQU $-2
;
LINE_FEED EQU $
LD A,26 ;Non-destructive LF
CALL STORE_CHAIN ;Chain into any filters
R031 EQU $-2
LD A,(FVAL)
R131 EQU $-2
AND 2 ;Check for auto CR
LD A,29 ;Get a CR
CALL NZ,STORE_CHAIN
R177 EQU $-2
JP RETOUT ;Return
R178 EQU $-2
;
FORM_FEED EQU $
LD HL,0 ;Set the cursor to 0,0
PUT_CURSOR
JP CLEAR_TO_EOS ;Do a clear to end of screen
R032 EQU $-2
;
MOVE_HOME EQU $
LD HL,0 ;Get Row=0, Column=0
STORE_ROW_COL EQU $
PUT_CURSOR ;Move the cursor to the pos in HL
JP RETOUT ;Return
R033 EQU $-2
;
CARRIAGE EQU $
LD A,29 ;True carriage return
CALL STORE_CHAIN
R034 EQU $-2
LD A,(FVAL)
R174 EQU $-2
AND 1
LD A,26 ;Get a line_feed
CALL NZ,STORE_CHAIN ;Display it conditionally
R175 EQU $-2
JP RETOUT
R176 EQU $-2
;
; Process the ESCAPE character sequences
;
DOESCAPE EQU $
LD HL,ESCAPE_1 ;Set the next state to go to
R035 EQU $-2
LD (OLDSTATE),HL
R036 EQU $-2
JP RETOUT ;Leave with no chain
R037 EQU $-2
;
; Escape has been seen, now check for a special character
;
ESCAPE_CHARS DB 'ABCDEFGHIJKLMNOY@fqpxyjkbol'
ESC_LEN EQU $-ESCAPE_CHARS
;
ESCAPE_1 EQU $
LD A,(NEWCHAR) ;Get the character sent
R038 EQU $-2
LD HL,ESCAPE_CHARS ;Get the list of valid ones
R039 EQU $-2
LD B,ESC_LEN ;Get how many
LD DE,ESC_1_JMPS ;Get the vector table
R040 EQU $-2
ESC_1_LOOP LD C,(HL) ;Get a character
CP C ;Is it a match?
JR Z,ESC_1_FND ;Found it, so go
INC HL ;Next character
INC DE ;next jump table entry
INC DE
DJNZ ESC_1_LOOP ;Loop while still more
LD HL,0
LD (OLDSTATE),HL
R041 EQU $-2
JP RETOUT ;Ignore unimplemented or invalid codes
R042 EQU $-2
;
ESC_1_FND EQU $
EX DE,HL ;Get the vector's address
LD E,(HL) ;Get the table value
INC HL
LD D,(HL)
LD HL,0 ;Reset the state
LD (OLDSTATE),HL
R043 EQU $-2
EX DE,HL ;Get the vector in HL
LD A,(NEWCHAR)
R044 EQU $-2
JP (HL) ;Go do the right thing.
;
; Level 1 escape vector table
;
ESC_1_JMPS DW CURSOR_UP
R045 EQU $-2
DW LINE_FEED
R046 EQU $-2
DW CURSOR_RIGHT
R047 EQU $-2
DW BACK_SPACE
R048 EQU $-2
DW FORM_FEED
R049 EQU $-2
DW START_ALT_SET
R050 EQU $-2
DW END_ALT_SET
R051 EQU $-2
DW MOVE_HOME
R052 EQU $-2
DW REV_INDEX
R053 EQU $-2
DW CLEAR_TO_EOS
R054 EQU $-2
DW CLEAR_TO_EOL
R055 EQU $-2
DW ADD_LINE
R056 EQU $-2
DW DEL_LINE
R057 EQU $-2
DW DEL_CHAR
R058 EQU $-2
DW END_INSERT
R059 EQU $-2
DW SET_ESC_2
R060 EQU $-2
DW BEGIN_INSERT
R061 EQU $-2
DW FLASH_SCREEN
R062 EQU $-2
DW STAND_END
R063 EQU $-2
DW STAND_OUT
R064 EQU $-2
DW SET_ESC_2
R065 EQU $-2
DW SET_ESC_2
R066 EQU $-2
DW SAVE_CURSOR
R001 EQU $-2
DW RESTORE_CURSOR
R027 EQU $-2
DW ERA_BEG_SCR
R141 EQU $-2
DW ERA_BEG_LIN
R142 EQU $-2
DW ERASE_LINE
R143 EQU $-2
;
; Move the cursor up one line if possible, stopping at the top
; of the screen.
;
CURSOR_UP EQU $
LD A,27 ;Non-destructive cursor up
STORE_CHAIN EQU $
LD (NEWCHAR),A ;Store it
R067 EQU $-2
JP CHAIN ;Let *DO do the dirty work
R068 EQU $-2
;
CURSOR_RIGHT EQU $
LD A,25 ;Non-destructive cursor right
JP STORE_CHAIN ;Let *DO do it for us
R069 EQU $-2
;
START_ALT_SET JP RETOUT ;No defined action
R070 EQU $-2
;
END_ALT_SET JP RETOUT ;No defined action
R071 EQU $-2
;
; This is the reverse scroll. We use direct screen access to
; move one line. Interrupts are off during the move, but are
; restored between each line. There seems to be quite reasonable
; behavior at 9600 baud with this strategy.
;
REV_INDEX EQU $
GET_CURSOR ;Make sure we are at the top
LD A,H ;Get the cursor row
OR A ;Is it row zero?
JP NZ,CURSOR_UP ;Go if not, to Cursor up routine
R072 EQU $-2
LD A,15 ;Remove the cursor
CALL CHAIN_IN
R127 EQU $-2
LD A,23 ;Move 23 lines down
LD HL,23*80+0F7FFH ;Get the next to last line, last byte
LD DE,24*80+0F7FFH ;Get the last byte on the screen
REV_LOOP LD BC,80 ;Get the byte count
PUSH AF ;Save the line count
SWAP_IN ;Screen in, interrupts off
LDDR ;Move a line
SWAP_OUT ;Screen out, interrupts on
POP AF ;Get line count
DEC A ;One less to move
JR NZ,REV_LOOP ;Loop if not done
REV_DONE EQU $
LD DE,SCR_BUFF ;Get the buffer address
R073 EQU $-2
PUSH DE ;Save it
PUSH DE ;Copy it into HL
POP HL
INC DE ;Point one ahead for the copy
LD (HL),' ' ;Store one blank
LD BC,79 ;Copy it into the remaining 79
LDIR ;Do the copy
LD H,0 ;Get the top row
POP DE ;Get the buffer address back
PUT_LINE ;Put a blank line there
LD A,14 ;Turn the cursor back on
JP CHAIN_IN
R074 EQU $-2
;
; Flash the screen, by inverting all of the msb's of the characters
; twice. The result is a fair approximation to a flash.
;
FLASH_SCREEN EQU $
LD A,16 ;Turn reverse video on
CALL CHAIN_IN
R128 EQU $-2
LD C,0 ;Get the loop counter
FLASH_LOOP_1 EQU $
PUSH BC ;Save it
LD H,0 ;Get the first line
FLASH_LOOP_2 EQU $
LD DE,SCR_BUFF ;Get the buffer to put it in
R075 EQU $-2
GET_LINE ;Get the line from @VDCTL
PUSH HL ;Save the line number for PUT_LINE
LD H,D ;Copy DE into HL
LD L,E
LD B,80 ;Get the BYTE count
FLASH_LOOP_3 EQU $
LD A,(HL) ;Get a BYTE
XOR 080H ;Invert the HIGH BIT
LD (HL),A ;Put it back
INC HL ;Point to the next
DJNZ FLASH_LOOP_3 ;Loop until line is done
POP HL ;Restore the Line number
PUT_LINE ;Put the line back
INC H ;Point to next line
LD A,H ;Test for last
CP 24 ;END?
JR NZ,FLASH_LOOP_2 ;Loop if not done
EI ;Make sure interrupts are back on
POP BC ;Restore the FLASH counter
LD A,C ;Get the original value
INC C ;Increment the counter
OR A ;Test OLD value
JR Z,FLASH_LOOP_1 ;Loop if just finished first time
LD A,17 ;Set reverse video OFF
JP STORE_CHAIN ;Chain to *DO
R076 EQU $-2
;
; Save the current cursor position
;
SAVE_CURSOR EQU $
LD DE,(LASTPUSH) ;Get the nextplace available
R132 EQU $-2
GET_CURSOR ;Get the cursor
EX DE,HL ;Swap push address for screen pos
PUSH HL ;Save push address
LD BC,ENDPUSH ;Get the first illeagal address
R133 EQU $-2
OR A ;Reset the carry
SBC HL,BC ;Compute difference
POP HL ;Restore real address
JR Z,NO_SAVE ;Jump if can't save
LD (HL),E ;Put in column
INC HL ;Point to next pos
LD (HL),D ;Put in the row
INC HL ;Point past it to next position
LD (LASTPUSH),HL ;Save the new address
R134 EQU $-2
NO_SAVE EQU $
JP RETOUT
R135 EQU $-2
;
; Restore the previously pushed cursor position.
;
RESTORE_CURSOR EQU $
LD HL,(LASTPUSH) ;Get the next store position
R136 EQU $-2
LD BC,PUSHAREA ;Get the start of the area
R137 EQU $-2
OR A ;Reset carry
PUSH HL ;Save the address
SBC HL,BC ;See if anything to pop
POP HL
JR Z,NO_RESTORE ;Jump if not
DEC HL ;Point back to row
LD D,(HL) ;Get it
DEC HL ;Point back to column
LD E,(HL) ;Get it
LD (LASTPUSH),HL ;Save the next position
R138 EQU $-2
EX DE,HL ;Put the Row/Column into HL
PUT_CURSOR ;Set the cursor position
NO_RESTORE EQU $
JP RETOUT ;Return without calling *DO
R139 EQU $-2
;
; Erase the current line
;
ERASE_LINE EQU $
GET_CURSOR ;Get the current position
PUSH HL ;Save it
LD L,0 ;Move to beginning of line
PUT_CURSOR ;Store the new cursor position
CALL CLEAR_TO_EOL
R144 EQU $-2
POP HL
PUT_CURSOR
JP RETOUT
R145 EQU $-2
;
; Erase to beginning of screen
;
ERA_BEG_SCR EQU $
GET_CURSOR ;Get the current screen position
CALL GET_RC_ADDR ;Convert it to a memory address
R146 EQU $-2
LD DE,0F800H ;Get the start of the screen
OR A ;Reset the carry
SBC HL,DE ;Compute number to blank
LD B,H ;Put the count into BC
LD C,L
LD A,B ;See if at start of screen
OR C
JR Z,NO_ERA_SCR ;Jump if so, nothing to erase
LD HL,0F800H ;Get the start
LD DE,0F801H ;Get the start + 1
SWAP_IN ;Make the screen visible
LD (HL),20H ;Blank one position
SWAP_OUT ;Swap the screen back out
DEC BC ;Decrement remaining places
LD A,B ;See if only one needed blanking
OR C
JR Z,NO_ERA_SCR ;Jump it that was all
SWAP_IN ;Swap the screen back in
LDIR ;Blank the characters
SWAP_OUT ;Swap the screen back out
NO_ERA_SCR EQU $
JP RETOUT ;Return without chaining
R147 EQU $-2
;
; Clear to the beginning of the line
;
ERA_BEG_LIN EQU $
GET_CURSOR ;Get current position
PUSH HL ;Save it
CALL GET_RC_ADDR ;Convert to memory address
R148 EQU $-2
EX DE,HL ;Swap current to DE
POP HL ;Get the row/column back
LD L,0 ;Set row to start of screen
CALL GET_RC_ADDR ;Get the address there
R149 EQU $-2
EX DE,HL ;Swap it back
OR A ;Reset the carry
PUSH DE ;Save starting address
SBC HL,DE ;Compute length
LD B,H ;Put it into BC
LD C,L
LD A,B ;Check if no characters
OR C
JR Z,NO_ERA_LIN ;Jump if at start of line
POP HL ;Get start of line address back
LD D,H ;Make DE=HL+1
LD E,L
INC DE
SWAP_IN ;Swap the screen in
LD (HL),20H ;Store a space
SWAP_OUT ;Swap the screen out
DEC BC ;Decrement the count for prev inst
LD A,B ;Check for zero
OR C ;Set the flags
JR Z,NO_ERA_LIN
SWAP_IN ;Fold the screen into memory
LDIR ;Blank the screen
SWAP_OUT ;Swap the screen back out
NO_ERA_LIN EQU $
JP RETOUT ;Return to caller
R150 EQU $-2
*GET M4H192/ASM
END LOAD