d .title TYIO: Terminal driver for SAO VAX/VMS STOIC ; ***************************************************************** ,; * * ; * This is a module of SAO VAX/VMS STOIC * ; * * X; * It was created by * ; * Roger Hauck * ; * Smithsonian Institution * ; * Astrophysical Observatory * ; * Cambridge, Massachusetts 02138 * L; * (617)495-7151 (FTS 830-7151) * ; * * ; * This module may be reproduced * x; * provided that this title page is retained. * ; * * @; ***************************************************************** d.macro newpage title .page , .sbttl title  .endm  X .ident /01/  .enabl dbg  .mcall $iodef,$trnlog,$assign,$qiow_s  $iodef  $dcdef L  .macro descriptor text,?label1,?label2  .long label2-label1 x .long label1 label1: .ascii /text/ @label2:  .endm  .macro .errstop ?p1 l blbs r0,p1  pushl r0 4 calls #1,g^lib$stop p1:  .endm ` ;macro to assemble code to initialize a user table location with ( ;an address .macro addr_to_ut addr,dest T .save ;save current location .psect setup ;go to setup psect  moval l^(r11),w^dest(r11) ;do move .restore ;return to where we were .endm H ;macro to give one block in the data area the address of another  t.macro addr_to_addr addr,dest  .save < .psect setup  moval l^(r11),l^(r11)  .restore h.endm  0 newpage  .psect datinit  \tyiodata::  $ .extrn sssize ttname0:: descriptor ;descriptor for terminal name ttchan0:: .blkw 1 ;receive channel number here P ttiosb: .blkw 1 ;first word of iosb, status ttiolen: | .blkw 1 ;second word, get length  .blkl 1 ;second longword of iosb D devdesc: ;descriptor _nlen: .long 63 ;buffer length p_naddr: .long 0 ;address of buffer _name:: .blkb 63 8 tyiosize==<.-tyiodata>/^x200+1  d.extrn nlen,naddr,nstore,ttname .extrn _rmstype,_rmstyo ,  .psect kernel ;----tyopen: opens console for i/o X_TYOPEN::  movl #63,nlen(r11) ;initialize the length  $trnlog_s lognam=@ttname(r11),rsllen=nlen(r11),rslbuf=nlen(r11)  blbc r0,20$ ;if not successful  cmpb @nstore(r11),#^x1b ;does name begin with escape? L bneq 10$ ;no, skip  subl #4,nlen(r11) ;otherwise, subtract 4 from length  addl #4,naddr(r11) ;add 4 to address x 10$: $assign_s devnam=nlen(r11),chan=ttchan(r11) ;assign channel @20$: movl r0,-(r10) ;completion code  rsb  l ;----OUTINIT: open a terminal channel to SYS$COMMAND, and use it to ; find out if the process is interactive or batch. If 4!; batch, initialize TYPEADDR and TYOADDR with the addresses !; of RMSTYPE and RMSTYO (and de-assign the terminal channel); !; if interactive, use normal TYPE and TYO. `"outinit:: " jsb _tyopen (# movl (r10)+,r0 # .errstop # ; (The following code was taken largely from CONTROLC) T$ clrq -(sp) ;allocate 8-byte buffer & clear it $ movl sp,r2 ;r2->buffer % movl sp,-(sp) ;-4(r2)-> buffer % movl #8,-(sp) ;-8(r2),- 5 iosb=ttchan+2(r11),- 5 p1=@4(r10),p2=(r10),p4=#rdterm,- L6 p5=12(r10),p6=8(r10) 6 addl2 #^x10,r10 ;pop buffer addresses, lengths 7 movzwl ttchan+4(r11),-(r10) ;get transfer count x7 movl r0,-(r10) ;push status 7 rsb @8 8_type_tyi:: 9 movl (r10)+,r0 ;put length in r0 l9 movl (r10)+,r1 ;put prompt address in r1 9 clrl -(r10) ;clear longword to recieve byte 4: $qiow_s chan=ttchan(r11),- : func=#-^X100,- : iosb=ttchan+2(r11),p1=(r10),p2=#1,- `; p5=r1,p6=r0 ;; QIOW FUNCTIONS: -100,- (< movl r0,-(r10) ;save condition code on stack < rsb < T=_tyo:: = $qiow_s chan=ttchan(r11),- > func=#io$_writevblk!io$m_noformat- > iosb=ttchan+2(r11),p1=(r10)+,p2=#1 > movl r0,-(r10) H? jsb syserr ? rsb @ t@_type:: @ $qiow_s chan=ttchan(r11),- L L.extrn rminame,rmichan,rmoname,rmochan,rmbuf XM M;----rmopen: opens remote line for i/o N_REMSTART:: N N; Open Input Channel LO movl (r10)+,r0 ;address of input name as STOIC string O movw (r0)+,rminame(r11) ;length of name P movl r0,rminame+4(r11) ;address of name xP movl (r10)+,r0 ;address of output name as STOIC string P movw (r0)+,rmoname(r11) ;length of name @Q movl r0,rmoname+4(r11) ;address of name Q R movl nstore(r11),naddr(r11) ;fixup descriptor lR movl #63,nlen(r11) R $trnlog_s lognam=rminame(r11),rsllen=nlen(r11),rslbuf=nlen(r11) 4S blbc r0,13$ ;if not successful S cmpb @nstore(r11),#^x1b ;does name begin with escape? S bneq 10$ ;no, skip `T subl #4,nlen(r11) ;otherwise, subtract 4 from length T addl #4,naddr(r11) ;add 4 to address (U U10$: $assign_s devnam=nlen(r11),chan=rmichan(r11) ;assign channel U blbs r0,15$ ;if not successful TV13$: movl r0,-(r10) V rsb W W; Open Output Channel W HX15$: movl @nstore(r11),naddr(r11) ;fixup descriptor X movl #63,nlen(r11) Y $trnlog_s lognam=rmoname(r11),rsllen=nlen(r11),rslbuf=nlen(r11) tY blbc r0,30$ ;if not successful Y cmpb @nstore(r11),#^x1b ;does name begin with escape? ;here on read completion ` blbs rmichan+2(r11),10$ ;if no error |` calls #1,g^lib$signal ` ret Da a10$: $qio_s chan=ttchan(r11),- ;write one char. to local b func=#io$_writevblk!io$m_noformat,- pb iosb=ttchan+2(r11),p1=rmbuf(r11),p2=#1 b blbs r0,20$ 8c calls #1,g^lib$signal c d20$: $qio_s chan=rmichan(r11),- ;read next char. from remote dd func=#io$_readvblk!io$m_noecho!io$m_nofiltr,- d iosb=rmichan+2(r11),astadr=rmast,- ,e p1=rmbuf(r11),p2=#1 e blbs r0,30$ e calls #1,g^lib$signal Xf30$: ret f g; Type to remote g_remtype:: g $qiow_s chan=rmochan(r11),- Lh func=#io$_writevblk!io$m_noformat- h iosb=rmochan+2(r11),p1=@(r10)+,p2=(r10)+ i movl r0,-(r10) xi rsb i @j .end