Retro1.org codex

*DECK OPENSIO 
      PROC OPENSIO( (FET),(OPTION), STATIS ); 
      BEGIN # OPENSIO # 
      CONTROL NOLIST;        # EXECUSRS                                #
      CONTROL LIST; 
*IF DEF,IMS 
 #
**
* 
*     1. PROC NAME           AUTHOR              DATE 
*        OPENSIO             M. D. PICKARD       77/01/10 
* 
*     2. FUNCTIONAL DESCRIPTION 
*        OPENSIO WILL OPEN AN EXISTING SUPIO RANDOM FILE OR CREATE
*        A NEW SUPIO RANDOM FILE. 
* 
*     3. METHOD USED
*        IF THE FET IS RANDOM, THE FILE IS OPENED W/ ALTER IF THE 
*        OPTION IS NEW OR W/ THE OPTION IF OPTION IS NOT NEW. IF THE
*        OPEN IS SUCCESSFUL AND THE OPTION WAS NEW, THE INITIAL SUPIO 
*        INDEX IS BUILT.  IF THE OPTION WAS NOT NEW THE INDEX IS
*        CHECKED TO SEE IF IT IS A SUPIO INDEX AND THAT THE INDEX 
*        AREA LENGTH IS LARGE ENOUGH.  IF THE AREA IS NOT LARGE 
*        ENOUGH, THE NEEDED LENGTH IS PLACE IN THE FIRST WORD OF THE
*        INDEX AREA 
* 
*     4. ENTRY PARAMETERS 
*        FET                 ADDRESS OF THE FET 
*                            THE FET MUST CONTAIN THE INDEX BUFFER
*                            FWA AND LENGTH IN WORD FET+7 
*        OPTION              OPEN OPTION
*                              0 - READ/WRITE WITH REWIND 
*                              "NEW" - OPEN W/ ALTER AS NEW FILE
*                              "ALTER" - READ/WRITE, REWIND 
*                              "ALTERNR" - READ/WRITE, NO REWIND
*                              "NR" - NO REWIND 
*                              "READ" - READ, REWIND
*                              "READNR" - READ, NO REWIND 
*                              "WRITE" - WRITE, REWIND
*                              "WRITENR" - WRITE, NO REWIND 
* 
*     5. EXIT PARAMETERS
*        STATIS              RETURN STATUS
*                              0 = OPEN SUCCESSFUL
*                              NOTSIOF - NOT A SUPIO FILE 
*                              INDXSML - INDEX AREA TO SMALL
*                              INDXERR - INDEX POINTER IN ERROR 
*                              RANRSEQ - RANDOM REQ. ON SEQ. FILE 
* 
*     6. COMDECKS CALLED
*        SIODEFS             SUPIO SYMPL DEFS 
*        SIOBASE             SUPIO BASED ARRAY DEFINITIONS
* 
*     7. ROUTINES CALLED
*        OPEN                MACREL OPEN SYMPL INTERFACE
*        RECALL              MACREL CPU RECALL SYMPL INTERFACE
* 
*     8. DAYFILE MESSAGES 
*        NONE.
* 
 #
*ENDIF
*CALL SIODEFS 
*CALL SIOBASE 
      ITEM
           FET U,            # FET ADDRESS                             #
           OPTION C(10),     # OPEN OPTION                             #
           STATIS U,         # RETURN STATUS                           #
           TEMP C(10);       # FOR INTEGER TO CHARACTER CONVERSION     #
      XREF
        BEGIN 
        PROC ABORT; 
        PROC MESSAGE; 
        PROC OPEN;
        PROC RECALL;
        FUNC XCOD C(10);
        END 
 
      DEF INDXAT # O"23" #; # INDEX BUFFER TOO SMALL ABN. TERM. CODE   #
 
      ARRAY ABNTMSG [0:0] S(4); 
        BEGIN 
        ITEM ABNTMSG1 C(0,0,33) = ["OPEN ERROR, ABN. TERM. CODE = XX."];
        ITEM ABNTMSG2 C(3,0,2); 
        ITEM ABNTMSGZ U(3,18,42) = [ 0 ]; 
        END 
 
      P<SIOFET> = FET;       # FORMAT FET                              #
      IF FETRAN[0]
      THEN                   # FET IS A RANDOM FET                     #
        BEGIN                # SEE IF INDEX POINTERS ARE OK            #
        IF ( FETINDX[0] GQ 2 ) AND ( FETINDL GQ MINSIOI ) 
        THEN                 # INDEX POINTERS OK                       #
          BEGIN              # SEE IF OPTION IS NEW                    #
          P<SIOINDX> = FETINDX[0]; # FORMAT INDEX AREA                 #
          FETFST[0] = FETINDX[0]; # SET CIRCULAR BUFFER PARAMS FOR     #
                             # EXISTING FILES                          #
          FETIN[0] = FETINDX[0];
          FETOUT[0] = FETINDX[0]; 
          FETLMT[0] = FETINDX[0] + FETINDL[0] + 1;
          FETEP[0] = TRUE;
          IF OPTION EQ "NEW"
          THEN
            OPEN(SIOFET,"ALTER"); # OPEN W/ ALTER                      #
          ELSE
            OPEN(SIOFET,OPTION); # OPEN W/ SPECIFIED OPTION            #
          RECALL(SIOFET);    # WAIT TIL COMPLETE BIT SET               #
          FETEP[0] = FALSE; 
          IF FETABNT[0] EQ INDXAT 
          THEN               # INDEX BUFFER TOO SMALL                  #
            BEGIN 
            FETABNT[0] = 0;  # CLEAR FOR NEXT USER OF FET              #
            STATIS = INDXSML; # INDEX AREA TOO SMALL                   #
            RETINDL[0] = (LINDX[0] + 1) * 2; # NEEDED SIZE             #
            RETURN;          # ***** EXIT *****                        #
 
            END 
          IF FETABNT[0] NQ 0
          THEN               # OPEN ERROR                              #
            BEGIN 
            TEMP = XCOD(FETABNT[0]);
            ABNTMSG2[0] = C<8,2>TEMP; 
            MESSAGE(ABNTMSG,3); 
            ABORT;
            END 
          IF FETRAN[0]
          THEN               # OPEN WAS SUCCESSFUL                     #
            BEGIN            # SEE IF OPTION WAS NEW                   #
            IF OPTION EQ "NEW"
            THEN             # OPTION IS NEW                           #
              BEGIN          # OPTION IS NEW, INITIALIZE SUPIO INDEX   #
              SIONAME[0] = "SUPIOINDEX"; # SUPIO INDEX NAME IN HEADER  #
              CINDX[0] = 0;  # INITIALIZE CURRENT POSITION             #
              LINDX[0] = 0;  # INITIALIZE LAST INDEX ORDINAL USED      #
              HDRRSV[0] = 0; # CLEAR HEADER RESERVED                   #
              STATIS = 0;    # SUCCESSFUL COMPLETE                     #
              END 
            ELSE             # OPTION WAS NOT NEW                      #
              BEGIN          # SEE IF FILE WAS A SUPIO FILE            #
              IF SIONAME[0] NQ "SUPIOINDEX" 
              THEN           # NOT A SUPIO INDEX                       #
                BEGIN 
                STATIS = NOTSIOF; # NOT A SUPIO FILE                   #
                END 
              ELSE           # FILE IS SUPIO FILE                      #
                BEGIN        # SEE IF INDEX BUFFER WAS BIG ENOUGH      #
                IF ( ( LINDX[0] + 1 ) * SIOINDL ) GR FETINDL[0] 
                THEN         # INDEX TOO SMALL                         #
                  BEGIN 
                  STATIS = INDXSML; # INDEX AREA TOO SMALL             #
                  RETINDL[0] = ( LINDX[0] + 1 ) * 2; # NEEDED SIZE     #
                  END 
                ELSE
                  STATIS = 0; # EVERYTHING IS OK.                      #
                END 
              END 
            END 
          ELSE               # FILE NOT SUPIO FILE, RANDOM BIT CLEARED #
            STATIS = RANRSEQ; # RANDOM REQUEST ON SEQUENTIAL FILE      #
          END 
        ELSE                 # INDEX POINTERS NOT GOOD                 #
          STATIS = INDXERR;  # INDEX POINTER ERROR ON OPEN             #
        END 
      ELSE                   # FET IS NOT A RANDOM FET                 #
        STATIS = RANRSEQ;    # RANDOM REQUEST ON SEQUENTIAL FILE       #
      RETURN; 
      END 
      TERM # OPENSIO #