subroutine SetTrap(SyRv) ,<881219.1353> >Set Fortran Trapping implicit none ! K6SUBS contains routines which are specific to RTE-6. This ! revision operates with KERMIT revision 1.99 or later. ! This routine is actually system-independent. It is included in the ! system-dependent outines only because it contains conditionally- ! compiled code. If the user MUST use this KERMIT on a C.83 system, ! having this routine here will reduce the installation time greatly. ! BE SURE TO RE-INDEX the appropriate library file! include kercom.ftni,NOLIST !Defines "SysRev" integer*2 SyRv external FtnTrap if (SysRev .ge. 2440) then !Fortran trapping desired? if (SyRv .ge. 2440) then !Yes - is it available? call Ftrap(FtnTrap) !Yes - use it else call tpFm('You must set "SysRev" (in KERCOM) <_') call tpFm(' 2440, then recompile/relink KxSubs!') call quit endif endif return end subroutine restore(lu) ,<881219.1353> >6/Restore LU's implicit none include kercom.ftni,NOLIST include kercnf.ftni,NOLIST integer*2 lu,cnf(CnfSiz) logical*2 fMux integer*2 timv,ctrg,c17s,c30c,c30s,c33c,c33s,c34c,c34s equivalence (fMux,Cnf(fMx)), (timv,Cnf(tim)), (ctrg,Cnf(trg)) equivalence (c17s,Cnf(v17)) equivalence (c30c,Cnf(c30)), (c33c,Cnf(c33)), (c34c,Cnf(c34)) equivalence (c30s,Cnf(s30)), (c33s,Cnf(s33)), (c34s,Cnf(s34)) ! This routine differs from its RTE-A counterpart in that IDM00 ! has a CN45 request to kill the DC1 trigger character, which would ! need to be restored. The DVM00 trigger handling is part of the ! DDV05 device-driver, which is restored (if needed) when we do the ! CN33 to restore the driver-responses configuration. if (lu .eq. L) then !Use which configuration array? call MoveWords(LocCnf,cnf,CnfSiz) else call MoveWords(RemCnf,cnf,CnfSiz) endif call Set_timeout(lu,timv,fMux) !Restore original timeout if (.not. fMux) return !Not mux? Nothing left to do c At this point, we will restore ONLY those parameters we have altered c as a result of KERMIT's normal operations. if (c30c .ne. c30s) then call control(lu,3000b,c30s) !restore char format endif if (c33c .ne. c33s) then call control(lu,3300b,c33s) !restore configuration endif if (c34c .ne. c34s) then call control(lu,3400b,c34s) endif if (.not. btest(cnf,0) ) then !D mux? call control(lu,3700b,173400b) !No: allow echo/edit; end on CR else ! --> Need not yet established! call control(lu,1700b,c17s) !Yes: restore terminator endif return end subroutine enable(lu,imux) ,<881219.1353> >6/Enable int-scheduling implicit none integer*2 lu,imux ! This routine differs from its RTE-A counterpart in that IDM00 ! muxt keep up with the names of the interrupt-scheduled programs ! and DVM00 doesn't. if (.not. btest(imux,0) ) then !B/C mux? call control(lu,3700b,173400b) !cn37: set read type endif call control(lu,2000b,0) !cn20: enable interrupts return end subroutine disable(lu,imux) ,<881219.1353> >6/Disable int-scheduling implicit none integer*2 lu,imux ! This routine differs from its RTE-A counterpart in that IDM00 ! uses CN23 to disable interrupts, whereas DVM00 should agree with ! the RTE-6 "D" mux driver in using a CN21 to do the same job. call control(lu,2100b,0) !cn21: disable interrupts return end subroutine set_timeout(lu,val,imux) ,<881219.1353> >6/Set LU timeout value implicit none integer*2 lu,val,imux ! This routine differs from its RTE-A counterpart in that IDM00 ! has two flavors of timeout ("user" and "system") where DVM00 has ! only one. if (val .lt. 0) return !Don't set negative time-outs call control(lu,2200b,val) !cn22: set time-out return end subroutine KillEnqAck ,<881219.1353> >6/Disable ENQ/ACK implicit none include kercom.ftni,NOLIST include kercnf.ftni,NOLIST ! This routine differs from its RTE-A counterpart in that IDM00 ! has a CN45 request to clear the trigger-character, whereas DVM00 ! uses DDV05 to perform triggering, and we bypass that anyway. if ( btest(iRmx,0) ) then !D-mux? if ( btest(r34c,0) ) then !XON/XOFF enabled? r34c = 5 !Yes - add CPU<-->CPU protocol else r34c = 4 !else change to CPU<-->CPU proto endif call control (R,3400b,r34c) r33c = 100000b !Turn on FIFO mode else if ( btest(r30c,7) ) then !Is Enq/Ack on now? r30c = ibclr(r30c,7) !Yes - turn it off call control(R,3000b,r30c) endif r33c = 22501B !Bypass dev-drvr/type-ahead on endif call control(R,3300b,r33c) ! If we are really modifying the local configuration, we must track ! the changes to the local array, or RESTORE won't work correctly! if (R .eq. L) call MoveWords(RemCnf,LocCnf,CnfSiz) return end Subroutine cPrep ,<881219.1353> >6/Prepare for Connect implicit none include kercom.ftni,NOLIST !Defines L and R include kercnf.ftni,NOLIST include kconcw.ftni,NOLIST ! This routine differs from its RTE-A counterpart in the function- ! codes it sets for IDM00 (12040B/C) vs. DVM00 (12792B/C), and for ! ID*00 (12005) vs. DVA05 (12966). call disable(L) !Kill local interrupt scheduling Ltx=L $ Lrx=L $ Rtx=R $ Rrx=R !Prepare XLUEX hi control words term = 1200b !(B/C mux terminate rcv buffer) dstat = 600b !Dynamic status request code ! Prepare the local LU for connect - allows 12966 and 2 Mux types if ( fLmx ) then !Local on a mux? if ( fLcm ) then !Yes - if B or C mux... Lrc = 3300b !transparent + save t-a data L33c = iand(L33c,17b) .or. 22600b !Turn on type-ahead call control(L,3300b,L33c) call control(L,3600b,1) !Set read length call control(L,3700b,4000b) !Terminate on count only call control(L,term,0) !Terminate all buffers call control(L,term,0) !Terminate all buffers again call control(L,term,0) !Terminate all buffers once more else Lrc = 100b !D mux uses only binary L33c = 100000b !Turn on FIFO mode call control(L,3300b,L33c) endif call control(L,2600b,1) !Flush card else Lrc = 100b !binary endif Ltc = 2000b !transparent ! Prepare the remote LU for connect - allows for 2 mux types only if ( fRcm ) then !Prepping a B/C mux port? Rrc = 3300b !transparent + save t-a data Rtc = 3300b !transparent R33c = (R33c.and.17b) + 22600b !cn33: read reconfig off call control(R,3300b,R33c) call control(R,3600b,254) !cn36: set read len (254 bytes) call control(R,3700b,4000b) !cn37: terminate on count only call control(R,term,0) !terminate all buffers call control(R,term,0) !terminate all buffers again call control(R,term,0) !terminate all buffers once more call sleep(10) !allow .1 sec settling time else Rrc = 100b !D-mux is simple: just binary Rtc = 2000b !...still simple: transparent endif if ( fLmx ) call control(L,2600b,1) !Flush local if on a mux call control(R,2600b,1) !Flush remote return end integer*2 function GetPak() ,<881219.1353> >6/Read a packet implicit none include kercom.ftni,NOLIST include kercnf.ftni,NOLIST !To define iRmx integer*2 buf(128),xr(2),cw equivalence (buf,RecPkt),(xr(2),cw) ! This routine differs from its RTE-A equivalent in that we must ! bypass DD*00 and suppress a trigger in the read call under RTE-A. if ( btest(iRmx,0) ) then !D-mux? cw = 0 !Yes - set for normal ASCII else cw = 3000b !B/C: transparent, keep t-a data endif xr = R !Set remote lu into control word call xluex(1,xr,buf,-254) !Read a buffer call abreg(GetPak,rlen) !Get the received length return end subroutine PutPak(len) ,<881219.1353> >6/Send a packet implicit none include kercom.ftni,NOLIST include kercnf.ftni,NOLIST !Defines iRmx integer*2 len,xl(2),cw,PakBuf equivalence (xl(2),cw),(Packet,PakBuf) data cw /2000b/ !transparent ! This routine differs from its RTE-A counterpart in that we must ! bypass DD*00 and suppress handshake under RTE-A. xl = R !Get the remote LU call control(R,2600b,1) !Flush card before sending call xluex(2,xl,PakBuf,-len) return end subroutine GetMux(LU,CnfArr) ,<881219.1353> >6/Get MUX info implicit none ! This routine fills the Loc or Rem CNF array for the given LU. ! If it uses the new serial drivers, we can ask the driver what kind of ! card the LU is connected to; if it doesn't, we will look in the DVP ! of the LU to see what we can learn. ! ! The value placed in fLmx or fRmx tells KERMIT what kind of LU it is: ! Bit 15: set if LU supports KERMIT protocol as follows ! RTE-A: 12040 mux only ! RTE-6: 12792 mux (or 12966 using DVW00 - see note below) ! Bit 0: set if LU is on a D MUX ! Bit 1: set if LU is on the A400 OBIO ! ! NOTE: This version of KERMIT doesn't actually support the 12966/DVW00 ! combination. It is supported by KERMIT-CX as part of CONNECT, ! which is a terminal-emulation program by ICT. If KERMIT-RTE ! does things which you would like to see in KERMIT-CX, ask Don ! Wright (at ICT) to add the appropriate code. $alias /datc/ = '$DATC', NoAllocate $alias opsy = '.OPSY', direct $alias xla = '.XLA', direct $alias xluex, NoAbort include kercnf.ftni,NOLIST include kercom.ftni,NOLIST integer*2 LU,CnfArr(CnfSiz) integer*2 xl(2),cw,j,a,b,z,datc,eqta,eqxa integer*2 LuTru,AddressOf,IxGet,opsy,xla,sc,eqx integer*2 naRd,naCn parameter (naRd = 100001b) parameter (naCn = 100003b) logical*2 xftty common /datc/ datc equivalence (xl(2),cw) integer*2 Cnf(CnfSiz) logical*2 fmxc integer*2 imxc,syuc,timc,trgc,v17c integer*2 c30c,c33c,c34c,s30c,s33c,s34c equivalence (fmxc,imxc,Cnf(fmx)),(syuc,Cnf(syu)) equivalence (timc,Cnf(tim)),(trgc,Cnf(trg)),(v17c,Cnf(v17)) equivalence (c30c,Cnf(c30)),(c33c,Cnf(c33)),(c34c,Cnf(c34)) equivalence (s30c,Cnf(s30)),(s33c,Cnf(s33)),(s34c,Cnf(s34)) ! The following are equivalences to cfg (in kercnf.ftni) character*6 pnam,snam character*4 dnam,inam integer*2 drev,dvt6,dvad,irev,frev integer*2 cn17,cn22,cn30,cn31,cn33,cn34,dv20 equivalence (dnam, cfg(1)),(drev, cfg(4)),(dvt6, cfg(5)) equivalence (dvad, cfg(6)),(inam, cfg(7)),(irev,cfg(10)) equivalence (frev,cfg(11)),(pnam,cfg(12)),(snam,cfg(15)) equivalence (cn17,cfg(18)),(cn22,cfg(19)),(cn30,cfg(20)) equivalence (cn31,cfg(21)),(cn33,cfg(22)),(cn34,cfg(23)) ! cfg words 24-31 are currently (rev 4.1) spares equivalence (dv20,cfg(32)) !Statement function: sc(j) = ixget(j) .and. 77b !Get/isolate a select-code eqx(j) = ixget(j+8) .and. 377b !Get/isolate the EQTX size ! This routine differs from its RTE-A counterpart in that the ! determination of the interface type is different. j = opsy() !Get the operating-system type if (j .ne. -17) then call tpFm('Aborting - not set up for this system!') call exec(6) endif Cnf = 0 Call MoveWords(Cnf,Cnf(2),CnfSiz-1) !Clear the configuration array syuc = LuTru(LU) !Get system LU xl = syuc .or. 100000b !Set session override for XLUEX imxc = 0 !Preset to 'not a mux' if (xla(datc) .lt. 2440) then !timeout bit moved at rev 2440 rtoBit = 7 else rtoBit = 0 endif if ( xftty(xl) ) then !If interactive... cw = 60600b !see if we can do SSR call xluex(naCn,xl,-2,*10) !No-abort special dynamic status call abreg(a,b) !Get the return flag if (b .ne. 123456b) goto 10 !Not SSR compatible cw = 3700b !Prepare for the SSR call xluex(naRd,xl,cfg,32,*30) !Do the SSR if (dnam .eq. 'DV80') then !Remains to be seen what happens imxc = 100001b rtoBit = 1 !just a guess... endif if (imxc .eq. 0) goto 20 !Not a mux? Just return to caller v17c = cn17 !Get current terminator timc = cn22 !Current time-out value c30c = cn30 !Current CN30 value c33c = cn33 !Current CN33 value c34c = cn34 !Current CN34 value endif goto 20 ! We come here if the LU is interactive but the driver won't do SSR. ! We decide it is a MUX LU if there are 3 or more EQTs using the ! same select-code (Don Wright: thanks for that idea!). We must also ! eliminate DVV00 LUs, so each of the LUs using the same select-code ! must also have an EQT-extension of more than 13 words. Sad to say, ! once DVM00 is happy with the EQTX size, it clears that word, so we ! must also allow the EQTX size to be zero! 10 call exec(13,LU,a,b) !Get the EQT4 value in "b" b = b .and. 77b !Isolate the select-code eqta = IxGet(1650b) + 3 !Point to 1st EQT4 word a = 0 !Clear the loop counter do j = 1,IxGet(1651b) !Loop through the EQT table if (sc(eqta) .eq. b) then !Same select-code? z = eqx(eqta) !Get the EQT-extension size if (z.gt.13 .or. z.eq.0) > a = a + 1 endif eqta = eqta + 15 !Bump to next EQT4 end do if (a .lt. 3) goto 20 !probably not a mux imxc = 100000b !Flag as KERMIT-useable eqta = IxGet(1652b) + syuc - 1 !Find my DRT entry eqta = IxGet(eqta) .and. 377b !Find my EQT-number eqta = IxGet(1650b) + (eqta-1)*15 !Find my EQT entry timc = abs(IxGet(eqta+13)) !Get current timeout value eqxa = IxGet(eqta+12) !Get my EQT-extension address c30c = IxGet(eqxa + 4) !Get the current CN30 value c33c = IxGet(eqxa + 5) !Get the current CN33 value if (iand(c33c,177760b) .eq. 0) then !any cn33 configuration set up? c33c = c33c .or. 52500b !No - set power-on defaults endif !Note: the cn34 parameter isn't needed with 12792B/C muxes 20 call MoveWords(c30c,s30c,3) !Copy current values to saves call MoveWords(cnf,CnfArr,CnfSiz) !Copy config back to caller return 30 call tpFm('Aborting: SSR-compatible driver rejected the SSR') call quit end subroutine LogOff ,<881219.1353> >6/Log the server off implicit none include kercom.ftni,NOLIST !Needed for system integer*2 sess,Eqt,EqTypA,EqTyp,junk,err,ime(3) integer*2 LuTru,LuSes,LogLu,ixget integer*2 drt,eqta character*6 me equivalence (me,ime) ! This routine differs from its RTE-A counterpart in that the jobs ! performed by the log-off program are completely different under ! RTE-A and under RTE-6. Further, CLGOF doesn't exist for RTE-6! sess = LuTru( L ) !Get our true terminal LU# ! Trace down the EQT entry for this session - we will be modifying ! the device type so that it doesn't look interactive. drt=ixget(1652b) $ eqta=ixget(1650b)!Locate system tables Eqt = ixget(drt+sess-1) .and. 377b !Get our EQT# EqTypA = (Eqt - 1) * 15 + eqta + 4 !Locate device-type word junk = ixget(EqTypA) !Get current device-type word EqTyp = junk .and. 37400b !Isolate current device-type junk = junk .or. 37400b !Turn us into an instrument... call ixPut(EqTypA,junk) !...now! call clgof(sess,1,err) !Log us off now junk = ixget(EqTypA) .xor. 37400b .or. EqTyp call ixPut(EqTypA,junk) !Restore device-type word call pname(ime) !Who am I call ShootProg(me,'8') !Commit suicide end subroutine clgof(sess,dum1,dum2) ,<881219.1353> >6/Perform programmatic log-off implicit none ! CLGOF logs the session indicated by SESS off. ! ! This routine differs from the versions submitted to the CSL by ! Don Wright and Bill Donze in that the shutdown of any programs ! running in the session is performed here, and not in LGOFF (as ! it would otherwise be). If the caller of this routine has ! a) DeTACHed from the session and ! b) set the device-type of the user's terminal to a non- ! interactive type ! then it is possible to perform a completely "silent" log-off ! (i.e., no messages will be emitted to the user's terminal). ! BE SURE TO RESTORE THE TERMINAL'S DEVICE TYPE! ! ! Note -- this code was obtained originally by disassembling the ! appropriate code from RTE-A (of all things) to find out what ! operations were done by CLGOF there. I reasoned that I could ! perform similar operations under RTE-6, and a look at LGOFF ! verified the methods used here. integer*2 sess !Formal parameters integer*2 dum1,dum2 !(for RTE-A compatibility) integer*2 lgof,lgcl,dscs !External stuff $alias /lgof/ = '$LGOF', NoAllocate $alias xla = '.XLA', direct common /lgof/ lgof common /LogOffInfo/ scba,sessn,idad integer*2 xla,LUSes,LogLU,LUTru,TrimLen,GetMySons integer*2 scba,sessn,idad integer*2 junk,temp,p1,p2,p3 !Local stuff integer*2 myses,cclas,prog(3),ime(3) logical*2 fses character*5 pgnam,me equivalence (pgnam,prog),(me,ime) ! The RTE-A equivalent to this code is furnished by the system. myses = LuTru(LogLu(junk)) !Get my session# call pname(ime) sessn = sess !...and passed session# if (sessn .eq. myses) call dtach !Get out of LGOFF's way lgcl = xla(lgof) !Get LGOFF's class# if (lgcl .eq. 0) return !Session not available lgcl = lgcl .or. 20000b !Set 'no deallocate' bit scba = LuSes(sessn) !Get the SCB address if (scba .eq. 0) return !No such session? Just return! ! The following loop terminates all programs running in the given ! session except: ! My caller (in case we didn't actually detach...) ! D.RTR/SMP (special cases - they clean themselves up) p2 = 0 !Initialize for program-search do while (GetMySons(prog,p2,fses) .ne. 0) if (pgnam .eq. 'D.RTR') goto 10 if (pgnam .eq. 'SMP') goto 10 if (pgnam .eq. me) goto 10 if ( fses ) then !Normal program in session? call ShootProg(pgnam,'8') else call ShootProg(pgnam,'1') !A "system utility" endif 10 end do cclas = 0 !Insure we allocate a class# call exec(18,0,0,0,0,0,cclas) !Write to new comm class ! Tell LGOFF to log off the given session call exec(100024b,0,cclas,1,sessn+20000b,scba,lgcl,*999) ! Get messages from LGOFF until LGOFF is done. 20 call exec(100025b,cclas+20000b,junk,0,p1,p2,p3,*999) if (p3 .ne. 1) goto 20 !Must be class read or write/read if (p2 .gt. 0) goto 20 !Ignore class-writes/-controls call clrq(2,cclas) !Release the class# 999 return end integer*2 function GetMySons(pgnam,idno,fses) ,<881219.1353> >6/Find Session Programs implicit none integer*2 pgnam(3),idno !My parameters logical*2 fses integer*2 ixget !Externals common /LogOffInfo/ scb,sessn,idad integer*2 scb,sessn,idad integer*2 keywd,temp !Local stuff ! The RTE-A equivalent to this code is furnished by the system. keywd = ixget(1657b) !Get ID-segment table pointer GetMySons = 0 !Prepare for pessimistic result fses = .true. !Assume program is in session 10 idad = ixget(keywd + idno) !Get an ID-segment address if (idad .eq. 0) return !End of ID-segment table - done idno = idno + 1 !Prep for next iteration temp = ixget(idad + 14) !Get the ID-segment status if (.not. btest(temp,4) ) then !If this is a long ID-segment temp = ixget(idad+32) !Get the SCB pointer from it if (scb .eq. temp) then !If it matches the target pgnam = ixget(idad+12) !...get progname (1st word) pgnam(2) = ixget(idad+13) !...get progname (2nd word) pgnam(3) = ixget(idad+14) .and. 177400b .or. 40b GetMySons = 1 !Flag success temp = ixget(idad+31) .and. 377b fSes = temp .eq. sessn !Flag program in session return endif endif goto 10 end subroutine ShootProg(name,how) ,<881219.1353> >6/Quietly kill a program implicit none character*(*) name,how integer*2 buf(7),TrimLen,p character*13 cBuf equivalence (buf,cbuf) ! The RTE-A equivalent to this routine is furnished by RTE-A p = TrimLen(name) cbuf = 'OF,' // name(:p) // ',' // how // ',NP' call messs(buf,13) return end integer*2 function WhoLockedLu(LU) >, 92084-1Y013 REV 2718 870506 implicit none ! This source was obtained via disassembly of the system routine of the ! same name. As of the 4.1 system revision, the original system routine ! caused its caller to be non-transportable; this is fixed here: ! The original WhoLockedLu used "AddressOf($RNTB)" via an alias to ! obtain the true address of the Resource Number table. ! By going one level indirect using "XLA($$RTB)" also via an alias ! to retrieve this address, the code becomes transportable. $alias /rntb/ = '$$RTB', NoAllocate $alias xla = '.XLA', direct integer*2 rntb common /rntb/ rntb integer*2 LU integer*2 drt,lumax,drt3,LockWord,LockerRN,LockerIDNo integer*2 IxGet,IDNumberToAdd,xla ! WhoLockedLu = 0 !Preset return value drt = ixget(1652b) !Locate the Device Reference Table lumax = ixget(1653b) !...and the size of it if (LU .gt. lumax) return !Return if illegal LU drt3 = drt + lumax*2 !Locate DRT part 3 LockWord = IxGet( ((LU-1)/2)+drt3 ) !Get word with lock for this lu if (iand(LU,1) .ne. 0) then !Upper or lower byte? LockerRN = ibits(LockWord,8,8) !Odd LU uses upper byte else LockerRN = ibits(LockWord,0,8) !Even LU uses lower byte endif if (LockerRN .eq. 0) return !Quit if not locked LockerIDNo = ixget(xla(rntb) + LockerRn) .and. 377b WhoLockedLu = IDNumberToAdd(LockerIDNo) return end subroutine IDAddToName(idaddr,PrgName,lu) >, 92084-1Y013 REV 2718 870506 implicit none ! The source for this routine was obtained via disassembly of the system ! routine of the same name. As of the 4.1 system revision, this routine ! did not provide the ID-segment's session info; it is fixed here! integer*2 idaddr,PrgName(*),lu,IxGet PrgName(1) = IxGet(idaddr+12) PrgName(2) = IxGet(idaddr+13) PrgName(3) = IxGet(idaddr+14) .and. 177400b .or. 40b lu = IxGet(idaddr+31) .and. 377b !870506-ps return end