{This version for new Imp compiler}

! Disq IO procedures for Fred-Machine Filestore
! Version for M2294N drive - 1024*16*32*512

%externalroutinespec phex(%integer x)
%externalroutinespec phex4(%integer x)
%externalroutinespec phex2(%integer x)
%externalroutinespec pdate

! Configuration parameters

%constinteger lbps = 9;      ! log(bytes per sector)
%constinteger bps = 1<<lbps; ! bytes per sector
%constinteger spt = 32;      ! sectors per track
%constinteger tpc = 16;      ! tracks per cylinder
%constinteger cpd = 1024;    ! cylinders per drive
%constinteger maxdrive = 0

! Device register addresses

@16_71000 %byte nec data
@16_71001 %byte nec csr
@16_71002 %short board control
%constinteger disq buffer = 16_70000
%owninteger bcr; !shadow register for board control

%owninteger ipt = 0; !Interrupts per transfer
%owninteger maxipt=0,minipt=16_7fffffff

! Board Control

%constinteger board reset = -16_8000
%constinteger int enable  =  16_4000
%constinteger dma out     =  16_2000
%constinteger dma in      =  16_1000
%owninteger   normal      =        0

! Controller Status
! CB | CEH | CEL | SRQ | RRQ | IER | NCI | DRQ

! Error Status
! ENC | OVR | DER | EQC | NR | ND | NWR | MDM

! Interrupt Status
! SEN | RC | SER | EQC | NR | UA<2:0>

! Unit Status
! SEL | SEN | WPR | AMF | RDY | ONC | SER | FLT

! Controller Commands

%constinteger clear done = 8
%constinteger mute srq   = 4
%constinteger clear fifo = 2
%constinteger reset      = 1

%constinteger specify       = 16_20
%constinteger sense int     = 16_10
%constinteger sense unit    = 16_30
%constinteger detect error  = 16_40
%constinteger recalibrate   = 16_50
%constinteger seek          = 16_60
%constinteger format        = 16_70
%constinteger verify format = 16_80
%constinteger read format   = 16_90
!constinteger read bad data = 16_a0
%constinteger read data     = 16_b0
%constinteger write data    = 16_f0
%constinteger verify data   = 16_e0
!constinteger check data    = 16_c0
!constinteger scan data     = 16_d0

%routine parameter(%integer x)
   nec data = x
%end

%integerfn result
   %result = nec data
%end

%routinespec intwait

%routine wait(%integer mask,target)
  %cycle
    ipt = ipt+1
    intwait
    %returnif nec csr&mask=target
    nec csr = clear done
  %repeat
%end

%routine controller wait(%integer bc)
  bcr = bc
  board control = bc
  wait(128,0)
  board control = normal
  bcr = normal
%end

%integerfn drive wait(%integer drive)
%integer i
  %cycle
    bcr = intenable
    board control = intenable
    wait(16,16)
    nec csr = sense int
    controller wait(intenable)
    i = result
  %repeatuntil i&7=drive
  %result=i
%end

%integerfn unit status(%integer drive)
  nec csr = sense unit+drive
  controller wait(intenable)
  %result = result<<8
%end

%routine initialise controller
%integer i,dtl=16_8000+bps
  bcr = board reset
  board control = board reset
  %for i=1,1,10000 %cycle; %repeat
  bcr = normal
  board control = normal
  %for i=1,1,10000 %cycle; %repeat
  parameter(16_40);       !Mode
  parameter(dtl>>8);      !DTLH
  parameter(dtl);         !DTLL
  parameter(tpc-1);       !ETN
  parameter(spt-1);       !ESN
  parameter(16);          !GPL2
  parameter(10);          !MGPL1
  nec csr = specify
  controller wait(intenable)
  i = drive wait(7)
%end

%owninteger ec=0,fec=0; ! Error count, Fatal error count
%ownintegerarray curcyl(0:maxdrive) = -1(*)
%owninteger curdrive = -1
%owninteger drive,cylinder,track,sector,disqaddress,errorcode

%routine restore
%integer x
  nec csr = recalibrate+drive
  x = drive wait(drive)
%end

%routine position head
%integer x
  parameter(cylinder>>8)
  parameter(cylinder)
  nec csr = seek+drive
  x = drive wait(drive)
%end

%routine fail(%integername lives,%integer code,operation)
%owninteger e=0,f=0
  ec = ec+1; e = e+1
  pdate
  printstring("*** Disk error "); printsymbol(operation)
  write(disqaddress>>lbps,6); printsymbol('b')
  write(cylinder,3); printsymbol('c')
  write(track,2); printsymbol('t')
  write(sector,2); printstring("s ")
  %unless code=-1 %start
    code = unit status(code&7)+code
    phex(code)
    printstring(" cb")  %if code&16_80000000#0
    printstring(" rrq") %if code&16_08000000#0
    printstring(" ier") %if code&16_04000000#0
    printstring(" nci") %if code&16_02000000#0
    printstring(" drq") %if code&16_01000000#0
    printstring(" enc") %if code&16_00800000#0
    printstring(" ovr") %if code&16_00400000#0
    printstring(" der") %if code&16_00200000#0
    printstring(" eqc") %if code&16_00100000#0
    printstring(" nr")  %if code&16_00080000#0
    printstring(" nd")  %if code&16_00040000#0
    printstring(" nwr") %if code&16_00020000#0
    printstring(" mdm") %if code&16_00010000#0
    printstring(" sel") %if code&16_00008000#0
    printstring(" sen") %if code&16_00004000#0
    printstring(" wpr") %if code&16_00002000#0
    printstring(" rdy") %if code&16_00000800#0
    printstring(" onc") %if code&16_00000400#0
    printstring(" ser") %if code&16_00000200#0
    printstring(" flt") %if code&16_00000100#0
    printstring(" sen") %if code&16_00000080#0
    printstring(" rc")  %if code&16_00000040#0
    printstring(" ser") %if code&16_00000020#0
    printstring(" eqc") %if code&16_00000010#0
    printstring(" nr")  %if code&16_00000008#0
  %finish
  errorcode = code
  lives = lives-1
  initialise controller; restore; position head
  newline %andreturnunless lives<=0
  fec = fec+1
  printstring(" - fatal"); newline
  %signal 9 %if lives=0
%end

%routine bulk move (%integer bytes,from,to)
!Assume bytes is multiple of 4 and not more than 256k
  bytes = bytes>>1-1       {was bytes>>2-1}
  *move.l from,a0
  *move.l to,a1
  *move.l bytes,d0
loop: *move.w (a0)+,(a1)+  {was move.l}
      *dbra d0,loop
%end

%routine copy from(%integer userbuffer,bytes)
  bulkmove(bytes,userbuffer,disqbuffer) %unless userbuffer=disqbuffer
%end

%routine copy to(%integer userbuffer,bytes)
  bulkmove(bytes,disqbuffer,userbuffer) %unless userbuffer=disqbuffer
%end

%routine do(%integer op,bytes,da,ub)
%integer target,sectors,max,size,lives=3
%integer st,h,f,c,t,s,n
  %cycle
    sectors = bytes>>lbps
    disqaddress = da
    sector = da>>lbps
    track = sector//spt
    cylinder = track//tpc
    drive = cylinder//cpd
    sector = rem(sector,spt)
    track = rem(track,tpc)
    cylinder = rem(cylinder,cpd)
    max = spt-sector;                    !Disallow head crossing
    max = 4096>>lbps %if max>4096>>lbps; !(Disk buffer size restriction)
    sectors = max %if sectors>max
    size = sectors<<lbps
    fail(lives,-1,'D') %andcontinueunless drive<=maxdrive
    %unless curdrive=drive %start
      initialise controller %if curdrive<0
      curdrive = drive
    %finish
    %unless curcyl(curdrive)=cylinder %start
      position head
      curcyl(curdrive) = cylinder
    %finish
    copyfrom(ub,size) %unless op=readdata
    parameter(track);       !PHN
    parameter(0);           !Flag
    parameter(cylinder>>8); !LCNH
    parameter(cylinder);    !LCNL
    parameter(track);       !LHN
    parameter(sector);      !LSN
    parameter(sectors);     !NSEC
    neccsr = op+drive
    %if op=readdata %start
      controllerwait(dmain+intenable)
    %else
      controllerwait(dmaout+intenable)
    %finish
    st = neccsr; st = result<<16+st<<24
    h = result; f = result; c = result; c = result+c<<8
    t = result; s = result; n = result
    copyto(ub,size) %if op=readdata
    target = rem(track+(sector+sectors)//spt,tpc)
    target = (target!!t)!(track!!h)!f!n
    target = target!(rem(sector+sectors,spt)!!s)
    target = target!((cylinder+(track+(sector+sectors)//spt)//tpc)!!c)
    %if target#0 %or st&16_efff0000#16_40000000 %start
    ! %if op=writedata %then printsymbol('W') %c
    ! %elseif op=readdata %then printsymbol('R') %c
    ! %elseif op=verifydata %then printsymbol('V') %c
    ! %else printsymbol('?'); space
    ! fail(lives,st,'T')
      %if op = read data %then fail(lives, st, 'R') %c
      %else %if op = write data %then fail(lives, st, 'W') %c
      %else %if op = verify data %then fail(lives, st, 'V') %c
      %else fail(lives, st, '?')
      %if target#0 %start
        pdate
        printstring("H="); write(h,0); printstring(" F="); write(f,0)
        printstring(" C="); write(c,0); printstring(" T="); write(t,0)
        printstring(" S="); write(sector,0); printstring(" N="); write(n,0)
        newline
      %finish
      %continue
    %finish
    ub = ub+size; da = da+size; bytes = bytes-size
  %repeatuntil bytes=0
%end

%constinteger dwrite=1,dread=2,dverify=4

%integerfn xtransfer(%integer func,bytes,disqaddr,%integername buf)
%constinteger signbit = \((-1)>>1)
%integer lives=0
  %onevent 9 %start
    lives = lives-1
    %result = signbit!errorcode
  %finish
  fail(lives,-1,'A') %andresult = -1 %unless disqaddress&(1<<lbps-1)=0
  fail(lives,-1,'B') %andresult = -1 %unless addr(buf)&1=0
  fail(lives,-1,'S') %andresult = -1 %unless bytes&(1<<lbps-1)=0
  fail(lives,-1,'S') %andresult = -1 %if bytes<=0
  fail(lives,-1,'O') %andresult = -1 %if func&(dwrite+dread+dverify)=0
  ipt = 0
  do(writedata, bytes,disqaddr,addr(buf)) %if func&dwrite#0
  do(readdata,  bytes,disqaddr,addr(buf)) %if func&dread#0
  do(verifydata,bytes,disqaddr,addr(buf)) %if func&dverify#0
  maxipt = ipt %if ipt>maxipt
  minipt = ipt %if ipt<minipt
  %result = bytes
%end

%owninteger accepted=0,count=-1,xf=0,xn,xa,xm

@16_3f90 %integer intsp
@16_3f94 %integer mysp

%routine intwait
  *movem.l d5-d7/a4-a6,-(sp)
  *move.l sp,mysp
  *move.l intsp,sp
  *movem.l (sp)+,d2-d7/a1-a6
  *move.l 16_374c,a0
  *jsr (a0)
  *movem.l d2-d7/a1-a6,-(sp)
  *move.l sp,intsp
  *move.l mysp,sp
  *movem.l (sp)+,d5-d7/a4-a6
%end

%routine startup
%ownintegerarray stack(-2048:1) = 16_55555555(*)
  pdate; printstring("Disk driver (M2294N 13/09/84) starting"); newline
  mysp = addr(stack(0))
  *move.l (sp)+,a0
  *mfsr d1
  *move #16_2400,d0
  *trap #0
  *move.l a0,-(sp)
  *move.w d1,-(sp)
  *movem.l d0-d1/a0,-(sp)
  *movem.l d2-d7/a1-a6,-(sp)
  *move.l sp,intsp
  *move.l mysp,sp
  %cycle
    intwait %until count=0 {xf#0
    accepted = 1
    count = xtransfer(xf,xn,xa,integer(xm))
  %repeat
%end

@16_ff8003 %byte interrupt register

%externalroutine show disq status
  pdate; printstring("Disk status: Co="); write(count,0)
  printstring(" By="); write(xn,0)
  printstring(" Bl="); write(xa>>9,0)
  %unless xa&511=0 %start
    printsymbol('.'); write(xa&511,0)
  %finish
  printstring(" Bu="); phex(xm)
  printstring(" Op="); write(xf,0)
  printstring(" BCR="); phex4(board control)
  printstring(" SB="); phex4(bcr)
  printstring(" CSR="); phex2(nec csr)
  newline
  pdate; printstring("Min/max IPT: "); write(minipt,0)
  write(maxipt,1); newline; minipt=16_7fffffff; maxipt = 0
%end

%externalroutine kick disq
  interrupt register = 1
%end

%externalintegermap transfer(%integer f,n,a,%integername m)
%owninteger started=0
  started = 1 %and startup %if started=0
  %if count=0 %start
    pdate
    printstring("*** Disq request while driver busy"); newline
    %while count=0 %cycle; %repeat
  %finish
  count = 0; xm = addr(m); xa = a; xn = n; xf = f
  accepted = 0
  %cycle
    kick disq
    %result == count %unless accepted=0
  %repeat
%end

%endoffile