! 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&notermecho=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