subroutine SetTrap(SyRv) ,<871015.1451> >Set Fortran Trapping implicit none ! KASUBS contains routines which are specific to RTE-A. This ! revision operates with KERMIT revision 1.99a 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) ,<871015.1451> >A/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 it's RTE-6 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 !If we changed port configuration call control(lu,3000b,c30s) !...put it back endif if (c33c .ne. c33s) then !If we changed type-ahead call control(lu,3300b,c33s) !...restore that too endif if (c34c .ne. c34s) then !If we changed handshake call control(lu,3400b,c34s) !...fix it up endif if (.not. btest(Cnf,0) ) then !D-mux or B-/C-mux? call control(lu,4500b,10400b) !Restore DC1 trigger-char call control(lu,3700b,173400b) !allow echo/edit; end on CR else ! --> Need not yet established! call control(lu,1700b,c17s) !Restore terminator endif return end subroutine enable(lu,imux) ,<871015.1451> >A/Enable int-scheduling implicit none include kercom.ftni,NOLIST !Defines L include kercnf.ftni,NOLIST !Defines non-mux "trigger" integer*2 lu,iMux,dv6,if6,dp(12),p1(4),p2(4),xl(2),cw,p1s,p2s integer*2 p1a,p1b,p1c,p1d,p2a,p2b,p2c,p2d equivalence (dp(5),p1),(dp(9),p2),(xl(2),cw) equivalence (p1(1),p1a),(p1(2),p1b),(p1(3),p1c),(p1(4),p1d) equivalence (p2(1),p2a),(p2(2),p2b),(p2(3),p2c),(p2(4),p2d) ! This routine differs from it's RTE-6 counterpart in that IDM00 ! muxt keep up with the names of the interrupt-scheduled programs ! and DVM00 doesn't. if ( btest(iMux,0) ) then !D-mux? call control(lu,2000b) !Yes - just re-enable else if (lu .eq. L) then p1s = Ltrg p2s = L17v else p1s = Rtrg p2s = R17v endif xl = lu !Prepare for XLUEX call control(lu,3700b,173400b) !cn37: set read type cw = 10000b !Set the "Z-bit" call xluex(13,xl,dv6,if6,dp,12) !Get pri/sec program names call control(lu,102300b,0) !cn23: set scheduling flag if (imux .ge. 0) p1a = p1s !Restore P1a if not on mux cw = 2000b !cn20: enable primary scheduling call xluex(3,xl,p1a,p1b,p1c,p1d) if (imux .ge. 0) p2a = p2s !Restore P2a if not on mux cw = 4000b !cn40: enable secondary sched call xluex(3,xl,p2a,p2b,p2c,p2d) endif return end subroutine disable(lu,iMux) ,<871015.1451> >A/Disable int-scheduling implicit none integer*2 lu,iMux ! This routine differs from it's RTE-6 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. if ( btest(iMux,0) ) then !D-mux? call control(lu,2100b,1) !cn21: disable scheduling else call control(lu,102300b,1) !cn23: clr sched flg (to intfc) endif return end subroutine set_timeout(lu,val,iMux) ,<871015.1451> >A/Set LU timeout value implicit none integer*2 lu,val,iMux ! This routine differs from it's RTE-6 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 if ( btest(iMux,0) ) then !D-mux or B-/C-mux? call control(lu,2200b,val) !D: only one flavor of timeout else call control(lu,2700b,val) !B/C: set "user" time-out endif return end subroutine KillEnqAck ,<871015.1451> >A/Disable remote ENQ/ACK implicit none include kercom.ftni,NOLIST include kercnf.ftni,NOLIST ! This routine differs from it's RTE-6 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 call control(R,4500b,0) !cn45: set trigger-char (to none) if ( btest(r30c,7) ) then !is Enq/Ack on now? r30c = r30c .xor. 200b !Yes - turn it off call control(R,3000b,r30c) !...and send it to the port endif r33c = 22500b !Set for type-ahead 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 ,<871015.1451> >A/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 it's RTE-6 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 = 5200b !(B/C mux terminate rcv buffer) dstat = 100600b !Dynamic status bypasses dev-dvr ! Prepare the local LU for connect - allows for ASIC and 2 Mux types if ( fLmx ) then !Local on a mux? if ( fLcm ) then !Yes - if B or C mux... Lrc = 3100b !...use trans/save t-a data L33c = 22600b !Turn on local FIFO 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 local FIFO mode call control(L,3300b,l33c) endif call control(L,2600b,1) !Flush card else Lrc = 100100b !Skip device-driver + 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 = 3100b !transparent + save t-a data Rtc = 3700b !transparent + no handshake R33c = 22600b !cn33: read reconfig off call control(R,3300b,R33c) !cn33: read reconfig off 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() ,<871015.1451> >A/Read a packet implicit none include kercom.ftni,NOLIST include kercnf.ftni,NOLIST !To define fRmx integer*2 buf(128),xr(2),cw equivalence (buf,RecPkt),(xr(2),cw) ! This routine differs from it's RTE-6 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 = 103000b !B/C: no ddvr, trans, keep t-a endif xr = R !Set remote lu into control word call xluex(1,xr,buf,-254,40000b) !Get the info call abreg(GetPak,rlen) !Get the received length return end subroutine PutPak(len) ,<871015.1451> >A/Send a packet implicit none include kercom.ftni,NOLIST !Defines include kercnf.ftni,NOLIST !Defines fRmx integer*2 len,xl(2),cw,PakBuf equivalence (xl(2),cw),(Packet,PakBuf) ! This routine differs from it's RTE-6 counterpart in that we must ! bypass DD*00 and suppress handshake under RTE-A. if ( btest(iRmx,0) ) then !D-mux cw = 2000b !Yes - do transparent write else cw = 102700b !Else bypass, trans, no handshake endif xl = R !Get the remote LU call control(R,2600b,1) !Flush the card before sending call xluex(2,xl,PakBuf,-len) return end subroutine GetMux(LU,CnfArr) ,<871015.1451> >A/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 ! RTE-6: 12792 mux (or 12966 using DVW00 - see note below) ! Bit 0: set if LU uses the new serial drivers ! 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 /lut/ = '$LUTA', NoAllocate $alias opsy = '.OPSY', 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,lut,dvta,dvxa integer*2 LuTru,AddressOf,IxGet,opsy integer*2 naRd,naCn parameter (naRd = 100001b) parameter (naCn = 100003b) logical*2 xftty common /lut/ lut 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)) ! This routine differs from it's RTE-6 counterpart in that ! determination of the interface type is different. j = opsy() !Get the operating-system type if (j.ne.-53 .and. j.ne.-37 .and. j.ne.-61) 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' rtobit = 1 !Set the time-out bit for RTE-A 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 (inam .eq. 'ID80') then !We have a "D" mux! imxc = 100001b endif if (inam .eq. 'ID40') then !See if maybe it's A400 OBIO imxc = 100003b 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: ! It has 12 driver parameters (eliminates IO-mapped LUs) ! It has 57 DVT-extension words (eliminates ASIC LUs) ! DVP1 has bit 2 set (further eliminates ASIC LUs) 10 dvta = AddressOf(lut) !Get address of $LUTA dvta = IxGet(dvta) !Get the address of the LUT dvta = IxGet(dvta + syuc - 1) !Get LU's DVT address !1.99a dvta = IxGet(dvta) !Get the DVT address a = IxGet(dvta + 20) !Get DVP/DVX size word b = a .and. 777b !Isolate the DVX size a = ibits(a,9,7) !...and the DVP size if (a .ne. 12) goto 20 !Terminals have 12 DVP words timc = abs(IxGet(dvta+28)) !Get the current timeout value if (b .ne. 57) then !MUX (IDM00) has 57 DVX words trgc = IxGet(dvta + 29) !Capture 1st word of pri prog name v17c = IxGet(dvta + 33) !...and 1st word of sec prog name goto 20 endif a = IxGet(dvta + 25) !Get Driver Parameter #1 if (.not. btest(a,2)) goto 20 !DVP1 bit 2 must be set imxc = 100000b !Flag as KERMIT-useable trgc = IxGet(dvta + 27) !Get the current trigger-character dvxa = IxGet(dvta + 21) !Get DVT-extension address c30c = IxGet(dvxa + 40) !Get the current CN30 value c33c = IxGet(dvxa + 39) !Get the current cn33 value if (iand(c33c,177760b) .eq. 0) then !any configuration setup? c33c = 52500b !No - set power-on defaults endif !Note: the cn34 parameter isn't needed with 12040B/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 ,<871015.1451> >A/Log the server off implicit none integer*2 sess,err,usnum ! This routine differs from it's RTE-6 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 = usnum() !Get the session number call Clgof(sess,2,err) !Go to background (suppress msgs) sess = usnum() !My session# has changed call Clgof(sess,1,err) !Now kill everything off. call exec(6) !(...and die, just in case) end