Retro1.org codex

          IDENT  TCOMND,FWA
          TITLE  TCOMND - TERMINAL COMMAND PROCESSOR.
          ABS
          ENTRY  APPSW
          ENTRY  ASCII
          ENTRY  CSET
          ENTRY  EFFECT
          ENTRY  PARITY
          ENTRY  RFL=
*COMMENT  TCOMND - TERMINAL COMMAND PROCESSOR.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 
          SYSCOM B1
          SPACE  4,2
***       TCOMND - TERMINAL COMMAND PROCESSOR.
*         P. D. FARRELL.  74/08/28.
          SPACE  4,3
***            TCOMND PROCESSES TIME SHARING TERMINAL COMMANDS.
*         THAT HAVE BEEN ENTERED BY MEANS OF CONTROL CARD CALLS
*         RATHER THAN DIRECTLY THROUGH A TERMINAL.
          SPACE  4,10
***       APPLICATION SWITCH COMMAND FORMATS.
*
*         APPSW
*
*         APPSW(ANAME[,Z.])
*
*         APPSW(AP=ANAME[,Z.])
*
*                ANAME = NETWORK APPLICATION NAME.  IF NO APPLICATION
*                        NAME IS SPECIFIED, THE USER WILL BE RETURNED
*                        TO THEIR PRIMARY APPLICATION.
*
*                Z = Z PARAMETER OPTION.  IF SPECIFIED, THE REMAINDER
*                    OF THE COMMAND LINE WILL BE PASSED TO THE NEW
*                    APPLICATION.
*
*         THE APPLICATION SWITCH COMMAND IS PROCESSED AS FOLLOWS-
*
*           TLX WILL BE CALLED TO NOTIFY IAF OF THE APPLICATION SWITCH.
*           TLX WILL BE CALLED TO RESTART THE JOB WHEN THE CONNECTION
*           RETURNS.
          SPACE  4,4
***       DAYFILE MESSAGES.
*
*         *ERROR IN COMMAND PARAMETERS.* = A COMMAND PARAMETER
*                WAS ILLEGAL.
          SPACE  4,3
***       OPERATOR MESSAGES.
*
*         NONE.
          SPACE  4
*CALL     COMCMAC
          TITLE  COMMAND PROCESSORS.
          ORG    120B
 FWA      BSS    0           DEFINE LOAD ADDRESS
 APP      SPACE  4,10
**        APP - APPLICATION SWITCH PROCESSOR.
*
*         THE APPLICATION SWITCH COMMAND CAUSES A USER TO BE SWITCHED
*         TO THE SECONDARY APPLICATION SPECIFIED IN THE COMMAND.  IF
*         THE CURRENT APPLICATION IS A SECONDARY APPLICATION, THE
*         *ABORT* OR NULL APPLICATION NAMES MAY BE SPECIFED TO RETURN
*         THE USER TO THE PRIMARY APPLICATION.
*
*         CALLS  PZO, UPC.
 
 
 APPSW    BSS    0           ENTRY
          SB1    1
          SA5    CCDR        SET COMMAND ADDRESS
          SB7    ARGR        SET PARAMETER ADDRESS
          RJ     UPC         UNPACK COMMAND
          NZ     X6,ERR      IF PARAMETER ERROR
          SA1    ARGR+B1     READ FIRST PARAMETER
          MX0    42
          BX6    X0*X1
          ZR     X6,APP2     IF NO PARAMETER SPECIFIED
          SA2    =2LAP
          BX2    X6-X2
          BX6    -X0*X1      CHECK SEPARATOR
          NZ     X2,APP1     IF NOT *AP* PARAMETER
          SA2    =1R=
          BX6    X6-X2
          NZ     X6,ERR      IF *AP* NOT EQUATED
          SA1    A1+B1       GET APPLICATION NAME
 APP1     BX6    X0*X1
          SA6    APPA        SAVE APPLICATION NAME
          SA1    A1+B1       READ NEXT PARAMETER
          ZR     X1,APP2     IF NO MORE PARAMETERS
          SA2    =1LZ
          BX6    X0*X1
          BX2    X6-X2
          NZ     X2,ERR      IF NOT *Z* PARAMETER
          SB7    APPA+B1     SET WRITE BUFFER ADDRESS
          SB4    APPB        SET END OF WRITE BUFFER
          RJ     PZO         PROCESS *Z* OPTION
 APP2     SX7    APPA        SET APPLICATION NAME ADDRESS
          SX0    22B         SET *TLX* REQUEST NUMBER
          TLX    X0,X7       ENTER *TLX* SYSTEM REQUEST
          SX0    23B         SET *TLX* REQUEST NUMBER
          EQ     TLX         CALL *TLX*
 
 
 APPA     BSSZ   6           APPLICATION BUFFER
 APPB     CON    0           END OF BUFFER
 ASCII    SPACE  4,10
***       ASCII.
*
*         SET EXTENDED (ASCII) MODE.
 
 
 ASCII    SB2    0           SET PARAMETER LIMIT
          RJ     PRS
          SX0    3           SET FUNCTION CODE = 3
          SX7    11B         SET ARGUMENT
          EQ     TLX
 CSET     SPACE  4,10
***       CSET(M)
*
*         SET CHARACTER SET MODE M.
*
*                M = *NORMAL*.
*                  = *ASCII*.
*                  = *EXTEND*.
 
 
 CSET     SB2    1           SET PARAMETER LIMIT
          RJ     PRS         CHECK PARAMETERS
          SX0    3           SET FUNCTION CODE = 3
          SA1    =6LNORMAL
          BX7    X5-X1
          ZR     X7,CST1     IF *NORMAL*
          SX7    B1
          SA1    =6LEXTEND
          SA2    =5LASCII
          BX1    X5-X1
          ZR     X1,CST1     IF *EXTEND*
          BX2    X5-X2
          NZ     X2,ERR      IF NOT *ASCII*
 CST1     SX7    X7+10B      SET ENTRY MODE RESET BIT
          EQ     TLX
 EFFECT   SPACE  4,10
***       EFFECT(A)
*
*         SET USER OR SYSTEM SUPPLIED FORMAT EFFECTOR MODE.
*
*         A = *SYSTEM*, SET SYSTEM SUPPLIED FORMAT EFFECTOR MODE.
*           = *USER*,   SET USER SUPPLIED FORMAT EFFECTOR MODE.
*           = (OMITTED) = *SYSTEM*.
 
 
 EFFECT   SB2    1           SET PARAMETER LIMIT
          RJ     PRS
          SX0    21B         SET FUNCTION CODE = 21B
          ZR     X5,TLX      IF NO PARAMETER
          SA1    =6LSYSTEM
          SA2    =4LUSER
          SA3    =2LON
          SA4    =3LOFF
          BX1    X5-X1
          BX2    X5-X2
          BX3    X5-X3
          BX4    X5-X4
          ZR     X1,TLX      IF *SYSTEM*
          ZR     X3,TLX      IF *ON*
          SX0    20B         SET FUNCTION CODE = 20B
          ZR     X2,TLX      IF *USER*
          ZR     X4,TLX      IF *OFF*
          EQ     ERR         IF NONE OF THE ABOVE
 PARITY   SPACE  4,10
***       PARITY(P)
*
*         SET PARITY P.
*
*         P = *ODD*.
*           = *EVEN*.
*           = (OMITTED) = *ODD*.
 
 
 PARITY   SB2    1           SET PARAMETER LIMIT
          RJ     PRS
          SX0    4           SET FUNCTION CODE = 4
          SX7    1           SET ODD PARITY
          ZR     X5,TLX      IF NO PARAMETER
          SA1    =3LODD
          SA2    =4LEVEN
          BX1    X5-X1
          IX2    X5-X2
          ZR     X1,TLX      IF *ODD*
          NZ     X2,ERR      IF NOT *EVEN*
          SX7    B0          SET EVEN PARITY
          EQ     TLX
          TITLE  SUBROUTINES.
 ERR      SPACE  4,10
**        ERR - PROCESS PARAMETER ERROR.
 
 
 ERR      BSS    0
          MESSAGE (=C* ERROR IN COMMAND PARAMETERS.*)
          ABORT
 PRS      SPACE  4,10
**        PRS - PRESET PROGRAM.
*
*         ENTRY  (B2) = MAXIMUM NUMBER OF ALLOWABLE PARAMETERS.
*
*         EXIT   (X5) = FIRST PARAMETER.
*                (A5) = ADDRESS OF FIRST PARAMETER.
*                (B3) = PARAMETER COUNT.
 
 
 PRS      SUBR               ENTRY/EXIT
          SB1    1           SET CONSTANT 1
          SA5    ACTR        READ PARAMETER COUNT
          SB3    X5
          GT     B3,B2,ERR   IF INVALID PARAMETER COUNT
          SA5    B1+B1       READ FIRST PARAMETER
          EQ     PRSX        RETURN
 PZO      SPACE  4,10
**        PZO - PROCESS *Z* OPTION.
*
*         ENTRY  (A5) = ADDRESS OF *Z* PARAMETER.
*                (B7) = BEGINNING ADDRESS OF WRITE BUFFER.
*                (B4) = END OF WRITE BUFFER.
*
*         EXIT   BUFFER CONTAINS THE CHARACTERS FOLLOWING THE *Z*
*                PARAMETER.
 
 
 PZO      SUBR               ENTRY/EXIT
          SB5    10D         INITIALIZE CHARACTERS LEFT IN READ WORD
          SB3    B1          INITIALIZE END-OF-LINE FLAG
          SX6    B0          CLEAR WRITE WORD
          MX0    6
          SB6    B5+         INITIALIZE ROOM LEFT IN WRITE WORD
          MX1    -12
          SA3    =1L.
          SA4    =1L)
          SA5    A5+         READ FIRST WORD
 PZO1     BX2    X0*X5       FIND COMMAND TERMINATOR
          LX5    6
          SB5    B5-B1
          BX7    X2-X3
          ZR     X7,PZO2     IF COMMAND TERMINATOR
          BX7    X2-X4
          NZ     X7,PZO1     IF NOT COMMAND TERMINATOR
 PZO2     BX2    X0*X5       GET NEXT CHARACTER
          SB3    B3-B1
          ZR     X2,PZO3     IF ZERO CHARACTER
          SB3    B1          RESET END-OF-LINE FLAG
 PZO3     BX6    X6+X2       ADD CHARACTER TO WRITE WORD
          SB6    B6-B1
          LX6    6
          NZ     B6,PZO4     IF WRITE WORD NOT FULL
          SA6    B7+         WRITE FULL WORD
          NG     B3,PZOX     IF END-OF-LINE FOUND
          SB7    B7+1       INCREMENT POINTER
          GE     B7,B4,PZOX  IF END OF WRITE BUFFER
          SX6    B0+         RESET REGISTERS
          SB6    10D
 PZO4     SB5    B5-B1
          LX5    6
          NZ     B5,PZO2     IF READ CHARACTERS LEFT
          SB5    10D         RESET REGISTERS
          SA5    A5+B1       GET NEXT WORD
          EQ     PZO2        CONTINUE
 TLX      SPACE  4,10
**        TLX - ENTER TELEX SYSTEM REQUEST.
*
*         ENTRY  (X0) = FUNCTION CODE.
*                (X7) = ARGUMENT.
 
 
 TLX      BSS    0
          TLX    X0,X7       ENTER TELEX SYSTEM REQUEST
          ENDRUN
          SPACE  4
**        COMMON DECKS.
 
 
*CALL     COMCSYS
*CALL     COMCUPC
 
          USE    //
 RFL=     BSS    0
 
          END