! 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