cdc:nos2.source:opl.opl871:deck:sslabel
Deck SSLABEL
1 Modification
Listing Sections
- Deck SSLABEL Start
- Deck SSLABEL Part 1 (Line 2138)
- Deck SSLABEL Part 2 (Line 4385)
- Deck SSLABEL Part 3 (Line 6626)
Source
Seq # *Modification Id* Act ----------------------------+ 00001 M01S00001.sslabel +++|PRGM SSLABEL; 00002 M01S00002.sslabel +++|# TITLE SSLABEL - INITIALIZES *SSLABEL*. # 00003 M01S00003.sslabel +++| 00004 M01S00004.sslabel +++| BEGIN # SSLABEL # 00005 M01S00005.sslabel +++| 00006 M01S00006.sslabel +++|# 00007 M01S00007.sslabel +++|*** SSLABEL - INITIALIZES *SSLABEL*. 00008 M01S00008.sslabel +++|* 00009 M01S00009.sslabel +++|* THIS PROCEDURE INITIALIZES *SSLABEL* BY 00010 M01S00010.sslabel +++|* CRACKING THE CONTROL CARD AND SETTING 00011 M01S00011.sslabel +++|* UP POINTERS AND DEFAULT VALUES. 00012 M01S00012.sslabel +++|* 00013 M01S00013.sslabel +++|* SSLABEL,I,L. 00014 M01S00014.sslabel +++|* 00015 M01S00015.sslabel +++|* PRGM SSLABEL. 00016 M01S00016.sslabel +++|* 00017 M01S00017.sslabel +++|* ENTRY. INPUTS TO SSLABEL ARE- 00018 M01S00018.sslabel +++|* I SOURCE OF DIRECTIVES IS ON FILE 00019 M01S00019.sslabel +++|* *INPUT*. 00020 M01S00020.sslabel +++|* I = LFN SOURCE OF DIRECTIVES IS ON FILE 00021 M01S00021.sslabel +++|* *LFN*. 00022 M01S00022.sslabel +++|* I OMITTED SAME AS *I*. 00023 M01S00023.sslabel +++|* *INPUT*. 00024 M01S00024.sslabel +++|* L LISTABLE OUTPUT ON FILE *OUTPUT*. 00025 M01S00025.sslabel +++|* L = LFN LISTABLE OUTPUT ON FILE *LFN*. 00026 M01S00026.sslabel +++|* L = 0 NO OUTPUT FILE GENERATED. 00027 M01S00027.sslabel +++|* L OMITTED SAME AS *L*. 00028 M01S00028.sslabel +++|* 00029 M01S00029.sslabel +++|* Z SOURCE OF DIRECTIVES IS ON THE 00030 M01S00030.sslabel +++|* CONTROL CARD. 00031 M01S00031.sslabel +++|* 00032 M01S00032.sslabel +++|* *SSLABEL* DIRECTIVE OPTIONS ARE- 00033 M01S00033.sslabel +++|* OP NOT PERMITTED. 00034 M01S00034.sslabel +++|* OP = XX WHERE XX IS THE DIRECTIVE TO BE PROCESSED. 00035 M01S00035.sslabel +++|* XX MAY BE ANY ONE OF THE FOLLOWING. 00036 M01S00036.sslabel +++|* *AM*--ADD A CARTRIDGE (*ADDMSC*). 00037 M01S00037.sslabel +++|* *RM*--REMOVE A CARTRIDGE (*RMVMSC*). 00038 M01S00038.sslabel +++|* *RS*--RESTORE A CARTRIDGE (*RSTRMSC*). 00039 M01S00039.sslabel +++|* *FX*--REPAIR A LABEL (*FIXVSN*). 00040 M01S00040.sslabel +++|* *IB*--SET OR CLEAR *FCT INHIBIT FLAG* 00041 M01S00041.sslabel +++|* (*FLAGMSC*). 00042 M01S00042.sslabel +++|* *FC*--SET OR CLEAR *FREE CARTRIDGE FLAG* 00043 M01S00043.sslabel +++|* (*FLAGFC*) IN FCT. 00044 M01S00044.sslabel +++|* *AS*--ADD A *SM* TO A SUBFAMILY 00045 M01S00045.sslabel +++|* (*ADDCSU*). 00046 M01S00046.sslabel +++|* *RS*--REMOVE A SM FROM A SUBFAMILY 00047 M01S00047.sslabel +++|* (*RMVCSU*). 00048 M01S00048.sslabel +++|* *AB*--ADD A CUBE TO A SUBFAMILY 00049 M01S00049.sslabel +++|* (*ADDCUBE*). 00050 M01S00050.sslabel +++|* *RB*--REMOVE AN EMPTY CUBE FROM A SUBFAMILY 00051 M01S00051.sslabel +++|* (*RMVCUBE*). 00052 M01S00052.sslabel +++|* OP OMITTED NOT PERMITTED. 00053 M01S00053.sslabel +++|* 00054 M01S00054.sslabel +++|* N NUMBER OF CARTRIDGES OR CUBES = 1. 00055 M01S00055.sslabel +++|* N = X NUMBER OF CARTRIDGES OR CUBES = X. 00056 M01S00056.sslabel +++|* X MAY RANGE FROM 1 TO 100. 00057 M01S00057.sslabel +++|* N OMITTED SAME AS *N*. 00058 M01S00058.sslabel +++|* *NOTE* - *N* MUST BE 1 IF THE *CSN* 00059 M01S00059.sslabel +++|* OPTION IS SPECIFIED. 00060 M01S00060.sslabel +++|* 00061 M01S00061.sslabel +++|* B SAME AS *B* = 600. 00062 M01S00062.sslabel +++|* B = N NUMBER OF AU'S (N) USED FOR SMALL FILES. 00063 M01S00063.sslabel +++|* 1931 - N AU'S REMAIN FOR LARGE FILES. 00064 M01S00064.sslabel +++|* B OMITTED SAME AS *B*. 00065 M01S00065.sslabel +++|* 00066 M01S00066.sslabel +++|* CM CARTRIDGE MANUFACTURER CODE IS *A* INDICATI 00067 M01S00067.sslabel +++|* *IBM*. 00068 M01S00068.sslabel +++|* CM = A CARTRIDGE MANUFACTURER CODE IS *A* INDICATI 00069 M01S00069.sslabel +++|* *IBM*. 00070 M01S00070.sslabel +++|* CM = ANYTHING ELSE IS CURRENTLY ILLEGAL. 00071 M01S00071.sslabel +++|* CM OMMITTED CARTRIDGE MANUFACTURER CODE IS *A*. 00072 M01S00072.sslabel +++|* 00073 M01S00073.sslabel +++|* CN CARTRIDGE SERIAL NUMBER OF CARTRIDGE IS 00074 M01S00074.sslabel +++|* NOT SPECIFIED. 00075 M01S00075.sslabel +++|* CN = CSN SERIAL NUMBER OF CARTRIDGE IS 00076 M01S00076.sslabel +++|* *CSN*. 00077 M01S00077.sslabel +++|* C OMITTED SAME AS *C*. 00078 M01S00078.sslabel +++|* *NOTE* - *CSN* MUST BE SPECIFIED WITH 00079 M01S00079.sslabel +++|* *RMVMSC LOST(LS)* OPTION. 00080 M01S00080.sslabel +++|* *CSN* MAY NOT BE SPECIFIED WHEN ANY *PK* 00081 M01S00081.sslabel +++|* OPTION IS USED. 00082 M01S00082.sslabel +++|* *NOTE* - PK IS SET TO 0 00083 M01S00083.sslabel +++|* WHENEVER CSN IS SPECIFIED. 00084 M01S00084.sslabel +++|* *N* MUST BE 1 IF THE *C* = CSN 00085 M01S00085.sslabel +++|* OPTION IS SPECIFIED. 00086 M01S00086.sslabel +++|* *CSN* MAY NOT BE SPECIFIED WITH 00087 M01S00087.sslabel +++|* *OP* = *ADDCSU* (AC) 00088 M01S00088.sslabel +++|* *OP* = *RMVCSU* (RC) 00089 M01S00089.sslabel +++|* *OP* = *ADDCUBE* (AB) 00090 M01S00090.sslabel +++|* *OP* = *RMVCUBE* (RB) 00091 M01S00091.sslabel +++|* 00092 M01S00092.sslabel +++|* 00093 M01S00093.sslabel +++|* GR CHOOSE DEFAULT GROUP. 00094 M01S00094.sslabel +++|* GR = N GROUP TO WHICH CARTRIDGE IS ADDED/REMOVED. 00095 M01S00095.sslabel +++|* INVALID IF *PT* = P IS SPECIFIED WITH 00096 M01S00096.sslabel +++|* *OP* = *AM*. N MUST BE O TO 127. 00097 M01S00097.sslabel +++|* GR OMITTED SAME AS *GR*. 00098 M01S00098.sslabel +++|* 00099 M01S00099.sslabel +++|* PK SAME AS *PK* = P. 00100 M01S00100.sslabel +++|* PK = D CARTRIDGE IS TO BE PICKED FROM INPUT 00101 M01S00101.sslabel +++|* DRAWER SLOT. 00102 M01S00102.sslabel +++|* PK = P CARTRIDGE OR CUBE IS PICKED FROM POOL. 00103 M01S00103.sslabel +++|* PK = F CARTRIDGE OR CUBE IS PICKED FROM THE 00104 M01S00104.sslabel +++|* SPECIFIED FAMILY (SEE *FM* OPTION) AND 00105 M01S00105.sslabel +++|* SUBFAMILY (SEE *SB* OPTION) AND GROUP 00106 M01S00106.sslabel +++|* (SEE *GR* OPTION). 00107 M01S00107.sslabel +++|* PK OMITTED SAME AS *PK*. 00108 M01S00108.sslabel +++|* *NOTE* - VALID USES OF *PK* 00109 M01S00109.sslabel +++|* OP=AM - PK=D OR PK=P 00110 M01S00110.sslabel +++|* OP=RM - PK=P OR PK=F 00111 M01S00111.sslabel +++|* OP=RB - PK=P OR PK=F OR PK=R 00112 M01S00112.sslabel +++|* NONE OF THE *PK* OPTION MAY BE 00113 M01S00113.sslabel +++|* USED IF *C* = CSN OPTION IS 00114 M01S00114.sslabel +++|* SPECIFIED. 00115 M01S00115.sslabel +++|* PK=D OR F IF PT=P. 00116 M01S00116.sslabel +++|* 00117 M01S00117.sslabel +++|* PT SAME AS *PT* = P. 00118 M01S00118.sslabel +++|* PT = D CARTRIDGE IS TO BE PLACED IN THE 00119 M01S00119.sslabel +++|* DRAWER. 00120 M01S00120.sslabel +++|* PT = P CARTRIDGE OR CUBE IS PUT IN THE POOL. 00121 M01S00121.sslabel +++|* PT = F CARTRIDGE OR CUBE IS PUT IN THE SPECIFIED 00122 M01S00122.sslabel +++|* FAMILY (SEE *FM* OPTION) AND SUBFAMILY 00123 M01S00123.sslabel +++|* (SEE *SB* OPTION). 00124 M01S00124.sslabel +++|* PT = R CUBE IS PUT INTO THE *RESERVED FOR 00125 M01S00125.sslabel +++|* ALTERNATE SMMAP* AREA OF THE SMMAP. 00126 M01S00126.sslabel +++|* PT OMITTED SAME AS *PT*. 00127 M01S00127.sslabel +++|* *NOTE* - VALID USES OF *PT* 00128 M01S00128.sslabel +++|* OP=AM - PT=P OR PT=F 00129 M01S00129.sslabel +++|* HOWEVER, WITH OP=AM AND THE CSN 00130 M01S00130.sslabel +++|* SPECIFIED, *PT* CANNOT BE EQUAL 00131 M01S00131.sslabel +++|* TO *P*. 00132 M01S00132.sslabel +++|* OP=RM - PT=D OR PT=P 00133 M01S00133.sslabel +++|* OP=AB - PT=P OR PT=F OR PT=R 00134 M01S00134.sslabel +++|* 00135 M01S00135.sslabel +++|* LT CARTRIDGE IS LOST AND EXISTS ONLY IN THE 00136 M01S00136.sslabel +++|* CATALOG. ITS CATALOG ENTRY IS TO BE 00137 M01S00137.sslabel +++|* REMOVED. 00138 M01S00138.sslabel +++|* LT OMITTED NO ACTION. 00139 M01S00139.sslabel +++|* *NOTE* - *LT* IS VALID ONLY WITH OP=RM 00140 M01S00140.sslabel +++|* (*RMVMSC*). 00141 M01S00141.sslabel +++|* 00142 M01S00142.sslabel +++|* SM USE *SM* *A*. 00143 M01S00143.sslabel +++|* SM = N USE *SM* N WHERE N IS ONE OF THE 00144 M01S00144.sslabel +++|* FOLLOWING 00145 M01S00145.sslabel +++|* A - SM A 00146 M01S00146.sslabel +++|* B - SM B 00147 M01S00147.sslabel +++|* C - SM C 00148 M01S00148.sslabel +++|* D - SM D 00149 M01S00149.sslabel +++|* E - SM E 00150 M01S00150.sslabel +++|* F - SM F 00151 M01S00151.sslabel +++|* G - SM G 00152 M01S00152.sslabel +++|* H - SM H 00153 M01S00153.sslabel +++|* SM OMITTED SAME AS *SM*. 00154 M01S00154.sslabel +++|* 00155 M01S00155.sslabel +++|* ON TURN ON A FLAG. 00156 M01S00156.sslabel +++|* 00157 M01S00157.sslabel +++|* OF TURN OFF A FLAG. 00158 M01S00158.sslabel +++|* 00159 M01S00159.sslabel +++|* YI INVALID. 00160 M01S00160.sslabel +++|* YF INVALID. 00161 M01S00161.sslabel +++|* ZI INVALID. 00162 M01S00162.sslabel +++|* ZF INVALID. 00163 M01S00163.sslabel +++|* YI = I ROW I IS SELECTED FOR THE *ADDCUBE* 00164 M01S00164.sslabel +++|* OR *RMVCUBE* DIRECTIVE. I IS FROM 0 TO 21. 00165 M01S00165.sslabel +++|* ZI = J COLUMNN J IS SELECTED FOR THE *ADDCUBE* OR 00166 M01S00166.sslabel +++|* *RMVCUBE* DIRECTIVE. J IS FROM 0 TO 15. 00167 M01S00167.sslabel +++|* YI=I,ZI=J LOCATION (I,J) IS SELECTED FOR THE 00168 M01S00168.sslabel +++|* *ADDCUBE* OR *RMVCUBE* DIRECTIVE. 00169 M01S00169.sslabel +++|* YI=I,ZI=J, A RECTANGLE OF CELLS BOUNDED BY (I,J), 00170 M01S00170.sslabel +++|* YF=K,ZF=L (I,L), (K,J) AND (K,L) ARE SELECTED FOR 00171 M01S00171.sslabel +++|* THE *ADDCUBE* OR *RMVCUBE* DIRECTIVE. 00172 M01S00172.sslabel +++|* *NOTE* - YF=K AND ZF=L MUST BOTH BE 00173 M01S00173.sslabel +++|* SPECIFIED IF EITHER IS SPECIFIED. 00174 M01S00174.sslabel +++|* YF=K AND ZF=L CANNOT BE SPECIFIED UNLESS 00175 M01S00175.sslabel +++|* BOTH YI=I AND ZI=J ARE SPECIFIED. 00176 M01S00176.sslabel +++|* K MUST BE GREATER THAN I AND L MUST BE 00177 M01S00177.sslabel +++|* GREATER THAN J. 00178 M01S00178.sslabel +++|* YI=I AND YF=K MUST BE LESS THAN OR EQUAL 00179 M01S00179.sslabel +++|* TO 21. 00180 M01S00180.sslabel +++|* ZI=J AND ZF=L MUST BE LESS THAN OR EQUAL 00181 M01S00181.sslabel +++|* TO 15. 00182 M01S00182.sslabel +++|* THE FOLLOWING LOCATIONS ARE RESERVED: 00183 M01S00183.sslabel +++|* (0,0),((Y,6),Y=0,21),(0,15),(11,15), 00184 M01S00184.sslabel +++|* (21,15),((Y,Z),Y=11,15,Z=0,1),(0,1), 00185 M01S00185.sslabel +++|* (0,14),(21,0),AND (21,14). 00186 M01S00186.sslabel +++|* YI AND ZI *ADDCUBE* WILL SELECT THE NEXT AVAILABLE 00187 M01S00187.sslabel +++|* OMITTED CUBE CLOSEST TO THE TOP OF THE *SM* FOR 00188 M01S00188.sslabel +++|* ASSIGNMENTS TO A FAMILY OR THE FARTHEST 00189 M01S00189.sslabel +++|* CUBE FOR ASSIGNMENT TO THE POOL. 00190 M01S00190.sslabel +++|* *RMVCUBE* WILL SELECT THE FIRST UNASSIG- 00191 M01S00191.sslabel +++|* NED CUBE FROM THE *AST* FOR A FAMILY. 00192 M01S00192.sslabel +++|* 00193 M01S00193.sslabel +++|* FM USE DEFAULT FAMILY. 00194 M01S00194.sslabel +++|* FM = FAMILY SELECT SPECIFIED FAMILY. 00195 M01S00195.sslabel +++|* FM OMITTED SAME AS *FM*. 00196 M01S00196.sslabel +++|* 00197 M01S00197.sslabel +++|* SB SELECT SUB-FAMILY 0. 00198 M01S00198.sslabel +++|* SB = SUB SELECT SUB-FAMILY SUB. 00199 M01S00199.sslabel +++|* SB OMITTED SAME AS *SB*. 00200 M01S00200.sslabel +++|* *NOTE* - SUB MUST BE BETWEEN 0 AND 7. 00201 M01S00201.sslabel +++|* 00202 M01S00202.sslabel +++|* EXIT. *SSLABEL* DIRECTIVES PROCESSED OR 00203 M01S00203.sslabel +++|* AN ERROR CONDITION ENCOUNTERED. 00204 M01S00204.sslabel +++|* 00205 M01S00205.sslabel +++|* MESSAGES. 1. SSLABEL COMPLETE. 00206 M01S00206.sslabel +++|* 2. UNABLE TO CONNECT WITH EXEC. 00207 M01S00207.sslabel +++|* 3. SSLABEL - MUST BE SYSTEM ORIGIN. 00208 M01S00208.sslabel +++|* 00209 M01S00209.sslabel +++|* NOTES. PROC *SSLABEL* INITIALIZES *SSLABEL*. 00210 M01S00210.sslabel +++|* *SSLABEL* PROCESSING IS CONTROLLED BY 00211 M01S00211.sslabel +++|* THE USE OF DIRECTIVES. THE DIRECTIVES CAN 00212 M01S00212.sslabel +++|* BE SPECIFIED ON THE CONTROL CARD, ON 00213 M01S00213.sslabel +++|* *INPUT* FILE OR ON 00214 M01S00214.sslabel +++|* AN ALTERNATE FILE. PROC *SSLABEL* 00215 M01S00215.sslabel +++|* CRACKS THE CONTROL CARD AND READS 00216 M01S00216.sslabel +++|* IN THE DIRECTIVES FROM THE FILE 00217 M01S00217.sslabel +++|* SPECIFIED INTO THE CIO BUFFER. PROC 00218 M01S00218.sslabel +++|* *LBLOOP* IS CALLED TO CRACK THE DIREC- 00219 M01S00219.sslabel +++|* TIVES AND TO WRITE THEM ON A TEMPORARY 00220 M01S00220.sslabel +++|* FILE. THE CRACKED PARAMETERS ARE RETUR- 00221 M01S00221.sslabel +++|* NED IN COMMON AREA *ULBPCOM*. ANY ERROR 00222 M01S00222.sslabel +++|* IN THE DIRECTIVE CAUSES *SSLABEL* TO 00223 M01S00223.sslabel +++|* ABORT. PROC *LBERR* DOES ERROR PROCESSING 00224 M01S00224.sslabel +++|* FOR *SSLABEL*. AFTER THE DIRECTIVES ARE 00225 M01S00225.sslabel +++|* CRACKED AND SYNTAX CHECKED A *CONNECT* IS 00226 M01S00226.sslabel +++|* SET WITH EXEC. PROC *LBMAIN* IS CALLED 00227 M01S00227.sslabel +++|* TO PROCESS ALL THE DIRECTIVES. A 00228 M01S00228.sslabel +++|* *DISCONNECT* IS DONE WITH EXEC AFTER ALL 00229 M01S00229.sslabel +++|* THE DIRECTIVES ARE PROCESSED. 00230 M01S00230.sslabel +++|# 00231 M01S00231.sslabel +++| 00232 M01S00232.sslabel +++|# 00233 M01S00233.sslabel +++|**** PROC SSLABEL - XREF LIST BEGIN. 00234 M01S00234.sslabel +++|# 00235 M01S00235.sslabel +++| 00236 M01S00236.sslabel +++| XREF 00237 M01S00237.sslabel +++| BEGIN 00238 M01S00238.sslabel +++| PROC ABORT; # ABORT PROCESSING # 00239 M01S00239.sslabel +++| PROC BZFILL; # BLANK OR ZERO-FILLS A BUFFER # 00240 M01S00240.sslabel +++| PROC CALL1; # SENDS TYPE 1 CALLSS TO EXEC # 00241 M01S00241.sslabel +++| PROC GETFAM; # GETS DEFAULT FAMILY # 00242 M01S00242.sslabel +++| PROC GETPFP; # GET USER INDEX AND FAMILY # 00243 M01S00243.sslabel +++| PROC GETSPS; # GET PRIVILIDGES # 00244 M01S00244.sslabel +++| PROC LBERR; # ERROR PROCESSOR # 00245 M01S00245.sslabel +++| PROC LBHEAD; # WRITES HEADER ON OUTPUT FILE # 00246 M01S00246.sslabel +++| PROC LBLOOP; # CRACK AND SYNTAX CHECK 00247 M01S00247.sslabel +++| DIRECTIVES # 00248 M01S00248.sslabel +++| PROC LBMAIN; # PROCESSES SSLABEL DIRECTIVES # 00249 M01S00249.sslabel +++| PROC LBTAB; # SETS UP THE ARGUMENT LIST # 00250 M01S00250.sslabel +++| PROC MESSAGE; # DISPLAYS MESSAGE IN DAYFILE # 00251 M01S00251.sslabel +++| PROC PDATE; # GETS PACKED DATE AND TIME # 00252 M01S00252.sslabel +++| PROC READ; # READS A FILE # 00253 M01S00253.sslabel +++| PROC RESTPFP; # RESTORE USER-S *PFP* AND ABORT 00254 M01S00254.sslabel +++| OR RETURN # 00255 M01S00255.sslabel +++| PROC RPCLOSE; # CLOSES OUTPUT FILE # 00256 M01S00256.sslabel +++| PROC RPLINE; # WRITES A LINE ON OUTPUT FILE # 00257 M01S00257.sslabel +++| PROC RPOPEN; # OPENS OUTPUT FILE # 00258 M01S00258.sslabel +++| PROC RPSPACE; # WRITES A BLANK LINE # 00259 M01S00259.sslabel +++| PROC VERSION; # GETS OS LEVEL # 00260 M01S00260.sslabel +++| PROC XARG; # CRACK PARAMETER LIST # 00261 M01S00261.sslabel +++| PROC XZAP; # *Z* ARGUMENT PROCESSOR # 00262 M01S00262.sslabel +++| PROC ZSETFET; # SETS UP A FET # 00263 M01S00263.sslabel +++| END 00264 M01S00264.sslabel +++| 00265 M01S00265.sslabel +++|# 00266 M01S00266.sslabel +++|**** PROC SSLABEL - XREF LIST END. 00267 M01S00267.sslabel +++|# 00268 M01S00268.sslabel +++| 00269 M01S00269.sslabel +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS # 00270 M01S00270.sslabel +++| 00271 M01S00271.sslabel +++| CONTROL PRESET; 00272 M01S00272.sslabel +++|*CALL COMBFAS 00273 M01S00273.sslabel +++|*CALL COMBBZF 00274 M01S00274.sslabel +++|*CALL COMBCMD 00275 M01S00275.sslabel +++|*CALL COMBCPR 00276 M01S00276.sslabel +++|*CALL COMBLBL 00277 M01S00277.sslabel +++|*CALL COMBPFP 00278 M01S00278.sslabel +++|*CALL COMBUCR 00279 M01S00279.sslabel +++|*CALL COMSPFM 00280 M01S00280.sslabel +++|*CALL COMTERR 00281 M01S00281.sslabel +++|*CALL COMTFMT 00282 M01S00282.sslabel +++|*CALL COMTLAB 00283 M01S00283.sslabel +++|*CALL COMTLBP 00284 M01S00284.sslabel +++|*CALL COMTOUT 00285 M01S00285.sslabel +++| 00286 M01S00286.sslabel +++| ITEM ARGLIST U; # ADDRESS OF ARGUMENT TABLE # 00287 M01S00287.sslabel +++| ITEM BUFP U; # FWA OF CIO BUFFER # 00288 M01S00288.sslabel +++| ITEM DEFAULT I; # DEFAULT FAMILY ORDINAL # 00289 M01S00289.sslabel +++| ITEM ERRFLAG B; # ERROR FLAG # 00290 M01S00290.sslabel +++| ITEM FAM$NUM I; # NUMBER OF FAMILIES # 00291 M01S00291.sslabel +++| ITEM FETP U; # FWA OF FET # 00292 M01S00292.sslabel +++| ITEM FLAG I; # ERROR FLAG # 00293 M01S00293.sslabel +++| ITEM LFN C(7); # TEMP LOC FOR FILE NAME # 00294 M01S00294.sslabel +++| ITEM LINK I; # LINK FAMILY ORDINAL # 00295 M01S00295.sslabel +++| ITEM OPTION I; # OPTION OF SKIPPING OVER PROGRAM 00296 M01S00296.sslabel +++| NAME IN CONTROL CARD # 00297 M01S00297.sslabel +++| ITEM REQCODE U; # REQUEST CODE # 00298 M01S00298.sslabel +++| ITEM RESP$CODE U; # RESPONSE CODE FROM EXEC # 00299 M01S00299.sslabel +++| 00300 M01S00300.sslabel +++| ARRAY CALL$SS [0:0] P(CPRLEN);; # CALLSS REQUEST BLOCK # 00301 M01S00301.sslabel +++| ARRAY OUT$FET [0:0] S(SFETL);; # FET FOR OUTPUT FILE # 00302 M01S00302.sslabel +++| BASED 00303 M01S00303.sslabel +++| ARRAY RA [0:0] P(1);; # ACCESS CONTROL CARD AREA # 00304 M01S00304.sslabel +++| ARRAY SPSSTAT [0:0] S(1); 00305 M01S00305.sslabel +++| BEGIN 00306 M01S00306.sslabel +++| ITEM SPS$STATUS U(00,48,12); # RETURN STATUS # 00307 M01S00307.sslabel +++| END 00308 M01S00308.sslabel +++| 00309 M01S00309.sslabel +++| 00310 M01S00310.sslabel +++| CONTROL EJECT; 00311 M01S00311.sslabel +++| 00312 M01S00312.sslabel +++|# 00313 M01S00313.sslabel +++|* USER MUST HAVE SYSTEM ORIGIN PRIVILIDGES. 00314 M01S00314.sslabel +++|# 00315 M01S00315.sslabel +++| 00316 M01S00316.sslabel +++| GETSPS(SPSSTAT); 00317 M01S00317.sslabel +++| IF SPS$STATUS NQ OK 00318 M01S00318.sslabel +++| THEN 00319 M01S00319.sslabel +++| BEGIN 00320 M01S00320.sslabel +++| LBMSG$LINE[0] = " SSLABEL - MUST BE SYSTEM ORIGIN."; 00321 M01S00321.sslabel +++| MESSAGE(LBMSG$BUF[0],SYSUDF1); 00322 M01S00322.sslabel +++| ABORT; 00323 M01S00323.sslabel +++| END 00324 M01S00324.sslabel +++| 00325 M01S00325.sslabel +++| 00326 M01S00326.sslabel +++| REQID$LB = REQNAME"RQILABL"; # SET REQUESTOR ID FOR SSLABEL # 00327 M01S00327.sslabel +++| 00328 M01S00328.sslabel +++|# 00329 M01S00329.sslabel +++|* SAVE THE USER-S CURRENT FAMILY AND USER INDEX IN COMMON. 00330 M01S00330.sslabel +++|# 00331 M01S00331.sslabel +++| 00332 M01S00332.sslabel +++| GETPFP(PFP[0]); 00333 M01S00333.sslabel +++| USER$FAM[0] = PFP$FAM[0]; 00334 M01S00334.sslabel +++| USER$UI[0] = PFP$UI[0]; 00335 M01S00335.sslabel +++| 00336 M01S00336.sslabel +++|# 00337 M01S00337.sslabel +++|* CRACK THE PARAMETERS ON SSLABEL CALL. 00338 M01S00338.sslabel +++|# 00339 M01S00339.sslabel +++| 00340 M01S00340.sslabel +++| LBTAB(ARGLIST); # SET UP THE ARGUMENT LIST # 00341 M01S00341.sslabel +++| OPTION = 0; # SKIP OVER PROGRAM NAME # 00342 M01S00342.sslabel +++| XARG(ARGLIST,OPTION,FLAG); # CRACK THE CONTROL STATEMENT # 00343 M01S00343.sslabel +++| IF FLAG NQ 0 00344 M01S00344.sslabel +++| THEN # SYNTAX ERROR # 00345 M01S00345.sslabel +++| BEGIN 00346 M01S00346.sslabel +++| ERRCODE = S"SYNTX$ABRT"; # ABORT WITH *SYNTAX ERROR* # 00347 M01S00347.sslabel +++| OUT$FETP = 0; 00348 M01S00348.sslabel +++| LBERR(ERRCODE); 00349 M01S00349.sslabel +++| END 00350 M01S00350.sslabel +++| 00351 M01S00351.sslabel +++|# 00352 M01S00352.sslabel +++|* SET UP FET FOR READING THE DIRECTIVE FILE. 00353 M01S00353.sslabel +++|# 00354 M01S00354.sslabel +++| 00355 M01S00355.sslabel +++| FETP = LOC(LBIN$FET[0]); 00356 M01S00356.sslabel +++| LB$BUFP = LOC(LBIN$BUF[0]); 00357 M01S00357.sslabel +++| LFN = LBARG$I[0]; 00358 M01S00358.sslabel +++| ZSETFET(FETP,LFN,LB$BUFP,BUFL,SFETL); 00359 M01S00359.sslabel +++| 00360 M01S00360.sslabel +++|# 00361 M01S00361.sslabel +++|* DO *Z* ARGUMENT PROCESSING. 00362 M01S00362.sslabel +++|# 00363 M01S00363.sslabel +++| 00364 M01S00364.sslabel +++| IF LBARG$Z[0] NQ 0 00365 M01S00365.sslabel +++| THEN # *Z* OPTION SPECIFIED # 00366 M01S00366.sslabel +++| BEGIN 00367 M01S00367.sslabel +++| XZAP(LBIN$FET[0]); # PROCESS *Z* ARGUMENTS # 00368 M01S00368.sslabel +++| END 00369 M01S00369.sslabel +++| 00370 M01S00370.sslabel +++| ELSE 00371 M01S00371.sslabel +++| BEGIN 00372 M01S00372.sslabel +++| READ(LBIN$FET[0],NRCL); # READ INPUT FILE # 00373 M01S00373.sslabel +++| END 00374 M01S00374.sslabel +++| 00375 M01S00375.sslabel +++|# 00376 M01S00376.sslabel +++|* SET UP FET POINTER FOR OUTPUT FILE. 00377 M01S00377.sslabel +++|# 00378 M01S00378.sslabel +++| 00379 M01S00379.sslabel +++| IF LBARG$L[0] EQ 0 00380 M01S00380.sslabel +++| THEN # NO OUTPUT FILE # 00381 M01S00381.sslabel +++| BEGIN 00382 M01S00382.sslabel +++| OUT$FETP = 0; 00383 M01S00383.sslabel +++| END 00384 M01S00384.sslabel +++| 00385 M01S00385.sslabel +++| ELSE # SET UP THE FWA OF THE FET # 00386 M01S00386.sslabel +++| BEGIN 00387 M01S00387.sslabel +++| OUT$FETP = LOC(OUT$FET[0]); 00388 M01S00388.sslabel +++| END 00389 M01S00389.sslabel +++| 00390 M01S00390.sslabel +++|# 00391 M01S00391.sslabel +++|* OPEN OUTPUT FILE AND WRITE THE CONTROL CARD 00392 M01S00392.sslabel +++|* IMAGE TO IT. 00393 M01S00393.sslabel +++|# 00394 M01S00394.sslabel +++| 00395 M01S00395.sslabel +++| RPOPEN(LBARG$L[0],OUT$FETP,LBHEAD); 00396 M01S00396.sslabel +++| P<RA> = 0; # SET TO RA+0 # 00397 M01S00397.sslabel +++| BZFILL(RA[O"70"],TYPFILL"BFILL",80); 00398 M01S00398.sslabel +++| RPLINE(OUT$FETP,RA[O"70"],2,80,0); 00399 M01S00399.sslabel +++| RPSPACE(OUT$FETP,SP"SPACE",1); 00400 M01S00400.sslabel +++| 00401 M01S00401.sslabel +++|# 00402 M01S00402.sslabel +++|* READ EACH DIRECTIVE AND CRACK AND SYNTAX CHECK IT. 00403 M01S00403.sslabel +++|# 00404 M01S00404.sslabel +++| 00405 M01S00405.sslabel +++| ERRFLAG = FALSE; # INITIALIZE ERROR STATUS # 00406 M01S00406.sslabel +++| LBLOOP(ARGLIST,ERRFLAG); 00407 M01S00407.sslabel +++| IF ERRFLAG 00408 M01S00408.sslabel +++| THEN # ERROR IN ANY DIRECTIVE # 00409 M01S00409.sslabel +++| BEGIN 00410 M01S00410.sslabel +++| ERRCODE = S"SYNTX$ABRT"; # ABORT WITH DAYFILE MESSAGE # 00411 M01S00411.sslabel +++| LBERR(ERRCODE); 00412 M01S00412.sslabel +++| END 00413 M01S00413.sslabel +++| 00414 M01S00414.sslabel +++| PDATE(PD$T); # GET PACKED DATE/TIME # 00415 M01S00415.sslabel +++| VERSION(OSVERSION[0]); # GET *OS* LEVEL # 00416 M01S00416.sslabel +++| 00417 M01S00417.sslabel +++|# 00418 M01S00418.sslabel +++|* GET DEFAULT FAMILY AND SUBSYSTEM ID. 00419 M01S00419.sslabel +++|# 00420 M01S00420.sslabel +++| 00421 M01S00421.sslabel +++| SSID$LB = ATAS; 00422 M01S00422.sslabel +++| GETFAM(FAMT,FAM$NUM,LINK,DEFAULT,SSID$LB); 00423 M01S00423.sslabel +++| DEF$FAM = FAM$NAME[DEFAULT]; 00424 M01S00424.sslabel +++| 00425 M01S00425.sslabel +++|# 00426 M01S00426.sslabel +++|* INITIALIZE THE POINTER OF THE BASED ARRAY 00427 M01S00427.sslabel +++|* DESCRIBING THE FORMAT OF THE CALLSS REQUEST 00428 M01S00428.sslabel +++|* BLOCK. 00429 M01S00429.sslabel +++|# 00430 M01S00430.sslabel +++| 00431 M01S00431.sslabel +++| P<CPR> = LOC(CALL$SS[0]); 00432 M01S00432.sslabel +++| 00433 M01S00433.sslabel +++|# 00434 M01S00434.sslabel +++|* SET UP CONNECT WITH EXEC. 00435 M01S00435.sslabel +++|# 00436 M01S00436.sslabel +++| 00437 M01S00437.sslabel +++| REQCODE = REQTYP1"CONNECT"; 00438 M01S00438.sslabel +++| CALL1(REQCODE,RESP$CODE); 00439 M01S00439.sslabel +++| IF RESP$CODE NQ OK 00440 M01S00440.sslabel +++| THEN 00441 M01S00441.sslabel +++| BEGIN 00442 M01S00442.sslabel +++| LBMSG$LINE[0] = " UNABLE TO CONNECT WITH EXEC."; 00443 M01S00443.sslabel +++| MESSAGE(LBMSG$BUF[0],SYSUDF1); 00444 M01S00444.sslabel +++| RPCLOSE(OUT$FETP); # CLOSE OUTPUT FILE # 00445 M01S00445.sslabel +++| RESTPFP(PFP$ABORT); # RESTORE USER-S *PFP* AND ABORT # 00446 M01S00446.sslabel +++| END 00447 M01S00447.sslabel +++| 00448 M01S00448.sslabel +++|# 00449 M01S00449.sslabel +++|* PROCESS EACH DIRECTIVE. 00450 M01S00450.sslabel +++|# 00451 M01S00451.sslabel +++| 00452 M01S00452.sslabel +++| LBMAIN; 00453 M01S00453.sslabel +++| 00454 M01S00454.sslabel +++|# 00455 M01S00455.sslabel +++|* DISCONNECT WITH EXEC. 00456 M01S00456.sslabel +++|# 00457 M01S00457.sslabel +++| 00458 M01S00458.sslabel +++| REQCODE = REQTYP1"DISCONNECT"; 00459 M01S00459.sslabel +++| CALL1(REQCODE,RESP$CODE); 00460 M01S00460.sslabel +++| RPCLOSE(OUT$FETP); # CLOSE OUTPUT FILE # 00461 M01S00461.sslabel +++| 00462 M01S00462.sslabel +++|# 00463 M01S00463.sslabel +++|* DISPLAY *SSLABEL COMPLETE* IN THE DAYFILE. 00464 M01S00464.sslabel +++|# 00465 M01S00465.sslabel +++| 00466 M01S00466.sslabel +++| LBMSG$LINE[0] = " SSLABEL COMPLETE."; 00467 M01S00467.sslabel +++| MESSAGE(LBMSG$BUF[0],SYSUDF1); 00468 M01S00468.sslabel +++| RESTPFP(PFP$END); # RESTORE USER-S *PFP* # 00469 M01S00469.sslabel +++| 00470 M01S00470.sslabel +++| END # SSLABEL # 00471 M01S00471.sslabel +++| 00472 M01S00472.sslabel +++| TERM 00473 M01S00473.sslabel +++|PROC CALL1((REQ$CODE),RESP$CODE); 00474 M01S00474.sslabel +++|# TITLE CALL1 - SETS UP AND ISSUES A CALLSS TYPE 1 REQUEST. # 00475 M01S00475.sslabel +++| 00476 M01S00476.sslabel +++| BEGIN # CALL1 # 00477 M01S00477.sslabel +++| 00478 M01S00478.sslabel +++|# 00479 M01S00479.sslabel +++|** CALL1 - SETS UP AND ISSUES A CALLSS TYPE 1 REQUEST. 00480 M01S00480.sslabel +++|* 00481 M01S00481.sslabel +++|* THIS PROC SETS UP THE CALLSS REQUEST BLOCK FOR A 00482 M01S00482.sslabel +++|* UCP REQUEST TYPE 1 AND CALLS *CALLSS* TO ISSUE IT 00483 M01S00483.sslabel +++|* TO EXEC. 00484 M01S00484.sslabel +++|* 00485 M01S00485.sslabel +++|* PROC CALL1((REQ$CODE),RESP$CODE) 00486 M01S00486.sslabel +++|* 00487 M01S00487.sslabel +++|* ENTRY (REQCODE) = REQUEST CODE. 00488 M01S00488.sslabel +++|* (REQID$LB) = REQUESTOR ID. 00489 M01S00489.sslabel +++|* (SSID$LB) = SUBSYSTEM ID. 00490 M01S00490.sslabel +++|* P<CPR> = FWA OF PARAMETER BLOCK. 00491 M01S00491.sslabel +++|* 00492 M01S00492.sslabel +++|* EXIT (RESP$CODE) = RESPONSE FROM EXEC. 00493 M01S00493.sslabel +++|* 00494 M01S00494.sslabel +++|* NOTES PROC *CALL1* SETS UP THE CALLSS PARAMETER 00495 M01S00495.sslabel +++|* BLOCK FOR A UCP TYPE 1 REQUEST. TYPE 1 00496 M01S00496.sslabel +++|* REQUESTS ARE THE UCP LINKAGE REQUESTS I.E 00497 M01S00497.sslabel +++|* CONNECT AND DISCONNECT. THE REQUEST CODE 00498 M01S00498.sslabel +++|* IS SET UP IN THE CALLSS PARAMETER BLOCK 00499 M01S00499.sslabel +++|* TO IDENTIFY THE TYPE OF REQUEST BEING SENT 00500 M01S00500.sslabel +++|* TO EXEC. THE RESPONSE CODE IS RETURNED 00501 M01S00501.sslabel +++|* TO THE CALLING PROCEDURE. 00502 M01S00502.sslabel +++|# 00503 M01S00503.sslabel +++| 00504 M01S00504.sslabel +++| ITEM REQ$CODE U; # REQUEST CODE # 00505 M01S00505.sslabel +++| ITEM RESP$CODE U; # RESPONSE CODE FROM EXEC # 00506 M01S00506.sslabel +++| 00507 M01S00507.sslabel +++|# 00508 M01S00508.sslabel +++|**** PROC CALL1 - XREF LIST BEGIN. 00509 M01S00509.sslabel +++|# 00510 M01S00510.sslabel +++| 00511 M01S00511.sslabel +++| XREF 00512 M01S00512.sslabel +++| BEGIN 00513 M01S00513.sslabel +++| PROC CALLSS; # ISSUES A CALLSS TO EXEC # 00514 M01S00514.sslabel +++| END 00515 M01S00515.sslabel +++| 00516 M01S00516.sslabel +++|# 00517 M01S00517.sslabel +++|**** PROC CALL1 - XREF LIST END. 00518 M01S00518.sslabel +++|# 00519 M01S00519.sslabel +++| 00520 M01S00520.sslabel +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS # 00521 M01S00521.sslabel +++|*CALL COMBFAS 00522 M01S00522.sslabel +++|*CALL COMBCPR 00523 M01S00523.sslabel +++|*CALL COMTLAB 00524 M01S00524.sslabel +++| 00525 M01S00525.sslabel +++| ITEM I I; # LOOP VARIABLE # 00526 M01S00526.sslabel +++| 00527 M01S00527.sslabel +++| CONTROL EJECT; 00528 M01S00528.sslabel +++| 00529 M01S00529.sslabel +++|# 00530 M01S00530.sslabel +++|* ZERO FILL THE CALLSS PARAMETER REQUEST BLOCK. 00531 M01S00531.sslabel +++|# 00532 M01S00532.sslabel +++| 00533 M01S00533.sslabel +++| SLOWFOR I = 0 STEP 1 UNTIL CPRLEN-1 00534 M01S00534.sslabel +++| DO 00535 M01S00535.sslabel +++| BEGIN 00536 M01S00536.sslabel +++| CPR1[I] = 0; 00537 M01S00537.sslabel +++| END 00538 M01S00538.sslabel +++| 00539 M01S00539.sslabel +++| CPR$WC[0] = TYP1$WC; # SET UP WORD COUNT # 00540 M01S00540.sslabel +++| CPR$RQT[0] = TYP"TYP1"; # TYPE 1 REQUEST # 00541 M01S00541.sslabel +++| CPR$RQC[0] = REQ$CODE; # SET UP REQUEST CODE # 00542 M01S00542.sslabel +++| CPR$RQI[0] = REQID$LB; # SET UP REQUESTOR ID # 00543 M01S00543.sslabel +++| CPR$SSPFLG[0] = TRUE; 00544 M01S00544.sslabel +++| CALLSS(SSID$LB,CPR[0],RCL); # ISSUE CALLSS # 00545 M01S00545.sslabel +++| RESP$CODE = CPR$ES[0]; # RETURN THE RESPONSE CODE # 00546 M01S00546.sslabel +++| RETURN; 00547 M01S00547.sslabel +++| 00548 M01S00548.sslabel +++| END # CALL1 # 00549 M01S00549.sslabel +++| 00550 M01S00550.sslabel +++| TERM 00551 M01S00551.sslabel +++|PROC CALL3((REQ$CODE),PT$CSU$ENT,(CATFLD),(CATVALUE),RESP$CODE); 00552 M01S00552.sslabel +++|# TITLE CALL3 - SETS UP AND ISSUES A TYPE 3 CALLSS TO EXEC. # 00553 M01S00553.sslabel +++| 00554 M01S00554.sslabel +++| BEGIN # CALL3 # 00555 M01S00555.sslabel +++| 00556 M01S00556.sslabel +++|# 00557 M01S00557.sslabel +++|** CALL3 - SETS UP AND ISSUES A TYPE 3 CALLSS TO EXEC. 00558 M01S00558.sslabel +++|* 00559 M01S00559.sslabel +++|* PROC CALL3((REQ$CODE),PT$CSU$ENT,(CATFLD),(CATVALUE),RESP$CODE) 00560 M01S00560.sslabel +++|* 00561 M01S00561.sslabel +++|* ENTRY (REQ$CODE) = REQUEST CODE. 00562 M01S00562.sslabel +++|* (PT$CSU$ENT) = 3 WORD SMMAP ENTRY WITH THE THIRD 00563 M01S00563.sslabel +++|* WORD CONTAINING THE Y,Z COORDINATES. 00564 M01S00564.sslabel +++|* (CATFLD) = CATALOG FIELD TO BE UPDATED. 00565 M01S00565.sslabel +++|* (CATVALUE) = NEW VALUE FOR THE CATALOG FIELD TO 00566 M01S00566.sslabel +++|* BE UPDATED. 00567 M01S00567.sslabel +++|* (REQID$LB) = REQUESTOR ID. 00568 M01S00568.sslabel +++|* (NEWLABP) = FWA OF BUFFER CONTAINING NEW CARTRIDGE 00569 M01S00569.sslabel +++|* LABEL. 00570 M01S00570.sslabel +++|* (OLDLABP) = FWA OF BUFFER CONTAINING OLD CARTRIDGE 00571 M01S00571.sslabel +++|* LABEL. 00572 M01S00572.sslabel +++|* (SSID$LB) = SUBSYSTEM ID. 00573 M01S00573.sslabel +++|* (LBARG$B) = LARGE FILE ALLOCATION SPACE. 00574 M01S00574.sslabel +++|* (LBARG$SMID) = *SM*-ID. 00575 M01S00575.sslabel +++|* (LBARG$FM) = FAMILY NAME. 00576 M01S00576.sslabel +++|* (LBARG$SB) = SUBFAMILY ID. 00577 M01S00577.sslabel +++|* P<CPR> = FWA OF PARAMETER BLOCK. 00578 M01S00578.sslabel +++|* 00579 M01S00579.sslabel +++|* EXIT (RESP$CODE) = RESPONSE FROM EXEC. 00580 M01S00580.sslabel +++|* 00581 M01S00581.sslabel +++|* NOTES PROC *CALL3* SETS UP THE CALLSS PARAMETER BLOCK 00582 M01S00582.sslabel +++|* FOR A TYPE 3 REQUEST TO EXEC. TYPE 3 REQUESTS 00583 M01S00583.sslabel +++|* ARE THE REQUESTS TO MODIFY MSF CATALOGS AND MAPS. 00584 M01S00584.sslabel +++|* THE SPECIFIC REQUEST ISSUED IS DEPENDENT ON THE 00585 M01S00585.sslabel +++|* VALUE OF *REQCODE*. PARAMETERS NOT NEEDED FOR 00586 M01S00586.sslabel +++|* THE REQUEST ARE IGNORED. IF THE RESPONSE CODE 00587 M01S00587.sslabel +++|* RETURNED BY EXEC IS *RESUBMIT THE REQUEST*, THE 00588 M01S00588.sslabel +++|* CALLSS IS REISSUED. OTHERWISE THE RESPONSE CODE 00589 M01S00589.sslabel +++|* IS RETURNED TO THE CALLING PROC. 00590 M01S00590.sslabel +++|# 00591 M01S00591.sslabel +++| 00592 M01S00592.sslabel +++| ITEM REQ$CODE U; # REQUEST CODE # 00593 M01S00593.sslabel +++| 00594 M01S00594.sslabel +++| ARRAY PT$CSU$ENT [0:0] P(5); # *PUT* SMMAP ENTRY # 00595 M01S00595.sslabel +++| BEGIN 00596 M01S00596.sslabel +++| ITEM PT$MAPENT C(00,00,30); # THREE WORD MAP ENTRY # 00597 M01S00597.sslabel +++| ITEM PT$Y U(03,00,30); # Y COORDINATE # 00598 M01S00598.sslabel +++| ITEM PT$Z U(03,30,30); # Z COORDINATE # 00599 M01S00599.sslabel +++| ITEM PT$GR U(04,00,07); # GROUP # 00600 M01S00600.sslabel +++| ITEM PT$GRT U(04,07,05); # GROUP ORDINAL # 00601 M01S00601.sslabel +++| END 00602 M01S00602.sslabel +++| 00603 M01S00603.sslabel +++| 00604 M01S00604.sslabel +++| ITEM CATFLD U; # CATALOG FIELD # 00605 M01S00605.sslabel +++| ITEM CATVALUE U; # NEW VALUE FOR CATALOG FIELD # 00606 M01S00606.sslabel +++| ITEM RESP$CODE U; # RESPONSE CODE FROM EXEC # 00607 M01S00607.sslabel +++| 00608 M01S00608.sslabel +++|# 00609 M01S00609.sslabel +++|**** PROC CALL3 - XREF LIST BEGIN. 00610 M01S00610.sslabel +++|# 00611 M01S00611.sslabel +++| 00612 M01S00612.sslabel +++| XREF 00613 M01S00613.sslabel +++| BEGIN 00614 M01S00614.sslabel +++| PROC CALLSS; # ISSUES A CALLSS TO EXEC # 00615 M01S00615.sslabel +++| END 00616 M01S00616.sslabel +++| 00617 M01S00617.sslabel +++|# 00618 M01S00618.sslabel +++|**** PROC CALL3 - XREF LIST END. 00619 M01S00619.sslabel +++|# 00620 M01S00620.sslabel +++| 00621 M01S00621.sslabel +++| DEF LISTCON #0#; # CONTROLS LISTING OF COMDECKS # 00622 M01S00622.sslabel +++|*CALL COMBFAS 00623 M01S00623.sslabel +++|*CALL COMBCPR 00624 M01S00624.sslabel +++|*CALL COMBLBL 00625 M01S00625.sslabel +++|*CALL COMBMAP 00626 M01S00626.sslabel +++|*CALL COMTLAB 00627 M01S00627.sslabel +++|*CALL COMTLBP 00628 M01S00628.sslabel +++| 00629 M01S00629.sslabel +++| ITEM COMPLETE B; # CALLSS COMPLETION STATUS # 00630 M01S00630.sslabel +++| ITEM I I; # LOOP VARIABLE # 00631 M01S00631.sslabel +++| 00632 M01S00632.sslabel +++| SWITCH CALL3ACT: REQTYP3 # TYPE OF CALLSS ISSUED # 00633 M01S00633.sslabel +++| ADDCBFM: ADD$CUBE, # ADD CUBE TO FAMILY # 00634 M01S00634.sslabel +++| ADDCRFM: ADD$CART, # ADD CARTRIDGE TO FAMILY # 00635 M01S00635.sslabel +++| ADDCSFM: ADD$CSU, # ADD *SM* TO FAMILY # 00636 M01S00636.sslabel +++| RMVCBFM: RMV$CUBE, # REMOVE CUBE FROM FAMILY # 00637 M01S00637.sslabel +++| RMVCRFM: RMV$CART, # REMOVE CARTRIDGE FROM FAMILY # 00638 M01S00638.sslabel +++| RMVCSFM: RMV$CSU, # REMOVE *SM* FROM FAMILY # 00639 M01S00639.sslabel +++| UPDCAT: UPD$CAT, # UPDATE CATALOG FIELD # 00640 M01S00640.sslabel +++| UPDMAP: UPD$MAP; # UPDATE SMMAP FIELD # 00641 M01S00641.sslabel +++| 00642 M01S00642.sslabel +++| CONTROL EJECT; 00643 M01S00643.sslabel +++| 00644 M01S00644.sslabel +++|# 00645 M01S00645.sslabel +++|* ZERO FILL CALLSS REQUEST BLOCK AND SET UP FIELDS COMMON 00646 M01S00646.sslabel +++|* TO MOST REQUESTS. 00647 M01S00647.sslabel +++|# 00648 M01S00648.sslabel +++| 00649 M01S00649.sslabel +++| COMPLETE = FALSE; 00650 M01S00650.sslabel +++| 00651 M01S00651.sslabel +++| SLOWFOR I = 0 STEP 1 UNTIL CPRLEN-1 00652 M01S00652.sslabel +++| DO 00653 M01S00653.sslabel +++| BEGIN 00654 M01S00654.sslabel +++| CPR1[I] = 0; 00655 M01S00655.sslabel +++| END 00656 M01S00656.sslabel +++| 00657 M01S00657.sslabel +++|# 00658 M01S00658.sslabel +++|* SET UP PARAMETER BLOCK. 00659 M01S00659.sslabel +++|# 00660 M01S00660.sslabel +++| 00661 M01S00661.sslabel +++| CPR$RQT[0] = TYP"TYP3"; 00662 M01S00662.sslabel +++| CPR$RQC[0] = REQ$CODE; 00663 M01S00663.sslabel +++| CPR$RQI[0] = REQID$LB; 00664 M01S00664.sslabel +++| CPR$FAM[0] = LBARG$FM[0]; 00665 M01S00665.sslabel +++| CPR$SUB[0] = LBARG$SB[0]; 00666 M01S00666.sslabel +++| CPR$CSU[0] = LBARG$SMID[0]; 00667 M01S00667.sslabel +++| CPR$WC[0] = TYP3$WC; 00668 M01S00668.sslabel +++| P<SMUMAP> = LOC(PT$CSU$ENT[0]); 00669 M01S00669.sslabel +++| 00670 M01S00670.sslabel +++|# 00671 M01S00671.sslabel +++|* SET UP ADDITIONAL REQUEST BLOCK FIELDS FOR SPECIFIC 00672 M01S00672.sslabel +++|* REQUEST CODES. 00673 M01S00673.sslabel +++|# 00674 M01S00674.sslabel +++| 00675 M01S00675.sslabel +++| GOTO CALL3ACT[REQ$CODE]; 00676 M01S00676.sslabel +++| 00677 M01S00677.sslabel +++|ADDCBFM: # ADD CUBE TO FAMILY # 00678 M01S00678.sslabel +++| CPR$Y[0] = PT$Y[0]; # SET Y AND Z COORDINATES # 00679 M01S00679.sslabel +++| CPR$Z[0] = PT$Z[0]; 00680 M01S00680.sslabel +++| GOTO ISSUECALL; 00681 M01S00681.sslabel +++| 00682 M01S00682.sslabel +++|ADDCRFM: # ADD CARTRIDGE TO FAMILY # 00683 M01S00683.sslabel +++| P<LABEL$CART> = NEWLABP; 00684 M01S00684.sslabel +++| CPR$FCT[0] = (PT$GR[0]) * 16 + PT$GRT[0]; 00685 M01S00685.sslabel +++| CPR$Y[0] = LAB$Y[0]; # SET Y AND Z COORDINATES # 00686 M01S00686.sslabel +++| CPR$Z[0] = LAB$Z[0]; 00687 M01S00687.sslabel +++| CPR$CSND[0] = LAB$CSND[0]; # SET VSN FIELD # 00688 M01S00688.sslabel +++| CPR$CCOD[0] = LAB$CCOD[0]; 00689 M01S00689.sslabel +++| CPR$GR[0] = LBARG$GR[0]; # SET GROUP PARAMETERS # 00690 M01S00690.sslabel +++| CPR$GRT[0] = PT$GRT; 00691 M01S00691.sslabel +++| # CALCULATE GRTO # 00692 M01S00692.sslabel +++| CPR$B[0] = LBARG$B[0]; 00693 M01S00693.sslabel +++| CPR$STRD[0] = LAB$STRD[0]; 00694 M01S00694.sslabel +++| CPR$STWR[0] = LAB$STWR[0]; 00695 M01S00695.sslabel +++| CPR$SRDE[0] = LAB$SRDE[0]; 00696 M01S00696.sslabel +++| CPR$SWRE[0] = LAB$SWRE1[0]; 00697 M01S00697.sslabel +++| B<28,4>CPR$SWRE = LAB$SWRE[0]; 00698 M01S00698.sslabel +++| CPR$HRDE[0] = LAB$HRDE[0]; 00699 M01S00699.sslabel +++| CPR$STDM[0] = LAB$STDM[0]; 00700 M01S00700.sslabel +++| CPR$CRLD[0] = LAB$CRLD[0]; 00701 M01S00701.sslabel +++| CPR$LDER[0] = LAB$LDER[0]; 00702 M01S00702.sslabel +++| GOTO ISSUECALL; 00703 M01S00703.sslabel +++| 00704 M01S00704.sslabel +++|ADDCSFM: # ADD *SM* TO FAMILY # 00705 M01S00705.sslabel +++| GOTO ISSUECALL; 00706 M01S00706.sslabel +++| 00707 M01S00707.sslabel +++|RMVCBFM: # REMOVE CUBE FROM FAMILY # 00708 M01S00708.sslabel +++| CPR$FCT[0] = CM$FCTORD[0]; # SET FCT ORDINAL # 00709 M01S00709.sslabel +++| CPR$Y[0] = PT$Y[0]; # SET Y AND Z COORDINATES # 00710 M01S00710.sslabel +++| CPR$Z[0] = PT$Z[0]; 00711 M01S00711.sslabel +++| GOTO ISSUECALL; 00712 M01S00712.sslabel +++| 00713 M01S00713.sslabel +++|RMVCRFM: # REMOVE CARTRIDGE FROM FAMILY # 00714 M01S00714.sslabel +++| CPR$FAM[0] = CM$FMLYNM[0]; # USE *FM* AND *SB* FROM SMMAP # 00715 M01S00715.sslabel +++| CPR$SUB[0] = CM$SUB[0]; 00716 M01S00716.sslabel +++| CPR$FCT[0] = CM$FCTORD[0]; # SET FCT ORDINAL # 00717 M01S00717.sslabel +++| CPR$GR[0] = LBARG$GR[0]; # SET GROUP # 00718 M01S00718.sslabel +++| CPR$Y[0] = PT$Y[0]; # SET Y AND Z COORDINATES # 00719 M01S00719.sslabel +++| CPR$Z[0] = PT$Z[0]; 00720 M01S00720.sslabel +++| GOTO ISSUECALL; 00721 M01S00721.sslabel +++| 00722 M01S00722.sslabel +++|RMVCSFM: # REMOVE *SM* FROM FAMILY # 00723 M01S00723.sslabel +++| GOTO ISSUECALL; 00724 M01S00724.sslabel +++| 00725 M01S00725.sslabel +++|UPDCAT: # UPDATE CATALOG FIELD # 00726 M01S00726.sslabel +++| CPR$FAM[0] = CM$FMLYNM[0]; # USE *FM* AND *SB* FROM SMMAP # 00727 M01S00727.sslabel +++| CPR$SUB[0] = CM$SUB[0]; 00728 M01S00728.sslabel +++| CPR$FCT[0] = CM$FCTORD[0]; # SET FCT ORDINAL # 00729 M01S00729.sslabel +++| CPR$FLD[0] = CATFLD; # SET FIELD NAME # 00730 M01S00730.sslabel +++| CPR$VAL[0] = CATVALUE; # SET CATALOG FIELD VALUE # 00731 M01S00731.sslabel +++| GOTO ISSUECALL; 00732 M01S00732.sslabel +++| 00733 M01S00733.sslabel +++|UPDMAP: # UPDATE SMMAP ENTRY # 00734 M01S00734.sslabel +++| CPR$Y[0] = PT$Y[0]; # SET Y AND Z COORDINATES # 00735 M01S00735.sslabel +++| CPR$Z[0] = PT$Z[0]; 00736 M01S00736.sslabel +++| CPR$MAPENT[0] = PT$MAPENT[0]; # SET UP NEW SMMAP ENTRY # 00737 M01S00737.sslabel +++| GOTO ISSUECALL; 00738 M01S00738.sslabel +++| 00739 M01S00739.sslabel +++|ISSUECALL: # ISSUE REQUEST TO EXEC # 00740 M01S00740.sslabel +++| REPEAT WHILE NOT COMPLETE 00741 M01S00741.sslabel +++| DO 00742 M01S00742.sslabel +++| BEGIN 00743 M01S00743.sslabel +++| CALLSS(SSID$LB,CPR[0],RCL); 00744 M01S00744.sslabel +++| IF CPR$RQR[0] NQ RESPTYP3"RESUB$REQ" 00745 M01S00745.sslabel +++| THEN # REQUEST COMPLETE # 00746 M01S00746.sslabel +++| BEGIN 00747 M01S00747.sslabel +++| COMPLETE = TRUE; 00748 M01S00748.sslabel +++| TEST DUMMY; 00749 M01S00749.sslabel +++| END 00750 M01S00750.sslabel +++| 00751 M01S00751.sslabel +++|# 00752 M01S00752.sslabel +++|* RESUBMIT THE REQUEST. 00753 M01S00753.sslabel +++|# 00754 M01S00754.sslabel +++| 00755 M01S00755.sslabel +++| CPR$RQR[0] = 0; 00756 M01S00756.sslabel +++| CPR$C[0] = FALSE; 00757 M01S00757.sslabel +++| END 00758 M01S00758.sslabel +++| 00759 M01S00759.sslabel +++| RESP$CODE = CPR$RQR[0]; 00760 M01S00760.sslabel +++| RETURN; 00761 M01S00761.sslabel +++| 00762 M01S00762.sslabel +++| END # CALL3 # 00763 M01S00763.sslabel +++| 00764 M01S00764.sslabel +++| TERM 00765 M01S00765.sslabel +++|PROC CALL4((REQ$CODE),(DRD),(CART$CSN),(OLD$Y),(OLD$Z),RESP$CODE); 00766 M01S00766.sslabel +++|# TITLE CALL4 - SETS UP AND ISSUES A TYPE 4 CALLSS TO EXEC. # 00767 M01S00767.sslabel +++| 00768 M01S00768.sslabel +++| BEGIN # CALL4 # 00769 M01S00769.sslabel +++| 00770 M01S00770.sslabel +++|# 00771 M01S00771.sslabel +++|** CALL4 - SETS UP AND ISSUES A TYPE4 CALLSS TO EXEC. 00772 M01S00772.sslabel +++|* 00773 M01S00773.sslabel +++|* PROC CALL4((REQ$CODE),(OLD$Y),(OLD$Z),(NEW$Y),(NEW$Z),RESP$CODE) 00774 M01S00774.sslabel +++|* 00775 M01S00775.sslabel +++|* ENTRY (REQ$CODE) = REQUEST CODE. 00776 M01S00776.sslabel +++|* (OLD$Y) = PRIMARY Y COORDINATE. 00777 M01S00777.sslabel +++|* (OLD$Z) = PRIMARY Z COORDINATE. 00778 M01S00778.sslabel +++|* (NEW$Y) = SECONDARY Y COORDINATE. 00779 M01S00779.sslabel +++|* (NEW$Z) = SECONDARY Z COORDINATE. 00780 M01S00780.sslabel +++|* (REQID$LB) = REQUESTOR ID. 00781 M01S00781.sslabel +++|* (SSID$LB) = SUBSYSTEM ID. 00782 M01S00782.sslabel +++|* (NEWLABP) = FWA OF BUFFER CONTAINING NEW 00783 M01S00783.sslabel +++|* CARTRIDGE LABEL. 00784 M01S00784.sslabel +++|* (OLDLABP) = FWA OF BUFFER CONTAINING OLD 00785 M01S00785.sslabel +++|* CARTRIDGE LABEL. 00786 M01S00786.sslabel +++|* (ADDRSNS) = FWA OF BUFFER TO HOLD DRAWER 00787 M01S00787.sslabel +++|* STATUS TABLE. 00788 M01S00788.sslabel +++|* (DRD$NUM) = TRANSPORT ID. 00789 M01S00789.sslabel +++|* (LBARG$SMID) = *SM*-ID. 00790 M01S00790.sslabel +++|* P<CPR> = FWA OF PARAMETER BLOCK. 00791 M01S00791.sslabel +++|* 00792 M01S00792.sslabel +++|* EXIT (RESP$CODE) = RESPONSE FROM EXEC. 00793 M01S00793.sslabel +++|* 00794 M01S00794.sslabel +++|* NOTES PROC *CALL4* SETS UP THE CALLSS PARAMETER BLOCK 00795 M01S00795.sslabel +++|* FOR A TYPE 4 REQUEST TO EXEC. TYPE 4 ARE THE 00796 M01S00796.sslabel +++|* REQUESTS THAT REQUIRE SM OR M860 ACTIONS PERFOR- 00797 M01S00797.sslabel +++|* -MED. THE SPECIFIC REQUEST ISSUED IS DEPENDENT 00798 M01S00798.sslabel +++|* ON THE VALUE OF *REQCODE*. PARAMETERS NOT NEEDED 00799 M01S00799.sslabel +++|* FOR THE REQUEST ARE IGNORED. IF THE RESPONSE 00800 M01S00800.sslabel +++|* RETURNED BY EXEC IS *RESUBMIT* THE REQUEST*, THE 00801 M01S00801.sslabel +++|* CALLSS IS REISSUED. OTHERWISE THE RESPONSE CODE 00802 M01S00802.sslabel +++|* IS RETURNED TO THE CALLING PROC. 00803 M01S00803.sslabel +++|# 00804 M01S00804.sslabel +++| 00805 M01S00805.sslabel +++| ITEM CART$CSN U; # CARTRIDGE SERIAL NUMBER # 00806 M01S00806.sslabel +++| ITEM DRD U; # DRIVE NUMBER # 00807 M01S00807.sslabel +++| 00808 M01S00808.sslabel +++| ITEM REQ$CODE U; # REQUEST CODE # 00809 M01S00809.sslabel +++| ITEM OLD$Y I; # OLD Y COORDINATE # 00810 M01S00810.sslabel +++| ITEM OLD$Z I; # OLD Z COORDINATE # 00811 M01S00811.sslabel +++| ITEM NEW$Y I; # NEW Y COORDINATE # 00812 M01S00812.sslabel +++| ITEM NEW$Z I; # NEW Z COORDINATE # 00813 M01S00813.sslabel +++| ITEM RESP$CODE U; # RESPONSE CODE FROM EXEC # 00814 M01S00814.sslabel +++| 00815 M01S00815.sslabel +++|# 00816 M01S00816.sslabel +++|**** PROC CALL4 - XREF LIST BEGIN. 00817 M01S00817.sslabel +++|# 00818 M01S00818.sslabel +++| 00819 M01S00819.sslabel +++| XREF 00820 M01S00820.sslabel +++| BEGIN 00821 M01S00821.sslabel +++| PROC CALLSS; # ISSUES A CALLSS TO EXEC # 00822 M01S00822.sslabel +++| END 00823 M01S00823.sslabel +++| 00824 M01S00824.sslabel +++|# 00825 M01S00825.sslabel +++|**** PROC CALL4 - XREF LIST END. 00826 M01S00826.sslabel +++|# 00827 M01S00827.sslabel +++| 00828 M01S00828.sslabel +++| DEF LISTCON #0#; # CONTROLS LISTING OF COMDECKS # 00829 M01S00829.sslabel +++|*CALL COMBFAS 00830 M01S00830.sslabel +++|*CALL COMBCPR 00831 M01S00831.sslabel +++|*CALL COMTLAB 00832 M01S00832.sslabel +++|*CALL COMTLBP 00833 M01S00833.sslabel +++| 00834 M01S00834.sslabel +++| SWITCH CALL4ACT: REQTYP4 # TYPE OF CALLSS TO BE ISSUED # 00835 M01S00835.sslabel +++| GETCART: LOAD$CART, # GET CARTRIDGE # 00836 M01S00836.sslabel +++| PUTCART: UNLD$CART, # PUT CARTRIDGE # 00837 M01S00837.sslabel +++| WRITLAB: WRT$LAB; # WRITE LABEL # 00838 M01S00838.sslabel +++| 00839 M01S00839.sslabel +++| ITEM I I; # LOOP VARIABLE # 00840 M01S00840.sslabel +++| 00841 M01S00841.sslabel +++| CONTROL EJECT; 00842 M01S00842.sslabel +++| 00843 M01S00843.sslabel +++|# 00844 M01S00844.sslabel +++|* ZERO-FILL CALLSS REQUEST BLOCK AND SET UP FIELDS USED BY 00845 M01S00845.sslabel +++|* MOST REQUESTS. 00846 M01S00846.sslabel +++|# 00847 M01S00847.sslabel +++| 00848 M01S00848.sslabel +++| SLOWFOR I = 0 STEP 1 UNTIL CPRLEN-1 00849 M01S00849.sslabel +++| DO 00850 M01S00850.sslabel +++| BEGIN 00851 M01S00851.sslabel +++| CPR1[I] = 0; 00852 M01S00852.sslabel +++| END 00853 M01S00853.sslabel +++| 00854 M01S00854.sslabel +++| CPR$RQT[0] = TYP"TYP4"; 00855 M01S00855.sslabel +++| CPR$RQC[0] = REQ$CODE; 00856 M01S00856.sslabel +++| CPR$RQI[0] = REQID$LB; 00857 M01S00857.sslabel +++| CPR$CSU[0] = LBARG$SMID[0]; 00858 M01S00858.sslabel +++| CPR$WC[0] = TYP4$WC; 00859 M01S00859.sslabel +++| CPR$Y[0] = OLD$Y; 00860 M01S00860.sslabel +++| CPR$Z[0] = OLD$Z; 00861 M01S00861.sslabel +++| 00862 M01S00862.sslabel +++|# 00863 M01S00863.sslabel +++|* SET UP ADDITIONAL REQUEST BLOCK FIELDS FOR SPECIFIC REQUEST. 00864 M01S00864.sslabel +++|# 00865 M01S00865.sslabel +++| 00866 M01S00866.sslabel +++| GOTO CALL4ACT[REQ$CODE]; 00867 M01S00867.sslabel +++| 00868 M01S00868.sslabel +++|GETCART: # GET CARTRIDGE REQUEST # 00869 M01S00869.sslabel +++| CPR$ADDR2[0] = OLDLABP; 00870 M01S00870.sslabel +++| GOTO ISSUECALL; 00871 M01S00871.sslabel +++| 00872 M01S00872.sslabel +++| 00873 M01S00873.sslabel +++|PUTCART: # PUT CARTRIDGE REQUEST # 00874 M01S00874.sslabel +++| GOTO ISSUECALL; 00875 M01S00875.sslabel +++| 00876 M01S00876.sslabel +++|WRITLAB: # WRITE LABEL REQUEST # 00877 M01S00877.sslabel +++| CPR$ADDR2[0] = NEWLABP; 00878 M01S00878.sslabel +++| GOTO ISSUECALL; 00879 M01S00879.sslabel +++| 00880 M01S00880.sslabel +++| 00881 M01S00881.sslabel +++| 00882 M01S00882.sslabel +++|ISSUECALL: # ISSUE REQUEST TO EXEC # 00883 M01S00883.sslabel +++| CALLSS(SSID$LB,CPR[0],RCL); 00884 M01S00884.sslabel +++| RESP$CODE = CPR$RQR[0]; 00885 M01S00885.sslabel +++| RETURN; 00886 M01S00886.sslabel +++| 00887 M01S00887.sslabel +++| END # CALL4 # 00888 M01S00888.sslabel +++| 00889 M01S00889.sslabel +++| TERM 00890 M01S00890.sslabel +++|PROC CKLAB(LAB$TYPE); 00891 M01S00891.sslabel +++|# TITLE CKLAB - CHECKS CARTRIDGE LABEL. # 00892 M01S00892.sslabel +++| 00893 M01S00893.sslabel +++| BEGIN # CKLAB # 00894 M01S00894.sslabel +++| 00895 M01S00895.sslabel +++|# 00896 M01S00896.sslabel +++|** CKLAB - CHECKS CARTRIDGE LABEL. 00897 M01S00897.sslabel +++|* 00898 M01S00898.sslabel +++|* THIS PROCEDURE CHECKS CARTRIDGE LABEL 00899 M01S00899.sslabel +++|* TO SEE IF IT IS A RECOGNIZABLE LABEL. 00900 M01S00900.sslabel +++|* 00901 M01S00901.sslabel +++|* PROC CKLAB(LAB$TYPE) 00902 M01S00902.sslabel +++|* 00903 M01S00903.sslabel +++|* ENTRY OLDLABP, AN ITEM CONTAINING FWA OF BUFFER 00904 M01S00904.sslabel +++|* CONTAINING OLD CARTRIDGE LABEL. 00905 M01S00905.sslabel +++|* 00906 M01S00906.sslabel +++|* EXIT CARTRIDGE LABEL CHECKED. 00907 M01S00907.sslabel +++|* LAB$TYPE, AN ITEM CONTAINING 00908 M01S00908.sslabel +++|* LABEL TYPE. 00909 M01S00909.sslabel +++|* 00910 M01S00910.sslabel +++|* NOTES PROC *CKLAB* CHECKS THE LABEL 00911 M01S00911.sslabel +++|* TO SEE IF IT IS A MANUFACTURERS 00912 M01S00912.sslabel +++|* LABEL, SCRATCH LABEL, FAMILY 00913 M01S00913.sslabel +++|* LABEL OR AN UNRECOGNIZABLE LABEL. 00914 M01S00914.sslabel +++|# 00915 M01S00915.sslabel +++| 00916 M01S00916.sslabel +++| ITEM LAB$TYPE U; # CARTRIDGE LABEL TYPE # 00917 M01S00917.sslabel +++| 00918 M01S00918.sslabel +++|# 00919 M01S00919.sslabel +++|**** PROC CKLAB - XREF LIST BEGIN. 00920 M01S00920.sslabel +++|# 00921 M01S00921.sslabel +++| 00922 M01S00922.sslabel +++| XREF 00923 M01S00923.sslabel +++| BEGIN 00924 M01S00924.sslabel +++| PROC CONVSN; # CONVERTS VSN FROM EBCDIC TO CDC 00925 M01S00925.sslabel +++| DISPLAY CODE # 00926 M01S00926.sslabel +++| END 00927 M01S00927.sslabel +++| 00928 M01S00928.sslabel +++|# 00929 M01S00929.sslabel +++|**** PROC CKLAB - XREF LIST END. 00930 M01S00930.sslabel +++|# 00931 M01S00931.sslabel +++| 00932 M01S00932.sslabel +++| DEF PROCNAME #"CKLAB."#; # PROC NAME # 00933 M01S00933.sslabel +++| 00934 M01S00934.sslabel +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS # 00935 M01S00935.sslabel +++|*CALL COMBFAS 00936 M01S00936.sslabel +++|*CALL COMBLBL 00937 M01S00937.sslabel +++|*CALL COMTLAB 00938 M01S00938.sslabel +++| 00939 M01S00939.sslabel +++| ITEM CONTYPE I; # TYPE OF CONVERSION # 00940 M01S00940.sslabel +++| ITEM FLAG I; # CHECK FOR LEGAL CHARACTER # 00941 M01S00941.sslabel +++| ITEM TEMP$VSN C(8); # CSN IN CDC DISPLAY CODE # 00942 M01S00942.sslabel +++| 00943 M01S00943.sslabel +++| CONTROL EJECT; 00944 M01S00944.sslabel +++| 00945 M01S00945.sslabel +++|# 00946 M01S00946.sslabel +++|* CONVERT THE TWELVE BYTES IN THE CSN IN EBCDIC TO 00947 M01S00947.sslabel +++|* DISPLAY CODE AND ALSO CHECK TO SEE IF THEY ARE 00948 M01S00948.sslabel +++|* LEGAL CDC CHARACTERS (A - Z EXCEPT I AND O AND 00949 M01S00949.sslabel +++|* 0 - 9). 00950 M01S00950.sslabel +++|# 00951 M01S00951.sslabel +++| 00952 M01S00952.sslabel +++| CONTYPE = 1; 00953 M01S00953.sslabel +++| CONVSN(TEMP$VSN,CONTYPE,FLAG); 00954 M01S00954.sslabel +++| IF FLAG NQ 0 00955 M01S00955.sslabel +++| THEN # NOT LEGAL CDC CHARACTER # 00956 M01S00956.sslabel +++| BEGIN 00957 M01S00957.sslabel +++| GOTO UNREC$LAB; # PROCESS THE ERROR # 00958 M01S00958.sslabel +++| END 00959 M01S00959.sslabel +++| 00960 M01S00960.sslabel +++| P<LABEL$CART> = OLDLABP; 00961 M01S00961.sslabel +++| 00962 M01S00962.sslabel +++| 00963 M01S00963.sslabel +++| 00964 M01S00964.sslabel +++|# 00965 M01S00965.sslabel +++|* CHECK FOR A FAMILY LABEL. 00966 M01S00966.sslabel +++|# 00967 M01S00967.sslabel +++| 00968 M01S00968.sslabel +++| IF (LAB$FMLY[0] NQ " ") AND (LAB$CARTTP[0] EQ 1) 00969 M01S00969.sslabel +++| THEN 00970 M01S00970.sslabel +++| BEGIN 00971 M01S00971.sslabel +++| LAB$TYPE = LABTYPE"FAM$LAB"; 00972 M01S00972.sslabel +++| RETURN; 00973 M01S00973.sslabel +++| END 00974 M01S00974.sslabel +++| 00975 M01S00975.sslabel +++|# 00976 M01S00976.sslabel +++|* CHECK FOR A SCRATCH LABEL. 00977 M01S00977.sslabel +++|# 00978 M01S00978.sslabel +++| 00979 M01S00979.sslabel +++| IF (LAB$FMLY[0] EQ " ") AND (LAB$CARTTP[0] EQ LABTYPE"SCR$LAB") 00980 M01S00980.sslabel +++| THEN 00981 M01S00981.sslabel +++| BEGIN 00982 M01S00982.sslabel +++| LAB$TYPE = LABTYPE"SCR$LAB"; 00983 M01S00983.sslabel +++| RETURN; 00984 M01S00984.sslabel +++| END 00985 M01S00985.sslabel +++| 00986 M01S00986.sslabel +++| LAB$TYPE = LABTYPE"MAN$LAB"; 00987 M01S00987.sslabel +++| RETURN; 00988 M01S00988.sslabel +++| 00989 M01S00989.sslabel +++| 00990 M01S00990.sslabel +++|UNREC$LAB: # UNRECOGNIZABLE LABEL # 00991 M01S00991.sslabel +++| LAB$TYPE = LABTYPE"UNR$LAB"; 00992 M01S00992.sslabel +++| RETURN; 00993 M01S00993.sslabel +++| 00994 M01S00994.sslabel +++| END # CKLAB # 00995 M01S00995.sslabel +++| 00996 M01S00996.sslabel +++| TERM 00997 M01S00997.sslabel +++|PROC CONVSN(DC$VSN,(CONTYPE),CONFLAG); 00998 M01S00998.sslabel +++|# TITLE CONVSN - CONVERTS CSN BETWEEN EBCDIC AND DISPLAY CODE. # 00999 M01S00999.sslabel +++| 01000 M01S01000.sslabel +++| BEGIN # CONVSN # 01001 M01S01001.sslabel +++| 01002 M01S01002.sslabel +++|# 01003 M01S01003.sslabel +++|** CONVSN - CONVERTS CSN BETWEEN EBCDIC AND DISPLAY CODE. 01004 M01S01004.sslabel +++|* 01005 M01S01005.sslabel +++|* THIS PROCEDURE CONVERTS THE CSN FROM EBCDIC TO DISPLAY CODE, 01006 M01S01006.sslabel +++|* OR FROM DISPLAY CODE TO EBCDIC. 01007 M01S01007.sslabel +++|* 01008 M01S01008.sslabel +++|* PROC CONVSN(DC$VSN,(CONTYPE),CONFLAG) 01009 M01S01009.sslabel +++|* 01010 M01S01010.sslabel +++|* ENTRY CONTYPE TYPE OF CONVERSION REQUESTED. 01011 M01S01011.sslabel +++|* 0, DISPLAY CODE TO EBCDIC. 01012 M01S01012.sslabel +++|* 1, EBCDIC TO DISPLAY CODE. 01013 M01S01013.sslabel +++|* DC$VSN AN ITEM CONTAINING CSN IN CDC 01014 M01S01014.sslabel +++|* DISPLAY CODE. 01015 M01S01015.sslabel +++|* OLDLABP AN ITEM CONTAINING FWA OF BUFFER 01016 M01S01016.sslabel +++|* CONTAINING OLD CARTRIDGE LABEL. 01017 M01S01017.sslabel +++|* 01018 M01S01018.sslabel +++|* EXIT CONFLAG BOOLEAN ITEM CONTAINING ERROR STATUS. 01019 M01S01019.sslabel +++|* FALSE, NO ERROR. 01020 M01S01020.sslabel +++|* TRUE, NOT A LEGAL CDC CHARACTER. 01021 M01S01021.sslabel +++|* 01022 M01S01022.sslabel +++|* NOTES PROC *CONVSN* CONVERTS THE EBCDIC CSN FROM 01023 M01S01023.sslabel +++|* *OLDLABEL* AND RETURNS A DISPLAY CODE CSN IN ITEM 01024 M01S01024.sslabel +++|* *DC$VSN*, OR IT CONVERTS THE DISPLAY CODE CSN FROM 01025 M01S01025.sslabel +++|* ITEM *DC$VSN* TO EBCDIC AND STORES THE RESULT IN 01026 M01S01026.sslabel +++|* ARRAY *OLDLABEL*. IF ANY CHARACTERS ARE NOT LEGAL 01027 M01S01027.sslabel +++|* CDC CHARACTERS (ALPHANUMERIC, EXCLUDING *O* AND *I*) 01028 M01S01028.sslabel +++|* ERROR FLAG *CONFLAG* IS SET. 01029 M01S01029.sslabel +++|# 01030 M01S01030.sslabel +++| 01031 M01S01031.sslabel +++| ITEM DC$VSN C(8); # CSN IN CDC DISPLAY CODE # 01032 M01S01032.sslabel +++| ITEM CONTYPE U; # TYPE OF CONVERSION # 01033 M01S01033.sslabel +++| ITEM CONFLAG B; # ERROR FLAG FOR ILLEGAL CSN # 01034 M01S01034.sslabel +++| 01035 M01S01035.sslabel +++|# 01036 M01S01036.sslabel +++|**** PROC CONVSN - XREF LIST BEGIN. 01037 M01S01037.sslabel +++|# 01038 M01S01038.sslabel +++| 01039 M01S01039.sslabel +++| XREF 01040 M01S01040.sslabel +++| BEGIN 01041 M01S01041.sslabel +++| PROC DCEBC; # CONVERTS BETWEEN EBCDIC AND 01042 M01S01042.sslabel +++| DISPLAY CODE # 01043 M01S01043.sslabel +++| END 01044 M01S01044.sslabel +++| 01045 M01S01045.sslabel +++|# 01046 M01S01046.sslabel +++|**** PROC CONVSN - XREF LIST END. 01047 M01S01047.sslabel +++|# 01048 M01S01048.sslabel +++| 01049 M01S01049.sslabel +++| DEF LISTCON #0#; # DO NOT LIST THE COMDECKS # 01050 M01S01050.sslabel +++|*CALL COMBFAS 01051 M01S01051.sslabel +++|*CALL COMBLBL 01052 M01S01052.sslabel +++|*CALL COMTLAB 01053 M01S01053.sslabel +++| 01054 M01S01054.sslabel +++| ITEM DCTEMP C(1); # TEMPORARY DISPLAY CODE ITEM # 01055 M01S01055.sslabel +++| ITEM EBCTEMP U; # TEMPORARY EBCDIC ITEM # 01056 M01S01056.sslabel +++| ITEM I I; # LOOP VARIABLE # 01057 M01S01057.sslabel +++| ITEM LEGCHAR B; # LEGAL CHARACTER FLAG # 01058 M01S01058.sslabel +++| 01059 M01S01059.sslabel +++| ARRAY EBC$VSN [1:12] P(1); # CONTAINS EBCDIC CHARACTERS # 01060 M01S01060.sslabel +++| BEGIN 01061 M01S01061.sslabel +++| ITEM EBC$CHAR U(00,00,60); # EBCDIC CHARACTER # 01062 M01S01062.sslabel +++| END 01063 M01S01063.sslabel +++| 01064 M01S01064.sslabel +++| CONTROL EJECT; 01065 M01S01065.sslabel +++| 01066 M01S01066.sslabel +++| P<LABEL$CART> = OLDLABP; # LABEL FORMAT DESCRIPTION # 01067 M01S01067.sslabel +++| CONFLAG = FALSE; 01068 M01S01068.sslabel +++| 01069 M01S01069.sslabel +++|# 01070 M01S01070.sslabel +++|* CONVERSION FROM DISPLAY CODE TO EBCDIC. 01071 M01S01071.sslabel +++|# 01072 M01S01072.sslabel +++| 01073 M01S01073.sslabel +++| IF CONTYPE EQ 0 01074 M01S01074.sslabel +++| THEN 01075 M01S01075.sslabel +++| BEGIN # DISPLAY TO EBCDIC CONVERSION # 01076 M01S01076.sslabel +++| SLOWFOR I = 0 STEP 1 UNTIL 7 01077 M01S01077.sslabel +++| DO 01078 M01S01078.sslabel +++| BEGIN 01079 M01S01079.sslabel +++| DCTEMP = C<I,1>DC$VSN; 01080 M01S01080.sslabel +++| IF DCTEMP EQ "I" ## 01081 M01S01081.sslabel +++| OR DCTEMP EQ "O" ## 01082 M01S01082.sslabel +++| OR DCTEMP LS "A" ## 01083 M01S01083.sslabel +++| OR DCTEMP GR "9" 01084 M01S01084.sslabel +++| THEN # ILLEGAL CDC CHARACTER # 01085 M01S01085.sslabel +++| BEGIN 01086 M01S01086.sslabel +++| CONFLAG = TRUE; 01087 M01S01087.sslabel +++| RETURN; 01088 M01S01088.sslabel +++| END 01089 M01S01089.sslabel +++| 01090 M01S01090.sslabel +++| DCEBC(DCTEMP,EBCTEMP,0); # CONVERT TO EBCDIC # 01091 M01S01091.sslabel +++| EBC$CHAR[I+1] = EBCTEMP; 01092 M01S01092.sslabel +++| END 01093 M01S01093.sslabel +++| 01094 M01S01094.sslabel +++| B<32,8>LAB$CSN[0] = B<52,8>EBC$CHAR[1]; 01095 M01S01095.sslabel +++| B<40,8>LAB$CSN[0] = B<52,8>EBC$CHAR[2]; 01096 M01S01096.sslabel +++| B<48,8>LAB$CSN[0] = B<52,8>EBC$CHAR[3]; 01097 M01S01097.sslabel +++| B<56,4>LAB$CSN[0] = B<52,4>EBC$CHAR[4]; 01098 M01S01098.sslabel +++| B<0,4>LAB$CSN[1] = B<56,4>EBC$CHAR[4]; 01099 M01S01099.sslabel +++| B<4,8>LAB$CSN[1] = B<52,8>EBC$CHAR[5]; 01100 M01S01100.sslabel +++| B<12,8>LAB$CSN[1] = B<52,8>EBC$CHAR[6]; 01101 M01S01101.sslabel +++| B<20,8>LAB$CSN[1] = B<52,8>EBC$CHAR[7]; 01102 M01S01102.sslabel +++| B<28,8>LAB$CSN[1] = B<52,8>EBC$CHAR[8]; 01103 M01S01103.sslabel +++| RETURN; 01104 M01S01104.sslabel +++| END # DISPLAY TO EBCDIC CONVERSION # 01105 M01S01105.sslabel +++| 01106 M01S01106.sslabel +++|# 01107 M01S01107.sslabel +++|* CONVERSION FROM EBCDIC TO DISPLAY CODE. 01108 M01S01108.sslabel +++|# 01109 M01S01109.sslabel +++| 01110 M01S01110.sslabel +++| IF CONTYPE EQ 1 01111 M01S01111.sslabel +++| THEN 01112 M01S01112.sslabel +++| BEGIN # EBCDIC TO DISPLAY CONVERSION # 01113 M01S01113.sslabel +++| EBC$CHAR[1] = B<32,8>LAB$CSN[0]; # SAVE EBCDIC BYTES # 01114 M01S01114.sslabel +++| EBC$CHAR[2] = B<40,8>LAB$CSN[0]; 01115 M01S01115.sslabel +++| EBC$CHAR[3] = B<48,8>LAB$CSN[0]; 01116 M01S01116.sslabel +++| B<52,4>EBC$CHAR[4] = B<56,4>LAB$CSN[0]; 01117 M01S01117.sslabel +++| B<56,4>EBC$CHAR[4] = B<0,4>LAB$CSN[1]; 01118 M01S01118.sslabel +++| EBC$CHAR[5] = B<4,8>LAB$CSN[1]; 01119 M01S01119.sslabel +++| EBC$CHAR[6] = B<12,8>LAB$CSN[1]; 01120 M01S01120.sslabel +++| EBC$CHAR[7] = B<20,8>LAB$CSN[1]; 01121 M01S01121.sslabel +++| EBC$CHAR[8] = B<28,8>LAB$CSN[1]; 01122 M01S01122.sslabel +++| LEGCHAR = TRUE; 01123 M01S01123.sslabel +++| 01124 M01S01124.sslabel +++| SLOWFOR I = 0 STEP 1 WHILE LEGCHAR AND I LQ 7 01125 M01S01125.sslabel +++| DO 01126 M01S01126.sslabel +++| BEGIN 01127 M01S01127.sslabel +++| DCEBC(DCTEMP,EBC$CHAR[I+1],1); # CONVERT TO DISPLAY CODE # 01128 M01S01128.sslabel +++| IF DCTEMP EQ "I" ## 01129 M01S01129.sslabel +++| OR DCTEMP EQ "O" ## 01130 M01S01130.sslabel +++| OR DCTEMP LS "A" ## 01131 M01S01131.sslabel +++| OR DCTEMP GR "9" 01132 M01S01132.sslabel +++| THEN # ILLEGAL CDC CHARACTER # 01133 M01S01133.sslabel +++| BEGIN 01134 M01S01134.sslabel +++| LEGCHAR = FALSE; 01135 M01S01135.sslabel +++| TEST I; 01136 M01S01136.sslabel +++| END 01137 M01S01137.sslabel +++| 01138 M01S01138.sslabel +++| C<I,1>DC$VSN = DCTEMP; 01139 M01S01139.sslabel +++| END 01140 M01S01140.sslabel +++| 01141 M01S01141.sslabel +++| IF NOT LEGCHAR 01142 M01S01142.sslabel +++| THEN # RETURN ERROR FLAG # 01143 M01S01143.sslabel +++| BEGIN 01144 M01S01144.sslabel +++| CONFLAG = TRUE; 01145 M01S01145.sslabel +++| END 01146 M01S01146.sslabel +++| 01147 M01S01147.sslabel +++| RETURN; 01148 M01S01148.sslabel +++| END # EBCDIC TO DISPLAY CONVERSION # 01149 M01S01149.sslabel +++| 01150 M01S01150.sslabel +++| END # CONVSN # 01151 M01S01151.sslabel +++| 01152 M01S01152.sslabel +++| TERM 01153 M01S01153.sslabel +++|PROC DCEBC(DC$ITEM,EBC$ITEM,FLAG); 01154 M01S01154.sslabel +++|# TITLE DCEBC - CONVERTS TO/FROM EBCDIC VALUES. # 01155 M01S01155.sslabel +++| 01156 M01S01156.sslabel +++| BEGIN # DCEBC # 01157 M01S01157.sslabel +++| 01158 M01S01158.sslabel +++|# 01159 M01S01159.sslabel +++|** DCEBC CONVERTS TO/FROM EBCDIC VALUES. 01160 M01S01160.sslabel +++|* 01161 M01S01161.sslabel +++|* THIS PROCEDURE CONVERTS AN ITEM FROM DISPLAY 01162 M01S01162.sslabel +++|* CODE TO EBCDIC (FLAG = 0), OR FROM EBCDIC TO 01163 M01S01163.sslabel +++|* DISPLAY CODE (FLAG = 1). 01164 M01S01164.sslabel +++|* 01165 M01S01165.sslabel +++|* PROC DCEBC(DC$ITEM,EBC$ITEM,FLAG) 01166 M01S01166.sslabel +++|* 01167 M01S01167.sslabel +++|* ENTRY FLAG, AN ITEM CONTAINING CODE FOR THE 01168 M01S01168.sslabel +++|* THE TYPE OF CONVERSION. 01169 M01S01169.sslabel +++|* 0, DISPLAY CODE TO EBCDIC. 01170 M01S01170.sslabel +++|* 1, EBCDIC TO DISPLAY CODE. 01171 M01S01171.sslabel +++|* DC$ITEM, DISPLAY CODE VALUE (IF FLAG=0). 01172 M01S01172.sslabel +++|* EBC$ITEM, EBCDIC VALUE (IF FLAG=1). 01173 M01S01173.sslabel +++|* 01174 M01S01174.sslabel +++|* EXIT CONVERSION DONE AND THE CONVERTED VALUE SET 01175 M01S01175.sslabel +++|* UP IN DC$ITEM (FLAG=1) OR EBC$ITEM(FLAG=0). 01176 M01S01176.sslabel +++|* (DC$ITEM) = 0, IF AN ILLEGAL CHARACTER. 01177 M01S01177.sslabel +++|* 01178 M01S01178.sslabel +++|* NOTES PROC *DCEBC* CONVERTS AN ITEM FROM DISPLAY 01179 M01S01179.sslabel +++|* CODE TO EBCDIC OR EBCDIC TO DISPLAY CODE 01180 M01S01180.sslabel +++|* VALUE DEPENDING ON THE VALUE OF FLAG. A 01181 M01S01181.sslabel +++|* TABLE HAS BEEN PRESET WITH THE EBCDIC VALUES. 01182 M01S01182.sslabel +++|* THE ORDINAL OF THE MATCHING EBCDIC VALUE GIVES 01183 M01S01183.sslabel +++|* THE DISPLAY CODE VALUE. 01184 M01S01184.sslabel +++|# 01185 M01S01185.sslabel +++| 01186 M01S01186.sslabel +++| ITEM DC$ITEM U; # DISPLAY CODE VALUE # 01187 M01S01187.sslabel +++| ITEM EBC$ITEM U; # EBCDIC VALUE # 01188 M01S01188.sslabel +++| ITEM FLAG I; # DIRECTION OF CONVERSION # 01189 M01S01189.sslabel +++| 01190 M01S01190.sslabel +++| DEF CTLEN #36#; # CONVERSION TABLE LENGTH # 01191 M01S01191.sslabel +++| 01192 M01S01192.sslabel +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS # 01193 M01S01193.sslabel +++|*CALL COMBFAS 01194 M01S01194.sslabel +++| 01195 M01S01195.sslabel +++| ITEM I I; # LOOP VARIABLE # 01196 M01S01196.sslabel +++| 01197 M01S01197.sslabel +++|# 01198 M01S01198.sslabel +++|* DISPLAY CODE / EBCDIC CONVERSION TABLE. 01199 M01S01199.sslabel +++|# 01200 M01S01200.sslabel +++| 01201 M01S01201.sslabel +++| ARRAY CONVTBL [1:CTLEN] P(1); # EBCDIC VALUE # 01202 M01S01202.sslabel +++| BEGIN 01203 M01S01203.sslabel +++| ITEM CONV$VAL U(00,00,08) = [X"C1", # A # 01204 M01S01204.sslabel +++| X"C2", # B # 01205 M01S01205.sslabel +++| X"C3", # C # 01206 M01S01206.sslabel +++| X"C4", # D # 01207 M01S01207.sslabel +++| X"C5", # E # 01208 M01S01208.sslabel +++| X"C6", # F # 01209 M01S01209.sslabel +++| X"C7", # G # 01210 M01S01210.sslabel +++| X"C8", # H # 01211 M01S01211.sslabel +++| X"C9", # I # 01212 M01S01212.sslabel +++| X"D1", # J # 01213 M01S01213.sslabel +++| X"D2", # K # 01214 M01S01214.sslabel +++| X"D3", # L # 01215 M01S01215.sslabel +++| X"D4", # M # 01216 M01S01216.sslabel +++| X"D5", # N # 01217 M01S01217.sslabel +++| X"D6", # O # 01218 M01S01218.sslabel +++| X"D7", # P # 01219 M01S01219.sslabel +++| X"D8", # Q # 01220 M01S01220.sslabel +++| X"D9", # R # 01221 M01S01221.sslabel +++| X"E2", # S # 01222 M01S01222.sslabel +++| X"E3", # T # 01223 M01S01223.sslabel +++| X"E4", # U # 01224 M01S01224.sslabel +++| X"E5", # V # 01225 M01S01225.sslabel +++| X"E6", # W # 01226 M01S01226.sslabel +++| X"E7", # X # 01227 M01S01227.sslabel +++| X"E8", # Y # 01228 M01S01228.sslabel +++| X"E9", # Z # 01229 M01S01229.sslabel +++| X"F0", # 0 # 01230 M01S01230.sslabel +++| X"F1", # 1 # 01231 M01S01231.sslabel +++| X"F2", # 2 # 01232 M01S01232.sslabel +++| X"F3", # 3 # 01233 M01S01233.sslabel +++| X"F4", # 4 # 01234 M01S01234.sslabel +++| X"F5", # 5 # 01235 M01S01235.sslabel +++| X"F6", # 6 # 01236 M01S01236.sslabel +++| X"F7", # 7 # 01237 M01S01237.sslabel +++| X"F8", # 8 # 01238 M01S01238.sslabel +++| X"F9"]; # 9 # 01239 M01S01239.sslabel +++| END 01240 M01S01240.sslabel +++| 01241 M01S01241.sslabel +++| CONTROL EJECT; 01242 M01S01242.sslabel +++| 01243 M01S01243.sslabel +++| IF FLAG EQ 1 01244 M01S01244.sslabel +++| THEN 01245 M01S01245.sslabel +++| BEGIN # CONVERT FROM EBCDIC TO DISPLAY CODE # 01246 M01S01246.sslabel +++| 01247 M01S01247.sslabel +++| SLOWFOR I = 1 STEP 1 UNTIL CTLEN 01248 M01S01248.sslabel +++| DO 01249 M01S01249.sslabel +++| BEGIN 01250 M01S01250.sslabel +++| IF CONV$VAL[I] EQ EBC$ITEM 01251 M01S01251.sslabel +++| THEN 01252 M01S01252.sslabel +++| BEGIN 01253 M01S01253.sslabel +++| B<0,6>DC$ITEM = I; 01254 M01S01254.sslabel +++| RETURN; 01255 M01S01255.sslabel +++| END 01256 M01S01256.sslabel +++| 01257 M01S01257.sslabel +++| END 01258 M01S01258.sslabel +++| 01259 M01S01259.sslabel +++| DC$ITEM = 0; # ILLEGAL CHARACTER # 01260 M01S01260.sslabel +++| RETURN; 01261 M01S01261.sslabel +++| END # CONVERT FROM EBCDIC TO DISPLAY CODE # 01262 M01S01262.sslabel +++| 01263 M01S01263.sslabel +++| ELSE 01264 M01S01264.sslabel +++| BEGIN # CONVERT FROM DISPLAY CODE TO EBCDIC # 01265 M01S01265.sslabel +++| I = B<0,6>DC$ITEM; 01266 M01S01266.sslabel +++| EBC$ITEM = CONV$VAL[I]; 01267 M01S01267.sslabel +++| RETURN; 01268 M01S01268.sslabel +++| END # CONVERT FROM DISPLAY CODE TO EBCDIC # 01269 M01S01269.sslabel +++| 01270 M01S01270.sslabel +++| END # DCEBC # 01271 M01S01271.sslabel +++| 01272 M01S01272.sslabel +++| TERM 01273 M01S01273.sslabel +++|PROC DLABFLD; 01274 M01S01274.sslabel +++|# TITLE DLABFLD - DISPLAYS FIELDS IN THE CARTRIDGE LABEL. # 01275 M01S01275.sslabel +++| 01276 M01S01276.sslabel +++| BEGIN # DLABFLD # 01277 M01S01277.sslabel +++| 01278 M01S01278.sslabel +++|# 01279 M01S01279.sslabel +++|** DLABFLD - DISPLAYS FIELDS IN THE CARTRIDGE LABEL. 01280 M01S01280.sslabel +++|* 01281 M01S01281.sslabel +++|* PROC DLABFLD. 01282 M01S01282.sslabel +++|* 01283 M01S01283.sslabel +++|* ENTRY (OLDLABP) = FWA OF BUFFER CONTAINING 01284 M01S01284.sslabel +++|* CARTRIDGE LABEL. 01285 M01S01285.sslabel +++|* 01286 M01S01286.sslabel +++|* EXIT ALL APPROPRIATE FIELDS ARE DISPLAYED IN THE 01287 M01S01287.sslabel +++|* DAYFILE AND IN THE REPORT FILE. 01288 M01S01288.sslabel +++|* 01289 M01S01289.sslabel +++|* MESSAGES 1) CSN = XXXXXXXX. 01290 M01S01290.sslabel +++|* 2) FAMILY = XXXXXXX. 01291 M01S01291.sslabel +++|* 3) SUBFAMILY = X. 01292 M01S01292.sslabel +++| 4) SM = X. 01293 M01S01293.sslabel +++|* 5) X = X. 01294 M01S01294.sslabel +++|* 6) Y = X. 01295 M01S01295.sslabel +++|* 01296 M01S01296.sslabel +++|* NOTES PROC *DLABFLD* CALLS *CONVSN* AND *XCDD* TO 01297 M01S01297.sslabel +++|* CONVERT ALL FIELDS TO DISPLAY CODE. THE APPROPRIATE 01298 M01S01298.sslabel +++|* FIELDS FROM THE OLD CARTRIDGE LABEL ARE THEN DISPLAYED 01299 M01S01299.sslabel +++|* IN THE DAYFILE AND IN THE REPORT FILE. 01300 M01S01300.sslabel +++|# 01301 M01S01301.sslabel +++| 01302 M01S01302.sslabel +++|# 01303 M01S01303.sslabel +++|**** PROC DLABFLD - XREF LIST BEGIN. 01304 M01S01304.sslabel +++|# 01305 M01S01305.sslabel +++| 01306 M01S01306.sslabel +++| XREF 01307 M01S01307.sslabel +++| BEGIN 01308 M01S01308.sslabel +++| PROC BZFILL; # BLANK/ZERO FILLS A BUFFER # 01309 M01S01309.sslabel +++| PROC CONVSN; # CONVERTS VSN FROM EBCDIC TO 01310 M01S01310.sslabel +++| DISPLAY CODE # 01311 M01S01311.sslabel +++| PROC LBERR; # ERROR PROCESSOR # 01312 M01S01312.sslabel +++| PROC MESSAGE; # DISPLAYS DAYFILE MESSAGES # 01313 M01S01313.sslabel +++| PROC RPLINE; # WRITES A LINE ON OUTPUT FILE # 01314 M01S01314.sslabel +++| FUNC XCDD C(10); # CONVERTS ITEMS FROM INTEGERS TO 01315 M01S01315.sslabel +++| DISPLAY CODE # 01316 M01S01316.sslabel +++| END 01317 M01S01317.sslabel +++| 01318 M01S01318.sslabel +++|# 01319 M01S01319.sslabel +++|**** PROC DLABFLD - XREF LIST END. 01320 M01S01320.sslabel +++|# 01321 M01S01321.sslabel +++| 01322 M01S01322.sslabel +++| DEF PROCNAME #"DLABFLD."#; # PROC NAME # 01323 M01S01323.sslabel +++| 01324 M01S01324.sslabel +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS # 01325 M01S01325.sslabel +++|*CALL COMBFAS 01326 M01S01326.sslabel +++|*CALL COMBBZF 01327 M01S01327.sslabel +++|*CALL COMBLBL 01328 M01S01328.sslabel +++|*CALL COMTERR 01329 M01S01329.sslabel +++|*CALL COMTLAB 01330 M01S01330.sslabel +++|*CALL COMTOUT 01331 M01S01331.sslabel +++| 01332 M01S01332.sslabel +++| ITEM CONFLAG B; # CONVERSION FLAG # 01333 M01S01333.sslabel +++| ITEM CONTYPE I; # TYPE OF CONVERSION # 01334 M01S01334.sslabel +++| ITEM DIS$SUB C(10); # SUBFAMILY IN DISPLAY CODE # 01335 M01S01335.sslabel +++| ITEM DIS$VSN C(8); # *CSN* IN DISPLAY CODE # 01336 M01S01336.sslabel +++| ITEM DIS$Y C(10); # Y COORDINATE IN DISPLAY CODE # 01337 M01S01337.sslabel +++| ITEM DIS$Z C(10); # Z COORDINATE IN DISPLAY CODE # 01338 M01S01338.sslabel +++| ITEM TEMP C(7); # TEMPORARY ITEM # 01339 M01S01339.sslabel +++| 01340 M01S01340.sslabel +++| ARRAY LABFLD [0:0] P(4); # DISPLAY FIELDS ARRAY # 01341 M01S01341.sslabel +++| BEGIN 01342 M01S01342.sslabel +++| ITEM LABMSG C(00,00,38); # MESSAGE DISPLAY FIELD # 01343 M01S01343.sslabel +++| ITEM LABY C(00,30,02); # Y COORDINATE IN DISPLAY # 01344 M01S01344.sslabel +++| ITEM LABZ C(00,30,02); # Z COORDINATE IN DISPLAY # 01345 M01S01345.sslabel +++| ITEM LABCSU C(00,42,01); # *SM* IN DISPLAY CODE # 01346 M01S01346.sslabel +++| ITEM LABCM C(00,42,02); # CARTRIDGE MANUFACTURER # 01347 M01S01347.sslabel +++| ITEM LABVSN C(00,42,08); # *CSN* IN DISPLAY CODE # 01348 M01S01348.sslabel +++| ITEM LABFAM C(01,00,07); # FAMILY IN DISPLAY CODE # 01349 M01S01349.sslabel +++| ITEM LABSUB C(01,18,01); # SUBFAMILY IN DISPLAY CODE # 01350 M01S01350.sslabel +++| ITEM LABTERM U(03,48,12) = [0]; # TERMINATOR # 01351 M01S01351.sslabel +++| END 01352 M01S01352.sslabel +++| 01353 M01S01353.sslabel +++| CONTROL EJECT; 01354 M01S01354.sslabel +++| 01355 M01S01355.sslabel +++|# 01356 M01S01356.sslabel +++|* CONVERT EACH BYTE IN *CSN* TO DISPLAY CODE. 01357 M01S01357.sslabel +++|# 01358 M01S01358.sslabel +++| 01359 M01S01359.sslabel +++| CONTYPE = 1; 01360 M01S01360.sslabel +++| CONVSN(DIS$VSN,CONTYPE,CONFLAG); 01361 M01S01361.sslabel +++| IF CONFLAG 01362 M01S01362.sslabel +++| THEN # ILLEGAL *CSN* # 01363 M01S01363.sslabel +++| BEGIN 01364 M01S01364.sslabel +++| ERRCODE = S"ILLEG$C"; 01365 M01S01365.sslabel +++| LBERR(ERRCODE); 01366 M01S01366.sslabel +++| END 01367 M01S01367.sslabel +++| 01368 M01S01368.sslabel +++|# 01369 M01S01369.sslabel +++|* DISPLAY CARTRIDGE MANUFACTURER. 01370 M01S01370.sslabel +++|# 01371 M01S01371.sslabel +++| 01372 M01S01372.sslabel +++| P<LABEL$CART> = OLDLABP; 01373 M01S01373.sslabel +++| LABMSG[0] = " CM = "; 01374 M01S01374.sslabel +++| LABCM[0] = LAB$CCOD[0]; 01375 M01S01375.sslabel +++| MESSAGE(LABFLD[0],UDFL1); 01376 M01S01376.sslabel +++| RPLINE(OUT$FETP,"CM = ",8,8,1); 01377 M01S01377.sslabel +++| RPLINE(OUT$FETP,LABCM[0],14,2,0); 01378 M01S01378.sslabel +++| 01379 M01S01379.sslabel +++| 01380 M01S01380.sslabel +++|# 01381 M01S01381.sslabel +++|* DISPLAY *CSN* IN DAYFILE AND IN REPORT FILE. 01382 M01S01382.sslabel +++|# 01383 M01S01383.sslabel +++| 01384 M01S01384.sslabel +++| LABMSG[0] = " CSN = "; 01385 M01S01385.sslabel +++| LABVSN[0] = DIS$VSN; 01386 M01S01386.sslabel +++| MESSAGE(LABFLD[0],UDFL1); 01387 M01S01387.sslabel +++| RPLINE(OUT$FETP,"CSN = ",8,8,1); 01388 M01S01388.sslabel +++| RPLINE(OUT$FETP,DIS$VSN,14,8,0); 01389 M01S01389.sslabel +++| 01390 M01S01390.sslabel +++| 01391 M01S01391.sslabel +++| 01392 M01S01392.sslabel +++|# 01393 M01S01393.sslabel +++|* DISPLAY FAMILY AND SUBFAMILY FOR A FAMILY LABEL. 01394 M01S01394.sslabel +++|# 01395 M01S01395.sslabel +++| 01396 M01S01396.sslabel +++| IF LAB$FMLY[0] NQ " " 01397 M01S01397.sslabel +++| THEN 01398 M01S01398.sslabel +++| BEGIN # DISPLAY FAMILY/SUBFAMILY # 01399 M01S01399.sslabel +++| TEMP = LAB$FMLY[0]; # BLANK FILL FAMILY NAME # 01400 M01S01400.sslabel +++| BZFILL(TEMP,TYPFILL"BFILL",7); 01401 M01S01401.sslabel +++| LABMSG[0] = " FAMILY = "; 01402 M01S01402.sslabel +++| LABFAM[0] = TEMP; 01403 M01S01403.sslabel +++| MESSAGE(LABFLD[0],UDFL1); 01404 M01S01404.sslabel +++| RPLINE(OUT$FETP,"FAMILY = ",8,9,1); 01405 M01S01405.sslabel +++| RPLINE(OUT$FETP,TEMP,17,7,0); 01406 M01S01406.sslabel +++| 01407 M01S01407.sslabel +++| DIS$SUB = XCDD(LAB$SF[0]); 01408 M01S01408.sslabel +++| LABMSG[0] = " SUBFAMILY"; 01409 M01S01409.sslabel +++| LABFAM[0] = " = "; 01410 M01S01410.sslabel +++| LABSUB[0] = C<9,1>DIS$SUB; 01411 M01S01411.sslabel +++| MESSAGE(LABFLD[0],UDFL1); 01412 M01S01412.sslabel +++| RPLINE(OUT$FETP,"SUBFAMILY = ",8,12,1); 01413 M01S01413.sslabel +++| RPLINE(OUT$FETP,LABSUB[0],20,1,0); 01414 M01S01414.sslabel +++| END # DISPLAY FAMILY/SUBFAMILY # 01415 M01S01415.sslabel +++| 01416 M01S01416.sslabel +++|# 01417 M01S01417.sslabel +++|* DISPLAY *SM* IDENTIFIER. 01418 M01S01418.sslabel +++|# 01419 M01S01419.sslabel +++| 01420 M01S01420.sslabel +++| LABMSG[0] = " SM = "; 01421 M01S01421.sslabel +++| LABCSU[0] = LAB$SMID[0]; 01422 M01S01422.sslabel +++| MESSAGE(LABFLD[0],UDFL1); 01423 M01S01423.sslabel +++| RPLINE(OUT$FETP,"SM = ",8,6,1); 01424 M01S01424.sslabel +++| RPLINE(OUT$FETP,LABCSU[0],14,1,0); 01425 M01S01425.sslabel +++| 01426 M01S01426.sslabel +++|# 01427 M01S01427.sslabel +++|* DISPLAY Y,Z COORDINATES. 01428 M01S01428.sslabel +++|# 01429 M01S01429.sslabel +++| 01430 M01S01430.sslabel +++| DIS$Y = XCDD(LAB$Y[0]); 01431 M01S01431.sslabel +++| LABMSG[0] = " Y = "; 01432 M01S01432.sslabel +++| LABY[0] = C<8,2>DIS$Y; 01433 M01S01433.sslabel +++| MESSAGE(LABFLD[0],UDFL1); 01434 M01S01434.sslabel +++| RPLINE(OUT$FETP,"Y = ",8,4,1); 01435 M01S01435.sslabel +++| RPLINE(OUT$FETP,LABY[0],12,2,0); 01436 M01S01436.sslabel +++| 01437 M01S01437.sslabel +++| DIS$Z = XCDD(LAB$Z[0]); 01438 M01S01438.sslabel +++| LABMSG[0] = " Z = "; 01439 M01S01439.sslabel +++| LABZ[0] = C<8,2>DIS$Z; 01440 M01S01440.sslabel +++| MESSAGE(LABFLD[0],UDFL1); 01441 M01S01441.sslabel +++| RPLINE(OUT$FETP,"Z = ",8,4,1); 01442 M01S01442.sslabel +++| RPLINE(OUT$FETP,LABZ[0],12,2,0); 01443 M01S01443.sslabel +++| 01444 M01S01444.sslabel +++| RETURN; 01445 M01S01445.sslabel +++| 01446 M01S01446.sslabel +++| END # DLABFLD # 01447 M01S01447.sslabel +++| 01448 M01S01448.sslabel +++| TERM 01449 M01S01449.sslabel +++|PROC GENLAB((LAB$TYPE),PT$CSU$ENT,(LD$CNT),(LD$ERR),(SR$ERR), ( 01450 M01S01450.sslabel +++| STR$RD),(STR$WR),(STR$DM)); 01451 M01S01451.sslabel +++|# TITLE GENLAB - SETS UP A FAMILY OR SCRATCH LABEL. # 01452 M01S01452.sslabel +++| 01453 M01S01453.sslabel +++| BEGIN # GENLAB # 01454 M01S01454.sslabel +++| 01455 M01S01455.sslabel +++|# 01456 M01S01456.sslabel +++|** GENLAB - SETS UP A FAMILY OR SCRATCH LABEL. 01457 M01S01457.sslabel +++|* 01458 M01S01458.sslabel +++|* THIS PROCEDURE SETS UP A FAMILY OR SCRATCH 01459 M01S01459.sslabel +++|* LABEL DEPENDING UPON THE *LABTYPE* SPECIFIED. 01460 M01S01460.sslabel +++|* 01461 M01S01461.sslabel +++|* PROC GENLAB((LAB$TYPE),PT$CSU$ENT,(LD$CNT),(LD$ERR), 01462 M01S01462.sslabel +++|* (SR$ERR),(SW$ERR),(HR$ERR)) 01463 M01S01463.sslabel +++|* 01464 M01S01464.sslabel +++|* ENTRY PT$CSU$ENT AN ARRAY CONTAINING THE 01465 M01S01465.sslabel +++|* SMMAP ENTRY. 01466 M01S01466.sslabel +++|* LD$CNT AN ITEM CONTAINING THE 01467 M01S01467.sslabel +++|* CARTRIDGE LOAD COUNT. 01468 M01S01468.sslabel +++|* LD$ERR AN ITEM CONTAINING A COUNT OF 01469 M01S01469.sslabel +++|* LOAD ERRORS. 01470 M01S01470.sslabel +++|* SR$ERR AN ITEM CONTAINING A COUNT OF 01471 M01S01471.sslabel +++|* SOFT READ ERRORS. 01472 M01S01472.sslabel +++|* SW$ERR AN ITEM CONTAINING A COUNT OF 01473 M01S01473.sslabel +++|* SOFT WRITE ERRORS. 01474 M01S01474.sslabel +++|* HR$ERR AN ITEM CONTAINING A COUNT OF 01475 M01S01475.sslabel +++|* HARD READ ERRORS. 01476 M01S01476.sslabel +++|* STR$RD AN ITEM CONTAINING A COUNT OF 01477 M01S01477.sslabel +++|* STRIPES WRITTEN. 01478 M01S01478.sslabel +++|* STR$WR AN ITEM CONTAINING A COUNT OF 01479 M01S01479.sslabel +++|* STRIPES READ. 01480 M01S01480.sslabel +++|* STR$DM AN ITEM CONTAINING A COUNT OF 01481 M01S01481.sslabel +++|* STRIPES DEMARKED. 01482 M01S01482.sslabel +++|* NEWLABP AN ITEM CONTAINING FWA OF BUFFER 01483 M01S01483.sslabel +++|* CONTAINING NEW CARTRIDGE LABEL. 01484 M01S01484.sslabel +++|* DRD$NUM AN ITEM CONTAINING TRANSPORT ID. 01485 M01S01485.sslabel +++|* 01486 M01S01486.sslabel +++|* EXIT LABEL SET UP IN *NEWLABEL*. 01487 M01S01487.sslabel +++|* 01488 M01S01488.sslabel +++|* NOTES PROC *GENLAB* SETS UP THE FIELDS FOR 01489 M01S01489.sslabel +++|* A FAMILY OR SCRATCH LABEL FOR A CARTRIDGE. 01490 M01S01490.sslabel +++|# 01491 M01S01491.sslabel +++| 01492 M01S01492.sslabel +++| ITEM LAB$TYPE U; # TYPE OF CARTRIDGE LABEL # 01493 M01S01493.sslabel +++| 01494 M01S01494.sslabel +++| ARRAY PT$CSU$ENT [0:0] P(5); # *PUT* SMMAP ENTRY # 01495 M01S01495.sslabel +++| BEGIN 01496 M01S01496.sslabel +++| ITEM PT$MAPENT C(00,00,30); # THREE WORD MAP ENTRY # 01497 M01S01497.sslabel +++| ITEM PT$Y U(03,00,30); # Y COORDINATE # 01498 M01S01498.sslabel +++| ITEM PT$Z U(03,30,30); # Z COORDINATE # 01499 M01S01499.sslabel +++| ITEM PT$GR U(04,00,07); # GROUP # 01500 M01S01500.sslabel +++| ITEM PT$GRT U(04,07,04); # GROUP ORDINAL # 01501 M01S01501.sslabel +++| END 01502 M01S01502.sslabel +++| 01503 M01S01503.sslabel +++| 01504 M01S01504.sslabel +++| ITEM LD$CNT I; # CARTRIDGE LOAD COUNT # 01505 M01S01505.sslabel +++| ITEM PS$CNT I; # CARTRIDGE PASS COUNT # 01506 M01S01506.sslabel +++| ITEM ERR$CNT I; # CARTRIDGE ERROR COUNT # 01507 M01S01507.sslabel +++| 01508 M01S01508.sslabel +++|# 01509 M01S01509.sslabel +++|**** PROC GENLAB - XREF LIST BEGIN. 01510 M01S01510.sslabel +++|# 01511 M01S01511.sslabel +++| 01512 M01S01512.sslabel +++| XREF 01513 M01S01513.sslabel +++| BEGIN 01514 M01S01514.sslabel +++| PROC CONVSN; # CONVERTS VSN FROM EBCDIC TO 01515 M01S01515.sslabel +++| DISPLAY CODE # 01516 M01S01516.sslabel +++| PROC LBERR; # ERROR PROCESSOR # 01517 M01S01517.sslabel +++| END 01518 M01S01518.sslabel +++| 01519 M01S01519.sslabel +++|# 01520 M01S01520.sslabel +++|**** PROC GENLAB - XREF LIST END. 01521 M01S01521.sslabel +++|# 01522 M01S01522.sslabel +++| 01523 M01S01523.sslabel +++| DEF PROCNAME #"GENLAB."#; # PROC NAME # 01524 M01S01524.sslabel +++| 01525 M01S01525.sslabel +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS # 01526 M01S01526.sslabel +++|*CALL COMBFAS 01527 M01S01527.sslabel +++|*CALL COMBLBL 01528 M01S01528.sslabel +++|*CALL COMBMAP 01529 M01S01529.sslabel +++|*CALL COMTERR 01530 M01S01530.sslabel +++|*CALL COMTLAB 01531 M01S01531.sslabel +++|*CALL COMTLBP 01532 M01S01532.sslabel +++| 01533 M01S01533.sslabel +++| ITEM CONTYPE I; # TYPE OF CONVERSION # 01534 M01S01534.sslabel +++| ITEM FLAG I; # ERROR FLAG # 01535 M01S01535.sslabel +++| ITEM HR$ERR I; # HARD READ ERRORS # 01536 M01S01536.sslabel +++| ITEM I I; # LOOP VARIABLE # 01537 M01S01537.sslabel +++| ITEM LD$ERR I; # LOAD ERRORS # 01538 M01S01538.sslabel +++| ITEM TEMP$VSN C(8); # CSN IN CDC DISPLAY CODE # 01539 M01S01539.sslabel +++| ITEM SR$ERR I; # SOFT READ ERRORS # 01540 M01S01540.sslabel +++| ITEM STR$RD I; # STRIPES READ # 01541 M01S01541.sslabel +++| ITEM STR$WR I; # STRIPES WRITTEN # 01542 M01S01542.sslabel +++| ITEM STR$DM I; # STRIPES DEMARKED # 01543 M01S01543.sslabel +++| ITEM SW$ERR I; # SOFT WRITE ERRORS # 01544 M01S01544.sslabel +++| 01545 M01S01545.sslabel +++|# 01546 M01S01546.sslabel +++|* BASED ARRAY TO ACCESS FIRST FOUR WORDS OF CARTRIDGE LABEL. 01547 M01S01547.sslabel +++|# 01548 M01S01548.sslabel +++| 01549 M01S01549.sslabel +++| BASED 01550 M01S01550.sslabel +++| ARRAY TEMP$LAB [0:0] P(1); 01551 M01S01551.sslabel +++| BEGIN 01552 M01S01552.sslabel +++| ITEM TEMP$LABW U(00,00,60); # FIRST WORD OF LABEL # 01553 M01S01553.sslabel +++| END 01554 M01S01554.sslabel +++| 01555 M01S01555.sslabel +++| CONTROL EJECT; 01556 M01S01556.sslabel +++| 01557 M01S01557.sslabel +++|# 01558 M01S01558.sslabel +++|* ZERO FILL THE *NEWLABEL* ARRAY. 01559 M01S01559.sslabel +++|# 01560 M01S01560.sslabel +++| 01561 M01S01561.sslabel +++| P<LABEL$CART> = NEWLABP; 01562 M01S01562.sslabel +++| SLOWFOR I = 0 STEP 1 UNTIL LABLEN-1 01563 M01S01563.sslabel +++| DO 01564 M01S01564.sslabel +++| BEGIN 01565 M01S01565.sslabel +++| LAB$W1[I] = 0; 01566 M01S01566.sslabel +++| END 01567 M01S01567.sslabel +++| 01568 M01S01568.sslabel +++|# 01569 M01S01569.sslabel +++|* SET THE FIRST 4 WORDS WORDS OF *NEWLABEL* 01570 M01S01570.sslabel +++|* EQUAL TO THE FIRST 4 WORDS OF *OLDLABEL*. 01571 M01S01571.sslabel +++|# 01572 M01S01572.sslabel +++| 01573 M01S01573.sslabel +++| P<LABEL$CART> = OLDLABP; 01574 M01S01574.sslabel +++| P<TEMP$LAB> = NEWLABP; 01575 M01S01575.sslabel +++| SLOWFOR I = 0 STEP 1 UNTIL 3 01576 M01S01576.sslabel +++| DO 01577 M01S01577.sslabel +++| BEGIN 01578 M01S01578.sslabel +++| TEMP$LABW[I] = LAB$W1[I]; 01579 M01S01579.sslabel +++| END 01580 M01S01580.sslabel +++| 01581 M01S01581.sslabel +++|# 01582 M01S01582.sslabel +++|* CONVERT EACH OF THE SIX EBCDIC BYTES IN *OLDLABEL* 01583 M01S01583.sslabel +++|* TO DISPLAY CODE. 01584 M01S01584.sslabel +++|# 01585 M01S01585.sslabel +++| 01586 M01S01586.sslabel +++| CONTYPE = 1; 01587 M01S01587.sslabel +++| CONVSN(TEMP$VSN,CONTYPE,FLAG); 01588 M01S01588.sslabel +++| IF FLAG NQ 0 01589 M01S01589.sslabel +++| THEN # ILLEGAL VSN # 01590 M01S01590.sslabel +++| BEGIN 01591 M01S01591.sslabel +++| ERRCODE = S"ILLEG$C"; 01592 M01S01592.sslabel +++| LBERR(ERRCODE); 01593 M01S01593.sslabel +++| END 01594 M01S01594.sslabel +++| 01595 M01S01595.sslabel +++| P<LABEL$CART> = NEWLABP; 01596 M01S01596.sslabel +++| P<SMUMAP> = LOC(PT$CSU$ENT[0]); 01597 M01S01597.sslabel +++| 01598 M01S01598.sslabel +++|# 01599 M01S01599.sslabel +++|* SET UP VARIOUS FIELDS IN *NEWLABEL*. 01600 M01S01600.sslabel +++|# 01601 M01S01601.sslabel +++| 01602 M01S01602.sslabel +++| LAB$CSND[0] = TEMP$VSN; 01603 M01S01603.sslabel +++| LAB$Y[0] = PT$Y[0]; 01604 M01S01604.sslabel +++| LAB$Z[0] = PT$Z[0]; 01605 M01S01605.sslabel +++| LAB$FMLY[0] = CM$FMLYNM[0]; 01606 M01S01606.sslabel +++| LAB$SF[0] = CM$SUB[0]; 01607 M01S01607.sslabel +++| LAB$SMID[0] = LBARG$SM[0]; 01608 M01S01608.sslabel +++| LAB$CLF[0] = 1; 01609 M01S01609.sslabel +++| 01610 M01S01610.sslabel +++|# 01611 M01S01611.sslabel +++|* SET UP *P* FLAG. 01612 M01S01612.sslabel +++|# 01613 M01S01613.sslabel +++| 01614 M01S01614.sslabel +++| IF LAB$TYPE EQ LABTYPE"SCR$LAB" 01615 M01S01615.sslabel +++| THEN # A SCRATCH LABEL # 01616 M01S01616.sslabel +++| BEGIN 01617 M01S01617.sslabel +++| LAB$CARTTP[0] = 2; 01618 M01S01618.sslabel +++| END 01619 M01S01619.sslabel +++| 01620 M01S01620.sslabel +++| ELSE # A FAMILY LABEL # 01621 M01S01621.sslabel +++| BEGIN 01622 M01S01622.sslabel +++| LAB$CARTTP[0] = 1; 01623 M01S01623.sslabel +++| END 01624 M01S01624.sslabel +++| 01625 M01S01625.sslabel +++| 01626 M01S01626.sslabel +++|# 01627 M01S01627.sslabel +++|* SET UP THE LOAD COUNT, LOAD ERRORS, SOFT READ/WRITE 01628 M01S01628.sslabel +++|* AND HARD READ ERRORS. 01629 M01S01629.sslabel +++|* FOR THE CARTRIDGE. 01630 M01S01630.sslabel +++|# 01631 M01S01631.sslabel +++| 01632 M01S01632.sslabel +++| LAB$CRLD[0] = LD$CNT; 01633 M01S01633.sslabel +++| LAB$LDER = LD$ERR; 01634 M01S01634.sslabel +++| LAB$SWRE = B<28,4>SW$ERR; 01635 M01S01635.sslabel +++| LAB$SWRE1 = B<32,28>SW$ERR; 01636 M01S01636.sslabel +++| LAB$SRDE = SR$ERR; 01637 M01S01637.sslabel +++| LAB$HRDE = HR$ERR; 01638 M01S01638.sslabel +++| LAB$STRD[0] = B<28,8>STR$RD; 01639 M01S01639.sslabel +++| LAB$STWR1[0] = B<36,24>STR$WR; 01640 M01S01640.sslabel +++| LAB$STWR[0] = STR$WR; 01641 M01S01641.sslabel +++| LAB$STDM[0] = STR$DM; 01642 M01S01642.sslabel +++| 01643 M01S01643.sslabel +++|# 01644 M01S01644.sslabel +++|* SET UP NUMBER OF THE TRANSPORT ON WHICH 01645 M01S01645.sslabel +++|* LABEL WAS WRITTEN. ALSO SET UP THE DATE 01646 M01S01646.sslabel +++|* AND TIME WHEN LABEL WAS WRITTEN. 01647 M01S01647.sslabel +++|# 01648 M01S01648.sslabel +++| 01649 M01S01649.sslabel +++| LAB$DTTM[0] = PD$T; 01650 M01S01650.sslabel +++| 01651 M01S01651.sslabel +++| RETURN; 01652 M01S01652.sslabel +++| 01653 M01S01653.sslabel +++| END # GENLAB # 01654 M01S01654.sslabel +++| 01655 M01S01655.sslabel +++| TERM 01656 M01S01656.sslabel +++|PROC LBADCSU; 01657 M01S01657.sslabel +++|# TITLE LBADCSU - ADDS A *SM* TO A SUBFAMILY. # 01658 M01S01658.sslabel +++| 01659 M01S01659.sslabel +++| BEGIN # LBADCSU # 01660 M01S01660.sslabel +++| 01661 M01S01661.sslabel +++|# 01662 M01S01662.sslabel +++|** LBADCSU - ADDS A *SM* TO A SUBFAMILY. 01663 M01S01663.sslabel +++|* 01664 M01S01664.sslabel +++|* THIS PROCEDURE ADDS A *SM* TO A FAMILY 01665 M01S01665.sslabel +++|* IN THE CATALOG. THIS DIRECTIVE DOES NOT 01666 M01S01666.sslabel +++|* MANIPULATE CUBES OR CARTRIDGES. 01667 M01S01667.sslabel +++|* 01668 M01S01668.sslabel +++|* PROC LBADCSU. 01669 M01S01669.sslabel +++|* 01670 M01S01670.sslabel +++|* ENTRY CRACKED AND SYNTAX CHECKED DIRECTIVE PARAMETERS 01671 M01S01671.sslabel +++|* SET UP IN COMMON AREA DEFINED IN *COMTLBP*. 01672 M01S01672.sslabel +++|* 01673 M01S01673.sslabel +++|* EXIT *SM* ADDED TO THE SPECIFIED FAMILY. 01674 M01S01674.sslabel +++|* 01675 M01S01675.sslabel +++|* NOTES PROC *LBADCSU* SENDS A REQUEST TO EXEC TO ADD 01676 M01S01676.sslabel +++|* THE *SM* TO THE FAMILY CATALOG. IF THE *SM* IS 01677 M01S01677.sslabel +++|* ALREADY DEFINED, IT CALLS THE ERROR PROCESSOR 01678 M01S01678.sslabel +++|* WITH THE CORRESPONDING ERROR CODE. SEE *LBERR* 01679 M01S01679.sslabel +++|* FOR FURTHER INFORMATION. 01680 M01S01680.sslabel +++|# 01681 M01S01681.sslabel +++| 01682 M01S01682.sslabel +++|# 01683 M01S01683.sslabel +++|**** PROC LBADCSU - XREF LIST BEGIN. 01684 M01S01684.sslabel +++|# 01685 M01S01685.sslabel +++| 01686 M01S01686.sslabel +++| XREF 01687 M01S01687.sslabel +++| BEGIN 01688 M01S01688.sslabel +++| PROC CALL3; # SENDS TYPE 3 CALLSS TO EXEC # 01689 M01S01689.sslabel +++| PROC LBRESP; # RESPONSE CODE PROCESSOR # 01690 M01S01690.sslabel +++| END 01691 M01S01691.sslabel +++| 01692 M01S01692.sslabel +++|# 01693 M01S01693.sslabel +++|**** PROC LBADCSU - XREF LIST END. 01694 M01S01694.sslabel +++|# 01695 M01S01695.sslabel +++| 01696 M01S01696.sslabel +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS # 01697 M01S01697.sslabel +++|*CALL COMBFAS 01698 M01S01698.sslabel +++|*CALL COMBCPR 01699 M01S01699.sslabel +++| 01700 M01S01700.sslabel +++| ITEM RESP$CODE U; # RESPONSE CODE FROM EXEC # 01701 M01S01701.sslabel +++| 01702 M01S01702.sslabel +++| CONTROL EJECT; 01703 M01S01703.sslabel +++| 01704 M01S01704.sslabel +++|# 01705 M01S01705.sslabel +++|* ADD *SM* TO FAMILY CATALOG. 01706 M01S01706.sslabel +++|# 01707 M01S01707.sslabel +++| 01708 M01S01708.sslabel +++| CALL3(REQTYP3"ADD$CSU",0,0,0,RESP$CODE); 01709 M01S01709.sslabel +++| 01710 M01S01710.sslabel +++|# 01711 M01S01711.sslabel +++|* PROCESS THE RESPONSE CODE RETURNED BY EXEC. 01712 M01S01712.sslabel +++|# 01713 M01S01713.sslabel +++| 01714 M01S01714.sslabel +++| IF RESP$CODE NQ RESPTYP3"OK3" 01715 M01S01715.sslabel +++| THEN 01716 M01S01716.sslabel +++| BEGIN 01717 M01S01717.sslabel +++| LBRESP(RESP$CODE,TYP"TYP3"); 01718 M01S01718.sslabel +++| END 01719 M01S01719.sslabel +++| 01720 M01S01720.sslabel +++| RETURN; 01721 M01S01721.sslabel +++| 01722 M01S01722.sslabel +++| END # LBADCSU # 01723 M01S01723.sslabel +++| 01724 M01S01724.sslabel +++| TERM 01725 M01S01725.sslabel +++|PROC LBADCUB; 01726 M01S01726.sslabel +++|# TITLE LBADCUB - ADDS CUBES TO A FAMILY OR POOL. # 01727 M01S01727.sslabel +++| 01728 M01S01728.sslabel +++| BEGIN # LBADCUB # 01729 M01S01729.sslabel +++| 01730 M01S01730.sslabel +++|# 01731 M01S01731.sslabel +++|** LBADCUB - ADDS CUBES TO A FAMILY OR POOL. 01732 M01S01732.sslabel +++|* 01733 M01S01733.sslabel +++|* THIS PROC ADDS NON-ASSIGNED CUBES TO A FAMILY OR 01734 M01S01734.sslabel +++|* THE POOL. 01735 M01S01735.sslabel +++|* 01736 M01S01736.sslabel +++|* PROC LBADCUB. 01737 M01S01737.sslabel +++|* 01738 M01S01738.sslabel +++|* ENTRY CRACKED AND SYNTAX CHECKED DIRECTIVE PARAMETERS 01739 M01S01739.sslabel +++|* SET UP IN COMMON AREA DEFINED IN *COMTLBP*. 01740 M01S01740.sslabel +++|* 01741 M01S01741.sslabel +++|* EXIT A SPECIFIED NUMBER OR LOCATIONS OF CUBES 01742 M01S01742.sslabel +++|* ADDED TO A FAMILY OR POOL. 01743 M01S01743.sslabel +++|* 01744 M01S01744.sslabel +++|* NOTES PROC *LBADCUB* ADDS UNASSIGNED CUBES TO 01745 M01S01745.sslabel +++|* A FAMILY OR POOL. IT ADDS A SPECIFIED 01746 M01S01746.sslabel +++|* NUMBER OF CUBES IF *N* IS SPECIFIED OR 01747 M01S01747.sslabel +++|* ADDS THE CUBES AT THE LOCATIONS SPECIFIED 01748 M01S01748.sslabel +++|* BZ *YI*, *YF*, *ZI*, *ZF*. IT SEARCHES 01749 M01S01749.sslabel +++|* THE SMMAP FOR AN UNASSIGNED CUBE AND 01750 M01S01750.sslabel +++|* SENDS A REQUEST TO EXEC TO ADD IT TO THE 01751 M01S01751.sslabel +++|* FAMILY CATALOG OR TO THE POOL. IF AN 01752 M01S01752.sslabel +++|* ERROR CONDITION IS ENCOUNTERED, *LBERR* IS 01753 M01S01753.sslabel +++|* CALLED TO DO THE ERROR PROCESSING. 01754 M01S01754.sslabel +++|# 01755 M01S01755.sslabel +++| 01756 M01S01756.sslabel +++|# 01757 M01S01757.sslabel +++|**** PROC LBADCUB - XREF LIST BEGIN. 01758 M01S01758.sslabel +++|# 01759 M01S01759.sslabel +++| 01760 M01S01760.sslabel +++| XREF 01761 M01S01761.sslabel +++| BEGIN 01762 M01S01762.sslabel +++| PROC CALL3; # SENDS TYPE 3 CALLSS TO EXEC # 01763 M01S01763.sslabel +++| PROC LBERR; # *SSLABEL* ERROR PROCESSOR # 01764 M01S01764.sslabel +++| PROC LBRESP; # RESPONSE CODE PROCESSOR # 01765 M01S01765.sslabel +++| PROC MFLUSH; # FLUSH MAP BUFFER # 01766 M01S01766.sslabel +++| PROC MCLOSE; # CLOSE SMMAP # 01767 M01S01767.sslabel +++| PROC MOPEN; # OPEN SMMAP # 01768 M01S01768.sslabel +++| PROC SERCSU; # SEARCHES SMMAP # 01769 M01S01769.sslabel +++| PROC SETCORD; # SETS UP Y Z COORDINATE TABLE # 01770 M01S01770.sslabel +++| END 01771 M01S01771.sslabel +++| 01772 M01S01772.sslabel +++|# 01773 M01S01773.sslabel +++|**** PROC LBADCUB - XREF LIST END. 01774 M01S01774.sslabel +++|# 01775 M01S01775.sslabel +++| 01776 M01S01776.sslabel +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS # 01777 M01S01777.sslabel +++|*CALL COMBFAS 01778 M01S01778.sslabel +++|*CALL COMBCPR 01779 M01S01779.sslabel +++|*CALL COMBMAP 01780 M01S01780.sslabel +++|*CALL COMTERR 01781 M01S01781.sslabel +++|*CALL COMTLAB 01782 M01S01782.sslabel +++|*CALL COMTLBP 01783 M01S01783.sslabel +++| 01784 M01S01784.sslabel +++| ITEM FLAG I; # ERROR FLAG # 01785 M01S01785.sslabel +++| ITEM I I; # LOOP VARIABLE # 01786 M01S01786.sslabel +++| ITEM LOC$OPTION B ; # TRUE, IF *LOC* OPTION SELECTED 01787 M01S01787.sslabel +++| FALSE, IF *N* OPTION SELECTED # 01788 M01S01788.sslabel +++| ITEM RESP$CODE U; # RESPONSE CODE FROM EXEC # 01789 M01S01789.sslabel +++| ITEM SERTYPE S:SERCH$TYPE; # SMMAP SEARCH TYPE # 01790 M01S01790.sslabel +++| ITEM SP$CODE U; # CODE FOR CUBE/CARTRIDGE 01791 M01S01791.sslabel +++| ASSIGNMENT # 01792 M01S01792.sslabel +++| ITEM SP$FAM C(7); # SPECIFIED FAMILY # 01793 M01S01793.sslabel +++| ITEM SP$SUB U; # SPECIFIED SUB FAMILY # 01794 M01S01794.sslabel +++| ITEM SP$VSN C(8); # SPECIFIED *CSN* # 01795 M01S01795.sslabel +++| ITEM SP$Y U; # Y COORDINATE # 01796 M01S01796.sslabel +++| ITEM SP$Z U; # Z COORDINATE # 01797 M01S01797.sslabel +++| 01798 M01S01798.sslabel +++| 01799 M01S01799.sslabel +++| ARRAY PK$CSU$ENT [0:0] P(4); # *PICK* SMMAP ENTRY # 01800 M01S01800.sslabel +++| BEGIN 01801 M01S01801.sslabel +++| ITEM PK$MAPENT C(00,00,30); # THREE WORD MAP ENTRY # 01802 M01S01802.sslabel +++| ITEM PK$Y U(03,00,30); # Y COORDINATE # 01803 M01S01803.sslabel +++| ITEM PK$Z U(03,30,30); # Z COORDINATE # 01804 M01S01804.sslabel +++| END 01805 M01S01805.sslabel +++| 01806 M01S01806.sslabel +++| 01807 M01S01807.sslabel +++| ARRAY CMAP$NM [0:0] P(1); # BUILD SMMAP FILE NAME # 01808 M01S01808.sslabel +++| BEGIN 01809 M01S01809.sslabel +++| ITEM CMAP$NAME C(00,00,07); # SMMAP FILE NAME # 01810 M01S01810.sslabel +++| ITEM CMAP$IN C(00,00,05); # FIRST FIVE CHARACTERS # 01811 M01S01811.sslabel +++| ITEM CMAP$ID C(00,30,01); # SM-ID # 01812 M01S01812.sslabel +++| ITEM CMAP$Z U(00,36,24) = [0]; # ZERO FILL # 01813 M01S01813.sslabel +++| END 01814 M01S01814.sslabel +++| 01815 M01S01815.sslabel +++| CONTROL EJECT; 01816 M01S01816.sslabel +++| 01817 M01S01817.sslabel +++|# 01818 M01S01818.sslabel +++|* CHECK TO SEE IF THE *N* OPTION OR THE *LOC* OPTION 01819 M01S01819.sslabel +++|* IS SPECIFIED. 01820 M01S01820.sslabel +++|# 01821 M01S01821.sslabel +++| 01822 M01S01822.sslabel +++| LOC$OPTION = FALSE; # INITIALIZE # 01823 M01S01823.sslabel +++| IF (LBARG$YI[0] NQ -1) OR (LBARG$ZI[0] NQ -1) 01824 M01S01824.sslabel +++| THEN # *LOC* OPTION SPECIFIED # 01825 M01S01825.sslabel +++| BEGIN 01826 M01S01826.sslabel +++| SETCORD; # SET UP THE Y/Z COORDINATES # 01827 M01S01827.sslabel +++| LOC$OPTION = TRUE; 01828 M01S01828.sslabel +++| END 01829 M01S01829.sslabel +++| 01830 M01S01830.sslabel +++|# 01831 M01S01831.sslabel +++|* INITIALIZE ITEMS TO SEARCH SMMAP FOR UNASSIGNED 01832 M01S01832.sslabel +++|* CUBES. 01833 M01S01833.sslabel +++|# 01834 M01S01834.sslabel +++| 01835 M01S01835.sslabel +++| SP$VSN = " "; 01836 M01S01836.sslabel +++| SP$CODE = CUBSTAT"UNASGN"; 01837 M01S01837.sslabel +++| SP$FAM = " "; 01838 M01S01838.sslabel +++| SP$SUB = 0; 01839 M01S01839.sslabel +++| IF NOT LOC$OPTION 01840 M01S01840.sslabel +++| THEN 01841 M01S01841.sslabel +++| BEGIN # *N* OPTION # 01842 M01S01842.sslabel +++| IF LBARG$PT[0] EQ "F" 01843 M01S01843.sslabel +++| THEN # SEARCH SMMAP FOR FIRST 01844 M01S01844.sslabel +++| UNASSIGNED CUBE # 01845 M01S01845.sslabel +++| BEGIN 01846 M01S01846.sslabel +++| SERTYPE = S"ASSIGN"; 01847 M01S01847.sslabel +++| END 01848 M01S01848.sslabel +++| 01849 M01S01849.sslabel +++| IF LBARG$PT[0] EQ "P" 01850 M01S01850.sslabel +++| THEN # SEARCH SMMAP FOR LAST 01851 M01S01851.sslabel +++| UNASSIGNED CUBE # 01852 M01S01852.sslabel +++| BEGIN 01853 M01S01853.sslabel +++| SERTYPE = S"LST$UNAS"; 01854 M01S01854.sslabel +++| END 01855 M01S01855.sslabel +++| 01856 M01S01856.sslabel +++| END # *N* OPTION # 01857 M01S01857.sslabel +++| 01858 M01S01858.sslabel +++| ELSE # *LOC* OPTION # 01859 M01S01859.sslabel +++| BEGIN 01860 M01S01860.sslabel +++| SERTYPE = S"LOC"; # SEARCH FOR LOCATION # 01861 M01S01861.sslabel +++| END 01862 M01S01862.sslabel +++| 01863 M01S01863.sslabel +++|# 01864 M01S01864.sslabel +++|* PROCESS EACH OF THE *NOPT* CUBES. 01865 M01S01865.sslabel +++|# 01866 M01S01866.sslabel +++| 01867 M01S01867.sslabel +++| SLOWFOR I = 1 STEP 1 UNTIL LBARG$N[0] 01868 M01S01868.sslabel +++| DO 01869 M01S01869.sslabel +++| BEGIN # ADD CUBES # 01870 M01S01870.sslabel +++| IF SERTYPE EQ S"LOC" 01871 M01S01871.sslabel +++| THEN 01872 M01S01872.sslabel +++| BEGIN 01873 M01S01873.sslabel +++| SP$Y = Y$COORD[I]; # SET UP Y AND Z COORDINATES # 01874 M01S01874.sslabel +++| SP$Z = Z$COORD[I]; 01875 M01S01875.sslabel +++| END 01876 M01S01876.sslabel +++| 01877 M01S01877.sslabel +++|# 01878 M01S01878.sslabel +++|* SEARCH SMMAP FOR THE SPECIFIC ENTRY. 01879 M01S01879.sslabel +++|# 01880 M01S01880.sslabel +++| 01881 M01S01881.sslabel +++| SERCSU(SERTYPE,SP$Y,SP$Z,SP$CODE,SP$VSN,SP$FAM,SP$SUB, 01882 M01S01882.sslabel +++| PK$CSU$ENT[0],FLAG); 01883 M01S01883.sslabel +++| IF FLAG NQ 0 01884 M01S01884.sslabel +++| THEN # ENTRY NOT FOUND # 01885 M01S01885.sslabel +++| BEGIN 01886 M01S01886.sslabel +++| NUMDONE = I - 1; # NUMBER OF CUBES PROCESSED # 01887 M01S01887.sslabel +++| ERRCODE = S"INSUF$CB"; 01888 M01S01888.sslabel +++| LBERR(ERRCODE); 01889 M01S01889.sslabel +++| RETURN; 01890 M01S01890.sslabel +++| END 01891 M01S01891.sslabel +++| 01892 M01S01892.sslabel +++| CMAP$ID[0] = LBARG$SM[0]; 01893 M01S01893.sslabel +++| CMAP$IN[0] = SMMAP; 01894 M01S01894.sslabel +++| 01895 M01S01895.sslabel +++|# 01896 M01S01896.sslabel +++|* CHECK THE *CODE* IN SMMAP ENTRY TO SEE IF 01897 M01S01897.sslabel +++|* THE CUBE IS UNASSIGNED. 01898 M01S01898.sslabel +++|# 01899 M01S01899.sslabel +++| 01900 M01S01900.sslabel +++| P<SMUMAP> = LOC(PK$CSU$ENT[0]); 01901 M01S01901.sslabel +++| IF CM$CODE[0] NQ CUBSTAT"UNASGN" 01902 M01S01902.sslabel +++| THEN 01903 M01S01903.sslabel +++| BEGIN 01904 M01S01904.sslabel +++| NUMDONE = I - 1; # NUMBER OF CUBES PROCESSED # 01905 M01S01905.sslabel +++| ERRCODE = S"CB$ASGN"; 01906 M01S01906.sslabel +++| LBERR(ERRCODE); 01907 M01S01907.sslabel +++| RETURN; 01908 M01S01908.sslabel +++| END 01909 M01S01909.sslabel +++| 01910 M01S01910.sslabel +++|# 01911 M01S01911.sslabel +++|* CHECK *PT* TO SEE IF THE CUBE IS TO BE ADDED TO 01912 M01S01912.sslabel +++|* FAMILY, POOL OR THE RESERVED AREA AND SEND A 01913 M01S01913.sslabel +++|* CORRESPONDING REQUEST TO EXEC. 01914 M01S01914.sslabel +++|# 01915 M01S01915.sslabel +++| 01916 M01S01916.sslabel +++| IF LBARG$PT[0] EQ "F" 01917 M01S01917.sslabel +++| THEN # ADD CUBE TO FAMILY # 01918 M01S01918.sslabel +++| BEGIN 01919 M01S01919.sslabel +++| CALL3(REQTYP3"ADD$CUBE",PK$CSU$ENT[0],0,0,RESP$CODE); 01920 M01S01920.sslabel +++| IF RESP$CODE NQ RESPTYP3"OK3" 01921 M01S01921.sslabel +++| THEN 01922 M01S01922.sslabel +++| BEGIN 01923 M01S01923.sslabel +++| LBRESP(RESP$CODE,TYP"TYP3"); 01924 M01S01924.sslabel +++| RETURN; 01925 M01S01925.sslabel +++| END 01926 M01S01926.sslabel +++| 01927 M01S01927.sslabel +++| END 01928 M01S01928.sslabel +++| 01929 M01S01929.sslabel +++| ELSE 01930 M01S01930.sslabel +++| BEGIN # ADD CUBE TO POOL/RESERVED AREA # 01931 M01S01931.sslabel +++| IF LBARG$PT[0] EQ "P" 01932 M01S01932.sslabel +++| THEN 01933 M01S01933.sslabel +++| BEGIN 01934 M01S01934.sslabel +++| CM$CODE[0] = CUBSTAT"SCRPOOL"; 01935 M01S01935.sslabel +++| END 01936 M01S01936.sslabel +++| 01937 M01S01937.sslabel +++| IF LBARG$PT[0] EQ "R" 01938 M01S01938.sslabel +++| THEN 01939 M01S01939.sslabel +++| BEGIN 01940 M01S01940.sslabel +++| CM$CODE[0] = CUBSTAT"ALTCSU"; 01941 M01S01941.sslabel +++| END 01942 M01S01942.sslabel +++| 01943 M01S01943.sslabel +++| CALL3(REQTYP3"UPD$MAP",PK$CSU$ENT[0],0,0,RESP$CODE); 01944 M01S01944.sslabel +++| END # ADD CUBE TO POOL/RESERVED AREA # 01945 M01S01945.sslabel +++| 01946 M01S01946.sslabel +++|# 01947 M01S01947.sslabel +++|* CHECK THE RESPONSE CODE RETURNED BY EXEC. 01948 M01S01948.sslabel +++|# 01949 M01S01949.sslabel +++| 01950 M01S01950.sslabel +++| IF RESP$CODE NQ RESPTYP3"OK3" 01951 M01S01951.sslabel +++| THEN 01952 M01S01952.sslabel +++| BEGIN 01953 M01S01953.sslabel +++| LBRESP(RESP$CODE,TYP"TYP3"); 01954 M01S01954.sslabel +++| RETURN; 01955 M01S01955.sslabel +++| END 01956 M01S01956.sslabel +++| 01957 M01S01957.sslabel +++| MFLUSH; # FLUSH MAP BUFFER # 01958 M01S01958.sslabel +++| END # ADD CUBES # 01959 M01S01959.sslabel +++| 01960 M01S01960.sslabel +++|# 01961 M01S01961.sslabel +++|* ALL THE CUBES ADDED. 01962 M01S01962.sslabel +++|# 01963 M01S01963.sslabel +++| 01964 M01S01964.sslabel +++| RETURN; 01965 M01S01965.sslabel +++| 01966 M01S01966.sslabel +++| END # LBADCUB # 01967 M01S01967.sslabel +++| 01968 M01S01968.sslabel +++| TERM 01969 M01S01969.sslabel +++|PROC LBADMSC; 01970 M01S01970.sslabel +++|# TITLE LBADMSC - PROCESS THE *ADDMSC* DIRECTIVE. # 01971 M01S01971.sslabel +++| 01972 M01S01972.sslabel +++| BEGIN # LBADMSC # 01973 M01S01973.sslabel +++| 01974 M01S01974.sslabel +++|# 01975 M01S01975.sslabel +++|** LBADMSC - PROCESS THE *ADDMSC* DIRECTIVE. 01976 M01S01976.sslabel +++|* 01977 M01S01977.sslabel +++|* PROC LBADMSC. 01978 M01S01978.sslabel +++|* 01979 M01S01979.sslabel +++|* ENTRY CRACKED AND SYNTAX CHECKED DIRECTIVE PARAMETERS 01980 M01S01980.sslabel +++|* SET UP IN COMMON AREA DEFINED IN *COMTLBP*. 01981 M01S01981.sslabel +++|* 01982 M01S01982.sslabel +++|* EXIT ALL CARTRIDGES PROCESSED. 01983 M01S01983.sslabel +++|* 01984 M01S01984.sslabel +++|* NOTES THE SMMAP IS SEARCHED FOR THE APPROPRIATE 01985 M01S01985.sslabel +++|* *PICK* AND *PUT* LOCATIONS. IF SUCCESSFUL, THE 01986 M01S01986.sslabel +++|* CARTRIDGE IS BROUGHT TO A TRANSPORT AND GIVEN A NEW 01987 M01S01987.sslabel +++|* LABEL. THE SMMAP (AND FCT AND AST IF ADDED TO A 01988 M01S01988.sslabel +++|* FAMILY) IS UPDATED TO REFLECT THE NEW CARTRIDGE 01989 M01S01989.sslabel +++|* ASSIGNMENT, AND THE CARTRIDGE IS UNLOADED TO THE 01990 M01S01990.sslabel +++|* NEW LOCATION. ANY ERROR CONDITIONS ARE PROCESSED 01991 M01S01991.sslabel +++|* BY PROC *LBERR*. 01992 M01S01992.sslabel +++|# 01993 M01S01993.sslabel +++| 01994 M01S01994.sslabel +++|# 01995 M01S01995.sslabel +++|**** PROC LBADMSC - XREF LIST BEGIN. 01996 M01S01996.sslabel +++|# 01997 M01S01997.sslabel +++| 01998 M01S01998.sslabel +++| XREF 01999 M01S01999.sslabel +++| BEGIN 02000 M01S02000.sslabel +++| PROC CALL3; # SENDS TYPE 3 CALLSS TO EXEC # 02001 M01S02001.sslabel +++| PROC CALL4; # SENDS TYPE 4 CALLSS TO EXEC # 02002 M01S02002.sslabel +++| PROC CKLAB; # CHECKS CARTRIDGE LABEL TYPE # 02003 M01S02003.sslabel +++| PROC GENLAB; # GENERATES NEW LABEL # 02004 M01S02004.sslabel +++| PROC LBERR; # *SSLABEL* ERROR PROCESSOR # 02005 M01S02005.sslabel +++| PROC LBRESP; # RESPONSE CODE PROCESSOR # 02006 M01S02006.sslabel +++| PROC LBSTCLR; # STORE A *CE* CARTRIDGE # 02007 M01S02007.sslabel +++| PROC MFLUSH; # FLUSH MAP BUFFER # 02008 M01S02008.sslabel +++| PROC SERASTG; # DETERMINE GROUP AND ORDINAL # 02009 M01S02009.sslabel +++| PROC SERCSU; # SEARCHES SMMAP # 02010 M01S02010.sslabel +++| END 02011 M01S02011.sslabel +++| 02012 M01S02012.sslabel +++|# 02013 M01S02013.sslabel +++|**** PROC LBADMSC - XREF LIST END. 02014 M01S02014.sslabel +++|# 02015 M01S02015.sslabel +++| 02016 M01S02016.sslabel +++| DEF LISTCON #0#; # DO NOT LIST COMDECKS # 02017 M01S02017.sslabel +++|*CALL COMBFAS 02018 M01S02018.sslabel +++|*CALL COMBCPR 02019 M01S02019.sslabel +++|*CALL COMBLBL 02020 M01S02020.sslabel +++|*CALL COMBMAP 02021 M01S02021.sslabel +++|*CALL COMTERR 02022 M01S02022.sslabel +++|*CALL COMTLAB 02023 M01S02023.sslabel +++|*CALL COMTLBP 02024 M01S02024.sslabel +++| 02025 M01S02025.sslabel +++| ITEM CART$CSN C(20); # CARTRIDGE SERIAL NUMBER # 02026 M01S02026.sslabel +++| ITEM CATFLD U; # CATALOG FIELD # 02027 M01S02027.sslabel +++| ITEM CATVALUE U; # NEW VALUE FOR CATALOG FIELD # 02028 M01S02028.sslabel +++| ITEM ERR$CNT I; # CARTRIDGE ERROR COUNT # 02029 M01S02029.sslabel +++| ITEM FLAG I; # ERROR FLAG # 02030 M01S02030.sslabel +++| ITEM GROUP I; # GROUP NUMBER # 02031 M01S02031.sslabel +++| ITEM GRT I; # ORDINAL WITHIN GROUP # 02032 M01S02032.sslabel +++| ITEM HR$ERR I; # HARD READ ERRORS # 02033 M01S02033.sslabel +++| ITEM I I; # LOOP VARIABLE # 02034 M01S02034.sslabel +++| ITEM LD$CNT I; # CARTRIDGE LOAD COUNT # 02035 M01S02035.sslabel +++| ITEM LD$ERR I; # LOAD ERRORS # 02036 M01S02036.sslabel +++| ITEM PS$CNT U; # CARTRIDGE PASS COUNT # 02037 M01S02037.sslabel +++| ITEM REQCODE U; # REQUEST CODE # 02038 M01S02038.sslabel +++| ITEM RESP$CODE U; # RESPONSE CODE # 02039 M01S02039.sslabel +++| ITEM SGROUP I; # SAVE GROUP PARAMETER # 02040 M01S02040.sslabel +++| ITEM SERFLAG B; # SMMAP SEARCH FLAG # 02041 M01S02041.sslabel +++| ITEM SERTYPE S:SERCH$TYPE; # SMMAP SEARCH TYPE # 02042 M01S02042.sslabel +++| ITEM SP$CODE U; # CUBE/CARTRIDGE ASSIGNMENT # 02043 M01S02043.sslabel +++| ITEM SP$FAM C(7); # SPECIFIED FAMILY NAME # 02044 M01S02044.sslabel +++| ITEM SP$SUB U; # SPECIFIED SUB FAMILY ID # 02045 M01S02045.sslabel +++| ITEM SP$VSN C(8); # SPECIFIED CARTRIDGE *CSND* # 02046 M01S02046.sslabel +++| ITEM SP$Y I; # Y COORDINATE # 02047 M01S02047.sslabel +++| ITEM SP$Z I; # Z COORDINATE # 02048 M01S02048.sslabel +++| ITEM SR$ERR I; # SOFT READ ERRORS # 02049 M01S02049.sslabel +++| ITEM STR$RD I; # STRIPES READ # 02050 M01S02050.sslabel +++| ITEM STR$WR I; # STRIPES WRITTEN # 02051 M01S02051.sslabel +++| ITEM STR$DM I; # STRIPES DEMARKED # 02052 M01S02052.sslabel +++| ITEM SW$ERR I; # SOFT WRITE ERRORS # 02053 M01S02053.sslabel +++| 02054 M01S02054.sslabel +++| 02055 M01S02055.sslabel +++| ARRAY PK$CSU$ENT [0:0] P(4); # *PICK* SMMAP ENTRY # 02056 M01S02056.sslabel +++| BEGIN 02057 M01S02057.sslabel +++| ITEM PK$MAPENT C(00,00,30); # THREE WORD MAP ENTRY # 02058 M01S02058.sslabel +++| ITEM PK$Y U(03,00,30); # Y COORDINATE # 02059 M01S02059.sslabel +++| ITEM PK$Z U(03,30,30); # Z COORDINATE # 02060 M01S02060.sslabel +++| END 02061 M01S02061.sslabel +++| 02062 M01S02062.sslabel +++| 02063 M01S02063.sslabel +++| 02064 M01S02064.sslabel +++| ARRAY PT$CSU$ENT [0:0] P(5); # *PUT* SMMAP ENTRY # 02065 M01S02065.sslabel +++| BEGIN 02066 M01S02066.sslabel +++| ITEM PT$MAPENT C(00,00,30); # THREE WORD MAP ENTRY # 02067 M01S02067.sslabel +++| ITEM PT$Y U(03,00,30); # Y COORDINATE # 02068 M01S02068.sslabel +++| ITEM PT$Z U(03,30,30); # Z COORDINATE # 02069 M01S02069.sslabel +++| ITEM PT$GR U(04,00,07); # GROUP # 02070 M01S02070.sslabel +++| ITEM PT$GRT U(04,07,05); # GROUP ORDINAL # 02071 M01S02071.sslabel +++| END 02072 M01S02072.sslabel +++| 02073 M01S02073.sslabel +++| 02074 M01S02074.sslabel +++| CONTROL EJECT; 02075 M01S02075.sslabel +++| 02076 M01S02076.sslabel +++| IF LBARG$CC[0] NQ -1 02077 M01S02077.sslabel +++| THEN # STORE CLEAR CARTRIDGE # 02078 M01S02078.sslabel +++| BEGIN 02079 M01S02079.sslabel +++| LBSTCLR; 02080 M01S02080.sslabel +++| RETURN; 02081 M01S02081.sslabel +++| END 02082 M01S02082.sslabel +++| 02083 M01S02083.sslabel +++| SGROUP = LBARG$GR[0]; 02084 M01S02084.sslabel +++| SLOWFOR I = 1 STEP 1 UNTIL LBARG$N[0] 02085 M01S02085.sslabel +++| DO 02086 M01S02086.sslabel +++| BEGIN # LBADMSC PROCESSING # 02087 M01S02087.sslabel +++| 02088 M01S02088.sslabel +++|# 02089 M01S02089.sslabel +++|* SEARCH FOR DEFAULT GROUP AND GROUP ORDINAL. 02090 M01S02090.sslabel +++|# 02091 M01S02091.sslabel +++| 02092 M01S02092.sslabel +++| IF LBARG$PT[0] NQ "P" 02093 M01S02093.sslabel +++| THEN 02094 M01S02094.sslabel +++| BEGIN 02095 M01S02095.sslabel +++| LBARG$GR[0] = SGROUP; 02096 M01S02096.sslabel +++| GROUP = LBARG$GR[0]; 02097 M01S02097.sslabel +++| SERASTG(GROUP,GRT,FLAG); 02098 M01S02098.sslabel +++| IF FLAG NQ 0 02099 M01S02099.sslabel +++| THEN # GROUP OR ORDINAL NOT AVAILABLE # 02100 M01S02100.sslabel +++| BEGIN 02101 M01S02101.sslabel +++| ERRCODE = S"GR$FULL"; 02102 M01S02102.sslabel +++| LBERR(ERRCODE); 02103 M01S02103.sslabel +++| RETURN; 02104 M01S02104.sslabel +++| END 02105 M01S02105.sslabel +++| 02106 M01S02106.sslabel +++| ELSE # SEARCH SUCCESSFUL # 02107 M01S02107.sslabel +++| BEGIN 02108 M01S02108.sslabel +++| LBARG$GR[0] = GROUP; 02109 M01S02109.sslabel +++| PT$GR[0] = GROUP; 02110 M01S02110.sslabel +++| PT$GRT[0] = GRT; 02111 M01S02111.sslabel +++| END 02112 M01S02112.sslabel +++| 02113 M01S02113.sslabel +++| END 02114 M01S02114.sslabel +++| 02115 M01S02115.sslabel +++| 02116 M01S02116.sslabel +++|# 02117 M01S02117.sslabel +++|* SEARCH FOR EMPTY CUBE TO WHICH CARTRIDGE IS TO BE ADDED. 02118 M01S02118.sslabel +++|# 02119 M01S02119.sslabel +++| 02120 M01S02120.sslabel +++| IF LBARG$PT[0] EQ "F" 02121 M01S02121.sslabel +++| THEN # ADD CARTRIDGE TO FAMILY # 02122 M01S02122.sslabel +++| BEGIN # FAMILY SEARCH # 02123 M01S02123.sslabel +++| SERTYPE = S"ASSIGN"; 02124 M01S02124.sslabel +++| SP$CODE = CUBSTAT"SUBFAM"; 02125 M01S02125.sslabel +++| SP$VSN = " "; # SEARCH FOR AN EMPTY CUBE # 02126 M01S02126.sslabel +++| SERCSU(SERTYPE,0,0,SP$CODE,SP$VSN,LBARG$FM[0],LBARG$SB[0], 02127 M01S02127.sslabel +++| PT$CSU$ENT[0],SERFLAG); 02128 M01S02128.sslabel +++| IF SERFLAG 02129 M01S02129.sslabel +++| THEN # NO EMPTY CUBE IN FAMILY # 02130 M01S02130.sslabel +++| BEGIN 02131 M01S02131.sslabel +++| NUMDONE = I - 1; 02132 M01S02132.sslabel +++| ERRCODE = S"NO$EMPCBFP"; 02133 M01S02133.sslabel +++| LBERR(ERRCODE); # DO ERROR PROCESSING # 02134 M01S02134.sslabel +++| RETURN; 02135 M01S02135.sslabel +++| END 02136 M01S02136.sslabel +++| 02137 M01S02137.sslabel +++| END # FAMILY SEARCH #
Proceed to Part 1
cdc/nos2.source/opl.opl871/deck/sslabel.txt · Last modified: by 127.0.0.1