%include "mouse.inc"
%option "-nocheck"

%externalstring(127)%fnspec itos (%integer x,y)
%Constinteger nfiles = 20

!%Recordformat filefm (%Integer flags,%Record(scbfm)%Name scb) for mouse
%Recordformat filefm (%Integer streamno,mode)

%ownrecord(filefm)%array files (0:NFILES) =0(*)

%Routine debug (%String(255) s)
!   selectoutput(0)
!   printstring(s)
!   newline
%End

%Routine Setup IO
   %Integer i
   files(0)_streamno = 0; files(0)_mode = inputmode
   files(1)_streamno = 0; files(1)_mode = outputmode
   files(2)_streamno = 0; files(2)_mode = outputmode
   %for i = 3,1,nfiles %cycle
      files(i)_mode = -1
      files(i)_streamno = i-2
   %Repeat
   prompt("")
   debug("IO Setup")
%End

%Externalinteger ErrNO %Alias "C_ERRNO" = 0

%Ownstring(255) clis 
%ownintegerarray argptrs (1:20)
%ownstring(5) argmain = "main"
%Owninteger argc,argv

%Routine Parse
   %integer p, l, i

   clis = cliparam
   charno(argmain,5) = 0
   argptrs(1)=addr(argmain)+1
   l = length(clis)
   p = 1
   argc = 1
   %cycle
      %exit %if p > l
      p = p + 1 %andcontinueif charno(clis,p) = ' '
      argc = argc + 1
      argptrs (argc) = addr(charno(clis,p))
      p = p + 1 %while p <= l %and charno(clis,p) # ' '
      charno(clis,p)=0; p=p+1 %unless p > l
   %repeat
   argv = addr(argptrs(1))
%End

%Externalroutine Start
   %Integer c
   
   %Routine Go
!      %on 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15 %start
!         Printstring("Event_no  =");write(event_event,0);newline
!         Printstring("Event_mess=".event_message);newline
!         %Return
!      %Finish

      *move.l argv,-(sp)
      *move.l argc,-(sp)
      *move.l c,a0
      *jsr (a0)
   %End

   *move.l a0,c
   debug("Image Startup")
   parse 
   setup IO
   go
   debug ("Image rundown")
   %Stop
%End

%Externalintegerfn EXIT (%integer reason)
   debug("+EXIT called+")
   %Signal 1,1,1,"_exit called"
%End

%Externalintegerfn SIGNAL
   debug("+Signal called+")
   %result = -1
%End

%Externalintegerfn BRK (%integer addr)
   debug("+Brk called+")
   %result = -1
%End

%Externalintegerfn EXECL (%integer name,argl)
   debug("+EXECL called+")
   %Result = -1
%End

%Externalintegerfn EXECV (%Integer name, argv)
   debug("+EXECV called+")
   %Result = -1
%End

%Externalintegerfn EXECLE (%integer name,argl)
   debug ("+EXECLE called+")
   %Result = -1
%End

%Externalintegerfn FORK
   debug  ("+FORK called+")
   %Result = -1
%End

%Externalintegerfn GETUID
   debug ("+GETUID called+")
   %Result = -1
%End

%Externalintegerfn GETEUID
   debug ("+GETEUID called+")
   %Result = -1
%End

%Externalintegerfn GETGID
   debug ("+GETGID called+")
   %Result = -1
%End

%Externalintegerfn GETEGID
   debug ("+GETEGID called+")
   %Result = -1
%End

%Externalintegerfn GETPID
   debug ("+GETPID called+")
   %result = -1
%End

%Externalintegerfn KILL
   debug ("+KILL called+")
   %result = -1
%End

%Externalintegerfn LINK
   debug ("+LINK called+")
   %Result = -1
%End

%Externalintegerfn NICE
   debug ("+NICE called+")
   %result = -1
%End

%Externalintegerfn PIPE (%Integer filedes)
   debug ("+PIPE called+")
   %Result = -1
%End

%Externalintegerfn PROFIL
   debug ("+PROFIL called+")
   %Result = -1
%End

%Externalintegerfn SETUID
   debug ("+SETUID called+")
   %result = -1
%End

%Externalintegerfn SETGID
   debug ("+SETGID called+")
   %result = -1
%End

%Externalintegerfn UMASK
   debug ("+UMASK called+")
   %Result = -1
%End

%Externalintegerfn WAIT (%integer status)
   debug ("+WAIT called+")
   %Result = -1
%End

%externalpredicatespec exists (%String(255) s)
%Routine scopy (%integer name,%string(*)%name s)
   s = ""
   %While byteinteger(name) # 0 %cycle
      s = s.tostring(byteinteger(name))
      name = name + 1
   %Repeat 
%End      

%Routine copy s (%string(*)%name s, %integer name)
   %integer i
   %for i = 1,1,length(s) %cycle
      byteinteger(name) = charno (s,i)
      name = name + 1
   %Repeat
   byteinteger(name)=0
%End

%Externalroutine PS (%Integer x)
   %String(255) s
   debug ("+PS called+")
   scopy (x,s)
   !printstring(s);newline
%End

%ExternalIntegerfn ACCESS (%Integer name,mode)
   %string(255) filename

   debug ("+ACCESS called+")
   scopy (name,filename)
   %Result = 0 %if exists(filename)
   %result = -1
%End

%Externalintegerfn CHDIR (%Integer name)
   %string(255) filename

   debug("+CHDIR called+")
   scopy (name,filename)
   ! Do something ???
   %Result = 0
%End

%Externalintegerfn CHMOD (%Integer name,mode)
   %string(255) filename

   debug ("+CHMOD called+")
   scopy (name,filename)
   ! Do something
   %Result = 0
%End

%Externalintegerfn TIME (%Integer tloc)
   !Return no. of secs since Jan 1, 1970
   debug ("+TIME called+")
   %Result = 0
%End

%Recordformat Timebfm (%Integer time,%Short millitm,timezone,dstflag)

%Externalintegerfn FTIME (%Integer tp)
   %Record(timebfm)%name t == record(tp)

   debug ("+FTIME called+")
   t_time = time(0)
   t_millitm = cputime
   t_timezone = 0
   t_dstflag = 0
   %Result = 0
%End

%Recordformat tmsfm (%Integer utime,stime,ctime,cstime)

%Externalintegerfn TIMES (%integer buff)
   %Record(tmsfm)%name b == record(buff)

   debug ("+TIMES called+")
   b_utime = cputime // 10
!NOSQUEAK   b_stime = realtime // 10
   b_ctime = 0
   b_cstime = 0
   %Result = -1
%End

%Externalintegerfn UNLINK (%Integer name)
   %String(255) filename

   %on 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15 %start
      %result = -1
   %Finish

   debug ("+UNLINK called+")
   scopy (name,filename)
!   delete file (filename)
   %result = 0
%End

%Externalintegerfn GETWD (%integer name)
   %string(255) dirname

   debug ("+GETWD called+")
! get default directory
   copys (dirname,name)
   %Result = 0
%End

%Externalintegerfn SBRK (%Integer inc)
   %Owninteger saved6=0
   %integer a
   %on 0,1,2,3,4,5,6,7,8,9,10,11,12 %start
      printstring("*Bang ")
      write(event_event,0);space;write(event_sub,0);newline
{}      printstring("Heapget moaned -returning -1");newline
      *move.l d6,saved6
      %result = -1
   %finish

   *move.l saved6, d6
   debug ("+SBRK ".itos(inc,0)." called+")
{}   printstring("Before heapget");newline
   a = heapget (inc)
{}   printstring("Past heapget");newline
   debug("Allocated ".itos(a,0))
   *move.l d6,saved6
   %result = a
%End

%Externalintegerfn FREE (%Integer adr)
   debug ("+FREE called+")
{}   printstring("Heapput");newline
   heapput (adr)
   %result = 0
%End

%Integerfn fdalloc
   %integer i
   %for i = 3,1,nfiles %cycle
      %result = i %if files(i)_mode = -1
   %Repeat
   %result = -1
%End

%Externalintegerfn OPENC (%integer name, mode)
   %string(255) filename
   %Record(filefm)%name f
   %integer fd

   %on 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15 %start
      debug("OPENC signalled")
      %result = -1
   %Finish

   %result = -1 %unless 0<=mode<=1
   scopy (name,filename)
   debug("OPENC ".filename)
   fd = fdalloc; %result = -1 %if fd = -1
   f == files(fd)
   debug("Imp stream = ".itos(f_streamno,0))
   %if mode = input mode %start
      open input (f_streamno,filename)
      f_mode = input mode
   %Else
      open output (f_streamno,filename)
      f_mode = output mode
   %finish
   %Result = fd
%End

%Predicate fdok (%integer fd)
   %falseunless 0<=fd<=nfiles
   %falseif files(fd)_mode = -1
   %true
%End

%Externalintegerfn CLOSEC (%integer fd)
   %record(filefm)%name f
   
   debug("CLOSEC ".itos(fd,0));newline
   %Result = -1 %unless fdok (fd)
   f == files(fd)
   debug("Stream = ".itos(f_streamno,0))
   debug("Mode = ".itos(f_mode,0))
   %if f_mode = input mode %start
      debug("closing input")
      select input(f_streamno);closeinput
      debug("closed input")
   %elseif f_mode = output mode
      debug("closing output")
      select output(f_streamno);closeoutput
      debug("closed output")
   %else
      %result = -1
   %finish
   f_mode = -1
   %Result = 0
%End

%Externalintegerfn UCLOSEC (%Integer fd)
   debug("+UCLOSEC called+")
   %result=Closec(fd)
%End

%Externalintegerfn IOCTL (%integer fd,req,argp)
   debug ("+IOCTL Called+")
   %result = 1 %if fd < 2  {temp}
   %result = -1
%End

%Externalintegerfn CREAT (%Integer name,mode)
   %integer fd
   debug ("+CREAT called+")
   fd = openc (name,outputmode)
   %result = fd
%End

%Externalintegerfn LSEEK (%Integer fd,offset,dir)
   %Integer curpos,newpos
   %Record(filefm)%name f

   debug("+LSEEK called+")
!   %Result = -1 %unless fdok (fd)
!   f == files(fd)
!   curpos = f_scb_p - f_scb_fs
!   %if dir = 0 %start
!      newpos = offset
!   %elseif dir = 1
!      newpos = curpos + offset
!   %elseif dir = 2
!      %Result = -1 %unless offset <= 0
!      newpos = f_scb_fl + offset
!   %finish
!   %if f_scb_mode = input mode %start
!      service (f_scb,ser set in ,newpos)
!   %else
!      service (f_scb,ser set out,newpos)
!   %Finish
!   %Result = newpos
   %result = -1
%End

%Externalintegerfn READC (%Integer fd, buffer, nbytes)
   %Record(filefm)%name f
   %integer i,sym,count=0

   %on 9 %start
      debug("Returning ".itos(count,0)." bytes")
      %result = count
   %finish

   debug("READC ".itos(nbytes,0))
!   printstring("Fd=");write(fd,0);space
!   printstring("addr=");write(buffer,0);newline
   %Result = -1 %unless fdok (fd)
   f == files(fd)
   %result = -1 %unless f_mode = input mode
   select input (f_streamno)
   %if fd=0 %start {special for term}
      readsymbol(sym)
      byteinteger(buffer)=sym
      %result=1
   %finish
   %for i = 1,1,nbytes %cycle
      read symbol (sym)
      byteinteger(buffer)=sym
      buffer=buffer+1
      count = count +1
   %Repeat
   %Result =count
%End

%Externalintegerfn WRITEC (%Integer fd,buffer,nbytes)
   %record(filefm)%name f
   %integer i

!   Printstring("WRITEC");newline
   %Result = -1 %unless fdok(fd)
   f == files(fd)
   %result = -1 %unless f_mode = output mode
   select output (f_streamno)
   %for i=1,1,nbytes %cycle
      printsymbol(byteinteger(buffer))
      buffer=buffer+1
   %repeat
   %Result = nbytes
%End

%Externalintegerfn IPENDC
   ! Number of unread characters in keyboard buffer
   %result = 1 {for now}
%End
