Retro1.org codex

User Tools

Site Tools

Trace: • TMSPROG
cdc:nos2.source:opl871:tmsprog

Table of Contents

TMSPROG

Table Of Contents

Source Code

TMSPROG.txt 
  1.       PROGRAM TMSPROG
  2. C
  3. C     *TMSPROG* CONTAINS THE *FTN5* PROGRAMS REQUIRED BY PROCEDURES
  4. C     ON *TMSPROC*.  TO BUILD ABSOLUTE BINARIES OF THESE PROGRAMS
  5. C     OFF OF THE SYSTEM *OPL*, USE THE FOLLOWING COMMANDS -
  6. C
  7. C       MODIFY,Z./*EDIT TMSPROG
  8. C       FTN5,I=COMPILE,B=LGO.
  9. C       LOAD,LGO.
  10. C       NOGO,TMSPROG,RECTMS,TMSBILL.
  11. C
  12. C     THE ABSOLUTE BINARIES WILL BE ON THE FILE *TMSPROG*.
  13. C
  14.       END
  15.       PROGRAM RECTMS(ACCFILE,FAMNAME,DIRFILE,TAPE1=ACCFILE,
  16.      1  TAPE2=FAMNAME,TAPE3=DIRFILE)
  17. C
  18. C     *RECTMS* IS USED BY THE *TMSDBLD* PROCEDURE TO CONVERT *TMS*
  19. C     ACCOUNT FILE MESSAGES INTO *TFSP* INPUT DIRECTIVES FOR TAPE
  20. C     CATALOG FILE RECOVERY.  THE FORMAT OF THE CALL IS -
  21. C
  22. C       RECTMS,ACCFILE,FAMNAME,DIRFILE.
  23. C
  24. C     WHERE -
  25. C       ACCFILE = LOCAL FILE NAME OF ACCOUNT FILE WITH *TMS* MESSAGES.
  26. C       FAMNAME = LOCAL FILE NAME OF FILE WITH ONE LINE OF INFORMATION
  27. C                 WITH THE STARTING TIME IN COLUMNS 1 THROUGH 6, A 1 IN
  28. C                 COLUMN 7 IF STARTING TIME IS AFTER MIDNIGHT, THE
  29. C                 ENDING TIME IN COLUMNS 8 THROUGH 13, AND A 1 IN
  30. C                 COLUMN 14 IF THE ENDING TIME IS AFTER MIDNIGHT.
  31. C       DIRFILE = LOCAL FILE NAME OF *TFSP* INPUT FILE.
  32. C
  33.       IMPLICIT INTEGER (A-Z)
  34.       CHARACTER LINE*40
  35.       CHARACTER FAM*7, START*8, END*8, TIME*8, LAST*8
  36.       CHARACTER FAMILY*7, MSGTYP*2, SUBTYP*2
  37.       CHARACTER STMAIN(0:1)*5, STOWNR(0:1)*6, STSITE(0:1)*3
  38.       CHARACTER STERRF(0:1)*5, STSYST(0:1)*3, STVTYP(0:3)*4
  39.       CHARACTER LABTYPE(0:3)*2, DENSIT7(1:3)*2, FINDS*1, FS*1, SEP*1
  40.       CHARACTER DENSIT9(3:5)*2, CONMODE(0:3)*2, FORMAT(0:5)*2
  41.       CHARACTER DENSITC(1:3)*2
  42.       LOGICAL AFTMID, B4MID, ENDB4M, ENDMID, STRMID
  43.       DATA BITMAIN, BITOWNR, BITSITE, BITERRF /16, 12, 3, 1/
  44.       DATA STMAIN /'AVAIL',  'HOLD'/
  45.       DATA STOWNR /'CENTER', 'USER'/
  46.       DATA STSITE /'ON',     'OFF' /
  47.       DATA STERRF /'CLEAR',  'SET' /
  48.       DATA STSYST /'NO',     'YES' /
  49.       DATA STVTYP /'MTNT', 'CT', ' ', 'AT'/
  50.       DATA START, END, LAST / 3*'00.00.00'/
  51.       DATA AFTMID, B4MID /.FALSE., .TRUE. /
  52.       DATA BT3LABT, BT2TTYP, BT3DENS, BT3CONV /15, 13, 9, 6/
  53.       DATA BT3FORM, BT2VTYP, BITSYST /0, 5, 7/
  54.       DATA LABTYPE /'KU', 'UN', 'KL', 'NS'/
  55.       DATA DENSIT7 /'HI', 'LO', 'HY'/
  56.       DATA DENSIT9 /'HD', 'PE', 'GE'/
  57.       DATA DENSITC /'CE', ' ', 'AE'/
  58.       DATA CONMODE /'AS', 'NU', 'AS', 'EB'/
  59.       DATA FORMAT  /'I ', 'SI', 'F ', 'S ', 'L ', 'LI'/
  60.  
  61. C     FUNCTION TO EXTRACT BIT N FROM INTEGER I
  62.       BIT (I, N) = AND (1, SHIFT (I, -N))
  63.  
  64. C     FUNCTION TO EXTRACT 2 BIT FIELD FROM INTEGER I WITH LSB AT N
  65.       BIT2 (I, N) = AND (3, SHIFT (I, -N))
  66.  
  67. C     FUNCTION TO EXTRACT 3 BIT FIELD FROM INTEGER I WITH LSB AT N
  68.       BIT3 (I, N) = AND (7, SHIFT (I, -N))
  69.  
  70. C     INITIALIZE VARIABLES
  71.  
  72.       READ (2, 10) FAM, (START (I:I+1), I=1,7,3), STRF,
  73.      1                  (END (J:J+1),   J=1,7,3), ENDF
  74. 10    FORMAT (A7/2(3A2,I1))
  75.       STRMID = STRF .EQ. 1
  76.       ENDMID = ENDF .EQ. 1
  77.       ENDB4M = .NOT. ENDMID
  78.  
  79. C     READ ACCOUNT FILE
  80.  
  81. 1000  READ (1, 20, END=2000) TIME, MSGTYP, SUBTYP, FAMILY, FS, LINE
  82. 20    FORMAT (1X, A8, 11X, A2, A2, 2X, A7, A1, A40)
  83.  
  84.       IF (TIME .LT. LAST) THEN
  85.         AFTMID = .TRUE.
  86.         B4MID  = .FALSE.
  87.         END IF
  88.  
  89.       LAST = TIME
  90.  
  91.       IF (STRMID) THEN
  92. C     START AFTER MIDNIGHT
  93.  
  94.         IF (B4MID) GO TO 1000
  95.         IF (START .GT. TIME) GO TO 1000
  96.         IF (END .LE. TIME) GO TO 2000
  97.  
  98.       ELSE IF (AFTMID) THEN
  99. C     START BEFORE MIDNIGHT, CURRENT TIME AFTER MIDNIGHT
  100.  
  101.         IF (ENDB4M) GO TO 2000
  102.         IF (END .LE. TIME) GO TO 2000
  103.  
  104.       ELSE
  105. C     START BEFORE MIDNIGHT, CURRENT TIME BEFORE MIDNIGHT
  106.  
  107.         IF (START .GT. TIME) GO TO 1000
  108.         IF (ENDB4M .AND. END.LE. TIME) GO TO 2000
  109.         END IF
  110.  
  111.       IF (MSGTYP .NE. 'SD') GO TO 1000
  112.       IF (FAMILY .NE. FAM) GO TO 1000
  113.       IF (SUBTYP .EQ. 'AU') THEN
  114. C     RESERVE MESSAGE
  115. C                           1234567890123456789012345678901234567890
  116. C     FORMAT   SDAU, FAMILYN/USERNAM/QNXXX/VSNFFF, VSNCCC.
  117.  
  118.         WRITE (3, 120) LINE (1:7), LINE (15:20), LINE (9:13)
  119. 120     FORMAT ('USER=',A7,',FILEV=',A6,'/',A5,
  120.      1            'B,RECOVER=YES')
  121.  
  122.         IF (LINE (15:20) .NE. LINE (23:28) .OR.
  123.      1      LINE (9:13) .NE. '00001')
  124.      2    WRITE (3, 130) LINE (23:28)
  125. 130       FORMAT ('AVSN=',A6)
  126.  
  127.         WRITE (3, 140)
  128. 140     FORMAT ('GO,DROP')
  129.  
  130.       ELSE IF (SUBTYP .EQ. 'CR') THEN
  131. C     RELEASE MESSAGE
  132. C                           1234567890123456789012345678901234567890
  133. C     FORMAT   SDCR, FAMILYN/USERNAM/QNXXX/VSNFFF.
  134. C     OR       SDCR, FAMILYN/USERNAM/QNXXX/VSNFFF,  YY/MM/DD.
  135. C              (IF CONDITIONAL RELEASE)
  136. C     OR       SDCR, FAMILYN/USERNAM/QNXXX/VSNFFF,  YYMMDD.
  137. C              (IF CONDITIONAL RELEASE FROM TFSP)
  138. C     OR       SDCR, FAMILYN/USERNAM/QNXXX/VSNFFF, .
  139. C              (IF CLEARING CONDITIONAL RELEASE DATE)
  140.  
  141.         IF (LINE (21:21) .EQ. '.') THEN
  142. C       UNCONDITIONAL RELEASE
  143.  
  144.           WRITE (3, 150) LINE (1:7), LINE (15:20), LINE (9:13)
  145. 150       FORMAT ('USER=',A7,',RELEASV=',A6,'/',A5,'B',/,'DROP')
  146.  
  147.         ELSE
  148. C       CONDITIONAL RELEASE
  149.  
  150.           IF (LINE (26:26) .EQ. '/') THEN
  151. C         RELEASE BY USER
  152.  
  153.           WRITE (3,160) LINE (1:7), LINE (15:20),
  154.      1                  (LINE (I:I+1), I = 24, 30, 3)
  155. 160       FORMAT ('USER=',A7,',FILEV=',A6,',RDATE=',3A2,/,'GO,GO')
  156.  
  157.           ELSE
  158. C         RELEASE BY TFSP
  159.  
  160.           WRITE (3,161) LINE (1:7), LINE (15:20),
  161.      1                  (LINE (I:I+1), I = 24, 28, 2)
  162. 161       FORMAT ('USER=',A7,',FILEV=',A6,',URDATE=',3A2,/,'GO,GO')
  163.  
  164.           ENDIF
  165.  
  166.           ENDIF
  167.  
  168.       ELSE IF (SUBTYP .EQ. 'AD' .OR. SUBTYP .EQ. 'RV') THEN
  169. C     VSN ADD OR REVISE
  170. C                           1234567890123456789012345678901234567890
  171. C     FORMAT   SDAD, FAMILYN, VSNESN, VSNPRN, SSSSSS.
  172. C     FORMAT   SDRV, FAMILYN, VSNESN, VSNPRN, SSSSSS.
  173.  
  174.         READ (LINE (18:23), '(O6)') STATUS
  175.         WRITE (3, 190) LINE (2:8), LINE (10:15),
  176.      1               STMAIN (BIT (STATUS, BITMAIN)),
  177.      2               STOWNR (BIT (STATUS, BITOWNR)),
  178.      3               STSITE (BIT (STATUS, BITSITE)),
  179.      4               STERRF (BIT (STATUS, BITERRF)),
  180.      5               STSYST (BIT (STATUS, BITSYST)),
  181.      6               STVTYP (BIT2 (STATUS, BT2VTYP))
  182. 190     FORMAT ('VSN=',A6,',PRN=',A6,',MAINT=',A,',OWNER=',A,',SITE=',
  183.      1          A/'ERRFLAG=',A,',SYSTEM=',A3,',VT=',A4,/,'GO')
  184.  
  185.       ELSE IF (SUBTYP .EQ. 'RM') THEN
  186. C     VSN REMOVE
  187. C                           1234567890123456789012345678901234567890
  188. C     FORMAT   SDRM, FAMILYN, VSNESN.
  189.  
  190.         WRITE (3, 200) LINE (2:7)
  191. 200     FORMAT ('REMOVE=',A6)
  192.  
  193.       ELSE IF (SUBTYP .EQ. 'AM') THEN
  194. C     TSITE/TOWNER CHANGE
  195. C                           1234567890123456789012345678901234567890
  196. C     FORMAT   SDAM, FAMILYN, USERNAM, VSNFFF, SSSSSS.
  197.  
  198.         READ (LINE (19:24), '(O6)') STATUS
  199.         WRITE (3, 210) LINE (2:8), LINE (11:16),
  200.      1               STOWNR ( BIT (STATUS, BITOWNR)),
  201.      2               STSITE ( BIT (STATUS, BITSITE))
  202. 210     FORMAT ('USER=',A7,',FILEV=',A6,',TOWNER=',A,',TSITE=',A,
  203.      1          /,'GO,DROP')
  204.  
  205.         ENDIF
  206.  
  207.       IF (SUBTYP .EQ. 'RA') THEN
  208.  
  209. C     *TMS* RECOVERY INFORMATION
  210. C                           1234567890123456789012345678901234567890
  211. C     FORMAT   SDRA, FAMILYN/USERNAM/QNXXX/VSNFFF, TFD/PASSWRD.
  212. C        IF *PASSWRD* IS NULL, THE FORMAT IS THE FOLLOWING -
  213. C              SDRA, FAMILYN/USERNAM/QNXXX/VSNFFF, TFD.
  214. C     OPTIONAL SDRB, FAMILYNYLOGICAL*FILE*IDNTXPHYSICAL*FILE*IDT.
  215. C     END MSG  SDRC, FAMILYN/CONTROLWRDX/CHRGNUMBER, MULSIDY.
  216.  
  217.         READ (LINE (23:25), '(R3)') STATUS
  218.         STATUS = STATUS - O"10101"
  219.         WRITE (3, 1400) LINE (1:7), LINE (15:20), LINE (9:13),
  220.      1                  LABTYPE (BIT3 (STATUS, BT3LABT)),
  221.      2                  CONMODE (BIT3 (STATUS, BT3CONV)),
  222.      3                  FORMAT  (BIT3 (STATUS, BT3FORM)),
  223.      4                  LINE (27:33)
  224. 1400    FORMAT ('USER=',A7,',FILEV=',A6,'/',A5,
  225.      1          'B,RECOVER=YES,LB=',A2,',CV=',A2,',F=',A2,',PW=',A7)
  226. 1410    FORMAT ('D=',A2)
  227.  
  228.         IF (BIT2 (STATUS, BT2TTYP) .EQ. 0) THEN
  229.           WRITE (3, 1410) DENSIT7 (BIT3 (STATUS, BT3DENS))
  230.         ELSE IF (BIT2 (STATUS, BT2TTYP) .EQ. 2) THEN
  231.           WRITE (3, 1410) DENSIT9 (BIT3 (STATUS, BT3DENS))
  232.         ELSE
  233.           WRITE (3, 1410) DENSITC (BIT2 (STATUS, BT2TTYP))
  234.         END IF
  235.  
  236.       ELSE
  237.         GOTO 1000
  238.       END IF
  239.  
  240. 1500  READ (1, 20, END=1600) TIME, MSGTYP, SUBTYP, FAMILY, FS, LINE
  241.  
  242.       IF (TIME .LT. LAST) THEN
  243.         AFTMID = .TRUE.
  244.         B4MID  = .FALSE.
  245.         END IF
  246.  
  247.       LAST = TIME
  248.  
  249.       IF (STRMID) THEN
  250. C     START AFTER MIDNIGHT
  251.  
  252.         IF (B4MID) GO TO 1500
  253.         IF (START .GT. TIME) GO TO 1500
  254.         IF (END .LE. TIME) GO TO 1600
  255.  
  256.       ELSE IF (AFTMID) THEN
  257. C     START BEFORE MIDNIGHT, CURRENT TIME AFTER MIDNIGHT
  258.  
  259.         IF (ENDB4M) GO TO 1600
  260.         IF (END .LE. TIME) GO TO 1600
  261.  
  262.       ELSE
  263. C     START BEFORE MIDNIGHT, CURRENT TIME BEFORE MIDNIGHT
  264.  
  265.         IF (START .GT. TIME) GO TO 1500
  266.         IF (ENDB4M .AND. END .LE. TIME) GO TO 1600
  267.         END IF
  268.  
  269.       IF (MSGTYP .NE. 'SD') GO TO 1500
  270.       IF (FAMILY .NE. FAM) GO TO 1500
  271.       IF (SUBTYP .EQ. 'RB') THEN
  272.  
  273.         SEP = FINDS ( LINE, 1, 17, LINE (18:18))
  274.         WRITE (3, 1510) LINE (18:18), SEP, LINE (1:17), SEP, SEP
  275. 1510    FORMAT ('COLON=',A1,',SEPARAT=',A1,',FI=',A17,A1,'SEPARAT=',A1,
  276.      1          'COLON=,SV=SET')
  277.  
  278.         SEP = FINDS ( LINE, 19, 35, FS)
  279.         WRITE (3, 1515) FS, SEP, LINE (19:35), SEP, SEP
  280. 1515    FORMAT ('COLON=',A1,',SEPARAT=',A1,',PI=',A17,A1,'SEPARAT=',A1,
  281.      1          'COLON=')
  282.  
  283.         GOTO 1500
  284.       END IF
  285.  
  286.       IF (SUBTYP .EQ. 'RC') THEN
  287.  
  288.         SEP = FINDS ( LINE, 9, 18, LINE (11:11))
  289.         WRITE (3, 1530) LINE (13:22), LINE (11:11), SEP, LINE (1:10),
  290.      1                  SEP, SEP
  291. 1530    FORMAT ('CN=',A10,',COLON=',A1,',SEPARAT=',A1,',UC=',A10,A1,
  292.      1          'SEPARAT=',A1,'COLON=')
  293.  
  294.         SEP = FINDS ( LINE, 25, 30, LINE (31:31))
  295.         WRITE (3, 1535) LINE (31:31), SEP, LINE (25:30), SEP, SEP
  296. 1535    FORMAT ('COLON=',A1,',SEPARAT=',A1,',SI=',A6,A1,
  297.      1          'SEPARAT=',A1,'COLON=')
  298.  
  299.       END IF
  300.  
  301. 1600  WRITE (3,1610)
  302. 1610  FORMAT ('GO,DROP')
  303.  
  304.       GO TO 1000
  305.  
  306. C     END OF DAYFILE
  307. 2000  WRITE (3, 220)
  308. 220   FORMAT ('GO')
  309.  
  310.           END
  311.       CHARACTER*1 FUNCTION FINDS ( ARR, FC, LC, FS)
  312.       IMPLICIT INTEGER (A-Z)
  313.       CHARACTER ARR*40, FS*1
  314.  
  315.       CALL COLSEQ('DISPLAY')
  316.       SC = ICHAR(FS)
  317. 1     SC = SC - 1
  318.  
  319.  
  320.       FINDS = CHAR(SC)
  321.       IF (FINDS .EQ. ' ') GOTO 1
  322.  
  323.       DO 2 I = FC, LC
  324.       IF (ARR(I:I) .EQ. FINDS) GOTO 1
  325. 2     CONTINUE
  326.  
  327.       RETURN
  328.       END
  329.       PROGRAM TMSBILL(MREAD=/300,TAPE2,TAPE1=MREAD)
  330. C
  331. C     *TMSBILL* IS USED BY *GENTMS* TO CONVERT A *TFSP* MACHINE
  332. C     READABLE OUTPUT FILE INTO A *TFDUMP* FORMATTED FILE.  THE FORMAT
  333. C     OF THE CALL IS -
  334. C
  335. C       TMSBILL,MREAD,TAPE2.
  336. C
  337. C     WHERE -
  338. C       MREAD = LOCAL FILE NAME OF THE MACHINE READABLE FILE GENERATED
  339. C               BY THE *TFSP* *MREADUN=* DIRECTIVE.
  340. C       TAPE2 = LOCAL FILE NAME OF THE *TFDUMP* FILE.
  341. C
  342.  100  FORMAT(1X,3A7,2A10,24X,6A2,77X,A6,12X,A6,8X,A6,24X,A6)
  343.  200  FORMAT(2A7,"000000",A6,1X,A3,"0000000001",
  344.      C    1X,A2,"/",A2,"/",A2,".",1X,A2,".",A2,".",A2,".",
  345.      C    A7,2X,"E",2A10)
  346.       INTEGER FAM,UN,VSN,CN,PN(2),YR,MO,DY,HR,MI,SC,OWNER
  347.       INTEGER OLDVSN,MT,UT
  348.       INTEGER LVSN,NVSN,RDATE,RD
  349.       MT="MT "
  350.       UT="UT "
  351.       OLDVSN=0
  352.       LVSN=0
  353.       RDATE="      "
  354.  300  CONTINUE
  355.       READ(1,100,END=400)FAM,UN,CN,PN,YR,MO,DY,HR,MI,SC
  356.      C  ,VSN,NVSN,OWNER,RD
  357.       IF(VSN.NE.LVSN)THEN
  358.         RDATE=RD
  359.       ENDIF
  360.       IF(RDATE.EQ."      ")THEN
  361.       IF(VSN.NE.OLDVSN)THEN
  362.           IF(OWNER.EQ.6HCENTER)THEN
  363.               WRITE(2,200)FAM,UN,VSN,MT,YR,MO,DY,HR,MI,SC,CN,PN
  364.           ELSE
  365.               WRITE(2,200)FAM,UN,VSN,UT,YR,MO,DY,HR,MI,SC,CN,PN
  366.           ENDIF
  367.       ENDIF
  368.       ENDIF
  369.       LVSN=NVSN
  370.       OLDVSN=VSN
  371.       GOTO 300
  372.  400  CONTINUE
  373.       STOP
  374.       END
cdc/nos2.source/opl871/tmsprog.txt · Last modified: 2023/08/05 17:24 by Site Administrator