! Version of Mar 87
%option "-low-nocheck-nodiag-noline-nostack"
%include "moose:mouse.inc"
%systemstring(127)%fnspec itos (%integer x,y)

! Physical stuff
%constant %integer boardaddr = 16_7FFC0    ;! Change as appropriate

%recordformat DEVICE FM(%byte bstatus,data,intvec,dstatus,x,mode,y,command)
@boardaddr %record(device fm) dev

%constant %integer mode1=16_4e,mode2=16_30,comm=16_37
%constant %integer txie=1,rxie=2,reset=8
%Constinteger rion=2, tion=3 ,tioff=rion

%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
%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 = 1024-1              { 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)

%Routine Psymr (%Integer sym)
   %Integer k,t,a
   %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
      dev_bstatus = tion
   %finish
%End

%Routine psym (%Integer sym)
   %if opbuff_gotsem=0 %or gotit=0 %Start
      semaphorewait(outmutex) 
      opbuff_gotsem = 1
      gotit = 1
   %Finish
   psymr(sym)
%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 qtestsymbol
   %integer k
   %record(semaphorefm)%name sem

   sem == record(kbbuff_notempty)
   k = extract character
   sem_count = sem_count - 1 %if k # -1
   %result = k
%End

%Ownstring(12) context=""

%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

%externalrecord(scb fm)%map open %alias "q_open" -
  (%integer mode, %string(255)file)
%record(scb fm)%name scb
%integer x,t,tmode

  %routine refresh(%record(scb fm)%name scb)
    %integer k,i, mode
    %label release mutex

    %routine put(%integer x)
      %returnif scb_l=scb_bl
      byteinteger(scb_l) = x; scb_l = scb_l+1
    %end

    scb_p = scb_bs; scb_l = scb_bs
    k = rsym
    %signal 9,,,"End of file" %if k = 26
    put (k)
  %end

  %routine flush(%record(scb fm)%name scb,%integer sym)
     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 ("Q_MUTEX_IN",poa_logdict)
      %Signal 3,0,0,"Failed to find Q_MUTEX_IN" %if t=0
      inmutex  == record(integer(t))       
      t = Find Entry ("Q_MUTEX_OUT",poa_logdict)
      %Signal 3,0,0,"Failed to find Q_MUTEX_OUT" %if t=0
      outmutex == record(integer(t))
      t = Find Entry ("Q_OP_BUFFER",poa_logdict)
      %Signal 3,0,0,"Failed to find Q_OP_BUFFER" %if t=0
      opbuff==record(integer(t))
      notfull  == record(opbuff_notfull)
      t = Find Entry ("Q_KB_BUFFER",poa_logdict)
      %Signal 3,0,0,"Failed to find Q_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