-+-+-+-+-+-+-+-+ START OF PART 7 -+-+-+-+-+-+-+-+
X  until (status(infile)=PAS$K_SUCCESS) or (status(infile)=PAS$K_EOF);
X  Close (infile);
X  posn (1,23);
XEND;
X
XEND.
$ CALL UNPACK TOPTEN.PAS;1 1549781308
$ create 'f'
X`5B
X  Inherit
X    ('SYS$LIBRARY:STARLET','SYS$LIBRARY:PASCAL$LIB_ROUTINES'),
X  Environment
X    ('TRIM.PEN')
X`5D
X
XMODULE TRIM;
X
X`5BHIDDEN`5DTYPE
X  $UWORD = `5BWORD`5D 0..65535;
X  v_array = varying `5B256`5D of char;
X
X`5BASYNCHRONOUS, EXTERNAL(STR$TRIM)`5D
XFUNCTION  $Trim
X  ( VAR destination_str : `5BCLASS_S`5D PACKED ARRAY `5B$L1 .. $U1 : INTEGER
V`5D OF CHAR;
X        source_str      : `5BCLASS_S`5D PACKED ARRAY `5B$L2 .. $U2 : INTEGER
V`5D OF CHAR;
X    VAR return_length   : $UWORD
X  ) : integer;
XExtern;
X
X`5BGLOBAL`5D
XFUNCTION  Trim ( text : v_array ) : v_array;
XVAR
X  ret_status : integer;
XBEGIN
X  ret_status := $trim (text.body,text,text.length);
X  IF not odd(ret_status) then
X    LIB$SIGNAL(ret_status);
X  trim := text;
XEND;
X
XEND.
$ CALL UNPACK TRIM.PAS;1 1946843273
$ create 'f'
X`09.title`09TTIO`09Terminal IO routines ($QIO's)
X;+
X;`09Routines to do IO via $QIO's to get special features.
X;-
X.if ne 0
X1 TTIO
XThis is a group of routines to enable you to perform efficient/special
Xinput and/or output to a terminal.
X2 TT_INIT
XCALL TT_INIT( type )
X
X"type" is an integer variable which indicates the input you wish.
X
X"type" = 0  ordinary line input
X         1  efficient single character input if available
X         2  line input with escape sequences
X2 TT_SET_FUNC
XSets the read function modifiers and the wait time.  Once set, the options
Xwill stay in effect until changed.
X
XINTEGER TT_SET_FUNC
X
XI = TT_SET_FUNC( value `5B, seconds `5D )
X
X"value" is a bit encoded integer specifying options required
X  Symbol      Hex value         Description
XIO$M_NOFILTR   '0200'X  Ctrl/U, Ctrl/R or Delete are passed to the user
XIO$M_PURGE     '0800'X  Type-ahead buffer is purged before the read
XIO$M_TIMED     '0080'X  Read must complete within specified time
XIO$M_TRMNOECHO '1000'X  The terminator character (if any) is not echoed
X
X"seconds"  maximum time a read may take in seconds
X"I" is the IO completion status code
X2 TT_SET_READF
XSets the buffer address and length before calling TT_SET_READF.
X
XINTEGER FUNCTION TT_SET_READF( buffer, buf_len )
X
Xbuffer`09address of buffer or address of descriptor of buffer
Xbuf_len length of buffer.  If omitted then "buffer" is a descriptor
X
XValue of function is the I/O status completion code
X2 TT_SET_TERM
XSet terminator character mask
X
XCALL TT_SET_TERM( option, parameters... )
X
Xoption
X  0`09normal terminators (any control char except LF VT FF TAB BS
X  1`09parameter 1 is the address of a longword containing the
X   `09terminator bit mask (first 32 characters only)
X   `09eg. CALL TT_SET_TERM( 1, '00000001'X )
X   `09    enable Control A as terminator
X  2`09parameter 1 is address of # of bytes in terminator mask
X   `09parameter 2 is address of array containing terminator bit mask
X  3`09the following parameters are addresses of a byte containing
X   `09the acsii code of the character to be a terminator.
X   `09eg. CALL TT_SET_TERM( 3, 10, 13 )
X   `09    enable LF and CR to be terminators
X2 TT_CTRLCAST
X
XCALL TT_CTRLCAST( subroutine )
X
XThis causes the next control C to call the named routine.
X2 TT_1_CHAR
XINTEGER TT_1_CHAR
X
XI = TT_1_CHAR()
X
X"I" contains the ascii value of the character typed.
XThis routine waits for the character and then returns it.
XWhatever options that are set (see TT_SET_OPTION) are applied. (not true)
X2 TT_1_CHAR_T
XINTEGER TT_1_CHAR_T
X
XI = TT_1_CHAR_T( seconds )
X
XThis routine reads 1 character if typed within "seconds" time.
X"I" contains the ascii value of the character typed,
X it is 0 if the read timed out.
X2 TT_1_CHAR_NOW
XINTEGER TT_1_CHAR_NOW
X
XI = TT_1_CHAR_NOW()
X
X"I" contains the ascii value of the character typed, or -1 if no
Xcharacter is available.  The character is not echoed.
XThis routine returns immediately.
X2 TT_READ
XThis routine reads a line from the terminal.
X
XINTEGER TT_READ
XI = TT_READ( buffer, buf_len, data_len `5B, term_len `5D )
X  or
XI = TT_READ( buf_desc, , data_len `5B, term_len `5D )
X
X"buffer" is the address of the input buffer
X"buf_len" is the length of the input buffer in bytes
X"data_len" will contain the number of characters read
X"term_len" (if specified) will contain the length of the terminator
X"I" will contain the IO completion status code
X
X"buf_desc" is the address of a descriptor of the input buffer
X
X2 TT_READF
X
XINTEGER FUNCTION TT_READF( data_len )
Xdata_len length of data read (# of characters) (not including term)
X
XThis routine is used for reading a lot of data (presumably with
Xecho reset). READF stands for READ FAST.
XTT_READF_SET must be called first.
X
XValue of function is the I/O status completion code
X2 TT_PROMPT
XThis routine reads a line from the terminal.
X
XINTEGER TT_PROMPT
XI = TT_PROMPT( prompt, prompt_len, buffer, buf_len, data_len
X`09`09`09`09`09`09`5B, term_len `5D )
X  or
XI = TT_PROMPT( prompt_desc, , buf_desc, , data_len `5B, term_len `5D )
X
X"prompt" is the address of a character string
X"prompt_len" is the length of the prompt character string
X"buffer" is the address of the input buffer
X"buf_len" is the length of the input buffer in bytes
X"data_len" will contain the number of characters read
X"term_len" (if specified) will contain the length of the terminator
X"I" will contain the IO completion status code
X
X"prompt_desc" is the address of a descriptor of the prompt string
X"buf_desc" is the address of a descriptor of the input buffer
X
X2 TT_WRITE
XCALL TT_WRITE( array, length )
XINTEGER length
XBYTE array( length )
X
X"array" is the address of the characters
X"length" is the number of characters to write
X
XThe write is done in "noformat" (binary) mode.  This completely bypasses
Xany checking done by the terminal driver eg. for tabs, escape sequences,
Xor end of line wrapping. `20
X2 TT_WRITE_S
XCALL TT_WRITE( array, length, efn )
XINTEGER length, efn
XBYTE array( length )
X
X"array" is the address of the characters
X"length" is the number of characters to write
X"efn" is the efn which will be set upon the writes completion
X`09This routine does not wait for it to be set.
X
XCan be called synchronously with TT_WRITE.
XThis is so that you can do 2 writes at the same time.
XIt is designed for use within an AST procedure.
X2 TT_CANCEL
XCALL TT_CANCEL
X
XCancels type-ahead.
X2 TT_CANCEL_IO
XCALL TT_CANCEL_IO
X
XCancels all pending I/O requests that were issued via the TTIO routines.
XThis will normally be called from within an AST procedure.
X2 Examples
XC`09TEST TTIO ROUTINES
XC
X`09INTEGER TT_PROMPT
X`09CHARACTER PROMPT*16, BUF_IN*80
X`09DATA PROMPT / 'ABCDEFGHIJKLMNO>' /
XC
X`09CALL TT_INIT( 2 )
XC
X`09DO J=1,10
X`09  I = TT_PROMPT( PROMPT, , BUF_IN, , LEN_IN , LEN_TERM )
X`09  TYPE *,I,LEN_IN, LEN_TERM
X`09  TYPE *,BUF_IN(:LEN_IN)`09! THE TERMINATOR IS AFTER THIS
X`09END DO
X`09END
X1 SLEEP_SET
XThis routine, along with SLEEP_START and SLEEP_WAIT, allows your program
Xto execute an asynchronous sleep.  You call SLEEP_SET to specify the length
Xof time.  Then you call SLEEP_START to begin the timed period.  Control
Xreturns immediately to your image; you can then execute whatever code is
Xrequired.  Then you call SLEEP_WAIT to wait for the timed period to expire.
XThe timed period may have already finished, in which case control will
Xreturn immediately.
X2 Parameters
XCALL SLEEP_SET( time , efn )
X
X"time" is the address of an integer specifying the timed period in
X       hundredths of a second.
X"efn"  is the address of an integer indicating which event flag to use.
X       Use 21 if you have no preference.  Must be less than 24.
X1 SLEEP_START
XThis starts a timed period, as specified by the previous call to SLEEP_SET.
X
XCALL SLEEP_START
X
XControl returns immediately.
X1 SLEEP_WAIT
XThis waits for the completion of a timed period, as started by the previous
Xcall to SLEEP_START
X
XCALL SLEEP_WAIT
X.endc
X`09$dvidef
X`09$iodef`09`09; qio io$_...
X`09$ttdef`09`09; terminal characteristics
X
X
X`09.psect`09$rw_TT_channel$ wrt, rd, noexe, noshr, pic, long
Xttchan:
X`09.long`09; channel on which terminal is open (if non zero)
X
X`09.psect`09tt$rodata`09nowrt, noexe, shr, pic, long
X
Xttname_descr:
X`09.ascid`09/TT/
X
Xmbxcnv:
X`09.ascid`09/_MBA!UW:/`09; convert mbx unit number to physical name
X
Xmbxbuf_descr:
X`09.word`09mbxbuf_siz, 0
X`09.address mbxbuf
X
Xmbxitmlst:
X`09.word`09mbxname_len, dvi$_devnam
X`09.address mbxname
X`09.address mbxiosb`09`09; return length, don't want
X`09.long`090`09`09`09; end of list
X
X`09.align long
X
X`09.psect`09tt$rwbuf`09wrt, noexe, noshr, pic, long
X
Xmbxname_len = 64
Xmbxname:`09`09`09; room to hold the physical mbx name
X`09.blkb`09mbxname_len
Xmbxname_descr:
X`09.word`09mbxname_len, 0
X`09.address mbxname
Xmbxiosb:
X`09.long`090,0
Xmbxbuf_siz = 32
Xmbxbuf:
X`09.blkb`09mbxbuf_siz
X
X`09.align`09long
Xttbuf_siz = 128
Xttbuf:
X`09.blkb`09ttbuf_siz
X;outbuf_siz = 128
X;outbuf::
X;`09.blkb`09outbuf_siz
X
Xttiosb:
X`09.long`090,0
Xtt_func:
X`09.long`09io$_readvblk
Xtt_p_func:
X`09.long`09io$_readprompt
Xtt_timed:
X`09.long`09`09`09; wait time if specified
Xtt_term_addr:
X`09.long`09`09`09; p4 parameter of read
Xtt_term_quad:
X`09.quad`09`09`09; quad word pointed to be tt_term_addr
Xtt_term_mask:
X`09.blkb`0916`09`09; bit set if that char is a terminator (0-127)
X
X
X`09.psect`09tt$rwdata`09wrt, noexe, noshr, pic, long
X
Xmbxchan:
X`09.word
Xdata_ready:
X`09.word
X
Xchars_left:
X`09.long
Xchar_pointer:
X`09.long
X
Xsleep_time:
X`09.long -100000*30, -1`09`09; time to sleep (30/100ths default)
X
Xttmode:`09`09`09`09`09; terminal chars changed
X`09.quad
Xttsavemode:`09`09`09`09; original terminal characteristics
X`09.quad
X
Xsleep_args:
X`09.long`094
Xsleep_efn:
X`09.long`0921`09; event flag to use for sleeps
X`09.address sleep_time
X`09.long`090`09; astadr
X`09.long`090`09; reqidt
X
X;outbuf_qio:
X;`09$qio`09func=io$_writevblk!io$m_noformat,-
X;`09`09p1=outbuf
Xoutput_qio:
X`09$qio`09func=io$_writevblk!io$m_noformat
X
Xread_now_qio:
X`09$qio`09func=io$_readvblk!io$m_timed!io$m_noecho!io$m_nofiltr,-
X`09`09iosb=ttiosb,-
X`09`09p1=ttbuf, p2=ttbuf_siz, p3=0`09; wait time = 0
X
Xread_fast_qio:`09; inittialized by TT_SET_READF
X`09$qio`09func=io$_ttyreadall!io$m_noecho, iosb=ttiosb
X
Xtt_exit_blk:`09`09`09; exit handler block
X`09.long
X`09.address tt_exit_handler
X`09.long`091`09`09; 1 argument
X`09.address 10$
X10$:`09.long`090`09`09; exit reason
X
X
X`09.psect`09tt$code  nowrt, exe, shr, pic, long
X
X`09.entry`09-
XTT_INIT, `5Em<r2>
X;+
X; CALL TT_INIT( type )
X; type`09= 0, ordinary line input
X;`09  1, single character input
X;`09  2, line input with escape sequences
X;
X;`09patch 16-Sep-1982
X;`09`09Only allow 1 call to TT_INIT
X;-
X`09tstw`09ttchan`09`09; if channel already allocated, return
X`09beql`0950$`09`09; patch 16-Sep-1982
X`09ret
X50$:
X`09movl`09@4(ap), r2`09; get type code
X
X`09caseb`09r2, #0, #2
X20$:`09.word`09100$-20$
X`09.word`09200$-20$
X`09.word`09300$-20$
X100$:`09; type 0 (line input)
X`09$assign_s`09devnam=ttname_descr, chan=ttchan
X`09bsbw`09error`09`09`09; check for error
X`09brw`091000$
X
X200$:`09; type 1 (single character input)
X; Create a mailbox.  Assign a channel to terminal with an associated mailbox
V.
X`09$crembx_s`09chan=mbxchan, promsk=#`5ExFF00
X`09bsbw`09`09error
X
X;`09$getchn_s`09chan=mbxchan, pribuf=dibbuf_descr
X;`09bsbw`09`09error
X;`09$fao_s`09`09ctrstr=mbxcnv, outbuf=mbxname_descr,-
X;`09`09`09outlen=mbxname_descr, p1=dibbuf+dib$w_unit
X
X`09$getdvi_s`09chan=mbxchan, itmlst=mbxitmlst
X`09bsbw`09`09error
X`09locc`09`09#0, #mbxname_len, mbxname  ; find trailing nulls
X`09subl3`09`09r0, #mbxname_len, r0
X`09movw`09`09r0, mbxname_descr`09; store length of name
X
X`09$assign_s`09devnam=ttname_descr, chan=ttchan, - ; acmode=#`5ExFF00
X`09`09`09mbxnam=mbxname_descr`09; acmode fails in VMS 5.5
X`09bsbw`09error
X`09bsbw`09queue_mbxread`09`09; start mail box read
X`09brw`091000$
X
X300$:`09; type 2 (line input with escape sequences)
X`09$assign_s`09devnam=ttname_descr, chan=ttchan
X`09bsbw`09error`09`09`09; check for error
X`09$qiow_s func=#io$_sensemode, chan=ttchan, -
X`09`09iosb=ttiosb, p1=ttmode`09; get terminal characteristics
X`09bsbw`09error
X`09movzwl`09ttiosb, r0
X`09bsbw`09error
X`09movq`09ttmode, ttsavemode`09; save current terminal chars
X`09$dclexh_s desblk=tt_exit_blk`09; declare exit handler to restore
X`09`09`09`09`09; terminal chars on exit.
X`09bsbw`09error
X`09bbss`09#tt$v_escape, ttmode+4, 310$`09; want escape sequences
X310$:`09$qiow_s func=#io$_setmode, chan=ttchan, -
X`09`09iosb=ttiosb, p1=ttmode
X`09bsbw`09error
X`09movzwl`09ttiosb, r0
X`09bsbw`09error
X;`09brbw`091000$
X
X1000$:
X;`09movw`09ttchan, outbuf_qio+qio$_chan`09`09;store channel #
X`09movw`09ttchan, output_qio+qio$_chan`09`09;store channel #
X`09movw`09ttchan, read_now_qio+qio$_chan`09`09;store channel #
X;`09$qiow_s`09func=#io$_setmode!io$m_ctrlcast, chan=ttchan,-
X;`09`09p1=control_c`09`09`09; set control C trap
X`09ret
X
X
X`09.entry`09-
XTT_SET_FUNC, `5Em<>
X;+
X;`09I = TT_SET_FUNC( value `5B, seconds `5D )
X;`09set read modifiers
X;-
X`09movl`09@4(ap), r0`09`09`09; get modifiers
X`09movl`09#io$m_nofiltr!io$m_purge!io$m_timed!io$m_trmnoecho, r1
X`09`09`09`09`09; get bits allowed to set
X`09bicl2`09r1, tt_func`09`09; clear previous options
X`09bicl2`09r1, tt_p_func
X`09mcoml`09r1, r1`09`09`09; get bits cannot change
X`09bicl2`09r1, r0`09`09`09; make sure only change correct bits
X`09bisl2`09r0, tt_func`09`09; and set new options
X`09bisl2`09r0, tt_p_func
X
X`09cmpb`09#1, (ap)`09`09; check if "seconds" parameter here
X`09bgtr`09100$
X`09ret
X100$:`09movl`09@8(ap), tt_timed`09; store time
X`09ret
X
X
X`09.entry`09-
XTT_SET_TERM, `5Em<r2,r3>
X;+
X;`09CALL TT_SET_TERM( option, parameters... )
X;`09set terminator character mask
X;
X;`09option
X;`090`09normal terminators (any control char except LF VT FF TAB BS
X;`091`09parameter 1 is the address of a longword containing the
X;`09`09terminator bit mask (first 32 characters only)
X;`09`09( 1, '00000001'X )`09! enable Control A as terminator
+-+-+-+-+-+-+-+-  END  OF PART 7 +-+-+-+-+-+-+-+-