-+-+-+-+-+-+-+-+ START OF PART 8 -+-+-+-+-+-+-+-+
X;`092`09parameter 1 is address of # of bytes in terminator mask
X;`09`09parameter 2 is address of array containing terminator bit mask
X;`093`09the following parameters are addresses of a byte containing
X;`09`09the acsii code of the character to be a terminator.
X;`09`09( 3, 10, 13 )`09`09! enable LF and CR to be terminators
X;-
X`09subl3`09#1, (ap)+, r0`09`09; get number of parameters - 1
X`09movl`09@(ap)+, r1`09`09; get option
X
X`09caseb`09r1, #0, #3
X10$:`09.word`09100$-10$
X`09.word`09200$-10$
X`09.word`09300$-10$
X`09.word`09400$-10$
X; fall thru to option 0
X100$:
X`09clrl`09tt_term_addr`09`09; 0 means the default term mask
X`09ret
X200$:`09; option 1
X`09sobgeq`09r0, 210$`09`09; see if another parameter
X`09ret
X210$:`09movl`09@(ap)+, r3`09`09; get longword terminator mask
X240$:`09; r3 contains low 32 bits of terminator mask
X`09clrl`09r2`09`09`09; first longword must be zero
X`09movq`09r2, tt_term_quad`09; store it
X250$:`09movaq`09tt_term_quad, tt_term_addr ; set up pointer to quadword
X`09ret
X
X300$:`09; option 2`09; param1 is # of bytes`09; param2 if address of bytes
X`09sobgeq`09r0, 310$`09`09; see if another parameter
X`09ret
X310$:`09movzbl`09@(ap)+, tt_term_quad`09; store # of bytes in term mask
X`09sobgeq`09r0, 320$`09`09; see if another parameter
X`09ret
X320$:`09movl`09@(ap)+, tt_term_quad+4`09; store address of term bit mask
X`09brb`09250$`09`09`09; go set up pointer and exit
X
X400$:`09; option 3`09; a list of ascii codes follow
X`09movab`09tt_term_mask, r3`09; base of terminator bit mask
X`09movl`09r3, r1
X`09clrq`09(r1)+`09`09`09; zero terminator bit mask
X`09clrq`09(r1)+`09`09`09; 16 bytes (0-127)
X`09clrq`09(r1)+
X`09clrq`09(r1)+
X`09clrl`09r1`09`09`09; maximum ascii code
X`09clrl`09r2`09`09`09; we put ascii code in low byte
X`09tstl`09r0`09`09`09; see if at least 1 parameter
X`09bgtr`09410$
X`09ret
X410$:
X`09bicb3`09#`5EX80, @(ap)+, r2`09; get ascii code (0-127)
X`09cmpl`09r2, r1`09`09`09; bigger than previous maximum ?
X`09bleq`09420$
X`09movl`09r2, r1
X420$:`09bbss`09r2, (r3), 440$`09`09; set bit
X440$:`09sobgtr`09r0, 410$`09`09; do all parameters
X
X`09addl2`09#7, r1`09`09`09; round up to nearest byte
X`09divl2`09#8, r1`09`09`09; get # of bytes in term mask
X`09cmpl`09r1, #4`09`09`09; if <= 4 bytes, use short format
X`09bgtr`09450$
X`09movl`09(r3), r3`09`09; get first 4 bytes of mask in r3
X`09brw`09240$`09`09`09; go store it and pointer and exit
X450$:
X`09movl`09r1, tt_term_quad`09; store # of bytes for long format
X`09movl`09r3, tt_term_quad+4`09; store address of term bit mask
X`09brb`09250$`09`09`09; store pointer and exit
X
X
X
X`09.entry`09-
XTT_CTRLCAST,`09`5Em<>
X;+
X;`09CALL TT_CTRLCAST( routine address )
X;`09enable a control C ast
X;-
X`09$qiow_s func=#io$_setmode!io$m_ctrlcast, chan=ttchan, iosb=ttiosb, -
X`09`09p1=@4(ap)
X`09ret`09`09`09`09; ignore all erros
X
X
X`09.entry`09-
XTT_1_CHAR,`09`5Em<>
X;+
X;`09I = TT_1_CHAR
X;`09read 1 character.  Waits for it.
X;-
X`09clrb`09ttbuf
X`09$qiow_s`09func=#io$_readvblk!io$m_noecho!io$m_nofiltr,-
X`09`09chan=ttchan, iosb=ttiosb,-
X`09`09p1=ttbuf, p2=#1
X`09cvtbl`09ttbuf, r0
X`09ret
X
X`09.entry`09-
XTT_1_CHAR_T,`09`5Em<>
X;+
X;`09I = TT_1_CHAR_T( seconds )
X;`09read 1 character.  Waits "seconds" for it.
X;`09returns 0 if times out
X;-
X`09clrb`09ttbuf
X`09$qiow_s`09func=#io$_readvblk!io$m_noecho!io$m_nofiltr!io$m_timed,-
X`09`09chan=ttchan, iosb=ttiosb,-
X`09`09p1=ttbuf, p2=#1, p3=@4(ap)
X`09cvtbl`09ttbuf, r0
X`09ret
X
X`09.entry`09-
XTT_1_CHAR_NOW, `5Em<>
X;+
X;`09I = TT_1_CHAR_NOW()
X;`09get next character if typed.  Returns immediately.
X;`09I = -1 if no character available
X;-
X`09tstl`09chars_left`09`09; have we used all characters ?
X`09bgtr`0950$`09`09`09; no --> 50$
X`09bbsc`09#0, data_ready, 20$`09; check if input ready
X5$:`09mnegl`09#1, r0`09`09`09; no characters read
X`09ret`09`09`09`09; no
X20$:
X`09$qiow_g read_now_qio
X`09blbc`09r0, 5$`09`09`09; error
X;
X;`09$qiow_s`09func=#io$_writevblk,chan=ttchan,-`09; debug write
X;`09`09p1=ttbuf, p2=ttiosb+2, p4=#`5Ex1000
X
X`09movzwl`09ttiosb+2, chars_left`09`09; # chars read
X`09movab`09ttbuf, char_pointer`09`09; store address of character
X50$:
X`09decl`09chars_left
X`09movzbl`09@char_pointer, r0`09`09; get next char
X`09incl`09char_pointer`09`09`09; point to next
X`09ret
X
X
X`09.entry`09-
XTT_READ, `5Em<r2,r3>
X;+
X;`09INTEGER FUNCTION TT_READ( buffer, buf_len, data_len, term_len )
X;`09buffer`09address of buffer or address of descriptor of buffer
X;`09buf_len length of buffer.  If omitted then "buffer" is a descriptor
X;`09data_len length of data read (# of characters)
X;`09term_len length of terminator
X;
X;`09Value of function is the I/O status completion code
X;-
X`09movl`098(ap), r2`09`09; get buf_len
X`09bneq`09100$`09`09`09; if <> 0 then it was specified
X`09movq`09@4(ap), r2`09`09; get descriptor of buffer
X`09`09`09`09`09; r2 = length, r3 = address
X`09bicl2`09#`5EXFFFF0000, r2`09`09; want length only
X`09brb`09200$
X100$:
X`09movl`09(r2), r2`09`09; get buffer length
X`09movl`094(ap), r3`09`09; get buffer address
X200$:
X`09$qiow_s func=tt_func, chan=ttchan, iosb=ttiosb, -
X`09`09p1=(r3), p2=r2, p3=tt_timed, p4=tt_term_addr
X`09blbc`09r0, 600$`09`09; did $qio get an error.  yes --> 600$
X
X`09movzwl`09ttiosb+2, @12(ap)`09; store # characters read
X`09cmpb`09(ap), #3`09`09; enough arguments supplied
X`09bleq`09500$`09`09`09; no --> 500$
X`09movl`0916(ap), r2`09`09; does user want terminator length
X`09beql`09500$
X`09movzwl`09ttiosb+6, (r2)`09`09; store terminator length
X500$:
X`09movzwl`09ttiosb, r0
X600$:
X`09ret
X
X`09.entry`09-
XTT_READ_S, `5Em<>
X;+
X;`09CALL TT_READ_S( array, length, efn, iast, iosb )
X;`09BYTE ARRAY( LENGTH )
X;`09INTEGER iosb(2)
X;
X;`09reads a line asynchronously
X;`09will set "iast" to one when complete
X;-
X`09$qio_s`09func=tt_func, -
X`09`09chan=ttchan, -
X`09`09efn=@12(ap), -
X`09`09iosb=@20(ap), -
X`09`09astadr=tt_read_s_ast, -
X`09`09astprm=@16(ap), -
X`09`09p1=@4(ap), p2=@8(ap)
X`09blbc`09r0, 100$
X`09ret
X100$:
X`09bsbw`09error
X`09ret
X
X`09.align`09word
X`09.entry`09-
XTT_READ_S_AST, `5Em<>
X`09movl`09#1, @4(ap)
X`09ret
X
X
X`09.entry`09-
XTT_SET_READF, `5Em<r2,r3>
X;+
X;`09CALL TT_SET_READF( buffer, buf_len )
X;`09buffer`09address of buffer or address of descriptor of buffer
X;`09buf_len length of buffer.  If omitted then "buffer" is a descriptor
X;-
X`09movl`098(ap), r2`09`09; get buf_len
X`09bneq`09100$`09`09`09; if <> 0 then it was specified
X`09movq`09@4(ap), r2`09`09; get descriptor of buffer
X`09`09`09`09`09; r2 = length, r3 = address
X`09bicl2`09#`5EXFFFF0000, r2`09`09; want length only
X`09brb`09200$
X100$:
X`09movl`09(r2), r2`09`09; get buffer length
X`09movl`094(ap), r3`09`09; get buffer address
X200$:
X`09movl`09r3, read_fast_qio+qio$_p1`09; address of buffer
X`09movl`09r2, read_fast_qio+qio$_p2`09; length of buffer
X;`09movl`09tt_timed, read_fast_qio+qio$_p3 ; time out
X`09movl`09tt_term_addr, read_fast_qio+qio$_p4 ; terminator pointer
X;`09movl`09tt_func, read_fast_qio+qio$_func
X`09movzwl`09ttchan, read_fast_qio+qio$_chan
X
X`09ret
X
X
X`09.entry`09-
XTT_READF, `5Em<r2,r3>
X;+
X;`09INTEGER FUNCTION TT_READF( data_len )
X;`09data_len length of data read (# of characters) (not including term)
X;
X;`09This routine is used for reading a lot of data in binary mode
X;`09with no echo.  READF stands for READ FAST.
X;`09TT_READF_SET must be called first
X;
X;`09Value of function is the I/O status completion code
X;-
X
X`09$qiow_g read_fast_qio
X`09blbc`09r0, 600$`09`09; did $qio get an error.  yes --> 600$
X
X`09movzwl`09ttiosb+2, @4(ap)`09; store # characters read
X`09movzwl`09ttiosb, r0
X600$:
X`09ret
X
X
X`09.entry`09-
XTT_PROMPT, `5Em<r2,r3,r4,r5>
X;+
X;`09INTEGER FUNCTION TT_PROMPT( prompt, prompt_len,
X;`09`09buffer, buf_len, data_len, term_len )
X;`09prompt  address of prompt string or address of descriptor
X;`09prompt_len  length of prompt string.  If omitted then "prompt"
X;`09`09`09`09`09`09is a descriptor
X;`09buffer`09address of buffer or address of descriptor of buffer
X;`09buf_len length of buffer.  If omitted then "buffer" is a descriptor
X;`09data_len length of data read (# of characters)
X;`09term_len length of terminator
X;
X;`09Value of function is the I/O status completion code
X;-
X`09movl`0916(ap), r2`09`09; get buf_len
X`09bneq`09100$`09`09`09; if <> 0 then it was specified
X`09movq`09@12(ap), r2`09`09; get descriptor of buffer
X`09`09`09`09`09; r2 = length, r3 = address
X`09bicl2`09#`5EXFFFF0000, r2`09`09; want length only
X`09brb`09200$
X100$:
X`09movl`09(r2), r2`09`09; get buffer length
X`09movl`0912(ap), r3`09`09; get buffer address
X200$:
X`09movl`098(ap), r4`09`09; get prompt_len
X`09bneq`09300$`09`09`09; if <> 0 then it was specified
X`09movq`09@4(ap), r4`09`09; get descriptor of prompt string
X`09`09`09`09`09; r4 = length, r5 = address
X`09bicl2`09#`5EXFFFF0000, r4`09`09; get length only
X`09brb`09400$
X300$:
X`09movl`09(r4), r4`09`09; get prompt length
X`09movl`094(ap), r5`09`09; get prompt address
X400$:
X
X`09$qiow_s func=tt_p_func, chan=ttchan, iosb=ttiosb, -
X`09`09p1=(r3), p2=r2, p3=tt_timed, p5=r5, p6=r4
X`09blbc`09r0, 600$`09`09; did $qio get an error.  yes --> 600$
X
X`09movzwl`09ttiosb+2, @20(ap)`09; store # characters read
X`09cmpb`09(ap), #5`09`09; enough arguments supplied
X`09bleq`09500$`09`09`09; no --> 500$
X`09movl`0924(ap), r2`09`09; does user want terminator length
X`09beql`09500$
X`09movzwl`09ttiosb+6, (r2)`09`09; store terminator length
X500$:
X`09movzwl`09ttiosb, r0
X600$:
X`09ret
X
X
X`09.entry`09-
XTT_MBX_READ,`09`5Em<>
X;+
X; This is an AST routine which executes when the mailbox record has been rea
Vd.
X; The record itself is a status message which is assumed to say that
X; unsolicited data is available at the terminal
X;-
X`09blbc`09mbxiosb, 100$`09`09; on error, dont re-que read
X;`09we could have SS$_CANCEL or SS$_ABORT from the $CANCEL in the
X;`09exit handler
X`09movb`09#1, data_ready`09`09; indicate data is there
X`09bsbw`09queue_mbxread`09`09; queue another read request
X100$:
X`09ret
X
XQUEUE_MBXREAD:
X`09$qio_s`09efn=#2, func=#io$_readvblk, chan=mbxchan, iosb=mbxiosb,-
X`09`09astadr=tt_mbx_read,-
X`09`09p1=mbxbuf, p2=#mbxbuf_siz
X`09blbc`09r0, 100$
X`09rsb
X100$:
X`09bsbw`09error
X`09rsb
X
X;TT_WRITE$:
X;+
X;`09bsbw`09ttwrite
X;`09r3 contains length of buffer to write
X;`09the buffer is outbuf
X;-
X;`09movl`09r3, outbuf_qio+qio$_p2`09`09; store length of buffer
X;`09$qiow_g`09outbuf_qio
X;`09blbc`09r0, 100$
X;`09rsb
X;100$:
X;`09bsbw`09error
X;`09rsb
X
X`09.entry`09-
XTT_WRITE, `5Em<>
X;+
X;`09CALL TT_WRITE( array, length )
X;`09BYTE ARRAY( LENGTH )
X;`09writes buffer to terminal in noformat mode
X;-
X`09movl`094(ap), output_qio+qio$_p1`09; store address of buffer
X`09movl`09@8(ap), output_qio+qio$_p2`09; store length of buffer
X`09$qiow_g`09output_qio
X`09blbc`09r0, 100$
X`09ret
X100$:
X`09bsbw`09error
X`09ret
X
X`09.entry`09-
XTT_WRITE_S, `5Em<>
X;+
X;`09CALL TT_WRITE_S( array, length, efn )
X;`09BYTE ARRAY( LENGTH )
X;`09writes buffer to terminal in noformat mode
X;`09this puts the qio on the stack so that it can be called
X;`09synchronously with TT_WRITE
X;-
X`09$qio_s func=#io$_writevblk!io$m_noformat, -
X`09`09chan=ttchan, -
X`09`09efn=@12(ap), -
X`09`09p1=@4(ap), p2=@8(ap)
X`09blbc`09r0, 100$
X`09ret
X100$:
X`09bsbw`09error
X`09ret
X
X`09.entry -
XTT_CANCEL, `5Em<>
X`09clrl`09r0
X`09tstw`09ttchan`09`09; check channel is open
X`09beql`09100$
X`09$qiow_s`09func=#io$_readvblk!io$m_purge!io$m_timed,-
X`09`09chan=ttchan, p1=ttbuf, p2=#0
X;###`09`09`09; do read with 0 length buffer (p2)
X`09clrl`09chars_left`09; for TT_1_char_now
X`09clrl`09data_ready`09; say no data ready to read
X100$:
X`09ret`09`09`09; return with status in r0
X
X`09.entry -
XTT_CANCEL_IO, `5Em<>
X;+
X;`09cancels I/O on channel
X;-
X`09clrl`09r0
X`09tstw`09ttchan`09`09; check channel is open
X`09beql`09100$
X`09$cancel_s chan=ttchan
X`09bsbb`09error
X100$:`09ret`09`09`09; return with status in r0
X
XERROR:
X`09blbs`09r0, 100$
X`09pushl`09r0
X`09calls`09#1, G`5Elib$signal
X100$:
X`09rsb
X
X;`09.entry`09-
X;control_c, `5Em<>
X;`09movb`09#1, control_c_flag
X;`09ret
X
X
X`09.entry`09-
XSLEEP_SET, `5Em<>
X;+
X;`09CALL SLEEP_SET( efn , time )
X;`09INTEGER efn, time
X;`09use "efn" as event flag
X;`09sleep for "time" 100th's of a second
X;-
X`09movl`09@4(ap), sleep_efn
X`09emul`09#-100000, @8(ap), #0, sleep_time`09; get delta time format
X`09$setef_s efn=sleep_efn`09`09; set ef in case SLEEP_START not called
X`09ret
X
X`09.entry`09-
XSLEEP_START, `5Em<>
X;+
X;`09CALL SLEEP_START
X;`09starts a timer
X;-
X`09$setimr_g sleep_args
X`09blbc`09r0, 100$
X`09ret
X100$:`09bsbw`09error
X`09ret
X
X`09.entry`09-
XSLEEP_WAIT, `5Em<>
X;+
X;`09CALL SLEEP_WAIT
X;`09waits for sleep efn to turn on
X;-
X`09$waitfr_s efn=sleep_efn
X`09ret
X
Xtt_exit_handler = .
X`09.word`09`5Em<>
X`09$qiow_s func=#io$_setmode, chan=ttchan, iosb=ttiosb -
X`09`09p1=ttsavemode`09`09; reset terminal mode
X;`09if we get an error, too bad.
X`09ret
X
X`09.end
$ CALL UNPACK TTIO.MAR;1 980021740
$ create 'f'
X`5B
X  Environment
X    ('VT100.PEN')
X`5D
X
XMODULE VT100;
X
X%INCLUDE 'VT100_ESC_SEQS.PAS'
X
XEND.
$ CALL UNPACK VT100.PAS;1 1567977334
$ create 'f'
XCONST
X  VT100_ESC  = chr(27);
X
X  VT100_top      = ''(27)'#3';
X  VT100_bottom   = ''(27)'#4';
X  VT100_wide     = ''(27)'#6';
X
X  VT100_normal   = ''(27)'`5Bm';
X  VT100_bright   = ''(27)'`5B1m';
X  VT100_flash    = ''(27)'`5B5m';
X  VT100_inverse  = ''(27)'`5B7m';
X
X  VT100_bright_only  = ''(27)'`5B0;1m';
X  VT100_flash_only   = ''(27)'`5B0;5m';
X  VT100_inverse_only = ''(27)'`5B0;7m';
X
X  VT100_store    = ''(27)'7';
X  VT100_restore  = ''(27)'8';
X
X  VT100_graphics_on  = ''(27)'(0';
X  VT100_graphics_off = ''(27)'(B';
X  VT100_Alternate_graphics = ''(27)')0';
X
X  VT100_normal_scroll = ''(27)'`5B0;24r';
X  VT100               = ''(27)'<';
X
X  VT100_application_keypad    = ''(27)'=';
X  VT100_no_application_keypad = ''(27)'>';
X
X  VT100_bell = chr(7);
X  VT100_bs   = chr(8);
X  VT100_lf   = chr(10);
X  VT100_cr   = chr(13);
X  VT100_si   = chr(14);
X  VT100_so   = chr(15);
X
$ CALL UNPACK VT100_ESC_SEQS.PAS;1 1914183775
$ v=f$verify(v)
$ EXIT