IDENT LDISTAP,110B
ABS
SST CP,CSTM
SYSCOM B1
ENTRY LDISTAP
ENTRY TMSDIS
ENTRY TMSOFF
ENTRY TMSON
ENTRY RFL=
ENTRY SSJ=
*COMMENT LDISTAP - TAPE MANAGEMENT UTILITY.
COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992.
TITLE LDISTAP - TAPE MANAGEMENT UTILITY.
LDISTAP SPACE 4,10
*** LDISTAP - TAPE MANAGEMENT UTILITY.
*
* J. D. HOLMBECK 85/02/28.
SPACE 4,10
*** *TMSDIS* DISPLAYS THE STATUS OF THE TMS CATALOGS. IT CAN
* CALLED FROM SYSTEM ORIGIN AS AN *L* DISPLAY UTILITY OR FROM
* NON-SYSTEM ORIGIN JOBS BY VALIDATED USERS.
SPACE 4,10
*** TMSDIS - COMMAND FORMAT.
*
* THE FORMAT OF THE ORDER DEPENDENT *TMSDIS* COMMAND IS -
*
* TMSDIS,IDIS,MODE,LFN1,LFN2,TIME,NOBELL.
*
* THE FORMAT OF THE ORDER INDEPENDENT *TMSDIS* COMMAND IS -
*
* TMSDIS,ID=IDIS,OP=MODE,I=LFN1,L=LFN2,WT=TIME,NOBELL.
*
* WHERE -
*
* IDIS INITIAL DISPLAY. VALID VALUES FOR *IDIS* ARE *HELP*
* OR *FAM*. DEFAULT IS *HELP*.
*
* MODE INPUT/OUTPUT OPTION. VALID VALUES FOR *MODE* ARE -
*
* L - L-DISPLAY. VALID ONLY FROM SYSTEM
* ORIGIN.
*
* LINE - READ COMMANDS FROM INPUT FILE AND WRITE
* DISPLAYS TO OUTPUT FILE.
*
* SCREEN - READ COMMANDS FROM TERMINAL INPUT FILE AND
* WRITE DISPLAYS TO TERMINAL OUTPUT FILE.
* DISPLAYS ARE REFRESHED WHILE WAITING FOR
* INPUT. INPUT CAN BE ENTERED AFTER
* ENTERING USER BREAK ONE (THE *BREAK* KEY).
* VALID ONLY FROM INTERACTIVE ORIGIN.
*
* DEFAULT IS *L* FOR SYSTEM ORIGIN AND *LINE* FOR
* NON-SYSTEM ORIGIN.
*
* LFN1 INPUT FILE NAME. IGNORED FOR L-DISPLAY AND SCREEN
* MODES. DEFAULT IS *INPUT*.
*
* LFN2 OUTPUT FILE NAME. IGNORED FOR SCREEN MODE. DEFAULT IS
* *OUTPUT*.
*
* TIME WAITING TIME IN SECONDS BEFORE A DISPLAY IS REFRESHED.
* IGNORED FOR LINE MODE. A VALUE GREATER THAN 4095 IS
* CONVERTED TO 4095. DEFAULT IS 2 FOR L-DISPLAY MODE
* AND 10 FOR SCREEN MODE.
*
* NOBELL IGNORED FOR LINE AND L-DISPLAY MODES. IF *NOBELL* IS
* NOT SPECIFIED, A BELL WILL SOUND AT THE TERMINAL WHEN
* THE SCREEN IS REFRESHED AND WHEN THERE ARE TAPE
* CATALOGS WITH ERRORS OR NO SCRATCH VSN-S.
*
* TO USE *TMSDIS* FROM A NON-SYSTEM ORIGIN JOB, THE USER MUST
* BE VALIDATED TO USE THE TAPE FILE SUPERVISOR *TFSP*.
DMESS SPACE 4,10
*** DAYFILE MESSAGES.
*
* FOLLOWING ARE THE DAYFILE MESSAGES THAT MAY BE ISSUED BY
* TMSDIS -
*
* INCORRECT COMMAND.
* A USER THAT IS NOT VALIDATED FOR *TFSP* ATTEMPTED TO
* USE *TMSDIS* FROM A NON-SYSTEM ORIGIN JOB.
*
* INCORRECT VALUE FOR PP PARAMETER - VVVVVVV.
* THE VALUE *VVVVVVV* CANNOT BE USED FOR PARAMETER *PP*
* ON THE *TMSDIS* COMMAND.
*
* TMSDIS COMPLETE.
* *TMSDIS* NORMAL TERMINATION.
*
* L-DISPLAY NOT AVAILABLE.
* *TMSDIS* CANNOT USE L-DISPLAY MODE AT THIS TIME
* BECAUSE ANOTHER JOB HAS INTERLOCKED THE L-DISPLAY.
*
* UNKNOWN PARAMETER - PP.
* THE PARAMETER *PP* CANNOT BE PROCESSED BY THE
* *TMSDIS* COMMAND.
DISPLAY SPACE 4,13
*** TMSDIS DISPLAYS.
*
* EACH *TMSDIS* DISPLAY INCLUDES A THREE LINE HEADER WITH *TMS*
* STATUS, DISPLAY NAME, PAGE NUMBER, THE NUMBER OF CATALOGS
* WITH ERRORS AND THE NUMBER OF CATALOGS WITH NO AVAILABLE
* SCRATCH TAPES.
*
* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* + +
* + TMSDIS. TMS ENABLED. FAM DISPLAY PAGE 1 OF 2. +
* + CATALOGS WITH ERRORS= 0. CATALOGS WITH NO MT/NT SCRATCH= 2. +
* + CATALOGS WITH NO CT SCRATCH= 2. CATALOGS WITH NO AT SCRATCH= 2. +
* + +
* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
HELP SPACE 4,10
*** HELP DISPLAY.
*
* THE HELP DISPLAY LISTS THE *TMSDIS* INPUT COMMANDS THAT CAN
* BE ENTERED. THE HELP DISPLAY IS INITIATED BY THE *HELP*
* COMMAND. FOR EXAMPLE, PAGE 1 -
*
* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* + +
* + HELP DISPLAY VALID COMMANDS. +
* + FAM DISPLAY *TMS* FAMILY TAPE CATALOG STATUSES. +
* + COPY COPY CURRENT DISPLAY TO OUTPUT FILE. +
* + + TOGGLE PAGE FORWARD. +
* + +N TOGGLE *N* PAGES FORWARD. +
* + - TOGGLE PAGE BACKWARD. +
* + -N TOGGLE *N* PAGES BACKWARD. +
* + END TERMINATE *TMSDIS*. +
* + +
* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
*
* FOR EXAMPLE, PAGE 2 -
*
* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* + +
* + + TOGGLE PAGE FORWARD. +
* + - TOGGLE PAGE BACKWARD. +
* + END TERMINATE *TMSDIS*. +
* + +
* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
FAM SPACE 4,10
*** FAMILY CATALOG DISPLAY.
*
* THE FAMILY CATALOG DISPLAY LISTS THE STATUS OF THE *TMS* TAPE
* CATALOG FILE FOR EACH FAMILY ON THE SYSTEM. THE FAMILY
* CATALOG DISPLAY IS INITIATED BY *FAM* COMMAND. FOR EXAMPLE -
*
* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
* + +
* + FAMILY MT/NT SCRATCH CT SCRATCH AT SCRATCH +
* + STATUS COUNT NXT-VSN COUNT NXT-VSN COUNT NXT-VSN +
* + +
* + KCP 120 KCP055 20 CK0456 60 AK0459 +
* + CATALOG LINKAGE ERROR. +
* + TFFAMLY 0 ------ 0 ------ 0 ------ +
* + NO SCRATCH TAPES. +
* + KTJ 55 KTJ133 0 ------ 231 AJ0319 +
* + +
* + FAMTWO * 2341 T03450 70 CF0021 1492 AF1221 +
* + +
* + NEWFAM 0 ------ 0 ------ 0 ------ +
* + CATALOG NOT FAST-ATTACHED. +
* + PFFAMLY 0 ------ 0 ------ 0 ------ +
* + CATALOG NOT FOUND. +
* + +
* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
*
* WHERE -
*
* FAMILY - FAMILY NAME. AN ASTERISK (*) WILL APPEAR AFTER THE
* FAMILY NAME IF THE TAPE CATALOG IS BEING PROCESSED BY
* *TMS* MEANING THAT THE INFORMATION DISPLAYED MAY NOT
* UP TO DATE.
*
* COUNT - NUMBER OF SCRATCH VSNS OF THE SPECIFIED TAPE TYPE
* (MT/NT, CT OR AT) IN THE TAPE CATALOG. THIS FIELD
* IS ZERO IF THE FAMILY DOES NOT HAVE A FAST-ATTACHED
* TAPE CATALOG.
*
* NXT-VSN - THE NEXT SCRATCH VSN OF THE SPECIFIED TAPE TYPE
* (MT/NT, CT OR AT) IN THE TAPE CATALOG. THIS FIELD IS
* SIX HYPHENS (------) IF NO SCRATCH TAPES OF THE
* SPECIFIED TYPE ARE IN THE TAPE CATALOG. THIS FIELD
* IS ALSO SIX HYPHENS IF THE FAMILY DOES NOT HAVE A
* FAST-ATTACHED TAPE CATALOG.
*
* STATUS - STATUS MESSAGE FOR TAPE CATALOG. THIS FIELD
* CONTAINS THE CONTENTS OF THE CATALOG MESSAGE BUFFER
* IF THE TAPE CATALOG HAS AN ERROR CONDITION. THIS
* FIELD CONTAINS *NO SCRATCH VSNS* IF *COUNT* IS ZERO
* FOR ALL TAPE TYPES. THIS FIELD CONTAINS *CATALOG NOT
* FAST-ATTACHED* IF THE TAPE CATALOG EXISTS BUT HAS NOT
* BEEN FAST-ATTACHED. THIS FIELD CONTAINS *CATALOG NOT
* FOUND* IF THE TAPE CATALOG DOES NOT EXIST.
*
* THE FAMILY CATALOGS ARE ORDERED IN THIS DISPLAY AS FOLLOWS -
*
* FAMILIES WITH CATALOG ERRORS
* FAMILIES WITH NO SCRATCH VSNS
* FAMILIES WITH FAST-ATTACHED CATALOGS BUT NO ERRORS
* FAMILIES WITHOUT FAST-ATTACHED CATALOGS
* FAMILIES WITHOUT CATALOGS
COMMAND SPACE 4,10
*** *TMSDIS* INPUT COMMANDS.
*
* *TMSDIS* COMMANDS ARE ENTERED ONE COMMAND PER INPUT LINE.
* THE MAXIMUM NUMBER OF CHARACTERS PROCESSED FOR AN INPUT LINE
* IS 77. AN INPUT LINE CAN OPTIONALLY BE TERMINATED BY A
* PERIOD. ANY CHARACTERS FOLLOWING THE PERIOD ARE IGNORED. IF
* A PARAMETER REQUIRES SPECIAL CHARACTERS, THE PARAMETER CAN BE
* DOLLAR SIGN ($) DELIMITTED. FOR EXAMPLE, SUPPOSE VSN A$BC+E
* IS TO BE ASSIGNED TO THE TAPE ON EQUIPMENT 65 -
*
* VSN,65,$A$$BC+E$.
*
* THE FOLLOWING ARE THE VALID *TMSDIS* INPUT COMMANDS -
*
* HELP
* INITIATES THE HELP DISPLAY.
*
* FAM
* INITIATES THE FAMILY TAPE CATALOG DISPLAY.
*
* COPY
* COPIES THE CURRENT DISPLAY TO THE OUTPUT FILE. THIS
* COMMAND IS IGNORED FOR SCREEN MODE.
*
* +N
* TOGGLE THE DISPLAY *N* PAGES FORWARD. DEFAULT FOR *N*
* IS 1.
*
* -N
* TOGGLE THE DISPLAY *N* PAGES BACKWARD. DEFAULT FOR
* *N* IS 1.
CMESS SPACE 4,10
*** COMMAND STATUS MESSAGES.
*
* ONE OF THE FOLLOWING MESSAGES WILL APPEAR AT THE BOTTOM OF
* THE DISPLAY PAGE. THE IMAGE OF THE LAST INPUT COMMAND
* ENTERED WILL APPEAR AFTER THE MESSAGE -
*
* INCORRECT INCREMENT
* THE PAGE INCREMENT SPECIFIED WITH THE *+* OR *-*
* COMMAND WAS NOT A NUMBER.
*
* LAST COMMAND
* INDICATES THE LAST COMMAND PROCESSED WITHOUT ERRORS.
*
* PROCESSING
* INDICATES THE CURRENT COMMAND BEING PROCESSED BY
* *TMSDIS*.
*
* TOO MANY PARAMETERS
* MORE PARAMETERS WERE SPECIFIED THAN THE COMMAND
* ALLOWS.
*
* UNKNOWN COMMAND
* THE COMMAND SPECIFIED CANNOT BE PROCESSED BY
* *TMSDIS*.
TMSON SPACE 4,10
*** *TMSON* CAN BE CALLED FROM SYSTEM ORIGIN JOBS TO TURN ON
* *TMS* TAPE CATALOG FILES FOR FAMILIES ON THE SYSTEM.
TMSON SPACE 4,10
*** TMSON - COMMAND FORMAT.
*
* THE FORMAT OF THE *TMSON* COMMAND IS -
*
* TMSON,FM=FNAME,DEFTO=NOPT,DEFTOS=SOPT.
*
* WHERE -
*
* FNAME FAMILY NAME OF *TMS* CATALOG TO TURN ON. IF A
* SPECIFIC FAMILY NAME IS USED AND THE *TMS* CATALOG
* FOR THAT FAMILY CANNOT BE TURNED ON, *TMSON* WILL
* ABORT. IF AN ASTERISK (*) IS USED, *TMSON* WILL
* ATTEMPT TO TURN ON THE *TMS* CATALOGS ON ALL FAMILIES
* OF THE SYSTEM. AN INFORMATIVE MESSAGE WILL BE ISSUED
* IF *TMSON* CANNOT TURN ON A *TMS* CATALOG FOR A
* FAMILY. IF THIS PARAMETER IS NOT SPECIFIED, *TMSON*
* WILL NOT TURN ON ANY *TMS* CATALOGS.
*
* NOPT IDENTIFIES THE DEFAULT TAPE OPTION (THE *TO*
* PARAMETER) FOR *LABEL* AND *REQUEST* COMMANDS FOR
* NON-SYSTEM ORIGIN JOBS. THIS PARAMETER CAN ONLY BE
* SPECIFIED IF THE CALLING JOB IS RUNNING WITH THE
* SUBSYSTEM ID OF *MAGNET* (*MTSI*). *NOPT* IS A STRING
* WITH ONE OR MORE OF THE FOLLOWING CHARACTERS -
*
* T - SET THE DEFAULT TO *TO=T* (*TMS*
* PROCESSING).
*
* F - SET THE DEFAULT TO *TO=F* (NON-*TMS*
* PROCESSING).
*
* C - SET THE DEFAULT TO *TO=C* (CHECK FOR
* CATALOG ERROR).
*
* E - SET THE DEFAULT TO *TO=E* (IGNORE CATALOG
* ERROR).
*
* IF THIS PARAMETER IS NOT SPECIFIED, *TMSON* WILL NOT
* CHANGE THE DEFAULT TAPE OPTION. A USER CAN CHANGE THE
* DEFAULT TAPE OPTION FOR HIS OR HER JOB VIA THE
* *TMSDEF* COMMAND.
*
* SOPT IDENTIFIES THE DEFAULT TAPE OPTION (THE *TO*
* PARAMETER) FOR *LABEL* AND *REQUEST* COMMANDS FOR
* SYSTEM ORIGIN JOBS. THIS PARAMETER CAN ONLY BE
* SPECIFIED IF THE CALLING JOB IS RUNNING WITH THE
* SUBSYSTEM ID OF *MAGNET* (*MTSI*). *NOPT* IS A STRING
* WITH ONE OR MORE OF THE FOLLOWING CHARACTERS -
*
* T - SET THE DEFAULT TO *TO=T* (*TMS*
* PROCESSING).
*
* F - SET THE DEFAULT TO *TO=F* (NON-*TMS*
* PROCESSING).
*
* C - SET THE DEFAULT TO *TO=C* (CHECK FOR
* CATALOG ERROR).
*
* E - SET THE DEFAULT TO *TO=E* (IGNORE CATALOG
* ERROR).
*
* IF THIS PARAMETER IS NOT SPECIFIED, *TMSON* WILL NOT
* CHANGE THE DEFAULT TAPE OPTION. A USER CAN CHANGE THE
* DEFAULT TAPE OPTION FOR HIS OR HER JOB VIA THE
* *TMSDEF* COMMAND.
TMSOFF SPACE 4,10
*** *TMSOFF* CAN BE CALLED FROM SYSTEM ORIGIN JOBS TO TURN OFF
* *TMS* TAPE CATALOG FILES FOR FAMILIES ON THE SYSTEM.
TMSOFF SPACE 4,10
*** TMSOFF - COMMAND FORMAT.
*
* THE FORMAT OF THE *TMSOFF* COMMAND IS -
*
* TMSOFF,FM=FNAME.
*
* WHERE -
*
* FNAME FAMILY NAME OF *TMS* CATALOG TO TURN OFF. IF A
* SPECIFIC FAMILY NAME IS USED AND THE *TMS* CATALOG
* FOR THAT FAMILY CANNOT BE TURNED OFF, *TMSOFF* WILL
* ABORT. IF AN ASTERISK (*) IS USED, *TMSOFF* WILL
* ATTEMPT TO TURN OFF THE *TMS* CATALOGS ON ALL
* FAMILIES OF THE SYSTEM. AN INFORMATIVE MESSAGE WILL
* BE ISSUED IF *TMSOFF* CANNOT TURN OFF A *TMS* CATALOG
* FOR A FAMILY. IF THIS PARAMETER IS NOT SPECIFIED,
* *TMSOFF* WILL NOT TURN OFF ANY *TMS* CATALOGS.
*
* *TMSOFF* REMOVES THE FAST-ATTACH STATUS OF A *TMS* CATALOG.
* *TMSON* WILL REINSTATE THE CATALOG AS FAST-ATTACHED.
DMESS SPACE 4,10
*** *TMSON* AND *TMSOFF* DAYFILE MESSAGES.
*
* FOLLOWING ARE THE DAYFILE MESSAGES THAT MAY BE ISSUED BY
* *TMSON* OR *TMSOFF* -
*
* FAMILY NOT FOUND.
* THE SPECIFIED FAMILY IS NOT ACTIVE ON THE SYSTEM.
*
* INCORRECT COMMAND.
* *TMSON* OR *TMSOFF* WAS CALLED BY A NON-SYSTEM ORIGIN
* JOB.
*
* INCORRECT VALUE FOR PP PARAMETER - VVVVVVV.
* THE VALUE *VVVVVVV* CANNOT BE USED FOR PARAMETER *PP*
* ON THE *TMSON* OR *TMSOFF* COMMAND.
*
* UNABLE TO TURN OFF *TMS* CATALOG FOR FFFFFFF.
* THE *TMS* CATALOG FOR FAMILY *FFFFFFF* CANNOT BE
* TURNED OFF AT THIS TIME.
*
* UNABLE TO TURN ON *TMS* CATALOG FOR FFFFFFF.
* THE *TMS* CATALOG FOR FAMILY *FFFFFFF* CANNOT BE
* TURNED ON AT THIS TIME.
*
* UNKNOWN PARAMETER - PP.
* THE PARAMETER *PP* CANNOT BE PROCESSED BY THE
* *TMSON* OR *TMSOFF* COMMAND.
TITLE PROGRAM MACROS AND EQUIVALENCES.
COMMON SPACE 4,10
** COMMON DECKS.
*CALL COMCMAC
*CALL COMCCMD
*CALL COMCDCM
*CALL COMSEVT
*CALL COMSPFM
*CALL COMSPRD
*CALL COMSRPV
*CALL COMSSFM
*CALL COMSSSD
*CALL COMSTCM
QUAL TFM
*CALL COMSTFM
QUAL *
QUAL TFU
*CALL COMSTFU
QUAL *
QUAL MTX
*CALL COMSMTX
QUAL *
TITLE PROGRAM MACROS AND EQUIVALENCES.
ABTMSG SPACE 4,15
** ABTMSG - ABORT PROGRAM WITH DAYFILE MESSAGE.
*
* ABTMSG MADD
*
* ENTRY MADD = ADDRESS OF DAYFILE MESSAGE.
*
* EXIT MESSAGE ISSUED TO SYSTEM AND USER DAYFILES.
* PROGRAM ABORTED.
*
* USES X - 5.
*
* CALLS ABT.
PURGMAC ABTMSG
ABTMSG MACRO MA
MACREF ABTMSG
R= X5,MA
EQ ABT
ABTMSG ENDM
CLEAR SPACE 4,15
** CLEAR - CLEAR BUFFER.
*
* CLEAR BUFFER,LENGTH
*
* ENTRY BUFFER = FWA OF BUFFER TO CLEAR.
* LENGTH = LENGTH OF BUFFER.
*
* EXIT BUFFER FILLED WITH ZERO WORDS.
*
* USES X - 6.
* A - 6.
* B - 7.
PURGMAC CLEAR
CLEAR MACRO BF,LN
LOCAL A,B
MACREF CLEAR
R= B7,LN
R= X6,0
A SB7 B7-B1
NG B7,B
SA6 B7+BF
EQ A
B BSS 0
CLEAR ENDM
LDIS SPACE 4,15
** LDIS - RESERVE L-DISPLAY ENTRY.
*
*TAG LDIS NCHAR,STRING
*
* ENTRY TAG - LOCATION TAG OF ENTRY.
* NCHAR - NUMBER OF CHARACTERS.
* STRING - INITIAL CHARACTER STRING.
* CP - SET TO CURRENT CHARACTER POSITION - 1.
*
* EXIT *TAG* DEFINED AT ADDRESS LOCATION.
* *TAGU* DEFINED AT BIT POSITION.
* *TAGC* DEFINED AS BIT COUNT (NCHAR*6).
* CP - SET TO CURRENT CHARACTER POSITION - 1.
PURGMAC LDIS
MACRO LDIS,TG,NC,ST
LOCAL BC,BP,CC,LC,SS,WC
LC EQU *
BP EQU *P-1
WC SET NC-1
WC SET WC/10
CC DECMIC 1
DUP WC
SS MICRO "CC",10,$ST$
VFD 60/10H"SS"
CC DECMIC "CC"+10
ENDD
SS MICRO "CC",,$ST$
CC DECMIC NC-WC*10
BC DECMIC "CC"*6
VFD "BC"/"CC"H"SS"
AA IFC NE,$TG$$
TG EQU LC
TG_U EQU BP
WC SET NC
TG_C EQU WC*6
AA ENDIF
CP SET CP+NC
LDIS ENDM
LDISE SPACE 4,10
** LDISE - END L-DISPLAY LINE.
*
* LDISE
*
* ENTRY CP - SET TO CURRENT CHARACTER POSITION - 1.
*
* EXIT LAST WORD OF L-DISPLAY LINE ZERO FILLED.
PURGMAC LDISE
LDISE MACRO
LOCAL BC
AA IFLT *P,60
BC DECMIC *P
VFD "BC"/0
AA ENDIF
ERRNG 64-CP TOO MANY CHARACTERS IN LINE
LDISE ENDM
LDISS SPACE 4,10
** LDISS - START L-DISPLAY LINE.
*
* LDISS FC,LN
*
* ENTRY FC - FIRST CHARACTER POSITION OF LINE.
* LN - LINE NUMBER.
*
* EXIT K - SET TO LINE NUMBER PLUS ONE.
* CP - SET TO CURRENT CHARACTER POSITION - 1.
PURGMAC LDISS
LDISS MACRO FC,LN
LOCAL LL,XX,YY
LL EQU *
XX EQU FC-1
YY EQU LN
VFD 12/6000B+XX*8,12/7707B-YY*15
KDL RMT
VFD 24/0,18/LL,18/7726B-YY*10
KDL RMT
K SET YY+1
CP SET XX
LDISS ENDM
MBSATA SPACE 4,30
** MBSATA - MOVE BIT STRING FROM ADDRESS TO ADDRESS.
*
* MBSATA SADD,DADD,BITC,SUPB,DUPB
*
* ENTRY SADD = ADDRESS OF SOURCE STRING.
* DADD = ADDRESS OF DESTINATION STRING.
* (DO NOT USE A1, X1.)
* BITC = BIT COUNT OF STRING.
* (DO NOT USE A1, X1, A2, X2.)
* SUPB = UPPER BIT POSITION OF SOURCE STRING.
* (DO NOT USE A1, X1, A2, X2, B4.)
* DUPB = UPPER BIT POSITION OF DESTINATION STRING.
* (DO NOT USE A1, X1, A2, X2, B4, B3.)
*
* EXIT (A1) = ADDRESS OF REMAINDER OF SOURCE STRING.
* (A2) = ADDRESS OF REMAINDER OF DESTINATION STRING.
* (B2) = UPPER BIT POSITION OF REMAINDER OF DESTINATION
* STRING.
* (B3) = UPPER BIT POSITION OF REMAINDER OF SOURCE
* STRING.
* (X1) = FIRST WORD OF REMAINDER OF SOURCE STRING.
* (X2) = FIRST WORD OF REMAINDER OF DESTINATION STRING.
*
* USES B - 4.
*
* CALLS MBS.
PURGMAC MBSATA
MBSATA MACRO SA,DA,BC,SU,DU
MACREF MBSATA
R= A1,SA
R= A2,DA
R= B4,BC
R= B3,SU
R= B2,DU
RJ MBS
MBSATA ENDM
MBSXTA SPACE 4,30
** MBSXTA - MOVE BIT STRING FROM X-REGISTER TO ADDRESS.
*
* MBSXTA SX,DADD,BITC,SUPB,DUPB
*
* ENTRY SX = X-REGISTER WITH SOURCE STRING.
* DADD = ADDRESS OF DESTINATION STRING.
* (DO NOT USE X1.)
* BITC = BIT COUNT OF STRING.
* (DO NOT USE X1, A2, X2.)
* SUPB = UPPER BIT POSITION OF SOURCE STRING.
* (DO NOT USE X1, A2, X2, B4.)
* DUPB = UPPER BIT POSITION OF DESTINATION STRING.
* (DO NOT USE X1, A2, X2, B4, B3.)
*
* EXIT (A2) = ADDRESS OF REMAINDER OF DESTINATION STRING.
* (B2) = UPPER BIT POSITION OF REMAINDER OF DESTINATION
* STRING.
* (B3) = UPPER BIT POSITION OF REMAINDER OF SOURCE
* STRING.
* .LT. 0 IF NO MORE BITS IN SOURCE STRING.
* (B4) = NUMBER OF BITS NOT MOVED.
* (X1) = SOURCE STRING.
* (X2) = FIRST WORD OF REMAINDER OF DESTINATION STRING.
*
* USES B - 4.
*
* CALLS MBS.
PURGMAC MBSXTA
MBSXTA MACRO SX,DA,BC,SU,DU
LOCAL A
MACREF MBSXTA
.A IFC NE,$X1$SX$
X= X1,SX
.A ENDIF
R= A2,DA
R= B4,BC
R= B3,SU
R= B2,DU
RJ SBS
NG B3,A
PL B2,A
R= A6,A2
R= A2,A2+B1
R= B2,59
RJ SBS
A R= A6,A2
MBSXTA ENDM
RDMEM SPACE 4,20
** RDMEM - READ MEMORY INTO BUFFER.
*
* RDMEM TYPE,ADD,COUNT,BUFF
*
* ENTRY TYPE - *ABS* IF READ FROM ABSOLUTE ADDRESS.
* - *CPA* IF READ FROM CONTROL POINT ADDRESS.
* - SUBSYSTEM IDENTIFIER IF READ FROM SUBSYSTEM
* FIELD LENGTH.
* ADD - ADDRESS TO READ FROM. (DO NOT USE X4.)
* COUNT - NUMBER OF WORDS TO READ. (DO NOT USE X2, X4.)
* BUFF - ADDRESS OF BUFFER TO RECEIVE DATA. (DO NOT
* USE X2, X3, X4.)
*
* EXIT (X1) .LT. 0 IF READ IS SUCCESSFUL.
*
* USES X - 2, 3, 4.
*
* CALLS RDM.
PURGMAC RDMEM
RDMEM MACRO TY,AD,CT,BF
MACREF RDMEM
.A IFC EQ,$TY$ABS$
R= X4,0
.A ELSE
.B IFC EQ,$TY$CPA$
R= X4,-1
.B ELSE
R= X4,TY
.B ENDIF
.A ENDIF
R= X2,AD
R= X3,CT
R= X1,BF
RJ RDM
RDMEM ENDM
RJM SPACE 4,15
** RJM - RETURN JOB TO ADDRESS IN REGISTER.
*
* RJM ADDR
*
* ENTRY ADDR = ADDRESS OF SUBROUTINE.
*
* EXIT RETURN JUMP INTO SUBROUTINE.
*
* USES X - 1, 6.
* A - 1, 6.
* B - 2.
PURGMAC RJM
RJM MACRO AD
LOCAL A,B
MACREF RJM
R= B2,AD
R= A1,A
BX6 X1
R= A6,B2
JP B2+1
A EQ B
B BSS 0
RJM ENDM
SRCHTAB SPACE 4,25
** SRCHTAB - SEARCH TABLE.
*
* SRCHTAB XR,TABADD,ENTADD,ENTLNG,TABLNG
*
* ENTRY (X0) = SEARCH MASK.
* XR = X-REGISTER WITH VALUE TO SEARCH FOR.
* TABADD = TABLE ADDRESS.
* (DO NOT USE X1.)
* ENTADD = RELATIVE ADDRESS OF VALUE IN TABLE ENTRY.
* (DO NOT USE X1 OR B2.)
* ENTLNG = LENGTH OF TABLE ENTRY.
* (DO NOT USE X1, B2, OR B6.)
* TABLNG = LENGTH OF TABLE IF SPECIFIED.
* ZERO WORD TERMINATED TABLE IF NOT SPECIFIED.
* (DO NOT USE X1, B2, B6, OR B7.)
*
* EXIT (X6) = 0 IF VALUE FOUND IN TABLE.
* (A2) = ADDRESS OF WORD WITH VALUE.
* (X2) = IMAGE OF WORD WITH VALUE.
*
* USES X - 1.
* B - 2, 3, 6, 7.
*
* CALLS STL, STZ.
PURGMAC SRCHTAB
SRCHTAB MACRO XR,TA,EA,EL,TL
MACREF SRCHTAB
.A IFC NE,$X1$XR$
X= X1,XR
.A ENDIF
R= B2,TA
R= B6,EA
R= B7,EL
.A IFC EQ,$TL$$
RJ STZ
.A ELSE
R= B3,TL
RJ STL
.A ENDIF
SRCHTAB ENDM
MISCEQU SPACE 4,10
** MISCELLANEOUS EQUIVALENCES.
DEFRN EQU 10 DEFAULT WAITING TIME FOR NON-SYSTEM ORIGIN
DEFRS EQU 2 DEFAULT WAITING TIME FOR SYSTEM ORIGIN
SBCWL EQU /TFM/BWUN+1 CATALOG SYSTEM BLOCK CONTROL WORD LENGTH
SBUFE EQU SBCWL+/TFM/TSTL CATALOG SYSTEM BLOCK LENGTH
SSJ= EQU 0 SYSTEM PRIVILEGES DEFINITION
DISEQU SPACE 4,10
** DISPLAY EQUIVALENCES.
LPEFC EQU 2 FAMILY CATALOG LINES PER ENTRY
NLPDS EQU 23 NUMBER OF LINES PER DISPLAY
NLPTT EQU 3 NUMBER OF LINES PER TITLE
NLPMS EQU 2 NUMBER OF LINES PER MESSAGE
NLPHD EQU 2 NUMBER OF LINES PER HEADER
NLPPG EQU NLPDS-NLPTT-NLPHD-NLPMS-1 NUMBER OF LINES PER PAGE
MXNEL SET 100B*LPEFC-1 MAXIMUM NUMBER OF ENTRY LINES
NPGFD EQU MXNEL/NLPPG+1 NUMBER OF PAGES FOR FAMILY DISPLAY
NPGHD EQU 1 NUMBER OF PAGES FOR HELP DISPLAY
OPTLD EQU 0 L-DISPLAY MODE
OPTLN EQU 1 LINE MODE
OPTSC EQU 2 SCREEN MODE
BUFFL SPACE 4,10
** BUFFER LENGTHS.
CBUFL EQU LCOM COMMAND BUFFER LENGTH
DBUFL EQU LDSY DISPLAY BUFFER LENGTH
FBUFL EQU 100B FAMILY ORDINAL TABLE BUFFER LENGTH
IBUFL EQU 1001B INPUT FILE BUFFER LENGTH
LBUFL EQU 1001B OUTPUT FILE BUFFER LENGTH
SBUFL EQU SBUFE*FBUFL CATALOG SYSTEM BLOCKS BUFFER LENGTH
ZBUFL EQU 101B CATALOG FILE BUFFER LENGTH
LEQUIV SPACE 4,10
** L-DISPLAY EQUIVALENCES.
NERR EQU 0 NO ERROR
NBUF EQU 1 NO L-DISPLAY BUFFER DEFINED IN CMR
NINL EQU 2 L-DISPLAY BUFFER NOT INTERLOCKED
NDBF EQU 3 DISPLAY BUFFER TOO LARGE
NCMD EQU 4 NO COMMAND ENTERED
NCBF EQU 5 COMMAND BUFFER TOO SMALL
MICROS SPACE 4,10
** PROGRAM MICROS.
DEFRN DECMIC DEFRN DEFAULT WAITING TIME NON-SYSTEM ORIGIN
DEFRS DECMIC DEFRS DEFAULT WAITING TIME SYSTEM ORIGIN
TITLE DATA AREA.
SPACE 4
ORG 110B
FETS SPACE 4,10
** FETS.
I BSS 0 INPUT FILE
INPUT FILEC IBUF,IBUFL,(FET=8),EPR
L BSS 0 OUTPUT FILE
OUTPUT FILEC LBUF,LBUFL,(FET=8),EPR
P BSS 0 CATALOG FILE
"TMFC" FILEB ZBUF,ZBUFL,(FET=16),EPR,(PFN="TMFC")
CSMS SPACE 4,10
** COMMAND STATUS MESSAGES.
CSII DATA 30H INCORRECT INCREMENT
CSLC DATA 30H LAST COMMAND
CSPR DATA 30H PROCESSING
CSTM DATA 30H TOO MANY PARAMETERS
CSUC DATA 30H UNKNOWN COMMAND
DFES SPACE 4,10
** DAYFILE MESSAGES.
DFFN DATA C* FAMILY NOT FOUND.*
DFIC DATA C* INCORRECT COMMAND.*
DFIV DATA C* INCORRECT VALUE FOR ####### PARAMETER - $$$$$$$.*
DFLC DATA C* TMSDIS COMPLETE.*
DFLN DATA C* L-DISPLAY NOT AVAILABLE.*
DFUF DATA C$ UNABLE TO TURN OFF *TMS* CATALOG FOR #######.$
DFUN DATA C$ UNABLE TO TURN ON *TMS* CATALOG FOR #######.$
DFUP DATA C* UNKNOWN PARAMETER - $$$$$$$.*
TCOM SPACE 4,10
** TCOM - TABLE OF INPUT COMMANDS.
*
*T, 42/ NAME, 18/ ADDRESS
*
* ENTRY NAME = LEFT JUSTIFIED, ZERO-FILLED COMMAND NAME.
* ADDRESS = PROCESSOR ADDRESS IF PROCESS AFTER SYSTEM
* STATUS.
* = (-1)*PROCESSOR ADDRESS IF PROCESS
* IMMEDIATELY.
TCOM BSS 0 TABLE OF INPUT COMMANDS
VFD 42/0LHELP,18/HEP HELP DISPLAY
VFD 42/0LFAM,18/FAP FAMILY CATALOG DISPLAY
VFD 42/0LCOPY,18/COP COPY DISPLAY TO OUTPUT FILE
VFD 42/1L+,18/PCP TOGGLE PAGE FORWARD
VFD 42/1L-,18/MCP TOGGLE PAGE BACKWARD
VFD 42/0LDROP,18/-DRO TERMINATE *TMSDIS*
VFD 42/0LEND,18/-DRO TERMINATE *TMSDIS*
TCOML EQU *-TCOM LENGTH OF TABLE
TDPR SPACE 4,10
** TDPR - TABLE OF DISPLAY PROCESSORS.
TDPR BSS 0 TABLE OF DISPLAY PROCESSORS
LOC 0
DISHP CON HEL *HELP*
DISFC CON FAM *FAM*
LOC *O
TFCM SPACE 4,10
** TFCM - TABLE OF FAMILY CATALOG MESSAGE ADDRESSES.
TFCM BSS 0 TABLE OF FAMILY CATALOG MESSAGE ADDRESSES.
LOC 0
CSCFA CON BLANKS CATALOG FILE FAST-ATTACHED STATUS
CSERR CON 0 CATALOG FILE ERROR STATUS
CSNSV CON =40H NO SCRATCH VSNS.
CSCFN CON =40H CATALOG NOT FAST-ATTACHED.
CSCNF CON =40H CATALOG NOT FOUND.
CSCFB CON 0 CATALOG FILE BUSY STATUS
CSFNF CON 0 FAMILY NOT FOUND STATUS
LOC *O
TFCP SPACE 4,10
** TFCP - TABLE OF FAMILY CATALOG PROCESSORS
TFCP BSS 0 TABLE OF FAMILY CATALOG PROCESSORS
LOC 0
CSCFA CON CCS CATALOG FILE FAST-ATTACHED STATUS
CSERR CON CCS CATALOG FILE ERROR STATUS
CSNSV CON CCS NO SCRATCH VSNS STATUS
CSCFN CON CNF CATALOG FILE NOT FAST-ATTACHED
CSCNF CON CCB CATALOG FILE NOT FOUND STATUS
CSCFB CON CCS CATALOG FILE BUSY STATUS
CSFNF CON CCB FAMILY NOT FOUND STATUS
NFCST EQU * NUMBER OF FAMILY CATALOG STATUSES
LOC *O
TNDP SPACE 4,10
** TNDP - TABLE OF NUMBER OF DISPLAY PAGES.
TNDP BSS 0 TABLE OF NUMBER OF DISPLAY PAGES
LOC 0
DISHP CON NPGHD *HELP*
DISFC CON 1 *FAM*
LOC *O
WORKING SPACE 4,10
** WORKING STORAGE CELLS.
BEL CON 2R^* BELL CHARACTER
BLANKS DATA 64L
CCE CON 0 COUNT OF CATALOG ERRORS
CIN BSS 0 CLEAR INPUT LINE
VFD 12/2R"EM" ASCII OUTPUT
VFD 48/8H 78 BLANK CHARACTERS
DUP 7
VFD 60/10H
ENDD
VFD 24/4H"CR""CB" CARRIAGE RETURN/NO LINE FEED
VFD 36/0 END OF LINE
CLN CON 0 CURRENT LINE NUMBER
CMP CON 0 COMMAND PROCESSOR ADDRESS
CNSM CON 0 COUNT OF CATALOGS WITH NO *MT/NT* SCRATCH
CNSC CON 0 COUNT OF CATALOGS WITH NO *CT* SCRATCH
CNSA CON 0 COUNT OF CATALOGS WITH NO *AT* SCRATCH
COA CON 0 COUNT OF JOBS REQUIRING OPERATOR ACTION
COM CON 0 COMMAND IMAGE
CON CON 0 CONSOLE STATUS
CPN BSS 0 *CP=N,PG=N* LINE
VFD 12/2R:N *NAM* OUTPUT
VFD 12/4107B CURSOR POSITIONING
VFD 12/4000B NO
VFD 12/4045B PAGE WAITING
VFD 12/4000B NO
VFD 60/0 END OF LINE
CPY BSS 0 *CP=Y* LINE
VFD 12/2R:N *NAM* OUTPUT
VFD 12/4107B CURSOR POSITIONING
VFD 12/4001B YES
VFD 24/0 END OF LINE
CSL BSS 0 CLEAR SCREEN LINE
VFD 12/2R"EM" ASCII OUTPUT
VFD 12/2R^= CLEAR SCREEN CHARACTER
VFD 24/4R"CR""ES" CARRIAGE RETURN/NO LINE FEED
VFD 12/0 END OF LINE
DIS CON DISHP CURRENT DISPLAY
FFO CON 0 FWA OF FAMILY ORDINAL TABLE
HYPHENS DATA 10H---------- TEN HYPHEN CHARACTERS
JOT CON 0 JOB ORIGIN TYPE
LDE CON 0 L-DISPLAY ERROR FLAG
LIT CON 0 LITERAL STATUS FOR *POP* (0=NO LITERALS)
LNS CON 0 LINE MODE OUTPUT STATUS (0=NO OUTPUT)
MXF CON 0 MAXIMUM NUMBER OF FOT ENTRIES
OFM CON 0 ORIGINAL FAMILY NAME
OPT CON OPTLN INPUT/OUTPUT MODE
OUI CON 0 ORIGINAL USER INDEX
PAG CON 1 CURRENT PAGE NUMBER
PAR CON 0 COMMAND PARAMETER ADDRESS
PNO CON NPGHD CURRENT NUMBER OF PAGES
ROT DATA 0 ROLLOUT TIME
SIA CON 0 SCREEN INPUT AVAILABLE FLAG
TIN CON 0 TERMINAL INPUT STATUS (0=TERMINAL INPUT)
TMS CON 0 *TMS* STATUS (0=ENABLED)
TOP BSS 0 TOP OF PAGE CHARACTERS
VFD 12/2R"EM" ASCII OUTPUT
VFD 12/2R BELL CHARACTER
VFD 12/2R^? TOP OF PAGE CHARACTER
VFD 24/4R"CR""ES" CARRIAGE RETURN/NO LINE FEED
VFD 60/0 END OF LINE
TOU CON 0 TERMINAL OUTPUT STATUS (0=TERMINAL OUTPUT)
ZEROES BSSZ 7 SEVEN WORDS OF ZEROES
TITLE TMSDIS MAIN PROGRAM.
LDI SPACE 4,10
** TMSDIS - MAIN PROGRAM.
TMSDIS BSS 0 ENTRY
LDISTAP SB1 1 ENTRY
RJ PRS PRESET PROGRAM
SA1 OPT
SX1 X1-OPTLN
ZR X1,LDI7 IF LINE MODE
SX1 X1-OPTSC+OPTLN
ZR X1,LDI1 IF SCREEN MODE
SX6 B0 CLEAR DISPLAY
SA6 DBUF+DBUFS
RJ IDO ISSUE DISPLAY OUTPUT
EQ LDI3 GET SYSTEM STATUSES
LDI1 WRITEC L,CPN CLEAR PAGE WAIT/CURSOR POSITIONING
WRITEC L,CSL CLEAR SCREEN
EQ LDI3 GET SYSTEM STATUSES
LDI2 SA1 ROT
ZR X1,LDI3 IF NO ROLLOUT TIME
ROLLOUT ROT ROLLOUT ON TIMED-EVENT
LDI3 RECALL
RJ GCS GET CATALOG STATUS
SA1 CMP
ZR X1,LDI6 IF NO COMMAND PROCESSOR
LDI4 RJM X1 PROCESS COMMAND
NZ X5,LDI5 IF ERROR
MBSATA CSLC,DMMA,DMMAC,59,DMMAU *LAST COMMMAND*
EQ LDI6 ISSUE OUTPUT
LDI5 MBSATA X5,DMMA,DMMAC,59,DMMAU SET ERROR MESSAGE
SA1 OPT CHECK FOR LINE MODE
SX1 X1-OPTLN
NZ X1,LDI6 IF NOT LINE MODE
MBSATA DMMA,LDIA,64*6,DMMAU,53 ISSUE ERROR MESSAGE TO OUTPUT
WRITEC L,BLANKS
WRITEC L,LDIA
LDI6 RJ CLS CHECK LINE MODE OUTPUT STATUS
NZ X6,LDI7 IF NO LINE MODE OUTPUT
RJ BDT BUILD DISPLAY TITLE
SA1 DIS GET DISPLAY PROCESSOR ADDRESS
SA1 X1+TDPR
RJM X1 PROCESS DISPLAY
RJ IOU ISSUE OUTPUT
LDI7 RJ GIN GET INPUT
SA1 CBUF+1
NZ X1,LDI8 IF INPUT
SX6 B0 CLEAR COMMAND PROCESSOR
SA6 CMP
SX6 B1 FORCE LINE MODE OUTPUT
SA6 LNS
EQ LDI2 ROLLOUT JOB
LDI8 SB2 7 BLANK FILL COMMAND
LDI9 NG B2,LDI10 IF END OF COMMAND
SA1 B2+CBUF+1
RJ ZTB CONVERT ZEROES TO BLANKS
SA6 A1
SB2 B2-B1
EQ LDI9 CHECK NEXT COMMAND WORD
LDI10 MX0 42 FORCE TERMINATOR INTO COMMAND
SA1 CBUF+1+7
SX6 1R.
BX1 X0*X1
LX6 12
BX6 X1+X6
SA6 A1
MBSATA CSPR,DMMA,DMMAC,59,DMMAU *PROCESSING*
MBSATA CBUF+1,DMCM,DMCMC,59,DMCMU
SA1 OPT CHECK OPTION
SX1 X1-OPTLD
NZ X1,LDI11 IF NOT L-DISPLAY MODE
RJ IDO ISSUE DISPLAY OUTPUT
LDI11 SB2 CBUF+1
RJ USB UNPACK STRING BUFFER
RJ POP PICK OUT PARAMETER
SB5 B5-B1
SX5 CSUC *UNKNOWN COMMAND.*
PL B5,LDI5 IF COMMAND TOO LONG
ZR X6,LDI12 IF SPECIAL CHARACTER
MX0 42 CHECK COMMAND LENGTH
BX1 -X0*X6
NZ X1,LDI5 IF COMMAND TOO LONG
EQ LDI13 SAVE COMMAND IMAGE
LDI12 LX1 54 POSITION COMMAND
BX6 X1
LDI13 SA6 COM SAVE COMMAND IMAGE
SX6 B6 SAVE FIRST PARAMETER ADDRESS
SA6 PAR
MX0 42 FIND COMMAND
SA1 COM
SRCHTAB X1,TCOM,0,1,TCOML
SX5 CSUC *UNKNOWN COMMAND.*
NZ X6,LDI5 IF COMMAND NOT FOUND
SX6 X2 SAVE COMMAND PROCESSOR ADDRESS
SA6 CMP
PL X6,LDI3 IF DO NOT PROCESS IMMEDIATELY
BX1 -X6
EQ LDI4 PROCESS COMMAND
LDIA DATA 65L
ABT SPACE 4,10
** ABT - ABORT PROGRAM.
*
* ENTRY (X5) = ADDRESS OF DAYFILE MESSAGE.
*
* EXIT MESSAGE ISSUED TO SYSTEM AND USER DAYFILES.
* PROGRAM ABORTED.
*
* CALLS CUP.
*
* MACROS ABORT, MESSAGE.
ABT BSS 0 ENTRY
RJ CUP CLEAN UP PROGRAM
MESSAGE X5,0,R ISSUE ERROR MESSAGE
ABORT ABORT PROGRAM
END SPACE 4,10
** END - TERMINATE PROGRAM.
*
* EXIT PROGRAM TERMINATED.
*
* CALLS CUP.
*
* MACROS ENDRUN, MESSAGE.
END BSS 0 ENTRY
RJ CUP CLEAN UP PROGRAM
MESSAGE DFLC,0,R *TMSDIS COMPLETE.*
ENDRUN TERMINATE PROGRAM
RPV SPACE 4,15
** RPV - REPRIEVE PROCESSOR.
*
* EXIT (SIA) = 1 AND PROGRAM RESUMED IF USER BREAK ONE AND
* TERMINAL INPUT/OUTPUT.
* PROGRAM CLEANED UP AND ERROR CONDITION RESET IF NOT
* USER BREAK ONE OR NOT TERMINAL INPUT/OUTPUT.
*
* USES X - 0, 1, 2, 6.
* A - 1, 2, 6.
*
* CALLS CUP.
*
* MACROS REPRIEVE.
RPV BSS 0 ENTRY
MX0 -12 CHECK ERROR FLAG
SA1 RPVA+/COMSRPV/OSEF
BX1 -X0*X1
SX1 X1-TIET
NZ X1,RPV2 IF NOT USER BREAK ONE
SA1 TIN CHECK FOR TERMINAL INPUT/OUTPUT
SA2 TOU
BX1 X1+X2
NZ X1,RPV2 IF NOT TERMINAL INPUT/OUTPUT
SX6 B1 FLAG SCREEN INPUT AVAILABLE
SA6 SIA
REPRIEVE RPVA,RESUME,237B RESUME PROGRAM EXECUTION
RPV2 RJ CUP CLEAN UP PROGRAM
REPRIEVE RPVA,RESET,000B RESET ERROR CONDITION
RPVA RPVBLK RPV REPRIEVE BLOCK
TITLE COMMAND SUBROUTINES.
COP SPACE 4,15
** COP - PROCESS *COPY* COMMAND.
*
* COPY.
*
* EXIT CURRENT DISPLAY COPIED TO OUTPUT FILE IF L-DISPLAY OR
* LINE MODE.
* (X5) = 0 IF NO PARAMETERS.
* = CSTM IF TOO MANY PARAMETERS.
*
* USES X - 1.
* A - 1.
*
* CALLS ILO, VNP.
COP SUBR ENTRY/EXIT
RJ VNP VERIFY NO MORE PARAMETERS
NZ X5,COPX IF TOO MANY PARAMETERS
SA1 OPT CHECK INPUT/OUTPUT MODE
SX1 X1-OPTSC
ZR X1,COPX IF SCREEN MODE
RJ BDT BUILD DISPLAY TITLE
SA1 DIS GET DISPLAY PROCESSOR ADDRESS
SA1 X1+TDPR
RJM X1 PROCESS DISPLAY
RJ ILO ISSUE LINE OUTPUT
SX5 B0 FLAG NO ERROR
EQ COPX RETURN
DRO SPACE 4,10
** DRO - PROCESS *DROP* OR *END* COMMAND.
*
* END.
* DROP.
*
* EXIT TO *END* TO TERMINATE PROGRAM.
*
* ERROR (X5) = CSTM IF TOO MANY PARAMETERS.
*
* CALLS VNP.
DRO SUBR ENTRY/EXIT
RJ VNP VERIFY NO PARAMETERS
NZ X5,DROX IF TOO MANY PARAMETERS
EQ END TERMINATE PROGRAM
FAP SPACE 4,15
** FAP - PROCESS *FAM* COMMAND.
*
* FAM.
*
* EXIT (DIS) = DISFC.
* (PAG) = 1.
* (X5) = 0 IF NO PARAMETERS.
* = CSTM IF TOO MANY PARAMETERS.
*
* USES X - 6.
* A - 6.
*
* CALLS VNP.
FAP SUBR ENTRY/EXIT
RJ VNP VERIFY NO MORE PARAMETERS
NZ X5,FAPX IF TOO MANY PARAMETERS
SX6 B1 SET PAGE NUMBER
SA6 PAG
SX6 DISFC SET DISPLAY TYPE
SA6 DIS
SX6 B1 FORCE LINE MODE OUTPUT
SA6 LNS
SX5 B0
EQ FAPX RETURN
HEP SPACE 4,15
** HEP - PROCESS *HELP* COMMAND.
*
* HELP.
*
* EXIT (DIS) = DISHP.
* (PAG) = 1.
* (X5) = 0 IF NO PARAMETERS.
* = CSTM IF TOO MANY PARAMETERS.
*
* USES X - 6.
* A - 6.
*
* CALLS VNP.
HEP SUBR ENTRY/EXIT
RJ VNP VERIFY NO MORE PARAMETERS
NZ X5,HEPX IF TOO MANY PARAMETERS
SX6 B1 SET PAGE NUMBER
SA6 PAG
SX6 DISHP SET DISPLAY TYPE
SA6 DIS
SX6 B1 FORCE LINE MODE OUTPUT
SA6 LNS
SX5 B0
EQ HEPX RETURN
MCP SPACE 4,15
** MCP - PROCESS MINUS COMMAND.
*
* -.
* -N.
*
* EXIT PAGE TOGGLED BACKWARD.
* (X5) = 0 IF NO PARAMETERS.
* = ERROR MESSAGE ADDRESS IF INCORRECT INCREMENT.
*
* USES X - 1, 2, 6.
* A - 1, 2, 6.
*
* CALLS VIP, VNP.
MCP SUBR ENTRY/EXIT
RJ VIP VERIFY INCREMENT PARAMETER
NZ X5,MCPX IF INCORRECT PARAMETER
SA6 MCPA SAVE INCREMENT
RJ VNP VERIFY NO PARAMETERS
NZ X5,MCPX IF TOO MANY PARAMETERS
SA1 PAG CHECK PAGE NUMBER
SA2 MCPA
IX2 X2-X1
BX6 -X2
NG X2,MCP1 IF NOT BEFORE FIRST PAGE
SA1 PNO SET LAST PAGE
SX6 X1
MCP1 SA6 PAG SET NEW PAGE NUMBER
SX6 B1 FORCE LINE MODE OUTPUT
SA6 LNS
SX5 B0
EQ MCPX RETURN
MCPA BSS 1 INCREMENT
PCP SPACE 4,15
** PCP - PROCESS PLUS COMMAND.
*
* +.
* +N.
*
* EXIT PAGE TOGGLED FORWARD.
* (X5) = 0 IF NO PARAMETERS.
* = ERROR MESSAGE ADDRESS IF INCORRECT INCREMENT.
*
* USES X - 1, 2, 6.
* A - 1, 2, 6.
*
* CALLS VIP, VNP.
PCP SUBR ENTRY/EXIT
RJ VIP VERIFY INCREMENT PARAMETER
NZ X5,PCPX IF INCORRECT INCREMENT
SA6 PCPA SAVE INCREMENT
RJ VNP VERIFY NO MORE PARAMETERS
NZ X5,PCPX IF TOO MANY PARAMETERS
SA1 PAG CHECK PAGE NUMBER
SA2 PCPA
IX6 X1+X2
SA1 PNO
IX1 X1-X6
PL X1,PCP1 IF NOT AFTER LAST PAGE
SX6 B1 SET FIRST PAGE
PCP1 SA6 PAG SET NEW PAGE NUMBER
SX6 B1 FORCE LINE MODE OUTPUT
SA6 LNS
SX5 B0
EQ PCPX RETURN
PCPA BSS 1 INCREMENT
TITLE DISPLAY SUBROUTINES.
BDT SPACE 4,10
** BDT - BUILD DISPLAY TITLE.
*
* EXIT FIRST THREE LINES OF DISPLAY SET UP.
*
* USES X - 1, 2, 6.
* A - 1, 2.
*
* CALLS CDD.
*
* MACROS MBSATA, MBSXTA.
BDT SUBR ENTRY/EXIT
SA1 TMS GET *TMS* STATUS
SX6 BDTC
ZR X1,BDT2 IF *TMS* ACTIVE
SX6 BDTD
BDT2 MBSATA X6,DTTS,DTTSC,59,DTTSU SET *TMS* STATUS
SA1 DIS GET DISPLAY NAME
MBSATA X1+BDTE,DTDS,DTDSC,59,DTDSU SET DISPLAY NAME
SA1 DIS GET NUMBER OF PAGES
SA2 X1+TNDP
NZ X2,BDT3 IF ONE OR MORE PAGES
SX2 B1
BDT3 SX6 X2 SET NUMBER OF PAGES
SA6 PNO
SA1 PAG GET CURRENT PAGE NUMBER
IX6 X2-X1
PL X6,BDT4 IF NOT TOO MANY PAGES
SX1 X2 RESET PAGE NUMBER
SX6 X2
SA6 A1
BDT4 NZ X1,BDT5 IF NON-ZERO
SX1 B1 RESET PAGE NUMBER
SX6 B1
SA6 A1
BDT5 RJ CDD CONVERT TO DECIMAL DISPLAY
MBSXTA X6,DTPN,DTPNC,DTPNC-1,DTPNU SET CURRENT PAGE NUMBER
SA1 PNO GET NUMBER OF PAGES
RJ CDD CONVERT TO DECIMAL DISPLAY
MBSXTA X6,DTPC,DTPCC,DTPCC-1,DTPCU SET CURRENT PAGE NUMBER
SA1 CCE GET NUMBER OF CATALOGS WITH ERRORS
RJ CDD CONVERT TO DECIMAL DISPLAY
MBSXTA X6,DTCE,DTCEC,DTCEC-1,DTCEU SET CATALOG ERRORS
SA1 CNSM NUMBER OF CATALOGS WITH NO *MT/NT* SCRATCH
RJ CDD CONVERT TO DECIMAL DISPLAY
MBSXTA X6,DTNM,DTNMC,DTNMC-1,DTNMU SET NO SCRATCH COUNT
SA1 CNSC NUMBER OF CATALOGS WITH NO *CT* SCRATCH
RJ CDD CONVERT TO DECIMAL DISPLAY
MBSXTA X6,DTNC,DTNCC,DTNCC-1,DTNCU SET NO SCRATCH COUNT
SA1 CNSA NUMBER OF CATALOGS WITH NO *AT* SCRATCH
RJ CDD CONVERT TO DECIMAL DISPLAY
MBSXTA X6,DTNA,DTNAC,DTNAC-1,DTNAU SET NO SCRATCH COUNT
EQ BDTX RETURN
BDTC DATA 14H TMS ENABLED.
BDTD DATA 14HTMS DISABLED.
BDTE BSS 0 DISPLAY NAMES
LOC 0
DISHP DATA 4HHELP
DISFC DATA 4H FAM
LOC *O
FAM SPACE 4,10
** FAM - BUILD *FAM* DISPLAY.
*
* EXIT FAMILY CATALOG DISPLAY SET INTO *DBUF*.
*
* USES X - 0, 1, 2, 6.
* A - 0, 1, 2, 6.
*
* CALLS CDD, CLY, ZTB.
*
* MACROS MBSATA, MBSXTA, MOVE.
FAM3 SX6 B0 FLAG END OF DISPLAY BUFFER
SA6 X5
FAM SUBR ENTRY/EXIT
SX5 DBUF+DBUFS SET START OF DISPLAY BUFFER
MOVE FAMAL,FAMA,X5 SET HEADER IN DISPLAY BUFFER
SX5 X5+FAMAL
SA1 PNO
ZR X1,FAM3 IF NO PAGES FOR DISPLAY
SA1 PAG GET ADDRESS OF FIRST ENTRY FOR PAGE
ZR X1,FAM3 IF NO PAGES FOR DISPLAY
SA1 X1+TFDP-1
SX6 NLPTT+NLPHD+1 SET CURRENT LINE NUMBER
SA6 CLN
FAM1 SX1 X1
ZR X1,FAM3 IF NO MORE ENTRIES
SA0 X1
SA1 CLN CHECK CURRENT LINE NUMBER
SX6 X1+LPEFC-NLPHD-NLPTT-NLPPG-2
PL X6,FAM3 IF NO MORE LINES IN DISPLAY
SX6 X5+FAMBL-DBUF-DBUFL
PL X6,FAM3 IF NO MORE ROOM IN DISPLAY BUFFER
SX0 FAMB CALCULATE Y-COORDINATE FOR FIRST LINE
SA1 CLN
RJ CLY CONVERT LINE NUMBER TO Y-COORDINATE
SX0 FAMB2 CALCULATE Y-COORDINATE FOR SECOND LINE
SA1 CLN
SX1 X1+B1
RJ CLY CONVERT LINE NUMBER TO Y-COORDINATE
* SET *FAMILY*.
SA1 A0+SBCWL+/TFM/TMFM GET FAMILY NAME
RJ ZTB CONVERT ZEROES TO BLANKS
MBSXTA X6,DFFM,DFFMC,59,DFFMU SET *FAMILY*
* SET BUSY FLAG.
SA1 A0 CHECK CATALOG BUSY FLAG
LX1 59-47
SX6 1R
PL X1,FAM2 IF CATALOG NOT BUSY
SX6 1R*
FAM2 MBSXTA X6,DFBS,DFBSC,DFBSC-1,DFBSU SET BUSY FLAG
* SET *MT/NT* SCRATCH COUNT.
MX0 -24 GET SCRATCH COUNT
SA1 A0+SBCWL+/TFM/TMSM
BX1 -X0*X1
RJ CDD CONVERT TO DECIMAL DISPLAY
MBSXTA X6,DFSM,DFSMC,DFSMC-1,DFSMU SET COUNT
* SET *MT/NT* NEXT SCRATCH VSN.
SA1 A0+SBCWL+/TFM/TMSM
RJ ZTB CONVERT ZEROES TO BLANKS
MBSXTA X6,DFNM,DFNMC,59,DFNMU SET NEXT VSN
* SET *CT* SCRATCH COUNT.
MX0 -24 GET SCRATCH COUNT
SA1 A0+SBCWL+/TFM/TMSC
BX1 -X0*X1
RJ CDD CONVERT TO DECIMAL DISPLAY
MBSXTA X6,DFSC,DFSCC,DFSCC-1,DFSCU SET COUNT
* SET *CT* NEXT SCRATCH VSN.
SA1 A0+SBCWL+/TFM/TMSC
RJ ZTB CONVERT ZEROES TO BLANKS
MBSXTA X6,DFNC,DFNCC,59,DFNCU SET NEXT VSN
* SET *AT* SCRATCH COUNT.
MX0 -24 GET SCRATCH COUNT
SA1 A0+SBCWL+/TFM/TMSA
BX1 -X0*X1
RJ CDD CONVERT TO DECIMAL DISPLAY
MBSXTA X6,DFSA,DFSAC,DFSAC-1,DFSAU SET COUNT
* SET *AT* NEXT SCRATCH VSN.
SA1 A0+SBCWL+/TFM/TMSA
RJ ZTB CONVERT ZEROES TO BLANKS
MBSXTA X6,DFNA,DFNAC,59,DFNAU SET NEXT VSN
* SET *STATUS*.
SA1 A0+SBCWL+/TFM/TMMB GET STATUS MESSAGE
RJ ZTB CONVERT ZEROES TO BLANKS
SA6 A1
SA1 A1+B1
RJ ZTB CONVERT ZEROES TO BLANKS
SA6 A1
SA1 A1+B1
RJ ZTB CONVERT ZEROES TO BLANKS
SA6 A1
SA1 A1+B1
RJ ZTB CONVERT ZEROES TO BLANKS
SA6 A1
MBSATA A0+SBCWL+/TFM/TMMB,DFST,DFSTC,59,DFSTU SET *STATUS*
MOVE FAMBL,FAMB,X5 SET ENTRY INTO BUFFER
SX5 X5+FAMBL INCREMENT DISPLAY BUFFER ADDRESS
SA1 CLN INCREMENT CURRENT LINE NUMBER
SX6 X1+LPEFC
SA6 A1
SA1 A0 GET NEXT FAMILY CATALOG ADDRESS
EQ FAM1 CHECK ADDRESS
FAMA BSS 0 FAMILY CATALOG DISPLAY HEADER
LDISS 1,NLPTT+1 HEADER LINE ONE
LDIS 7,(FAMILY )
LDIS 1,( )
LDIS 16,( MT/NT SCRATCH)
LDIS 1,( )
LDIS 16,( CT SCRATCH )
LDIS 1,( )
LDIS 16,( AT SCRATCH )
LDISE
LDISS 1,K HEADER LINE TWO
LDIS 8,( STATUS)
LDIS 8,( COUNT)
LDIS 1,( )
LDIS 7,(NXT-VSN)
LDIS 1,( )
LDIS 8,( COUNT)
LDIS 1,( )
LDIS 7,(NXT-VSN)
LDIS 1,( )
LDIS 8,( COUNT)
LDIS 1,( )
LDIS 7,(NXT-VSN)
LDISE
FAMAL EQU *-FAMA FAMILY CATALOG DISPLAY HEADER LENGTH
FAMB BSS 0
LDISS 1,K+1 FAMILY CATALOG ENTRY LINE ONE
DFFM LDIS 7,(FAMNAME) FAMILY NAME
DFBS LDIS 1,( ) BUSY FLAG
DFSM LDIS 8,( 0) *MT/NT* SCRATCH COUNT
LDIS 1,( )
DFNM LDIS 6,(------) *MT/NT* NEXT SCRATCH VSN
LDIS 1,( )
DFSC LDIS 8,( 0) *CT* SCRATCH COUNT
LDIS 1,( )
DFNC LDIS 6,(------) *CT* NEXT SCRATCH VSN
LDIS 1,( )
DFSA LDIS 8,( 0) *AT* SCRATCH COUNT
LDIS 1,( )
DFNA LDIS 6,(------) *AT* NEXT SCRATCH VSN
LDISE
FAMB2 BSS 0
LDISS 1,K FAMILY CATALOG ENTRY LINE TWO
LDIS 1,( )
DFST LDIS 40,( ) STATUS
LDISE
FAMBL EQU *-FAMB FAMILY CATALOG ENTRY LINE LENGTH
NWIFD EQU FAMBL*NLPPG/LPEFC+FAMAL NUMBER OF WORDS IN *FAM* DIS
HEL SPACE 4,10
** HEL - BUILD *HELP* DISPLAY.
*
* EXIT *HELP* DISPLAY SET INTO DISPLAY BUFFER.
*
* USES X - 1, 2, 6.
* A - 1.
*
* MACROS MOVE.
HEL SUBR ENTRY/EXIT
SA1 PAG GET PAGE NUMBER
SA1 X1+HELA-1
SX2 X1
AX1 18
MOVE X1,X2,DBUF+DBUFS SET *HELP* DISPLAY IN BUFFER
EQ HELX RETURN
HELA BSS 0 LENGTHS AND POINTERS TO HELP DISPLAY PAGES
LOC 1
VFD 24/0,18/HELBL,18/HELB PAGE ONE
LOC *O
HELB BSS 0 HELP DISPLAY PAGE ONE
LDISS 1,NLPTT+2
LDIS 4,(HELP)
LDISE
LDISS 20,K-1
LDIS 23,(DISPLAY VALID COMMANDS.)
LDISE
LDISS 1,K
LDIS 3,(FAM)
LDISE
LDISS 20,K-1
LDIS 43,(DISPLAY *TMS* FAMILY TAPE CATALOG STATUSES.)
LDISE
LDISS 1,K
LDIS 4,(COPY)
LDISE
LDISS 20,K-1
LDIS 36,(COPY CURRENT DISPLAY TO OUTPUT FILE.)
LDISE
LDISS 1,K
LDIS 1,(+)
LDISE
LDISS 20,K-1
LDIS 20,(TOGGLE PAGE FORWARD.)
LDISE
LDISS 1,K
LDIS 1,(-)
LDISE
LDISS 20,K-1
LDIS 21,(TOGGLE PAGE BACKWARD.)
LDISE
LDISS 1,K
LDIS 4,(END )
LDISE
LDISS 20,K-1
LDIS 20,(TERMINATE *TMSDIS* .)
LDISE
CON 0 END OF DISPLAY
HELBL EQU *-HELB LENGTH OF HELP DISPLAY
NWIHD EQU HELBL NUMBER OF WORDS IN *HELP* DISPLAY
TITLE SYSTEM STATUS SUBROUTINES.
CCB SPACE 4,10
** CCB - CLEAR CATALOG BUFFER.
*
* (A0) = ADDRESS OF CATALOG BUFFER.
*
* EXIT CATALOG BUFFER FIELDS SET TO ZERO.
* (TMSM) SET TO SIX HYPHENS.
* (TMSC) SET TO SIX HYPHENS.
* (TMSA) SET TO SIX HYPHENS.
*
* MACROS CLEAR, MBSATA.
CCB SUBR ENTRY/EXIT
CLEAR A0,SBUFE CLEAR CATALOG BUFFER
MBSATA HYPHENS,A0+SBCWL+/TFM/TMSM,6*6,59,59 *MT/NT* SCRATCH
MBSATA HYPHENS,A0+SBCWL+/TFM/TMSC,6*6,59,59 *CT* SCRATCH
MBSATA HYPHENS,A0+SBCWL+/TFM/TMSA,6*6,59,59 *AT* SCRATCH
EQ CCBX RETURN
CCS SPACE 4,20
** CCS - CHECK CATALOG STATUS.
*
* ENTRY (A0) = ADDRESS OF CATALOG BUFFER.
* (X4) = *CSCFA* IF CATALOG IS FAST-ATTACHED.
* = *CSCFB* IF CATALOG IS BUSY.
*
* EXIT ((A0)+0) = BIT 47 SET IF CATALOG IS BUSY.
* (X4) = *CSERR* IF CATALOG ERROR.
* = *CSNSV* IF NO SCRATCH VSNS OF ANY TYPE.
* = *CSCFA* IF NO SPECIAL STATUS.
* (CCE) INCREMENTED IF CATALOG ERROR.
* (CNSN) INCREMENTED IF NO *MT/NT* SCRATCH VSNS.
* (TMSM) SET TO SIX HYPHENS IF NO *MT/NT* SCRATCH VSNS.
* (CNSC) INCREMENTED IF NO *CT* SCRATCH VSNS.
* (TMSC) SET TO SIX HYPHENS IF NO *CT* SCRATCH VSNS.
* (CNSA) INCREMENTED IF NO *AT* SCRATCH VSNS.
* (TMSA) SET TO SIX HYPHENS IF NO *AT* SCRATCH VSNS.
*
* USES X - 0, 1, 4, 6, 7.
* A - 1, 6.
*
* MACROS MBSATA, MBSXTA.
CCS5 SA1 CCSB CHECK TOTAL SCRATCH COUNT FOR FAMILY
NZ X1,CCSX IF SCRATCH VSN-S OF ANY TYPE FOUND
SX4 CSNSV SET ERROR STATUS
CCS SUBR ENTRY/EXIT
SX6 X4-CSCFA
SX1 B0
ZR X6,CCS1 IF CATALOG IS FAST-ATTACHED
SX4 CSCFA
SX1 B1+
CCS1 MBSXTA X1,A0,1,0,47 SET/CLEAR CATALOG BUSY BIT
MX0 -24 CHECK *MT/NT* SCRATCH VSN COUNT
SA1 A0+SBCWL+/TFM/TMSM
BX6 -X0*X1
SA6 CCSB
NZ X6,CCS2 IF *MT/NT* SCRATCH VSNS
MBSATA HYPHENS,A0+SBCWL+/TFM/TMSM,6*6,59,59 CLEAR VSN
SA1 CNSM COUNT OF FAMILIES WITH NO *MT/NT* SCRATCH
SX6 X1+B1
SA6 A1
CCS2 MX0 -24 CHECK *CT* SCRATCH VSN COUNT
SA1 A0+SBCWL+/TFM/TMSC
BX2 -X0*X1
SA1 CCSB INCREMENT TOTAL SCRATCH COUNT
IX6 X1+X2
SA6 A1
NZ X2,CCS3 IF *CT* SCRATCH VSNS
MBSATA HYPHENS,A0+SBCWL+/TFM/TMSC,6*6,59,59 CLEAR VSN
SA1 CNSC COUNT OF FAMILIES WITH NO *CT* SCRATCH
SX6 X1+B1
SA6 A1
CCS3 MX0 -24 CHECK *AT* SCRATCH VSN COUNT
SA1 A0+SBCWL+/TFM/TMSA
BX2 -X0*X1
SA1 CCSB INCREMENT TOTAL SCRATCH COUNT
IX6 X1+X2
SA6 A1
NZ X2,CCS4 IF *AT* SCRATCH VSNS
MBSATA HYPHENS,A0+SBCWL+/TFM/TMSA,6*6,59,59 CLEAR VSN
SA1 CNSA COUNT OF FAMILIES WITH NO *AT* SCRATCH
SX6 X1+B1
SA6 A1
CCS4 SX0 /TFM/FETS CHECK FOR CATALOG ERROR
SA1 A0+SBCWL+/TFM/TMFM
BX1 X0*X1
ZR X1,CCS5 IF NO CATALOG ERROR
SA1 CCE INCREMENT CATALOG ERROR COUNT
SX6 X1+B1
SA6 A1
SX4 CSERR
EQ CCSX RETURN
CCSB CON 0 TOTAL SCRATCH COUNT FOR THIS FAMILY
CNF SPACE 4,10
** CNF - CHECK NON-FAST ATTACHED FILE STATUS.
*
* EXIT CALL *CCS* IF CATALOG ERROR.
* CALL *CCB* IF NO CATALOG ERROR.
*
* USES X - 0, 1.
* A - 1.
*
* CALLS CCB, CCS.
CNF1 RJ CCB CLEAR CATALOG BUFFER
CNF SUBR ENTRY/EXIT
SX0 /TFM/FETS CHECK FOR CATALOG ERROR
SA1 A0+SBCWL+/TFM/TMFM
BX1 X0*X1
ZR X1,CNF1 IF NO CATALOG ERROR
SX4 CSCFA
RJ CCS CHECK CATALOG STATUS
EQ CNFX RETURN
GCS SPACE 4,20
** GCS - GET CATALOG STATUSES.
*
* EXIT CATALOG STATUS BUFFERS SET INTO *SBUF*.
* FAMILY ORDINAL TABLE SET INTO *FBUF*.
* FIRST CATALOG STATUS BUFFER ENTRY FOR EACH DISPLAY
* PAGE SET INTO *TFDP*.
* WORD 0 OF EACH CATALOG STATUS BUFFER ENTRY SET -
*T, 12/STATUS, 1/BUSY FLAG, 29/0, 18/ADDRESS OF NEXT ENTRY
* (CCE) = NUMBER OF FAMILY CATALOGS WITH ERRORS.
* (CNS) = NUMBER OF FAMILY CATALOGS WITH NO SCRATCH.
* (TMS) = 0 IF *TMS* IS ACTIVE.
*
* USES X - 0, 1, 2, 4, 5, 6.
* A - 0, 1, 2, 4, 5, 6.
* B - 2, 3.
*
* CALLS ACF, SWP.
*
* MACROS CLEAR, MBSATA, MBSXTA, RDMEM, READ, READW, REWIND,
* RJM.
GCS13 SX6 B2 SET NUMBER OF PAGES
SA6 TNDP+DISFC
GCS SUBR ENTRY/EXIT
CLEAR TFCF,NFCST PRESET POINTER TABLES
CLEAR TFCL,NFCST
CLEAR TFDP,NPGFD PRESET *TFDP*
SX6 B0 CLEAR CATALOG STATUS COUNTS
SA6 CCE
SA6 CNSM
SA6 CNSC
SA6 CNSA
SA6 TNDP+DISFC
SYSTEM SFM,R,TMS,GTSF*100B GET *TMS* STATUS
MX0 1 SAVE *TMS* STATUS
SA1 TMS
BX1 X0*X1
BX6 X0-X1
SA6 TMS
SA1 MXF GET FAMILY ORDINAL TABLE
SA2 FFO
RDMEM ABS,X2,X1,FBUF
SA5 MXF GET CATALOG SYSTEM BLOCKS
SA0 SBUF
GCS1 SX5 X5-1
NG X5,GCS5 IF END OF FAMILIES
MX0 42 GET FAMILY NAME
SA1 X5+FBUF
BX1 X0*X1
SX4 CSFNF
ZR X1,GCS2 IF NO FAMILY NAME
SX2 377777B
RJ SWP SWAP TO FAMILY NAME AND USER INDEX
NZ X4,GCS2 IF FAMILY NOT FOUND
RJ ACF ATTACH CATALOG FILE
NZ X1,GCS2 IF CATALOG NOT ATTACHED
SX6 X4 SAVE STATUS
SA6 GCSB
REWIND P,R GET SYSTEM BLOCK
READ P,R
MX0 -5 CHECK FOR ERROR
SA1 P
AX1 9
BX1 -X0*X1
ZR X1,GCS1.1 IF NO ERROR ON READ
SX6 CSCNF FLAG AS CATALOG FILE NOT FOUND
SA6 GCSB
EQ GCS1.2 RETURN CATALOG FILE
GCS1.1 READW P,A0,SBUFE
GCS1.2 RETURN P
SA4 GCSB GET STATUS
GCS2 SA1 X4+TFCP
RJM X1 EXECUTE PROCESSOR FOR CATALOG STATUS
MBSATA X5+FBUF,A0+SBCWL+/TFM/TMFM,42,59,59 SET FAMILY NAME
MBSXTA X4,A0,12,11,59 SET CATALOG STATUS
MBSATA X4+TFCF,A0,18,17,17 LINK STATUS ENTRIES
SX1 A0
MBSXTA X1,X4+TFCF,18,17,17
SA1 X4+TFCM
ZR X1,GCS3 IF USE MESSAGE BUFFER
MBSATA X1,A0+SBCWL+/TFM/TMMB,/TFM/MBML*60,59,59 SET MESSAGE
GCS3 SA1 X4+TFCL
NZ X1,GCS4 IF ALREADY A LAST ENTRY
SX6 A0 SET LAST ENTRY
SA6 A1
GCS4 SA0 A0+SBUFE
EQ GCS1 CHECK NEXT FAMILY
GCS5 SA1 OFM GET ORIGINAL FAMILY NAME
SA2 OUI
RJ SWP SWAP TO FAMILY NAME AND USER INDEX
SA4 GCSA LINK STATUS ENTRIES
GCS6 ZR X4,GCS10 IF END OF TABLE
SA5 A4+B1
SA2 X4
ZR X2,GCS9 IF NO ENTRIES FOR THIS STATUS
SA1 TFDP+0
NZ X1,GCS7 IF FIRST ENTRY ALREADY SET
SA1 X4+TFCF-TFCL SET FIRST ENTRY
SX6 X1
SA6 TFDP+0
GCS7 ZR X5,GCS10 IF END OF TABLE
SA1 X5+TFCF-TFCL
NZ X1,GCS8 IF ENTRIES FOR THIS STATUS
SA5 A5+B1
EQ GCS7 CHECK NEXT STATUS
GCS8 MBSATA A1,X2,18,17,17 LINK STATUS ENTRIES
GCS9 SA4 A5
EQ GCS6 CHECK NEXT STATUS
GCS10 SA5 TFDP+0 COUNT NUMBER FAMILY CATALOG ENTRIES
SB2 B0 PRESET PAGE NUMBER
SB3 B0
GCS11 SX5 X5
ZR X5,GCS13 IF END OF ENTRIES
SB3 B3-LPEFC
PL B3,GCS12 IF NOT END OF PAGE
SX6 X5 SET FIRST ENTRY OF PAGE
SA6 B2+TFDP
SB2 B2+B1 INCREMENT PAGE NUMBER
SB3 NLPPG-1
GCS12 SA5 X5
EQ GCS11 CHECK NEXT ADDRESS
GCSA BSS 0 TABLE OF CATALOG STATUS LINKS
CON CSERR+TFCL CATALOG ERROR
CON CSNSV+TFCL NO SCRATCH VSNS
CON CSCFA+TFCL CATALOG FAST-ATTACHED
CON CSCFN+TFCL CATALOG NOT FAST-ATTACHED
CON CSCNF+TFCL CATALOG FILE NOT FOUND
CON 0 END OF TABLE
GCSB CON 0 CATALOG STATUS
TITLE INPUT/OUTPUT SUBROUTINES.
GDI SPACE 4,10
** GDI - GET *DISPLAY* INPUT.
*
* EXIT (CBUF+1) = INPUT COMMAND.
*
* ERROR ABORT WITH *L-DISPLAY NOT AVAILABLE*.
*
* USES X - 1, 2, 6.
* A - 1, 6.
*
* MACROS DSDINP, ABTMSG.
GDI SUBR ENTRY/EXIT
SX6 CBUFL SET BUFFER LENGTH
LX6 48
SA6 CBUF
DSDINP A6 REQUEST L-DISPLAY INPUT
SA1 CBUF CHECK FOR ERRORS
SX2 X1-2*NERR-1
ZR X2,GDIX IF NO ERROR
SX2 X1-2*NCMD-1
SX6 B0 PRESET COMMAND
SA6 CBUF+1
ZR X2,GDIX IF NO COMMAND ENTERED
SX6 B1 FLAG L-DISPLAY ERROR
SA6 LDE
ABTMSG DFLN *L-DISPLAY NOT AVAILABLE.*
GIN SPACE 4,10
** GIN - GET INPUT.
*
* ENTRY (OPT) = INPUT OPTION.
*
* EXIT INPUT PROCESSOR EXECUTED FOR OPTION.
*
* USES X - 1.
* A - 1.
*
* MACROS RJM, WRITER.
GIN SUBR ENTRY/EXIT
SA1 TOU
NZ X1,GIN1 IF NOT TERMINAL OUTPUT
WRITER L,R FLUSH BUFFER
GIN1 CLEAR CBUF+1,CBUFL CLEAR INPUT BUFFER
SA1 OPT GET INPUT OPTION
SA1 X1+GINA
RJM X1 PROCESS INPUT
EQ GINX RETURN
GINA BSS 0 INPUT OPTION PROCESSORS
LOC 0
OPTLD CON GDI DISPLAY
OPTLN CON GLI LINE
OPTSC CON GSI SCREEN
LOC *O
GLI SPACE 4,10
** GLI - GET LINE INPUT.
*
* EXIT (CBUF+1) = INPUT COMMAND.
*
* USES X - 1, 2, 6.
* A - 1, 2, 6.
*
* MACROS MBSATA, READC, REWIND.
GLI1 MBSATA ZEROES,I,15,17,17 CLEAR EOF
GLI SUBR ENTRY/EXIT
READC I,CBUF+1,8 READ COMMAND LINE
ZR X1,GLIX IF NOT EOR/EOF/EOI
SX6 B0 PRESET COMMAND
SA6 CBUF+1
SA1 TIN CHECK FOR TERMINAL INPUT/OUTPUT
SA2 TOU
BX1 X1+X2
ZR X1,GLI1 IF BOTH TERMINAL INPUT AND OUTPUT
SA1 =0LEND SET TERMINATION COMMAND
BX6 X1
SA6 CBUF+1
EQ GLIX RETURN
GSI SPACE 4,10
** GSI - GET SCREEN INPUT.
*
* EXIT (CBUF+1) = INPUT COMMAND.
* (SIA) = 0 IF INPUT REQUESTED.
*
* USES X - 1, 6.
* A - 1, 6.
*
* CALLS GLI.
GSI1 RJ GLI GET LINE INPUT
SX6 B0 CLEAR SCREEN INPUT AVAILABLE
SA6 SIA
GSI SUBR ENTRY/EXIT
SA1 SIA
NG X1,GSI1 IF SCREEN INPUT AVAILABLE
SX6 B0 SET NO COMMAND
SA6 CBUF+1
EQ GSIX RETURN
IDO SPACE 4,10
** IDO - ISSUE *DISPLAY* OUTPUT.
*
* EXIT (DBUF) SENT TO L-DISPLAY.
*
* ERROR ABORT WITH *L-DISPLAY NOT AVAILABLE*.
*
* USES X - 1, 2, 6.
* A - 1, 6.
*
* MACROS DSDOUT, ABTMSG.
IDO SUBR ENTRY/EXIT
SX6 LDSY SET BUFFER LENGTH
LX6 48
SA6 DBUF
DSDOUT A6 REQUEST L-DISPLAY OUTPUT
SA1 DBUF CHECK FOR ERRORS
SX2 X1-2*NERR-1
ZR X2,IDOX IF NO ERROR
SX6 B1 FLAG L-DISPLAY ERROR
SA6 LDE
ABTMSG DFLN *L-DISPLAY NOT AVAILABLE.*
ILO SPACE 4,15
** ILO - ISSUE LINE OUTPUT.
*
* EXIT (DBUF) COPIED TO OUTPUT FILE.
*
* USES X - 1, 2.
* A - 1.
* B - 6, 7.
*
* CALLS CKD.
*
* MACROS WRITEC.
ILO SUBR ENTRY/EXIT
SA1 TOU CHECK FOR TERMINAL OUTPUT
SB7 B0
ZR X1,ILO1 IF TERMINAL OUTPUT
WRITEC L,ILOA DOUBLE SPACE
SB7 B1
ILO1 SX2 L SET OUTPUT FILE ADDRESS
SB6 DBUF
RJ CKD COPY K-DISPLAY TO OUTPUT FILE
EQ ILOX RETURN
ILOA DATA C*0* DOUBLE SPACE
IOU SPACE 4,10
** IOU - ISSUE OUTPUT.
*
* ENTRY (OPT) = OUTPUT OPTION.
*
* EXIT OUTPUT PROCESSOR EXECUTED FOR OPTION.
*
* USES X - 1.
* A - 1.
*
* MACROS RJM.
IOU SUBR ENTRY/EXIT
SA1 OPT GET OUTPUT OPTION
SA1 X1+IOUA
RJM X1 PROCESS OUTPUT
EQ IOUX RETURN
IOUA BSS 0 OUTPUT OPTION PROCESSORS
LOC 0
DOPT CON IDO DISPLAY
LOPT CON ILO LINE
SOPT CON ISO SCREEN
LOC *O
ISO SPACE 4,10
** ISO - ISSUE SCREEN OUTPUT.
*
* EXIT (DBUF) COPIED TO OUTPUT FILE.
*
* USES X - 1, 2.
* A - 1, 2.
*
* CALLS ILO.
*
* MACROS WRITEC.
ISO SUBR ENTRY/EXIT
SA2 SIA
SA1 ISOB
ZR X2,ISO1 IF TERMINAL INPUT NOT AVAILABLE
SX6 -B1 FLAG INPUT AVAILABLE
SA6 A2
SA1 ISOA
ISO1 MBSATA A1,DMIN,DMINC,59,DMINU SET INPUT MESSAGE
SA1 BEL CHECK IF BELL IS REQUIRED
SA2 CCE
NZ X2,ISO2 IF CATALOG ERRORS
SA2 CNSM
NZ X2,ISO2 IF CATALOGS WITH NO *MT/NT* SCRATCH
SA2 CNSC
NZ X2,ISO2 IF CATALOGS WITH NO *CT* SCRATCH
SA2 CNSA
NZ X2,ISO2 IF CATALOGS WITH NO *AT* SCRATCH
SA2 COA
NZ X2,ISO2 IF JOBS REQUIRE OPERATOR ACTION
SX1 2R
ISO2 MBSXTA X1,TOP,12,11,47 SET/CLEAR BELL
WRITEC L,TOP GO TO TOP OF SCREEN
RJ ILO ISSUE LINE OUTPUT
WRITEC L,CIN CLEAR INPUT LINE
EQ ISOX RETURN
ISOA DATA 50HENTER *HELP* FOR HELP. ENTER *END* TO TERMINATE.
ISOB DATA 50HISSUE *BREAK* TO ENTER INPUT.
TITLE COMMON SUBROUTINES.
ACF SPACE 4,15
** ACF - ATTACH CATALOG FILE.
*
* EXIT (X1) = 0 IF CATALOG ATTACHED.
* .NE. 0 IF CATALOG NOT ATTACHED.
* (X4) = CSCFA IF CATALOG FILE IS FAST-ATTACHED.
* = CSCFB IF CATALOG FILE IS BUSY.
* = CSCFN IF CATALOG FILE IS NOT FAST-ATTACHED.
* = CSCNF IF CATALOG FILE IS NOT FOUND.
*
* USES X - 0, 1, 6.
* A - 1, 6.
*
* MACROS ATTACH, CATLIST, MBSATA, SETFET.
ACF SUBR ENTRY/EXIT
SETFET P,(DTY=B0),(ERA=ACFB) CLEAR DEVICE TYPE
MBSATA ZEROES,P,16,17,17 CLEAR ERROR CODE
ATTACH P,,,,RM,,,IP,FA ATTACH CATALOG FILE
MX0 -8 GET STATUS
SA1 P
AX1 10
BX1 -X0*X1
SX4 CSCFA
ZR X1,ACFX IF FILE ATTACHED
SX1 X1-/ERRMSG/FBS
SX4 CSCFB
ZR X1,ACF1 IF FILE BUSY
SX6 ZBUF RESET BUFFER POINTERS
SA6 P+2
SA6 A6+B1
MBSATA ZEROES,P,16,17,17 CLEAR ERROR CODE
ATTACH P,,,,RM,,,IP,NF ATTACH CATALOG FILE
MX0 -8 GET STATUS
SA1 P
AX1 10
BX1 -X0*X1
SX4 CSCFN
ZR X1,ACFX IF FILE FOUND
SX1 X1-/ERRMSG/FBS CHECK FOR FILE BUSY
SX4 CSCFB
ZR X1,ACF1 IF FILE BUSY
SX4 CSCNF
ACF1 SX1 B1 FLAG CATALOG NOT ATTACHED
EQ ACFX RETURN
ACFB BSS 4 *PFM* MESSAGE BUFFER
CLS SPACE 4,15
** CLS - CHECK LINE MODE OUTPUT STATUS.
*
* ENTRY (LNS) = 0 IF DO NOT FORCE LINE MODE OUTPUT.
* .NE. 0 IF FORCE LINE MODE OUTPUT.
*
* EXIT (X6) = 0 IF FORCE OUTPUT.
* .NE. 0 IF DO NOT FORCE OUTPUT.
* (LNS) = 0.
*
* USES X - 1.
* A - 1, 6.
CLS SUBR ENTRY/EXIT
SA1 OPT CHECK INPUT/OUTPUT OPTION
SX1 X1-OPTLN
SX6 B0
NZ X1,CLSX IF NOT LINE MODE
SA1 LNS GET LINE MODE OUTPUT STATUS
SA6 A1
NZ X1,CLSX IF FORCE OUTPUT
SX6 B1
EQ CLSX RETURN
CLY SPACE 4,15
** CLY - CONVERT LINE NUMBER TO Y-COORDINATE.
*
* ENTRY (X0) = FWA OF L-DISPLAY LINE.
* (X1) = DISPLAY LINE NUMBER.
*
* EXIT Y-COORDINATE SET INTO BYTE 1 OF L-DISPLAY LINE.
*
* USES X - 2, 6.
* A - 2.
*
* MACROS MBSXTA.
CLY SUBR ENTRY/EXIT
SX6 15 PRESET Y-COORDINATE INCREMENT
SA2 CON
ZR X2,CLY1 IF NOT 721 CONSOLE
SX6 10 RESET Y-COORDINATE INCREMENT
SX2 7726B-7707B
CLY1 SX2 X2+7707B
IX6 X1*X6 COMPUTE Y-COORDINATE
IX6 X2-X6
MBSXTA X6,X0,12,11,47 SET Y-COORDINATE
EQ CLYX RETURN
CUP SPACE 4,15
** CUP - CLEAN UP PROGRAM.
*
* EXIT TAPE CATALOG FILE RETURNED.
* INPUT AND OUTPUT FILES RETURNED IF SCREEN MODE.
* SWAPPED BACK TO ORIGINAL FAMILY NAME AND USER INDEX.
* L-DISPLAY CLEARED IF L-DISPLAY MODE.
*
* USES X - 0, 1, 2, 6.
* A - 1, 2, 6.
*
* CALLS IDO, SWP.
*
* MACROS DSDINP, MBSATA, RETURN, WRITER.
CUP SUBR ENTRY/EXIT
MBSATA (=1),P,1,0,0 RETURN TAPE CATALOG FILE
RETURN P,R
SA1 OPT CHECK FOR SCREEN MODE
SX1 X1-OPTSC
NZ X1,CUP1 IF NOT SCREEN MODE
MBSATA (=1),I,1,0,0 RETURN TERMINAL INPUT
RETURN I
MBSATA (=1),L,1,0,0 RESET CURSOR POSITIONING
WRITEC L,CPY
WRITEC L,CSL CLEAR SCREEN
WRITER L,R
RETURN L RETURN TERMINAL OUTPUT
EQ CUP2 RETURN TO ORIGINAL FAMILY/USER INDEX
CUP1 WRITER L,R FLUSH OUTPUT BUFFER
CUP2 SA1 OFM GET ORIGINAL FAMILY NAME
SA2 OUI
RJ SWP SWAP TO FAMILY NAME AND USER INDEX
SA1 OPT CHECK FOR L-DISPLAY
SX1 X1-OPTLD
NZ X1,CUPX IF NOT L-DISPLAY MODE
SA1 LDE
NZ X1,CUPX IF L-DISPLAY ERROR
SX6 B0 CLEAR L-DISPLAY BUFFER
SA6 DBUF+1
RJ IDO ISSUE L-DISPLAY OUTPUT
SA1 LDE
NZ X1,CUPX IF L-DISPLAY ERROR
SX6 CBUFL SET BUFFER LENGTH
LX6 48
SA6 CBUF
DSDINP A6,C CLEAR L-DISPLAY INTERLOCK
SA1 CBUF CHECK FOR ERROR
SX6 X1-2*NERR-1
ZR X6,CUPX IF NO ERROR
SA6 LDE FLAG L-DISPLAY ERROR
EQ CUPX RETURN
RDM SPACE 4,20
** RDM - READ MEMORY INTO BUFFER.
*
* ENTRY (X1) = ADDRESS OF BUFFER TO RECEIVE DATA.
* (X2) = ADDRESS TO READ DATA FROM.
* (X3) = NUMBER OF WORDS TO READ.
* (X4) = 0 IF READ FROM ABSOLUTE ADDRESS.
* .LT. 0 IF READ FROM CONTROL POINT ADDRESS.
* = SUBSYSTEM IDENTIFIER IF READ FROM SUBSYSTEM
* FIELD LENGTH.
*
* EXIT (X1) .LT. 0 IF TRANSFER COMPLETE.
* .GE. 0 IF ERROR.
* (X2) = CONTENTS OF FIRST WORD OF DATA.
*
* USES X - 4, 6.
* A - 2, 6.
*
* CALLS RSB=.
RDM SUBR ENTRY/EXIT
SX6 X1 SAVE BUFFER ADDRESS
SA6 RDMA
MX6 1 PRESET ABSOLUTE READ PARAMETERS
PL X4,RDM1 IF NOT CONTROL POINT READ
SX4 B0 SET CONTROL POINT READ PARAMETERS
SX6 X2
RDM1 SA6 X1 SET READ TYPE
RJ RSB= READ SUBSYSTEM BLOCK
PL X1,RDMX IF TRANSFER ERROR
SA2 RDMA GET FIRST WORD OF DATA
SA2 X2
EQ RDMX RETURN
RDMA BSS 1 ADDRESS OF BUFFER
STL SPACE 4,15
** STL - SEARCH TABLE WITH DEFINED LENGTH.
*
* ENTRY (B2) = FWA OF TABLE TO SEARCH.
* (B3) = LENGTH OF TABLE TO SEARCH.
* (B6) = RELATIVE ADDRESS OF VALUE IN TABLE ENTRY.
* (B7) = LENGTH OF TABLE ENTRY.
* (X0) = SEARCH MASK.
* (X1) = VALUE TO SEARCH FOR.
*
* EXIT (X6) = 0 IF VALUE FOUND.
* (A2) = ADDRESS OF WORD WITH VALUE.
* (X2) = IMAGE OF WORD WITH VALUE.
*
* USES B - 2, 3.
STL SUBR ENTRY/EXIT
SB3 B2+B3 SET LWA+1 OF TABLE
SX6 B1
STL1 GE B2,B3,STLX IF ENTRY NOT FOUND
SA2 B2+B6 COMPARE ENTRY WITH VALUE
BX6 X1-X2
BX6 X0*X6
ZR X6,STLX IF ENTRY FOUND
SB2 B2+B7
EQ STL1 CHECK NEXT ENTRY
STZ SPACE 4,15
** STZ - SEARCH TABLE TERMINATED BY A ZERO WORD.
*
* ENTRY (B2) = FWA OF TABLE TO SEARCH.
* (B6) = RELATIVE ADDRESS OF VALUE IN TABLE ENTRY.
* (B7) = LENGTH OF TABLE ENTRY.
* (X0) = SEARCH MASK.
* (X1) = VALUE TO SEARCH FOR.
*
* EXIT (X6) = 0 IF VALUE FOUND.
* (A2) = ADDRESS OF WORD WITH VALUE.
* (X2) = IMAGE OF WORD WITH VALUE.
*
* USES B - 2.
STZ SUBR ENTRY/EXIT
SA2 B2 GET FIRST ENTRY
SB2 B7-B6
SX6 B1
STZ1 ZR X2,STZX IF ENTRY NOT FOUND
SA2 A2+B6 COMPARE ENTRY WITH VALUE
BX6 X1-X2
BX6 X0*X6
ZR X6,STZX IF ENTRY FOUND
SA2 A2+B2
EQ STZ1 CHECK NEXT ENTRY
SWP SPACE 4,15
** SWP - SWAP FAMILY AND USER INDEX.
*
* ENTRY (X1) = FAMILY NAME TO SWAP TO.
* (X2) = USER INDEX TO SWAP TO.
*
* EXIT (X4) = 0 IF FAMILY FOUND.
* = CSFNF IF FAMILY NOT FOUND.
*
* USES X - 0, 1, 6.
* A - 1, 6.
*
* MACROS SETPFP
SWP SUBR ENTRY/EXIT
MX0 42 SET FAMILY NAME IN *SETPFP* BLOCK
SX6 11B
BX1 X0*X1
BX6 X1+X6
SA6 SWPA+0
BX6 -X0*X2 SET USER INDEX IN *SETPFP* BLOCK
SA6 SWPA+2
SETPFP SWPA CHANGE FAMILY NAME AND USER INDEX
MX0 -6 GET STATUS
SA1 SWPA+0
AX1 12
BX4 -X0*X1
ZR X4,SWPX IF SWAP COMPLETE
SX4 CSFNF
EQ SWPX RETURN
SWPA BSS 3 *SETPFP* BLOCK
VIP SPACE 4,15
** VIP - VERIFY INCREMENT PARAMETER.
*
* ENTRY (PAR) = ADDRESS OF INCREMENT PARAMETER IN STRING
* BUFFER.
*
* EXIT (PAR) = ADDRESS OF NEXT PARAMETER IN STRING BUFFER.
* (X6) = INCREMENT IF VALID.
* (X5) = 0 IF VALID INCREMENT.
* = *CSII* IF INCORRECT INCREMENT.
*
* USES X - 1, 7.
* A - 1, 6, 7.
* B - 5, 6, 7.
*
* CALLS DXB, POP.
VIP1 SX5 B0 FLAG VALID PARAMETER
NZ X6,VIPX IF NON-ZERO INCREMENT
SX6 B1 RESET INCREMENT
VIP SUBR ENTRY/EXIT
SA1 PAR
SX5 CSII *INCORRECT INCREMENT*
ZR X1,VIPX IF NO NEXT PARAMETER
SB6 X1
RJ POP PICK OUT PARAMETER
SX7 B6 SAVE NEXT PARAMETER ADDRESS
SA7 PAR
SX5 CSII *INCORRECT INCREMENT*
NG B5,VIPX IF BUFFER EXHAUSTED
SB5 B5-B1
GE B5,VIPX IF PARAMETER TOO LARGE
ZR X6,VIP1 IF NO INCREMENT
BX5 X6
SB7 B1
RJ DXB CONVERT DISPLAY TO BINARY
SX5 CSII *INCORRECT INCREMENT*
NZ X4,VIPX IF CONVERSION ERROR
EQ VIP1 FLAG VALID PARAMETER
VNP SPACE 4,10
** VNP - VERIFY NO MORE PARAMETERS.
*
* ENTRY (PAR) = ADDRESS OF NEXT PARAMETER IN STRING BUFFER.
*
* EXIT (X5) = 0 IF NO MORE PARAMETERS.
* = *CSTM* IF MORE PARAMETERS.
*
* USES X - 1.
* A - 1.
VNP SUBR ENTRY/EXIT
SA1 PAR CHECK NEXT PARAMETER
SX5 CSTM *TOO MANY PARAMETERS*
NZ X1,VNPX IF MORE PARAMETERS
SX5 B0 FLAG NO PARAMETERS
EQ VNPX RETURN
COMMON SPACE 4,10
** COMMON DECKS.
*CALL COMCCOD
*CALL COMCCDD
*CALL COMCCIO
CCKD BSS 0 STARTING ADDRESS OF *COMCCKD*
CKDL$ EQU NLPDS MAXIMUM NUMBER OF LINES IN DISPLAY
CKDY$ EQU 7672B DEFINE INITIAL Y-COORDINATE
*CALL COMCCKD
CCKDL EQU *-CCKD LENGTH OF *COMCCKD
*CALL COMCCPM
*CALL COMCDXB
*CALL COMCMBS
*CALL COMCMVE
*CALL COMCPFM
*CALL COMCPOP
*CALL COMCRDC
*CALL COMCRDW
*CALL COMCRSB
*CALL COMCSFN
*CALL COMCUSB
*CALL COMCSYS
*CALL COMCWTC
*CALL COMCWTH
*CALL COMCWTW
*CALL COMCZTB
TITLE BUFFER AREA.
BUFFERS SPACE 4,10
** BUFFERS THAT CANNOT OVERWRITE *PRESET*.
USE BUFFERS DEFINE LITERALS
ZBUF BSS ZBUFL TAPE CATALOG FILE BUFFER
DBUF BSS 0 L-DISPLAY OUTPUT BUFFER
VFD 12/DBUFL BUFFER LENGTH
VFD 1/0 SMALL CHARACTERS
VFD 1/0 PROGRAM FORMAT
VFD 1/0 SINGLE SPACING
VFD 45/0
LDISS 1,1 FIRST LINE OF TITLE
LDIS 25,(TMSDIS. )
DTTS LDIS 14,( TMS ENABLED. ) *TMS* STATUS
DTDS LDIS 4,(HELP) CURRENT DISPLAY
LDIS 14,( DISPLAY PAGE )
DTPN LDIS 1,(1) CURRENT PAGE NUMBER
LDIS 4,( OF )
DTPC LDIS 1,(1) PAGE COUNT
LDIS 1,(.)
LDISE
LDISS 1,K THIRD LINE OF TITLE
LDIS 21,(CATALOGS WITH ERRORS=)
DTCE LDIS 2,( 0) NUMBER OF CATALOGS WITH ERRORS
LDIS 34,(. CATALOGS WITH NO MT/NT SCRATCH=)
DTNM LDIS 2,( 0) NUMBER OF CATALOGS WITH NO *MT/NT* SCRATCH
LDIS 1,(.)
LDISE
LDISS 1,K FOURTH LINE OF TITLE
LDIS 28,(CATALOGS WITH NO CT SCRATCH=)
DTNC LDIS 2,( 0) NUMBER OF CATALOGS WITH NO *CT* SCRATCH
LDIS 31,(. CATALOGS WITH NO AT SCRATCH=)
DTNA LDIS 2,( 0) NUMBER OF CATALOGS WITH NO *AT* SCRATCH
LDIS 1,(.)
LDISE
LDISS 1,NLPDS+1-NLPMS FIRST LINE OF MESSAGE
DMIN LDIS 49,(ENTER *HELP* FOR HELP. ENTER *END* TO TERMINATE.)
LDISE
LDISS 1,K SECOND LINE OF MESSAGE
DMMA LDIS 30,( LAST COMMAND)
LDIS 3,( - )
DMCM LDIS 30,( )
LDISE
DBUFS EQU *-DBUF LENGTH OF START OF DISPLAY BUFFER
ERRNG DBUFL-DBUFS-NWIFD *FAM* DISPLAY OVERFLOW
ERRNG DBUFL-DBUFS-NWIHD *HELP* DISPLAY OVERFLOW
BUFF BSS 0 FWA OF OVERWRITTEN BUFFER AREA
BSS DBUFL-DBUFS REMAINDER OF DISPLAY BUFFER
ERRNZ *-DBUF-DBUFL DISPLAY BUFFER MISMATCH
CON 0 END OF DISPLAY BUFFER
BUFFERS SPACE 4,10
** BUFFERS THAT CAN OVERWRITE *PRESET*.
CBUF BSS 1 COMMAND BUFFER
BSS CBUFL
FBUF BSS FBUFL FAMILY ORDINAL TABLE BUFFER
IBUF BSS IBUFL INPUT FILE BUFFER
LBUF BSS LBUFL OUTPUT FILE BUFFER
SBUF BSS SBUFL CATALOG SYSTEM BLOCKS BUFFER
TFCF BSS NFCST TABLE OF FAMILY CATALOG FIRST ENTRIES
TFCL BSS NFCST TABLE OF FAMILY CATALOG LAST ENTRIES
TFDP BSS NPGFD TABLE OF FAMILY CATALOG DISPLAY PAGES
BUFFL EQU *-BUFF LENGTH OF BUFFER AREA
TITLE PRESET AREA.
SPACE 4
ORG BUFF
FETS SPACE 4,10
** *STATUS* FET.
Z BSS 0 *STATUS* FET
Z555555 FILEB 0,0,(FET=5)
TARG SPACE 4,10
** TARG - TABLE OF COMMAND ARGUMENTS.
TARG BSS 0 TABLE OF COMMAND ARGUMENTS
ID ARG ID,ID,400B INITIAL DISPLAY
OP ARG OP,OP,400B INPUT/OUTPUT MODE
I ARG I,I,400B INPUT FILE
L ARG L,L,400B OUTPUT FILE
NOBELL ARG (-=2R ),BEL NO BELL OPTION
WT ARG WT,WT,400B WAITING TIME
CON 0 END OF TABLE
TOPT SPACE 4,10
** TOPT - TABLE OF VALID INPUT/OUTPUT OPTIONS.
TOPT BSS 0 TABLE OF VALID INPUT/OUTPUT OPTIONS
LOC 0
OPTLD VFD 42/0LL,18/OPTLD L-DISPLAY MODE
OPTLN VFD 42/0LLINE,18/OPTLN LINE MODE
OPTSC VFD 42/0LSCREEN,18/OPTSC SCREEN MODE
LOC *O
TOPTL EQU *-TOPT LENGTH OF TABLE
TDIS SPACE 4,10
** TDIS - TABLE OF VALID DISPLAY DIRECTIVES.
TDIS BSS 0 TABLE OF VALID DISPLAY DIRECTIVES.
VFD 42/0LFAM,18/DISFC FAMILY CATALOG DISPLAY
VFD 42/0LHELP,18/DISHP HELP DISPLAY
TDISL EQU *-TDIS LENGTH OF TABLE
TTSC SPACE 4,10
** TTSC - TABLE OF TERMINAL SCREEN CHARACTERS.
*
* ENTRY ONE WORD PER TERMINAL TYPE.
*T, VFD 24/ , 12/ BCHAR, 12/ CCHAR, 12/ TCHAR
*
* BCHAR = BELL CHARACTER
* CCHAR = CLEAR SCREEN CHARACTER.
* TCHAR = TOP OF SCREEN CHARACTER.
TTSC BSS 0 TABLE OF TOP OF SCREEN CHARACTERS
LOC 0
VFD 24/,12/2R^*,12/2R ,12/2R NO SCREEN MODE
VFD 24/,12/2R ,12/2R ,12/2R RESERVED
VFD 24/,12/2R^*,12/2R^=,12/2R^? CDC 721
VFD 24/,12/2R^*,12/2R^',12/2R CDC 722
VFD 24/,12/2R^*,12/2R ,12/2R DEC VT100
VFD 24/,12/2R^*,12/2R ,12/2R Z19 OR H19
VFD 24/,12/2R ,12/2R ,12/2R UNDEFINED
VFD 24/,12/2R ,12/2R ,12/2R UNDEFINED
VFD 24/,12/2R ,12/2R ,12/2R UNDEFINED
VFD 24/,12/2R ,12/2R ,12/2R UNDEFINED
VFD 24/,12/2R ,12/2R ,12/2R UNDEFINED
VFD 24/,12/2R ,12/2R ,12/2R UNDEFINED
VFD 24/,12/2R ,12/2R ,12/2R UNDEFINED
VFD 24/,12/2R ,12/2R ,12/2R UNDEFINED
VFD 24/,12/2R ,12/2R ,12/2R UNDEFINED
VFD 24/,12/2R ,12/2R ,12/2R UNDEFINED
VFD 24/,12/2R ,12/2R ,12/2R UNDEFINED
VFD 24/,12/2R ,12/2R ,12/2R UNDEFINED
VFD 24/,12/2R ,12/2R ,12/2R UNDEFINED
VFD 24/,12/2R ,12/2R ,12/2R UNDEFINED
VFD 24/,12/2R ,12/2R ,12/2R UNDEFINED
VFD 24/,12/2R ,12/2R ,12/2R UNDEFINED
VFD 24/,12/2R ,12/2R ,12/2R UNDEFINED
VFD 24/,12/2R ,12/2R ,12/2R UNDEFINED
VFD 24/,12/2R ,12/2R ,12/2R UNDEFINED
VFD 24/,12/2R ,12/2R ,12/2R UNDEFINED
VFD 24/,12/2R ,12/2R ,12/2R UNDEFINED
VFD 24/,12/2R ,12/2R ,12/2R UNDEFINED
VFD 24/,12/2R ,12/2R ,12/2R UNDEFINED
VFD 24/,12/2R ,12/2R ,12/2R UNDEFINED
VFD 24/,12/2R ,12/2R ,12/2R UNDEFINED
VFD 24/,12/2R ,12/2R ,12/2R UNDEFINED
ERRNZ *-40B INCORRECT TABLE SIZE
LOC *O
WORKING SPACE 4,10
** PRESET WORKING STORAGE.
DF DATA C*"DEFRN"* DEFAULT WAITING TIME NON-SYSTEM ORIGIN
GP BSS 3 *GETPFP* BLOCK
ID DATA C*HELP* INITIAL DISPLAY
OP DATA C*L* INPUT/OUTPUT MODE
PI BSS 1 PARAMETER IMAGE
RT CON 10 CATALOG ATTACH RETRY COUNT
WT DATA C*"DEFRS"* WAITING TIME
PRS SPACE 4,10
** PRS - PRESET PROGRAM.
PRS SUBR ENTRY/EXIT
MX0 1 SET THE REAL-TIME BIT IN TAPE CATALOG FET
SA1 P+1
LX0 43-59+60
BX6 X0+X1
SA6 A1
GETPFP GP GET FAMILY NAME, USER NAME, AND USER INDEX
MX0 42 SAVE ORIGINAL FAMILY NAME
SA1 GP+0
BX6 X0*X1
SA6 OFM
SA1 GP+2 SAVE ORIGINAL USER INDEX
BX6 -X0*X1
SA6 OUI
RJ GSF GET SCRATCH FILE NAME
SX1 3 SET LOCAL FILE NAME FOR CATALOG FILE
BX6 X6+X1
SA6 P
REPRIEVE RPVA,SET,237B SET EXTENDED REPRIEVE
MX0 -12 CHECK ORIGIN TYPE
SA1 JOPR
AX1 24
BX6 -X0*X1
SA6 JOT
SX6 X6-SYOT
ZR X6,PRS5 IF SYSTEM ORIGIN
SX6 X6+SYOT-IAOT
SX5 X6
PRS1 RJ ACF ATTACH CATALOG FILE
SX4 X4-CSCFA
ZR X4,PRS2 IF FILE ATTACHED
SX4 X4-CSCFB+CSCFA
NZ X4,PRS3 IF NOT FILE BUSY
NZ X5,PRS1.1 IF NOT INTERACTIVE ORIGIN
SA1 RT DECREMENT RETRY COUNT
SX6 X1-1
SA6 A1
NG X6,PRS3 IF RETRY COUNT EXHAUSTED
PRS1.1 ROLLOUT =1
EQ PRS1 RETRY ATTACH
PRS2 REWIND P,R GET SYSTEM BLOCK
READ P,R
MX0 -5 CHECK FOR ERROR
SA1 P
AX1 9
BX1 -X0*X1
NZ X1,PRS3 IF ERROR ON READ
READW P,PRSA,SBCWL+/TFM/TMUN+/TFM/UNCL
RETURN P,R
MX0 42 CHECK FOR VALID USER NAME
SA1 GP+2
SRCHTAB X1,PRSA+SBCWL+/TFM/TMUN,0,1,/TFM/UNCL
ZR X6,PRS4 IF VALID USER NAME
PRS3 RETURN P,R
ABTMSG DFIC *INCORRECT COMMAND.*
PRS4 SX6 -1 DISABLE L-DISPLAY MODE
SA6 TOPT+OPTLD
SA1 TOPT+OPTLN SWITCH TO LINE MODE DEFAULT
BX6 X1
SA6 OP
SA1 DF RESET DEFAULT WAITING TIME
BX6 X1
SA6 WT
SA1 JOT CHECK ORIGIN TYPE
SX1 X1-IAOT
ZR X1,PRS6 IF INTERACTIVE ORIGIN
PRS5 SX6 -1 DISABLE SCREEN MODE
SA6 TOPT+OPTSC
PRS6 RJ GTC GET TERMINAL CHARACTERISTICS
MX0 -12 GET ORDER DEPENDENT ARGUMENTS
SA1 ACTR GET ARGUMENT COUNT
SB4 X1
SA4 ARGR GET FIRST ARGUMENT
SB5 TARG GET FWA OF ARGUMENT TABLE
PRS7 ZR B4,PRS14 IF END OF ARGUMENTS
SA2 B5 CHECK FOR EQUIVALENCED ARGUMENTS
LX2 59-47
NG X2,PRS12 IF END OF EQUIVALENCED ARGUMENTS
SX2 X4 CHECK FOR EQUIVALENCED ARGUMENT
SX2 X2-1R=
ZR X2,PRS12 IF END OF ORDER DEPENDENT ARGUMENTS
SB4 B4-B1 DECREMENT ARGUMENT COUNT
SA2 B5 GET TABLE ENTRY
ZR X2,PRS13 IF END OF TABLE
BX6 X0*X4 SAVE ARGUMENT
SA4 A4+B1
SB2 X2 GET ADDRESS TO RECEIVE ARGUMENT
LX2 12 GET OPTION POINTER
BX3 -X0*X2
LX2 18 GET ASSUMED VALUE
SB3 X2
LX2 12 GET *0* STATUS
BX2 -X0*X2
SX3 X3-77B CHECK FOR TWO CHARACTER ARGUMENT
SB5 B5+B1
NZ X3,PRS8 IF TWO CHARACTER ARGUMENT
SB5 B5+B1
PRS8 NZ X6,PRS9 IF ARGUMENT SPECIFIED
SA1 B3 GET DEFAULT ARGUMENT
BX6 X1
PRS9 SX2 X2-4000B
ZR X2,PRS10 IF DISPLAY *0* ALLOWED
SX1 1R0
LX1 54
BX1 X6-X1
NZ X1,PRS10 IF NOT DISPLAY *0*
SX6 B0
PRS10 MX2 42
NZ X6,PRS11 IF NON-ZERO ARGUMENT
MX2 60
PRS11 SA1 B2 SET VALUE FOR ARGUMENT
BX1 -X2*X1
BX6 X6+X1
SA6 A1
EQ PRS7 CHECK NEXT ARGUMENT
PRS12 RJ ARG PROCESS ORDER INDENPENDENT ARGUMENTS
ZR X1,PRS14 IF VALID ARGUMENTS
PRS13 MX0 42 SET INCORRECT PARAMETER IN MESSAGE
BX1 X0*X4
SB2 1R$
SB3 DFUP
SB5 -B3
RJ SNM SET NAME IN MESSAGE
ABTMSG DFUP *UNKNOWN PARAMETER - PPPPPPP.*
PRS14 MX0 42 CHECK INITIAL DISPLAY PARAMETER
SA1 ID
SRCHTAB X1,TDIS,0,1,TDISL
SX7 2RID
LX7 48
NZ X6,PRS18 IF VALUE NOT FOUND
BX6 -X0*X2
SA6 DIS SET INITIAL DISPLAY VALUE
MX0 42 CHECK INPUT/OUTPUT MODE
SA1 OP
SRCHTAB X1,TOPT,0,1,TOPTL
SX7 2ROP
LX7 48
NZ X6,PRS18 IF VALUE NOT FOUND
BX6 -X0*X2
SA6 OPT SET INPUT/OUTPUT MODE
SA5 WT CHECK WAITING TIME
SB7 -B1
RJ DXB CONVERT DISPLAY TO BINARY
SA1 WT
SX7 2RWT
LX7 48
NZ X4,PRS18 IF INCORRECT WAITING TIME
SX1 X6-10000B
NG X1,PRS16 IF LESS THAN THE MAXIMUM
SX6 7777B
PRS16 SA1 OPT CHECK FOR LINE MODE
SX1 X1-OPTLN
NZ X1,PRS17 IF NOT LINE MODE
SX6 B0
PRS17 SA6 ROT SET ROLLOUT TIME
ZR X6,PRS19 IF NO ROLLOUT TIME
SA1 OPT
SX1 X1-OPTLD
NZ X1,PRS19 IF NOT DISPLAY MODE
SX1 LINE SET EVENT DESCRIPTOR FOR ROLLOUT
MBSXTA X1,ROT,12,11,23
EQ PRS20 CHECK FOR TERMINAL INPUT
PRS18 SA7 PI SAVE PARAMETER IMAGE
SB2 1R$ SET VALUE IMAGE IN MESSAGE
SB3 DFIV
SB5 -B3
RJ SNM SET NAME IN MESSAGE
SA1 PI SET PARAMETER IMAGE IN MESSAGE
SB2 1R#
SB3 DFIV
SB5 -B3
RJ SNM SET NAME IN MESSAGE
ABTMSG DFIV *INCORRECT VALUE FOR PP PARAMETER - VVVV.*
PRS19 SA1 OPT CHECK FOR SCREEN MODE
SX1 X1-OPTSC
NZ X1,PRS20 IF NOT SCREEN MODE
SX4 2RTT SET DEVICE TYPE
SETFET I,(DTY=X4)
RJ GSF GET SCRATCH FILE NAME
SX1 B1 SET SCRATCH FILE NAME INTO INPUT FET
BX6 X6+X1
SA6 I
REQUEST A6,TT,NOMSG ASSIGN INPUT FILE TO TERMINAL
SX4 2RTT SET DEVICE TYPE
SETFET L,(DTY=X4)
RJ GSF GET SCRATCH FILE NAME
SX1 B1 SET SCRATCH FILE NAME INTO OUTPUT FET
BX6 X6+X1
SA6 L
REQUEST A6,TT,NOMSG ASSIGN OUTPUT FILE TO TERMINAL
PRS20 SX2 I
RJ STF SET TERMINAL FILE
SA6 TIN SAVE TERMINAL INPUT STATUS
SX2 L
RJ STF SET TERMINAL FILE
SA6 TOU SAVE TERMINAL OUTPUT STATUS
CSET NORMAL SET 6-BIT CHARACTER SET
RDMEM ABS,FOTP,1,FFO GET FAMILY ORDINAL TABLE ADDRESS
MX0 -24
LX2 24
BX6 -X0*X2
SA6 FFO
MX0 -12 GET MAXIMUM FOT ENTRIES
LX2 12
BX6 -X0*X2
SA6 MXF
SA1 OPT CHECK INPUT/OUTPUT MODE
SX1 X1-OPTLD
NZ X1,PRSX IF NOT L-DISPLAY
CSTATUS CON GET CONSOLE TYPE
SA1 CON
ZR X1,PRSX IF NOT 721 CONSOLE
MOVE PRSBL,PRSB,CCKD REWRITE COMMON DECK *COMCCKD*
SX3 KDL
RJ PRK PROCESS K-DISPLAY
EQ PRSX RETURN
PRSA BSS SBCWL+/TFM/TMUN+/TFM/UNCL CATALOG WORKING BUFFER
PRSB BSS 0 IMAGE OF *COMCCKD* FOR 721 CONSOLE
LOC CCKD
QUAL PRSB
QUAL$ EQU 1 QUALIFY COMMON DECK
CKDI$ EQU 10 DEFINE Y-COORDINATE INCREMENT
CKDY$ EQU 7714B DEFINE INITIAL Y-COORDINATE
*CALL COMCCKD
QUAL *
PRSBL EQU *-CCKD LENGTH OF *COMCCKD*
LOC *O
ERRNZ CKD-/PRSB/CKD COMMON DECK ENTRY MISMATCH
ERRNZ CCKDL-PRSBL COMMON DECK LENGTH MISMATCH
GSF SPACE 4,10
** GSF - GET SCRATCH FILE NAME.
*
* EXIT (X6) = UNASSIGNED SCRATCH FILE NAME.
*
* USES X - 1, 4, 6.
* A - 1, 6.
*
* MACROS PDATE, STATUS.
GSF4 SX1 B1 SET FILE NAME IN FET
BX6 X6+X1
SA6 Z
STATUS Z CHECK FILE STATUS
SX6 7776B
SA1 Z
BX6 X6*X1
NZ X6,GSF1 IF FILE EXISTS
MX6 42 GET FILE NAME
BX6 X6*X1
GSF SUBR ENTRY/EXIT
GSF1 SA1 GSFA
NZ X1,GSF2 IF BINARY NUMBER EXISTS
SA1 GSFC SET INITIAL BINARY
BX6 X1
SA6 GSFA
PDATE GSFB GET PACKED DATE AND TIME
MX6 -6 RANDOMIZE BINARY
SA1 GSFB
BX6 -X6*X1
LX6 15
SA1 GSFA
BX6 X1-X6
SA6 A1
BX1 X6
GSF2 SX6 B1 RESET BINARY
IX6 X1-X6
SA6 A1
* CONVERT BINARY TO FILE NAME.
SX6 B0
GSF3 ZR X1,GSF4 IF END OF BINARY
MX4 -5 CONVERT 5 BINARY BITS TO 6 BIT CHARACTER
BX4 -X4*X1
SX4 X4+B1
BX6 X6+X4
LX6 -6+60
AX1 5
EQ GSF3 GET NEXT CHARACTER CODE
GSFA CON 0 BINARY NUMBER
GSFB CON 0 PACKED DATE AND TIME
GSFC CON 317777777777B
GTC SPACE 4,10
** GTC - GET TERMINAL CHARACTERISTICS.
*
* EXIT (BEL) = BELL CHARACTER IN BITS 11 - 0.
* (CSL) = CLEAR SCREEN CHARACTER IN BITS 47 - 36.
* (TOP) = TOP OF SCREEN CHARACTER IN BITS 35 - 24.
*
* USES X - 0, 1, 4.
* A - 1.
*
* MACROS MBSATA, SETSLM.
GTC SUBR ENTRY/EXIT
SA1 JOT CHECK IF INTERACTIVE
SX1 X1-IAOT
ZR X1,GTCX IF NOT INTERACTIVE ORIGIN TYPE
SETSLM GTCA GET TERMINAL MODEL
MX0 -5
SA1 GTCA
BX4 -X0*X1
MBSATA X4+TTSC,BEL,12,35,11 SET BELL CHARACTER
MBSATA X4+TTSC,CSL,12,23,47 SET CLEAR SCREEN CHARACTER
MBSATA X4+TTSC,TOP,12,11,35 SET TOP OF SCREEN CHARACTER
EQ GTCX RETURN
GTCA BSS 1 TERMINAL MODEL WORD
COMMON SPACE 4,10
** PRESET COMMON DECKS.
*CALL COMCARG
*CALL COMCDCP
KDL BSS 0 TABLE OF L-DISPLAY LINES
KDL HERE
PRK HERE
*CALL COMCLFM
*CALL COMCSFM
*CALL COMCSNM
*CALL COMCSTF
TITLE *TMSON* AND *TMSOFF* PROGRAM AREA.
SPACE 4,10
QUAL TMSON
FBUF IFLT *,FBUF+FBUFL
BSS FBUF+FBUFL-* PREVENT OVERWRITE BY FAMILY TABLE BUFFER
FBUF ENDIF
FETS SPACE 4,10
** FETS.
TF BSS 0 *TMS* CATALOG FET FOR *TFM*
"TMFC" FILEB 0,0,(FET=16),EPR
TARG SPACE 4,10
** TARG - TABLE OF COMMAND ARGUMENTS.
TARG BSS 0 TABLE OF COMMAND ARGUMENTS
FM ARG FM,FM,400B FAMILY NAME
TARGN BSS 0
* CON 0 END OF TABLE FOR *TMSOFF*
DEFTO ARG DT,DT,400B DEFAULT *TO* FOR NON-*SYOT*
DEFTOS ARG DS,DS,400B DEFAULT *TO* FOR *SYOT*
CON 0 END OF TABLE
TDEF SPACE 4,10
** TDEF - TABLE OF *TO* ARGUMENT OPTIONS.
TDEF BSS 0 TABLE OF *TO* ARGUMENT OPTIONS
VFD 18/58,12/0,30/1RF BIT POSITION 0, CLEAR BIT, *TO=F*
VFD 18/58,12/1,30/1RT BIT POSITION 0, SET BIT, *TO=T*
VFD 18/56,12/0,30/1RE BIT POSITION 1, CLEAR BIT, *TO=E*
VFD 18/56,12/1,30/1RC BIT POSITION 1, SET BIT, *TO=C*
CON 0 END OF TABLE
TDES SPACE 4,10
** TDES - TABLE OF *TO* ARGUMENT OPTIONS FOR SYOT JOBS.
TDES BSS 0 TABLE OF *TO* ARGUMENT OPTIONS
VFD 18/57,12/0,30/1RF BIT POSITION 0, CLEAR BIT, *TO=F*
VFD 18/57,12/1,30/1RT BIT POSITION 0, SET BIT, *TO=T*
VFD 18/55,12/0,30/1RE BIT POSITION 1, CLEAR BIT, *TO=E*
VFD 18/55,12/1,30/1RC BIT POSITION 1, SET BIT, *TO=C*
CON 0 END OF TABLE
WORKING SPACE 4,10
** WORKING STORAGE.
DS CON 0 *TO* FOR SYSTEM ORIGIN
DT CON 0 *TO* FOR NON-SYSTEM ORIGIN
FM CON 0 FAMILY NAME
PPC CON 0 PP CHECK FLAG FET ADDRESS
PPS CON 0 PP ERROR FLAG
SSI CON 0 SUBSYSTEM ID
TM CON 0 *TMSON* FLAG
TMSOFF SPACE 4,10
** TMSOFF - MAIN PROGRAM.
TMSOFF SB1 1 ENTRY
SX6 B0 CLEAR *DEFTO* AND *DEFTOS* ARGUMENTS
SA6 TARGN
RJ PRS PRESET PROGRAM
SA1 FM
ZR X1,END IF NO FAMILY CATALOGS TO DELETE
SX6 X1-1
ZR X6,TMF1 IF DELETE ALL FAMILY CATALOGS
MX0 42 FIND FAMILY IN TABLE
SA5 MXF
SRCHTAB X1,FBUF,0,1,X5
RJ DCF DELETE FAMILY CATALOG
ZR X3,END IF CATALOG DELETED
SX3 X3-2
SX5 DFFN *FAMILY NOT FOUND.*
ZR X3,ABT IF FAMILY NOT FOUND
SX5 B0
EQ ABT ABORT PROGRAM
TMF1 SA5 MXF GET CATALOG SYSTEM BLOCKS
TMF2 SX5 X5-1
NG X5,END IF END OF FAMILIES
MX0 42 GET FAMILY NAME
SA1 X5+FBUF
RJ DCF DELETE FAMILY CATALOG FILE
EQ TMF2 CHECK NEXT FAMILY
TMSON SPACE 4,10
** TMSON - MAIN ROUTINE.
TMSON SB1 1 ENTRY
SX6 B1 FLAG *TMSON*
SA6 TM
RJ PRS PRESET PROGRAM
SA1 FM
ZR X1,TMN3 IF NO FAMILY CATALOGS TO INITIALIZE
SX6 X1-1
ZR X6,TMN1 IF INITIALIZE ALL FAMILY CATALOGS
MX0 42 FIND FAMILY IN TABLE
SA5 MXF
SRCHTAB X1,FBUF,0,1,X5
RJ ICF INITIALIZE FAMILY CATALOG FILE
ZR X3,TMN3 IF CATALOG INITIALIZED
SX1 X3-2
SX5 DFFN *FAMILY NOT FOUND.*
ZR X3,ABT IF FAMILY NOT FOUND
SX5 B0
EQ ABT ABORT PROGRAM
TMN1 SA5 MXF GET CATALOG SYSTEM BLOCKS
TMN2 SX5 X5-1
NG X5,TMN3 IF END OF FAMILIES
MX0 42 GET FAMILY NAME
SA1 X5+FBUF
RJ ICF INITIALIZE FAMILY CATALOG FILE
EQ TMN2 CHECK NEXT FAMILY
TMN3 SA1 SSI CHECK SUBSYSTEM ID
SX1 X1-MTSI
NZ X1,END IF NOT *MAGNET* SUBSYSTEM
MX6 1 SET *TMS* SYSTEM STATUS BITS
SA1 TMS
BX6 X6+X1
SA6 TMS
SYSTEM TFU,R,TMS,/TFU/STSF*100B CALL *TFU*
EQ END TERMINATE PROGRAM
ABT SPACE 4,15
** ABT - ABORT PROGRAM.
*
* ENTRY (X5) = ADDRESS OF DAYFILE MESSAGE.
*
* EXIT MESSAGE ISSUED TO USER AND SYSTEM DAYFILES.
* PROGRAM ABORTED.
*
* USES X - 1, 2.
* A - 1, 2.
*
* CALLS SWP.
*
* MACROS ABORT, MESSAGE, RETURN.
ABT BSS 0 ENTRY
MBSATA (=3),P,18,17,17 SET FET COMPLETION BIT
RETURN P,R RETURN CATALOG FILE
SA1 OFM GET ORIGINAL FAMILY NAME/USER INDEX
SA2 OUI
RJ SWP SWAP TO FAMILY NAME/USER INDEX
ZR X5,ABT1 IF NO DAYFILE MESSAGE
MESSAGE X5,0,R ISSUE DAYFILE MESSAGE
ABT1 ABORT ABORT PROGRAM
DCF SPACE 4,20
** DCF - DELETE FAMILY CATALOG FILE.
*
* ENTRY (X1) = FAMILY NAME.
*
* EXIT (X3) = 0 IF FILE IS DELETED.
* = 1 IF FILE CANNOT BE DELETED.
* = 2 IF FAMILY NOT FOUND.
* MESSAGE *DFUF* ISSUED TO DAYFILE IF (X3) = 1.
*
* USES X - 0, 1, 2, 6, 7.
* A - 1, 3, 6, 7.
* B - 2, 3, 5.
*
* CALLS SWP.
*
* MACROS ATTACH, DFAT, MBSATA, MBSXTA, RETURN, SETFET.
DCF2 RETURN P,R RETURN FILE
SA3 DCFB GET STATUS
DCF SUBR ENTRY/EXIT
MX0 42 SAVE FAMILY NAME
BX6 X0*X1
SA6 DCFA
SX3 B1+B1
ZR X6,DCFX IF NO FAMILY NAME
SX2 377777B
RJ SWP SWAP TO FAMILY NAME AND USER INDEX
SX3 B1+B1
NZ X4,DCFX IF FAMILY NOT FOUND
SX6 B0 PRESET FILE STATUS
SA6 DCFB
MBSATA ZEROES,P,16,17,17 CLEAR ERROR CODE
SETFET P,(DTY=B0),(ERA=ACFB)
ATTACH P,,,,W,,,IP,FA ATTACH SYSTEM FILE
MX0 -8 CHECK ERROR CODE
SA1 P
AX1 10
BX1 -X0*X1
NZ X1,DCF1 IF ERROR IN ACCESS
SX6 B0 CLEAR PP ERROR FLAG
SA6 PPS
SX6 P SET PP CHECK FLAG
SA6 PPC
SX1 B1 SET IGNORE FAMILY ACTIVITY
MBSXTA X1,P,1,0,9
DFAT P DELETE FAST-ATTACHED STATUS
SA3 PPS
NZ X3,DCF1 IF UNABLE TO DELETE FILE
EQ DCF2 RETURN FILE
DCF1 SX6 B1 FLAG UNABLE TO DELETE FILE
SA6 DCFB
SA1 DCFA SET FAMILY NAME IN MESSAGE
SB2 1R#
SB3 DCFC
SB5 -DFUF
RJ SNM SET NAME IN MESSAGE
MESSAGE DCFC,0,R *UNABLE TO TURN OFF *TMS* CATALOG*
EQ DCF2 RETURN FILE
DCFA BSS 1 FAMILY NAME
DCFB CON 0 FILE STATUS
DCFC DATA C$ UNABLE TO TURN OFF *TMS* CATALOG FOR #######.$
END SPACE 4,10
** END - TERMINATE PROGRAM.
*
* EXIT PROGRAM TERMINATED.
*
* USES X - 1, 2.
* A - 1, 2.
*
* CALLS SWP.
*
* MACROS ENDRUN, RETURN.
END BSS 0 ENTRY
RETURN P,R RETURN CATALOG FILE
SA1 OFM GET ORIGINAL FAMILY NAME/USER INDEX
SA2 OUI
RJ SWP SWAP TO FAMILY NAME/USER INDEX
ENDRUN TERMINATE PROGRAM
ICF SPACE 4,20
** ICF - INITIALIZE FAMILY CATALOG FILE.
*
* ENTRY (X1) = FAMILY NAME.
*
* EXIT (X3) = 0 IF FILE IS INITIALIZED.
* = 1 IF FILE CANNOT BE INITIALIZED.
* = 2 IF FAMILY NOT FOUND.
* MESSAGE *DFUN* ISSUED IF (X3) = 1.
*
* USES X - 0, 1, 2, 6, 7.
* A - 1, 3, 6, 7.
* B - 2, 3, 5.
*
* CALLS SWP.
*
* MACROS ATTACH, DFAT, ENFA, MBSATA, RETURN, SETFET, SYSTEM.
ICF4 RETURN P,R RETURN FILE
SA3 ICFB GET STATUS
ICF SUBR ENTRY/EXIT
MX0 42 SAVE FAMILY NAME
BX6 X0*X1
SA6 ICFA
SX3 B1+B1
ZR X6,ICFX IF NO FAMILY NAME
SX2 377777B
RJ SWP SWAP TO FAMILY NAME AND USER INDEX
SX3 B1+B1
NZ X4,ICFX IF FAMILY NOT FOUND
ICF0.1 BSS 0
SX6 B0 PRESET FILE STATUS
SA6 ICFB
SX6 ICFC SET *TFM* ERROR MESSAGE ADDRESS
SA6 TF+/TFM/TFEA
MBSATA ZEROES,P,16,17,17 CLEAR ERROR CODE
SETFET P,(DTY=B0),(ERA=ACFB)
ATTACH P,,,,W,,,IP,NF ATTACH SYSTEM FILE
MX0 -8 CHECK ERROR CODE
SA1 P
AX1 10
BX1 -X0*X1
ZR X1,ICF0.2 IF NO ERROR
SX0 X1-/ERRMSG/PFA
NZ X0,ICF1 IF NOT UTILITY ACTIVE
ROLLOUT =10 WAIT 10 SECONDS
EQ ICF0.1 RETRY ATTACH
ICF0.2 BSS 0
SX1 /TFM/ISFS*10B+4 SET *TFM* SUBFUNCTION
MBSXTA X1,TF,9,8,8
SX7 10000B SET INITIALIZE VSNS
SA7 TF+/TFM/TFES
SX6 B0 CLEAR PP ERROR FLAG
SA6 PPS
SX6 TF SET PP CHECK FLAG
SA6 PPC
SYSTEM TFM,R,TF,/TFM/SSJF*100B CALL *TFM* TO INTIALIZE FILE
SA3 PPS
NZ X3,ICF3 IF ERROR FROM *TFM*
MX0 -9 CHECK *TFM* ERROR CODE
SA1 TF
AX1 9
BX1 -X0*X1
NZ X1,ICF3 IF ERROR FROM *TFM*
SX6 B0 CLEAR PP ERROR FLAG
SA6 PPS
SX6 P SET PP CHECK FLAG
SA6 PPC
ENFA P,GLOBAL ENTER GLOBAL FAST ATTACH FILE
SA3 PPS
NZ X3,ICF3 IF UNABLE TO ENTER FAST ATTACH FILE
EQ ICF4 RETURN FILE
ICF1 SX1 X1-/ERRMSG/FBS
NZ X1,ICF3 IF NOT *FILE BUSY*
ATTACH P,,,,W,,,IP,FA ATTEMPT FAST ATTACH
MX0 -8 CHECK ERROR CODE
SA1 P
AX1 10
BX1 -X0*X1
ZR X1,ICF4 IF ALREADY FAST ATTACHED ON THIS MACHINE
SX6 B0 CLEAR PP ERROR FLAG
SA6 PPS
SX6 P SET PP CHECK FLAG
SA6 PPC
ENFA P,LINK LINK TO EXISTING FAST ATTACH
SA3 PPS
NZ X3,ICF3 IF UNABLE TO ENTER FAST ATTACH FILE
ATTACH P,,,,W,,,IP,FA ATTACH FILE
MX0 -8 CHECK ERROR CODE
SA1 P
AX1 10
BX1 -X0*X1
NZ X1,ICF3 IF ERROR IN ACCESS
SX1 /TFM/ISFS*10B SET FUNCTION CODE
MBSXTA X1,TF,9,8,8
SX7 20000B SET TO CLEAR CURRENT AND DOWN MACHINES
SA7 TF+/TFM/TFES
SX6 B0 CLEAR PP ERROR FLAG
SA6 PPS
SX6 TF SET PP CHECK FLAG
SA6 PPC
SYSTEM TFM,R,TF,/TFM/SSJF*100B CLEAN UP CATALOG
SA3 PPS
NZ X3,ICF2 IF ERROR FROM *TFM*
MX0 -9 CHECK *TFM* ERROR CODE
SA1 TF
AX1 9
BX1 -X0*X1
ZR X1,ICF4 IF NO ERROR FROM *TFM*
ICF2 SX6 P SET PP CHECK FLAG
SA6 PPC
DFAT P DELETE FAST ATTACH CATALOG FILE
ICF3 SX6 B1 FLAG UNABLE TO ATTACH FILE
SA6 ICFB
SA1 ICFA SET FAMILY NAME IN MESSAGE
SB2 1R#
SB3 ICFD
SB5 -DFUN
RJ SNM SET NAME IN MESSAGE
MESSAGE ICFD,0,R *UNABLE TO TURN ON *TMS* CATALOG*
EQ ICF4 RETURN FILE
ICFA BSS 1 FAMILY NAME
ICFB CON 0 FILE STATUS
ICFC BSS 4 *TFM* ERROR MESSAGE BUFFER
ICFD DATA C$ UNABLE TO TURN ON *TMS* CATALOG FOR #######.$
PRS SPACE 4,10
** PRS - PRESET PROGRAM.
PRS SUBR ENTRY/EXIT
MX0 1 SET THE REAL-TIME BIT IN TAPE CATALOG FET
SA1 P+1
LX0 43-59+60
BX6 X0+X1
SA6 A1
GETPFP GP GET FAMILY NAME, USER NAME, AND USER INDEX
MX0 42 SAVE ORIGINAL FAMILY NAME
SA1 GP+0
BX6 X0*X1
SA6 OFM
SA1 GP+2 SAVE ORIGINAL USER INDEX
BX6 -X0*X1
SA6 OUI
SA1 TF SET FILE NAME
BX6 X1
SA6 P
MX0 -12 CHECK ORIGIN TYPE
SA1 JOPR
AX1 24
BX6 -X0*X1
SX6 X6-SYOT
SX5 DFIC *INCORRECT COMMAND.*
NZ X6,ABT IF NOT SYSTEM ORIGIN
SYSTEM SFM,R,TMS,GTSF*100B GET *TMS* STATUS
GETSSID SSI GET SUBSYSTEM ID
SA1 SSI CHECK FOR MAGNET SUBSYSTEM
SX1 X1-MTSI
ZR X1,PRS1 IF *MAGNET* SUBSYSTEM
SA1 TM
ZR X1,PRS1 IF *TMSOFF*
SA1 TMS CHECK IF *TMS* IS ENABLED
SX5 DFIC *INCORRECT COMMAND.*
PL X1,ABT IF *TMS* IS DISABLED
SX6 B0 CLEAR *DEFTO* AND *DEFTOS* ARGUMENTS
SA6 TARGN
PRS1 SA1 ACTR GET ARGUMENT COUNT
SB4 X1
ZR B4,PRS5 IF NO ARGUMENTS
SA4 ARGR GET FIRST ARGUMENT
SB5 TARG
RJ ARG PROCESS ARGUMENTS
ZR X1,PRS2 IF VALID ARGUMENTS
MX0 42 SET INCORRECT PARAMETER IN MESSAGE
BX1 X0*X4
SB2 1R$
SB3 DFUP
SB5 -B3
RJ SNM SET NAME IN MESSAGE
SX5 DFUP *UNKNOWN PARAMETER - PPPPPPP.*
EQ ABT ABORT PROGRAM
PRS2 SX6 B0 RESET *DEFTO* AND *DEFTOS* ARGUEMENTS
SA6 TMS
MX0 42 CHECK *DEFTO*
SA1 DT
ZR X1,PRS3 IF *DEFTO* NOT SPECIFIED
SB2 DT
RJ USB UNPACK STRING BUFFER
SX6 B0 FLAG LAST OPTION
SA6 B7+B1
SA1 B6 GET FIRST COMMAND OPTION
MX0 -12
SA3 TMS GET DEFAULT OPTIONS
BX7 X3
PRS2.1 ZR X1,PRS2.4 IF NO MORE OPTIONS
SA2 TDEF GET FIRST OPTION IN TABLE
PRS2.2 ZR X2,PRS2.5 IF UNKNOWN OPTION
BX6 -X0*X2
BX6 X6-X1
ZR X6,PRS2.3 IF OPTIONS MATCH
SA2 A2+B1
EQ PRS2.2 CHECK NEXT OPTION IN TABLE
PRS2.3 LX2 18 GET SHIFT COUNT
SB2 X2
LX2 12 GET SET/CLEAR STATUS
BX2 -X0*X2
SX6 B1
LX2 B2 SET/CLEAR DEFAULT OPTION
LX6 B2
BX7 -X6*X7
BX7 X7+X2
SA1 A1+B1
EQ PRS2.1 CHECK NEXT OPTION ON COMMAND
PRS2.4 SA7 A3 SET DEFAULT TAPE OPTION
EQ PRS3 CHECK *DEFTOS*
PRS2.5 SA1 =0LDEFTO GET PARAMETER IMAGE
BX7 X1
SA1 DT
EQ PRS4 ISSUE ERROR MESSAGE
PRS3 MX0 42 CHECK *DEFTOS*
SA1 DS
ZR X1,PRS5 IF *DEFTOS* NOT SPECIFIED
SB2 DS
RJ USB UNPACK STRING BUFFER
SX6 B0 FLAG LAST OPTION
SA6 B7+B1
SA1 B6 GET FIRST COMMAND OPTION
MX0 -12
SA3 TMS GET DEFAULT OPTIONS
BX7 X3
PRS3.1 ZR X1,PRS3.4 IF NO MORE OPTIONS
SA2 TDES GET FIRST OPTION IN TABLE
PRS3.2 ZR X2,PRS3.5 IF UNKNOWN OPTION
BX6 -X0*X2
BX6 X6-X1
ZR X6,PRS3.3 IF OPTIONS MATCH
SA2 A2+B1
EQ PRS3.2 CHECK NEXT OPTION IN TABLE
PRS3.3 LX2 18 GET SHIFT COUNT
SB2 X2
LX2 12 GET SET/CLEAR STATUS
BX2 -X0*X2
SX6 B1
LX2 B2 SET/CLEAR DEFAULT OPTION
LX6 B2
BX7 -X6*X7
BX7 X7+X2
SA1 A1+B1
EQ PRS3.1 CHECK NEXT OPTION ON COMMAND
PRS3.4 SA7 A3 SET DEFAULT TAPE OPTION
EQ PRS5 CHECK *FM*
PRS3.5 SA1 =0LDEFTOS GET PARAMETER IMAGE
BX7 X1
SA1 DS
PRS4 SA7 PI SAVE PARAMETER IMAGE
SB2 1R$ SET VALUE IMAGE IN MESSAGE
SB3 DFIV
SB5 -B3
RJ SNM SET NAME IN MESSAGE
SA1 PI SET PARAMETER IMAGE IN MESSAGE
SB2 1R#
SB3 DFIV
SB5 -B3
RJ SNM SET NAME IN MESSAGE
SX5 DFIV *INCORRECT VALUE FOR PP PARAMETER - VVVV.*
EQ ABT ABORT PROGRAM
PRS5 SA1 FM CHECK *FM*
SA2 =1L*
BX1 X1-X2
NZ X1,PRS6 IF NOT ALL FAMILIES
SX6 B1 FLAG ALL FAMILIES
SA6 A1
PRS6 RDMEM ABS,FOTP,1,FFO GET FAMILY ORDINAL TABLE ADDRESS
MX0 -24
LX2 24
BX6 -X0*X2
SA6 FFO
MX0 -12 GET MAXIMUM FOT ENTRIES
LX2 12
BX7 -X0*X2
SA7 MXF
RDMEM ABS,X6,X7,FBUF GET FAMILY ORDINAL TABLE
REPRIEVE RPVA,SET,237B SET EXTENDED REPRIEVE
EQ PRSX RETURN
RPV SPACE 4,15
** RPV - REPRIEVE PROCESSOR.
*
* ENTRY (PPC) = 0 IF ABORT ON PP ERROR.
* = FET ADDRESS IF DO NOT ABORT ON PP ERROR.
*
* EXIT (PPC) = 0.
* (PPS) .NE. IF PP ERROR.
* COMPLETION BIT SET IN PP ERROR FET.
*
* USES X - 0, 1, 5, 6.
* A - 1, 6.
*
* CALLS ABT.
*
* MACROS REPRIEVE.
RPV BSS 0 ENTRY/EXIT
MX0 -12 CHECK ERROR FLAG
SA1 RPVA+/COMSRPV/OSEF
BX1 -X0*X1
SX1 X1-PPET
SX5 B0
NZ X1,ABT IF NOT PP CALL ERROR
SA1 PPC
ZR X1,ABT IF NOT PP CHECK
SX6 B0 CLEAR PP CHECK FLAG
SA6 A1
SX6 B1 SET PP ERROR FLAG
SA6 PPS
MX0 42 SET COMPLETION BIT IN FET
SA1 X1
BX1 X0*X1
SX6 3
BX6 X1+X6
SA6 A1
REPRIEVE RPVA,RESUME,237B RESUME PROGRAM EXECUTION
RPVA RPVBLK RPV REPRIEVE BLOCK
SPACE 4,10
QUAL *
TMSOFF EQU /TMSON/TMSOFF *TMSOFF* ENTRY POINT
TMSON EQU /TMSON/TMSON *TMSON* ENTRY POINT
TITLE FIELD LENGTH DEFINITIONS.
RFL SPACE 4,10
** FIELD LENTH DEFINITION.
RFL IFGT BUFF+BUFFL,*
RFL= EQU BUFF+BUFFL PROGRAM FIELD LENGTH
RFL ELSE
RFL= EQU * PROGRAM FIELD LENGTH
RFL ENDIF
SPACE 4
END