Retro1.org codex

          IDENT  PANSUBS 
 
          ENTRY  ABT
          ENTRY  CSETA
          ENTRY  MSG
          ENTRY  X612TA
          ENTRY  RFL=
          SYSCOM B1
          TITLE  PANSUBS - PANEL ACCESS SUBROUTINES.
*COMMENT  PANSUBS - PANEL ACCESS SUBROUTINES.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          TITLE  ABT - ABNORMALLY TERMINATE THE JOB
 ABT      SPACE  4,10
***       ABT - ABNORMALLY TERMINATE THE JOB.
*
*         R.K. FOSTER.       83/03/07.
 ABT      SPACE  4,10
***       *ABT* PROVIDES AN INTERFACE TO *SMF* ROUTINES FOR
*         ABNORMALLY TERMINATING THE JOB.
 ABT      SPACE  4,10
**        ABT - ABNORMALLY TERMINATE THE JOB.
*
*         USES   B - 1.
*
*         MACROS ABORT.
 
 
 ABT      SUBR               ENTRY/EXIT
          SB1    1
          ABORT              DUMP THE JOB
          EQ     ABTX        RETURN
          TITLE  CSETA - SET CHARACTER SET TO ASCII.
***       CSETA - SET CHARACTER SET TO ASCII.
*
*         R.K. FOSTER.       83/03/07.
 CSETA    SPACE  4,10
***       *CSETA* PROVIDES AN INTERFACE TO *SMF* ROUTINES FOR
*         SETTING THE CHARACTER SET OF THE TERMINAL TO ASCII.
*         IT ALSO ALTERS *TVXD* IN *COMTVDT* IF USING 63-CHARACTER SET.
 CSETA    SPACE  4,10
**        CSETA - SET CHARACTER SET TO ASCII.
*
*         USES   X - 1, 2, 6.
*                A - 1, 2, 6.
*                B - 1, 6.
*
*         MACROS CSET.
 
 
 CSETA    SUBR               ENTRY/EXIT
          SB1    1
          CSET   ASCII       SET CHARACTER SET TO ASCII
          SA1    CSMR        READ INSTALLATION OPTION
          SB6    TVXD64      ASSUME 64 CHARACTER SET
          NG     X1,CSE1     IF 64 CHARACTER SET
          SB6    TVXD63      SET 63 CHARACTER SET
 CSE1     SA1    B6+         READ MODIFICATION TABLE ENTRY
          NG     X1,CSETAX   IF END OF TABLE, RETURN
          SA2    A1+B1       READ SUBSTITUTION
          SB6    B6+2
          BX6    X2          STORE SUBSTITUTION
          SA6    TVXD+X1
          EQ     CSE1        CONTINUE
          TITLE  MSG - TERMINATION MESSAGE
 MSG      SPACE  4,10
***       MSG - DAYFILE MESSAGE.
*
*         R.K. FOSTER.       83/03/07.
 MSG      SPACE  4,10
***       *MSG  * PROVIDES AN INTERFACE TO *SMF* ROUTINES FOR
*         A DAYFILE MESSAGE.
 MSG      SPACE  4,10
**        MSG - DAYFILE MESSAGE PRIOR TO TERMINATION.
*
*         CALLING SEQUENCE.
*
*         *FORTRAN5* CALL -
*
*         CALL MSG(M)
*
*                M = MESSAGE (MUST BE ON WORD BOUNDARY).
*
*         USES   B - 1.
*
*         MACROS MESSAGE.
 
 
 MSG      SUBR               ENTRY/EXIT
          SB1    1
          SX1    X1
          MESSAGE X1,3,R
          EQ     MSGX        RETURN
          TITLE  X612TA - TRANSLATE 6/12 TO ASCII.
 X612TA   SPACE  4,10
***       X612TA - TRANSLATE 6/12 TO ASCII.
*
*         R.K. FOSTER.       83/03/07.
 X612TA   SPACE  4,10
***       *X612TA* PROVIDES AN INTERFACE TO *SMF* ROUTINES FOR
*         TRANSLATING 6/12 TO ASCII.
*
*         CALLING SEQUENCE.
*
*         *FORTRAN5* CALL -
*
*         CALL X612TA(N)
*
*                N = ICHAR (CHARACTER TO TRANSLATE).
*                IF ICHAR PRECEDED BY UPARROW, N = N + Z"40".
*                IF ICHAR PRECEDED BY ATSIGN, N = N + Z"80".
 X612TA   SPACE  4,10
**        X612TA - TRANSLATE 6/12 TO ASCII.
*
*         ENTRY  (A1) = FWA OF PARAMETER.
*                (X1) = ACTUAL PARAMETER.
*
*         EXIT   (X6) = TRANSLATED CHARACTER.
*
*         USES   X - 0, 1, 2, 6.
*                A - 1, 2.
*                B - 1, 2.
 
 
 X612TA   SUBR               ENTRY/EXIT
          SB1    1
          SA1    X1+         GET ARGUMENT
          SB2    X1          GET WORD FROM TABLE
          SA2    TVXD+B2
          MX0    -7          EXTRACT ASCII
          LX2    -18
          BX6    -X0*X2
          EQ     X612TAX     RETURN
          SPACE 4,10
 
*         CHARACTER SET TRANSLATION TABLES.
 
          LIST   X
*CALL     COMTVDT
          LIST   -X
          SPACE  4,10
 
          USE    //          FORCE RFL= TO FOLLOW BLANK COMMON
 RFL=     BSS    0
          END