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
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)
$)
$)