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