Retro1.org codex

          IDENT  SCRCCK
          ENTRY  SCRCCK
          SYSCOM B1
          TITLE  SCRCCK - CAPSULE CHECK.
*COMMENT  SCRCCK - CAPSULE CHECK.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 CCK      SPACE  4,10
***       SCRCCK - CAPSULE CHECK.
*
*         M. L. SWANSON.     84/05/09.
 CCK      SPACE  4,10
***       *SCRCCK* VERIFIES THAT THE CAPSULE LOADED IS A VALID
*         *TDU* PRODUCED CAPSULE, CHECKING THE TERMINAL MNEMONIC
*         AND THE VERSION NUMBER AGAINST THE SPECIFIED MNEMONIC
*         AND THE CURRENT *TDU* VERSION NUMBER. IT ALSO CONDITIONALLY
*         SETS A FLAG IN THE FIRST WORD OF THE DYNAMICALLY LOADED
*         CAPSULE TO SIGNIFY THE LOCATION OF THE *TERMLIB* FILE USED
*         BY THE SCREEN/LINE DIRECTIVE.  IF THE CAPSULE IS VALIDATED,
*         *SCRCCK* RETURNS THE LENGTH OF THE TERMINAL CAPSULE.
 CCK      SPACE  4,10
**        COMMON DECKS.
 
 
          LIST   X
*CALL     COMSTIR
          LIST   -X
 CCK      SPACE  4,15
***       SCRCCK - CAPSULE CHECK.
*
*         CALLING SEQUENCE.
*         *SYMPL* CALL -
*
*         SCRCCK(ADDRESS,TERMINAL,VALIDATION,LENGTH,TSTATUS);
*
*               (ADDRESS)    = LOADED CAPSULE ADDRESS.
*               (TERMINAL)   = TERMINAL MNEMONIC.
*               (VALIDATION) = TERMCAP VALIDATION FLAG.
*               (LENGTH)     = TERMCAP LENGTH IN WORDS.
*               (TSTATUS) =  STATUS OF *TERMLIB* USED BY *SCREX*
*                         ( 0 - SOURCE OF TERMLIB IS UN=LIBRARY,
*                           1 - SOURCE IS LOCAL FILE OR PFN CATALOG )
 CCK      SPACE  4,10
**        SCRCCK - CAPSULE CHECK.
*
*         ENTRY  (A1) = FWA OF FORMAL PARAMETER LIST.
*                (X1) = FWA OF LOADED CAPSULE ADDRESS.
*
*         USES   X - 2, 3, 4, 5, 6, 7.
*                A - 2, 3, 6, 7.
*                B - 1, 2, 3.
 
 
 SCRCCK   SUBR               ENTRY/EXIT
          SB1    1
 
*         INITIALIZE TERMCAP VALIDATION FLAG TO FALSE.
 
          SB2    2
          SA2    A1+B2       GET ADDRESS OF FLAG
          SX7    B0          INITIALIZE FLAG TO FALSE
          SA7    X2          STORE INITIALIZED FLAG
 
*         CHECK IF HEADER WORD HAS TERMINAL MNEMONIC.
 
          SA2    X1          GET LOADED CAPSULE ADDRESS
          SA2    X2          GET FIRST WORD OF CAPSULE
          SA3    A1+B1       GET MNEMONIC ADDRESS
          SA3    X3          GET TERMINAL MNEMONIC
          LX3    6           SHIFT TO REMOVE *Z* PREFIX
          MX4    42
          BX3    X3*X4       GET UNPREFIXED MNEMONIC
          BX5    X4*X2       MASK OFF FIRST SEVEN CHARACTERS
          BX6    X5-X3       COMPARE MNEMONIC TO CAPSULE HEADER
          NZ     X6,SCRCCKX  IF NOT MATCH, INVALID CAPSULE
 
*         CHECK IF VALID VERSION NUMBER.
 
          SX3    TDUV        GET CURRENT *TDU* VERSION NUMBER
          BX5    -X4*X2      MASK OFF VERSION NUMBER FIELD
          BX6    X5-X3       CHECK FOR MATCHING VERSION NUMBER
          NZ     X6,SCRCCKX  IF NOT MATCH, INVALID CAPSULE
 
*         CONDITIONALLY SET THE *TERMLIB* STATUS FLAG.
 
          SA3    A1+4        ADDRESS OF *TERMLIB* STATUS FLAG
          SA3    X3+
          ZR     X3,CCK1     IF *TERMLIB* FOUND FROM UN=LIBRARY
          MX4    59
          LX4    17
          SA3    X1
          SA2    X3          FIRST WORD OF TERMINAL CAPSULE
          BX6    -X4+X2      SET *TERMLIB* STATUS FLAG
          SA6    X3          REPLACE HEADER OF CAPSULE
 
*         GET LENGTH OF CAPSULE FROM TERMCAP HEADER TABLE.
 
 CCK1     SA2    X1          ADDRESS OF LOADED CAPSULE ADDRESS
          SA2    X2          GET FIRST WORD OF TERMCAP
 
*         THIS TAKES THE LENGTH FROM THE CAPSULE HEADER.
 
          SB3    -3
          SA2    A2+B3       GET CAPSULE HEADER
          MX3    42          MASK FOR LENGTH OF CAPSULE
          BX6    -X3*X2      EXTRACT CAPSULE LENGTH
          SA2    A1+3        GET LENGTH ADDRESS
          SA6    X2          STORE TERMCAP LENGTH
          SA3    A1+B2       GET FLAG ADDRESS
          SX7    B1          SET TERMCAP VALID FLAG TO TRUE
          SA7    X3          STORE FLAG
          EQ     SCRCCKX     RETURN
 
          END
          IDENT  SCRCIS
          ENTRY  SCRCIS
          SYSCOM B1
          SST
          TITLE  SCRCIS - CHECK INTERACTIVE STATUS.
*COMMENT  SCRCIS - CHECK INTERACTIVE STATUS.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 CIS      SPACE  4,10
***       SCRCIS - CHECK INTERACTIVE STATUS.
*
*         M. L. SWANSON.     84/10/29.
 CIS      SPACE  4,10
***       *SCRCIS* CHECKS TO SEE IF THE CURRENT RUNNING JOB IS
*         OF INTERACTIVE ORIGIN TYPE.  IF SO, IT RETURNS TRUE TO
*         THE CALLING ROUTINE, FALSE IF NOT.
 CIS      SPACE  4,15
***       SCRCIS - CHECK INTERACTIVE STATUS.
*
*         CALLING SEQUENCE.
*         *SYMPL* CALL -
*
*         SCRCIS(INTFLAG);
*
*               (INTFLAG)    - INTERACTIVE STATUS FLAG.
*                            = 1, IF INTERACTIVE JOB ORIGIN TYPE.
*                            = 0, IF NOT INTERACTIVE TYPE.
 CIS      SPACE  4,10
**        SCRCIS - CHECK INTERACTIVE STATUS.
*
*         ENTRY  (A1) = FWA OF FORMAL PARAMETER LIST.
*                (X1) = FWA OF INTERACTIVE STATUS FLAG.
*
*         USES   X - 0, 2, 3, 4, 6.
*                A - 2, 3, 4, 6.
*                B - 1.
 
 
 SCRCIS   SUBR               ENTRY/EXIT
          SB1    1
          SA2    X1
          MX0    48
          SA3    JOPR        GET JOB ORIGIN TYPE
          LX3    36
          BX3    -X0*X3
          SX4    IAOT
          IX4    X4-X3
          SX2    B0          RESET INTERACTIVE STATUS FLAG
          NZ     X4,CIS1     IF NOT INTERACTIVE JOB TYPE
          SX2    B1+         SET INTERACTIVE STATUS FLAG
 CIS1     BX6    X2
          SA6    X1          SAVE FLAG
          EQ     SCRCISX     RETURN
 
          END
          IDENT  SCRCZF
          ENTRY  SCRCZF
          SYSCOM B1
          TITLE  SCRCZF - CREATE ZZZZTRM FILE.
*COMMENT  SCRCZF - CREATE ZZZZTRM FILE.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 CZF      SPACE  4,10
***       SCRCZF - CREATE ZZZZTRM FILE.
*
*         M. L. SWANSON.     84/05/09.
 CZF      SPACE  4,10
***       *SCRCZF* CREATES A FILE NAMED *ZZZZTRM* WHICH
*         CONTAINS THE CONTENTS OF THE LOADED TERMINAL
*         CAPSULE .
 CZF      SPACE  4,10
**        COMMON DECKS.
 
 
          LIST   X
*CALL     COMSTIR
          LIST   -X
 CZF      SPACE  4,10
**        FETS.
 
 
 ZZZZTRM  RFILEB ZBUF,ZBFL,EPR,(FET+7B)
 CZF      SPACE  4,10
***       SCRCZF - CREATE ZZZZTRM FILE.
*
*         CALLING SEQUENCE.
*
*         *SYMPL* CALL -
*
*         SCRCZF(ADDRESS,LENGTH);
*
*                ADDRESS = LOADED TERMCAP ADDRESS;
*                LENGTH = TERMCAP LENGTH.
 CZF      SPACE  4,15
**        SCRCZF - CREATE ZZZZTRM FILE.
*
*         ENTRY  (A1) - FWA OF FORMAL PARAMETER LIST.
*                (X1) - ADDRESS OF LOADED CAPSULE ADDRESS.
*
*         EXIT   OBJECT ROUTINE EXECUTED - ZZZZTRM FILE CREATED,
*                MARKED NON-RETURNABLE BY GLOBAL CLEAR.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 5, 6, 7.
*                B - 1, 2.
*
*         MACROS SETFS, WRITEF, WRITEO, WRITER.
 
 
 SCRCZF   SUBR               ENTRY/EXIT
          SB1    1
          SA2    X1          GET ADDRESS OF LOADED CAPSULE
          SX6    X2
          SA6    CZFA        SAVE FWA OF LOADED CAPSULE
          SA3    X6          GET FIRST WORD OF LOADED CAPSULE
          BX6    X3          PREPARE FOR *WRITEO*
          SA4    A1+B1       GET ADDRESS OF LENGTH
          SA4    X4          GET TERMCAP LENGTH
          BX7    X4          ADD TERMCAP HEADER LENGTH
          SA7    A6+B1       SAVE LENGTH OF TERMCAP
 CZF1     WRITEO ZZZZTRM     WRITE FIRST WORD INTO I/O BUFFER
          SA2    CZFB
          SB2    -1
          SX7    X2+B2       DECREMENT COUNTER OF TABLE LENGTH
          SA7    A2          SAVE REMAINING LENGTH
          SA1    CZFA        GET FWA OF LOADED CAPSULE
          SX7    X1+B1       GET NEXT WORD OF LOADED CAPSULE
          SA7    A1          STORE CURRENT POINTER
          SA5    X7
          BX6    X5          PREPARE FOR *WRITEO*
          SA3    A2+         CHECK IF END OF TABLE
          NZ     X3,CZF1     IF NOT END OF TABLE
          WRITER ZZZZTRM     WRITE EOR ON *ZZZZTRM* FILE
          WRITEF ZZZZTRM     WRITE EOF ON *ZZZZTRM* FILE
          SETFS  ZZZZTRM,NAD MARK NON-RETURNABLE BY GLOBAL CLEAR
          EQ     SCRCZFX     RETURN
 
 ZBUF     BSS    ZBFL
 CZFA     VFD    60/0        CURRENT POINTER TO CAPSULE
 CZFB     VFD    60/0        CAPSULE LENGTH COUNTER
 
          END
          IDENT  SCRFST
          ENTRY  SCRFST
          SYSCOM B1
          TITLE  SCRFST - FILE STATUS CHECK.
*COMMENT  SCRFST - FILE STATUS CHECK.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 FST      SPACE  4,10
***       SCRFST - FILE STATUS CHECK.
*
*         M. L. SWANSON.     84/05/13.
 FST      SPACE  4,10
***       *SCRFST* USES THE *STATUS* MACRO TO CHECK
*         IF THE SPECIFIED FILE IS LOCAL. IF FOUND LOCAL,
*         *SCRFST* REWINDS THE FILE.
 FST      SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMCCMD
***       CALLING SEQUENCE.
*
*         *SYMPL* CALL -
*
*         SCRFST(FILE,STATUS);
*
*                FILE = SPECIFIED FILE.
*                STATUS = LOCAL STATUS OF FILE (0 = NOT LOCAL,
*                         1 = LOCAL).
 FST      SPACE  4,10
**        SCRFST - CHECK FILE STATUS.
*
*         ENTRY  (A1) = FWA OF FORMAL PARAMETER LIST.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         USES   X - 0, 2, 3, 6.
*                A - 2, 3, 6.
*                B - 1.
*
*         MACROS REWIND, SETFET, STATUS.
 FST      SPACE  4,10
*         FETS.
 
 
 ZZZFET   FILEB  BUF,BUFL
 BUFL     EQU    1
 BUF      BSS    BUFL
*
 SCRFST   SUBR               ENTRY/EXIT
          SB1    1
          SA2    A1+B1       GET ADDRESS OF *STATUS* ADDRESS
          SX6    X2          GET ADDRESS OF *STATUS* PARAMETER
          SA6    FSTA        STORE ADDRESS OF *STATUS* PARAMETER
 
          SA2    X1          GET *FILENAME* PARAMETER
          SETFET ZZZFET,(LFN=X2)  REPLACE FILE NAME IN FET
          STATUS ZZZFET      CHECK IF FILE IS LOCAL
 
*         *STATUS* RETURNS 0 IN BITS 11-0 OF FET+0 IF FILE NOT FOUND.
 
          SA2    ZZZFET      GET FET+0 REPLY WORD
          MX0    11
          LX0    12
          BX3    X0*X2       MASK OFF LOW 12 BITS OF FET+0
          SA2    FSTA        GET ADDRESS OF *STATUS* PARAMETER
          NZ     X3,FST1     IF SPECIFIED FILE IS FOUND
          BX6    X6-X6       SET *STATUS* TO FALSE
          JP     FST2        NO *REWIND*
 
 FST1     SX6    B1          SET *STATUS* TO TRUE
          SA6    X2          SAVE *STATUS*
          REWIND ZZZFET,R    REWIND WITH AUTO RECALL
 FST2     SA6    X2          SAVE *STATUS*
          EQ     SCRFSTX     RETURN
 
 FSTA     VFD    60/0        ADDRESS OF *STATUS* PARAMETER
          END
          IDENT  SCRGIS
          ENTRY  SCRGIS
          SYSCOM B1
          TITLE  SCRGIS - GET INITIALIZATION SEQUENCE.
*COMMENT  SCRGIS - GET INITIALIZATION SEQUENCE.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 GIS      SPACE  4,10
***       SCRGIS - GET INITIALIZATON SEQUENCE.
*
*         M. L. SWANSON.     84/05/09.
 GIS      SPACE  4,10
***       *SCRGIS* RETRIEVES THE SPECIFIED INITIALIZATION
*         SEQUENCE FROM THE LOADED CAPSULE, CONVERTING THE
*         CAPSULE-S 7-BIT BYTES INTO 12-BIT XPARENT BYTES,
*         AND RETURNING THE ADDRESS OF THE BUFFER.
 GIS      SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMCCMD
          LIST   X
*CALL     COMSTIR
          LIST   -X
 GIS      SPACE  4,15
***       SCRGIS - GET INITIALIZATION SEQUENCE.
*
*         CALLING SEQUENCE.
*
*         *SYMPL* CALL -
*
*         SCRGIS(ADDRESS,MODE,BUFFER);
*
*               (ADDRESS) = LOADED CAPSULE ADDRESS.
*               (MODE)    = TERMINAL MODE.
*               (BUFFER)  = PACKED SEQUENCE BUFFER.
 GIS      SPACE  4,10
**        SCRGIS - GET INITIALIZATION SEQUENCE.
*
*         ENTRY  (A1) = FWA OF FORMAL PARAMETER LIST.
*                (X1) = ADDRESS OF LOADED CAPSULE ADDRESS.
*
*         USES   X - 1, 2, 3, 4, 5, 6, 7.
*                A - 1, 2, 3, 4, 5, 6, 7.
*                B - 1, 2, 3, 4, 5, 6, 7.
 
 
 SCRGIS   SUBR               ENTRY/EXIT
          SB1    1
          SX6    A1          SAVE FWA OF *SYMPL* PARAMETERS
          SA2    X1          GET ADDRESS OF TERMCAP
          SA6    GISA
          SA3    X2+B1       GET SECOND WORD OF TERMCAP
          MX4    12          CREATE MASK FOR POINTER OFFSET
          LX4    36          POSITION MASK AT SEQUENCE FIELD
          BX5    X4*X3       GET SEQUENCE TABLE OFFSET
          LX5    36
 
*         GET FIRST WORD OF INITIALIZATION TABLE.
 
          SB2    X5
          SA2    X2+B2       GET FIRST WORD OF SEQUENCE TABLE
 
*         DETERMINE WHICH SEQUENCE TO OUTPUT (SCREEN OR LINE).
 
          SA3    A1+1        GET ADDRESS OF MODE PARAMETER
          SA3    X3          GET MODE
          ZR     X3,GIS1     IF LINE MODE
          LX4    12          POSITION MASK AT SCREEN SEQUENCE
          BX5    X4*X2       GET BYTE OFFSET OF SCREEN SEQUENCE
          LX5    24          REPOSITION
          LX4    48          REPOSITION MASK FOR NEXT FIELD
          BX6    X4*X2       GET NEXT FIELD
          LX6    36          REPOSITION
          EQ     GIS2        GET BYTE LENGTH OF FIELD
 
 GIS1     LX4    24          POSITION MASK AT LINE SEQUENCE
          BX5    X4*X2       GET BYTE OFFSET OF LINE SEQUENCE
          LX5    12          REPOSITION
          LX4    48          REPOSITION MASK FOR NEXT FIELD
          BX6    X4*X2       GET NEXT FIELD
          LX6    24          REPOSITION
 GIS2     IX6    X6-X5       CALCULATE BYTE LENGTH OF FIELD
          ZR     X6,SCRGISX  IF EMPTY INITIALIZATION SEQUENCE
          SX7    A2          GET CAPSULE POINTER
          SA6    GISB        STORE BYTE LENGTH OF SEQUENCE
          BX6    X5          GET OFFSET
 
*         CALCULATE POSITION OF MODE INDICATED SEQUENCE.
 
          BX3    X5          OFFSET OF SEQUENCE
          SX2    8           NUMBER OF BYTES IN WORD
          PX3    X3          PACK NUMERATOR
          PX4    X2          PACK DENOMINATOR
          NX4    X4          NORMALIZE
          FX5    X3/X4       CALCULATE NUMBER OF WORDS
          UX5    B7,X5       UNPACK RESULT
          LX5    B7,X5       SHIFT RESULT
          BX3    X7          CURRENT CAPSULE POINTER
          IX3    X3+X5       MOVE TO BEGINNING OF SEQUENCE
          BX4    X6          BYTE OFFSET OF SEQUENCE
          IX5    X5*X2       GET TOTAL BYTES BYPASSED
          IX4    X4-X5       CALCULATE CURRENT BYTE FIELD
          IX4    X2-X4       REVERSE TO REFLECT BYTE FIELD
          SB3    X4+         SAVE CAPSULE FIELD COUNTER
          SA4    GISB
          SB2    X4+         SAVE BYTE COUNTER
          SA4    GISC        INITIALIZE FIRST OUTPUT WORD
          BX7    X4
          MX4    7           CREATE CAPSULE 7-BIT BYTE MASK
          SB4    4           INITIALIZE BUFFER FIELD COUNTER
          SB6    GISC        INITIALIZE BUFFER POINTER
          SX5    7           BYTE LENGTH
          SX2    B3          GET CAPSULE BYTE FIELD
          IX5    X2*X5       CALCULATE INITIAL BYTE POSITION
          SB5    X5          COLUMNS TO SHIFT
 
*         THE FOLLOWING REGISTERS ARE USED AS FOLLOWS
*
*                X3  -  CAPSULE POINTER.
*                X4  -  CAPSULE BYTE MASK.
*                X7  -  BUFFER WORD.
*                B2  -  BYTE COUNTER OF INIT. SEQUENCE.
*                B3  -  CAPSULE BYTE FIELD COUNTER.
*                B4  -  BUFFER BYTE FIELD COUNTER.
*                B5  -  CAPSULE COLUMNS TO SHIFT.
*                B6  -  BUFFER POINTER.
 
          LX4    B5          MOVE MASK TO FIRST BYTE
          SB5    B5-7        ADJUST COLUMNS TO SHIFT
GIS3      SA1    X3          GET CURRENT CAPSULE WORD
          BX6    X4*X1       EXTRACT CAPSULE BYTE
          SX2    B4          GET BUFFER BYTE COUNTER
          AX6    B5          REPOSITION BYTE TO LOW BITS
          SX6    X6+4000B    CONVERT TO 12-BIT XPARENT BYTE
          SX5    12          XPARENT BYTE LENGTH
          IX5    X5*X2       CALCULATE POSITION IN BUFFER WORD
          SB7    X5-12       CALCULATE COLUMNS TO SHIFT
          LX6    B7          REPOSITION
          BX7    X6+X7       PLACE NEW BYTE IN BUFFER WORD
 
*         DECREMENT NUMBER OF SEQUENCE BYTES LEFT TO OUTPUT.
 
          SB2    B2-B1       DECREMENT SEQUENCE BYTE COUNTER
          ZR     B2,GIS8     IF DONE WITH SEQUENCE
 
*         DECREMENT CAPSULE BYTE FIELD.
 
          SB3    B3-1        DECREMENT CAPSULE BYTE FIELD
          ZR     B3,GIS4     IF END OF CAPSULE WORD
 
          SB5    B5-7        DECREMENT CAPSULE COLUMNS TO SHIFT
          EQ     GIS5        NOT END OF CAPSULE WORD
 
*         IF END OF CAPSULE WORD.
 
 GIS4     SX3    X3+1        MOVE TO NEXT WORD IN CAPSULE
          SA1    X3+         GET CAPSULE WORD
          SB3    8           RESET CAPSULE BYTE FIELD
          SB5    49          RESET CAPSULE COLUMNS TO SHIFT
          LX4    49          RESET CAPSULE MASK TO FIRST BYTE
          EQ     GIS6        NEW CAPSULE WORD
 
 GIS5     LX4    53          SHIFT MASK TO NEXT CAPSULE BYTE
 
*         DECREMENT BUFFER BYTE FIELD.
 
 GIS6     SB4    B4-1        DECREMENT BUFFER BYTE FIELD
          ZR     B4,GIS7     IF END OF BUFFER WORD
 
          EQ     GIS3        GET NEXT BYTE
 
*         IF END OF BUFFER WORD.
 
 GIS7     SA7    B6          STORE FULL WORD INTO BUFFER
          SX7    B0          RESET WORD TO ZERO
          SB6    B6+1        INCREMENT BUFFER POINTER
          SB7    48          RESET COLUMNS TO SHIFT
          SB4    5           RESET BUFFER BYTE FIELD
          EQ     GIS3        GET NEXT BYTE
 
*         IF END OF SEQUENCE.
 
 GIS8     SA7    B6+         STORE LAST WORD
 
*         RETURN SEQUENCE BUFFER TO CALLING ROUTINE.
 
          SA2    GISA        GET ADDRESS OF *SYMPL* PARAMETERS
          SA2    X2+2        GET ADDRESS OF BUFFER PARAMETER
          SA3    GISC        GET ADDRESS OF SEQUENCE BUFFER
          SX7    A3
          SA7    X2          STORE ADDRESS OF SEQUENCE BUFFER
          EQ     SCRGISX     RETURN
 
 GISA     VFD    60/0        ADDRESS OF *SYMPL* PARAMETERS
 GISB     VFD    60/0        SEQUENCE BYTE COUNTER
 GISC     VFD    12/7,48/0   FIRST WORD OF BUFFER
          BSSZ   ISBL        OUTPUT BUFFER
 
 
          END
          IDENT  SCRISR
          ENTRY  SCRISR
          SYSCOM B1
          TITLE  SCRISR - ISSUE SYSTEM REQUEST.
*COMMENT  SCRISR - ISSUE SYSTEM REQUEST.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 ISR      SPACE  4,10
***       SCRISR - ISSUE SYSTEM REQUEST.
*
*         M. L. SWANSON.     84/05/09.
 ISR      SPACE  4,10
***       *SCRISR* ISSUES A SYSTEM REQUEST TO SET THE SCREEN
*         BIT IN TERMINAL TABLE WORD *VSTT*.
 ISR      SPACE  4,10
***       SCRISR - ISSUE SYSTEM REQUEST.
*
*         CALLING SEQUENCE.
*
*         *SYMPL* CALL -
*
*         SCRISR(MODE);
*
*                MODE = 0, TERMINAL IN LINE MODE.
*                     = 1, TERMINAL IN SCREEN MODE.
 ISR      SPACE  4,10
**        SCRISR - ISSUE SYSTEM REQUEST.
*
*         ENTRY  (A1) = FWA OF FORMAL PARAMETER LIST.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         USES   X - 1.
*                A - 2.
*                B - 1.
*
*         MACROS  SYSTEM.
 
 SCRISR   SUBR               ENTRY/EXIT
          SB1    1
          SA2    X1+         GET DIRECTIVE PARAMETER
          ZR     X2,ISR1     IF LINE MODE
          SYSTEM TLX,R,0,13B*100B  SET SCREEN BIT IN *VSTT*
          EQ     SCRISRX     RETURN
 
 ISR1     SYSTEM TLX,R,0,14B*100B  CLEAR SCREEN BIT IN *VSTT*
          EQ     SCRISRX     RETURN
 
          END
          IDENT  SCRLCP
          ENTRY  SCRLCP
          SYSCOM B1
          TITLE  SCRLCP - LOAD TERMINAL CAPSULE.
*COMMENT  SCRLCP - LOAD TERMINAL CAPSULE.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 LCP      SPACE  4,10
***       SCRLCP - LOAD TERMINAL CAPSULE.
*
*         M. L. SWANSON.     84/05/09.
 LCP      SPACE  4,10
***       *SCRLCP* INVOKES THE FAST DYNAMIC LOADER TO LOAD
*         THE SPECIFIED TERMINAL CAPSULE, RETURNING THE
*         ADDRESS OF THE LOADED CAPSULE AND A STATUS FLAG.
 LCP      SPACE  4,10
***       CALLING SEQUENCE.
*
*         *SYMPL* CALL -
*
*         SCRLCP(TERMINAL,ADDRESS,STATUS);
*
*                TERMINAL = TERMINAL MNEMONIC(CAPSULE NAME).
*                ADDRESS = LOADED CAPSULE ADDRESS.
*                STATUS = CAPSULE LOADED SUCCESSFULLY FLAG.
 LCP      SPACE  4,10
**        SCRLCP - LOAD TERMINAL CAPSULE.
*
*         ENTRY  (A1) = FWA OF FORMAL PARAMETER LIST.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         USES   X - 0, 1, 2, 3, 4, 6, 7.
*                A - 1, 2, 3, 4, 6, 7.
*                B - 1, 2.
*
*         CALLS  FDL.LDC.
 
 
 SCRLCP   SUBR               ENTRY/EXIT
          SB1    1
          SX6    A1          SAVE ADDRESS OF *SYMPL* PARAMETERS
          MX0    42          MASK OUT SEVEN CHARACTER NAME
          SA6    SLCA
          SA1    X1          GET CAPSULE NAME
          BX6    X0*X1
          MX0    -6          MASK OFF BLANK FILL
          SB2    6           AT LEAST ONE NON-BLANK CHARACTER
          LX6    6           START AT SECOND CHARACTER
 SLC1     LX6    6           PROCESS NEXT CHARACTER
          BX2    -X0*X6      CHECK FOR BLANK CHARACTER
          SX3    X2-1R
          NZ     X3,SLC2     IF NOT BLANK
          BX6    X0*X6       MASK OFF BLANK CHARACTER
 SLC2     SB2    B2-B1
          NZ     B2,SLC1     IF NOT DONE
          LX6    18          REPOSITION NAME
          SA6    SLCC        PUT NAME INTO LIST FOR *FDL* CALL
          SA6    SLCG        PUT NAME INTO ENTRY POINT LIST
          SA1    SLCB        SET PARAMETERS FOR *FDL* CALL
          SA2    A1+1        SET CAPSULE NAME
          SA3    A2+B1       SET LIBRARY LIST ADDRESS
          SA4    A3+B1       SET ENTRY POINT LIST ADDRESS
          RJ     =XFDL.LDC   LOAD CAPSULE
          SA1    SLCA        GET ADDRESS OF *SYMPL* PARAMETERS
          SA1    X1+B1       GET LOADED CAPSULE ADDRESS
          SA2    A1+B1       GET ADDRESS OF CAPSULE-LOADED FLAG
          SA3    SLCG        MASK ENTRY POINT ADDRESS OUT OF LIST
          MX0    -18
          BX7    -X0*X3
          SA7    X1          ENTRY POINT ADDR INTO CAPSULE ADDR
          SA6    X2          PUT LOAD STATUS IN STATUS PARAMETER
          EQ     SCRLCPX     RETURN
 
 SLCA     VFD    60/0        FWA OF *SYMPL* PARAMETER LIST
 
*         LOADER REPLY BLOCK.
 
 SLCB     VFD    60/0LVIRTERM  GROUPNAME
 SLCC     VFD    60/0        CAPSULE NAME (TERMINAL MNEMONIC)
          VFD    60/SLCD     ADDRESS OF LIBRARY LIST
          VFD    60/SLCE     ADDRESS OF LIST OF ENTRY POINTS
 SLCD     VFD    60/0LTERMLIB  LIST OF LIBRARIES
          VFD    60/0        END OF LIST
 SLCE     VFD    60/SLCF     LIST OF ADDRS OF ENTRY POINT LISTS
          VFD    60/0        END OF LIST
 SLCF     VFD    24/00210001B  HEADER WORD OF ENTRY POINT LIST
          VFD    36/0
 SLCG     VFD    60/0        ENTRY POINT NAME AND ADDRESS
 
          END
          IDENT  SCRPKP
          ENTRY  SCRPKP
          SYSCOM B1
          TITLE  SCRPKP - PROCESS SCREEN/LINE PARAMETERS.
*COMMENT  SCRPKP - PROCESS SCREEN/LINE PARAMETERS.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 PKP      SPACE  4,10
***       SCRPKP - PROCESS SCREEN/LINE PARAMETERS.
*
*         M. L. SWANSON.     84/05/09.
 PKP      SPACE  4,10
***       *SCRPKP* PROCESSES PARAMETERS FOR THE SCREEN AND
*         LINE DIRECTIVES.
 PKP      SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMCARG
*CALL     COMCARM
*CALL     COMCCPA
*CALL     COMCPOP
*CALL     COMCUSB
 PKP      SPACE  4,10
***       SCRPKP - PROCESS SCREEN/LINE PARAMETERS.
*
*         CALLING SEQUENCE.
*
*         *SYMPL* CALL -
*
*         SCRPKP(TERMINAL);
*
*               (TERMINAL) = USER INPUT TERMINAL MNEMONIC.
 PKP      SPACE  4,10
**        SCRPKP - PROCESS SCREEN/LINE PARAMETERS.
*
*         ENTRY  (A1) = FWA OF FORMAL PARAMETER LIST.
*                (X1) = FWA OF TERMINAL MNEMONIC.
*
*         USES   X - 3, 6, 7.
*                A - 3, 6.
*                B - 1.
*
*         CALLS  PKP.
 
 SCRPKP   SUBR               ENTRY/EXIT
          SB1    1
          SX6    X1+         STORE FWA OF *SYMPL* PARAMETER LIST
          SA6    SPPA
          SX6    TSLA        ARGUMENT TABLE ADDRESS
          SX7    TSLAL       ARGUMENT TABLE LENGTH
          RJ     PKP         PROCESS PARAMETERS
          NZ     X1,SCRPKPX  IF NO ARGUMENTS
          SA3    SPPA        GET FWA OF FORMAL PARAMETER LIST
          BX6    X2
          SA6    X3          PUT MNEMONIC IN PARAMETER LIST
          EQ     SCRPKPX     RETURN
 
 SPPA     BSS    1           FWA OF *SYMPL* PARAMETER LIST
 PKP      SPACE  4,10
**        TABLE OF VALID ARGUMENTS.
 
 
 TSLA     BSS    0
 TM       ARG    ZR,TCKA,400B  TERMINAL MNEMONIC
          ARG
 TSLAL    EQU    *-TSLA-1    LENGTH OF *TSLA* TABLE
 
 ZR       CON    0
 PKP      SPACE  4,20
**        PKP - PROCESS KEYWORD OR POSITIONAL ARGUMENTS.
*
*         ENTRY  (X6) = ARGUMENT TABLE ADDRESS.
*                (X7) = ARGUMENT TABLE LENGTH.
*
*         EXIT   (B1) = 1.
*                (X1) .NE. 0 IF NO ARGUMENTS SPECIFIED.
*                (X2) = TERMINAL MNEMONIC.
*                TO *ERR* IF ARGUMENT ERROR.
*
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 6, 7.
*                B - 1, 2, 3, 4, 6.
*
*         CALLS  ARM, CPA, USB.
*
*         MACROS ABORT, MESSAGE.
 
 
 PKP      SUBR               ENTRY/EXIT
          SB1    1
          SA6    PKPA        SAVE ADDRESS AND LENGTH
          SA7    PKPB
          SB2    CCDR        UNPACK CONTROL CARD
          RJ     USB         UNPACK STRING BUFFER
          SA1    A6          ASSURE TERMINATION
          SX6    1R.
          SA6    X1+B1
 
*         SKIP TO FIRST ARGUMENT.
 
 PKP1     SA1    B6          SKIP OVER CONTROL CARD NAME
          SB6    B6+B1       ADVANCE CHARACTER ADDRESS
          SB2    X1-1R9-1
          NG     B2,PKP1     IF NOT END OF NAME
          SB2    X1-1R
          ZR     B2,PKP1     IF A BLANK
          SB3    X1-1R.
          SB4    X1-1R)
          ZR     B3,PKPX     IF NO ARGUMENTS
          ZR     B4,PKPX     IF NO ARGUMENTS
 
*         PROCESS ARGUMENTS.
 
          SA1    PKPA        RETRIEVE ADDRESS AND LENGTH
          SA2    PKPB
          SB3    X1          ARGUMENT TABLE ADDRESS
          SB2    X2
          SB4    ABUF
          RJ     CPA         CONVERT POSITIONAL ARGUMENTS
          NG     B5,ERR      IF ARGUMENT ERROR
          SX6    B5+         SET LWA OF ARGUMENTS
          SB6    ABUF        SET FWA OF ARGUMENTS
          SA6    USBC
          RJ     ARM         PROCESS ARGUMENTS
          NZ     X1,ERR      IF ARGUMENT ERROR
          EQ     PKPX        RETURN
 
 PKPA     CON    0           ARGUMENT TABLE ADDRESS
 PKPB     CON    0           ARGUMENT TABLE LENGTH
 PKP      SPACE  4,10
 ERR      MESSAGE (=C* ERROR IN COMMAND PARAMETERS.*)
          ABORT
 PKP      SPACE  4,10
 TCKA     BSSZ   TSLAL       CRACKED ARGUMENT VALUES
 CPALN    EQU    40          CPA ARGUMENT LENGTH
 ABUF     EQU    *           ARGUMENT STRING BUFFER
 SBUF     EQU    ABUF+CPALN  SCRATCH BUFFER
 TBUF     BSS    SBUF-ABUF+1
 
          END
          IDENT  SCRRET
          ENTRY  SCRRET
          SYSCOM B1
          TITLE  SCRRET - RETURN LOCAL FILE.
*COMMENT  SCRRET - RETURN LOCAL FILE.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 RET      SPACE  4,10
***       SCRRET - RETURN LOCAL FILE.
*
*         M. L. SWANSON.     84/05/09.
 RET      SPACE  4,10
***       *SCRRET* PROVIDES AN INTERFACE FOR HIGH-LEVEL
*         LANGUAGES USING THE *RETURN* MACRO.
 RET      SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMCCMD
          LIST X
*CALL     COMSTIR
          LIST   -X
 RET      SPACE  4,10
**        FETS.
 
 
 RETFET   RFILEB  RBUF,RBFL
 RET      SPACE  4,10
***       SCRRET - RETURN LOCAL FILE.
*
*         CALLING SEQUENCE.
*
*         *SYMPL* CALL -
*
*         SCRRET(FILE);
*
*               (FILE) = LOCAL FILE NAME.
 RET      SPACE  4,10
**        SCRRET - RETURN LOCAL FILE.
*
*         ENTRY  (A1) = FWA OF FORMAL PARAMETER LIST.
*                (X1) = FWA OF LOCAL FILE NAME.
*
*         USES   X - 1.
*                A - 1.
*                B - 1.
*
*         MACROS  RETURN, SETFET.
 
 
 SCRRET   SUBR               ENTRY/EXIT
          SB1    1
          SA1    X1
          SETFET RETFET,(LFN=X1)
          RETURN RETFET,R
          EQ     SCRRETX     RETURN
 
 RET      SPACE  4,10
**        BUFFER.
 
 
 RBUF     BSS    RBFL        FET BUFFER
 
          END
          IDENT  SCRRTA
          ENTRY  SCRRTA
          SYSCOM B1
          TITLE  SCRRTA - RETRIEVE TERMCAP ADDRESS.
*COMMENT  SCRRTA - RETRIEVE TERMCAP ADDRESS.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 RTA      SPACE  4,10
***       SCRRTA - RETRIEVE RESIDENT TERMCAP ADDRESS.
*
*         M. L. SWANSON.     84/04/24.
 RTA      SPACE  4,10
***       *SCRRTA* CALLS *GTO* TO RETRIEVE A RESIDENT
*         TERMINAL CAPSULE ADDRESS, GIVEN THE TERMINAL
*         MNEMONIC (CAPSULE NAME).
 RTA      SPACE  4,10
***       CALLING SEQUENCE.
*
*         *SYMPL* CALL -
*
*         SCRRTA(TERMINAL,ADDRESS);
*
*                TERMINAL = TERMINAL MNEMONIC(CAPSULE NAME).
*                ADDRESS  = RESIDENT CAPSULE ADDRESS.
 RTA      SPACE  4,10
**        SCRRTA - RETRIEVE RESIDENT TERMCAP ADDRESS.
*
*         ENTRY  (A1) = FWA OF FORMAL PARAMETER LIST.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         USES   X - 2, 6, 7.
*                A - 2, 6, 7.
*                B - 1.
*
*         CALLS  GTO.
 
 
 SCRRTA   SUBR               ENTRY/EXIT
          SB1    1
          SX6    A1          SAVE ADDRESS OF *SYMPL* PARAMETERS
          SA2    X1          GET TERMINAL MNEMONIC
          SA6    RTAA        STORE PARAMETER LIST
 
*         GET RESIDENT TERMCAP ADDRESS.
 
          RJ     GTO
 
*         *GTO* RETURNS ADDRESS OF TERMCAP IN X3.
 
          SA2    RTAA        GET ADDRESS OF *SYMPL* PARAMETERS
 
          SA2    X2+1        GET ADDRESS PARAMETER
          BX7    X3
          SA7    X2          STORE ADDRESS IN PARAMETER LIST
          EQ     SCRRTAX     RETURN
 
          LIST   X
*CALL     COMCGTO
          LIST   -X
 
 RTAA     VFD    60/0        ADDRESS OF SYMPL PARAMETER LIST.
 
          END
          IDENT  SCRRZF
          ENTRY  SCRRZF
          SYSCOM B1
          TITLE  SCRRZF - READ ZZZZTRM FILE.
 RZF      SPACE  4,10
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
***       SCRRZF - READ ZZZZTRM FILE.
*
*         M. L. SWANSON.     84/05/14.
 RZF      SPACE  4,10
***       *SCRRZF* CALLS *READEI* TO FILL A BUFFER WITH
*         THE CONTENTS OF THE *ZZZZTRM* FILE.  THE ADDRESS
*         OF THIS BUFFER IS THEN RETURNED TO THE CALLING
*         ROUTINE.
 RZF      SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMCCMD
***       CALLING SEQUENCE.
*
*         *SYMPL* CALL -
*
*         SCRRZF(FILE,ADDRESS);
*
*                FILE = SPECIFIED FILE.
*                ADDRESS = ADDRESS OF BUFFER TO WHICH FILE IS READ.
 RZF      SPACE  4,10
**        SCRRZF - READ ZZZZTRM FILE.
*
*         ENTRY  (A1) = FWA OF FORMAL PARAMETER LIST.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         USES   X - 0, 1, 2. 3, 6.
*                A - 1, 2, 6.
*                B - 1, 2.
*
*         MACROS SETFET, READEI.
 RZF      SPACE  4,10
*         FETS.
 
 
 ZZZFET   RFILEB BUF,BUFL
 BUFL     EQU    1001B
 BUF      BSS    BUFL
*
 SCRRZF   SUBR               ENTRY/EXIT
          SB1    1
          SA2    A1+B1       GET ADDRESS OF *ADDRESS* ADDRESS
          SX6    X2          GET ADDRESS OF *ADDRESS* PARAMETER
          SA6    RZFA        STORE ADDRESS OF *ADDRESS* PARAMETER
          SA1    X1          GET *FILENAME* PARAMETER
          MX0    42          MASK OFF SEVEN CHARACTER NAME
          BX6    X0*X1
          MX0    -6          MASK OFF BLANK FILL
          SB2    6           AT LEAST ONE NON-BLANK CHARACTER
          LX6    6           START AT SECOND CHARACTER
 RZF1     LX6    6           PROCESS NEXT CHARACTER
          BX2    -X0*X6      CHECK FOR BLANK CHARACTER
          SX3    X2-1R
          NZ     X3,RZF2     IF NOT BLANK
          BX6    X0*X6       MASK OFF BLANK CHARACTER
 RZF2     SB2    B2-B1
          NZ     B2,RZF1     IF NOT DONE
          LX6    18          REPOSITION NAME
          SETFET ZZZFET,(LFN=X6)  REPLACE FILE NAME IN FET
          READEI ZZZFET,R    READ UNTIL EOI OR BUFFER IS FILLED
          SA2    RZFA        GET ADDRESS OF *ADDRESS* PARAMETER
          SX6    BUF         GET CIO BUFFER ADDRESS
          SA6    X2          RETURN BUFFER ADDRESS
          EQ     SCRRZFX     RETURN
 
 RZFA     VFD    60/0        ADDRESS OF *ADDRESS* PARAMETER
 
          END
          IDENT  SCRUGD
          ENTRY  SCRUGD
          SYSCOM B1
          TITLE  SCRUGD - UNLOAD GROUP DIRECTORY
*COMMENT  SCRUGD - UNLOAD GROUP DIRECTORY.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 UGD      SPACE  4,10
***       SCRUGD - UNLOAD GROUP DIRECTORY.
*
*         M. L. SWANSON.     84/09/06.
 UGD      SPACE  4,10
***       *SCRUGD* INVOKES THE FAST DYNAMIC LOADER TO UNLOAD
*         THE *VIRTERM* GROUP DIRECTORY.
 UGD      SPACE  4,10
***       CALLING SEQUENCE.
*
*         *SYMPL* CALL -
*
*         SCRUGD;
 UGD      SPACE  4,10
**        SCRUGD - UNLOAD GROUP DIRECTORY.
*
*         ENTRY  OBJECT ROUTINE CALLED.
*
*         EXIT   *VIRTERM* GROUP DIRECTORY UNLOADED.
*
*         USES   X - 1.
*                A - 1.
*                B - 1.
*
*         CALLS  FDL.UGD.
 
 
 SCRUGD   SUBR               ENTRY/EXIT
          SB1    1
          SA1    UGDA        GROUP NAME
          RJ     =XFDL.UGD   UNLOAD GROUP DIRECTORY
          EQ     SCRUGDX     RETURN
 
 UGDA     VFD    42/0LVIRTERM,18/0  GROUP NAME
 
          END
          IDENT  SFCNP$
          ENTRY  SFCNP$
          SYSCOM B1
          TITLE  SFCNP$ - COPY NEXT PARAMETER.
*COMMENT  SFCNP$ - COPY NEXT PARAMETER.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 CNP      SPACE  4,10
***       SFCNP$ - COPY NEXT PARAMETER.
*
*         E.D. REDIG.        83/01/14.
 CNP      SPACE  4,10
***       *SFCNP$* PROVIDES AN INTERFACE TO *SMF* ROUTINES FOR
*         COPYING A PARAMETER TO A NEW PARAMETER LIST.
 CNP      SPACE  4,10
**        SFCNP$ - COPY NEXT PARAMETER.
*
*         ENTRY  (A1) = FWA OF PARAMETER.
*                (X1) = ACTUAL PARAMETER.
*                (B2) = FWA OF NEW PARAMETER.
*
*         EXIT   (A1) = POINTS TO NEXT PARAMTER.
*                (B2) = POINTS TO NEXT NEW PARAMETER.
*
*         USES   X - 1, 6.
*                A - 1, 6.
*                B - 1, 2.
 
 
 SFCNP$   SUBR               ENTRY/EXIT
          SB1    1
          SX6    X1          SAVE ADDRESS OF PARAMETER
          SA6    B2
          SA1    A1+B1       POINT TO NEXT PARAMETER
          SB2    B2+B1       POINT TO NEXT NEW PARAMETER
          EQ     SFCNP$X     RETURN
 
          END
          IDENT  SFCSP$
          ENTRY  SFCSP$
          SYSCOM B1
          TITLE  SFCSP$ - COPY STRING PARAMETER.
*COMMENT  SFCSP$ - COPY STRING PARAMETER.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 CSP      SPACE  4,10
***       SFCSP$ - COPY STRING PARAMETER.
*
*         E.D. REDIG.        83/01/14.
 CSP      SPACE  4,10
***       *SFCSP$* PROVIDES AN INTERFACE TO *SMF* ROUTINES FOR
*         COPYING A STRING PARAMETER, ITS LENGTH, AND OFFSET TO
*         A NEW PARAMETER LIST.
 CSP      SPACE  4,10
**        SFCSP$ - COPY STRING PARAMETER.
*
*         ENTRY  (A1) = FWA OF PARAMETER.
*                (X1) = ACTUAL PARAMETER.
*                (B2) = ADDRESS OF NEXT NEW PARAMETER.
*                (B3) = ADDRESS OF LENGTH OF STRING PARAMETER.
*
*         EXIT   (A1) = POINTS TO NEXT PARAMTER.
*                (B2) = POINTS TO NEXT NEW PARAMETER.
*                (B3) = POINTS TO NEXT NEW LENGTH AND OFFSET.
*
*         USES   X - 0, 1, 6, 7.
*                A - 1, 6, 7.
*                B - 1, 2, 3.
 
 
 CSP2     SB2    A6+B1
          SB3    A7+B1
          SA1    A1+1
 
 SFCSP$   SUBR               ENTRY/EXIT
          SB1    1
          SX6    X1          COPY STRING ADDRESS
          MX0    -3          EXTRACT CLASS OF DATA
          SA6    B2
          LX1    0-21
          BX7    -X0*X1
          MX0    -18
          ZR     X7,CSP1     IF *FORTRAN5* CALL
          LX1    0-36-0+21   EXTRACT *COBOL5* LENGTH
          BX7    -X0*X1
          SX6    B3
          SA7    B3          LENGTH
          MX0    -6
          SA6    A6+B1       ADDRESS OF LENGTH
          LX1    0-30-0+36   EXTRACT OFFSET
          BX7    -X0*X1
          SA7    A7+B1       OFFSET
          SX6    A7
          SA6    A6+1        ADDRESS OF OFFSET
          EQ     CSP2        INCREMENT POINTERS
 
 CSP1     LX1    0-30-0+21   EXTRACT LENGTH
          BX7    -X0*X1
          SX6    B3
          SA7    B3          LENGTH
          MX0    -4
          SA6    A6+B1       ADDRESS OF LENGTH
          LX1    0-24-0+30   EXTRACT OFFSET
          BX7    -X0*X1
          SA7    A7+1        OFFSET
          SX6    A7+
          SA6    A6+1        ADDRESS OF OFFSET
          EQ     CSP2        INCREMENT POINTERS
 
          END
          IDENT  VDTABT$
          ENTRY  VDTABT$
          SYSCOM B1
          TITLE  VDTABT$ - ABORT JOB.
*COMMENT  ABORT JOB.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 ABT      SPACE  4,10
***       VDTABT$ - ABORT JOB.
*
*         G.K. CHACE.        83/02/03.
 ABT      SPACE  4,10
***       CALLING SEQUENCE.
*
*         *SYMPL* CALL -
*
*         VDTABT$;
 VDTABT$  SPACE  4,10
***       VDTABT$ - ABORT JOB.
*
*         USES   B - 1.
*
*         MACROS ABORT.
 
 
 VDTABT$  SUBR               ENTRY/EXIT
          SB1    1
          ABORT
 
          END
*IF DEF,CRM
          IDENT  VDTCRM$
          ENTRY  VDTCLO$
          ENTRY  VDTOPN$
          SYSCOM B1
          TITLE  VDTCRM$ - CRM OUTPUT ROUTINES.
*COMMENT  CRM OUTPUT ROUTINES.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 CRM      SPACE  4,10
***       VDTCRM$ - CRM OUTPUT ROUTINES.
*
*         E.D. REDIG.        83/08/17.
 CRM      SPACE  4,10
**        FILE INFORMATION TABLE.
 
 
 OUTPUT   FILE   LFN=ZZZZZSF,BT=C,RT=S,CNF=YES,PD=OUTPUT,DFC=3,EFC=3,MRL
,=131071,ASCII=2,BFS=513
 CRM      SPACE  4,10
***       CALLING SEQUENCE.
*
*         *SYMPL* CALL -
*
*         VDTCLO$;
 CRM      SPACE  4,10
***       VDTCLO$ - CLOSE THE FILE.
*
*         USES   X - 1, 5, 6.
*                A - 0, 1, 6.
*                B - 1.
*
*         MACROS CLOSEM, FETCH.
 
 
 VDTCLO$  SUBR               ENTRY/EXIT
          SB1    1
          SX6    A0+         SAVE (A0)
          SA6    CLOA
          FETCH  OUTPUT,OC,X5  GET OPEN/CLOSE FLAG
          SX6    #CLO#       FILE CLOSED
          IX5    X5-X6
          ZR     X5,CLO1     IF FILE CLOSED
          CLOSEM OUTPUT,RET,FILE
 CLO1     SA1    CLOA        RESTORE (A0)
          SA0    X1+
          EQ     VDTCLO$X    RETURN
 
 CLOA     BSSZ   1           (A0)
 CRM      SPACE  4,10
***       CALLING SEQUENCE.
*
*         *SYMPL* CALL -
*
*         VDTOPN$;
 CRM      SPACE  4,10
***       VDTOPN$ - INITIALIZE THE *TERMIO* MODULE.
*
*         USES   X - ALL.
*                A - 0, 1, 2, 6, 7.
*                B - 1, 2, 3, 4, 5.
*
*         MACROS FETCH, GETLOF, OPENM, PUTP.
 
 
 VDTOPN$  SUBR               ENTRY/EXIT
          SB1    1
          SX6    A0          SAVE (A0)
          SX7    X1
          SA6    OPNA
          SA7    OPNB        SAVE FET ADDRESS
          FETCH  OUTPUT,OC,X5  GET OPEN/CLOSE FLAG
          SX6    #OPE#       FILE OPENED
          IX5    X5-X6
          ZR     X5,OPN1     IF FILE OPENED
          OPENM  OUTPUT,OUTPUT,N  INITIALIZE *TERMIO* MODULE
          PUTP   OUTPUT,OPNB,0,,,0
 OPN1     GETLOF OPNC-1      GET LIST OF FILES
          SA2    OPNC-1
          LX2    30
          SX1    X2          POINTER ADDRESS
          SA2    X1+B1       READ UP FIRST ENTRY
          SX6    X2
          SA1    OPNB
          SA2    X1
          SA6    A2+         RETURN FET ADDRESS
          SA1    X6+B1       FIRST
          SA2    A1+B1       IN
          SA3    A2+B1       OUT
          SA4    A3+B1       LIMIT
          SX6    X1-OPNC
          ZR     X6,OPN4     IF BUFFER ALREADY SWITCHED
          SX6    X1
          SX7    X4
          IX7    X7-X6       CURRENT BUFFER LENGTH
          SX7    X7-OPNCL
          PL     X7,OPN4     IF CURRENT BUFFER LARGE ENOUGH
          SX6    OPNC        ALLOCATE LARGER BUFFER
          MX0    42
          SB2    X1          FIRST
          SB3    X2          IN
          SB4    X3          OUT
          SB5    X4          LIMIT
          BX7    X0*X1       SET NEW FIRST
          BX7    X7+X6
          SA7    A1
          BX7    X0*X4       SET NEW LIMIT
          SX4    OPNC+OPNCL
          BX7    X7+X4
          SA7    A4
          SA6    A3          SET NEW OUT
          SA7    OPNC-1      SET DESTINATION ADDRESS
 OPN2     EQ     B4,B3,OPN3  IF OLD BUFFER IS EMPTY
          SA1    B4          TRANSFER OLD DATA TO NEW BUFFER
          SB4    B4+B1       ADVANCE POINTER
          BX7    X1
          SA7    A7+B1       PLACE WORD INTO NEW BUFFER
          NE     B4,B5,OPN2  IF NO WRAP AROUND
          SB4    B2          RESET POINTER
          EQ     OPN2        CONTINUE TRANSFER
 
 OPN3     SX6    A7+1        SET IN
          SA6    A2+
 OPN4     BSS    0
          SA1    OPNA        RESTORE (A0)
          SA0    X1+
          EQ     VDTOPN$X    RETURN
 
 OPNA     BSSZ   1           (A0)
 OPNB     BSSZ   1           FET ADDRESS
          BSS    1
 OPNC     BSS    401B        OUTPUT BUFFER
 OPNCL    EQU    *-OPNC
 
          END
*ENDIF
          IDENT  VDTFUN
          ENTRY  VDTFUN
          SYSCOM B1
          TITLE  VDTFUN - GET FUNCTION NAME.
*COMMENT  VDTFUN - GET FUNCTION NAME.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 FUN      SPACE  4,10
***       VDTFUN - GET FUNCTION NAME.
*
*         E.D. REDIG.        83/02/11.
 FUN      SPACE  4,10
***       *VDTFUN* PROVIDES AN INTERFACE TO *VDTFUN$* FOR PROGRAMS
*         WRITTEN IN HIGHER LEVEL LANGUAGES.
 FUN      SPACE  4,15
***       CALLING SEQUENCE.
*
*         *FORTRAN5* CALL -
*
*         CALL VDTFUN(FUNCTION,NAME,LENGTH)
*
*         *COBOL5* CALL -
*
*         ENTER VDTFUN USING FUNCTION, NAME, LENGTH.
*
*                FUNCTION = UNSHIFTED FUNCTION NUMBER (1-16).
*                         = SHIFTED FUNCTION NUMBER (MINUS 1-16).
*                NAME     = FUNCTION NAME.
*                LENGTH   = NUMBER OF CHARACTERS IN NAME.
 FUN      SPACE  4,10
**        VDTFUN - GET FUNCTION NAME.
*
*         ENTRY  (A1) = FWA OF FORMAL PARAMETER LIST.
*                (X1) = FWA OF FUNCTION NUMBER.
*
*         USES   A - 1.
*                B - 1, 2, 3.
*
*         CALLS  SFCNP$, SFCSP$, VDTFUN$.
 
 
 VDTFUN   SUBR               ENTRY/EXIT
          SB1    1
          SB2    FUNA        FWA OF PARAMETER LIST
          SB3    FUNB        LENGTH AND OFFSET
          RJ     =XSFCNP$    COPY FUNCTION
          RJ     =XSFCSP$    COPY NAME
          RJ     =XSFCNP$    COPY LENGTH
          SA1    FUNA        SET NEW PARAMETER LIST ADDRESS
          RJ     =XVDTFUN$   GET FUNCTION NAME
          EQ     VDTFUNX     RETURN
 
 FUNA     BSSZ   6           NEW PARAMETER LIST
 FUNB     BSSZ   2           LENGTH AND OFFSET FOR NAME
 
          END
          IDENT  VDTGEN
          ENTRY  VDTGEN
          SYSCOM B1
          TITLE  VDTGEN - GET GENERIC FUNCTION NAME.
*COMMENT  VDTGEN - GET GENERIC FUNCTION NAME.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 GEN      SPACE  4,10
***       VDTGEN - GET GENERIC FUNCTION NAME.
*
*         E.D. REDIG.        83/02/11.
 GEN      SPACE  4,10
***       *VDTGEN* PROVIDES AN INTERFACE TO *VDTGEN$* FOR PROGRAMS
*         WRITTEN IN HIGHER LEVEL LANGUAGES.
 GEN      SPACE  4,15
***       CALLING SEQUENCE.
*
*         *FORTRAN5* CALL -
*
*         CALL VDTGEN(FUNCTION,NAME,LENGTH)
*
*         *COBOL5* CALL -
*
*         ENTER VDTGEN USING FUNCTION, NAME, LENGTH.
*
*                FUNCTION = UNSHIFTED FUNCTION NUMBER (1-32).
*                         = SHIFTED FUNCTION NUMBER (MINUS 1-16).
*                NAME     = FUNCTION NAME.
*                LENGTH   = NUMBER OF CHARACTERS IN NAME.
 GEN      SPACE  4,10
**        VDTGEN - GET GENERIC FUNCTION NAME.
*
*         ENTRY  (A1) = FWA OF FORMAL PARAMETER LIST.
*                (X1) = FWA OF FUNCTION NUMBER.
*
*         USES   A - 1.
*                B - 1, 2, 3.
*
*         CALLS  SFCNP$, SFCSP$, VDTGEN$.
 
 
 VDTGEN   SUBR               ENTRY/EXIT
          SB1    1
          SB2    GENA        FWA OF PARAMETER LIST
          SB3    GENB        LENGTH AND OFFSET
          RJ     =XSFCNP$    COPY FUNCTION
          RJ     =XSFCSP$    COPY NAME
          RJ     =XSFCNP$    COPY LENGTH
          SA1    GENA        SET NEW PARAMETER LIST ADDRESS
          RJ     =XVDTGEN$   GET FUNCTION NAME
          EQ     VDTGENX     RETURN
 
 GENA     BSSZ   6           NEW PARAMETER LIST
 GENB     BSSZ   2           LENGTH AND OFFSET FOR NAME
 
          END
*IF UNDEF,RETRO
          IDENT  VDTGSL
          ENTRY  VDTGSL
          SYSCOM B1
          TITLE  VDTGSL - GET SCREEN/LINE MODE.
*COMMENT  VDTGSL - GET SCREEN/LINE MODE.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 GSL      SPACE  4,10
***       VDTGSL - GET SCREEN/LINE MODE.
*
*         E.D. REDIG.        83/02/09.
 GSL      SPACE  4,10
***       *VDTGSL* PROVIDES AN INTERFACE TO *SETSLM* FOR PROGRAMS
*         WRITTEN IN HIGHER LEVEL LANGUAGES.
 GSL      SPACE  4,15
***       CALLING SEQUENCE.
*
*         *FORTRAN5* CALL -
*
*         CALL VDTGSL(MODEL,SCREEN)
*
*         *COBOL5* CALL -
*
*         ENTER VDTGSL USING MODEL, SCREEN.
*
*                MODEL  = TERMINAL MODEL NUMBER.
*                SCREEN = 0, IF LINE MODE.
*                       = 1, IF SCREEN MODE.
 GSL      SPACE  4,10
**        VDTGSL - GET SCREEN/LINE MODE.
*
*         ENTRY  (A1) = FWA OF FORMAL PARAMETER LIST.
*                (X1) = FWA OF MODEL NUMBER.
*
*         USES   X - 0, 1, 2, 6.
*                A - 1, 2, 6.
*                B - 1.
*
*         CALLS  SETSLM.
 
 
 VDTGSL   SUBR               ENTRY/EXIT
          SB1    1
          SX6    X1
          SA1    A1+B1
          SA6    GSLA        SAVE ORDINAL ADDRESS
          SX6    X1
          SA6    A6+B1       SAVE SCREEN/LINE ADDRESS
          SETSLM GSLC        READ SCREEN/LINE MODE
          SA1    GSLC
          MX0    -6
          BX6    -X0*X1      EXTRACT ORDINAL
          SA2    GSLA
          LX1    0-6
          MX0    -1
          SA6    X2          STORE ORDINAL
          BX6    -X0*X1      EXTRACT SCREEN/LINE
          SA2    GSLB
          SA6    X2+         STORE SCREEN/LINE
          EQ     VDTGSLX     RETURN
 
 GSLA     CON    0           ORDINAL ADDRESS
 GSLB     CON    0           SCREEN/LINE ADDRESS
 GSLC     CON    0           *SETSLM* PARAMETER WORD
 
          END
*ENDIF
          IDENT  VDTGTA
          ENTRY  VDTGTA
          SYSCOM B1
          TITLE  VDTGTA - GET TEXT PARAMETER.
*COMMENT  VDTGTA - GET RESIDENT TERMCAP ADDRESS.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 GTA      SPACE  4,10
***       VDTGTA - GET RESIDENT TERMCAP ADDRESS.
*
*         M. L. SWANSON.     84/05/09.
 GTA      SPACE  4,10
***       *VDTGTA* CALLS *GTN* TO RETRIEVE A RESIDENT TERMCAP
*         ADDRESS CORRESPONDING TO THE GIVEN TERMINAL MODEL.
 GTA      SPACE  4,10
***       CALLING SEQUENCE.
*
*         *SYMPL* CALL -
*
*         VDTGTA(MODEL,ADDRESS);
*
*                MODEL = TERMINAL MODEL.
*                ADDRESS = CORRESPONDING RESIDENT CAPSULE ADDRESS.
 GTA      SPACE  4,10
**        VDTGTA - GET RESIDENT TERMCAP ADDRESS.
*
*
*         ENTRY  (A1) = FWA OF FORMAL PARAMETER LIST.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         USES   X - 2, 6, 7.
*                A - 2, 6, 7.
*                B - 1.
*
*         CALLS  GTN.
 
 
 VDTGTA   SUBR               ENTRY/EXIT
          SB1    1
          SX6    A1          SAVE ADDRESS OF SYMPL PARAMETERS
          SA2    X1          GET TERMINAL MODEL
          SA6    GTAA        STORE PARAMETER LIST
 
*         GET RESIDENT TERMCAP ADDRESS.
 
          RJ     GTN
 
*         *GTN* RETURNS ADDRESS OF TERMCAP IN X1.
 
          SA2    GTAA        GET ADDRESS OF SYMPL PARAMETERS
          SA2    X2+1        GET ADDRESS PARAMETER
          SX7    X1          EXTRACT RESIDENT TERMCAP ADDRESS
          SA7    X2          STORE ADDRESS IN PARAMETER LIST
          EQ     VDTGTAX     RETURN
 
          LIST   X
*CALL     COMCGTO
          LIST   -X
 
 GTAA     VFD    60/0        ADDRESS OF SYMPL PARAMETER LIST
 
          END
          IDENT  VDTGTO
          ENTRY  VDTGTO
          SYSCOM B1
          TITLE  VDTGTO - GET TERMINAL ORDINAL.
*COMMENT  VDTGTO - GET TERMINAL ORDINAL.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 GTO      SPACE  4,10
***       VDTGTO - GET TERMINAL ORDINAL.
*
*         E.D. REDIG.        83/02/03.
 GTO      SPACE  4,10
***       *VDTGTO* PROVIDES AN INTERFACE TO *COMCGTO* FOR
*         PROGRAMS WRITTEN IN HIGHER LEVEL LANGUAGES.
 GTO      SPACE  4,15
***       CALLING SEQUENCE.
*
*         *FORTRAN5* CALL -
*
*         CALL VDTGTO(ORDINAL,MNEMONIC)
*
*         *COBOL5* CALL -
*
*         ENTER VDTGTO USING ORDINAL, MNEMONIC.
*
*                ORDINAL  = TERMINAL MODEL NUMBER.
*                MNEMONIC = TERMINAL MNEMONIC.
 GTO      SPACE  4,10
**        VDTGTO - GET TERMINAL ORDINAL.
*
*         ENTRY  (A1) = FWA OF FORMAL PARAMETER LIST.
*                (X1) = FWA OF MODEL NUMBER.
*
*         USES   X - 1, 6.
*                A - 1, 6.
*                B - 1, 2, 3.
*
*         CALLS  SFCNP$, SFCSP$, VDGTO.
 
 
 VDTGTO   SUBR               ENTRY/EXIT
          SB1    1
          SB2    GTOA        FWA OF PARAMETER LIST
          SB3    GTOB        LENGTH AND OFFSET
          RJ     =XSFCNP$    COPY ORDINAL
          RJ     =XSFCSP$    COPY MNEMONIC
          SA1    GTOB        GET MNEMONIC LENGTH
          NZ     X1,VGO1     IF VALID LENGTH
          SX6    10          ONE WORD LENGTH
          SA6    GTOB        RESTORE MNEMONIC LENGTH
 VGO1     SA1    GTOA        SET NEW PARAMETER LIST ADDRESS
          RJ     VDGTO       GET TERMINAL ORDINAL
          EQ     VDTGTOX     RETURN
 GTO      SPACE  4,10
**        VDGTO - GET TERMINAL ORDINAL.
*
*         ENTRY  (A1) = FWA OF NEW PARAMETER LIST.
*                (X1) = FWA OF MODEL NUMBER.
*
*         EXIT   RETURN TERMINAL ORDINAL CORRESPONDING TO MNEMONIC.
*
*         USES   X - 0, 1, 2, 3, 4, 5, 6.
*                A - 1, 2, 3, 6.
*                B - 1, 2, 3, 4, 5, 6, 7.
*
*         CALLS  GTO.
 
 
 VDGTO    SUBR               ENTRY/EXIT
          SB1    1
          SB7    X1          SAVE RETURN ADDRESS
          SA1    A1+B1       GET MNEMONIC
          SA2    A1+B1       GET LENGTH
          SA3    A2+B1       GET OFFSET
          SA1    X1
          SA2    X2
          SA3    X3+
          SX4    6
          SB6    X2          SAVE LENGTH
          IX4    X4*X3       COMPUTE SHIFT COUNT
          SB2    X4+
          SB4    X3          SAVE OFFSET
          LX1    B2          LEFT JUSTIFY FIRST WORD OF MNEMONIC
          SX4    10
          SB3    60          SHIFT COUNT
          IX4    X4-X3       COMPUTE CHARACTERS LEFT IN FIRST WORD
          BX6    X6-X6       CLEAR TERMINAL NAME
          SB5    X4          SAVE CHARACTERS LEFT IN FIRST WORD
          LX1    6           POSITION MNEMONIC
          SB2    6
          SX0    1R+
          MX3    -6          ONE CHARACTER MASK
          BX2    X2-X2
 VDG1     BX4    -X3*X1      GET A CHARACTER
          ZR     X4,VDG3     IF END OF NAME
          IX5    X4-X0
          PL     X5,VDG4     IF NOT ALPHANUMERIC
          LX6    6
          SB3    B3-B2       DECREMENT SHIFT COUNT
          BX6    X6+X4       TRANSFER A CHARACTER
          SB5    B5-B1       DECREMENT FIRST WORD COUNT
          LX1    6
          SB6    B6-B1       DECREMENT LENGTH COUNT
          ZR     B6,VDG3     IF ENOUGH CHARACTERS
          GT     B5,VDG1     IF MORE IN THIS WORD
          ZR     B3,VDG2     IF FULL WORD
          SA1    A1+1        GET NEXT WORD
          SB5    B4          NUMBER OF CHARACTERS LEFT
          LX1    6           POSITION MNEMONIC
          EQ     VDG1        LOOP FOR NEXT CHARACTER
 
 VDG2     NZ     B6,VDGTOX   IF TOO MANY CHARACTERS
 VDG3     NG     B3,VDGTOX   IF TOO MANY CHARACTERS
 VDG4     ZR     X6,VDGTOX   IF ZERO LENGTH NAME
          LX6    X6,B3       POSITION NAME
          BX2    X6
          RJ     GTO         GET TERMINAL ORDINAL
          SX6    X1
          SA6    B7          STORE ORDINAL
          EQ     VDGTOX      RETURN
 
          LIST   X
*CALL     COMCGTO
          LIST   *
 
 GTOA     BSSZ   1           TERMINAL ORDINAL
          BSSZ   1           MNEMONIC
          BSSZ   1           ADDRESS OF MNEMONIC LENGTH
          BSSZ   1           ADDRESS OF MNEMONIC OFFSET
          BSSZ   1           ZERO TERMINATOR
 GTOB     BSSZ   1           MNEMONIC LENGTH
          BSSZ   1           MNEMONIC OFFSET
 
          END
          IDENT  VDTGTN
          ENTRY  VDTGTN
          SYSCOM B1
          TITLE  VDTGTN - GET TERMINAL MNEMONIC.
*COMMENT  VDTGTO - GET TERMINAL MNEMONIC.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 GTN      SPACE  4,10
***       VDTGTN - GET TERMINAL MNEMONIC.
*
*         E.D. REDIG.        83/02/03.
 GTN      SPACE  4,10
***       *VDTGTN* PROVIDES AN INTERFACE TO *COMCGTO* FOR
*         PROGRAMS WRITTEN IN HIGHER LEVEL LANGUAGES.
 GTN      SPACE  4,15
***       CALLING SEQUENCE.
*
*         *FORTRAN5* CALL -
*
*         CALL VDTGTN(ORDINAL,MNEMONIC)
*
*         *COBOL5* CALL -
*
*         ENTER VDTGTN USING ORDINAL, MNEMONIC.
*
*                ORDINAL  = TERMINAL MODEL NUMBER.
*                MNEMONIC = TERMINAL MNEMONIC.
 GTN      SPACE  4,10
**        VDTGTN - GET TERMINAL NAME.
*
*         ENTRY  (A1) = FWA OF FORMAL PARAMETER LIST.
*                (X1) = FWA OF MODEL NUMBER.
*
*         USES   X - 1, 6.
*                A - 1, 6.
*                B - 1, 2, 3.
*
*         CALLS  SFCNP$, SFCSP$, VDGTN.
 
 
 VDTGTN   SUBR               ENTRY/EXIT
          SB1    1
          SB2    GTNA        FWA OF PARAMETER LIST
          SB3    GTNB        LENGTH AND OFFSET
          RJ     =XSFCNP$    COPY ORDINAL
          RJ     =XSFCSP$    COPY MNEMONIC
          SA1    GTNB        GET MNEMONIC LENGTH
          NZ     X1,VGN1     IF VALID LENGTH
          SX6    10          ONE WORD LENGTH
          SA6    GTNB        RESTORE MNEMONIC LENGTH
 VGN1     SA1    GTNA        SET NEW PARAMETER LIST ADDRESS
          RJ     VDGTN       GET TERMINAL NAME
          EQ     VDTGTNX     RETURN
 GTN      SPACE  4,10
**        VDGTN - GET TERMINAL MNEMONIC.
*
*         ENTRY  (A1) = FWA OF NEW PARAMETER LIST.
*                (X1) = FWA OF MODEL NUMBER.
*
*         EXIT   RETURN TERMINAL MNEMONIC CORRESPONDING TO ORDINAL.
*
*         USES   X - ALL.
*                A - 1, 2, 3, 4, 6.
*                B - 1, 2, 3, 4, 5, 6, 7.
*
*         CALLS  GTN.
 
 
 VDGTN    SUBR               ENTRY/EXIT
          SB1    1
          SA2    X1          GET ORDINAL
          SA1    A1+B1       GET MNEMONIC
          SB7    X1          SAVE RETURN ADDRESS
          SA3    A1+B1       GET LENGTH
          SA4    A3+B1       GET OFFSET
          SA3    X3
          SA4    X4+
          RJ     GTN         GET TERMINAL MNEMONIC
          SA2    B7+
          SX5    6
          SB6    X3          SAVE LENGTH
          IX5    X5*X4       COMPUTE SHIFT COUNT
          SB2    X5+
          SB4    X4          SAVE OFFSET
          LX2    B2          LEFT JUSTIFY FIRST WORD OF MNEMONIC
          SB5    10
          SX7    B2          SAVE SHIFT COUNT
          SB3    60          SHIFT COUNT
          SB5    B5-B4       COMPUTE CHARACTERS LEFT IN FIRST WORD
          LX1    6           POSITION MNEMONIC
          SB2    6
          MX3    -6          ONE CHARACTER MASK
 VDN1     BX4    -X3*X1      GET A CHARACTER
          NZ     X4,VDN2     IF NOT END OF NAME
          SX4    1R
 VDN2     LX2    6
          BX2    X3*X2       CLEAR CHARACTER
          SB3    B3-B2       DECREMENT SHIFT COUNT
          BX2    X2+X4       TRANSFER A CHARACTER
          SB5    B5-1        DECREMENT FIRST WORD COUNT
          LX1    6
          SB6    B6-B1       DECREMENT LENGTH COUNT
          ZR     B6,VDN4     IF ENOUGH CHARACTERS
          GT     B5,VDN1     IF MORE IN THIS WORD
          ZR     B3,VDN3     IF FULL WORD
          SB5    X7
          SB3    B3-B5       SHIFT COUNT
          SX7    B0
          LX6    X2,B3       POSITION MNEMONIC
          SA6    B7          STORE WORD ONE
          SA2    B7+B1       GET NEXT WORD
          SB7    A2+         SAVE RETURN ADDRESS
          SB5    B4          NUMBER OF CHARACTERS LEFT
          LX2    6           POSITION MNEMONIC
          SB3    60
          EQ     VDN1        LOOP FOR NEXT CHARACTER
 
 VDN3     NZ     B6,VDGTNX   IF TOO MANY CHARACTERS
 VDN4     NG     B3,VDGTNX   IF TOO MANY CHARACTERS
          SB2    X7
          SB3    B3-B2       SHIFT COUNT
          LX6    X2,B3       POSITION NAME
          SA6    B7          STORE MNEMONIC
          EQ     VDGTNX      RETURN
 
          LIST   X
*CALL     COMCGTO
          LIST   *
 
 GTNA     BSSZ   1           TERMINAL ORDINAL
          BSSZ   1           MNEMONIC
          BSSZ   1           ADDRESS OF MNEMONIC LENGTH
          BSSZ   1           ADDRESS OF MNEMONIC OFFSET
          BSSZ   1           ZERO TERMINATOR
 GTNB     BSSZ   1           MNEMONIC LENGTH
          BSSZ   1           MNEMONIC OFFSET
 
          END
          IDENT  VDTLOF$
          ENTRY  VDTLOF$
          SYSCOM B1
          TITLE  VDTLOF$ - SET LIST OF FILES.
*COMMENT  VDTLOF$ - SET LIST OF FILES.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 LOF      SPACE  4,10
***       VDTLOF$ - SET LIST OF FILES.
*
*         G.K. CHACE.        83/02/03.
 LOF      SPACE  4,10
**        COMMON DECKS.
 
 
*CALL     COMCCMD
 LOF      SPACE  4,15
***       CALLING SEQUENCE.
*
*         *SYMPL* CALL -
*
*         VDTLOF$(PARAMETER);
*
*                PARAMETER = ADDRESS TO LIST OF FILES TABLE.
 LOF      SPACE  4,10
**        VDTLOF$ - SET LIST OF FILES.
*
*         ENTRY  (A1) = FWA OF FORMAL PARAMETER LIST.
*                (X1) = FWA OF LIST OF FILES TABLE.
*
*         USES   B - 1.
*
*         MACROS SETLOF.
 
 
 VDTLOF$  SUBR               ENTRY/EXIT
          SB1    1
          SETLOF X1
          EQ     VDTLOF$X    RETURN
 
          END
          IDENT  VDTMSG$
          ENTRY  VDTMSG$
          SYSCOM B1
          TITLE  VDTMSG$ - SEND MESSAGE.
*COMMENT  SEND MESSAGE.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 MES      SPACE  4,10
***       VDTMSG$ - SEND MESSAGE.
*
*         G.K. CHACE.        83/02/03.
 MES      SPACE  4,25
***       CALLING SEQUENCE.
*
*         *FORTRAN5* CALL -
*
*         CALL VDTMSG$ (TEXT,OPTION,R)
*
*         *SYMPL* CALL -
*
*         VDTMSG$(TEXT,OPTION,1);
*
*                  (TEXT) = MESSAGE ARRAY, TERMINATED BY ZERO BYTE.
*                (OPTION) = 0, SEND MESSAGE TO SYSTEM DAYFILE,
*                              LOCAL JOB DAYFILE, AND A AND B DISPLAYS.
*                         = 1, SEND MESSAGE TO LINE 1 OF CONTROL POINT.
*                         = 2, SEND MESSAGE TO LINE 2 OF CONTROL POINT.
*                         = 3, SEND MESSAGE TO USER DAYFILE AND LINE
*                              1 OF CONTROL POINT.
*                         = 4, SEND MESSAGE TO ERROR LOG DAYFILE.
*                         = 5, SEND MESSAGE TO ACCOUNT DAYFILE.
*                         = 6, SAME AS 0.
*                         = 7, SAME AS 3.
*                         = 9, SEND MESSAGE TO BINARY MAINTENANCE LOG.
*                         = 5HLOCAL, SEND MESSAGE TO LOCAL JOB DAYFILE.
 MES      SPACE  4,15
***       VDTMSG$ - SEND MESSAGE.
*
*         ENTRY  (TEXT) - AN ARRAY WITH THE TEXT IN IT, OR AN ITEM
*                         WITH TEXT IN IT.
*                (OPTION) - AN ITEM CONTAINING ONE OF THE OPTIONS.
*                (R) = 1, IF RECALL.
*
*         USES   X - 2, 3, 4.
*                A - 2, 3.
*                B - 1.
*
*         MACROS MESSAGE.
 
 
 VDTMSG$  SUBR               ENTRY/EXIT
          SB1    1
          SA2    A1+B1       ADDRESS OF OPTION
          SA2    X2          OPTION
          SA3    =0HLOCAL
          BX4    X2-X3
          ZR     X4,MES1     IF LOCAL
          MESSAGE  X1,X2,R
          EQ     VDTMSG$X    RETURN
 
 
 MES1     MESSAGE X1,LOCAL,R
          EQ     VDTMSG$X    RETURN
 
          END
          IDENT  VDTPRT$
          ENTRY  VDTPRT$
          SYSCOM B1
          TITLE  VDTPRT$ - DISABLE/ENABLE PROMPT.
*COMMENT  VDTPRT$ - DISALBE/ENABLE PROMPT.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 PRT      SPACE  4,10
***       VDTPRT$ - DISABLE/ENABLE PROMPT.
*
*         E.D. REDIG.        84/05/21.
 PRT      SPACE  4,10
***       CALLING SEQUENCE.
*
*         *SYMPL* CALL -
*
*         VDTPRT$(PARAMETER);
*
*                PARAMETER = PARAMETER TO PASS TO PROMPT MACRO.
*                          = 0, DISABLE PROMPT.
*                          = 1, ENABLE PROMPT.
 PRT      SPACE  4,10
**        VDTPRT$ - DISABLE/ENABLE PROMPT.
*
*         ENTRY  (A1) = FWA OF FORMAL PARAMETER LIST.
*
*         USES   X - 1.
*                A - 1.
*                B - 1.
*
*         MACROS PROMPT.
 
 
 VDTPRT$  SUBR               ENTRY/EXIT
          SB1    1
          SA1    X1+
          ZR     X1,PRP1     IF PROMPT OFF
          PROMPT ON
          EQ     VDTPRT$X    RETURN
 
 PRP1     PROMPT OFF
          EQ     VDTPRT$X    RETURN
 
          END
          IDENT  VDTRD$
          ENTRY  VDTRD$
          SYSCOM B1
          TITLE  VDTRD$ - READ FILE TO *CIO* BUFFER.
*COMMENT  READ FILE TO *CIO* BUFFER.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 TRD      SPACE  4,10
***       VDTRD$ - READ FILE TO *CIO* BUFFER.
*
*         G.K. CHACE.        83/02/03.
 TRD      SPACE  4,10
***       CALLING SEQUENCE.
*
*         *FORTRAN5* CALL -
*
*         CALL VDTRD$ (FILE,R)
*
*         *SYMPL* CALL -
*
*         VDTRD$(FILE,1);
*
*                (FILE) = FIRST WORD OF THE FET.
*                (R) = RECALL, IF .NE. 0, RECALL IS REQUESTED.
 TRD      SPACE  4,10
***       VDTRD$ - READ FILE TO *CIO* BUFFER.
*
*         ENTRY  (FILE) - AN ARRAY THAT CONTAINS THE FET.
*                (R) = RECALL IF .NE. 0, RECALL IS REQUESTED.
*
*         USES   X - 2.
*                A - 2.
*                B - 1.
*
*         MACROS READ.
 
 
 VDTRD$   SUBR               ENTRY/EXIT
          SB1    1
          SA2    A1+B1       GET RECALL PARAMETER
          SA2    X2
          NZ     X2,TRD1     IF RECALL
          READ   X1
          EQ     VDTRD$X     RETURN
 
 TRD1     READ   X1,R
          EQ     VDTRD$X     RETURN
 
          END
          IDENT  VDTREC$
          ENTRY  VDTREC$
          SYSCOM B1
          TITLE  VDTREC$ - READ CODED LINE IN *C* FORMAT.
*COMMENT  READ CODED LINE IN *C* FORMAT.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 REC      SPACE  4,10
***       VDTREC$ - READ CODED LINE IN *C* FORMAT.
*
*         G.K. CHACE.        83/02/03.
 REC      SPACE  4,15
***       CALLING SEQUENCE.
*
*         *FORTRAN5* CALL -
*
*         CALL VDTREC$ (FILE,BUF,N,STATUS)
*
*         *SYMPL* CALL -
*
*         VDTREC$(FILE,BUF,N,STATUS);
*
*                (FILE) = FIRST WORD OF THE FET.
*                (BUF) = FIRST WORD OF THE WORKING BUFFER.
*                (N) = WORD COUNT OF THE WORKING BUFFER.
 REC      SPACE  4,25
***       VDTREC$ - READ CODED LINE IN *C* FORMAT.
*
*         TRANSFERS DATA UNTIL THE END OF LINE BYTE (0000) IS SENSED.
*
*         ENTRY  (FILE) = FWA OF THE FET.
*                (BUF) = FWA OF WORKING BUFFER.
*                (N) = WORD COUNT OF THE WORKING BUFFER.
*
*         EXIT   (STATUS) = 0, TRANSFER COMPLETE.
*                         = -1, END-OF-FILE DETECTED ON FILE.
*                         = -2, END-OF-INFORMATION DETECTED ON FILE.
*                         = LWA, END-OF-RECORD DETECTED ON FILE BEFORE
*                                TRANSFER WAS COMPLETE.
*                     LWA = ADDRESS + 1 OF LAST WORD TRANSFERRED TO
*                           WORKING BUFFER.
*
*         USES   X - 3, 4, 5, 6.
*                A - 3, 4, 5, 6.
*                B - 1.
*
*         MACROS READC.
 
 
 VDTREC$  SUBR               ENTRY/EXIT
          SB1    1
          SA3    A1+B1       FWA OF WORKING BUFFER
          SA4    A3+B1       ADDRESS OF WORD COUNT
          SA5    A4+B1       (X5) = ADDRESS OF STATUS WORD
          SA4    X4          WORD COUNT
          READC  X1,X3,X4
          BX6    X1
          SA6    X5
          EQ     VDTREC$X    RETURN
 
          END
          IDENT  VDTREO$
          ENTRY  VDTREO$
          SYSCOM B1
          TITLE  VDTREO$ - READ ONE WORD.
*COMMENT  READ ONE WORD.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 REO      SPACE  4,10
***       VDTREO$ - READ ONE WORD.
*
*         G.K. CHACE.        83/02/03.
 REO      SPACE  4,15
***       CALLING SEQUENCE.
*
*         *FORTRAN5* CALL -
*
*         CALL VDTREO$ (FILE,WORD,STATUS)
*
*         *SYMPL* CALL -
*
*         VDTREO$(FILE,WORD,STATUS);
*
*                (FILE) = FIRST WORD OF THE FET.
 REO      SPACE  4,20
***       VDTREO$ - READ ONE WORD.
*
*         ENTRY  (FILE) = FIRST WORD OF THE FET.
*
*         EXIT   (WORD) = WORD READ IF (STATUS) = 0.
*                (STATUS) = 0, TRANSFER COMPLETE.
*                         = -1, END-OF-FILE DETECTED ON FILE.
*                         = -2, END-OF-INFORMATION DETECTED ON FILE.
*                         = LWA, END-OF-RECORD DETECTED ON FILE BEFORE
*                                TRANSFER WAS COMPLETE.
*                     LWA = ADDRESS + 1 OF LAST WORD TRANSFERRED TO
*                           WORKING BUFFER.
*
*         USES   X - 3, 5, 6, 7.
*                A - 3, 5, 6, 7.
*                B - 1.
*
*         MACROS READO.
 
 
 VDTREO$  SUBR               ENTRY/EXIT
          SB1    1
          SA3    A1+B1       ADDRESS OF WORD
          SA5    A3+B1       ADDRESS OF STATUS WORD
          BX0    X3
          READO  X1
          SA6    X0          RETURN WORD READ
          BX7    X1          RETURN STATUS
          SA7    X5
          EQ     VDTREO$X    RETURN
 
          END
*IF UNDEF,RETRO
          IDENT  VDTSSL
          ENTRY  VDTSSL
          SYSCOM B1
          TITLE  VDTSSL - SET SCREEN/LINE MODE.
*COMMENT  VDTSSL - SET SCREEN/LINE MODE.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 SSL      SPACE  4,10
***       VDTSSL - SET SCREEN/LINE MODE.
*
*         E.D. REDIG.        83/02/09.
 SSL      SPACE  4,10
***       *VDTSSL* PROVIDES AN INTERFACE TO *SETSLM* FOR PROGRAMS
*         WRITTEN IN HIGHER LEVEL LANGUAGES.
 SSL      SPACE  4,15
***       CALLING SEQUENCE.
*
*         *FORTRAN5* CALL -
*
*         CALL VDTSSL(MODEL,SCREEN)
*
*         *COBOL5* CALL -
*
*         ENTER VDTSSL USING MODEL, SCREEN.
*
*                MODEL  = TERMINAL MODEL NUMBER.
*                SCREEN = 0, IF LINE MODE.
*                       = 1, IF SCREEN MODE.
 SSL      SPACE  4,10
**        VDTSSL - SET SCREEN/LINE MODE.
*
*         ENTRY  (A1) = FWA OF FORMAL PARAMETER LIST.
*                (X1) = FWA OF MODEL NUMBER.
*
*         USES   X - 1, 2, 6.
*                A - 1, 2, 6.
*                B - 1.
*
*         CALLS  SETSLM.
 
 
 VDTSSL   SUBR               ENTRY/EXIT
          SB1    1
          SA2    A1+B1       GET SCREEN/LINE
          SA1    X1          GET ORDINAL
          SA2    X2
          SX6    X1
          ZR     X2,SSL1     IF LINE MODE
          SX2    B1+         SET SCREEN MODE
          LX2    6
          BX6    X6+X2
 SSL1     SA6    SSLA        SET PARAMETER WORD
          SETSLM SSLA,W      SET SCREEN/LINE MODE
          EQ     VDTSSLX     RETURN
 
 SSLA     CON    0           *SETSLM* PARAMETER WORD
 
          END
          IDENT  VDTRWD
          ENTRY  VDTRWD
          SYSCOM B1
          TITLE  VDTRWD - REWIND LOCAL FILE.
*COMMENT  VDTRWD - REWIND LOCAL FILE.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 RWD      SPACE  4,10
***       VDTRWD - REWIND LOCAL FILE.
*
*         M. L. SWANSON.     84/05/09.
 RWD      SPACE  4,10
***       *VDTRWD* PROVIDES AN INTERFACE TO HIGH-LEVEL
*         LANGUAGES USING THE *REWIND* MACRO.
 RWD      SPACE  4,10
***       REWIND SPECIFIED LOCAL FILE.
*
*         CALLING SEQUENCE.
*
*         *SYMPL* CALL -
*
*         VDTRWD(ADDRESS,RECALL);
*
*                ADDRESS = ADDRESS OF FET.
*                RECALL = AUTO RECALL ( 0 = NO RECALL ).
 RWD      SPACE  4,10
**        VDTRWD - REWIND SPECIFIED LOCAL FILE.
*
*         ENTRY  (A1) = FWA OF FORMAL PARAMETER LIST.
*                (X1) = ADDRESS OF FIRST PARAMETER.
*
*         USES   X - 2, 3.
*                A - 2, 3.
*                B - 1.
*
*         MACROS  REWIND.
 
 
 VDTRWD   SUBR               ENTRY/EXIT
          SB1    1
          SA3    A1          GET ADDRESS OF FET PARAMETER
          SA2    A1+B1       GET RECALL PARAMETER ADDRESS
          SA2    X2+         GET RECALL PARAMETER
          ZR     X2,RWD1     IF NO AUTO RECALL SPECIFIED
          REWIND X3          REWIND FILE WITHOUT RECALL
          EQ     VDTRWDX     RETURN
 
 RWD1     REWIND X3,1        REWIND WITH AUTO RECALL
          EQ     VDTRWDX     RETURN
 
          END
 
*ENDIF
          IDENT  VDTWRC$
          ENTRY  VDTWRC$
          SYSCOM B1
          TITLE  VDTWRC$ - WRITE CODED LINE IN *C* FORMAT.
*COMMENT  WRITE CODED LINE IN *C* FORMAT.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 WRC      SPACE  4,10
***       VDTWRC$ - WRITE CODED LINE IN *C* FORMAT.
*
*         G.K. CHACE.        83/02/03.
 WRC      SPACE  4,15
***       CALLING SEQUENCE.
*
*         *FORTRAN5* CALL -
*
*         CALL VDTWRC$ (FILE,BUF)
*
*         *SYMPL* CALL -
*
*         VDTWRC$(FILE,BUF);
*
*                (FILE) = FIRST WORD OF THE FET.
*                (BUF) = FIRST WORD OF THE WORKING BUFFER.
 WRC      SPACE  4,15
***       VDTWRC$ - WRITE CODED LINE IN *C* FORMAT.
*
*         TRANSFERS DATA UNTIL THE END OF LINE BYTE (0000) IS SENSED.
*
*         ENTRY  (FILE) = FIRST WORD OF THE FET.
*                (BUF) = FIRST WORD OF THE WORKING BUFFER.
*
*         USES   X - 3.
*                A - 3.
*                B - 1.
*
*         MACROS WRITEC.
 
 
 VDTWRC$  SUBR               ENTRY/EXIT
          SB1    1
          SA3    A1+B1       FWA OF WORKING BUFFER
          WRITEC X1,X3
          EQ     VDTWRC$X    RETURN
 
          END
          IDENT  VDTWRO$
          ENTRY  VDTWRO$
          SYSCOM B1
          TITLE  VDTWRO$ - WRITE ONE WORD.
*COMMENT  WRITE ONE WORD.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 WRO      SPACE  4,10
***       VDTWRO$ - WRITE ONE WORD.
*
*         G.K. CHACE.        83/02/03.
 WRO      SPACE  4,15
***       CALLING SEQUENCE.
*
*         *FORTRAN5* CALL -
*
*         CALL VDTWRO$ (FILE,WORD)
*
*         *SYMPL* CALL -
*
*         VDTWRO$(FILE,WORD);
*
*                (FILE) = FIRST WORD OF THE FET.
*                (WORD) = WORD TO BE TRANSFERRED.
 WRO      SPACE  4,10
***       VDTWRO$ - WRITE ONE WORD.
*
*         ENTRY  (FILE) = FIRST WORD OF THE FET.
*                (WORD) = WORD TO BE TRANSFERRED.
*
*         USES   X - 3, 6.
*                A - 3.
*                B - 1.
*
*         MACROS WRITEO.
 
 
 VDTWRO$  SUBR               ENTRY/EXIT
          SB1    1
          SA3    A1+B1       ADDRESS OF WORD
          SA3    X3          WORD
          BX6    X3
          WRITEO X1
          EQ     VDTWRO$X    RETURN
 
          END
          IDENT  VDTWRR$
          ENTRY  VDTWRR$
          SYSCOM B1
          TITLE  VDTWRR$ - WRITE END OF RECORD.
*COMMENT  WRITE END OF RECORD.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
 WRR      SPACE  4,10
***       VDTWRR$ - WRITE END OF RECORD.
*
*         G.K. CHACE.        83/02/03.
 WRR      SPACE  4,15
***       CALLING SEQUENCE.
*
*         *FORTRAN5* CALL -
*
*         CALL VDTWRR$ (FILE,R)
*
*         *SYMPL* CALL -
*
*         VDTWRR$(FILE,R);
*
*                (FILE) = FIRST WORD OF THE FET.
*                (R) = RECALL, IF .NE. 0, RECALL IS REQUESTED.
 WRR      SPACE  4,10
***       VDTWRR$ - WRITE END OF RECORD.
*
*         ENTRY  (FILE) = FIRST WORD OF THE FET.
*                (R) = RECALL, IF .NE. 0, RECALL IS REQUESTED.
*
*         USES   X - 2.
*                A - 2.
*                B - 1.
*
*         MACROS WRITER.
 
 
 VDTWRR$  SUBR               ENTRY/EXIT
          SB1    1
          SA2    A1+B1       GET RECALL PARAMETER
          SA2    X2
          NZ     X2,WRT1     IF RECALL REQUESTED
          WRITER X1
          EQ     VDTWRR$X    RETURN
 
 WRT1     WRITER X1,R
          EQ     VDTWRR$X    RETURN
 
          END