COMCSRT 
COMMON
          CTEXT  COMCSRT - SET RECORD TYPE. 
 SRT      SPACE  4
          IF     -DEF,QUAL$,1 
          QUAL   COMCSRT
          BASE   D
*         COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 SRT      SPACE  4
***       SRT - SET RECORD TYPE.
*         G. R. MANSFIELD.  70/10/09. 
*         ADAPTED FROM SUBROUTINE *CPT* IN *LIBEDIT*. 
* 
*                *SRT* IDENTIFIES THE FORMAT OF A RECORD FROM THE DATA
*         LOCATED IN A WORKING BUFFER DEFINED BY THE CALLER.
*         THE TYPE IS RETURNED AS FOLLOWS - 
* 
*         NUMBER TYPE        FORMAT 
* 
*         0      TEXT        UNRECOGNIZED 
*         1      PP          PP PROGRAM 
*         3      REL         RELOCATABLE SUBPROGRAM 
*         4      OVL         OVERLAY
*         5      ULIB        USER LIBRARY 
*         6      OPL         MODIFY OPL DECK
*         7      OPLC        MODIFY OPL COMMON DECK 
*         8      OPLD        MODIFY OPL DIRECTORY 
*         9      ABS         ABSOLUTE PROGRAM 
*         10     PPU         PPU PROGRAM
*         14     CAP         FAST DYNAMIC LOAD CAPSULE
*         16     PROC        PROCEDURE RECORD 
*         20     PPL         16-BIT PP PROGRAM
* 
*         IF TYPE NUMBER AND RECORD NAME = 0, RECORD IS ZERO LENGTH.
* 
*         ENTRY  (X1) = LAST WORD ADDRESS + 1 OF DATA.
*                (X2) = START OF BLOCK IN MEMORY. 
*                (B1) = 1.
* 
*         EXIT   (X6) = RECORD NAME AND TYPE. 
*                (X7) = RECORD NAME, 0 FILL.
* 
*         USES   X - 0, 1, 2, 3, 4, 6, 7. 
*                B - 2, 3.
*                A - 1, 2, 4. 
          SPACE  4,10 
*         CALL *COMSSRT* IF NOT ALREADY CALLED. 
  
*CALLC    COMSSRT 
  
  
 SRT15    MX6    0           CLEAR NAMES
          SX7    B0 
  
 SRT      PS                 ENTRY/EXIT 
          IX6    X1-X2       NUMBER OF DATA WORDS 
          ZR     X6,SRT15    IF ZERO LENGTH RECORD
          SX4    B1+B1
          SX7    X6-2        NUMBER OF DATA WORDS - 2 
          SA1    X2          CHECK FIRST WORD 
          BX6    X1          (X6) = PROGRAM NAME
          MX0    -12
          LX2    X1          (X2) = RECORD NAME 
          LX1    12 
          BX3    -X0*X1 
          SB3    X3-7700B 
          NZ     B3,SRT1     IF NO 7700 TABLE 
          SA2    A1+B1       GET NAME FROM 7700 TABLE 
  
*         CHECK FOR A VALID 7700 TABLE. 
*         THERE MUST BE WC+2 DATA WORDS FOR A VALID 7700 TABLE. 
  
          LX1    12          CHECK 7700 WORD COUNT .LE. REAL LENGTH 
          BX3    -X0*X1 
          IX7    X7-X3
          PL     X7,SRT0     IF VALID 7700 TABLE
          SA2    A1          GET TEXT RECORD NAME 
          SX3    B0          PROCESS AS TEXT RECORD 
 SRT0     SB2    B0          REPORT *TEXT* FOR *UCF* TYPE 
          ERRNZ  TXRT        CODE ASSUMES VALUE 
          ZR     X3,SRT12    IF UPDATE COMPRESSED COMPILE FILE
          SB3    X2          CHECK SEQUENCE NUMBER
          NZ     B3,SRT12    IF MODIFY COMPRESSED COMPILE FILE
  
*         CHECK FIRST WORD BEYOND 7700 TABLE FOR *LDSET* TABLE. 
  
          SB3    X3          GET FIRST WORD BEYOND 7700 TABLE 
          SA1    A2+B3
          BX6    X1 
          LX1    12          POSITION FOR 7000 TABLE CHECK
          BX3    -X0*X1 
          IX7    X7-X4       INSURE WORD AFTER *LDSET* TABLE
  
*         CHECK FOR *OPLD* AND *LDSET* TABLES.
*         THERE MAY OR MAY NOT BE A 7700 TABLE. 
*         THERE MUST BE WC+1 MORE DATA WORDS FOR A VALID 7000 TABLE.
  
 SRT1     SB2    X3-7000B 
          NZ     B2,SRT2     IF NO 7000 TABLE 
          LX1    12          CHECK FOR WC = 0 (*OPLD* TABLE)
          BX3    -X0*X1 
          ZR     X3,SRT5     IF OPLD TYPE 
          SB3    X3+B1
          SX7    X7+B1       IGNORE FIRST WORD IF NO 7700 TABLE 
          SB2    B0          SET TEXT RECORD TYPE 
          ERRNZ  TXRT        CODE ASSUMES VALUE 
          IX7    X7-X3
          NG     X7,SRT12    IF NOT VALID 7000 TABLE
          SA1    A1+B3
          BX6    X1          (X6) = FIRST WORD OF PROGRAM 
  
*         CHECK FOR AND PROCESS CONTROL LANGUAGE PROCEDURE RECORDS. 
  
 SRT2     SA4    SRTB        CHECK FOR .PROC, 
          MX0    36 
          BX3    X0*X6
          BX4    X3-X4
          NZ     X4,SRT5     IF NOT .PROC,
          LX6    36          GET FIRST FOUR LETTERS OF NAME 
          MX0    24 
          BX6    X0*X6
          SA1    A1+B1       GET LAST THREE CHARACTERS OF NAME
          MX0    18 
          BX4    X0*X1
          LX4    -24
          BX6    X6+X4
          MX0    -6 
          LX4    X6 
          SB2    -B1
          SB3    7
 SRT3     LX4    6
          BX3    -X0*X4 
          SX2    X3-1R9-1    CHECK FOR SEPARATOR
          PL     X2,SRT4     IF END OF NAME 
          SB3    B3-1 
          SB2    B2+6 
          NZ     B3,SRT3     IF SEVEN LETTERS NOT PROCESSED YET 
 SRT4     MX0    1           BUILD MASK 
          AX0    B2 
          SX2    PRRT        TYPE = PROC
          BX7    X0*X6
          IX6    X7+X2
          PL     B2,SRT      RETURN IF NAME PRESENT 
          SX7    1R          RETURN SPACE FOR NAME
          LX7    48 
          BX6    X7+X2
          EQ     SRT
  
*         IDENTIFY PP PROGRAM FORMAT. 
*                CHARACTER 3 " 0, 
*                CHARACTER 4 = 0, 
*                BYTE 3 = 0,
*                BYTE 4 " 0.
*                IF CHARACTER 1 IS ALPHA, BYT2 2 " 0. 
  
 SRT5     SA1    SRTA        =77000077770000B 
          SB2    B0          TYPE = TEXT
          ERRNZ  TXRT        CODE ASSUMES VALUE 
          BX3    X1*X6       CHECK FOR NAME @ 3-CHARACTERS AND BYTE 3=0 
          MX0    12 
          BX1    X0*X6       CHECK FOR NUMERIC FIRST CHARACTER
          LX0    48 
          BX4    X0*X6       CHECK FOR 3-CHARACTER NAME 
          LX1    12 
          LX0    48 
          NZ     X3,SRT7     IF NAME .GT. 3 CHARACTERS OR BYTE 3 .NE. 0 
          ZR     X4,SRT7     IF NAME .LT. 3 CHARACTERS
          SB3    X1-2R0A
          BX3    X0*X6
          MX0    6
          LX0    54 
          BX7    X0*X6
          ZR     X7,SRT7     IF CHARACTER TWO = 0 
          PL     B3,SRT6     IF NUMERIC PP NAME 
          ZR     X3,SRT7     IF NO LOAD ADDRESS 
 SRT6     MX0    18 
          SB3    X6 
          ZR     B3,SRT12    IF ZERO LENGTH PROGRAM 
          SB2    B1          TYPE = PP
          ERRNZ  PPRT-1      CODE ASSUMES VALUE 
          BX2    X0*X2
          EQ     SRT12       EXIT 
  
*         CHECK FOR.
*                REL
*                ULIB 
*                OPL
*                OPLC 
*                OPLD 
*                ABS
*                PPU
  
 SRT7     SB2    RLRT        TYPE = REL 
          SB3    X1-3400B 
          ZR     B3,SRT12    IF RELOCATABLE 
          SB2    ULRT        TYPE = ULIB
          SB3    X1-7600B 
          ZR     B3,SRT12    IF USER LIBRARY
          SB2    OPRT        TYPE = OPL 
          SB3    X1-7001B 
          ZR     B3,SRT12    IF OLD PROGRAM LIBRARY 
          SB2    OCRT        TYPE = OPLC
          SB3    X1-7002B 
          ZR     B3,SRT12    IF OPL COMMON DECK 
          SB2    ODRT        TYPE = OPLD
          SB3    X1-7000B 
          ZR     B3,SRT12    IF OPL DIRECTORY 
          SB2    CART        TYPE = CAP 
          SB3    X1-6000B 
          ZR     B3,SRT12    IF CAP 
          SB2    PLRT        TYPE = PPL 
          SB3    X1-6100B 
          ZR     B3,SRT12    IF 16-BIT PP PROGRAM 
          SB2    ABRT        TYPE = ABS 
          SB3    X1-5400B 
          NZ     B3,SRT8     IF NOT *5400* TABLE
          LX0    12 
          BX0    X0*X6       CHECK OVERLAY LEVELS 
          ZR     X0,SRT12    IF 00,00 OVERLAY 
          JP     SRT10       CHECK NAME 
  
 SRT8     SB3    X1-5300B 
          NZ     B3,SRT9     IF NOT *ACPM* TYPE 
          SB3    X6+
          NG     B3,SRT12    IF NOT ABS TYPE *ACPM* 
          JP     SRT10       CHECK NAME 
  
 SRT9     SB3    X1-5100B 
          ZR     B3,SRT12    IF ABS 
          SB2    PURT        TYPE = PPU 
          SB3    X1-5200B 
          ZR     B3,SRT12    IF PPU 
          SB3    X1-5000B 
          NZ     B3,SRT11    IF NOT OVERLAY 
 SRT10    SB2    OVRT        TYPE = OVL 
          BX7    X2-X6
          NZ     X7,SRT12    IF NAME .NE. FIRST WORD OF PROGRAM 
 SRT11    SB2    B0+         TYPE = TEXT
          ERRNZ  TXRT        CODE ASSUMES VALUE 
  
*         SET NAME AND TYPE.
  
 SRT12    MX0    42 
          SX4    1R          CHECK FOR TRAILING SPACES
          BX7    X0*X2
          LX4    12 
          MX2    6
          LX2    -42
 SRT13    LX4    6
          NG     X2,SRT14    IF END OF WORD 
          LX2    6           POSITION MASK
          BX3    X2*X7
          ZR     X3,SRT13    IF COLON OR NULL CHARACTER 
          BX6    X4-X3
          NZ     X6,SRT14    IF NOT BLANK 
          BX7    -X2*X7      DELETE TRAILING SPACE
          EQ     SRT13       CHECK NEXT CHARACTER 
  
 SRT14    SX6    B2          TYPE 
          IX6    X6+X7
          EQ     SRT         RETURN 
  
 SRTA     CON    77000077770000B
 SRTB     CON    6L.PROC, 
          SPACE  4
          BASE   *
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 SRT      EQU    /COMCSRT/SRT 
 QUAL$    ENDIF 
          ENDX
