home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / modcomp / posusl. < prev    next >
Text File  |  2020-01-01  |  7KB  |  169 lines
  1.           PGM         POSUSL
  2.           INT         POSUSL
  3. *
  4. *         SUBROUTINE POSUSL (FILNUM,MEMBER,FOUND)
  5. *
  6. *     ****************************************************************
  7. *
  8. *              KERMIT for the MODCOMP MAXIV operating system
  9. *
  10. *        Compliments of:
  11. *
  12. *                         SETPOINT, Inc.
  13. *                      10245 Brecksville Rd.
  14. *                      Brecksville, Ohio 44141
  15. *
  16. *
  17. *      KERMIT is a copyrighted protocol of Columbia Univ. The authors
  18. *      of this version hereby grant permission to copy this software
  19. *      provided that it is not used for an explicitly commercial
  20. *      purpose and that proper credit be given. SETPOINT, Inc. makes
  21. *      no warranty whatsoever regarding the accuracy of this package
  22. *      and will assume no liability resulting from it's use.
  23. *
  24. *     ****************************************************************
  25. *
  26. *     Abstract: Position a FORTRAN file to a SED directory entry.
  27. *
  28. *     MODIFICATION HISTORY
  29. *
  30. *     BY            DATE     REASON            PROGRAMS AFFECTED
  31. *
  32. *     ****************************************************************
  33. *
  34. *     Author:  Rick Burke           Version:  A.0   Date: Aug-86
  35. *
  36. *     Calling Parameters:
  37. *
  38. *     FILNUM       - Integer FORTRAN file number to be positioned
  39. *                    If FILNUM < 1600 then it is assumed to be an
  40. *                    integer FORTRAN logical unit number.  If it
  41. *                    is >= 1600 it is assumed to be the CAN code
  42. *                    of the logical device name.
  43. *
  44. *     MEMBER       - 8 character member name
  45. *
  46. *     FOUND        - Logical status for position,
  47. *                    .TRUE.  = Successful
  48. *                    .FALSE. = Error condition
  49. *
  50. *     ****************************************************************
  51. *
  52. *     Messages generated by this module :  None
  53. *
  54. *     ****************************************************************
  55. *
  56. *     Subroutines called directly : None
  57. *
  58. *     ****************************************************************
  59. *
  60. *     Files referenced :  None
  61. *
  62. *     ****************************************************************
  63. *
  64. *     Local variable definitions :
  65. *
  66. *     ATTACH       - Name of an attached USL directory
  67. *     POSUFT       - UFT assigned to logical file containing
  68. *                    requested entry
  69. *     BUFFER       - Sector-sized file buffer
  70. *
  71. *     ****************************************************************
  72. *
  73. *     Commons referenced :  None
  74. *
  75. *     ****************************************************************
  76. *
  77. *     (*$END.DOCUMENT*)
  78. *
  79. *     ****************************************************************
  80. *
  81. *     Code starts here :
  82. *
  83. POSUSL    TRR,1,8                       SAVE LINKKAGE
  84.           ADX,8,8                       GENERATE RETURN ADDRESS
  85.           ABR,8,15                       *
  86.           LDS,2,0                       CHECK ARGUMENT COUNT
  87.           SBR,2,14                       *
  88.           SBRB,2,15   BADARG             *
  89.           LDS,9,3                       GET "FOUND" ADDRESS
  90.           LDS,3,1                       GET FILE NUMBER
  91.           LDX,3,3                        *
  92.           HNS,FILNAM                    CHECK FILE NUMBER OR NAME
  93.           CRI,3       #0640             CHECK FILE NUMBER / NAME
  94.           HGE,FILNAM                     *
  95.           REX,#3A                       CONVERT TO ASCII
  96.           LLD,2,8                       REPOSIION
  97.           REX,#37                       CONVERT TO CAN CODE
  98.           DFC         RETURN            ERROR - BAD NUMBER
  99. FILNAM    STM,3       POSUFT+1          PLACE IN UFT
  100.           LDS,2,2                       GET MEMBER NAME ADDRESS
  101.           LFX,2,2                       GET MEMBER NAME
  102.           REX,#37                       CAN BYTES 1-3
  103.           DFC         ERROR              *
  104.           XOR,3,4                       SWAP R3 & R4
  105.           XOR,4,3                        *
  106.           XOR,3,4                        *
  107.           LLD,2,8                       POSITION BYTES 4-6
  108.           REX,#37                       CAN BYTES 4-6
  109.           DFC         ERROR              *
  110.           TRR,2,5                       GET BYTES 7-8
  111.           TRR,5,3                       HOLD BYTES 4-6 IN R5
  112.           LBR,3,2                       LAST BYTE IS SPACE
  113.           REX,#37                       CAN BYTES 7-8
  114.           DFC         ERROR              *
  115.           TRR,6,3                       MOVE BYTES 7-8 TO R6
  116.           LDI,2       POSUFT            LOAD UFT
  117.           ZRR,3                         AND RESET IT
  118.           STM,3,2     5                  *
  119.           STM,3       ATTACH            AND RESET ATTACHED FILE
  120.           REX,2                         REWIND INPUT FILE
  121.           REX,0                         READ FIRST RECORD
  122.           DFC         BUFFER             *
  123.           DFC         256                *
  124.           LDM,3       BUFFER            LOAD FIRST WORD
  125.           ABRB,3,15   ERROR             CHECK DIRECTORY PRESENT
  126.           LDM,3       BUFFER+2          GET # ENTRIES PER SECTOR
  127. NXSCTR    LDI,1       BUFFER            LOAD BUFFER ADDRESS
  128.           TRR,8,3                       NUMBER OF ENTRIES PER SECTOR
  129. NXNTRY    LFS,12,2                      LOAD ENTRY NAME
  130.           TRR,2,12                      CHECK END OF LIST
  131.           ABRB,2,15   MORE               *
  132. ERROR     GMR,2,15                      RETURN FOUND = .FALSE.
  133. RETURN    STX,2,9                        *
  134.           BRX,10                         *
  135. MORE      CRI,12      #FEFE             CHECK FILE ENTRY
  136.           HZR,CKNAME                     *
  137.           STM,13      ATTACH            SAVE FILE ENTRY FILE NAME
  138.           HOP,NOTIT                     AND KEEP CHECKING
  139. CKNAME    CRRT,4,12                     CHECK NAME = MEMBER WANTED
  140.           HZR,NOTIT                      *
  141.           LDS,5,8                       LOAD SECTOR ADDRESS OF ENTRY
  142.           LDM,2       ATTACH            CHECK USL FILE
  143.           HZS,POSIT                      *
  144.           STM,2       $+5               NO - ATTACHED FILE
  145.           LDI,2       POSUFT            ASSIGN TO THE ATTACHED FILE
  146.           REX,#A                         *
  147.           DFC         $$                 *
  148. POSIT     LDI,2       POSUFT            POSITION THE FILE
  149.           STM,5,2     3                 SET THE RECORD POSITION
  150.           REX,5                         ADVANCE RECORD
  151.           REX,4                         BACKSPACE RECORD
  152.           ZRR,2                         SET FOUND = .TRUE.
  153.           HOP,RETURN                     *
  154. NOTIT     ADI,1       9                 POINT TO NEXT ENTRY
  155.           SBRB,8,15   NXNTRY            CHECK MORE ENTRIES
  156.           LDM,2       BUFFER+1          LOAD NEXT SECTOR ADDRESS
  157.           STM,2       POSUFT+3          NEXT SECTOR TO READ
  158.           LDI,2       POSUFT            READ NEXT SECTOR
  159.           REX,0                          *
  160.           DFC         BUFFER             *
  161.           DFC         256                *
  162.           BRU         NXSCTR            GO SEARCH NEXT DIRECTORY SECTOR
  163. BADARG    REX,#13                       ABORT
  164.           DFC         @ARG              REASON = "ARG"
  165. ATTACH    DFC         $$
  166. POSUFT    DFC         0,$$,#A400,0,0,0
  167. BUFFER    RES         128
  168.           END
  169.