! FILE RX50 1S 
!
!     RX50 FLOPPY DISC HANDLER
!
!     THIS IS THE UNIT 0&1 VERSION
!
!     %% LAST UPDATED 21ST MARCH 1985  FILE=RX5021S
!
!     USES SYSTEM SLOTS 8 AND 14. INT SLOT -8.
!
!     CALLING PARAMETERS ARE AS FOLLOWS
!        P_A1=MODE    (0=READ,1=WRITE)
!        P_A2=ADDRESS OF BUFFER IN MEMORY
!        P_A3=BLOCK NUMBER ON DISC
!
!     SINCE DEIMOS DEALS IN 512 BYTE BLOCKS ALL TRANSFERS ARE 2*256
!BYTE SECTORS. THE FIRST 77 BLOCKS ARE RESERVED FOR THE SYSTEM.
!WITHIN EACH TRACK OF 26 SECTORS THE SECTORS ARE INTERLEAVED.
!
!     ON EXIT P_A1=FAULT NO. (0=OK)
!
!     ANY ERROR WILL RESULT IN UP TO 10 RETRIES.
!
!     STACK=300   STREAMS=0
!
%CONTROL K'101011'
%SYSTEMROUTINESPEC LINKIN(%INTEGER SERVICE)
%SYSTEMROUTINESPEC MAPHWR(%INTEGER SEG)
%SYSTEMINTEGERFNSPEC MAP ABS(%INTEGER VAD,LEN,ID)
%SYSTEMINTEGERFNSPEC GET ID
%PERMROUTINESPEC SVC(%INTEGER EP,P1,P2)
%BEGIN
%RECORDFORMAT PF(%BYTEINTEGER SERVICE,REPLY,%INTEGER A1,A2,A3)
%RECORDFORMAT P2F(%INTEGER D)
!
%RECORDFORMAT CMDF(%INTEGER LEN, SP0, REF1, REF2, UNIT, SP, OPCODE, STS, %C
                            BYTE1, BYTE2, BADDR, BADDR2, A3, A4, A5, A6, %C
                            BLNO, BLNO2, %INTEGERARRAY X(0:13))
                                 ! NB: RQDX1 BUFFER STARTS AT 'REF1'

%RECORDFORMAT R1F(%INTEGER X)
%RECORDFORMAT R2F(%RECORD (CMDF) %NAME R)
%RECORDFORMAT R3F(%INTEGERNAME X)
!
%CONSTINTEGERNAME UDAIP = K'112150';     ! ADDRESS 17772150
%CONSTINTEGERNAME UDASA = K'112152'
!
!     SYSTEM CONSTANTS
!
%OWNINTEGER KID
%CONSTINTEGER SYS1=8;                   !UNIT 2
%CONSTINTEGER SYS2=14;                  !UNIT 3
%CONSTINTEGER DINT=-3;                  !INT SLOT
!
!     RX50 PARAMETERS
!
%OWNINTEGER BOT = 88;               ! TOP OF PROTECTED AREA
%CONSTINTEGER TOP = 1000;             ! TOP OF DISC ?

%CONSTINTEGER READ=0;                   !INPUT PARAMS
%CONSTINTEGER WRITEC=1
!
%CONSTINTEGER OPONL = K'11';            ! ONLINE
%CONSTINTEGER OPRD  = K'41';            ! READ
%CONSTINTEGER OPWR  = K'42';            ! WRITE
!
! ERROR CODES
!
%CONSTINTEGER NO VOLUME = K'43'
!

%CONSTINTEGER UDA BIT = K'100000';      ! UDA (RQDX1) OWNES BUFFER
%CONSTINTEGER STEP    = K'100000'
%CONSTINTEGER STEP 1  = K'004000';      ! STEP ONE DONE
%CONSTINTEGER GO = 1
!
!     GENERAL VARIABLS
!
%RECORD (PF) P,PX
%RECORD (P2F) %NAME P2
%OWNINTEGER SYS,FAULT,ID,SAVE ID,RETRIES,MAPIND,I,VADDR,PAR,FN,OVER
%OWNINTEGER RCMD AD, RMSG AD, RING AD, STEP IND, STEP NO, REPLY

%OWNRECORD (CMDF) RMSG;             ! RING MESSAGE BUFFER
%OWNRECORD (CMDF) RCMD;             !      COMMAND BUFFER
%OWNINTEGERARRAY RING(-5:3);        ! RING AREA, POINTER TO ABOVE ETC

%OWNINTEGERARRAY COMMAND(0:3) = STEP, 0, 0, GO;  ! INFO FOR INIT STEPS
%OWNINTEGERARRAY ONLINA(0:1) = 1(2); ! UNIT ON-LINE INDICATOR (0=IS ONLINE)

%CONSTINTEGERARRAY OPARR(0:1) = OPRD, OPWR

%OWNRECORD (R1F) R1; %OWNRECORD (R2F) %NAME R2; %OWNRECORD (R3F) %NAME R3
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!           INTEGERFNS START HERE
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!     REPORT FAULT SEND A MESSAGE TO MOTHER
!
%INTEGERFN REPORT FAULT
      %RECORD (PF) PX
      PX_SERVICE=7; PX_REPLY=KID
      PX_A1=FAULT; PX_A2=0; PX_A3=0
      PONOFF(PX)
      %RESULT = PX_A1
%END
!
!     MAPADDR MAPS BUS ADDRESS
!
%INTEGERFN MAPADDR(%INTEGER VADDR)
      PAR=MAP ABS(VADDR,256,ID)
      %RESULT=1 %IF PAR=0
      PAR=PAR+(VADDR&K'17700')>>6
      %IF PAR>=K'2000' %START;          !SET 17TH&18TH BITS
         OVER = PAR >> 10
         PAR=PAR&K'1777'
      %FINISH
      %RESULT=0
%END

   %ROUTINE OCTAL(%INTEGER N)
      %INTEGER I
      SPACE
      %CYCLE I = 15, -3, 0
         PRINTSYMBOL((N>>I)&7+'0')
      %REPEAT
   %END

   %ROUTINE DUMP REPLY
      %INTEGER I
      %RECORDFORMAT RF(%INTEGERARRAY A(0:27))
      %RECORD (RF) %NAME R
      R == RMSG
      %CYCLE I = 0, 1, 27
         WRITE(I, 2); OCTAL(R_A(I))
         %IF I&3=3 %THEN NEWLINE %ELSE SPACES(3)
      %REPEAT
      NEWLINE
   %END

   %ROUTINE READY MSG
      RMSG = 0;       ! GET THE MSG AREA (CONT->ME) READY FOR ITS USE
      RMSG_LEN = 60
      RING(0) = RMSG AD
      RING(1) = UDABIT;      ! OWNED BY UDA
   %END

   %ROUTINE ISSUE COMMAND(%INTEGER OP, LEN, UNIT)
      %INTEGER I
      RCMD_LEN = 36
      RCMD_OPCODE = OP
      RCMD_BYTE1 = LEN
      RCMD_UNIT = UNIT
      RING(2) = RCMD AD
      RING(3) = UDABIT;         ! AND A RESPONSE PACKET
      I = UDAIP;                ! KICK IT
   %END

   %ROUTINE WAIT FOR IT
      %INTEGER N, M
      N=0; M=0
      %CYCLE
         %EXIT %IF RING(1) >= 0
         N = N+1
         %IF N = 0 %START
            M = M+1
            %IF M = 10 %THEN FAULT = -1 %AND PRINTSTRING("TIMEOUT
")          %AND %RETURN
         %FINISH
      %REPEAT
      FAULT = RMSG_STS
      %IF FAULT = NO VOLUME %START
         ONLINA(SYS) = FAULT;  ! MARK IT OFF-LINE
      %ELSE
         DUMP REPLY %IF FAULT # 0
      %FINISH
   %END

   %ROUTINE GO ONLINE
      ISSUE COMMAND(OPONL, 0, SYS)
      WAIT FOR IT
      ONLIN(SYS) = FAULT
   %END


   %ROUTINE INITIALISE
!
!  INITIALISE THE RX50
!
   ID = KID;         ! FIND ABS ADDRESS OF OWN AREAS
   R2_R == RMSG
   I = MAP ADDR(R1_X)
   I = MAP ABS(R1_X, 0, 10); ! MAP OFF AGAIN
   RMSG AD = PAR<<6+(R1_X&K'77')+4
   R2_R == RCMD
   I = MAP ADDR(R1_X)
   I = MAP ABS(R1_X, 0, 10)
   RCMD AD = PAR<<6+(R1_X&K'77')+4
   R3_X == RING(0)
   I = MAP ADDR(R1_X)
   I = MAP ABS(R1_X, 0, 10)
   RING AD = PAR<<6+(R1_X&K'77')
   %IF OVER # 0 %START
      PRINTSTRING("NOT IN BOTTOM 64K
")
      %STOP
   %FINISH

   COMMAND(1) = RING AD;      ! STORE RING ADDRESS (CURRENTLY NO BIT 17&18


   UDAIP = 0;                  ! INITIALISE IT
REINIT:

   STEP IND = STEP 1;          ! START WITH STEP 1
   STEP NO = 0;                ! FOR INDEX TO COMMAND

   %CYCLE
      %IF UDASA < 0 %START
         PRINTSTRING("REINITIALISING
")
         -> REINIT
      %FINISH

      %IF STEP IND & UDASA = 0 %THEN %CONTINUE;     ! NOT READY YET
      WRITE(STEP NO, 1); OCTAL(UDASA); NEWLINE
      UDASA = COMMAND(STEP NO)
      STEP NO = STEP NO+1
      STEP IND = STEP IND<<1
      %EXIT %IF STEP IND < 0
   %REPEAT

   PRINTSTRING("INITIALISED OK
")
      SYS = 0; GO ONLINE
      SYS = 1; GO ONLINE
   %END
!
!
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!**
!*****   CODE STARTS HERE
!**
!
!   LINKIN(DINT)
P2==PX
R2==R1; R3==R2
MAPHWR(4);                            !MAP TO DICS REGS
KID=GET ID

  ! REPORT DISC FIGURES TO DIRECTORY TASK

P_SERVICE = 4; P_REPLY = 8;  ! UNIT 0
P_A1 = 10!2<<8; ! TOP BYTE = DRIVE = 2, BOTTOM DRIVE = HERE I AM
P_A2 = 161; ! 1ST USER BLOCK
P_A3 = 799; ! LAST USER BLOCK
PON(P)

! 2ND PAR<<6+(R1_X&K'77')T
P_A1 = 11!2<<8
P_A2 = 97; ! DIRECTORY BLOCK
P_A3 = 88; ! BLOCK LIST START
PON(P)

! NOW FOR UNIT 1
P_REPLY = 14
P_A1 = 10!3<<8;  ! UNIT = 3
P_A2 = 161; P_A3 = 799
PON(P)

P_A1 = 11!3<<8
P_A2 = 97; P_A3 = 88
PON(P)

! REPORT IN FINISHED
LINKIN(SYS1); LINKIN(SYS2)
!
   INITIALISE

!
!        MAIN LOOP-WAIT FOR DISC REQUEST
!
BOT = 0;          ! TEMP FOR NOW (EASY ACCESS TO BLOCK 0)

%CYCLE
      P_SERVICE=0
      POFF(P)
      %IF RING(1) >= 0 %START;   ! RESPONSE IN
         PRINTSTRING("MESSAGE IN!
")
         DUMP REPLY
         READY MSG
      %FINISH
      REPLY = P_SERVICE
      %IF P_A3&K'020000'#0 %START
         P_A3 = P_A3&K'017777'
         SYS=1
      %FINISHELSESTART
         %IF REPLY = SYS2 %THEN SYS=1 %ELSE %C
         SYS=0
      %FINISH
      %IF ONLINA(SYS) # 0 %START
         GO ONLINE
      %FINISH
      FAULT=0; ID=P_REPLY; SAVE ID = ID
      FN = P_A1
      VADDR=P_A2
      !
      !  CHECK IF ACCESS TO RESEVED AREA
      !
      %IF VADDR=0 %START
         BOT=0; FAULT=9
      %ELSESTART
         %IF P_A3<BOT %OR P_A3>TOP %C
            %THEN FAULT=4 %AND ->FIN
RETRY:   FAULT=MAPADDR(VADDR)
         ->FIN %IF FAULT#0
!
         RCMD_BADDR = PAR<<6+VADDR&K'77'
         RCMD_BADDR2 = OVER;          ! ADDRESS & EXTERNSION BITS (UP TO 22)
         RCMD_BLNO = P_A3;            ! BLOCK NUMBER
         ISSUE COMMAND(OPARR(FN), 512, SYS)
         WAIT FOR IT
         PAR=MAP ABS(VADDR,0,10);       !RELEASE USER SEG
         %IF FAULT = -1 %START
            INITIALISE; ID = SAVE ID
            -> RETRY
         %FINISH
      %FINISH
      !
      !RETURN MESSAGE TO USER
      !
FIN:  P_A1=FAULT
      P_SERVICE=ID
      P_REPLY = REPLY
      PON(P)
      READY MSG
%REPEAT
!
%ENDOFPROGRAM