! FILE 'SYS_FSYSTU581S'  - MODIFIED TO RUN TU58 ONLY !!!!!!!

!******************************
!*  FILE SYSTEM HANDLER       *
!*   FSYS1S/FSYS1Y            *
!*  DATE: 28.JUN.79           *
!******************************

!*W.S.C. 25TH AUGUST 1976
!*B.G.  27.MAR.78

!*THIS HANDLER IS THE FILE SYSTEM UTILITY TO REPLACE THE
!*EXISTING ONE IN DEIMOS TO PERMIT A FILE SYSTEM TO BE
!*CREATED ON THE AMPEX 9500 DISC AS WELL AS THE RK05'S.

!*IT IS A CONCEPTUAL COPY OF THE RK05 FILE SYSTEM HANDLER
!*EXCEPT THAT A BUFFER POOL IS USED FOR BLOCK DESCRIPTORS
!*AND DIRECTORY BLOCKS.

!*THE CODE IS SHARED BY 3 SYSTEM SLOTS,4 FOR THE RK05'S,
!*AND 9,15 FOR THE AMPEX DISC.THE AMPEX DISC IS LOGICALLY
!*DIVIDED INTO TWO,UNITS 2&3.
!* A FURTHER DISC IS CATERED FOR IN SLOT 28

!*THE CLOCK IS USED TO WRITE BLOCKS BACK EVERY 10SECS
!*(BLOCK DESCRIPTOR BLOCKS).DIRECTORY BLOCKS ARE ALWAYS
!*WRITTEN BACK AS SOON AS POSSIBLE AFTER A CHANGE.

!*TUNEABLE PARAMETERS

!*     NBUF=NUMBER OF BUFFERS IN POOL-1(MUST BE>0)

!*     SECS::LENGTH OF TIME BETWEEN INSPECTING BUFFER
!*          POOL FOR WRITING BACK TO DISC.

!*THE FOLLOWING FACILITIES ARE OFFERED

!*     EXAMINE A FILE
!*     GET NEXT BLOCK OF A FILE
!*     DESTROY A FILE
!*     CREATE A FILE
!*     APPEND A BLOCK TO A FILE
!*     RENAME A FILE
!*     RENAME A TEMPORARY FILE

!*STACK=300     STREAMS=0

!**********************************************************
!**********************************************************

%CONTROL K'101010';                    !SYSTEM+FAST ROUTINE ENTRY

%SYSTEMROUTINESPEC LINKIN(%INTEGER SER)
%SYSTEMROUTINESPEC ALARM(%INTEGER TICKS)
%SYSTEMINTEGERFNSPEC GETID

%PERMROUTINESPEC SVC(%INTEGER EP, R0, R1)
%PERMINTEGERMAPSPEC INTEGER(%INTEGER N)
%PERMBYTEINTEGERMAPSPEC BYTEINTEGER(%INTEGER N)
%PERMINTEGERFNSPEC ADDR(%BYTEINTEGERNAME N)
%PERMINTEGERFNSPEC ACC
%RECORDFORMAT DD(%INTEGER X)
%PERMRECORD (DD) %MAPSPEC RECORD(%INTEGER X)
%CONSTRECORD (DD) %NAME NULL = 0


%BEGIN

     !*********************************************************
     !*************     DATA AREAS &DECLARATIONS     **********
     !*********************************************************


     !*SYSTEM SLOTS/DISC

     %CONSTINTEGER MAX DRIVES = 4

     %CONSTBYTEINTEGERARRAY SERV(0:MAX DRIVES) = 3, 3, 8, 14, 28

     !*DIRECTORY BLOCK AREAS/DISC
     %CONSTINTEGERARRAY DIRBLK(0:MAX DRIVES) =
         K'220', 0, K'100', K'100', K'220'

     !*BLOCK DESCRIPTOR BASE/DISC
     %CONSTBYTEINTEGERARRAY BLKLST(0:MAX DRIVES) =
         K'100', 0, K'103', K'103', K'100'

     !*FREE BLOCK START/DISC
     %CONSTINTEGERARRAY FBLOCK(0:MAX DRIVES) =
      K'400', 0, K'110', K'110', K'400'

     %OWNINTEGERARRAY FIRST FREE(0:MAX DRIVES) =
      K'400', 0, K'110', K'110', K'400'
                                       ! INITIALLY IS IDENTICAL TO
                                       ! FBLOCK

     !*TOP OF DISC
     %CONSTINTEGERARRAY LASTBL(0:MAX DRIVES) =
      9199, 0, 511, 511, 9199

     !*REQUEST TYPES

     %CONSTINTEGER EXAMINE = 0
     %CONSTINTEGER GET NEXT = 1
     %CONSTINTEGER DESTROY = 2
     %CONSTINTEGER CREATE = 3
     %CONSTINTEGER APPEND = 4
     %CONSTINTEGER RENAME = 5
     %CONSTINTEGER RENAME TEMP = 6
     %CONSTINTEGER RENAME FSYS = 7
     %CONSTINTEGER DIR BLK NO = 8

     !*SYSTEM CONSTANTS

     %CONSTINTEGER DREAD = 0, DWRITE = 1
                                       !MODES
     %CONSTINTEGER CLOCK INT = 0
     %CONSTINTEGER MY SEG = 4, MSA = K'100000'

     !*SYSTEM SLOTS

     %CONSTINTEGER RKSER = 4
     %CONSTINTEGER AMP1SER = 9
     %CONSTINTEGER AMP2SER = 15
     %CONSTINTEGER RKBSER = 29

     %SWITCH REQUEST(0:DIR BLK NO)

     %INTEGER ID, SEG, I, BK, NO, NOSAVE, PR, EXIT, SEG2
     %OWNINTEGER DRIVE, FNO

     !*MESSAGE FORMATS

     %RECORDFORMAT PF(%BYTEINTEGER SERVICE, REPLY, %INTEGER A1, A2, A3)
     %RECORDFORMAT P2F(%BYTEINTEGER SERVICE, REPLY, %INTEGER A1, %C
       %INTEGERNAME A2, %INTEGER A3)
     %RECORD (PF)P, PX

     !*DISC BUFFER POOL

     %CONSTINTEGER SECS = 60;           !BUFFER WRITE BACK TIME
     %CONSTINTEGER NBUF = 2;           !NUMBER OF BUFFERS-1(MUST BE>0)

     %RECORDFORMAT XF(%INTEGER X)
     %RECORDFORMAT BF(%INTEGER DRIVE, BLOCK, WRM, %RECORD (XF) %C
       %ARRAY BLK(0:255))
     !*WRM IS A WRITE MARKER TO SAY THAT BLOCK HAS BEEN
     !*ALTERED AND MUST BE WRITTEN BACK TO DISC.
     %OWNRECORD (BF) %ARRAY B(0:NBUF)
     %OWNINTEGER BLAST = 0;            !LAST BUFFER USED IN POOL
     %OWNRECORD (BF) %NAME BX;         !POINTS TO CURRENT BUFFER RECORD

     !*FORMATS FOR BLOCK DESCRIPTORS AND DIRECTORY BLOCKS

     %RECORDFORMAT BLKF(%INTEGER PR, NEXT)
                                       !BLOCK DESCRIPTOR

     %RECORDFORMAT N1F(%BYTEINTEGERARRAY NAME(0:5))
     %RECORDFORMAT N2F(%INTEGER A, B, C)
                                       ! TWO FORMS OF THE FILE NAME

     %RECORDFORMAT INFF(%BYTEINTEGER UNIT, FSYS, %RECORD (N1F)N)
                                       ! FILE DESCRIPTOR

     %RECORDFORMAT INF2F(%BYTEINTEGER UNIT, FSYS, %RECORD (N2F)N)

     %RECORDFORMAT FILEF(%RECORD (N1F)N, %INTEGER FIRST, PR)
                                       !DIRECTORY ENTRY

     %RECORDFORMAT FILE2F(%RECORD (N2F)N, %INTEGER FIRST, PR)

     %OWNRECORD (BLKF) %ARRAYNAME BLKA
     %RECORD (FILEF) %ARRAYNAME FA
     %OWNRECORD (FILEF) %NAME F
     %RECORD (BLKF) %NAME BLK
     %RECORD (BLKF)SAVE BLK
     %RECORD (INFF) %NAME INF, INF2
     %RECORD (INFF)G

     !***********************************************
     !* E V E N T S 
    
      !! %ON %EVENT 15 %START;        ! DISC I/O FAIL
!!         %IF PX_SERVICE = 0 %THEN -> RESTART; ! IN TIMER SECTION
!!         -> REPLY
!!      %FINISH

     !**********************************************

     !****************************************************************
     !******************************************************************

     !*ROUTINE DA

     !*CALLS DISC HANDLER TO READ IN A BLOCK
     !* NB:  THIS ROUTINE ASSUMES THAT BX POINTS TO THE BLOCK DESCRIPTOR


     %ROUTINE DA(%INTEGER MODE)
        %RECORD (P2F)P
        %INTEGER DRIVE

        DRIVE = BX_DRIVE
        P_A3 = BX_BLOCK;               ! COMPILER ERROR FORCES THIS
        P_SERVICE = SERV(DRIVE)
        P_REPLY = ID
        %IF DRIVE = 1 %THEN P_A3 = P_A3!K'020000'
        P_A1 = MODE
        %IF MODE # D READ %THEN BX_WRM = 0
                                       ! CLEAR THE WRITE MARKER
        P_A2 == BX_BLK(0)
        PONOFF(P)
        %IF P_A1 # 0 %THENSIGNAL 15, 15
     %END

     !*******************************************************

     !*RECORD MAP LOAD

     !*LOADS REQUESTED BLOCK INTO CORE IF IT IS NOT ALREADY THERE
     !*AND RETURNS A POINTER TO THE START OF THE RECORD BX
     !*WHICH IS SET UP TO CURRENT ENTRY IN THE BUFFER POOL
     !*DRIVE IS ASSUMED TO BE SET UP.   ********
     !* THE ROUTINE ALSO SETS UP GLOBAL BX AS A SIDE EFFECT

     %RECORD (BF) %MAP LOAD(%INTEGER BLOCK)
        %INTEGER I, TEMP

        !*CHECK IF BLOCK ALREADY IN POOL

        %CYCLE I = NBUF, -1, 0
           BX == B(I)
           %IF BX_DRIVE = DRIVE %AND BX_BLOCK = BLOCK %START
              %RESULT == BX
           %FINISH
        %REPEAT

        !*BLOCK NOT IN POOL

        BX == B(BLAST)
        BLAST = BLAST+1
        %IF BLAST > NBUF %THEN BLAST = 0
        %IF BX_WRM # 0 %START;         !WRITE BACK OLD BLOCK
           DA(DWRITE)
        %FINISH
        BX_DRIVE = DRIVE
        BX_BLOCK = BLOCK
        DA(DREAD);                     !READ IN NEW BLOCK
        %RESULT == BX
     %END

     !************************************************************


     !*RECORD MAP EXAM 

     !*TO READ IN CORRECT DIRECTORY BLOCK
     !*AND FIND REQUIRED ENTRY

     %RECORD (FILEF) %MAP EXAM(%RECORD (INFF) %NAME INF)
        %INTEGER N, J, K, HIT, T

        %RECORD (N2F) %NAME FILE
        %RECORD (N2F) %NAME INFO

        %RECORD (FILE2F) %NAME F

        !*SET UP DRIVE NUMBER,0,1 RK05
                                       !2,3 AMPEX

        DRIVE = INF_UNIT
        INFO == INF_N;                 ! POINT TO NAME PART

        !*SET UP DIRECTORY BLOCK FOR SCAN

        T = DIRBLK(DRIVE)
        N = T+INF_FSYS;                ! MAP TO USERS DIRECTORY
        %UNTIL N > T+2 %CYCLE;         ! SYSTEM OCCUPIES 3 BLOCKS
           FA == LOAD(N)_BLK

           !*LOOK FOR MATCH

           %CYCLE J = 0, 1, 50
              FNO = J;                 ! GLOBAL FOR CREATE
              F == FA(J);              ! POINT TO TARGET ENTRY
              FILE == F_N;             ! MOST CONVENIENT FORMATR
              %IF FILE_A = INFO_A %AND FILE_B = INFO_B %AND FILE_C = %C
                INFO_C %THENRESULT == F
           %REPEAT
           N = N+1
            %EXIT;   ! ONLY ON BLOCK ON TU58
        %REPEAT
        %RESULT == NULL
     %END

     !******************************************************************

     !*RECORD MAP GET BLOCK

     !*RETURNS POINTER TO CORRECT BLOCK DESCRIPTOR
     !*AFTER CALLING LOAD TO READ IT INTO CORE

     %RECORD (BLKF) %MAP GET BLOCK(%INTEGER BLOCK NO)
        %INTEGER POS, PT
        POS = BLOCK NO >> 7+BLKLST(DRIVE)
                                       !BLOCK DESC BLOCK
        BLKA == LOAD(POS)_BLK
        %RESULT == BLKA(BLOCK NO&K'177')
                                       ! OFFSET INTO BLOCK
     %END

     !**********************************************************

     !*INTEGER FUNCTION APPENDB

     !*RETURNS NEXT FREE BLOCK NUMBER


     %INTEGERFN APPENDB(%INTEGER LAST)
        %INTEGER WRAP

        WRAP = 0
        %CYCLE
           LAST = LAST+1
           %IF LAST = LASTBL(DRIVE) %START
              %IF WRAP = 0 %THENRESULT = 0
              WRAP = WRAP+1
              LAST = FBLOCK(DRIVE)
           %FINISH
           BLK == GET BLOCK(LAST)
           %IF BLK_PR = 0 %THENRESULT = LAST
        %REPEAT
     %END

     !*****************************************************************

     !*************************************************************
     !*************************************************************


     !*MAIN CONTROL LOOP

     !*LINK TO SYSTEM SLOTS
     LINKIN(AMP1SER)
      LINKIN(AMP2SER)
     ID = GETID
     ALARM(SECS*50);                   !SET CLOCK FOR SECS SECONDS

RESTART:
     %CYCLE
        P_SERVICE = 0
        POFF(P)

        !*IF CLOCK TICK CHECK IF BUFFER POOL NEEDS WRITING

        %IF P_REPLY = CLOCK INT %START

           PX_SERVICE = 0;           ! FOR EVENT 15 HANDLING

           %CYCLE I = NBUF, -1, 0
              %IF B(I)_WRM # 0 %START
                 BX == B(I)
                 DA(DWRITE)
              %FINISH
           %REPEAT
          ALARM(SECS*50)
           %CONTINUE
        %FINISH

        !*NOT A CLOCK TICK--REQUEST FOR SERVICE

        PX_SERVICE = P_REPLY
        PX_REPLY = P_SERVICE
        PX_A2 = P_A2

        !*GET CALLERS BLOCK

         NO = 0

        SEG = P_A2 >> 13
        %IF SEG = 0 %THENSIGNAL 36, 36
        MAP VIRT(P_REPLY, SEG, MY SEG)
        INF == RECORD(MSA+(P_A2&K'17777'));  INF2 == INF

        -> REQUEST(P_A1)

        !*
        !**
        !***** EXAMINE FILE
        !**
        !*

REQUEST(EXAMINE):

        !*P_A2 HAS ADDRESS OF DESCRIPTOR
        !*EXAMINE FINDS THE FILE ENTRY IN THE DIRECTORY BLOCK
        !*AND RETURNS THE FIRST BLOCK'S NUMBER IN THE FILE
        !*TO THE CALLER.

        NO = 0
        F == EXAM(INF)
        %UNLESS F == NULL %THEN NO = F_FIRST
        %IF DRIVE = 1 %AND NO # 0 %THEN NO = NO!K'020000'
        -> REPLY

WRITE DIR: DA(DWRITE);                    !PUT DIRECTORY BLOCK BACK

REPLY:  MAP VIRT(0, -1, MYSEG);        !RELEASE SEGMENT
        PX_A1 = NO
        PON(PX)
        %CONTINUE

        !*
        !**
        !***** GET NEXT
        !**
        !*

REQUEST(GET NEXT):

        !*P_A2=FILE DESCRIPTOR,P_A3=LAST BLOCK
        !*GET NEXT IS GIVEN A BLOCK OF A FILE AND RETURNS
        !*THE NEXT BLOCK IN THE FILE BY LOOKING AT THE LINK IN
        !*THE BLOCK DESCRIPTOR.IT ALSO READS THE BLOCK DECRIPTOR
        !*ENTRY FOR THE NEXT BLOCK TO CHECK THE PROTECT CODE.

        DRIVE = INF_UNIT
        BK = P_A3
        %IF DRIVE = 1 %THEN BK = BK&K'17777'
        BLK == GET BLOCK(BK);          !GET PREVIOUS BLOCK
        PR = BLK_PR;  NO = BLK_NEXT
        %IF NO # 0 %START
           BLK == GET BLOCK(NO)
           %IF BLK_PR # PR %THEN NO =- 1 %ELSESTART
              !! NO = -1  IS A PROTECT CODE ERROR
              %IF DRIVE = 1 %THEN NO = NO!K'020000'
           %FINISH
        %FINISH
        -> REPLY

        !*
        !**
        !***** DESTROY
        !**
        !*

REQUEST(DESTROY):

        !*DESTROY REMOVES THE FILE'S NAME FROM THE DIRECTORY
        !*BLOCK AND GOES DOWN THE BLOCK DESCRIPTOR ENTRIES FOR
        !*THAT FILE SETTING ALL THE LINKS AND PROTECT CODES TO
        !*ZERO(CHECKING THE PROTECT CODES AS IT GOES.)

        EXIT = 0;                      !TAKE NORMAL EXIT
DESTF:  
        NO = 1;               ! FILE DOES NOT EXIST
        F == EXAM(INF)
        %UNLESS F == NULL %START
           NO = 0
           BK = F_FIRST;  PR = F_PR

           F = 0;                      ! DELETE NAME ETC
           F_PR = PR;                  ! RESTORE "PR"

           DA(DWRITE);                 !WRITE BLOCK BACK IMMEDIATELY
           %UNTIL BK = 0 %CYCLE
                                       !DELETE ALL LINKS AND PR
              BLK == GET BLOCK(BK)
              %IF BLK_PR # PR %START
                 NO =- 1;              !CORRUPT FILE!!!
                 %EXIT
              %FINISH
              %IF FBLOCK(DRIVE) <= BK < FIRST FREE(DRIVE) %THEN %C
                FIRST FREE(DRIVE) = BK
              BK = BLK_NEXT
              BLK = 0;                 ! ZERO PR AND NEXT
              BX_WRM = BX_WRM+1
           %REPEAT
        %FINISH
        -> REPLY %IF EXIT = 0
        -> REN TMP;                    !BACK TO RENAME TEMP

        !*
        !**
        !***** CREATE FILE
        !**
        !*

REQUEST(CREATE):

        !*A FILE IS CREATED  BY FINDING AN EMPTY SLOT IN THE DIRECTORY
        !*BLOCK AND COPYING THE NAME INTO IT.A FREE BLOCK IS THEN FOUND
        !*AND IS DEEMED TO BE THE FIRST BLOCK OF THE FILE.A LINK TO
        !*THIS BLOCK IS SET UP AND THE PROTECT CODE CALCULATED AND
        !*INSERTED INTO THE BLOCK DESCRIPTOR.

        DRIVE = INF_UNIT
        NOSAVE = 0
        NOSAVE = APPENDB(FIRST FREE(DRIVE))
        %IF NOSAVE # 0 %START
           G_FSYS = INF_FSYS
           G_UNIT = INF_UNIT
           F == EXAM(G);               !FIND EMPTY SLOT
           %UNLESS F == NULL %START
              NO = NOSAVE
              F_N = INF_N;             ! COPY NAME
              BX_WRM = BX_WRM+1
              F_PR = ((F_PR+K'010000')&K'170000')!INF_FSYS << 6!FNO
              F_PR = K'010000' %IF F_PR = 0
                                       ! IN CASE OF ZERO PR
              F_FIRST = NO
              PR = F_PR
              DA(D WRITE);             !PUT DIRECTORY BLOCK BACK
              BLK == GET BLOCK(NO);    !GET BLOCK DESCRIPTOR BACK
              BLK_PR = PR
              BX_WRM = BX_WRM+1
              FIRST FREE(DRIVE) = NO
              %IF DRIVE = 1 %THEN NO = NO!K'020000'
           %FINISH
        %FINISH
        -> REPLY

        !*
        !**
        !***** APPEND BLOCK
        !**
        !*

REQUEST(APPEND):

        !*TO APPEND A BLOCK TO A FILE THE CURRENT LAST BLOCK
        !*DESCRIPTOR ENTRY IS INSPECTED FOR THE PROTECT CODE.
        !*THE NEXT FREE BLOCK'S DESCRIPTOR IS THEN
        !*UPDATED WITH THIS CODE AND A LINK TO THIS BLOCK
        !*IS INSERTED IN THE LAST DESCRIPTOR ENTRY.

        DRIVE = INF_UNIT
        BK = P_A3;                     !GET LAST BLOCK
         %IF DRIVE = 1 %THEN BK = BK&K'17777'
        BLK == GET BLOCK(BK);          !GET LAST BLOCK
        PR = BLK_PR
        NO = APPENDB(BK);              !GET NEW LAST BLOCK
        %IF NO # 0 %START
           BLK_NEXT = 0
           BLK_PR = PR
           BX_WRM = BX_WRM+1
           FIRST FREE(DRIVE) = NO
           BLK == GET BLOCK(BK);       !GET PREVIUOS LAST BLOCK TO
                                       ! INSERT LINK
           BLK_NEXT = NO
           %IF DRIVE = 1 %THEN NO = NO!K'020000'
           BX_WRM = BX_WRM+1
        %FINISH
        -> REPLY

        !*
        !**
        !***** RENAME FILE
        !**
        !*

REQUEST(RENAME):
REQUEST(RENAME FSYS):                  ! FILES IN DIFFERENT FSYS

        !*P_A2HAS EXISTING,P_A3 HAS NEW FILE DESCRIPTOR
        !*IF THE NEW FILE DOES NOT ALREADY EXIST THEN THE OLD
        !*FILE NAME IN THE DIRECTORY BLOCK IS REPLACED BY
        !*THE NEW.

        NO =- 1
        SEG2 = P_A3 >> 13
        %IF SEG2 = SEG %START
           INF2 == RECORD(MSA+(P_A3&K'17777'))
           %IF INF_UNIT = INF2_UNIT %START
              %IF P_A1 = RENAME FSYS %START
                 G_FSYS = INF2_FSYS
                 G_UNIT = INF2_UNIT
                 F == EXAM(G)
                 %UNLESS F == NULL %START

                    F == EXAM(INF);     ! GET EXISTING FILE
                    %UNLESS F == NULL %START; ! DOESN'T EXIST
                       BK = F_FIRST;  PR = F_PR
                       F = 0;         ! ZERO NAME RECORD
                       BX_WRM = BX_WRM+1
                       DA(D WRITE)
                       F == EXAM(G);        ! GET EMPTY SLOT AGAIN
                       F_N = INF2_N;        ! COPY NAME
                       F_FIRST = BK;  F_PR = PR
                       !! BX_WRM = BX_WRM+1 (WRITE DIR WRITES BACK)
                       NO = 0
                    %FINISH
                 %FINISH
              %ELSE

                 F == EXAM(INF2);            !CHECK NEW FILE DOES NOT EXIST
                 %IF F == NULL %START
                    F == EXAM(INF)
                    %IF F == NULL %THEN NO = 1 %ELSESTART
                       F_N = INF2_N;         ! COPY NAME
                       !! BX_WRM = BX_WRM+1 (WRITE DIR WRITES BACK)
                       NO = 0
                    %FINISH
                 %FINISH
              %FINISH
           %FINISH
        %FINISH
        -> WRITE DIR

        !*
        !**
        !***** RENAME TEMPORARY FILE
        !**
        !*

REQUEST(RENAME TEMP):

        !*THIS RENAMES A TEMPORARY FILE IN THE SENSE THAT IT REMOVES
        !*THE TEMP FILE MARKER AND DESTROYS THE FILE.

        EXIT = 1;                      !SPECIAL EXIT FORM DIRECTORY
        INF_N_NAME(0) = INF_N_NAME(0)&X'FF7F'
                                       !REMOVE TEMP MARKER
        -> DESTF

REN TMP:
        INF_N_NAME(0) = INF_N_NAME(0)!X'0080'
                                       !PUT BACK MARKER
        F == EXAM(INF)
        %IF F == NULL %THEN NO =- 1 %ELSESTART
           F_N_NAME(0) = F_N_NAME(0)&X'FF7F'
                                       !NOT TEMP NOW
           !! BX_WRM = BX_WRM+1 (WRITE DIR WRITES BACK)
           NO = 0
        %FINISH
        -> WRITE DIR


REQUEST(DIR BLK NO):                ! GIVE BLOCK NO OF DIRECTORY
        NO = DIRBLK(INF_UNIT)+INF_FSYS
        -> REPLY

     %REPEAT
%ENDOFPROGRAM