*DECK S$GTCTL 
          IDENT  S$GTCTL
          TITLE  S$GTCTL -  GET CONTROL STATEMENT 
          COMMENT  GET CONTROL STATEMENT
          SPACE  4
**        S$GTCTL -  GET CONTROL STATEMENT
* 
*     CALLING SEQUENCE- 
*         S$GTCTL(LINE, EOF); 
* 
*         LINE = 80-CHARACTER VARIABLE. 
*         EOF = BOOLEAN VARIABLE. 
* 
*     DOES- 
*         IF END-OF-FILE HAD PREVIOUSLY BEEN RETURNED,
*             ABORTS WITH "S$GTCTL-1".
*         IF THIS IS THE FIRST CALL,
*             BEGIN 
*             SETS EOF = FALSE. 
*             SETS LINE = IMAGE.
*_____       EXITS. 
*             END 
*         TRIES TO GET THE NEXT CONTROL STATEMENT IMAGE.
*         IF SUCCESSFUL,
*             BEGIN 
*             SETS EOF = FALSE. 
*             IF THE FIRST CHARACTER IS A PERIOD, 
*                 SETS LINE = IMAGE SHIFTED LEFT TO DELETE THE PERIOD 
*                  AND PADDED WITH A BLANK. 
*             ELSE (IF THE FIRST CHARACTER IS NOT A PERIOD),
*                 ISSUES DIAGNOSTIC E$68. 
*                 SETS LINE = IMAGE.
*             END 
*         ELSE (IF NOT SUCCESSFUL)
*             SETS EOF = TRUE.
* 
*     NOTE- 
*         A CONTROL STATEMENT OTHER THAN THE ORIGINAL CALL SHOULD START 
*         WITH A PERIOD TO AVOID SYNTAX-CHECKING BY THE OPERATING SYTEM.
*         THIS ROUTINE STRIPS SUCH PERIODS. 
  
  
          ENTRY  S$GTCTL
 S$GTCTL  SUBR
          SB1    1           CONSTANT 1 
          SA0    A1          SAVE ADDRESS OF ACTUAL PARAMETER LIST
          SA1    RA+70B      FIRST WORD OF CONTROL STATEMENT IMAGE
          IFTHEN X1=0        IF ALREADY RETURNED END-OF-FILE, 
            SX1    =10HS$GTCTL-1
            CALL   S$ABORT     INTERNAL ERROR 
            ENDIF.
  
          SA1    FIRST       ZERO IFF NOT FIRST CALL
          IFTHEN X1"0        IF FIRST CALL
            IFNOSBE 
            RJ     CHKDOT 
            ENDIF 
          CALL   CHKSPC      CHECK FOR LEADING SPACES 
            SX6    0           SET FLAG FOR NEXT TIME 
            SA6    FIRST
            SA5    A0+B1       ADDRESS FOR EOF
            SA6    X5          EOF := FALSE (0) 
            SA5    A0          ADDRESS FOR LINE 
            SB7    7
            SB2    B0 
 GTCTL1     BSS    0
              SA1    RA+70B+B2   GET WORD FROM IMAGE
              BX6    X1          MOVE IT
              SA6    X5+B2               TO LINE
              SB2    B2+B1       INCREMENT WORD COUNT 
              LE     B2,B7,GTCTL1  IF MORE WORDS TO MOVE, LOOP
_____       EXIT
            ENDIF.
  
*     NOT FIRST CALL
  
          IFNOS 
            CONTROL RA+70B     READ IMAGE INTO RA+70B 
          ELSE
            MX6    0           CLEAR COMPLETE BIT 
            SA6    STATUS 
            CONTRLC STATUS,READ,DAYFILE  READ IMAGE INTO RA+70B 
            ENDIF 
          CALL   CHKSPC 
          SA1    RA+70B      .ABCDEFGHI  (E.G.) 
          IFTHEN X1"0        IF WE GOT AN IMAGE 
            SA5    A0+B1       ADDRESS FOR EOF
            MX6    0           FALSE
            SA6    X5          EOF := FALSE 
            LX1    6           ABCDEFGHI. 
            MX0    -6          77777777777777777700 
            BX6    -X0*X1 
            SX6    X6-1R. 
            IFTHEN X6=0        IF IMAGE STARTS WITH PERIOD
              SA5    A0          ADDRESS FOR LINE 
              MX0    6           77000000000000000000 
              SB7    7
              SB2    B0 
 GTCTL2       BSS    0
                SA1    RA+70B+B2   .ABCDEFGHI   (E.G.)
                SA3    A1+B1       JKLMNOPQRS   (E.G.)
                BX2    -X0*X1      :ABCDEFGHI 
                BX4    X0*X3       J: ... : 
                BX6    X4+X2       JABCDEFGHI 
                LX6    6           ABCDEFGHIJ 
                SA6    X5+B2       STORE WORD IN IMAGE
                SB2    B2+B1       INCREMENT WORD COUNT 
                LE     B2,B7,GTCTL2  IF MORE WORDS, LOOP
              MX0    -6      77777777777777777700 
              BX6    X0*X6       KLMNOPQR:   (E.G.) 
              SA6    A6          CORRECT LAST WORD IN LINE
            ELSE-              LINE DOES NOT START WITH A PERIOD
              SX6    A0          STOP S$ERROR FROM KILLING A0 
              SA6    SAVEA0 
              SA1    GTCTLA      ADDRESS OF ERROR NUMBER
              CALL   S$ERROR     TELL USER ABOUT MISTAKE
              SA1    SAVEA0      RESET VALUE OF A0
              SA0    X1 
          SB1    1           RESET B1 = CONSTANT 1
              SA5    A0          ADDRESS FOR LINE 
              SB7    7
              SB2    B0 
 GTCTL3       BSS    0
                SA1    RA+70B+B2
                BX6    X1 
                SA6    X5+B2
                SB2    B2+B1
                LE     B2,B7,GTCTL3 
              ENDIF.
          ELSE-              IF WE DID NOT GET AN IMAGE 
            SX6    B1          TRUE 
            SA5    A0+B1       ADDRESS FOR EOF
            SA6    X5          EOF := TRUE
            ENDIF.
  
          EXIT
  
  
 E$68     EQU    68 
  
 FIRST    DATA   1           ZERO IFF NOT FIRST TIME CALLED 
  
 GTCTLA   VFD    42/,18/GTCTLB
          VFD    42/,18/RA+70B
 GTCTLB   CON    E$68 
  
 RA       EQU    0           TO REFERENCE ABSOLUTE MEMORY 
  
 SAVEA0   BSS    1           TO SAVE A0 
  
          IFNOSBE 
CHKDOT    DATA   0           ENTRY/EXIT WORD
          SB1    1
          SA1    66B               JOB ORIGIN CONTROL WORD
          AX1    24 
          SB2    X1 
          SB3    3                 3 = TERMINAL ORIGIN
          NE     B2,B3,OUT         NOT AN INTERCOM JOB
          SB7    8                 MAXIMUM NO OF WORDS TO SCAN
          SA2    RA+70B 
L1        SB7    B7-B1
          SA1    A2+B7             SCAN 'RIGHT TO LEFT' 
          EQ     B7,B0,CHKGOOD     SPECIAL DARNED CASE
L4        ZR     X1,L1             WORD IS ALL ZEROS
          LT     B7,B0,*+400000B   OBVIOUSLY NOT MEANT TO HAPPEN
  
* OFFENDING DOT NOW IN X1 
  
          BX2    X1 
          SB6    10                NUMBER OF CHARS IN 1 WORD
          SB5    10                NUMBER OF CHARS TO SCAN
          SB4    57B               ONE DOT
          SB2    55B               ONE SPACE
          MX3    -6 
L2        BX4    -X3*X2            ONE CHARACTER
          SB6    B6-B1
          SB5    B5-B1             ONE LESS TO SCAN 
          LT     B5,B0,OUT
          LX2    -6 
          ZR     X4,L2
  
* WE HAVE A CHARACTER IN X4 
  
          SB3    X4 
          EQ     B3,B2,L3          WE HAVE TRAILING DOT + SPACE 
          NE     B3,B4,OUT         NOT A DOT  NOR A SPACE 
          SX3    54                MAXIMUM NUMBER OF GOOD BITS
          SX4    B6                NUMBER OF GOOD CHARACTERS IN X1
          SX5    6                 MULTIPLIER 
          IX4    X4*X5             NUMBER OF GOOD BITS
          IX4    X3-X4             54  MINUS NO. OF GOOD BITS 
          SB5    X4 
          SX3    1R.
          LX3    B5 
          BX6    X1-X3
          SA6    A1                REMOVE INTERCOM'S DOT
          NZ     B6,OUT            THERE MAY BE *TWO* DOTS!!
          SB7    B7-B1             HANDLE SECOND DOT-IF ANY 
          SA1    A2+B7
          BX2    X1 
          MX3    -6 
          SB5    2                 NUMBER OF CHARS TO SCAN
          SB6    10                CHARACTERS IN 1 WORD 
          JP     L2                I *LOVE* STRUCTURED PROGRAMMING
OUT       EQ     CHKDOT            ALL DONE 
  
CHKGOOD   SA3    SORT5
          BX3    X1-X3
          ZR     X3,OUT 
          SA3    MERGE
          BX3    X1-X3
          ZR     X3,OUT 
          JP     L4                SPECIAL CASES CHECKED FOR
  
* NOW WE HAVE TO BE SURE THAT THIS IS DOT + SPACE 
* IT COULD BE LEFT PAREN + SPACE WHICH WOULD BE EMBARRASSING
  
L3        BX4    -X3*X2            GET NEXT CHARACTER FROM X2 
          SB3    X4                CHARACTER INTO B3
          SB5    52B               LEFT PARENTHESIS 
          EQ     B3,B5,OUT
          SX3    54 
          SX4    B6                NUMBER OF GOOD CHARACTERS IN X1
          SX5    6                 MULTIPLIER 
          IX4    X4*X5             NUMBER OF GOOD BITS
          IX4    X3-X4             54  MINUS NO. OF GOOD BITS 
          SB5    X4 
          SX3    2R.
          LX3    B5 
          BX6    X1-X3
          SA6    A1                REMOVE INTERCOM'S DOT
          EQ     CHKDOT            ALL DONE 
  
SORT5     DATA   6LSORT5. 
MERGE     DATA   6LMERGE. 
 STATUS   BSS    1           FOR *CONTRLC* MACRO CALL 
          ENDIF 
  
  
CHKSPC    SUBR
          SB4    B0          DEFAULT IS NO SPACES FOUND 
          SA1    70B         LOOK AT RA+70
          MX2    6           ONE CHARACTER
          BX3    X2*X1       LEFT-MOST CHARACTER -> X3
          LX3    6           LMC NOW ON RIGHT SIDE OF X3
          SB2    X3          LMC -> B2
          SB3    1R          SHOULD BE 55B
          NE     B2,B3,QUIT  IF FIRST CHARACTER NOT A SPACE, GO HOME
          SB4    B1          START COUNTING THEM
          SB5    9           LOOP CONTROLLER FOR LOOP2
          LX1    6           POSITION FOR SECOND CHARACTER
LOOP2     BX3    X2*X1       ISOLATE ANOTHER CHARACTER IN X3
          LX3    6           MOVE IT TO THE RIGHT 
          SB2    X3          NEW CHARACTER IN B2
          NE     B2,B3,QUIT 
          SB4    B4+B1       KEEP COUNTING
          SB5    B5-B1       DECREMENT INDEX
          EQ     B5,B0,LABEL3    EXIT IF DONE 
          LX1    6           NOT DONE, POSITION NEW CHARACTER 
          EQ     LOOP2       LOOP AGAIN 
LABEL3    BSS    0           WE HAVE TO GET A NEW WORD NOW
          SA1    A1+B1       SO WE GET IT 
          SX6    120B        AREA OF REAL LIVE PROGRAM
          SX7    A1          WHERE WE ARE NOW 
          IX6    X6-X7       AVOID INFINITE LOOPING...... 
          PL     X6,GOOD
          SB4    B0 
          EQ     QUIT        SOMETHING IS VERY WRONG HERE 
GOOD      SB5    10 
          EQ     LOOP2
QUIT      EQ     B4,B0,NOTHING
* ZERO OUT TEMPORARY STORAGE AREA IN CASE WE
* ARE CRACKING MANY CONTROL CARDS 
          MX7    0
          SB7    10B
          SA7    MYCARD 
          SB7    B7-B1
LOOP7     SA7    A7+1 
          SB7    B7-B1
          NE     B7,B0,LOOP7
* CALL COMCMOS TO MOVE OUR DATA 
          SX1    B4          B4 CONTAINS COUNT OF SPACES I.E. 34
          SX2    10          NUMBER OF SPACES IN ONE WORD 
          PX1 
          NX1 
          PX2 
          NX2 
          FX3    X1/X2       NUMBER OF SPACES / 10
          UX3    X3,B7
          LX3    B7          INTEGER NUM SPACES / 10 I.E. 3 
* X3 NOW HAS THE WORD OFFSET
          SX5    10 
          IX4    X3*X5       WORD OFFSET * 10 I.E. 30 
          SX1    B4          ORIGINAL COUNT OF LEADING SPACES 
          IX2    X1-X4       BYTE OFFSET I.E. 4 
          SX5    6
          IX2    X2*X5       BIT OFFSET  I.E. 24
          SB2    X2          SET PARAMETERS FOR MNS=
          SB4    B0          SEE COMPASS REF. MAN. P. 12-7
          SX1    80*6        MAXIMUM NUMBER OF CHARACTERS 
          IX2    X4*X5       BITS IN WORD OFFSET
          IX0    X1-X2
          SX2    B2          BITS IN BIT OFFSET 
          IX0    X0-X2       NUMBER OF BITS TO MOVE 
          SX2    X3+70B 
          SX4    MYCARD 
          CALL   MNS= 
          SB7    10B
          SA1    MYCARD 
          BX7    X1 
          SA7    RA+70B 
          SB7    B7-B1
LOOP8     SA1    A1+1 
          BX7    X1 
          SA7    A7+1 
          SB7    B7-B1
          NE     B7,B0,LOOP8
NOTHING   EXIT               ALL DONE SO GO HOME
  
MYCARD    BSSZ   10B         STORE CONTROL CARD TEMPORARILY 
  
  
          END 
