.title TTFISW - [TT] to [FI]le [SW]itch program .sbttl Included Declarations ; .library "mar:always" $dvidef $iodef $prvdef $rmsalldef $rmsdef $ssdef $ttdef $tt2def .sbttl Header ;++ ; Program: TTFISW.MAR ; ; Author: David G. North, CCP ; 1333 Maywood Ct ; Plano, Texas 75023-1914 ; (214) 902-3957 ; ; Date: 91.10.01 ; ; Revisions: Who Date Description ; D.North 911001 Initial release ; ; Description: ; The TTFISW program is a modification of a simple AST-driven $QIO ; interface to the VMS PY/TW drivers. The outline of it's function ; is: 1) Create the PY/TW pair, and initiate the copy PY->TT: portion, ; 2) Open SYS$INPUT and copy the contents to the PY device (thereby ; providing the (FI)le portion of the program.), and 3) enable the ; TT: device for I/O to the PY device. ; ; Functionally, life is a bit more complicated. First, to propagate ; the terminal characteristics, PHY_IO privilege is required, and ; secondly, since the typeahead buffer is not created until such time ; as the first IO$_READ[VLP]BLK function is executed, the program ; must force creation of the typeahead buffer on the TW device. ; ; Communication is performed thru a JOB logical TW_DEV indicating the ; name of the TW device for the client application to use. SYS$INPUT ; is expected to be the input file to be copied to the PY device prior ; to enabling TT: for input, and obviously, TT: is expected to be the ; I/O terminal. If no input file is desired, then the caller should ; bypass the usage of this program, but the same effect can be obtained ; by defining SYS$INPUT to be NL:. ; ; Synchronization with the client is performed by polling the TW device ; DVI$_REFCNT until that count is non-zero. ; ; License: ; Ownership of and rights to these programs is retained by the author(s). ; Limited license to use and distribute the software in this library is ; hereby granted under the following conditions: ; 1. Any and all authorship, ownership, copyright or licensing ; information is preserved within any source copies at all times. ; 2. Under absolutely *NO* circumstances may any of this code be used ; in any form for commercial profit without a written licensing ; agreement from the author(s). This does not imply that such ; a written agreement could not be obtained. ; 3. Except by written agreement under condition 2, source shall ; be freely provided with all binaries. ; 4. Library contents may be transferred or copied in any form so ; long as conditions 1, 2, and 3 are met. Nominal charges may ; be assessed for media and transferral labor without such charges ; being considered 'commercial profit' thereby violating condition 2. ; ; Warranty: ; These programs are distributed in the hopes that they will be useful, but ; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY ; or FITNESS FOR A PARTICULAR PURPOSE. ; ;-- .sbttl Data Declarations .psect $$data,noexe,wrt,noshr ;RMS data structures to access SYS$INPUT ifab: $fab fac=get,shr=get,fnm= ;SYS$INPUT file access irab: $rab fab=ifab ;SYS$INPUT RAB ;Buffer definition for access to SYS$INPUT MAXBUF = 512 ;Maximum buffer size ibuf: .blkb MAXBUF ;SYS$INPUT buffer ttchn: .long ;I/O channel to the local terminal twchn: .long ;Temp I/O channel to TW device pychn: .long ;I/O channel to PY device mbychn: .long ;PY device mailbox channel ttschr: .blkb 12 ;Saved TT chars of origin TT: ttnchr: .blkb 12 ;New TT chars for origin TT: _TT_L_TTDEF = 4 ;Offset to $TTDEF in ttxchr block _TT_L_TT2DEF = 8 ;Offset to $TT2DEF in ttxchr block chrset: .long 0 ;flag for whether or not to reset TT characs exhblk: .long 0 ;Exit handler block (reset TT characs) .address bugout ;handler routine address .long 1 .address finst ;final status address finst: .long 0 ;final status storage location hupcnt: .long 0 ;number of hangup messages gotten extflg: .long 0 ;flag for if exit is in progress pyiosb: .quad ;IOSB for PY device I/O pybuf: .blkb 512 ;Buffer for PY device I/O pylabuf: .quad ;PY Look-Ahead (typeahead) retrieval buffer pymbiosb: .quad ;IOSB for PY mailbox I/O pymbbuf: .blkb 128 ;Buffer for PY mailbox I/O ttiosb: .quad ;IOSB for TT device I/O ttybuf: .blkb 512 ;Buffer for TT device I/O ttlabuf: .quad ;TT Look-Ahead (typeahead) retrieval buffer TTEFN = 5 ;EFN used for TT device I/O PYEFN = 6 ;EFN used for PY device I/O PMEFN = 7 ;EFN usef for PY mailbox I/O d_tty: .ascid /TT:/ ;Device logical name for TT d_pya: .ascid /PYA0:/ ;PY template device name pymbnm: .ascid /PYAMBX/ ;PY mailbox process logical name d_twa: .ascid /TWAnnnnnnnn/ ;TW device name in TEXT format d_job: .ascid /LNM$JOB/ ;JOB logical name table name twlnm: .ascid /TW_DEV/ ;Logical to assign TW name to .sbttl Exit Handler Junk .psect $$code,exe,nowrt,shr ;++ ; BUGOUT - Exit handler to reset tube upon exit ;-- .entry bugout, ^m<> tstl chrset ;make sure we got term chars bneq 20$ ;yep... go reset terminal 10$: ret 20$: incl extflg ;signal exit in progress $cancel_s - chan = ttchn ;blast I/O on terminal $qiow_s - ;Fixup term chars backto normal chan = ttchn,- func = #IO$_SETMODE,- p1 = ttschr,- p2 = #12 clrl chrset ;clear reset brw 10$ ;++ ; TRAPEXIT - Setup Exit handler ;-- .entry trapexit, ^m<> $dclexh_s - desblk = exhblk ret .sbttl Initialization routines ;++ ; INITTY - Initialize TT parameters ; ; Get current terminal characteristics & save them for exit handler restore ; Modify terminal characteristics so this program gets *EVERY* keystroke ; ;-- .entry initty, ^m 10$: $assign_s - devnam = d_tty,- chan = ttchn blbs r0,30$ 20$: ret 30$: clrq -(SP) ;space for IOSB moval (SP),r2 ;save address of IOSB $qiow_s - chan = ttchn,- func = #IO$_SENSEMODE,- iosb = (r2),- p1 = ttschr,- p2 = #12 blbs r0,50$ 40$: movl r0,r2 $dassgn_s - chan = ttchn movl r2,r0 brw 20$ 50$: movzwl (r2),r0 blbc r0,40$ movo ttschr,ttnchr movl ttschr+8,ttnchr+8 ;make a copy of the term chars bisl #TT$M_NOECHO,ttnchr+_TT_L_TTDEF ;set noecho bicl #TT$M_HOSTSYNC!TT$M_TTSYNC,ttnchr+_TT_L_TTDEF ;pass ^S bisl #TT2$M_PASTHRU,ttnchr+_TT_L_TT2DEF ;use pasthru $qiow_s - chan = ttchn,- func = #IO$_SETMODE,- iosb = (r2),- p1 = ttnchr,- p2 = #12 blbs r0,70$ 60$: brw 40$ 70$: movzwl (r2),r0 blbc r0,60$ incl chrset ;flag us for reset ret ;++ ; INIPYA - Initialize access to the PY/TW device pair ; ; Create the PY/TW device pair ; Propagate terminal characteristics to target TW device ; ;-- .entry inipya, ^m $crembx_s - chan = mbychn,- maxmsg = #40,- bufquo = #256,- lognam = pymbnm blbs r0,20$ 10$: ret 20$: $assign_s - devnam = d_pya,- chan = pychn,- mbxnam = pymbnm blbs r0,40$ 30$: movl r0,r2 $dassgn_s - chan = mbychn movl r2,r0 brw 10$ 40$: clrl (SP) clro -(SP) ;space for 2 longs, term, retlen moval 8(SP),r2 ;address of scratch space pushal 8(r2) ;space to return unitno pushl #DVI$_UNIT@16!4 ;get unit number code moval (SP),r3 $getdviw_s - chan = pychn,- itmlst = (r3),- iosb = (r2) blbs r0,60$ 50$: movl r0,r2 $dassgn_s - chan = pychn movl r2,r0 brw 30$ 60$: movzwl (r2),r0 ;get IOSB status blbc r0,50$ moval 8(r2),SP ;blast itmlst & IOSB into space popl r2 ;unit number in r2 SPRINTF d_twa,,r2 ;format TWA name $assign_s - devnam = d_twa,- chan = twchn blbs r0,80$ 70$: brw 50$ 80$: clrq -(SP) ;get an IOSB moval (SP),r2 ;get address movl ttschr+_TT_L_TT2DEF,r3 ;save ttschr $qiow_s - ;propage term chars chan = twchn,- func = #IO$_SETCHAR,- iosb = (r2),- p1 = ttschr,- p2 = #12 blbs r0,100$ 90$: brw 70$ 100$: movzwl (r2),r0 blbc r0,90$ 110$: $dassgn_s - chan = twchn ret .sbttl Set Privileges - bomb off if incorrect ;++ ; PRIVS - Set process privileges required for this program ; ; Return a bomboff if the privileges can't be got at ; ;-- .entry privs, ^m<> clrq -(SP) moval (SP),r2 bisl #PRV$M_PHY_IO,(r2) ;try to get PHY_IO privilege $setprv_s - ;try to set privileges enbflg = #1,- prvadr = (r2) cmpl r0,#SS$_NOTALLPRIV bneq 10$ movl #SS$_NOPHY_IO,r0 ;create a bomb code 10$: ret .sbttl TT read AST processing ;++ ; TTYRDAST - process a TT read complete or PY write complete ;-- .entry ttyrdast, ^m tstl extflg ;Has an EXIT started? beql 10$ ;Nope... process AST ret ;bomb this AST thread 10$: tstl 4(AP) ;see if WRITE to PY completed bneq ttwr ;nope... go do a write operation ttrrd: $qio_s - ;queue a read operation to TT efn = #TTEFN,- chan = ttchn,- func = #IO$_READVBLK,- iosb = ttiosb,- p1 = ttybuf,- p2 = #1,- astadr = ttyrdast,- astprm = #1 ;signal next operation is write to PY ret ttwr: blbc ttiosb,b^ttrrd ;skip error completions movzwl ttiosb+2,r2 ;get actual IO count addw ttiosb+6,r2 ;add in terminator length beql b^ttrrd ;reread if no data clrq ttlabuf ;zap off typeahead count $qiow_s - ;go get # of chars in typahd buf efn = #TTEFN,- chan = ttchn,- func = #IO$_SENSEMODE!IO$M_TYPEAHDCNT,- iosb = ttiosb,- p1 = ttlabuf,- p2 = #8 movzwl ttlabuf,r3 ;additional char count to get beql 20$ ;jmp if no extra chars to get cmpl r3,#^x511 ;see if it's too big blss 10$ ;no... go get it movl #500,r3 ;set max bufsiz - maxtrm 10$: $qiow_s - ;suck out type ahead efn = #TTEFN,- chan = ttchn,- func = #IO$_READVBLK,- iosb = ttiosb,- p1 = ttybuf(r2),- p2 = r3 movzwl ttiosb+2,r3 ;get actual IO count addw ttiosb+6,r3 ;add in terminator length addw r3,r2 ;compute real output length 20$: $qio_s - ;Queue output to PY device chan = pychn,- func = #IO$_WRITEVBLK,- iosb = ttiosb,- p1 = ttybuf,- p2 = r2,- astadr = ttyrdast,- astprm = #0 ;signal next operation is RD TT ret .sbttl PY device read AST processing ;++ ; PYRDAST - process a PY read complete or TT write complete ;-- .entry pyrdast, ^m tstl 4(AP) ;see if we should write to TT bneq pywr ;yop - go write to TT pyrrd: $qio_s - ;queue read to PY device efn = #PYEFN,- chan = pychn,- func = #IO$_READVBLK,- iosb = pyiosb,- p1 = pybuf,- p2 = #512,- astadr = pyrdast,- astprm = #1 ;signal write to TT next oper ret pywr: blbc pyiosb,b^pyrrd ;skip error completions movzwl pyiosb+2,r2 ;get read count $qio_s - ;Copy read-in data to TT chan = ttchn,- func = #IO$_WRITEVBLK,- iosb = pyiosb,- p1 = pybuf,- p2 = r2,- astadr = pyrdast,- astprm = #0 ret .sbttl PY mailbox read AST processing ;++ ; PYRDAST - process a PY mailbox read complete ;-- .entry pymbast, ^m<> tstl 4(AP) ;should we simply hang out a read? beql 20$ ;yep... (i.e. this is an INIT ast) 10$: incl hupcnt ;increment hangup count cmpl hupcnt,#2 ;see if hangup MAXcount reached bneq 20$ ;nope... re-hang the read $exit_s ;else bugoff - this is the program exit 20$: $qio_s - ;rehang a read on the PY mailbox efn = #PMEFN,- chan = mbychn,- func = #IO$_READVBLK,- iosb = pymbiosb,- p1 = pymbbuf,- p2 = #1,- astadr = pymbast,- astprm = #1 ;signal NON-INIT completion AST ret .sbttl Startup of AST threads ;++ ; HANG_PY_READS - setup PY reader AST threads ;-- .entry hang_py_reads, ^m<> $dclast_s - ;start PY reader AST thread astadr = pyrdast,- astprm = #0 ;signal hang a read first $dclast_s - ;start PY MBX reader AST thread astadr = pymbast,- astprm = #0 ;signal INIT completion AST ret ;++ ; HANG_TTY_READ - start TT reader thread ;-- .entry hang_tty_read, ^m<> $dclast_s - ;start TT reader AST thread astadr = ttyrdast,- astprm = #0 ;signal hang a read first ret .sbttl TTFISW interprocess connection routines ;++ ; ACCESS_FILE - access SYS$INPUT file for queue to PY device ;-- access_file: $open - ;try to open file fab = ifab blbs r0,10$ ret ;crash if failure 10$: $connect - ;go connect a record stream rab = irab blbs r0,20$ ret ;crashola for failure 20$: rsb ;++ ; DECLARE_TWA - Define logical in JOB table for caller access ;-- declare_twa: pushaq d_job ;define in JOB table pushaq d_twa ;name of TW device to use pushaq twlnm ;using logical name 'twlnm' calls #3,g^LIB$SET_LOGICAL ; $ DEFINE/JOB 'twlnm' 'd_twa' rsb ;++ ; PAUSE - snooze for a time increment (in tenths of seconds) ;-- CVFAC = -1000*100*10 .entry pause,^m<> emul #CVFAC,4(ap),#0,-(sp) clrl -(sp) pushab 4(sp) clrq -(sp) calls #4,g^SYS$SCHDWK blbc r0,10$ calls #0,g^SYS$HIBER 10$: ret ;++ ; WAIT_ACCESS - wait for client to access the TW device ;-- wait_access: movl SP,r8 ;save sp clrl -(SP) ;make temp space moval (SP),r7 ;point to temp space clrl -(SP) ;no retadr pushal (r7) ;place to return refcnt pushl #!4 moval (SP),r6 ;point at itmlst 10$: $getdviw_s - devnam = d_twa,- itmlst = (r6) tstl (r7) beql 20$ movl r8,SP ;restore stack rsb ;back to caller... TWA's got a channel up 20$: pushl #5 calls #1,w^pause ;go snooze a half-second brw 10$ ;try again ;++ ; COPY_FILE - Copy SYS$INPUT file to PY device ; (TW device is assigned by client now... legal to use SHARE to get at it) ;-- copy_file: $assign_s - ;assign channel to TW device devnam = d_twa,- chan = twchn $qiow_s - ;force setup of typeahead buffer chan = twchn,- func = #IO$_READVBLK,- p1 = ibuf,- p2 = #0 $dassgn_s - ;Typahd set up - don't need chn anymore chan = twchn movab ibuf,irab+rab$l_ubf ;I/O to this buffer movw #MAXBUF,irab+rab$w_usz ;with a MAX of this length 10$: $get rab=irab ;go get an input record blbs r0,20$ ;and process it if we got it OK $close fab=ifab ;else blowoff the file access rsb ;and go back to caller 20$: movzwl irab+rab$w_rsz,r2 ;get length of record read in $qiow_s - ;queue it to the PY device chan = pychn,- func = #IO$_WRITEVBLK,- iosb = ttiosb,- p1 = ibuf,- p2 = r2 brw 10$ ;do for all records in file .entry main, ^xffc bsbw access_file ;Go access SYS$INPUT data file/device calls #0,w^trapexit ;Initiate exit handler blbc r0,w^bug ;Bomb off for an OOPS! calls #0,w^privs ;Go grab required privs (may exit prg) blbc r0,w^bug ;Whoops! - get lost calls #0,w^initty ;Setup terminal & save current chars blbc r0,w^bug ;KaBlooie... bugout... calls #0,w^inipya ;Startup the PY/TW devices blbc r0,w^bug ;Belly-up if it didn't work calls #0,w^hang_py_reads ;Startup PY reader AST thread bsbw declare_twa ;Announce TW name in JOB table bsbw wait_access ;Wait for someone to use it bsbw copy_file ;Now copy input file to PY device calls #0,w^hang_tty_read ;And start the TT interface blbc r0,w^bug ;Go crap if it didn't work $hiber_s ;Hiber & let AST's do the work bug: ret ;leave. .end main