SECTION "emulate-3277-1"

GET "libhdr"
GET "etherhdr"
GET "sim3270hdr"
GET "em3277hdr"

    /* This command uses the SIM3270 package of routines
       to emulate a 3277 model II terminal. It connects to
       the E-net task. The console must be a Cifer 2600
       series terminal.

       At startup it:  connects to the E-net task,
                       holds the console handler,
                       loads its own console dcb and driver.
    */

LET start() BE
$( LET ech = ?
   cdriv, cdcb := 0, 0
  restart:
   startt()       // the main program

   // does the user wish to have another go?
   writes("*NType C to reconnect, E to finish ->  *E")
   ech := capitalch(rdch()) REPEATUNTIL ech='C' | ech='E'
   IF ech='C' GOTO restart
   unloadseg(cdcb)
   newline()
$)


AND startt() BE
$( LET rti = rootnode!rtn.info
   LET hd.txbv = VEC 11
   LET hd.rxb1v = VEC 11
   LET hd.rxb2v = VEC 11
    // pkts for console devices
   wpkt1 := TABLE -1, 0, act.ttyout, 0, 0, 0
   wpkt2 := TABLE -1, 0, act.ttyout, 0, 0, 0
   rpkt := TABLE -1, kdev, act.ttyin, 0, 0, 0
    // pkts for E-net task
   etxp := TABLE -1, 0, act.write, 0, 0, 0, 0, 0, 0
   erxp1 := TABLE -1, 0, act.read, 0, 0, 0, 0, 0, 0
   erxp2 := TABLE -1, 0, act.read, 0, 0, 0, 0, 0, 0
   wpkt1.back := TRUE
   wpkt2.back := TRUE
   hd.txb := hd.txbv
   hd.rxb1 := hd.rxb1v
   hd.rxb2 := hd.rxb2v
   err.p := level()
   err.l := exit
   exstring := "normal end"

   vv := getvec(2500+800+2*960+(circbufsize/bytesperword+1))
   cdev := 0
   hwbufp, hrbufp := 0, 0
   etxpback := TRUE
   pendingq := 0
   ttyp, outp := 0, 0

   etsk := rti!rtninfo.ether

   IF vv=0 DO
   $( err("*NNot enough room for buffers*N")
      stop(5)
   $)

   hold(task.consolehandler)

   IF rti=0 | etsk=0 DO
   $( err("Load E-net handler!")
      stop(7)
   $)

    // Now load and create new console (display) device
    // tramples over but remembers old interrupt vector

   IF cdcb=0 DO     // after first time already loaded
   $(
   cdcb := loadseg("sys:ether.3270-dcb")
   cdriv := loadseg("sys:ether.3270-driver")
   $)

   IF cdcb=0 | cdriv=0 DO
   $( err("Can*'t load device files")
      stop(9)
   $)

   !cdcb := cdriv    // link to driver

   cdev := createdev(cdcb)     // create new console device
   IF cdev=0 DO
   $( err("Can*'t create console device")
      stop(11)
   $)

   // Package initialisation ***********************
   cba, currat, aid, ca, la := 0, 0, 0, 0, -1
   escing := FALSE
   last.PT.nulling := FALSE
   errstream := output()
   highlighting := FALSE
   insert.mode.on := FALSE
   /***********************************************/

   wpkt1!pkt.id := cdev; wpkt2!pkt.id := cdev

   // assign data parts of E-net bbs
   etx := vv
   erx1 := vv+150
   erx2 := erx1+150
   write.buffer := erx2+150
   read.buffer := write.buffer+1000
   // More Package initialisation *****************
   listp := read.buffer+1000
   dba := listp+800
   dbb := dba+960
   circbuf := dbb+960
   minlistp := listp
   maxlistp := listp+798
   FOR i = 0 TO 959 DO dba!i, dbb!i := 0, 0
   FOR i = 0 TO 799 DO listp!i := 0
   /***********************************************/

   etxp!pkt.arg1 := hd.txb
   etxp!pkt.arg2 := etx
   erxp1!pkt.arg1 := hd.rxb1; erxp2!pkt.arg1 := hd.rxb2
   erxp1!pkt.arg2 := erx1; erxp2!pkt.arg2 := erx2
   hd.txb%e.dest := 2 // 3032

   $( LET mp = sendpkt(-1, etsk, act.findfreeport, ?, ?, ?)
      hd.rxb1%e.port1 := mp >> 4
      hd.rxb2%e.port1 := mp >> 4
      hd.rxb1%e.port2 := mp << 4
      hd.rxb2%e.port2 := mp << 4
      hd.txb%e.port1 := 0
      hd.txb%e.port2 := (2 << 4) | (mp >> 8)
      hd.txb%e.port3 := mp
      hd.txb%e.source := 1
   $)

   // send receive pkts to E-net task
   erxp1!pkt.id := etsk
   erxp2!pkt.id := etsk
   qpkt(erxp1); qpkt(erxp2)

   // initiate connection
   etxp!pkt.id := etsk
   etx%0 := t.initiate
   hd.txb%e.len1 := 0
   hd.txb%e.len2 := 1
   qpkt(etxp)

   $( LET p = taskwait()
      IF p!pkt.type=act.write & (p!pkt.res1~=0) DO
      $( exstring := "E-net error on initiate"
         longjump(err.p, err.l)
      $)

      UNLESS p!pkt.type=act.read DO $( append(p); LOOP $)
      UNLESS (p!pkt.arg2)%1=0 GOTO exit // initiate failed
      qpkt(p)

      remote.port := (p!pkt.arg1)%e.port3 |
                     (((p!pkt.arg1)%e.port2 & #XF)<<8)
      hd.txb%e.port1 := remote.port>>4
      hd.txb%e.port2 := (hd.txb%e.port2 & #XF) | (remote.port << 4)
      BREAK
   $) REPEAT

   // enter data transfer phase

   qpkt(rpkt)    // q receive character pkt on device
   setup.display()

   $( LET p = wait.for.pkt()     // wait for something to happen

      SWITCHON p!pkt.type INTO
      $(S1 DEFAULT:
            qpkt(p); ENDCASE

         CASE act.ttyin:
            $( LET ich = p!pkt.res1 & #X7F
               LET res2 = p!pkt.res2
               qpkt(p)
               IF res2=0 DO handle.ch(ich)
               ENDCASE
            $)

 /*$$$$
         CASE act.ttyout:
            TEST p=wpkt1 DO wpkt1.back := TRUE
                         OR wpkt2.back := TRUE
            ENDCASE
 $$$$*/

         CASE act.ttyout:
            ttyp := ttyp+1
            IF ttyp=circbufsize DO ttyp := 0
            UNLESS ttyp=outp DO
            $( p!pkt.arg1 := circbuf%ttyp
               qpkt(p) $)
            ENDCASE

         CASE act.timer:
            // timer packet from terminate has returned so finish
            BREAK

         CASE act.read:
            $( LET hd = p!pkt.arg1
               LET blk = p!pkt.arg2
               LET t = blk%0

               UNLESS p!pkt.res1=0 DO
               $( qpkt(p)
                  exstring := "E-net task dying?"
                  BREAK
               $)

               SWITCHON t INTO
               $(S2 DEFAULT:
                  CASE t.terminate:
                     qpkt(p)
                     keyboard.restore()
                     unsetup.display()
                     exstring := "terminated!"
                     $( // wait for two seconds to allow circular buffer
                        // to be cleared
                        LET tpkt = TABLE -1, -1, act.timer, 0, 0, 100
                        qpkt(tpkt)
                     $)
                     ENDCASE

                  CASE t.write:   // the usual case
                     $( LET m = blk%1 // more data marker
                        LET len = (blk%2 << 8) | blk%3

                        movebytes((blk<<1)+4,(write.buffer<<1)+hwbufp,len)
                        hwbufp := hwbufp+len

                        qpkt(p)

                        IF m=0 DO
                        $( LET blen = hwbufp-1
                           hwbufp := 0
                           host.update((write.buffer<<1) +1, blen,
                                       write.buffer%0)
                        $)
                     $)
                     ENDCASE

                  CASE t.read.modified:
                     qpkt(p)
                     read.modified()
                     ENDCASE

                  CASE t.read.buffer:
                     qpkt(p)
                     read.buff()
               $)S2
               ENDCASE

            CASE act.write:  // a write block has returned
                             // (read mod and read buf wait for
                             //  their write pkts themselves)
               etxpback := TRUE
               UNLESS p!pkt.res1=0 DO
               $( exstring := "E-net error on write!"
                  BREAK
               $)
         $)S1
      $) REPEAT   // keep getting pkts

  exit:


   dqpkt(kdev,rpkt)
   dqpkt(cdev,wpkt1)
   dqpkt(cdev,wpkt2)
   dqpkt(etsk,erxp1)
   dqpkt(etsk,erxp2)

   UNLESS etxpback DO
   $( LET p = wait.for.pkt()
      UNTIL p!pkt.type=act.write DO p := wait.for.pkt()
   $)

   $( LET cp0 = TABLE -1, 0, act.cancel.rx, 0, 0, 0
      LET cp = ?
      cp0!pkt.id := etsk
      qpkt(cp0)
      cp := wait.for.pkt()
      UNTIL cp!pkt.type=act.cancel.rx DO cp := wait.for.pkt()
   $)
   deletedev(cdev)    // replaces interrupt vector with original
   release(task.consolehandler)
   freevec(vv)
   writef("*N%S*N", exstring)
$)


AND err(s) BE
$( freevec(vv)
   release(task.consolehandler)
   UNLESS cdev=0 DO deletedev(cdev)
   !cdcb := 0
   UNLESS cdriv=0 DO unloadseg(cdriv)
   UNLESS cdcb=0 DO unloadseg(cdcb)
   writef("*N%S*N", s)
$)


.
SECTION "emulate-3277-2"
GET "libhdr"
GET "etherhdr"
GET "sim3270hdr"
GET "em3277hdr"


LET append(p) BE
$( LET q = @pendingq
   UNTIL !q=0 DO q := !q
   !p := 0
   !q := p
$)


AND wait.for.pkt() = VALOF
$( UNLESS pendingq=0 DO
   $( LET pk=pendingq
      pendingq := !pendingq
      !pk := -1
      RESULTIS pk
   $)
   RESULTIS taskwait()
$)


  // Routine used by Package to send buffer
  // (for E-net may have to send more than one bb)
AND send(n) BE
$( LET nthis = 0
   LET off = 0

   $( // REPEAT loop
      LET wp = wait.for.write()

      FOR i = 4 TO 270 DO
      $( IF nthis+1>n BREAK
         etx%i := read.buffer%off
         off := off+1
         nthis := nthis+1
      $)

      etx%2 := nthis>>8
      etx%3 := nthis
      etx%1 := nthis<n -> 1, 0
      etx%0 := t.read.modified
      hd.txb%e.len1 := (nthis+4)>>8
      hd.txb%e.len2 := nthis+4
      etxpback := FALSE
      qpkt(etxp)
      IF nthis>=n BREAK
      n := n-nthis
      nthis := 0
   $) REPEAT
$)


  // Routine used by send
AND wait.for.write() = VALOF
$( // waits for write pkt to return from E-net task
   LET p = @pendingq
   IF etxpback RESULTIS etxp

   UNTIL !p=0 DO
   $( IF(!p)!pkt.type=act.write DO
      $( LET rp=!p
         !p := !rp
         !rp := -1
         RESULTIS rp
      $)
      p := !p
   $)

  // None on pendingq so wait for something on work queue
   $( p := taskwait()
      IF p!pkt.type=act.write RESULTIS p
      append(p)
   $) REPEAT
$)


  // Routine used by Package to write to terminal
 /*$$$$
AND outch(ch) BE
$( LET p = ?
   LET rp = ?
   ch := ch&#X7F

   IF wpkt1.back DO
   $( wpkt1.back := FALSE
      wpkt1!pkt.arg1 := ch
      qpkt(wpkt1)
      RETURN
   $)

   IF wpkt2.back DO
   $( wpkt2.back := FALSE
      wpkt2!pkt.arg1 := ch
      qpkt(wpkt2)
      RETURN
   $)

  // wait for pkt to return
   p := @pendingq
   rp := !p
   UNTIL rp=0 DO
   $( IF rp!pkt.type=act.ttyout DO
      $(
         !p := !rp
         !rp := -1
         rp!pkt.arg1 := ch
         qpkt(rp)
         RETURN
      $)
      p := rp
      rp := !p
   $)

  // None on pendingq so wait
   $( p := taskwait()
      IF p!pkt.type=act.ttyout DO
      $( p!pkt.arg1 := ch
         qpkt(p)
         RETURN
      $)
      append(p)  // put on pendingq
   $) REPEAT
$)
 $$$$*/

AND outch(ch) BE
$( circbuf%outp := ch
   IF ttyp=outp DO
   $( wpkt1!pkt.arg1 := ch
      qpkt(wpkt1)
   $)
   outp := outp+1
   IF outp=circbufsize DO outp := 0
   IF outp=ttyp DO // buffer full! miss a character
   $( ttyp := ttyp+1
      IF ttyp=circbufsize DO ttyp := 0
   $)
$)


AND user.terminate() BE
$( wait.for.write()
   etx%0 := t.terminate
   hd.txb%e.len1 := 0
   hd.txb%e.len2 := 1
   etxpback := FALSE
   qpkt(etxp)
   $( LET tp = TABLE -1, -1, act.timer, 0, 0, 100
      qpkt(tp)
   $)
$)