! Version of Mar 87
option "-low-nocheck-nodiag-noline-nostack"
include "moose:mouse.inc"
@16_4000c0 byte *,acia s,*,acia d
constinteger buffer size = 128
constinteger cr=13,eot=4,esc=27,bs=8,del=127,etx=3,dle=16,bel=7
constinteger noecho=1,notermecho=2,single=4,nopage=8,frozen=16
externalinteger terminalmode=0
externalinteger terminalmask=0
externalinteger terminatormask=1<<nl
constinteger pagesize=24
owninteger linesleft=pagesize-1
owninteger initialised = 0
Owninteger gotit = 0
OwnRecord (semaphorefm)name inmutex,outmutex
Ownrecord (semaphorefm)name notfull
Ownrecord (semaphorefm)name notempty
Constinteger kbbs = 512-1
Recordformat kb buff fm(Integer sem,bs,be,in,out,notempty,
Bytearray buff(0:kbbs),integer op)
ownrecord (kbbufffm)name kb buff
Constinteger opbs = 1024-1
Recordformat op buff fm(Integer notfull,bs,in,out,
bytearray buff(0:opbs),integer code,ctrlo,
Integer xonsem, integer xonflag, integer gotsem)
Ownrecord (opbufffm)name op buff
systemroutinespec phex (Integer x)
Externalroutine set terminal mode (Integer x)
terminal mode = x
End
Routine Psymr (Integer sym)
Integer k,t,a
Returnif opbuff_Ctrlo=1
if opbuff_xonflag = 1 start
Semaphore wait (record(opbuff_xonsem))
finish
a = (opbuff_in&opbs)+opbuff_bs
t = opbuff_in
byteinteger(a) = sym
opbuff_in = t+1
semaphore wait (notfull) while opbuff_in-opbuff_out = opbs-20
if t = opbuff_out start
acias =16_B1
finish
End
Routine psym (Integer sym)
if opbuff_gotsem=0 or gotit=0 Start
semaphorewait(outmutex)
opbuff_gotsem = 1
gotit = 1
Finish
psymr(sym)
If sym = NL or sym = 0 start
opbuff_gotsem=0
gotit =0
signal semaphore (outmutex)
Finish
End
Integerfn Extract Character
Integer t,k
t=kbbuff_out
If kbbuff_in # t start
k=byteinteger(t)
t=t+1
t=kbbuff_bs if t=kbbuff_be
kbbuff_out=t
Result =k
Else
Result = -1
Finish
End
externalintegerfn testsymbol
integer k
k = extract character
k=k!!(cr!!nl) if k=cr or k=nl
result = k
End
Integerfn rsym
! This should be rewritten once there is no signal per character
integer k
Cycle
semaphore wait (record(kbbuff_notempty))
k = extract character
repeatuntil k # -1
Result = k
End
Routine cancel ctrlo
opbuff_ctrlo = 0
End
!%Externalroutine screen put (%Integer x)
! psym(x)
!%End
externalroutine release terminal
putstring("Rel")
if gotit # 0 start
putstring("eased")
opbuff_gotsem=0
gotit =0
signal semaphore (outmutex)
finish
End
externalrecord (scb fm)map open alias "t_open" -
(integer mode, string (255)file)
record (scb fm)name scb
integer x,t
routine refresh(record (scb fm)name scb)
integer k
routine put(integer x)
returnif scb_l=scb_bl
byteinteger(scb_l) = x; scb_l = scb_l+1
end
semaphore wait (inmutex)
cancel ctrlo
scb_p = scb_bs; scb_l = scb_bs
linesleft = pagesize-1
if scb_a#0 start
psym(byteinteger(scb_a+k)) for k = 1,1,byteinteger(scb_a)
finish
signal semaphore(outmutex) and opbuff_gotsem=0 if opbuff_gotsem=1
cycle
k = rsym
k = k!!(cr!!nl) if (k=cr or k=nl) {%and terminalmode&single=0}
put(k) and signalsemaphore(inmutex) and -
returnif terminalmode&single#0 or -
(k&31=k and 1<<k&terminalmask#0)
signalsemaphore(inmutex) andreturnif k=etx
signalsemaphore(inmutex) and signal 0,1,,"abort" if k='Y'-64
if k=del start
continueif scb_l=scb_p
scb_l = scb_l-1
psymr(bs) and psymr(' ') and psymr(bs) if terminalmode&noecho=0
continue
finish
if k='R'-64 start
cancel ctrlo
psym(13);psym(10)
If scb_a#0 start
psym(byteinteger(scb_a+k)) for k=1,1,byteinteger(scb_a)
finish
for k=scb_p,1,scb_l-1 cycle
psym(byteinteger(k))
Repeat
signal semaphore(outmutex) and opbuff_gotsem=0 if opbuff_gotsem=1
Continue
Finish
if k='X'-64 or k=bs start
while scb_l>scb_p cycle
scb_l = scb_l-1; psymr(bs); psymr(' '); psymr(bs)
repeat
continue
finish
if k=dle start
put(rsym); continue
finish
if k=esc start
put(esc)
k = rsym; put(k)
k = rsym and put(k) if k='?'
Continue
finish
signalsemaphore(inmutex) andsignal 9,,,"End of file" if k=eot or k='Z'-64
if k&31=k start
exitif 1<<k&terminatormask#0
psymr(bel); continue
finish
put(k); psymr(k) if terminalmode&noecho=0
repeat
put(k)
if terminalmode¬ermecho=0 start
psymr(cr) if k=nl; psymr(k)
finish
signalsemaphore(inmutex)
end
routine flush(record (scb fm)name scb,integer sym)
psym(cr) if sym=nl and terminalmode&single=0 ; psym(sym)
end
routine closin(record (scb fm)name scb)
heapput(scb_a) unless scb_a=0
heapput(scb_bs); scb_bs = 0
end
routine prompt(record (scb fm)name scb,integer stringad)
heapput(scb_a) unless scb_a=0
scb_a = 0 andreturnif byteinteger(stringad)=0
scb_a = heapget(byteinteger(stringad)+1)
{} byteinteger(scb_a-4) = 1 {HEAP frig to prevent release}
string(scb_a) = string(stringad)
end
routine service(record (scb fm)name scb,integer op,parm)
switch sw(0:7)
->sw(op&7)
sw(serclosin): closin(scb); return
sw(serclosout): return
sw(serprompt): prompt(scb,parm); return
sw(serdropout): return
sw(sersetin): return
sw(sersetout): return
sw(serrefresh): refresh(scb); return
sw(serflush): flush(scb,parm)
end
If initialised = 0 start
t = Find Entry ("T_MUTEX_IN",poa_logdict)
Signal 3,0,0,"Failed to find T_MUTEX_IN" if t=0
inmutex == record(integer(t))
t = Find Entry ("T_MUTEX_OUT",poa_logdict)
Signal 3,0,0,"Failed to find T_MUTEX_OUT" if t=0
outmutex == record(integer(t))
t = Find Entry ("T_OP_BUFFER",poa_logdict)
Signal 3,0,0,"Failed to find T_OP_BUFFER" if t=0
opbuff==record(integer(t))
notfull == record(opbuff_notfull)
t = Find Entry ("T_KB_BUFFER",poa_logdict)
Signal 3,0,0,"Failed to find T_KB_BUFFER" if t=0
kbbuff==record(integer(t))
notempty == record(kbbuff_notempty)
initialised = 1
Finish
scb == record(heapget(sizeof(scb))); scb = 0
scb_mode = mode
scb_gla = a4
*lea service,a0; *move.l a0,x
scb_serpc = x
If mode=inputmode start
*lea refresh,a0; *move.l a0,x
scb_fastpc=x
Else
*lea flush,a0; *move.l a0,x
scb_fastpc = x
Finish
scb_bs = heapget(buffersize)
scb_bl = scb_bs+buffersize
scb_fs = scb_bs
scb_fl = scb_bs
scb_p = scb_bs
scb_l = scb_bs
result == scb
end