È(èHa ·AKtSCRATCH CCS20 P040682(èÈÐ NAM TSTASK A01 A ITOS CCS 3.0 SL-149A0100001* USER PROGRAM TASK PROCESSOR A0100002* CREDIT COLLECTION SYSTEM VERSION 3.0 A0100003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A0100004* COPYRIGHT CONTROL DATA CORPORATION 1979 A0100005* A0100006 SPC 2 A0100007* I T O S E N T R Y P O I N T S A0100008 SPC 1 A0100009 ENT TSTASK ITOS EXECUTIVE TASK PROCESSOR A0100010 ENT TSURTN RETURN TO UNPROTECTED USER PROGRAM A0100011 ENT TSATCH MULTI-USER PROGRAM ATTACH REQUEST PROCESSOR A0100012 ENT TIMSLC MULTI-USER TIMESLICE REQUEST PROCESSOR A0100013 ENT TSNABL ITOS ENABLED INDICATOR A0100014 ENT TSACTV ITOS ACTIVE INDICATOR A0100015 ENT TSCNAC MASTER TERMINAL ACTIVE INDICATOR A0100016 ENT EXPIRE MULTI-USER TIMESLICE SEMAPHORE A0100017 ENT TSMFLG MASS MEMORY ERROR INDICATOR A0100018 ENT XMBLOK MAIN MEMORY RESERVATION INDICATOR A0100019 ENT TSULBF BASE SECTOR OF THE ULB BUFFER A0100020 ENT REAREQ UNSWAP REQUEST PARAMETER LIST A0100021 EJT A0100022 SPC 4 A0100023* I T O S E X T E R N A L S A0100024 SPC 1 A0100025ÐÐ EXT TSAREA START OF THE ITOS USER AREA A0100026 EXT TSXERR EXECUTIVE ERROR MESSAGE PROCESSOR A0100027 EXT TSUSCP UNSWAP COMPLETION PROCESSOR A0100028 EXT TSLSIZ LOG-IN PROCESSOR LENGTH A0100029 EXT TSLMSB LOG-IN PROCESSOR SECTOR ADDRESS A0100030 EXT TSLLSB LOG-IN PROCESSOR SECTOR ADDRESS A0100031 EXT TSPORT ITOS I/O TABLE STARTING ADDRESS A0100032 EXT TSPEND ITOS I/O TABLE ENDING ADDRESS A0100033 EXT TSUSER ITOS USER TABLE STARTING ADDRESS A0100034 EXT TSUEND ITOS USER TABLE ENDING ADDRESS A0100035 EXT TSMUSR ITOS MULTI-USER TABLE STARTING ADDRESS A0100036 EXT TSMEND ITOS MULTI-USER TABLE ENDING ADDRESS A0100037 EXT TSCLOK TIMESLICE DELAY REQUEST A0100038 EXT ONNXUC NXUC QUEUE ENTRY ADDITION A0100039 EXT ONNXUM NXUM QUEUE ENTRY ADDITION A0100040 EXT ONNSWP NSWP QUEUE ENTRY ADDITION A0100041 EXT ADNSWP NSWP QUEUE ENTRY ADDITION - UNCONDITIONAL A0100042 EXT OFNXUC NXUC QUEUE ENTRY REMOVAL A0100043 EXT GTNXUM NXUM QUEUE ENTRY FETCH A0100044 EXT OFNSWP NSWP QUEUE ENTRY REMOVAL A0100045 EXT DENXUC NXUC QUEUE ENTRY DELETION A0100046 EXT DENXUM NXUM QUEUE ENTRY DELETION A0100047 EXT DENSWP NSWP QUEUE ENTRY DELETION A0100048 EXT XMALC MAIN MEMORY ALLOCATE ROUTINE A0100049 EXT XMRSV MAIN MEMORY RESERVE ROUTINE A0100050ÐÐ EXT XMREL MAIN MEMORY RELEASE ROUTINE A0100051 EXT XMMOD MAIN MEMORY REASSIGN ROUTINE A0100052 EXT XMRTN MAIN MEMORY RETURN ROUTINE A0100053 EXT MMALC MASS MEMORY ALLOCATION ROUTINE A0100054 EXT MMREL MASS MEMORY RELEASE ROUTINE A0100055 EXT TSRFTN FORTRAN AREA RESTORE ROUTINE A0100056 EXT TSCLLB CLEAR LINKAGE BUFFER ROUTINE A0100057 EXT TSMMER MASS MEMORY ERROR PROCESSOR A0100058 EXT EXTREG SAVE - RESTORE EXTENDED REGISTERS A0100059 EXT TSPAGE CONTROL POINT DEFINITION TABLE A0100060 EXT CPFET OBTAIN CONTROL POINT A0100061 EXT CPDEF DEFINE CONTROL POINT A0100062 EXT CPMOD MODIFY CONTROL POINT A0100063 EXT CPSET ACTIVATE CONTROL POINT A0100064 EXT CPREL RELEASE CONTROL POINT A0100065 EXT CPTBLN NUMBER OF PAGES IN THE CONTROL POINT AREA A0100066 EJT A0100067 SPC 4 A0100068* S Y S T E M E X T E R N A L S A0100069 SPC 1 A0100070 EXT SETBND SET PROTECT BOUNDS REGISTERS A0100071 EXT UBPROT UPPER PROTECT BOUNDS REGISTER A0100072 EXT SYFAIL SYSTEM FAILURE PROCESSOR A0100073 EXT PARTBL PARTITIONED MEMORY ADDRESS TABLE A0100074 EXT YERTO LOCATION CONTAINING THE CURRENT YEAR A0100075ÐÐ EXT FSHARE FORCE FILE SHARE A0100076 EXT FUNSHR FORCE FILE UNSHARE A0100077 EXT MOV DATA TRANSFER ROUTINE A0100078 SPC 4 A0100079* E Q U I V A L E N C E S A0100080 SPC 1 A0100081 EQU LPMASK(2) BIT MASK TABLE A0100082 EQU THREE(4) LOCATION CONTAINING THREE A0100083 EQU NZERO($12) NEGATIVE ZERO TABLE A0100084 EQU ZERO($22) LOCATION CONTAINING ZERO A0100085 EQU ONEBIT($23) SINGLE BIT TABLE A0100086 EQU ZROBIT($33) ZERO BIT TABLE A0100087 EQU ADISP($EA) ADDRESS OF DISPATCHER A0100088 EQU AMONI($F4) ADDRESS OF MONITOR REQUEST ENTRY A0100089 EQU QPL1(1) QUEUE PRIORITY = 1 A0100090 EQU QPL2(2) QUEUE PRIORITY = 2 A0100091 EQU QPL3(3) QUEUE PRIORITY = 3 A0100092 EQU QPL4(4) QUEUE PRIORITY = 4 A0100093 EQU E02(02) ILLEGAL ATTACH REQUEST A0100094 EQU E09(09) TERMINAL DISCONNECT MESSAGE A0100095 EQU E10(10) MASS MEMORY ERROR A0100096 EQU E11(11) FILE REQUEST ERROR A0100097 EQU E12(12) PROGRAM ABORT REQUEST A0100098 EJT A0100099 SPC 4 A0100100ÐÐ* M U L T I - U S E R P R O G R A M T A B L E E N T R I E S A0100101 SPC 1 A0100102 EQU MUROOT(ZERO) ASSOCIATED ROOT TABLE ADDRESS A0100103 EQU MUSRID(01) PROGRAM IDENTIFICATION - 4 WORDS ASCII A0100104 EQU MUSIZE(05) PROGRAM LENGTH (WORDS) A0100105 EQU MUSECT(06) PROGRAM SECTOR ADDRESS - 2 WORDS A0100106 EQU MUPAGE(08) PROGRAM BASE MEMORY PAGE NUMBER A0100107 EQU ACROOT(09) PROGRAM ACTIVE ROOT COUNT A0100108 EQU MURSIZ(10) PROGRAM TRUE LENGTH (WORDS) A0100109 EQU MUEXTH(11) PROGRAM EXECUTION THREAD A0100110 EQU MURSTX(13) PROGRAM STATE INDEX A0100111 EQU MUCNPT(15) PROGRAM CONTROL POINT A0100112 EQU MUITEM(MUCNPT+1) A0100113 SPC 2 A0100114* U S E R P R O G R A M U S E R T A B L E E N T R I E S A0100115 SPC 1 A0100116 EQU TSIOTB(ZERO) ASSOCIATED I/O TABLE ADDRESS A0100117 EQU USERID(01) USER IDENTIFICATION - 4 WORDS ASCII A0100118 EQU PGMSIZ(05) USER PROGRAM LENGTH (WORDS) A0100119 EQU PGMSEC(06) USER PROGRAM SECTOR - 2 WORDS A0100120 EQU TWNSEC(08) SWAP TWIN SECTOR - 2 WORDS A0100121 EQU SWPBLK(10) USER SWAP BLOCK BYTES A0100122 EQU NEXETH(11) USER EXECUTION THREAD A0100123 EQU NSWPTH(12) USER SWAP THREAD A0100124 EQU USRSTX(13) USER STATE INDEX A0100125ÐÐ EQU TSMUTB(14) MULTI USER TABLE ADDRESS A0100126 EQU NUMREQ(15) USER REQUEST COUNT A0100127 EQU USRITM(NUMREQ+1) A0100128 EJT A0100129 SPC 4 A0100130* U S E R P R O G R A M S T A T E I N D I C E S A0100131 SPC 1 A0100132 EQU SXCACT(01) EXECUTING IN MAIN MEMORY A0100133 EQU SXCTSL(02) SUSPENDED IN MAIN MEMORY-TIMESLICE COMPLETE A0100134 EQU SXCMMA(03) SUSPENDED IN MAIN MEMORY-M.M. I/O ACTIVE A0100135 EQU SXCMMC(04) SUSPENDED IN MAIN MEMORY-M.M. I/O COMPLETE A0100136 EQU SXCFMA(05) SUSPENDED IN MAIN MEMORY-FILE I/O ACTIVE A0100137 EQU SXCFMC(06) SUSPENDED IN MAIN MEMORY-FILE I/O COMPLETE A0100138 EQU SXCTMA(07) SUSPENDED IN MAIN MEMORY-TMNL I/O ACTIVE A0100139 EQU SXCTMC(08) SUSPENDED IN MAIN MEMORY-TMNL I/O COMPLETE A0100140 EQU SXCDTA(09) SUSPENDED IN MAIN MEMORY-DATA I/O ACTIVE A0100141 EQU SXCDTC(10) SUSPENDED IN MAIN MEMORY-DATA I/O COMPLETE A0100142 EQU SXCATA(11) SUSPENDED IN MAIN MEMORY-ATTACH ACTIVE A0100143 EQU SXCATC(12) SUSPENDED IN MAIN MEMORY-ATTACH COMPLETE A0100144* A0100145 EQU SXMASS(13) RESERVED A0100146 EQU SXMTSL(14) SWAPPED ON MASS MEMORY-TIMESLICE COMPLETE A0100147 EQU SXM015(15) RESERVED A0100148 EQU SXMMMC(16) SWAPPED ON MASS MEMORY-M.M. I/O COMPLETE A0100149 EQU SXM017(17) RESERVED A0100150ÐÐ EQU SXMFMC(18) SWAPPED ON MASS MEMORY-FILE I/O COMPLETE A0100151 EQU SXMTMA(19) SWAPPED ON MASS MEMORY-TMNL I/O ACTIVE A0100152 EQU SXMTMC(20) SWAPPED ON MASS MEMORY-TMNL I/O COMPLETE A0100153 EQU SXMDTA(21) SWAPPED ON MASS MEMORY-DATA I/O ACTIVE A0100154 EQU SXMDTC(22) SWAPPED ON MASS MEMORY-DATA I/O COMPLETE A0100155 EQU SXMATA(23) SWAPPED ON MASS MEMORY-ATTACH ACTIVE A0100156 EQU SXM024(24) RESERVED A0100157* A0100158 EQU SXMUSA(25) SUSPENDED ON MASS MEMORY-UNSWAP ACTIVE A0100159 EQU SXCUSC(26) SUSPENDED IN MAIN MEMORY-UNSWAP COMPLETE A0100160 EQU SXMMUR(27) SUSPENDED ON MASS MEMORY-MULTIUSER READ A0100161 EQU SXMLOG(28) SUSPENDED ON MASS MEMORY-INITIAL LOGIN A0100162 EQU SXMJOB(29) SUSPENDED ON MASS MEMORY-JOB STEP A0100163 SPC 2 A0100164* NOTE - BIT 15 = 1 WHILE THE USER IS BEING SWAPPED A0100165 EJT A0100166 SPC 4 A0100167* U S E R P R O G R A M I / O T A B L E E N T R I E S A0100168 SPC 1 A0100169 EQU TSUSTB(ZERO) ASSOCIATED USER TABLE ADDRESS A0100170 EQU FRQBUF(01) FILE REQUEST BUFFER HEADER (4 WORDS) A0100171 EQU IORQCD(05) INPUT/OUTPUT REQUEST CODE A0100172 EQU IORQCA(06) INPUT/OUTPUT COMPLETION ADDRESS A0100173 EQU IORQTH(07) INPUT/OUTPUT THREAD WORD A0100174 EQU IORQLU(08) INPUT/OUTPUT LOGICAL UNIT A0100175ÐÐ EQU IOMSLN(09) INPUT/OUTPUT MESSAGE LENGTH A0100176 EQU IOBFAD(10) INPUT/OUTPUT MESSAGE BUFFER ADDRESS A0100177 EQU IOMMSB(11) INPUT/OUTPUT MASS MEMORY ADDRESS A0100178 EQU IOMLSB(12) INPUT/OUTPUT MASS MEMORY ADDRESS A0100179 EQU IOCNPT(13) INPUT/OUTPUT CONTROL POINT A0100180 EQU IOSTAT(14) INPUT/OUTPUT STATUS WORD A0100181 EQU TERMBF(15) TERMINAL MESSAGE BUFFER ADDRESS A0100182 EQU IOITEM(TERMBF+1) A0100183 SPC 2 A0100184* USER PROGRAM I/O STATUS INDICATORS A0100185 SPC 1 A0100186* UNSOLICITED INPUT GROUP A0100187 EQU LI(00) TERMINAL LOG-IN A0100188 EQU MN(01) TERMINAL MANUAL INTERRUPT A0100189 EQU ES(02) TERMINAL ESCAPE A0100190* INPUT-OUTPUT ERROR GROUP A0100191 EQU DS(04) TERMINAL DISCONNECT A0100192 EQU ME(05) MASS MEMORY ERROR A0100193 EQU FE(06) FILE REQUEST ERROR A0100194* REQUEST TYPE GROUP A0100195 EQU IN(08) DATA INPUT REQUEST A0100196 EQU IA(09) INPUT / OUTPUT ACTIVE A0100197 EQU IC(10) INPUT / OUTPUT COMPLETE A0100198 EQU MM(11) MASS MEMORY I/O REQUEST A0100199 EQU TI(12) TERMINAL I/O REQUEST A0100200ÐÐ* TERMINAL CHARACTERISTIC GROUP A0100201* A0100202 EQU DY(TI+1) END OF THE DYNAMIC STATUS GROUP A0100203 EJT A0100204* U S E R L I N K A G E B U F F E R E N T R I E S A0100205* A0100206* THE USER LINKAGE BUFFER IMMEDIATELY PRECEEDS THE USER PROGRAM A0100207 SPC 2 A0100208 EQU LASTEP(ZERO) LAST ENTRY TO THE USER PROGRAM A0100209 EQU ULIOTB(001) USERS I/O TABLE ADDRESS A0100210 EQU ULUSTB(002) USERS USER TABLE ADDRESS A0100211 EQU RSCLOK(003) USERS REMAINING TIMESLICE A0100212 EQU FALADD(004) PROTECT FAULT ADDRESS A0100213 EQU PARADD(005) CURRENT PARAMETER ADDRESS A0100214 EQU RSP(006) P-REGISTER STORAGE A0100215 EQU RSA(007) A-REGISTER STORAGE A0100216 EQU RSQ(008) Q-REGISTER STORAGE A0100217 EQU RSI(009) I-REGISTER STORAGE A0100218 EQU RSL(010) OVERFLOW STORAGE A0100219 EQU RS1(011) 1-REGISTER STORAGE A0100220 EQU RS2(012) 2-REGISTER STORAGE A0100221 EQU RS3(013) 3-REGISTER STORAGE A0100222 EQU RS4(014) 4-REGISTER STORAGE A0100223 EQU RSUB(015) UPPER BOUNDS REGISTER STORAGE A0100224 EQU RSIORC(016) MONITOR I/O REQUEST CODE A0100225ÐÐ EQU RSIOCA(017) COMPLETION ADDRESS A0100226 EQU RSIOTH(018) REQUEST THREAD A0100227 EQU RSIOLU(019) MODE + LOGICAL UNIT A0100228 EQU RSIOLN(020) LENGTH A0100229 EQU RSIOSA(021) STARTING ADDRESS A0100230 EQU RSIOMS(022) MASS MEMORY ADDRESS - MSB A0100231 EQU RSIOLS(023) MASS MEMORY ADDRESS - LSB A0100232 EQU RSIOCP(024) MONITOR REQUEST CONTROL POINT A0100233 EQU RQTYPE(025) MONITOR REQUEST TYPE INDEX A0100234 EQU RQCLAS(026) MONITOR REQUEST DEVICE CLASS CODE A0100235 EQU RQMODE(027) MONITOR REQUEST CHARACTER MODE INDICATOR A0100236 EQU REQLUN(028) MONITOR REQUEST LOGICAL UNIT A0100237 EQU RSCPAD(029) USERS MONITOR REQUEST COMPLETION ADDRESS A0100238 EQU RSUSLN(030) USERS MONITOR REQUEST MESSAGE LENGTH A0100239 EQU RSUSBF(031) USERS MONITOR REQUEST MESSAGE ADDRESS A0100240 EQU PORTNO(032) MONITOR REQUEST COMMUNICATIONS PORT NUMBER A0100241 EQU RSBHDR(032) MONITOR REQUEST MESSAGE HEADER - 6 WORDS A0100242 EQU WROUTP(038) WRITE-READ USERS OUTPUT LOGICAL UNIT A0100243 EQU WRILEN(039) WRITE-READ INPUT BUFFER LENGTH A0100244 EQU WRIBUF(040) WRITE-READ INPUT BUFFER ADDRESS A0100245 EQU WRTCAD(041) WRITE-READ TERMINATION CODE ADDRESS A0100246 EQU PMCNTR(042) REQUEST PARAMETER COUNT A0100247 EQU RSCARG(043) USERS MONITOR REQUEST COMPLETION A-REGISTER A0100248 EQU RQINPT(044) USERS INPUT LOGICAL UNIT A0100249 EQU RQOUTP(045) USERS OUTPUT LOGICAL UNIT A0100250ÐÐ EQU RQUN01(046) USERS SPARE LOGICAL UNIT A0100251 EQU RQUN02(047) USERS SPARE LOGICAL UNIT A0100252 EJT A0100253 SPC 4 A0100254* U S E R L I N K A G E B U F F E R E N T R I E S A0100255 SPC 2 A0100256 EQU ERRIDX(048) ERROR MESSAGE INDEX A0100257 EQU ERRADD(049) ERROR MESSAGE ADDRESS A0100258 EQU USRPGM(050) CURRENT USER PROGRAM INDEX A0100259 EQU PGMIDX(051) LOG-IN PROCESSOR PROGRAM INDEX A0100260 EQU INTADD(052) PGMINT REQUEST INTERRUPT ADDRESS A0100261 EQU INTFLG(053) PGMINT REQUEST INTERRUPT FLAG ADDRESS A0100262 EQU ATTADR(054) ATTACH REQUEST COMPLETION ADDRESS A0100263 EQU LUNERR(055) ILLEGAL LOGICAL UNIT ERROR ADDRESS A0100264 EQU FMINDX(056) FILE REQUEST TYPE INDEX A0100265 EQU SPARE0(057) SPARE ENTRY A0100266 EQU DATIME(058) DATE AND TIME FOR DAYFILE ENTRY - 6 WORDS A0100267 EQU FRQBFA(064) FILE REQUEST BUFFER ADDRESS A0100268 EQU FILREQ(065) USER DECLARED FILE REQUEST INDICATOR A0100269 EQU FMPMTR(066) FILE REQUEST PARAMETER LIST - 5 WORDS A0100270 EQU CHNAME(071) CHAIN REQUEST PROGRAM NAME - 4 WORDS A0100271 EQU MUFWAD(075) FIRST WORD ADDRESS OF THE MULTI-USER PROGRAM A0100272 EQU TEMPQR(076) TEMPORARY STORAGE - Q REGISTER A0100273 EQU TEMPAR(077) TEMPORARY STORAGE - A REGISTER A0100274 EQU RSC5E5(078) FORTRAN SCRATCH AREA STORAGE - 33 WORDS A0100275ÐÐ EQU SPARE1(111) SPARE ENTRY A0100276 EQU ENDPRO(111) END OF THE PROTECTED LINKAGE BUFFER AREA A0100277* A0100278 EQU UFPARM(112) USER DECLARED FILE REQUEST PARAMETERS A0100279 EQU FISTAT(128) USER DECLARED FILE REQUEST STATUS A0100280 EQU PFNAME(129) CURRENT PROCEDURE FILE NAME - 4 WORDS A0100281 EQU MENUKY(133) REQUESTED FUNCTION MENU KEY A0100282 EQU USABRT(134) USER PROGRAM ABORT INDICATOR A0100283 EQU USMODE(135) USER EXECUTION MODE INDICATOR A0100284 EQU TMPGMX(136) TEMPORARY - PROGRAM INDEX A0100285 EQU TMSECT(137) TEMPORARY - PROGRAM SECTOR - 2 WORDS A0100286 EQU TMPLEN(139) TEMPORARY - PROGRAM LENGTH A0100287 EQU TMUSID(140) TEMPORARY - USER IDENTIFICATION - 4 WORDS A0100288 EQU IREQBF(144) INPUT FILE REQUEST BUFFER AND FCB A0100289 EQU FINAME(188) INPUT FILE NAME - 4 WORDS A0100290 EQU OREQBF(192) OUTPUT FILE REQUEST BUFFER AND FCB A0100291 EQU FONAME(236) OUTPUT FILE NAME - 4 WORDS A0100292 EQU FIRCNO(240) INPUT FILE RECORD NUMBER - 2 WORDS A0100293 EQU LULBUF(256) LENGTH OF THE LINKAGE BUFFER A0100294 EJT A0100295 SPC 4 A0100296* I T O S E X E C U T I V E A0100297* A0100298* D A T A A N D S T O R A G E A0100299 SPC 4 A0100300ÐÐTSNABL ADC 0 ITOS ENABLED INDICATOR A0100301TSACTV ADC 0 ITOS ACTIVE INDICATOR A0100302TSCNAC ADC 0 MASTER TERMINAL ACTIVE INDICATOR A0100303EXPIRE ADC 0 MULTI-USER TIMESLICE SEMAPHORE A0100304USLICE ADC 10 NOMINAL USER TIMESLICE VALUE (COUNTS) A0100305TSMFLG ADC 0 MASS MEMORY ERROR INDICATOR A0100306XMBLOK ADC 0 MAIN MEMORY RESERVATION INDICATOR A0100307TEMP01 ADC 0 TEMPORARY STORAGE A0100308 EJT A0100309 SPC 4 A0100310* I T O S U S E R T A S K P R O C E S S O R A0100311 SPC 4 A0100312********************************************************************** A0100313* * A0100314* I T O S EXECUTIVE TASK PROCESSOR ENTRY * A0100315* * A0100316* ENTRY CONDITIONS: Q = 0 FOR NORMAL TASK ENTRY * A0100317* Q = 1 FOR ALL MASS MEMORY * A0100318* REQUEST CONTINUATIONS. * A0100319* * A0100320********************************************************************** A0100321 SPC 2 A0100322TSTASK STQ* TEMP01 SAVE THE ENTRY PARAMETER A0100323 SPC 1 A0100324 LDA* TSMFLG HAS A MASS MEMORY ERROR BEEN DETECTED A0100325ÐÐ SAZ TST000 NO, CONTINUE A0100326 JMP- (ADISP) YES, DO NOT PROCESS THE USER A0100327 SPC 1 A0100328TST000 ENA 0 A0100329 STA* EXPIRE INITIALIZE THE TIMESLICE SEMAPHORE A0100330 SPC 1 A0100331 RTJ LOGIN CHECK FOR LOG - IN REQUESTS A0100332 LDQ* TEMP01 A0100333 SQN TST010 MASS MEMORY ACTIVE, DO NOT ATTEMPT TO UNSWAP A0100334 SPC 1 A0100335 RTJ UNSWAP ATTEMPT TO REINSTATE A SWAPPED USER A0100336 SPC 1 A0100337TST010 RTJ+ OFNXUC REMOVE THE NEXT ENTRY FROM THE NXUC QUEUE A0100338 IIN 0 A0100339 INA 0 A0100340 STA* TSACTV SET/CLEAR THE ITOS ACTIVE INDICATOR A0100341 EIN 0 A0100342 SAN TST020 GO PROCESS THE USER A0100343 SPC 1 A0100344 CLR A,Q NO WORK TO DO A0100345 RTJ+ SETBND PROTECT THE USER AREA A0100346 JMP- (ADISP) AND EXIT A0100347 EJT A0100348 SPC 4 A0100349TST020 INA -NEXETH A0100350ÐÐ STA- I I = USER TABLE ADDRESS A0100351 SPC 1 A0100352 LDA- USRSTX,I A0100353 INA -SXMMUR IS THIS A MULTI-USER READ COMPLETION A0100354 SAN TST030 NO A0100355 RTJ TSACMP YES, PROCESS IT A0100356 SPC 1 A0100357TST030 LDA- I A = USER TABLE ADDRESS A0100358 RTJ+ DENSWP DELETE THE USER FROM THE NSWP QUEUE A0100359 SPC 1 A0100360 LDA* USLICE SET UP THE USERS TIMESLICE VALUE A0100361 STA* USTIME A0100362 SPC 1 A0100363TSTUEX LDQ- (TSIOTB),I A0100364 LDQ- IOCNPT,Q OBTAIN THE USERS CONTROL POINT A0100365 RTJ+ CPSET ACTIVATE IT A0100366 SPC 1 A0100367 LDA- USRSTX,I A0100368 INA -SXMASS IS THIS AN UNSWAP COMPLETION A0100369 SAM TST040 NO A0100370 RTJ UNSCMP YES, PROCESS IT A0100371 SPC 1 A0100372TST040 ENA SXCACT A0100373 STA- USRSTX,I INDICATE THE USER IS ACTIVE A0100374 SPC 1 A0100375ÐÐ RTJ* BOUNDS SET THE PROTECT BOUNDS REGISTERS A0100376 STQ- I I = LINKAGE BUFFER ADDRESS A0100377 SPC 1 A0100378 LDQ- ULIOTB,I A0100379 IIN 0 A0100380 LDA- IOSTAT,Q A0100381 STA* TEMP01 SAVE THE USERS I/O STATUS A0100382 AND- NZERO+DY CLEAR THE DYNAMIC STATUS FIELD A0100383 STA- IOSTAT,Q A0100384 EIN 0 A0100385 SPC 1 A0100386 ENA 0 INITIALIZE THE ERROR ADDRESS A0100387 STA- TEMPAR,I A0100388 EJT A0100389 LDQ* TEMP01 Q = USER'S I/O STATUS A0100390 LDA- ONEBIT+DS A0100391 LAQ A IS THE USER DISCONNECTED A0100392 SAZ TST050 NO A0100393 ENQ E09 YES, SPECIFY THE DISCONNECT MESSAGE A0100394 JMP* TST080 A0100395 SPC 1 A0100396TST050 LDA- ONEBIT+ME A0100397 LAQ A DID A MASS MEMORY ERROR OCCUR A0100398 SAZ TST060 NO A0100399 ENQ E10 YES, INDICATE THE ERROR A0100400ÐÐ JMP* TST080 A0100401 SPC 1 A0100402TST060 LDA- ONEBIT+FE A0100403 LAQ A DID A FILE ERROR OCCUR A0100404 SAZ TST070 NO A0100405 ENQ E11 YES, INDICATE THE ERROR A0100406 LDA- FRQBFA,I SPECIFY THE ERROR ADDRESS A0100407 STA- TEMPAR,I A0100408 JMP* TST080 A0100409 SPC 1 A0100410TST070 LDA- ONEBIT+ES A0100411 LAQ A WAS A PROGRAM ABORT RECIEVED A0100412 SAZ TST090 NO A0100413 ENQ E12 YES, SPECIFY THE ABORT MESSAGE A0100414 SPC 1 A0100415TST080 LDA- TEMPAR,I A = ERROR ADDRESS A0100416 JMP+ TSXERR GO PROCESS THE ERROR MESSAGE A0100417 SPC 1 A0100418TST090 LDA- ONEBIT+MN A0100419 LAQ A DID A MANUAL INTERRUPT OCCUR A0100420 SAZ TST120 NO A0100421 SPC 1 A0100422 LDA- INTADD,I YES, IS AN INTERRUPT ADDRESS SPECIFIED A0100423 SAZ TST100 NO A0100424 STA- RSP,I YES, SET UP THE RETURN ADDRESS A0100425ÐÐ ENA 0 RELEASE ANY POSSIBLE I/O COMPLETION A0100426 STA- RSCPAD,I A0100427 JMP* TST120 CONTINUE A0100428 SPC 1 A0100429TST100 LDQ- INTFLG,I A0100430 SQZ TST120 SKIP IF NO FLAG IS SPECIFIED A0100431 RAO- (ZERO),Q ENABLE THE INTERRUPT FLAG A0100432 EJT A0100433 SPC 4 A0100434TST120 LDQ* TEMP01 Q = USER'S I/O STATUS A0100435 LDA- ONEBIT+IC A0100436 LAQ A HAS AN I/O REQUEST COMPLETED A0100437 SAZ TST140 NO, PASS CONTROL TO THE USER PROGRAM A0100438 SPC 1 A0100439 LDA- FILREQ,I IS THIS A DECLARED FILE REQUEST COMPLETION A0100440 SAZ TST130 NO, CONTINUE A0100441 LDA- FISTAT,I YES, WAS THERE A FILE ERROR A0100442 SAP TST130 NO, CONTINUE A0100443 STA- USABRT,I YES, ABORT THE USER PROGRAM A0100444 SPC 1 A0100445TST130 LDA- ONEBIT+IN A0100446 LAQ A HAS AN INPUT REQUEST COMPLETED A0100447 SAN TST150 YES A0100448 SPC 1 A0100449TST140 JMP* TST200 NO, CONTINUE A0100450ÐÐ SPC 1 A0100451TST150 LDQ- ULIOTB,I A0100452 LDQ- TERMBF,Q A0100453 LR1- 4,Q R1 = SOURCE DATA BUFFER ADDRESS A0100454 LR2- RSUSBF,I R2 = DESTINATION DATA BUFFER ADDRESS A0100455 SPC 1 A0100456 LDA- 3,Q OBTAIN THE NUMBER OF CHARACTERS ENTERED A0100457 STA- TEMPAR,I SAVE A0100458 LDA- 2,Q OBTAIN THE TERMINATION CODE A0100459 LDQ- WRTCAD,I IS A TERMINATION CODE ADDRESS SPECIFIED A0100460 SQZ TST160 NO A0100461 STA- (ZERO),Q YES, RETURN THE VALUE A0100462 SPC 1 A0100463TST160 LDQ- RSUSBF,I A0100464 ADQ- RSUSLN,I Q = LWA + 1 OF THE USERS BUFFER A0100465 LDA- TEMPAR,I A = NUMBER OF ENTERED CHARACTERS A0100466 STA- (ZERO),Q RETURN THE NUMBER OF ENTERED CHARACTERS A0100467 SPC 1 A0100468 TRA Q Q = NUMBER OF CHARACTERS TO MOVE A0100469 SJ4+ MOV RETURN THE DATA TO THE USER A0100470 EJT A0100471 SPC 4 A0100472TST200 ENA 0 A0100473 STA- RSIOTH,I CLEAR THE REQUEST THREAD A0100474 SPC 1 A0100475ÐÐ RTJ+ TSRFTN RESTORE THE USERS FORTRAN SCRATCH AREA A0100476 SPC 1 A0100477 ENQ 1 A0100478 RTJ+ EXTREG RESTORE THE USERS EXTENDED REGISTERS A0100479 SPC 1 A0100480 LDA* USTIME A = USERS TIMESLICE A0100481 IIN 0 A0100482 RTJ+ TSCLOK ACTIVATE THE TIMESLICE CLOCK A0100483 SPC 1 A0100484 LDQ- I Q = USER LINKAGE BUFFER ADDRESS A0100485 LDA- ONEBIT+15 A0100486 SOV 0 A0100487 ADD- RSL,Q RESTORE THE OVERFLOW CONDITION A0100488 LDA- RSI,Q A0100489 STA- I RESTORE THE I-REGISTER A0100490 LDA- RSP,Q A0100491 STA- (LASTEP),Q SAVE THE LAST USER EXECUTION ADDRESS A0100492 STA* USTIME A0100493 LDA- RSA,Q RESTORE THE A-REGISTER A0100494 LDQ- RSQ,Q RESTORE THE Q-REGISTER A0100495 EIN 0 A0100496 JMP* (USTIME) TRANSFER CONTROL TO THE USER PROGRAM A0100497 SPC 2 A0100498USTIME ADC 0 TEMPORARY STORAGE A0100499 EJT A0100500ÐÐ SPC 4 A0100501********************************************************************** A0100502* * A0100503* I T O S USER SUBROUTINE RETURN PROCESSOR * A0100504* * A0100505* ENTRY CONDITIONS: I = USER LINKAGE BUFFER ADDRESS * A0100506* * A0100507********************************************************************** A0100508 SPC 2 A0100509TSURTN LDA- RSCLOK,I OBTAIN THE USERS REMAINING TIMESLICE A0100510 SAZ TSU010 A0100511 INA -1 ADJUST FOR THIS REQUEST A0100512TSU010 STA* USTIME A0100513 SPC 1 A0100514 LDA- ULUSTB,I A0100515 STA- I I = USER TABLE ADDRESS A0100516 JMP* TSTUEX RETURN THE USER TO EXECUTION A0100517 EJT A0100518 SPC 4 A0100519* A0100520* BOUNDS TSTASK SUBROUTINE USED TO SET THE USER A0100521* ------ PROGRAM PROTECT BOUNDS REGISTERS A0100522* A0100523* ENTRY CONDITIONS: I = USER TABLE ADDRESS A0100524* A0100525ÐÐ* EXIT CONDITIONS: Q = LINKAGE BUFFER ADDRESS A0100526* A0100527 SPC 2 A0100528BOUNDS NOP 0 A0100529 SPC 1 A0100530 LDQ* APRTBL A0100531 LDA- TSMUTB,I IS THE USER A MULTI-USER ROOT A0100532 SAZ BND010 NO A0100533 LDA- 3,Q YES A0100534 JMP* BND020 UPPER PROTECT BOUNDS = PARTITION(3) A0100535 SPC 1 A0100536BND010 LDA- PGMSIZ,I A0100537 ADD- 1,Q UPPER PROTECT BOUNDS = PARTITION(1) + PGMSIZ A0100538 SPC 1 A0100539BND020 LDQ- 1,Q A0100540 INQ ENDPRO LOWER PROTECT BOUNDS = PARTITION(1) + ENDPRO A0100541 LLS 16 A0100542 RTJ+ SETBND SET THE PROTECT BOUNDS A0100543 SPC 1 A0100544 LDQ* (ATSAR1) A0100545 LDA+ UBPROT A0100546 STA- RSUB,Q SET UP THE USERS UPPER BOUNDS REGISTER A0100547 SPC 1 A0100548 JMP* (BOUNDS) RETURN A0100549 EJT A0100550ÐÐ********************************************************************** A0100551* * A0100552* I T O S EXECUTIVE UNSWAP CONTROL ROUTINE * A0100553* * A0100554* THIS ROUTINE IS RESPONSIBLE FOR REMOVING ENTRIES * A0100555* FROM THE 'NEXT EXECUTING - MASS' QUEUE * A0100556* * A0100557* ENTRY CONDITIONS: NONE * A0100558* * A0100559* EXIT CONDITIONS: (1) THE ATTEMPT IS UNSUCCESSFUL * A0100560* (2) MASS MEMORY READ INITIATED * A0100561* * A0100562********************************************************************** A0100563 SPC 2 A0100564UNSWAP NOP 0 A0100565 LDA UNSACT IS THE UNSWAP SUBROUTINE ACTIVE A0100566 SAN UNS020 YES, EXIT A0100567 SPC 1 A0100568 LDQ XMBLOK IS THERE A MEMORY RESERVATION REQUESTED A0100569 SQZ UNS010 NO A0100570 RTJ RESMEM YES, PROCESS IT A0100571 SPC 1 A0100572UNS010 RTJ+ GTNXUM OBTAIN THE NEXT ENTRY ON THE NXUM QUEUE A0100573 INA 0 ARE THERE ANY ENTRIES A0100574 SAN UNS030 YES, CONTINUE A0100575ÐÐ SPC 1 A0100576UNS020 JMP* (UNSWAP) NO, RETURN A0100577 SPC 1 A0100578UNS030 INA -NEXETH A0100579 STA- I I = USER OR MULTI-USER TABLE ADDRESS A0100580 SPC 1 A0100581 LDQ- PGMSIZ,I Q = PROGRAM SIZE A0100582 RTJ NOPAGE CONVERT THE LENGTH TO PAGES A0100583 STQ* NUMPGS SAVE THE NUMBER OF REQUIRED PAGES A0100584 SPC 1 A0100585 RTJ* (AXMALC) ALLOCATE EXECUTION MEMORY FOR THE USER A0100586 SQP UNSAOK ALLOCATION WAS SUCESSFUL A0100587 JMP* UNSNOT INSUFFICIENT MEMORY, PERFORM A SWAP A0100588 EJT A0100589 SPC 4 A0100590********************************************************************** A0100591* * A0100592* THIS ROUTINE PROCESSES UNSWAP REQUESTS WHEN THERE IS * A0100593* SUFFICIENT EXECUTION MEMORY AVAILABLE * A0100594* * A0100595* ENTRY CONDITIONS: I = USER OR MULTI-USER TABLE * A0100596* ADDRESS OF THE SWAPPED USER * A0100597* Q = BASE PAGE OF THE USERS MEMORY * A0100598* * A0100599********************************************************************** A0100600ÐÐ SPC 2 A0100601UNSAOK TRQ A A = BASE PAGE NUMBER A0100602 RTJ DEFPAG SET UP AND DEFINE THE CONTROL POINT A0100603 STQ* UNSXFR Q = USERS CONTROL POINT A0100604 SPC 1 A0100605 LDA- USRSTX,I A0100606 INA -SXMMUR IS THIS A MULTI-USER READ A0100607 SAN UNS110 NO A0100608 STQ- MUCNPT,I SAVE THE MULTI-USER CONTROL POINT A0100609 JMP* UNS120 A0100610 SPC 1 A0100611UNS110 LDQ- (TSIOTB),I A0100612 LDA* UNSXFR A0100613 STA- IOCNPT,Q SPECIFY THE USERS CONTROL POINT A0100614 SPC 1 A0100615UNS120 LDA- I A0100616 RTJ+ DENXUM REMOVE THE USER FROM THE NXUM QUEUE A0100617 SPC 1 A0100618 LDQ* UNSXFR Q = USERS CONTROL POINT A0100619 RTJ* READMM TRANSFER THE USER PROGRAM INTO MAIN MEMORY A0100620 SPC 1 A0100621 JMP* (UNSWAP) RETURN A0100622 EJT A0100623 SPC 4 A0100624********************************************************************** A0100625ÐÐ* * A0100626* THIS ROUTINE PROCESSES UNSWAP REQUESTS WHEN THERE IS * A0100627* INSUFFICIENT EXECUTION MEMORY AVAILABLE * A0100628* * A0100629* ENTRY CONDITIONS: I = USER OR MULTI-USER TABLE * A0100630* ADDRESS OF THE SWAPPED USER * A0100631* * A0100632********************************************************************** A0100633 SPC 2 A0100634UNSNOT LDQ* NUMPGS Q = NUMBER OF PAGES REQUIRED A0100635 RTJ COLSWP CAN A COLLECTIVE SWAP PROVIDE THE MEMORY A0100636 SQP UNS210 YES A0100637 JMP* (UNSWAP) NO, RETURN A0100638 SPC 1 A0100639UNS210 JMP* UNSAOK READ IN THE USER PROGRAM A0100640 SPC 4 A0100641* U N S W A P R O U T I N E D A T A A N D S T O R A G E A0100642 SPC 2 A0100643UNSXFR NUM 0 UNSWAP ROUTINE TEMPORARY STORAGE A0100644NUMPGS NUM 0 NUMBER OF 2K PAGES ALLOCATED TO THE USER A0100645TSULBF ADC 0 SECTOR ADDRESS OF THE ULB BUFFER A0100646ATSPRT ADC TSPORT USER I/O TABLE STARTING ADDRESS A0100647AIOITM ADC IOITEM USER I/O TABLE WORDS / ENTRY A0100648APRTBL ADC PARTBL PARTITIONED CORE TABLE ADDRESS A0100649ATSAR1 ADC TSAREA START OF THE USER AREA A0100650ÐÐAXMALC ADC XMALC EXECUTION MEMORY ALLOCATION ROUTINE A0100651 EJT A0100652 SPC 4 A0100653* A0100654* UNSCMP TSTASK SUBROUTINE USED TO PROCESS UNSWAP A0100655* ------ COMPLETIONS A0100656* A0100657* ENTRY CONDITIONS: I = USER TABLE ADDRESS A0100658* Q = USERS CONTROL POINT A0100659* A0100660* EXIT CONDITIONS: I = USER TABLE ADDRESS A0100661* A0100662 SPC 2 A0100663UNSCMP NOP 0 A0100664 SPC 1 A0100665 STQ* UNSXFR SAVE THE USERS CONTROL POINT A0100666 LDA- I A = USER TABLE ADDRESS A0100667 STA* NUMPGS SAVE A0100668 SPC 1 A0100669 LDA- USRSTX,I A0100670 INA -SXMLOG A0100671 SAN USC010 A0100672 JMP* USC040 GO PROCESS AN INITIAL LOG-IN A0100673 SPC 1 A0100674USC010 INA +SXMLOG-SXMJOB A0100675ÐÐ SAZ USC030 GO PROCESS A JOB STEP SEQUENCE A0100676 SPC 1 A0100677 LDA- I PROCESS A NORMAL UNSWAP A0100678 RTJ+ FUNSHR REMOVE THE USERS FILES FROM SHARED STATUS A0100679 SPC 1 A0100680 LDQ- PGMSIZ,I Q = PROGRAM LENGTH A0100681 RTJ+ MMREL RELEASE THE SWAP AREA A0100682 SQP USC020 A0100683 RTJ+ SYFAIL NO MEMORY ASSIGNED, FATAL ERROR A0100684USC020 JMP* (UNSCMP) RETURN A0100685 SPC 1 A0100686USC030 LDQ* UNSXFR A0100687 RTJ* READUL READ IN THE USER LINKAGE BUFFER A0100688 SPC 1 A0100689 LDA* (ATSAR1) A0100690 STA- I I = LINKAGE BUFFER ADDRESS A0100691 JMP* USC060 CONTINUE A0100692 EJT A0100693 SPC 4 A0100694USC040 LDA- I A0100695 STA* UNSXFR SAVE THE USER TABLE ADDRESS A0100696 LDA* (ATSAR1) A0100697 STA- I I = LINKAGE BUFFER ADDRESS A0100698 RTJ+ TSCLLB CLEAR THE LINKAGE BUFFER A0100699 SPC 1 A0100700ÐÐ LDQ* UNSXFR A0100701 STQ- ULUSTB,I SET UP THE USER TABLE ADDRESS A0100702 SPC 1 A0100703 LDA- (TSIOTB),Q A0100704 STA- ULIOTB,I SET UP THE I/O TABLE ADDRESS A0100705 SUB* ATSPRT CALCULATE THE PORT NUMBER A0100706 CLR Q A0100707 DVI* AIOITM A0100708 STA- PORTNO,I PORTNO = (ULIOTB-TSPORT)/IOITEM A0100709 SPC 1 A0100710 ENQ 5 A0100711USC050 LDA+ YERTO,Q A0100712 STA- DATIME,B SET UP THE DATE AND TIME A0100713 DQP *-USC050 A0100714 SPC 1 A0100715USC060 LDQ* APRTBL A0100716 LDA- 2,Q A0100717 STA- RSP,I SET UP THE INITIAL EXECUTION ADDRESS A0100718 SPC 1 A0100719 LDA- TMPGMX,I A0100720 STA- USRPGM,I SET UP THE PROGRAM INDEX A0100721 SPC 1 A0100722 LDA* NUMPGS A0100723 STA- I I = USER TABLE ADDRESS A0100724 JMP* (UNSCMP) RETURN A0100725ÐÐ EJT A0100726* A0100727* READUL TSTASK SUBROUTINE USED TO READ THE USER A0100728* ------ LINKAGE BUFFER FROM THE AREA IN WHICH A0100729* IT WAS WRITTEN PRIOR TO THE JOB STEP A0100730* A0100731* ENTRY CONDITIONS: I = USER TABLE ADDRESS A0100732* Q = USERS CONTROL POINT A0100733 SPC 2 A0100734READUL NOP 0 A0100735 SPC 1 A0100736 STQ* REUCCP SAVE THE USERS CONTROL POINT A0100737 LDA- (TSIOTB),I A0100738 SUB* ATSPRT CALCULATE THE USERS PORT NUMBER A0100739 CLR Q A0100740 DVI* AIOITM A0100741 MUI- THREE A0100742 ADD* TSULBF A = ULB BUFFER SECTOR A0100743 STA* REUSEC SAVE A0100744 LDA* (ATSAR2) A = FWA OF THE LINKAGE BUFFER A0100745 STA* REUADR SAVE A0100746 SPC 1 A0100747 RTJ- (AMONI) READ THE LINKAGE BUFFER A0100748 ADC $6000 A0100749 ADC REUREQ A0100750ÐÐ JMP- (ADISP) A0100751 SPC 1 A0100752REU010 SQP REU020 MASS MEMORY I/O COMPLETION A0100753 RTJ+ TSMMER MASS MEMORY ERROR A0100754 SPC 1 A0100755REU020 LDQ* REUCCP A0100756 RTJ+ CPSET RESTORE THE CONTROL POINT A0100757 JMP* (READUL) RETURN A0100758 SPC 2 A0100759* M A S S M E M O R Y R E A D I / O R E Q U E S T A0100760 SPC 2 A0100761REUREQ ADC $48F4 FORMATTED READ A0100762 ADC REU010 COMPLETION ADDRESS A0100763 ADC 0 REQUEST THREAD A0100764 ADC $08C2 LOGICAL UNIT A0100765ULBLEN ADC LULBUF LINKAGE BUFFER LENGTH A0100766REUADR ADC 0 LINKAGE BUFFER ADDRESS A0100767 NUM $8000 LINKAGE BUFFER SECTOR A0100768REUSEC ADC 0 LINKAGE BUFFER SECTOR A0100769REUCCP ADC 0 LINKAGE BUFFER CONTROL POINT A0100770 EJT A0100771* A0100772* READMM TSTASK SUBROUTINE USED TO READ A USER OR A0100773* ------ MULTI-USER PROGRAM INTO MAIN MEMORY A0100774* A0100775ÐÐ* ENTRY CONDITIONS: I = USER OR MULTI-USER A0100776* TABLE ADDRESS A0100777* Q = USERS CONTROL POINT A0100778* A0100779* EXIT CONDITIONS: I = SAVED A0100780* A0100781 SPC 2 A0100782READMM NOP 0 A0100783 STQ* REACCP CONTROL POINT = ENTRY VALUE A0100784 SPC 1 A0100785 LDA- PGMSEC,I A0100786 STA* REAMSB SECTOR ADDRESS = PROGRAM SECTOR A0100787 LDA- PGMSEC+1,I A0100788 STA* REALSB A0100789 SPC 1 A0100790 LDA- PGMSIZ,I A0100791 LDQ- USRSTX,I A0100792 INQ -SXMLOG IS THIS A NEW PROGRAM A0100793 SQZ REA010 YES A0100794 INQ +SXMLOG-SXMJOB A0100795 SQN REA020 NO A0100796REA010 SUB* ULBLEN NEW PROGRAM, REMOVE THE LINKAGE BUFFER SIZE A0100797REA020 STA* REALEN LENGTH = PROGRAM SIZE A0100798 SPC 1 A0100799 TRQ A A0100800ÐÐ LDQ* APRTBL A0100801 INQ 1 Q = ADDRESS OF PARTITION (1) A0100802 SAN REA030 SKIP IF THIS IS NOT A NEW PROGRAM A0100803 INQ 1 Q = ADDRESS OF PARTITION (2) A0100804 SPC 1 A0100805REA030 LDA- (ZERO),Q A0100806 STA* READDR SPECIFY THE STARTING ADDRESS A0100807 SPC 1 A0100808 LDA- I SPECIFY THE USER TABLE ADDRESS A0100809 STA* REAUSR FOR THE COMPLETION PROCESSOR A0100810 SPC 1 A0100811 RTJ- (AMONI) READ THE PROGRAM FROM MASS MEMORY A0100812 ADC $6000 A0100813 ADC REAREQ A0100814 SPC 1 A0100815 JMP* (READMM) REQUEST ACCEPTED, RETURN A0100816 EJT A0100817 SPC 4 A0100818* M A S S M E M O R Y R E A D I / O R E Q U E S T A0100819 SPC 2 A0100820REAREQ ADC $48F5 0 - FORMATTED READ A0100821 ADC TSUSCP 1 - COMPLETION ADDRESS IN TSIOCP A0100822UNSACT ADC 0 2 - REQUEST THREAD A0100823 ADC $08C2 3 - LOGICAL UNIT A0100824REALEN ADC 0 4 - USER PROGRAM LENGTH A0100825ÐÐREADDR ADC 0 5 - USER PROGRAM ADDRESS A0100826REAMSB ADC 0 6 - USER PROGRAM SECTOR A0100827REALSB ADC 0 7 - USER PROGRAM SECTOR A0100828REACCP ADC 0 8 - USER CONTROL POINT A0100829REAUSR ADC 0 9 - USER TABLE ADDRESS A0100830 EJT A0100831* A0100832* LOGIN TSTASK SUBROUTINE USER TO FIND AND SET UP A0100833* ----- ALL USER I/O TABLES WHICH CONTAIN A0100834* LOG-IN STATUS A0100835* A0100836* ENTRY CONDITIONS: NONE A0100837* A0100838* EXIT CONDITIONS: (TSIOTB) = I/O TABLE ADDR. A0100839* (TSUSTB) = USER TABLE ADDR. A0100840* FOR ALL LOG-IN'S A0100841* A0100842 SPC 2 A0100843LOGIN NOP 0 A0100844 LDQ =XTSPORT OBTAIN THE I/O TABLE ADDRESS A0100845 SPC 1 A0100846LOG010 STQ- I A0100847 LDQ- ONEBIT+LI A0100848 IIN 0 A0100849 LDA- IOSTAT,I A0100850ÐÐ LAQ Q Q = LOG-IN STATUS A0100851 AND- ZROBIT+LI A0100852 STA- IOSTAT,I CLEAR THE STATUS, IF PRESENT A0100853 EIN 0 A0100854 SQZ LOG050 SKIP IF NO LOG-IN A0100855 LDQ =XTSUSER OBTAIN THE USER TABLE ADDRESS A0100856 SPC 1 A0100857LOG030 LDA- PGMSIZ,Q IS THIS ENTRY AVAILABLE A0100858 SAZ LOG070 YES A0100859 INQ USRITM NO, INCREMENT TO THE NEXT ENTRY A0100860 TRQ A A0100861 SUB* ATSUND HAVE ALL ENTRIES BEEN EXAMINED A0100862 SAP LOG060 YES A0100863 JMP* LOG030 NO, CONTINUE A0100864 SPC 1 A0100865LOG050 LDQ- I A0100866 INQ IOITEM INCREMENT TO THE NEXT I/O TABLE A0100867 TRQ A A0100868 SUB* ATSPND HAVE ALL I/O TABLES BEEN EXAMINED A0100869 SAP LOG060 YES, RETURN A0100870 JMP* LOG010 NO, CONTINUE A0100871 SPC 1 A0100872LOG060 JMP* (LOGIN) A0100873 EJT A0100874 SPC 4 A0100875ÐÐLOG070 LDA- I A0100876 STA- (TSIOTB),Q SET THE I/O TABLE ADDRESS IN THE USER TABLE A0100877 STQ- (TSUSTB),I SET THE USER TABLE ADDRESS IN THE I/O TABLE A0100878 SPC 1 A0100879 LDQ* ATSMSB A0100880 LDA- (ZERO),Q A0100881 LDQ- (TSUSTB),I A0100882 STA- PGMSEC,Q A0100883 LDQ* ATSLSB SET UP THE SECTOR ADDRESS OF TSLOG A0100884 LDA- (ZERO),Q A0100885 LDQ- (TSUSTB),I A0100886 STA- PGMSEC+1,Q A0100887 LDA* (ATSLSZ) A0100888 ADD* ULBLEN A0100889 STA- PGMSIZ,Q AND THE PROGRAM LENGTH A0100890 SPC 1 A0100891 ENA SXMLOG A0100892 STA- USRSTX,Q INDICATE AN INITIAL LOG-IN A0100893 SPC 1 A0100894 TRQ A A0100895 ENQ QPL3 QUEUE PRIORITY = 3 A0100896 RTJ+ ONNXUM PLACE THE USER ON THE NXUM QUEUE A0100897 JMP* LOG050 AND CONTINUE A0100898 SPC 2 A0100899ATSPND ADC TSPEND PORT TABLE ENDING ADDRESS A0100900ÐÐATSUND ADC TSUEND USER TABLE ENDING ADDRESS A0100901ATSLSZ ADC TSLSIZ LOG-IN PROCESSOR LENGTH A0100902ATSMSB ADC TSLMSB LOG-IN PROCESSOR SECTOR ADDRESS A0100903ATSLSB ADC TSLLSB LOG-IN PROCESSOR SECTOR ADDRESS A0100904ATSAR2 ADC TSAREA START OF THE USER PROGRAM AREA A0100905 EJT A0100906 SPC 4 A0100907* A0100908* RESMEM TSTASK SUBROUTINE USED TO PROCESS A MAIN A0100909* ------ MEMORY RESERVATION REQUEST A0100910* A0100911* ENTRY CONDITIONS: Q = MEMORY RESERVATION A0100912* INDICATOR A0100913* A0100914* EXIT CONDITIONS: A0100915* INDICATOR = 0 IF SUCCESSFUL A0100916* A0100917 SPC 2 A0100918RESMEM NOP 0 A0100919 SPC 1 A0100920 ENA -1 A0100921 STA- I SPECIFY A RESERVATION A0100922 SPC 1 A0100923 RTJ* (AMXRSV) ATTEMPT TO RESERVE THE MEMORY A0100924 SQP RES010 THE MEMORY IS RESERVED A0100925ÐÐ SPC 1 A0100926 LDQ- LPMASK+15 ASSURE A COMPLETE SWAP A0100927 RTJ* COLSWP SWAP ALL USERS A0100928 SPC 1 A0100929 LDQ* (AXMBLK) A0100930 RTJ* (AMXRSV) ATTEMPT TO RESERVE THE MEMORY A0100931 SQM RES020 THE MEMORY IS STILL NOT AVAILABLE A0100932 SPC 1 A0100933RES010 ENA 0 A0100934 STA* (AXMBLK) INDICATE THE RESERVATION IS COMPLETE A0100935 SPC 1 A0100936RES020 JMP* (RESMEM) RETURN A0100937 SPC 2 A0100938AMXRSV ADC XMRSV MAIN MEMORY RESERVATION ROUTINE A0100939AXMBLK ADC XMBLOK MAIN MEMORY RESERVATION INDICATOR A0100940 EJT A0100941* A0100942* MUFREE TSTASK SUBROUTINE USED TO RELEASE ALL A0100943* ------ MULTI-USER PROGRAMS WHICH CURRENTLY A0100944* HAVE NO ACTIVE ROOTS ATTACHED A0100945 SPC 2 A0100946MUFREE NOP 0 A0100947 LDQ- I A0100948 STQ* MUSAVI SAVE THE REQUESTORS I-REGISTER A0100949 LDQ* ATSMSR OBTAIN THE MULTI-USER TABLE ADDRESS A0100950ÐÐ SPC 1 A0100951MUF010 STQ- I I = MULTI-USER TABLE ADDRESS A0100952 SPC 1 A0100953 LDA- ACROOT,I ARE ANY OF ITS ROOTS ACTIVE A0100954 SAN MUF030 YES A0100955 SPC 1 A0100956 LDA- MUPAGE,I NO, IS IT ACTIVE A0100957 SAZ MUF030 NO, IGNORE THIS ENTRY A0100958 LDA- USRSTX,I YES A0100959 INA -SXMMUR IS THE MULTI-USER BEING READ IN A0100960 SAZ MUF030 YES, IGNORE THIS ENTRY A0100961 RTJ+ XMREL RELEASE THE PROGRAMS EXECUTION MEMORY A0100962 SQP MUF020 A0100963 RTJ* (ASYFAL) FATAL ERROR A0100964 SPC 1 A0100965MUF020 ENA 0 INDICATE THE PROGRAM IS INACTIVE A0100966 STA- MUPAGE,I A0100967 SPC 1 A0100968MUF030 LDQ- I A0100969 INQ MUITEM INCREMENT TO THE NEXT ENTRY A0100970 TRQ A A0100971 SUB* ATSMND HAVE ALL ENTRIES BEEN EXAMINED A0100972 SAP MUF040 YES A0100973 JMP* MUF010 NO, CONTINUE A0100974 SPC 1 A0100975ÐÐMUF040 LDQ* MUSAVI A0100976 STQ- I RESTORE THE REQUESTORS I-REGISTER A0100977 JMP* (MUFREE) AND RETURN A0100978 SPC 2 A0100979ASYFAL ADC SYFAIL SYSTEM FAILURE ROUTINE A0100980ATSMSR ADC TSMUSR MULTI-USER TABLE STARTING ADDRESS A0100981ATSMND ADC TSMEND MULTI-USER TABLE ENDING ADDRESS A0100982MUSAVI NUM 0 TEMPORARY STORAGE - REQUESTORS I-REGISTER A0100983 EJT A0100984* A0100985* MUSTAT TSTASK SUBROUTINE USED TO UPDATE THE MULTI- A0100986* ------ USER STATE OF A ROOT PROGRAM WHICH A0100987* IS BEING SWAPPED A0100988* A0100989* ENTRY CONDITIONS: Q = USER TABLE ADDRESS OF A0100990* THE SWAP CANDIDATE A0100991* A0100992* EXIT CONDITIONS: I = VALUE AT ENTRY A0100993* A0100994 SPC 2 A0100995MUSTAT NOP 0 A0100996 LDA- I SAVE THE USERS I-REGISTER A0100997 STA* MUSAVI A0100998 STQ- I I = CANDIDATES USER TABLE ADDRESS A0100999 SPC 1 A0101000ÐÐ LDQ- TSMUTB,I IS THE PROGRAM A MULTI-USER ROOT A0101001 SQN MUS010 YES A0101002 JMP* MUS030 NO, RETURN A0101003 SPC 1 A0101004MUS010 LDA- ACROOT,Q A0101005 INA -1 DECREASE THE ACTIVE ROOT COUNT A0101006 SAP MUS020 A0101007 RTJ* (ASYFAL) INVALID ROOT COUNT A0101008MUS020 STA- ACROOT,Q A0101009 SPC 1 A0101010 ENA 0 A0101011 STA- TSMUTB,I DETACH THE MULTI-USER ROOT A0101012 SPC 1 A0101013 LDA* (ATSAR2) A0101014 STA- I I = LINKAGE BUFFER ADDRESS A0101015 SPC 1 A0101016 LDQ =XPARTBL A0101017 LDQ- 2,Q Q = FWA OF THE USER PROGRAM A0101018 LDA- RSP,I A0101019 STQ- RSP,I P = START OF THE USER PROGRAM A0101020 LDQ- ATTADR,I A0101021 LDQ- (ZERO),Q IS THE ORIGINAL RETURN ALREADY SET UP A0101022 SQN MUS030 YES, EXIT A0101023 LDQ- ATTADR,I NO A0101024 STA- (ZERO),Q SAVE THE ORIGINAL RETURN FOR THE USER A0101025ÐÐ SPC 1 A0101026MUS030 LDA* MUSAVI A0101027 STA- I RESTORE THE REQUESTORS I-REGISTER A0101028 JMP* (MUSTAT) RETURN A0101029 EJT A0101030 SPC 4 A0101031* A0101032* COLSWP TSTASK SUBROUTINE USED TO PERFORM A A0101033* ------ COLLECTIVE SWAP OF ALL USERS ON THE A0101034* 'NEXT-TO-SWAP' QUEUE A0101035* A0101036* ENTRY CONDITIONS: Q = NUMBER OF REQUIRED PAGESA0101037* I = USER TABLE ADDRESS OF A0101038* THE PROGRAM REQUIRING A0101039* EXECUTION MEMORY A0101040* A0101041* EXIT CONDITIONS: Q = BASE PAGE IF SUCCESSFUL A0101042* Q = -1 IF NOT SUCCESSFUL A0101043 SPC 2 A0101044COLSWP NOP 0 A0101045 SPC 1 A0101046 STQ* CLNOPG SAVE THE NUMBER OF PAGES A0101047 LDA- I A0101048 STA* CLSAVI SAVE THE REQUESTORS I-REGISTER A0101049 SPC 1 A0101050ÐÐCOL010 RTJ* MUFREE RELEASE ANY UNTTACHED MULTI-USER PROGRAMS A0101051 SPC 1 A0101052 LDQ* CLNOPG Q = NUMBER OF PAGES REQUIRED A0101053 RTJ* (AXMLC1) CAN THE REQUEST BE HONORED A0101054 SQP COL020 YES, Q = BASE PAGE NUMBER A0101055 SPC 1 A0101056 RTJ+ OFNSWP NO, OBTAIN THE NEXT USER ON THE NSWP QUEUE A0101057 IIN 0 A0101058 INA 0 ANY ENTRIES ON THE QUEUE A0101059 SAN COL030 YES A0101060 EIN 0 A0101061 SPC 1 A0101062 ENQ -1 NO, INDICATE NO SUCCESS A0101063COL020 JMP* COL040 RETURN A0101064 EJT A0101065 SPC 4 A0101066COL030 INA -NSWPTH A0101067 STA- I I = USER TABLE ADDRESS OF THE CANDIDATE A0101068 LDA- USRSTX,I A0101069 EOR- ONEBIT+15 INDICATE A SWAP IS IN PROGRESS A0101070 STA- USRSTX,I A0101071 EIN 0 A0101072 SPC 1 A0101073 LDA- I A0101074 RTJ+ DENXUC DELETE THE CANDIDATE FROM THE NXUC QUEUE A0101075ÐÐ SPC 1 A0101076 RTJ* SWAPUS SWAP THE CANDIDATE A0101077 SPC 1 A0101078 LDQ* CLSAVI A0101079 STQ- I I = USER OR MULTI-USER TABLE ADDRESS A0101080 SPC 1 A0101081 LDQ* CLNOPG Q = NUMBER OF PAGES REQUIRED A0101082 RTJ* (AXMLC1) CAN THE REQUEST BE HONORED NOW A0101083 SQP COL040 YES, Q = BASE PAGE NUMBER A0101084 JMP* COL010 NO, TRY AGAIN A0101085 SPC 1 A0101086COL040 LDA* CLSAVI A0101087 STA- I RESTORE THE REQUESTORS I-REGISTER A0101088 JMP* (COLSWP) RETURN A0101089 SPC 2 A0101090AXMLC1 ADC XMALC EXECUTION MEMORY ALLOCATION ROUTINE A0101091CLNOPG NUM 0 TEMPORARY STORAGE - NUMBER OF PAGES A0101092CLSAVI NUM 0 TEMPORARY STORAGE - REQUESTORS I-REGISTER A0101093 EJT A0101094 SPC 4 A0101095* A0101096* SWAPUS TSTASK SUBROUTINE USED TO UNCONDITIONALLY A0101097* ------ SWAP A USER PROGRAM A0101098* A0101099* ENTRY CONDITIONS: I = USER TABLE ADDRESS A0101100ÐÐ* A0101101* EXIT CONDITIONS: I = VALUE AT ENTRY A0101102 SPC 2 A0101103SWAPUS NOP 0 A0101104 LDA- I A0101105 STA* SWSAVI SAVE THE I-REGISTER FOR THE I/O COMPLETION A0101106 SPC 1 A0101107 LDA* (ATSAR2) A0101108 STA* SWUADD STARTING ADDRESS = BEGINNING OF USER AREA A0101109 SPC 1 A0101110 LDQ- (TSIOTB),I A0101111 LDQ- IOCNPT,Q A0101112 STQ* SWUCCP CONTROL POINT = USERS C. P. A0101113 RTJ+ CPSET ACTIVATE THE USERS CONTROL POINT A0101114 SPC 1 A0101115 LDA- I A = USER TABLE ADDRESS A0101116 RTJ+ FSHARE FORCE SHARE THE USERS FILES A0101117 SPC 1 A0101118 LDQ- PGMSIZ,I A0101119 STQ* SWULEN LENGTH = PROGRAM SIZE A0101120 SPC 1 A0101121 RTJ+ MMALC ALLOCATE A SWAP AREA A0101122 SQP SWU010 A0101123 RTJ* (ASYFAL) NO SWAP AREA AVAILABLE A0101124 SPC 1 A0101125ÐÐSWU010 ADQ- ONEBIT+15 SPECIFY CONTROL POINT ACCESS A0101126 STQ- PGMSEC,I A0101127 STQ* SWUMSB SET UP THE SWAP BUFFER ADDRESS A0101128 STA- PGMSEC+1,I A0101129 STA* SWULSB A0101130 SPC 1 A0101131 LDQ- I Q = USER TABLE ADDRESS A0101132 RTJ* MUSTAT UPDATE THE MULTI-USER STATE IF REQUIRED A0101133 EJT A0101134 SPC 4 A0101135 RTJ- (AMONI) TRANSFER THE USER TO MASS MEMORY A0101136 ADC $6000 A0101137 ADC SWUREQ A0101138 JMP- (ADISP) A0101139 SPC 1 A0101140SWU020 SQP SWU030 MASS MEMORY I/O COMPLETION A0101141 RTJ+ TSMMER MASS MEMORY ERROR A0101142 SPC 1 A0101143SWU030 LDA* SWSAVI A0101144 STA- I I = USER TABLE ADDRESS A0101145 SPC 1 A0101146 RTJ+ XMREL RELEASE THE USERS MEMORY A0101147 SQP SWU040 A0101148 RTJ* (ASYFAL) FATAL ERROR A0101149 SPC 1 A0101150ÐÐSWU040 LDQ* SWUCCP A0101151 RTJ+ CPREL RELEASE THE USERS CONTROL POINT A0101152 SPC 1 A0101153 RTJ* USTATE UPDATE THE USER STATE A0101154 SPC 1 A0101155 JMP* (SWAPUS) RETURN A0101156 SPC 2 A0101157* U N C O N D I T I O N A L S W A P I / O R E Q U E S T A0101158 SPC 2 A0101159SWUREQ ADC $4CF4 FORMATTED WRITE A0101160 ADC SWU020 COMPLETION ADDRESS A0101161 ADC 0 REQUEST THREAD A0101162 ADC $08C2 LOGICAL UNIT A0101163SWULEN ADC 0 USER PROGRAM LENGTH A0101164SWUADD ADC 0 USER PROGRAM ADDRESS A0101165SWUMSB ADC 0 USER SWAP SECTOR A0101166SWULSB ADC 0 USER SWAP SECTOR A0101167SWUCCP ADC 0 USER CONTROL POINT A0101168 SPC 2 A0101169SWSAVI NUM 0 TEMPORARY STORAGE - REQUESTORS I-REGISTER A0101170 EJT A0101171 SPC 4 A0101172* A0101173* USTATE TSTASK SUBROUTINE USED TO UPDATE THE USER A0101174* ------ STATE FOLLOWING A SWAP OF THE PROGRAM A0101175ÐÐ* A0101176* ENTRY CONDITIONS: I = USER TABLE ADDRESS A0101177* OF THE SWAPPED USER A0101178 SPC 2 A0101179USTATE NOP 0 A0101180 SPC 1 A0101181 IIN 0 A0101182 LDA- USRSTX,I A0101183 AND- LPMASK+15 REMOVE THE SWAP-IN-PROGRESS INDICATOR A0101184 TRA Q A0101185 INA -SXMASS IS THE USER IN A NORMAL UNSWAPPED STATE A0101186 SAP UST020 NO A0101187 INQ SXMASS-1 YES, INDICATE THE USER IS NOW SWAPPED A0101188 SPC 1 A0101189UST020 STQ- USRSTX,I A0101190 LDQ- (TSIOTB),I OBTAIN THE I/O TABLE ADDRESS A0101191 ENA 0 A0101192 STA- IOCNPT,Q CLEAR THE USERS CONTROL POINT A0101193 STA- NUMREQ,I AND THE USERS REQUEST COUNT A0101194 SPC 1 A0101195 LDA- USRSTX,I A0101196 INA -SXMATA DOES THE USER HAVE AN ACTIVE ATTACH REQUEST A0101197 SAZ UST040 YES, EXIT A0101198 LDA- IOSTAT,Q NO A0101199 AND- ONEBIT+IA DOES THE USER HAVE I/O ACTIVE A0101200ÐÐ SAN UST040 YES, EXIT A0101201 LDA- IOSTAT,Q NO A0101202 ENQ QPL1 A0101203 ALS 15-TI HAS THE USER COMPLETED TERMINAL I/O A0101204 SAP UST030 NO, QUEUE PRIORITY = 1 A0101205 ALS TI-IN HAS THE USER COMPLETED TERMINAL INPUT A0101206 SAP UST030 NO, QUEUE PRIORITY = 1 A0101207 ENQ QPL3 YES, QUEUE PRIORITY = 3 A0101208 SPC 1 A0101209UST030 LDA- I A0101210 RTJ+ ONNXUM PLACE THE USER ON THE NXUM QUEUE A0101211UST040 EIN 0 A0101212 JMP* (USTATE) RETURN A0101213 EJT A0101214 SPC 4 A0101215* A0101216* DEFPAG TSTASK SUBROUTINE USED TO SET UP THE PAGE A0101217* ------ ENTRIES USED TO DEFINE A CONTROL POINT A0101218* A0101219* ENTRY CONDITIONS: I = USER TABLE ADDRESS A0101220* A = BASE PAGE NUMBER A0101221* A0101222* EXIT CONDITIONS: Q = DEFINED CONTROL POINT A0101223 SPC 2 A0101224DEFPAG NOP 0 A0101225ÐÐ STA* (APGDEF) A0101226 LDQ* APGSZ1 A0101227 ENA 0 A0101228 SPC 1 A0101229DEF010 INQ -1 A0101230 SQZ DEF020 A0101231 STA* (APGDEF),Q PRESET THE DEFINITION TABLE WITH ZERO A0101232 JMP* DEF010 A0101233 SPC 1 A0101234DEF020 LDQ- PGMSIZ,I Q = USER PROGRAM LENGTH A0101235 RTJ* NOPAGE CONVERT THE LENGTH TO PAGES A0101236DEF030 LDA* (APGDEF) A0101237 INQ -1 A0101238 SQZ DEF040 A0101239 AAQ A SET UP THE PAGE DEFINITION FOR THE USER A0101240 STA* (APGDEF),Q A0101241 JMP* DEF030 A0101242 SPC 1 A0101243DEF040 LDA* APGDEF A = ADDRESS OF THE PAGE DEFINITION TABLE A0101244 RTJ+ CPDEF DEFINE THE USERS CONTROL POINT A0101245 SPC 1 A0101246 JMP* (DEFPAG) RETURN A0101247 SPC 2 A0101248APGDEF ADC TSPAGE CONTROL POINT DEFINITION TABLE A0101249APGSZ1 ADC CPTBLN NUMBER OF PAGES IN THE CONTROL POINT AREA A0101250ÐÐ EJT A0101251 SPC 4 A0101252* A0101253* NOPAGE TSTASK SUBROUTINE USED TO CONVERT PROGRAM A0101254* ------ LENGTH TO NUMBER OF PAGES A0101255* A0101256* ENTRY CONDITIONS: Q = PROGRAM LENGTH A0101257* A0101258* EXIT CONDITIONS: Q = NUMBER OF PAGES A0101259 SPC 2 A0101260NOPAGE NOP 0 A0101261 SPC 1 A0101262 CLR A A0101263 LRS 11 CONVERT PROGRAM SIZE INTO PAGES A0101264 ANQ- LPMASK+5 127*5165A0101265 SAZ NOP010 A0101266 INQ 1 A0101267 SPC 1 A0101268NOP010 JMP* (NOPAGE) RETURN A0101269 EJT A0101270 SPC 4 A0101271* M U L T I - U S E R C O N T R O L P R O C E S S O R S A0101272 SPC 4 A0101273********************************************************************** A0101274* * A0101275ÐÐ* MULTI-USER TIMESLICE REQUEST PROCESSOR * A0101276* * A0101277* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER * A0101278* * A0101279********************************************************************** A0101280 SPC 2 A0101281TIMSLC LDA- ULUSTB,I OBTAIN THE USER TABLE ADDRESS A0101282 ENQ QPL1 QUEUE PRIORITY = 1 A0101283 RTJ+ ONNSWP PLACE THE USER ON THE NSWP QUEUE A0101284 SPC 1 A0101285 LDA- ULUSTB,I OBTAIN THE USER TABLE ADDRESS A0101286 ENQ QPL1 QUEUE PRIORITY = 1 A0101287 RTJ+ ONNXUC PLACE THE USER ON THE NXUC QUEUE A0101288 SPC 1 A0101289 LDQ- ULUSTB,I OBTAIN THE USER TABLE ADDRESS A0101290 ENA SXCTSL INDICATE THE USERS TIMESLICE HAS EXPIRED A0101291 STA- USRSTX,Q A0101292 SPC 1 A0101293 ENQ 0 INDICATE A NORMAL ENTRY A0101294 JMP TSTASK START ANOTHER USER A0101295 EJT A0101296* MODPAG TSTASK SUBROUTINE USED TO MODIFY THE PAGE A0101297* ------ ENTRIES USED TO DEFINE A CONTROL POINT A0101298* A0101299* ENTRY CONDITIONS: I = USER TABLE ADDRESS A0101300ÐÐ* Q = USERS CONTROL POINT A0101301* A0101302* EXIT CONDITIONS: Q = USERS CONTROL POINT A0101303 SPC 2 A0101304MODPAG NOP 0 A0101305 STQ* MODCCP SAVE THE CONTROL POINT A0101306 SPC 1 A0101307 LDA* APGDEF A = PAGE DEFINITION TABLE A0101308 RTJ+ CPFET OBTAIN THE CONTROL POINT IMAGE A0101309 LDQ- TSMUTB,I A0101310 LDA- MUPAGE,Q A = REQUESTED MULTI-USER PROGRAM BASE PAGE A0101311 STA* PAGNUM SAVE A0101312 LDQ- PGMSIZ,I Q = USER PROGRAM LENGTH A0101313 RTJ* NOPAGE CONVERT THE LENGTH TO PAGES A0101314 TRQ A A0101315 ADD* APGDEF A0101316 STA* MODBAS A = MULTI-USER PROGRAM BASE PAGE ENTRY A0101317 TCQ Q A0101318 ADQ* APGSZ2 A0101319 LDA* PAGNUM A0101320 SPC 1 A0101321MOD020 INQ -1 A0101322 SQM MOD030 A0101323 STA* (MODBAS),Q FILL THE TABLE WITH THE M-U BASE PAGE NUMBER A0101324 JMP* MOD020 A0101325ÐÐ SPC 1 A0101326MOD030 LDQ- TSMUTB,I A0101327 LDQ- MUSIZE,Q Q = REQUESTED MULTI-USER PROGRAM SIZE A0101328 RTJ* NOPAGE CONVERT THE LENGTH TO PAGES A0101329 TCQ A A0101330 ADD* APGSZ2 A0101331 ADD* APGDEF A0101332 STA* MODBAS A = THE BASE MULTI-USER PAGE A0101333MOD040 INQ -1 A0101334 SQM MOD050 A0101335 LDA* PAGNUM A0101336 AAQ A SET UP THE PAGE DEFINITION FOR THE MULTI-USER A0101337 STA* (MODBAS),Q A0101338 JMP* MOD040 A0101339 SPC 1 A0101340MOD050 LDQ* MODCCP Q = USERS CONTROL POINT A0101341 LDA* APGDEF A = PAGE MEMORY IMAGE TABLE A0101342 RTJ+ CPMOD RE-DEFINE THE USERS CONTROL POINT A0101343 JMP* (MODPAG) RETURN A0101344 EJT A0101345 SPC 4 A0101346********************************************************************** A0101347* * A0101348* MULTI-USER PROGRAM ATTACH REQUEST PROCESSOR * A0101349* * A0101350ÐÐ* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER * A0101351* Q = ATTACH INDEX * A0101352* * A0101353********************************************************************** A0101354 SPC 2 A0101355TSATCH TRQ A A = ATTACH INDEX A0101356 SAM TSA010 ILLEGAL VALUE A0101357 SPC 1 A0101358 MUI* AMUITM CONVERT TO A TABLE ADDRESS A0101359 ADD* ATSMUR A0101360 STA- TEMPAR,I SAVE A0101361 SPC 1 A0101362 SUB* ATSMUN A0101363 SAP TSA010 ILLEGAL VALUE A0101364 SPC 1 A0101365 LDQ- TEMPAR,I A0101366 LDA- MURSIZ,Q IS THIS MULTI-USER LOADED IN THE SYSTEM A0101367 SAZ TSA010 NO, ERROR A0101368 SPC 1 A0101369 RTJ* SIZATT YES, WILL THE ATTACHMENT CONFIGURATION FIT A0101370 SAP TSA020 YES A0101371 SPC 1 A0101372TSA010 ENQ E02 INDICATE AN ILLEGAL ATTACHMENT REQUEST A0101373 LDA- PARADD,I A0101374 INA -2 OBTAIN THE ADDRESS OF THE ERROR A0101375ÐÐ SPC 1 A0101376 JMP+ TSXERR GO PROCESS THE ERROR MESSAGE A0101377 EJT A0101378 SPC 4 A0101379TSA020 LDQ- ULUSTB,I Q = USER TABLE ADDRESS A0101380 LDA* (ATSAR3) A0101381 ADD- PGMSIZ,Q A0101382 ADD- ONEBIT+11 CALCULATE THE FWA OF THE MULTI-USER PROGRAM A0101383 AND- NZERO+11 A0101384 STA- MUFWAD,I SAVE FOR THE ATTACH REQUESTOR A0101385 SPC 1 A0101386 LDQ- TSMUTB,Q Q = MULTI-USER TABLE ADDRESS A0101387 SQZ TSA030 SKIP IF THE USER IS NOT CURRENTLY ATTACHED A0101388 TRQ A A0101389 SUB- TEMPAR,I IS THE REQUEST FOR THE CURRENT ATTACHMENT A0101390 SAN TSA030 NO A0101391 LDA- MUPAGE,Q YES, IS THE MULTI-USER RESIDENT A0101392 SAZ TSA040 NO A0101393 JMP* TSA060 YES, RETURN TO THE REQUESTOR A0101394 SPC 1 A0101395TSA030 LDQ- TEMPAR,I Q = REQUESTED MULTI-USER TABLE ADDRESS A0101396 LDA- MUPAGE,Q IS THE REQUESTED PROGRAM RESIDENT A0101397 SAN TSA050 YES A0101398TSA040 JMP* TSA100 NO A0101399 SPC 1 A0101400ÐÐTSA050 LDA- ULUSTB,I A0101401 STA- I I = REQUESTORS USER TABLE ADDRESS A0101402 RTJ* ATTMUR PERFORM THE LOGICAL ATTACHMENT A0101403 SPC 1 A0101404 LDQ- (TSIOTB),I A0101405 LDQ- IOCNPT,Q Q = USERS CONTROL POINT A0101406 RTJ* MODPAG MODIFY THE USERS CONTROL POINT A0101407 SPC 1 A0101408 LDA* (ATSAR3) A0101409 STA- I I = LINKAGE BUFFER ADDRESS A0101410 SPC 1 A0101411TSA060 JMP TSURTN RETURN TO THE REQUESTOR A0101412 EJT A0101413 SPC 4 A0101414* A0101415* SIZATT TSTASK SUBROUTINE USED TO VERIFY THAT THE A0101416* ------ REQUESTED ATTACHMENT CONFIGURATION A0101417* WILL FIT IN THE USER MEMORY SPACE A0101418* A0101419* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0101420* A0101421* EXIT CONDITIONS: A = + IF THE SIZE IS OK A0101422* A = - IF THE SIZE IS NOT OK A0101423* A0101424 SPC 2 A0101425ÐÐSIZATT NOP 0 A0101426 SPC 1 A0101427 LDQ- ULUSTB,I A0101428 LDA- PGMSIZ,Q A0101429 LDQ- TEMPAR,I A0101430 ADD- MURSIZ,Q A = ROOT SIZE + MULTI-USER SIZE A0101431 ADD- I A = LWA + 1 OF THE ATTACHED CONFIGURATION A0101432 STA* TSATMP A0101433 LDQ* APRTB2 A0101434 LDA- 3,Q A = LWA OF THE USER AREA A0101435 EOR* TSATMP ARE THE SIGNS ALIKE A0101436 SAP SIZ010 YES A0101437 LDA* TSATMP NO, THE SIGN OF A INDICATES THE CONDITION A0101438 JMP* (SIZATT) RETURN A0101439 SPC 1 A0101440SIZ010 EOR* TSATMP A = LWA + 1 OF THE ATTACHED CONFIGURATION A0101441 SUB* TSATMP THE SIGN OF A INDICATES THE CONDITION A0101442 JMP* (SIZATT) RETURN A0101443 SPC 4 A0101444* A T T A C H R E Q U E S T D A T A A N D S T O R A G E A0101445 SPC 2 A0101446PAGNUM NUM 0 TEMPORARY STORAGE A0101447MODCCP NUM 0 TEMPORARY STORAGE - CONTROL POINT A0101448MODBAS NUM 0 TEMPORARY STORAGE - BASE PAGE NUMBER A0101449APGSZ2 ADC CPTBLN NUMBER OF PAGES IN THE CONTROL POINT AREA A0101450ÐÐAPRTB2 ADC PARTBL ADDRESS OF THE SYSTEM PARTITIONED CORE TABLE A0101451ATSMUR ADC TSMUSR MULTI-USER TABLE STARTING ADDRESS A0101452ATSMUN ADC TSMEND MULTI-USER TABLE ENDING ADDRESS A0101453AMUITM ADC MUITEM MULTI-USER TABLE WORDS / ITEM A0101454APGDF2 ADC TSPAGE CONTROL POINT DEFINITION TABLE A0101455ATSAR3 ADC TSAREA START OF THE USER PROGRAM AREA A0101456TSATMP NUM 0 TEMPORARY STORAGE A0101457TSAMUT NUM 0 MULTI-USER TABLE ADDRESS A0101458 EJT A0101459********************************************************************** A0101460* * A0101461* THIS ROUTINE PROCESSES ATTACH REQUESTS WHEN THE MULTI- * A0101462* USER PROGRAM IS NOT RESIDENT IN MAIN MEMORY * A0101463* * A0101464* ENTRY CONDITIONS: Q = MULTI-USER TABLE ADDRESS * A0101465* I = USER LINKAGE BUFFER ADDRESS * A0101466* * A0101467********************************************************************** A0101468 SPC 2 A0101469TSA100 LDA- MURSTX,Q A0101470 INA -SXMMUR IS THE REQUESTED MULTI-USER BEING READ IN A0101471 SAN TSA110 NO, CONTINUE A0101472 RTJ* REPEAT YES, SET UP TO REPEAT THE ATTACH REQUEST A0101473 JMP TIMSLC SUSPEND THE REQUESTING USER PROGRAM A0101474 SPC 1 A0101475ÐÐTSA110 LDA- ULUSTB,I A0101476 STA- I I = USER TABLE ADDRESS A0101477 STA- (MUROOT),Q SPECIFY THE REQUESTING USER PROGRAM A0101478 SPC 1 A0101479 LDA- MUSIZE,Q A0101480 ADD- LPMASK+11 A0101481 AND- NZERO+11 ROUND UP A0101482 ADD- PGMSIZ,I INCREASE THE MULTI-USER FIELD LENGTH A0101483 ADD- LPMASK+11 A0101484 AND- NZERO+11 A0101485 STA- MUSIZE,Q TO INCLUDE THE REQUESTING USER PROGRAM A0101486 SPC 1 A0101487 ENA SXMMUR INDICATE THE MULTI-USER IS BEING READ IN A0101488 STA- MURSTX,Q A0101489 SPC 1 A0101490 TRQ A A = MULTI-USER TABLE ADDRESS A0101491 ENQ QPL4 QUEUE PRIORITY = 4 A0101492 RTJ+ ONNXUM PLACE THE MULTI-USER ON THE NXUM QUEUE A0101493 SPC 1 A0101494 ENQ 0 A0101495 RTJ* ATTMUR DETATCH THE ROOT FROM THE CURRENT MULTI-USER A0101496 SPC 1 A0101497 ENA SXCATA INDICATE AN ATTACH REQUEST IS ACTIVE A0101498 STA- USRSTX,I A0101499 SPC 1 A0101500ÐÐ LDA- I A = USER TABLE ADDRESS A0101501 ENQ QPL1 QUEUE PRIORITY = 1 A0101502 RTJ+ ADNSWP FORCE THE USER ON THE NSWP QUEUE A0101503 SPC 1 A0101504 ENQ 0 INDICATE A NORMAL ENTRY A0101505 JMP TSTASK START ANOTHER USER A0101506 EJT A0101507* A0101508* TSACMP TSTASK SUBROUTINE USED TO PROCESS THE A0101509* ------ COMPLETION OF A MULTI-USER UNSWAP A0101510* A0101511* ENTRY CONDITIONS: I = MULTI-USER TABLE ADDRESSA0101512* A0101513* EXIT CONDITIONS: I = USER TABLE ADDRESS A0101514* A0101515 SPC 2 A0101516TSACMP NOP 0 A0101517 SPC 1 A0101518 LDA- I A0101519 STA* TSAMUT SAVE THE MULTI-USER TABLE ADDRESS A0101520 SPC 1 A0101521 LDQ- MUCNPT,I Q = MULTI-USER CONTROL POINT A0101522 LDA* APGDF2 A = PAGE DEFINITION TABLE A0101523 RTJ+ CPFET OBTAIN THE CONTROL POINT IMAGE A0101524 LDA* (APGDF2) A0101525ÐÐ STA- MUPAGE,I SAVE THE MULTI-USER'S BASE PAGE NUMBER A0101526 SPC 1 A0101527 LDQ- MURSIZ,I RESTORE THE NORMAL MULTI-USER SIZE A0101528 STQ- MUSIZE,I A0101529 RTJ NOPAGE A0101530 STQ* TSATMP Q = MULTI-USER PAGE SIZE A0101531 SPC 1 A0101532 LDQ- MUCNPT,I A0101533 RTJ+ CPREL RELEASE THE MULTI-USER CONTROL POINT A0101534 SPC 1 A0101535 ENA 0 A0101536 STA- MURSTX,I CLEAR THE MULTI-USER STATE A0101537 STA- MUCNPT,I AND THE CONTROL POINT A0101538 SPC 1 A0101539 LDQ- (MUROOT),I A0101540 LDA- USRSTX,Q A0101541 INA -SXMASS IS THE USER PROGRAM MASS RESIDENT A0101542 SAP TSA200 YES A0101543 SPC 1 A0101544 LDQ* TSATMP NO, Q = NUMBER OF MULTI-USER PAGES A0101545 RTJ+ XMRTN RETURN THE EXTRA ALLOCATED MEMORY A0101546 SPC 1 A0101547 LDA- (MUROOT),I A0101548 STA- I I = REQUESTING USER TABLE ADDRESS A0101549 JMP* TSA210 PUT THE USER INTO EXECUTION A0101550ÐÐ EJT A0101551 SPC 4 A0101552TSA200 LDQ* TSATMP Q = NUMBER OF MULTI-USER PAGES A0101553 RTJ+ XMMOD ALLOCATE THE EXTRA MEMORY TO THE ROOT A0101554 SPC 1 A0101555 LDA- (MUROOT),I A0101556 STA- I I = USER TABLE ADDRESS A0101557 SPC 1 A0101558 LDQ* TSATMP A0101559 LDA* (APGDF2),Q A = LAST PAGE + 1 OF THE MULTI-USER A0101560 RTJ DEFPAG DEFINE A CONTROL POINT FOR THE USER A0101561 SPC 1 A0101562 RTJ* READUS READ THE USER INTO MAIN MEMORY A0101563 SPC 2 A0101564TSA210 LDQ* TSAMUT Q = MULTI-USER TABLE ADDRESS A0101565 RTJ* ATTMUR PERFORM THE LOGICAL ATTACHMENT A0101566 SPC 1 A0101567 LDQ- (TSIOTB),I A0101568 LDQ- IOCNPT,Q Q = USERS CONTROL POINT A0101569 RTJ MODPAG MODIFY THE USERS CONTROL POINT A0101570 SPC 1 A0101571 ENA SXCATC INDICATE THE ATTACH IS COMPLETE A0101572 STA- USRSTX,I A0101573 SPC 1 A0101574 LDA- I A0101575ÐÐ INA +NEXETH A0101576 STA TSACTV SPECIFY THE ACTIVE USER A0101577 SPC 1 A0101578 JMP* (TSACMP) RETURN A0101579 EJT A0101580* A0101581* ATTMUR TSTASK SUBROUTINE USED TO PERFORM A LOGICAL A0101582* ------ ATTACHMENT BETWEEN A ROOT AND A MULTI- A0101583* USER PROGRAM A0101584* A0101585* ENTRY CONDITIONS: I = USER TABLE ADDRESS A0101586* Q = REQUESTED MULTI-USER A0101587* TABLE ADDRESS A0101588* A0101589* EXIT CONDITIONS: I = SAVED A0101590 SPC 2 A0101591ATTMUR NOP 0 A0101592 STQ* ATTEMP SAVE THE REQUESTED TABLE ADDRESS A0101593 SPC 1 A0101594 LDQ- TSMUTB,I IS THE USER CURRENTLY ATTACHED A0101595 SQZ ATT020 NO A0101596 LDA- ACROOT,Q YES, DECREASE THE ACTIVE ROOT COUNT A0101597 INA -1 FOR THE FORMER MULTI-USER ROUTINE A0101598 SAP ATT010 A0101599RTJ RTJ+ SYFAIL ROOT COUNT ERROR A0101600ÐÐATT010 STA- ACROOT,Q A0101601 SPC 1 A0101602ATT020 LDQ* ATTEMP A0101603 SQZ ATT030 A0101604 RAO- ACROOT,Q INCREASE THE ACTIVE ROOT COUNT A0101605 SPC 1 A0101606ATT030 STQ- TSMUTB,I INDICATE THE NEW ATTACHMENT A0101607 JMP* (ATTMUR) RETURN A0101608 SPC 2 A0101609ATTEMP NUM 0 TEMPORARY STORAGE - NEW MULTI-USER ADDRESS A0101610 SPC 2 A0101611* A0101612* REPEAT TSTASK SUBROUTINE USED TO SET THE REQUESTOR'S A0101613* ------ P-REGISTER BACK TO THE PRECEEDING A0101614* ATTACH REQUEST A0101615* A0101616* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0101617 SPC 2 A0101618REPEAT NOP 0 A0101619 SPC 1 A0101620 LDQ- FALADD,I OBTAIN THE ENTRY ADDRESS A0101621 INQ -2 SET IT BACK TO THE RETURN JUMP A0101622 LDA- (ZERO),Q A0101623 SUB* RTJ IS IT A TWO-WORD INSTRUCTION A0101624 SAZ REP010 YES A0101625ÐÐ INQ 1 NO A0101626REP010 STQ- RSP,I SET UP TO REPEAT THE REQUEST A0101627 JMP* (REPEAT) RETURN A0101628 EJT A0101629* A0101630* READUS TSTASK SUBROUTINE USED TO READ A USER A0101631* ------ PROGRAM INTO MAIN MEMORY A0101632* A0101633* ENTRY CONDITIONS: I = USER TABLE ADDRESS A0101634* Q = USER CONTROL POINT A0101635* A0101636* EXIT CONDITIONS: I = SAVED A0101637* CONTROL POINT ACTIVE A0101638* A0101639 SPC 2 A0101640READUS NOP 0 A0101641 STQ* REDCCP SAVE THE USERS CONTROL POINT A0101642 LDA- I A0101643 STA* REDSVI AND THE USER TABLE ADDRESS A0101644 SPC 1 A0101645 LDA- PGMSIZ,I A0101646 STA* REDLEN SPECIFY THE PROGRAM LENGTH A0101647 LDA- PGMSEC,I A0101648 STA* REDMSB SPECIFY THE PROGRAM SECTOR A0101649 LDA- PGMSEC+1,I A0101650ÐÐ STA* REDLSB A0101651 LDA* (ATSAR3) A0101652 STA* REDADD SPECIFY THE STARTING ADDRESS A0101653 SPC 1 A0101654 RTJ- (AMONI) READ IN THE USER A0101655 ADC $6000 A0101656 ADC REDREQ A0101657 JMP- (ADISP) EXIT A0101658 SPC 2 A0101659RED010 SQP RED020 MASS MEMORY I/O COMPLETION A0101660 RTJ+ TSMMER MASS MEMORY ERROR A0101661 SPC 1 A0101662RED020 LDA* REDSVI A0101663 STA- I RESTORE THE USER TABLE ADDRESS A0101664 LDQ- (TSIOTB),I A0101665 LDA* REDCCP A0101666 STA- IOCNPT,Q SPECIFY THE USERS CONTROL POINT A0101667 TRA Q A0101668 RTJ+ CPSET INCLUDE THE USER IN LOGICAL MEMORY A0101669 LDQ- PGMSIZ,I A0101670 RTJ+ MMREL RELEASE THE USER PROGRAM SWAP BUFFER A0101671 LDA- I A0101672 RTJ+ FUNSHR REMOVE THE USERS FILES FROM SHARED STATUS A0101673 SPC 1 A0101674 JMP* (READUS) AND RETURN A0101675ÐÐ EJT A0101676 SPC 4 A0101677* R E A D U S E R D A T A A N D S T O R A G E A0101678 SPC 2 A0101679REDREQ ADC $48F4 FORMATTED READ A0101680 ADC RED010 COMPLETION ADDRESS A0101681 ADC 0 REQUEST THREAD A0101682 ADC $08C2 LOGICAL UNIT A0101683REDLEN ADC 0 USER PROGRAM LENGTH A0101684REDADD ADC 0 USER PROGRAM ADDRESS A0101685REDMSB ADC 0 USER PROGRAM SECTOR A0101686REDLSB ADC 0 USER PROGRAM SECTOR A0101687REDCCP ADC 0 USER CONTROL POINT A0101688 SPC 2 A0101689REDSVI NUM 0 TEMPORARY STORAGE - REQUESTORS I-REGISTER A0101690 SPC 2 A0101691 END A0101692 NAM TSSUBR A02 A ITOS CCS 3.0 SL-149A0200001* ITOS EXECUTIVE SUBROUTINES A0200002* CREDIT COLLECTION SYSTEM VERSION 3.0 A0200003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A0200004* COPYRIGHT CONTROL DATA CORPORATION 1979 A0200005* A0200006 SPC 2 A0200007* I T O S E N T R Y P O I N T S A0200008ÐÐ SPC 1 A0200009 ENT ONNXUC NXUC QUEUE ENTRY ADDITION A0200010 ENT ONNXUM NXUM QUEUE ENTRY ADDITION A0200011 ENT ONNSWP NSWP QUEUE ENTRY ADDITION A0200012 ENT ADNSWP NSWP QUEUE ENTRY ADDITION - UNCONDITIONAL A0200013 ENT OFNXUC NXUC QUEUE ENTRY REMOVAL A0200014 ENT OFNSWP NSWP QUEUE ENTRY REMOVAL A0200015 ENT GTNXUM NXUM QUEUE ENTRY FETCH A0200016 ENT DENXUM NXUM QUEUE ENTRY DELETION A0200017 ENT DENSWP NSWP QUEUE ENTRY DELETION A0200018 ENT DENXUC NXUC QUEUE ENTRY DELETION A0200019 ENT XMALC MAIN MEMORY ALLOCATE ROUTINE A0200020 ENT XMRSV MAIN MEMORY RESERVE ROUTINE A0200021 ENT XMMOD MAIN MEMORY REASSIGN ROUTINE A0200022 ENT XMRTN MAIN MEMORY RETURN ROUTINE A0200023 ENT XMREL MAIN MEMORY RELEASE ROUTINE A0200024 ENT MMALC MASS MEMORY ALLOCATE ROUTINE A0200025 ENT MMREL MASS MEMORY RELEASE ROUTINE A0200026 ENT TSCLOK TIMESLICE DELAY REQUEST A0200027 ENT SLICER TIMESLICE DELAY VALUE A0200028 ENT TSBGIN TASK PROCESSOR INITIATION ROUTINE A0200029 ENT TSVFTN FORTRAN AREA SAVE ROUTINE A0200030 ENT TSRFTN FORTRAN AREA RESTORE ROUTINE A0200031 ENT TSCLLB LINKAGE BUFFER CLEAR ROUTINE A0200032 ENT TSWSEC BASE SWAP BUFFER SECTOR A0200033ÐÐ ENT TSCKMU PARAMETER VERIFICATION ROUTINE A0200034 ENT TSCKPM PARAMETER VERIFICATION ROUTINE A0200035 ENT TSPMCK PARAMETER PICKUP AND VERIFICATION ROUTINE A0200036 EJT A0200037 SPC 4 A0200038 SPC 1 A0200039* I T O S E X T E R N A L S A0200040 SPC 1 A0200041 EXT TSTASK ITOS EXECUTIVE TASK PROCESSOR A0200042 EXT TSACTV ITOS EXECUTIVE ACTIVE INDICATOR A0200043 EXT TSXERR EXECUTIVE ERROR MESSAGE PROCESSOR A0200044 EXT TSAREA START OF THE ITOS USER AREA A0200045 EXT TSQPRI NUMBER OF QUEUE PRIORITY ENTRIES A0200046 EXT RQLLIM SWAP CANDIDATE LOWER REQUEST LIMIT A0200047 EXT RQULIM SWAP CANDIDATE UPPER REQUEST LIMIT A0200048 EXT LRGUSR MEMORY ALLOCATION SEPARATION LIMIT A0200049 EXT NXUC BASE TOP OF THE NXUC QUEUE A0200050 EXT NXUM BASE TOP OF THE NXUM QUEUE A0200051 EXT NSWP BASE TOP OF THE NSWP QUEUE A0200052 EXT XMAT EXECUTION MEMORY TABLE STARTING ADDRESS A0200053 EXT XMTEND EXECUTION MEMORY TABLE ENDING ADDRESS A0200054 EXT MMAT MASS MEMORY ALLOCATION TABLE STARTING ADDRESS A0200055 EXT MMAMAX MAXIMUM NUMBER OF ALLOCATION BLOCKS A0200056 SPC 4 A0200057* S Y S T E M E X T E R N A L S A0200058ÐÐ SPC 1 A0200059 EXT PARTBL SYSTEM PARTITIONED MEMORY TABLE A0200060 EXT SYFAIL SYSTEM FAILURE PROCESSOR A0200061 EXT CNTWAR MICRO-MEMORY CONTROLWARE STATUS A0200062 SPC 4 A0200063* E Q U I V A L E N C E S A0200064 SPC 1 A0200065 EQU ZERO($22) LOCATION CONTAINING ZERO A0200066 EQU SIXTEN($27) LOCATION CONTAINING SIXTEEN A0200067 EQU LPMASK($2) BIT MASK TABLE A0200068 EQU NZERO($12) NEGATIVE ZERO TABLE A0200069 EQU ONEBIT($23) SINGLE BIT TABLE A0200070 EQU ZROBIT($33) ZERO BIT TABLE A0200071 EQU AVOLR($BA) VOLATILE STORAGE RELEASE A0200072 EQU AVOLA($BB) VOLATILE STORAGE ALLOCATION A0200073 EQU AMONI($F4) ADDRESS OF MONITOR REQUEST ENTRY A0200074 EQU E06(06) ILLEGAL REQUEST PARAMETER A0200075 EJT A0200076 SPC 4 A0200077* M U L T I - U S E R P R O G R A M T A B L E E N T R I E S A0200078 SPC 1 A0200079 EQU MUROOT(ZERO) ASSOCIATED ROOT TABLE ADDRESS A0200080 EQU MUSRID(01) PROGRAM IDENTIFICATION - 4 WORDS ASCII A0200081 EQU MUSIZE(05) PROGRAM LENGTH (WORDS) A0200082 EQU MUSECT(06) PROGRAM SECTOR ADDRESS - 2 WORDS A0200083ÐÐ EQU MUPAGE(08) PROGRAM BASE MEMORY PAGE NUMBER A0200084 EQU ACROOT(09) PROGRAM ACTIVE ROOT COUNT A0200085 EQU MURSIZ(10) PROGRAM TRUE LENGTH (WORDS) A0200086 EQU MUEXTH(11) PROGRAM EXECUTION THREAD A0200087 EQU MURSTX(13) PROGRAM STATE INDEX A0200088 EQU MURCLK(15) PROGRAM CLOCK VALUE A0200089 EQU MUITEM(MURCLK+1) A0200090 SPC 2 A0200091* U S E R P R O G R A M U S E R T A B L E E N T R I E S A0200092 SPC 1 A0200093 EQU TSIOTB(ZERO) ASSOCIATED I/O TABLE ADDRESS A0200094 EQU USERID(01) USER IDENTIFICATION - 4 WORDS ASCII A0200095 EQU PGMSIZ(05) USER PROGRAM LENGTH (WORDS) A0200096 EQU PGMSEC(06) USER PROGRAM SECTOR - 2 WORDS A0200097 EQU TWNSEC(08) SWAP TWIN SECTOR - 2 WORDS A0200098 EQU SWPBLK(10) USER SWAP BLOCK BYTES A0200099 EQU NEXETH(11) USER EXECUTION THREAD A0200100 EQU NSWPTH(12) USER SWAP THREAD A0200101 EQU USRSTX(13) USER STATE INDEX A0200102 EQU TSMUTB(14) MULTI USER TABLE ADDRESS A0200103 EQU NUMREQ(15) USER REQUEST COUNT A0200104 EQU USRITM(NUMREQ+1) A0200105 EJT A0200106 SPC 4 A0200107* U S E R P R O G R A M S T A T E I N D I C E S A0200108ÐÐ SPC 1 A0200109 EQU SXCACT(01) EXECUTING IN MAIN MEMORY A0200110 EQU SXCTSL(02) SUSPENDED IN MAIN MEMORY-TIMESLICE COMPLETE A0200111 EQU SXCMMA(03) SUSPENDED IN MAIN MEMORY-M.M. I/O ACTIVE A0200112 EQU SXCMMC(04) SUSPENDED IN MAIN MEMORY-M.M. I/O COMPLETE A0200113 EQU SXCFMA(05) SUSPENDED IN MAIN MEMORY-FILE I/O ACTIVE A0200114 EQU SXCFMC(06) SUSPENDED IN MAIN MEMORY-FILE I/O COMPLETE A0200115 EQU SXCTMA(07) SUSPENDED IN MAIN MEMORY-TMNL I/O ACTIVE A0200116 EQU SXCTMC(08) SUSPENDED IN MAIN MEMORY-TMNL I/O COMPLETE A0200117 EQU SXCDTA(09) SUSPENDED IN MAIN MEMORY-DATA I/O ACTIVE A0200118 EQU SXCDTC(10) SUSPENDED IN MAIN MEMORY-DATA I/O COMPLETE A0200119 EQU SXCATA(11) SUSPENDED IN MAIN MEMORY-ATTACH ACTIVE A0200120 EQU SXCATC(12) SUSPENDED IN MAIN MEMORY-ATTACH COMPLETE A0200121* A0200122 EQU SXMASS(13) RESERVED A0200123 EQU SXMTSL(14) SWAPPED ON MASS MEMORY-TIMESLICE COMPLETE A0200124 EQU SXM015(15) RESERVED A0200125 EQU SXMMMC(16) SWAPPED ON MASS MEMORY-M.M. I/O COMPLETE A0200126 EQU SXM017(17) RESERVED A0200127 EQU SXMFMC(18) SWAPPED ON MASS MEMORY-FILE I/O COMPLETE A0200128 EQU SXMTMA(19) SWAPPED ON MASS MEMORY-TMNL I/O ACTIVE A0200129 EQU SXMTMC(20) SWAPPED ON MASS MEMORY-TMNL I/O COMPLETE A0200130 EQU SXMDTA(21) SWAPPED ON MASS MEMORY-DATA I/O ACTIVE A0200131 EQU SXMDTC(22) SWAPPED ON MASS MEMORY-DATA I/O COMPLETE A0200132 EQU SXMATA(23) SWAPPED ON MASS MEMORY-ATTACH ACTIVE A0200133ÐÐ EQU SXM024(24) RESERVED A0200134* A0200135 EQU SXMUSA(25) SUSPENDED ON MASS MEMORY-UNSWAP ACTIVE A0200136 EQU SXCUSC(26) SUSPENDED IN MAIN MEMORY-UNSWAP COMPLETE A0200137 EQU SXMMUR(27) SUSPENDED ON MASS MEMORY-MULTIUSER READ A0200138 EQU SXMLOG(28) SUSPENDED ON MASS MEMORY-INITIAL LOGIN A0200139 EQU SXMJOB(29) SUSPENDED ON MASS MEMORY-JOB STEP A0200140 SPC 2 A0200141* NOTE - BIT 15 = 1 WHILE THE USER IS BEING SWAPPED A0200142 EJT A0200143 SPC 4 A0200144* U S E R P R O G R A M I / O T A B L E E N T R I E S A0200145 SPC 1 A0200146 EQU TSUSTB(ZERO) ASSOCIATED USER TABLE ADDRESS A0200147 EQU FRQBUF(01) FILE REQUEST BUFFER HEADER (4 WORDS) A0200148 EQU IORQCD(05) INPUT/OUTPUT REQUEST CODE A0200149 EQU IORQCA(06) INPUT/OUTPUT COMPLETION ADDRESS A0200150 EQU IORQTH(07) INPUT/OUTPUT THREAD WORD A0200151 EQU IORQLU(08) INPUT/OUTPUT LOGICAL UNIT A0200152 EQU IOMSLN(09) INPUT/OUTPUT MESSAGE LENGTH A0200153 EQU IOBFAD(10) INPUT/OUTPUT MESSAGE BUFFER ADDRESS A0200154 EQU IOMMSB(11) INPUT/OUTPUT MASS MEMORY ADDRESS A0200155 EQU IOMLSB(12) INPUT/OUTPUT MASS MEMORY ADDRESS A0200156 EQU IOCNPT(13) INPUT/OUTPUT CONTROL POINT A0200157 EQU IOSTAT(14) INPUT/OUTPUT STATUS WORD A0200158ÐÐ EQU TERMBF(15) TERMINAL MESSAGE BUFFER ADDRESS A0200159 EQU IOITEM(TERMBF+1) A0200160 SPC 2 A0200161* USER PROGRAM I/O STATUS INDICATORS A0200162 SPC 1 A0200163* UNSOLICITED INPUT GROUP A0200164 EQU LI(00) TERMINAL LOG-IN A0200165 EQU MN(01) TERMINAL MANUAL INTERRUPT A0200166 EQU ES(02) TERMINAL ESCAPE A0200167* INPUT-OUTPUT ERROR GROUP A0200168 EQU DS(04) TERMINAL DISCONNECT A0200169 EQU ME(05) MASS MEMORY ERROR A0200170 EQU FE(06) FILE REQUEST ERROR A0200171* REQUEST TYPE GROUP A0200172 EQU IN(08) DATA INPUT REQUEST A0200173 EQU IA(09) INPUT / OUTPUT ACTIVE A0200174 EQU IC(10) INPUT / OUTPUT COMPLETE A0200175 EQU MM(11) MASS MEMORY I/O REQUEST A0200176 EQU TI(12) TERMINAL I/O REQUEST A0200177* TERMINAL CHARACTERISTIC GROUP A0200178* A0200179 EQU DY(TI+1) END OF THE DYNAMIC STATUS GROUP A0200180 EJT A0200181* U S E R L I N K A G E B U F F E R E N T R I E S A0200182* A0200183ÐÐ* THE USER LINKAGE BUFFER IMMEDIATELY PRECEEDS THE USER PROGRAM A0200184 SPC 2 A0200185 EQU LASTEP(ZERO) LAST ENTRY TO THE USER PROGRAM A0200186 EQU ULIOTB(001) USERS I/O TABLE ADDRESS A0200187 EQU ULUSTB(002) USERS USER TABLE ADDRESS A0200188 EQU RSCLOK(003) USERS REMAINING TIMESLICE A0200189 EQU FALADD(004) PROTECT FAULT ADDRESS A0200190 EQU PARADD(005) CURRENT PARAMETER ADDRESS A0200191 EQU RSP(006) P-REGISTER STORAGE A0200192 EQU RSA(007) A-REGISTER STORAGE A0200193 EQU RSQ(008) Q-REGISTER STORAGE A0200194 EQU RSI(009) I-REGISTER STORAGE A0200195 EQU RSL(010) OVERFLOW STORAGE A0200196 EQU RS1(011) 1-REGISTER STORAGE A0200197 EQU RS2(012) 2-REGISTER STORAGE A0200198 EQU RS3(013) 3-REGISTER STORAGE A0200199 EQU RS4(014) 4-REGISTER STORAGE A0200200 EQU RSUB(015) UPPER BOUNDS REGISTER STORAGE A0200201 EQU RSIORC(016) MONITOR I/O REQUEST CODE A0200202 EQU RSIOCA(017) COMPLETION ADDRESS A0200203 EQU RSIOTH(018) REQUEST THREAD A0200204 EQU RSIOLU(019) MODE + LOGICAL UNIT A0200205 EQU RSIOLN(020) LENGTH A0200206 EQU RSIOSA(021) STARTING ADDRESS A0200207 EQU RSIOMS(022) MASS MEMORY ADDRESS - MSB A0200208ÐÐ EQU RSIOLS(023) MASS MEMORY ADDRESS - LSB A0200209 EQU RSIOCP(024) MONITOR REQUEST CONTROL POINT A0200210 EQU RQTYPE(025) MONITOR REQUEST TYPE INDEX A0200211 EQU RQCLAS(026) MONITOR REQUEST DEVICE CLASS CODE A0200212 EQU RQMODE(027) MONITOR REQUEST CHARACTER MODE INDICATOR A0200213 EQU REQLUN(028) MONITOR REQUEST LOGICAL UNIT A0200214 EQU RSCPAD(029) USERS MONITOR REQUEST COMPLETION ADDRESS A0200215 EQU RSUSLN(030) USERS MONITOR REQUEST MESSAGE LENGTH A0200216 EQU RSUSBF(031) USERS MONITOR REQUEST MESSAGE ADDRESS A0200217 EQU PORTNO(032) MONITOR REQUEST COMMUNICATIONS PORT NUMBER A0200218 EQU RSBHDR(032) MONITOR REQUEST MESSAGE HEADER - 6 WORDS A0200219 EQU WROUTP(038) WRITE-READ USERS OUTPUT LOGICAL UNIT A0200220 EQU WRILEN(039) WRITE-READ INPUT BUFFER LENGTH A0200221 EQU WRIBUF(040) WRITE-READ INPUT BUFFER ADDRESS A0200222 EQU WRTCAD(041) WRITE-READ TERMINATION CODE ADDRESS A0200223 EQU PMCNTR(042) REQUEST PARAMETER COUNT A0200224 EQU RSCARG(043) USERS MONITOR REQUEST COMPLETION A-REGISTER A0200225 EQU RQINPT(044) USERS INPUT LOGICAL UNIT A0200226 EQU RQOUTP(045) USERS OUTPUT LOGICAL UNIT A0200227 EQU RQUN01(046) USERS SPARE LOGICAL UNIT A0200228 EQU RQUN02(047) USERS SPARE LOGICAL UNIT A0200229 EJT A0200230 SPC 4 A0200231* U S E R L I N K A G E B U F F E R E N T R I E S A0200232 SPC 2 A0200233ÐÐ EQU ERRIDX(048) ERROR MESSAGE INDEX A0200234 EQU ERRADD(049) ERROR MESSAGE ADDRESS A0200235 EQU USRPGM(050) CURRENT USER PROGRAM INDEX A0200236 EQU PGMIDX(051) LOG-IN PROCESSOR PROGRAM INDEX A0200237 EQU INTADD(052) PGMINT REQUEST INTERRUPT ADDRESS A0200238 EQU INTFLG(053) PGMINT REQUEST INTERRUPT FLAG ADDRESS A0200239 EQU ATTADR(054) ATTACH REQUEST COMPLETION ADDRESS A0200240 EQU LUNERR(055) ILLEGAL LOGICAL UNIT ERROR ADDRESS A0200241 EQU FMINDX(056) FILE REQUEST TYPE INDEX A0200242 EQU SPARE0(057) SPARE ENTRY A0200243 EQU DATIME(058) DATE AND TIME FOR DAYFILE ENTRY - 6 WORDS A0200244 EQU FRQBFA(064) FILE REQUEST BUFFER ADDRESS A0200245 EQU FILREQ(065) USER DECLARED FILE REQUEST INDICATOR A0200246 EQU FMPMTR(066) FILE REQUEST PARAMETER LIST - 5 WORDS A0200247 EQU CHNAME(071) CHAIN REQUEST PROGRAM NAME - 4 WORDS A0200248 EQU MUFWAD(075) FIRST WORD ADDRESS OF THE MULTI-USER PROGRAM A0200249 EQU TEMPQR(076) TEMPORARY STORAGE - Q REGISTER A0200250 EQU TEMPAR(077) TEMPORARY STORAGE - A REGISTER A0200251 EQU RSC5E5(078) FORTRAN SCRATCH AREA STORAGE - 33 WORDS A0200252 EQU SPARE1(111) SPARE ENTRY A0200253 EQU ENDPRO(111) END OF THE PROTECTED LINKAGE BUFFER AREA A0200254* A0200255 EQU UFPARM(112) USER DECLARED FILE REQUEST PARAMETERS A0200256 EQU FISTAT(128) USER DECLARED FILE REQUEST STATUS A0200257 EQU PFNAME(129) CURRENT PROCEDURE FILE NAME - 4 WORDS A0200258ÐÐ EQU MENUKY(133) REQUESTED FUNCTION MENU KEY A0200259 EQU USABRT(134) USER PROGRAM ABORT INDICATOR A0200260 EQU USMODE(135) USER EXECUTION MODE INDICATOR A0200261 EQU TMPGMX(136) TEMPORARY - PROGRAM INDEX A0200262 EQU TMSECT(137) TEMPORARY - PROGRAM SECTOR - 2 WORDS A0200263 EQU TMPLEN(139) TEMPORARY - PROGRAM LENGTH A0200264 EQU TMUSID(140) TEMPORARY - USER IDENTIFICATION - 4 WORDS A0200265 EQU IREQBF(144) INPUT FILE REQUEST BUFFER AND FCB A0200266 EQU FINAME(188) INPUT FILE NAME - 4 WORDS A0200267 EQU OREQBF(192) OUTPUT FILE REQUEST BUFFER AND FCB A0200268 EQU FONAME(236) OUTPUT FILE NAME - 4 WORDS A0200269 EQU FIRCNO(240) INPUT FILE RECORD NUMBER - 2 WORDS A0200270 EQU LULBUF(256) LENGTH OF THE LINKAGE BUFFER A0200271 EJT A0200272* A0200273* I T O S Q U E U E M A N A G E R A0200274* A0200275 SPC 2 A0200276* A0200277* ONNXUC EXECUTIVE SUBROUTINE USED TO ADD AN ENTRY TO A0200278* ------ THE 'NEXT EXECUTING - CORE' QUEUE A0200279* A0200280* ENTRY CONDITIONS: Q = QUEUE PRIORITY A0200281* A = USER TABLE ADDRESS A0200282* A0200283ÐÐ* EXIT CONDITIONS: I = SAVED A0200284 SPC 2 A0200285ONNXUC NOP 0 A0200286 IIN 0 A0200287 RTJ* QSETUP INITIALIZE A0200288 SPC 1 A0200289 ADD* ANXUC A = TOP OF THIS PRIORITY QUEUE A0200290 RTJ* EXQPRC ADD THE ENTRY TO THE EXECUTION QUEUE THREAD A0200291 SPC 1 A0200292 EIN 0 A0200293 JMP* (ONNXUC) AND RETURN A0200294 SPC 4 A0200295* ONNXUM EXECUTIVE SUBROUTINE USED TO ADD AN ENTRY TO A0200296* ------ THE 'NEXT EXECUTING - MASS' QUEUE A0200297* A0200298* ENTRY CONDITIONS: Q = QUEUE PRIORITY A0200299* A = USER TABLE ADDRESS A0200300* A0200301* EXIT CONDITIONS: I = SAVED A0200302 SPC 2 A0200303ONNXUM NOP 0 A0200304 IIN 0 A0200305 RTJ* QSETUP INITIALIZE A0200306 SPC 1 A0200307 ADD* ANXUM A = TOP OF THIS PRIORITY QUEUE A0200308ÐÐ RTJ* EXQPRC ADD THE ENTRY TO THE EXECUTION QUEUE THREAD A0200309 SPC 1 A0200310 EIN 0 A0200311 JMP* (ONNXUM) AND RETURN A0200312 EJT A0200313 SPC 4 A0200314* ONNSWP EXECUTIVE SUBROUTINE USED TO ADD AN ENTRY TO A0200315* ------ THE 'NEXT TO SWAP' QUEUE A0200316* A0200317* ENTRY CONDITIONS: Q = QUEUE PRIORITY A0200318* A = USER TABLE ADDRESS A0200319* A0200320* EXIT CONDITIONS: I = SAVED A0200321 SPC 2 A0200322ONNSWP NOP 0 A0200323 IIN 0 A0200324 RTJ* QSETUP INITIALIZE A0200325 SPC 1 A0200326 STA* QUTEMP SAVE THE REQUESTED PRIORITY A0200327 STQ- I I = USER TABLE ADDRESS A0200328 SPC 1 A0200329 RAO- NUMREQ,I INCREASE THE REQUEST COUNTER A0200330 LDQ- (TSIOTB),I A0200331 LDA- IOSTAT,Q A0200332 ALS 15-TI IS THE USER PERFORMING TERMINAL I/O A0200333ÐÐ SAP ONS010 NO A0200334 ALS TI-IN YES, IS THE USER PERFORMING TERMINAL INPUT A0200335 SAM ONS020 YES, PLACE THE USER ON THE ONNSWP QUEUE A0200336 SPC 1 A0200337ONS010 LDA* (ALLIMT) NO A0200338 SUB- NUMREQ,I HAS THE LOWER LIMIT BEEN REACHED A0200339 SAP ONS030 NO, JUST RETURN A0200340 SPC 1 A0200341 LDA- NUMREQ,I YES A0200342 SUB* (AULIMT) HAS THE UPPER LIMIT BEEN EXCEEDED A0200343 SAP ONS020 YES, PLACE THE USER ON THE NSWP QUEUE A0200344 SPC 1 A0200345 LDQ* ANXUM NO, Q = BASE OF THE NXUM QUEUE A0200346 LDA- 2,Q A0200347 INA 0 IS THERE A PRIORITY USER ON THE NXUM QUEUE A0200348 SAZ ONS030 NO, JUST RETURN A0200349 SPC 1 A0200350ONS020 LDA* QUTEMP A = REQUEST QUEUE PRIORITY A0200351 LDQ- I Q = USER TABLE ADDRESS A0200352 RTJ* PUTSWP PLACE THE USER ON THE NSWP QUEUE A0200353 SPC 1 A0200354ONS030 RTJ* QRSTOR RESTORE THE I-REGISTER A0200355 EIN 0 A0200356 JMP* (ONNSWP) AND RETURN A0200357 EJT A0200358ÐÐ SPC 4 A0200359* ADNSWP EXECUTIVE SUBROUTINE USED TO UNCONDITIONALLY A0200360* ------ ADD AN ENTRY TO THE 'NSWP' QUEUE A0200361* A0200362* ENTRY CONDITIONS: Q = QUEUE PRIORITY A0200363* A = USER TABLE ADDRESS A0200364* A0200365* EXIT CONDITIONS: I = SAVED A0200366 SPC 2 A0200367ADNSWP NOP 0 A0200368 IIN 0 A0200369 RTJ* QSETUP INITIALIZE A0200370 RTJ* PUTSWP PLACE THE USER ON THE NSWP QUEUE A0200371 RTJ* QRSTOR RESTORE THE I-REGISTER A0200372 EIN 0 A0200373 JMP* (ADNSWP) RETURN A0200374 SPC 4 A0200375* PUTSWP EXECUTIVE SUBROUTINE USED TO PLACE A USER ON A0200376* ------ ON THE NSWP QUEUE A0200377* A0200378* ENTRY CONDITIONS: Q = USER TABLE ADDRESS A0200379* A = QUEUE PRIORITY A0200380 SPC 2 A0200381PUTSWP NOP 0 A0200382 SPC 1 A0200383ÐÐ ADD* ANSWP A = TOP OF THIS PRIORITY QUEUE A0200384 STA- I A0200385 INQ +NSWPTH Q = THREAD ADDRESS A0200386 LDA- (ZERO),Q IS THE THREAD WORD ACTIVE A0200387 SAZ PUT010 NO A0200388 RTJ* (ASYFAL) YES, FATAL ERROR A0200389 SPC 1 A0200390PUT010 LDA- (I) A = OLD TOP (LIFO QUEUE) A0200391 STA- (ZERO),Q OLD TOP GOES INTO NEW ENTRY A0200392 STQ- (I) NEW ENTRY GOES INTO TOP A0200393 SPC 1 A0200394 JMP* (PUTSWP) RETURN A0200395 EJT A0200396 SPC 4 A0200397* A0200398* GTNXUM EXECUTIVE SUBROUTINE USED TO OBTAIN THE TOP A0200399* ------ ENTRY FROM THE 'NEXT EXECUTING - A0200400* MASS' QUEUE A0200401* A0200402* ENTRY CONDITIONS: NONE A0200403* A0200404* EXIT CONDITIONS: A = USER THREAD ADDRESS A0200405* OF THE TOP ENTRY A0200406 SPC 2 A0200407GTNXUM NOP 0 A0200408ÐÐ IIN 0 A0200409 LDQ* NUMPRI A0200410 SPC 1 A0200411GTN010 LDA* (ANXUM),Q A0200412 INA 0 IS THIS PRIORITY ENTRY DEFINED A0200413 SAN GTN030 YES, RETURN A0200414 INQ -1 A0200415 SQM GTN020 ALL PRIORITIES ARE EMPTY A0200416 JMP* GTN010 A0200417 SPC 1 A0200418GTN020 SET A INDICATE AN EMPTY QUEUE A0200419GTN030 EIN 0 A0200420 JMP* (GTNXUM) RETURN A0200421 EJT A0200422 SPC 4 A0200423* A0200424* QSETUP TSSUBR SUBROUTINE USED TO SET UP THE QUEUE A0200425* ------ PARAMETERS AND SAVE THE I-REGISTER A0200426* A0200427* ENTRY CONDITIONS: Q = QUEUE PRIORITY A0200428* A = USER TABLE ADDRESS A0200429* A0200430* EXIT CONDITIONS: Q = USER TABLE ADDRESS A0200431* A = PRIORITY INDEX A0200432 SPC 2 A0200433ÐÐQSETUP NOP 0 A0200434 SPC 1 A0200435 STA* QUTEMP A0200436 LDA- I A0200437 STA* QSAVEI SAVE THE I-REGISTER A0200438 SPC 1 A0200439 INQ -1 A0200440 TRQ A A = PRIORITY INDEX A0200441 SQM QSE010 INVALID INDEX A0200442 SUB* NUMPRI A0200443 SAM QSE020 A0200444 SAZ QSE020 A0200445QSE010 RTJ* (ASYFAL) ILLEGAL QUEUE INDEX A0200446 SPC 1 A0200447QSE020 TRQ A A = PRIORITY INDEX A0200448 LDQ* QUTEMP Q = USER TABLE ADDRESS A0200449 SPC 1 A0200450 JMP* (QSETUP) RETURN A0200451 SPC 4 A0200452* A0200453* QRSTOR TSSUBR SUBROUTINE USED TO RESORE THE USERS A0200454* ------ I-REGISTER A0200455 SPC 2 A0200456QRSTOR NOP 0 A0200457 SPC 1 A0200458ÐÐ LDQ* QSAVEI A0200459 STQ- I RESTORE THE I-REGISTER A0200460 JMP* (QRSTOR) RETURN A0200461 EJT A0200462 SPC 4 A0200463* A0200464* EXQPRC TSSUBR SUBROUTINE USED TO ADD AN ENTRY ONTO A0200465* ------ THE EXECUTION QUEUE THREAD A0200466* A0200467* ENTRY CONDITIONS: Q = USER TABLE ADDRESS A0200468* A = ADDRESS OF THE TOP OF A0200469* THE QUEUE A0200470 SPC 2 A0200471EXQPRC NOP 0 A0200472 SPC 1 A0200473EXQ010 STA- I I = NEXT ADDRESS ON THE THREAD A0200474 LDA- (I) A0200475 INA 0 IS THIS THE END OF THE THREAD A0200476 SAZ EXQ020 YES, TOP OF THE FIFO QUEUE IS FOUND A0200477 JMP* EXQ010 NO, CONTINUE A0200478 SPC 1 A0200479EXQ020 INQ +NEXETH Q = THREAD ADDRESS A0200480 LDA- (ZERO),Q IS THE THREAD WORD ACTIVE A0200481 SAZ EXQ030 NO A0200482 RTJ* (ASYFAL) YES, FATAL ERROR A0200483ÐÐ SPC 1 A0200484EXQ030 STQ- (I) PLACE NEW ENTRY ON THE END OF THE THREAD A0200485 SET A A0200486 STA- (ZERO),Q SET THE NEW END A0200487 RTJ* QRSTOR RESTORE THE I-REGISTER A0200488 SPC 1 A0200489 JMP* (EXQPRC) AND RETURN A0200490 SPC 4 A0200491* Q U E U E M A N A G E R D A T A A N D S T O R A G E A0200492 SPC 2 A0200493QSAVEI NUM 0 I-REGISTER STORAGE A0200494QUEIDX NUM 0 QUEUE SEARCH INDEX A0200495QUTEMP NUM 0 TEMPORARY STORAGE A0200496ALLIMT ADC RQLLIM SWAP CANDIDATE LOWER REQUEST LIMIT A0200497AULIMT ADC RQULIM SWAP CANDIDATE UPPER REQUEST LIMIT A0200498ANXUC ADC NXUC BASE TOP OF THE NXUC QUEUE A0200499ANXUM ADC NXUM BASE TOP OF THE NXUM QUEUE A0200500ANSWP ADC NSWP BASE TOP OF THE NSWP QUEUE A0200501NUMPRI ADC TSQPRI NUMBER OF QUEUE PRIORITY ENTRIES A0200502ASYFAL ADC SYFAIL SYSTEM FAILURE PROCESSOR A0200503 EJT A0200504 SPC 4 A0200505* A0200506* OFNXUC EXECUTIVE SUBROUTINE USED TO POP AN ENTRY OFF A0200507* ------ THE 'NEXT EXECUTING - CORE' QUEUE A0200508ÐÐ* A0200509* ENTRY CONDITIONS: NONE A0200510* A0200511* EXIT CONDITIONS: I = SAVED A0200512* A = USER THREAD ADDRESS OF A0200513* THE TOP OF THE QUEUE A0200514 SPC 2 A0200515OFNXUC NOP 0 A0200516 IIN 0 A0200517 SPC 1 A0200518 LDQ* ANXUC Q = BASE TOP OF THE NXUC QUEUE A0200519 ENA 0 INDICATE A POP REQUEST A0200520 RTJ* POPQUE A0200521 SPC 1 A0200522 EIN 0 A0200523 JMP* (OFNXUC) RETURN A0200524 SPC 4 A0200525* A0200526* OFNSWP EXECUTIVE SUBROUTINE USED TO POP AN ENTRY OFF A0200527* ------ THE 'NEXT TO SWAP' QUEUE A0200528* A0200529* ENTRY CONDITIONS: NONE A0200530* A0200531* EXIT CONDITIONS: I = SAVED A0200532* A = USER THREAD ADDRESS OF A0200533ÐÐ* THE TOP OF THE QUEUE A0200534 SPC 2 A0200535OFNSWP NOP 0 A0200536 IIN 0 A0200537 SPC 1 A0200538 LDQ* ANSWP Q = BASE TOP OF THE NSWP QUEUE A0200539 ENA 0 INDICATE A POP REQUEST A0200540 RTJ* POPQUE A0200541 SPC 1 A0200542 EIN 0 A0200543 JMP* (OFNSWP) RETURN A0200544 EJT A0200545* A0200546* DENSWP EXECUTIVE SUBROUTINE USED TO DELETE AN ENTRY A0200547* ------ (IF PRESENT) FROM THE 'NEXT TO A0200548* SWAP' QUEUE A0200549* A0200550* ENTRY CONDITIONS: A = USER TABLE ADDRESS A0200551* A0200552* EXIT CONDITIONS: I = SAVED A0200553 SPC 1 A0200554DENSWP NOP 0 A0200555 IIN 0 A0200556 LDQ* ANSWP Q = BASE TOP OF THE NSWP QUEUE A0200557 INA +NSWPTH A = NSWP THREAD ADDRESS A0200558ÐÐ RTJ* POPQUE A0200559 EIN 0 A0200560 JMP* (DENSWP) RETURN A0200561 SPC 2 A0200562* A0200563* DENXUM EXECUTIVE SUBROUTINE USED TO DELETE AN ENTRY A0200564* ------ FROM THE 'NEXT EXECUTING - MASS' A0200565* QUEUE A0200566* A0200567* ENTRY CONDITIONS: A = USER TABLE ADDRESS A0200568* A0200569* EXIT CONDITIONS: I = SAVED A0200570 SPC 1 A0200571DENXUM NOP 0 A0200572 IIN 0 A0200573 LDQ* ANXUM Q = BASE TOP OF THE NXUM QUEUE A0200574 INA +NEXETH A = NXUM THREAD ADDRESS A0200575 RTJ* POPQUE A0200576 EIN 0 A0200577 JMP* (DENXUM) RETURN A0200578 SPC 2 A0200579* A0200580* DENXUC EXECUTIVE SUBROUTINE USED TO DELETE AN ENTRY A0200581* ------ FROM THE 'NEXT EXECUTING - CORE' A0200582* QUEUE A0200583ÐÐ* A0200584* ENTRY CONDITIONS: A = USER TABLE ADDRESS A0200585* A0200586* EXIT CONDITIONS: I = SAVED A0200587 SPC 1 A0200588DENXUC NOP 0 A0200589 IIN 0 A0200590 LDQ* ANXUC Q = BASE TOP OF THE NXUC QUEUE A0200591 INA +NEXETH A = NXUC THREAD ADDRESS A0200592 RTJ* POPQUE A0200593 EIN 0 A0200594 JMP* (DENXUC) RETURN A0200595 EJT A0200596* POPQUE TSSUBR SUBROUTINE USED TO POP AN ENTRY FROM A0200597* ------ THE SPECIFIED QUEUE AND TO REMOVE THE A0200598* ENTRY IF REQUIRED A0200599* A0200600* ENTRY CONDITIONS: Q = ADDRESS OF THE BASE TOP A0200601* OF THE QUEUE A0200602* A = USER THREAD ADDRESS A0200603* (FOR ENTRY DELETIONS) A0200604* A = 0 A0200605* (FOR POP REQUESTS) A0200606* A0200607* EXIT CONDITIONS: I = SAVED A0200608ÐÐ* A = USER TABLE ADDRESS A0200609 SPC 2 A0200610POPQUE NOP 0 A0200611 STQ* QUTEMP SAVE THE BASE QUEUE TOP A0200612 LDQ- I A0200613 STQ* QSAVEI SAVE THE I-REGISTER A0200614 LDQ* NUMPRI A0200615 SPC 1 A0200616POP010 STQ* QUEIDX A0200617 ADQ* QUTEMP Q = BASE ADDRESS OF THIS PRIORITY QUEUE A0200618POP020 STQ- I I = NEXT ADDRESS ON THE THREAD A0200619 LDQ- (I) A0200620 INQ 0 IS THIS THE END OF THIS THREAD A0200621 SQZ POP030 YES A0200622 EAQ Q NO, IS THIS THE ENTRY TO REMOVE A0200623 SQZ POP060 YES A0200624 SAZ POP050 NO, POP REQUEST ONLY A0200625 LDQ- (I) NEITHER, RESTORE THE Q-REGISTER A0200626 JMP* POP020 AND CONTINUE THE SEARCH A0200627 SPC 1 A0200628POP030 LDQ* QUEIDX A0200629 INQ -1 HAVE ALL PRIORITIES BEEN SEARCHED A0200630 SQM POP040 YES, EXIT A0200631 JMP* POP010 NO, SEARCH THE NEXT ONE A0200632 SPC 1 A0200633ÐÐPOP040 SET A NO ENTRIES PRESENT, INDICATE AN END-OF-THREAD A0200634 JMP* POP070 A0200635 SPC 1 A0200636POP050 TRQ A A = TOP ENTRY ON THE QUEUE A0200637 SPC 1 A0200638POP060 TRA Q Q = ENTRY TO BE REMOVED A0200639 LDQ- (ZERO),Q Q = NEXT ADDRESS ON THE THREAD A0200640 STQ- (I) REMOVE THE SELECTED ENTRY A0200641 STA- I A0200642 CLR Q CLEAR THE OLD THREAD ENTRY A0200643 STQ- (I) A0200644 SPC 1 A0200645POP070 RTJ* QRSTOR RESTORE THE I-REGISTER A0200646 JMP* (POPQUE) AND RETURN A0200647 EJT A0200648* A0200649* I T O S M E M O R Y M A N A G E R A0200650* A0200651 SPC 2 A0200652* A0200653* XMALC EXECUTIVE SUBROUTINE USED TO ALLOCATE MAIN A0200654* ----- MEMORY AND ASSIGN IT TO A USER A0200655* A0200656* ENTRY CONDITIONS: I = USER OR MULTI-USER A0200657* TABLE ADDRESS A0200658ÐÐ* Q = NUMBER OF MEMORY PAGES A0200659* TO BE ALLOCATED A0200660* A0200661* EXIT CONDITIONS: Q = BASE PAGE IF SUCCESSFUL A0200662* Q = -1 IF NOT SUCCESSFUL A0200663 SPC 2 A0200664XMALC NOP 0 A0200665 ENA 0 SPECIFY A MEMORY ALLOCATION A0200666 RTJ* XMFIND FIND AND ALLOCATE THE MEMORY A0200667 JMP* (XMALC) RETURN A0200668 SPC 4 A0200669* A0200670* XMRSV EXECUTIVE SUBROUTINE USED TO RESERVE A A0200671* ----- SPECIFIC BLOCK OF MAIN MEMORY A0200672* A0200673* ENTRY CONDITIONS: I = RESERVE INDICATOR (-1) A0200674* Q = BASE PAGE (BITS 0-7 ) A0200675* Q = NO. PAGES (BITS 8-15) A0200676* A0200677* EXIT CONDITIONS: Q = BASE PAGE IF SUCCESSFUL A0200678* Q = -1 IF NOT SUCCESSFUL A0200679* A0200680 SPC 2 A0200681XMRSV NOP 0 A0200682 LRS 8 Q = NUMBER OF PAGES REQUESTED A0200683ÐÐ ARS 8 A = BASE PAGE REQUESTED A0200684 RTJ* XMFIND FIND AND RESERVE THE MEMORY A0200685 JMP* (XMRSV) RETURN A0200686 EJT A0200687* XMFIND TSSUBR SUBROUTINE USED TO ALLOCATE OR RESERVE A0200688* ------ EXECUTION MEMORY A0200689* A0200690* ENTRY CONDITIONS: I = ALLOCATION VARIABLE A0200691* Q = NUMBER OF PAGES A0200692* A = ENTRY PARAMETER A0200693* A0200694* EXIT CONDITIONS: Q = BASE PAGE IF SUCCESSFUL A0200695* Q = -1 IF NOT SUCCESSFUL A0200696 SPC 2 A0200697XMFIND NOP 0 A0200698 STA* MEMTM1 SAVE THE ENTRY PARAMETER A0200699 ENA 0 A0200700 STA* MEMTM2 INITIALIZE THE SEARCH COUNTER A0200701 TRQ A A0200702 INQ -1 A0200703 STQ* MEMTM3 INITIALIZE THE REQUEST PAGE COUNT A0200704 LDQ- I A0200705 STQ* MEMSVI SAVE THE ALLOCATION VARIABLE A0200706 SQM XMF010 FORWARD SEARCH REQUIRED FOR RESERVE REQUEST A0200707 SUB+ LRGUSR IS THIS A 'LARGE' ALLOCATION A0200708ÐÐ SAM XMF020 NO A0200709XMF010 ENQ 0 YES, ALLOCATE FROM THE LOWEST MEMORY ADDRESS A0200710 LDA* AXMAT A0200711 JMP* XMF030 A0200712XMF020 ENQ -127 ALLOCATE FROM THE HIGHEST MEMORY ADDRESS A0200713 LDA* AXMEND A0200714XMF030 STA- I I = BASE ADDRESS FOR TABLE SEARCH A0200715 SPC 1 A0200716XMF040 LDA- (I) OBTAIN THE NEXT XMAT TABLE ENTRY A0200717 SAZ XMF050 THIS BLOCK IS AVAILABLE A0200718 SAP XMF070 THIS BLOCK IS OCCUPIED A0200719 JMP* XMF100 THIS BLOCK IS UNAVAILABLE A0200720 SPC 1 A0200721XMF050 LDA* MEMTM1 IS THIS AN ALLOCATION REQUEST A0200722 SAZ XMF060 YES, CONTINUE A0200723 EAQ A NO, THIS THE REQUIRED BASE PAGE A0200724 SAN XMF070 NO A0200725 RAO* MEMTM1 YES, INCREMENT THE REQUESTED BASE A0200726XMF060 LDA* MEMTM2 A0200727 SUB* MEMTM3 IS THE BLOCK LARGE ENOUGH A0200728 SAP XMF110 YES, ASSIGN THE MEMORY A0200729 RAO* MEMTM2 NO, CONTINUE A0200730 JMP* XMF080 A0200731 SPC 1 A0200732XMF070 ENA 0 THIS BLOCK CANT BE USED A0200733ÐÐ STA* MEMTM2 RESET THE SEARCH COUNT A0200734XMF080 INQ 1 INCREMENT THE PAGE COUNTER A0200735 RTJ* XMINCT AND THE TABLE INDEX A0200736 SAM XMF090 SEARCH COMPLETE A0200737 JMP* XMF040 CONTINUE A0200738 EJT A0200739 SPC 4 A0200740XMF090 ENQ -1 REQUEST IS UNSUCESSFUL A0200741 JMP* XMF150 A0200742 SPC 1 A0200743XMF100 INA 1 A0200744 TCA A A0200745 AAQ Q ADVANCE THROUGH THE UNAVAILABLE PAGES A0200746 JMP* XMF070 CONTINUE A0200747 SPC 1 A0200748* REQUEST IS SUCESSFUL A0200749XMF110 SQP XMF120 FOREWARD SEARCH A0200750 TCQ Q Q = BASE PAGE OF THE ALLOCATION A0200751 JMP* XMF130 A0200752 SPC 1 A0200753XMF120 LDA* MEMTM2 A0200754 TCA A A0200755 AAQ Q ADJUST BACK TO THE BASE PAGE NUMBER A0200756 ADD- I ALSO ADJUST THE TABLE INDEX A0200757 STA- I A0200758ÐÐXMF130 STQ* MEMTM3 Q = BASE PAGE OF THE ALLOCATION A0200759 SPC 1 A0200760 LDA* MEMSVI A0200761 LDQ* MEMTM2 A0200762 SPC 1 A0200763XMF140 STA- (I),Q SET UP THE MEMORY AS REQUESTED A0200764 DQP *-XMF140 A0200765 SPC 1 A0200766 LDQ* MEMTM3 Q = BASE PAGE OF THE ALLOCATION A0200767 SPC 1 A0200768XMF150 LDA* MEMSVI A0200769 STA- I RESTORE THE I-REGISTER A0200770 JMP* (XMFIND) RETURN A0200771 EJT A0200772 SPC 4 A0200773* A0200774* XMINCT TSSUBR SUBROUTINE USED TO INCREMENT THE XMAT A0200775* ------ TABLE INDEX AND TEST FOR AN END-OF- A0200776* TABLE CONDITION. THIS ROUTINE WILL A0200777* OPERATE IN FOREWARD OR BACKWARD MODE A0200778* A0200779* ENTRY CONDITIONS: I = TABLE INDEX A0200780* Q = FOREWARD MODE IF + A0200781* Q = BACKWARD MODE IF - A0200782* A0200783ÐÐ* EXIT CONDITIONS: A = -1 IF AN END-OF-TABLE A0200784* HAS OCCURED A0200785 SPC 2 A0200786XMINCT NOP 0 A0200787 SPC 1 A0200788 SQM XMI010 BACKWARD MODE A0200789 SPC 1 A0200790 RAO- I INCREMENT THE TABLE INDEX A0200791 LDA* AXMEND A0200792 SUB- I CHECK FOR THE END A0200793 JMP* XMI020 RETURN A0200794 SPC 1 A0200795XMI010 LDA- I A0200796 INA -1 DECREMENT THE TABLE INDEX A0200797 STA- I A0200798 SUB* AXMAT CHECK FOR THE END A0200799 SPC 1 A0200800XMI020 JMP* (XMINCT) RETURN A0200801 EJT A0200802* XMREL EXECUTIVE SUBROUTINE USED TO RELEASE THE MAIN A0200803* ----- MEMORY ASSIGNED TO A USER A0200804* A0200805* ENTRY CONDITIONS: I = USER OR MULTI-USER A0200806* TABLE ADDRESS A0200807* A0200808ÐÐ* EXIT CONDITIONS: Q = -1 IF NO MEMORY IS A0200809* ALLOCATED TO THE USER A0200810 SPC 2 A0200811XMREL NOP 0 A0200812 CLR A,Q SPECIFY A RELEASE A0200813 RTJ* XMSRCH FIND AND RELEASE THE USERS MEMORY A0200814 JMP* (XMREL) RETURN A0200815 SPC 4 A0200816* XMRTN EXECUTIVE SUBROUTINE USED TO RELEASE A PART A0200817* ----- OF THE MEMORY ASSIGNED TO A MULTI- A0200818* USER PROGRAM A0200819* A0200820* ENTRY CONDITIONS: I = MULTI-USER TABLE ADDRESSA0200821* Q = MULTI-USER SIZE (PAGES) A0200822* A0200823* EXIT CONDITIONS: Q = -1 IF NO MEMORY IS A0200824* ALLOCATED TO THE USER A0200825 SPC 2 A0200826XMRTN NOP 0 A0200827 ENA 0 SPECIFY A RETURN A0200828 RTJ* XMSRCH FIND AND RETURN ALL EXTRA ASSIGNED MEMORY A0200829 JMP* (XMRTN) RETURN A0200830 SPC 4 A0200831* XMMOD EXECUTIVE SUBROUTINE USED TO REASSIGN A A0200832* ----- PART OF THE MEMORY ASSIGNED TO A A0200833ÐÐ* MULTI-USER PROGRAM A0200834* A0200835* ENTRY CONDITIONS: I = MULTI-USER TABLE ADDRESSA0200836* Q = MULTI-USER SIZE (PAGES) A0200837* A0200838* EXIT CONDITIONS: Q = -1 IF NO MEMORY IS A0200839* ALLOCATED TO THE USER A0200840 SPC 2 A0200841XMMOD NOP 0 A0200842 LDA- (MUROOT),I A = USER TABLE ADDRESS A0200843 RTJ* XMSRCH FIND AND REASSIGN THE EXTRA MEMORY A0200844 JMP* (XMMOD) RETURN A0200845 EJT A0200846 SPC 4 A0200847* A0200848* XMSRCH TSSUBR SUBROUTINE USED TO FIND AN ENTRY IN A0200849* ------ THE 'XMAT' TABLE AND TO PLACE THE A0200850* SPECIFIED DATA IN THE ENTRY A0200851* A0200852* ENTRY CONDITIONS: I = USER OR MULTI-USER A0200853* TABLE ADDRESS OF THE A0200854* DESIRED ENTRY A0200855* Q = ENTRY PARAMETER A0200856* A = REPLACEMENT VALUE A0200857* A0200858ÐÐ* EXIT CONDITIONS: Q = -1 IF NO MEMORY IS A0200859* ALLOCATED TO THE USER A0200860 SPC 2 A0200861XMSRCH NOP 0 A0200862 STQ* MEMTM1 SAVE THE ENTRY PARAMETERS A0200863 STA* MEMTM2 A0200864 ENA -1 A0200865 STA* MEMTM3 INITIALIZE THE COMPLETION PARAMETER A0200866 LDQ* AXMAT Q = BASE ADDRESS OF THE XMAT TABLE A0200867 SPC 1 A0200868XMS010 LDA- (ZERO),Q OBTAIN THE NEXT XMAT ENTRY A0200869 SUB- I IS THIS THE DESIRED ENTRY A0200870 SAN XMS020 NO A0200871 LDA* MEMTM1 A = MULTI-USER PAGE SIZE (IF ANY) A0200872 AAQ Q INCREMENT THE TABLE ADDRESS A0200873 ENA 0 A0200874 STA* MEMTM1 CLEAR THE ENTRY PARAMETER A0200875 LDA* MEMTM2 A = USER TABLE ADDRESS OR ZERO A0200876 STA- (ZERO),Q SPECIFY THE MEMORY ALLOCATION A0200877 STA* MEMTM3 INDICATE THE ENTRY WAS FOUND A0200878 SPC 1 A0200879XMS020 TRQ A A0200880 SUB* AXMEND IS THE SEARCH COMPLETE A0200881 SAP XMS030 YES A0200882 INQ 1 A0200883ÐÐ JMP* XMS010 NO, CONTINUE A0200884 SPC 1 A0200885XMS030 LDQ* MEMTM3 OBTAIN THE COMPLETION PARAMETER A0200886 JMP* (XMSRCH) AND RETURN A0200887 EJT A0200888 SPC 4 A0200889* M E M O R Y M A N A G E R D A T A A N D S T O R A G E A0200890 SPC 2 A0200891AXMAT ADC XMAT EXECUTION MEMORY TABLE STARTING ADDRESS A0200892AXMEND ADC XMTEND EXECUTION MEMORY TABLE ENDING ADDRESS A0200893MEMTM1 NUM 0 TEMPORARY STORAGE A0200894MEMTM2 NUM 0 TEMPORARY STORAGE A0200895MEMTM3 NUM 0 TEMPORARY STORAGE A0200896MEMSVI NUM 0 I-REGISTER STORAGE A0200897TSWSEC ADC 0 SWAP BUFFER BASE SECTOR ADDRESS - MSB A0200898 ADC 0 SWAP BUFFER BASE SECTOR ADDRESS - LSB A0200899AMAMAX ADC MMAMAX TOTAL NUMBER OF MASS MEMORY BLOCKS A0200900AMMAT ADC MMAT MASS MEMORY ALLOCATION TABLE A0200901N86 ADC 86 NUMBER OF SECTORS / SWAP BLOCK A0200902 EJT A0200903 SPC 4 A0200904* A0200905* MMALC EXECUTIVE SUBROUTINE USED TO ALLOCATE MASS A0200906* ----- MEMORY FOR USER SWAPS A0200907* A0200908ÐÐ* ENTRY CONDITIONS: I = USER TABLE ADDRESS A0200909* Q = PROGRAM LENGTH A0200910* A0200911* EXIT CONDITIONS: I = SAVED A0200912* Q = SWAP SECTOR MSB A0200913* A = SWAP SECTOR LSB A0200914* A0200915 SPC 2 A0200916MMALC NOP 0 A0200917 RTJ* MSETUP INITIALIZE A0200918 SPC 1 A0200919 STQ* MEMTM3 Q = NUMBER OF BLOCKS REQUIRED A0200920 ENQ 0 A0200921 STQ- I A0200922 STQ* MEMTM1 INITIALIZE THE ALLOCATION COUNT A0200923 STQ* MEMTM2 A0200924 RAO* MEMTM2 AND THE TOTAL BLOCK COUNT A0200925 SPC 1 A0200926MMA030 RAO* MEMTM1 A0200927 LDA* (AMMAT),I A0200928 AND- ONEBIT,Q IS THIS BLOCK AVAILABLE A0200929 SAZ MMA040 YES A0200930 ENA 0 A0200931 STA* MEMTM1 NO, RESET THE ALLOCATION COUNTER A0200932 SPC 1 A0200933ÐÐMMA040 LDA* MEMTM1 A0200934 SUB* MEMTM3 ARE THE REQUIRED BLOCKS AVAILABLE A0200935 SAP MMA050 YES A0200936 LDA* (AMAMAX) NO A0200937 RTJ* MMINCT HAVE ALL BLOCKS BEEN SEARCHED A0200938 JMP* MMA030 NO, CONTINUE A0200939 SPC 1 A0200940 ENQ -1 YES, INDICATE AN ERROR A0200941 LDA* MEMSVI A0200942 STA- I RESTORE THE I-REGISTER A0200943 JMP* (MMALC) RETURN A0200944 EJT A0200945 SPC 4 A0200946MMA050 LDA* MEMTM2 OBTAIN THE CURRENT BLOCK COUNT A0200947 SUB* MEMTM3 A0200948 STA* MEMTM1 A = BASE BLOCK COUNT A0200949 SPC 1 A0200950 CLR Q A0200951 STQ* MEMTM2 A0200952 DVI- SIXTEN Q = BASE BIT POSITION A0200953 STA- I I = BASE WORD A0200954 SPC 1 A0200955MMA060 LDA* (AMMAT),I A0200956 EOR- ONEBIT,Q ALLOCATE THE MASS MEMORY BLOCK A0200957 STA* (AMMAT),I A0200958ÐÐ SPC 1 A0200959 LDA* MEMTM3 A0200960 RTJ* MMINCT HAVE ALL BLOCKS BEEN ALLOCATED A0200961 JMP* MMA060 NO, CONTINUE A0200962 SPC 1 A0200963 LDA* MEMSVI A0200964 STA- I RESTORE THE I-REGISTER A0200965 SPC 1 A0200966 LDA* MEMTM1 A0200967 MUI* N86 A = RELATIVE SECTOR INTO THE SWAP BUFFER A0200968 LDQ* TSWSEC A0200969 ADD* TSWSEC+1 CALCULATE THE SWAP SECTOR A0200970 SAP MMA070 A0200971 INQ 1 MAINTAIN 15-BIT FORMAT A0200972 AND- LPMASK+15 A0200973 SPC 1 A0200974MMA070 JMP* (MMALC) RETURN A0200975 EJT A0200976* MSETUP TSSUBR SUBROUTINE USED TO CONVERT THE A0200977* ------ PROGRAM LENGTH TO SWAP BLOCKS A0200978* A0200979* ENTRY CONDITIONS: Q = PROGRAM LENGTH A0200980* A0200981* EXIT CONDITIONS: Q = NUMBER OF SWAP BLOCKS A0200982* (MEMSVI) = ENTRY I-REGISTER A0200983ÐÐ* A0200984 SPC 2 A0200985MSETUP NOP 0 A0200986 LDA- I A0200987 STA* MEMSVI SAVE THE I-REGISTER A0200988 CLR A A0200989 LRS 13 LENGTH / 8192 A0200990 SQZ MSE010 ALLOCATE A MINIMUM OF 1 BLOCK A0200991 SAZ MSE020 A0200992MSE010 INQ 1 A0200993MSE020 JMP* (MSETUP) RETURN A0200994 SPC 4 A0200995* MMINCT TSSUBR SUBROUTINE USED TO INCREMENT THE MMAT A0200996* ------ WORD AND BIT INDICES, AND TO TEST FOR A0200997* MAXIMUM BLOCK COUNT A0200998* A0200999* ENTRY CONDITIONS: A = MAXIMUM INDEX VALUE A0201000* (MEMTM2) = CURRENT BLOCK COUNT A0201001* A0201002* EXIT CONDITIONS: Q = INCREMENTED A0201003* I = INCREMENTED A0201004* RETURN = P+1 IF NOT THRU A0201005* RETURN = P+2 IF THRU A0201006* A0201007 SPC 2 A0201008ÐÐMMINCT NOP 0 A0201009 SPC 1 A0201010 RAO* MEMTM2 INCREMENT THE BLOCK COUNT A0201011 SUB* MEMTM2 HAS THE MAXIMUM COUNT BEEN REACHED A0201012 SAN MMI010 NO A0201013 RAO* MMINCT YES, RETURN AT P+2 A0201014 JMP* (MMINCT) A0201015 SPC 1 A0201016MMI010 INQ 1 INCREMENT THE BIT INDEX A0201017 TRQ A A0201018 AND- NZERO+4 IS THIS THE END OF THIS WORD A0201019 SAZ MMI020 NO A0201020 RAO- I YES, INCREMENT THE WORD INDEX A0201021 ENQ 0 RESET THE BIT INDEX A0201022MMI020 JMP* (MMINCT) RETURN A0201023 EJT A0201024* A0201025* MMREL EXECUTIVE SUBROUTINE USED TO RELEASE MASS A0201026* ----- MEMORY FOR USER SWAPS A0201027* A0201028* ENTRY CONDITIONS: I = USER TABLE ADDRESS A0201029* Q = PROGRAM LENGTH A0201030* A0201031* EXIT CONDITIONS: I = SAVED A0201032* Q = -1 IF NOT SUCCESSFUL A0201033ÐÐ* A0201034 SPC 2 A0201035MMREL NOP 0 A0201036 RTJ* MSETUP INITIALIZE A0201037 STQ* MEMTM1 Q = NUMBER OF BLOCKS ALLOCATED A0201038 SPC 1 A0201039 LDA- PGMSEC,I A0201040 EOR* TSWSEC A0201041 TRA Q Q = MSB RELATIONSHIP A0201042 LDA- PGMSEC+1,I A0201043 ALS 1 CONVERT TO 16-BIT ADDRESS A0201044 LRS 1 A0201045 SAN MMR010 A0201046 ENQ -1 NO MEMORY ASSIGNED, RETURN AN ERROR A0201047 JMP* (MMREL) A0201048 SPC 1 A0201049MMR010 SUB* TSWSEC+1 A = RELATIVE SECTOR POSITION A0201050 CLR Q A0201051 STQ* MEMTM2 A0201052 DVI* N86 A0201053 DVI- SIXTEN Q = BASE BIT POSITION A0201054 STA- I I = BASE WORD A0201055 SPC 1 A0201056MMR020 LDA* (AMMAT),I A0201057 AND- ZROBIT,Q RELEASE THE ALLOCATION A0201058ÐÐ STA* (AMMAT),I A0201059 LDA* MEMTM1 A0201060 RTJ* MMINCT HAVE ALL BLOCKS BEEN RELEASED A0201061 JMP* MMR020 NO, CONTINUE A0201062 SPC 1 A0201063 LDA* MEMSVI A0201064 STA- I RESTORE THE REQUESTORS I-REGISTER A0201065 ENQ 0 INDICATE A SUCCESSFUL RELEASE A0201066 STQ- PGMSEC,I A0201067 STQ- PGMSEC+1,I RELEASE THE SWAP SECTOR A0201068 SPC 1 A0201069 JMP* (MMREL) RETURN A0201070 EJT A0201071 SPC 4 A0201072* M I S C E L L A N E O U S S U B R O U T I N E S A0201073 SPC 4 A0201074* A0201075* TSCLOK EXECUTIVE SUBROUTINE USED TO SET THE VALUE A0201076* ------ OF THE TIMESLICE DELAY A0201077* A0201078* ENTRY CONDITIONS: A = DELAY VALUE (COUNTS) A0201079* INTERRUPTS = OFF A0201080* A0201081* EXIT CONDITIONS: I = SAVED A0201082* A = CURRENT DELAY VALUE A0201083ÐÐ SPC 2 A0201084TSCLOK NOP 0 A0201085 SPC 1 A0201086 LDQ* SLICER Q = CURRENT TIMESLICE VALUE A0201087 STA* SLICER SPECIFY THE NEW VALUE A0201088 SQP TSC010 SKIP IF THE CLOCK WAS ACTIVE A0201089 ENQ 0 NOT ACTIVE, RETURN A ZERO VALUE A0201090 SPC 1 A0201091TSC010 TRQ A A = REMAINING TIMESLICE A0201092 JMP* (TSCLOK) RETURN A0201093 SPC 2 A0201094SLICER NUM $FFFE USER TIMESLICE COUNTER A0201095 EJT A0201096 SPC 4 A0201097* A0201098* TSBGIN EXECUTIVE SUBROUTINE USED TO INITIATE THE A0201099* ------ TASK PROCESSOR IF IT IS INACTIVE A0201100* A0201101* ENTRY CONDITIONS: Q = TSTASK ENTRY PARAMETER A0201102* A0201103 SPC 2 A0201104TSBGIN NOP 0 A0201105 SPC 1 A0201106 IIN 0 A0201107 LDA* (ATSACT) IS THE EXECUTIVE ACTIVE A0201108ÐÐ SAN TSB010 YES, RETURN A0201109 SPC 1 A0201110 RAO* (ATSACT) NO, ACTIVATE IT A0201111 LDA* TSBGIN OBTAIN THE RETURN ADDRESS A0201112 RTJ- (AVOLA) OBTAIN VOLATILE A0201113 ADC 3 A0201114 SPC 1 A0201115 RTJ- (AMONI) SCHEDULE THE TASK PROCESSOR A0201116 ADC $5204 A0201117 ADC TSTASK A0201118 SPC 1 A0201119 IIN 0 A0201120 RTJ- (AVOLR) RELEASE VOLATILE A0201121 STA* TSBGIN RESTORE THE RETURN ADDRESS A0201122 SPC 1 A0201123TSB010 EIN 0 A0201124 JMP* (TSBGIN) RETURN A0201125 SPC 2 A0201126ATSACT ADC TSACTV ITOS EXECUTIVE ACTIVE INDICATOR A0201127 EJT A0201128* A0201129* TSVFTN EXECUTIVE SUBROUTINE USED TO SAVE THE FORTRAN A0201130* ------ SCRATCH AREA ($C5-$E5) IN THE USER A0201131* LINKAGE BUFFER A0201132* A0201133ÐÐ* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0201134 SPC 2 A0201135TSVFTN NOP 0 A0201136 IIN 0 A0201137 SPC 1 A0201138 SFN+ CNTWAR,1,1 SKIP IF CONTROLWARE IS PRESENT A0201139 JMP* TSV010 NOT PRESENT A0201140 ENQ 0 A0201141 NUM $0830 A = SCIENTIFIC CONTROLWARE STATUS A0201142 STA- $C8 SAVE IN THE FORTRAN STATUS WORD A0201143 SPC 1 A0201144TSV010 ENQ $E5-$C5 A0201145 SPC 1 A0201146TSV020 LDA- $C5,Q MOVE LOCATIONS $C5 THROUGH $E5 A0201147 STA- RSC5E5,B TO THE USERS LINKAGE BUFFER A0201148 DQP *-TSV020 A0201149 SPC 1 A0201150 EIN 0 A0201151 JMP* (TSVFTN) RETURN A0201152 SPC 2 A0201153* A0201154* TSRFTN EXECUTIVE SUBROUTINE USED TO RESTORE THE A0201155* ------ FORTRAN SCRATCH AREA ($C5-$E5) A0201156* FROM THE USER LINKAGE BUFFER A0201157* A0201158ÐÐ* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0201159 SPC 2 A0201160TSRFTN NOP 0 A0201161 ENQ $E5-$C5 A0201162 SPC 1 A0201163TSR010 LDA- RSC5E5,B RESTORE LOCATIONS $C5 THRU $E5 A0201164 STA- $C5,Q FROM THE USERS LINKAGE BUFFER A0201165 DQP *-TSR010 A0201166 SPC 1 A0201167 LDA- $C8 A0201168 NUM $0830 RESTORE THE SCIENTIFIC CONTROLWARE STATUS A0201169 SPC 1 A0201170 JMP* (TSRFTN) RETURN A0201171 EJT A0201172 SPC 4 A0201173* A0201174* TSCLLB EXECUTIVE SUBROUTINE USED TO CLEAR THE USER A0201175* ------ LINKAGE BUFFER TO ZERO A0201176* A0201177* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0201178 SPC 2 A0201179TSCLLB NOP 0 A0201180 ENA 0 A0201181 LDQ =XLULBUF-1 A0201182 SPC 1 A0201183ÐÐTSL010 STA- (I),Q CLEAR THE BUFFER ENTRY A0201184 DQP *-TSL010 A0201185 SPC 1 A0201186 JMP* (TSCLLB) RETURN A0201187 SPC 2 A0201188APRTBL ADC PARTBL ADDRESS OF THE PARTITIONED MEMORY TABLE A0201189 EJT A0201190* TSCKPM EXECUTIVE SUBROUTINE WHICH DETERMINES IF AN A0201191* ------ ABSOLUTE MEMORY ADDRESS IS WITHIN A0201192* THE AREA ASSIGNED TO THE USER A0201193* A0201194* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0201195* Q = ADDR. TO BE CHECKED A0201196* A0201197* EXIT CONDITIONS: Q = VALUE AT ENTRY A0201198* A = VALUE AT ENTRY A0201199* RETURN = P+1 IF ADDRESS ILLEGAL A0201200* RETURN = P+2 IF ADDRESS LEGAL A0201201 SPC 2 A0201202TSCKPM NOP 0 A0201203 IIN 0 A0201204 STQ- TEMPQR,I SAVE REGISTERS A0201205 STA- TEMPAR,I A0201206 LDQ* APRTBL A0201207 LDA- 1,Q A0201208ÐÐ INA ENDPRO A0201209 RTJ* COMPAR IS THE ADDRESS ABOVE THE START A0201210 SAP CKP010 NO, THIS IS AN ERROR A0201211 LDA- RSUB,I OBTAIN THE UPPER PROTECT BOUNDS A0201212 INA -1 A0201213 RTJ* COMPAR IS THE ADDRESS BELOW THE END OF THE AREA A0201214 SAM CKP010 NO, THIS IS AN ERROR A0201215 RAO* TSCKPM ADDRESS IS VALID, RETURN TO P+2 A0201216CKP010 LDA- TEMPAR,I RESTORE THE REGISTERS A0201217 LDQ- TEMPQR,I A0201218 EIN 0 A0201219 JMP* (TSCKPM) RETURN A0201220 SPC 2 A0201221* A0201222* COMPAR TSSUBR SUBROUTINE TO COMPARE 16-BIT ADDRESSES A0201223* ------ A0201224* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0201225* A = REFERENCE ADDRESS A0201226* (TEMPQR) = ADDRESS TO COMPARE A0201227* A0201228* EXIT CONDITIONS: A = + IF REF. >,= TEMPQR A0201229* A = - IF REF. < TEMPQR A0201230 SPC 2 A0201231COMPAR NOP 0 A0201232 EOR- TEMPQR,I ARE THE SIGNS ALIKE A0201233ÐÐ SAP COM010 YES A0201234 LDA- TEMPQR,I NO, THE SIGN OF TEMPQR GIVES THE RELATIONSHIP A0201235 JMP* (COMPAR) RETURN A0201236 SPC 1 A0201237COM010 EOR- TEMPQR,I RESTORE THE REFERENCE ADDRESS A0201238 SUB- TEMPQR,I DETERMINE THE RELATIONSHIP A0201239 JMP* (COMPAR) AND RETURN A0201240 EJT A0201241* A0201242* TSPMCK EXECUTIVE SUBROUTINE USED TO VERIFY THAT THE A0201243* ------ NEXT PARAMETER ADDRESS IS WITHIN A0201244* THE USER AREA A0201245* A0201246* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0201247* A0201248* EXIT CONDITIONS: Q = PARAMETER VALUE A0201249 SPC 2 A0201250TSPMCK NOP 0 A0201251 LDQ- PARADD,I A0201252 LDQ- (ZERO),Q OBTAIN THE NEXT PARAMETER VALUE A0201253 RTJ* TSCKPM IS IT WITHIN THE USER AREA A0201254 JMP* PMC010 NO, INDICATE AN ERROR A0201255 JMP* (TSPMCK) YES, RETURN A0201256 SPC 1 A0201257PMC010 ENQ E06 ILLEGAL REQUEST PARAMETER A0201258ÐÐ LDA- PARADD,I OBTAIN THE ADDRESS OF THE ERROR A0201259 JMP+ TSXERR PROCESS THE ERROR MESSAGE A0201260 SPC 2 A0201261* A0201262* TSCKMU TSSUBR SUBROUTINE USED TO VERIFY THAT AN A0201263* ------ ABSOLUTE MEMORY ADDRESS IS WITHIN A A0201264* MULTI-USER ROOT PROGRAM AREA A0201265* A0201266* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0201267* Q = ADDRESS TO BE CHECKED A0201268* A0201269* EXIT CONDITIONS: Q = VALUE AT ENTRY A0201270* A = VALUE AT ENTRY A0201271* RETURN = P+1 IF ADDRESS ILLEGAL A0201272* RETURN = P+2 IF ADDRESS LEGAL A0201273 SPC 2 A0201274TSCKMU NOP 0 A0201275 STQ- TEMPQR,I SAVE REGISTERS A0201276 STA- TEMPAR,I A0201277 LDQ- ULUSTB,I A0201278 LDA- TSMUTB,Q IS THE PROGRAM A MULTI-USER ROOT A0201279 SAZ CKM010 NO, RETURN A0201280 LDA+ TSAREA YES A0201281 ADD- PGMSIZ,Q CALCULATE THE LWA-1 OF THE ROOT A0201282 INA -1 A0201283ÐÐ RTJ* COMPAR IS THE ADDRRSS WITHIN THE ROOT AREA A0201284 SAM CKM020 NO, ERROR A0201285CKM010 RAO* TSCKMU YES, RETURN TO P+2 A0201286CKM020 LDQ- TEMPQR,I RESTORE REGISTERS A0201287 LDA- TEMPAR,I A0201288 JMP* (TSCKMU) RETURN A0201289 SPC 2 A0201290 END A0201291 NAM TSPROT A03 A ITOS CCS 3.0 SL-149A0300001* USER PROGRAM PROTECT PROCESSOR A0300002* CREDIT COLLECTION SYSTEM VERSION 3.0 A0300003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A0300004* COPYRIGHT CONTROL DATA CORPORATION 1979 A0300005* A0300006 SPC 2 A0300007* THIS PROGRAM PERFORMS THE FOLLOWING FUNCTIONS - A0300008* A0300009* 1. ITOS USER PROTECT PROCESSING. A0300010* A0300011* ESTABLISHES THE LEGALITY OF ALL USER PROGRAM PROTECT A0300012* VIOLATIONS, AND INITIATES ERROR MESSAGES WHEN ERRORS OCCUR. A0300013* A0300014* 2. ITOS USER PROGRAM REQUEST PROCESSING. A0300015* A0300016* PROVIDES AN INTERFACE BETWEEN THE USER PROGRAM AND THE A0300017ÐÐ* MONITOR, FILE MANAGER, AND VARIOUS OTHER MONITOR FUNCTIONS. A0300018* ALSO PERFORMS THE INPUT / OUTPUT BUFFERING OF ALL USER A0300019* I/O REQUESTS. A0300020 SPC 2 A0300021* I T O S E N T R Y P O I N T S A0300022 SPC 1 A0300023 ENT TSIPRC ITOS LINE 0 INTERRUPT ENTRY A0300024 ENT WTREAD USER FUNCTION WRITE-READ REQUEST A0300025 ENT UNPTBL UNPROTECTED ENTRY POINT LIST A0300026 EJT A0300027 SPC 4 A0300028* I T O S E X T E R N A L S A0300029 SPC 1 A0300030 EXT TSAREA ADDRESS OF THE USERS LINKAGE BUFFER A0300031 EXT TSTASK ITOS EXECUTIVE TASK PROCESSOR A0300032 EXT TSURTN RETURN TO USER PROGRAM (TSTASK) A0300033 EXT TSIOC1 TMNL. I/O COMPLETION ADDRESS (TSIOCP) A0300034 EXT TSIOC2 M. M. I/O COMPLETION ADDRESS (TSIOCP) A0300035 EXT TSFMCP FILE RQST. COMPLETION ADDRESS (TSIOCP) A0300036 EXT TERMLU COMMUNICATIONS CONTROLLER LOGICAL UNIT A0300037 EXT TSACTV ITOS ACTIVE INDICATOR A0300038 EXT TSMFLG MASS MEMORY ERROR INDICATOR A0300039 EXT TSCLOK TIMESLICE CLOCK HANDLER A0300040 EXT CCP CURRENT CONTROL POINT A0300041 EXT EXTREG EXTENDED REGISTER SAVE ROUTINE A0300042ÐÐ EXT TSVFTN FORTRAN AREA SAVE ROUTINE A0300043 EXT ONNSWP NSWP QUEUE ENTRY A0300044 EXT PGMIN USER FUNCTION INITIALIZATION ROUTINE A0300045 EXT TSPMIN INITIALIZATION ROUTINE PROCESSOR A0300046 EXT PGMINT USER FUNCTION MANUAL INTERRUPT ROUTINE A0300047 EXT TSINTR MANUAL INTERRUPT PROCESSOR A0300048 EXT PGLUNT USER I/O DEVICE SPECIFICATION ROUTINE A0300049 EXT TSLUNT DEVICE SPECIFICATION PROCESSOR A0300050 EXT SLICUP MULTI-USER TIMESLICE COMPLETION ROUTINE A0300051 EXT TSLCUP TIMESLICE COMPLETION PROCESSOR A0300052 EXT ATTACH MULTI-USER ROOT ATTACHMENT ROUTINE A0300053 EXT TSATTC ATTACH REQUEST PROCESSOR A0300054 EXT CHAIN USER PROGRAM CHAIN ROUTINE A0300055 EXT TSCHAN PROGRAM CHAIN REQUEST PROCESSOR A0300056 EXT PGMOUT USER FUNCTION EXIT ROUTINE A0300057 EXT TSEXIT EXIT REQUEST PROCESSOR A0300058 EXT TSXERR EXECUTIVE ERROR MESSAGE PROCESSOR A0300059 EXT TSCKPM PARAMETER VERIFICATION ROUTINE A0300060 EXT TSCKMU PARAMETER VERIFICATION ROUTINE A0300061 EXT TSPMCK PARAMETER PICKUP AND VERIFICATION ROUTINE A0300062 EXT WKSTAT WORKSTATION PROCESSOR TABLE A0300063 EJT A0300064 SPC 4 A0300065* S Y S T E M E X T E R N A L S A0300066 SPC 1 A0300067ÐÐ EXT LOG1A PHYSTB ADDRESS TABLE A0300068 EXT MMLUTB MASS MEMORY UNIT TABLE A0300069 EXT MONI MSOS MONITOR ENTRY A0300070 EXT PRO NIPROC - BACKGROUND PROTECT PROCESSOR A0300071 EXT PTYERR NIPROC - PARITY ERROR PROCESSOR A0300072 EXT PWFAIL NIPROC - POWER FAILURE PROCESSOR A0300073 EXT SYFAIL SYSTEM FAILURE PROCESSOR A0300074 EXT FMEXEC FILE MANAGER EXECUTIVE ENTRY A0300075 EXT PROMTR TERMINAL INPUT PROMPTER CHARACTER A0300076 EXT MOV DATA TRANSFER ROUTINE A0300077 EJT A0300078* E Q U I V A L E N C E S A0300079 SPC 1 A0300080 EQU LPMASK($2) BIT MASK TABLE A0300081 EQU ZERO($22) LOCATION CONTAINING ZERO A0300082 EQU NZERO($12) NEGATIVE ZERO TABLE A0300083 EQU ONEBIT($23) SINGLE BIT TABLE A0300084 EQU ALUABS($BC) ADDRESS OF REQUEST L.U. ABSOLUTIZING A0300085 EQU AEXTAB($E9) ADDRESS OF THE EXTENDED CORE TABLE A0300086 EQU ADISP($EA) ADDRESS OF DISPATCHER A0300087 EQU PRILVL($EF) SYSTEM PRIORITY LEVEL A0300088 EQU AMONI($F4) ADDRESS OF MONITOR REQUEST ENTRY A0300089 EQU EREQST(8) STD. P.D.T REQUEST STATUS A0300090 EQU ELSTWD(11) STD. P.D.T. LAST WORD + 1 A0300091 EQU ESTAT2(12) STD. P.D.T. DEVICE STATUS A0300092ÐÐ EQU AFMEXC(30) ADDRESS OF THE FILE MANAGER EXECUTIVE A0300093 EQU QPL4(4) QUEUE PRIORITY = 4 A0300094 EQU QPL3(3) QUEUE PRIORITY = 3 A0300095 EQU QPL2(2) QUEUE PRIORITY = 2 A0300096 EQU QPL1(1) QUEUE PRIORITY = 1 A0300097 SPC 2 A0300098* E R R O R M E S S A G E C O D E S A0300099 SPC 1 A0300100 EQU E01(01) PROGRAM PROTECT VIOLATION A0300101 EQU E03(03) ILLEGAL FILE REQUEST A0300102 EQU E04(04) ILLEGAL FILE REQUEST PARAMETER A0300103 EQU E05(05) ILLEGAL MONITOR REQUEST A0300104 EQU E06(06) ILLEGAL REQUEST PARAMETER A0300105 EQU E07(07) ILLEGAL MONITOR REQUEST LOGICAL UNIT A0300106 EQU E08(08) ATTEMPT TO STACK I/O REQUESTS A0300107 EJT A0300108 SPC 4 A0300109* F I L E M A N A G E R E Q U I V A L E N C E S A0300110* A0300111* FILE REQUEST BUFFER A0300112* A0300113 EQU CNTLPT(02) FILE REQUEST CONTROL POINT A0300114 EQU RQINFO(03) FILE REQUEST INFORMATION A0300115 EQU PARLST(06) FILE REQUEST PARAMETER LIST ADDRESS A0300116 EQU UCTADR(07) FILE REQUEST USER CONTROL ADDRESS A0300117ÐÐ EQU FMUSER(08) FILE REQUEST USER IDENTIFICATION A0300118 EQU FCBADR(09) FILE CONTROL BLOCK ADDRESS A0300119 EQU FCBBLN(12) FCB BUFFER LENGTH A0300120 EQU LOKREC(12) RECORD BLOCKING FACTOR A0300121 EQU USEFLG(13) FILE USE INDICATOR A0300122 EQU RRNMSB(17) RELATIVE RECORD NUMBER -MSB A0300123 EQU RRNLSB(18) RELATIVE RECORD NUMBER -LSB A0300124 EQU FRQLEN(24) FILE REQUEST BUFFER LENGTH A0300125* A0300126* FILE CONTROL BLOCK A0300127* A0300128 EQU FILEID(ZERO) FILE IDENTIFIER A0300129 EQU RECLEN(05) FILE RECORD LENGTH (WORDS) A0300130 EQU FCBIND(10) FILE CONTROL INDICATORS A0300131 EQU LENKY1(19) LENGTH OF KEY 1 A0300132 EQU LENKY2(21) LENGTH OF KEY 2 A0300133 EQU LENKY3(23) LENGTH OF KEY 3 A0300134 EQU LENKY4(25) LENGTH OF KEY 4 A0300135 EQU FCBLN1(15) FILE CONTROL BLOCK LENGTH (SEQ. FILE) 127*5175A0300136 EQU FCBLN2(27) FILE CONTROL BLOCK LENGTH (INDEXED FILE) A0300137* A0300138* VOLUME INFORMATION TABLE A0300139* A0300140 EQU VIWPS(13) WORDS / SECTOR FOR VOLUME A0300141 EJT A0300142ÐÐ SPC 4 A0300143* M U L T I - U S E R P R O G R A M T A B L E E N T R I E S A0300144 SPC 1 A0300145 EQU MUROOT(ZERO) ASSOCIATED ROOT TABLE ADDRESS A0300146 EQU MUSRID(01) PROGRAM IDENTIFICATION - 4 WORDS ASCII A0300147 EQU MUSIZE(05) PROGRAM LENGTH (WORDS) A0300148 EQU MUSECT(06) PROGRAM SECTOR ADDRESS - 2 WORDS A0300149 EQU MUPAGE(08) PROGRAM BASE MEMORY PAGE NUMBER A0300150 EQU ACROOT(09) PROGRAM ACTIVE ROOT COUNT A0300151 EQU MURSIZ(10) PROGRAM TRUE LENGTH (WORDS) A0300152 EQU MUEXTH(11) PROGRAM EXECUTION THREAD A0300153 EQU MURSTX(13) PROGRAM STATE INDEX A0300154 EQU MURCLK(15) PROGRAM CLOCK VALUE A0300155 EQU MUITEM(MURCLK+1) A0300156 SPC 2 A0300157* U S E R P R O G R A M U S E R T A B L E E N T R I E S A0300158 SPC 1 A0300159 EQU TSIOTB(ZERO) ASSOCIATED I/O TABLE ADDRESS A0300160 EQU USERID(01) USER IDENTIFICATION - 4 WORDS ASCII A0300161 EQU PGMSIZ(05) USER PROGRAM LENGTH (WORDS) A0300162 EQU PGMSEC(06) USER PROGRAM SECTOR - 2 WORDS A0300163 EQU TWNSEC(08) SWAP TWIN SECTOR - 2 WORDS A0300164 EQU SWPBLK(10) USER SWAP BLOCK BYTES A0300165 EQU NEXETH(11) USER EXECUTION THREAD A0300166 EQU NSWPTH(12) USER SWAP THREAD A0300167ÐÐ EQU USRSTX(13) USER STATE INDEX A0300168 EQU TSMUTB(14) MULTI USER TABLE ADDRESS A0300169 EQU NUMREQ(15) USER REQUEST COUNT A0300170 EQU USRITM(NUMREQ+1) A0300171 EJT A0300172 SPC 4 A0300173* U S E R P R O G R A M S T A T E I N D I C E S A0300174 SPC 1 A0300175 EQU SXCACT(01) EXECUTING IN MAIN MEMORY A0300176 EQU SXCTSL(02) SUSPENDED IN MAIN MEMORY-TIMESLICE COMPLETE A0300177 EQU SXCMMA(03) SUSPENDED IN MAIN MEMORY-M.M. I/O ACTIVE A0300178 EQU SXCMMC(04) SUSPENDED IN MAIN MEMORY-M.M. I/O COMPLETE A0300179 EQU SXCFMA(05) SUSPENDED IN MAIN MEMORY-FILE I/O ACTIVE A0300180 EQU SXCFMC(06) SUSPENDED IN MAIN MEMORY-FILE I/O COMPLETE A0300181 EQU SXCTMA(07) SUSPENDED IN MAIN MEMORY-TMNL I/O ACTIVE A0300182 EQU SXCTMC(08) SUSPENDED IN MAIN MEMORY-TMNL I/O COMPLETE A0300183 EQU SXCDTA(09) SUSPENDED IN MAIN MEMORY-DATA I/O ACTIVE A0300184 EQU SXCDTC(10) SUSPENDED IN MAIN MEMORY-DATA I/O COMPLETE A0300185 EQU SXCATA(11) SUSPENDED IN MAIN MEMORY-ATTACH ACTIVE A0300186 EQU SXCATC(12) SUSPENDED IN MAIN MEMORY-ATTACH COMPLETE A0300187* A0300188 EQU SXMASS(13) RESERVED A0300189 EQU SXMTSL(14) SWAPPED ON MASS MEMORY-TIMESLICE COMPLETE A0300190 EQU SXM015(15) RESERVED A0300191 EQU SXMMMC(16) SWAPPED ON MASS MEMORY-M.M. I/O COMPLETE A0300192ÐÐ EQU SXM017(17) RESERVED A0300193 EQU SXMFMC(18) SWAPPED ON MASS MEMORY-FILE I/O COMPLETE A0300194 EQU SXMTMA(19) SWAPPED ON MASS MEMORY-TMNL I/O ACTIVE A0300195 EQU SXMTMC(20) SWAPPED ON MASS MEMORY-TMNL I/O COMPLETE A0300196 EQU SXMDTA(21) SWAPPED ON MASS MEMORY-DATA I/O ACTIVE A0300197 EQU SXMDTC(22) SWAPPED ON MASS MEMORY-DATA I/O COMPLETE A0300198 EQU SXMATA(23) SWAPPED ON MASS MEMORY-ATTACH ACTIVE A0300199 EQU SXM024(24) RESERVED A0300200* A0300201 EQU SXMUSA(25) SUSPENDED ON MASS MEMORY-UNSWAP ACTIVE A0300202 EQU SXCUSC(26) SUSPENDED IN MAIN MEMORY-UNSWAP COMPLETE A0300203 EQU SXMMUR(27) SUSPENDED ON MASS MEMORY-MULTIUSER READ A0300204 EQU SXMLOG(28) SUSPENDED ON MASS MEMORY-INITIAL LOGIN A0300205 EQU SXMJOB(29) SUSPENDED ON MASS MEMORY-JOB STEP A0300206 SPC 2 A0300207* NOTE - BIT 15 = 1 WHILE THE USER IS BEING SWAPPED A0300208 EJT A0300209 SPC 4 A0300210* U S E R P R O G R A M I / O T A B L E E N T R I E S A0300211 SPC 1 A0300212 EQU TSUSTB(ZERO) ASSOCIATED USER TABLE ADDRESS A0300213 EQU FRQBUF(01) FILE REQUEST BUFFER HEADER (4 WORDS) A0300214 EQU IORQCD(05) INPUT/OUTPUT REQUEST CODE A0300215 EQU IORQCA(06) INPUT/OUTPUT COMPLETION ADDRESS A0300216 EQU IORQTH(07) INPUT/OUTPUT THREAD WORD A0300217ÐÐ EQU IORQLU(08) INPUT/OUTPUT LOGICAL UNIT A0300218 EQU IOMSLN(09) INPUT/OUTPUT MESSAGE LENGTH A0300219 EQU IOBFAD(10) INPUT/OUTPUT MESSAGE BUFFER ADDRESS A0300220 EQU IOMMSB(11) INPUT/OUTPUT MASS MEMORY ADDRESS A0300221 EQU IOMLSB(12) INPUT/OUTPUT MASS MEMORY ADDRESS A0300222 EQU IOCNPT(13) INPUT/OUTPUT CONTROL POINT A0300223 EQU IOSTAT(14) INPUT/OUTPUT STATUS WORD A0300224 EQU TERMBF(15) TERMINAL MESSAGE BUFFER ADDRESS A0300225 EQU IOITEM(TERMBF+1) A0300226 SPC 2 A0300227* USER PROGRAM I/O STATUS INDICATORS A0300228 SPC 1 A0300229* UNSOLICITED INPUT GROUP A0300230 EQU LI(00) TERMINAL LOG-IN A0300231 EQU MN(01) TERMINAL MANUAL INTERRUPT A0300232 EQU ES(02) TERMINAL ESCAPE A0300233* INPUT-OUTPUT ERROR GROUP A0300234 EQU DS(04) TERMINAL DISCONNECT A0300235 EQU ME(05) MASS MEMORY ERROR A0300236 EQU FE(06) FILE REQUEST ERROR A0300237* REQUEST TYPE GROUP A0300238 EQU IN(08) DATA INPUT REQUEST A0300239 EQU IA(09) INPUT / OUTPUT ACTIVE A0300240 EQU IC(10) INPUT / OUTPUT COMPLETE A0300241 EQU MM(11) MASS MEMORY I/O REQUEST A0300242ÐÐ EQU TI(12) TERMINAL I/O REQUEST A0300243* TERMINAL CHARACTERISTIC GROUP A0300244* A0300245 EQU DY(TI+1) END OF THE DYNAMIC STATUS GROUP A0300246 EJT A0300247* U S E R L I N K A G E B U F F E R E N T R I E S A0300248* A0300249* THE USER LINKAGE BUFFER IMMEDIATELY PRECEEDS THE USER PROGRAM A0300250 SPC 2 A0300251 EQU LASTEP(ZERO) LAST ENTRY TO THE USER PROGRAM A0300252 EQU ULIOTB(001) USERS I/O TABLE ADDRESS A0300253 EQU ULUSTB(002) USERS USER TABLE ADDRESS A0300254 EQU RSCLOK(003) USERS REMAINING TIMESLICE A0300255 EQU FALADD(004) PROTECT FAULT ADDRESS A0300256 EQU PARADD(005) CURRENT PARAMETER ADDRESS A0300257 EQU RSP(006) P-REGISTER STORAGE A0300258 EQU RSA(007) A-REGISTER STORAGE A0300259 EQU RSQ(008) Q-REGISTER STORAGE A0300260 EQU RSI(009) I-REGISTER STORAGE A0300261 EQU RSL(010) OVERFLOW STORAGE A0300262 EQU RS1(011) 1-REGISTER STORAGE A0300263 EQU RS2(012) 2-REGISTER STORAGE A0300264 EQU RS3(013) 3-REGISTER STORAGE A0300265 EQU RS4(014) 4-REGISTER STORAGE A0300266 EQU RSUB(015) UPPER BOUNDS REGISTER STORAGE A0300267ÐÐ EQU RSIORC(016) MONITOR I/O REQUEST CODE A0300268 EQU RSIOCA(017) COMPLETION ADDRESS A0300269 EQU RSIOTH(018) REQUEST THREAD A0300270 EQU RSIOLU(019) MODE + LOGICAL UNIT A0300271 EQU RSIOLN(020) LENGTH A0300272 EQU RSIOSA(021) STARTING ADDRESS A0300273 EQU RSIOMS(022) MASS MEMORY ADDRESS - MSB A0300274 EQU RSIOLS(023) MASS MEMORY ADDRESS - LSB A0300275 EQU RSIOCP(024) MONITOR REQUEST CONTROL POINT A0300276 EQU RQTYPE(025) MONITOR REQUEST TYPE INDEX A0300277 EQU RQCLAS(026) MONITOR REQUEST DEVICE CLASS CODE A0300278 EQU RQMODE(027) MONITOR REQUEST CHARACTER MODE INDICATOR A0300279 EQU REQLUN(028) MONITOR REQUEST LOGICAL UNIT A0300280 EQU RSCPAD(029) USERS MONITOR REQUEST COMPLETION ADDRESS A0300281 EQU RSUSLN(030) USERS MONITOR REQUEST MESSAGE LENGTH A0300282 EQU RSUSBF(031) USERS MONITOR REQUEST MESSAGE ADDRESS A0300283 EQU PORTNO(032) MONITOR REQUEST COMMUNICATIONS PORT NUMBER A0300284 EQU RSBHDR(032) MONITOR REQUEST MESSAGE HEADER - 6 WORDS A0300285 EQU WROUTP(038) WRITE-READ USERS OUTPUT LOGICAL UNIT A0300286 EQU WRILEN(039) WRITE-READ INPUT BUFFER LENGTH A0300287 EQU WRIBUF(040) WRITE-READ INPUT BUFFER ADDRESS A0300288 EQU WRTCAD(041) WRITE-READ TERMINATION CODE ADDRESS A0300289 EQU PMCNTR(042) REQUEST PARAMETER COUNT A0300290 EQU RSCARG(043) USERS MONITOR REQUEST COMPLETION A-REGISTER A0300291 EQU RQINPT(044) USERS INPUT LOGICAL UNIT A0300292ÐÐ EQU RQOUTP(045) USERS OUTPUT LOGICAL UNIT A0300293 EQU RQUN01(046) USERS SPARE LOGICAL UNIT A0300294 EQU RQUN02(047) USERS SPARE LOGICAL UNIT A0300295 EJT A0300296 SPC 4 A0300297* U S E R L I N K A G E B U F F E R E N T R I E S A0300298 SPC 2 A0300299 EQU ERRIDX(048) ERROR MESSAGE INDEX A0300300 EQU ERRADD(049) ERROR MESSAGE ADDRESS A0300301 EQU USRPGM(050) CURRENT USER PROGRAM INDEX A0300302 EQU PGMIDX(051) LOG-IN PROCESSOR PROGRAM INDEX A0300303 EQU INTADD(052) PGMINT REQUEST INTERRUPT ADDRESS A0300304 EQU INTFLG(053) PGMINT REQUEST INTERRUPT FLAG ADDRESS A0300305 EQU ATTADR(054) ATTACH REQUEST COMPLETION ADDRESS A0300306 EQU LUNERR(055) ILLEGAL LOGICAL UNIT ERROR ADDRESS A0300307 EQU FMINDX(056) FILE REQUEST TYPE INDEX A0300308 EQU SPARE0(057) SPARE ENTRY A0300309 EQU DATIME(058) DATE AND TIME FOR DAYFILE ENTRY - 6 WORDS A0300310 EQU FRQBFA(064) FILE REQUEST BUFFER ADDRESS A0300311 EQU FILREQ(065) USER DECLARED FILE REQUEST INDICATOR A0300312 EQU FMPMTR(066) FILE REQUEST PARAMETER LIST - 5 WORDS A0300313 EQU CHNAME(071) CHAIN REQUEST PROGRAM NAME - 4 WORDS A0300314 EQU MUFWAD(075) FIRST WORD ADDRESS OF THE MULTI-USER PROGRAM A0300315 EQU TEMPQR(076) TEMPORARY STORAGE - Q REGISTER A0300316 EQU TEMPAR(077) TEMPORARY STORAGE - A REGISTER A0300317ÐÐ EQU RSC5E5(078) FORTRAN SCRATCH AREA STORAGE - 33 WORDS A0300318 EQU SPARE1(111) SPARE ENTRY A0300319 EQU ENDPRO(111) END OF THE PROTECTED LINKAGE BUFFER AREA A0300320* A0300321 EQU UFPARM(112) USER DECLARED FILE REQUEST PARAMETERS A0300322 EQU FISTAT(128) USER DECLARED FILE REQUEST STATUS A0300323 EQU PFNAME(129) CURRENT PROCEDURE FILE NAME - 4 WORDS A0300324 EQU MENUKY(133) REQUESTED FUNCTION MENU KEY A0300325 EQU USABRT(134) USER PROGRAM ABORT INDICATOR A0300326 EQU USMODE(135) USER EXECUTION MODE INDICATOR A0300327 EQU TMPGMX(136) TEMPORARY - PROGRAM INDEX A0300328 EQU TMSECT(137) TEMPORARY - PROGRAM SECTOR - 2 WORDS A0300329 EQU TMPLEN(139) TEMPORARY - PROGRAM LENGTH A0300330 EQU TMUSID(140) TEMPORARY - USER IDENTIFICATION - 4 WORDS A0300331 EQU IREQBF(144) INPUT FILE REQUEST BUFFER AND FCB A0300332 EQU FINAME(188) INPUT FILE NAME - 4 WORDS A0300333 EQU OREQBF(192) OUTPUT FILE REQUEST BUFFER AND FCB A0300334 EQU FONAME(236) OUTPUT FILE NAME - 4 WORDS A0300335 EQU FIRCNO(240) INPUT FILE RECORD NUMBER - 2 WORDS A0300336 EQU LULBUF(256) LENGTH OF THE LINKAGE BUFFER A0300337 EJT A0300338 SPC 2 A0300339* P R O T E C T I N T E R R U P T P R O C E S S O R A0300340 SPC 2 A0300341* THIS ROUTINE IS ENTERED VIA THE LINE 0 INTERRUPT TRAP. A0300342ÐÐ* IF THE PROTECT VIOLATION WAS CAUSED BY AN ITOS USER PROGRAM A0300343* (AS INDICATED BY A PRIORITY LEVEL = 4), CONTROL IS PASSED TO THE A0300344* ITOS PROTECT PROCESSOR. OTHERWISE, CONTROL IS PASSED TO A0300345* THE LINE 0 INTERRUPT PROCESSOR (NIPROC). A0300346 SPC 2 A0300347TSIPRC NOP 0 A0300348 SPF PIP020 A PROTECT VIOLATION HAS OCCURED A0300349 SPE PIP010 A PARITY ERROR HAS OCCURED A0300350 JMP+ PWFAIL IF NEITHER, ASSUME A POWER FAIL INTERRUPT A0300351PIP010 JMP+ PTYERR PASS CONTROL TO THE PARITY ERROR PROCESSOR A0300352 SPC 1 A0300353PIP020 STA* TEMP1 SAVE THE A-REGISTER A0300354 LDA- PRILVL A0300355 INA -4 DOES THE PRIORITY = THE ITOS USER LEVEL A0300356 SAZ PIP030 YES, CONTINUE A0300357 LDA* TEMP1 NO, RESTORE THE A-REGISTER A0300358 JMP+ PRO PASS CONTROL TO NIPROC A0300359PIP030 LDA+ TSACTV IS THE ITOS SYSTEM ACTIVE A0300360 SAN PIP035 YES A0300361 RTJ+ SYFAIL NO, FATAL SYSTEM ERROR A0300362 SPC 1 A0300363PIP035 LDA+ TSMFLG HAS A MASS MEMORY ERROR BEEN DETECTED A0300364 SAZ PIP040 NO, CONTINUE A0300365 JMP- (ADISP) YES, DO NOT PROCESS THE REQUEST A0300366 EJT A0300367ÐÐ SPC 4 A0300368********************************************************************** A0300369* * A0300370* SAVE ALL NECESSARY REGISTERS, INDICATORS AND LOCATIONS * A0300371* * A0300372********************************************************************** A0300373 SPC 2 A0300374PIP040 LDA- I SAVE THE I-REGISTER A0300375 STA* TEMP2 A0300376 LDA+ TSAREA SET I = ADDRESS OF USERS LINKAGE BUFFER A0300377 STA- I A0300378 STQ- RSQ,I Q A0300379 LDA* TEMP1 A0300380 STA- RSA,I A - SAVE REGISTERS IN USER LINKAGE BUFFER A0300381 LDA* TEMP2 A0300382 STA- RSI,I I A0300383 LDA- PRILVL A0300384 SNO PIP050 A0300385 EOR- ONEBIT+15 A0300386PIP050 STA- RSL,I PRIORITY + OVERFLOW A0300387 LDA- (ONEBIT+8) OBTAIN THE ADDRESS OF THE PROTECT FAULT A0300388 INA -2 A0300389 STA* FAULT SAVE ($100)-2 A0300390 LDA* (FAULT) A0300391 STA- FALADD,I SAVE (($100)-2) = FAULT ORIGINATION A0300392ÐÐ STA- PARADD,I INITIALIZE THE PARAMETER ADDRESS A0300393 SPC 1 A0300394 ENA -1 DISABLE THE TIMESLICE CLOCK A0300395 RTJ+ TSCLOK A0300396 EIN 0 RESTORE INTERRUPTS A0300397 STA- RSCLOK,I SAVE THE REMAINING TIMESLICE A0300398 SPC 1 A0300399 ENQ 0 FETCH AND SAVE THE EXTENDED REGISTERS A0300400 RTJ+ EXTREG A0300401 RTJ+ TSVFTN SAVE THE USERS FORTRAN SCRATCH AREA A0300402 EJT A0300403 SPC 4 A0300404 LDA* CURPOS A0300405 STA- RSBHDR+4,I A0300406 SPC 1 A0300407 ENA -1 A0300408 STA- RSBHDR+5,I A0300409 SPC 1 A0300410 ENA 0 INITIALIZE THE TERMINAL I/O REQUEST HEADER A0300411 STA- RSBHDR+1,I A0300412 STA- RSBHDR+2,I A0300413 STA- RSBHDR+3,I A0300414 STA- PMCNTR,I INITIALIZE THE REQUEST PARAMETER COUNT A0300415 STA- WRTCAD,I INITIALIZE THE TERMINATION CODE ADDRESS A0300416 SPC 1 A0300417ÐÐ LDQ- USABRT,I HAS THE USER PROGRAM ABORTED A0300418 SQZ PIP055 NO A0300419 STA- USABRT,I YES, RETURN TO INTERACTIVE MODE A0300420 STA- USMODE,I A0300421 STA- RQINPT,I A0300422 STA- RQOUTP,I A0300423 STA- FIRCNO+1,I REWIND THE PROCEDURE FILE A0300424 EJT A0300425 SPC 4 A0300426********************************************************************** A0300427* * A0300428* DETERMINE THE SOURCE OF THE PROGRAM PROTECT INTERRUPT * A0300429* * A0300430********************************************************************** A0300431 SPC 1 A0300432PIP055 ENQ 0 WAS THE FAULT CAUSED BY AN ENTRY A0300433PIP060 LDA* UNPTBL+0,Q TO A LEGAL SYSTEM SUBROUTINE A0300434 INA 0 A0300435 SAZ PIP080 NO, SEARCH COMPLETE A0300436 SUB* FAULT A0300437 SAN PIP070 A0300438 TRQ A SAVE THE PROCESSOR INDEX A0300439 LDQ* UNPTBL+1,Q A0300440 JMP- (ZERO),Q PASS CONTROL TO THE INTERNAL PROCESSOR A0300441 SPC 1 A0300442ÐÐPIP070 INQ 2 NO, CONTINUE CHECKING A0300443 JMP* PIP060 A0300444 SPC 2 A0300445PIP080 LDA* FAULT A0300446 INA 1 WAS THE FAULT CAUSED BY AN ENTRY A0300447 SUB- ADISP TO THE DISPATCHER A0300448 SAN PIP090 A0300449 JMP* PPDISP YES, PASS CONTROL TO THE INTERNAL PROCESSOR A0300450 SPC 2 A0300451PIP090 ENQ E01 INDICATE A PROTECT VIOLATION A0300452 LDA* FAULT A0300453 INA 1 SET UP THE ADDRESS OF THE ERROR A0300454 JMP+ TSXERR PROCESS THE ERROR MESSAGE A0300455 EJT A0300456 SPC 4 A0300457* U S E R P R O G R A M P R O T E C T P R O C E S S O R A0300458* A0300459* E X I T V I A D I S P A T C H E R A0300460 SPC 2 A0300461PPDISP LDA- RSCPAD,I IS THERE A COMPLETION ADDRESS WAITING A0300462 SAN PPD010 YES A0300463 SPC 1 A0300464 JMP+ TSEXIT NO, RETURN TO THE EXECUTIVE A0300465 SPC 1 A0300466PPD010 STA- RSP,I SAVE THE COMPLETION ADDRESS A0300467ÐÐ LDA- RSCARG,I RETURN THE PARAMETER LIST ADDRESS A0300468 STA- RSA,I TO THE USER IN THE A-REGISTER A0300469 SPC 1 A0300470 LDA- FILREQ,I WAS THE LAST I/O REQUEST TO A FILE A0300471 SAN PPD030 YES A0300472 LDQ- ULIOTB,I NO, GET THE I/O DATA TABLE ADDRESS A0300473 LDA- IORQLU,Q A0300474 SPC 1 A0300475PPD020 STA- RSQ,I Q = THE I/O COMPLETION STATUS A0300476 ENA 0 A0300477 STA- RSCPAD,I CLEAR THE WAITING COMPLETION ADDRESS A0300478 JMP+ TSURTN AND RETURN TO THE USER A0300479 SPC 1 A0300480PPD030 LDQ- FISTAT,I OBTAIN THE FILE REQUEST STATUS A0300481 LDA- RSIOLU,I A0300482 SQP PPD040 SKIP IF NO FILE ERROR OCCURRED A0300483 ADD- NZERO+13 INDICATE AN ERROR A0300484PPD040 JMP* PPD020 CONTINUE A0300485 SPC 2 A0300486* P R O T E C T P R O C E S S O R D A T A A0300487* A0300488* A N D S T O R A G E A0300489 SPC 2 A0300490TEMP1 NUM 0 A-REGISTER STORAGE A0300491TEMP2 NUM 0 I-REGISTER STORAGE A0300492ÐÐFAULT NUM 0 PROTECT FAULT ADDRESS A0300493CURPOS ADC $1B31 CURSOR POSITION ESCAPE SEQUENCE A0300494 EJT A0300495* L E G A L S Y S T E M S U B R O U T I N E A0300496* A0300497* E N T R Y P O I N T S A0300498 SPC 2 A0300499********************************************************************** A0300500* * A0300501* THIS TABLE CONTAINS A LIST OF UNPROTECTED ENTRY POINT * A0300502* NAMES WHICH MAY BE LEGALLY ENTERED BY A USER PROGRAM * A0300503* * A0300504********************************************************************** A0300505 SPC 2 A0300506UNPTBL ADC MONI MSOS MONITOR REQUEST A0300507 ADC PPMONI INTERNAL PROCESSOR A0300508* A0300509 ADC WTREAD WRITE-READ REQUEST A0300510 ADC PPWTRD INTERNAL PROCESSOR A0300511* A0300512 ADC FMEXEC FILE MANAGER REQUEST A0300513 ADC PPFMGR INTERNAL PROCESSOR A0300514* A0300515 ADC SLICUP MULTI-USER TIMESLICE REQUEST A0300516 ADC TSLCUP EXTERNAL PROCESSOR A0300517ÐÐ* A0300518 ADC ATTACH MULTI-USER ROOT ATTACHMENT A0300519 ADC TSATTC EXTERNAL PROCESSOR A0300520* A0300521 ADC PGMIN USER FUNCTION INITIALIZATION ROUTINE A0300522 ADC TSPMIN EXTERNAL PROCESSOR A0300523* A0300524 ADC PGMINT USER FUNCTION MANUAL INTERRUPT ROUTINE A0300525 ADC TSINTR EXTERNAL PROCESSOR A0300526* A0300527 ADC PGMOUT USER FUNCTION EXIT ROUTINE A0300528 ADC TSEXIT EXTERNAL PROCESSOR A0300529* A0300530 ADC PGLUNT USER I/O DEVICE SELECTION A0300531 ADC TSLUNT EXTERNAL PROCESSOR A0300532* A0300533 ADC CHAIN PROGRAM CHAIN REQUEST A0300534 ADC TSCHAN EXTERNAL PROCESSOR A0300535* A0300536 ADC (-0) TABLE TERMINATOR A0300537 EJT A0300538 SPC 4 A0300539* F I L E M A N A G E R R E Q U E S T T A B L E S A0300540 SPC 2 A0300541* A0300542ÐÐ* FMTYPE TABLE OF PROCESSOR TABLE ADDRESSES, BASED A0300543* ------ FILE MANAGER REQUEST TYPE A0300544* A0300545 SPC 2 A0300546FMTYPE ADC FM00 00 - EXECUTIVE FUNCTIONS A0300547 ADC FM01 01 - CREATE FILE A0300548 ADC FM02 02 - CLEAR FILE A0300549 ADC FM03 03 - DELETE FILE A0300550 ADC FM04 04 - OPEN FILE A0300551 ADC FM05 05 - CLOSE FILE A0300552 ADC FM06 06 - LOCK FILE A0300553 ADC FM07 07 - UNLOCK FILE A0300554 ADC FM08 08 - GET FILE CONTROL BLOCK A0300555 ADC FM09 09 - UPDATE FILE CONTROL BLOCK A0300556 ADC FM10 10 - RENAME FILE A0300557 ADC FM11 11 - PUT SEQUENTIAL RECORD A0300558 ADC FM12 12 - WRITE INDEXED RECORD A0300559 ADC FM13 13 - READ RECORD RANDOMLY A0300560 ADC FM14 14 - GET SEQUENTIAL RECORD A0300561 ADC FM15 15 - STORE UPDATED RECORD A0300562 ADC FM16 16 - DELETE RECORD A0300563 ADC FM17 17 - COMPRESS FILE A0300564 ADC FM18 18 - VOLUME MAINTENENCE A0300565 ADC FM19 19 - REDUCE FILE SPACE A0300566 SPC 1 A0300567ÐÐ EQU FMTMAX(*-FMTYPE) A0300568 EJT A0300569 SPC 4 122*4859A0300570* A0300571* FM'NN' TABLE OF REQUEST PARAMETER PROCESSOR BYTES A0300572* ------ WHICH REFER TO SUB-PROCESSORS USED TO A0300573* VALIDATE THE PARAMETERS OF EACH FILE A0300574* REQUEST A0300575* A0300576 SPC 2 A0300577* EXECUTIVE FILE FUNCTIONS A0300578FM00 VFD X8/REQBUF,X8/REQLEN A0300579 VFD X8/REQCHK,X8/NOTLEN A0300580 VFD X8/ISTATS,X8/ISTLEN A0300581* CREATE FILE A0300582FM01 VFD X8/REQBUF,X8/REQLEN A0300583 VFD X8/IDATA1,X8/NOTLEN A0300584 VFD X8/USRNAM,X8/NOTLEN A0300585 VFD X8/ISTATS,X8/ISTLEN A0300586* CLEAR FILE A0300587FM02 VFD X8/REQBUF,X8/REQLEN A0300588 VFD X8/IDATA2,X8/ID1LEN A0300589 VFD X8/USRNAM,X8/NOTLEN A0300590 VFD X8/ISTATS,X8/ISTLEN A0300591* DELETE FILE A0300592ÐÐFM03 VFD X8/REQBUF,X8/REQLEN A0300593 VFD X8/IDATA2,X8/ID1LEN A0300594 VFD X8/USRNAM,X8/NOTLEN A0300595 VFD X8/ISTATS,X8/ISTLEN A0300596* OPEN FILE A0300597FM04 VFD X8/REQBUF,X8/REQLEN A0300598 VFD X8/USRIDN,X8/NOTLEN A0300599 VFD X8/IDATA2,X8/ID2LEN A0300600 VFD X8/USRNAM,X8/NOTLEN A0300601 VFD X8/FCBADD,X8/NOTLEN A0300602 VFD X8/ISTATS,X8/ISTLEN A0300603* CLOSE FILE A0300604FM05 VFD X8/REQBUF,X8/REQLEN A0300605 VFD X8/ISTATS,X8/ISTLEN A0300606* LOCK FILE A0300607FM06 VFD X8/REQBUF,X8/REQLEN A0300608 VFD X8/ISTATS,X8/ISTLEN A0300609* UNLOCK FILE A0300610FM07 VFD X8/REQBUF,X8/REQLEN A0300611 VFD X8/ISTATS,X8/ISTLEN A0300612* GET FILE CONTROL BLOCK A0300613FM08 VFD X8/REQBUF,X8/REQLEN A0300614 VFD X8/VOLNAM,X8/NOTLEN A0300615 VFD X8/FINDEX,X8/NOTLEN A0300616 VFD X8/FCBBF1,X8/FCBLEN A0300617ÐÐ VFD X8/ISTATS,X8/ISTLEN A0300618 EJT A0300619 SPC 4 122*4859A0300620* UPDATE FILE CONTROL BLOCK A0300621FM09 VFD X8/REQBUF,X8/REQLEN A0300622 VFD X8/VOLNAM,X8/NOTLEN A0300623 VFD X8/FINDEX,X8/NOTLEN A0300624 VFD X8/FCBBF2,X8/NOTLEN A0300625 VFD X8/ISTATS,X8/ISTLEN A0300626* RENAME FILE A0300627FM10 VFD X8/REQBUF,X8/REQLEN A0300628 VFD X8/IDATA2,X8/ID3LEN A0300629 VFD X8/USRNAM,X8/NOTLEN A0300630 VFD X8/NEWNAM,X8/NOTLEN A0300631 VFD X8/ISTATS,X8/ISTLEN A0300632* PUT SEQUENTIAL RECORD A0300633FM11 VFD X8/REQBUF,X8/REQLEN A0300634 VFD X8/RECBF1,X8/NOTLEN A0300635 VFD X8/NMRECS,X8/NOTLEN A0300636 VFD X8/ISTATS,X8/ISTLEN A0300637* WRITE INDEXED RECORD A0300638FM12 VFD X8/REQBUF,X8/REQLEN A0300639 VFD X8/RECBF2,X8/NOTLEN A0300640 VFD X8/KYVAL1,X8/NOTLEN A0300641 VFD X8/ISTATS,X8/ISTLEN A0300642ÐÐ* READ RECORD RANDOMLY A0300643FM13 VFD X8/REQBUF,X8/REQLEN A0300644 VFD X8/RECBF3,X8/NOTLEN A0300645 VFD X8/KYVAL1,X8/NOTLEN A0300646 VFD X8/ISTATS,X8/ISTLEN A0300647 EJT 122*4859A0300648 SPC 4 122*4859A0300649* GET SEQUENTIAL RECORD A0300650FM14 VFD X8/REQBUF,X8/REQLEN A0300651 VFD X8/RECBF4,X8/NOTLEN A0300652 VFD X8/KYVAL2,X8/NOTLEN A0300653 VFD X8/ISTATS,X8/ISTLEN A0300654* STORE UPDATED RECORD A0300655FM15 VFD X8/REQBUF,X8/REQLEN A0300656 VFD X8/RECBF6,X8/NOTLEN A0300657 VFD X8/ISTATS,X8/ISTLEN A0300658* DELETE RECORD A0300659FM16 VFD X8/REQBUF,X8/REQLEN A0300660 VFD X8/RECBF5,X8/NOTLEN A0300661 VFD X8/ISTATS,X8/ISTLEN A0300662* COMPRESS FILE A0300663FM17 VFD X8/REQBUF,X8/REQLEN A0300664 VFD X8/RECBF5,X8/NOTLEN A0300665 VFD X8/ISTATS,X8/ISTLEN A0300666* VOLUME MAINTENENCE A0300667ÐÐFM18 VFD X8/REQBUF,X8/REQLEN A0300668 VFD X8/VOLNAM,X8/NOTLEN A0300669 VFD X8/VOLUNT,X8/NOTLEN A0300670 VFD X8/ISTATS,X8/ISTLEN A0300671* REDUCE FILE SPACE A0300672FM19 VFD X8/REQBUF,X8/REQLEN A0300673 VFD X8/IDATA2,X8/ID4LEN A0300674 VFD X8/ISTATS,X8/ISTLEN A0300675 EJT A0300676 SPC 4 A0300677* A0300678* FMPROC TABLE OF FILE REQUEST PARAMETER PROCESSOR A0300679* ------ ADDRESSES. INDICES TO THIS TABLE ARE A0300680* CONTAINED IN THE BYTES SPECIFIED IN A0300681* THE FILE MANAGER REQUEST TABLE A0300682* A0300683 SPC 2 A0300684FMPROC ADC NOTCHK 00 - MOVE PARAMETER-NO VALIDATION A0300685 ADC RQBFCK 01 - FILE REQUEST BUFFER VALIDATION A0300686 ADC FMBFCK 02 - FILE DATA BUFFER VALIDATION A0300687 ADC STATCK 03 - FILE STATUS VALIDATION AND TERMINATION A0300688 ADC SETUSR 04 - SET UP FILE USER ID A0300689 ADC REC1CK 05 - FILE RECORD VALIDATION A0300690 ADC REC2CK 06 - FILE RECORD VALIDATION A0300691 ADC REC3CK 07 - FILE RECORD VALIDATION A0300692ÐÐ ADC REC4CK 08 - FILE RECORD VALIDATION A0300693 ADC REC5CK 09 - FILE RECORD VALIDATION A0300694 ADC KEYCHK 10 - FILE KEY VALIDATION A0300695 ADC OWNAME 11 - SET UP FILE OWNER NAME A0300696 ADC FCBCHK 12 - FILE CONTROL BLOCK VALIDATION A0300697 ADC EXEREQ 13 - FILE REQUESTOR VALIDATION A0300698 EJT A0300699 SPC 4 A0300700 EQU IDATA1(00) REQUEST DATA BUFFER A0300701 EQU VOLNAM(00) VOLUME NAME A0300702 EQU VOLUNT(00) VOLUME UNIT A0300703 EQU FINDEX(00) FILE CONTROL BLOCK INDEX A0300704 EQU FCBBF2(00) FILE CONTROL BLOCK BUFFER A0300705 EQU NEWNAM(00) NEW FILE NAME A0300706 EQU NMRECS(00) NUMBER OF RECORDS A0300707 EQU RECBF6(00) RECORD BUFFER A0300708 EQU KYVAL1(00) KEY VALUE A0300709 EQU REQBUF(01) REQUEST BUFFER A0300710 EQU IDATA2(02) REQUEST DATA BUFFER A0300711 EQU FCBBF1(02) FILE CONTROL BLOCK BUFFER A0300712 EQU ISTATS(03) REQUEST STATUS A0300713 EQU USRIDN(04) USER IDENTIFICATION A0300714 EQU RECBF1(05) RECORD BUFFER A0300715 EQU RECBF2(06) RECORD BUFFER A0300716 EQU RECBF3(07) RECORD BUFFER A0300717ÐÐ EQU RECBF4(08) RECORD BUFFER A0300718 EQU RECBF5(09) RECORD BUFFER A0300719 EQU KYVAL2(10) KEY VALUE A0300720 EQU USRNAM(11) OWNER NAME A0300721 EQU FCBADD(12) FILE CONTROL BLOCK A0300722 EQU REQCHK(13) REQUESTOR VALIDATION A0300723* A0300724 EQU NOTLEN(00) DUMMY LENGTH A0300725 EQU REQLEN(24) REQUEST BUFFER LENGTH A0300726 EQU ID1LEN(12) IDATA ARRAY LENGTH A0300727 EQU ID2LEN(15) IDATA ARRAY LENGTH A0300728 EQU ID3LEN(20) IDATA ARRAY LENGTH A0300729 EQU ID4LEN(14) IDATA ARRAY LENGTH A0300730 EQU ISTLEN(01) REQUEST STATUS LENGTH A0300731 EQU FCBLEN(96) FCB BUFFER LENGTH A0300732 EQU FMDLEN(06) FILE MANAGER DATA ARRAY LENGTH A0300733 EJT A0300734 SPC 2 A0300735 SPC 4 A0300736* U S E R P R O G R A M R E Q U E S T P R O C E S S O R A0300737* A0300738* F I L E M A N A G E R R E Q U E S T P R O C E S S O R A0300739 SPC 2 A0300740PPFMGR ENA 0 INITIALIZE THE RETURN ADDRESS INCREMENT A0300741 STA* (CNTAD1) A0300742ÐÐ SPC 1 A0300743 LDQ- RSI,I OBTAIN THE FILE REQUEST BUFFER ADDRESS A0300744 STQ- FRQBFA,I SAVE A0300745 LDA- PARLST,Q A0300746 STA- PARADD,I SET UP THE PARAMETER LIST ADDRESS A0300747 SPC 1 A0300748 LDQ- RQINFO,Q Q = FILE REQUEST INDEX A0300749 STQ- FMINDX,I SAVE IN THE LINKAGE BUFFER A0300750 TRQ A A0300751 INA -FMTMAX IS IT VALID A0300752 SAP PPF010 NO A0300753 SPC 1 A0300754 LDQ* FMTYPE,Q YES, Q = PROCESSOR TABLE ENTRY A0300755 STQ* FMTADD A0300756 SPC 1 A0300757PPFNXT LDQ* FMTADD A0300758 RAO* FMTADD A0300759 LDQ- (ZERO),Q OBTAIN THE NEXT PROCESSOR CODE A0300760 LRS 8 Q = SUB-PROCESSOR INDEX A0300761 ARS 8 A = PARAMETER ARRAY LENGTH A0300762 LDQ* FMPROC,Q GO PROCESS THE NEXT REQUEST PARAMETER A0300763 JMP- (ZERO),Q A0300764 SPC 2 A0300765PPF010 ENQ E03 ILLEGAL FILE REQUEST A0300766 LDA- FALADD,I OBTAIN THE ADDRESS OF THE ERROR A0300767ÐÐ JMP* (ATSER1) PROCESS THE ERROR MESSAGE A0300768 EJT A0300769* F I L E M A N A G E R R E Q U E S T P R O C E S S O R A0300770* A0300771* C O M P L E T I O N O F F I L E P A R A M E T E R A0300772* A0300773* V A L I D A T I O N A0300774 SPC 2 A0300775FVALID LDQ- FALADD,I A0300776 ADQ* (CNTAD1) A0300777 RTJ+ TSCKPM VALIDATE THE RETURN ADDRESS A0300778 JMP* PPF030 THE RETURN ADDRESS IS ILLEGAL A0300779 SPC 1 A0300780 STQ- RSP,I SAVE FOR EXIT AFTER REQUEST COMPLETION A0300781 SPC 1 A0300782 LDQ- ULUSTB,I A0300783 ENA SXCFMA SPECIFY SUSPENSION FOR A FILE REQUEST A0300784 STA- USRSTX,Q A0300785 SPC 1 A0300786 LDQ- ULIOTB,I A0300787 IIN 0 A0300788 LDA- IOSTAT,Q A0300789 EOR- ONEBIT+IA INDICATE I/O IS ACTIVE A0300790 EOR- ONEBIT+MM INDICATE A MASS MEMORY REQUEST A0300791 STA- IOSTAT,Q A0300792ÐÐ EIN 0 A0300793 SPC 1 A0300794 RTJ- (AMONI) INSURE REQUEST COMPLETION AT TSIOCP LEVEL A0300795 ADC $5205 A0300796 ADC PPF020 A0300797 SPC 1 A0300798 ENQ 1 FILE REQUEST ACCEPTED, START ANOTHER USER A0300799 JMP+ TSTASK A0300800 SPC 1 A0300801PPF020 INQ FRQBUF A0300802 STQ- I I = REQUEST BUFFER ADDRESS A0300803 LDQ- AEXTAB A0300804 LDQ- AFMEXC,Q Q = FILE MANAGER EXECUTIVE ADDRESS A0300805 RTJ- (ZERO),Q GO PERFORM THE REQUEST A0300806 SPC 1 A0300807 JMP+ TSFMCP PROCESS THE FILE REQUEST COMPLETION A0300808 SPC 2 A0300809PPF030 ENQ E01 PROGRAM PROTECT VIOLATION A0300810 LDA- PARADD,I SET UP THE ADDRESS OF THE ERROR A0300811 JMP* (ATSER1) PROCESS THE ERROR MESSAGE A0300812 EJT A0300813* A0300814* NOTCHK FILE REQUEST PARAMETER PROCESSOR 0 A0300815* ------ A0300816* MOVE PARAMETER - NO VALIDATION A0300817ÐÐ* A0300818 SPC 2 A0300819NOTCHK RTJ* (AMVFRQ) PLACE THE PARAMETER IN THE LINKAGE BUFFER A0300820 JMP* PPFNXT GO GET THE NEXT PARAMETER A0300821 SPC 2 A0300822* A0300823* RQBFCK FILE REQUEST PARAMETER PROCESSOR 1 A0300824* ------ A0300825* VALIDATE FILE REQUEST BUFFER A0300826* A0300827 SPC 2 A0300828RQBFCK RTJ* (ABFCHK) VERIFY THE FWA AND LWA OF THE BUFFER A0300829 SPC 1 A0300830 LDQ- PARADD,I A0300831 LDA- (ZERO),Q A = REQUEST BUFFER ADDRESS A0300832 RTJ* FMDXFR MOVE THE REQUEST BUFFER HEADER A0300833 SPC 1 A0300834 RTJ* (AMVFRQ) PLACE THE PARAMETER IN THE LINKAGE BUFFER A0300835 JMP* PPFNXT GO GET THE NEXT PARAMETER A0300836 SPC 2 A0300837* A0300838* FMDXFR TSPROT SUBROUTINE USED TO MOVE THE FIRST 4 A0300839* ------ WORDS OF THE REQUEST BUFFER TO THE A0300840* USER'S I/O TABLE A0300841* A0300842ÐÐ* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0300843* A = REQBUF ADDRESS A0300844* A0300845 SPC 2 A0300846FMDXFR NOP 0 A0300847 STA* FMXFR1 SET UP THE REQUEST BUFFER ADDRESS A0300848 LDA- ULIOTB,I A0300849 INA FRQBUF A0300850 STA* FMXFR2 SET UP THE DESTINATION ADDRESS A0300851 ENQ RQINFO A0300852 SPC 1 A0300853FMD010 LDA* (FMXFR1),Q MOVE THE REQUEST BUFFER HEADER A0300854 STA* (FMXFR2),Q FROM THE USER AREA TO THE I/O BUFFER A0300855 DQP *-FMD010 A0300856 JMP* (FMDXFR) RETURN A0300857 EJT A0300858* A0300859* FMBFCK FILE REQUEST PARAMETER PROCESSOR 2 A0300860* ------ A0300861* VALIDATE FILE REQUEST ARRAY A0300862* A0300863 SPC 2 A0300864FMBFCK RTJ* FBFCHK VERIFY THE FWA AND THE LWA OF THE BUFFER A0300865 RTJ* MOVFRQ PLACE THE PARAMETER IN THE LINKAGE BUFFER A0300866 JMP* PPFNXT GO GET THE NEXT PARAMETER A0300867ÐÐ SPC 2 A0300868* A0300869* STATCK FILE REQUEST PARAMETER PROCESSOR 3 A0300870* ------ A0300871* VERIFY REQUEST STATUS AND TERMINATE A0300872* A0300873 SPC 2 A0300874STATCK RTJ* FBFCHK VERIFY THE STATUS WORD A0300875 RTJ* MOVFRQ PLACE THE PARAMETER IN THE LINKAGE BUFFER A0300876 JMP* FVALID GO PERFORM THE REQUEST A0300877 SPC 2 A0300878* A0300879* SETUSR FILE REQUEST PARAMETER PROCESSOR 4 A0300880* ------ A0300881* SET UP THE FILE USER IDENTIFICATION A0300882* A0300883 SPC 2 A0300884SETUSR LDQ- FRQBFA,I A0300885 LDA- ULUSTB,I A0300886 STA- FMUSER,Q SPECIFY THE USER TABLE ADDRESS AS THE ID A0300887 JMP* PPFNXT GO GET THE NEXT PARAMETER A0300888 SPC 4 A0300889* F I L E R E Q U E S T P R O C E S S O R A0300890* A0300891* D A T A A N D S T O R A G E A0300892ÐÐ SPC 2 A0300893FMTADD NUM 0 FILE REQUEST TABLE ADDRESS A0300894FMXFR1 NUM 0 FILE REQUEST BUFFER TRANSFER ADDRESS A0300895FMXFR2 NUM 0 FILE REQUEST BUFFER TRANSFER ADDRESS A0300896CNTAD1 ADC CONTAD CONTINUATION ADDRESS INCREMENT A0300897AMVFRQ ADC MOVFRQ FILE REQUEST PARAMETER MOVE ROUTINE A0300898ABFCHK ADC FBFCHK FILE DATA BUFFER VERIFICATION ROUTINE A0300899 EJT A0300900* REC1CK FILE REQUEST PARAMETER PROCESSOR 5 A0300901* ------ A0300902* VERIFY RECORD LENGTH - PUTS REQUESTS A0300903 SPC 1 A0300904REC1CK LDQ- PARADD,I A0300905 LDQ- 1,Q Q = ADDRESS OF NUMREC A0300906 LDA- (ZERO),Q NUMREC = REQUEST PARAMETER A0300907 JMP* REC010 CONTINUE A0300908 SPC 2 A0300909* REC2CK FILE REQUEST PARAMETER PROCESSOR 6 A0300910* ------ A0300911* VERIFY RECORD LENGTH - WRITER REQUESTS A0300912 SPC 1 A0300913REC2CK ENA 1 NUMREC = 1 A0300914REC010 ENQ 2 RECORD LENGTH INCREMENT = 2 A0300915 JMP* REC030 CONTINUE A0300916 SPC 2 A0300917ÐÐ* REC3CK FILE REQUEST PARAMETER PROCESSOR 7 A0300918* ------ A0300919* VERIFY RECORD LENGTH - READR REQUESTS A0300920 SPC 1 A0300921REC3CK LDQ- FRQBFA,I A0300922 LDA- USEFLG,Q A0300923 SAM REC4CK FILE IS OPEN FOR SPECIAL PROCESSING A0300924 AND- LPMASK+3 IS THIS AN INDEXED REQUEST A0300925 SAN REC5CK YES A0300926 SPC 2 A0300927* REC4CK FILE REQUEST PARAMETER PROCESSOR 8 A0300928* ------ A0300929* VERIFY RECORD LENGTH - GETS REQUESTS A0300930 SPC 1 A0300931REC4CK LDQ- FRQBFA,I A0300932 LDA- LOKREC,Q A0300933 AND- LPMASK+15 NUMREC = BLOCKING FACTOR A0300934 JMP* REC020 CONTINUE A0300935 SPC 2 A0300936* REC5CK FILE REQUEST PARAMETER PROCESSOR 9 A0300937* ------ A0300938* VERIFY RECORD LENGTH - DELETE REQUESTS A0300939 SPC 1 A0300940REC5CK ENA 1 NUMREC = 1 A0300941REC020 ENQ 0 RECORD LENGTH INCREMENT = 0 A0300942ÐÐREC030 RTJ* LENREC CALCULATE THE RECORD LENGTH A0300943 RTJ* FBFCHK VERIFY THE FWA AND LWA OF THE RECORD A0300944 RTJ* MOVFRQ PLACE THE PARAMETER IN THE LINKAGE BUFFER A0300945 JMP* PPFNXT GO GET THE NEXT PARAMETER A0300946 EJT A0300947 SPC 4 A0300948* A0300949* KEYCHK FILE REQUEST PARAMETER PROCESSOR 10 A0300950* ------ A0300951* VALIDATE THE RECORD KEY A0300952* A0300953 SPC 2 A0300954KEYCHK LDQ- FRQBFA,I A0300955 LDA- USEFLG,Q A0300956 SAM KEY010 FILE IS OPEN FOR SPECIAL PROCESSING A0300957 AND- LPMASK+3 ISOLATE THE KEY NUMBER A0300958 TRA Q A0300959 LDA* KEYTAB,Q OBTAIN THE KEY LENGTH INCREMENT INTO THE FCB A0300960 SAZ KEY010 SKIP IF NOT AN INDEXED REQUEST A0300961 LDQ- FRQBFA,I A0300962 LDQ- FCBADR,Q A0300963 AAQ Q Q = KEY LENGTH ADDRESS A0300964 LDA- (ZERO),Q A = KEY LENGTH IN BYTES A0300965 INA 1 CONVERT TO WORDS A0300966 ARS 1 A0300967ÐÐ RTJ* FBFCHK VERIFY THE FWA AND THE LWA OF THE KEY A0300968 SPC 1 A0300969KEY010 RTJ* MOVFRQ PLACE THE PARAMETER IN THE LINKAGE BUFFER A0300970 JMP* PPFNXT GO GET THE NEXT PARAMETER A0300971 SPC 4 A0300972* A0300973* KEYTAB TABLE OF KEYLENGTH INCREMENTS INTO THE A0300974* ------ FILE CONTROL BLOCK A0300975 SPC 2 A0300976KEYTAB ADC 0 RELATIVE RECORD ACCESS A0300977 ADC LENKY1 KEY NO. 1 A0300978 ADC LENKY2 KEY NO. 2 A0300979 ADC LENKY3 KEY NO. 3 A0300980 ADC LENKY4 KEY NO. 4 A0300981 SPC 2 A0300982ATSER1 ADC TSXERR EXECUTIVE ERROR MESSAGE PROCESSOR A0300983ATSPM1 ADC TSCKPM PARAMETER VERIFICATION ROUTINE A0300984ATSMU1 ADC TSCKMU PARAMETER VERIFICATION ROUTINE A0300985 EJT A0300986 SPC 4 A0300987* A0300988* OWNAME FILE REQUEST PARAMETER PROCESSOR 11 A0300989* ------ A0300990* SET UP THE FILE OWNER NAME A0300991* A0300992ÐÐ SPC 2 A0300993OWNAME LDQ- ULUSTB,I A0300994 INQ USERID Q = ADDRESS OF THE USER'S IDENTIFICATION A0300995 STQ* FMXFR1 SET UP THE SOURCE ADDRESS A0300996 LDA- (ZERO),Q HAS A USER ID BEEN SET UP YET A0300997 SAN OWN010 YES A0300998 JMP* OWN050 NO, EXIT A0300999 SPC 1 A0301000OWN010 LDQ- PARADD,I A0301001 INQ -1 Q = POINTER TO IDATA PARAMETER A0301002 LDQ- (ZERO),Q A0301003 INQ 4 Q = ADDRESS OF IDATA(5) A0301004 LDA- (ZERO),Q OBTAIN THE FILE OWNER NAME A0301005 SAN OWN020 A0301006 LDA =XCOMOWN OWNER NAME = 0, SPECIFY A COMMON OWNER A0301007 STA* FMXFR1 A0301008 JMP* OWN030 A0301009 SPC 1 A0301010OWN020 SUB* COMOWN IS AN OWNER SPECIFIED A0301011 SAN OWN050 YES, EXIT A0301012OWN030 STQ* FMXFR2 NO, SET UP THE DESTINATION A0301013 ENQ 3 A0301014 SPC 1 A0301015OWN040 LDA* (FMXFR1),Q MOVE THE USER IDENTIFICATION A0301016 STA* (FMXFR2),Q TO THE OWNER NAME FIELD OF IDATA A0301017ÐÐ DQP *-OWN040 A0301018 SPC 1 A0301019OWN050 JMP* (APFNXT) GO GET THE NEXT PARAMETER A0301020 SPC 2 A0301021COMOWN ALF 4, COMMON OWNER NAME A0301022 EJT A0301023* A0301024* FCBCHK FILE REQUEST PARAMETER PROCESSOR 12 A0301025* ------ A0301026* VERIFY THE FILE CONTROL BLOCK A0301027* A0301028 SPC 2 A0301029FCBCHK LDQ- FRQBFA,I OBTAIN THE REQUEST BUFFER ADDRESS A0301030 LDQ- FCBADR,Q IS A LOCAL FCB SPECIFIED A0301031 SQZ FCB020 NO A0301032 TRQ A SAVE ADDRESS A0301033 RTJ* (ATSPM1) YES, VERIFY THE FWA OF THE ARRAY A0301034 JMP* FCB040 ERROR A0301035 SPC 1 A0301036 LDQ- FRQBFA,I OBTAIN THE REQUEST BUFFER ADDRESS A0301037 LDQ- FCBBLN,Q = BUFFER LENGTH A0301038 SQN FCB010 SENSE BUFFER LENGTH SPECIFIED A0301039 ENQ FCBLN2-1 SPECIFY THE INDEXED FCB LENGTH A0301040FCB010 AAQ Q A0301041 RTJ* (ATSPM1) VERIFY THE LWA OF THE ARRAY A0301042ÐÐ JMP* FCB040 ERROR A0301043 RTJ* (ATSMU1) VERIFY AGAINST THE LWA OF THE USER PROGRAM A0301044 JMP* FCB040 ERROR A0301045FCB020 JMP* (APFNXT) GO GET THE NEXT PARAMETER A0301046 SPC 1 A0301047FCB040 ENQ E04 ILLEGAL FILE REQUEST PARAMETER A0301048 LDA- FRQBFA,I A0301049 INA FCBADR OBTAIN THE ADDRESS OF THE ERROR A0301050 JMP* (ATSER1) PROCESS THE ERROR MESSAGE A0301051 SPC 2 A0301052* A0301053* EXEREQ FILE REQUEST PARAMETER PROCESSOR 13 A0301054* ------ A0301055* VERIFY THE REQUESTOR A0301056* A0301057EXEREQ LDA- USRPGM,I DID THE REQUEST COME FROM TSLOG A0301058 SAN EXE010 NO, ERROR A0301059 JMP* (APFNXT) YES, GO GET THE NEXT PARAMETER A0301060 SPC 1 A0301061EXE010 ENQ E03 ILLEGAL FILE REQUEST A0301062 LDA- FALADD,I OBTAIN THE ADDRESS OF THE ERROR A0301063 JMP* (ATSER1) PROCESS THE ERROR MESSAGE A0301064 SPC 2 A0301065APFNXT ADC PPFNXT GET NEXT FILE PARAMETER PROCESSOR INDEX A0301066 EJT A0301067ÐÐ* A0301068* MOVFRQ TSPROT SUBROUTINE USED TO TRANSFER THE NEXT A0301069* ------ FILE REQUEST PARAMETER TO THE USER A0301070* LINKAGE BUFFER A0301071* A0301072* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0301073* PMCNTR = NEXT PARAMETER INDEX A0301074* (PARADD) = PARAMETER ADDRESS A0301075* LOCATION A0301076* A0301077* EXIT CONDITIONS: A = PARAMETER VALUE A0301078 SPC 2 A0301079MOVFRQ NOP 0 A0301080 LDQ- PARADD,I A0301081 LDA- (ZERO),Q OBTAIN THE NEXT PARAMETER A0301082 LDQ- PMCNTR,I OBTAIN THE NEXT PARAMETER POSITION A0301083 STA- FMPMTR,B A0301084 RAO- PMCNTR,I INCREMENT THE POSITION INDEX A0301085 RAO- PARADD,I AND THE PARAMETER POINTER A0301086 JMP* (MOVFRQ) RETURN A0301087 SPC 2 A0301088* A0301089* FBFCHK TSPROT SUBROUTINE USED TO VERIFY THE FWA A0301090* ------ AND THE LWA OF A FILE DATA BUFFER A0301091* A0301092ÐÐ* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0301093* A = BUFFER LENGTH A0301094* ((PARADD)) = BUFFER FWA A0301095* A0301096* EXIT CONDITIONS: I = SAVED A0301097* A0301098 SPC 2 A0301099FBFCHK NOP 0 A0301100 SPC 1 A0301101 RTJ+ TSPMCK GO VERIFY THE FWA A0301102 SPC 1 A0301103 AAQ Q Q = LWA OF THE BUFFER A0301104 RTJ* (ATSPM1) IS IT WITHIN THE USER AREA A0301105 JMP* FBF010 NO A0301106 SPC 1 A0301107 RTJ* (ATSMU1) VERIFY AGAINST THE LWA OF THE USER PROGRAM A0301108 JMP* FBF010 ERROR A0301109 SPC 1 A0301110 JMP* (FBFCHK) YES, RETURN A0301111 SPC 1 A0301112FBF010 ENQ E04 ILLEGAL FILE REQUEST PARAMETER A0301113 LDA- PARADD,I OBTAIN THE ADDRESS OF THE ERROR A0301114 JMP* (ATSER1) PROCESS THE ERROR MESSAGE A0301115 EJT A0301116* LENREC TSPROT SUBROUTINE USED TO COMPUTE THE FILE A0301117ÐÐ* ------ RECORD LENGTH A0301118* A0301119* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0301120* A = NUMBER OF RECORDS A0301121* Q = RECORD SIZE INCREMENT A0301122* A0301123* EXIT CONDITIONS: I = SAVED A0301124* A = RECORD LENGTH IN WORDS A0301125* A0301126 SPC 2 A0301127LENREC NOP 0 A0301128 STA* NORECS SAVE THE NUMBER OF RECORDS A0301129 STQ* INCREM AND THE RECORD SIZE INCREMENT A0301130 SPC 1 A0301131 LDQ- FRQBFA,I A0301132 LDQ- FCBADR,Q A0301133 LDA- RECLEN,Q OBTAIN THE FILE RECORD LENGTH A0301134 STA* RCDLEN AND SAVE A0301135 SPC 1 A0301136 LDA- FCBIND,Q ARE THE RECORDS SECTOR ALIGNED A0301137 SAP LEN020 NO A0301138 SPC 1 A0301139 LDA- (FILEID),Q YES,SET Q TO FILE'S MM LOGICAL UNIT A0301140 ARS 11 A0301141 AND- LPMASK+5 A0301142ÐÐ TRA Q A0301143 LDQ+ MMLUTB,Q = VIT ADDRESS FOR FILE'S UNIT A0301144 LDA- VIWPS,Q = WORDS PER SECTOR A0301145 STA* WDSSTR AND SAVE A0301146 LDA* RCDLEN A0301147 CLR Q A0301148 DVI* WDSSTR PERFORM A SECTOR MODULO CALCULATION A0301149 SQZ LEN010 A0301150 INA 1 A0301151LEN010 MUI* WDSSTR A0301152 JMP* LEN030 CONTINUE A0301153 SPC 1 A0301154LEN020 LDA* RCDLEN A = RECORD LENGTH A0301155LEN030 MUI* NORECS CALCULATE NUMREC*RECLEN A0301156 ADD* INCREM INCLUDE THE SIZE INCREMENT A0301157 JMP* (LENREC) RETURN A0301158 SPC 2 A0301159NORECS NUM 0 NUMBER OF RECORDS A0301160INCREM NUM 0 RECORD SIZE INCREMENT A0301161RCDLEN NUM 0 BASE RECORD LENGTH A0301162WDSSTR NUM 0 WORDS / SECTOR FOR THIS DEVICE A0301163 EJT A0301164 SPC 4 A0301165* L E G A L M O N I T O R R E Q U E S T T A B L E A0301166 SPC 1 A0301167ÐÐ********************************************************************** A0301168* * A0301169* THIS TABLE CONTAINS THE REQUEST CODE AND THE ADDRESS OF * A0301170* THE INTERNAL PROCESSOR FOR ALL LEGAL MONITOR REQUESTS * A0301171* * A0301172********************************************************************** A0301173 SPC 2 A0301174MONTBL ADC 1 READ REQUEST A0301175 ADC IOPROC INTERNAL PROCESSOR A0301176* A0301177 ADC 2 WRITE REQUEST A0301178 ADC IOPROC INTERNAL PROCESSOR A0301179* A0301180 ADC 3 STATUS REQUEST A0301181 ADC MONSTS INTERNAL PROCESSOR A0301182* A0301183 ADC 4 FREAD REQUEST A0301184 ADC IOPROC INTERNAL PROCESSOR A0301185* A0301186 ADC 5 EXIT REQUEST A0301187 ADC PPDISP INTERNAL PROCESSOR A0301188* A0301189 ADC 6 FWRITE REQUEST A0301190 ADC IOPROC INTERNAL PROCESSOR A0301191* A0301192ÐÐ ADC 14 MOTION REQUEST A0301193 ADC MOTPRC INTERNAL PROCESSOR A0301194* A0301195 ADC 16 INDIRECT REQUEST A0301196 ADC MONIND INTERNAL PROCESSOR A0301197* A0301198 ADC (-0) TABLE TERMINATOR A0301199 EJT A0301200 SPC 4 A0301201* U S E R P R O G R A M R E Q U E S T P R O C E S S O R A0301202* A0301203* M O N I T O R R E Q U E S T P R O C E S S O R A0301204 SPC 2 A0301205PPMONI ENA 6 INITIALIZE THE CONTINUATOR ADDRESS A0301206 STA* CONTAD A0301207 SPC 1 A0301208PPM010 LDQ- PARADD,I OBTAIN THE REQUEST CODE A0301209 LDA- (ZERO),Q IS THIS A 1-WORD INDIRECT REQUEST A0301210 SAP PPM020 NO A0301211 JMP* PPM060 YES, IT IS ILLEGAL A0301212 SPC 1 A0301213PPM020 ALS 1 NO, IS THE D-BIT SET IN THE REQUEST A0301214 SAP PPM030 NO, REQUEST ERROR A0301215 ALS 6 IS THE X-BIT SET IN THE REQUEST A0301216 SAP PPM040 NO A0301217ÐÐ SPC 1 A0301218PPM030 ENQ E06 ILLEGAL REQUEST PARAMETER A0301219 LDA- PARADD,I OBTAIN THE ADDRESS OF THE ERROR A0301220 JMP* (ATSER2) PROCESS THE ERROR MESSAGE A0301221 SPC 1 A0301222PPM040 AND- LPMASK+5 ISOLATE THE REQUEST CODE A0301223 STA* RQCODE AND SAVE A0301224 ARS 1 A0301225 STA- RQTYPE,I ALSO SAVE THE REQUEST TYPE INDEX A0301226 SPC 1 A0301227 INQ 3 A0301228 STQ- LUNERR,I SAVE THE LOGICAL UNIT ERROR ADDRESS A0301229 SPC 1 A0301230 ENQ 0 IS THIS REQUEST ALLOWED A0301231PPM050 LDA* MONTBL,Q TO THE USER PROGRAMS A0301232 SAM PPM060 NO, SEARCH COMPLETE A0301233 SUB* RQCODE A0301234 SAZ PPM070 YES A0301235 INQ 2 NO, CONTINUE CHECKING A0301236 JMP* PPM050 A0301237 SPC 1 A0301238PPM060 ENQ E05 ILLEGAL MONITOR REQUEST A0301239 LDA- FALADD,I OBTAIN THE ADDRESS OF THE ERROR A0301240 JMP* (ATSER2) PROCESS THE ERROR MESSAGE A0301241 SPC 1 A0301242ÐÐPPM070 LDQ* MONTBL+1,Q OBTAIN THE PROCESSOR ADDRESS A0301243 JMP- (ZERO),Q PASS CONTROL TO THE INTERNAL PROCESSOR A0301244 EJT A0301245* A0301246* MONSTS REQUEST CODE = 3 A0301247* ------ STATUS REQUEST A0301248* A0301249 SPC 2 A0301250MONSTS LDQ- PARADD,I A0301251 INQ -2 A0301252 RTJ- (ALUABS) OBTAIN THE LOGICAL UNIT A0301253 LDQ* (ALOG1A),Q OBTAIN THE UNIT'S PHYSICAL DEVICE TABLE A0301254 LDA- EREQST,Q A0301255 STA- RSQ,I RETURN THE REQUEST STATUS IN Q A0301256 LDA- ESTAT2,Q A0301257 STA- RSA,I RETURN THE DEVICE STATUS IN A A0301258 LDA- ELSTWD,Q A0301259 INA -1 A0301260 STA- RSI,I RETURN THE LAST LOCATION IN I A0301261 LDQ- FALADD,I A0301262 INQ 3 A0301263 RTJ* (ATSPM2) IS THE RETURN ADDRESS IN THE USER AREA A0301264 JMP* MON010 NO A0301265 STQ- RSP,I YES, SAVE THE RETURN A0301266 JMP* (ATURTN) AND EXIT A0301267ÐÐ SPC 4 A0301268* A0301269* MONIND REQUEST CODE = 16 A0301270* ------ INDIRECT REQUEST A0301271* A0301272 SPC 2 A0301273MONIND LDQ- PARADD,I A0301274 LDQ- 1,Q OBTAIN THE ADDRESS OF THE PARAMETER LIST A0301275 STQ- PARADD,I SAVE IT A0301276 RTJ* (ATSPM2) IS THE PARAMETER LIST IN THE USER AREA A0301277 JMP* MON010 NO A0301278 SPC 1 A0301279 ENA 2 YES, SET UP THE CONTINUATOR ADDRESS A0301280 STA* CONTAD A0301281 JMP* PPM010 GO PROCESS THE REQUEST A0301282 SPC 1 A0301283MON010 ENQ E01 PROGRAM PROTECT VIOLATION A0301284 LDA- FALADD,I OBTAIN THE ADDRESS OF THE ERROR A0301285 JMP* (ATSER2) PROCESS THE ERROR MESSAGE A0301286 EJT A0301287 SPC 4 A0301288* A0301289* MOTREQ REQUEST CODE = 14 A0301290* ------ MOTION REQUEST A0301291* A0301292ÐÐ SPC 2 A0301293MOTPRC LDA* CONTAD A0301294 INA -2 IS THIS AN INDIRECT REQUEST A0301295 SAZ MOT010 YES A0301296 ENA 5 NO, SPECIFY THE CONTINUATION INCREMENT A0301297 STA* CONTAD A0301298 SPC 1 A0301299MOT010 ENA 5 A0301300 STA- RQTYPE,I RQTYPE = 5 (WRITE TYPE - MOTION REQUEST) A0301301 LDQ- PARADD,I A0301302 RTJ* LUNCHK OBTAIN THE REQUEST LOGICAL UNIT A0301303 LDA- RQCLAS,I A0301304 INA -8 IS THE MOTION REQUEST TO THE TERMINAL A0301305 SAN MOT020 NO, CONTINUE A0301306 SPC 1 A0301307 LDQ- FALADD,I YES, Q = REQUEST ADDRESS A0301308 STQ- RSCARG,I SPECIFY THE COMPLETION A-REGISTER A0301309 LDA- 1,Q A0301310 STA- RSCPAD,I SPECIFY THE REQUEST COMPLETION ADDRESS A0301311 LDA- 3,Q A = REQUEST LOGICAL UNIT A0301312 ADQ* CONTAD A0301313 RTJ* (ATSPM2) IS THE CONTINUATION ADDRESS VALID A0301314 JMP* MOT010 NO A0301315 SPC 1 A0301316 STQ- RSP,I YES, SPECIFY THE CONTINUATION ADDRESS A0301317ÐÐ LDQ- ULIOTB,I A0301318 STA- IORQLU,Q AND THE REQUEST LOGICAL UNIT A0301319 JMP* (ATURTN) RETURN TO THE USER A0301320 SPC 1 A0301321MOT020 LDQ =XMTRQ Q = PROCESSOR TABLE FOR MOTION REQUESTS A0301322 JMP IOP010 GO PROCESS THE REQUEST A0301323 EJT A0301324 SPC 4 A0301325* A0301326* MRMOTN I/O REQUEST PARAMETER PROCESSOR 21 A0301327* ------ A0301328* MOTION REQUEST PARAMETERS A0301329* A0301330 SPC 2 A0301331MRMOTN LDQ- PARADD,I A0301332 LDA- (ZERO),Q OBTAIN THE MOTION PARAMETER WORD A0301333 STA- TEMPAR,I A0301334 SAM MRT010 SKIP IF REPETATIVE MODE A0301335 SAZ MRT010 SKIP IF NO PARAMETERS SPECIFIED A0301336 TCA A A0301337 ADD* MOTMAX VERIFY THE PARAMETER BYTES A0301338 AND* MOTMSK ARE ALL BYTES VALID A0301339 SAN MRT020 NO A0301340 LDA- TEMPAR,I A0301341MRT010 RTJ MOVMRQ PLACE THE PARAMETERS IN THE LINKAGE BUFFER A0301342ÐÐ JMP IOPNXT GO GET THE NEXT PARAMETER A0301343 SPC 1 A0301344MRT020 ENQ E06 ILLEGAL REQUEST PARAMETER A0301345 LDA- PARADD,I OBTAIN THE ADDRESS OF THE ERROR A0301346 JMP* (ATSER2) PROCESS THE ERROR MESSAGE A0301347 EJT A0301348* M O N I T O R R E Q U E S T D A T A A N D S T O R A G E A0301349 SPC 2 A0301350RQCODE NUM 0 MONITOR REQUEST CODE A0301351CONTAD NUM 0 CONTINUATION ADDRESS INCREMENT A0301352LUNADD NUM 0 MASS MEMORY VOLUME TABLE ADDRESS A0301353MOTMAX NUM $7774 MOTION PARAMETER BYTE MAXIMUM VALUE A0301354MOTMSK NUM $8888 MOTION PARAMETER BYTE ERROR MASK A0301355AMMLUT ADC MMLUTB MASS MEMORY UNIT TABLE A0301356ALOG1A ADC LOG1A SYSTEM LOGICAL UNIT TABLE A0301357ATRMLU ADC TERMLU COMMUNICATIONS CONTROLLER L. U. A0301358ATSER2 ADC TSXERR EXECUTIVE ERROR MESSAGE PROCESSOR A0301359ATSPM2 ADC TSCKPM PARAMETER VERIFICATION ROUTINE A0301360ATURTN ADC TSURTN RETURN TO USER PROGRAM PROCESSOR A0301361 SPC 4 A0301362* A0301363* LUCLAS LUPROC SUBROUTINE USED TO OBTAIN THE DEVICE A0301364* ------ CLASS OF A LOGICAL UNIT A0301365* A0301366* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0301367ÐÐ* Q = LOGICAL UNIT A0301368* A0301369 SPC 2 A0301370LUCLAS NOP 0 A0301371 TRQ A A0301372 INA -1 A0301373 SAM LUC030 ILLEGAL LOGICAL UNIT A0301374 SUB* (ALOG1A) A0301375 SAP LUC030 ILLEGAL LOGICAL UNIT A0301376 SPC 1 A0301377 TRQ A A0301378 SUB* ATRMLU IS THE LOGICAL UNIT THE TERMINAL A0301379 SAN LUC010 NO A0301380 ENA 8 YES, CLASS CODE = 8 A0301381 JMP* LUC020 RETURN A0301382 SPC 1 A0301383LUC010 LDQ* (ALOG1A),Q A0301384 LDA- EREQST,Q A0301385 ARS 11 POSITION THE DEVICE CLASS CODE A0301386 AND- LPMASK+3 A0301387LUC020 STA- RQCLAS,I SAVE A0301388 JMP* (LUCLAS) AND RETURN A0301389 SPC 1 A0301390LUC030 ENQ E07 INVALID LOGICAL UNIT A0301391 LDA- LUNERR,I OBTAIN THE ADDRESS OF THE ERROR A0301392ÐÐ JMP* (ATSER2) PROCESS THE ERROR MESSAGE A0301393 EJT 122*4844A0301394* A0301395* WKSTLU LUPROC SUBROUTINE USED TO PROCESS A0301396* ------ TERMINAL WORKSTATION DEVICES A0301397* A0301398* ENTRY CONDITIONS: I = LINKAGE BUFFER ADDRESS A0301399* A0301400 SPC 2 A0301401WKSTLU NOP 0 A0301402 ENQ 0 A0301403 STQ* LUWKST INITIALIZE THE WORKSTATION FLAG A0301404 SPC 1 A0301405WKS010 STQ* WKSQSV A0301406 LDQ* (AWKSTA),Q OBTAIN THE NEXT TABLE ENTRY A0301407 SQP WKS020 SKIP IF END NOT REACHED A0301408 JMP* (WKSTLU) END OF TABLE, RETURN A0301409 SPC 1 A0301410WKS020 LRS 8 Q = PORT NUMBER INDICATOR A0301411 ARS 8 A = PORT NUMBER A0301412 SQN WKS030 NOT A PORT NUMBER, CONTINUE A0301413 SUB- PORTNO,I LOOK FOR A PORT MATCH A0301414 SPC 1 A0301415WKS030 LDQ* WKSQSV A0301416 INQ 1 A0301417ÐÐ SAZ WKS040 SKIP IF THIS IS THE USERS PORT A0301418 JMP* WKS010 OTHERWISE, CONTINUE A0301419 SPC 1 A0301420WKS040 STQ* WKSQSV A0301421 LDQ* (AWKSTA),Q OBTAIN THE NEXT TABLE ENTRY A0301422 SQM WKS060 SKIP IF THE END HAS BEEN REACHED A0301423 LLS 8 A = MASTER LOGICAL UNIT A0301424 QRS 8 Q = WORKSTATION LOGICAL UNIT A0301425 SUB- REQLUN,I IS THE REQUEST TO THIS UNIT A0301426 SAZ WKS050 YES A0301427 ENA 0 NO A0301428 JMP* WKS030 CONTINUE A0301429 SPC 1 A0301430WKS050 STQ- REQLUN,I SPECIFY THE WORKSTATION LOGICAL UNIT A0301431 STQ* LUWKST INDICATE A WORKSTATION WAS SELECTED A0301432 SPC 1 A0301433WKS060 JMP* (WKSTLU) RETURN A0301434 SPC 2 A0301435AWKSTA ADC WKSTAT ADDRESS OF THE WORKSTATION TABLE A0301436LUWKST ADC 0 WORKSTATION SELECTION INDICATOR A0301437WKSQSV ADC 0 TEMPORARY STORAGE - Q-REGISTER A0301438 EJT A0301439 SPC 4 A0301440* A0301441* LUNCHK TSPROT SUBROUTINE USED TO OBTAIN THE REQUEST A0301442ÐÐ* ------ LOGICAL UNIT, DEVICE CLASS, AND CHAR- A0301443* ACTER MODE INDICATOR A0301444* A0301445* ENTRY CONDITIONS: Q = PARAMETER LIST ADDRESS A0301446* I = ADDR. OF LINKAGE BUFFER A0301447* A0301448 SPC 2 A0301449LUNCHK NOP 0 A0301450 SPC 1 A0301451 LDA- 3,Q OBTAIN THE REQUEST LOGICAL UNIT A0301452 AND- ONEBIT+12 ISOLATE THE CHARACTER MODE INDICATOR A0301453 STA- RQMODE,I SAVE A0301454 SPC 1 A0301455 RTJ- (ALUABS) ABSOLUTIZE THE LOGICAL UNIT A0301456 SQN LUN005 A0301457 LDQ* ATRMLU LOGICAL UNIT = 0, ASSUME THE TERMINAL A0301458LUN005 STQ- REQLUN,I SAVE A0301459 SPC 1 A0301460 RTJ* WKSTLU PROCESS ANY WORKSTATION DEVICES A0301461 LDQ- REQLUN,I A0301462 RTJ* LUCLAS VERIFY THE L. U. AND OBTAIN THE CLASS CODE A0301463 SPC 1 A0301464 LDA- REQLUN,I A0301465 INA -4 IS THE REQUEST FOR LOGICAL UNIT 4 A0301466 SAN LUN010 NO A0301467ÐÐ LDA- RQTYPE,I YES A0301468 AND- ONEBIT IS THE REQUEST A READ A0301469 SAZ LUN030 YES, ERROR A0301470 SPC 1 A0301471 JMP* (LUNCHK) NO, RETURN A0301472 SPC 1 A0301473LUN010 LDA- RQCLAS,I A0301474 INA -2 IS THE LOGICAL UNIT A MASS MEMORY A0301475 SAZ LUN020 YES A0301476 JMP* LUN100 NO A0301477 SPC 1 A0301478LUN020 LDA- RSBHDR+1,I IS THIS A WRITE-READ REQUEST A0301479 SAZ LUN040 NO A0301480LUN030 JMP* LUN090 YES, ERROR A0301481 SPC 1 A0301482LUN040 LDA- ONEBIT+12 FORCE WORD MODE A0301483 STA- RQMODE,I A0301484 SPC 1 A0301485 LDQ* AMMLUT Q = MASS MEMORY L.U. TABLE A0301486 ADQ* (AMMLUT) INCREMENT TO THE LAST ENTRY A0301487 EJT A0301488 SPC 4 A0301489LUN050 STQ* LUNADD A0301490 LDQ- (ZERO),Q Q = CURRENT VOLUME INFORMATION TABLE ADDRESS A0301491 LDA- (ZERO),Q IS THIS VOLUME MOUNTED A0301492ÐÐ SAP LUN060 YES A0301493 AND- LPMASK+15 NO A0301494 SUB- REQLUN,I IS THIS THE REQUESTED UNIT A0301495 SAN LUN060 NO, CONTINUE A0301496 LDA- PORTNO,I YES, IS THE REQUEST FROM THE MASTER TERMINAL A0301497 SAN LUN090 NO, ERROR A0301498 JMP* (LUNCHK) YES, RETURN A0301499 SPC 1 A0301500LUN060 LDQ* LUNADD A0301501 INQ -1 A0301502 TRQ A A0301503 SUB* AMMLUT IS THE SEARCH COMPLETE A0301504 SAM LUN070 YES A0301505 JMP* LUN050 NO, CONTINUE A0301506 SPC 1 A0301507LUN070 LDA- RQTYPE,I A0301508 AND- ONEBIT IS THIS A WRITE TO A MOUNTED VOLUME A0301509 SAN LUN090 YES, ERROR A0301510 SPC 1 A0301511 JMP* (LUNCHK) NO, RETURN A0301512 SPC 1 A0301513LUN090 ENQ E07 INVALID LOGICAL UNIT A0301514 LDA- LUNERR,I OBTAIN THE ADDRESS OF THE ERROR A0301515 JMP* (ATSER2) PROCESS THE ERROR MESSAGE A0301516 SPC 1 A0301517ÐÐLUN100 LDA- RQTYPE,I A0301518 AND- ONEBIT A0301519 TRA Q A0301520 LDQ- RQINPT,B OBTAIN THE INPUT OR OUTPUT LOGICAL UNIT A0301521 SQM LUN120 SKIP IF A FILE IS SPECIFIED A0301522 LDA- RQCLAS,I A0301523 INA -8 IS THE REQUEST TO THE TERMINAL A0301524 SAN LUN110 NO, RETURN A0301525 SQZ LUN110 NO DECLARED FILE DEVICE, RETURN A0301526 SPC 1 A0301527 STQ- REQLUN,I SPECIFY THE SELECTED LOGICAL UNIT A0301528 RTJ* LUCLAS VERIFY THE L. U. AND OBTAIN THE CLASS CODE A0301529LUN110 JMP* (LUNCHK) AND RETURN A0301530 SPC 1 A0301531LUN120 ENA 9 CLASS = 9 A0301532 STA- RQCLAS,I A0301533 JMP* (LUNCHK) AND RETURN A0301534 EJT A0301535 SPC 4 A0301536* M O N I T O R I / O R E Q U E S T T A B L E S A0301537 SPC 4 A0301538* A0301539* DEVTAB TABLE OF PROCESSOR TABLE ADDRESSES, BASED A0301540* ------ ON DEVICE CLASS CODE A0301541* A0301542ÐÐ SPC 2 A0301543DVTYPE ADC 0 00 - INVALID DEVICE CLASS A0301544 ADC CL01 01 - MAGNETIC TAPE A0301545 ADC CL02 02 - MASS MEMORY A0301546 ADC CL03 03 - CARD DEVICE A0301547 ADC 0 04 - PAPER TAPE (NOT AVAILABLE) A0301548 ADC CL05 05 - LINE PRINTER A0301549 ADC CL06 06 - SYSTEM COMMENT DEVICE A0301550 ADC 0 07 - NOT USED A0301551 ADC CL08 08 - COMMUNICATIONS TERMINAL A0301552 ADC CL09 09 - SEQUENTIAL FILE A0301553 SPC 4 A0301554* MTRQ TABLE OF REQUEST PARAMETER PROCESSOR BYTES A0301555* ---- WHICH REFER TO SUB-PROCESSORS USED TO A0301556* VALIDATE THE MOTION REQUEST PARAMETERS A0301557* A0301558 SPC 2 A0301559MTRQ VFD X8/REQST1,X8/COMPL1 A0301560 VFD X8/THREAD,X8/LOGUN2 A0301561 VFD X8/MOTION,X8/THREAD A0301562 VFD X8/MMADR1,X8/TMNATE A0301563 EJT A0301564* A0301565* CL'NN' TABLE OF REQUEST PARAMETER PROCESSOR BYTES A0301566* ------ WHICH REFER TO SUB-PROCESSORS USED TO A0301567ÐÐ* VALIDATE THE PARAMETERS OF EACH I/O A0301568* REQUEST A0301569* A0301570 SPC 2 A0301571* MAGNETIC TAPE DEVICE A0301572CL01 VFD X8/REQST1,X8/COMPL1 A0301573 VFD X8/THREAD,X8/LOGUN1 A0301574 VFD X8/NOWRD1,X8/DATBF1 A0301575 VFD X8/MMADR1,X8/DXFER1 A0301576 VFD X8/TMNATE,X8/TMNATE A0301577* MASS MEMORY DEVICE A0301578CL02 VFD X8/REQST1,X8/COMPL1 A0301579 VFD X8/THREAD,X8/LOGUN2 A0301580 VFD X8/NOWRD2,X8/DATBF2 A0301581 VFD X8/MMADR2,X8/TMNATE A0301582* CARD DEVICE A0301583CL03 VFD X8/REQST1,X8/COMPL1 A0301584 VFD X8/THREAD,X8/LOGUN1 A0301585 VFD X8/NOWRD1,X8/DATBF1 A0301586 VFD X8/MMADR1,X8/DXFER1 A0301587 VFD X8/TMNATE,X8/TMNATE A0301588* LINE PRINTER DEVICE A0301589CL05 VFD X8/REQST3,X8/COMPL1 A0301590 VFD X8/THREAD,X8/LOGUN1 A0301591 VFD X8/NOWRD1,X8/DATBF1 A0301592ÐÐ VFD X8/MMADR1,X8/DXFER1 A0301593 VFD X8/TMNATE,X8/TMNATE A0301594* SYSTEM COMMENT DEVICE A0301595CL06 VFD X8/REQST3,X8/COMPL1 A0301596 VFD X8/THREAD,X8/LOGUN3 A0301597 VFD X8/NOWRD1,X8/DATBF1 A0301598 VFD X8/MMADR1,X8/DXFER1 A0301599 VFD X8/TMNATE,X8/TMNATE A0301600* COMMUNICATIONS TERMINAL DEVICE A0301601CL08 VFD X8/REQST4,X8/COMPL2 A0301602 VFD X8/THREAD,X8/LOGUN3 A0301603 VFD X8/NOWRD3,X8/DATBF3 A0301604 VFD X8/MMADR1,X8/DXFER2 A0301605 VFD X8/TMNATE,X8/TMNATE A0301606* SEQUENTIAL FILE DEVICE A0301607CL09 VFD X8/REQST1,X8/COMPL1 A0301608 VFD X8/THREAD,X8/LOGUN2 A0301609 VFD X8/NOWRD1,X8/DATBF1 A0301610 VFD X8/MMADR1,X8/DXFER1 A0301611 VFD X8/REQFIL,X8/TMNATE A0301612 EJT A0301613 SPC 4 A0301614* RQPROC TABLE OF MONITOR REQUEST PARAMETER PROCESSOR A0301615* ------ ADDRESSES. INDICES TO THIS TABLE ARE A0301616* CONTAINED IN THE BYTES SPECIFIED IN A0301617ÐÐ* THE MONITOR I/O REQUEST TABLE A0301618* A0301619 SPC 1 A0301620RQPROC ADC 0 00 - NOT USED A0301621 ADC MRCOD1 01 - REQUEST CODE-MSOS READ/WRITE DEVICE A0301622 ADC MRCOD2 02 - REQUEST CODE-MSOS READ ONLY DEVICE A0301623 ADC MRCOD3 03 - REQUEST CODE-MSOS WRITE ONLY DEVICE A0301624 ADC MRCOD4 04 - REQUEST CODE-TERMINAL DEVICE A0301625 ADC MRCMP1 05 - COMPLETION ADDRESS-MSOS DEVICE A0301626 ADC MRCMP2 06 - COMPLETION ADDRESS-TERMINAL DEVICE A0301627 ADC MRTHRD 07 - REQUEST THREAD-ALL DEVICES A0301628 ADC MRLUN1 08 - LOGICAL UNIT-MSOS DEVICE A0301629 ADC MRLUN2 09 - LOGICAL UNIT-MASS MEMORY DEVICE A0301630 ADC MRLUN3 10 - LOGICAL UNIT-TERMINAL DEVICE A0301631 ADC MRSIZ1 11 - BUFFER SIZE-MSOS DEVICE A0301632 ADC MRSIZ2 12 - BUFFER SIZE-MASS MEMORY DEVICE A0301633 ADC MRSIZ3 13 - BUFFER SIZE-TERMINAL DEVICE A0301634 ADC MRBUF1 14 - BUFFER ADDRESS-MSOS DEVICE A0301635 ADC MRBUF2 15 - BUFFER ADDRESS-MASS MEMORY DEVICE A0301636 ADC MRBUF3 16 - BUFFER ADDRESS-TERMINAL DEVICE A0301637 ADC MRMMA1 17 - SECTOR AND CONTROL POINT-MSOS DEVICE A0301638 ADC MRMMA2 18 - SECTOR AND CONTROL POINT-M.M. DEVICE A0301639 ADC MRDAT1 19 - MESSAGE DATA-MSOS DEVICE A0301640 ADC MRDAT2 20 - MESSAGE DATA-TERMINAL DEVICE A0301641 ADC MRMOTN 21 - MOTION REQUEST PARAMETERS A0301642ÐÐ ADC MRFILE 22 - SEQUENTIAL FILE PROCESSOR A0301643 ADC RVALID 23 - TERMINATE REQUEST VALIDATION A0301644 EJT A0301645 SPC 4 A0301646 EQU REQST1(01) REQUEST CODE A0301647 EQU REQST2(02) REQUEST CODE A0301648 EQU REQST3(03) REQUEST CODE A0301649 EQU REQST4(04) REQUEST CODE A0301650 EQU COMPL1(05) COMPLETION ADDRESS A0301651 EQU COMPL2(06) COMPLETION ADDRESS A0301652 EQU THREAD(07) REQUEST THREAD A0301653 EQU LOGUN1(08) LOGICAL UNIT A0301654 EQU LOGUN2(09) LOGICAL UNIT A0301655 EQU LOGUN3(10) LOGICAL UNIT A0301656 EQU NOWRD1(11) BUFFER LENGTH A0301657 EQU NOWRD2(12) BUFFER LENGTH A0301658 EQU NOWRD3(13) BUFFER LENGTH A0301659 EQU DATBF1(14) BUFFER ADDRESS A0301660 EQU DATBF2(15) BUFFER ADDRESS A0301661 EQU DATBF3(16) BUFFER ADDRESS A0301662 EQU MMADR1(17) MASS MEMORY ADDRESS A0301663 EQU MMADR2(18) MASS MEMORY ADDRESS A0301664 EQU DXFER1(19) MESSAGE DATA A0301665 EQU DXFER2(20) MESSAGE DATA A0301666 EQU MOTION(21) MOTION PARAMETERS A0301667ÐÐ EQU REQFIL(22) SEQUENTIAL FILE A0301668 EQU TMNATE(23) LIST TERMINATION A0301669 EJT A0301670 SPC 4 A0301671* U S E R P R O G R A M R E Q U E S T P R O C E S S O R A0301672* A0301673* R E A D / W R I T E R E Q U E S T P R O C E S S O R A0301674 SPC 2 A0301675IOPROC ENA 0 A0301676 STA- FILREQ,I INITIALIZE THE DECLARED FILE INDICATOR A0301677 SPC 1 A0301678 LDQ- PARADD,I Q = PARAMETER LIST ADDRESS A0301679 STQ- RSCARG,I SAVE THE I/O COMPLETION A-REGISTER VALUE A0301680 RTJ LUNCHK OBTAIN THE CLASS CODE AND MODE OF THE REQUEST A0301681 SPC 1 A0301682 LDQ- RQCLAS,I Q = DEVICE CLASS CODE A0301683 LDQ* DVTYPE,Q Q = DEVICE TABLE ENTRY A0301684 SQZ IOP030 SKIP IF THE CLASS IS INVALID A0301685 SPC 1 A0301686IOP010 STQ* DEVADD A0301687 LDA- (ZERO),Q OBTAIN THE NEXT PROCESSOR CODES A0301688 STA* MNSAVE AND SAVE A0301689 SPC 1 A0301690IOPNXT CLR Q A0301691 LDA* MNSAVE A0301692ÐÐ LLS 8 POSITION THE NEXT PROCESSOR CODE A0301693 SQZ IOP020 SKIP IF THIS WORD IS EXAUSTED A0301694 STA* MNSAVE A0301695 LDQ* RQPROC,Q GO PROCESS THE NEXT REQUEST PARAMETER A0301696 JMP- (ZERO),Q A0301697 SPC 1 A0301698IOP020 LDQ* DEVADD A0301699 INQ 1 INCREMENT TO THE NEXT TABLE ENTRY A0301700 JMP* IOP010 CONTINUE A0301701 SPC 1 A0301702IOP030 ENQ E07 INVALID LOGICAL UNIT A0301703 LDA- PARADD,I A0301704 LDA- LUNERR,I OBTAIN THE ADDRESS OF THE ERROR A0301705 JMP (ATSER3) PROCESS THE ERROR MESSAGE. A0301706 SPC 2 A0301707* M O N I T O R R E Q U E S T D A T A A N D S T O R A G E A0301708 SPC 2 A0301709DEVADD NUM 0 DEVICE CLASS TABLE ADDRESS A0301710MNSAVE NUM 0 PARAMETER PROCESSOR INDICES A0301711RQXFER NUM 0 USER MONITOR REQUEST ADDRESS A0301712 EJT A0301713 SPC 4 A0301714* R E A D / W R I T E R E Q U E S T P R O C E S S O R A0301715* A0301716* C O M P L E T I O N O F I / O R E Q U E S T A0301717ÐÐ* A0301718* P A R A M E T E R V A L I D A T I O N A0301719 SPC 2 A0301720RVALID LDQ- FALADD,I CALCULATE THE CONTINUATION ADDRESS A0301721 ADQ CONTAD A0301722 RTJ* (ATSPM3) AND VALIDATE IT A0301723 JMP* IOP110 IT IS ILLEGAL A0301724 SPC 1 A0301725 STQ- RSP,I SAVE THE CONTINUATION ADDRESS A0301726 SPC 1 A0301727 LDA- ULIOTB,I CALCULATE THE ADDRESS OF A0301728 INA IORQCD THE MONITOR REQUEST IN THE I/O TABLE A0301729 STA* IOPREQ SAVE A0301730 LDA- I CALCULATE THE ADDRESS OF A0301731 INA RSIORC THE MONITOR REQUEST IN THE LINKAGE BUFFER A0301732 STA* RQXFER SAVE A0301733 SPC 1 A0301734 ENQ 8 A0301735IOP040 LDA* (RQXFER),Q TRANSFER THE REQUEST FROM A0301736 STA* (IOPREQ),Q THE LINKAGE BUFFER TO THE I/O TABLE A0301737 DQP *-IOP040 A0301738 SPC 1 A0301739 SET A A0301740 STA- RSIOTH,I INDICATE THE REQUEST IS ACTIVE A0301741 SPC 1 A0301742ÐÐ LDA- RSBHDR+1,I IS THIS A WRITE-READ REQUEST A0301743 SAZ IOP060 NO A0301744 LDA- WROUTP,I A0301745 STA- RQOUTP,I RESTORE THE USERS OUTPUT DEVICE A0301746 LDA- RSBHDR+3,I A0301747 INA 1 A0301748 ARS 1 A0301749 STA- RSUSLN,I RESTORE THE INPUT LENGTH (WORDS) A0301750 LDA- WRIBUF,I A0301751 STA- RSUSBF,I AND THE INPUT BUFFER A0301752 ENA 0 A0301753 STA- RQTYPE,I INDICATE AN INPUT REQUEST A0301754 EJT A0301755IOP060 LDA- RQCLAS,I A0301756 INA -2 IS THIS A MASS MEMORY REQUEST A0301757 SAN IOP070 NO A0301758 SPC 1 A0301759 LDQ- ULUSTB,I YES A0301760 ENA SXCMMA INDICATE SUSPENSION FOR A MASS MEMORY REQUEST A0301761 STA- USRSTX,Q A0301762 ENQ 1 START ANOTHER USER A0301763 JMP* IOP100 A0301764 SPC 1 A0301765IOP070 LDA- RQTYPE,I A0301766 AND- ONEBIT A0301767ÐÐ TRA Q A0301768 ENA 0 A0301769 SQN IOP080 SKIP IF THIS IS A WRITE REQUEST A0301770 EOR- ONEBIT+IN SPECIFY AN INPUT REQUEST A0301771 SPC 1 A0301772IOP080 LDQ- ULIOTB,I A0301773 IIN 0 A0301774 EOR- IOSTAT,Q UPDATE THE USERS I/O STATUS A0301775 STA- IOSTAT,Q A0301776 EIN 0 A0301777 SPC 1 A0301778 ENQ SXCTMA INDICATE SUSPENSION FOR TERMINAL I/O A0301779 LDA- RQCLAS,I A0301780 INA -8 IS THE REQUEST TO THE TERMINAL A0301781 SAZ IOP090 YES A0301782 ENQ SXCDTA NO, INDICATE SUSPENSION FOR DATA I/O A0301783 SPC 1 A0301784IOP090 TRQ A A0301785 LDQ- ULUSTB,I A0301786 STA- USRSTX,Q SPECIFY THE STATE INDEX A0301787 SPC 1 A0301788 TRQ A A = USER TABLE ADDRESS A0301789 ENQ QPL1 QUEUE PRIORITY = 1 A0301790 RTJ+ ONNSWP PLACE THE USER ON THE NSWP QUEUE A0301791 SPC 1 A0301792ÐÐ ENQ 0 A0301793IOP100 RTJ- (AMONI) MAKE AN INDIRECT MONITOR REQUEST A0301794 ADC $6000 A0301795IOPREQ ADC 0 ADDRESS OF THE REQUEST A0301796 SQN IOP108 SKIP IF A MASS MEMORY REQUEST WAS MADE. A0301797 LDQ- ULIOTB,I Q = ADDRESS OF I/O TABLE. A0301798 IIN 0 A0301799 LDA- IOSTAT,Q SET I/O ACTIVE FLAG AFTER THE A0301800 EOR- ONEBIT+IA MONITOR REQUEST IS COMPLETE. A0301801 EIN 0 A0301802 STA- IOSTAT,Q A0301803 ENQ 0 A0301804IOP108 JMP+ TSTASK START ANOTHER USER. A0301805 SPC 1 A0301806IOP110 TRQ A OBTAIN THE ADDRESS OF THE ERROR A0301807 ENQ E01 PROGRAM PROTECT VIOLATION A0301808 JMP* (ATSER3) PROCESS THE ERROR MESSAGE A0301809 EJT A0301810 SPC 4 A0301811* A0301812* MRQCD1 I/O REQUEST PARAMETER PROCESSOR 1 A0301813* ------ A0301814* MSOS READ - WRITE DEVICE A0301815* A0301816 SPC 2 A0301817ÐÐMRCOD1 LDQ- RQTYPE,I OBTAIN THE REQUEST TYPE A0301818 LDA* RQCOD1,Q GET THE ASSOCIATED REQUEST CODE A0301819 RTJ* MOVMRQ PLACE IT IN THE USER LINKAGE BUFFER A0301820 JMP* IOPNXT GO GET THE NEXT PARAMETER A0301821 SPC 2 A0301822* A0301823* MRCOD2 I/O REQUEST PARAMETER PROCESSOR 2 A0301824* ------ A0301825* MSOS READ - ONLY DEVICE A0301826* A0301827 SPC 2 A0301828 SPC 2 A0301829MRCOD2 ENA 0 SPECIFY READ-ONLY DEVICE A0301830 JMP* MRC010 CONTINUE A0301831 SPC 2 A0301832* A0301833* MRCOD3 I/O REQUEST PARAMETER PROCESSOR 3 A0301834* ------ A0301835* MSOS WRITE - ONLY DEVICE A0301836* A0301837 SPC 2 A0301838MRCOD3 ENA 1 INDICATE A WRITE-ONLY DEVICE A0301839 SPC 1 A0301840MRC010 LDQ- RQTYPE,I A0301841 EAQ A ISOLATE THE TYPE OF OPERATION A0301842ÐÐ AND- ONEBIT IS THE REQUEST VALID FOR THIS DEVICE A0301843 SAN MRC020 NO, INDICATE AN ERROR A0301844 LDA* RQCOD1,Q OBTAIN THE REQUEST CODE A0301845 RTJ* MOVMRQ PLACE IT IN THE USER LINKAGE BUFFER A0301846 JMP* IOPNXT GO GET THE NEXT PARAMETER A0301847 SPC 1 A0301848MRC020 ENQ E05 ILLEGAL MONITOR REQUEST A0301849 LDA- PARADD,I OBTAIN THE ADDRESS OF THE ERROR A0301850 JMP* (ATSER3) PROCESS THE ERROR MESSAGE A0301851 EJT A0301852 SPC 4 A0301853* A0301854* MRCOD4 I/O REQUEST PARAMETER PROCESSOR 4 A0301855* ------ A0301856* TERMINAL READ / WRITE REQUESTS A0301857* A0301858 SPC 2 A0301859MRCOD4 LDQ- RQTYPE,I OBTAIN THE REQUEST TYPE A0301860 LDA* RQCOD2,Q GET THE ASSOCIATED REQUEST CODE A0301861 RTJ* MOVMRQ PLACE IT IN THE USER LINKAGE BUFFER A0301862 JMP* IOPNXT GO GET THE NEXT PARAMETER A0301863 SPC 4 A0301864* REQCOD TABLES OF BUFFERED REQUESTS BASED ON THE A0301865* ------ USERS ACTUAL MONITOR REQUEST A0301866 SPC 2 A0301867ÐÐRQCOD1 ADC $4255 MSOS READ REQUEST A0301868 ADC $4455 MSOS WRITE REQUEST A0301869 ADC $4855 MSOS FREAD REQUEST A0301870 ADC $4C55 MSOS FWRITE REQUEST A0301871 ADC $5C55 MSOS MOTION REQUEST A0301872 ADC $5C55 MSOS MOTION REQUEST A0301873 SPC 2 A0301874RQCOD2 ADC $4455 TMNL READ REQUEST A0301875 ADC $4455 TMNL WRITE REQUEST A0301876 ADC $4C55 TMNL FREAD REQUEST A0301877 ADC $4C55 TMNL FWRITE REQUEST A0301878 EJT A0301879 SPC 4 A0301880* A0301881* MRCMP1 I/O REQUEST PARAMETER PROCESSOR 5 A0301882* ------ A0301883* MSOS DEVICE COMPLETION ADDRESS A0301884* A0301885 SPC 2 A0301886MRCMP1 RTJ* CMPCHK VERIFY THE USERS COMPLETION ADDRESS A0301887 LDA =XTSIOC2 OBTAIN THE EXECUTIVE COMPLETION ADDRESS A0301888 RTJ* MOVMRQ PLACE IT IN THE USER LINKAGE BUFFER A0301889 JMP (AIONXT) GO GET THE NEXT PARAMETER A0301890 SPC 2 A0301891* A0301892ÐÐ* MRCMP2 I/O REQUEST PARAMETER PROCESSOR 6 A0301893* ------ A0301894* TERMINAL DEVICE COMPLETION ADDRESS A0301895* A0301896 SPC 2 A0301897MRCMP2 RTJ* CMPCHK VERIFY THE USERS COMPLETION ADDRESS A0301898 LDA- RQTYPE,I A0301899 AND- ONEBIT A0301900 TRA Q A0301901 ENA 0 READ REQUESTS HAVE NO COMPLETION ADDRESS A0301902 SQZ MRP010 SKIP IF THE REQUEST IS A READ A0301903 SPC 1 A0301904 LDA =XTSIOC1 OBTAIN THE EXECUTIVE COMPLETION ADDRESS A0301905MRP010 RTJ* MOVMRQ PLACE IT IN THE USER LINKAGE BUFFER A0301906 JMP (AIONXT) GO GET THE NEXT PARAMETER A0301907 SPC 2 A0301908ATSER3 ADC TSXERR EXECUTIVE ERROR MESSAGE PROCESSOR A0301909ATSPM3 ADC TSCKPM PARAMETER VERIFICATION ROUTINE A0301910 EJT A0301911 SPC 4 A0301912* A0301913* CMPCHK TSPROT SUBROUTINE USED TO VERIFY THE USERS A0301914* ------ I/O REQUEST COMPLETION ADDRESS A0301915* A0301916* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0301917ÐÐ* A0301918 SPC 2 A0301919CMPCHK NOP 0 A0301920 LDQ- PARADD,I A0301921 LDQ- (ZERO),Q OBTAIN THE COMPLETION ADDRESS A0301922 SQZ CMP010 NO COMPLETION IS LEGAL A0301923 LDA- RSCPAD,I IS A COMPLETION CURRENTLY PENDING A0301924 SAN CMP020 YES, ERROR A0301925 SPC 1 A0301926 RTJ* (ATSPM3) VERIFY THAT THE COMPLETION IS LEGAL A0301927 JMP* CMP030 IT IS NOT A0301928 SPC 1 A0301929 STQ- RSCPAD,I SAVE IT FOR THE I/O COMPLETION A0301930CMP010 JMP* (CMPCHK) RETURN A0301931 SPC 1 A0301932CMP020 ENQ E08 STACKING I/O REQUESTS IS ILLEGAL A0301933 LDA- FALADD,I PICK UP THE ADDRESS OF THE ERROR A0301934 JMP* (ATSER3) PROCESS THE ERROR MESSAGE A0301935 SPC 1 A0301936CMP030 ENQ E01 PROGRAM PROTECT VIOLATION A0301937 LDA- PARADD,I OBTAIN THE ADDRESS OF THE ERROR A0301938 JMP* (ATSER3) PROCESS THE ERROR MESSAGE A0301939 EJT A0301940 SPC 4 A0301941* A0301942ÐÐ* MRTHRD I/O REQUEST PROCESSOR 7 A0301943* ------ A0301944* PROCESS THE REQUEST THREAD A0301945* A0301946 SPC 2 A0301947MRTHRD CLR A INSURE THE THREAD IS CLEAR A0301948 RTJ* MOVMRQ A0301949 JMP* (AIONXT) GO GET THE NEXT PARAMETER A0301950 SPC 4 A0301951* A0301952* MOVMRQ TSPROT SUBROUTINE USED TO TRANSFER THE NEXT A0301953* ------ I/O REQUEST PARAMETER TO THE USER A0301954* LINKAGE BUFFER A0301955* A0301956* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0301957* A = PARAMETER VALUE A0301958* A0301959* EXIT CONDITIONS: A = PARAMETER VALUE A0301960* (PARADD) = (PARADD) + 1 A0301961* A0301962 SPC 2 A0301963MOVMRQ NOP 0 A0301964 LDQ- PMCNTR,I OBTAIN THE NEXT PARAMETER POSITION A0301965 STA- RSIORC,B A0301966 RAO- PARADD,I INCREMENT THE PARAMETER ADDRESS A0301967ÐÐ RAO- PMCNTR,I INCREMENT THE POSITION INDEX A0301968 JMP* (MOVMRQ) RETURN A0301969 EJT A0301970* A0301971* MRLUN1 I/O REQUEST PARAMETER PROCESSOR 8 A0301972* ------ A0301973* MSOS DEVICE LOGICAL UNIT A0301974* A0301975 SPC 2 A0301976MRLUN1 LDA- PORTNO,I IS THE REQUEST FROM THE MASTER TERMINAL A0301977 SAZ MRL010 YES, CONTINUE A0301978 LDA LUWKST NO, IS IT A WORKSTATION LOGICAL UNIT A0301979 SAN MRL010 YES, CONTINUE A0301980 SPC 1 A0301981 ENQ E07 NO, INDICATE AN INVALID LOGICAL UNIT A0301982 LDA- LUNERR,I OBTAIN THE ADDRESS OF THE ERROR A0301983 JMP* (ATSER3) PROCESS THE ERROR MESSAGE A0301984 SPC 1 A0301985MRL010 LDA- ONEBIT+12 INDICATE ASCII MODE A0301986 SPC 1 A0301987MRL020 ADD- REQLUN,I OBTAIN THE REQUESTED LOGICAL UNIT A0301988 RTJ* MOVMRQ PLACE IT IN THE USER LINKAGE BUFFER A0301989 JMP* (AIONXT) GO GET THE NEXT PARAMETER A0301990 SPC 2 A0301991* A0301992ÐÐ* MRLUN2 I/O REQUEST PARAMETER PROCESSOR 9 A0301993* ------ A0301994* MASS MEMORY LOGICAL UNIT A0301995* A0301996 SPC 2 A0301997MRLUN2 ENA 0 DO NOT INCLUDE ASCII MODE A0301998 JMP* MRL020 CONTINUE A0301999 SPC 2 A0302000* A0302001* MRLUN3 I/O REQUEST PARAMETER PROCESSOR 10 A0302002* ------ A0302003* TERMINAL DEVICE LOGICAL UNIT A0302004* A0302005 SPC 2 A0302006MRLUN3 LDQ- ULIOTB,I A0302007 LDA- ONEBIT+TI INDICATE A TERMINAL I/O REQUEST A0302008 IIN 0 A0302009 EOR- IOSTAT,Q A0302010 STA- IOSTAT,Q A0302011 EIN 0 A0302012 LDA- RQMODE,I INCLUDE THE CHARACTER MODE, IF REQUIRED A0302013 JMP* MRL020 CONTINUE A0302014 EJT A0302015* MRSIZ1 I/O REQUEST PARAMETER PROCESSOR 11 A0302016* ------ A0302017ÐÐ* MSOS DEVICE BUFFER SIZE A0302018* A0302019 SPC 2 A0302020MRSIZ1 RTJ* SIZGET OBTAIN AND SAVE THE REQUEST LENGTH A0302021 SPC 1 A0302022MRS010 SAM MRS020 INDIRECT LENGTHS ARE ILLEGAL A0302023 RTJ* MOVMRQ MOVE IT TO THE LINKAGE BUFFER A0302024 LDQ- ULIOTB,I A0302025 LDQ- TERMBF,Q Q = TERMINAL I/O BUFFER ADDRESS A0302026 INQ -1 Q = BUFFER LENGTH ADDRESS A0302027 INA -1 A0302028 SUB- (ZERO),Q IS THE REQUEST TOO LARGE FOR THE BUFFER A0302029 SAP MRS020 YES, ERROR A0302030 JMP* (AIONXT) NO, GO GET THE NEXT PARAMETER A0302031 SPC 1 A0302032MRS020 ENQ E06 ILLEGAL REQUEST PARAMETER A0302033 LDA- PARADD,I A0302034 INA -1 OBTAIN THE ADDRESS OF THE ERROR A0302035 JMP* (ATSER3) PROCESS THE ERROR MESSAGE A0302036 SPC 2 A0302037* A0302038* MRSIZ2 I/O REQUEST PARAMETER PROCESSOR 12 A0302039* ------ A0302040* MASS MEMORY DEVICE BUFFER SIZE A0302041* A0302042ÐÐ SPC 2 A0302043MRSIZ2 LDQ- PARADD,I A0302044 LDA- (ZERO),Q OBTAIN THE REQUEST LENGTH A0302045 STA- RSUSLN,I A0302046 RTJ* MOVMRQ MOVE IT TO THE LINKAGE BUFFER A0302047 JMP* (AIONXT) GO GET THE NEXT PARAMETER A0302048 SPC 2 A0302049* A0302050* MRSIZ3 I/O REQUEST PARAMETER PROCESSOR 13 A0302051* ------ A0302052* TERMINAL DEVICE BUFFER SIZE A0302053* A0302054 SPC 2 A0302055MRSIZ3 RTJ* SIZGET OBTAIN AND SAVE THE REQUEST LENGTH A0302056 TRA Q A0302057 LDA- RQTYPE,I A0302058 AND- ONEBIT IS THIS A READ REQUEST A0302059 SAN MRS030 NO A0302060 ENQ 1 YES, SPECIFY A 1-WORD MESSAGE A0302061MRS030 TRQ A A0302062 JMP* MRS010 CONTINUE A0302063 EJT A0302064 SPC 4 A0302065* A0302066* SIZGET TSPROT SUBROUTINE USED TO OBTAIN AND SAVE A0302067ÐÐ* ------ THE REQUEST MESSAGE LENGTH A0302068* A0302069* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0302070* A0302071* EXIT CONDITIONS: A = LENGTH FOR I/O REQUEST A0302072* A0302073 SPC 2 A0302074SIZGET NOP 0 A0302075 SPC 1 A0302076 LDQ- PARADD,I A0302077* TRUNCATE REQUEST LENGTH IF GREATER THAN TERMINAL BUFFER A0302078 LDQ- ULIOTB,I USER I/O TABLE ADDR. A0302079 LDQ- TERMBF,Q TERMINAL MSG BUF ADDR. A0302080 INQ -1 A0302081 LDA- (ZERO),Q = TERMINAL BUFFER LENGTH A0302082 INA -1 A0302083 STA* WRDLEN LENGTH IN WORDS A0302084 ALS 1 A0302085 INA -1 A0302086 STA* BYTLEN LENGTH IN BYTES A0302087 LDQ- PARADD,I A0302088 LDA- RQMODE,I A0302089 SAN SIZ004 SENSE WORD MODE A0302090 LDA- (ZERO),Q A0302091 SUB* BYTLEN A0302092ÐÐ SAM SIZ006 SENSE REQUEST LENGTH LESS THAN BUFFER A0302093 LDQ* BYTLEN A0302094 INQ -1 USE TRUNCATED LENGTH A0302095 JMP* SIZ008 A0302096SIZ004 LDA- (ZERO),Q A0302097 SUB* WRDLEN A0302098 SAM SIZ006 SENSE REQUEST LENGTH LESS THAN BUFFER A0302099 LDQ* WRDLEN A0302100 INQ -1 USE TRUNCATED LENGTH A0302101 JMP* SIZ008 A0302102SIZ006 LDQ- (ZERO),Q USE REQUEST LENGTH A0302103SIZ008 STQ- TEMPQR,I SAVE A0302104 LDA- RSBHDR+1,I IS THIS A WRITE-READ REQUEST A0302105 SAZ SIZ010 NO A0302106 LDQ- WRILEN,I YES, Q = INPUT LENGTH A0302107SIZ010 LDA- RQMODE,I IS CHARACTER MODE REQUESTED A0302108 SAZ SIZ020 YES A0302109 QLS 1 NO, Q = REQUEST LENGTH IN CHARACTERS A0302110SIZ020 STQ- RSBHDR+3,I SAVE IN WORD 4 OF THE HEADER A0302111 SPC 1 A0302112 LDQ- TEMPQR,I A0302113 SAN SIZ030 SKIP IF WORD MODE A0302114 LRS 1 CONVERT THE LENGTH TO WORDS A0302115 SAP SIZ030 A0302116 INQ 1 A0302117ÐÐ STA- RQMODE,I SAVE THE ODD / EVEN INDICATOR A0302118SIZ030 STQ- RSUSLN,I SAVE THE LENGTH FOR I/O COMPLETION A0302119 TRQ A A0302120 SPC 1 A0302121 JMP* (SIZGET) RETURN A0302122WRDLEN NUM 0 A0302123BYTLEN NUM 0 A0302124 EJT A0302125 SPC 4 A0302126* A0302127* MRBUF1 I/O REQUEST PARAMETER PROCESSOR 14 A0302128* ------ A0302129* MSOS DEVICE BUFFER ADDRESS A0302130* A0302131 SPC 2 A0302132MRBUF1 RTJ* MRBFCK VERIFY THE FWA AND THE LWA OF THE BUFFER A0302133 LDQ- ULIOTB,I A0302134 LDQ- TERMBF,Q SPECIFY THE EXECUTIVE'S BUFFER ADDRESS A0302135 LDA- 4,Q A0302136 STA- RSIOSA,I SPECIFY IT IN THE LINKAGE BUFFER A0302137 LDA- RSBHDR+3,I A0302138 STA- 3,Q SPECIFY THE INPUT LENGTH A0302139 LDA- ONEBIT+12 FORCE WORD MODE A0302140 STA- RQMODE,I A0302141 JMP* (AIONXT) GO GET THE NEXT PARAMETER A0302142ÐÐ SPC 2 A0302143* MRBUF2 I/O REQUEST PARAMETER PROCESSOR 15 A0302144* ------ A0302145* MASS MEMORY BUFFER ADDRESS A0302146* A0302147 SPC 2 A0302148MRBUF2 RTJ* MRBFCK VERIFY THE FWA AND THE LWA OF THE BUFFER A0302149 JMP* (AIONXT) GO GET THE NEXT PARAMETER A0302150 SPC 2 A0302151* MRBUF3 I/O REQUEST PARAMETER PROCESSOR 16 A0302152* ------ A0302153* TMNL DEVICE BUFFER ADDRESS A0302154* A0302155 SPC 2 A0302156MRBUF3 RTJ* MRBFCK VERIFY THE FWA AND THE LWA OF THE BUFFER A0302157 LDQ- ULIOTB,I A0302158 LDA- TERMBF,Q SPECIFY THE BUFFER ADDRESS A0302159 STA- RSIOSA,I A0302160 JMP* (AIONXT) GO GET THE NEXT PARAMETER A0302161 SPC 2 A0302162AIONXT ADC IOPNXT GET NEXT I/O PARAMETER PROCESSOR INDEX A0302163AMOVRQ ADC MOVMRQ MOVE MONITOR REQUEST ROUTINE A0302164 EJT A0302165 SPC 4 A0302166* A0302167ÐÐ* MRBFCK TSPROT SUBROUTINE USED TO VERIFY THE MONITOR A0302168* ------ REQUEST BUFFER ADDRESS AND LENGTH A0302169* A0302170* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0302171 SPC 2 A0302172MRBFCK NOP 0 A0302173 LDA- RQTYPE,I A0302174 AND- ONEBIT IS THIS A WRITE REQUEST A0302175 SAZ MRB010 NO A0302176 SPC 1 A0302177 LDQ- PARADD,I YES, DONT VERIFY THE BUFFER A0302178 LDA- (ZERO),Q OBTAIN THE BUFFER ADDRESS A0302179 RTJ* (AMOVRQ) MOVE IT TO THE LINKAGE BUFFER A0302180 STA- RSUSBF,I SAVE IT FOR I/O COMPLETION A0302181 JMP* (MRBFCK) RETURN A0302182 SPC 1 A0302183MRB010 RTJ* (ATSCK4) OBTAIN AND VERIFY THE FWA OF THE BUFFER A0302184 STQ- RSUSBF,I SAVE FOR THE I/O COMPLETION A0302185 TRQ A A0302186 RTJ* (AMOVRQ) MOVE IT TO THE LINKAGE BUFFER A0302187 LDQ- RSUSBF,I A0302188 ADQ- RSUSLN,I CALCULATE THE BUFFER ENDING ADDRESS A0302189 RTJ* (ATSPM4) VERIFY THE LENGTH A0302190 JMP* MRB020 ERROR A0302191 SPC 1 A0302192ÐÐ RTJ* (ATSMU4) VERIFY AGAINST THE LWA OF THE USER PROGRAM A0302193 JMP* MRB020 ERROR A0302194 SPC 1 A0302195 JMP* (MRBFCK) RETURN A0302196 SPC 1 A0302197MRB020 ENQ E06 ILLEGAL REQUEST PARAMETER A0302198 LDA- PARADD,I A0302199 INA -2 OBTAIN THE ADDRESS OF THE ERROR A0302200 JMP* (ATSER4) PROCESS THE ERROR MESSAGE A0302201 EJT A0302202 SPC 4 A0302203* A0302204* MRMMA1 I/O REQUEST PARAMETER PROCESSOR 17 A0302205* ------ A0302206* MSOS DEVICE SECTOR ADDRESS-CONTROL POINT A0302207* A0302208 SPC 1 A0302209MRMMA1 CLR A PLACE ZERO IN A0302210 RTJ* (AMOVRQ) THE MSB A0302211 RTJ* (AMOVRQ) LSB A0302212 LDA* (ACCP) A0302213 RTJ* (AMOVRQ) MOVE THE CONTROL POINT A0302214 JMP* (AIONXT) GO GET THE NEXT PARAMETER A0302215 SPC 2 A0302216* A0302217ÐÐ* MRMMA2 I/O REQUEST PARAMETER PROCESSOR 18 A0302218* ------ A0302219* MASS MEMORY SECTOR ADDRESS-CONTROL POINT A0302220* A0302221 SPC 1 A0302222MRMMA2 LDQ- ULIOTB,I A0302223 IIN 0 A0302224 LDA- IOSTAT,Q A0302225 EOR- ONEBIT+IA INDICATE I/O IS ACTIVE A0302226 EOR- ONEBIT+MM INDICATE A MASS MEMORY REQUEST A0302227 STA- IOSTAT,Q A0302228 EIN 0 A0302229 SPC 1 A0302230 LDQ- PARADD,I A0302231 LDA- (ZERO),Q OBTAIN THE MSB A0302232 AND- LPMASK+15 A0302233 EOR- ONEBIT+15 SET THE CONTROL POINT INDICATOR A0302234 RTJ* (AMOVRQ) PLACE IT IN THE USER LINKAGE BUFFER A0302235 LDQ- PARADD,I A0302236 LDA- (ZERO),Q OBTAIN THE LSB A0302237 RTJ* (AMOVRQ) PLACE IT IN THE USER LINKAGE BUFFER A0302238 LDA* (ACCP) A0302239 RTJ* (AMOVRQ) PLACE IT IN THE USER LINKAGE BUFFER A0302240 SPC 1 A0302241 LDA* (CNTAD2) A0302242ÐÐ INA -2 IS THE REQUEST INDIRECT A0302243 SAZ MRM010 YES A0302244 INA 4 NO, INCREMENT THE CONTINUATION ADDRESS BY 2 A0302245 STA* (CNTAD2) A0302246 SPC 1 A0302247MRM010 JMP* (AIONXT) GO GET THE NEXT PARAMETER A0302248 EJT A0302249 SPC 4 A0302250* A0302251* MRDAT1 I/O REQUEST PARAMETER PROCESSOR 19 A0302252* ------ A0302253* MSOS DEVICE MESSAGE DATA TRANSFER A0302254* A0302255 SPC 2 A0302256MRDAT1 LDA- RQTYPE,I A0302257 AND- ONEBIT IS THIS A READ REQUEST A0302258 SAZ MRD010 YES, RETURN A0302259 SPC 1 A0302260 LDQ- ULIOTB,I NO A0302261 LDQ- TERMBF,Q A0302262 LDQ- 4,Q Q = DESTINATION ADDRESS A0302263 RTJ* MRDXFR MOVE THE MESSAGE TO THE EXECUTIVE'S BUFFER A0302264 SPC 1 A0302265MRD010 JMP* (AIONXT) GO GET THE NEXT PARAMETER A0302266 SPC 4 A0302267ÐÐ* A0302268* MRDXFR TSPROT SUBROUTINE USED TO TRANSFER DATA FROM A0302269* ------ ONE BUFFER TO ANOTHER A0302270* A0302271* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0302272* Q = DESTINATION ADDRESS A0302273* A0302274 SPC 2 A0302275MRDXFR NOP 0 A0302276 LR1- RSUSBF,I R1 = SOURCE DATA BUFFER ADDRESS A0302277 XFQ 2 R2 = DESTINATION DATA BUFFER ADDRESS A0302278 LDQ- RSUSLN,I A0302279 QLS 1 Q = NUMBER OF CHARACTERS TO MOVE A0302280 SJ4+ MOV TRANSFER THE DATA TO THE USER'S I/O BUFFER A0302281 SPC 1 A0302282 JMP* (MRDXFR) RETURN A0302283 EJT A0302284* MRDAT2 I/O REQUEST PARAMETER PROCESSOR 20 A0302285* ------ A0302286* TMNL DEVICE MESSAGE DATA TRANSFER A0302287* A0302288 SPC 2 A0302289MRDAT2 LDQ- ULIOTB,I A0302290 LDQ- TERMBF,Q Q = HEADER ADDRESS A0302291 LDA- RSBHDR+0,I A0302292ÐÐ STA- (ZERO),Q A0302293 LDA- RSBHDR+1,I A0302294 STA- 1,Q A0302295 LDA- RSBHDR+2,I A0302296 STA- 2,Q SET UP THE MESSAGE HEADER A0302297 LDA- RSBHDR+3,I A0302298 STA- 3,Q A0302299 LDQ- 4,Q Q = MESSAGE ADDRESS A0302300 LDA- RSBHDR+5,I IS A CURSOR POSITION SPECIFIED A0302301 SAM MRD020 NO A0302302 STA- 1,Q YES A0302303 LDA- RSBHDR+4,I A0302304 STA- (ZERO),Q A0302305 INQ 2 INCREASE THE STARTING ADDRESS A0302306MRD020 LDA- RQTYPE,I A0302307 AND- ONEBIT IS THIS A READ REQUEST A0302308 SAZ MRD030 YES A0302309 RTJ* MRDXFR MOVE THE MESSAGE TO THE EXECUTIVE'S BUFFER A0302310 JMP* MRD040 CONTINUE A0302311 SPC 1 A0302312MRD030 LDA* PROMPT A0302313 STA- (ZERO),Q A0302314 SPC 1 A0302315MRD040 LDQ- RSIOLN,I A0302316 LDA- RSBHDR+5,I IS A CURSOR POSITION SPECIFIED A0302317ÐÐ SAM MRD050 NO A0302318 INQ 2 YES, INCREASE THE REQUEST LENGTH A0302319MRD050 LDA- RQMODE,I WAS CHARACTER MODE SPECIFIED A0302320 SAZ MRD060 YES, BUT THE CHARACTER COUNT WAS EVEN A0302321 SAP MRD070 NO A0302322 INQ -1 YES A0302323MRD060 LLS 1 RETURN TO CHARACTER MODE A0302324MRD070 STQ- RSIOLN,I A0302325 STA- RQMODE,I A0302326 SPC 1 A0302327 JMP* (AIONXT) GO GET THE NEXT PARAMETER A0302328 SPC 2 A0302329ATSER4 ADC TSXERR EXECUTIVE ERROR MESSAGE PROCESSOR A0302330ATSCK4 ADC TSPMCK PARAMETER PICKUP AND VERIFICATION ROUTINE A0302331ATSPM4 ADC TSCKPM PARAMETER VERIFICATION ROUTINE A0302332ATSMU4 ADC TSCKMU PARAMETER VERIFICATION ROUTINE A0302333 EJT A0302334 SPC 4 A0302335* A0302336* MRFILE I/O REQUEST PARAMETER PROCESSOR 22 A0302337* ------ A0302338* PROCESS A SEQUENTIAL FILE AND TERMINATE A0302339* A0302340 SPC 2 A0302341MRFILE RAO- FILREQ,I INDICATE A DECLARED FILE REQUEST A0302342ÐÐ SPC 1 A0302343 LDA- RQTYPE,I OBTAIN THE REQUEST TYPE A0302344 AND- ONEBIT A0302345 STA- TEMPQR,I A0302346 SAN MRF010 SKIP IF THIS IS A WRITE REQUEST A0302347 SPC 1 A0302348 RAO- FIRCNO+1,I READ REQUEST, INCREMENT THE RECORD NUMBER A0302349 LDQ- ULIOTB,I A0302350 IIN 0 A0302351 LDA- IOSTAT,Q A0302352 EOR- ONEBIT+IN INDICATE AN INPUT REQUEST A0302353 STA- IOSTAT,Q A0302354 EIN 0 A0302355 JMP* MRF030 CONTINUE A0302356 SPC 1 A0302357MRF010 LDQ- ULIOTB,I A0302358 LDQ- TERMBF,Q A0302359 LDA- 4,Q A0302360 STA* MRXFR2 SPECIFY THE USERS I/O BUFFER ADDRESS A0302361 ENQ 40 A0302362 SPC 1 A0302363MRF020 INQ -1 A0302364 TRQ A A0302365 SUB- RSUSLN,I A0302366 SAM MRF030 A0302367ÐÐ LDA =A BLANK FILL THE REMAINDER OF THE MESSAGE A0302368 STA* (MRXFR2),Q A0302369 JMP* MRF020 A0302370 EJT A0302371 SPC 4 A0302372MRF030 LDQ- TEMPQR,I Q = REQUEST TYPE INDEX A0302373 LDQ* FILRQA,Q A0302374 ADQ- I Q = REQBUF ADDRESS A0302375 SPC 1 A0302376 LDA- PARLST,Q A0302377 INA -4 RESET THE PARAMETER LIST ADDRESS A0302378 STA- PARLST,Q A0302379 SPC 1 A0302380 LDA* (ACCP) A0302381 STA- CNTLPT,Q SPECIFY THE CURRENT CONTROL POINT A0302382 SPC 1 A0302383 TRQ A A0302384 RTJ FMDXFR MOVE THE REQBUF HEADER A0302385 JMP FVALID AND PROCESS THE FILE REQUEST A0302386 SPC 2 A0302387FILRQA ADC IREQBF USER DECLARED INPUT FILE DATA AREA A0302388 ADC OREQBF USER DECLARED OUTPUT FILE DATA AREA A0302389 SPC 4 A0302390* R E A D / W R I T E R E Q U E S T D A T A A0302391* A0302392ÐÐ* A N D S T O R A G E A0302393 SPC 2 A0302394MRXFR2 NUM 0 MESSAGE DATA TRANSFER ADDRESS A0302395ACCP ADC CCP CURRENT CONTROL POINT A0302396CNTAD2 ADC CONTAD CONTINUATION ADDRESS INCREMENT A0302397PROMPT ADC PROMTR INPUT PROMPTER CHARACTER A0302398 EJT A0302399* A0302400* WTREAD USER SUBROUTINE WHICH ALLOWS THE USER TO A0302401* ------ PERFORM A TERMINAL WRITE, IMMEDIATELY A0302402* FOLLOWED BY A TERMINAL READ. THIS A0302403* ELIMINATES A POSSIBLE SWAP BETWEEN THE A0302404* TWO REQUESTS A0302405* A0302406* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0302407* (PARADD) = PARAMETER ADDRESS A0302408* LOCATION A0302409* A0302410 SPC 2 A0302411WTREAD NOP 0 ENTRY FROM UNPROTECTED MEMORY A0302412 IIN 0 A0302413 EIN 0 A0302414 SPC 1 A0302415PPWTRD LDA- RQOUTP,I A0302416 STA- WROUTP,I SAVE THE USERS OUTPUT DEVICE A0302417ÐÐ LDQ- PARADD,I A0302418 LDA- (ZERO),Q A0302419 STA- LUNERR,I SET UP THE LOGICAL UNIT ERROR ADDRESS A0302420 RTJ* GETPRM A0302421 STA* PPWREQ+3 SET UP THE REQUESTED LOGICAL UNIT A0302422 RTJ* GETPRM A0302423 STA- RSBHDR+5,I SET UP THE CURSOR POSITION PRIOR TO OUTPUT A0302424 RTJ* GETPRM A0302425 STQ* PPWREQ+5 SET UP THE OUTPUT BUFFER A0302426 RTJ* GETPRM A0302427 STA* PPWREQ+4 SET UP THE OUTPUT LENGTH A0302428 RTJ* GETPRM A0302429 STA- RSBHDR+2,I SET UP THE CURSOR POSITION PRIOR TO INPUT A0302430 SPC 1 A0302431 RTJ* (ATSCK4) OBTAIN AND CHECK THE INPUT BUFFER ADDRESS A0302432 STQ- WRIBUF,I SAVE A0302433 RAO- PARADD,I A0302434 RTJ* GETPRM A0302435 TRA Q Q = INPUT BUFFER LENGTH A0302436 STQ- WRILEN,I SAVE A0302437 LDA- RQMODE,I IS CHARACTER MODE REQUESTED A0302438 SAN PPW010 NO A0302439 QLS 1 NO, CONVERT TO WORDS A0302440PPW010 ADQ- WRIBUF,I A0302441 RTJ* (ATSPM4) VERIFY THE LWA OF THE INPUT BUFFER A0302442ÐÐ JMP* PPW040 ERROR A0302443 SPC 1 A0302444 RTJ* (ATSMU4) VERIFY AGAINST THE LWA OF THE USER PROGRAM A0302445 JMP* PPW040 ERROR A0302446 SPC 1 A0302447 RTJ* (ATSCK4) OBTAIN AND VERIFY THE TERMINATION CODE A0302448 STQ- WRTCAD,I SAVE THE ADDRESS A0302449 EJT A0302450 SPC 4 A0302451 ENQ 1 INDICATE A WRITE TYPE REQUEST A0302452 LDA- WRILEN,I DOES THE INPUT LENGTH = 0 A0302453 SAZ PPW020 YES, PERFORM A REGULAR WRITE ONLY A0302454 LDA- RQINPT,I NO, HAS THE USER SPECIFIED AN INPUT DEVICE A0302455 SAN PPW030 YES, PERFORM A REGULAR READ ONLY A0302456 SPC 1 A0302457 ENA 0 NO A0302458 STA- RQOUTP,I SPECIFY TERMINAL OUTPUT ONLY A0302459 ENA 3 A0302460 STA- RSBHDR+1,I SPECIFY A WRITE-READ REQUEST A0302461 SPC 1 A0302462PPW020 STQ- RQTYPE,I A0302463 LDA =XPPWREQ A0302464 STA- PARADD,I PARADD = DUMMY REQUEST ADDRESS A0302465 ENA 8 A0302466 STA* (CNTAD2) CONTINUATION INCREMENT = 8 A0302467ÐÐ JMP IOPROC GO PROCESS THE REQUEST A0302468 SPC 1 A0302469PPW030 LDA- WRILEN,I SET UP THE INPUT REQUEST A0302470 STA* PPWREQ+4 A0302471 LDA- WRIBUF,I A0302472 STA* PPWREQ+5 A0302473 ENQ 0 INDICATE A READ TYPE REQUEST A0302474 JMP* PPW020 CONTINUE A0302475 SPC 1 A0302476PPW040 ENQ E06 ILLEGAL REQUEST PARAMETER A0302477 LDA- PARADD,I OBTAIN THE ADDRESS OF THE ERROR A0302478 JMP* (ATSER4) PROCESS THE ERROR MESSAGE A0302479 SPC 2 A0302480* W R I T E - R E A D R E Q U E S T D A T A A0302481* A0302482* A N D S T O R A G E A0302483 SPC 2 A0302484PPWREQ ADC 0 00 - REQUEST CODE A0302485 ADC 0 01 - COMPLETION ADDRESS A0302486 ADC 0 02 - REQUEST THREAD A0302487 ADC 0 03 - LOGICAL UNIT A0302488 ADC 0 04 - MESSAGE LENGTH A0302489 ADC 0 05 - MESSAGE ADDRESS A0302490 EJT A0302491 SPC 4 A0302492ÐÐ* A0302493* GETPRM TSPROT SUBROUTINE USED TO OBTAIN THE NEXT A0302494* ------ FORTRAN-TYPE PARAMETER A0302495* A0302496* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0302497* (PARADD) = NEXT PARAMETER LOCATION A0302498* A0302499* EXIT CONDITIONS: Q = PARAMETER ADDRESS A0302500* A = PARAMETER VALUE A0302501* A0302502 SPC 2 A0302503GETPRM NOP 0 A0302504 SPC 1 A0302505 LDQ- PARADD,I A0302506 LDQ- (ZERO),Q Q = PARAMETER ADDRESS A0302507 LDA- (ZERO),Q A = PARAMETER VALUE A0302508 RAO- PARADD,I A0302509 JMP* (GETPRM) RETURN A0302510 SPC 2 A0302511 END A0302512 NAM TSUREQ A04 A ITOS CCS 3.0 SL-149A0400001* USER PROGRAM REQUEST PROCESSOR A0400002* CREDIT COLLECTION SYSTEM VERSION 3.0 A0400003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A0400004* COPYRIGHT CONTROL DATA CORPORATION 1979 A0400005ÐÐ* A0400006 SPC 2 A0400007* I T O S E N T R Y P O I N T S A0400008 SPC 1 A0400009 ENT PGMIN USER FUNCTION INITIALIZATION ROUTINE A0400010 ENT TSPMIN INITIALIZATION ROUTINE PROCESSOR A0400011 ENT PGMINT USER FUNCTION MANUAL INTERRUPT ROUTINE A0400012 ENT TSINTR MANUAL INTERRUPT PROCESSOR A0400013 ENT PGLUNT USER I/O DEVICE SPECIFICATION ROUTINE A0400014 ENT TSLUNT DEVICE SPECIFICATION PROCESSOR A0400015 ENT SLICUP MULTI-USER TIMESLICE COMPLETION ROUTINE A0400016 ENT TSLCUP TIMESLICE COMPLETION PROCESSOR A0400017 ENT ATTACH MULTI-USER ROOT ATTACHMENT ROUTINE A0400018 ENT TSATTC ATTACH REQUEST PROCESSOR A0400019 ENT CHAIN USER PROGRAM CHAIN ROUTINE A0400020 ENT TSCHAN PROGRAM CHAIN REQUEST PROCESSOR A0400021 ENT TSLMSB LOG-IN PROCESSOR SECTOR ADDRESS A0400022 ENT TSLLSB LOG-IN PROCESSOR SECTOR ADDRESS A0400023 ENT TSLSIZ LOG-IN PROCESSOR LENGTH A0400024 ENT TSXERR EXECUTIVE ERROR MESSAGE PROCESSOR A0400025 ENT PGMOUT USER FUNCTION EXIT ROUTINE A0400026 ENT TSEXIT EXIT REQUEST PROCESSOR A0400027 SPC 4 A0400028* I T O S E X T E R N A L S A0400029 SPC 1 A0400030ÐÐ EXT TSTASK ITOS EXECUTIVE TASK PROCESSOR A0400031 EXT TSAREA ADDRESS OF THE USERS LINKAGE BUFFER A0400032 EXT TSURTN RETURN TO USER PROGRAM (TSTASK) A0400033 EXT TIMSLC MULTI-USER TIMESLICE PROCESSOR (TSTASK) A0400034 EXT TSATCH MULTI-USER ATTACH PROCESSOR (TSTASK) A0400035 EXT TSULBF USER LINKAGE BUFFER SECTOR ADDRESS A0400036 EXT TSNABL ITOS ENABLED INDICATOR A0400037 EXT TSCNAC MASTER TERMINAL ACTIVE INDICATOR A0400038 EXT TERMLU COMMUNICATIONS CONTROLLER LOGICAL UNIT A0400039 EXT TSMMER MASS MEMORY ERROR PROCESSOR A0400040 EXT CCP CURRENT CONTROL POINT A0400041 EXT TSCKPM PARAMETER VERIFICATION ROUTINE A0400042 EXT TSPMCK PARAMETER PICKUP AND VERIFICATION ROUTINE A0400043 EXT CPSET ACTIVATE CONTROL POINT A0400044 EXT CPREL RELEASE CONTROL POINT A0400045 EXT XMREL RELEASE EXECUTION MEMORY A0400046 EXT ONNXUM NXUM QUEUE ENTRY A0400047 EJT A0400048 SPC 4 A0400049* S Y S T E M E X T E R N A L S A0400050 SPC 1 A0400051 EXT PARTBL PARTITIONED MEMORY TABLE ADDRESS A0400052 EXT FSHARE FILE MANAGER FORCED FILE SHARE ROUTINE A0400053 EXT SYFAIL SYSTEM FAILURE PROCESSOR A0400054 SPC 2 A0400055ÐÐ* E Q U I V A L E N C E S A0400056 SPC 1 A0400057 EQU NZERO($12) NEGATIVE ZERO TABLE A0400058 EQU ZERO($22) LOCATION CONTAINING ZERO A0400059 EQU THREE(4) LOCATION CONTAINING THREE A0400060 EQU ADISP($EA) ADDRESS OF DISPATCHER A0400061 EQU AMONI($F4) ADDRESS OF MONITOR REQUEST ENTRY A0400062 EQU QPL1(1) QUEUE PRIORITY = 1 A0400063 EQU QPL2(2) QUEUE PRIORITY = 2 A0400064 EQU QPL3(3) QUEUE PRIORITY = 3 A0400065 EQU QPL4(4) QUEUE PRIORITY = 4 A0400066 EQU E01(01) PROGRAM PROTECT VIOLATION A0400067 EQU E06(06) ILLEGAL REQUEST PARAMETER A0400068 EJT A0400069 SPC 4 A0400070* M U L T I - U S E R P R O G R A M T A B L E E N T R I E S A0400071 SPC 1 A0400072 EQU MUROOT(ZERO) ASSOCIATED ROOT TABLE ADDRESS A0400073 EQU MUSRID(01) PROGRAM IDENTIFICATION - 4 WORDS ASCII A0400074 EQU MUSIZE(05) PROGRAM LENGTH (WORDS) A0400075 EQU MUSECT(06) PROGRAM SECTOR ADDRESS - 2 WORDS A0400076 EQU MUPAGE(08) PROGRAM BASE MEMORY PAGE NUMBER A0400077 EQU ACROOT(09) PROGRAM ACTIVE ROOT COUNT A0400078 EQU MURSIZ(10) PROGRAM TRUE LENGTH (WORDS) A0400079 EQU MUEXTH(11) PROGRAM EXECUTION THREAD A0400080ÐÐ EQU MURSTX(13) PROGRAM STATE INDEX A0400081 EQU MURCLK(15) PROGRAM CLOCK VALUE A0400082 EQU MUITEM(MURCLK+1) A0400083 SPC 2 A0400084* U S E R P R O G R A M U S E R T A B L E E N T R I E S A0400085 SPC 1 A0400086 EQU TSIOTB(ZERO) ASSOCIATED I/O TABLE ADDRESS A0400087 EQU USERID(01) USER IDENTIFICATION - 4 WORDS ASCII A0400088 EQU PGMSIZ(05) USER PROGRAM LENGTH (WORDS) A0400089 EQU PGMSEC(06) USER PROGRAM SECTOR - 2 WORDS A0400090 EQU TWNSEC(08) SWAP TWIN SECTOR - 2 WORDS A0400091 EQU SWPBLK(10) USER SWAP BLOCK BYTES A0400092 EQU NEXETH(11) USER EXECUTION THREAD A0400093 EQU NSWPTH(12) USER SWAP THREAD A0400094 EQU USRSTX(13) USER STATE INDEX A0400095 EQU TSMUTB(14) MULTI USER TABLE ADDRESS A0400096 EQU NUMREQ(15) USER REQUEST COUNT A0400097 EQU USRITM(NUMREQ+1) A0400098 EJT A0400099 SPC 4 A0400100* U S E R P R O G R A M S T A T E I N D I C E S A0400101 SPC 1 A0400102 EQU SXCACT(01) EXECUTING IN MAIN MEMORY A0400103 EQU SXCTSL(02) SUSPENDED IN MAIN MEMORY-TIMESLICE COMPLETE A0400104 EQU SXCMMA(03) SUSPENDED IN MAIN MEMORY-M.M. I/O ACTIVE A0400105ÐÐ EQU SXCMMC(04) SUSPENDED IN MAIN MEMORY-M.M. I/O COMPLETE A0400106 EQU SXCFMA(05) SUSPENDED IN MAIN MEMORY-FILE I/O ACTIVE A0400107 EQU SXCFMC(06) SUSPENDED IN MAIN MEMORY-FILE I/O COMPLETE A0400108 EQU SXCTMA(07) SUSPENDED IN MAIN MEMORY-TMNL I/O ACTIVE A0400109 EQU SXCTMC(08) SUSPENDED IN MAIN MEMORY-TMNL I/O COMPLETE A0400110 EQU SXCDTA(09) SUSPENDED IN MAIN MEMORY-DATA I/O ACTIVE A0400111 EQU SXCDTC(10) SUSPENDED IN MAIN MEMORY-DATA I/O COMPLETE A0400112 EQU SXCATA(11) SUSPENDED IN MAIN MEMORY-ATTACH ACTIVE A0400113 EQU SXCATC(12) SUSPENDED IN MAIN MEMORY-ATTACH COMPLETE A0400114* A0400115 EQU SXMASS(13) RESERVED A0400116 EQU SXMTSL(14) SWAPPED ON MASS MEMORY-TIMESLICE COMPLETE A0400117 EQU SXM015(15) RESERVED A0400118 EQU SXMMMC(16) SWAPPED ON MASS MEMORY-M.M. I/O COMPLETE A0400119 EQU SXM017(17) RESERVED A0400120 EQU SXMFMC(18) SWAPPED ON MASS MEMORY-FILE I/O COMPLETE A0400121 EQU SXMTMA(19) SWAPPED ON MASS MEMORY-TMNL I/O ACTIVE A0400122 EQU SXMTMC(20) SWAPPED ON MASS MEMORY-TMNL I/O COMPLETE A0400123 EQU SXMDTA(21) SWAPPED ON MASS MEMORY-DATA I/O ACTIVE A0400124 EQU SXMDTC(22) SWAPPED ON MASS MEMORY-DATA I/O COMPLETE A0400125 EQU SXMATA(23) SWAPPED ON MASS MEMORY-ATTACH ACTIVE A0400126 EQU SXM024(24) RESERVED A0400127* A0400128 EQU SXMUSA(25) SUSPENDED ON MASS MEMORY-UNSWAP ACTIVE A0400129 EQU SXCUSC(26) SUSPENDED IN MAIN MEMORY-UNSWAP COMPLETE A0400130ÐÐ EQU SXMMUR(27) SUSPENDED ON MASS MEMORY-MULTIUSER READ A0400131 EQU SXMLOG(28) SUSPENDED ON MASS MEMORY-INITIAL LOGIN A0400132 EQU SXMJOB(29) SUSPENDED ON MASS MEMORY-JOB STEP A0400133 SPC 2 A0400134* NOTE - BIT 15 = 1 WHILE THE USER IS BEING SWAPPED A0400135 EJT A0400136 SPC 4 A0400137* U S E R P R O G R A M I / O T A B L E E N T R I E S A0400138 SPC 1 A0400139 EQU TSUSTB(ZERO) ASSOCIATED USER TABLE ADDRESS A0400140 EQU FRQBUF(01) FILE REQUEST BUFFER HEADER (4 WORDS) A0400141 EQU IORQCD(05) INPUT/OUTPUT REQUEST CODE A0400142 EQU IORQCA(06) INPUT/OUTPUT COMPLETION ADDRESS A0400143 EQU IORQTH(07) INPUT/OUTPUT THREAD WORD A0400144 EQU IORQLU(08) INPUT/OUTPUT LOGICAL UNIT A0400145 EQU IOMSLN(09) INPUT/OUTPUT MESSAGE LENGTH A0400146 EQU IOBFAD(10) INPUT/OUTPUT MESSAGE BUFFER ADDRESS A0400147 EQU IOMMSB(11) INPUT/OUTPUT MASS MEMORY ADDRESS A0400148 EQU IOMLSB(12) INPUT/OUTPUT MASS MEMORY ADDRESS A0400149 EQU IOCNPT(13) INPUT/OUTPUT CONTROL POINT A0400150 EQU IOSTAT(14) INPUT/OUTPUT STATUS WORD A0400151 EQU TERMBF(15) TERMINAL MESSAGE BUFFER ADDRESS A0400152 EQU IOITEM(TERMBF+1) A0400153 SPC 2 A0400154* USER PROGRAM I/O STATUS INDICATORS A0400155ÐÐ SPC 1 A0400156* UNSOLICITED INPUT GROUP A0400157 EQU LI(00) TERMINAL LOG-IN A0400158 EQU MN(01) TERMINAL MANUAL INTERRUPT A0400159 EQU ES(02) TERMINAL ESCAPE A0400160* INPUT-OUTPUT ERROR GROUP A0400161 EQU DS(04) TERMINAL DISCONNECT A0400162 EQU ME(05) MASS MEMORY ERROR A0400163 EQU FE(06) FILE REQUEST ERROR A0400164* REQUEST TYPE GROUP A0400165 EQU IN(08) DATA INPUT REQUEST A0400166 EQU IA(09) INPUT / OUTPUT ACTIVE A0400167 EQU IC(10) INPUT / OUTPUT COMPLETE A0400168 EQU MM(11) MASS MEMORY I/O REQUEST A0400169 EQU TI(12) TERMINAL I/O REQUEST A0400170* TERMINAL CHARACTERISTIC GROUP A0400171* A0400172 EQU DY(TI+1) END OF THE DYNAMIC STATUS GROUP A0400173 EJT A0400174* U S E R L I N K A G E B U F F E R E N T R I E S A0400175* A0400176* THE USER LINKAGE BUFFER IMMEDIATELY PRECEEDS THE USER PROGRAM A0400177 SPC 2 A0400178 EQU LASTEP(ZERO) LAST ENTRY TO THE USER PROGRAM A0400179 EQU ULIOTB(001) USERS I/O TABLE ADDRESS A0400180ÐÐ EQU ULUSTB(002) USERS USER TABLE ADDRESS A0400181 EQU RSCLOK(003) USERS REMAINING TIMESLICE A0400182 EQU FALADD(004) PROTECT FAULT ADDRESS A0400183 EQU PARADD(005) CURRENT PARAMETER ADDRESS A0400184 EQU RSP(006) P-REGISTER STORAGE A0400185 EQU RSA(007) A-REGISTER STORAGE A0400186 EQU RSQ(008) Q-REGISTER STORAGE A0400187 EQU RSI(009) I-REGISTER STORAGE A0400188 EQU RSL(010) OVERFLOW STORAGE A0400189 EQU RS1(011) 1-REGISTER STORAGE A0400190 EQU RS2(012) 2-REGISTER STORAGE A0400191 EQU RS3(013) 3-REGISTER STORAGE A0400192 EQU RS4(014) 4-REGISTER STORAGE A0400193 EQU RSUB(015) UPPER BOUNDS REGISTER STORAGE A0400194 EQU RSIORC(016) MONITOR I/O REQUEST CODE A0400195 EQU RSIOCA(017) COMPLETION ADDRESS A0400196 EQU RSIOTH(018) REQUEST THREAD A0400197 EQU RSIOLU(019) MODE + LOGICAL UNIT A0400198 EQU RSIOLN(020) LENGTH A0400199 EQU RSIOSA(021) STARTING ADDRESS A0400200 EQU RSIOMS(022) MASS MEMORY ADDRESS - MSB A0400201 EQU RSIOLS(023) MASS MEMORY ADDRESS - LSB A0400202 EQU RSIOCP(024) MONITOR REQUEST CONTROL POINT A0400203 EQU RQTYPE(025) MONITOR REQUEST TYPE INDEX A0400204 EQU RQCLAS(026) MONITOR REQUEST DEVICE CLASS CODE A0400205ÐÐ EQU RQMODE(027) MONITOR REQUEST CHARACTER MODE INDICATOR A0400206 EQU REQLUN(028) MONITOR REQUEST LOGICAL UNIT A0400207 EQU RSCPAD(029) USERS MONITOR REQUEST COMPLETION ADDRESS A0400208 EQU RSUSLN(030) USERS MONITOR REQUEST MESSAGE LENGTH A0400209 EQU RSUSBF(031) USERS MONITOR REQUEST MESSAGE ADDRESS A0400210 EQU PORTNO(032) MONITOR REQUEST COMMUNICATIONS PORT NUMBER A0400211 EQU RSBHDR(032) MONITOR REQUEST MESSAGE HEADER - 6 WORDS A0400212 EQU WROUTP(038) WRITE-READ USERS OUTPUT LOGICAL UNIT A0400213 EQU WRILEN(039) WRITE-READ INPUT BUFFER LENGTH A0400214 EQU WRIBUF(040) WRITE-READ INPUT BUFFER ADDRESS A0400215 EQU WRTCAD(041) WRITE-READ TERMINATION CODE ADDRESS A0400216 EQU PMCNTR(042) REQUEST PARAMETER COUNT A0400217 EQU RSCARG(043) USERS MONITOR REQUEST COMPLETION A-REGISTER A0400218 EQU RQINPT(044) USERS INPUT LOGICAL UNIT A0400219 EQU RQOUTP(045) USERS OUTPUT LOGICAL UNIT A0400220 EQU RQUN01(046) USERS SPARE LOGICAL UNIT A0400221 EQU RQUN02(047) USERS SPARE LOGICAL UNIT A0400222 EJT A0400223 SPC 4 A0400224* U S E R L I N K A G E B U F F E R E N T R I E S A0400225 SPC 2 A0400226 EQU ERRIDX(048) ERROR MESSAGE INDEX A0400227 EQU ERRADD(049) ERROR MESSAGE ADDRESS A0400228 EQU USRPGM(050) CURRENT USER PROGRAM INDEX A0400229 EQU PGMIDX(051) LOG-IN PROCESSOR PROGRAM INDEX A0400230ÐÐ EQU INTADD(052) PGMINT REQUEST INTERRUPT ADDRESS A0400231 EQU INTFLG(053) PGMINT REQUEST INTERRUPT FLAG ADDRESS A0400232 EQU ATTADR(054) ATTACH REQUEST COMPLETION ADDRESS A0400233 EQU LUNERR(055) ILLEGAL LOGICAL UNIT ERROR ADDRESS A0400234 EQU FMINDX(056) FILE REQUEST TYPE INDEX A0400235 EQU SPARE0(057) SPARE ENTRY A0400236 EQU DATIME(058) DATE AND TIME FOR DAYFILE ENTRY - 6 WORDS A0400237 EQU FRQBFA(064) FILE REQUEST BUFFER ADDRESS A0400238 EQU FILREQ(065) USER DECLARED FILE REQUEST INDICATOR A0400239 EQU FMPMTR(066) FILE REQUEST PARAMETER LIST - 5 WORDS A0400240 EQU CHNAME(071) CHAIN REQUEST PROGRAM NAME - 4 WORDS A0400241 EQU MUFWAD(075) FIRST WORD ADDRESS OF THE MULTI-USER PROGRAM A0400242 EQU TEMPQR(076) TEMPORARY STORAGE - Q REGISTER A0400243 EQU TEMPAR(077) TEMPORARY STORAGE - A REGISTER A0400244 EQU RSC5E5(078) FORTRAN SCRATCH AREA STORAGE - 33 WORDS A0400245 EQU SPARE1(111) SPARE ENTRY A0400246 EQU ENDPRO(111) END OF THE PROTECTED LINKAGE BUFFER AREA A0400247* A0400248 EQU UFPARM(112) USER DECLARED FILE REQUEST PARAMETERS A0400249 EQU FISTAT(128) USER DECLARED FILE REQUEST STATUS A0400250 EQU PFNAME(129) CURRENT PROCEDURE FILE NAME - 4 WORDS A0400251 EQU MENUKY(133) REQUESTED FUNCTION MENU KEY A0400252 EQU USABRT(134) USER PROGRAM ABORT INDICATOR A0400253 EQU USMODE(135) USER EXECUTION MODE INDICATOR A0400254 EQU TMPGMX(136) TEMPORARY - PROGRAM INDEX A0400255ÐÐ EQU TMSECT(137) TEMPORARY - PROGRAM SECTOR - 2 WORDS A0400256 EQU TMPLEN(139) TEMPORARY - PROGRAM LENGTH A0400257 EQU TMUSID(140) TEMPORARY - USER IDENTIFICATION - 4 WORDS A0400258 EQU IREQBF(144) INPUT FILE REQUEST BUFFER AND FCB A0400259 EQU FINAME(188) INPUT FILE NAME - 4 WORDS A0400260 EQU OREQBF(192) OUTPUT FILE REQUEST BUFFER AND FCB A0400261 EQU FONAME(236) OUTPUT FILE NAME - 4 WORDS A0400262 EQU FIRCNO(240) INPUT FILE RECORD NUMBER - 2 WORDS A0400263 EQU LULBUF(256) LENGTH OF THE LINKAGE BUFFER A0400264 EJT A0400265 SPC 4 A0400266* U S E R P R O G R A M P R O T E C T P R O C E S S O R A0400267* A0400268* C O M M O N S U B R O U T I N E P R O C E S S O R S A0400269 SPC 2 A0400270* A0400271* PGMIN USER SUBROUTINE WHICH RETURNS THE USERS A0400272* ----- STATION NUMBER, LOGICAL UNIT, AND A0400273* BASE SCRATCH FILE NUMBER A0400274* A0400275* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0400276* (PARADD) = PARAMETER ADDRESS A0400277* LOCATION A0400278* A0400279 SPC 2 A0400280ÐÐPGMIN NOP 0 ENTRY FROM UNPROTECTED MEMORY A0400281 IIN 0 A0400282 EIN 0 A0400283 SPC 1 A0400284TSPMIN RTJ* (ATSPMC) OBTAIN AND VERIFY THE USER ID BUFFER FWA A0400285 STQ* USXFR2 SAVE IT A0400286 INQ 3 A0400287 RTJ* (ATSCKP) VERIFY THE LWA OF THE ID BUFFER A0400288 JMP* PIN030 INVALID ADDRESS A0400289 SPC 1 A0400290 LDA- ULUSTB,I A0400291 INA USERID A = USER IDENTIFICATION TABLE ADDRESS A0400292 STA* USXFR1 A0400293 ENQ 3 A0400294 SPC 1 A0400295PIN010 LDA* (USXFR1),Q A0400296 STA* (USXFR2),Q MOVE THE USER ID TO THE REQUESTOR'S BUFFER A0400297 DQP *-PIN010 A0400298 EJT A0400299 SPC 4 A0400300 RAO- PARADD,I A0400301 RTJ* (ATSPMC) OBTAIN AND VERIFY THE SECOND PARAMETER A0400302 LDA* ATMNLU A0400303 STA- (ZERO),Q RETURN THE TERMINAL LOGICAL UNIT A0400304 SPC 1 A0400305ÐÐ RAO- PARADD,I A0400306 RTJ* (ATSPMC) OBTAIN AND VERIFY THE THIRD PARAMETER A0400307 LDA- USMODE,I A0400308 STA- (ZERO),Q RETURN THE OPERATING MODE A0400309 SPC 1 A0400310 RAO- PARADD,I A0400311 RTJ* (ATSPMC) OBTAIN AND VERIFY THE FOURTH PARAMETER A0400312 LDA- PORTNO,I A0400313 STA- (ZERO),Q RETURN THE COMMUNICATIONS PORT NUMBER A0400314 SPC 1 A0400315 RAO- PARADD,I A0400316 JMP* SUBXIT RETURN TO THE CALLER A0400317 SPC 1 A0400318PIN030 ENQ E06 ILLEGAL REQUEST PARAMETER A0400319 LDA- PARADD,I OBTAIN THE ADDRESS OF THE ERROR A0400320 JMP* TSXERR PROCESS THE ERROR MESSAGE A0400321 SPC 2 A0400322ATMNLU ADC TERMLU COMMUNICATIONS CONTROLLER LOGICAL UNIT A0400323ATSPMC ADC TSPMCK PARAMETER PICKUP AND VERIFICATION ROUTINE A0400324ATSCKP ADC TSCKPM PARAMETER VERIFICATION ROUTINE A0400325USXFR1 NUM 0 USER IDENTIFICATION TRANSFER ADDRESS A0400326USXFR2 NUM 0 USER IDENTIFICATION TRANSFER ADDRESS A0400327 EJT A0400328 SPC 4 A0400329* A0400330ÐÐ* PGMINT USER SUBROUTINE WHICH ALLOWS THE USER TO A0400331* ------ SPECIFY AN INTERRUPT RESPONSE ADDRESS A0400332* A0400333* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0400334* (PARADD) = PARAMETER ADDRESS A0400335* LOCATION A0400336* A0400337 SPC 2 A0400338PGMINT NOP 0 ENTRY FROM UNPROTECTED MEMORY A0400339 IIN 0 A0400340 EIN 0 A0400341 SPC 1 A0400342TSINTR RTJ* GETPRM OBTAIN THE FIRST PARAMETER A0400343 TRA Q A0400344 SQZ INT010 SKIP IF THE RESPONSE ADDRESS = 0 A0400345 RTJ* (ATSCKP) IS THE SPECIFIED ADDRESS IN THE USER AREA A0400346 JMP* INT030 NO, INDICATE AN ERROR A0400347 SPC 1 A0400348INT010 STQ- INTADD,I YES, SAVE IT IN THE LINKAGE BUFFER A0400349 RTJ* GETPRM OBTAIN THE SECOND PARAMETER A0400350 SQZ INT020 SKIP IF THE FLAG ADDRESS = 0 A0400351 RTJ* (ATSCKP) IS THE SPECIFIED ADDRESS IN THE USER AREA A0400352 JMP* INT030 NO, INDICATE AN ERROR A0400353 SPC 1 A0400354INT020 STQ- INTFLG,I SAVE THE FLAG ADDRESS IN THE LINKAGE BUFFER A0400355ÐÐ SPC 1 A0400356 JMP* SUBXIT RETURN TO THE CALLER A0400357 SPC 1 A0400358INT030 ENQ E06 ILLEGAL REQUEST PARAMETER A0400359 LDA- PARADD,I A0400360 INA -1 INDICATE THE ADDRESS OF THE ERROR A0400361 JMP* TSXERR PROCESS THE ERROR MESSAGE A0400362 EJT A0400363 SPC 4 A0400364* A0400365* PGLUNT USER SUBROUTINE WHICH ALLOWS SPECIFICATION A0400366* ------ OF AN 'INPUT' OR 'OUTPUT' DEVICE. A0400367* IT IS EXPECTED THAT THIS ROUTINE IS A0400368* CALLED ONLY BY THE USER FUNCTION A0400369* 'INPEQ' OR 'OUTEQ'. A0400370* A0400371* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0400372* Q = UNIT TABLE INDEX (0-1) A0400373* A = SPECIFIED UNIT OR FILE A0400374* A0400375 SPC 2 A0400376PGLUNT NOP 0 ENTRY FROM UNPROTECTED MEMORY A0400377 IIN 0 A0400378 EIN 0 A0400379 SPC 1 A0400380ÐÐTSLUNT LDQ- RSQ,I Q = REQUEST INDEX A0400381 LDA- RSA,I A = REQUESTED UNIT A0400382 SPC 1 A0400383 SQM TSL010 INVALID INDEX A0400384 INQ -2 A0400385 SQP TSL010 INVALID INDEX A0400386 SPC 1 A0400387 INQ 2 A0400388 STA- RQINPT,B SAVE THE SPECIFIED UNIT OR FILE A0400389 JMP* SUBXIT RETURN TO THE CALLER A0400390 SPC 1 A0400391TSL010 ENQ E01 PROGRAM PROTECT VIOLATION A0400392 LDA- FALADD,I OBTAIN THE ADDRESS OF THE ERROR A0400393 JMP* TSXERR PROCESS THE ERROR MESSAGE A0400394 EJT A0400395 SPC 4 A0400396* A0400397* SLICUP MULTI-USER SUBROUTINE USED TO PERFORM A A0400398* ------ PSEUDO-TIMESLICE COMPLETION A0400399* A0400400* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0400401* A0400402 SPC 2 A0400403SLICUP NOP 0 ENTRY FROM UNPROTESTED MEMORY A0400404 IIN 0 A0400405ÐÐ EIN 0 A0400406 SPC 1 A0400407TSLCUP LDQ- PARADD,I A0400408 RTJ* (ATSCKP) VERIFY THE RETURN ADDRESS A0400409 JMP* PPA010 THE RETURN IS ILLEGAL A0400410 SPC 1 A0400411 STQ- RSP,I SPECIFY THE RETURN ADDRESS A0400412 SPC 1 A0400413 JMP+ TIMSLC PROCESS THE TIMESLICE REQUEST A0400414 EJT A0400415 SPC 4 A0400416* A0400417* ATTACH MULTI-USER SUBROUTINE USED TO ALLOW A ROOT A0400418* ------ PROGRAM TO BECOME ATTACHED TO A A0400419* MULTI-USER PROGRAM A0400420* A0400421* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0400422* A0400423 SPC 2 A0400424ATTACH NOP 0 ENTRY FROM UNPROTECTED MEMORY A0400425 IIN 0 A0400426 EIN 0 A0400427 SPC 1 A0400428TSATTC RTJ* GETPRM OBTAIN THE ATTACH INDEX A0400429 STA* TSAIDX SAVE A0400430ÐÐ SPC 1 A0400431 RTJ* (ATSPMC) OBTAIN AND VERIFY THE ADDRESS PARAMETER A0400432 STQ- ATTADR,I SAVE A0400433 SPC 1 A0400434 LDQ- PARADD,I A0400435 INQ 1 A0400436 RTJ* (ATSCKP) VERIFY THE RETURN ADDRESS A0400437 JMP* PPA010 THE RETURN IS ILLEGAL A0400438 SPC 1 A0400439 STQ- RSP,I SPECIFY THE RETURN ADDRESS A0400440 LDQ* TSAIDX Q = ATTACH INDEX A0400441 JMP+ TSATCH PROCESS THE ATTACH REQUEST A0400442 SPC 1 A0400443PPA010 ENQ E01 PROGRAM PROTECT VIOLATION A0400444 LDA- PARADD,I OBTAIN THE ADDRESS OF THE ERROR A0400445 JMP* TSXERR PROCESS THE ERROR MESSAGE A0400446 SPC 2 A0400447TSAIDX ADC 0 TEMPORARY STORAGE - ATTACH INDEX A0400448 EJT A0400449 SPC 4 A0400450********************************************************************** A0400451* * A0400452* COMMON EXIT FOR TERMINAL USER SUBROUTINE REQUESTS * A0400453* * A0400454********************************************************************** A0400455ÐÐ SPC 2 A0400456SUBXIT LDQ- PARADD,I OBTAIN THE RETURN ADDRESS A0400457 RTJ* (ATSCKP) IS IT IN THE USER AREA A0400458 JMP* SBX010 NO, INDICATE AN ERROR A0400459 SPC 1 A0400460 STQ- RSP,I YES, SET UP THE USERS RETURN A0400461 JMP+ TSURTN AND EXIT A0400462 SPC 1 A0400463SBX010 ENQ E01 PROGRAM PROTECT VIOLATION A0400464 LDA- PARADD,I OBTAIN THE ADDRESS OF THE ERROR A0400465 JMP* TSXERR PROCESS THE ERROR MESSAGE A0400466 SPC 4 A0400467* A0400468* GETPRM TSUREQ SUBROUTINE USED TO OBTAIN THE NEXT A0400469* ------ FORTRAN-TYPE PARAMETER A0400470* A0400471* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0400472* (PARADD) = NEXT PARAMETER LOCATION A0400473* A0400474* EXIT CONDITIONS: Q = PARAMETER ADDRESS A0400475* A = PARAMETER VALUE A0400476* A0400477 SPC 2 A0400478GETPRM NOP 0 A0400479 SPC 1 A0400480ÐÐ LDQ- PARADD,I A0400481 LDQ- (ZERO),Q Q = PARAMETER ADDRESS A0400482 LDA- (ZERO),Q A = PARAMETER VALUE A0400483 RAO- PARADD,I A0400484 SPC 1 A0400485 JMP* (GETPRM) RETURN A0400486 EJT A0400487 SPC 4 A0400488* A0400489* TSXERR EXECUTIVE ROUTINE WHICH SETS UP USER PROGRAM A0400490* ------ ERROR MESSAGES AND ABORTS THE USER A0400491* PROGRAM BY INITIATING 'TSLOG' A0400492* A0400493* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0400494* Q = ERROR MESSAGE NUMBER A0400495* A = LOCATION OF ERROR A0400496* A0400497 SPC 2 A0400498TSXERR STQ- ERRIDX,I SAVE THE ERROR INDEX A0400499 STA- ERRADD,I AND THE ERROR ADDRESS A0400500 ENQ 2 SET UP THE TSLOG PARAMETER INDEX A0400501 STQ- RSQ,I A0400502 JMP* TSXLOG EXIT TO THE TSLOG PROGRAM A0400503 EJT A0400504 SPC 4 A0400505ÐÐ* CHAIN USER SUBROUTINE WHICH ALLOWS INITIATION OF A0400506* ----- ANOTHER USER FUNCTION A0400507* A0400508* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0400509* (PARADD) = PARAMETER ADDRESS A0400510* LOCATION A0400511* A0400512 SPC 2 A0400513CHAIN NOP 0 ENTRY FROM UNPROTECTED MEMORY A0400514 IIN 0 A0400515 EIN 0 A0400516 SPC 1 A0400517TSCHAN RTJ* GETPRM A0400518 STQ* USXFR1 SAVE THE PROGRAM NAME ADDRESS A0400519 ENQ 3 A0400520 SPC 1 A0400521TSC010 LDA* (USXFR1),Q MOVE THE PROGRAM NAME TO THE LINKAGE BUFFER A0400522 STA- CHNAME,B A0400523 DQP *-TSC010 A0400524 SPC 1 A0400525 ENQ 3 SPECIFY A PROGRAM CHAIN REQUEST A0400526 STQ- RSQ,I A0400527 JMP* TSXLOG INITIATE THE REQUESTED PROGRAM A0400528 EJT A0400529 SPC 4 A0400530ÐÐ* A0400531* PGMOUT USER SUBROUTINE WHICH PROCESSES THE USERS A0400532* ------ REQUEST TO EXIT. THIS ROUTINE IS ALSO A0400533* ENTERED BY THE LOG-IN PROCESSOR (TSLOG) A0400534* DURING THE LOG-IN AND LOG-OUT PROCESS A0400535* A0400536* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0400537* (PARADD) = PARAMETER ADDRESS A0400538* LOCATION A0400539* A0400540 SPC 2 A0400541PGMOUT NOP 0 ENTRY FROM UNPROTECTED MEMORY A0400542 IIN 0 A0400543 EIN 0 A0400544 SPC 1 A0400545TSEXIT LDA- USRPGM,I IS THE CALL FROM TSLOG A0400546 SAN XIT010 NO A0400547 SPC 1 A0400548 LDQ- RSQ,I OBTAIN THE REQUEST INDEX A0400549 LDQ* XITTBL,Q OBTAIN THE REQUEST PROCESSOR ADDRESS A0400550 JMP- (ZERO),Q PROCESS THE REQUEST A0400551 SPC 2 A0400552XITTBL ADC XIT100 00 - FINAL EXIT A0400553 ADC XIT200 01 - START A NEW PROGRAM A0400554 SPC 4 A0400555ÐÐXIT010 ENQ 1 USER PROGRAM TERMINATION A0400556 STQ- RSQ,I SET UP THE TSLOG PARAMETER A0400557 JMP* TSXLOG AND INITIATE THE TSLOG PROGRAM A0400558 EJT A0400559********************************************************************** A0400560* * A0400561* TIMESHARE LOG-OUT INITIATION PROCESSOR * A0400562* * A0400563********************************************************************** A0400564 SPC 1 A0400565TSXLOG LDQ- ULIOTB,I A0400566 IIN 0 A0400567 LDA- IOSTAT,Q A0400568 AND- NZERO+DY CLEAR ANY OUTSTANDING I/O STATUS A0400569 STA- IOSTAT,Q A0400570 EIN 0 A0400571 LDQ- USRPGM,I A0400572 STQ- PGMIDX,I SAVE THE PROGRAM INDEX FOR TSLOG A0400573 ENA 0 A0400574 STA- TMPGMX,I INDICATE THAT TSLOG IS THE ACTIVE PROGRAM A0400575 STA- RSCPAD,I RELEASE ANY I/O COMPLETION ADDRESS A0400576 STA- RQINPT,I RETURN TO TERMINAL I/O A0400577 STA- RQOUTP,I A0400578 STA- USABRT,I RESET THE PROGRAM ABORT INDICATOR A0400579 SQN XTL010 SKIP IF THE REQUEST IS NOT FROM TSLOG A0400580ÐÐ LDQ* APRTBL A0400581 LDA- 2,Q A = START OF THE USER AREA A0400582 STA- RSP,I A0400583 JMP+ TSURTN RETURN TO THE TSLOG PROGRAM A0400584 SPC 1 A0400585XTL010 LDA- ULUSTB,I A0400586 STA- I I = USER TABLE ADDRESS A0400587 RTJ+ FSHARE FORCE SHARE THE USERS FILES A0400588 LDQ- TSMUTB,I IS THE CALLER AN ATTACHED ROOT A0400589 SQZ XTL030 NO A0400590 ENA 0 YES, DETACH THE ROOT A0400591 STA- TSMUTB,I A0400592 LDA- ACROOT,Q A0400593 INA -1 DECREASE THE ACTIVE ROOT COUNT A0400594 SAP XTL020 A0400595 RTJ* (ASYFAL) ILLEGAL ROOT COUNT, FATAL ERROR A0400596XTL020 STA- ACROOT,Q A0400597 SPC 1 A0400598XTL030 LDA* TSLSIZ A0400599 ADD* ULBSIZ A0400600 STA- PGMSIZ,I SPECIFY THE PROGRAM LENGTH A0400601 LDA* TSLMSB A0400602 STA- PGMSEC,I AND THE SECTOR ADDRESS OF TSLOG A0400603 LDA* TSLLSB A0400604 STA- PGMSEC+1,I A0400605ÐÐ LDA* (ATSARA) A0400606 STA- I I = LINKAGE BUFFER ADDRESS A0400607 LDQ- ULUSTB,I Q = USER TABLE ADDRESS A0400608 JMP* XITJOB INITIATE THE LOG-IN PROCESSOR A0400609 EJT A0400610* A0400611* ULBSAV TSUREQ SUBROUTINE USED TO SAVE THE USER A0400612* ------ LINKAGE BUFFER ON MASS MEMORY BETWEEN A0400613* JOB STEPS A0400614* A0400615* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0400616* A0400617* EXIT CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0400618* A0400619 SPC 2 A0400620ULBSAV NOP 0 A0400621 SPC 1 A0400622 LDA- PORTNO,I A0400623 MUI- THREE CALCULATE THE ULB SECTOR FOR THIS PORT A0400624 ADD+ TSULBF A0400625 STA* ULBSEC A0400626 LDA- I A0400627 STA* ULBADD SPECIFY THE START OF THE LINKAGE BUFFER A0400628 LDA* (ACCP) A0400629 STA* ULBCCP A0400630ÐÐ SPC 1 A0400631 RTJ- (AMONI) SAVE THE USER LINKAGE BUFFER A0400632 ADC $6000 A0400633 ADC ULBREQ A0400634 JMP- (ADISP) A0400635 SPC 1 A0400636ULB010 SQP ULB020 A0400637 RTJ+ TSMMER MASS MEMORY ERROR A0400638ULB020 LDA* (ATSARA) A0400639 STA- I RESTORE THE LINKAGE BUFFER ADDRESS A0400640 LDQ* ULBCCP A0400641 RTJ+ CPSET RESTORE THE USERS CONTROL POINT A0400642 SPC 1 A0400643 JMP* (ULBSAV) RETURN A0400644 SPC 2 A0400645ULBREQ ADC $4CF4 FORMATTED WRITE A0400646 ADC ULB010 COMPLETION ADDRESS A0400647 ADC 0 REQUEST THREAD A0400648 ADC $08C2 LOGICAL UNIT A0400649ULBSIZ ADC LULBUF LINKAGE BUFFER LENGTH A0400650ULBADD ADC 0 LINKAGE BUFFER ADDRESS A0400651 NUM $8000 A0400652ULBSEC ADC 0 LINKAGE BUFFER SECTOR A0400653ULBCCP ADC 0 LINKAGE BUFFER CONTROL POINT A0400654 EJT A0400655ÐÐ SPC 4 A0400656* L O G - O U T P R O C E S S O R D A T A A0400657 SPC 2 A0400658ACCP ADC CCP CURRENT SYSTEM CONTROL POINT A0400659ATSARA ADC TSAREA START OF THE ITOS USER AREA A0400660ATSCNC ADC TSCNAC MASTER TERMINAL ACTIVE INDICATOR A0400661ATSNBL ADC TSNABL ITOS ACTIVE INDICATOR A0400662APRTBL ADC PARTBL SYSTEM PARTITIONED MEMORY TABLE A0400663TSLMSB ADC 0 TSLOG SECTOR ADDRESS A0400664TSLLSB ADC 0 TSLOG SECTOR ADDRESS A0400665TSLSIZ ADC 0 TSLOG PROGRAM LENGTH A0400666 EJT A0400667 SPC 4 A0400668********************************************************************** A0400669* * A0400670* REQUEST INDEX = 0 - TIMESHARE USER PROGRAM FINAL EXIT * A0400671* * A0400672********************************************************************** A0400673 SPC 2 A0400674XIT100 LDA- ULUSTB,I A0400675 ENQ USRITM-1 A0400676 RTJ* CLTABL RELEASE THE ITOS USER TABLE A0400677 SPC 1 A0400678 LDQ- ULIOTB,I A0400679 ENA 0 RELEASE THE USER I/O TABLE A0400680ÐÐ STA- (TSUSTB),Q A0400681 SPC 1 A0400682 LDA- PORTNO,I IS THE MASTER CONSOLE LOGGING OFF A0400683 SAN XIT110 NO A0400684 SPC 1 A0400685 ENA 0 YES A0400686 STA* (ATSCNC) INDICATE THE MASTER CONSOLE IS NOT ACTIVE A0400687 SPC 1 A0400688XIT110 LDA* (ATSNBL) IS THE SYSTEM BEING STOPPED A0400689 SAP XIT120 NO A0400690 RAO* (ATSNBL) YES, REMOVE THIS USER FROM THE ACTIVE COUNT A0400691 SPC 1 A0400692XIT120 RTJ* RELPGM RELEASE THE USERS MEMORY AND CONTROL POINT A0400693 SPC 1 A0400694 ENQ 0 START ANOTHER USER A0400695 JMP+ TSTASK A0400696 EJT A0400697********************************************************************** A0400698* * A0400699* REQUEST INDEX = 1 - INITIATE A REQUESTED TIMESHARE PROGRAM * A0400700* * A0400701********************************************************************** A0400702 SPC 2 A0400703XIT200 LDQ- ULUSTB,I A0400704 INQ USERID A0400705ÐÐ LDA- (ZERO),Q IS THE USER IDENTIFICATION DEFINED A0400706 SAN XIT220 YES, CONTINUE A0400707 SPC 1 A0400708 STQ* XITXFR NO A0400709 ENQ 3 A0400710XIT210 LDA- TMUSID,B MOVE THE USER ID. TO THE USER TABLE A0400711 STA* (XITXFR),Q A0400712 DQP *-XIT210 A0400713 SPC 1 A0400714XIT220 LDQ- ULUSTB,I Q = USER TABLE ADDRESS A0400715 LDA- TMSECT+0,I A0400716 STA- PGMSEC+0,Q SPECIFY THE NEW PROGRAMS SECTOR A0400717 LDA- TMSECT+1,I A0400718 STA- PGMSEC+1,Q A0400719 LDA- TMPLEN,I A0400720 ADD* ULBSIZ INCLUDE THE LINKAGE BUFFER IN THE LENGTH A0400721 STA- PGMSIZ,Q SPECIFY THE PROGRAM LENGTH A0400722 SPC 1 A0400723XITJOB ENA SXMJOB SPECIFY A JOB STEP SEQUENCE A0400724 STA- USRSTX,Q A0400725 SPC 1 A0400726 TRQ A A = USER TABLE ADDRESS A0400727 ENQ QPL3 QUEUE PRIORITY = 3 A0400728 RTJ+ ONNXUM ADD THIS USER TO THE NXUM QUEUE A0400729 SPC 1 A0400730ÐÐ RTJ* ULBSAV SAVE THE USER LINKAGE BUFFER A0400731 SPC 1 A0400732 RTJ* RELPGM RELEASE THE USERS MEMORY AND CONTROL POINT A0400733 SPC 1 A0400734 ENQ 0 START ANOTHER USER A0400735 JMP+ TSTASK A0400736 SPC 4 A0400737* D A T A A N D S T O R A G E A0400738 SPC 1 A0400739ASYFAL ADC SYFAIL SYSTEM FAILURE PROCESSOR A0400740XITXFR NUM 0 DATA TRANSFER ADDRESS A0400741 EJT A0400742* A0400743* RELPGM TSUREQ SUBROUTINE USED TO RELEASE THE USERS A0400744* ------ EXECUTION MEMORY AND CONTROL POINT A0400745* A0400746* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0400747* A0400748 SPC 2 A0400749RELPGM NOP 0 A0400750 SPC 1 A0400751 LDA- ULUSTB,I A0400752 STA- I I = USER TABLE ADDRESS A0400753 RTJ+ XMREL RELEASE THE USERS MEMORY A0400754 SQP REL010 A0400755ÐÐ RTJ* (ASYFAL) REQUEST REJECTED, FATAL ERROR A0400756 SPC 1 A0400757REL010 LDQ* (ACCP) A0400758 RTJ+ CPREL RELEASE THE USERS CONTROL POINT A0400759 SPC 1 A0400760 JMP* (RELPGM) RETURN A0400761 SPC 2 A0400762* A0400763* CLTABL TSUREQ SUBROUTINE USED TO PLACE ZEROS IN A A0400764* ------ SPECIFIED TABLE AREA A0400765* A0400766* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0400767* A = FWA TO CLEAR A0400768* Q = NO. OF WORDS TO CLEAR A0400769* A0400770 SPC 2 A0400771CLTABL NOP 0 A0400772 SPC 1 A0400773 STA* XITXFR SAVE THE BASE ADDRESS A0400774 CLR A A0400775 SPC 1 A0400776CLT010 STA* (XITXFR),Q ZERO THE ENTRY A0400777 DQP *-CLT010 A0400778 SPC 1 A0400779 JMP* (CLTABL) RETURN A0400780ÐÐ SPC 2 A0400781 END A0400782 NAM TSIOCP A05 A ITOS CCS 3.0 SL-149A0500001* USER PROGRAM I/O COMPLETION PROCESSOR A0500002* CREDIT COLLECTION SYSTEM VERSION 3.0 A0500003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A0500004* COPYRIGHT CONTROL DATA CORPORATION 1979 A0500005* A0500006 SPC 2 A0500007* I T O S E N T R Y P O I N T S A0500008 SPC 1 A0500009 ENT TSLICE USER TIMESLICE COMPLETION PROCESSOR A0500010 ENT TSUSCP USER UNSWAP COMPLETION PROCESSOR A0500011 ENT TSIOC1 USER I/O COMPLETION PROCESSOR - TYPE 1 A0500012 ENT TSIOC2 USER I/O COMPLETION PROCESSOR - TYPE 2 A0500013 ENT TSFMCP USER FILE REQUEST COMPLETION PROCESSOR A0500014 SPC 2 A0500015* I T O S E X T E R N A L S A0500016 SPC 1 A0500017 EXT TSMMER ITOS EXECUTIVE MASS MEMORY ERROR ROUTINE A0500018 EXT REAREQ UNSWAP REQUEST PARAMETER LIST A0500019 EXT TSPORT I/O TABLE STARTING ADDRESS A0500020 EXT TSPEND I/O TABLE ENDING ADDRESS A0500021 EXT CPSET ACTIVATE CONTROL POINT A0500022 EXT ONNXUC NXUC QUEUE ENTRY A0500023ÐÐ EXT ONNXUM NXUM QUEUE ENTRY A0500024 EXT ONNSWP NSWP QUEUE ENTRY A0500025 EXT DENSWP NSWP QUEUE DELETION A0500026 EXT TSBGIN ITOS EXECUTIVE INITIATION ROUTINE A0500027 EXT TSNABL ITOS ENABLED INDICATOR A0500028 EXT TSCNAC MASTER TERMINAL ACTIVE INDICATOR A0500029 EXT TSOFFM ADDRESS OF THE 'OFF UNTIL MESSAGE' A0500030 EXT TSLOFF LENGTH OF THE 'OFF UNTIL MESSAGE' A0500031 EXT TSACTV ITOS ACTIVE INDICATOR A0500032 EXT EXPIRE MULTI-USER TIMESLICE SEMAPHORE A0500033 EXT TSCKPM PARAMETER VERIFICATION ROUTINE A0500034 EXT TSVFTN FORTRAN AREA SAVE ROUTINE A0500035 EXT TSAREA START OF THE ITOS USER AREA A0500036 SPC 2 A0500037* S Y S T E M E X T E R N A L S A0500038 SPC 1 A0500039 EXT SYFAIL SYSTEM FAILURE PROCESSOR A0500040 EXT LOG1A SYSTEM DEVICE TABLE A0500041 EJT A0500042* E Q U I V A L E N C E S A0500043 SPC 1 A0500044 EQU LPMASK($2) BIT MASK TABLE A0500045 EQU NZERO($12) NEGATIVE ZERO TABLE A0500046 EQU ZERO($22) LOCATION CONTAINING ZERO A0500047 EQU ONEBIT($23) SINGLE BIT TABLE A0500048ÐÐ EQU ZROBIT($33) ZERO BIT TABLE A0500049 EQU INTSTK($B8) TOP ENTRY IN THE INTERRUPT STACK A0500050 EQU ADISP($EA) ADDRESS OF DISPATCHER A0500051 EQU AMONI($F4) ADDRESS OF MONITOR REQUEST ENTRY A0500052 EQU EXTSTK(27) EXTENDED INTERRUPT STACK (EXT. CORE TABLE) A0500053 EQU ESTAT2(12) DEVICE STATUS ENTRY IN THE P. D. T. A0500054 EQU LOGIN($2B) LOG-IN CHARACTER (PLUS SIGN) A0500055 EQU ESCAP(05) ESCAPE FUNCTION TERMINATION CODE A0500056 EQU MANIN(06) MANUAL INTERRUPT TERMINATION CODE A0500057 EQU USRADD(9) UNSWAP REQUEST USER TABLE ADDRESS PARAMETER A0500058 EQU QPL4(4) QUEUE PRIORITY = 4 A0500059 EQU QPL3(3) QUEUE PRIORITY = 3 A0500060 EQU QPL2(2) QUEUE PRIORITY = 2 A0500061 EQU QPL1(1) QUEUE PRIORITY = 1 A0500062 EJT A0500063 SPC 4 A0500064* M U L T I - U S E R P R O G R A M T A B L E E N T R I E S A0500065 SPC 1 A0500066 EQU MUROOT(ZERO) ASSOCIATED ROOT TABLE ADDRESS A0500067 EQU MUSRID(01) PROGRAM IDENTIFICATION - 4 WORDS ASCII A0500068 EQU MUSIZE(05) PROGRAM LENGTH (WORDS) A0500069 EQU MUSECT(06) PROGRAM SECTOR ADDRESS - 2 WORDS A0500070 EQU MUPAGE(08) PROGRAM BASE MEMORY PAGE NUMBER A0500071 EQU ACROOT(09) PROGRAM ACTIVE ROOT COUNT A0500072 EQU MURSIZ(10) PROGRAM TRUE LENGTH (WORDS) A0500073ÐÐ EQU MUEXTH(11) PROGRAM EXECUTION THREAD A0500074 EQU MURSTX(13) PROGRAM STATE INDEX A0500075 EQU MURCLK(15) PROGRAM CLOCK VALUE A0500076 EQU MUITEM(MURCLK+1) A0500077 SPC 2 A0500078* U S E R P R O G R A M U S E R T A B L E E N T R I E S A0500079 SPC 1 A0500080 EQU TSIOTB(ZERO) ASSOCIATED I/O TABLE ADDRESS A0500081 EQU USERID(01) USER IDENTIFICATION - 4 WORDS ASCII A0500082 EQU PGMSIZ(05) USER PROGRAM LENGTH (WORDS) A0500083 EQU PGMSEC(06) USER PROGRAM SECTOR - 2 WORDS A0500084 EQU TWNSEC(08) SWAP TWIN SECTOR - 2 WORDS A0500085 EQU SWPBLK(10) USER SWAP BLOCK BYTES A0500086 EQU NEXETH(11) USER EXECUTION THREAD A0500087 EQU NSWPTH(12) USER SWAP THREAD A0500088 EQU USRSTX(13) USER STATE INDEX A0500089 EQU TSMUTB(14) MULTI USER TABLE ADDRESS A0500090 EQU NUMREQ(15) USER REQUEST COUNT A0500091 EQU USRITM(NUMREQ+1) A0500092 EJT A0500093 SPC 4 A0500094* U S E R P R O G R A M S T A T E I N D I C E S A0500095 SPC 1 A0500096 EQU SXCACT(01) EXECUTING IN MAIN MEMORY A0500097 EQU SXCTSL(02) SUSPENDED IN MAIN MEMORY-TIMESLICE COMPLETE A0500098ÐÐ EQU SXCMMA(03) SUSPENDED IN MAIN MEMORY-M.M. I/O ACTIVE A0500099 EQU SXCMMC(04) SUSPENDED IN MAIN MEMORY-M.M. I/O COMPLETE A0500100 EQU SXCFMA(05) SUSPENDED IN MAIN MEMORY-FILE I/O ACTIVE A0500101 EQU SXCFMC(06) SUSPENDED IN MAIN MEMORY-FILE I/O COMPLETE A0500102 EQU SXCTMA(07) SUSPENDED IN MAIN MEMORY-TMNL I/O ACTIVE A0500103 EQU SXCTMC(08) SUSPENDED IN MAIN MEMORY-TMNL I/O COMPLETE A0500104 EQU SXCDTA(09) SUSPENDED IN MAIN MEMORY-DATA I/O ACTIVE A0500105 EQU SXCDTC(10) SUSPENDED IN MAIN MEMORY-DATA I/O COMPLETE A0500106 EQU SXCATA(11) SUSPENDED IN MAIN MEMORY-ATTACH ACTIVE A0500107 EQU SXCATC(12) SUSPENDED IN MAIN MEMORY-ATTACH COMPLETE A0500108* A0500109 EQU SXMASS(13) RESERVED A0500110 EQU SXMTSL(14) SWAPPED ON MASS MEMORY-TIMESLICE COMPLETE A0500111 EQU SXM015(15) RESERVED A0500112 EQU SXMMMC(16) SWAPPED ON MASS MEMORY-M.M. I/O COMPLETE A0500113 EQU SXM017(17) RESERVED A0500114 EQU SXMFMC(18) SWAPPED ON MASS MEMORY-FILE I/O COMPLETE A0500115 EQU SXMTMA(19) SWAPPED ON MASS MEMORY-TMNL I/O ACTIVE A0500116 EQU SXMTMC(20) SWAPPED ON MASS MEMORY-TMNL I/O COMPLETE A0500117 EQU SXMDTA(21) SWAPPED ON MASS MEMORY-DATA I/O ACTIVE A0500118 EQU SXMDTC(22) SWAPPED ON MASS MEMORY-DATA I/O COMPLETE A0500119 EQU SXMATA(23) SWAPPED ON MASS MEMORY-ATTACH ACTIVE A0500120 EQU SXM024(24) RESERVED A0500121* A0500122 EQU SXMUSA(25) SUSPENDED ON MASS MEMORY-UNSWAP ACTIVE A0500123ÐÐ EQU SXCUSC(26) SUSPENDED IN MAIN MEMORY-UNSWAP COMPLETE A0500124 EQU SXMMUR(27) SUSPENDED ON MASS MEMORY-MULTIUSER READ A0500125 EQU SXMLOG(28) SUSPENDED ON MASS MEMORY-INITIAL LOGIN A0500126 EQU SXMJOB(29) SUSPENDED ON MASS MEMORY-JOB STEP A0500127 SPC 2 A0500128* NOTE - BIT 15 = 1 WHILE THE USER IS BEING SWAPPED A0500129 EJT A0500130 SPC 4 A0500131* U S E R P R O G R A M I / O T A B L E E N T R I E S A0500132 SPC 1 A0500133 EQU TSUSTB(ZERO) ASSOCIATED USER TABLE ADDRESS A0500134 EQU FRQBUF(01) FILE REQUEST BUFFER HEADER (4 WORDS) A0500135 EQU IORQCD(05) INPUT/OUTPUT REQUEST CODE A0500136 EQU IORQCA(06) INPUT/OUTPUT COMPLETION ADDRESS A0500137 EQU IORQTH(07) INPUT/OUTPUT THREAD WORD A0500138 EQU IORQLU(08) INPUT/OUTPUT LOGICAL UNIT A0500139 EQU IOMSLN(09) INPUT/OUTPUT MESSAGE LENGTH A0500140 EQU IOBFAD(10) INPUT/OUTPUT MESSAGE BUFFER ADDRESS A0500141 EQU IOMMSB(11) INPUT/OUTPUT MASS MEMORY ADDRESS A0500142 EQU IOMLSB(12) INPUT/OUTPUT MASS MEMORY ADDRESS A0500143 EQU IOCNPT(13) INPUT/OUTPUT CONTROL POINT A0500144 EQU IOSTAT(14) INPUT/OUTPUT STATUS WORD A0500145 EQU TERMBF(15) TERMINAL MESSAGE BUFFER ADDRESS A0500146 EQU IOITEM(TERMBF+1) A0500147 SPC 2 A0500148ÐÐ* USER PROGRAM I/O STATUS INDICATORS A0500149 SPC 1 A0500150* UNSOLICITED INPUT GROUP A0500151 EQU LI(00) TERMINAL LOG-IN A0500152 EQU MN(01) TERMINAL MANUAL INTERRUPT A0500153 EQU ES(02) TERMINAL ESCAPE A0500154* INPUT-OUTPUT ERROR GROUP A0500155 EQU DS(04) TERMINAL DISCONNECT A0500156 EQU ME(05) MASS MEMORY ERROR A0500157 EQU FE(06) FILE REQUEST ERROR A0500158* REQUEST TYPE GROUP A0500159 EQU IN(08) DATA INPUT REQUEST A0500160 EQU IA(09) INPUT / OUTPUT ACTIVE A0500161 EQU IC(10) INPUT / OUTPUT COMPLETE A0500162 EQU MM(11) MASS MEMORY I/O REQUEST A0500163 EQU TI(12) TERMINAL I/O REQUEST A0500164* TERMINAL CHARACTERISTIC GROUP A0500165* A0500166 EQU DY(TI+1) END OF THE DYNAMIC STATUS GROUP A0500167 EJT A0500168* U S E R L I N K A G E B U F F E R E N T R I E S A0500169* A0500170* THE USER LINKAGE BUFFER IMMEDIATELY PRECEEDS THE USER PROGRAM A0500171 SPC 2 A0500172 EQU LASTEP(ZERO) LAST ENTRY TO THE USER PROGRAM A0500173ÐÐ EQU ULIOTB(001) USERS I/O TABLE ADDRESS A0500174 EQU ULUSTB(002) USERS USER TABLE ADDRESS A0500175 EQU RSCLOK(003) USERS REMAINING TIMESLICE A0500176 EQU FALADD(004) PROTECT FAULT ADDRESS A0500177 EQU PARADD(005) CURRENT PARAMETER ADDRESS A0500178 EQU RSP(006) P-REGISTER STORAGE A0500179 EQU RSA(007) A-REGISTER STORAGE A0500180 EQU RSQ(008) Q-REGISTER STORAGE A0500181 EQU RSI(009) I-REGISTER STORAGE A0500182 EQU RSL(010) OVERFLOW STORAGE A0500183 EQU RS1(011) 1-REGISTER STORAGE A0500184 EQU RS2(012) 2-REGISTER STORAGE A0500185 EQU RS3(013) 3-REGISTER STORAGE A0500186 EQU RS4(014) 4-REGISTER STORAGE A0500187 EQU RSUB(015) UPPER BOUNDS REGISTER STORAGE A0500188 EQU RSIORC(016) MONITOR I/O REQUEST CODE A0500189 EQU RSIOCA(017) COMPLETION ADDRESS A0500190 EQU RSIOTH(018) REQUEST THREAD A0500191 EQU RSIOLU(019) MODE + LOGICAL UNIT A0500192 EQU RSIOLN(020) LENGTH A0500193 EQU RSIOSA(021) STARTING ADDRESS A0500194 EQU RSIOMS(022) MASS MEMORY ADDRESS - MSB A0500195 EQU RSIOLS(023) MASS MEMORY ADDRESS - LSB A0500196 EQU RSIOCP(024) MONITOR REQUEST CONTROL POINT A0500197 EQU RQTYPE(025) MONITOR REQUEST TYPE INDEX A0500198ÐÐ EQU RQCLAS(026) MONITOR REQUEST DEVICE CLASS CODE A0500199 EQU RQMODE(027) MONITOR REQUEST CHARACTER MODE INDICATOR A0500200 EQU REQLUN(028) MONITOR REQUEST LOGICAL UNIT A0500201 EQU RSCPAD(029) USERS MONITOR REQUEST COMPLETION ADDRESS A0500202 EQU RSUSLN(030) USERS MONITOR REQUEST MESSAGE LENGTH A0500203 EQU RSUSBF(031) USERS MONITOR REQUEST MESSAGE ADDRESS A0500204 EQU PORTNO(032) MONITOR REQUEST COMMUNICATIONS PORT NUMBER A0500205 EQU RSBHDR(032) MONITOR REQUEST MESSAGE HEADER - 6 WORDS A0500206 EQU WROUTP(038) WRITE-READ USERS OUTPUT LOGICAL UNIT A0500207 EQU WRILEN(039) WRITE-READ INPUT BUFFER LENGTH A0500208 EQU WRIBUF(040) WRITE-READ INPUT BUFFER ADDRESS A0500209 EQU WRTCAD(041) WRITE-READ TERMINATION CODE ADDRESS A0500210 EQU PMCNTR(042) REQUEST PARAMETER COUNT A0500211 EQU RSCARG(043) USERS MONITOR REQUEST COMPLETION A-REGISTER A0500212 EQU RQINPT(044) USERS INPUT LOGICAL UNIT A0500213 EQU RQOUTP(045) USERS OUTPUT LOGICAL UNIT A0500214 EQU RQUN01(046) USERS SPARE LOGICAL UNIT A0500215 EQU RQUN02(047) USERS SPARE LOGICAL UNIT A0500216 EJT A0500217 SPC 4 A0500218* U S E R L I N K A G E B U F F E R E N T R I E S A0500219 SPC 2 A0500220 EQU ERRIDX(048) ERROR MESSAGE INDEX A0500221 EQU ERRADD(049) ERROR MESSAGE ADDRESS A0500222 EQU USRPGM(050) CURRENT USER PROGRAM INDEX A0500223ÐÐ EQU PGMIDX(051) LOG-IN PROCESSOR PROGRAM INDEX A0500224 EQU INTADD(052) PGMINT REQUEST INTERRUPT ADDRESS A0500225 EQU INTFLG(053) PGMINT REQUEST INTERRUPT FLAG ADDRESS A0500226 EQU ATTADR(054) ATTACH REQUEST COMPLETION ADDRESS A0500227 EQU LUNERR(055) ILLEGAL LOGICAL UNIT ERROR ADDRESS A0500228 EQU FMINDX(056) FILE REQUEST TYPE INDEX A0500229 EQU SPARE0(057) SPARE ENTRY A0500230 EQU DATIME(058) DATE AND TIME FOR DAYFILE ENTRY - 6 WORDS A0500231 EQU FRQBFA(064) FILE REQUEST BUFFER ADDRESS A0500232 EQU FILREQ(065) USER DECLARED FILE REQUEST INDICATOR A0500233 EQU FMPMTR(066) FILE REQUEST PARAMETER LIST - 5 WORDS A0500234 EQU CHNAME(071) CHAIN REQUEST PROGRAM NAME - 4 WORDS A0500235 EQU MUFWAD(075) FIRST WORD ADDRESS OF THE MULTI-USER PROGRAM A0500236 EQU TEMPQR(076) TEMPORARY STORAGE - Q REGISTER A0500237 EQU TEMPAR(077) TEMPORARY STORAGE - A REGISTER A0500238 EQU RSC5E5(078) FORTRAN SCRATCH AREA STORAGE - 33 WORDS A0500239 EQU SPARE1(111) SPARE ENTRY A0500240 EQU ENDPRO(111) END OF THE PROTECTED LINKAGE BUFFER AREA A0500241* A0500242 EQU UFPARM(112) USER DECLARED FILE REQUEST PARAMETERS A0500243 EQU FISTAT(128) USER DECLARED FILE REQUEST STATUS A0500244 EQU PFNAME(129) CURRENT PROCEDURE FILE NAME - 4 WORDS A0500245 EQU MENUKY(133) REQUESTED FUNCTION MENU KEY A0500246 EQU USABRT(134) USER PROGRAM ABORT INDICATOR A0500247 EQU USMODE(135) USER EXECUTION MODE INDICATOR A0500248ÐÐ EQU TMPGMX(136) TEMPORARY - PROGRAM INDEX A0500249 EQU TMSECT(137) TEMPORARY - PROGRAM SECTOR - 2 WORDS A0500250 EQU TMPLEN(139) TEMPORARY - PROGRAM LENGTH A0500251 EQU TMUSID(140) TEMPORARY - USER IDENTIFICATION - 4 WORDS A0500252 EQU IREQBF(144) INPUT FILE REQUEST BUFFER AND FCB A0500253 EQU FINAME(188) INPUT FILE NAME - 4 WORDS A0500254 EQU OREQBF(192) OUTPUT FILE REQUEST BUFFER AND FCB A0500255 EQU FONAME(236) OUTPUT FILE NAME - 4 WORDS A0500256 EQU FIRCNO(240) INPUT FILE RECORD NUMBER - 2 WORDS A0500257 EQU LULBUF(256) LENGTH OF THE LINKAGE BUFFER A0500258 EJT A0500259********************************************************************** A0500260* * A0500261* USER TIMESLICE COMPLETION PROCESSOR * A0500262* * A0500263* ENTRY CONDITIONS: (TSACTV) = USERS EXECUTION THREAD * A0500264* * A0500265********************************************************************** A0500266 SPC 2 A0500267TSLICE LDQ* (ATSACT) IS A USER ACTIVE A0500268 SQN TSL010 YES A0500269 JMP- (ADISP) NO, IGNORE THE FINAL TIMESLICE ENTRY A0500270 SPC 1 A0500271TSL010 INQ -NEXETH Q = ACTIVE USER TABLE ADDRESS A0500272 LDQ- (TSIOTB),Q A0500273ÐÐ LDQ- IOCNPT,Q OBTAIN THE USERS CONTROL POINT A0500274 RTJ+ CPSET AND ACTIVATE IT A0500275 SPC 1 A0500276 LDA+ TSAREA A0500277 STA- I I = LINKAGE BUFFER ADDRESS A0500278 LDQ- ULUSTB,I A0500279 LDA- TSMUTB,Q IS THE ENTRY FROM A MULTI-USER ROOT A0500280 SAZ TSL020 NO A0500281 STA+ EXPIRE YES SET THE TIMESLICE SEMAPHORE A0500282 JMP- (ADISP) AND EXIT A0500283 SPC 1 A0500284TSL020 RTJ* INTUSR INTERRUPT THE USER A0500285 SPC 1 A0500286 LDA- ULUSTB,I OBTAIN THE USER TABLE ADDRESS A0500287 ENQ QPL1 QUEUE PRIORITY = 1 A0500288 RTJ+ ONNSWP PLACE THE USER ON THE NSWP QUEUE A0500289 LDA- ULUSTB,I OBTAIN THE USER TABLE ADDRESS A0500290 ENQ QPL1 QUEUE PRIORITY = 1 A0500291 RTJ+ ONNXUC PLACE THE USER ON THE NXUC QUEUE A0500292 SPC 1 A0500293 LDQ- ULUSTB,I OBTAIN THE USER TABLE ADDRESS A0500294 ENA SXCTSL INDICATE THE USER'S TIMESLICE HAS EXPIRED A0500295 STA- USRSTX,Q A0500296 SPC 1 A0500297 IIN 0 A0500298ÐÐ ENA 0 A0500299 STA* (ATSACT) INDICATE THE USER IS INACTIVE A0500300 JMP* CASTRT START ANOTHER USER A0500301 SPC 2 A0500302ATSACT ADC TSACTV ITOS ACTIVE INDICATOR A0500303 EJT A0500304* A0500305* INTUSR TSIOCP SUBROUTINE WHICH STOPS THE EXECUTION A0500306* ------ OF A USER PROGRAM AND SAVES ALL THE A0500307* NECESSARY DATA IN THE LINKAGE BUFFER A0500308* A0500309* ENTRY CONDITIONS: I = ADDR. OF LINKAGE BUFFER A0500310 SPC 2 A0500311INTUSR NOP 0 A0500312 SPC 1 A0500313 LDQ- INTSTK Q = TOP OF THE INTERRUPT STACK A0500314 INQ -5 Q = INTERRUPTED USER ENTRY A0500315 LDA- 3,Q A0500316 LLS 16 Q = USERS P-REGISTER A0500317 RTJ+ TSCKPM IS IT WITHIN THE USER AREA A0500318 JMP* INT020 NO, ERROR A0500319 SPC 1 A0500320 TRA Q MOVE THE USERS REGISTERS A0500321 LDA- (ZERO),Q FROM THE INTERRUPT STACK A0500322 STA- RSQ,I Q-REGISTER A0500323ÐÐ LDA- 1,Q A0500324 STA- RSA,I A-REGISTER A0500325 LDA- 2,Q A0500326 STA- RSI,I I-REGISTER A0500327 LDA- 3,Q A0500328 STA- RSP,I P-REGISTER A0500329 LDA- 4,Q A0500330 STA- RSL,I PRIORITY LEVEL AND OVERFLOW A0500331 SPC 1 A0500332 LDA- ADISP SET THE RETURN IN THE INTERRUPT STACK A0500333 STA- 3,Q TO THE ADDRESS OF THE DISPATCHER A0500334 SPC 1 A0500335 LDQ- $E9 A0500336 LDQ- EXTSTK,Q Q = ADDRESS OF THE EXTENDED INTERRUPT STACK A0500337 INQ -5 Q = INTERRUPTED USER ENTRY A0500338 LDA- (ZERO),Q A0500339 STA- RS1,I 1-REGISTER A0500340 LDA- 1,Q A0500341 STA- RS2,I 2-REGISTER A0500342 LDA- 2,Q A0500343 STA- RS3,I 3-REGISTER A0500344 LDA- 3,Q A0500345 STA- RS4,I 4-REGISTER A0500346 SPC 1 A0500347 RTJ+ TSVFTN SAVE THE USER FORTRAN SCRATCH AREA A0500348ÐÐ JMP* (INTUSR) AND RETURN A0500349 SPC 1 A0500350INT020 RTJ* (ASYFAL) USER NOT ON THE INTERRUPT STACK A0500351 EJT A0500352 SPC 4 A0500353********************************************************************** A0500354* * A0500355* USER UNSWAP COMPLETION PROCESSOR * A0500356* * A0500357* ENTRY CONDITIONS: A = PARAMETER LIST ADDRESS * A0500358* Q = V-FIELD (BITS 13-15) * A0500359* * A0500360********************************************************************** A0500361 SPC 2 A0500362TSUSCP SUB* AREREQ IS THE PARAMETER LIST VALID A0500363 SAZ TSU010 YES A0500364 RTJ* (ASYFAL) NO, FATAL ERROR A0500365 SPC 1 A0500366TSU010 SQP TSU020 SKIP IF THERE IS NO ERROR A0500367 RTJ+ TSMMER MASS MEMORY ERROR A0500368 SPC 1 A0500369TSU020 LDQ* AREREQ Q = PARAMETER LIST ADDRESS A0500370 LDA- USRADD,Q A = USER TABLE ADDRESS A0500371 ENQ QPL1 QUEUE PRIORITY = 1 A0500372 RTJ+ ONNXUC PLACE THE USER ON THE NXUC QUEUE A0500373ÐÐ SPC 1 A0500374 ENQ 1 A0500375 RTJ* (ATSBGN) START THE TASK PROCESSOR IF NECESSARY A0500376 JMP- (ADISP) EXIT A0500377 SPC 2 A0500378AREREQ ADC REAREQ UNSWAP REQUEST PARAMETER LIST A0500379 EJT A0500380 SPC 4 A0500381********************************************************************** A0500382* * A0500383* COMPLETION TYPE 1 - TERMINAL INPUT / OUTPUT COMPLETIONS * A0500384* * A0500385* ENTRY CONDITIONS: Q = PORT NUMBER (BITS 0-7) * A0500386* ERROR FLAG (BIT 15 ) * A0500387* * A0500388********************************************************************** A0500389 SPC 2 A0500390TSIOC1 STQ* TEMP1 SAVE THE COMPLETION PARAMETER A0500391 TRQ A A0500392 AND- LPMASK+8 ISOLATE THE PORT NUMBER A0500393 MUI =XIOITEM A0500394 ADD* ATSPRT A0500395 STA- I AND SAVE A0500396 SUB* ATSPND IS IT LEGAL A0500397 SAM CA1010 YES A0500398ÐÐ RTJ* (ASYFAL) NO, FATAL SYSTEM ERROR A0500399 SPC 1 A0500400CA1010 LDA- IOSTAT,I OBTAIN THE I/O STATUS A0500401 AND- ONEBIT+DS IS THE TERMINAL DISCONNECTED A0500402 SAN CA1020 YES, PROCESS THE COMPLETION A0500403 SPC 1 A0500404 LDA* TEMP1 OBTAIN THE COMPLETION PARAMETER A0500405 RTJ* STATS1 PROCESS ANY ERROR STATUS A0500406 SPC 1 A0500407 SQZ CA1040 SKIP IF NO ERROR STATUS FOUND A0500408 SPC 1 A0500409 LDA- (TSUSTB),I IS THIS PORT ACTIVE A0500410 SAZ CA1030 NO, IGNORE THE COMPLETION A0500411CA1020 JMP* CA1050 YES, PROCESS THE ERROR STATUS A0500412 SPC 1 A0500413CA1030 LDA- IOSTAT,I A0500414 AND- NZERO+IN CLEAR ALL ERROR STATUS A0500415 STA- IOSTAT,I A0500416 JMP* CASTRT EXIT A0500417 EJT A0500418 SPC 4 A0500419CA1040 LDQ- TERMBF,I OBTAIN THE HEADER ADDRESS A0500420 LDA- 3,Q A = NUMBER OF ENTERED CHARACTERS A0500421 SPC 1 A0500422 LDQ- 4,Q Q = START OF THE INPUT BUFFER A0500423ÐÐ RTJ* UNSOLI PROCESS ANY UNSOLICITED INPUT A0500424 SPC 1 A0500425 LDQ- ONEBIT+LI A0500426 LAQ A WAS THERE A LOG-IN A0500427 SAN CA1060 YES, EXIT A0500428 SPC 1 A0500429CA1050 LDA- IOSTAT,I A0500430 AND- ONEBIT+MM NO, IS MASS MEMORY I/O IN PROCESS A0500431 SAN CA1060 YES, EXIT TO AWAIT THE M. M. COMPLETION A0500432 SPC 1 A0500433 LDA- IOSTAT,I NO, CONTINUE A0500434 LDQ- ONEBIT+IA A0500435 LAQ Q IS THERE ANY I/O ACTIVE A0500436 SQZ CA1060 NO, EXIT A0500437 LDQ- IORQTH,I YES, IS THIS REQUEST ACTIVE A0500438 SQZ CAIOCP NO, CONTINUE A0500439 SPC 1 A0500440CA1060 JMP* CASTRT YES, EXIT A0500441 EJT A0500442 SPC 4 A0500443CAIOCP LDQ- (TSUSTB),I A0500444 RAO- USRSTX,Q UPDATE THE USER'S STATE INDEX A0500445 SPC 1 A0500446CAIOST LDA- (TSUSTB),I OBTAIN THE USER TABLE ADDRESS A0500447 RTJ+ DENSWP DELETE THE USER FROM THE NSWP QUEUE A0500448ÐÐ SPC 1 A0500449 LDA- IOSTAT,I A0500450 AND- ONEBIT+IC IS A COMPLETION BEING PROCESSED A0500451 SAZ CA1100 NO A0500452 JMP* CASTRT YES, IGNORE THIS ONE A0500453 SPC 1 A0500454CA1100 LDA- IOSTAT,I A0500455 AND- ZROBIT+IA A0500456 EOR- ONEBIT+IC CHANGE ACTIVE STATUS TO COMPLETED STATUS A0500457 STA- IOSTAT,I A0500458 SPC 1 A0500459 LDQ- (TSUSTB),I A0500460 LDQ- USRSTX,Q A0500461 SQM CASTRT SKIP IF A SWAP IS IN PROGRESS A0500462 INQ -SXMASS IS THE USER IN MAIN MEMORY A0500463 SQP CA1120 NO A0500464 SPC 1 A0500465 ENQ QPL1 QUEUE PRIORITY = 1 A0500466 LDA- (TSUSTB),I A = USER TABLE ADDRESS A0500467 RTJ+ ONNXUC PLACE THE USER ON THE NXUC QUEUE A0500468 SPC 1 A0500469CASTRT ENQ 0 A0500470 RTJ* (ATSBGN) START THE TASK PROCESSOR IF NECESSARY A0500471 JMP- (ADISP) EXIT A0500472 SPC 1 A0500473ÐÐCA1120 ENQ QPL1 QUEUE PRIORITY = 1 A0500474 ALS 15-TI IS THIS A TERMINAL I/O COMPLETION A0500475 SAP CA1140 NO A0500476 ALS TI-IN YES, IS A TERMINAL INPUT COMPLETION A0500477 SAM CA1130 YES A0500478 LDA- IOSTAT,I NO A0500479 AND- LPMASK+DS IS THERE ANY UNSOLICITED INPUT A0500480 SAZ CA1140 NO, QUEUE PRIORITY = 1 A0500481CA1130 ENQ QPL3 YES, QUEUE PRIORITY = 3 A0500482 SPC 1 A0500483CA1140 LDA- (TSUSTB),I A = USER TABLE ADDRESS A0500484 RTJ+ ONNXUM PLACE THE USER ON THE NXUM QUEUE A0500485 SPC 1 A0500486 JMP* CASTRT START ANOTHER USER A0500487 EJT A0500488 SPC 4 A0500489* STATS1 TSIOCP SUBROUTINE USED TO OBTAIN AND FORMAT A0500490* ------ THE I/O STATUS WORD FOR TYPE 1 INPUT- A0500491* OUTPUT COMPLETIONS A0500492* A0500493* ENTRY CONDITIONS: I = USER I/O TABLE ADDRESS A0500494* A = I/O COMPLETION V-FIELD A0500495* A0500496* EXIT CONDITIONS: I = USER I/O TABLE ADDRESS A0500497* A = NEW I/O STATUS WORD A0500498ÐÐ* Q = CURRENT ERROR STATUS A0500499* A0500500 SPC 2 A0500501STATS1 NOP 0 A0500502 SPC 1 A0500503 SAM ST1010 AN I/O ERROR HAS OCCURED A0500504 ENQ 0 NO ERROR STATUS TO SET UP A0500505 JMP* ST1030 A0500506 SPC 1 A0500507ST1010 LDQ- TERMBF,I A0500508 LFA- 1,15,3,Q A = CP AND LINE STATUS. A0500509 LDQ- ONEBIT+DS SET UP A DISCONNECT STATUS A0500510 SAZ ST1020 SKIP IF CP AND LINE ARE UP. A0500511 LDA- (TSIOTB),I THE CLA IS DOWN, IS THIS TERMINAL ACTIVE A0500512 SAN ST1030 YES, INDICATE A DISCONNECT A0500513 JMP* CASTRT NO, IGNORE THE ERROR A0500514 SPC 1 A0500515ST1020 CLR Q A0500516* ERROR CHECKING AND CALL TO SYFAIL WERE DELETED HERE. A0500517* ALL ERRORS ARE IQNORED. A0500518 SPC 1 A0500519ST1030 LDA- IOSTAT,I OBTAIN THE CURRENT STATUS WORD A0500520 EAQ A UPDATE A0500521 STA- IOSTAT,I AND SAVE A0500522 SPC 1 A0500523ÐÐ JMP* (STATS1) RETURN A0500524 EJT A0500525 SPC 4 A0500526* I / O C O M P L E T I O N D A T A A N D S T O R A G E A0500527 SPC 2 A0500528TEMP1 NUM 0 TEMPORARY STORAGE A0500529ATSBGN ADC TSBGIN TASK PROCESSOR INITIATOR A0500530ATSPRT ADC TSPORT I/O TABLE STARTING ADDRESS A0500531ATSPND ADC TSPEND I/O TABLE ENDING ADDRESS A0500532ASYFAL ADC SYFAIL SYSTEM FAILURE PROCESSOR A0500533ATSLFF ADC TSLOFF 'OFF UNTIL' MESSAGE LENGTH A0500534 EJT A0500535* A0500536* UNSOLI TSIOCP SUBROUTINE USED TO SET UP UNSOLICITED A0500537* ------ INPUT STATUS A0500538* A0500539* ENTRY CONDITIONS: I = USER I/O TABLE ADDRESS A0500540* A = NO. WORDS OF INPUT A0500541* Q = START OF INPUT BUFFER A0500542* A0500543* EXIT CONDITIONS: I = USER I/O TABLE ADDRESS A0500544* A = NEW I/O STATUS WORD A0500545* Q = CURRENT U. I. STATUS A0500546* A0500547 SPC 2 A0500548ÐÐUNSOLI NOP 0 A0500549 SPC 1 A0500550 INA -2 IS THE INPUT LESS THAN OR EQUAL TO 1 WORD A0500551 SAM UNS010 YES, CHECK FOR LOG-IN A0500552 JMP* UNS040 NO, CONTINUE A0500553 SPC 1 A0500554UNS010 LDA- (ZERO),Q A0500555 ARS 8 OBTAIN THE FIRST INPUT CHARACTER A0500556 LDQ- ONEBIT+LI SET UP LOG-IN STATUS A0500557 INA -LOGIN A0500558 SAN UNS040 NOT A LOG-IN A0500559 SPC 1 A0500560 LDA* TEMP1 IS THE REQUEST FROM THE MASTER TERMINAL A0500561 SAN UNS020 NO A0500562 RAO+ TSCNAC YES, INDICATE IT IS ACTIVE A0500563UNS020 SAZ UNS030 SKIP IF THIS IS THE MASTER TERMINAL A0500564 LDA+ TSNABL IS THE SYSTEM ENABLED A0500565 SAN UNS030 YES, CONTINUE A0500566 JMP* UNSMSG NO, OUTPUT THE 'OFF UNTIL' MESSAGE A0500567 SPC 1 A0500568UNS030 LDA- (TSUSTB),I IS THE TERMINAL ALREADY LOGGED IN A0500569 SAN UNS050 YES A0500570 JMP* UNS060 NO, CONTINUE A0500571 EJT A0500572 SPC 4 A0500573ÐÐUNS040 LDQ- TERMBF,I A0500574 LDA- 2,Q A = TERMINATION CODE A0500575 SPC 1 A0500576 LDQ- ONEBIT+ES SET UP ESCAPE STATUS A0500577 INA -ESCAP A0500578 SAZ UNS060 ESCAPE REQUEST A0500579 SPC 1 A0500580 LDQ- ONEBIT+MN SET UP MANUAL INTERRUPT STATUS A0500581 INA ESCAP-MANIN A0500582 SAZ UNS060 MANUAL INTERRUPT REQUEST A0500583 SPC 1 A0500584UNS050 ENQ 0 A0500585 SPC 1 A0500586UNS060 LDA- IOSTAT,I OBTAIN THE STATUS WORD A0500587 AND- NZERO+4 CLEAR THE UNSOLICITED INPUT FIELD A0500588 EAQ A UPDATE A0500589 STA- IOSTAT,I AND SAVE A0500590 SPC 1 A0500591 JMP* (UNSOLI) RETURN A0500592 SPC 2 A0500593UNSMSG LDQ- I A0500594 INQ IORQCD SPECIFY THE I/O REQUEST ADDRESS A0500595 STQ* UNSREQ A0500596 SPC 1 A0500597 LDQ- TERMBF,I OBTAIN THE HEADER ADDRESS A0500598ÐÐ LDA- 4,Q A0500599 STA* TEMP1 SPECIFY THE MESSAGE BUFFER ADDRESS A0500600 LDQ* ATSLFF A0500601 SPC 1 A0500602UNS070 INQ -1 A0500603 SQM UNS080 A0500604 LDA+ TSOFFM,Q MOVE THE MESSAGE TO THE I/O TABLE A0500605 STA* (TEMP1),Q A0500606 JMP* UNS070 A0500607 SPC 1 A0500608UNS080 RTJ- (AMONI) OUTPUT THE MESSAGE A0500609 ADC $6000 A0500610UNSREQ ADC 0 A0500611 SPC 1 A0500612 JMP- (ADISP) EXIT A0500613 EJT A0500614 SPC 4 A0500615********************************************************************** A0500616* * A0500617* COMPLETION TYPE 2 - NON-TERMINAL INPUT / OUTPUT COMPLETIONS * A0500618* * A0500619* ENTRY CONDITIONS: A = PARAMETER LIST ADDRESS * A0500620* Q = LOGICAL UNIT (BITS 0- 7) * A0500621* V-FIELD (BITS 13-15) * A0500622* * A0500623ÐÐ********************************************************************** A0500624 SPC 2 A0500625TSIOC2 STQ* TEMP1 SAVE THE COMPLETION PARAMETER A0500626 INA -IORQCD A0500627 STA- I SAVE THE I/O TABLE ADDRESS A0500628 SUB* ATSPRT IS IT LEGAL A0500629 SAM CA2010 NO A0500630 LDA- I A0500631 SUB* ATSPND IS IT LEGAL A0500632 SAM CA2020 YES A0500633 SPC 1 A0500634CA2010 RTJ* (ASYFAL) INVALID COMPLETION, FATAL SYSTEM ERROR A0500635 SPC 1 A0500636CA2020 LDA* TEMP1 A0500637 RTJ* STATS2 PROCESS ANY ERROR STATUS A0500638 SQZ CA2050 NO ERROR STATUS FOUND. A0500639 SPC 1 A0500640 QLS 15-ME DID A MASS MEMORY ERROR OCCUR A0500641 SQM CA2050 YES. A0500642 JMP CAIOST NO, PROCESS THE ERROR STATUS A0500643 SPC 1 A0500644CA2050 LDQ- ONEBIT+MM A0500645 LAQ Q IS THIS A MASS MEMORY COMPLETION A0500646 SQZ CA2060 NO A0500647 JMP* CAMMRQ YES, PROCESS IT A0500648ÐÐ EJT A0500649 SPC 4 A0500650CA2060 LDA* TEMP1 A0500651 ALS 1 DID AN MSOS SHORT READ OCCUR A0500652 SAP CA2070 NO, CONTINUE A0500653 SPC 1 A0500654 LDQ- TERMBF,I YES A0500655 LDQ- 4,Q A0500656 STQ* TEMP1 A0500657 ADQ- IOMSLN,I A0500658 INQ -1 Q = LWA OF THE INPUT BUFFER A0500659 LDA- (ZERO),Q A0500660 SUB* TEMP1 A = NUMBER OF WORDS ENTERED A0500661 ALS 1 CONVERT TO CHARACTERS A0500662 SPC 1 A0500663 LDQ- TERMBF,I A0500664 STA- 3,Q SPECIFY NUMBER OF ENTERED CHARACTERS A0500665 SPC 1 A0500666CA2070 JMP CAIOCP PROCESS THE I/O COMPLETION A0500667 EJT A0500668 SPC 4 A0500669* A0500670* STATS2 TSIOCP SUBROUTINE USED TO OBTAIN AND FORMAT A0500671* ------ THE I/O STATUS WORD FOR TYPE 2 INPUT- A0500672* OUTPUT COMPLETIONS A0500673ÐÐ* A0500674* ENTRY CONDITIONS: I = USER I/O TABLE ADDRESS A0500675* A = I/O COMPLETION V-FIELD A0500676* A0500677* EXIT CONDITIONS: I = USER I/O TABLE ADDRESS A0500678* A = COMPLETE I/O STATUS A0500679* Q = CURRENT STATUS A0500680* A0500681 SPC 2 A0500682STATS2 NOP 0 A0500683 SPC 1 A0500684 ENQ 0 A0500685 SAP ST2010 NO ERROR INDICATION A0500686 SPC 1 A0500687 LDQ- ONEBIT+ME SET UP MASS MEMORY ERROR STATUS A0500688 LDA- IOSTAT,I A0500689 AND- ONEBIT+MM IS THIS A MASS MEMORY REQUEST COMPLETION A0500690 SAN ST2010 YES A0500691 SPC 1 A0500692 LDA- IORQLU,I NO A0500693 AND- LPMASK+7 A0500694 TRA Q Q = REQUEST LOGICAL UNIT A0500695 LDQ+ LOG1A,Q A0500696 LDA- ESTAT2,Q A = DEVICE STATUS A0500697 ENQ 0 A0500698ÐÐ ALS 4 WAS AN END-OF-FILE DETECTED A0500699 SAM ST2010 YES A0500700 LDQ- ONEBIT+ES NO, DEVICE ERROR, ABORT THE PROGRAM A0500701 SPC 1 A0500702ST2010 LDA- IOSTAT,I OBTAIN THE CURRENT STATUS WORD A0500703 EAQ A UPDATE A0500704 STA- IOSTAT,I AND SAVE A0500705 SPC 1 A0500706 JMP* (STATS2) RETURN A0500707 EJT A0500708********************************************************************** A0500709* * A0500710* COMPLETION TYPE 3 - FILE MANAGER REQUEST COMPLETIONS * A0500711* * A0500712* ENTRY CONDITIONS: I = FILE REQUEST BUFFER ADDRESS * A0500713* * A0500714********************************************************************** A0500715 SPC 2 A0500716TSFMCP LDA- I A0500717 INA -FRQBUF A0500718 STA- I SAVE THE I/O TABLE ADDRESS A0500719 SUB =XTSPORT IS IT VALID A0500720 SAM CA3010 NO A0500721 LDA- I A0500722 SUB =XTSPEND IS IT VALID A0500723ÐÐ SAM CA3020 YES A0500724CA3010 RTJ+ SYFAIL INVALID COMPLETION, FATAL SYSTEM ERROR A0500725 SPC 1 A0500726CA3020 LDA- IOSTAT,I A0500727 SQP CA3030 SKIP IF THERE WAS NO EXECUTIVE FILE ERROR A0500728 EOR- ONEBIT+FE INDICATE A FILE PARAMETER OVERLAP ERROR A0500729 STA- IOSTAT,I A0500730CA3030 AND- ONEBIT+IN WAS THIS AN INPUT REQUEST A0500731 SAZ CAMMRQ NO, CONTINUE NORMALLY A0500732 JMP CAIOCP COMPLETE THE REQUEST AS A MONITOR CALL A0500733 SPC 1 A0500734CAMMRQ LDA- IOSTAT,I A0500735 AND- ZROBIT+IA A0500736 EOR- ONEBIT+IC CHANGE ACTIVE STATUS TO COMPLETED STATUS A0500737 STA- IOSTAT,I A0500738 SPC 1 A0500739 LDQ- (TSUSTB),I A0500740 RAO- USRSTX,Q UPDATE THE USERS STATE INDEX A0500741 SPC 1 A0500742 TRQ A A = USERS TABLE ADDRESS A0500743 ENQ QPL1 QUEUE PRIORITY = 1 A0500744 RTJ+ ONNSWP PLACE THE USER ON THE NSWP QUEUE A0500745 LDA- (TSUSTB),I OBTAIN THE USER TABLE ADDRESS A0500746 ENQ QPL1 QUEUE PRIORITY = 1 A0500747 RTJ+ ONNXUC PLACE THE USER ON THE NXUC QUEUE A0500748ÐÐ SPC 1 A0500749 JMP CASTRT START THE TASK PROCESSOR IF NECESSARY A0500750 SPC 2 A0500751 END A0500752 NAM TSMMER A06 A ITOS CCS 3.0 SL-149A0600001* ITOS EXECUTIVE MASS MEMORY ERROR PROCESSOR A0600002* CREDIT COLLECTION SYSTEM VERSION 3.0 A0600003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A0600004* COPYRIGHT CONTROL DATA CORPORATION 1979 A0600005* A0600006 SPC 2 A0600007 ENT TSMMER TIMESHARE MASS MEMORY ERROR PROCESSOR A0600008 EXT TSMFLG TIMESHARE MASS MEMORY ERROR INDICATOR A0600009 EXT SYFAIL SYSTEM FAILURE PROCESSOR A0600010* A0600011 EQU AMONI($F4) ADDRESS OF THE MONITOR REQUEST ENTRY A0600012 EQU ADISP($EA) ADDRESS OF THE DISPATCHER A0600013 SPC 2 A0600014TSMMER NOP 0 A0600015 SPC 1 A0600016 LDQ+ TSMFLG HAS AN ERROR ALREADY BEEN DETECTED A0600017 SQN TSM010 YES, EXIT A0600018 STA* TSMPAD SAVE THE PARAMETER LIST ADDRESS OF THE ERROR A0600019 SPC 1 A0600020 RTJ- (AMONI) START A TIMER DELAY TO ALLOW THE SYSTEM A0600021ÐÐ ADC $5024 TO GRACEFULLY DEGRADE A0600022 ADC TSM020 A0600023 ADC 10 DELAY FOR 10 SECONDS A0600024 SPC 1 A0600025TSM010 RAO+ TSMFLG INDICATE A MASS MEMORY ERROR A0600026 JMP- (ADISP) A0600027 SPC 1 A0600028TSM020 RTJ+ SYFAIL HALT THE SYSTEM A0600029 SPC 2 A0600030TSMPAD ADC 0 PARAMETER LIST ADDRESS OF THE ERROR A0600031 END A0600032 NAM EXTREG A07 A ITOS CCS 3.0 SL-149A0700001* ITOS EXECUTIVE EXTENDED REGISTER HANDLER A0700002* CREDIT COLLECTION SYSTEM VERSION 3.0 A0700003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A0700004* COPYRIGHT CONTROL DATA CORPORATION 1979 A0700005* A0700006 SPC 2 A0700007 ENT EXTREG A0700008 SPC 1 A0700009 EQU ZERO($22) LOCATION CONTAINING ZERO A0700010 SPC 2 A0700011* T I M E S H A R E L I N K A G E B U F F E R E N T R I E S A0700012* A0700013* THE USER LINKAGE BUFFER IS LOCATED IN PARTITION 0 A0700014ÐÐ SPC 2 A0700015 EQU LASTEP(ZERO) LAST ENTRY TO THE USER PROGRAM A0700016 EQU ULIOTB(001) USERS I/O TABLE ADDRESS A0700017 EQU ULUSTB(002) USERS USER TABLE ADDRESS A0700018 EQU RSCLOK(003) USERS REMAINING TIMESLICE A0700019 EQU FALADD(004) PROTECT FAULT ADDRESS A0700020 EQU PARADD(005) CURRENT PARAMETER ADDRESS A0700021 EQU RSP(006) P-REGISTER STORAGE A0700022 EQU RSA(007) A-REGISTER STORAGE A0700023 EQU RSQ(008) Q-REGISTER STORAGE A0700024 EQU RSI(009) I-REGISTER STORAGE A0700025 EQU RSL(010) OVERFLOW STORAGE A0700026 EQU RS1(011) 1-REGISTER STORAGE A0700027 EQU RS2(012) 2-REGISTER STORAGE A0700028 EQU RS3(013) 3-REGISTER STORAGE A0700029 EQU RS4(014) 4-REGISTER STORAGE A0700030 EQU RSUB(015) UPPER BOUNDS REGISTER STORAGE A0700031 EJT A0700032 SPC 4 A0700033********************************************************************** A0700034* * A0700035* TIMESHARE EXECUTIVE EXTENDED REGISTER SAVE AND RESTORE * A0700036* * A0700037* ENTRY CONDITIONS: I = LINKAGE BUFFER ADDRESS * A0700038* Q = 0 FOR REGISTER SAVE * A0700039ÐÐ* Q = 1 FOR REGISTER RESTORE * A0700040* * A0700041********************************************************************** A0700042 SPC 2 A0700043EXTREG NOP 0 A0700044 SPC 1 A0700045 SQN EXT010 REGISTER RESTORE A0700046 SPC 1 A0700047 SR1- RS1,I SAVE REGISTER 1 A0700048 SR2- RS2,I SAVE REGISTER 2 A0700049 SR3- RS3,I SAVE REGISTER 3 A0700050 SR4- RS4,I SAVE REGISTER 4 A0700051 JMP* (EXTREG) RETURN A0700052 SPC 1 A0700053EXT010 LR1- RS1,I RESTORE REGISTER 1 A0700054 LR2- RS2,I RESTORE REGISTER 2 A0700055 LR3- RS3,I RESTORE REGISTER 3 A0700056 LR4- RS4,I RESTORE REGISTER 4 A0700057 JMP* (EXTREG) RETURN A0700058 SPC 2 A0700059 END A0700060 NAM SETBND A08 A ITOS CCS 3.0 SL-149A0800001* ITOS EXECUTIVE BOUNDS REGISTER HANDLER A0800002* CREDIT COLLECTION SYSTEM VERSION 3.0 A0800003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A0800004ÐÐ* COPYRIGHT CONTROL DATA CORPORATION 1979 A0800005* A0800006* THE UPPER AND LOWER BOUND REGISTERS DATA ARE CONTAINED A0800007* IN Q AND A REGISTERS RESPECTIVELY WHEN ROUTINE IS CALLED. A0800008 SPC 2 A0800009* E N T R Y N A M E A0800010* A0800011 ENT SETBND SET UPPER + LOWER BOUND REGISTERS A0800012 SPC 2 A0800013* E X T E R N A L S A0800014* A0800015 EXT MPFLAG POINTER TO EXTENDED INTERRUPT STACK A0800016 EXT UBPROT LOCATION CONTAINS UPPER BOUND REGISTER DATA A0800017 EXT LBPROT LOWER A0800018 EXT LOBDTB LOWER BOUNDS REGISTER TABLE A0800019 EXT UPBDTB UPPER BOUNDS REGISTER TABLE A0800020 SPC 2 A0800021*----- --- ----- P R O G R A M S T A R T ----- A0800022 SPC 2 A0800023SETBND 0 0 A0800024 IIN 0 A0800025SET010 STQ UBPROT A0800026 STA LBPROT A0800027 ENQ 0 SET UPPER BOUNDS REGISTER TO ZERO TO SHUT A0800028 LUB Q OFF THE EFFECT OF THE BOUNDS REGISTERS. A0800029ÐÐ LDQ- $EF SET Q = CURRENT PRIORITY LEVEL. A0800030 STA LOBDTB,Q STORE LOWER BOUNDS REG INTO TABLE BY PRIORITY.A0800031 LLB A SET LOWER BOUNDS REGISTER. A0800032 LDA* (SET010+1) A0800033 STA UPBDTB,Q STORE UPPER BOUNDS REG INTO TABLE BY PRIORITY.A0800034 LUB A SET UPPER BOUNDS REGISTER. A0800035 EIN 0 A0800036 JMP* (SETBND) RETURN TO CALLER A0800037 END A0800038 NAM CONPNT A09 A ITOS CCS 3.0 SL-149A0900001* ITOS CONTROL POINT SUBROUTINES A0900002* CREDIT COLLECTION SYSTEM VERSION 3.0 A0900003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A0900004* COPYRIGHT CONTROL DATA CORPORATION 1979 A0900005* A0900006* SUPPORT ROUTINES A0900007* A0900008* A0900009*** FUNCTION - A0900010* -------- A0900011* A0900012 SPC 2 A0900013* A SET OF RE-ENTRANT SUBROUTINES ARE REQUIRED TO SUPPORT THE A0900014* CONTROL POINT FACILITY. THESE ROUTINES PROVIDE A CENTRALIZED A0900015* MEANS OF MANIPULATING AND CONTROLLING MEMORY MAPPING IN THE A0900016ÐÐ* SYSTEM. NONE OF THESE SUBROUTINES WILL AFFECT THE CONTENTS OF A0900017* THE FOUR EXTRA REGISTERS AVAILABLE ON THE CYBER-18. A0900018 SPC 1 A0900019* EXTERNAL FEATURES A0900020* -------- -------- A0900021 SPC 2 A0900022* DATA STRUCTURE A0900023 SPC 2 A0900024* A DATA STRUCTURE IS REQUIRED TO SUPPORT THE SYSTEM CONTROL POINTS. A0900025* THIS DATA WILL RESIDE IN THE MSOS SYSDAT, AND CONSIST OF THE A0900026* FOLLOWING. A0900027 SPC 1 A0900028* CONTROL POINT TABLE - THIS IS A FIXED-SIZE, FIXED-ENTRY TABLE A0900029* WHICH CONTAINS AN ENTRY FOR EVERY ACTIVE CONTROL POINT IN THE A0900030* SYSTEM. ITS MAXIMUM LENGTH IS SPECIFIED BY THE TOTAL NUMBER A0900031* OF PAGES ELIGIBLE AS CONTROL POINTS IN THE SYSTEM. EACH ENTRY A0900032* IN THE TABLE CONSISTS OF 'N' WORDS, WHERE 'N' IS THE TOTAL A0900033* NUMBER OF PAGES IN THE USER AREA. A0900034 SPC 1 A0900035* A CONTROL POINT NUMBER IS THE ORDINAL ENTRY INTO THE CONTROL A0900036* POINT TABLE, SO THAT A SIMPLE MECHANISM EXISTS TO OBTAIN THE A0900037* CONTENTS OF THE PAGE MEMORY FILE FOR ANY DEFINED MEMORY MAPPING A0900038* IN THE SYSTEM. A0900039 SPC 1 A0900040* CURRENT CONTROL POINT - THIS IS A ONE WORD LOCATION WITH THE A0900041ÐÐ* ENTRY POINT NAME 'CCP'. IT CONTAINS THE CURRENTLY ACTIVE A0900042* CONTROL POINT NUMBER. A VALUE OF ZERO INDICATES THAT THE A0900043* SYSTEM IS IN ABSOLUTE MODE. A0900044 EJT A0900045**** A0900046* ENTRY POINTS - A0900047* ------------ A0900048* A0900049 ENT CPDEF A0900050 ENT CPCHK A0900051 ENT CPREL A0900052 ENT CPMOD A0900053 ENT CPSET A0900054 ENT CPADD A0900055 ENT CPFET A0900056 SPC 1 A0900057* A0900058* EXTERNALS - A0900059* --------- A0900060* A0900061 EXT ACPTBE A TABLE CONTAINING THE ADDRESS OF EACH A0900062* ENTRY IN THE CONTROL POINT TABLE. A0900063 EXT CCP CURRENT CONTROL POINT (IN SYSDAT) A0900064 EXT TSAREA START OF THE USER AREA (IN SYSDAT) A0900065 EXT NUMCP NUMBER OF CONTROL POINTS IN THE SYSTEM. A0900066ÐÐ EXT CPTBLN SIZE OF CONTROL TABLE ENTRY A0900067 EXT SYFAIL SYSTEM FAILURE ROUTINE A0900068 SPC 1 A0900069* A0900070* EQUIVALENCES - A0900071* ------------ A0900072* A0900073 EQU AVOLA($BB),AVOLR($BA) A0900074 EQU ZERO($22) A0900075 EQU H7FFF($11) A0900076 EQU H001F($7) A0900077 EQU H01FF($B) A0900078 EJT A0900079* DEFINE CONTROL POINT SUBROUTINE A0900080 SPC 1 A0900081* DEFINE CONTROL POINT - THIS SUBROUTINE PLACES THE SPECIFIED A0900082* PAGE MEMORY FILE IMAGE IN THE NEXT AVAILABLE ENTRY OF THE A0900083* CONTROL POINT TABLE, AND RETURNS THE ASSIGNED CONTROL POINT A0900084* NUMBER. THE PAGE FILE IMAGE IS OBTAINED FROM A TABLE LOC- A0900085* ATED IN THE CALLING PROGRAM. THE 7 LSB OF EACH WORD IN THE A0900086* IMAGE IS MOVED TO THE CONTROL POINT TABLE, AND ONLY 'N' WORDS A0900087* ARE MOVED (WHERE 'N' IS THE NUMBER OF NON-ZERO BITS IN CPDFN). A0900088 SPC 1 A0900089* ENTRY CONDITIONS: A0900090* A = FWA OF THE SPECIFIED CONTROL POINT IMAGE TABLE A0900091ÐÐ* Q = N/A A0900092* I = N/A A0900093* RTJ+ CPDEF A0900094 SPC 1 A0900095* EXIT CONDITIONS: A0900096* (RETURN AT P+1) A0900097* A = SAVED A0900098* Q = ASSIGNED CONTROL POINT A0900099* I = SAVED A0900100 SPC 1 A0900101* ERROR CONDITIONS: A0900102* Q = NEGATIVE IF: A0900103* 1. THE CONTROL POINT TABLE IS FULL A0900104 SPC 1 A0900105CPDEF 0 0 A0900106 IIN 0 A0900107 RTJ- (AVOLA) A0900108 NUM 5 A0900109 LDQ* CPDEF SAVE RETURN A0900110 STQ- 3,I A0900111 EIN 0 A0900112 SR1- 4,I SAVE REGISTER 1. A0900113 LR1* NBRCP NUMBER OF CONTROL POINTS TO REGISTER 1. A0900114CP016 XF1 Q CONTROL POINT NUMBER TO Q. A0900115 LDQ* (AACPTE),Q Q = ADDRESS OF CP TABLE ENTRY FOR THIS CP. A0900116ÐÐ IIN 0 A0900117 LDA- (ZERO),Q GET FIRST WORD OF CONTROL POINT TABLE ENTRY. A0900118 INA 1 A0900119 SAZ CP018 SKIP IF AN AVAILABLE CP ENTRY HAS BEEN FOUND. A0900120 EIN 0 A0900121 D1P *-CP016 CHECK THE NEXT CONTROL POINT NUMBER, IF A0900122* THERE ARE ANY. A0900123 SPC 1 A0900124 RTJ* (FAIL) NO AVAILABLE CONTROL POINT TABLE ENTRIES. A0900125 SPC 1 A0900126CP018 SR1- (ZERO),I SAVE THE CONTROL POINT NUMBER. A0900127 STQ* AOFENT SAVE THE ADDRESS OF THE CP TABLE ENTRY. A0900128 SPC 1 A0900129 LDA- 1,I * MOVE IMAGE TABLE TO ENTRY * A0900130 STA* FWA A0900131 LDQ* NNN A0900132 INQ -1 Q = NUMBER OF WORDS - 1 IN CP TABLE ENTRY. A0900133 LDA (ATSARA) A0900134 ARS 11 A0900135 AND- H001F A0900136 STA* BASPAG A0900137CP019 TRQ A A0900138 ADD* BASPAG PAGE REGISTER NUMBER TO A. A0900139 ALS 11 SHIFT PAGE REGISTER NUMBER TO A15-A11. A0900140 EOR* (FWA),Q EOR IN PAGE REGISTER CONTENTS TO A08-A00. A0900141ÐÐ STA* (AOFENT),Q STORE INTO CONTROL POINT TABLE. A0900142 DQP *-CP019 DECREMENT Q AND SKIP BACKWARDS IF NOT DONE. A0900143 IIN 0 A0900144 LDA- 3,I RESTORE RETURN A0900145 STA* CPDEF A0900146 LR1- 4,I RESTORE REGISTER 1. A0900147 RTJ- (AVOLR) A0900148 EIN 0 A0900149 JMP* (CPDEF) A0900150FWA NUM 0 A0900151BASPAG NUM 0 A0900152AACPTE ADC ACPTBE ADDRESS OF A TABLE CONTAINING THE ADDRESS OF A0900153* EACH ENTRY IN THE CONTROL POINT TABLE. A0900154* THIS TABLE IS INDEXED BY CONTROL POINT NUMBER.A0900155 EJT A0900156* CHECK CONTROL POINT SUBROUTINE A0900157 SPC 1 A0900158* CHECK CONTROL POINT - THIS SUBROUTINE DETERMINES IF THE A0900159* SPECIFIED ADDRESS LIES WITHIN A CONTROL POINT AREA, AND IF A0900160* SO, WILL RETURN THE VALUE OF THE CURRENT CONTROL POINT (CCP). A0900161 SPC 1 A0900162* ENTRY CONDITIONS: A0900163* A = N/A A0900164* Q = LOGICAL ADDRESS A0900165* I = N/A A0900166ÐÐ* RTJ+ CPCHK A0900167 SPC 1 A0900168* EXIT CONDITIONS: A0900169* (RETURN AT P+1) A0900170* A = SAVED A0900171* Q = 0 IF ADDRESS IS NOT IN A CONTROL POINT A0900172* Q = 1 IF ADDRESS IS IN A CONTROL POINT. A0900173* I = SAVED A0900174 SPC 1 A0900175* ERROR CONDITIONS: A0900176* NONE A0900177 SPC 1 A0900178CPCHK 0 0 A0900179 IIN 0 A0900180 STA* ASV1 A0900181 RTJ* CKADD CHECK THE ADDRESS. A0900182* RETURNS Q = 0 IF NOT IN CONTROL POINT AREA. A0900183* Q = 1 IF IN A CONTROL POINT AREA. A0900184 LDA* ASV1 RESTORE A REGISTER. A0900185 EIN 0 A0900186 JMP* (CPCHK) RETURN. A0900187ASV1 NUM 0 TEMPORARY STORAGE FOR A REGISTER. A0900188 EJT A0900189* CHECK ADDRESS SR A0900190* A0900191ÐÐ* DETERMINE IF LOGICAL ADDRESS IS GREATER THAN A0900192* OR EQUAL TO BEGINNING OF TIMESHARE AREA AS FOLLOWS A0900193* 1- +ADD.-(+TSA .) GE 0 = OK ,OTHERWISE ERROR A0900194* 2- +ADD.-(-TSA .) = ERROR A0900195* 3- -ADD -(+TSA .) = OK A0900196* 4- -ADD -(-TSA .) GE 0 = OK,OTHERWISE ERROR A0900197* ENTRY- Q=LOGICAL ADDRESS A0900198* EXIT - Q = 1 IF ADDRESS IN CONTROL AREA. A0900199* Q=0 IF NOT A0900200 SPC 1 A0900201CKADD 0 0 A0900202 TRQ A = LOGICAL ADDRESS A0900203 SAM CKA010 SENSE L. ADD. GE $8000 A0900204 LDA* (ATSARA) A = ADDRESS OF USER AREA A0900205 SAM CKA040 SENSE L. ADD. LT START OF PARTITION A0900206 JMP* CKA020 A0900207CKA010 LDA* (ATSARA) A0900208 SAP CKA030 SENSE USER AREA .LT. LOAGICAL ADD. A0900209CKA020 TCA A A0900210 AAQ A A0900211 SAM CKA040 SENSE L. ADD LT PARTITION A0900212CKA030 ENQ 1 A0900213 JMP* CKA050 A0900214CKA040 ENQ 0 ERROR RETURN A0900215CKA050 JMP* (CKADD) A0900216ÐÐ SPC 2 A0900217AOFENT NUM 0 A0900218NNN ADC CPTBLN NO. OF WORDS IN CP TABLE ENTRY A0900219 EJT A0900220* RELEASE CONTROL POINT SR A0900221 SPC 1 A0900222* RELEASE CONTROL POINT - THIS SUBROUTINE REMOVES THE SPECIFIED A0900223* ENTRY FROM THE CONTROL POINT TABLE. AN ENTRY IS RELEASED BY A0900224* SETTING ITS FIRST WORD NEGATIVE. A0900225* IF THE CONTROL POINT TO BE RELEASED IS THE CURRENT A0900226* CONTROL POINT, THE CURRENT CONTROL POINT WILL BE SET A0900227* TO ZERO BY CALLING CPSET. A0900228 SPC 1 A0900229* ENTRY CONDITIONS: A0900230* A = N/A A0900231* Q = CONTROL POINT A0900232* I = N/A A0900233* RTJ+ CPREL A0900234 SPC 1 A0900235* EXIT CONDITIONS: A0900236* (RETURN AT P+1) A0900237* A = SAVED A0900238* Q = (SEE ERROR CONDITIONS) A0900239* I = SAVED A0900240 SPC 1 A0900241ÐÐ* ERROR CONDITIONS: A0900242 SPC 1 A0900243CPREL 0 0 A0900244 IIN 0 A0900245 RTJ- (AVOLA) A0900246 NUM 4 A0900247 LDQ* CPREL A0900248 STQ- 3,I SAVE RETURN A0900249 EIN 0 A0900250 LDA* (ACCP) A = CURRENT CONTROL POINT NUMBER. A0900251 SUB- (ZERO),I A0900252 SAN CPR012 SKIP IF REQ. CONTROL POINT NOT EQ TO CCP. A0900253 ENQ 0 REQ CP = CURRENT CP A0900254 RTJ* CPSET CALL CP SET TO SET CP 0. A0900255CPR012 LDQ- (ZERO),I Q = REQUESTED CONTROL POINT NUMBER A0900256 RTJ* VERCP VERIFY THE REQUESTED CONTROL POINT NUMBER. A0900257* RETURNS Q = ADDRESS OF THE CP TABLE ENTRY. A0900258 ENA -1 MARK THE FIRST WORD OF THE ENTRY A0900259 STA- (ZERO),Q NEGATIVE TO RELEASE THE CP. A0900260 ENQ 0 RETURN ZERO IF NO ERROR A0900261 STQ- (ZERO),I A0900262 STQ* LCP FORCE NEXT CNT POINT TO BE SET A0900263 IIN 0 A0900264 LDA- 3,I A0900265 STA* CPREL A0900266ÐÐ RTJ- (AVOLR) A0900267 EIN 0 A0900268 JMP* (CPREL) A0900269 EJT A0900270* A0900271* MODIFY CONTROL POINT SR A0900272* A0900273* MODIFY CONTROL POINT - THIS SUBROUTINE PLACES THE SPECIFIED A0900274* PAGE MEMORY FILE IMAGE IN THE SPECIFIED CONTROL POINT TABLE A0900275* ENTRY. THE PAGE FILE IMAGE IS OBTAINED FROM A TABLE LOCATED A0900276* IN THE CALLING PROGRAM. THE 7 LSB OF EACH WORD IN THE IMAGE A0900277* IS MOVED TO THE CONTROL POINT TABLE, AND ONLY 'N' WORDS ARE A0900278* MOVED (WHERE 'N' IS THE NUMBER OF NON-ZERO BITS IN CPDFN). A0900279 SPC 1 A0900280* ENTRY CONDITIONS: A0900281* A = FWA OF THE SPECIFIED CONTROL POINT IMAGE TABLE A0900282* Q = CONTROL POINT A0900283* I = N/A A0900284* RTJ+ CPMOD A0900285 SPC 1 A0900286* EXIT CONDITIONS: A0900287* (RETURN AT P+1) A0900288* A = SAVED A0900289* Q = (SEE ERROR CONDITIONS) A0900290* I = SAVED A0900291ÐÐ SPC 1 A0900292* ERROR CONDITIONS: A0900293 SPC 1 A0900294CPMOD 0 0 A0900295 IIN 0 A0900296 RTJ- (AVOLA) A0900297 NUM 4 A0900298 LDQ* CPMOD A0900299 STQ- 3,I SAVE RETRUN A0900300 LDQ- (ZERO),I Q = REQUESTED CONTROL POINT NUMBER A0900301 RTJ* VERCP VERIFY THE REQUESTED CONTROL POINT NUMBER. A0900302* RETURNS Q = ADDRESS OF THE CP TABLE ENTRY. A0900303 IIN 0 CONTROL POINT TABLE ENTRY * A0900304 STQ* AOFENT A0900305 LDA- 1,I A0900306 STA* FWA A0900307 LDQ* NNN A0900308 INQ -1 Q = NUMBER OF WORDS - 1 IN CP TABLE ENTRY. A0900309 LDA* (ATSARA) A0900310 ARS 11 A0900311 AND- H001F A0900312 STA* BASPAG A0900313CPM022 TRQ A A0900314 ADD* BASPAG PAGE REGISTER NUMBER TO A. A0900315 ALS 11 SHIFT PAGE REGISTER NUMBER TO A15-A11. A0900316ÐÐ EOR* (FWA),Q EOR IN PAGE REGISTER CONTENTS TO A08-A00. A0900317 STA* (AOFENT),Q STORE INTO CONTROL POINT TABLE. A0900318 DQP *-CPM022 DECREMENT Q AND SKIP BACKWARDS IF NOT DONE. A0900319 EIN 0 A0900320 ENQ 0 A0900321 STQ* LCP CLEAR LAST CP A0900322 STQ- (ZERO),I A0900323 LDA- 3,I A0900324 IIN 0 A0900325 STA* CPMOD A0900326 RTJ- (AVOLR) A0900327 EIN 0 A0900328 JMP* (CPMOD) A0900329FAIL ADC SYFAIL ADDRESS OF SYSTEM FAILURE ROUTINE. A0900330NBRCP ADC NUMCP NUMBER OF CONTROL POINTS IN THE SYSTEM. A0900331 EJT A0900332* A0900333* SET CONTROL POINT SR A0900334* A0900335* SET CONTROL POINT - THIS SUBROUTINE LOADS THE MEMORY PAGE FILE A0900336* WITH THE CONTENTS OF THE CONTROL POINT TABLE FOR THE SPECIFIED A0900337* CONTROL POINT, AND SETS THE CONTENTS OF CCP TO THE REQUESTED A0900338* VALUE. THE 7 LSB OF EACH WORD IN THE TABLE ENTRY IS USED TO A0900339* LOAD THE FILE, AND ONLY THOSE PAGES SPECIFIED AS CHANGABLE BY A0900340* CPDFN ARE MODIFIED. A REQUEST WITH A CONTROL POINT EQUAL A0900341ÐÐ* TO ZERO WILL RESULT IN THE CPU BEING SET TO ABSOLUTE MODE. A0900342 SPC 1 A0900343* ENTRY CONDITIONS: A0900344* A = N/A A0900345* Q = CONTROL POINT A0900346* I = N/A A0900347* RTJ+ CPSET A0900348 SPC 1 A0900349* EXIT CONDITIONS: A0900350* (RETURN AT P+1) A0900351* A = SAVED A0900352* Q = 0 IF NO ERRORS. THE PROGRAM DOES NOT RETURN A0900353* IF ERRORS ARE DETECTED. A0900354* I = SAVED A0900355 SPC 1 A0900356* ERROR CONDITIONS: A0900357* ALL DETECTED ERRORS CAUSE A RETURN JUMP TO THE A0900358* SYSTEM FAILURE ROUTINE - SYFAIL. A0900359* DETECTED ERRORS ARE THE FOLLOWING - A0900360* 1. CONTROL POINT NUMBER PASSED TO CPSET IS NEGATIVE. A0900361* 2. CONTROL POINT NUMBER PASSED TO CPSET IS LARGER A0900362* THAN THE LARGEST LEGAL CONTROL POINT NUMBER. A0900363* 3. CONTROL POINT NUMBER PASSED TO CPSET IS NOT DEFINED. A0900364 SPC 1 A0900365* IT IS THE CALLERS RESPONSIBILITY TO SAVE THE VALUE OF CCP A0900366ÐÐ* PRIOR TO THE CALL IF NECESSARY, SINCE THE SUBROUTINE WILL SET A0900367* CCP TO THE VALUE OF THE REQUESTED CONTROL POINT. A0900368 SPC 1 A0900369CPSET 0 0 A0900370 IIN 0 A0900371 STQ* (ACCP) SET THE REQUESTED CONTROL POINT. A0900372 SQN CPS020 SKIP IF CONTROL POINT NUMBER NOT ZER. A0900373 APM SET ABSOLUTE MODE A0900374 JMP* CPS060 RETURN WITHOUT ERRORS A0900375 SPC 2 A0900376CPS020 STA* ASAVE SAVE THE A REGISTER. A0900377 TRQ A CP TO A A0900378 SUB* LCP LAST CP TO BE SET A0900379 SAZ CPS050 NO NEED TO RESET TO SAME CP A0900380 STQ* LCP RESET LAST CP TO BE SET A0900381 RTJ* VERCP VERIFY THAT CP NUMBER IS LEGAL. A0900382* RETURNS Q = ADDRESS OF CP TABLE ENTRY. A0900383 IIN A0900384 STQ* AOFENT SAVE THE BASE ADDRESS OF THE ENTRY IN THE A0900385* CONTROL POINT TABLE FOR THIS CONTROL POINT. A0900386 TRQ A BASE ADDRESS OF REGISTER TABLE TO A A0900387 LDQ* NNN Q = TOTAL NUMBER OF PAGE REGISTERS TO BE SET. A0900388 NUM $0BC6 SET CONTROL POINT FILE (WPF A) A0900389CPS050 PM0 SET TO PAGE MODE 0 A0900390 LDQ* (ACCP) LOAD Q WITH ADDRESS OF CURRENT CP NUMBER A0900391ÐÐ LDA* ASAVE RESTORE THE A REGISTER. A0900392CPS060 EIN 0 ENABLE INTERRUPTS. A0900393 JMP* (CPSET) A0900394ASAVE NUM 0 A0900395ATSARA ADC TSAREA ADDRESS OF THE BEGINING OF THE TIMESHARE A0900396* EXECUTION AREA. A0900397ACCP ADC CCP ADDRESS OF THE CURRENT CONTROL POINT NUMBER. A0900398LCP NUM 0 LAST CONTROLPOINT SET A0900399 EJT A0900400* VERIFY THE VALIDITY OF A CONTROL POINT NUMBER. A0900401* A0900402* THIS ROUTINE IS CALLED TO VERIFY THE VALIDITY OF A0900403* A CONTROL POINT NUMBER. IF THE CONTROL POINT NUMBER IS A0900404* VALID IT RETURNS THE ADDRESS OF THE FIRST WORD OF THE A0900405* ENTRY IN THE CONTROL POINT TABLE FOR THE REQUESTED CONTROL A0900406* POINT NUMBER. IF THE CONTROL POINT NUMBER IS INVALID, THIS A0900407* ROUTINE CALLS SYFAIL TO HALT THE MACHINE. A0900408* A0900409* INVALID CONTROL POINT NUMBERS ARE ANY OF THE FOLLOWING - A0900410* 1. NEGATIVE NUMBER. A0900411* 2. ZERO NUMBER. A0900412* 3. NUMBER LARGER THAN LARGEST LEGAL CONTROL POINT NUMBER. A0900413* 4. THE CONTROL POINT FOR THIS NUMBER IS NOT DEFINED. A0900414* A0900415* A0900416ÐÐ* ENTRY CONDITIONS - A0900417* A = N/A. A0900418* Q = CONTROL POINT NUMBER. A0900419* I = N/A. A0900420* RTJ VERCP A0900421* A0900422* EXIT CONDITIONS - A0900423* (RETURN AT P+1) A0900424* A = FIRST WORD OF ENTRY IN THE CONTROL POINT TABLE FOR A0900425* THIS CONTROL POINT NUMBER. A0900426* Q = THE ADDRESS OF THE FIRST WORD OF ENTRY IN THE CONTROL A0900427* POINT TABLE FOR THIS CONTROL POINT. A0900428* I = SAVED A0900429* A0900430* ERROR CONDITIONS - A0900431* ALL ERRORS DETECTED ARE CONSIDERED FATAL. THE SYSTEM A0900432* FAILURE ROUTINE IS CALLED. A0900433* DETECTED ERRORS ARE - A0900434* A0900435* 1. NEGATIVE CONTROL POINT NUMBER A0900436* 2. ZERO CONTROL POINT NUMBER. A0900437* 3. CONTROL POINT NUMBER LARGER THAN THE LARGEST LEGAL A0900438* CONTROL POINT NUMBER. A0900439* 4. THE CONTROL POINT FOR THIS CONTROL POINT NUMBER IS A0900440* NOT DEFINED. A0900441ÐÐ* A0900442VERCP 0 A0900443 IIN 0 A0900444 SQP VER010 A0900445 RTJ* (FAIL) CP NUMBER IS NEGATIVE. A0900446VER010 SQN VER020 A0900447 RTJ* (FAIL) CP NUMBER IS ZERO. A0900448VER020 TCQ A A0900449 ADD* NBRCP A0900450 SAP VER030 SKIP IF REQUESTED CP NUMBER IS WITHIN RANGE. A0900451 RTJ* (FAIL) CP NUMBER IS TOO LARGE. A0900452VER030 LDQ* (AACPTE),Q Q = ADDRESS OF CP TABLE ENTRY FOR THIS CP NUM.A0900453 LDA- (ZERO),Q A = FIRST WORD OF CONTROL POINT TABLE ENTRY. A0900454 INA 1 A0900455 SAN VER040 SKIP IF CONTROL POINT NUMBER IS DEFINED. A0900456 RTJ* (FAIL) CP NOT DEFINED A0900457VER040 EIN 0 A0900458 JMP* (VERCP) RETURN A0900459 EJT A0900460* A0900461* CONTROL POINT ADDRESS SR A0900462* A0900463* CONTROL POINT ADDRESS - THIS SUBROUTINE CALCULATES THE 18 BIT A0900464* PHYSICAL ADDRESS OF THE SPECIFIED LOGICAL ADDRESS WITHIN THE A0900465* SPECIFIED CONTROL POINT. THIS IS ACCOMPLISHED BY USING THE A0900466ÐÐ* SPECIFIED CONTROL POINT ENTRY TO MAP THE LOGICAL ADDRESS INTO A0900467* A PHYSICAL ADDRESS. A0900468 SPC 1 A0900469* ENTRY CONDITIONS: A0900470* A = LOGICAL ADDRESS A0900471* Q = CONTROL POINT A0900472* I = N/A A0900473* RTJ+ CPADD A0900474 SPC 1 A0900475* EXIT CONDITIONS: A0900476* (RETURN AT P+1) A0900477* A = LSB OF THE EQUIVALENT ADDRESS A0900478* Q = MSB OF THE EQUIVALENT ADDRESS A0900479* I = SAVED A0900480 SPC 1 A0900481* ERROR CONDITIONS: A0900482 SPC 1 A0900483CPADD 0 0 A0900484 IIN 0 A0900485 RTJ- (AVOLA) A0900486 NUM 6 A0900487 LDQ* CPADD A0900488 STQ- 3,I SAVE RETURN A0900489 EIN 0 A0900490 LDQ- (ZERO),I Q = REQUESTED CONTROL POINT NUMBER A0900491ÐÐ SQN CPA020 IF CP NUMBER = 0 THEN LOGICAL ADD = PHYSICAL A0900492 JMP* CPA060 ADD. RETURN A = LOGICAL, Q = 0. A0900493CPA020 EQU CPA020(*) A0900494 RTJ* VERCP VERIFY THE REQUESTED CONTROL POINT NUMBER. A0900495* RETURNS Q = ADDRESS OF THE CP TABLE ENTRY. A0900496 STQ- 4,I SAVE A. OF CONTROL TBL. ENTRY A0900497 LDQ- 1,I =LOGICAL ADDRESS A0900498 IIN 0 A0900499 RTJ CKADD A0900500 EIN 0 A0900501 SQN CPA030 SKIP IF LOGICAL ADDR IS IN CONTRL POINT AREA. A0900502 ENQ 0 LOGICAL = PHYSICAL ADDRESS. A0900503 JMP* CPA050 RETURN A = LOGICAL ADDRESS, Q = 0. A0900504* * CALC. 18 BIT ADDRESS * A0900505* LOGICAL ADDR.-TSAREA/2048 = Q REM A0900506* CONTROL TBL. ENTRY(Q+1) = PAGE NO. A0900507* PAGE NO.*2048 + REM = PHYSICAL ADDRESS A0900508CPA030 ENQ 0 A0900509 LDA- 1,I = LOGICAL ADDRESS A0900510 SUB* (ATSARA) A0900511 DVI* N2048 A0900512 STQ- 5,I SAVE REMAINDER AS INCREMENT INTO 2K BLOCK A0900513 TRA Q A = Q = PAGE NUMBER FOR THIS LOGICAL ADDRESS. A0900514 ADQ- 4,I ADD BASE ADDRESS OF CP TABLE ENTRY. A0900515 LDA- (ZERO),Q GET WORD FROM CP TABLE ENTRY FOR THIS PAGE. A0900516ÐÐ AND- H01FF ISOLATE BITS 08-00 OF PAGE REGISTER CONTENTS. A0900517 MUI* N2048 =PHYSICAL ADDRESS OF START OF BLOCK A0900518 LLS 1 ADD INCREMENT INTO BLOCK(DOUBLE PRECISION ADD)A0900519 ALS 15 A0900520 ADD- 5,I A0900521 SAP CPA040 SENSE NO OVERFLOW A0900522 AND- H7FFF A0900523 INQ 1 A0900524CPA040 ALS 1 A0900525 LRS 1 AQ = 18 BIT PHYSICAL ADDRESS A0900526 STA- 1,I A0900527CPA050 STQ- (ZERO),I A0900528CPA060 LDA- 3,I A0900529 IIN 0 A0900530 STA* CPADD A0900531 RTJ- (AVOLR) A0900532 EIN 0 A0900533 JMP* (CPADD) A0900534N2048 NUM 2048 2K BLOCK SIZE A0900535 EJT A0900536* FETCH CONTROL POINT TABLE ENTRY A0900537 SPC 1 A0900538* THIS SUBROUTINE FETCHES THE CONTROL POINT TABLE ENTRY FOR A0900539* A SPECIFIED CONTROL POINT AND PLACES IT IN THE USER'S A0900540* BUFFER. THE SIZE OF THE ENTRY IS ALSO RETURNED. THE A0900541ÐÐ* USER SHOULD PROVIDE THE MAXIMUM SIZE BUFFER OF 32 WORDS A0900542 SPC 1 A0900543* ENTRY CONDITIONS- A0900544* A= FWA OF USER'S BUFFER A0900545* Q=CONTROL POINT A0900546* I=N/A A0900547* RTJ+ CPFET A0900548 SPC 1 A0900549* EXIT CONDITIONS- A0900550* (RETURN AT P+1) A0900551* A=SAVED A0900552* Q=(SEE ERROR CONDITIONS) A0900553* I=N/A A0900554* CONTROL POINT ENTRY IS MOVED TO USER'S BUFFER. A0900555 SPC 1 A0900556* ERROR CONDITIONS- A0900557 SPC 1 A0900558CPFET 0 0 A0900559 IIN 0 A0900560 RTJ- (AVOLA) A0900561 NUM 4 A0900562 LDQ* CPFET A0900563 STQ- 3,I A0900564 EIN 0 A0900565 LDQ- (ZERO),I Q = REQUESTED CONTROL POINT NUMBER A0900566ÐÐ RTJ* VERCP VERIFY THE REQUESTED CONTROL POINT NUMBER. A0900567* RETURNS Q = ADDRESS OF THE CP TABLE ENTRY. A0900568 IIN 0 A0900569 STQ* AOFCPE A0900570 LDA- 1,I =FWA OF USER'S BUFFER A0900571 STA* AOFUBF A0900572 LDQ NNN A0900573CPF030 INQ -1 A0900574 SQM CPF040 SENSE MOVE DONE A0900575 LDA* (AOFCPE),Q A0900576 AND- H01FF A0900577 STA* (AOFUBF),Q A0900578 JMP* CPF030 A0900579CPF040 EIN 0 A0900580 ENQ 0 A0900581 STQ- (ZERO),I A0900582 LDA NNN A0900583 STA- 1,I RETURN SIZE OF ENTRY A0900584 LDA- 3,I A0900585 IIN 0 A0900586 STA* CPFET A0900587 RTJ- (AVOLR) A0900588 EIN 0 A0900589 JMP* (CPFET) A0900590AOFCPE NUM 0 A0900591ÐÐAOFUBF NUM 0 A0900592 END A0900593 NAM DWMATH A10 A ITOS CCS 3.0 SL-149A1000001* ITOS DOUBLE-WORD MATH SUBROUTINES A1000002* CREDIT COLLECTION SYSTEM VERSION 3.0 A1000003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A1000004* COPYRIGHT CONTROL DATA CORPORATION 1979 A1000005* SASA A1000006* A1000007* THIS PACKAGE PROVIDES SUBROUTINES TO PERFORM A1000008* THREE DOUBLE WORD ARITHMETIC OPERATIONS. A1000009* THE DOUBLE WORD FORMAT IS THE SAME AS THE A1000010* MSB/LSB FORMAT USED FOR SECTOR AND WORD A1000011* ADDRESSING: WORD 1 OF A DOUBLE WORD VALUE A1000012* CONTAINS THE UPPER 15 BITS OF THE VALUE - AN A1000013* INTEGRAL MULTIPLE OF 32767, WORD 2 CONTAINS A1000014* THE LOWER 15 BITS OF THE VALUE (BIT 15 = 0). A1000015* IN THE FOLLOWING DESCRIPTIONS 'DWV' REFERS TO A1000016* 'DOUBLE WORD VALUE'. A1000017* A1000018* THE FOLLOWING OPERATIONS ARE IMPLEMENTED: A1000019* ADD A DWV TO A 2ND DWV A1000020* SUBTRACT A DWV FROM ANOTHER DWV A1000021* MULTIPLE A DWV BY A SINGLE WORD VALUE A1000022* A1000023ÐÐ* TO UTILIZE ONE OF THESE ROUITNES, THE CALLER A1000024* STORES THE VALUES TO BE OPERATED ON IN AN A1000025* ARRAY, SETS THE Q-REGISTER TO THE ADDRESS OF A1000026* THE ARRAY AND EXECUTES A RTJ TO THE APPROPRI- A1000027* ATE ROUTINE. THE I REGISTER CONTENTS WILL BE A1000028* SAVED AND RESTORED PRIOR TO RETURN TO THE A1000029* CALLER. THE COMPLETION STATUS WILL BE 0 IF A1000030* GOOD, ELSE IT WILL BE NON-ZERO. A1000031* A1000032* THE ENTRY POINT NAMES ARE AS FOLLOWS: A1000033 ENT DWADD DOUBLE WORD ADD A1000034 ENT DWSUB DOUBLE WORD SUBTRACT A1000035 ENT DWMUL DOUBLE WORD MULTIPLY A1000036* A1000037 EQU ZERO($22) A1000038 EQU ONEMSK(3) A1000039 EQU ONEBIT($23) A1000040 EJT A1000041* THE ARRAY PARAMETER LISTS ARE AS FOLLOWS: A1000042* FOR DWADD A1000043* WORD DESCRIPTION A1000044* 1 MSB OF 1ST DWV A1000045* 2 LSB OF 1ST DMV A1000046* 3 MSB OF 2ND DMV A1000047* 4 LSB OF 2ND DMV A1000048ÐÐ* 5 MSB OF RESULT DMV A1000049* 6 LSB OF RESULT DMV A1000050* 7 COMPLETION STATUS A1000051* A1000052* FOR DWSUB A1000053* WORD DESCRIPTION A1000054* 1 MSB OF MINUEND A1000055* 2 LSB OF MINUEND A1000056* 3 MSB OF SUBTRAHEND A1000057* 4 LSB OF SUBTRAHEND A1000058* 5 MSB OF RESULT A1000059* 6 LSB OF RESULT A1000060* 7 COMPLETION STATUS A1000061* FOR DWMUL A1000062* WORD DESCRIPTION A1000063* 1 MSB OF DWV A1000064* 2 LSB OF DMV A1000065* 3 SINGLE WORD VALUE A1000066* 4 MSB OF RESULT A1000067* 5 LSB OF RESULT A1000068* 6 COMPLETION STATUS A1000069* A1000070 EJT A1000071DWADD 000 000 DOUBLE WORD ADD ROUTINE A1000072 IIN 0 A1000073ÐÐA1 LDA- I SAVE I-REG CONTENTS A1000074 STA* ISAVE A1000075 STQ- I SET I TO ARRAY ADDRESS A1000076 LDA- 1,I SET A TO LSB A1000077 ENQ 0 CLEAR Q FOR USE AS MSB OFFSET A1000078 SOV 0 CLEAR OVERFLOW STATUS A1000079 ADD- 3,I ADD LSB A1000080 SNO A2 SKIP TO A3 IF NO OVERFLOW A1000081 AND- ONEMSK+14 MASK OUT BIT 15 A1000082 INQ 1 BUMP Q TO PUT OVERFLOW IN MSB A1000083A2 SAP A3 SKIP IF RESULT POSITIVE A1000084 INQ -1 SUBTRACT 1 FROM Q FOR MSB OFFSET A1000085 ADD- ONEBIT+15 MAKE LSW POSITIVE A1000086A3 STA- 5,I STORE LSB A1000087 TRQ A TRANSFER MSB OFFSET TO A A1000088 SOV 0 CLEAR OVERFLOW A1000089 ADD- (ZERO),I ADD THE TWO MSBS TO THE OFFSET A1000090 ADD- 2,I A1000091 STA- 4,I STORE MSB A1000092 ENQ 0 CLEAR Q FOR COMPLETION STATUS A1000093 SOV A4 SET TO BAD COMPLETION IF OVERFLOW OR A-REG NEGA1000094 SAP A5 A1000095A4 ENQ 1 A1000096A5 STQ- 6,I A1000097 LDA- 2,I COMPLEMENT 2ND DWV IF COMPLEMENTED BY US A1000098ÐÐ SAP A6 SKIP IF NOT COMPLEMENTED A1000099 TCA A A1000100 STA- 2,I A1000101 LDA- 3,I A1000102 TCA A A1000103 STA- 3,I A1000104A6 LDA* ISAVE RESTORE I-REG A1000105 STA- I A1000106 EIN 0 A1000107 JMP* (DWADD) A1000108 SPC 4 A1000109ISAVE NUM 0 A1000110 EJT A1000111DWSUB 000 0 DOUBLE WORD SUBTRACT ROUTINE A1000112 IIN 0 A1000113 LDA* DWSUB A1000114 STA* DWADD STORE RETURN ADDRESS IN DWADD'S ENTRY POINT A1000115 LDA- 2,Q COMPLEMENT SUBTRAHEND AND USE DWADD TO ADD A1000116 TCA A A1000117 STA- 2,Q A1000118 LDA- 3,Q A1000119 TCA A A1000120 STA- 3,Q A1000121 JMP* A1 A1000122 EJT A1000123ÐÐDWMUL 000 000 DOUBLE WORD MULTIPLY A1000124 IIN 0 A1000125 LDA- I A1000126 STA* ISAVE SAVE I-REG A1000127 STQ- I SET I TO ARRAY ADDRESS A1000128 LDA- 1,I SET A TO LSB OF DOUBLE WORD VALUE A1000129 MUI- 2,I MULTIPLY BY SINGLE WORD VALUE A1000130 LLS 1 A1000131 ALS 15 CONVERT TO DOUBLE PRECISION FORMAT A1000132 STQ* SAVE SAVE MSB A1000133 STA- 4,I STORE LSB IN RESULT A1000134 LDA- (ZERO),I A1000135 MUI- 2,I MULTIPLY MSB BY SINGLE WORD A1000136 LLS 1 A1000137 ALS 15 DOUBLE PRECISION FORMAT A1000138 SOV 0 CLEAR OVERFLOW A1000139 INQ 0 CHECK FOR OVERFLOW A1000140 SQZ 2 A1000141 LDQ- $11 SET OVERFLOW IND A1000142 INQ 1 A1000143 LDQ* SAVE ADD MSB THAT WAS SAVED A1000144 AAQ Q ADD IN RESULT FROM MSB MULTIPLY A1000145 STQ- 3,I STORE IN RESULT A1000146 CLR A A1000147 SOV M0 SKIP IF OVERFLOW A1000148ÐÐ SQP M1 A1000149M0 INA 1 A1000150M1 STA- 5,I SET STATUS WORD, 0 IF GOOD, 1 IF BAD A1000151 LDA* ISAVE RESTORE I-REG A1000152 STA- I A1000153 EIN 0 A1000154 JMP* (DWMUL) RETURN TO CALLER A1000155 SPC 2 A1000156SAVE NUM 0 A1000157 END A1000158 NAM MOV A11 A ITOS CCS 3.0 SL-149A1100001* MOVE CHARACTER STRING SUBROUTINE A1100002* CREDIT COLLECTION SYSTEM VERSION 3.0 A1100003* DATA SYSTEMS-LA JOLLA DIVISIORT LA JOLLA, CALIFORNIA A1100004* COPYRIGHT CONTROL DATA CORPORATION 1979 A1100005* A1100006 SPC 2 A1100007* ENTRY CONDITIONS: A1100008* A1100009* R1 = SOURCE STRING ABSOLUTE WORD ADDRESS A1100010* R2 = DEST. STRING ABSOLUTE WORD ADDRESS A1100011* Q = NUMBER OF BYTES TO MOVE A1100012* ENTRY IS VIA AN R4 REGISTER JUMP A1100013 SPC 2 A1100014 ENT MOV A1100015ÐÐ EXT CNTWAR A1100016* A1100017 EQU ONE($23) A1100018* A1100019MOV SQP MOV1 CAN'T MOVE MORE THAN 32,767 A1100020 JMP* SMOVX A1100021MOV1 SFN+ CNTWAR,2,1 SKIP IF COMMERCIAL PACKAGE LOADED INTO MEMORY A1100022 JMP* SMOV GO DO SOFTWARE MOVE A1100023 TRQ A PLACE BYTE COUNT IN REG A ALSO A1100024 NUM $0F01 (MOV) A1100025 SJE- 1,4 RETURN TO CALLER A1100026 SPC 2 A1100027SMOV INQ -1 ADJUST BYTE COUNT A1100028 SQM SMOVX SKIP IF ZERO LENGTH MOVE A1100029 SB1- ONE DECREMENT SOURCE ADDRESS A1100030 SB2- ONE DECREMENT DESTINATION ADDRESS A1100031SMOVL LCA- 1,Q,1 PICKUP BYTE A1100032 SCA- 1,Q,2 STORE BYTE A1100033 DQP *-SMOVL DO AGAIN IF COUNT NOT MINUS A1100034SMOVX SJE- 1,4 RETURN TO CALLER A1100035 END A1100036 NAM GRABMM A12 A ITOS CCS 3.0 SL-149A1200001* MAIN MEMORY RESERVATION ROUTINE A1200002* CREDIT COLLECTION SYSTEM VERSION 3.0 A1200003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A1200004ÐÐ* COPYRIGHT CONTROL DATA CORPORATION 1979 A1200005* A1200006 SPC 2 A1200007* ALLOCATE MEMORY A1200008* A1200009* A= BASE ADDRESS,MUST BE ON PAGE BOUNDARY A1200010* Q= NUMBER OF PAGES TO ALLOCATE A1200011* A1200012 SPC 2 A1200013* RELEASE MEMORY A1200014* A= BASE ADDRESS,MUST BE ON PAGE BOUNDARY A1200015* Q= NUMBER OF PAGES TO ALLOCATE A1200016* A1200017 SPC 2 A1200018* ERRORS - JUMPS TO SYFAIL IN SYSDAT A1200019* 1. NOT ON PAGE BOUNDARY (BASE ADDRESS) A1200020* 2. AREA UNAVAILABLE A1200021* 3. INCORRECT NUMBER OF PAGES A1200022* 4. PAGE COUNT IS ZERO A1200023* A1200024 SPC 2 A1200025* EXIT FROM SUBROUTINE A1200026* Q=0 NO ERRORS A1200027* Q=N/A IF ERRORS, JUMP TO SYFAIL IF ERRORS A1200028 SPC 2 A1200029ÐÐ SPC 2 A1200030* EXTERNALS/ENTRY POINTS A1200031* A1200032 ENT XMRESV MAIN MEMORY RESERVATION A1200033 ENT XMRETN MAIN MEMORY RETURN A1200034 EXT XMAT MAIN MEMORY ALLOCATION TABLE (SYSDAT) A1200035 EXT SYFAIL ERROR EXIT (SYSDAT) A1200036 EXT XMBLOK ITOS EXECUTIVE A1200037 EXT TSBGIN ITOS EXECUTIVE A1200038 SPC 2 A1200039* EQUATES A1200040* A1200041 EQU ONE($23) A1200042 EQU ZERO($22) A1200043 EJT A1200044* A1200045* ALLOCATE USER AREA MEMORY A1200046* A1200047XMRESV NOP 0 A1200048 SQZ XRMESB ZERO PAGE COUNT, ERROR A1200049 STQ* NUMPGS STORE NUMBER OF PAGES IN HOLD AREA A1200050 ENQ 0 A1200051 STQ* RMVFLG INDICATE A RESERVATION REQUEST A1200052* A1200053XRMESA ENQ 0 A1200054ÐÐ XFQ 1 CLEAR R1 A1200055 LLS 5 GET BASE PAGE IN Q A1200056 STQ* BASEPG A1200057 SAZ XRMES1 A1200058XRMESB RTJ* MEMERR NOT ON PAGE BOUNDARY A1200059 SPC 2 A1200060* A1200061XRMES1 LRA+ XMAT,1 DETERMINE IF MEMORY IS AVAILABLE A1200062 SAP XRMES2 A1200063 INA 1 A1200064 SAP XRMES2 A1200065 ARQ+ XMAT,1 A1200066 JMP* XRMS2A A1200067* A1200068XRMES2 INQ -1 A1200069* A1200070XRMS2A SQZ XRMES3 SEE IF AT BASE PAGE ADDRESS A1200071 SQP XRMS2B SEE IF STILL WITHIN TABLE A1200072 RTJ* MEMERR MEMORY UNAVAILABLE A1200073* A1200074XRMS2B AR1- ONE A1200075 JMP* XRMES1 A1200076 SPC 2 A1200077XRMES3 XF1 Q A1200078 INQ 1 A1200079ÐÐXRM3 LDA* RMVFLG SEE IF ALLOCATE OR RELEASE USER AREA A1200080 SAZ XRME3B ALLOCATE A1200081 JMP* XMRTN3 RELEASE AREA A1200082* A1200083XRME3B LDA* NUMPGS A1200084 ALS 8 A1200085 EOR* BASEPG A1200086 STA XMBLOK A1200087 ENQ 0 A1200088 RTJ+ TSBGIN A1200089* A1200090* A1200091XRMES4 LDA XMBLOK SEE IF EXECUTIVE ALLOCATED THE MEMORY OR NOT A1200092 SAZ XRMES7 YES A1200093* A1200094* A1200095 TIMER XRMES4-*+1,0,1,1,1 A1200096 JMP- ($EA) A1200097 SPC 2 A1200098XRMES7 ENQ 0 A1200099 JMP* (XMRESV) ALL DONE, RETURN TO CALLER A1200100* A1200101* A1200102 SPC 2 A1200103BASEPG NUM 0 BASE PAGE FOR ALLOCATION A1200104ÐÐNUMPGS NUM 0 NUMBER OF PAGES TO ALLOCATE A1200105RMVFLG NUM 0 REMOVE PROCESSOR FLAG A1200106 EJT A1200107* RELEASE USER AREA TO EXECUTIVE A1200108* A1200109* A1200110XMRETN NOP 0 A1200111 SQN XMRTN2 A1200112 RTJ* MEMERR PAGE COUNT IS ZERO A1200113XMRTN2 STQ* RMVFLG SET RELEASE PROCESSOR FLAG A1200114 INQ -1 A1200115 STQ* NUMPGS STORE NUMBER OF PAGES IN HOLD AREA A1200116 JMP* XRMESA USE FIRST PORTION OF REQUES PROCESSOR A1200117 SPC 2 A1200118 SPC 2 A1200119XMRTN3 ADQ* NUMPGS A1200120 LR1* NUMPGS A1200121 IIN 0 A1200122* A1200123XMRTN5 LDA XMAT,Q RELEASE MEMORY, HIGHEST PAGE LOC. TO LOWEST A1200124 SAP MEMERR ERROR, INCORRECT NUMBER OF PAGES A1200125 INA 1 A1200126 SAZ XMRTN6 SEE IF MINUS ONE A1200127* A1200128* A1200129ÐÐMEMERR NOP 0 A1200130 RTJ+ SYFAIL ERROR EXIT (SYSDAT) A1200131 SPC 2 A1200132XMRTN6 STA XMAT,Q A1200133* A1200134 INQ -1 A1200135* A1200136 D1P *-XMRTN5 SEE IF DONE RELEASING MEMORY A1200137* A1200138 SPC 2 A1200139XMRTN7 EIN 0 A1200140 ENQ 0 A1200141 RTJ+ TSBGIN LET ITOS EXEC KNOW THAT MEMORY WAS RELEASED A1200142 ENQ 0 A1200143 JMP* (XMRETN) DONE, RETURN TO REQUESTOR PROGRAM A1200144 END A1200145 NAM LOCATE A13 A ITOS CCS 3.0 SL-149A1300001* PROGRAM FILE LOCATOR A1300002* CREDIT COLLECTION SYSTEM VERSION 3.0 A1300003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A1300004* COPYRIGHT CONTROL DATA CORPORATION 1979 A1300005 SPC 2 A1300006* ENTRY - Q= ADDRESS OF NAME TO BE FOUND,MUST BE A FILE NAME A1300007* A1300008* A1300009ÐÐ* EXIT - A= STARTING SECTOR A1300010* Q= LENGTH IN WORDS A1300011* A1300012 SPC 2 A1300013 EQU AMONI($F4) A1300014 EQU ADISP($EA) A1300015 SPC 2 A1300016 ENT LOCATE A1300017* A1300018LOCATE NOP 0 A1300019 STQ* KEYADD A1300020 LDA- $C4 A1300021LOC0 STA* LIBSEC A1300022 SPC 2 A1300023 RTJ- (AMONI) A1300024PLC1 ADC $0944 A1300025 ADC LOC1-PLC1 A1300026 ADC 0 A1300027 ADC $08C2 A1300028 ADC 96 A1300029 ADC SLBF-PLC1 A1300030 ADC 0 A1300031LIBSEC ADC 0 A1300032 JMP- (ADISP) A1300033 SPC 2 A1300034ÐÐLOC1 ENQ 85 A1300035 LDA* KEYADD A1300036 STA- I A1300037LOC2 LDA* SLBF,Q A1300038 SUB- (I) A1300039 SAN LOC3 NO MATCH A1300040 LDA* SLBF+1,Q A1300041 SUB- 1,I A1300042 SAN LOC3 NO MATCH A1300043 LDA* SLBF+2,Q A1300044 SUB- 2,I A1300045 SAZ LOC4 FOUND THE ENTRY POINT A1300046LOC3 INQ -5 HAS THE SECTOR BEEN COMPLETELY SEARCHED A1300047 SQM LOC5 YES A1300048 JMP* LOC2 NO, CONTINUE A1300049 SPC 2 A1300050LOC4 LDA* SLBF+3,Q IS THE PROGRAM IN FILE FORMAT A1300051 SAM LOC4A A1300052 JMP* LOC3 NO A1300053LOC4A LDA* SLBF+4,Q A1300054 STA* SAVA+1 START SECTOR A1300055 LDA* SLBF+3,Q A1300056 TCA A A1300057 MUI =N96 A1300058 TRA Q LENGTH A1300059ÐÐSAVA LDA =N0 A1300060 JMP* (LOCATE) A1300061 SPC 2 A1300062LOC5 LDA* SLBF+95 A1300063 INA 0 A1300064 SAZ LOC6 IS THIS THE END OF THE DIRECTORY A1300065 JMP* LOC0 NO, READ IN THE NEXT SECTOR A1300066 SPC 2 A1300067LOC6 ENA -1 A1300068 JMP* (LOCATE) INDICATE THAT THE NAME WAS NOT FOUND A1300069 SPC 2 A1300070KEYADD ADC 0 A1300071SLBF BZS SLBF(96) A1300072 END A1300073 NAM C18DMY A14 A ITOS CCS 3.0 SL-149A1400001* DUMMY ENTRIES FOR COMM-18 INITIATION A1400002* CREDIT COLLECTION SYSTEM VERSION 3.0 A1400003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A1400004* COPYRIGHT CONTROL DATA CORPORATION 1979 A1400005 SPC 2 A1400006 ENT LOCATE PROGRAM FILE LOCATOR A1400007 ENT XMRESV MAIN MEMORY RESERVATION A1400008 ENT XMRETN MAIN MEMORY RETURN A1400009 SPC 1 A1400010 EXT SYFAIL SYSTEM FAILURE PROCESSOR A1400011ÐÐ SPC 2 A1400012LOCATE NOP 0 A1400013 RTJ+ SYFAIL A1400014 SPC 1 A1400015XMRESV NOP 0 A1400016 RTJ+ SYFAIL A1400017 SPC 1 A1400018XMRETN NOP 0 A1400019 RTJ+ SYFAIL A1400020 END A1400021 NAM SYUTIL A15 A ITOS CCS 3.0 SL-149A1500001* ITOS UTILITY PROCESSOR A1500002* CREDIT COLLECTION SYSTEM VERSION 3.0 A1500003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A1500004* COPYRIGHT CONTROL DATA CORPORATION 1979 A1500005* A1500006 SPC 2 A1500007* E X T E R N A L S A1500008 SPC 1 A1500009 EXT BAITOS CONCURRENT BATCH PROCESSING INDICATOR A1500010 EXT DWSUB SYSTEM DOUBLE WORD SUBTRACT SUBROUTINE A1500011 EXT FILOAD SYSTEM FILE INITIALIZATION INDICATOR A1500012 EXT HORMIN CURRENT TIME IN HOUR AND MINUTE A1500013 EXT JOBIND JOB PROCESSOR ACTIVE INDICATOR A1500014 EXT LOG1A SYSTEM LOGICAL UNIT TABLE A1500015ÐÐ EXT MAXSEC SYSTEM MAXIMUM SECTOR -LIBRARY UNIT A1500016 EXT MMLUTB MASS MEMORY DEVICE TABLE A1500017 EXT QPASWD BUFFER FOR PASSWORD A1500018 EXT RETIME TIME IN LOG OFF MESSAGE A1500019 EXT SWTCH JOB PROCESSOR ACTIVE INDICATOR A1500020 EXT STRBAS START PROCESSOR FIRST WORD ADDRESS A1500021 EXT TERMLU LOGICAL UNIT FOR TERMINAL A1500022 EXT TSIOC1 IO COMPLETION PROCESSOR ROUTINE A1500023 EXT TSLOFF LENGTH OF LOG OFF MESSAGE A1500024 EXT TSNABL TIMESHARE ENABLED INDICATOR A1500025 EXT TSPEND LAST LOCATION OF TSPORT A1500026 EXT TSPORT TIMESHARE I/O TABLE STARTING ADDRESS A1500027 EXT TSTLOC START FUNCTION ADDRESS LOCATIONS A1500028 EXT MIB MANUAL INTERRUPT DISABLE INDICATOR A1500029 EXT PRTCDR RETURN ADDRESS FOR DELAYED SWAPS A1500030 EXT UNPIO BACKGROUND I/O ACTIVE INDICATOR A1500031 EXT SPASW SWAP REQUEST INDICATOR A1500032 EXT SWPSEC BACKGROUND SWAP BUFFER SECTOR ADDRESS A1500033 EXT STLPV4 SWAP ACTIVATION SUBROUTINE (DRCORE) A1500034 EXT SWAPON SWAP ACTIVE INDICATOR A1500035 EXT LOOP SWAPPED IDLE LOOP ADDRESS A1500036 EXT* XMRESV ITOS MEMORY RESERVATION ROUTINE A1500037 EXT* XMRETN ITOS MEMORY RETURN ROUTINE A1500038 SPC 1 122*4612A1500039 EXT* BINASC CONVERT NUMBER TO ASCII A1500040ÐÐ EXT* DECHEX CONVERT ASCII TO NUMBER A1500041 EXT* IMAGE TIMESHARE DATA IMAGE UPDATE ROUTINE A1500042 EJT 122*4612A1500043 SPC 4 122*4612A1500044* E Q U I V A L E N C E S A1500045 SPC 1 A1500046 EQU LPMASK($2) BIT MASK TABLE A1500047 EQU ONEMSK(3) ONE MASK TABLE A1500048 EQU ZERO($22) LOCATION CONTAINING ZERO A1500049 EQU ZROMSK($13) ZERO MASK TABLE A1500050 EQU ONEBIT($23) SINGLE BIT TABLE A1500051 EQU ZROBIT($33) ZERO BIT TABLE A1500052 EQU AMONI($F4) ADDRESS OF MONITOR REQUEST ENTRY A1500053 EQU ADISP($EA) ADDRESS OF DISPATCHER A1500054 EQU RPCP($66) MONITOR REQUEST PRIORITIES A1500055 EQU PRI5($0055) COMPLETE REQUEST AT PRIORITY 5 A1500056 EQU EREQST(08) P. D. T. ENTRY -REQUEST STATUS A1500057 SPC 2 A1500058* V O L U M E I N F O R M A T I O N T A B L E A1500059 SPC 1 A1500060 EQU VIBMSM(6) BEGINNING OF MANAGEABLE SPACE - MSB A1500061 EQU VIBMSL(7) BEGINNING OF MANAGEABLE SPACE - LSB A1500062 EQU VILBAM(11) LARGEST BLOCK OF SPACE AVAILABLE - MSB A1500063 EQU VILBAL(12) LARGEST BLOCK OF SPACE AVAILABLE - LSB A1500064 EQU VICURF(17) CURRENT NUMBER OF FILES EXISTING ON VOLUME A1500065ÐÐ EQU VINFDB(18) NUMBER OF BLOCKS IN FILE DEFINITION DIRECTORY A1500066 EQU VINXTB(19) NEXT AVAILABLE BLOCK IN FILE DEF. DIRECTORY A1500067 EQU VINOOF(20) NUMBER OF OPEN FILES ON VOLUME A1500068 EJT A1500069 SPC 4 A1500070* M U L T I - U S E R P R O G R A M T A B L E E N T R I E S A1500071 SPC 1 A1500072 EQU MUROOT(ZERO) ASSOCIATED ROOT TABLE ADDRESS A1500073 EQU MUSRID(01) PROGRAM IDENTIFICATION - 4 WORDS ASCII A1500074 EQU MUSIZE(05) PROGRAM LENGTH (WORDS) A1500075 EQU MUSECT(06) PROGRAM SECTOR ADDRESS - 2 WORDS A1500076 EQU MUPAGE(08) PROGRAM BASE MEMORY PAGE NUMBER A1500077 EQU ACROOT(09) PROGRAM ACTIVE ROOT COUNT A1500078 EQU MURSIZ(10) PROGRAM TRUE LENGTH (WORDS) A1500079 EQU MUEXTH(11) PROGRAM EXECUTION THREAD A1500080 EQU MURSTX(13) PROGRAM STATE INDEX A1500081 EQU MURCLK(15) PROGRAM CLOCK VALUE A1500082 EQU MUITEM(MURCLK+1) A1500083 SPC 2 A1500084* U S E R P R O G R A M U S E R T A B L E E N T R I E S A1500085 SPC 1 A1500086 EQU TSIOTB(ZERO) ASSOCIATED I/O TABLE ADDRESS A1500087 EQU USERID(01) USER IDENTIFICATION - 4 WORDS ASCII A1500088 EQU PGMSIZ(05) USER PROGRAM LENGTH (WORDS) A1500089 EQU PGMSEC(06) USER PROGRAM SECTOR - 2 WORDS A1500090ÐÐ EQU TWNSEC(08) SWAP TWIN SECTOR - 2 WORDS A1500091 EQU SWPBLK(10) USER SWAP BLOCK BYTES A1500092 EQU NEXETH(11) USER EXECUTION THREAD A1500093 EQU NSWPTH(12) USER SWAP THREAD A1500094 EQU USRSTX(13) USER STATE INDEX A1500095 EQU TSMUTB(14) MULTI USER TABLE ADDRESS A1500096 EQU NUMREQ(15) USER REQUEST COUNT A1500097 EQU USRITM(NUMREQ+1) A1500098 EJT A1500099 SPC 4 A1500100* U S E R P R O G R A M S T A T E I N D I C E S A1500101 SPC 1 A1500102 EQU SXCACT(01) EXECUTING IN MAIN MEMORY A1500103 EQU SXCTSL(02) SUSPENDED IN MAIN MEMORY-TIMESLICE COMPLETE A1500104 EQU SXCMMA(03) SUSPENDED IN MAIN MEMORY-M.M. I/O ACTIVE A1500105 EQU SXCMMC(04) SUSPENDED IN MAIN MEMORY-M.M. I/O COMPLETE A1500106 EQU SXCFMA(05) SUSPENDED IN MAIN MEMORY-FILE I/O ACTIVE A1500107 EQU SXCFMC(06) SUSPENDED IN MAIN MEMORY-FILE I/O COMPLETE A1500108 EQU SXCTMA(07) SUSPENDED IN MAIN MEMORY-TMNL I/O ACTIVE A1500109 EQU SXCTMC(08) SUSPENDED IN MAIN MEMORY-TMNL I/O COMPLETE A1500110 EQU SXCDTA(09) SUSPENDED IN MAIN MEMORY-DATA I/O ACTIVE A1500111 EQU SXCDTC(10) SUSPENDED IN MAIN MEMORY-DATA I/O COMPLETE A1500112 EQU SXCATA(11) SUSPENDED IN MAIN MEMORY-ATTACH ACTIVE A1500113 EQU SXCATC(12) SUSPENDED IN MAIN MEMORY-ATTACH COMPLETE A1500114* A1500115ÐÐ EQU SXMASS(13) RESERVED A1500116 EQU SXMTSL(14) SWAPPED ON MASS MEMORY-TIMESLICE COMPLETE A1500117 EQU SXM015(15) RESERVED A1500118 EQU SXMMMC(16) SWAPPED ON MASS MEMORY-M.M. I/O COMPLETE A1500119 EQU SXM017(17) RESERVED A1500120 EQU SXMFMC(18) SWAPPED ON MASS MEMORY-FILE I/O COMPLETE A1500121 EQU SXMTMA(19) SWAPPED ON MASS MEMORY-TMNL I/O ACTIVE A1500122 EQU SXMTMC(20) SWAPPED ON MASS MEMORY-TMNL I/O COMPLETE A1500123 EQU SXMDTA(21) SWAPPED ON MASS MEMORY-DATA I/O ACTIVE A1500124 EQU SXMDTC(22) SWAPPED ON MASS MEMORY-DATA I/O COMPLETE A1500125 EQU SXMATA(23) SWAPPED ON MASS MEMORY-ATTACH ACTIVE A1500126 EQU SXM024(24) RESERVED A1500127* A1500128 EQU SXMUSA(25) SUSPENDED ON MASS MEMORY-UNSWAP ACTIVE A1500129 EQU SXCUSC(26) SUSPENDED IN MAIN MEMORY-UNSWAP COMPLETE A1500130 EQU SXMMUR(27) SUSPENDED ON MASS MEMORY-MULTIUSER READ A1500131 EQU SXMLOG(28) SUSPENDED ON MASS MEMORY-INITIAL LOGIN A1500132 EQU SXMJOB(29) SUSPENDED ON MASS MEMORY-JOB STEP A1500133 SPC 2 A1500134* NOTE - BIT 15 = 1 WHILE THE USER IS BEING SWAPPED A1500135 EJT A1500136 SPC 4 A1500137* U S E R P R O G R A M I / O T A B L E E N T R I E S A1500138 SPC 1 A1500139 EQU TSUSTB(ZERO) ASSOCIATED USER TABLE ADDRESS A1500140ÐÐ EQU FRQBUF(01) FILE REQUEST BUFFER HEADER (4 WORDS) A1500141 EQU IORQCD(05) INPUT/OUTPUT REQUEST CODE A1500142 EQU IORQCA(06) INPUT/OUTPUT COMPLETION ADDRESS A1500143 EQU IORQTH(07) INPUT/OUTPUT THREAD WORD A1500144 EQU IORQLU(08) INPUT/OUTPUT LOGICAL UNIT A1500145 EQU IOMSLN(09) INPUT/OUTPUT MESSAGE LENGTH A1500146 EQU IOBFAD(10) INPUT/OUTPUT MESSAGE BUFFER ADDRESS A1500147 EQU IOMMSB(11) INPUT/OUTPUT MASS MEMORY ADDRESS A1500148 EQU IOMLSB(12) INPUT/OUTPUT MASS MEMORY ADDRESS A1500149 EQU IOCNPT(13) INPUT/OUTPUT CONTROL POINT A1500150 EQU IOSTAT(14) INPUT/OUTPUT STATUS WORD A1500151 EQU TERMBF(15) TERMINAL MESSAGE BUFFER ADDRESS A1500152 EQU IOITEM(TERMBF+1) A1500153 SPC 2 A1500154* USER PROGRAM I/O STATUS INDICATORS A1500155 SPC 1 A1500156* UNSOLICITED INPUT GROUP A1500157 EQU LI(00) TERMINAL LOG-IN A1500158 EQU MN(01) TERMINAL MANUAL INTERRUPT A1500159 EQU ES(02) TERMINAL ESCAPE A1500160* INPUT-OUTPUT ERROR GROUP A1500161 EQU DS(04) TERMINAL DISCONNECT A1500162 EQU ME(05) MASS MEMORY ERROR A1500163 EQU FE(06) FILE REQUEST ERROR A1500164* REQUEST TYPE GROUP A1500165ÐÐ EQU IN(08) DATA INPUT REQUEST A1500166 EQU IA(09) INPUT / OUTPUT ACTIVE A1500167 EQU IC(10) INPUT / OUTPUT COMPLETE A1500168 EQU MM(11) MASS MEMORY I/O REQUEST A1500169 EQU TI(12) TERMINAL I/O REQUEST A1500170* TERMINAL CHARACTERISTIC GROUP A1500171* A1500172 EQU DY(TI+1) END OF THE DYNAMIC STATUS GROUP A1500173 SPC 1 A1500174* 2550 PHYSICAL DEVICE TABLE A1500175 SPC 1 A1500176 EQU CPSTAT(31) CP STATUS WORD A1500177 SPC 1 A1500178* SMD PHYSICAL DEVICE TABLE A1500179 SPC 1 A1500180 EQU NUMHDS(49) NO. OF HEADS(TRACKS) PER CYLINDER A1500181 EQU MXSRTK(71) MAX. NO.OF SECTORS PER TRACK A1500182 EJT A1500183 SPC 4 A1500184SYUTIL EQU SYUTIL(*) A1500185 SPC 1 A1500186SYU005 TRQ A A1500187 INA -FUNMAX IS THE INDEX LEGAL A1500188 SAP SYU010 NO, IGNORE THE REQUEST A1500189 SPC 1 A1500190ÐÐ LDA* FUNTAB,Q A1500191 INA -1 A = ADDRESS OF THE REQUESTED FUNCTION A1500192 STA* SYU010+1 A1500193SYU010 JMP SYU020 A1500194 SPC 2 A1500195FUNTAB ADC INIT-SYU010 00 - INITIALIZE THE SYSTEM VOLUME A1500196 ADC START-SYU010 01 - START THE ITOS SYSTEM A1500197 ADC STOP-SYU010 02 - STOP THE ITOS SYSTEM A1500198 ADC PASSWD-SYU010 03 - ENTER A SYSTEM PASSWORD A1500199 SPC 1 A1500200 EQU FUNMAX(*-FUNTAB) A1500201 SPC 2 A1500202SYU020 RTJ- (AMONI) RELEASE THE UTILITY A1500203SYU030 ADC $1901 A1500204 ADC (SYUTIL-SYU030) A1500205 SPC 2 A1500206 EJT A1500207************************************************** A1500208* A1500209* A1500210* INITIALIZE THE SYSTEM VOLUME A1500211* A1500212* A1500213************************************************** A1500214 SPC 4 A1500215ÐÐINIT NOP 0 A1500216 LDA+ TSNABL IS THE SYSTEM ACTIVE A1500217 SAZ INI010 NO A1500218 SPC 1 A1500219 ENQ 0 YES, INDICATE AN ERROR A1500220 RTJ MESSAG A1500221 JMP* SYU020 AND EXIT A1500222 SPC 1 A1500223INI010 ENQ 1 DISPLAY THE WARNING MESSAGE A1500224 RTJ MESSAG A1500225 ENQ 6 A1500226 RTJ MESSAG A1500227 SPC 1 A1500228 RTJ- (AMONI) READ THE RESPONSE A1500229INIP1 ADC $0900+RPCP A1500230 ADC INI020-INIP1 A1500231 ADC 0 A1500232 ADC $18FD A1500233 ADC 2 A1500234 ADC INIBUF-INIP1 A1500235 JMP- (ADISP) A1500236 SPC 1 A1500237INI020 LDA* INIBUF A1500238 SUB =AOK WAS THE RESPONSE PROPER A1500239 SAZ INI030 YES A1500240ÐÐ SPC 1 A1500241 ENQ 2 NO A1500242 RTJ MESSAG A1500243 JMP* SYU020 EXIT A1500244 EJT A1500245 SPC 4 A1500246INI030 EQU INI030(*) A1500247 LDQ =XMMLUTB A1500248 LDA- 1,Q A1500249 STA- I I = ADDRESS OF THE SYSTEM VOLUME VIT A1500250 LDA- (I) A1500251 AND- LPMASK+15 A1500252 TRA Q Q = SYSTEM VOLUME L. U. A1500253 EOR- ONEBIT+15 A1500254 STA- (I) DISMOUNT THE SYSTEM VOLUME A1500255 SPC 1 A1500256 LDQ+ LOG1A,Q A1500257 LDA- EREQST,Q A1500258 ARS 4 POSITION THE DEVICE TYPE CODE A1500259 AND- LPMASK+7 ISOLATE A1500260 INA -70 A1500261 SAZ INI040 SENSE SMD(1867-20) EQUIPMENT TYPE A1500262 JMP* INI050 ERROR IF ANY OTHER TYPE A1500263 SPC 1 A1500264* COMPUTE MAX. SECTOR A1500265ÐÐ* MAX SECTOR = CYLDEV * TRKCYL * SECTRK - 2 * SECTRK A1500266* (THIS CODE IS ALSO IN MMSIZ ROUTINE IN THE UTILITY OVERLAYS.) A1500267 SPC 1 A1500268INI040 STQ- I = ADDR. OF SYSVOL PHY. DEV. TBL. A1500269 SOV 0 (CLEAR OVERFLOW) A1500270 LDA =N823 CYLINDERS PER DEVICE A1500271 MUI- NUMHDS,I * TRACKS PER CYLINDER A1500272 MUI- MXSRTK,I * SECTORS PER TRACK A1500273 SNO INI041 SENSE NO OVERFLOW A1500274 JMP* INI050 A1500275INI041 LLS 1 CONVERT TO MSB,LSB A1500276 ALS 15 A1500277 SUB- MXSRTK,I ADJUST FOR LAST TWO TRACKS NOT AVAILABLE A1500278 SUB- MXSRTK,I A1500279 INA -1 ADJUST FOR SECTOR ADDRESS FROM NO. OF SECTORS A1500280* NOTE- THE ABOVE ADJUSTMENT FOR SECTOR ADDRESS IS WRONG BUT A1500281* CONSISTENT WITH THE 'MMSIZ' ROUTINE. THUS 'INITING' A A1500282* VOLUME ALWAYS RESULTS IN THE AVAILABLE FILE MANAGER SPACEA1500283* BEING 1 SECTOR LESS THAN MAXIMUM. A1500284 SAP INI042 SENSE NO OVERFLOW A1500285 AND =N$7FFF A1500286 INQ -1 A1500287INI042 STQ* INIMIN MSB A1500288 STA* INIMIN+1 LSB A1500289 JMP* INI060 A1500290ÐÐ SPC 1 A1500291INI050 ENQ 2 INDICATE AN ERROR A1500292 RTJ MESSAG A1500293 JMP* SYU020 AND EXIT A1500294 EJT A1500295 SPC 4 A1500296INI060 LDQ =XMMLUTB A1500297 LDA- 1,Q A1500298 STA- I I= ADDR. OF SYSTEM VULUME VIT A1500299 SPC 1 A1500300 LDA- VIBMSM,I A1500301 STA* INISUB SET UP THE START OF MANAGABLE SPACE MSB A1500302 STA* INIDIR+2 A1500303 LDA- VIBMSL,I A1500304 STA* INISUB+1 AND THE LSB A1500305 STA* INIDIR+3 A1500306 SPC 1 A1500307 RTJ* INIABS A1500308INIABS NOP 0 A1500309 LDQ* INIABS A1500310 ADQ* INIREL Q = ADDRESS OF THE DOUBLE WORD PARAMETERS A1500311 SPC 1 A1500312 RTJ+ DWSUB CALCULATE THE SIZE OF MANAGEABLE SPACE A1500313 SPC 1 A1500314 LDA* INISTT WAS THE OPERATION PERFORMED CORRECTLY A1500315ÐÐ SAZ INI070 YES A1500316 JMP* INI050 NO, REPORT THE ERROR AND EXIT A1500317 SPC 1 A1500318INI070 LDA* INIRES SET UP THE DIRECTORY DATA A1500319 STA* INIDIR A1500320 STA- VILBAM,I AND THE VOLUME LABEL A1500321 LDA* INIRES+1 A1500322 STA* INIDIR+1 A1500323 STA- VILBAL,I A1500324 EJT A1500325 SPC 4 A1500326 LDA+ MAXSEC A1500327 INA 1 SET UP THE DIRECTORY SECTOR A1500328 STA* INISEC A1500329 SPC 1 A1500330 ENA 0 A1500331 STA- VICURF,I INITIALIZE THE SYSTEM VOLUME VIT A1500332 STA- VINFDB,I A1500333 STA- VINXTB,I A1500334 STA- VINOOF,I A1500335 SPC 1 A1500336 STA+ FILOAD CLEAR THE FILE INITAILIZATION INDICATOR A1500337 SPC 1 A1500338 RTJ- (AMONI) WRITE THE DIRECTORY TO MASS MEMORY A1500339INIP2 ADC $0D00+RPCP A1500340ÐÐ ADC INI080-INIP2 A1500341 ADC 0 A1500342 ADC $08C2 A1500343 ADC 5 A1500344 ADC INIDIR-INIP2 A1500345 ADC 0 A1500346INISEC ADC 0 A1500347 JMP- (ADISP) A1500348 SPC 1 A1500349 SPC 1 A1500350INI080 RTJ IMAGE UPDATE THE ITOS DATA ON THE CORE IMAGE A1500351 SPC 1 A1500352 LDQ =XMMLUTB A1500353 LDQ- 1,Q A1500354 LDA- (ZERO),Q A1500355 AND- LPMASK+15 RE-MOUNT THE SYSTEM VOLUME A1500356 STA- (ZERO),Q A1500357 SPC 1 A1500358 ENQ 3 A1500359 RTJ MESSAG INDICATE THE REQUEST WAS SUCESSFUL A1500360 JMP SYU020 EXIT A1500361 EJT A1500362 SPC 4 A1500363* F I L E I N I T I A L I Z A T I O N A1500364* A1500365ÐÐ* D A T A A N D S T O R A G E A1500366 SPC 2 A1500367INIBUF NUM 0,0,0 A1500368INIREL ADC INIMIN-INIABS A1500369 SPC 1 A1500370 SPC 1 A1500371INIDIR NUM 0 INITIALIZED MASS MEMORY DIRECTORY A1500372 NUM 0 A1500373 NUM 0 A1500374 NUM 0 A1500375 NUM -1 A1500376 SPC 1 A1500377INIMIN ADC 0 DOUBLE WORD SUBTRACT MINUEND A1500378 ADC 0 A1500379INISUB ADC 0 DOUBLE WORD SUBTRACT SUBTRAHEND A1500380 ADC 0 A1500381INIRES ADC 0 DOUBLE WORD SUBTRACT RESULT A1500382 ADC 0 A1500383INISTT ADC 0 DOUBLE WORD SUBTRACT ERROR STATUS A1500384 EJT A1500385************************************************** A1500386* A1500387* A1500388* S T A R T T H E I T O S S Y S T E M A1500389* A1500390ÐÐ* A1500391************************************************** A1500392 SPC 4 A1500393 SPC 2 A1500394START LDA+ TSNABL IS THE SYSTEM ALREADY ACTIVE A1500395 SAZ STA020 NO A1500396 SPC 1 A1500397 ENQ 0 DISPLAY AN ERROR MESSAGE A1500398 SPC 1 A1500399STA010 RTJ MESSAG A1500400 JMP SYU020 EXIT A1500401 SPC 1 A1500402STA020 RTJ* ABSADD ABSOLUTIZE ALL REQUIRED ADDRESSES A1500403 SPC 1 A1500404 LDA+ JOBIND IS THE JOB PROCESSOR ACTIVE A1500405 SAN STA030 YES A1500406 LDA+ SWTCH NO, IS LIBEDT ACTIVE A1500407 SAZ STA050 NO A1500408 SPC 1 A1500409STA030 LDA =XBAITOS YES, IS CONCURRENT BATCH ALLOWED A1500410 SAN STA040 YES, CONTINUE A1500411 SPC 1 A1500412 ENQ 4 NO, INDICATE AN ERROR A1500413 JMP* STA010 A1500414 SPC 1 A1500415ÐÐSTA040 RAO* SWAPPD SET BACKGROUND SWAPPED A1500416 RTJ* SWAPIT SWAP THE BACKGROUND A1500417 SPC 1 A1500418STA050 RAO+ MIB DISABLE BACKGROUND INITIATION A1500419 EJT 122*4612A1500420 SPC 4 122*4612A1500421 LDQ =XTSTLOC Q = ADDRESS OF START ROUTINE ADDRESSES A1500422 LDA- (ZERO),Q A1500423 STA* STASEC SPECIFY THE SECTOR ADDRESS OF THE ROUTINE A1500424 LDA- 1,Q A1500425 SUB* STALOC A1500426 STA* STALEN SPECIFY THE PROGRAM LENGTH A1500427 LDQ* STALOC A1500428 INQ 2 (BUMP OVER JMP INSTRUCTION) A1500429 STQ* STA060+1 SETUP RTJ TO START ROUTINE A1500430 INQ -2 A1500431 RTJ* PAGMEM CONVERT ADDRESS AND LENGTH TO PAGES A1500432 RTJ XMRESV RESERVE THE MEMORY FOR START A1500433 SPC 4 A1500434 RTJ- (AMONI) READ IN THE START PROCESSOR A1500435 ADC $4800+RPCP A1500436STACP1 ADC 0 A1500437 ADC 0 A1500438 ADC $08C2 A1500439STALEN ADC 0 A1500440ÐÐSTALOC ADC STRBAS A1500441 ADC 0 A1500442STASEC ADC 0 A1500443 JMP- (ADISP) A1500444 SPC 1 A1500445STA060 RTJ+ STRBAS INITIATE START PROCESSOR A1500446 LDQ* STALOC GET START ADDRESS AND LENGTH A1500447 LDA* STALEN A1500448 RTJ* PAGMEM CONVERT TO PAGES A1500449 RTJ XMRETN RETURN MEMORY A1500450 LDA* SWAPPD A1500451 SAZ STA070 SENSE BACKGROUND NOT SWAPPED A1500452 RTJ* UNSWAP UNSWAP BACKGROUND A1500453STA070 ENA 0 A1500454 STA+ MIB RE-ENABLE THE MANUAL INTERRUPT A1500455 JMP SYU020 RELEASE AND EXIT A1500456SWAPPD NUM 0 BACKGROUND SWAPPED INDICATOR A1500457 SPC 2 A1500458* CONVERT LOGICAL ADDRESSES TO MEMORY PAGE FORMAT A1500459 SPC 2 A1500460PAGMEM 0 0 A1500461 STQ* PAGBAS SAVE THE BASE LOGICAL ADDRESS A1500462 ENQ 0 A1500463 LLS 5 CONVERT THE LENGTH TO PAGES A1500464 SAZ PAG010 A1500465ÐÐ INQ 1 A1500466PAG010 LDA* PAGBAS A1500467 AND- ZROMSK+10 ROUND BASE UP TO PAGE BOUNDARY A1500468 JMP* (PAGMEM) RETURN A1500469PAGBAS NUM 0 A1500470 SPC 2 A1500471 EJT A1500472 SPC 4 A1500473* A B S O L U T I Z E P R O G R A M A D D R E S S E S A1500474 SPC 2 A1500475ABSADD NOP 0 A1500476 SPC 1 A1500477 RTJ* ABSLOC A1500478ABSLOC NOP 0 A1500479 LDA* ABSLOC A1500480 ADD* ABSRL1 A1500481 LDQ =XPRTCDR A1500482 STA- 1,Q SET UP DELAYED SWAP RETURN ADDRESS A1500483 SPC 1 A1500484 LDA* ABSLOC A1500485 ADD* ABSRL2 A1500486 STA* SWACP1 SWAP WRITE COMPLETION ADDRESS A1500487 SPC 1 A1500488 LDA* ABSLOC A1500489 ADD* ABSRL3 A1500490ÐÐ STA* STACP1 'START' READ COMPLETION A1500491 SPC 1 A1500492 LDA* ABSLOC A1500493 ADD* ABSRL4 A1500494 STA* UNSCP1 UNSWAP READ COMPLETION A1500495 SPC 1 A1500496 LDA+ SWPSEC A1500497 STA* SWASEC SET UP SWAP BUFFER SECTOR A1500498 STA* UNSSEC A1500499 SPC 1 A1500500 JMP* (ABSADD) RETURN A1500501 SPC 2 A1500502ABSRL1 ADC SWA010-ABSLOC A1500503ABSRL2 ADC SWA020-ABSLOC A1500504ABSRL3 ADC (STA060-ABSLOC) A1500505ABSRL4 ADC UNS010-ABSLOC A1500506 EJT A1500507 SPC 4 A1500508* S W A P T H E M S O S B A C K G R O U N D A1500509 SPC 2 A1500510SWAPIT NOP 0 A1500511 SPC 1 A1500512 LDA+ UNPIO IS BACKGROUND I/O ACTIVE A1500513 SAZ SWA010 NO A1500514 STA+ SPASW YES, INDICATE A SWAP IS REQUIRED A1500515ÐÐ JMP- (ADISP) EXIT TO AWAIT DELAYED SWAP RETURN A1500516 SPC 1 A1500517SWA010 LDA- $F6 A1500518 SUB- $F7 A1500519 INA -1 A1500520 STA* SWALEN SET UP THE SWAP LENGTH A1500521 LDA- $F7 A1500522 INA 1 A1500523 STA* SWAADD AND THE STARTING ADDRESS A1500524 SPC 1 A1500525 RTJ- (AMONI) SWAP THE BACKGROUND TO MASS MEMORY A1500526 ADC $4C00+RPCP A1500527SWACP1 ADC 0 A1500528 ADC 0 A1500529 ADC $08C2 A1500530SWALEN ADC 0 A1500531SWAADD ADC 0 A1500532 ADC 0 A1500533SWASEC ADC 0 A1500534 SPC 1 A1500535 RTJ+ STLPV4 INITIATE THE SWAPPED IDLE LOOP A1500536 JMP- (ADISP) A1500537 SPC 1 A1500538SWA020 LDQ* SWAADD GET BACKGROUND ADDRESS AND LENGTH A1500539 LDA* SWALEN A1500540ÐÐ RTJ* PAGMEM CONVERT TO PAGES A1500541 RTJ XMRETN RETURN THE PAGES A1500542 JMP* (SWAPIT) A1500543 EJT A1500544 SPC 4 A1500545* U N S W A P T H E M S O S B A C K G R O U N D A1500546 SPC 2 A1500547UNSWAP NOP 0 A1500548 SPC 1 A1500549 RTJ* ABSADD ABSOLUTIZE ALL NECESSARY ADDRESSES A1500550 SPC 1 A1500551 LDA- $F6 A1500552 SUB- $F7 A1500553 INA -1 A1500554 STA* UNSLEN SET UP THE UNSWAP LENGTH A1500555 LDQ- $F7 A1500556 INQ -1 A1500557 STQ* UNSADD AND THE STARTING ADDRESS A1500558 RTJ* PAGMEM CONVERT TO PAGES A1500559 RTJ XMRESV RESERVE THE BACKGROUND MEMORY A1500560 SPC 1 A1500561 RTJ- (AMONI) READ THE BACKGROUND FROM MASS MEMORY A1500562 ADC $4800+RPCP A1500563UNSCP1 ADC 0 A1500564 ADC 0 A1500565ÐÐ ADC $08C2 A1500566UNSLEN ADC 0 A1500567UNSADD ADC 0 A1500568 ADC 0 A1500569UNSSEC ADC 0 A1500570 SPC 1 A1500571UNSXIT JMP- (ADISP) A1500572 SPC 1 A1500573UNS010 LDA* UNSXIT A1500574 STA+ LOOP TERMINATE THE SWAPPED IDLE LOOP A1500575 ENA 0 A1500576 STA+ MIB RE-ENABLE MANUAL INTERRUPT A1500577 IIN 0 A1500578 STA+ SWAPON DISABLE THE SWAP CONDITION A1500579 JMP* (UNSWAP) RETURN A1500580 EJT 0 A1500581************************************************** A1500582* A1500583* A1500584* S T O P T H E I T O S S Y S T E M A1500585* A1500586* A1500587************************************************** A1500588 SPC 2 A1500589 SPC 2 A1500590ÐÐSTOP NOP 0 A1500591 SPC 1 A1500592STP010 ENQ 6 REQUEST VERIFICATION A1500593 RTJ MESSAG A1500594 SPC 1 A1500595 RTJ- (AMONI) READ THE RESPONSE A1500596STP1 ADC $0900+RPCP A1500597 ADC STP020-STP1 A1500598 ADC 0 A1500599 ADC $18FD A1500600 ADC 2 A1500601 ADC STPBUF-STP1 A1500602 JMP- (ADISP) A1500603 SPC 1 A1500604STP020 LDA* STPBUF A1500605 SUB =AOK WAS THE RESPONSE PROPER ('OK') A1500606 SAZ STP030 YES A1500607 SPC 1 A1500608 ENQ 2 NO A1500609 RTJ MESSAG A1500610 JMP SYU020 EXIT A1500611 EJT 0 A1500612STP030 ENQ 7 REQUEST TIME WHEN SYSTEM WILL BE BACK A1500613 RTJ MESSAG A1500614 SPC 1 A1500615ÐÐ LDA =N$FF20 PRESET BUFFER S.T. IF NOTHING IS INPUT, IT A1500616* WILL BE AN ILLEGAL BINARY NUMBER A1500617 STA* STPBUF A1500618 LDA =N$2020 PRESET THE REST OF THE BUFFER TO BLANK A1500619 STA* STPBUF+1 A1500620 STA* STPBUF+2 A1500621 SPC 2 A1500622 RTJ- (AMONI) READ RESPONSE A1500623STP2 ADC $0900+PRI5 COMPLETE AT PRIORITY 5 , S.T. WHEN SETTING A1500624* STATUS WORD, THE PROGRAM WOULD NOT BE A1500625* INTERRUPTED BY PROGRAMS RUNNING AT 6 A1500626* A1500627 ADC STP040-STP2 A1500628 ADC 0 A1500629 ADC $18FD A1500630 ADC 2 A1500631 ADC STPBUF-STP2 A1500632 JMP- (ADISP) A1500633 SPC 1 A1500634STP040 RTJ DECHEX CONVERTS TO A NUMBER A1500635 ADC (STPBUF-*) A1500636 ADC (TIME-*) A1500637 SPC 1 A1500638 LDA* TIME A1500639 SAM STP050 CHECK IF POSITIVE,THEN A LEGAL NO. WAS INPUT A1500640ÐÐ SUB =N2401 CHECK IF SMALLER THAN 2401 A1500641 SAM STP060 A1500642 SPC 1 A1500643STP050 LDA =A?? TIME IS INVALID, ENTER ???? AS VALUE A1500644 STA* STPBUF A1500645 STA* STPBUF+1 A1500646 SPC 1 A1500647STP060 LDQ =XRETIME A1500648 LDA* STPBUF A1500649 STA- (ZERO),Q SAVE THE TIME OF RESTORATION IN TSDATA A1500650 LDA* STPBUF+1 A1500651 STA- 1,Q A1500652 SPC 1 A1500653 RTJ IMAGE SAVE THE DATA ON THE CORE IMAGE A1500654 EJT 0 A1500655* SET UP ALL I/O TABLES (EXCEPT PORT 0) A1500656* A1500657 SPC 2 A1500658* FORCE A RELOAD OF THE 2550 CPU TO A1500659* INITIALIZE TERMINALS. A1500660 LDQ =XTERMLU A1500661 LDQ+ LOG1A,Q A1500662 SEF- CPSTAT,14,1,Q SET CP FORCE RESTART A1500663 CLR A SET PORT NUMBER TO ZERO A1500664 STA* PORT A1500665ÐÐ STA* NUMACT NUMBER OF ACTIVE USERS A1500666 SPC 1 A1500667 LDQ =XTSPORT A1500668STP070 INQ IOITEM ADDR OF I/O TABLE FOR PORT N A1500669 LDA =XTSPEND A1500670 EAQ A A1500671 SAN STP080 SEE IF REACH END OF ALL PORTS A1500672 SPC 1 A1500673 JMP* STP120 YES, SKIP A1500674 SPC 1 A1500675STP080 EQU STP080(*) A1500676 RAO* PORT ADD ONE TO PORT NUMBER A1500677 SPC 1 A1500678 LDA- (TSUSTB),Q SEE IF THIS TERMINAL IS ACTIVE A1500679 SAZ STP090 NO, SKIP A1500680 SPC 1 A1500681 RAO* NUMACT COUNT NO. OF ACTIVE USERS A1500682 SPC 2 A1500683 JMP* STP070 A1500684 SPC 1 A1500685 SPC 2 A1500686STP090 EQU STP090(*) A1500687* TERMINAL IS NOT ACTIVE. FILL FWRITE REQUEST A1500688* IN I/O TABLE FOR THIS PORT A1500689 LDA =N$4C55 REQUEST CODE A1500690ÐÐ STA- IORQCD,Q A1500691 SPC 1 A1500692 CLR A A1500693 STA- IORQCA,Q COMPLETION ADDR A1500694 STA- IORQTH,Q THREAD WORD A1500695 SPC 1 A1500696 LDA =XTERMLU A1500697 ADD- ONEBIT+12 A1500698 STA- IORQLU,Q LOGICAL UNIT A1500699 SPC 1 A1500700 LDA =XTSLOFF LENGTH OF MESSAGE IN TSDATA A1500701 STA- IOMSLN,Q LENGTH OF MESSAGE TO BE OUTPUT A1500702 SPC 1 A1500703 LDA- TERMBF,Q ADDRESS OF I/O HEADER FOR THIS PORT A1500704 STA- IOBFAD,Q A1500705 SPC 2 A1500706 STA- I A1500707 SPC 2 A1500708 LDA* PORT SET UP 4 WORD HEADER FOR MSG A1500709 STA- (ZERO),I CURRENT PORT NUMBER A1500710 CLR A A1500711 STA- 1,I WORD 1 A1500712 STA- 3,I WORD 3 A1500713 ENA -1 A1500714 STA- 2,I WORD 2 A1500715ÐÐ SPC 2 A1500716STP110 JMP* STP070 DONE WITH ONE TABLE A1500717 SPC 1 A1500718STP120 EQU STP120(*) DONE WITH ALL PORTS A1500719 EJT 0 A1500720 LDA* NUMACT COMPLEMENT THE NO. OF ACTIVE USERS A1500721 TCA A SAVE FOR ITOS EXEC A1500722 INA 0 A1500723 STA+ TSNABL A1500724 SPC 5 A1500725 LDA+ HORMIN GET CURRENT TIME A1500726 STA* TIME A1500727 RTJ BINASC CONVERT TO ASCII IN MESSAGE BUFFER A1500728 ADC (TIME-*) A1500729 ADC (MESGX8-*) A1500730 SPC 1 A1500731 ENQ 8 PRINT STOP MESSAGE A1500732 RTJ* MESSAG A1500733 SPC 1 A1500734 JMP SYU020 ALL DONE A1500735 SPC 5 A1500736STPBUF NUM 0,0,0 INPUT BUFFER A1500737TIME NUM 0 NUMERIC VALUE FOR TIME A1500738PORT NUM 0 CURRENT PORT NUMBER A1500739NUMACT NUM 0 NO. OF ACTIVE USERS A1500740ÐÐTBLADR NUM 0 ADDR OF IO TABLE A1500741 EJT 0 A1500742************************************************** A1500743* A1500744* A1500745* E N T E R P A S S W O R D A1500746* A1500747* A1500748************************************************** A1500749 SPC 2 A1500750 SPC 2 A1500751PASSWD NOP 0 A1500752 SPC 1 A1500753 ENQ 9 REQUEST PASSWORD A1500754 RTJ* MESSAG A1500755 SPC 1 A1500756 RTJ- (AMONI) READ FROM COMMENT DEVICE A1500757PSW1 ADC $0900+RPCP INPUT BUFFER IS ALREADY BLANK FILLED A1500758 ADC PSW010-PSW1 DRIVER DOES NOT CHANGE BUFFER EXCEPT FOR A1500759 ADC 0 CHARACTERS ACTUALLY INPUT A1500760 ADC $18FD A1500761 ADC 5 8 CHARACTERS LONG A1500762 ADC PSWBUF-PSW1 A1500763 JMP- (ADISP) A1500764 SPC 1 A1500765ÐÐPSW010 LDA* PSWBUF SEE IF THERE IS ANY INPUT A1500766 AND- ZROMSK+7 NOTHING IS INPUT IF FIRST CHAR IS UNCHANGED A1500767 EOR- ZROMSK+7 (STILL $FF) A1500768 SAN PSW020 A1500769 SPC 1 A1500770 ENQ 2 ABORT REQUEST BECAUSE NOTHING HAS BEEN A1500771 RTJ* MESSAG ENTERED A1500772 JMP SYU020 EXIT A1500773 SPC 1 A1500774PSW020 ENQ 3 MOVE PASSWORD TO GLOBAL BUFFER A1500775PSW025 LDA* PSWBUF,Q BUFFER ALREADY BLANK FILLED A1500776 AND- ONEMSK+7 SEE IF AN ODD NO. OF CHARS HAVE BEEN INPUT A1500777 EOR- ONEMSK+7 IF SO, THE LEFT CHAR IS $FF A1500778 SAN PSW027 NO, SKIP A1500779 SPC 1 A1500780 LDA* PSWBUF,Q YES, RIGHT BLANK FILL THE WORD A1500781 AND- ZROMSK+7 SAVE LEFT CHAR A1500782 ADD- ONEBIT+5 FILL IN A BLANK ($20) A1500783 JMP* PSW028 A1500784 SPC 1 A1500785PSW027 LDA* PSWBUF,Q A1500786PSW028 EQU PSW028(*) A1500787 STA+ QPASWD,Q STORE A1500788 DQP *-PSW025 A1500789 SPC 2 A1500790ÐÐ EJT 0 A1500791 RTJ IMAGE SAVE THE SYSTEM INFORMATION TABLE A1500792 SPC 1 A1500793 ENQ 10 PRINT COMPLETION MESSAGE A1500794 RTJ* MESSAG A1500795 SPC 1 A1500796 JMP SYU020 EXIT A1500797 SPC 5 A1500798PSWBUF NUM $FF20 PASSWORD BUFFER A1500799 NUM $2020 PRESET TO ALL BLANKS A1500800 NUM $2020 A1500801 NUM $2020 A1500802 NUM 0 A1500803 EJT A1500804 SPC 4 A1500805MESSAG NOP 0 A1500806 SPC 1 A1500807 LDA* MESSAD,Q A1500808 STA* MESADR SPECIFY THE MESSAGE ADDRESS A1500809 LDA* MESLEN,Q A1500810 STA* MESLGN AND THE LENGTH A1500811 SPC 1 A1500812 RTJ- (AMONI) DISPLAY THE MESSAGE A1500813MESP1 ADC $0D00+RPCP A1500814 ADC MES010-MESP1 A1500815ÐÐ ADC 0 A1500816 ADC $18FC A1500817MESLGN ADC 0 A1500818MESADR ADC 0 A1500819 JMP- (ADISP) A1500820 SPC 1 A1500821MES010 JMP* (MESSAG) RETURN A1500822 SPC 2 A1500823MESSAD ADC MESG00-MESP1 00 A1500824 ADC MESG01-MESP1 01 A1500825 ADC MESG02-MESP1 02 A1500826 ADC MESG03-MESP1 03 A1500827 ADC MESG04-MESP1 04 A1500828 ADC MESG05-MESP1 05 A1500829 ADC MESG06-MESP1 06 A1500830 ADC MESG07-MESP1 07 A1500831 ADC MESG08-MESP1 08 A1500832 ADC MESG09-MESP1 09 A1500833 ADC MESG10-MESP1 10 A1500834 SPC 1 A1500835MESLEN ADC LMSG00 00 A1500836 ADC LMSG01 01 A1500837 ADC LMSG02 02 A1500838 ADC LMSG03 03 A1500839 ADC LMSG04 04 A1500840ÐÐ ADC LMSG05 05 A1500841 ADC LMSG06 06 A1500842 ADC LMSG07 07 A1500843 ADC LMSG08 08 A1500844 ADC LMSG09 09 A1500845 ADC LMSG10 10 A1500846 EJT A1500847* M E S S A G E S A1500848 SPC 2 A1500849MESG00 ALF $,CCS ACTIVE -REQUEST REJECTED$ A1500850 EQU LMSG00(*-MESG00) A1500851MESG01 ALF $,W A R N I N G : ALL SYSTEM VOLUME FILES:R$ A1500852 ALF $, WILL BE PURGED.$ A1500853 EQU LMSG01(*-MESG01) A1500854MESG02 ALF $,-REQUEST ABORTED$ A1500855 EQU LMSG02(*-MESG02) A1500856MESG03 ALF $,REQUEST COMPLETE$ A1500857 EQU LMSG03(*-MESG03) A1500858MESG04 ALF $,BATCH PROCESSOR ACTIVE -REQUEST REJECTED$ A1500859 EQU LMSG04(*-MESG04) A1500860 EJT 0 A1500861MESG05 ALF $, $ SPARE A1500862 EQU LMSG05(*-MESG05) A1500863 SPC 2 A1500864MESG06 ALF $,VERIFY $ A1500865ÐÐ EQU LMSG06(*-MESG06) A1500866MESG07 ALF $,UNTIL ? HHMM$ A1500867 NUM $0D00 RETURN TO BEGINNING OF LINE A1500868 NUM $1515,$1515,$1515,$1515 SKIP TO UNDER MSG A1500869 EQU LMSG07(*-MESG07) A1500870 SPC 2 A1500871MESG08 ALF $,CCS DISABLED AT$ A1500872MESGX8 ALF $, $ A1500873 EQU LMSG08(*-MESG08) A1500874MESG09 ALF $,PASSWORD = $ A1500875 EQU LMSG09(*-MESG09) A1500876 EJT 0 A1500877MESG10 ALF $,PASSWORD ENTERED$ A1500878 EQU LMSG10(*-MESG10) A1500879 END A1500880 NAM BIN2AS A16 A ITOS CCS 3.0 SL-149A1600001* ITOS UTILITY BINARY-ASCII CONVERSION A1600002* CREDIT COLLECTION SYSTEM VERSION 3.0 A1600003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A1600004* COPYRIGHT CONTROL DATA CORPORATION 1979 A1600005* A1600006 SPC 2 A1600007**** A1600008* CONVERTS BINARY TO DECIMAL CODED ASCII . A1600009* LEADING ZEROS ARE SUPRESSED. A1600010ÐÐ* A1600011* ENTRY POINTS- A1600012* ----- ------ A1600013 ENT BINASC A1600014* A1600015* A1600016* EXTERNALS- A1600017* --------- A1600018 EXT* Q8PREP A1600019 EXT* Q8PKUP A1600020* A1600021* A1600022* EQUIVALENCES- A1600023* ------------ A1600024 EQU ONEMSK(3) A1600025 EQU ONEBIT($23) A1600026 EQU ZROMSK($13) A1600027* A1600028* A1600029* ENTRY/EXIT A1600030* ----- ---- A1600031* ENTRY A1600032* CALL BINASC(IVAL,IBUF) A1600033* IVAL IS POSITIVE BINARY NBR A1600034* IBUF IS THREE WORD BUFFER A1600035ÐÐ* EXIT A1600036* IBUF CONTAINS RIGHT JUSTIFIED DECIMAL A1600037* CODED ASCII WITH LEADING SPACES. A1600038**** A1600039 SPC 4 A1600040BINASC NUM 0 A1600041 STQ* QSAVE SAVE Q,I A1600042 LDA- I A1600043 STA* ISAVE A1600044 RTJ Q8PREP PICK UP PARAMETER LOCATIONS A1600045 ADC* BINASC A1600046 RTJ Q8PKUP A1600047 STA* IVAL A1600048 RTJ Q8PKUP A1600049 STA* IBUF A1600050 ENA 2 SET OUTPUT BUFFER POINTERS TO A1600051 STA- I LAST WORD A1600052 ENA 1 A1600053 STA* SCHAR LS CHAR A1600054 LDA* (IVAL) A1600055 STA* VALUE A1600056BIN2 LDA* VALUE LOAD BINARY VALUE A1600057 CLR Q A1600058 DVI =N10 DIVIDE BY 10 A1600059 STA* VALUE SAVE ANSWER A1600060ÐÐ ADQ =N$30 CONV REMAINDER TO ASCII A1600061 STQ* TMPCHR SAVE A1600062 LDA* (IBUF),I LOAD OUTPUT WORD A1600063 LDQ* SCHAR IS LS NEXT A1600064 SQN BIN4 YES A1600065 AND- ONEMSK+7 NO,MS NEXT A1600066 LDQ* TMPCHR A1600067 QLS 8 A1600068 EAQ A MERGE WITH NEW MS CHAR A1600069 STA* (IBUF),I A1600070 JMP* BIN8 A1600071BIN4 AND- ZROMSK+7 A1600072 EOR* TMPCHR MERGE WITH NEW LS CHAR A1600073 STA* (IBUF),I A1600074BIN8 LDA- I IS END (FIRST) WORD IN BUFFER A1600075 SAZ BIN12 YES A1600076 JMP* BIN16 NO A1600077BIN12 LDA* SCHAR IS END (MS) CHAR IN BUFFER A1600078 SAN BIN16 NO A1600079 JMP* BIN24 DONE CODING A1600080BIN16 LDA* SCHAR BUMP POINTERS TO NEXT OUTPUT CHAR A1600081 EOR- ONEBIT SWITCH CHAR IDX A1600082 STA* SCHAR A1600083 SAZ BIN20 MS NEXT, SAME WORD A1600084 LDA- I LS NEXT, NEXT WORD A1600085ÐÐ INA -1 BUMP WORD INDEX A1600086 STA- I A1600087BIN20 JMP* BIN2 A1600088BIN24 LDA* (IBUF),I SUPRESS LEADING ZEROS A1600089 LDQ* SCHAR A1600090 SQN BIN32 LS NEXT A1600091 AND- ZROMSK+7 IS MS A ZERO A1600092 SUB =N$3000 A1600093 SAZ BIN28 YES A1600094 JMP* BIN42 NO, FINISHED A1600095BIN28 LDA* (IBUF),I REPLACE MS ZERO CHAR WITH SPACE A1600096 AND- ONEMSK+7 A1600097 EOR =N$2000 A1600098 STA* (IBUF),I A1600099 JMP* BIN40 A1600100BIN32 AND- ONEMSK+7 IS LS A ZERO A1600101 SUB =N$30 A1600102 SAZ BIN36 YES A1600103 JMP* BIN42 NO, FINISHED A1600104BIN36 LDA* (IBUF),I REPLACE LS ZERO CHAR WITH SPACE A1600105 AND- ZROMSK+7 A1600106 EOR =N$20 A1600107 STA* (IBUF),I A1600108BIN40 LDA- I IS DONE A1600109 INA -2 A1600110ÐÐ SAN BIN44 NO A1600111BIN42 LDA* ISAVE YES, LEAVE ONE ZERO UNCHECKED A1600112 STA- I A1600113 LDQ* QSAVE A1600114 JMP* (BINASC) A1600115BIN44 LDA* SCHAR BUMP OUTPUT BUFFER POINTERS A1600116 EOR- ONEBIT A1600117 STA* SCHAR A1600118 SAN BIN48 LS NEXT ,SAME WORD A1600119 RAO- I MS NEXT, BUMP WORD A1600120BIN48 JMP* BIN24 A1600121 SPC 2 A1600122QSAVE NUM 0 A1600123ISAVE NUM 0 A1600124IVAL NUM 0 A1600125IBUF NUM 0 A1600126VALUE NUM 0 A1600127SCHAR NUM 0 A1600128TMPCHR NUM 0 A1600129 END A1600130 NAM DEC2HX A17 A ITOS CCS 3.0 SL-149A1700001* ITOS UTILITY DECIMAL-BINARY COVERSION A1700002* CREDIT COLLECTION SYSTEM VERSION 3.0 A1700003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A1700004* COPYRIGHT CONTROL DATA CORPORATION 1979 A1700005ÐÐ* A1700006 SPC 2 A1700007**** A1700008* DECIMAL CODED ASCII TO BINARY CONVERSION ROUTINE A1700009* A1700010* A1700011* ENTRY POINTS- A1700012* ----- ------ A1700013 ENT DECHEX A1700014* A1700015* A1700016* EXTERNALS- A1700017* --------- A1700018 EXT* Q8PREP A1700019 EXT* Q8PKUP A1700020* A1700021* A1700022* EQUIVALENCES- A1700023* ------------ A1700024 EQU ONEMSK(3) A1700025 EQU ONEBIT($23) A1700026* A1700027* A1700028* GENERAL DESCRIPTION- A1700029* ------- ----------- A1700030ÐÐ* DECHEX CONVERTS THE DECIMAL CODED ASCII A1700031* CHARACTERS IN INPUT BUFFER TO BINARY . A1700032* IGNORES LEADING SPACES, TERMINATES ON TRAILING SPACES. A1700033* DECHEX USES INTERMEDIATE BUFFER FOR OUTPUT TO A1700034* ENABLE INPUT BUFFER TO BE OUTPUT BUFFER. A1700035* A1700036* A1700037* ENTRY/EXIT- A1700038* ----- ---- A1700039* ENTRY A1700040* CALL DECHEX(IBUF,IVAL) A1700041* IBUF IS 3 WORD INPUT CHAR BUFFER A1700042* IVAL IS VALUE LOCATION A1700043* IVAL MAY BE THE SAME AS IBUF A1700044* EXIT A1700045* IVAL SET TO BINARY VALUE A1700046* IVAL SET TO $FFFF IF NUMBER EXCEEDS 32767 A1700047* OR IF NON-NUMERIC CHAR ENCOUNTERED. A1700048**** A1700049 EJT A1700050DECHEX NUM 0 A1700051 LDA- I SAVE I,Q A1700052 STA* ISAVE A1700053 STQ* QSAVE A1700054 RTJ Q8PREP PICK UP PARAMETER LOCATIONS A1700055ÐÐ ADC* DECHEX A1700056 RTJ Q8PKUP A1700057 STA* IBUF A1700058 RTJ Q8PKUP A1700059 STA* IVAL A1700060 ENA 0 INITIALIZE A1700061 STA* IDX CHAR IDX A1700062 STA* TEMP VALUE A1700063 STA- I INPUT BUFFER WORD POINTER A1700064 STA* FOUND CLEAR FOUND NBR FLAG A1700065DEC4 ENQ 0 CONVERT LOOP A1700066 LDA* TEMP A1700067 MUI =N10 A1700068 STA* TEMP A1700069DEC6 LDA* (IBUF),I GET NEXT WORD A1700070 LDQ* IDX IS LS CHAR A1700071 SQN DEC8 YES A1700072 ARS 8 NO, RIGHT JUSTIFY A1700073DEC8 AND- ONEMSK+7 MASK A1700074 TRA Q A1700075 SUB =N$20 IS SPACE A1700076 SAN DEC8A NO A1700077 JMP* DEC8D A1700078DEC8A TRQ A A1700079 SUB =N$30 IS ZERO OR GREATER A1700080ÐÐ SAP DEC8B YES A1700081 JMP* DEC9A NO A1700082DEC8B TRQ A A1700083 SUB =N$40 IS NINE OR LESS A1700084 SAM DEC9 YES A1700085 JMP* DEC9A NO A1700086DEC8D LDA* FOUND IS TRAILING SPACE A1700087 SAN DEC8E SKIP IF TRAILING SPACE A1700088 JMP* DEC10 A1700089DEC8E CLR Q A1700090 LDA* TEMP A1700091 DVI =N10 CANCEL PREVIOUS *10 A1700092 STA* TEMP A1700093 JMP* DEC16 YES, STOP ENCODING A1700094DEC9 RAO* FOUND SET FOUND NBR FLAG A1700095 TRQ A A1700096 SUB =N$30 A1700097 ADD* TEMP A1700098 SAP DEC9B NO OVERFLOW A1700099DEC9A ENA -0 OVERFLOW OR NON/NUMERIC A1700100 STA* TEMP A1700101 JMP* DEC16 A1700102DEC9B STA* TEMP A1700103DEC10 LDA* IDX CHARACTER INDEX A1700104 EOR- ONEBIT SWITCH CHAR IDX A1700105ÐÐ STA* IDX A1700106 SAN DEC12 LS NEXT, SAME WORD A1700107 LDA- I CHECK END OF BUFFER A1700108 INA -2 A1700109 SAZ DEC16 DONE A1700110 RAO- I BUMP WORD INDEX A1700111DEC12 LDA* FOUND HAS A NON BLANK BEEN FOUND A1700112 SAN DEC14 YES A1700113 JMP* DEC6 NO, DONT ADJUST ACCUMULATOR A1700114DEC14 JMP* DEC4 A1700115DEC16 LDA* ISAVE RESTORE I,Q A1700116 STA- I A1700117 LDQ* QSAVE A1700118 LDA* TEMP A1700119 STA* (IVAL) A1700120 JMP* (DECHEX) A1700121IDX NUM 0 A1700122IBUF NUM 0 A1700123IVAL NUM 0 A1700124TEMP NUM 0 A1700125QSAVE NUM 0 A1700126ISAVE NUM 0 A1700127FOUND NUM 0 A1700128 END A1700129 NAM Q8PRMR A18 A ITOS CCS 3.0 SL-149A1800001ÐÐ* ITOS UTILITY PARAMETER PICKUP ROUTINE A1800002* CREDIT COLLECTION SYSTEM VERSION 3.0 A1800003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A1800004* COPYRIGHT CONTROL DATA CORPORATION 1979 A1800005* A1800006 SPC 2 A1800007 SPC 2 A1800008 ENT Q8PREP A1800009 ENT Q8PKUP A1800010 SPC 1 A1800011 EQU LPMSK(2) A1800012 EQU ENTAD($DC),PAD($DD) A1800013 SPC 2 A1800014Q8PREP NOP 0 A1800015* A1800016 LDA* (Q8PREP) OBTAIN THE PARAMETER A1800017 ADD* Q8PREP ABSOLUTIZE IT A1800018 AND- LPMSK+15 A1800019 STA- ENTAD A1800020 RAO* Q8PREP A1800021 JMP* (Q8PREP) RETURN A1800022 SPC 2 A1800023Q8PKUP NOP 0 A1800024 LDA- (ENTAD) PICK UP PARAMETER A1800025 STA- PAD A1800026ÐÐ LDA- (PAD) IS THE PARAMETER ABSOLUTE A1800027 SAP ABS YES A1800028 ADD- (ENTAD) NO, ABSOLUTIZE THE PARAMETER ADDRESS A1800029 AND- LPMSK+15 A = PARAMETER ADDRESS A1800030ABS RAO- (ENTAD) SET UP FOR NEXT PARAMETER A1800031 JMP* (Q8PKUP) RETURN A1800032 END A1800033 NAM IMAGE A19 A ITOS CCS 3.0 SL-149A1900001* ITOS UTILITY TABLE UPDATE ROUTINE A1900002* CREDIT COLLECTION SYSTEM VERSION 3.0 A1900003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A1900004* COPYRIGHT CONTROL DATA CORPORATION 1979 A1900005* A1900006 SPC 2 A1900007* THE ITEMS SAVED BY THIS SUBROUTINE ARE - A1900008* A1900009* RETIME I T O S REACTIVATION TIME A1900010* ONTIME I T O S ACTIVATION TIME A1900011* FILOAD I T O S FILES LOADED INDICATOR A1900012* QPASWD I T O S SYSTEM PASSWORD A1900013 SPC 1 A1900014* E N T R Y P O I N T S A1900015 SPC 1 A1900016 ENT IMAGE A1900017 SPC 1 A1900018ÐÐ* E X T E R N A L S A1900019 SPC 1 A1900020 EXT RETIME BASE ADDRESS OF IMAGE TABLE A1900021 SPC 1 A1900022* E Q U I V A L E N C E S A1900023 SPC 1 A1900024 EQU LPMSK($2) BIT MASK TABLE A1900025 EQU AMONI($F4) ADDRESS OF MONITOR REQUEST ENTRY A1900026 EQU ADISP($EA) ADDRESS OF DISPATCHER A1900027 SPC 2 A1900028IMAGE NOP 0 A1900029 LDQ- $E9 A1900030 LDA- 4,Q PICK UP THE CORE IMAGE A1900031 MUI =N96 CONVERT TO WORD ADDRESSING A1900032 SAP IMAGE1 A1900033 AND- LPMSK+15 A1900034 INQ 1 A1900035IMAGE1 ADD =XRETIME CALCULATE THE STARTING ADDRESS OF THE DATA A1900036 SAP IMAGE2 A1900037 AND- LPMSK+15 A1900038 INQ 1 A1900039IMAGE2 STQ* MSB SAVE THE ADDRESS A1900040 STA* LSB A1900041 SPC 1 A1900042 LDA* IMAGE SET UP THE COMPLETION ADDRESS A1900043ÐÐ STA* CMP A1900044 EJT A1900045 RTJ- (AMONI) A1900046 ADC $4466 WRITE THE DATA TO THE CORE IMAGE A1900047CMP ADC 0 A1900048 ADC 0 A1900049 ADC $08C2 A1900050 ADC 10 TABLE LENGTH = 10 A1900051 ADC RETIME A1900052MSB ADC 0 A1900053LSB ADC 0 A1900054 JMP- (ADISP) A1900055 END A1900056 NAM MNTCHK A20 A ITOS CCS 3.0 SL-149A2000001* ITOS VOLUME MOUNT CHECK ROUTINE A2000002* CREDIT COLLECTION SYSTEM VERSION 3.0 A2000003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A2000004* COPYRIGHT CONTROL DATA CORPORATION 1979 A2000005* A2000006* A2000007* MNTCHK IS RUN AS AN ORDINAL SCHEDULED IN SPACE A2000008* DURING AUTO-LOAD TIME A2000009* A2000010* PERIODICALLY CHECKS VOLUME LABEL ON ALL MOUNTED VOLUMES A2000011 SPC 3 A2000012ÐÐ* FOR ALL VOLUMES CURRENTLY MOUNTED, MNTCHK READS A2000013* THE LABEL ON THAT VOLUME. IF NO I/O ERROR, THEN A2000014* MNTCHK COMPARES THE VOLUME NAME ON THE LABEL A2000015* WITH THAT FROM THE VIT. IF THEY ARE THE SAME, A2000016* THEN GOES TO THE NEXT VIT. A2000017* A2000018* ANY TIME THERE IS AN ERROR, MNTCHK OUTPUTS A A2000019* MESSAGE AND DISMOUNTS THE VOLUME AND DOES A A2000020* FORCE FILE CLOSE ON ALL OPEN FILES ON THIS A2000021* VOLUME A2000022* A2000023* THE SYSTEM VOLUME (NUMBERED ONE) WILL NOT BE CHECKED A2000024* A2000025* A2000026* EXTERNALS A2000027 SPC 2 A2000028 EXT MNTCHK ORDINAL NAME FOR PROGRAM A2000029 SPC 2 A2000030 EXT SYFAIL SYSTEM FAILURE ROUTINE A2000031 EXT MMLUTB MASS MEMORY LOGICAL UNIT TABLE A2000032 EXT CCP CURRENT CONTROL POINT LOCATION ADDRESS A2000033 SPC 1 A2000034 SPC 2 A2000035 SPC 3 A2000036* EQUIVALENCES A2000037ÐÐ EQU ZERO($22) A2000038 EQU ONEMSK(3) ONE MASK TABLE A2000039 EQU FMEIDX(30) FILE MANAGER'S INDEX INTO EXTENDED CORE TABLE A2000040 EQU ADRECT($E9) ADDRESS OF EXTENDED CORE TABLE A2000041 EQU AMONI($F4) A2000042 EQU ADISP($EA) A2000043 EQU PERIOD(15) RUNS AT 15 SECOND INTERVALS A2000044 EJT A2000045* VOLUME INFORMATION TABLE A2000046* A2000047 EQU VISLUN(2) SYSTEM LOGICAL UNIT NUMBER (BIT 15=1,NOT READYA2000048* ACCESS VISLUN INDIRECTLY A2000049 EQU VINAME(1) VOLUME NAME - ASCII CHARACTERS 1 AND 2 A2000050* VOLUME NAME - ASCII CHARACTERS 3 AND 4 A2000051* VOLUME NAME - ASCII CHARACTERS 5 AND 6 A2000052* VOLUME NAME - ASCII CHARACTERS 7 AND 8 A2000053 EQU VINMBR(5) VOLUME NUMBER - (2 ASCII CHARACTERS) A2000054 EQU VIBMSM(6) BEGINNING OF MANAGEABLE SPACE - MSB A2000055 EQU VIBMSL(7) BEGINNING OF MANAGEABLE SPACE - LSB A2000056 EQU VIASDM(8) AVAILABLE SPACE DIRECTORY ADDRESS - MSB A2000057 EQU VIASDL(9) AVAILABLE SPACE DIRECTORY ADDRESS - LSB A2000058 EQU VIASDS(10) # SECTORS IN AVAILABLE SPACE DIRECTORY A2000059 EQU VILBAM(11) LARGEST BLOCK OF SPACE AVAILABLE - MSB A2000060 EQU VILBAL(12) LARGEST BLOCK OF SPACE AVAILABLE - LSB A2000061 EQU VIWPS(13) WORDS/SECTOR FOR VOLUME A2000062ÐÐ EQU VIFDDM(14) FILE DEFINITION DIRECTORY ADDRESS - MSB A2000063 EQU VIFDDL(15) FILE DEFINITION DIRECTORY ADDRESS - LSB A2000064 EQU VIMAXF(16) MAX. NUMBER OF FILES PERMITTED ON VOLUME A2000065 EQU VICURF(17) CURRENT NUMBER OF FILES EXISTING ON VOLUME A2000066 EQU VINFDB(18) NUMBER OF BLOCKS IN FILE DEFINITION DIRECTORY A2000067 EQU VINXTB(19) NEXT AVAILABLE BLOCK IN FILE DEF. DIRECTORY A2000068 EQU VINOOF(20) NUMBER OF OPEN FILES ON VOLUME A2000069 EQU VILBLM(21) VOLUME LABEL SECTOR - MSB A2000070 EQU VILBLL(22) VOLUME LABEL SECTOR - LSB A2000071 EJT 0 A2000072* A2000073* L A B E L O N M A S S M E M O R Y A2000074* A2000075* A2000076* A2000077 EQU VLIFLG(0) VOLUME INITIALIZED FLAG A2000078 EQU VLNAME(2) VOLUME NAME A2000079 EQU VLNMBR(6) VOLUME NUMBER A2000080 EJT 0 A2000081MNT000 EQU MNT000(*) FIRST LOCATION OF PGM A2000082 NUM $C8FE PICK UP ABSOLUTE ADDR OF THIS PROGRAM A2000083 STA* RELADR SAVE FOR RELEASE CALL A2000084* A2000085 ENA 1 A2000086 STA CURVOL CURRENT VOLUME NUMBER (SKIP SYSTEM VOLUME) A2000087ÐÐ SPC 2 A2000088 LDA- $EF GET PRIORITY LEVEL A2000089 TRA Q A2000090 ALS 4 A2000091 EAQ A A2000092 TRA Q PRIORITY LEVEL FOR REQUEST A2000093 ADD* CODE A2000094 STA* CODE A2000095* A2000096 ADQ* WRTCOD ADD PRIORITY LEVEL TO WRITE REQUEST A2000097 STQ* WRTCOD CODE A2000098* A2000099 AND- ONEMSK+3 GET PRIORITY LEVEL A2000100 ADD* TMRCOD ADD TO TIMER CODE A2000101 STA* TMRCOD A2000102* A2000103* SET UP ADDR FOR READ LABEL FROM MM REQUEST A2000104 LDA* RELADR A2000105 ADD =XMNT040-MNT000 A2000106 STA* CMPADR COMPLETION ADDR A2000107 ADD =XLABEL-MNT040 A2000108 STA* BUFADR BUFFER TO READ INTO A2000109MNT005 RAO* CURVOL INCREMENT VOL NO. A2000110 LDA* CURVOL A2000111 TCA A A2000112ÐÐ ADD MMLUTB TOTAL NO. OF VOLS IN SYSTEM A2000113 SAP MNT010 A2000114* DONE WITH ALL VOLS PRESENT A2000115* A2000116 LDA MMLUTB SEE IF ONLY THE SYSTEM VOLUME IS DEFINED A2000117 INA -1 IF SO, DO NOT RESCHEDULE MOUNT CHECK A2000118 SAZ MNT007 A2000119 SPC 2 A2000120 RTJ- (AMONI) TIMER REQUEST TO SCHEDULE MOUNT CHECK A2000121TMRCOD ADC $1020 CODE + UNIT IN SEC + PRIORITY A2000122 ADC (MNTCHK) ORDINAL A2000123 ADC PERIOD TIME IN SEC A2000124 SPC 2 A2000125MNT007 RTJ- (AMONI) RELEASE A2000126 NUM $1801 A2000127RELADR ADC 0 A2000128 EJT 0 A2000129MNT010 LDQ* CURVOL A2000130 LDQ MMLUTB,Q ABSOLUTE ADDR OF VIT FOR THE VOLUME A2000131 STQ* VITADR SAVE A2000132 LDA- (VISLUN),Q FIRST WORD FROM VIT A2000133 SAP MNT020 A2000134 SPC 2 A2000135 JMP* MNT080 VOLUME ALREADY DISMOUNTED A2000136* GO TO NEXT VIT A2000137ÐÐ SPC 1 A2000138MNT020 AND- ONEMSK+14 GET LU, STORE IN PARAMETER LIST FOR READING A2000139 STA* LOGUNT LABEL A2000140 LDA- VILBLM,Q STORE VOLUME LABEL SECTOR INTO REQUEST A2000141 STA* MSB A2000142 LDA- VILBLL,Q A2000143 STA* LSB A2000144 SPC 3 A2000145 RTJ- (AMONI) READ LABEL FROM SECTOR ZERO A2000146CODE ADC $4800 REQUEST CODE + PRIORITY LEVEL A2000147CMPADR ADC 0 COMPLETION ADDR A2000148 ADC 0 A2000149LOGUNT ADC 0 LOGICAL UNIT A2000150 NUM 6 READ ONLY FIRST SIX WORDS A2000151BUFADR ADC 0 BUFFER ADDR IN MAIN MEMORY A2000152MSB ADC 0 MSB OF LABEL SECTOR A2000153LSB ADC 0 LSB OF LABEL SECTOR A2000154 JMP- (ADISP) A2000155 SPC 5 A2000156MNT040 SQP MNT050 A2000157 JMP* MNT100 I/O ERROR, DISMOUNT + CLOSE FILES A2000158 SPC 2 A2000159MNT050 CLR Q COMPARE VOL NAME FROM VIT WITH ONE FROM LABEL A2000160 LDA* VITADR Q = COUNT 4 WORDS (8 CHARS) A2000161 STA- I A2000162ÐÐ SPC 2 A2000163MNT060 LDA- VINAME,B GET NAME FROM VIT A2000164 EOR* LABEL+VLNAME,Q COMPARE WITH NAME FROM LABEL A2000165 SAZ MNT070 A2000166 SPC 1 A2000167 JMP* MNT100 NAMES DO NOT MATCH, DISMOUNT + CLOSE FILES A2000168 SPC 1 A2000169MNT070 INQ 1 GO TO NEXT WORD A2000170 TCQ A A2000171 INA 5 A2000172 SAP MNT080 FINISH ALL 8 CHARS A2000173 JMP* MNT060 GO TO NEXT WORD A2000174 SPC 1 A2000175MNT080 JMP* MNT005 GO TO THE NEXT VIT A2000176 EJT A2000177MNT100 EQU MNT100(*) SOMETHING IS WRONG , DISMOUNT VOL AND CLOSE A2000178* ALL FILES ON THIS VOLUME A2000179* PREPARE TO OUTPUT MESSAGE A2000180 LDA* RELADR A2000181 ADD =XBUFFER-MNT000 A2000182 STA* WRTBUF SET BUFFER ADDRESS A2000183 ADD =XDIS10-BUFFER A2000184 STA* COMPR SET COMPLETION ADDRESS A2000185 SUB =XDIS10-ISTAT SET ISTAT ADDRESS AND REQBUF ADDRESS IN A2000186 STA* PLIST+1 PARAMETER LIST FOR FFCLOS REQUEST A2000187ÐÐ INA 1 A2000188 STA* PLIST A2000189 INA 4 STORE ABSOLUTE ADDRESS OF WORD 5 A2000190 STA* AWORD5 A2000191* A2000192 INA -7 A2000193 STA* APLIST SET ABSOLUTE ADDR OF PLIST A2000194 SPC 2 A2000195 LDQ* VITADR A2000196 LDA- (ZERO),Q ASSURE DISMOUNT BIT IS SET A2000197 AND- $11 ($7FFF) A2000198 EOR- $21 ($FFFF) A2000199 STA- (ZERO),Q A2000200* A2000201 LDA- 1,Q MOVE VOLUME NAME TO OUTPUT MESSAGE A2000202 STA* NAME A2000203 LDA- 2,Q A2000204 STA* NAME+1 A2000205 LDA- 3,Q A2000206 STA* NAME+2 A2000207 LDA- 4,Q A2000208 STA* NAME+3 A2000209 LDA- 5,Q MOVE VOLUME NUMBER A2000210 STA* NAME+4 A2000211 SPC 2 A2000212ÐÐ* A2000213 RTJ- ($F4) OUTPUT MESSAGE A2000214WRTCOD NUM $0400 WRITE REQUEST A2000215COMPR NUM 0 COMPLETION ADDRESS A2000216 NUM 0 THREAD WORD A2000217 NUM $18FC LOGICAL UNIT A2000218 NUM 23 NUMBER OF WORDS A2000219WRTBUF NUM 0 START CORE ADDRESS A2000220 JMP- ($EA) JUMP TO DISPATCHER A2000221 EJT A2000222BUFFER NUM $0D0A A2000223 ALF 5,ATTENTION: A2000224 NUM $0D0A A2000225NAME BZS NAME(5) A2000226 ALF 11, HAS BEEN DISMOUNTED. A2000227 NUM $0D0A A2000228* A2000229LABEL BZS LABEL(6) LABEL FROM MASS MEMORY A2000230* A2000231CURVOL NUM 0 VOLUME NUMBER OF CURRENT VOLUME A2000232VITADR NUM 0 SAVED VIT ADDRESS A2000233 EJT A2000234********************************************** A2000235* A2000236* THE ORDER OF THE FOLLOWING NUM CARDS MAY NOT BE CHANGED A2000237ÐÐ* A2000238********************************************** A2000239* PARAMETER LIST FOR FAKED FFCLOS CALL A2000240PLIST NUM 0 REQUEST BUFFER ADDRESS A2000241 NUM 0 STATUS WORD ADDRESS A2000242* A2000243ISTAT NUM 0 STATUS WORD A2000244* A2000245* REQUEST BUFFER FOR FORCED FILE CLOSE A2000246REQBUF NUM 0 1. THREAD WORD A2000247AWORD5 NUM 0 2. ABSOLUTE ADDRESS OF WORD 5 A2000248CPOINT NUM 0 3. CONTROL POINT A2000249 NUM 0 4. REQUEST INDEX - 0 A2000250* A2000251 NUM 0 5. SAVED Q-REG - NOT NEEDED A2000252 NUM 0 6. SAVED I-REG - NOT NEEDED A2000253APLIST NUM 0 7. ADDRESS OF PARAMETER LIST A2000254 NUM 0,0,0,0,0,0 8-13 A2000255VOLNUM NUM 0 14. VOLUME'S DRIVE NUMBER A2000256 NUM 0,0,0,0,0,0,0 15-21 A2000257 NUM 0,0,0 22-24 A2000258 EJT A2000259DIS10 LDQ* VITADR RESET Q TO VIT ADDRESS A2000260 LDA- VINOOF,Q CHECK IF VOLUME HAS ANY OPEN FILES A2000261 SAN DIS20 SKIP IF YES A2000262ÐÐ JMP* MNT080 GO TO NEXT VIT A2000263* VOLUME HAS OPEN FILES A2000264* PREPARE FOR FORCE FILE CLOSE A2000265DIS20 EQU DIS20(*) A2000266 LDQ* CURVOL A2000267* A2000268DIS45 STQ* VOLNUM SET VOLUME DRIVE NUMBER FOR FFCLOS REQUEST A2000269 LDA CCP A2000270 STA* CPOINT SET CONTROL POINT NUMBER A2000271 LDA* PLIST A2000272 STA- I SET I TO ADDRESS OF REQBUF A2000273 ENQ FMEIDX SET FM'S INDEX INTO EXTENDED CORE TABLE A2000274 LDQ- (ADRECT),Q PICKUP ADDRESS OF EXEC A2000275 RTJ- (ZERO),Q EXECUTE IT A2000276* A2000277 LDA* REQBUF+17 CHECK IF ALL OPEN FILES WERE FOUND A2000278 LDQ* VITADR RESET Q TO VIT ADDRESS A2000279 EOR- VINOOF,Q A2000280 SAZ DIS50 SKIP IF ALL OPEN FILES WERE FOUND A2000281 RTJ SYFAIL CRASH THE SYSTEM A2000282DIS50 LDA* ISTAT CHECK IF ANY ERROR NOTED A2000283 SAZ DIS100 SKIP IF NO A2000284 RTJ SYFAIL CRASH THE SYSTEM A2000285* A2000286DIS100 JMP* MNT080 GO TO NEXT VIT A2000287ÐÐ END A2000288 NAM DISMNT A21 A ITOS CCS 3.0 SL-149A2100001* ITOS VOLUME FORCED DISMOUNT ROUTINE A2100002* CREDIT COLLECTION SYSTEM VERSION 3.0 A2100003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A2100004* COPYRIGHT CONTROL DATA CORPORATION 1979 A2100005* A2100006* A2100007* DISMNT OUTPUTS A MESSAGE TO THE SYSTEM COMMENT DEVICE NOTI- A2100008* FYING THE OPERATOR THAT A PARTICULAR VOLUMN HAS BEEN DIS- A2100009* MOUNTED. THE VOLUME NUMBER FOR THE VOLUME TO BE DISMOUNTED A2100010* IS PASSED TO DISMNT VIA Q. A2100011* IF BIT 15 OF Q IS SET, THEN THE MESSAGE TO THE OPERATOR A2100012* WILL NOT BE OUTPUT. A2100013* A2100014* IF THERE WERE ANY OPEN FILES ON THE DISMOUNTED VOLUME, THE A2100015* FORCED FILE CLOSE (EXECUTIVE FUNCTION) FILE REUUEST IS EXE- A2100016* CUTED TO CLOSE THE FILES. A2100017 SPC 2 A2100018* ENTRY POINTS A2100019 ENT DISMNT A2100020 SPC 2 A2100021* EXTERNALS A2100022 EXT SYFAIL SYSTEM FAILURE ROUTINE A2100023 EXT MMLUTB MASS MEMORY LOGICAL UNIT TABLE A2100024ÐÐ EXT CCP CURRENT CONTROL POINT LOCATION ADDRESS A2100025 SPC 1 A2100026* EQUIVALENCES A2100027 EQU ZERO($22) A2100028 EQU FMEIDX(30) FILE MANAGER'S INDEX INTO EXTENDED CORE TABLE A2100029 EQU ONEMSK(3) ONE MASK TABLE A2100030 EQU ADRECT($E9) ADDRESS OF EXTENDED CORE TABLE A2100031 EJT A2100032* VOLUME INFORMATION TABLE A2100033* A2100034 EQU VISLUN(2) SYSTEM LOGICAL UNIT NUMBER (BIT 15=1,NOT READYA2100035* ACCESS VISLUN INDIRECTLY A2100036 EQU VINAME(1) VOLUME NAME - ASCII CHARACTERS 1 AND 2 A2100037* VOLUME NAME - ASCII CHARACTERS 3 AND 4 A2100038* VOLUME NAME - ASCII CHARACTERS 5 AND 6 A2100039* VOLUME NAME - ASCII CHARACTERS 7 AND 8 A2100040 EQU VINMBR(5) VOLUME NUMBER - (2 ASCII CHARACTERS) A2100041 EQU VIBMSM(6) BEGINNING OF MANAGEABLE SPACE - MSB A2100042 EQU VIBMSL(7) BEGINNING OF MANAGEABLE SPACE - LSB A2100043 EQU VIASDM(8) AVAILABLE SPACE DIRECTORY ADDRESS - MSB A2100044 EQU VIASDL(9) AVAILABLE SPACE DIRECTORY ADDRESS - LSB A2100045 EQU VIASDS(10) # SECTORS IN AVAILABLE SPACE DIRECTORY A2100046 EQU VILBAM(11) LARGEST BLOCK OF SPACE AVAILABLE - MSB A2100047 EQU VILBAL(12) LARGEST BLOCK OF SPACE AVAILABLE - LSB A2100048 EQU VIWPS(13) WORDS/SECTOR FOR VOLUME A2100049ÐÐ EQU VIFDDM(14) FILE DEFINITION DIRECTORY ADDRESS - MSB A2100050 EQU VIFDDL(15) FILE DEFINITION DIRECTORY ADDRESS - LSB A2100051 EQU VIMAXF(16) MAX. NUMBER OF FILES PERMITTED ON VOLUME A2100052 EQU VICURF(17) CURRENT NUMBER OF FILES EXISTING ON VOLUME A2100053 EQU VINFDB(18) NUMBER OF BLOCKS IN FILE DEFINITION DIRECTORY A2100054 EQU VINXTB(19) NEXT AVAILABLE BLOCK IN FILE DEF. DIRECTORY A2100055 EQU VINOOF(20) NUMBER OF OPEN FILES ON VOLUME A2100056 EJT A2100057DISMNT NUM $C8FE SET UP RELEASE ADDRESS A2100058 STA RELADR A2100059 ADD =XBUFFER-DISMNT A2100060 STA* BUFADR SET BUFFER ADDRESS A2100061 ADD =XDIS10-BUFFER A2100062 STA* COMPR SET COMPLETION ADDRESS A2100063 SUB =XDIS10-ISTAT SET ISTAT ADDRESS AND REQBUF ADDRESS IN A2100064 STA* PLIST+1 PARAMETER LIST FOR FFCLOS REQUEST A2100065 INA 1 A2100066 STA* PLIST A2100067 INA 4 STORE ABSOLUTE ADDRESS OF WORD 5 A2100068 STA* AWORD5 A2100069 INA -7 ABSOLUTE ADD OF THE PARAMETER LIST A2100070 STA* APLIST A2100071* A2100072 STQ* VOLNUM SAVE VOLUME NO. IN PARAMETER LIST FOR A2100073 TRQ A FORCE FILE CLOSE A2100074ÐÐ AND- ONEMSK+14 A2100075 TRA Q DELETE INDICATOR BIT A2100076 LDQ MMLUTB,Q ABSOLUTE ADDR OF VIT A2100077 STQ* VITADR SAVE VIT ADDRESS A2100078* A2100079* A2100080 LDA- (ZERO),Q ASSURE DISMOUNT BIT IS SET A2100081 AND- $11 A2100082 EOR- $21 A2100083 STA- (ZERO),Q A2100084 LDA- 1,Q MOVE VOLUME NAME TO OUTPUT MESSAGE A2100085 STA* LABEL A2100086 LDA- 2,Q A2100087 STA* LABEL+1 A2100088 LDA- 3,Q A2100089 STA* LABEL+2 A2100090 LDA- 4,Q A2100091 STA* LABEL+3 A2100092 LDA- 5,Q MOVE VOLUME NUMBER A2100093 STA* LABEL+4 A2100094* A2100095 LDA* VOLNUM VOL NUMBER + INDICATOR BIT A2100096 SAP DIS05 PRINT MESSAGE IF BIT 15 NOT SET A2100097 AND- ONEMSK+14 CLEAR BIT 15 AND DO NOT OUTPUT MESSAGE A2100098 STA* VOLNUM A2100099ÐÐ JMP* DIS10 A2100100 SPC 2 A2100101DIS05 RTJ- ($F4) OUTPUT MESSAGE A2100102 NUM $433 WRITE REQUEST, RP=CP=3 A2100103COMPR NUM 0 COMPLETION ADDRESS A2100104 NUM 0 THREAD WORD A2100105 NUM $18FC LOGICAL UNIT A2100106 NUM 23 NUMBER OF WORDS A2100107BUFADR NUM 0 START CORE ADDRESS A2100108 JMP- ($EA) JUMP TO DISPATCHER A2100109 EJT A2100110BUFFER NUM $0D0A A2100111 ALF 5,ATTENTION: A2100112 NUM $0D0A A2100113LABEL BZS LABEL(5) A2100114 ALF 11, HAS BEEN DISMOUNTED. A2100115 NUM $0D0A A2100116* A2100117VITADR NUM 0 SAVED VIT ADDRESS A2100118 EJT A2100119* PARAMETER LIST FOR FAKED FFCLOS CALL A2100120PLIST NUM 0 REQUEST BUFFER ADDRESS A2100121 NUM 0 STATUS WORD ADDRESS A2100122* A2100123ISTAT NUM 0 STATUS WORD A2100124ÐÐ* A2100125* REQUEST BUFFER FOR FORCED FILE CLOSE A2100126REQBUF NUM 0 1. THREAD WORD A2100127AWORD5 NUM 0 2. ABSOLUTE ADDRESS OF WORD 5 A2100128CPOINT NUM 0 3. CONTROL POINT A2100129 NUM 0 4. REQUEST INDEX - 0 A2100130* A2100131 NUM 0 5. SAVED Q-REG - NOT NEEDED A2100132 NUM 0 6. SAVED I-REG - NOT NEEDED A2100133APLIST NUM 0 7. ADDRESS OF PARAMETER LIST A2100134 NUM 0,0,0,0,0,0 8-13 A2100135VOLNUM NUM 0 14. VOLUME'S DRIVE NUMBER A2100136 NUM 0,0,0,0,0,0,0 15-21 A2100137 NUM 0,0,0 22-24 A2100138 EJT A2100139DIS10 LDQ* VITADR RESET Q TO VIT ADDRESS A2100140 LDA- VINOOF,Q CHECK IF VOLUME HAS ANY OPEN FILES A2100141 SAN DIS20 SKIP IF YES A2100142 JMP* DIS100 GO RELEASE CORE AND EXIT A2100143* A2100144* VOLUME HAS OPEN FILES A2100145DIS20 EQU DIS20(*) PREPARE TO DO A FORCE FILE CLOSE A2100146 LDA CCP A2100147 STA* CPOINT SET CONTROL POINT NUMBER A2100148 LDA* PLIST A2100149ÐÐ STA- I SET I TO ADDRESS OF REQBUF A2100150 ENQ FMEIDX SET FM'S INDEX INTO EXTENDED CORE TABLE A2100151 LDQ- (ADRECT),Q PICKUP ADDRESS OF EXEC A2100152 RTJ- (ZERO),Q EXECUTE IT A2100153* A2100154 LDA* REQBUF+17 CHECK IF ALL OPEN FILES WERE FOUND A2100155 LDQ* VITADR RESET Q TO VIT ADDRESS A2100156 EOR- VINOOF,Q A2100157 SAZ DIS50 SKIP IF ALL OPEN FILES WERE FOUND A2100158 RTJ SYFAIL CRASH THE SYSTEM A2100159 EJT A2100160DIS50 LDA* ISTAT CHECK IF ANY ERROR NOTED A2100161 SAZ DIS100 SKIP IF NO A2100162 RTJ SYFAIL CRASH THE SYSTEM A2100163* A2100164DIS100 RTJ- ($F4) RELEASE CORE AND EXIT A2100165 NUM $1801 A2100166RELADR NUM 0 CORE ADDRESS OF MODULE A2100167 END DISMNT A2100168 NAM START A22 A ITOS CCS 3.0 . SL-149A2200001* ITOS STARTUP ROUTINE A2200002* CREDIT COLLECTION SYSTEM VERSION 3.0 A2200003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A2200004* COPYRIGHT CONTROL DATA CORPORATION 1979 A2200005* A2200006ÐÐ SPC 2 A2200007* E N T R Y P O I N T S A2200008 SPC 1 A2200009 ENT START A2200010 SPC 2 A2200011* E X T E R N A L S A2200012 SPC 1 A2200013 EXT MIINP MANUAL INPUT DATA BUFFER A2200014 EXT FILOAD SYSTEM FILE INITIALIZATION INDICATOR A2200015 EXT MMAMAX MAXIMUM NUMBER OF USER SWAP BLOCKS A2200016 EXT PARTBL SYSTEM PARTITIONED MEMORY TABLE A2200017 EXT UNPTBL TIMESHARE UNPROTECTED ENTRY POINT LIST A2200018 EXT TSMUSR TIMESHARE MULTI-USER TABLE STARTING ADDRESS A2200019 EXT TSMEND TIMESHARE MULTI-USER TABLE ENDING ADDRESS A2200020 EXT TSPORT TIMESHARE I/O TABLE STARTING ADDRESS A2200021 EXT TSPEND TIMESHARE I/O TABLE ENDING ADDRESS A2200022 EXT TSIOC1 TIMESHARE I/O COMPLETION PROCESSOR A2200023 EXT TERMLU COMMUNICATIONS CONTROLLER LOGICAL UNIT A2200024 EXT TSLSIZ LOG-IN PROCESSOR LENGTH A2200025 EXT TSLMSB LOG-IN PROCESSOR SECTOR ADDRESS A2200026 EXT TSWSEC USER SWAP AREA BASE SECTOR A2200027 EXT TSULBF TIMESHARE LINKAGE BUFFER SECTOR ADDRESS A2200028 EXT TSNABL TIMESHARE ENABLED INDICATOR A2200029 EXT HORMIN TIME AND DATE - HOURS/MINUTES A2200030 EXT DAYTO TIME AND DATE - DAY A2200031ÐÐ EXT MONTO TIME AND DATE - MONTH A2200032 EXT AMONTO CURRENT MONTH - ASCII A2200033 EXT ADAYTO CURRENT DAY - ASCII A2200034 EXT AYERTO CURRENT YEAR - ASCII A2200035 EXT ONTIME TIME AND DATE OF TIMESHARE ACTIVATION A2200036 EXT JOBIND JOB PROCESSOR ACTIVE INDICATOR A2200037 EXT SYUTIL ITOS SYSTEM UTILITY PROCESSOR A2200038 EXT NUMLU NUMBER OF LOGICAL UNITS A2200039 EXT LOG1A LOGICAL UNIT TABLE A2200040 EJT 122*4818A2200041 SPC 4 122*4818A2200042* E X T E R N A L S A2200043 SPC 2 122*4818A2200044 EXT CREATE CREATE FILE REQUEST A2200045 EXT DELETE DELETE FILE REQUEST A2200046 EXT OPENFL OPEN FILE REQUEST A2200047 EXT CLOSFL CLOSE FILE REQUEST A2200048 EXT GETS GET SEQUENTIAL RECORD FILE REQUEST A2200049 EXT PUTS PUT SEQUENTIAL RECORD FILE REQUEST A2200050 EXT READR READ RANDOM RECORD FILE REQUEST A2200051 EXT WRITER WRITE RANDOM RECORD FILE REQUEST A2200052 EXT UPDREC UPDATE FILE RECORD A2200053 EXT GETFCB GET FILE CONTROL BLOCK FILE REQUEST A2200054 EXT UPDFCB UPDATE FILE CONTROL BLOCK FILE REQUEST A2200055 EXT* BINASC BINARY TO DECIMAL CODED ASCII A2200056ÐÐ EXT* BINHEX BINARY TO HEXIDECIMAL CODED ASCII A2200057 EXT* IMAGE ROUTINE TO WRITE TIMESHARE DATA TO CORE IMAGE A2200058 EXT* LUNEQ DEVICE NAME - LOGICAL UNIT CONVERSION A2200059 SPC 4 A2200060* E Q U I V A L E N C E S A2200061 SPC 1 A2200062 EQU ZERO($22) LOCATION CONTAINING ZERO A2200063 EQU ONE(3) LOCATION CONTAINING ONE A2200064 EQU THREE(4) LOCATION CONTAINING THREE A2200065 EQU ONEBIT($23) SINGLE BIT TABLE A2200066 EQU TEN($46) LOCATION CONTAINING TEN A2200067 EQU ADISP($EA) ADDRESS OF DISPATCHER A2200068 EQU AMONI($F4) ADDRESS OF MONITOR REQUEST ENTRY A2200069 EQU RPCP($66) MONITOR REQUEST PRIORITIES A2200070 EQU RECLEN(18) RECORD LENGTH OF HOST FILE (IN WORDS) A2200071 EQU NUMHST(8) NUMBER OF RECORDS IN HOST FILE. 1 FOR LOCAL A2200072* PLUS 1 PER REMOTE HOST ACTIVATED A2200073 EQU BDINIT(24) BATCH OUTPUT DRIVER INITIALIZATION FLAG A2200074 SPC 4 A2200075* F I L E M A N A G E R E Q U I V A L E N C E S A2200076* A2200077* FILE CONTROL BLOCK A2200078* A2200079 EQU FILNRC(07) NUMBER OF FILE RECORDS - LSB A2200080 EQU FILMSB(08) LOCATION OF FILE RECORDS - MSB A2200081ÐÐ EQU FILLSB(09) LOCATION OF FILE RECORDS - LSB A2200082 EJT A2200083 SPC 4 A2200084* M U L T I - U S E R P R O G R A M T A B L E E N T R I E S A2200085 SPC 1 A2200086 EQU MUROOT(ZERO) ASSOCIATED ROOT TABLE ADDRESS A2200087 EQU MUSRID(01) PROGRAM IDENTIFICATION - 4 WORDS ASCII A2200088 EQU MUSIZE(05) PROGRAM LENGTH (WORDS) A2200089 EQU MUSECT(06) PROGRAM SECTOR ADDRESS - 2 WORDS A2200090 EQU MUPAGE(08) PROGRAM BASE MEMORY PAGE NUMBER A2200091 EQU ACROOT(09) PROGRAM ACTIVE ROOT COUNT A2200092 EQU MURSIZ(10) PROGRAM TRUE LENGTH (WORDS) A2200093 EQU MUEXTH(11) PROGRAM EXECUTION THREAD A2200094 EQU MURSTX(13) PROGRAM STATE INDEX A2200095 EQU MURCLK(15) PROGRAM CLOCK VALUE A2200096 EQU MUITEM(MURCLK+1) A2200097 SPC 2 A2200098* U S E R P R O G R A M U S E R T A B L E E N T R I E S A2200099 SPC 1 A2200100 EQU TSIOTB(ZERO) ASSOCIATED I/O TABLE ADDRESS A2200101 EQU USERID(01) USER IDENTIFICATION - 4 WORDS ASCII A2200102 EQU PGMSIZ(05) USER PROGRAM LENGTH (WORDS) A2200103 EQU PGMSEC(06) USER PROGRAM SECTOR - 2 WORDS A2200104 EQU TWNSEC(08) SWAP TWIN SECTOR - 2 WORDS A2200105 EQU SWPBLK(10) USER SWAP BLOCK BYTES A2200106ÐÐ EQU NEXETH(11) USER EXECUTION THREAD A2200107 EQU NSWPTH(12) USER SWAP THREAD A2200108 EQU USRSTX(13) USER STATE INDEX A2200109 EQU TSMUTB(14) MULTI USER TABLE ADDRESS A2200110 EQU NUMREQ(15) USER REQUEST COUNT A2200111 EQU USRITM(NUMREQ+1) A2200112 EJT A2200113 SPC 4 A2200114* U S E R P R O G R A M S T A T E I N D I C E S A2200115 SPC 1 A2200116 EQU SXCACT(01) EXECUTING IN MAIN MEMORY A2200117 EQU SXCTSL(02) SUSPENDED IN MAIN MEMORY-TIMESLICE COMPLETE A2200118 EQU SXCMMA(03) SUSPENDED IN MAIN MEMORY-M.M. I/O ACTIVE A2200119 EQU SXCMMC(04) SUSPENDED IN MAIN MEMORY-M.M. I/O COMPLETE A2200120 EQU SXCFMA(05) SUSPENDED IN MAIN MEMORY-FILE I/O ACTIVE A2200121 EQU SXCFMC(06) SUSPENDED IN MAIN MEMORY-FILE I/O COMPLETE A2200122 EQU SXCTMA(07) SUSPENDED IN MAIN MEMORY-TMNL I/O ACTIVE A2200123 EQU SXCTMC(08) SUSPENDED IN MAIN MEMORY-TMNL I/O COMPLETE A2200124 EQU SXCDTA(09) SUSPENDED IN MAIN MEMORY-DATA I/O ACTIVE A2200125 EQU SXCDTC(10) SUSPENDED IN MAIN MEMORY-DATA I/O COMPLETE A2200126 EQU SXCATA(11) SUSPENDED IN MAIN MEMORY-ATTACH ACTIVE A2200127 EQU SXCATC(12) SUSPENDED IN MAIN MEMORY-ATTACH COMPLETE A2200128* A2200129 EQU SXMASS(13) RESERVED A2200130 EQU SXMTSL(14) SWAPPED ON MASS MEMORY-TIMESLICE COMPLETE A2200131ÐÐ EQU SXM015(15) RESERVED A2200132 EQU SXMMMC(16) SWAPPED ON MASS MEMORY-M.M. I/O COMPLETE A2200133 EQU SXM017(17) RESERVED A2200134 EQU SXMFMC(18) SWAPPED ON MASS MEMORY-FILE I/O COMPLETE A2200135 EQU SXMTMA(19) SWAPPED ON MASS MEMORY-TMNL I/O ACTIVE A2200136 EQU SXMTMC(20) SWAPPED ON MASS MEMORY-TMNL I/O COMPLETE A2200137 EQU SXMDTA(21) SWAPPED ON MASS MEMORY-DATA I/O ACTIVE A2200138 EQU SXMDTC(22) SWAPPED ON MASS MEMORY-DATA I/O COMPLETE A2200139 EQU SXMATA(23) SWAPPED ON MASS MEMORY-ATTACH ACTIVE A2200140 EQU SXM024(24) RESERVED A2200141* A2200142 EQU SXMUSA(25) SUSPENDED ON MASS MEMORY-UNSWAP ACTIVE A2200143 EQU SXCUSC(26) SUSPENDED IN MAIN MEMORY-UNSWAP COMPLETE A2200144 EQU SXMMUR(27) SUSPENDED ON MASS MEMORY-MULTIUSER READ A2200145 EQU SXMLOG(28) SUSPENDED ON MASS MEMORY-INITIAL LOGIN A2200146 EQU SXMJOB(29) SUSPENDED ON MASS MEMORY-JOB STEP A2200147 SPC 2 A2200148* NOTE - BIT 15 = 1 WHILE THE USER IS BEING SWAPPED A2200149 EJT A2200150 SPC 4 A2200151* U S E R P R O G R A M I / O T A B L E E N T R I E S A2200152 SPC 1 A2200153 EQU TSUSTB(ZERO) ASSOCIATED USER TABLE ADDRESS A2200154 EQU FRQBUF(01) FILE REQUEST BUFFER HEADER (4 WORDS) A2200155 EQU IORQCD(05) INPUT/OUTPUT REQUEST CODE A2200156ÐÐ EQU IORQCA(06) INPUT/OUTPUT COMPLETION ADDRESS A2200157 EQU IORQTH(07) INPUT/OUTPUT THREAD WORD A2200158 EQU IORQLU(08) INPUT/OUTPUT LOGICAL UNIT A2200159 EQU IOMSLN(09) INPUT/OUTPUT MESSAGE LENGTH A2200160 EQU IOBFAD(10) INPUT/OUTPUT MESSAGE BUFFER ADDRESS A2200161 EQU IOMMSB(11) INPUT/OUTPUT MASS MEMORY ADDRESS A2200162 EQU IOMLSB(12) INPUT/OUTPUT MASS MEMORY ADDRESS A2200163 EQU IOCNPT(13) INPUT/OUTPUT CONTROL POINT A2200164 EQU IOSTAT(14) INPUT/OUTPUT STATUS WORD A2200165 EQU TERMBF(15) TERMINAL MESSAGE BUFFER ADDRESS A2200166 EQU IOITEM(TERMBF+1) A2200167 SPC 2 A2200168* USER PROGRAM I/O STATUS INDICATORS A2200169 SPC 1 A2200170* UNSOLICITED INPUT GROUP A2200171 EQU LI(00) TERMINAL LOG-IN A2200172 EQU MN(01) TERMINAL MANUAL INTERRUPT A2200173 EQU ES(02) TERMINAL ESCAPE A2200174* INPUT-OUTPUT ERROR GROUP A2200175 EQU DS(04) TERMINAL DISCONNECT A2200176 EQU ME(05) MASS MEMORY ERROR A2200177 EQU FE(06) FILE REQUEST ERROR A2200178* REQUEST TYPE GROUP A2200179 EQU IN(08) DATA INPUT REQUEST A2200180 EQU IA(09) INPUT / OUTPUT ACTIVE A2200181ÐÐ EQU IC(10) INPUT / OUTPUT COMPLETE A2200182 EQU MM(11) MASS MEMORY I/O REQUEST A2200183 EQU TI(12) TERMINAL I/O REQUEST A2200184* TERMINAL CHARACTERISTIC GROUP A2200185* A2200186 EQU DY(TI+1) END OF THE DYNAMIC STATUS GROUP A2200187 EJT A2200188 SPC 4 A2200189START NOP 0 A2200190 SPC 1 A2200191 LDA =XTSPEND A2200192 SUB =XTSPORT A2200193 CLR Q A2200194 DVI =XIOITEM A2200195 STA NOPORT A = NUMBER OF TERMINALS IN THE SYSTEM A2200196 SPC 1 A2200197STA010 RTJ FNDFIL FIND THE NEXT PROGRAM LIBRARY FILE A2200198 SAZ STA020 SKIP IF THE SEARCH IS COMPLETE A2200199 RAO PGNDAT+2 INCREMENT THE RECORD COUNT A2200200 RTJ FNDPGM CHECK FOR A REQUIRED PROGRAM A2200201 JMP* STA010 CONTINUE A2200202 SPC 1 A2200203STA020 LDA+ TSLMSB IS THE LOG-IN PROCESSOR LOADED A2200204 SAZ STA030 NO A2200205 LDA+ TSULBF YES, IS A LINKAGE BUFFER SECTOR SPECIFIED A2200206ÐÐ SAN STA040 YES A2200207 SPC 1 A2200208STA030 ENQ 0 NO, INDICATE AN ERROR A2200209 RTJ MESSAG A2200210 JMP STAXIT AND EXIT A2200211 EJT A2200212 SPC 4 A2200213STA040 LDA+ FILOAD HAVE THE SYSTEM FILES BEEN INITIALIZED A2200214 SAN STA050 YES A2200215 JMP* STA070 NO A2200216 SPC 1 A2200217STA050 RTJ FILCLN CLEAN UP ANY DEFINED BATCH FILES A2200218 LDQ =XMIINP Q = ADDRESS OF THE INPUT BUFFER FOR MINT A2200219 LDA- 2,Q A2200220 SUB =AT, WAS 'START,X' REQUESTED A2200221 SAN STA060 NO, BUILD THE SYSTEM FILES A2200222 JMP* STA090 YES, CONTINUE A2200223 SPC 1 A2200224STA060 RTJ CLRQBF INITIALIZE THE FILE REQUEST BUFFER A2200225 ADC REQBFN A2200226 RTJ FILNAM SPECIFY THE PROGRAM NAME FILE A2200227 ADC PGMNAM A2200228 SPC 1 A2200229 RTJ+ DELETE DELETE THE PROGRAM NAME FILE A2200230 ADC REQBFN A2200231ÐÐ ADC IDATA A2200232 ADC ISTAT A2200233 SPC 1 A2200234STA070 ENQ 3 PRINT THE FILE INITIALIZATION MESSAGE A2200235 RTJ MESSAG A2200236 SPC 1 A2200237 RTJ PGNBLD BUILD THE PROGRAM NAME FILE A2200238 SPC 1 A2200239 LDA+ FILOAD HAVE THE SYSTEM FILES BEEN INITIALIZED A2200240 SAZ STA080 NO A2200241 JMP* STA085 YES A2200242 EJT A2200243 SPC 4 A2200244STA080 RTJ SWPBLD BUILD THE SWAP BUFFER FILE A2200245 RTJ DAYBLD BUILD THE DAY FILE A2200246 RTJ USRBLD BUILD THE USER IDENTIFICATION FILE A2200247 RTJ MSGBLD BUILD THE SYSTEM MESSAGE FILE A2200248 RTJ PDRBLD BUILD THE PROCEDURE DIRECTORY FILE A2200249 RTJ MNUBLD BUILD THE FUNCTION MENU FILE A2200250 RTJ MNTBLD BUILD THE TAPE MOUNT FILE A2200251 RTJ HOSTBL BUILD THE HOST FILE A2200252 RTJ BATBLD BUILD THE BATCH FILE A2200253 RTJ PRTBLD BUILD THE PRINT FILE A2200254 RAO+ FILOAD INDICATE THE SYSTEM FILES ARE INITIALIZED A2200255 SPC 1 A2200256ÐÐSTA085 RTJ+ CLOSFL CLOSE THE PROGRAM NAME FILE A2200257 ADC REQBFN A2200258 ADC ISTAT A2200259 RTJ CKSTAT CHECK FOR FILE ERRORS A2200260 SPC 1 A2200261 EJT A2200262 SPC 4 A2200263STA090 RTJ CLRQBF INITIALIZE THE FILE REQUEST BUFFER A2200264 ADC REQBUF A2200265 RTJ FILNAM SPECIFY THE SWAP BUFFER FILE A2200266 ADC SWPBUF A2200267 RTJ FILDAT SPECIFY A SEQUENTIAL FILE A2200268 ADC SEQDAT A2200269 SPC 1 A2200270 RTJ+ OPENFL OPEN THE SWAP BUFFER FILE A2200271 ADC REQBUF A2200272 ADC IDATA A2200273 ADC ISTAT A2200274 RTJ CKSTAT CHECK FOR FILE ERRORS A2200275 SPC 1 A2200276 LDQ REQBUF+9 Q = FCB ADDRESS A2200277 LDA =XTSWSEC A2200278 STA- I A2200279 LDA- FILMSB,Q A2200280 STA- (I) SPECIFY THE SWAP BUFFER SECTOR ADDRESS A2200281ÐÐ LDA- FILLSB,Q A2200282 STA- 1,I A2200283 LDA- FILNRC,Q A = NUMBER OF RECORDS IN THE FILE A2200284 CLR Q A2200285 DVI =N86 132*5241A2200286 INA 1 A2200287 TRA Q A2200288 SUB* MAXSWB IS THE CALCULATED VALUE TOO LARGE A2200289 SAM STA100 NO A2200290 LDQ* MAXSWB SPECIFY THE MAXIMUM NO. OF SWAP BLOCKS A2200291STA100 STQ+ MMAMAX SPECIFY THE MAXIMUM NUMBER OF SWAP BLOCKS A2200292 SPC 1 A2200293 RTJ+ CLOSFL CLOSE THE SWAP BUFFER FILE A2200294 ADC REQBUF A2200295 ADC ISTAT A2200296 RTJ CKSTAT CHECK FOR FILE ERRORS A2200297 EJT A2200298 SPC 4 A2200299 LDA =XUNPTBL A2200300 STA- I I = UNPROTECTED ENTRY POINT LIST A2200301 SPC 1 A2200302STA110 LDQ- (I) A2200303 INQ 0 IS THE LIST COMPLETE A2200304 SQZ STA120 YES A2200305 CPB 0 NO, UNPROTECT THE ENTRY ADDRESS A2200306ÐÐ RAO- I A2200307 RAO- I A2200308 JMP* STA110 A2200309 SPC 1 A2200310STA120 LDQ =XTSPORT Q = I/O TABLE ADDRESS A2200311 SPC 1 A2200312STA130 STQ* SAVQ A2200313 LDQ- TERMBF,Q Q = I/O HEADER ADDRESS A2200314 STQ* TERBF SPECIFY THE MESSAGE BUFFER ADDRESS A2200315 LDA* PRTNUM A2200316 STA- (ZERO),Q SPECIFY THE PORT NUMBER A2200317 INQ -1 A2200318 LDA- (ZERO),Q A2200319 STA* TERLN SPECIFY THE MESSAGE BUFFER LENGTH A2200320 ENA 1 A2200321 STA- 2,Q SPECIFY A CONNECT SUB-REQUEST A2200322 SPC 1 A2200323 RTJ- (AMONI) PERFORM A LOGICAL CONNECT A2200324 ADC $4855 A2200325 ADC TSIOC1 A2200326 ADC 0 A2200327 ADC TERMLU A2200328TERLN ADC 0 A2200329TERBF ADC 0 A2200330 SPC 1 A2200331ÐÐ LDQ* SAVQ A2200332 INQ IOITEM A2200333 TRQ A A2200334 SUB =XTSPEND HAVE ALL PORTS BEEN CONNECTED A2200335 SAP STA200 YES A2200336 RAO* PRTNUM NO, INCREMENT THE PORT NUMBER A2200337 JMP* STA130 REPEAT FOR THE NEXT UNIT A2200338 EJT A2200339STA200 LDQ =XONTIME SAVE THE TIME AND DATE OF ACTIVATION A2200340 LDA+ HORMIN A2200341 STA- (ZERO),Q A2200342 LDA+ MONTO A2200343 STA- 1,Q A2200344 LDA+ DAYTO A2200345 STA- 2,Q A2200346 RTJ IMAGE SAVE THE TIME ON THE CORE IMAGE A2200347 SPC 1 A2200348 LDA+ HORMIN SET UP TO PRINT THE ITOS ACTIVE MESSAGE A2200349 STA* BINTIM A2200350 RTJ BINASC CONVERT TO ASCII A2200351 ADC BINTIM A2200352 ADC MESG02+9 A2200353 SPC 1 A2200354 ENQ 2 PRINT THE ITOS ACTIVE MESSAGE A2200355 RTJ MESSAG A2200356ÐÐ SPC 1 A2200357 IIN 0 A2200358 ENA 1 INDICATE THAT ITOS IS ENABLED A2200359 STA+ TSNABL A2200360 SPC 1 A2200361STAXIT JMP (START) RETURN A2200362 EJT 122*4818A2200363 SPC 4 122*4818A2200364SAVQ NUM 0 TEMPORARY STORAGE A2200365NOPORT NUM 0 NUMBER OF TERMINALS IN THE SYSTEM A2200366PRTNUM NUM 0 SYSTEM TERMINAL COUNTER A2200367BINTIM NUM 0 A2200368MAXSWB NUM 160 MAX. NUMBER OF SWAP BLOCKS A2200369 EJT A2200370 SPC 4 A2200371PGNBLD NOP 0 A2200372 SPC 1 A2200373 RTJ CLRQBF INITIALIZE THE FILE REQUEST BUFFER A2200374 ADC REQBFN A2200375 RTJ FILNAM SPECIFY THE PROGRAM NAME FILE A2200376 ADC PGMNAM A2200377 RTJ FILDAT SET UP THE IDATA ARRAY A2200378 ADC PGNDAT A2200379 SPC 1 A2200380 RTJ+ CREATE CREATE THE PROGRAM NAME FILE A2200381ÐÐ ADC REQBFN A2200382 ADC IDATA A2200383 ADC ISTAT A2200384 RTJ CKSTAT CHECK FOR FILE ERRORS A2200385 SPC 1 A2200386 RTJ FLDATE SET UP THE FILE TYPE AND DATES A2200387 ADC 1 A2200388 SPC 1 A2200389 RTJ CLRQBF INITIALIZE THE FILE REQUEST BUFFER A2200390 ADC REQBFN A2200391 RTJ FILDAT SPECIFY AN INDEXED FILE A2200392 ADC IDXDAT A2200393 SPC 1 A2200394 RTJ+ OPENFL OPEN THE PROGRAM NAME FILE A2200395 ADC REQBFN A2200396 ADC IDATA A2200397 ADC ISTAT A2200398 RTJ CKSTAT CHECK FOR FILE ERRORS A2200399 EJT A2200400 SPC 4 A2200401PGN010 RTJ FNDFIL FIND THE NEXT PROGRAM LIBRARY FILE A2200402 SAN PGN020 A2200403 JMP* (PGNBLD) SEARCH COMPLETE, RETURN A2200404 SPC 1 A2200405PGN020 ENQ 2 A2200406ÐÐPGN030 LDA GTFILE,B MOVE THE PROGRAM FILE NAME A2200407 STA* PNFREC,Q TO THE PROGRAM NAME FILE RECORD A2200408 INQ -1 A2200409 SQM PGN040 A2200410 JMP* PGN030 A2200411 SPC 1 A2200412PGN040 LDA- ONEBIT+15 A2200413 STA* PNFREC+3 SPECIFY THE SECTOR MSB A2200414 LDA GTFILE+4,I A2200415 STA* PNFREC+4 AND THE SECTOR LSB A2200416 LDA GTFILE+3,I A2200417 TCA A A2200418 MUI =N96 CONVERT LENGTH TO WORDS A2200419 STA* PNFREC+5 SPECIFY THE PROGRAM LENGTH A2200420 SPC 1 A2200421 RTJ+ WRITER WRITE THE PROGRAM NAME FILE RECORD A2200422 ADC REQBFN A2200423 ADC PNFREC A2200424 ADC PNFREC A2200425 ADC ISTAT A2200426 RTJ CKSTAT CHECK FOR FILE ERRORS A2200427 JMP* PGN010 DO THE NEXT RECORD A2200428 SPC 2 A2200429PNFREC BZS PNFREC(8) PROGRAM NAME FILE RECORD BUFFER A2200430REQBFN BZS REQBFN(24) PROGRAM NAME FILE REQUEST BUFFER A2200431ÐÐPGMNAM ALF 4,$$PGMNAM PROGRAM NAME FILE NAME A2200432* PROGRAM NAME FILE IDATA ENTRIES A2200433PGNDAT NUM 12 13 - RECORD LENGTH-BYTES A2200434 NUM 0 14 - NUMBER OF RECORDS A2200435 NUM 0 15 - NUMBER OF RECORDS A2200436 NUM 1 16 - FILE TYPE-INDEXED A2200437 NUM 6 17 - KEY1 LENGTH-BYTES A2200438 NUM 1 18 - KEY1 POSITION-BYTE A2200439 EJT A2200440SWPBLD NOP 0 A2200441 SPC 1 A2200442 LDQ =XPARTBL A2200443 LDA- 3,Q A2200444 SUB- 1,Q A = USER PROGRAM AREA SIZE A2200445 CLR Q A2200446 DVI =N96 A2200447 INA 1 CONVERT THE SIZE TO SECTORS A2200448* 1 CARD DELETED 132*5241A2200449 MUI NOPORT A2200450 STA* SWPDAT+2 A = NUMBER OF SWAP BUFFER RECORDS A2200451 SPC 1 A2200452 RTJ CLRQBF INITIALIZE THE FILE REQUEST BUFFER A2200453 ADC REQBUF A2200454 RTJ FILNAM SPECIFY THE SWAP BUFFER FILE A2200455 ADC SWPBUF A2200456ÐÐ RTJ FILDAT SET UP THE IDATA ARRAY A2200457 ADC SWPDAT A2200458 SPC 1 A2200459 RTJ+ CREATE CREATE THE SWAP BUFFER FILE A2200460 ADC REQBUF A2200461 ADC IDATA A2200462 ADC ISTAT A2200463 RTJ CKSTAT CHECK FOR FILE ERRORS A2200464 SPC 1 A2200465 RTJ FLDATE SET UP THE FILE TYPE AND DATES A2200466 ADC 0 A2200467 SPC 1 A2200468 JMP* (SWPBLD) RETURN A2200469 SPC 2 A2200470SWPBUF ALF 4,$$SWPBUF SWAP BUFFER FILE NAME A2200471* SWAP BUFFER FILE IDATA ENTRIES A2200472SWPDAT NUM 192 13 - RECORD LENGTH-BYTES A2200473 NUM 0 14 - NUMBER OF RECORDS A2200474 NUM 0 15 - NUMBER OF RECORDS A2200475 NUM $8000 16 - FILE TYPE-SEQUENTIAL SECTOR ALIGNED A2200476 NUM 0 17 A2200477 NUM 0 18 A2200478 EJT A2200479 SPC 4 A2200480DAYBLD NOP 0 A2200481ÐÐ SPC 1 A2200482 LDA NOPORT A2200483 MUI =N250 A2200484 STA* DAYDAT+2 NUMREC = 250*NOPORT A2200485 SPC 1 A2200486 RTJ CLRQBF INITIALIZE THE FILE REQUEST BUFFER A2200487 ADC REQBUF A2200488 RTJ FILNAM SPECIFY THE DAY FILE A2200489 ADC DAYFIL A2200490 RTJ FILDAT SET UP THE IDATA ARRAY A2200491 ADC DAYDAT A2200492 SPC 1 A2200493 RTJ+ CREATE CREATE THE DAYFILE A2200494 ADC REQBUF A2200495 ADC IDATA A2200496 ADC ISTAT A2200497 RTJ CKSTAT CHECK FOR FILE ERRORS A2200498 SPC 1 A2200499 RTJ FLDATE SET UP THE FILE TYPE AND DATES A2200500 ADC 0 A2200501 SPC 1 A2200502 JMP* (DAYBLD) RETURN A2200503 SPC 2 A2200504DAYFIL ALF 4,$$DAYFIL DAYFILE FILE NAME A2200505* DAYFILE FILE IDATA ENTRIES A2200506ÐÐDAYDAT NUM 26 13 - RECORD LENGTH-BYTES A2200507 NUM 0 14 - NUMBER OF RECORDS A2200508 NUM 0 15 - NUMBER OF RECORDS A2200509 NUM 0 16 - FILE TYPE-SEQUENTIAL A2200510 NUM 0 17 A2200511 NUM 0 18 A2200512 EJT A2200513USRBLD NOP 0 A2200514 SPC 1 A2200515 RTJ+ READR FIND THE USERID INITIAL DATA FILE A2200516 ADC REQBFN A2200517 ADC PNFREC A2200518 ADC USRIDN+1 A2200519 ADC ISTAT A2200520 RTJ CKSTAT CHECK FOR FILE ERRORS A2200521 SPC 1 A2200522 LDA PNFREC+5 A2200523 CLR Q A2200524 DVI =N96 A2200525 ALS 1 A2200526 STA* USRDAT+2 NUMREC = (DATA FILE LENGTH/96)*2 A2200527* THIS WILL ALLOW ADDITIONS TO THE $$USERID A2200528* FILE WITHOUT HAVING TO DELETE, DEFINE A2200529* AND RELOAD THE FILE. A2200530 SPC 1 A2200531ÐÐ RTJ CLRQBF INITIALIZE THE FILE REQUEST BUFFER A2200532 ADC REQBUF A2200533 RTJ FILNAM SPECIFY THE USERID FILE A2200534 ADC USRIDN A2200535 RTJ FILDAT INITIALIZE THE IDATA ARRAY A2200536 ADC USRDAT A2200537 SPC 1 A2200538 RTJ+ CREATE CREATE THE USERID FILE A2200539 ADC REQBUF A2200540 ADC IDATA A2200541 ADC ISTAT A2200542 RTJ CKSTAT CHECK FOR FILE ERRORS A2200543 SPC 1 A2200544 RTJ FLDATE SET UP THE FILE TYPE AND DATES A2200545 ADC 1 A2200546 SPC 1 A2200547 RTJ CLRQBF INITIALIZE THE FILE REQUEST BUFFER A2200548 ADC REQBUF A2200549 RTJ FILDAT SPECIFY AN INDEXED FILE. A2200550 ADC IDXDAT A2200551 SPC 1 A2200552 RTJ+ OPENFL OPEN THE USERID FILE A2200553 ADC REQBUF A2200554 ADC IDATA A2200555 ADC ISTAT A2200556ÐÐ RTJ CKSTAT CHECK FOR FILE ERRORS A2200557 EJT A2200558 SPC 4 A2200559 LDA* USRDAT+2 A = MAXIMUM NUMBER OF RECORDS IN THE FILE. A2200560 ARS 1 A = NUMBER OF RECORDS IN THE PROGRAM A2200561* LIBRARY FILE 'USERID'. A2200562USR010 RTJ READPL READ THE NEXT SECTOR FROM THE PROGRAM LIBRARY A2200563 SAP USR020 SKIP IF ALL THE RECORDS ARE READ A2200564 SPC 1 A2200565 RTJ+ WRITER ENTER THE DATA INTO THE $$USERID FILE. A2200566 ADC REQBUF A2200567 ADC GTFILE A2200568 ADC GTFILE A2200569 ADC ISTAT A2200570 RTJ CKSTAT CHECK FOR FILE ERRORS A2200571 JMP* USR010 CONTINUE A2200572 SPC 1 A2200573USR020 RTJ+ CLOSFL CLOSE THE USERID FILE A2200574 ADC REQBUF A2200575 ADC ISTAT A2200576 RTJ CKSTAT CHECK FOR FILE ERRORS A2200577 SPC 1 A2200578 JMP* (USRBLD) RETURN A2200579 SPC 2 A2200580USRIDN ALF 4,$$USERID USER IDENTIFICATION FILE NAME A2200581ÐÐ* USER IDENTIFICATION FILE IDATA ENTRIES A2200582USRDAT NUM 20 13 - RECORD LENGTH IN BYTES. A2200583 NUM 0 14 - NUMBER OF RECORDS A2200584 NUM 0 15 - NUMBER OF RECORDS A2200585 NUM 1 16 - FILE TYPE-INDEXED. A2200586 NUM 10 17 - KEY1 LENGTH IN BYTES. A2200587 NUM 1 18 - KEY1 STARTING BYTE POSITION. A2200588 EJT A2200589MSGBLD NOP 0 A2200590 SPC 1 A2200591 RTJ+ READR FIND THE SYSMSG INITIAL DATA FILE A2200592 ADC REQBFN A2200593 ADC PNFREC A2200594 ADC SYSMSG+1 A2200595 ADC ISTAT A2200596 RTJ CKSTAT CHECK FOR FILE ERRORS A2200597 SPC 1 A2200598 LDA PNFREC+5 A2200599 CLR Q A2200600 DVI =N96 A2200601 STA* MSGDAT+2 NUMREC = DATA FILE LENGTH/96 A2200602 SPC 1 A2200603 RTJ CLRQBF INITIALIZE THE FILE REQUEST BUFFER A2200604 ADC REQBUF A2200605 RTJ FILNAM SPECIFY THE USERID FILE A2200606ÐÐ ADC SYSMSG A2200607 RTJ FILDAT INITIALIZE THE IDATA ARRAY A2200608 ADC MSGDAT A2200609 SPC 1 A2200610 RTJ+ CREATE CREATE THE SYSTEM MESSAGE FILE A2200611 ADC REQBUF A2200612 ADC IDATA A2200613 ADC ISTAT A2200614 RTJ CKSTAT CHECK FOR FILE ERRORS A2200615 SPC 1 A2200616 RTJ FLDATE SET UP THE FILE TYPE AND DATES A2200617 ADC 0 A2200618 SPC 1 A2200619 RTJ CLRQBF INITIALIZE THE FILE REQUEST BUFFER A2200620 ADC REQBUF A2200621 RTJ FILDAT SPECIFY A SEQUENTIAL FILE A2200622 ADC SEQDAT A2200623 SPC 1 A2200624 RTJ+ OPENFL OPEN THE SYSTEM MESSAGE FILE A2200625 ADC REQBUF A2200626 ADC IDATA A2200627 ADC ISTAT A2200628 RTJ CKSTAT CHECK FOR FILE ERRORS A2200629 EJT A2200630 SPC 4 A2200631ÐÐ LDA* MSGDAT+2 A = NUMBER OF RECORDS IN THE FILE A2200632MSG010 RTJ READPL READ THE NEXT SECTOR FROM THE PROGRAM LIBRARY A2200633 SAP MSG020 SKIP IF ALL THE RECORDS ARE READ A2200634 SPC 1 A2200635 RTJ+ PUTS ENTER THE DATA INTO THE SYSTEM MESSAGE FILE A2200636 ADC REQBUF A2200637 ADC GTFILE A2200638 ADC ONE A2200639 ADC ISTAT A2200640 RTJ CKSTAT CHECK FOR FILE ERRORS A2200641 JMP* MSG010 CONTINUE A2200642 SPC 1 A2200643MSG020 RTJ+ CLOSFL CLOSE THE SYSTEM MESSAGE FILE A2200644 ADC REQBUF A2200645 ADC ISTAT A2200646 RTJ CKSTAT CHECK FOR FILE ERRORS A2200647 SPC 1 A2200648 JMP* (MSGBLD) RETURN A2200649 SPC 2 A2200650SYSMSG ALF 4,$$SYMSGF SYSTEM MESSAGE FILE NAME A2200651* SYSTEM MESSAGE FILE IDATA ENTRIES A2200652MSGDAT NUM 80 13 - RECORD LENGTH-BYTES A2200653 NUM 0 14 - NUMBER OF RECORDS A2200654 NUM 0 15 - NUMBER OF RECORDS A2200655 NUM 0 16 - FILE TYPE-SEQUENTIAL A2200656ÐÐ NUM 0 17 A2200657 NUM 0 18 A2200658 EJT A2200659PDRBLD NOP 0 A2200660 SPC 1 A2200661 RTJ+ READR FIND THE PROCEDURE DIR. INITIAL DATA FILE A2200662 ADC REQBFN A2200663 ADC PNFREC A2200664 ADC PROCED+1 A2200665 ADC ISTAT A2200666 RTJ CKSTAT CHECK FOR FILE ERRORS A2200667 SPC 1 A2200668 LDA PNFREC+5 A2200669 CLR Q A2200670 DVI =N96 A2200671 STA PDRREC A2200672 ARS 1 A2200673 ADD PDRREC A2200674 STA PDRDAT+2 NUMREC = 1.5*(DATA FILE LENGTH/96) A2200675 SPC 1 A2200676 RTJ CLRQBF INITIALIZE THE FILE REQUEST BUFFER A2200677 ADC REQBUF A2200678 RTJ FILNAM SPECIFY THE PROCEDURE DIRECTORY FILE A2200679 ADC PROCED A2200680 RTJ FILDAT INITIALIZE THE IDATA ARRAY A2200681ÐÐ ADC PDRDAT A2200682 SPC 1 A2200683 RTJ+ CREATE CREATE THE PROCEDURE DIRECTORY FILE A2200684 ADC REQBUF A2200685 ADC IDATA A2200686 ADC ISTAT A2200687 RTJ CKSTAT CHECK FOR FILE ERRORS A2200688 SPC 1 A2200689 RTJ FLDATE SET UP THE FILE TYPE AND DATES A2200690 ADC 1 A2200691 SPC 1 A2200692 RTJ CLRQBF INITIALIZE THE FILE REQUEST BUFFER A2200693 ADC REQBUF A2200694 RTJ FILDAT SPECIFY AN INDEXED FILE A2200695 ADC IDXDAT A2200696 EJT A2200697 RTJ+ OPENFL OPEN THE PROCEDURE DIRECTORY FILE A2200698 ADC REQBUF A2200699 ADC IDATA A2200700 ADC ISTAT A2200701 RTJ CKSTAT CHECK FOR FILE ERRORS A2200702 SPC 1 A2200703 LDA PDRREC A = NUMBER OF RECORDS IN THE FILE A2200704PDR010 RTJ READPL READ THE NEXT SECTOR FROM THE PROGRAM LIBRARY A2200705 SAP PDR020 SKIP IF ALL THE RECORDS ARE READ A2200706ÐÐ SPC 1 A2200707 RTJ+ WRITER ENTER THE DATA INTO THE PROCEDURE DIR. FILE A2200708 ADC REQBUF A2200709 ADC GTFILE A2200710 ADC GTFILE A2200711 ADC ISTAT A2200712 RTJ CKSTAT CHECK FOR FILE ERRORS A2200713 JMP* PDR010 CONTINUE A2200714 SPC 1 A2200715PDR020 RTJ+ CLOSFL CLOSE THE PROCEDURE DIRECTORY FILE A2200716 ADC REQBUF A2200717 ADC ISTAT A2200718 RTJ CKSTAT CHECK FOR FILE ERRORS A2200719 SPC 1 A2200720 RTJ CLRQBF INITIALIZE THE FILE REQUEST BUFFER A2200721 ADC REQBFP A2200722 RTJ FILDAT SPECIFY RELEATIVE RECORD ACCESS A2200723 ADC SEQDAT A2200724 SPC 1 A2200725 RTJ+ OPENFL OPEN THE PROCEDURE DIRECTORY FILE A2200726 ADC REQBFP A2200727 ADC IDATA A2200728 ADC ISTAT A2200729 RTJ CKSTAT CHECK FOR FILE ERRORS A2200730 SPC 1 A2200731ÐÐ LDA =A A2200732 STA IDATA+4 SPECIFY COMMON FILE OWNERSHIP A2200733 EJT A2200734PDR030 RTJ+ GETS OBTAIN THE NEXT DIRECTORY RECORD A2200735 ADC REQBFP A2200736 ADC GTFILE A2200737 ADC GTFILE A2200738 ADC ISTAT A2200739 SPC 1 A2200740 LDA ISTAT A2200741 AND* FNDMSK HAVE ALL RECORDS BEEN RETRIEVED A2200742 SAZ PDR040 NO A2200743 JMP* PDR090 YES, EXIT A2200744 SPC 1 A2200745PDR040 RTJ CKSTAT CHECK FOR FILE ERRORS A2200746 SPC 1 A2200747 RTJ LUNEQ A2200748 ADC GTFILE+5 A2200749 ADC ISTAT A2200750 SPC 1 A2200751 LDA ISTAT IS THE PROCEDURE FILE A SYSTEM DEVICE A2200752 SAM PDR050 NO A2200753 JMP* PDR030 YES, DO NOT ATTEMPT TO BUILD A FILE A2200754 SPC 1 A2200755PDR050 RTJ MOVKEY MOVE THE DATA FILE KEY A2200756ÐÐ ADC GTFILE+6 A2200757 SPC 1 A2200758 RTJ+ READR FIND THIS PROCEDURES INITIAL DATA FILE A2200759 ADC REQBFN A2200760 ADC PNFREC A2200761 ADC FILKEY A2200762 ADC ISTAT A2200763 SPC 1 A2200764 LDA ISTAT A2200765 AND* FNDMSK IS THE DATA FILE RESIDENT A2200766 SAZ PDR060 YES, CONTINUE A2200767 JMP* PDR030 NO, DO NOT ATTEMPT TO BUILD THE FILE A2200768 SPC 1 A2200769PDR060 RTJ CKSTAT CHECK FOR FILE ERRORS A2200770 SPC 1 A2200771 LDA PNFREC+5 A2200772 CLR Q A2200773 DVI =N96 A2200774 STA* PRODAT+2 NUMREC = DATA FILE LENGTH/96 A2200775 EJT A2200776 SPC 4 A2200777 RTJ CLRQBF INITIALIZE THE FILE REQUEST BUFFER A2200778 ADC REQBUF A2200779 RTJ FILNAM SPECIFY THIS PROCEDURE FILE A2200780 ADC GTFILE+5 A2200781ÐÐ RTJ FILDAT INITIALIZE THE IDATA ARRAY A2200782 ADC PRODAT A2200783 SPC 1 A2200784 RTJ+ CREATE CREATE THIS PROCEDURE FILE A2200785 ADC REQBUF A2200786 ADC IDATA A2200787 ADC ISTAT A2200788 RTJ CKSTAT CHECK FOR FILE ERRORS A2200789 SPC 1 A2200790 RTJ FLDATE SET UP THE FILE TYPE AND DATES A2200791 ADC 0 A2200792 SPC 1 A2200793 RTJ CLRQBF INITIALIZE THE FILE REQUEST BUFFER A2200794 ADC REQBUF A2200795 RTJ FILDAT SPECIFY A SEQUENTIAL FILE A2200796 ADC SEQDAT A2200797 SPC 1 A2200798 RTJ+ OPENFL OPEN THIS PROCEDURE FILE A2200799 ADC REQBUF A2200800 ADC IDATA A2200801 ADC ISTAT A2200802 RTJ CKSTAT CHECK FOR FILE ERRORS A2200803 EJT A2200804 SPC 4 A2200805 LDA* PRODAT+2 A = NUMBER OF RECORDS IN THE FILE A2200806ÐÐPDR070 RTJ READPL READ THE NEXT SECTOR FROM THE PROGRAM LIBRARY A2200807 SAP PDR080 SKIP IF ALL THE RECORDS ARE READ A2200808 SPC 1 A2200809 RTJ+ PUTS ENTER THE DATA INTO THIS PROCEDURE FILE A2200810 ADC REQBUF A2200811 ADC GTFILE A2200812 ADC ONE A2200813 ADC ISTAT A2200814 RTJ CKSTAT CHECK FOR FILE ERRORS A2200815 JMP* PDR070 CONTINUE A2200816 SPC 1 A2200817PDR080 RTJ+ CLOSFL CLOSE THIS PROCEDURE FILE A2200818 ADC REQBUF A2200819 ADC ISTAT A2200820 RTJ CKSTAT CHECK FOR FILE ERRORS A2200821 JMP* PDR030 CONTINUE A2200822 SPC 1 A2200823PDR090 RTJ+ CLOSFL CLOSE THE PROCEDURE DIRECTORY FILE A2200824 ADC REQBFP A2200825 ADC ISTAT A2200826 RTJ CKSTAT CHECK FOR FILE ERRORS A2200827 LDA =A$$ A2200828 STA IDATA+4 RESTORE SYSTEM FILE OWNERSHIP A2200829 JMP (PDRBLD) RETURN A2200830 EJT A2200831ÐÐ SPC 4 A2200832FNDMSK NUM $0300 FILE REQUSET STATUS - NO RECORD FOUND A2200833PDRREC NUM 0 NUMBER OF INITIAL DATA RECORDS A2200834REQBFP BZS REQBFP(24) PROCEDURE DIRECTORY FILE REQUEST BUFFER A2200835PROCED ALF 4,$$PROCED PROCEDURE DIRECTORY FILE NAME A2200836* PROCEDURE DIRECTORY FILE IDATA ENTRIES A2200837PDRDAT NUM 18 13 - RECORD LENGTH-BYTES A2200838 NUM 0 14 - NUMBER OF RECORDS A2200839 NUM 0 15 - NUMBER OF RECORDS A2200840 NUM 1 16 - FILE TYPE-INDEXED A2200841 NUM 8 17 - KEY1 LENGTH-BYTES A2200842 NUM 1 18 - KEY1 POSITION-BYTE A2200843 SPC 1 A2200844* PROCEDURE FILE IDATA ARRAY A2200845PRODAT NUM 80 13 - RECORD LENGTH-BYTES A2200846 NUM 0 14 - NUMBER OF RECORDS A2200847 NUM 0 15 - NUMBER OF RECORDS A2200848 NUM 0 16 - FILE TYPE-SEQUENTIAL A2200849 NUM 0 17 A2200850 NUM 0 18 A2200851 EJT A2200852 SPC 4 A2200853MNUBLD NOP 0 A2200854 SPC 1 A2200855 RTJ+ READR FIND THE MASTER MENU INITIAL DATA FILE A2200856ÐÐ ADC REQBFN A2200857 ADC PNFREC A2200858 ADC SYMENU+1 A2200859 ADC ISTAT A2200860 RTJ CKSTAT CHECK FOR FILE ERRORS A2200861 SPC 1 A2200862 LDA PNFREC+5 A2200863 CLR Q A2200864 DVI =N96 A2200865 STA MNUDAT+2 NUMREC = DATA FILE LENGTH/96 A2200866 SPC 1 A2200867 RTJ CLRQBF INITIALIZE THE FILE REQUEST BUFFER A2200868 ADC REQBUF A2200869 RTJ FILNAM SPECIFY THE MASTER MENU FILE A2200870 ADC SYMENU A2200871 RTJ FILDAT INITIALIZE THE IDATA ARRAY A2200872 ADC MNUDAT A2200873 SPC 1 A2200874 RTJ+ CREATE CREATE THE MASTER MENU FILE A2200875 ADC REQBUF A2200876 ADC IDATA A2200877 ADC ISTAT A2200878 RTJ CKSTAT CHECK FOR FILE ERRORS A2200879 SPC 1 A2200880 RTJ FLDATE SET UP THE FILE TYPE AND DATES A2200881ÐÐ ADC 0 A2200882 EJT A2200883 SPC 4 A2200884 RTJ CLRQBF INITAILAZE THE FILE REQUEST BUFFER A2200885 ADC REQBFM A2200886 RTJ FILDAT SPECIFY A SEQUENTIAL FILE A2200887 ADC SEQDAT A2200888 SPC 1 A2200889 RTJ+ OPENFL OPEN THE MASTER MENU FILE A2200890 ADC REQBFM A2200891 ADC IDATA A2200892 ADC ISTAT A2200893 RTJ CKSTAT CHECK FOR FILE ERRORS A2200894 SPC 1 A2200895 LDA MNUDAT+2 A = NUMBER OF RECORDS IN THE FILE A2200896MNU010 RTJ READPL READ THE NEXT SECTOR FROM THE PROGRAM LIBRARY A2200897 SAP MNU020 SKIP IF ALL THE RECORDS ARE READ A2200898 SPC 1 A2200899 RTJ+ PUTS ENTER THE DATA INTO THE MASTER MENU FILE A2200900 ADC REQBFM A2200901 ADC GTFILE A2200902 ADC ONE A2200903 ADC ISTAT A2200904 RTJ CKSTAT CHECK FOR FILE ERRORS A2200905 JMP* MNU010 CONTINUE A2200906ÐÐ EJT A2200907 SPC 4 A2200908MNU020 RTJ+ GETS OBTAIN THE NEXT MASTER MENU RECORD A2200909 ADC REQBFM A2200910 ADC GTFILE A2200911 ADC GTFILE A2200912 ADC ISTAT A2200913 SPC 1 A2200914 LDA ISTAT A2200915 AND* FNDMSK HAVE ALL RECORDS BEEN RETRIEVED A2200916 SAZ MNU030 NO A2200917 JMP* MNU070 YES, EXIT A2200918 SPC 1 A2200919MNU030 RTJ CKSTAT CHECK FOR FILE ERRORS A2200920 SPC 1 A2200921 LDA GTFILE+5 A2200922 STA* MNUKEY+1 SPECIFY THIS MENU NAME A2200923 SPC 1 A2200924 RTJ MOVKEY MOVE THE MENU'S KEY A2200925 ADC MNUKEY+1 A2200926 SPC 1 A2200927 RTJ+ READR FIND THIS MENUS INITIAL DATA FILE A2200928 ADC REQBFN A2200929 ADC PNFREC A2200930 ADC FILKEY A2200931ÐÐ ADC ISTAT A2200932 SPC 1 A2200933 LDA ISTAT A2200934 AND FNDMSK IS THE MENU DATA RESIDENT A2200935 SAZ MNU040 YES, CONTINUE A2200936 JMP* MNU020 NO, DO NOT ATTEMPT TO BUILD THE FILE A2200937 SPC 1 A2200938MNU040 RTJ CKSTAT CHECK FOR FILE ERRORS A2200939 SPC 1 A2200940 LDA PNFREC+5 A2200941 CLR Q A2200942 DVI =N96 A2200943 STA* MENDAT+2 NUMREC = DATA FILE LENGTH/96 A2200944 EJT A2200945 SPC 4 A2200946 RTJ CLRQBF INITIALIZE THE FILE REQUEST BUFFER A2200947 ADC REQBUF A2200948 RTJ FILNAM SPECIFY THIS MENU FILE A2200949 ADC MNUKEY A2200950 RTJ FILDAT INITIALIZE THE IDATA ARRAY A2200951 ADC MENDAT A2200952 SPC 1 A2200953 RTJ+ CREATE CREATE THIS MENU FILE A2200954 ADC REQBUF A2200955 ADC IDATA A2200956ÐÐ ADC ISTAT A2200957 RTJ CKSTAT CHECK FOR FILE ERRORS A2200958 SPC 1 A2200959 RTJ FLDATE SET UP THE FILE TYPE AND DATES A2200960 ADC 0 A2200961 SPC 1 A2200962 RTJ CLRQBF INITIALIZE THE FILE REQUEST BUFFER A2200963 ADC REQBUF A2200964 RTJ FILDAT SPECIFY A SEQUENTIAL FILE A2200965 ADC SEQDAT A2200966 SPC 1 A2200967 RTJ+ OPENFL OPEN THIS MENU FILE A2200968 ADC REQBUF A2200969 ADC IDATA A2200970 ADC ISTAT A2200971 RTJ CKSTAT CHECK FOR FILE ERRORS A2200972 EJT A2200973 SPC 4 A2200974 LDA* MENDAT+2 A = NUMBER OF RECORDS IN THE FILE A2200975MNU050 RTJ READPL READ THE NEXT SECTOR FROM THE PROGRAM LIBRARY A2200976 SAP MNU060 SKIP IF ALL THE RECORDS HAVE BEEN READ A2200977 SPC 1 A2200978 RTJ+ PUTS ENTER THE DATA INTO THIS MENU FILE A2200979 ADC REQBUF A2200980 ADC GTFILE A2200981ÐÐ ADC ONE A2200982 ADC ISTAT A2200983 RTJ CKSTAT CHECK FOR FILE ERRORS A2200984 JMP* MNU050 CONTINUE A2200985 SPC 1 A2200986MNU060 RTJ+ CLOSFL CLOSE THIS MENU FILE A2200987 ADC REQBUF A2200988 ADC ISTAT A2200989 RTJ CKSTAT CHECK FOR FILE ERRORS A2200990 JMP* MNU020 CONTINUE A2200991 SPC 1 A2200992MNU070 RTJ+ CLOSFL CLOSE THE MASTER MENU FILE A2200993 ADC REQBFM A2200994 ADC ISTAT A2200995 RTJ CKSTAT CHECK FOR FILE ERRORS A2200996 JMP (MNUBLD) RETURN A2200997 EJT A2200998 SPC 4 A2200999REQBFM BZS REQBFM(24) MASTER MENU FILE REQUEST BUFFER A2201000SYMENU ALF 4,$$SYMENU MASTER MENU FILE NAME A2201001MNUKEY ALF 4,$$ MENU MENU FILE NAME SKELETON A2201002* MASTER MENU FILE IDATA ENTRIES A2201003MNUDAT NUM 80 13 - RECORD LENGTH-BYTES A2201004 NUM 0 14 - NUMBER OF RECORDS A2201005 NUM 0 15 - NUMBER OF RECORDS A2201006ÐÐ NUM 0 16 - FILE TYPE-SEQUENTIAL A2201007 NUM 0 17 A2201008 NUM 0 18 A2201009 SPC 1 A2201010* MENU FILE IDATA ENTRIES A2201011MENDAT NUM 80 13 - RECORD LENGTH-BYTES A2201012 NUM 0 14 - NUMBER OF RECORDS A2201013 NUM 0 15 - NUMBER OF RECORDS A2201014 NUM 0 16 - FILE TYPE-SEQUENTIAL A2201015 NUM 0 17 A2201016 NUM 0 18 A2201017 EJT A2201018MNTBLD NOP 0 A2201019 SPC 1 A2201020 RTJ LUNEQ CHECK FOR MAG TAPE PRESENCE A2201021 ADC TAPE A2201022 ADC ISTAT A2201023 LDA ISTAT A2201024 SAP MNT010 SKIP IF THE SYSTEM CONTAINS A TAPE A2201025 JMP* (MNTBLD) NO TAPE, RETURN A2201026 SPC 1 A2201027MNT010 RTJ CLRQBF INITIALIZE THE FILE REQUEST BUFFER A2201028 ADC REQBUF A2201029 RTJ FILNAM SPECIFY THE TAPE MOUNT FILE A2201030 ADC MOUNTS A2201031ÐÐ RTJ FILDAT INITIALIZE THE IDATA ARRAY A2201032 ADC MNTDAT A2201033 LDA =A A2201034 STA IDATA+4 SPECIFY COMMON FILE OWNERSHIP A2201035 ENA 8 A2201036 STA IDATA+18 SPECIFY THE KEY2 LENGTH A2201037 ENA 3 A2201038 STA IDATA+19 SPECIFY THE KEY2 POSITION A2201039 SPC 1 A2201040 RTJ+ CREATE CREATE THE TAPE MOUNT FILE A2201041 ADC REQBUF A2201042 ADC IDATA A2201043 ADC ISTAT A2201044 RTJ CKSTAT CHECK FOR FILE ERRORS A2201045 SPC 1 A2201046 RTJ FLDATE SET UP THE FILE TYPE AND DATES A2201047 ADC 1 A2201048 CLR A RESTORE THE KEY2 PARAMETERS TO ZERO A2201049 STA IDATA+18 A2201050 STA IDATA+19 A2201051 LDA =A$$ A2201052 STA IDATA+4 RESTORE SYSTEM FILE OWNERSHIP A2201053 JMP* (MNTBLD) RETURN A2201054 EJT A2201055 SPC 4 A2201056ÐÐTAPE ALF 4,TAPE0 A2201057MOUNTS ALF 4,$$MOUNTS TAPE MOUNT FILE NAME A2201058* TAPE MOUNT FILE IDATA ENTRIES A2201059MNTDAT NUM 42 13 - RECORD LENGTH-BYTES A2201060 NUM 0 14 - NUMBER OF RECORDS A2201061 NUM 50 15 - NUMBER OF RECORDS A2201062 NUM 1 16 - FILE TYPE-INDEXED A2201063 NUM 2 17 - KEY1 LENGTH-BYTES A2201064 NUM 1 18 - KEY1 POSITION-BYTE A2201065 EJT A2201066 SPC 4 A2201067HOSTBL NOP 0 BUILD THE HOST FILE A2201068 SPC 1 A2201069 RTJ CLRQBF SET F.M. BUFFER TO ZEROS. A2201070 ADC REQBUF A2201071 RTJ FILNAM MOVE HOST NAME TO IDATA. A2201072 ADC HOSFIL A2201073 RTJ FILDAT INITIALIZE THE IDATA ARRAY A2201074 ADC HOSDAT A2201075 SPC 1 A2201076 RTJ+ CREATE CREATE $$HOST FILE. A2201077 ADC REQBUF A2201078 ADC IDATA A2201079 ADC ISTAT A2201080 RTJ CKSTAT A2201081ÐÐ SPC 1 A2201082 RTJ FLDATE SET UP THE FILE TYPE AND DATES A2201083 ADC 0 A2201084 SPC 1 A2201085 RTJ CLRQBF NOW OPEN $$HOST AND STORE DATA. A2201086 ADC REQBUF A2201087 RTJ FILDAT SPECIFY SEQUENTIAL FILE OPTIONS. A2201088 ADC SEQDAT A2201089 SPC 1 A2201090 RTJ+ OPENFL A2201091 ADC REQBUF A2201092 ADC IDATA A2201093 ADC ISTAT A2201094 RTJ CKSTAT A2201095 EJT A2201096 SPC 4 A2201097HOST40 RTJ+ PUTS STORE INTO RECORDS A2201098 ADC REQBUF A2201099 ADC RECSTR A2201100 ADC ONE A2201101 ADC ISTAT A2201102 LDA ISTAT A2201103 AND- ONEBIT+12 HAVE ALL RECORDS BEEN STORED A2201104 SAN HOST50 YES A2201105 RTJ CKSTAT NO, CHECK FOR FILE ERRORS A2201106ÐÐ SPC 1 A2201107 LDA =N$2020 STORE BLANKS FOR NEXT ENTRIES OF HOSTS. A2201108 STA* RECSTR A2201109 STA* RECSTR+1 A2201110 JMP* HOST40 A2201111 SPC 1 A2201112HOST50 RTJ+ CLOSFL HOST FILE COMPLETE. A2201113 ADC REQBUF A2201114 ADC ISTAT A2201115 RTJ CKSTAT A2201116 JMP* (HOSTBL) RETURN. A2201117 SPC 2 A2201118RECSTR ALF 2,LOCL A2201119 BZS FILL(RECLEN) RECLEN-2 =NO. OF ZERO WORDS +2 WORDS FOR F.M. A2201120 SPC 1 A2201121HOSFIL ALF 4,$$HOST HOST FILE NAME A2201122* HOST FILE IDATA ENTRIES A2201123 A2201124HOSDAT ADC RECLEN*2 13 - RECORD LENGTH-BYTES A2201125 NUM 0 14 - NUMBER OF RECORDS A2201126 ADC NUMHST 15 - NUMBER OF RECORDS A2201127 NUM 0 16 - FILE TYPE-SEQUENTIAL A2201128 NUM 0 17 - KEY1 LENGTH-BYTES A2201129 NUM 0 18 - KEY1 POSITION-BYTE A2201130 EJT A2201131ÐÐBATBLD NOP 0 BUILD THE BATCH FILE A2201132 SPC 1 A2201133 LDA =XRECLEN COMPUTE NUMBER OF RECORDS FOR BATCH A2201134 INA -3 A2201135 ALS 2 A2201136 STA* RPERHO GET NUMBER OF RECORDS PER HOST/LOCL ENTRIES. A2201137 MUI =XNUMHST A2201138 STA* RECSB A2201139 SPC 1 A2201140 RTJ CLRQBF CLEAR FM BUFFER. A2201141 ADC REQBUF A2201142 RTJ FILNAM SPECIFY $$BATCH FILE. A2201143 ADC BATFIL A2201144 RTJ FILDAT SET UP IDATA. A2201145 ADC BATDAT A2201146 SPC 1 A2201147 RTJ CREATE CREATE $$BATCH FILE. A2201148 ADC REQBUF A2201149 ADC IDATA A2201150 ADC ISTAT A2201151 RTJ CKSTAT A2201152 SPC 1 A2201153 RTJ FLDATE SET UP THE FILE TYPE AND DATES A2201154 ADC 1 A2201155 SPC 1 A2201156ÐÐ RTJ CLRQBF NOW OPEN $$BATCH FILE AND STORE DATA. A2201157 ADC REQBUF A2201158 RTJ FILDAT A2201159 ADC IDXDAT A2201160 SPC 1 A2201161 RTJ+ OPENFL OPEN BATCH FILE A2201162 ADC REQBUF A2201163 ADC IDATA A2201164 ADC ISTAT A2201165 RTJ CKSTAT A2201166 EJT A2201167 SPC 4 A2201168* COMPUTE KEYS WHERE LOCAL HAS (RECLEN-3)*4 A2201169* KEYS FROM J001 TO JONN. EACH SUCCESSIVE REMOTEA2201170* HOST HAS KEYS OF THE FORM JMNN WHERE M RANGES A2201171* FROM 1 TO NUMHST-1 AND NN IS THE SAME AS FOR A2201172* LOCAL. A2201173* A2201174* ASCDAT WILL BE RETURNED WITH $2020 A2201175* ASCDAT+1 WILL HAVE $20XX A2201176* ASCDAT+2 WILL HAVE $YYZZ A2201177* WHERE XX CAN BE EITHER $20 OR AN ASCII NO. A2201178* AND YY CAN BE A $20 ONLY IF XX IS A $20,ELSE A2201179* YY MUST BE AN ASCII NO. A2201180* ZZ IS ALWAYS AN ASCII NO. A2201181ÐÐ* A2201182* THE LOGIC HERE TRANSFORMS LEADING $20(BLANKS) A2201183* TO A $30 FOR ASCDAT+1,+2. A2201184* A2201185BAT20 RTJ BINASC A2201186 ADC NN BINARY NUMBER. A2201187 ADC ASCDAT A2201188 SPC 1 A2201189 LDA* ASCDAT+1 A2201190 AND- ONE+7 A2201191 INA -$20 A2201192 SAN BAT30 A2201193 ENA $30 A2201194 STA* ASCDAT+1 SET =ZERO A2201195 LDA* ASCDAT+2 GET TENS AND UNITS DIGITS. A2201196 ALS 8 A2201197 AND- ONE+7 A2201198 INA -$20 A2201199 SAN BAT30 A2201200 LDA* ASCDAT+2 A2201201 AND- ONE+7 A2201202 ADD =N$3000 INSERT ZERO IN TENS DIGIT A2201203 STA* ASCDAT+2 A2201204BAT30 LDA* ASCDAT+1 IF HUNDREDS DIGIT WAS NOT A BLANK,THE ASCII A2201205 AND- ONE+7 NUMBER LIES IN ASCDAT+1,+2 IMMEDIATELY. A2201206ÐÐ ADD* J0 A2201207 STA* RECBUF A2201208 LDA* ASCDAT+2 A2201209 STA* RECBUF+1 A2201210 EJT A2201211 RTJ+ WRITER MAKE FM CALL TO STORE RECORD FOR THIS KEY. A2201212 ADC REQBUF A2201213 ADC RECBUF RECORD IS WRITTEN FROM RECBUF. A2201214 ADC RECBUF KEY IS BYTES 1-4 OF THE RECORD. A2201215 ADC ISTAT A2201216 RTJ CKSTAT A2201217 SPC 1 A2201218 RAO* WROTE A2201219 LDA* WROTE A2201220 SUB* RPERHO A2201221 SAZ BAT60 SKIP IF ALL RECORDS FOR A HOST HAVE BEEN DONE.A2201222 RAO* NN A2201223 JMP* BAT20 BUILD NEXT KEY. A2201224 SPC 1 A2201225BAT60 LDA* HOSTNO A2201226 SUB =XNUMHST A2201227 SAZ BAT100 SKIP IF ALL HOSTS HAVE THEIR RECORDS. A2201228 LDA* HOSTNO INITIALIZE TO NEXT KEY FOR NEXT HOST. A2201229 MUI =N100 A2201230 INA 1 A2201231ÐÐ STA* NN A2201232 RAO* HOSTNO A2201233 CLR A A2201234 STA* WROTE A2201235 JMP* BAT20 A2201236 SPC 1 A2201237BAT100 RTJ+ CLOSFL THE $$BATCH FILE IS INITIALIZED. A2201238 ADC REQBUF A2201239 ADC ISTAT A2201240 RTJ CKSTAT A2201241 JMP* (BATBLD) A2201242 SPC 2 A2201243BATFIL ALF 4,$$BATCH BATCH FILE NAME A2201244* BATCH FILE IDATA ENTRIES A2201245BATDAT NUM 64 13 - RECORD LENGTH-BYTES A2201246 NUM 0 14 - NUMBER OF RECORDS A2201247RECSB NUM $FFFF 15 - NUMBER OF RECORDS A2201248 NUM $4001 16 - FILE TYPE-INDEXED ORDERED A2201249 NUM 4 17 - KEY1 LENGTH-BYTES A2201250 NUM 1 18 - KEY1 POSITION-BYTE A2201251 EJT A2201252 SPC 4 A2201253HOSTNO NUM 1 NUMBER OF HOSTS PROCESSED. A2201254RPERHO NUM 0 A2201255WROTE NUM 0 NUMBER OF JOBS WRITTEN FOR A HOST. A2201256ÐÐJ0 NUM $4A00 J0 A2201257ASCDAT ALF 3, A2201258NN NUM 1 A2201259RECBUF ALF 1,J0 A2201260 ALF 1,01 A2201261 ALF 15, A2201262 ALF 15, A2201263 BZS FMWDS(2) FILE MANAGER WORDS FOR WRITER REQUEST. A2201264 EJT A2201265* BUILD PRINT FILE A2201266* A2201267* THE KEY FOR THE $$PRINT FILE WILL BE OF THE A2201268* FORM PRXX WHERE XX WILL RANGE FROM 01 TO 50. A2201269* A2201270* THE NUMBER OF RECORDS IN ANY PRXX FILE IS A2201271* FOUND IN WORDS 16 AND 17 OF THE $$PRINT A2201272* RECORDS. A2201273 SPC 2 A2201274PRTBLD NOP 0 A2201275 SPC 1 A2201276 RTJ CLRQBF CLEAR FM BUFFER. A2201277 ADC REQBUF A2201278 RTJ FILNAM SPECIFY FILE A2201279 ADC PRTFIL A2201280 RTJ FILDAT SET UP IDATA (13-18) A2201281ÐÐ ADC PRTDAT A2201282 SPC 1 A2201283 RTJ+ CREATE CREATE $$PRINT FILE. A2201284 ADC REQBUF A2201285 ADC IDATA A2201286 ADC ISTAT A2201287 RTJ CKSTAT A2201288 SPC 1 A2201289 RTJ FLDATE SET UP THE FILE TYPE AND DATES A2201290 ADC 1 A2201291 SPC 1 A2201292 RTJ CLRQBF NOW OPEN $$PRINT FILE AND INITIALIZE KEYS. A2201293 ADC REQBUF A2201294 RTJ FILDAT A2201295 ADC IDXDAT A2201296 SPC 1 A2201297 RTJ+ OPENFL OPEN $$PRINT FILE. A2201298 ADC REQBUF A2201299 ADC IDATA A2201300 ADC ISTAT A2201301 RTJ CKSTAT A2201302 EJT A2201303 SPC 4 A2201304PRT20 RTJ BINASC A2201305 ADC PP A2201306ÐÐ ADC ENDASC A2201307 SPC 1 A2201308 LDA* ENDASC+2 A2201309 ALS 8 A2201310 AND- ONE+7 A2201311 INA -$20 A2201312 SAN PRT30 SKIP IF TENS DIGIT IS NOT A $20. A2201313 LDA* ENDASC+2 A2201314 AND- ONE+7 A2201315 ADD =N$3000 INSERT ASCII ZERO. A2201316 JMP* PRT40 A2201317 SPC 1 A2201318PRT30 LDA* ENDASC+2 A2201319PRT40 STA* PRTKEY+1 PUT KEY IN RECORD WITH PR AS FIRST 2 CHAR. A2201320 SPC 1 A2201321 RTJ WRITER MAKE FM CALL TO STORE RECORD FOR THIS KEY. A2201322 ADC REQBUF A2201323 ADC PRTKEY WRITE FROM HERE. A2201324 ADC PRTKEY KEY IS IN FIRST 2 WORDS. A2201325 ADC ISTAT A2201326 RTJ CKSTAT A2201327 SPC 1 A2201328 LDA* PP A2201329 INA -50 A2201330 SAZ PRT50 SKIP IF 50 RECORDS ARE DONE. A2201331ÐÐ RAO* PP A2201332 JMP* PRT20 A2201333 SPC 1 A2201334PRT50 RTJ+ CLOSFL THE $$PRINT FILE IS INITIALIZED. A2201335 ADC REQBUF A2201336 ADC ISTAT A2201337 RTJ CKSTAT A2201338 JMP* (PRTBLD) A2201339 EJT A2201340 SPC 4 A2201341PRTFIL ALF 4,$$PRINT PRINT FILE NAME A2201342* PRINT FILE IDATA ENTRIES A2201343PRTDAT NUM 34 13 - RECORD LENGTH-BYTES A2201344 NUM 0 14 - NUMBER OF RECORDS A2201345 NUM 50 15 - NUMBER OF RECORDS A2201346 NUM $4001 16 - FILE TYPE-INDEXED ORDERED A2201347 NUM 4 17 - KEY1 LENGTH-BYTES A2201348 NUM 1 18 - KEY1 POSITION-BYTE A2201349 SPC 2 A2201350PRTKEY ALF 19,PR A2201351PP NUM 1 A2201352ENDASC ALF 3, A2201353 EJT A2201354 SPC 4 A2201355FILCLN NOP 0 A2201356ÐÐ SPC 1 A2201357 LDQ =XNUMLU A2201358FIL010 LR1+ LOG1A,Q R1 = P.D.T. ADDRESS A2201359 LRA- 8,1 A2201360 EOR TY1 IS THIS THE BATCH OUTPUT DRIVER A2201361 SAZ FIL020 YES A2201362 INQ -1 NO, CONTINUE A2201363 SQZ FIL030 A2201364 JMP* FIL010 A2201365 SPC 1 A2201366FIL020 LRA- BDINIT,1 HAS THE DRIVER EVER EXECUTED A2201367 SAZ FIL040 NO, CLEAN UP ANY ACTIVE FILES A2201368FIL030 JMP* (FILCLN) OTHERWISE, RETURN A2201369 SPC 1 A2201370FIL040 RTJ CLRQBF HOST FILE CLEANUP A2201371 ADC REQBUF A2201372 RTJ FILNAM MOVE HOST NAME TO IDATA A2201373 ADC HOSFIL A2201374 RTJ FILDAT MOVE FILE DATA TO IDATA A2201375 ADC SEQDAT A2201376 SPC 1 A2201377 RTJ+ OPENFL OPEN HOST FILE A2201378 ADC REQBUF A2201379 ADC IDATA A2201380 ADC ISTAT A2201381ÐÐ RTJ CKSTAT CHECK FOR F.M. ERROR A2201382 SPC 1 A2201383 RTJ+ GETS READ IN HOST FILE A2201384 ADC REQBUF A2201385 ADC HOBUF BUFFER A2201386 ADC KEYVAL A2201387 ADC ISTAT A2201388 RTJ CKSTAT CHECK FOR F.M. ERROR A2201389 EJT A2201390 LDQ =N126 A2201391HSCL1 XFQ 1 NUMBER OF HOST STATUS WORDS TO CHECK A2201392 AR1 =N14 A2201393 LR2 =N14 A2201394 LFA HOBUF+2,11,2,Q CHECK IF IA AND JA (BITS 11 - 10) ARE ZERO A2201395 SAZ HSCL2 A2201396 CLF HOBUF+2,11,2,Q NOT ZERO, CLEAR THESE BITS A2201397HSCL2 LFA HOBUF+3,3,4,1 CHECK IF BITS 3-0 = 2 (BEING SENT) A2201398 INA -2 A2201399 SAN HSCL3 NOT BEING SENT A2201400 CLF HOBUF+3,3,4,1 STATUS=2. CLEAR BITS 3-0 A2201401HSCL3 LFA HOBUF+3,7,4,1 CHECK IF BITS 7-4 = 2 (BEING SENT) A2201402 INA -2 A2201403 SAN HSCL4 NOT BEING SENT A2201404 CLF HOBUF+3,7,4,1 STATUS=2. CLEAR BITS 7-4 A2201405HSCL4 LFA HOBUF+3,11,4,1 CHECK IF BITS 11-8 = 2 (BEING SENT) A2201406ÐÐ INA -2 A2201407 SAN HSCL5 NOT BEING SENT A2201408 CLF HOBUF+3,11,4,1 STATUS=2. CLEAR BITS 11-8 A2201409 EJT A2201410 SPC 4 A2201411HSCL5 LFA HOBUF+3,15,4,1 CHECK IF BITS 15-12 = 2 (BEING SENT) A2201412 INA -2 A2201413 SAN HSCL6 NOT BEING SENT A2201414 CLF HOBUF+3,15,4,1 STATUS=2. CLEAR BITS 15-12 A2201415 SPC 1 A2201416HSCL6 AR1 =N-1 A2201417 JMP* HSCL8 A2201418 SPC 1 A2201419HSCL7 JMP* HSCL2 A2201420HSCL8 D2P *-HSCL7 A2201421 INQ -18 A2201422 SQM HSCL9 CHECK IF DONE WITH HOST FILE A2201423 JMP* HSCL1 NOT DONE A2201424 SPC 1 A2201425HSCL9 RTJ+ UPDREC DONE. UPDATE HOST FILE A2201426 ADC REQBUF A2201427 ADC HOBUF A2201428 ADC ISTAT A2201429 RTJ CKSTAT A2201430 SPC 1 A2201431ÐÐ RTJ+ CLOSFL CLOSE HOST FILE A2201432 ADC REQBUF A2201433 ADC ISTAT A2201434 RTJ CKSTAT A2201435 EJT A2201436 SPC 4 A2201437 LDQ =XNUMLU CLEAN UP THE BATCH DRIVER FILES A2201438BDCL2 LR1+ LOG1A,Q A2201439 LRA- 8,1 GET WORD 8 OF EACH LU PHYSTB A2201440 EOR* TY1 CHECK IF TYPE=$28A4 A2201441 SAZ BDCL4 YES A2201442 LRA- 8,1 A2201443 EOR* TY2 CHECK IF TYPE=$8A2 A2201444 SAZ BDCL4 YES A2201445 INQ -1 CHECK IF DONE WITH LU TABLE A2201446 SQN BDCL3 NOT DONE A2201447 JMP* (FILCLN) DONE. RETURN A2201448 SPC 1 A2201449BDCL3 JMP* BDCL2 A2201450 SPC 1 A2201451BDCL4 STQ* QSAVE A2201452 TRQ A CONVERT LU TO ASCII A2201453 CLR Q A2201454 DVI- TEN A2201455 INA $30 A2201456ÐÐ INQ $30 A2201457 ALS 8 A2201458 EAQ A A2201459 STA BDFIL+2 STORE LU IN IDATA BUFFER A2201460 SPC 1 A2201461 RTJ CLRQBF SET F.M. BUFFER TO ZEROS A2201462 ADC REQBUF A2201463 RTJ FILNAM MOVE $$BDXX TO IDATA A2201464 ADC BDFIL A2201465 RTJ FILDAT A2201466 ADC SEQDAT A2201467 EJT A2201468 SPC 4 A2201469 RTJ+ OPENFL OPEN $$BDXX FILE A2201470 ADC REQBUF A2201471 ADC IDATA A2201472 ADC ISTAT A2201473 SPC 1 A2201474 LDA ISTAT CHECK FOR F.M. ERROR A2201475 SAP BDCL7 A2201476 ALS 14 IF BIT 1 SET, F.M. COULD NOT LOCATE A2201477 SAP BDCL5 FILE. ASSUME ALREADY DELETED. A2201478 JMP* BDCL6 A2201479 SPC 1 A2201480BDCL5 RTJ CKSTAT A2201481ÐÐ SPC 1 A2201482BDCL7 RTJ+ CLOSFL CLOSE $$BDXX FILE A2201483 ADC REQBUF A2201484 ADC ISTAT A2201485 RTJ CKSTAT CHECK FOR F.M. ERROR A2201486 SPC 1 A2201487 RTJ+ DELETE DELETE $$BDXX FILE A2201488 ADC REQBUF A2201489 ADC IDATA A2201490 ADC ISTAT A2201491 RTJ CKSTAT CHECK FOR F.M. ERROR A2201492 SPC 1 A2201493BDCL6 LDQ* QSAVE RETRIEVE Q A2201494 INQ -1 A2201495 SQZ BDCL8 CHECK IF THIS THE LAST LU A2201496 JMP* BDCL2 NO, GO CHECK MORE A2201497 SPC 1 A2201498BDCL8 JMP (FILCLN) DONE. RETURN A2201499 SPC 2 A2201500BDFIL ALF 4,$$BD BATCH DRIVER FILE NAME SKELETON A2201501TY1 NUM $28A4 A2201502TY2 NUM $08A2 A2201503QSAVE NUM 0 A2201504KEYVAL NUM 0 A2201505HOBUF BZS HOBUF(144) A2201506ÐÐ EJT A2201507 EJT A2201508 SPC 4 A2201509FNDFIL NOP 0 A2201510 SPC 1 A2201511 LDA* FNDSEC IS THIS THE INITIAL ENTRY A2201512 SAZ FND010 YES A2201513 JMP* FND050 NO, CONTINUE A2201514 SPC 1 A2201515FND010 LDA- $C4 INITIALIZE THE PROGRAM LIBRARY SECTOR A2201516 SPC 1 A2201517FND020 STA* FNDSEC A2201518 SPC 1 A2201519 RTJ- (AMONI) PERFORM THE TRANSFER A2201520 ADC $4800+RPCP A2201521 ADC FND030 A2201522 ADC 0 A2201523 ADC $08C2 A2201524 ADC 96 A2201525 ADC GTFILE A2201526 ADC 0 A2201527FNDSEC ADC 0 A2201528 JMP- (ADISP) A2201529 SPC 1 A2201530FND030 ENA 85 A2201531ÐÐ STA- I INITIALIZE THE SEARCH A2201532 SPC 1 A2201533FND040 LDA GTFILE+3,I IS THIS LIBRARY ENTRY IN FILE FORMAT A2201534 SAP FND050 NO A2201535 JMP* (FNDFIL) YES, RETURN A2201536 SPC 1 A2201537FND050 LDA- I A2201538 INA -5 IS THIS THE END OF THE FILE BUFFER A2201539 SAM FND060 YES A2201540 STA- I NO A2201541 JMP* FND040 CONTINUE A2201542 SPC 1 A2201543FND060 LDA GTFILE+95 OBTAIN THE NEXT DIRECTORY SECTOR A2201544 SAZ FND070 SKIP IF THE END HAS BEEN REACHED A2201545 JMP* FND020 GET THE NEXT SECTOR A2201546 SPC 1 A2201547FND070 STA* FNDSEC SET UP FOR ANOTHER ENTRY A2201548 JMP* (FNDFIL) RETURN A2201549 EJT A2201550 SPC 4 A2201551FNDPGM NOP 0 A2201552 SPC 1 A2201553 LDA* (ATSMSB) HAS TSLOG BEEN FOUND A2201554 SAZ FNP000 NO A2201555 JMP* FNP010 YES, CONTINUE A2201556ÐÐ SPC 1 A2201557FNP000 LDQ =XTSLNAM A2201558 RTJ* NAMECK IS THIS ENTRY TSLOG A2201559 SAN FNP010 NO A2201560 SPC 1 A2201561 LDQ* ATSMSB YES A2201562 LDA- ONEBIT+15 INDICATE CONTROL POINT TRANSFER A2201563 STA- (ZERO),Q A2201564 LDA GTFILE+4,I A2201565 STA- 1,Q SET UP THE SECTOR ADDRESS A2201566 LDA GTFILE+3,I A2201567 TCA A A2201568 MUI =N96 SET UP THE LENGTH A2201569 STA+ TSLSIZ A2201570 JMP* (FNDPGM) RETURN A2201571 SPC 1 A2201572FNP010 LDA* (ATSULB) HAS THE ULB SECTOR BEEN FOUND A2201573 SAZ FNP020 NO A2201574 JMP* FNP040 YES A2201575 SPC 1 A2201576FNP020 LDQ =XULBNAM A2201577 RTJ* NAMECK IS THIS ENTRY ULBUFF A2201578 SAN FNP040 NO A2201579 LDA GTFILE+3,I YES A2201580 TCA A A = BUFFER SIZE IN SECTORS A2201581ÐÐ CLR Q A2201582 DVI- THREE A = NUMBER OF ENTRIES ALLOWED A2201583 SUB NOPORT IS THE BUFFER LARGE ENOUGH A2201584 SAM FNP030 NO, DO NOT SPECIFY ITS SECTOR A2201585 LDA GTFILE+4,I YES A2201586 STA* (ATSULB) SET UP THE SECTOR ADDRSSS A2201587FNP030 JMP* (FNDPGM) RETURN A2201588 EJT A2201589FNP040 LDQ =XTSMUSR Q = MULTI-USER TABLE ADDRESS A2201590 SPC 1 A2201591FNP050 STQ* FNPIDX A2201592 LDA- MUSIZE,Q HAS THIS ENTRY BEEN SET UP A2201593 SAZ FNP060 NO A2201594 JMP* FNP070 YES, CONTINUE A2201595 SPC 1 A2201596FNP060 INQ 1 Q = ADDRESS OF THE MULTI-USER NAME A2201597 RTJ* NAMECK DOES THE ENTRY MATCH A2201598 SAN FNP070 NO A2201599 SPC 1 A2201600 INQ -1 YES A2201601 LDA GTFILE+3,I A2201602 TCA A A2201603 MUI =N96 OBTAIN THE PROGRAM LENGTH A2201604 LDQ* FNPIDX A2201605 STA- MUSIZE,Q A2201606ÐÐ STA- MURSIZ,Q A2201607 LDA- ONEBIT+15 SPECIFY CONTROL POINT ACCESS A2201608 STA- MUSECT,Q A2201609 LDA GTFILE+4,I A2201610 STA- MUSECT+1,Q SET UP THE SECTOR ADDRESS A2201611 JMP* (FNDPGM) RETURN A2201612 SPC 1 A2201613FNP070 LDQ* FNPIDX A2201614 INQ MUITEM A2201615 TRQ A A2201616 SUB =XTSMEND HAVE ALL ENTRIES BEEN SEARCHED A2201617 SAP FNP080 YES A2201618 JMP* FNP050 NO, CONTINUE A2201619 SPC 1 A2201620FNP080 JMP* (FNDPGM) RETURN A2201621 SPC 2 A2201622TSLNAM ALF 3,TSLOG NAME OF THE LOG-IN PROCESSOR A2201623ATSMSB ADC TSLMSB SECTOR ADDRESS OF THE LOG-IN PROCESSOR A2201624ULBNAM ALF 3,ULBUFF NAME OF THE ULB BUFFER A2201625ATSULB ADC TSULBF SECTOR ADDRESS OF THE ULB BUFFER A2201626FNPIDX NUM 0 A2201627 EJT A2201628 SPC 4 A2201629NAMECK NOP 0 A2201630 SPC 1 A2201631ÐÐ LDA GTFILE+0,I A2201632 SUB- (ZERO),Q DOES THE FIRST WORD MATCH A2201633 SAN NAM010 NO A2201634 LDA GTFILE+1,I A2201635 SUB- 1,Q DOES THE SECOND WORD MATCH A2201636 SAN NAM010 NO A2201637 LDA GTFILE+2,I A2201638 SUB- 2,Q DOES THE THIRD WORD MATCH A2201639 SPC 1 A2201640NAM010 JMP* (NAMECK) A = 0 IF THE NAME MATCHES A2201641 EJT A2201642 SPC 4 A2201643CLRQBF NOP 0 A2201644 SPC 1 A2201645 LDA* (CLRQBF) CALCULATE THE PARAMETER ADDRESS A2201646 STA* CLRXFR A2201647 ENQ 23 A2201648 ENA 0 A2201649 SPC 1 A2201650CLR010 STA* (CLRXFR),Q CLEAR THE REQUEST BUFFER A2201651 DQP *-CLR010 A2201652 SPC 1 A2201653 RAO* CLRQBF A2201654 JMP* (CLRQBF) RETURN A2201655 SPC 2 A2201656ÐÐCLRXFR NUM 0 TEMPORARY STORAGE - TRANSFER ADDRESS A2201657 EJT A2201658 SPC 4 A2201659MOVKEY NOP 0 A2201660 SPC 1 A2201661 LDA* (MOVKEY) OBTAIN THE SOURCE ADDRESS A2201662 STA* MOVXFR A2201663 ENQ 2 A2201664 SPC 1 A2201665MOV010 LDA* (MOVXFR),Q MOVE THE RECORD KEY A2201666 STA FILKEY,Q TO THE KEY ARRAY A2201667 INQ -1 A2201668 SQM MOV020 A2201669 JMP* MOV010 A2201670 SPC 1 A2201671MOV020 RAO* MOVKEY A2201672 JMP* (MOVKEY) RETURN A2201673 SPC 2 A2201674MOVXFR NUM 0 TEMPORARY STORAGE - TRANSFER ADDRESS A2201675 EJT A2201676 SPC 4 A2201677FILNAM NOP 0 A2201678 SPC 1 A2201679 LDA* (FILNAM) CALCULATE THE PARAMETER ADDRESS A2201680 STA* FINXFR A2201681ÐÐ ENQ 3 A2201682 SPC 1 A2201683FIN010 LDA* (FINXFR),Q MOVE THE FILE NAME A2201684 STA IDATA,Q TO THE IDATA ARRAY A2201685 DQP *-FIN010 A2201686 SPC 1 A2201687 RAO* FILNAM A2201688 JMP* (FILNAM) RETURN A2201689 SPC 2 A2201690FINXFR NUM 0 TEMPORARY STORAGE - TRANSFER ADDRESS A2201691 EJT A2201692 SPC 4 A2201693FILDAT NOP 0 A2201694 SPC 1 A2201695 LDA* (FILDAT) CALCULATE THE PARAMETER ADDRESS A2201696 STA* FIDXFR A2201697 ENQ 5 A2201698 SPC 1 A2201699FID010 LDA* (FIDXFR),Q MOVE THE FILE DATA A2201700 STA IDATA+12,Q TO THE IDATA ARRAY A2201701 DQP *-FID010 A2201702 SPC 1 A2201703 RAO* FILDAT A2201704 JMP* (FILDAT) RETURN A2201705 SPC 2 A2201706ÐÐFIDXFR NUM 0 TEMPORARY STORAGE - TRANSFER ADDRESS A2201707 EJT A2201708 SPC 4 A2201709FLDATE NOP 0 A2201710 LDA* (FLDATE) A2201711 STA* FILTYP SAVE THE TYPE INDEX A2201712 SPC 1 A2201713 RTJ CLRQBF INITIALIZE THE FILE REQUEST BUFFER A2201714 ADC REQBUF A2201715 RTJ FILDAT SPECIFY A SEQUENTIAL FILE A2201716 ADC SEQDAT A2201717 SPC 1 A2201718 RTJ+ OPENFL OPEN THE FILE A2201719 ADC REQBUF A2201720 ADC IDATA A2201721 ADC ISTAT A2201722 RTJ CKSTAT CHECK FOR FILE ERRORS A2201723 SPC 1 A2201724 RTJ+ GETFCB READ IN THE FILE'S FCB A2201725 ADC REQBUF A2201726 ADC ZERO A2201727 ADC ZERO A2201728 ADC GTFILE A2201729 ADC ISTAT A2201730 RTJ CKSTAT CHECK FOR FILE ERRORS A2201731ÐÐ EJT A2201732 SPC 4 A2201733 LDA =A99 SPECIFY AN UNLIMITED EXPIRATION DATE A2201734 STA GTFILE+88 A2201735 STA GTFILE+89 A2201736 STA GTFILE+90 A2201737 LDA+ AMONTO SPECIFY THE CREATION DATE A2201738 STA GTFILE+91 A2201739 LDA+ ADAYTO A2201740 STA GTFILE+92 A2201741 LDA+ AYERTO A2201742 STA GTFILE+93 A2201743 LDA* FILTYP A2201744 STA GTFILE+94 SPECIFY THE FILE TYPE A2201745 SPC 1 A2201746 RTJ+ UPDFCB UPDATE THE FCB A2201747 ADC REQBUF A2201748 ADC ZERO A2201749 ADC ZERO A2201750 ADC GTFILE A2201751 ADC ISTAT A2201752 RTJ CKSTAT CHECK FOR FILE ERRORS A2201753 SPC 1 A2201754 RTJ+ CLOSFL CLOSE THE FILE A2201755 ADC REQBUF A2201756ÐÐ ADC ISTAT A2201757 RTJ CKSTAT CHECK FOR FILE ERRORS A2201758 SPC 1 A2201759 RAO* FLDATE A2201760 JMP* (FLDATE) RETURN A2201761 SPC 2 A2201762FILTYP NUM 0 FILE TYPE INDEX A2201763 EJT A2201764 SPC 4 A2201765READPL NOP 0 A2201766 SPC 1 A2201767 LDQ* REASEC IS THIS THE INITIAL ENTRY A2201768 SQN REA010 NO, CONTINUE A2201769 SPC 1 A2201770 STQ* REACNT INITIALIZE THE RECORD COUNT A2201771 STA* REAMAX INITIALIZE THE NUMBER OF RECORDS A2201772 LDA PNFREC+4 A2201773 STA* REASEC AND THE BASE SECTOR ADDRESS A2201774 SPC 1 A2201775REA010 LDA* REACNT YES A2201776 SUB* REAMAX HAVE ALL RECORDS BEEN READ A2201777 SAM REA020 NO, CONTINUE A2201778 ENA 0 A2201779 STA* REASEC SET UP FOR ANOTHER ENTRY A2201780 JMP* (READPL) RETURN A2201781ÐÐ SPC 1 A2201782REA020 RTJ- (AMONI) READ THE PROGRAM LIBRARY DATA A2201783 ADC $4800+RPCP A2201784 ADC REA030 A2201785 ADC 0 A2201786 ADC $08C2 A2201787 ADC 96 A2201788 ADC GTFILE A2201789 ADC 0 A2201790REASEC ADC 0 A2201791 JMP- (ADISP) A2201792 SPC 1 A2201793REA030 RAO* REACNT INCREMENT THE RECORD COUNT A2201794 RAO* REASEC AND THE SECTOR A2201795 SET A INDICATE A NON-TERMINATION A2201796 SPC 1 A2201797 JMP* (READPL) RETURN A2201798 SPC 2 A2201799REACNT NUM 0 DATA RECORD COUNT A2201800REAMAX NUM 0 DATA RECORD COUNT LIMIT A2201801 EJT A2201802 SPC 4 A2201803CKSTAT NOP 0 A2201804 SPC 1 A2201805 LDA ISTAT DID A FILE ERROR OCCUR A2201806ÐÐ SAM CKS010 YES, REPORT IT A2201807 JMP* (CKSTAT) NO, RETURN A2201808 SPC 1 A2201809CKS010 ENQ 7 A2201810 SPC 1 A2201811CKS020 LDA IDATA,Q MOVE THE FILE NAME AND OWNER A2201812 STA MESG01+6,Q TO THE ERROR MESSAGE A2201813 INQ -1 A2201814 SQM CKS030 A2201815 JMP* CKS020 A2201816 SPC 1 A2201817CKS030 RTJ BINHEX CONVERT THE ERROR STATUS TO ASCII A2201818 ADC ISTAT A2201819 ADC MESG01+22 A2201820 SPC 1 A2201821 ENQ 1 A2201822 RTJ MESSAG OUTPUT THE ERROR MESSAGE A2201823 SPC 1 A2201824 RTJ+ CLOSFL CLOSE THE PROGRAM NAME FILE A2201825 ADC REQBFN A2201826 ADC ISTAT A2201827 RTJ+ CLOSFL CLOSE THE PROCEDURE DIRECTORY A2201828 ADC REQBFP A2201829 ADC ISTAT A2201830 RTJ+ CLOSFL CLOSE THE MASTER MENU FILE A2201831ÐÐ ADC REQBFM A2201832 ADC ISTAT A2201833 RTJ+ CLOSFL CLOSE THE CURRENT DATA FILE A2201834 ADC REQBUF A2201835 ADC ISTAT A2201836 SPC 1 A2201837 JMP STAXIT EXIT A2201838 EJT A2201839 SPC 4 A2201840MESSAG NOP 0 A2201841 SPC 1 A2201842 LDA* MESSAD,Q A2201843 STA* MESAD SET UP THE MESSAGE ADDRESS A2201844 LDA* MESLEN,Q A2201845 STA* MESLN AND THE MESSAGE LENGTH A2201846 SPC 1 A2201847 RTJ- (AMONI) A2201848 ADC $4C00+RPCP FORMATTED WRITE A2201849 ADC MES010 A2201850 ADC 0 A2201851 ADC $18FC A2201852MESLN ADC 0 A2201853MESAD ADC 0 A2201854 JMP- (ADISP) A2201855 SPC 1 A2201856ÐÐMES010 JMP* (MESSAG) RETURN A2201857 SPC 4 A2201858MESSAD ADC MESG00 0 A2201859 ADC MESG01 1 A2201860 ADC MESG02 2 A2201861 ADC MESG03 3 A2201862 SPC 2 A2201863MESLEN ADC LMSG00 0 A2201864 ADC LMSG01 1 A2201865 ADC LMSG02 2 A2201866 ADC LMSG03 3 A2201867 EJT A2201868 SPC 2 A2201869REQBUF BZS REQBUF(24) FILE REQUEST BUFFER A2201870IDATA ALF 4, FILE REQUESTS IDATA ARRAY A2201871 ALF 4,$$ A2201872 ALF 4,SYSVOL A2201873 BZS DATA(12) A2201874FILKEY NUM 0,0,0 FILE RECORD KEY ARRAY A2201875ISTAT NUM 0 FILE REQUEST RETURN STATUS A2201876* SEQUENTIAL FILE ACCESS IDATA ENTRIES A2201877SEQDAT NUM 0 13 - SEQUENTIAL RETRIEVAL A2201878 NUM 1 14 - NUMBER OF RECORDS A2201879 NUM 0 15 - RECORD LOCK INDICATOR A2201880 NUM 0 16 A2201881ÐÐ NUM 0 17 A2201882 NUM 0 18 A2201883* INDEXED FILE ACCESS IDATA ENTRIES A2201884IDXDAT NUM 1 13 - INDEXED RETRIEVAL A2201885 NUM 1 14 - NUMBER OF RECORDS A2201886 NUM 0 15 - RECORD LOCK INDICATOR A2201887 NUM 0 16 A2201888 NUM 0 17 A2201889 NUM 0 18 A2201890GTFILE BZS GTFILE(96) FILE DATA BUFFER A2201891 EJT A2201892MESG00 ALF $,EXECUTIVE PROGRAM NOT LOADED -REQUEST REJECTED$ A2201893 EQU LMSG00(*-MESG00) A2201894MESG01 ALF $,FILE NAME: $ A2201895 ALF Z,:RERROR STATUS= $ Z A2201896 ALF $,:R-REQUEST REJECTED$ A2201897 EQU LMSG01(*-MESG01) A2201898MESG02 ALF $,C C S ACTIVE AT $ A2201899 EQU LMSG02(*-MESG02) A2201900MESG03 ALF $,BUILDING SYSTEM FILES$ A2201901 EQU LMSG03(*-MESG03) A2201902 SPC 2 A2201903 END START A2201904 NAM BINHEX A23 A ITOS CCS 3.0 SL-149A2300001* ITOS STARTUP BINARY-ASCII CONVERSION A2300002ÐÐ* CREDIT COLLECTION SYSTEM VERSION 3.0 A2300003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A2300004* COPYRIGHT CONTROL DATA CORPORATION 1979 A2300005* A2300006 SPC 2 A2300007* CALLING SEQUENCE - CALL BINHEX (IVAL,CHAR) A2300008* WHERE IVAL IS THE INTEGER VALUE A2300009* CHAR IS THE TWO WORD ARRAY FOR ASCII CHARSA2300010* A2300011* CONVERTS THE BINARY VALUE TO A TWO WORD ASCII ARRAY CHAR A2300012* THE REPRESENTATION IS EXTERNAL HEXADECIMAL A2300013* A2300014* A2300015 EQU LPMSK(2) A2300016 EQU ONEMSK($3) A2300017 EQU ZERO($22) A2300018 ENT BINHEX A2300019 EXT* Q8PREP A2300020 EXT* Q8PKUP A2300021 SPC 2 A2300022BINHEX NUM 0 A2300023 STQ* QSAVE SAVE CONTENTS OF Q-REG AT ENTRY A2300024 RTJ Q8PREP SET UP THE PARAMETER LOCATIONS A2300025 ADC* BINHEX A2300026 RTJ Q8PKUP A2300027ÐÐ TRA Q A2300028 LDA- (ZERO),Q OBTAIN THE VALUE A2300029 STA* VAL A2300030 RTJ Q8PKUP A2300031 STA* CHRADR SAVE ADR OF BUFFER A2300032 LDA* VAL CONVERT VALUE TO 4 CHARACTERS A2300033 AND- ONEMSK+3 GET BINARY VALUE OF NEXT HEX DIGIT A2300034 STA* BUFFER+3 A2300035 LDA* VAL A2300036 ARS 4 A2300037 AND- ONEMSK+3 A2300038 STA* BUFFER+2 A2300039 LDA* VAL A2300040 ARS 8 A2300041 AND- ONEMSK+3 A2300042 STA* BUFFER+1 A2300043 LDA* VAL A2300044 ARS 12 A2300045 AND- ONEMSK+3 A2300046 STA* BUFFER+0 A2300047 EJT A2300048 ENQ 0 A2300049LOOP LDA* BUFFER,Q CONVERT DIGIT TO ASCII CHARACTER A2300050 INA -10 A2300051 SAP Y A2300052ÐÐ INA $30-$41+10 A2300053Y INA $41 A2300054 STA* BUFFER,Q A2300055 INQ -3 A2300056 SQZ DONE A2300057 INQ 4 A2300058 JMP* LOOP A2300059DONE CLR Q BUILD FINAL BUFFER FOR USER A2300060 LDQ* BUFFER+0 A2300061 QLS 8 A2300062 ADQ* BUFFER+1 A2300063 LDA* BUFFER+2 A2300064 ALS 8 A2300065 ADD* BUFFER+3 A2300066 STQ* (CHRADR) A2300067 RAO* CHRADR A2300068 STA* (CHRADR) A2300069 LDQ* QSAVE A2300070 JMP* (BINHEX) A2300071QSAVE NUM 0 A2300072CHRADR ADC 0 ADDRESS OF ASCII CHARACTER BUFFER A2300073 BSS VAL(1) PASSED BINARY VALUE A2300074 BZS BUFFER(4) A2300075 END A2300076 NAM BINASC A24 A ITOS CCS 3.0 SL-149A2400001ÐÐ* ITOS STARTUP BINARY-DECIMAL CONVERSION A2400002* CREDIT COLLECTION SYSTEM VERSION 3.0 A2400003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A2400004* COPYRIGHT CONTROL DATA CORPORATION 1979 A2400005* A2400006 SPC 2 A2400007**** A2400008* CONVERTS BINARY TO DECIMAL CODED ASCII . A2400009* LEADING ZEROS ARE SUPRESSED. A2400010* A2400011* ENTRY POINTS- A2400012* ----- ------ A2400013 ENT BINASC A2400014* A2400015* A2400016* EXTERNALS- A2400017* --------- A2400018 EXT* Q8PREP A2400019 EXT* Q8PKUP A2400020* A2400021* A2400022* EQUIVALENCES- A2400023* ------------ A2400024 EQU ONEMSK(3) A2400025 EQU ONEBIT($23) A2400026ÐÐ EQU ZROMSK($13) A2400027* A2400028* A2400029* ENTRY/EXIT A2400030* ----- ---- A2400031* ENTRY A2400032* CALL BINASC(IVAL,IBUF) A2400033* IVAL IS POSITIVE BINARY NBR A2400034* IBUF IS THREE WORD BUFFER A2400035* EXIT A2400036* IBUF CONTAINS RIGHT JUSTIFIED DECIMAL A2400037* CODED ASCII WITH LEADING SPACES. A2400038**** A2400039 SPC 4 A2400040BINASC NUM 0 A2400041 STQ* QSAVE SAVE Q,I A2400042 LDA- I A2400043 STA* ISAVE A2400044 RTJ Q8PREP PICK UP PARAMETER LOCATIONS A2400045 ADC* BINASC A2400046 RTJ Q8PKUP A2400047 STA* IVAL A2400048 RTJ Q8PKUP A2400049 STA* IBUF A2400050 ENA 2 SET OUTPUT BUFFER POINTERS TO A2400051ÐÐ STA- I LAST WORD A2400052 ENA 1 A2400053 STA* SCHAR LS CHAR A2400054 LDA* (IVAL) A2400055 STA* VALUE A2400056BIN2 LDA* VALUE LOAD BINARY VALUE A2400057 CLR Q A2400058 DVI =N10 DIVIDE BY 10 A2400059 STA* VALUE SAVE ANSWER A2400060 ADQ =N$30 CONV REMAINDER TO ASCII A2400061 STQ* TMPCHR SAVE A2400062 LDA* (IBUF),I LOAD OUTPUT WORD A2400063 LDQ* SCHAR IS LS NEXT A2400064 SQN BIN4 YES A2400065 AND- ONEMSK+7 NO,MS NEXT A2400066 LDQ* TMPCHR A2400067 QLS 8 A2400068 EAQ A MERGE WITH NEW MS CHAR A2400069 STA* (IBUF),I A2400070 JMP* BIN8 A2400071BIN4 AND- ZROMSK+7 A2400072 EOR* TMPCHR MERGE WITH NEW LS CHAR A2400073 STA* (IBUF),I A2400074BIN8 LDA- I IS END (FIRST) WORD IN BUFFER A2400075 SAZ BIN12 YES A2400076ÐÐ JMP* BIN16 NO A2400077BIN12 LDA* SCHAR IS END (MS) CHAR IN BUFFER A2400078 SAN BIN16 NO A2400079 JMP* BIN24 DONE CODING A2400080BIN16 LDA* SCHAR BUMP POINTERS TO NEXT OUTPUT CHAR A2400081 EOR- ONEBIT SWITCH CHAR IDX A2400082 STA* SCHAR A2400083 SAZ BIN20 MS NEXT, SAME WORD A2400084 LDA- I LS NEXT, NEXT WORD A2400085 INA -1 BUMP WORD INDEX A2400086 STA- I A2400087BIN20 JMP* BIN2 A2400088BIN24 LDA* (IBUF),I SUPRESS LEADING ZEROS A2400089 LDQ* SCHAR A2400090 SQN BIN32 LS NEXT A2400091 AND- ZROMSK+7 IS MS A ZERO A2400092 SUB =N$3000 A2400093 SAZ BIN28 YES A2400094 JMP* BIN42 NO, FINISHED A2400095BIN28 LDA* (IBUF),I REPLACE MS ZERO CHAR WITH SPACE A2400096 AND- ONEMSK+7 A2400097 EOR =N$2000 A2400098 STA* (IBUF),I A2400099 JMP* BIN40 A2400100BIN32 AND- ONEMSK+7 IS LS A ZERO A2400101ÐÐ SUB =N$30 A2400102 SAZ BIN36 YES A2400103 JMP* BIN42 NO, FINISHED A2400104BIN36 LDA* (IBUF),I REPLACE LS ZERO CHAR WITH SPACE A2400105 AND- ZROMSK+7 A2400106 EOR =N$20 A2400107 STA* (IBUF),I A2400108BIN40 LDA- I IS DONE A2400109 INA -2 A2400110 SAN BIN44 NO A2400111BIN42 LDA* ISAVE YES, LEAVE ONE ZERO UNCHECKED A2400112 STA- I A2400113 LDQ* QSAVE A2400114 JMP* (BINASC) A2400115BIN44 LDA* SCHAR BUMP OUTPUT BUFFER POINTERS A2400116 EOR- ONEBIT A2400117 STA* SCHAR A2400118 SAN BIN48 LS NEXT ,SAME WORD A2400119 RAO- I MS NEXT, BUMP WORD A2400120BIN48 JMP* BIN24 A2400121 SPC 2 A2400122QSAVE NUM 0 A2400123ISAVE NUM 0 A2400124IVAL NUM 0 A2400125IBUF NUM 0 A2400126ÐÐVALUE NUM 0 A2400127SCHAR NUM 0 A2400128TMPCHR NUM 0 A2400129 END A2400130 NAM Q8PRMA A25 A ITOS CCS 3.0 SL-149A2500001* ITOS STARTUP PARAMETER PICKUP ROUTINE A2500002* CREDIT COLLECTION SYSTEM VERSION 3.0 A2500003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A2500004* COPYRIGHT CONTROL DATA CORPORATION 1979 A2500005* A2500006 SPC 2 A2500007 SPC 2 A2500008 ENT Q8PREP A2500009 ENT Q8PKUP A2500010 SPC 1 A2500011 EQU LPMSK(2) A2500012 EQU ENTAD($DC),PAD($DD) A2500013 SPC 2 A2500014Q8PREP NOP 0 A2500015* A2500016 LDA* (Q8PREP) OBTAIN THE PARAMETER A2500017 ADD* Q8PREP ABSOLUTIZE IT A2500018 STA- ENTAD A2500019 RAO* Q8PREP A2500020 JMP* (Q8PREP) RETURN A2500021ÐÐ SPC 2 A2500022Q8PKUP NOP 0 A2500023 LDA- (ENTAD) PICK UP PARAMETER A2500024 STA- PAD A2500025 LDA- (PAD) A = PARAMETER ADDRESS A2500026ABS RAO- (ENTAD) SET UP FOR NEXT PARAMETER A2500027 JMP* (Q8PKUP) RETURN A2500028 END A2500029 NAM TSLOG A30 A ITOS CCS 3.0 SL-149A3000001* USER PROGRAM LOG-IN PROCESSOR A3000002* CREDIT COLLECTION SYSTEM VERSION 3.0 A3000003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A3000004* COPYRIGHT CONTROL DATA CORPORATION 1979 A3000005* A3000006 SPC 2 A3000007* E X T E R N A L S A3000008 SPC 1 A3000009 EXT SYSMSG SYSTEM MESSAGE PROCESSOR A3000010 EXT QPASWD PASSWORD FOR TERMINAL USERS A3000011 EXT PGMINT USER FUNCTION MANUAL INTERRUPT ROUTINE A3000012 EXT PGMOUT USER FUNCTION EXIT ROUTINE A3000013 EXT WTREAD TIMESHARE WRITE-READ SUBROUTINE A3000014 EXT TSAREA TIMESHARE USER AREA STARTING ADDRESS A3000015 EXT TSNABL TIMESHARE ACTIVE INDICATOR A3000016 EXT TSOFFM ADDRESS OF THE 'OFF UNTIL' MESSAGE A3000017ÐÐ EXT TSLOFF LENGTH OF THE 'OFF UNTIL' MESSAGE A3000018 EXT SYSID LOCATION OF THE SYSTEM NAME A3000019 EXT PARTBL SYSTEM PARTITIONED MEMORY TABLE A3000020 EXT TERMLU COMMUNICATIONS CONTROLLER LOGICAL UNIT A3000021 EXT YERTO TIME AND DATE YEAR A3000022 EXT MONTO TIME AND DATE MONTH A3000023 EXT DAYTO TIME AND DATE DAY A3000024 EXT HORTO TIME AND DATE HOUR A3000025 EXT MINTO TIME AND DATE MINUTE A3000026 EXT SECON TIME AND DATE SECOND A3000027 EXT OPENFL OPEN FILE REQUEST A3000028 EXT CLOSFL CLOSE FILE FILE REQUEST A3000029 EXT READR READ INDEXED RECORD FILE REQUEST A3000030 EXT GETS READ SEQUENTIAL RECORD FILE REQUEST A3000031 EXT PUTS STORE SEQUENTIAL RECORD FILE REQUEST A3000032 EXT FCLOSE FORCE CLOSE FILE REQUEST A3000033 EXT FMEOFC FILE MAMAGER END-OF-FILE CODE A3000034 EXT LUNEQ DEVICE NAME - LOGICAL UNIT CONVERSION A3000035 EXT INPEQ USER INPUT DEVICE SPECIFICATION A3000036 EXT OUTEQ USER OUTPUT DEVICE SPECIFICATION A3000037 EXT PGLUNT INPUT / OUTPUT LOGICAL UNIT SPECIFICATION A3000038 EJT A3000039 SPC 4 A3000040* E Q U I V A L E N C E S A3000041 SPC 1 A3000042ÐÐ EQU LPMASK($2) BIT MASK TABLE A3000043 EQU NZERO($12) NEGATIVE ZERO TABLE A3000044 EQU ONEBIT($23) SINGLE BIT TABLE A3000045 EQU ZERO($22) LOCATION CONTAINING ZERO A3000046 EQU ONE(3) LOCATION CONTAINING ONE A3000047 EQU THREE(4) LOCATION CONTAINING THREE A3000048 EQU SIX($44) LOCATION CONTAINING SIX A3000049 EQU EIGHT($26) LOCATION CONTAINING EIGHT A3000050 EQU TEN($46) LOCATION CONTAINING TEN A3000051 EQU MINONE($33) LOCATION CONTAINING MINUS ONE A3000052 EQU ADISP($EA) ADDRESS OF THE DISPATCHER A3000053 EQU AMONI($F4) ADDRESS OF MONITOR REQUEST ENTRY A3000054 EQU SPACE($20) SPACE CHARACTER A3000055 EQU EQUAL($3D) EQUAL CHARACTER A3000056 EQU EF(08) END-OF-FILE INDICATOR A3000057 EQU NF(09) RECORD KEY NOT FOUND INDICATOR A3000058 EQU M13(13) SYSTEM MESSAGE - DATE/TIME A3000059 EQU M14(14) SYSTEM MESSAGE - TERMINAL NUMBER A3000060 EQU M15(15) SYSTEM MESSAGE - LOG-OFF A3000061 EQU E16(16) ILLEGAL LOG-IN A3000062 EQU E17(17) INVALID REQUEST NAME A3000063 EQU E18(18) PROGRAM TOO LARGE A3000064 EQU E19(19) ERROR DURING OPENFL A3000065 EQU E20(20) ERROR DURING CLOSFL A3000066 EQU E21(21) ERROR DURING READR A3000067ÐÐ EQU E22(22) ERROR DURING GETS A3000068 EQU E23(23) ERROR DURING FFCLOSE A3000069 EQU E24(24) PROCEDURE FILE ERROR A3000070 EJT A3000071 SPC 4 A3000072* M U L T I - U S E R P R O G R A M T A B L E E N T R I E S A3000073 SPC 1 A3000074 EQU MUROOT(ZERO) ASSOCIATED ROOT TABLE ADDRESS A3000075 EQU MUSRID(01) PROGRAM IDENTIFICATION - 4 WORDS ASCII A3000076 EQU MUSIZE(05) PROGRAM LENGTH (WORDS) A3000077 EQU MUSECT(06) PROGRAM SECTOR ADDRESS - 2 WORDS A3000078 EQU MUPAGE(08) PROGRAM BASE MEMORY PAGE NUMBER A3000079 EQU ACROOT(09) PROGRAM ACTIVE ROOT COUNT A3000080 EQU MURSIZ(10) PROGRAM TRUE LENGTH (WORDS) A3000081 EQU MUEXTH(11) PROGRAM EXECUTION THREAD A3000082 EQU MURSTX(13) PROGRAM STATE INDEX A3000083 EQU MURCLK(15) PROGRAM CLOCK VALUE A3000084 EQU MUITEM(MURCLK+1) A3000085 SPC 2 A3000086* U S E R P R O G R A M U S E R T A B L E E N T R I E S A3000087 SPC 1 A3000088 EQU TSIOTB(ZERO) ASSOCIATED I/O TABLE ADDRESS A3000089 EQU USERID(01) USER IDENTIFICATION - 4 WORDS ASCII A3000090 EQU PGMSIZ(05) USER PROGRAM LENGTH (WORDS) A3000091 EQU PGMSEC(06) USER PROGRAM SECTOR - 2 WORDS A3000092ÐÐ EQU TWNSEC(08) SWAP TWIN SECTOR - 2 WORDS A3000093 EQU SWPBLK(10) USER SWAP BLOCK BYTES A3000094 EQU NEXETH(11) USER EXECUTION THREAD A3000095 EQU NSWPTH(12) USER SWAP THREAD A3000096 EQU USRSTX(13) USER STATE INDEX A3000097 EQU TSMUTB(14) MULTI USER TABLE ADDRESS A3000098 EQU NUMREQ(15) USER REQUEST COUNT A3000099 EQU USRITM(NUMREQ+1) A3000100 EJT A3000101 SPC 4 A3000102* U S E R P R O G R A M S T A T E I N D I C E S A3000103 SPC 1 A3000104 EQU SXCACT(01) EXECUTING IN MAIN MEMORY A3000105 EQU SXCTSL(02) SUSPENDED IN MAIN MEMORY-TIMESLICE COMPLETE A3000106 EQU SXCMMA(03) SUSPENDED IN MAIN MEMORY-M.M. I/O ACTIVE A3000107 EQU SXCMMC(04) SUSPENDED IN MAIN MEMORY-M.M. I/O COMPLETE A3000108 EQU SXCFMA(05) SUSPENDED IN MAIN MEMORY-FILE I/O ACTIVE A3000109 EQU SXCFMC(06) SUSPENDED IN MAIN MEMORY-FILE I/O COMPLETE A3000110 EQU SXCTMA(07) SUSPENDED IN MAIN MEMORY-TMNL I/O ACTIVE A3000111 EQU SXCTMC(08) SUSPENDED IN MAIN MEMORY-TMNL I/O COMPLETE A3000112 EQU SXCDTA(09) SUSPENDED IN MAIN MEMORY-DATA I/O ACTIVE A3000113 EQU SXCDTC(10) SUSPENDED IN MAIN MEMORY-DATA I/O COMPLETE A3000114 EQU SXCATA(11) SUSPENDED IN MAIN MEMORY-ATTACH ACTIVE A3000115 EQU SXCATC(12) SUSPENDED IN MAIN MEMORY-ATTACH COMPLETE A3000116* A3000117ÐÐ EQU SXMASS(13) RESERVED A3000118 EQU SXMTSL(14) SWAPPED ON MASS MEMORY-TIMESLICE COMPLETE A3000119 EQU SXM015(15) RESERVED A3000120 EQU SXMMMC(16) SWAPPED ON MASS MEMORY-M.M. I/O COMPLETE A3000121 EQU SXM017(17) RESERVED A3000122 EQU SXMFMC(18) SWAPPED ON MASS MEMORY-FILE I/O COMPLETE A3000123 EQU SXMTMA(19) SWAPPED ON MASS MEMORY-TMNL I/O ACTIVE A3000124 EQU SXMTMC(20) SWAPPED ON MASS MEMORY-TMNL I/O COMPLETE A3000125 EQU SXMDTA(21) SWAPPED ON MASS MEMORY-DATA I/O ACTIVE A3000126 EQU SXMDTC(22) SWAPPED ON MASS MEMORY-DATA I/O COMPLETE A3000127 EQU SXMATA(23) SWAPPED ON MASS MEMORY-ATTACH ACTIVE A3000128 EQU SXM024(24) RESERVED A3000129* A3000130 EQU SXMUSA(25) SUSPENDED ON MASS MEMORY-UNSWAP ACTIVE A3000131 EQU SXCUSC(26) SUSPENDED IN MAIN MEMORY-UNSWAP COMPLETE A3000132 EQU SXMMUR(27) SUSPENDED ON MASS MEMORY-MULTIUSER READ A3000133 EQU SXMLOG(28) SUSPENDED ON MASS MEMORY-INITIAL LOGIN A3000134 EQU SXMJOB(29) SUSPENDED ON MASS MEMORY-JOB STEP A3000135 SPC 2 A3000136* NOTE - BIT 15 = 1 WHILE THE USER IS BEING SWAPPED A3000137 EJT A3000138 SPC 4 A3000139* U S E R P R O G R A M I / O T A B L E E N T R I E S A3000140 SPC 1 A3000141 EQU TSUSTB(ZERO) ASSOCIATED USER TABLE ADDRESS A3000142ÐÐ EQU FRQBUF(01) FILE REQUEST BUFFER HEADER (4 WORDS) A3000143 EQU IORQCD(05) INPUT/OUTPUT REQUEST CODE A3000144 EQU IORQCA(06) INPUT/OUTPUT COMPLETION ADDRESS A3000145 EQU IORQTH(07) INPUT/OUTPUT THREAD WORD A3000146 EQU IORQLU(08) INPUT/OUTPUT LOGICAL UNIT A3000147 EQU IOMSLN(09) INPUT/OUTPUT MESSAGE LENGTH A3000148 EQU IOBFAD(10) INPUT/OUTPUT MESSAGE BUFFER ADDRESS A3000149 EQU IOMMSB(11) INPUT/OUTPUT MASS MEMORY ADDRESS A3000150 EQU IOMLSB(12) INPUT/OUTPUT MASS MEMORY ADDRESS A3000151 EQU IOCNPT(13) INPUT/OUTPUT CONTROL POINT A3000152 EQU IOSTAT(14) INPUT/OUTPUT STATUS WORD A3000153 EQU TERMBF(15) TERMINAL MESSAGE BUFFER ADDRESS A3000154 EQU IOITEM(TERMBF+1) A3000155 SPC 2 A3000156* USER PROGRAM I/O STATUS INDICATORS A3000157 SPC 1 A3000158* UNSOLICITED INPUT GROUP A3000159 EQU LI(00) TERMINAL LOG-IN A3000160 EQU MN(01) TERMINAL MANUAL INTERRUPT A3000161 EQU ES(02) TERMINAL ESCAPE A3000162* INPUT-OUTPUT ERROR GROUP A3000163 EQU DS(04) TERMINAL DISCONNECT A3000164 EQU ME(05) MASS MEMORY ERROR A3000165 EQU FE(06) FILE REQUEST ERROR A3000166* REQUEST TYPE GROUP A3000167ÐÐ EQU IN(08) DATA INPUT REQUEST A3000168 EQU IA(09) INPUT / OUTPUT ACTIVE A3000169 EQU IC(10) INPUT / OUTPUT COMPLETE A3000170 EQU MM(11) MASS MEMORY I/O REQUEST A3000171 EQU TI(12) TERMINAL I/O REQUEST A3000172* TERMINAL CHARACTERISTIC GROUP A3000173* A3000174 EQU DY(TI+1) END OF THE DYNAMIC STATUS GROUP A3000175 EJT A3000176* U S E R L I N K A G E B U F F E R E N T R I E S A3000177* A3000178* THE USER LINKAGE BUFFER IMMEDIATELY PRECEEDS THE USER PROGRAM A3000179 SPC 2 A3000180 EQU LASTEP(ZERO) LAST ENTRY TO THE USER PROGRAM A3000181 EQU ULIOTB(001) USERS I/O TABLE ADDRESS A3000182 EQU ULUSTB(002) USERS USER TABLE ADDRESS A3000183 EQU RSCLOK(003) USERS REMAINING TIMESLICE A3000184 EQU FALADD(004) PROTECT FAULT ADDRESS A3000185 EQU PARADD(005) CURRENT PARAMETER ADDRESS A3000186 EQU RSP(006) P-REGISTER STORAGE A3000187 EQU RSA(007) A-REGISTER STORAGE A3000188 EQU RSQ(008) Q-REGISTER STORAGE A3000189 EQU RSI(009) I-REGISTER STORAGE A3000190 EQU RSL(010) OVERFLOW STORAGE A3000191 EQU RS1(011) 1-REGISTER STORAGE A3000192ÐÐ EQU RS2(012) 2-REGISTER STORAGE A3000193 EQU RS3(013) 3-REGISTER STORAGE A3000194 EQU RS4(014) 4-REGISTER STORAGE A3000195 EQU RSUB(015) UPPER BOUNDS REGISTER STORAGE A3000196 EQU RSIORC(016) MONITOR I/O REQUEST CODE A3000197 EQU RSIOCA(017) COMPLETION ADDRESS A3000198 EQU RSIOTH(018) REQUEST THREAD A3000199 EQU RSIOLU(019) MODE + LOGICAL UNIT A3000200 EQU RSIOLN(020) LENGTH A3000201 EQU RSIOSA(021) STARTING ADDRESS A3000202 EQU RSIOMS(022) MASS MEMORY ADDRESS - MSB A3000203 EQU RSIOLS(023) MASS MEMORY ADDRESS - LSB A3000204 EQU RSIOCP(024) MONITOR REQUEST CONTROL POINT A3000205 EQU RQTYPE(025) MONITOR REQUEST TYPE INDEX A3000206 EQU RQCLAS(026) MONITOR REQUEST DEVICE CLASS CODE A3000207 EQU RQMODE(027) MONITOR REQUEST CHARACTER MODE INDICATOR A3000208 EQU REQLUN(028) MONITOR REQUEST LOGICAL UNIT A3000209 EQU RSCPAD(029) USERS MONITOR REQUEST COMPLETION ADDRESS A3000210 EQU RSUSLN(030) USERS MONITOR REQUEST MESSAGE LENGTH A3000211 EQU RSUSBF(031) USERS MONITOR REQUEST MESSAGE ADDRESS A3000212 EQU PORTNO(032) MONITOR REQUEST COMMUNICATIONS PORT NUMBER A3000213 EQU RSBHDR(032) MONITOR REQUEST MESSAGE HEADER - 6 WORDS A3000214 EQU WROUTP(038) WRITE-READ USERS OUTPUT LOGICAL UNIT A3000215 EQU WRILEN(039) WRITE-READ INPUT BUFFER LENGTH A3000216 EQU WRIBUF(040) WRITE-READ INPUT BUFFER ADDRESS A3000217ÐÐ EQU WRTCAD(041) WRITE-READ TERMINATION CODE ADDRESS A3000218 EQU PMCNTR(042) REQUEST PARAMETER COUNT A3000219 EQU RSCARG(043) USERS MONITOR REQUEST COMPLETION A-REGISTER A3000220 EQU RQINPT(044) USERS INPUT LOGICAL UNIT A3000221 EQU RQOUTP(045) USERS OUTPUT LOGICAL UNIT A3000222 EQU RQUN01(046) USERS SPARE LOGICAL UNIT A3000223 EQU RQUN02(047) USERS SPARE LOGICAL UNIT A3000224 EJT A3000225 SPC 4 A3000226* U S E R L I N K A G E B U F F E R E N T R I E S A3000227 SPC 2 A3000228 EQU ERRIDX(048) ERROR MESSAGE INDEX A3000229 EQU ERRADD(049) ERROR MESSAGE ADDRESS A3000230 EQU USRPGM(050) CURRENT USER PROGRAM INDEX A3000231 EQU PGMIDX(051) LOG-IN PROCESSOR PROGRAM INDEX A3000232 EQU INTADD(052) PGMINT REQUEST INTERRUPT ADDRESS A3000233 EQU INTFLG(053) PGMINT REQUEST INTERRUPT FLAG ADDRESS A3000234 EQU ATTADR(054) ATTACH REQUEST COMPLETION ADDRESS A3000235 EQU LUNERR(055) ILLEGAL LOGICAL UNIT ERROR ADDRESS A3000236 EQU FMINDX(056) FILE REQUEST TYPE INDEX A3000237 EQU SPARE0(057) SPARE ENTRY A3000238 EQU DATIME(058) DATE AND TIME FOR DAYFILE ENTRY - 6 WORDS A3000239 EQU FRQBFA(064) FILE REQUEST BUFFER ADDRESS A3000240 EQU FILREQ(065) USER DECLARED FILE REQUEST INDICATOR A3000241 EQU FMPMTR(066) FILE REQUEST PARAMETER LIST - 5 WORDS A3000242ÐÐ EQU CHNAME(071) CHAIN REQUEST PROGRAM NAME - 4 WORDS A3000243 EQU MUFWAD(075) FIRST WORD ADDRESS OF THE MULTI-USER PROGRAM A3000244 EQU TEMPQR(076) TEMPORARY STORAGE - Q REGISTER A3000245 EQU TEMPAR(077) TEMPORARY STORAGE - A REGISTER A3000246 EQU RSC5E5(078) FORTRAN SCRATCH AREA STORAGE - 33 WORDS A3000247 EQU SPARE1(111) SPARE ENTRY A3000248 EQU ENDPRO(111) END OF THE PROTECTED LINKAGE BUFFER AREA A3000249* A3000250 EQU UFPARM(112) USER DECLARED FILE REQUEST PARAMETERS A3000251 EQU FISTAT(128) USER DECLARED FILE REQUEST STATUS A3000252 EQU PFNAME(129) CURRENT PROCEDURE FILE NAME - 4 WORDS A3000253 EQU MENUKY(133) REQUESTED FUNCTION MENU KEY A3000254 EQU USABRT(134) USER PROGRAM ABORT INDICATOR A3000255 EQU USMODE(135) USER EXECUTION MODE INDICATOR A3000256 EQU TMPGMX(136) TEMPORARY - PROGRAM INDEX A3000257 EQU TMSECT(137) TEMPORARY - PROGRAM SECTOR - 2 WORDS A3000258 EQU TMPLEN(139) TEMPORARY - PROGRAM LENGTH A3000259 EQU TMUSID(140) TEMPORARY - USER IDENTIFICATION - 4 WORDS A3000260 EQU IREQBF(144) INPUT FILE REQUEST BUFFER AND FCB A3000261 EQU FINAME(188) INPUT FILE NAME - 4 WORDS A3000262 EQU OREQBF(192) OUTPUT FILE REQUEST BUFFER AND FCB A3000263 EQU FONAME(236) OUTPUT FILE NAME - 4 WORDS A3000264 EQU FIRCNO(240) INPUT FILE RECORD NUMBER - 2 WORDS A3000265 EQU LULBUF(256) LENGTH OF THE LINKAGE BUFFER A3000266 EQU LOKNAM(242) 8 CHARACTER NAME OF FORCED ANSWER TO A3000267ÐÐ* REQUEST = QUERY. A3000268 EQU LOKLEN(246) NUMBER OF NON-BLANK CHARACTERS IN LOKNAM. A3000269 EJT A3000270 SPC 4 A3000271* T S L O G I N I T I A L I Z A T I O N R O U T I N E A3000272 SPC 2 A3000273TSLOG STQ* FUNIDX SAVE THE TSLOG FUNCTION INDEX A3000274 SPC 1 A3000275 RTJ+ PGMINT SET UP AN ABORT REQUEST ENTRY A3000276 ADC AEXIT A3000277 ADC FLAG A3000278 SPC 1 A3000279 ENA 0 A3000280 STA* MNUTMP INITIALIZE THE MENU KEY VALUE A3000281 SPC 1 A3000282 LDA+ TSAREA OBTAIN THE ADDRESS OF THE LINKAGE BUFFER A3000283 STA- I A3000284 SPC 1 A3000285 LDQ* FUNIDX A3000286 LDQ* FUNTAB,Q OBTAIN THE REQUIRED FUNCTION ADDRESS A3000287 JMP- (ZERO),Q PERFORM THE FUNCTION A3000288 SPC 2 A3000289* T S L O G F U N C T I O N T A B L E A3000290 SPC 1 A3000291FUNTAB ADC LOGIN 00 - PROCESS USER LOG-IN A3000292ÐÐ ADC SYSTEM 01 - PROCESS USER SYSTEM COMPLETION A3000293 ADC ERROR 02 - PROCESS EXECUTIVE ERROR MESSAGE A3000294 ADC CHAIN 03 - PROCESS A PROGRAM CHAIN A3000295 SPC 2 A3000296FUNIDX ADC 0 LOG-IN FUNCTION INDEX A3000297 EJT A3000298* L O G - I N P R O C E S S O R A3000299 SPC 2 A3000300LOGIN LDA- PORTNO,I OBTAIN AND SAVE THE TERMINAL NUMBER A3000301 CLR Q A3000302 DVI- TEN A3000303 QLS 8 CONVERT THE TERMINAL NUMBER TO ASCII A3000304 LLS 8 A3000305 ADD =A00 A3000306 STA MESG03+6 PLACE IT IN THE MESSAGE A3000307 SPC 1 A3000308 RTJ GETTOD OBTAIN AND SAVE THE CURRENT DATE AND TIME A3000309 SPC 1 A3000310 ENQ 0 CLEAR THE SCREEN A3000311 RTJ MESSAG A3000312 SPC 1 A3000313 RTJ SYSMSG OUTPUT THAT DATE AND TIME A3000314 ADC MSG13 A3000315 ADC DATIM A3000316 SPC 1 A3000317ÐÐ ENQ 1 OUTPUT THE HEADER A3000318 RTJ MESSAG A3000319 SPC 1 A3000320 ENQ 2 OUTPUT THE SYSTEM NAME A3000321 RTJ MESSAG A3000322 SPC 1 A3000323 ENQ 3 OUTPUT THE TERMINAL NUMBER A3000324 RTJ MESSAG A3000325 EJT A3000326 SPC 4 A3000327 LDA+ QPASWD A3000328 SUB =A IS THERE A PASSWORD DEFINED A3000329 SAN LOG010 YES, PROCESS IT A3000330 JMP* LOG020 NO, BYPASS THE PASSWORD INPUT AND CHECK A3000331 SPC 1 A3000332LOG010 RTJ+ WTREAD REQUEST THE PASSWORD A3000333 ADC WTRDLU LOGICAL UNIT A3000334 ADC MINONE X-Y POSITION (NULL) A3000335 ADC WTRD01 OUTPUT MESSAGE A3000336 ADC WTRDL1 OUTPUT MESSAGE LENGTH A3000337 ADC MINONE X-Y POSITION (NULL) A3000338 ADC TEMPBF INPUT BUFFER A3000339 ADC N18 INPUT LENGTH - CHARACTERS A3000340 ADC TCODE TERMINATION CODE A3000341 SPC 1 A3000342ÐÐ RTJ INPUT FORMAT THE INPUT A3000343 SPC 1 A3000344 RTJ COMPAR DOES THE PASSWORD MATCH A3000345 ADC QPASWD A3000346 SAZ LOG020 YES A3000347 SPC 1 A3000348 JMP LOGOFF NO, PASSWORD ERROR, LOG THE USER OFF. A3000349 EJT A3000350 SPC 4 A3000351LOG020 RTJ+ WTREAD REQUEST THE USER IDENTIFICATION A3000352 ADC WTRDLU LOGICAL UNIT A3000353 ADC MINONE X-Y POSITION (NULL) A3000354 ADC WTRD02 OUTPUT MESSAGE A3000355 ADC WTRDL2 OUTPUT MESSAGE LENGTH A3000356 ADC MINONE X-Y POSITION (NULL) A3000357 ADC TEMPBF INPUT BUFFER A3000358 ADC N18 INPUT LENGTH - CHARACTERS A3000359 ADC TCODE TERMINATION CODE A3000360 SPC 1 A3000361 ENA 0 A3000362 STA- LOKLEN,I A3000363 RTJ INPUT FORMAT THE INPUT A3000364 SPC 1 A3000365 SPC 1 A3000366 RTJ COMPAR IS THE IDENTIFICATION THE SYSTEM OPERATOR A3000367ÐÐ ADC OPID A3000368 ADD- PORTNO,I IT IS LEGAL ONLY FROM THE MASTER TERMINAL A3000369 SAZ LOG030 YES A3000370 SPC 1 A3000371 RTJ USRFIL IS THE IDENTIFICATION IN THE USER ID FILE A3000372 SAZ LOG030 YES A3000373 SPC 1 A3000374 JMP LOGOFF NO, INDICATE ILLEGAL LOG-IN. A3000375 SPC 1 A3000376LOG030 ENQ 3 A3000377 SPC 1 A3000378LOG040 LDA TEMPBF,Q MOVE THE USER IDENTIFICATION A3000379 STA- TMUSID,B TO THE LINKAGE BUFFER A3000380 DQP *-LOG040 A3000381 SPC 1 A3000382LOG050 JMP* SYSNXT REQUEST THE USER PROGRAM A3000383 EJT A3000384 SPC 4 A3000385* D A T A A N D S T O R A G E A3000386 SPC 1 A3000387ERRFLG NUM 0 LOG-IN ERROR INDICATOR A3000388FLAG NUM 0 MANUAL INTERRUPT INDICATOR A3000389COMMNT NUM 0 PROCEDURE COMMENT INDICATOR A3000390AEXIT ADC EXIT EXIT FUNCTION ADDRESS A3000391WTRDLU ADC TERMLU WRITE-READ LOGICAL UNIT A3000392ÐÐWTRDL1 ADC 2*LWTR01 WRITE-READ MESSAGE LENGTH 1 A3000393WTRDL2 ADC 2*LWTR02 WRITE-READ MESSAGE LENGTH 2 A3000394WTRDL3 ADC 2*LWTR03 WRITE-READ MESSAGE LENGTH 3 A3000395N18 NUM 18 WRITE-READ INPUT LENGTH 3 A3000396MSG13 ADC M13 SYSTEM MESSAGE INDEX 13 A3000397MSG14 ADC M14 SYSTEM MESSAGE INDEX 14 A3000398MSG24 ADC E24 SYSTEM ERROR INDEX 24 A3000399TCODE NUM 0 WRITE-READ TERMINATION CODE A3000400LOGUNT NUM 0 PROCEDURE LOGICAL UNIT A3000401ISTAT1 NUM 0 FILE MANAGER RETURN STATUS A3000402ISTAT2 NUM 0 FILE MANAGER RETURN STATUS A3000403WRDINP NUM 0 NUMBER OF WORDS INPUT A3000404MNUTMP NUM 0 TEMPORARY STORAGE - MENU KEY MNEMONIC A3000405 SPC 1 A3000406NOID ALF 4, A3000407OPID ALF 4,$$ A3000408EXRQ ALF 4,EX A3000409LSRQ ALF 4,? A3000410 EJT A3000411 SPC 4 A3000412* U S E R P R O G R A M C O M P L E T I O N A3000413 SPC 2 A3000414SYSTEM RTJ CLOSE CLOSE ANY OPEN USER FILES A3000415SYSERR RTJ IOFILE OPEN/POSITION ANY DECLARED I/O FILES A3000416 LDA- PGMIDX,I IS THE USER PROGRAM THE LOG-IN PROCESSOR A3000417ÐÐ SAN SYSMOD NO A3000418 JMP EXIT YES, EXIT A3000419 SPC 1 A3000420SYSMOD LDA- USMODE,I IS THE PROGRAM IN STREAM MODE A3000421 SAN SYS020 YES A3000422 JMP* SYSNXT NO, REQUEST THE NEXT PROGRAM A3000423 SPC 1 A3000424SYS020 LDA- MENUKY,I SAVE THE FUNCTION MENU KEY A3000425 STA* MNUTMP A3000426 SPC 1 A3000427SYSTRM LDA =XPFNAME A3000428 ADD- I A = ADDRESS OF THE PROCEDURE NAME A3000429 STA* SYSPR1 A3000430 RTJ+ LUNEQ OBTAIN THE EQUIVALENT LOGICAL UNIT A3000431SYSPR1 ADC 0 A3000432 ADC LOGUNT A3000433 SPC 1 A3000434SYS030 LDA* LOGUNT A3000435 RTJ GETREC OBTAIN THE NEXT PROCEDURE RECORD A3000436 SPC 1 A3000437 SAZ SYS035 SKIP IF THE PROCESURE IS EMPTY A3000438 LDA BUFFER A3000439 SUB =XFMEOFC IS THE RECORD AN END-OF-FILE A3000440 SAN SYS040 NO, CONTINUE A3000441SYS035 STA- USMODE,I YES, RETURN TO INTERACTIVE MODE A3000442ÐÐ JMP* SYSNXT THE PROCEDURE IS EMPTY A3000443 EJT A3000444 SPC 4 A3000445SYS040 LDA BUFFER A3000446 SUB =A * IS THE RECORD A PROCEDURE COMMENT A3000447 SAN SYS060 NO A3000448 LDA* COMMNT YES, HAS A COMMENT ALREADY BEEN DISPLAYED A3000449 SAN SYS050 YES A3000450 ENQ 0 NO, CLEAR THE SCREEN A3000451 RTJ MESSAG A3000452SYS050 ENQ 4 A3000453 STQ* COMMNT A3000454 RTJ MESSAG A3000455 JMP* SYS030 OBTAIN THE NEXT RECORD A3000456 SPC 1 A3000457SYS060 ENQ TMBFSZ-1 A3000458SYS070 LDA BUFFER,Q MOVE THE PROCEDURE RECORD A3000459 STA TEMPBF,Q TO THE INPUT BUFFER A3000460 INQ -1 A3000461 SQM SYS080 A3000462 JMP* SYS070 A3000463 SPC 1 A3000464SYS080 JMP* SYSFND CONTINUE A3000465 EJT A3000466 SPC 4 A3000467ÐÐ* O B T A I N T H E N E X T F U N C T I O N A3000468 SPC 2 A3000469SYSNXT ENA 0 CLEAR THE MENU KEY. A3000470 STA- MENUKY,I A3000471 STA MNUTMP A3000472 LDA- LOKLEN,I A3000473 SAZ SYSNX5 SKIP IF NO FORCED PROGRAM EXECUTION A3000474* IS SPECIFIED. A3000475 ENQ 3 A3000476SYSNX3 LDA- LOKNAM,B MOVE THE SPECIFIED PROGRAM NAME A3000477 STA TEMPBF,Q TO THE INPUT BUFFER. A3000478 DQP *-SYSNX3 A3000479 LDA- LOKLEN,I FAKE THE NUMBER OF CHARACTERS INPUT. A3000480 STA INPLEN A3000481 JMP* SYSNX9 A3000482SYSNX5 RTJ+ WTREAD REQUEST THE FUNCTION NAME. A3000483 ADC WTRDLU LOGICAL UNIT A3000484 ADC MINONE X-Y POSITION (NULL) A3000485 ADC WTRD03 OUTPUT MESSAGE A3000486 ADC WTRDL3 OUTPUT MESSAGE LENGTH A3000487 ADC MINONE X-Y POSITION (NULL) A3000488 ADC TEMPBF INPUT BUFFER A3000489 ADC N18 INPUT LENGTH - CHARACTERS A3000490 ADC TCODE TERMINATION CODE A3000491 SPC 1 A3000492ÐÐSYSNX9 RTJ INPUT FORMAT THE INPUT. A3000493 STQ* WRDINP SAVE THE NUMBER OF WORDS INPUT A3000494 SPC 1 A3000495SYSFND RTJ COMPAR WAS AN EXIT REQUESTED A3000496 ADC EXRQ A3000497 SAN SYS110 NO A3000498 JMP EXIT YES A3000499 SPC 1 A3000500SYS110 RTJ COMPAR WAS A FUNCTION MENU REQUESTED A3000501 ADC LSRQ A3000502 SAN SYS120 NO A3000503 JMP LIST YES A3000504 SPC 1 A3000505SYS120 RTJ IOEQAL WAS INPUT OR OUTPUT EQUAL REQUESTED A3000506 SAN SYS130 NO A3000507 JMP* SYSMOD YES, CONTINUE A3000508 SPC 1 A3000509SYS130 LDA* WRDINP A3000510 INA -1 WAS A 1-WORD REQUEST ENTERED A3000511 SAN SYS140 NO A3000512 RTJ PRMENU YES, USE THE SYSTEM MENU FOR THE REQUEST A3000513 EJT A3000514 SPC 4 A3000515SYS140 RTJ OPEN OPEN THE PROGRAM NAME FILE A3000516 ADC PGMNAM A3000517ÐÐ SPC 1 A3000518 RTJ+ READR LOOK FOR THE ENTRY IN THE PGM. NAME FILE A3000519 ADC REQBUF A3000520 ADC BUFFER A3000521 ADC KEYVAL A3000522 ADC ISTAT1 A3000523 SPC 1 A3000524 RTJ+ CLOSFL CLOSE THE PROGRAM NAME FILE A3000525 ADC REQBUF A3000526 ADC ISTAT2 A3000527 LDA ISTAT2 A3000528 RTJ CKSTAT CHECK FOR FILE ERRORS A3000529 NUM $FFFF A3000530 NUM 1 A3000531 SPC 1 A3000532 LDA ISTAT1 WAS THE PROGRAM FOUND A3000533 SAZ SYS150 YES A3000534 RTJ CKSTAT NO, CHECK FOR FILE ERRORS A3000535 NUM $60F4 A3000536 NUM 2 A3000537 JMP* SYS200 NO ERRORS, CONTINUE A3000538 SPC 1 A3000539SYS150 ENA -1 A3000540 STA- TMPGMX,I SPECIFY THE PROGRAM INDEX A3000541 ENQ 2 A3000542ÐÐSYS160 LDA BUFFER+3,Q MOVE THE PROGRAM SECTOR AND LENGTH A3000543 STA- TMSECT,B TO THE LINKAGE BUFFER A3000544 INQ -1 A3000545 SQM SYS170 A3000546 JMP* SYS160 A3000547 SPC 1 A3000548SYS170 LDA- TMPLEN,I A = PROGRAM LENGTH A3000549 RTJ SIZECK IS THE PROGRAM TOO LARGE A3000550 SAP SYS180 NO A3000551 ENQ E18 YES, INDICATE AN ERROR A3000552 RTJ* ERRPR2 A3000553 JMP* SYSNXT REQUEST ANOTHER FUNCTION A3000554 SPC 1 A3000555SYS180 JMP* SYSXIT INITIATE THE REQUESTED PROGRAM A3000556 EJT A3000557 SPC 4 A3000558SYS200 RTJ OPEN OPEN THE PROCEDURE DIRECTORY FILE A3000559 ADC PRODIR A3000560 SPC 1 A3000561 RTJ+ READR LOOK FOR THE ENTRY IN THE PROCEDURE DIR. FILE A3000562 ADC REQBUF A3000563 ADC BUFFER A3000564 ADC KEYVAL A3000565SYSST1 ADC ISTAT1 A3000566 SPC 1 A3000567ÐÐ RTJ+ CLOSFL CLOSE THE PROCEDURE DIRECTORY FILE A3000568 ADC REQBUF A3000569SYSST2 ADC ISTAT2 A3000570 LDA* (SYSST2) A3000571 RTJ CKSTAT CHECK FOR FILE ERRORS A3000572 NUM $FFFF A3000573 NUM 1 A3000574 SPC 1 A3000575 LDA* (SYSST1) WAS THE PROCEDURE FOUND A3000576 SAZ SYS210 YES A3000577 RTJ CKSTAT NO, CHECK FOR FILE ERRORS A3000578 NUM $60F4 A3000579 NUM 2 A3000580 JMP* SYS300 NO ERRORS, CONTINUE A3000581 SPC 1 A3000582SYS210 ENQ 3 A3000583 SPC 1 A3000584SYS220 LDA BUFFER+5,Q MOVE THE PROCEDURE NAME A3000585 STA- PFNAME,B TO THE LINKAGE BUFFER A3000586 INQ -1 A3000587 SQM SYS230 A3000588 JMP* SYS220 A3000589 EJT A3000590 SPC 4 A3000591SYS230 LDA =XUSABRT A3000592ÐÐ ADD- I A3000593 STA- USMODE,I SPECIFY PROCEDURE STREAM MODE A3000594 SPC 1 A3000595 RTJ+ INPEQ SPECIFY THE PROCEDURE FILE A3000596 ADC BUFFER+5 A3000597 ADC ISTAT1 A3000598 SPC 1 A3000599 LDA* (SYSST1) IS THE FILE LEGAL A3000600 SAZ SYS240 YES A3000601 SPC 1 A3000602 RTJ+ SYSMSG NO, INDICATE AN ERROR A3000603 ADC MSG24 A3000604 ADC BUFFER+5 A3000605 SPC 1 A3000606 ENA 0 RETURN TO INTERACTIVE MODE A3000607 STA- USMODE,I A3000608 JMP SYSNXT A3000609 SPC 1 A3000610SYS240 ENA 0 A3000611 STA- FIRCNO+1,I INITIALIZE THE FILES RECORD NUMBER A3000612 ENQ 0 A3000613 RTJ+ PGLUNT RETURN INPUT TO THE TERMINAL A3000614 SPC 1 A3000615 JMP SYSTRM PROCESS THE PROCEDURE STREAM A3000616 EJT A3000617ÐÐ SPC 4 A3000618SYS300 RTJ LIBSCH SEARCH THE PROGRAM LIBRARY FOR THE PROGRAM A3000619 SAN SYS310 PROGRAM FOUND A3000620 SPC 1 A3000621 ENQ E17 INDICATE THE REQUEST CANNOT BE FOUND A3000622 RTJ* ERRPR2 A3000623 JMP SYSNXT REQUEST ANOTHER FUNCTION A3000624 SPC 1 A3000625SYS310 LDA- TMPLEN,I A = PROGRAM LENGTH A3000626 RTJ SIZECK IS THE PROGRAM TOO LARGE A3000627 SAP SYSXIT NO A3000628 SPC 1 A3000629 ENQ E18 YES, INDICATE AN ERROR A3000630 RTJ* ERRPR2 A3000631 JMP SYSNXT REQUEST ANOTHER FUNCTION A3000632 SPC 1 A3000633 SPC 1 A3000634LOGOFF ENQ E16 INDICATE ILLEGAL LOGIN. A3000635 ENA 0 A3000636 RTJ* ERRPR1 A3000637 JMP* EXIT GO LOG THE USER OFF A3000638 SPC 1 A3000639SYSXIT RTJ+ PGMINT DISABLE THE PROGRAM INTERRUPT. A3000640 ADC ZERO A3000641 ADC 0 A3000642ÐÐ SPC 1 A3000643 LDA MNUTMP A3000644 STA- MENUKY,I SET UP THE FUNCTION MENU KEY A3000645 SPC 1 A3000646 ENQ 1 SET UP THE PGMOUT REQUEST INDEX A3000647 RTJ+ PGMOUT RETURN CONTROL TO THE EXECUTIVE A3000648 EJT A3000649 SPC 4 A3000650* E R R O R M E S S A G E P R O C E S S O R A3000651 SPC 2 A3000652ERROR RTJ CLOSE CLOSE ANY OPEN USER FILES A3000653 SPC 1 A3000654 LDQ- ERRIDX,I OBTAIN THE ERROR MESSAGE INDEX A3000655 LDA- ERRADD,I AND THE ADDRESS FROM THE LINKAGE BUFFER A3000656 RTJ* ERRPR1 PROCESS THE MESSAGE A3000657 SPC 1 A3000658 LDA+ TSNABL IS THE SYSTEM ENABLED A3000659 SAP ERR010 YES A3000660 LDA- PORTNO,I NO, IS THIS THE MASTER TERMINAL A3000661 SAZ ERR010 YES, CONTINUE A3000662 SPC 1 A3000663 ENQ 6 NO, DISPLAY THE 'OFF UNTIL' MESSAGE A3000664 RTJ MESSAG A3000665 JMP* EXIOFF AND LOG OFF A3000666 SPC 1 A3000667ÐÐERR010 JMP SYSERR REQUEST ANOTHER SYSTEM A3000668 EJT A3000669 SPC 4 A3000670* T S L O G E R R O R M E S S A G E S U B R O U T I N E S A3000671 SPC 2 A3000672ERRPR1 NOP 0 A3000673 STQ* MSGNUM SAVE THE MESSAGE NUMBER A3000674 STA* ERRLOC AND THE MESSAGE DATA A3000675 SPC 1 A3000676 RTJ+ SYSMSG OUTPUT THE ERROR MESSAGE A3000677 ADC MSGNUM A3000678 ADC ERRLOC A3000679 SPC 1 A3000680 ENA 0 RETURN TO INTERACTIVE MODE A3000681 STA- USMODE,I A3000682 RAO- USABRT,I INDICATE A JOB ABORT A3000683 SPC 1 A3000684 JMP* (ERRPR1) RETURN A3000685 SPC 2 A3000686ERRPR2 NOP 0 A3000687 STQ* MSGNUM SAVE THE MESSAGE NUMBER A3000688 SPC 1 A3000689 RTJ+ SYSMSG OUTPUT THE ERROR MESSAGE A3000690 ADC MSGNUM A3000691 ADC TEMPBF A3000692ÐÐ SPC 1 A3000693 ENA 0 A3000694 STA- USMODE,I RETURN TO INTERACTIVE MODE A3000695 RAO- USABRT,I INDICATE A JOB ABORT A3000696 SPC 1 A3000697 JMP* (ERRPR2) RETURN A3000698 SPC 2 A3000699MSGNUM NUM 0 ERROR MESSAGE INDEX A3000700ERRLOC NUM 0 ERROR LOCATION A3000701 EJT A3000702 SPC 4 A3000703* L O G - O U T P R O C E S S O R A3000704 SPC 2 A3000705EXIT RTJ ENTDAY ENTER THE USER IN THE DAY FILE A3000706 SPC 1 A3000707EXIERR RTJ GETTOD OBTAIN AND SAVE THE DATE AND TIME A3000708 RTJ SYSMSG OUTPUT THE LOG-OFF MESSAGE A3000709 ADC MSG14 A3000710 ADC DATIM+6 A3000711 SPC 1 A3000712EXIOFF RTJ CLOSE CLOSE ALL USER FILES A3000713 SPC 1 A3000714 ENQ 0 INDICATE A FINAL EXIT A3000715 RTJ+ PGMOUT RETURN CONTROL TO THE EXECUTIVE A3000716 EJT A3000717ÐÐ SPC 4 A3000718* L I S T A L L S T A N D A R D F U N C T I O N S A3000719 SPC 2 A3000720LIST RTJ OPEN OPEN THE SYSTEM MENU FILE A3000721 ADC SYMENU A3000722 SPC 1 A3000723 ENQ 0 CLEAR THE SCREEN A3000724 RTJ MESSAG A3000725 SPC 1 A3000726LIS010 RTJ+ GETS OBTAIN THE NEXT MENU RECORD A3000727 ADC REQBUF A3000728 ADC RECBUF A3000729 ADC ZERO A3000730LISST1 ADC ISTAT1 A3000731 SPC 1 A3000732 LDA* (LISST1) IS THE FILE EMPTY A3000733 SAZ LIS020 NO, DISPLAY THE RECORD A3000734 RTJ CKSTAT YES, CHECK FOR FILE ERRORS A3000735 NUM $60F1 A3000736 NUM 3 A3000737 JMP* LIS030 NO ERRORS, RETURN A3000738 SPC 1 A3000739LIS020 ENQ 5 DISPLAY THE MENU RECORD A3000740 RTJ MESSAG A3000741 JMP* LIS010 CONTINUE A3000742ÐÐ SPC 1 A3000743LIS030 RTJ+ CLOSFL CLOSE THE SYSTEM MENU FILE A3000744 ADC REQBUF A3000745 ADC ISTAT1 A3000746 LDA* (LISST1) A3000747 RTJ CKSTAT CHECK FOR FILE ERRORS A3000748 NUM $FFFF A3000749 NUM 1 A3000750 SPC 1 A3000751 JMP SYSMOD REQUEST ANOTHER FUNCTION A3000752 EJT A3000753 SPC 4 A3000754* P R O C E S S A P R O G R A M C H A I N R E Q U E S T A3000755 SPC 2 A3000756CHAIN RTJ CLOSE CLOSE ANY OPEN USER FILES A3000757 SPC 1 A3000758 ENQ 3 A3000759 SPC 1 A3000760CHA010 LDA- CHNAME,B MOVE THE REQUESTED PROGRAM NAME A3000761 STA TEMPBF,Q TO THE INPUT BUFFER A3000762 INQ -1 A3000763 SQM CHA020 A3000764 JMP* CHA010 A3000765 SPC 1 A3000766CHA020 LDA- MENUKY,I SET UP THE FUNCTION MENU KEY A3000767ÐÐ STA MNUTMP A3000768 SPC 1 A3000769 JMP SYSFND CONTINUE A3000770 EJT A3000771 SPC 4 A3000772* R E T R I E V E T H E P R O G R A M A3000773 SPC 2 A3000774LIBSCH NOP 0 A3000775 SPC 1 A3000776 LDA- $C4 INITIALIZE THE PROGRAM LIBRARY SECTOR A3000777 SPC 1 A3000778LIB010 STA* SECADD SET UP THE DIRECTORY SECTOR A3000779 SPC 1 A3000780 RTJ- (AMONI) PERFORM THE TRANSFER A3000781 ADC $4844 FORMATTED READ A3000782 ADC 0 A3000783 ADC 0 A3000784 ADC $08C2 A3000785N96 ADC 96 A3000786 ADC BUFFER A3000787 ADC 0 A3000788SECADD ADC 0 A3000789 SPC 1 A3000790 ENQ 85 A3000791LIB020 LDA BUFFER,Q A3000792ÐÐ SUB* TEMPBF DOES THE NAME MATCH A3000793 SAN LIB030 NO A3000794 LDA BUFFER+1,Q A3000795 SUB* TEMPBF+1 A3000796 SAN LIB030 NO A3000797 LDA BUFFER+2,Q A3000798 SUB* TEMPBF+2 A3000799 SAZ LIB060 YES A3000800 SPC 1 A3000801LIB030 INQ -5 IS THE SEARCH OF THIS SECTOR COMPLETE A3000802 SQM LIB040 YES A3000803 JMP* LIB020 NO, CONTINUE A3000804 SPC 1 A3000805LIB040 LDA BUFFER+95 OBTAIN THE NEXT DIRECTORY SECTOR A3000806 INA 0 IS THIS THE END A3000807 SAZ LIB050 YES A3000808 JMP* LIB010 NO, GET THE NEXT SECTOR A3000809 SPC 1 A3000810LIB050 JMP* (LIBSCH) PROGRAM NOT FOUND, RETURN A3000811 EJT A3000812 SPC 4 A3000813LIB060 LDA BUFFER+3,Q IS THE PROGRAM IN FILE FORMAT A3000814 SAM LIB070 YES A3000815 JMP* LIB030 NO, CONTINUE A3000816 SPC 1 A3000817ÐÐLIB070 LDA BUFFER+4,Q A3000818 STA- TMSECT+1,I SAVE THE PROGRAM SECTOR LSB A3000819 SPC 1 A3000820 LDA- ONEBIT+15 A3000821 STA- TMSECT+0,I SPECIFY CONTROL POINT ACCESS A3000822 SPC 1 A3000823 LDA BUFFER+3,Q A3000824 TCA A A3000825 MUI* N96 CALCULATE THE PROGRAM LENGTH A3000826 STA- TMPLEN,I AND SAVE A3000827 SPC 1 A3000828 ENA -1 A3000829 STA- TMPGMX,I SPECIFY THE PROGRAM INDEX A3000830 SPC 1 A3000831 JMP* (LIBSCH) RETURN A3000832 EJT A3000833 SPC 4 A3000834* A3000835* GETTOD SUBROUTINE USED TO OBTAIN THE CURRENT DATE A3000836* ------ AND TIME A3000837* A3000838 SPC 2 A3000839GETTOD NOP 0 A3000840 SPC 1 A3000841 LDQ+ MONTO OBTAIN THE CURRENT MONTH A3000842ÐÐ INQ -1 A3000843 QLS 1 CALCULATE THE INDEX INTO THE MONTHS TABLE A3000844 LDA* MONTHS,Q A3000845 STA* DATIM SPECIFY THE MONTH A3000846 LDA* MONTHS+1,Q A3000847 STA* DATIM+1 A3000848 LDQ =XYERTO A3000849 LDA- 2,Q A3000850 STA* DATIM+3 SPECIFY THE DAY A3000851 LDA- (ZERO),Q A3000852 STA* DATIM+5 SPECIFY THE YEAR A3000853 LDA- 3,Q A3000854 STA* DATIM+7 SPECIFY THE HOUR A3000855 LDA- 4,Q A3000856 STA* DATIM+9 SPECIFY THE MINUTE A3000857 LDA- 5,Q A3000858 STA* DATIM+11 SPECIFY THE SECOND A3000859 SPC 1 A3000860 JMP* (GETTOD) RETURN A3000861 EJT A3000862 SPC 4 A3000863* M O N T H N A M E T A B L E A3000864 SPC 2 A3000865MONTHS ALF $,JAN FEB MAR APR MAY JUN $ A3000866 ALF $,JUL AUG SEP OCT NOV DEC $ A3000867ÐÐ EJT A3000868 SPC 4 A3000869* D A T A C O M P A R E R O U T I N E A3000870* A3000871* EXIT CONDITIONS: A3000872* A = 0 IF A MATCH IS FOUND. A3000873* A NOT = 0 IF A MATCH IS NOT FOUND. A3000874 SPC 2 A3000875COMPAR NOP 0 A3000876 SPC 1 A3000877 LDQ* (COMPAR) Q = ADDRESS OF COMPARISON DATA A3000878 LDA* TEMPBF A3000879 SPC 1 A3000880 SUB- (ZERO),Q DOES THE 1ST WORD MATCH A3000881 SAN COM010 NO A3000882 LDA* TEMPBF+1 A3000883 SUB- 1,Q DOES THE 2ND WORD MATCH A3000884 SAN COM010 NO A3000885 LDA* TEMPBF+2 A3000886 SUB- 2,Q DOES THE 3RD WORD MATCH A3000887 SAN COM010 NO A3000888 LDA* TEMPBF+3 A3000889 SUB- 3,Q DOES THE 4TH WORD MATCH A3000890 SPC 1 A3000891COM010 RAO* COMPAR A3000892ÐÐ JMP* (COMPAR) RETURN A3000893 EJT A3000894 SPC 4 A3000895* I N P U T F O R M A T S U B R O U T I N E A3000896 SPC 2 A3000897INPUT NOP 0 A3000898 SPC 1 A3000899 ENA 0 A3000900 STA* INPTMP INITIALIZE THE RETURN PARAMETER A3000901 SPC 1 A3000902 LDQ* INPLEN OBTAIN THE NUMBER OF CHARACTERS A3000903 LRS 1 WERE AN EVEN NUMBER ENTERED A3000904 SAP INP010 YES A3000905 SPC 1 A3000906 LDA* TEMPBF,Q NO A3000907 AND- NZERO+8 A3000908 INA SPACE MERGE A BLANK A3000909 STA* TEMPBF,Q A3000910 INQ 1 A3000911 SPC 1 A3000912INP010 STQ* INPTMP Q = NUMBER OF WORDS INPUT A3000913 SPC 1 A3000914INP020 LDA =A BLANK FILL THE REMAINDER OF THE INPUT A3000915 STA* TEMPBF,Q A3000916 INQ 1 A3000917ÐÐ TRQ A A3000918 INA -TMBFSZ A3000919 SAP INP040 A3000920 JMP* INP020 A3000921 SPC 1 A3000922INP040 LDQ* INPTMP Q = NUMBER OF WORDS ENTERED A3000923 JMP* (INPUT) RETURN A3000924 SPC 2 A3000925INPTMP NUM 0 TEMPORARY STORAGE - NUMBER OF INPUT WORDS A3000926 EJT A3000927 SPC 4 A3000928* D A T A A N D S T O R A G E A3000929 SPC 2 A3000930TEMPBF BZS TEMPBF(9) TEMPORARY STORAGE OF INPUT DATA A3000931 EQU TMBFSZ(*-TEMPBF) A3000932INPLEN NUM 0 NUMBER OF INPUT CHARACTERS A3000933 SPC 2 A3000934DATIM BZS DATIM(12) TEMPORARY STORAGE OF DATE AND TIME A3000935 SPC 4 A3000936* S Y S T E M F I L E P A R A M E T E R S A3000937 SPC 2 A3000938PGMNAM ALF 4,$$PGMNAM OPEN FILE DATA - PROGRAM NAME FILE A3000939 ADC 1 INDEXED FILE A3000940PRODIR ALF 4,$$PROCED OPEN FILE DATA - PROCEDURE DIRECTORY FILE A3000941 ADC 1 INDEXED FILE A3000942ÐÐSYMENU ALF 4,$$SYMENU OPEN FILE DATA - SYSTEM MENU FILE A3000943 ADC 0 SEQUENTIAL FILE A3000944DAYFIL ALF 4,$$DAYFIL OPEN FILE DATA - DAY FILE A3000945 ADC 0 SEQUENTIAL FILE A3000946USRIDN ALF 4,$$USERID OPEN FILE DATA - USER IDENTIFICATION FILE A3000947 ADC 1 INDEXED FILE. A3000948 EJT A3000949 SPC 4 A3000950* A3000951* ENTDAY SUBROUTINE USED TO PLACE AN ENTRY IN THE A3000952* ------ DAYFILE A3000953* A3000954 SPC 2 A3000955ENTDAY NOP 0 A3000956 SPC 1 A3000957 LDA* DAYFLG HAS THE DAYFILE ALREADY BEEN UPDATED A3000958 SAN ENT010 YES A3000959 LDQ- ULUSTB,I NO A3000960 LDA- USERID,Q HAS THE USER LOGGED IN YET A3000961 SAZ ENT010 NO, RETURN A3000962 LDA- PGMIDX,I WAS TSLOG ABORTED A3000963 SAN ENT015 NO, CONTINUE A3000964 SPC 1 A3000965ENT010 JMP* (ENTDAY) YES, RETURN A3000966 SPC 1 A3000967ÐÐENT015 RAO* DAYFLG A3000968 SPC 1 A3000969 ENQ DATIME OBTAIN THE ADDRESS OF THE DATE-TIME A3000970 LDA- 1,B A3000971 SAN ENT020 A3000972 JMP* ENT070 NO TIME HAS BEEN SET UP A3000973 SPC 1 A3000974ENT020 STA* RECBUF+4 SAVE THE MONTH OF LOG-IN A3000975 LDA- 2,B A3000976 STA* RECBUF+5 SAVE THE DAY OF LOG-IN A3000977 LDA- (ZERO),B A3000978 STA* RECBUF+6 SAVE THE YEAR OF LOG-IN A3000979 LDA- 3,B A3000980 STA* RECBUF+7 SAVE THE HOUR OF LOG-IN A3000981 LDA- 4,B A3000982 STA* RECBUF+8 SAVE THE MINUTE OF LOG-IN A3000983 LDA- 5,B A3000984 STA* RECBUF+9 SAVE THE SECOND OF LOG-IN A3000985 SPC 1 A3000986 LDA* RECBUF+6 A3000987 ARS 2 CHECK FOR LEAP YEAR A3000988 ALS 2 A3000989 TCA A A3000990 ADD* RECBUF+6 A3000991 SAZ ENT030 A3000992ÐÐ RAO* MONTAB+1 LEAP YEAR, CHANGE FEBRUARY TO 29 A3000993 EJT A3000994ENT030 LDA+ YERTO A3000995 SUB* RECBUF+6 CALCULATE THE YEAR INCREMENT A3000996 MUI* N12 CONVERT TO MONTHS A3000997 ADD+ MONTO A3000998 SUB* RECBUF+4 CALCULATE THE MONTH INCREMENT A3000999 LDQ* RECBUF+4 A3001000 MUI* MONTAB-1,Q CONVERT TO DAYS A3001001 ADD+ DAYTO A3001002 SUB* RECBUF+5 CALCULATE THE DAY INCREMENT A3001003 MUI* N24 CONVERT TO HOURS A3001004 ADD+ HORTO A3001005 SUB* RECBUF+7 CALCULATE THE HOUR INCREMENT A3001006 MUI* N60 CONVERT TO MINUTES A3001007 ADD+ MINTO A3001008 SUB* RECBUF+8 CALCULATE THE MINUTES INCREMENT A3001009 MUI- TEN CONVERT TO TENTHS OF MINUTES A3001010 STA* RECBUF+10 SAVE THE CONNECT TIME A3001011 SPC 1 A3001012 LDA+ SECON A3001013 SUB* RECBUF+9 IS THE SECONDS DIFFERENTIAL NEGATIVE A3001014 SAP ENT040 NO A3001015 STA* NEGSEC YES, SET INDICATOR A3001016 TCA A A3001017ÐÐ SPC 1 A3001018ENT040 CLR Q A3001019 DVI- SIX CONVERT TO TENTHS OF MINUTES A3001020 INQ -3 IS ROUNDING REQUIRED A3001021 SQM ENT050 NO A3001022 SPC 1 A3001023 INA 1 YES A3001024ENT050 LDQ* NEGSEC WAS THE DIFFERENTIAL NEGATIVE A3001025 SQP ENT060 NO A3001026 SPC 1 A3001027 TCA A YES A3001028ENT060 ADD* RECBUF+10 INCLUDE SECONDS IN THE CONNECT TIME A3001029 SAP ENT070 A3001030 LDA- LPMASK+15 INVALID TIME, SET IT TO THE MAXIMUM A3001031 SPC 1 A3001032ENT070 STA* RECBUF+10 SAVE THE CONNECT TIME IN THE DAYFILE A3001033 EJT A3001034 SPC 4 A3001035 LDQ- ULUSTB,I OBTAIN THE USER TABLE ADDRESS A3001036 LDA- USERID,Q A3001037 STA* RECBUF+0 A3001038 LDA- USERID+1,Q A3001039 STA* RECBUF+1 SAVE THE USER NUMBER IN THE DAYFILE A3001040 LDA- USERID+2,Q A3001041 STA* RECBUF+2 A3001042ÐÐ LDA- USERID+3,Q A3001043 STA* RECBUF+3 A3001044 SPC 1 A3001045 LDA- PORTNO,I A3001046 STA* RECBUF+11 SAVE THE TERMINAL NUMBER IN THE DAYFILE A3001047 SPC 1 A3001048 LDA- PGMIDX,I A3001049 STA* RECBUF+12 SAVE THE PROGRAM NUMBER IN THE DAYFILE A3001050 SPC 1 A3001051 RTJ OPEN OPEN THE DAYFILE A3001052 ADC DAYFIL A3001053 SPC 1 A3001054 RTJ+ PUTS ENTER THE USER'S RECORD IN THE DAYFILE A3001055 ADC REQBUF A3001056 ADC RECBUF A3001057 ADC ONE A3001058 ADC ISTAT1 A3001059 SPC 1 A3001060 RTJ+ CLOSFL CLOSE THE DAY FILE A3001061 ADC REQBUF A3001062 ADC ISTAT1 A3001063 SPC 1 A3001064 JMP* (ENTDAY) RETURN A3001065 EJT A3001066 SPC 4 A3001067ÐÐ* D A Y F I L E U P D A T E D A T A A N D S T O R A G E A3001068 SPC 2 A3001069N12 NUM 12 A3001070N24 NUM 24 A3001071N60 NUM 60 A3001072NEGSEC NUM 0 SECONDS DIFFERENTIAL INDICATOR A3001073DAYFLG NUM 0 DAYFILE UPDATE FLAG A3001074 SPC 1 A3001075MONTAB NUM 31 JANUARY A3001076 NUM 28 FEBRUARY A3001077 NUM 31 MARCH A3001078 NUM 30 APRIL A3001079 NUM 31 MAY A3001080 NUM 30 JUNE A3001081 NUM 31 JULY A3001082 NUM 31 AUGUST A3001083 NUM 30 SEPTEMBER A3001084 NUM 31 OCTOBER A3001085 NUM 30 NOVEMBER A3001086 NUM 31 DECEMBER A3001087 SPC 4 A3001088* G E N E R A L D A T A B U F F E R A3001089 SPC 2 A3001090BUFFER BZS BUFFER(96) A3001091 EQU RECBUF(BUFFER+00) A3001092ÐÐ EQU REQBUF(BUFFER+42) A3001093 EQU FCBUFF(BUFFER+66) A3001094 EJT A3001095 SPC 4 A3001096* A3001097* SIZECK SUBROUTINE USED TO DETERMINE THAT THE A3001098* ------ REQUESTED PROGRAM WILL FIT IN A3001099* THE USER AREA A3001100* A3001101 SPC 2 A3001102SIZECK NOP 0 A3001103 SPC 1 A3001104 ADD =XLULBUF INCLUDE THE SIZE OF THE LINKAGE BUFFER A3001105 STA* SIZELN SAVE THE LENGTH A3001106 SPC 1 A3001107 LDQ =XPARTBL A3001108 LDA- 3,Q A3001109 SUB- 1,Q CALCULATE THE SIZE OF THE USER AREA A3001110 SPC 1 A3001111 EOR* SIZELN ARE THE SIGNS ALIKE A3001112 SAP SIZ010 YES A3001113 SPC 1 A3001114 LDA* SIZELN NO, THE SIGN OF SIZELN GIVES THE RELATIONSHIP A3001115 JMP* (SIZECK) A3001116 SPC 1 A3001117ÐÐSIZ010 EOR* SIZELN RESTORE THE AREA SIZE A3001118 SUB* SIZELN CALCULATE THE DIFFERENCE A3001119 JMP* (SIZECK) RETURN A3001120 SPC 2 A3001121SIZELN ADC 0 PROGRAM LENGTH A3001122 EJT A3001123* O P E N F I L E S U B R O U T I N E A3001124 SPC 2 A3001125OPEN NOP 0 A3001126 LDA* (OPEN) A3001127 STA* OPNXFR SET UP THE FILE DATA ADDRESS A3001128 SPC 1 A3001129 ENQ 23 A3001130 ENA 0 A3001131OPN010 STA* REQBUF,Q INITIALIZE THE REQUEST BUFFER A3001132 DQP *-OPN010 A3001133 SPC 1 A3001134OPN020 LDA =XFCBUFF A3001135 STA* REQBUF+9 SPECIFY THE FCB ADDRESS A3001136 SPC 1 A3001137 ENQ 3 A3001138OPN030 LDA* (OPNXFR),Q MOVE THE FILE INFORMATION INTO IDATA A3001139 STA* IDATA,Q A3001140 DQP *-OPN030 A3001141 SPC 1 A3001142ÐÐOPN040 LDQ* OPNXFR A3001143 LDA- 4,Q A3001144 STA* IDATA+12 SPECIFY THE ACCESS TYPE A3001145 SAZ OPN060 SKIP IF THIS IS A SEQUENTIAL FILE A3001146 ENQ 3 A3001147OPN050 LDA TEMPBF,Q MOVE THE KEYVALUE A3001148 STA* KEYVAL,Q A3001149 DQP *-OPN050 A3001150 SPC 1 A3001151OPN060 RTJ+ OPENFL OPEN THE REQUESTED FILE A3001152 ADC REQBUF A3001153 ADC IDATA A3001154OPNST1 ADC ISTAT1 A3001155 LDA* (OPNST1) A3001156 RTJ CKSTAT CHECK FOR FILE ERRORS A3001157 NUM $FC27 A3001158 NUM 0 A3001159 SPC 1 A3001160 RAO* OPEN A3001161 JMP* (OPEN) RETURN A3001162 SPC 2 A3001163OPNXFR ADC 0 FILE DATA SOURCE ADDRESS A3001164 EJT A3001165 SPC 4 A3001166* F I L E R E Q U E S T I D A T A A R R A Y A3001167ÐÐ SPC 2 A3001168ERSTAT ADC 0 FILE ERROR MESSAGE STATUS A3001169IDATA ALF 4, FILE NAME A3001170 ALF 4,$$ OWNER NAME A3001171 ALF 4,SYSVOL VOLUME NAME A3001172 ADC 0 ACCESS TYPE A3001173 ADC 1 NUMBER OF RECORDS A3001174 ADC 0 RECORD LOCK INDICATOR A3001175 SPC 1 A3001176KEYVAL NUM 0,0,0,0 INDEXED FILE KEY VALUE A3001177 EJT A3001178 SPC 4 A3001179* F O R C E F I L E C L O S E S U B R O U T I N E A3001180 SPC 2 A3001181CLOSE NOP 0 A3001182 SPC 1 A3001183 ENQ 23 A3001184 ENA 0 A3001185CLO010 STA REQBUF,Q INITIALIZE THE REQUEST BUFFER A3001186 INQ -1 A3001187 SQM CLO020 A3001188 JMP* CLO010 A3001189 SPC 1 A3001190CLO020 LDA- ULUSTB,I A3001191 STA REQBUF+14 SPECIFY THE USER IDENTIFICATION A3001192ÐÐ SPC 1 A3001193 RTJ+ FCLOSE PERFORM THE FORCE CLOSE A3001194 ADC REQBUF A3001195CLOST1 ADC ISTAT1 A3001196 LDA* (CLOST1) A3001197 RTJ CKSTAT CHECK FOR FILE ERRORS A3001198 NUM $FFFF A3001199 NUM 4 A3001200 SPC 1 A3001201 JMP* (CLOSE) RETURN A3001202 EJT A3001203 SPC 4 A3001204* U S E R I D F I L E P R O C E S S O R A3001205* A3001206* EXIT CONDITIONS: A3001207* A = 0 IF USER ID IS VALID FOR THIS TERMINAL NUMBER. A3001208* LOKNAM IN THE LINKAGE BUFFER GETS PLUGGED A3001209* WITH THE FORCED NAME FROM THE $$USERID FILE A3001210* RECORD FOR THIS USER AND TERMINAL. LOKLEN GETS A3001211* PLUGGED WITH THE NUMBER OF NON BLANK CHARACTERS IN A3001212* THE NAME. A3001213* A3001214* A NOT =0 IF USER ID NOT VALID ON THIS TERMINAL. A3001215* A3001216 SPC 2 A3001217ÐÐUSRFIL NOP 0 A3001218 SPC 1 A3001219 LDA MESG03+6 MOVE THE TERMINAL NUMBER IN ASCII TO A3001220 STA TEMPBF+4 THE INPUT BUFFER. A3001221 ENQ 4 A3001222USR002 LDA TEMPBF,Q A3001223 STA* USRNUM,Q MOVE THE USER ID AND THE TERMINAL NUMBER A3001224 DQP *-USR002 A3001225 SPC 1 A3001226 RTJ OPEN OPEN THE USER IDENTIFICATION FILE A3001227 ADC USRIDN A3001228 SPC 1 A3001229 SPC 1 A3001230 RTJ+ READR OBTAIN THIS TERMINAL'S RECORD A3001231 ADC REQBUF A3001232 ADC RECBUF A3001233 ADC USRNUM CONTAINS USER ID AND ASCII TERMINAL NUMBER. A3001234USRST1 ADC ISTAT1 A3001235 SPC 1 A3001236 LDA* (USRST1) A3001237 AND- ONEBIT+8 IS THIS THE END OF FILE. A3001238 SAZ USR015 NO A3001239 JMP* USR040 YES, INDICATE THE USER ID WAS NOT FOUND A3001240USR015 LDA* (USRST1) A = REQUEST STATUS. A3001241 AND- ONEBIT+9 A3001242ÐÐ SAZ USR020 SKIP IF THE CORRECT RECORD WAS RETRIVED. A3001243 JMP* USR040 ILLEGAL USER ID FOR THIS TERMINAL. A3001244 SPC 1 A3001245USR020 LDA* (USRST1) A = REQUEST STATUS. A3001246 RTJ CKSTAT CHECK FOR FILE ERRORS A3001247 NUM $E0F4 A3001248 NUM 2 A3001249 SPC 1 A3001250* A3001251* THIS USER MAY LOG ONTO THIS TERMINAL. A3001252* A3001253 ENQ 3 A3001254USR025 LDA RECBUF+6,Q A3001255 STA- LOKNAM,B MOVE THE FORCED PROGRAM REQUEST INTO THE A3001256 DQP *-USR025 LINKAGE BUFFER. A BLANK NAME MEANS THAT A3001257* THIS TERMINAL WILL NOT BE FORCED TO A GIVEN A3001258* PROGRAM. THE OPERATOR WILL BE GIVEN THE A3001259* REQUEST = QUERY. A3001260 SPC 2 A3001261 ENQ 0 A3001262USR030 LCA RECBUF+6,Q COUNT THE NUMBER OF NON BLANK CHARACTERS A3001263 INA -$20 IN LOKNAM. THE NAME, IF IT EXISTS, IS A3001264 SAZ USR035 ASSUMED TO BE LEFT JUSTIFIED IN THE FIELD, A3001265 INQ -7 WITH BLANK FILL. THE NAME IS A MAXIMUM OF A3001266 SQZ USR034 8 CHARACTERS LONG. A3001267ÐÐ INQ 8 A3001268 JMP* USR030 A3001269USR034 ENQ 8 A3001270USR035 STQ- LOKLEN,I A3001271 CLR A A3001272 SPC 1 A3001273USR040 STA* USRNUM SAVE THE EXIT PARAMETER. A3001274 SPC 1 A3001275 RTJ+ CLOSFL CLOSE THE USER IDENTIFICATION FILE A3001276 ADC REQBUF A3001277 ADC ISTAT1 A3001278 SPC 1 A3001279 LDA* (USRST1) A3001280 RTJ CKSTAT CHECK FOR FILE ERRORS A3001281 NUM $FFFF A3001282 NUM 1 A3001283 SPC 1 A3001284 LDA* USRNUM A = RETURN PARAMETER. A3001285 JMP* (USRFIL) RETURN A3001286 SPC 2 A3001287USRNUM BZS USRNUM(5) USER ID AND TERMINAL NUMBER IN ASCII. A3001288 EJT A3001289 SPC 4 A3001290* I N P U T - O U T P U T E Q U A L P R O C E S S O R A3001291 SPC 2 A3001292ÐÐIOEQAL NOP 0 A3001293 SPC 1 A3001294 ENA 0 A3001295 STA* IOMODE INITIALIZE THE REQUEST MODE A3001296 SPC 1 A3001297 LDA TEMPBF A3001298 SUB =AIN WAS 'INPUT = ' REQUESTED A3001299 SAZ IOE010 YES A3001300 SPC 1 A3001301 RAO* IOMODE NO A3001302 LDA TEMPBF A3001303 SUB =AOU WAS 'OUTPUT = ' REQUESTED A3001304 SAZ IOE010 YES A3001305 JMP* (IOEQAL) NO, RETURN A3001306 SPC 1 A3001307IOE010 ENQ 0 Q = CHARACTER PICKUP INDEX A3001308 ENA EQUAL A = DESIRED DELIMITER A3001309 RTJ* SCANBF SEARCH FOR THE CHARACTER A3001310 SAP IOE020 A3001311 SPC 1 A3001312 JMP* (IOEQAL) END OF BUFFER, RETURN A3001313 EJT A3001314 SPC 4 A3001315IOE020 ENA 0 A3001316 STA- I A3001317ÐÐ SPC 1 A3001318IOE030 LCA* (IOEBUF),Q RE-POSITION THE DEVICE NAME A3001319 SCA* (IOEBUF),I A3001320 INQ 1 A3001321 RAO- I A3001322 LDA- I A3001323 INA -8 IS THE MOVE COMPLETE A3001324 SAP IOE040 YES A3001325 JMP* IOE030 NO, CONTINUE A3001326 SPC 1 A3001327IOE040 LDA+ TSAREA RESTORE THE I-REGISTER A3001328 STA- I A3001329 LDA* IOMODE IS THE REQUEST FOR 'INPUT = ' A3001330 SAN IOE050 NO A3001331 SPC 1 A3001332 RTJ+ INPEQ PERFORM THE REQUEST A3001333IOEBUF ADC TEMPBF A3001334IOEST1 ADC ISTAT1 A3001335 JMP* IOE060 A3001336 SPC 1 A3001337IOE050 RTJ+ OUTEQ PERFORM THE REQUEST A3001338 ADC TEMPBF A3001339 ADC ISTAT1 A3001340 SPC 1 A3001341IOE060 LDA* (IOEST1) WAS THE REQUEST ACCEPTED A3001342ÐÐ SAN IOE070 NO A3001343 JMP* (IOEQAL) YES, RETURN A3001344 SPC 1 A3001345IOE070 ENQ E17 INDICATE THE NAME CANNOT BE FOUND A3001346 RTJ ERRPR2 A3001347 JMP SYSNXT REQUEST ANOTHER FUNCTION A3001348 SPC 2 A3001349IOMODE NUM 0 TEMPORARY STORAGE - REQUEST MODE A3001350 EJT A3001351 SPC 4 A3001352SCANBF NOP 0 A3001353 STA* DELIMT SAVE THE REQUESTED DELIMITER A3001354 SPC 1 A3001355SCA010 LCA* (IOEBUF),Q A3001356 SUB* DELIMT A3001357 SPC 1 A3001358SCA020 INQ 1 A3001359 SAZ SCA030 SKIP IF THE DELIMITER IS FOUND A3001360 TRQ A A3001361 INA -TMBFSZ*2 IS THE END OF BUFFER REACHED A3001362 SAP SCA040 YES, RETURN WITH ERROR A3001363 JMP* SCA010 CONTINUE A3001364 SPC 1 A3001365SCA030 LCA* (IOEBUF),Q A3001366 INA -SPACE A3001367ÐÐ SAN SCA050 SCAN COMPLETE, RETURN A3001368 JMP* SCA020 IGNORE BLANKS IN THE BUFFER A3001369 SPC 1 A3001370SCA040 ENA -1 INDICATE THE DELIMITER WAS NOT FOUND A3001371SCA050 JMP* (SCANBF) RETURN A3001372 SPC 2 A3001373DELIMT NUM 0 TEMPORARY STORAGE - REQUESTED DELIMITER A3001374 EJT A3001375 SPC 4 A3001376* F I L E E R R O R S T A T U S S U B R O U T I N E A3001377 SPC 2 A3001378CKSTAT NOP 0 A3001379 SPC 1 A3001380 STA ERSTAT SAVE THE FILE STATUS IN CASE OF ERROR A3001381 AND* (CKSTAT) COMPARE THE STATUS TO THE ERROR MASK A3001382 RAO* CKSTAT A3001383 SAZ CKS010 NO FILE ERRORS A3001384 SPC 1 A3001385 LDQ* (CKSTAT) A3001386 LDA* MSGREC,Q OBTAIN THE SYSTEM MESSAGE RECORD A3001387 STA* CKSPAR SAVE A3001388 SPC 1 A3001389 RTJ+ SYSMSG DISPLAY THE FILE ERROR MESSAGE A3001390 ADC CKSPAR A3001391 ADC ERSTAT A3001392ÐÐ SPC 1 A3001393 ENA 0 RETURN TO INTERACTIVE MODE A3001394 STA- USMODE,I A3001395 JMP EXIERR LOG THE USER OFF A3001396 SPC 1 A3001397CKS010 RAO* CKSTAT A3001398 JMP* (CKSTAT) RETURN A3001399 SPC 2 A3001400CKSPAR ADC 0 ERROR MESSAGE INDEX A3001401 SPC 1 A3001402MSGREC ADC E19 00 - OPENFL ERROR A3001403 ADC E20 01 - CLOSFL ERROR A3001404 ADC E21 02 - READR ERROR A3001405 ADC E22 03 - GETS ERROR A3001406 ADC E23 04 - FFCLOS ERROR A3001407 EJT A3001408* S Y S T E M M E N U F I L E P R O C E S S O R A3001409 SPC 2 A3001410PRMENU NOP 0 A3001411 SPC 1 A3001412 RTJ OPEN OPEN THE SYSTEM MENU FILE A3001413 ADC SYMENU A3001414 SPC 1 A3001415PRM010 RTJ+ GETS OBTAIN THE NEXT MENU RECORD A3001416 ADC REQBUF A3001417ÐÐPRECBF ADC RECBUF A3001418 ADC ZERO A3001419PRMST1 ADC ISTAT1 A3001420 SPC 1 A3001421 LDA* (PRMST1) IS THE FILE EMPTY A3001422 SAZ PRM020 NO A3001423 RTJ CKSTAT CHECK FOR FILE ERRORS A3001424 NUM $60F1 A3001425 NUM 3 A3001426 JMP* PRM050 NO ERRORS, RETURN A3001427 SPC 1 A3001428PRM020 ENQ 5 A3001429 LDA* (PRECBF),Q A3001430 SUB TEMPBF DOES THE MENU KEY MATCH A3001431 SAZ PRM030 YES A3001432 JMP* PRM010 NO, CONTINUE A3001433 SPC 1 A3001434PRM030 LDA* (PRECBF),Q SAVE THE REQUESTED MENU KEY A3001435 STA MNUTMP SAVE THE REQUESTED MENU KEY A3001436 ENQ 3 A3001437PRM040 LDA* (PRECBF),Q MOVE THE MENU PROGRAM NAME A3001438 STA TEMPBF,Q TO THE INPUT BUFFER A3001439 INQ -1 A3001440 SQM PRM050 A3001441 JMP* PRM040 A3001442ÐÐ SPC 1 A3001443PRM050 RTJ+ CLOSFL CLOSE THE SYSTEM MENU FILE A3001444 ADC REQBUF A3001445 ADC ISTAT1 A3001446 LDA* (PRMST1) A3001447 RTJ CKSTAT CHECK FOR FILE ERRORS A3001448 NUM $FFFF A3001449 NUM 1 A3001450 SPC 1 A3001451 JMP* (PRMENU) RETURN A3001452 EJT A3001453 SPC 4 A3001454* G E T P R O C E D U R E R E C O R D S U B R O U T I N E A3001455 SPC 2 A3001456GETREC NOP 0 A3001457 SPC 1 A3001458 LDQ- RQINPT,I A3001459 STQ* GERINP SAVE THE CURRENT INPUT DEVICE A3001460 SPC 1 A3001461 ENQ 0 SPECIFY THE PROCEDURE DEVICE A3001462 RTJ+ PGLUNT A3001463 SPC 1 A3001464 RTJ- (AMONI) READ THE NEXT PROCEDURE RECORD A3001465 ADC $4844 A3001466 ADC GER010 A3001467ÐÐ ADC 0 A3001468 ADC $1000 A3001469 ADC 40 A3001470 ADC BUFFER A3001471 JMP- (ADISP) A3001472 SPC 1 A3001473GER010 LDA* GERINP A3001474 STQ* GERINP SAVE THE COMPLETION PARAMETER A3001475 SPC 1 A3001476 SQP GER020 SKIP IF NO TERMINATION A3001477 ENA 0 RETURN TO INTERACTIVE INPUT A3001478 SPC 1 A3001479GER020 ENQ 0 RESTORE THE INPUT DEVICE A3001480 RTJ+ PGLUNT A3001481 SPC 1 A3001482 ENA -1 A3001483 LDQ* GERINP A3001484 SQP GER030 NO END-OF-FILE OR ERROR A3001485 ENA 0 INDICATE A TERMINATION A3001486 SPC 1 A3001487GER030 JMP* (GETREC) RETURN A3001488 SPC 2 A3001489GERINP NUM 0 TEMPORARY STORAGE A3001490 EJT A3001491 SPC 4 A3001492ÐÐIOFILE NOP 0 A3001493 SPC 1 A3001494 LDA- RQINPT,I IS A FILE SPECIFIED AS THE INPUT DEVICE A3001495 SAM IOF010 YES A3001496 LDA- USMODE,I NO, IS PROCEDURE MODE IN EFFECT A3001497 SAZ IOF020 NO, CONTINUE A3001498 SPC 1 A3001499IOF010 LDA =XFINAME A3001500 ADD- I SPECIFY THE FILE NAME A3001501 STA* IOFPR1 A3001502 SPC 1 A3001503 RTJ+ INPEQ OPEN AND POSITION THE FILE A3001504IOFPR1 ADC 0 A3001505 ADC ISTAT1 A3001506 SPC 1 A3001507 LDA- USMODE,I IS PROCEDURE MODE IN EFFECT A3001508 SAZ IOF020 NO, CONTINUE A3001509 CLR A,Q YES, SPECIFY TERMINAL INPUT A3001510 RTJ+ PGLUNT A3001511 SPC 1 A3001512IOF020 LDA- RQOUTP,I IS THE OUTPUT DEVICE A FILE A3001513 SAP IOF030 NO A3001514 SPC 1 A3001515 LDA =XFONAME A3001516 ADD- I SPECIFY THE FILE NAME A3001517ÐÐ STA* IOFPR2 A3001518 SPC 1 A3001519 RTJ+ OUTEQ OPEN THE FILE A3001520IOFPR2 ADC 0 A3001521 ADC ISTAT2 A3001522 SPC 1 A3001523IOF030 JMP* (IOFILE) RETURN A3001524 EJT A3001525 SPC 4 A3001526* O U T P U T M E S S A G E P R O C E S S O R A3001527 SPC 2 A3001528MESSAG NOP 0 A3001529 SPC 1 A3001530 LDA* MESADD,Q A3001531 STA* MESA SAVE THE MESSAGE ADDRESS A3001532 LDQ* MESLEN,Q A3001533 SPC 1 A3001534MES010 INQ -1 A3001535 SQM MES020 A3001536 LDA* (MESA),Q A3001537 SUB =A IS THIS THE END OF THE TEXT A3001538 SAN MES020 YES A3001539 JMP* MES010 NO, CONTINUE A3001540 SPC 1 A3001541MES020 INQ 1 A3001542ÐÐ QLS 1 A3001543 STQ* MESL SAVE THE MESSAGE LENGTH A3001544 SPC 1 A3001545 RTJ- (AMONI) A3001546 ADC $4C44 FORMATTED WRITE REQUEST A3001547 ADC 0 A3001548 ADC 0 A3001549 ADC TERMLU A3001550MESL ADC 0 A3001551MESA ADC 0 A3001552 SPC 1 A3001553 JMP* (MESSAG) RETURN A3001554 SPC 2 A3001555MESADD ADC MESG00 00 A3001556 ADC MESG01 01 A3001557 ADC SYSID 02 A3001558 ADC MESG03 03 A3001559 ADC BUFFER 04 A3001560 ADC RECBUF+4 05 A3001561 ADC TSOFFM 06 A3001562 SPC 1 A3001563MESLEN ADC LMES00 00 A3001564 ADC LMES01 01 A3001565 ADC 16 02 A3001566 ADC LMES03 03 A3001567ÐÐ ADC 36 04 A3001568 ADC 32 05 A3001569 ADC TSLOFF 06 A3001570 EJT A3001571 SPC 4 A3001572* M E S S A G E S A3001573 SPC 2 A3001574MESG00 ADC $1800 A3001575 EQU LMES00(*-MESG00) A3001576 SPC 2 A3001577MESG01 ALF $,CDC CYBER-18 C C S SYSTEM - VER 3.0$ A3001578 EQU LMES01(*-MESG01) A3001579 SPC 2 A3001580MESG03 ALF $,TERMINAL = XX$ A3001581 EQU LMES03(*-MESG03) A3001582 EJT A3001583 SPC 4 A3001584WTRD01 ALF $,:L:RPASSWORD = $ A3001585 NUM $8000 A3001586 EQU LWTR01(*-WTRD01) A3001587 SPC 2 A3001588WTRD02 ALF $,:L:RUSER ID. = $ A3001589 NUM $8000 A3001590 EQU LWTR02(*-WTRD02) A3001591 SPC 2 A3001592ÐÐWTRD03 ALF $,:L:RREQUEST = $ A3001593 EQU LWTR03(*-WTRD03) A3001594 SPC 2 A3001595 END A3001596 NAM IOLUNT A31 A ITOS CCS 3.0 SL-149A3100001* USER PROGRAM I/O DEVICE PROCESSOR A3100002* CREDIT COLLECTION SYSTEM VERSION 3.0 A3100003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A3100004* COPYRIGHT CONTROL DATA CORPORATION 1979 A3100005* A3100006 SPC 2 A3100007 ENT INPEQ USER DEFINED INPUT DEVICE A3100008 ENT OUTEQ USER DEFINED OUTPUT DEVICE A3100009 ENT LUNEQ USER REQUESTED LOGICAL UNIT NUMBER A3100010 EXT LUNAME NAMED LOGICAL UNIT TABLE A3100011 EXT OPENFL FILE MANAGER OPEN FILE REQUEST A3100012 EXT CLOSFL FILE MANAGER CLOSE FILE REQUEST A3100013 EXT PGLUNT EXECUTIVE LOGICAL UNIT DEFINITION FUNCTION A3100014 EXT TSAREA START OF THE USER AREA A3100015 EQU ZERO($22) LOCATION CONTAINING ZERO A3100016 EQU ONE(3) LOCATION CONTAINING ONE A3100017 SPC 4 A3100018* F I L E M A N A G E R E Q U I V A L E N C E S A3100019* A3100020* FILE REQUEST BUFFER A3100021ÐÐ* A3100022 EQU CNTLPT(02) FILE REQUEST CONTROL POINT A3100023 EQU RQINFO(03) FILE REQUEST INFORMATION A3100024 EQU PARLST(06) FILE REQUEST PARAMETER LIST ADDRESS A3100025 EQU UCTADR(07) FILE REQUEST USER CONTROL ADDRESS A3100026 EQU FMUSER(08) FILE REQUEST USER IDENTIFICATION A3100027 EQU FCBADR(09) FILE CONTROL BLOCK ADDRESS A3100028 EQU USEFLG(13) FILE USE INDICATOR A3100029 EQU RRNMSB(17) RELATIVE RECORD NUMBER -MSB A3100030 EQU RRNLSB(18) RELATIVE RECORD NUMBER -LSB A3100031 EQU NUMREC(19) NUMBER OF RETRIEVED RECORDS A3100032 EQU FRQLEN(24) FILE REQUEST BUFFER LENGTH A3100033* A3100034* FILE CONTROL BLOCK A3100035* A3100036 EQU FILEID(ZERO) FILE IDENTIFIER A3100037 EQU RECLEN(05) FILE RECORD LENGTH (WORDS) A3100038 EQU FCBIND(10) FILE CONTROL INDICATORS A3100039 EQU LENKY1(19) LENGTH OF KEY 1 A3100040 EQU LENKY2(21) LENGTH OF KEY 2 A3100041 EQU LENKY3(23) LENGTH OF KEY 3 A3100042 EQU LENKY4(25) LENGTH OF KEY 4 A3100043 EQU FCBLN1(13) FILE CONTROL BLOCK LENGTH (SEQUENTIAL FILE) A3100044 EQU FCBLN2(27) FILE CONTROL BLOCK LENGTH (INDEXED FILE) A3100045* A3100046ÐÐ* VOLUME INFORMATION TABLE A3100047* A3100048 EQU VIWPS(13) WORDS / SECTOR FOR VOLUME A3100049 EJT A3100050 SPC 4 A3100051* U S E R P R O G R A M U S E R T A B L E E N T R I E S A3100052 SPC 1 A3100053 EQU USERID(01) USER IDENTIFICATION - 4 WORDS ASCII A3100054 SPC 4 A3100055* U S E R P R O G R A M I / O T A B L E E N T R I E S A3100056 SPC 1 A3100057 EQU TERMBF(15) TERMINAL MESSAGE BUFFER ADDRESS A3100058 SPC 4 A3100059* U S E R L I N K A G E B U F F E R E N T R I E S A3100060 SPC 2 A3100061 EQU ULIOTB(001) USERS I/O TABLE ADDRESS A3100062 EQU ULUSTB(002) USERS USER TABLE ADDRESS A3100063 EQU RQINPT(044) USERS INPUT LOGICAL UNIT A3100064 EQU UFPARM(112) USER DECLARED FILE REQUEST PARAMETERS A3100065 EQU FISTAT(128) USER DECLARED FILE REQUEST STATUS A3100066 EQU PFNAME(129) CURRENT PROCEDURE FILE NAME - 4 WORDS A3100067 EQU MENUKY(133) REQUESTED FUNCTION MENU KEY A3100068 EQU USABRT(134) USER PROGRAM ABORT INDICATOR A3100069 EQU USMODE(135) USER EXECUTION MODE INDICATOR A3100070 EQU TMPGMX(136) TEMPORARY - PROGRAM INDEX A3100071ÐÐ EQU TMSECT(137) TEMPORARY - PROGRAM SECTOR - 2 WORDS A3100072 EQU TMPLEN(139) TEMPORARY - PROGRAM LENGTH A3100073 EQU TMUSID(140) TEMPORARY - USER IDENTIFICATION - 4 WORDS A3100074 EQU IREQBF(144) INPUT FILE REQUEST BUFFER AND FCB A3100075 EQU FINAME(188) INPUT FILE NAME - 4 WORDS A3100076 EQU OREQBF(192) OUTPUT FILE REQUEST BUFFER AND FCB A3100077 EQU FONAME(236) OUTPUT FILE NAME - 4 WORDS A3100078 EQU FIRCNO(240) INPUT FILE RECORD NUMBER - 2 WORDS A3100079 EQU LULBUF(256) LENGTH OF THE LINKAGE BUFFER A3100080 EJT A3100081 SPC 4 A3100082INPEQ NOP 0 A3100083 SPC 1 A3100084 ENA 0 SPECIFY AN INPUT REQUEST A3100085 RTJ* PROCES PROCESS THE REQUEST A3100086 ADC INPEQ A3100087 JMP* (INPEQ) RETURN A3100088 SPC 4 A3100089OUTEQ NOP 0 A3100090 SPC 1 A3100091 ENA 1 SPECIFY AN OUTPUT REQUEST A3100092 RTJ* PROCES PROCESS THE REQUEST A3100093 ADC OUTEQ A3100094 JMP* (OUTEQ) RETURN A3100095 SPC 4 A3100096ÐÐLUNEQ NOP 0 A3100097 ENA -1 SPECIFY A QUERY A3100098 RTJ* PROCES PROCESS THE REQUEST A3100099 ADC LUNEQ A3100100 JMP* (LUNEQ) RETURN A3100101 EJT A3100102PROCES NOP 0 A3100103 SPC 1 A3100104 STA* INDEX SAVE THE REQUEST INDEX A3100105 STQ* SAVQ SAVE THE Q-REGISTER A3100106 LDQ- I A3100107 STQ* SAVI AND THE I-REGISTER A3100108 ENA 0 A3100109 STA* PGSTAT INITIALIZE THE RETURN STATUS A3100110 SPC 1 A3100111 LDQ* (PROCES) A3100112 STQ* PRETRN SAVE THE RETURN ADDRESS A3100113 LDQ- (ZERO),Q Q = ADDRESS OF PARAMETER 1 A3100114 LDA- (ZERO),Q A = ADDRESS OF THE NAME BUFFER A3100115 STA NAMADD SAVE A3100116 INQ 2 A3100117 STQ* (PRETRN) SET UP THE RETURN ADDRESS A3100118 SPC 1 A3100119 RTJ FNDNAM SEARCH FOR A MATCH OF THE NAME A3100120 SPC 1 A3100121ÐÐPRO010 LDQ* INDEX Q = REQUEST INDEX A3100122 SQM PRO030 LOGICAL UNIT QUERY, RETURN A3100123 SAP PRO020 A3100124 JMP* PRO100 NO MATCH, ASSUME A FILE WAS SPECIFIED A3100125 SPC 1 A3100126PRO020 LDQ* INDEX A3100127 RTJ+ PGLUNT SPECIFY THE INPUT OR OUTPUT DEVICE A3100128 SPC 1 A3100129 LDA* PGSTAT OBTAIN THE RETURN STATUS A3100130PRO030 LDQ* (PROCES) A3100131 LDQ- (ZERO),Q A3100132 INQ -1 A3100133 LDQ- (ZERO),Q A3100134 STA- (ZERO),Q RETURN THE STATUS A3100135 SPC 1 A3100136 LDQ* SAVI A3100137 STQ- I RESTORE THE I-REGISTER A3100138 LDQ* SAVQ AND THE Q-REGISTER A3100139 RAO* PROCES A3100140 JMP* (PROCES) RETURN A3100141 EJT A3100142COMPAR NOP 0 A3100143 SPC 1 A3100144 STQ* COMSVQ A3100145 STA* TEMP01 SAVE THE COMPARISON NAME ADDRESS A3100146ÐÐ SPC 1 A3100147 ENQ 3 A3100148 SPC 1 A3100149COM010 LDA* (TEMP01),Q A3100150 SUB* (NAMADD),Q DO THE NAMES MATCH A3100151 SAN COM020 NO A3100152 INQ -1 A3100153 SQM COM020 THEY MATCH, RETURN WITH ERROR A3100154 JMP* COM010 CONTINUE A3100155 SPC 1 A3100156COM020 LDQ* COMSVQ A = 0 IF A MATCH WAS FOUND A3100157 JMP* (COMPAR) RETURN A3100158 SPC 4 A3100159ERRCHK NOP 0 A3100160 SAP ERR010 NO ERROR A3100161 SPC 1 A3100162 STA* PGSTAT SPECIFY THE ERROR CODE A3100163 ENA 0 FORCE A RETURN TO INTERACTIVE MODE A3100164 JMP* PRO010 RETURN TO THE ORIGINAL CALLER A3100165 SPC 1 A3100166ERR010 JMP* (ERRCHK) CONTINUE A3100167 SPC 4 A3100168* D A T A A N D S T O R A G E A3100169 SPC 2 A3100170SAVQ ADC 0 TEMPORARY STORAGE - Q-REGISTER A3100171ÐÐSAVI ADC 0 TEMPORARY STORAGE - I-REGISTER A3100172PRETRN ADC 0 TEMPORARY STORAGE - RETURN ADDRESS A3100173COMSVQ ADC 0 TEMPORARY STORAGE - Q-REGISTER A3100174PGSTAT ADC 0 PROGRAM RETURN STATUS A3100175NAMADD ADC 0 ADDRESS OF THE NAME BUFFER A3100176ISTAT ADC 0 FILE REQUEST STATUS A3100177TEMP01 ADC 0 TEMPORARY STORAGE A3100178INDEX ADC 0 REQUEST TYPE INDEX A3100179 EJT A3100180PRO100 LDA+ TSAREA A3100181 STA- I I = LINKAGE BUFFER ADDRESS A3100182 LDA PAR01,Q A3100183 ADD- I A = ADDRESS OF REQBUF FOR THIS FILE A3100184 STA* PRORQ1 SAVE IN THE FILE REQUESTS A3100185 STA* PRORQ2 A3100186 SPC 1 A3100187 LDA- RQINPT,B IS A FILE ALREADY DECLARED AS THIS DEVICE A3100188 SAP PRO110 NO A3100189 LDA FILNAM,Q A3100190 ADD- I A3100191 RTJ* COMPAR HAS THIS FILE ALREADY BEEN SPECIFIED A3100192 SAZ PRO110 YES A3100193 RTJ+ CLOSFL NO, CLOSE THE EXISTING FILE A3100194PRORQ1 ADC 0 A3100195 ADC ISTAT A3100196ÐÐ SPC 1 A3100197PRO110 ENQ 1 A3100198PRO120 LDA- RQINPT,B IS A FILE SPECIFIED FOR THIS DEVICE A3100199 SAP PRO130 NO A3100200 TRQ A YES A3100201 SUB* INDEX IS THIS THE REQUESTED DEVICE A3100202 SAZ PRO130 YES, CONTINUE A3100203 LDA* FILNAM,Q NO, OBTAIN THE FILE NAME ADDRESS A3100204 ADD- I A3100205 RTJ* COMPAR DOES THE REQUESTED FILE = THE OTHER FILE A3100206 SAN PRO130 NO A3100207 ENA -1 YES, INDICATE AN ERROR A3100208 RTJ* ERRCHK A3100209PRO130 INQ -1 A3100210 SQM PRO140 A3100211 JMP* PRO120 CONTINUE THE SEARCH A3100212 SPC 1 A3100213PRO140 LDA* INDEX IS THIS AN INPUT FILE REQUEST A3100214 SAN PRO160 NO A3100215 LDA- USMODE,I YES, IS PROCEDURE MODE ACTIVE A3100216 SAZ PRO160 NO A3100217 LDA =XPFNAME YES, OBTAIN THE ADDRESS OF THE PROCEDURE NAME A3100218 ADD- I A3100219 RTJ* COMPAR DOES THE INPUT FILE NAME = THE PROCEDURE NAME A3100220 SAZ PRO150 YES, CONTINUE A3100221ÐÐ SPC 1 A3100222 ENA -1 NO, INDICATE AN ERROR A3100223 RTJ* ERRCHK A3100224 EJT A3100225PRO150 RTJ* OPNCHK IS THE FILE ALREADY OPEN A3100226 SAN PRO160 NO, OPEN IT A3100227 JMP* PRO240 YES, CONTINUE A3100228 SPC 1 A3100229PRO160 LDQ* INDEX A3100230 LDA* FILNAM,Q A3100231 ADD- I A3100232 STA* TEMP01 SAVE THE ADDRESS OF THE FILE NAME ARRAY A3100233 ENQ 3 A3100234 SPC 1 A3100235PRO170 LDA* (NAMADD),Q A3100236 STA* IDATA,Q MOVE THE FILE NAME TO THE IDATA ARRAY A3100237 STA* (TEMP01),Q AND THE FILE NAME ARRAY A3100238 INQ -1 A3100239 SQM PRO180 A3100240 JMP* PRO170 A3100241 SPC 1 A3100242PRO180 LDA =XTMUSID A3100243 ADD- I OBTAIN THE ADDRESS OF THE USER ID A3100244 STA* TEMP01 A3100245 ENQ 3 A3100246ÐÐ SPC 1 A3100247PRO190 LDA* (TEMP01),Q A3100248 STA* IDATA+4,Q MOVE THE OWNER NAME TO THE IDATA ARRAY A3100249 INQ -1 A3100250 SQM PRO200 A3100251 JMP* PRO190 A3100252 SPC 1 A3100253PRO200 ENQ FRQLEN-1 A3100254 ENA 0 A3100255PRO210 STA* (PRORQ2),Q INITIALIZE THE REQUEST BUFFER TO ZERO A3100256 INQ -1 A3100257 SQM PRO220 A3100258 JMP* PRO210 A3100259 SPC 1 A3100260PRO220 ENQ FCBADR A3100261 LDA* PRORQ2 A3100262 INA FRQLEN A = ADDRESS OF THE FILES FCB A3100263 STA* (PRORQ2),Q SET UP THE FCB ADDRESS IN THE REQUEST BUFFER A3100264 STA* TEMP01 A3100265 SPC 1 A3100266 RTJ+ OPENFL OPEN THE REQUESTED FILE A3100267PRORQ2 ADC 0 A3100268 ADC IDATA A3100269 ADC ISTAT A3100270 SPC 1 A3100271ÐÐ LDA* ISTAT A3100272 RTJ* ERRCHK CHECK FOR FILE ERRORS A3100273 EJT A3100274 SPC 4 A3100275 LDQ- ULIOTB,I A3100276 LDQ- TERMBF,Q Q = I/O HEADER ADDRESS A3100277 INQ -1 A3100278 LDA- (ZERO),Q A = I/O BUFFER LENGTH A3100279 INA -2 ALLOW FOR END-OF-FILE CODES A3100280 LDQ* TEMP01 Q = FCB ADDRESS A3100281 SUB- RECLEN,Q WILL THE RECORD FIT IN THE BUFFER A3100282 SAM PRO230 NO, ERROR A3100283 LDA- FCBIND,Q YES, ARE THE RECORDS SECTOR ALIGNED A3100284 SAP PRO240 NO, CONTINUE A3100285PRO230 ENA -1 INDICATE AN ERROR A3100286 RTJ* ERRCHK A3100287 SPC 1 A3100288PRO240 LDQ- ULIOTB,I A3100289 LDQ- TERMBF,Q A3100290 LDA- 4,Q A = TERMINAL BUFFER ADDRESS A3100291 LDQ* INDEX A3100292 STA* PAR02,Q SPECIFY THE RECORD BUFFER A3100293 SQN PRO260 SKIP IF THIS IS AN 'OUTPUT' REQUEST A3100294 SPC 1 A3100295 LDA- USMODE,I IS PROCEDURE MODE IN EFFECT A3100296ÐÐ SAN PRO250 YES A3100297 STA- FIRCNO+1,I NO, INITIALIZE THE RECORD COUNT A3100298* 1 CARD DELETED 127*4978A3100299 SPC 1 A3100300PRO250 LDA- FIRCNO+1,I IS THE FILE AT LOAD POINT 127*4978A3100301 SAZ PRO260 YES 127*4978A3100302 LDQ* PRORQ2 Q = REQUEST BUFFER ADDRESS 127*4978A3100303 ENA 1 A3100304 STA- NUMREC,Q A3100305 ENA 0 A3100306 STA- RRNMSB,Q POSITION THE FILE TO THE CORRECT RECORD A3100307 LDA- FIRCNO+1,I A3100308 STA- RRNLSB,Q A3100309 EJT A3100310 SPC 4 A3100311PRO260 LDQ* INDEX A3100312 LDA- I A3100313 STA* TEMP01 SAVE THE LINKAGE BUFFER ADDRESS A3100314 ADD* PARLOC,Q A3100315 STA- I I = PARAMETER LOCATION FOR THIS REQUEST A3100316 SPC 1 A3100317 LDA* PAR01,Q A3100318 ADD* TEMP01 A3100319 STA- (I) SPECIFY REQBUF PARAMETER A3100320 LDA* PAR02,Q A3100321ÐÐ STA- 1,I SPECIFY RECBUF PARAMETER A3100322 LDA* PAR03,Q A3100323 STA- 2,I SPECIFY NUMREC PARAMETER A3100324 LDA* PAR04,Q A3100325 ADD TEMP01 A3100326 STA- 3,I SPECIFY ISTAT PARAMETER A3100327 SPC 1 A3100328 LDA* REQIDX,Q A3100329 ENQ RQINFO A3100330 STA* (PRORQ2),Q SPECIFY THE REQUEST INDEX A3100331 LDA- I A3100332 INA 4 A3100333 ENQ PARLST A3100334 STA* (PRORQ2),Q SPECIFY THE PARAMETER LIST LOCATION A3100335 SPC 1 A3100336 ENA -1 INDICATE A FILE DEVICE A3100337 JMP PRO020 RETURN A3100338 EJT A3100339 SPC 4 A3100340* D A T A A N D S T O R A G E A3100341 SPC 2 A3100342PARLOC ADC UFPARM 0 - INPUT FILE PARAMETER LIST A3100343 ADC UFPARM+4 1 - OUTPUT FILE PARAMETER LIST A3100344 SPC 1 A3100345REQIDX ADC 14 0 - INPUT FILE REQUEST INDEX A3100346ÐÐ ADC 11 1 - OUTPUT FILE REQUEST INDEX A3100347 SPC 1 A3100348FILNAM ADC FINAME 0 - INPUT FILE NAME A3100349 ADC FONAME 1 - OUTPUT FILE NAME A3100350 SPC 1 A3100351PAR01 ADC IREQBF 0 - INPUT REQBUF PARAMETER A3100352 ADC OREQBF 1 - OUTPUT REQBUF PARAMETER A3100353 SPC 1 A3100354PAR02 ADC 0 0 - INPUT RECBUF PARAMETER A3100355 ADC 0 1 - OUTPUT RECBUF PARAMETER A3100356 SPC 1 A3100357PAR03 ADC ZERO 0 - INPUT KEYVAL PARAMETER A3100358 ADC ONE 1 - OUTPUT RECLEN PARAMETER A3100359 SPC 1 A3100360PAR04 ADC FISTAT 0 - INPUT ISTAT PARAMETER A3100361 ADC FISTAT 1 - OUTPUT ISTAT PARAMETER A3100362 SPC 1 A3100363IDATA ALF 4, FILE NAME A3100364 ALF 4, FILE OWNER A3100365 ALF 4, VOLUME NAME A3100366 ADC 0 INDEXED REQUEST INDICATOR (N/A) A3100367 ADC 1 NUMBER OF RECORDS A3100368 ADC 0 LOCK INDICATOR A3100369 EJT A3100370OPNCHK NOP 0 A3100371ÐÐ SPC 1 A3100372 LDQ* PRORQ2 Q = REQBUF ADDRESS A3100373 LDQ- UCTADR,Q Q = UCT ADDRESS A3100374 LDA- (ZERO),Q A3100375 SUB- ULUSTB,I DOES THE USER ID MATCH A3100376 SAN OPN010 NO, RETURN A3100377 LDA- 2,Q YES A3100378 LDQ* PRORQ2 A3100379 SUB- FCBADR,Q DO THE FCB ADDRESSES MATCH A3100380 SPC 1 A3100381OPN010 JMP* (OPNCHK) A = 0 INDICATES THE FILE IS OPEN A3100382 SPC 4 A3100383FNDNAM NOP 0 A3100384 SPC 1 A3100385 LDA =XLUNAME A = ADDRESS OF THE NAMED LOGICAL UNIT TABLE A3100386 STA- I A3100387 SPC 1 A3100388FND010 ENQ 3 A3100389FND020 LDA- (I),Q A3100390 SUB (NAMADD),Q DOES THIS ENTRY MATCH A3100391 SAN FND030 NO, TRY THE NEXT A3100392 INQ -1 YES, CONTINUE A3100393 SQM FND040 THE NAME MATCHES A3100394 JMP* FND020 A3100395 SPC 1 A3100396ÐÐFND030 LDA- I A3100397 INA 5 INCREMENT TO THE NEXT ENTRY IN THE TABLE A3100398 STA- I A3100399 LDA- (I) IS THIS THE END OF THE TABLE A3100400 SAM FND050 YES, NO MATCH CAN BE FOUND A3100401 JMP* FND010 NO, CONTINUE A3100402 SPC 1 A3100403FND040 LDA- 4,I A = SPECIFIED LOGICAL UNIT A3100404 SPC 1 A3100405FND050 JMP* (FNDNAM) RETURN A3100406 SPC 1 A3100407 END A3100408 NAM FMCALL A32 A ITOS CCS 3.0 SL-149A3200001* LOG-IN FILE REQUEST INTERCEPTOR A3200002* CREDIT COLLECTION SYSTEM VERSION 3.0 A3200003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A3200004* COPYRIGHT CONTROL DATA CORPORATION 1979 A3200005* A3200006* A3200007* FMCALL CONTAINS THE ENTRY POINTS FOR ALL FILE MANAGER A3200008* REQUESTS REQUIRED BY THE ITOS LOG-IN PROCESSOR. A3200009* FMCALL INTERCEPTS ALL REQUESTS, PERFORMS SOME INITIALIZATIONA3200010* OF THE USER'S REQUEST BUFFER AND EXCUTES A RETURN JUMP TO A3200011* THE CORE RESIDENT FILE MANAGER EXECUTIVE'S ENTRY POINT. THEA3200012* FILE MANAGER EXECUTIVE RETURNS TO FMCALL UPON COMPLETING A3200013ÐÐ* A REQUEST. FMCALL WILL RETURN TO THE CALLER. A3200014 SPC 2 A3200015* A3200016* FILE REQUESTS ENTRY POINTS A3200017* A3200018 ENT OPENFL OPEN FILE A3200019 ENT CLOSFL CLOSE FILE A3200020 ENT PUTS PUT SEQUENTIAL RECORD A3200021 ENT READR READ RECORD RANDOMLY A3200022 ENT GETS GET NEXT SEQUENTIAL RECORD A3200023 ENT FCLOSE FORCE CLOSE ALL USER FILES A3200024 SPC 2 A3200025* A3200026* EXTERNALS A3200027* A3200028 EXT CCP CONTROL POINT LOCATION A3200029 SPC 2 A3200030* A3200031* EQUIVALENCES A3200032* COMMUNICATION REGION CONSTANTS A3200033* A3200034 EQU ZERO(2) ZERO CONSTANT A3200035 EQU ADRECT($E9) ADDRESS OF EXTENDED CORE TABLE A3200036 EQU FMEIDX(30) INDEX INTO EXT EXT CORE TABLE TO FM EXEC ENTRYA3200037* A3200038ÐÐ* REQUEST BUFFER INDEXES A3200039 EQU RBATHR(0) REQUEST BUFFER ADDRESS THREAD A3200040 EQU BUFAMP(1) BUFFER ADDRESS MAIN PART A3200041 EQU CNTLPT(2) CONTROL POINT (OR SPARE) A3200042 EQU RQINFO(3) REQUEST INFORMATION (MULTI-FIELD) A3200043 EQU QREG(4) Q REGISTER A3200044 EQU IREG(5) I REGISTER A3200045 EQU RTNADR(6) RETURN ADDRESS (UPON RETURN FROM EXEC) A3200046 EQU PARLST(6) ADDRESS OF PARAMETER LIST A3200047 EQU UCTIND(7) UCT ENTRY INDEX A3200048* A3200049 EQU OPNIDX(4) OPENFL REQUEST INDEX A3200050 EJT A3200051 SPC 4 A3200052* A3200053GETS NUM 0 GET NEXT SEQUENTIAL RECORD A3200054 ENA 14 REQUEST INDEX = 14 A3200055 RTJ* CONT A3200056* A3200057READR NUM 0 READ RECORD RANDOMLY A3200058 ENA 13 REQUEST INDEX = 13 A3200059 RTJ* CONT A3200060* A3200061PUTS NUM 0 PUT SEQUENTIAL RECORD A3200062 ENA 11 REQUEST INDEX = 11 A3200063ÐÐ RTJ* CONT A3200064* A3200065CLOSFL NUM 0 CLOSE FILE A3200066 ENA 5 REQUEST INDEX = 5 A3200067 RTJ* CONT A3200068* A3200069OPENFL NUM 0 OPEN FILE A3200070 ENA 4 REQUEST INDEX = 4 A3200071 RTJ* CONT A3200072* A3200073FCLOSE NUM 0 FORCE CLOSE A3200074 ENA 0 REQUEST INDEX = 0 A3200075 RTJ* CONT A3200076 EJT A3200077* INITIALIZE FIRST 6 WORDS OF REQUEST BUFFER A3200078CONT NUM 0 A3200079 STQ* QTEMP SAVE Q TEMPORARILY A3200080 STA* ATEMP SAVE THE REQUEST INDEX A3200081 LDQ* CONT A3200082 INQ -3 A3200083 LDQ- (ZERO),Q PICKUP ADDRESS OF USER PARAMETER LIST A3200084 STQ* PLIST SAVE IT A3200085 LDA- (ZERO),Q A = ADDRESS OF REQBUF A3200086 LDQ- I PICK UP I-REG CONTENTS A3200087 STA- I SET I TO REQBUF ADDRESS A3200088ÐÐ INA 4 A3200089 STA- BUFAMP,I SET REQBUF+4 ADDRESS A3200090 STQ- IREG,I SAVE ORIGINAL I-REG CONTENTS IN REQBUF A3200091 CLR A A3200092 STA- (ZERO),I CLEAR REQBUF(1) AND SAVE CONTROL POINT A3200093 LDA CCP A3200094 STA- CNTLPT,I A3200095 LDA* PLIST A3200096 STA- PARLST,I STORE USERS PARAM LIST ADDRESS IN REQBUF A3200097 LDQ* QTEMP RELOAD Q WITH SAVED VALUE A3200098 STQ- QREG,I STORE IN REQBUF A3200099 LDA* ATEMP A3200100 STA- RQINFO,I STORE REQUEST INDEX A3200101 INA -OPNIDX A3200102 SAN CONTIN SKIP IF NOT OPENFL CALL A3200103 STA- UCTIND,I CLEAR UCTIND WORD A3200104CONTIN ENQ FMEIDX EXECUTE FILE MANAGER REQUEST EXECUTIVE A3200105 LDQ- (ADRECT),Q A3200106 RTJ- (ZERO),Q A3200107* A3200108* RETURN FROM EXECUTIVE A3200109* A3200110 LDA- RTNADR,I GET RETURN ADDRESS A3200111 STA* QTEMP SAVE FOR RETURN A3200112 LDQ- QREG,I RESTORE SAVED Q-REG AND I-REG A3200113ÐÐ LDA- IREG,I A3200114 STA- I A3200115 JMP* (QTEMP) RETURN TO CALLER A3200116 SPC 3 A3200117PLIST NUM 0 SAVED USER PARAMETER LIST ADDRESS A3200118QTEMP NUM 0 SAVED Q-REG A3200119ATEMP NUM 0 A3200120 END A3200121 NAM SYSMSG A33 A ITOS CCS 3.0 SL-149A3300001* USER PROGRAM MESSAGE PROCESSOR A3300002* CREDIT COLLECTION SYSTEM VERSION 3.0 A3300003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A3300004* COPYRIGHT CONTROL DATA CORPORATION 1979 A3300005* A3300006 SPC 2 A3300007 ENT SYSMSG A3300008 EXT OPENFL OPEN FILE FILE REQUEST A3300009 EXT CLOSFL CLOSE FILE FILE REQUEST A3300010 EXT READR READ RECORD RANDOMLY FILE REQUEST A3300011 EXT TERMLU LOGICAL UNIT OF THE COMMUNICATIONS CONTROLLER A3300012 EQU LPMASK(2) BIT MASK TABLE A3300013 EQU ZERO($22) LOCATION CONTAINING ZERO A3300014 EQU TEN($46) LOCATION CONTAINING TEN A3300015 EQU AMONI($F4) MONITOR REQUEST ENTRY A3300016 EQU ASC($40) ASCII SPECIFICATION CHARACTER (@) A3300017ÐÐ EQU DEC($23) DECIMAL SPECIFICATION CHARACTER (#) A3300018 EQU HEX($24) HEXIDECIMAL SPECIFICATION CHARACTER ($) A3300019 SPC 2 A3300020SYSMSG NOP 0 A3300021 SPC 1 A3300022 STQ* SAVQ SAVE THE Q-REGISTER A3300023 SPC 1 A3300024 LDA- $E3 IS THE SYSTEM HANG SWITCH SET A3300025SYS000 SAP SYS005 NO, CONTINUE A3300026 JMP* SYS000 CLEAR THE A-REGISTER TO CONTINUE A3300027 SPC 1 A3300028SYS005 LDQ* (SYSMSG) A3300029 RAO* SYSMSG A3300030 LDA- (ZERO),Q OBTAIN THE FIRST PARAMETER - MESSAGE INDEX A3300031 STA* MSGTYP SAVE THE DISPOSITION INDICATOR A3300032 SAP SYS010 A3300033 TCA A A3300034SYS010 SAN SYS020 A3300035 JMP SYS450 INDEX = 0 (ILLEGAL) A3300036 EJT A3300037 SPC 4 A3300038SYS020 STA* RECNUM+1 RECNUM = MESSAGE INDEX A3300039 SPC 1 A3300040 LDQ* (SYSMSG) A3300041 RAO* SYSMSG A3300042ÐÐ STQ* DATBUF SAVE THE SECOND PARAMETER - DATA BUFFER A3300043 SPC 1 A3300044 ENQ 23 A3300045 ENA 0 A3300046SYS030 STA REQBUF,Q INITIALIZE THE FILE REQUEST BUFFER A3300047 INQ -1 A3300048 SQM SYS040 A3300049 JMP* SYS030 A3300050 SPC 1 A3300051SYS040 RTJ+ OPENFL OPEN THE SYSTEM MESSAGE FILE A3300052 ADC REQBUF A3300053 ADC IDATA A3300054 ADC ISTAT A3300055 SPC 1 A3300056 LDA* ISTAT WERE THERE ANY FILE ERRORS A3300057 SAP SYS050 NO A3300058 JMP SYS450 YES A3300059 EJT A3300060 SPC 4 A3300061SYS050 RTJ+ READR READ THE MESSAGE RECORD A3300062 ADC REQBUF A3300063 ADC RECBUF A3300064 ADC RECNUM A3300065 ADC ISTAT A3300066 SPC 1 A3300067ÐÐ LDA* ISTAT WERE THERE ANY FILE ERRORS A3300068 SAP SYS060 NO A3300069 JMP* SYS450 YES A3300070 SPC 1 A3300071 SPC 1 A3300072SYS060 RTJ+ CLOSFL CLOSE THE MESSAGE FILE A3300073 ADC REQBUF A3300074 ADC ISTAT A3300075 SPC 1 A3300076 ENQ 0 A3300077 STQ* RECIDX INITIALIZE THE RECORD CHARACTER INDEX A3300078 STQ* BUFIDX INITIALIZE THE DATA CHARACTER INDEX A3300079 SPC 1 A3300080SYS100 LDQ* RECIDX A3300081 TRQ A A3300082 INA -80 HAS THE ENTIRE RECORD BEEN SEARCHED A3300083 SAP SYS130 YES, DISPLAY THE MESSAGE A3300084 SPC 1 A3300085 RTJ* GETCHR NO, GET THE NEXT CHARACTER FROM RECBUF A3300086 ADC RECBUF A3300087 INQ 1 A3300088 STQ* RECIDX A3300089 SPC 1 A3300090 INA -ASC IS THIS AN ASCII SPECIFICATION A3300091 SAZ SYS140 YES A3300092ÐÐ INA -DEC+ASC NO, IS A DECIMAL SPECIFICATION A3300093 SAZ SYS110 YES A3300094 INA -HEX+DEC NO, IS IT A HEXIDECIMAL SPECIFICATION A3300095 SAZ SYS120 YES A3300096 JMP* SYS100 NO, CONTINUE THE SCAN A3300097 SPC 1 A3300098SYS110 JMP* SYS200 DECIMAL CONVERSION A3300099SYS120 JMP* SYS300 HEXIDECIMAL CONVERSION A3300100SYS130 JMP* SYS400 DISPLAY THE MESSAGE RECORD A3300101 EJT A3300102 SPC 4 A3300103SYS140 LDQ* BUFIDX ASCII SPECIFICATION A3300104 RTJ* GETCHR GET THE NEXT CHARACTER FROM THE DATA BUFFER A3300105DATBUF ADC 0 MESSAGE DATA BUFFER ADDRESS A3300106 INQ 1 A3300107 STQ* BUFIDX A3300108 SPC 1 A3300109 LDQ* RECIDX A3300110 INQ -1 A3300111 RTJ* PUTCHR PLACE THE CHARACTER IN THE MESSAGE RECORD A3300112 ADC RECBUF A3300113 JMP* SYS100 CONTINUE A3300114 SPC 4 A3300115* D A T A A N D S T O R A G E A3300116 SPC 2 A3300117ÐÐSAVQ ADC 0 Q-REGISTER STORAGE A3300118MSGTYP ADC 0 MESSAGE DISPOSITION TYPE A3300119RECIDX ADC 0 MESSAGE RECORD CHARACTER INDEX A3300120BUFIDX ADC 0 MESSAGE BUFFER CHARACTER INDEX A3300121ISTAT ADC 0 FILE REQUEST RETURN STATUS A3300122RECNUM ADC 0,0 MESSAGE FILE RELATIVE RECORD NUMBER A3300123IDATA ALF 4,$$SYMSGF FILE NAME A3300124 ALF 4,$$ FILE OWNER A3300125 ALF 4,SYSVOL FILE VOLUME A3300126 ADC 0 SEQUENTIAL FILE A3300127 ADC 1 RECORDS / REQUEST A3300128 ADC 0 RECORD LOCK INDICATOR A3300129 EJT A3300130 SPC 4 A3300131SYS200 RTJ* (AGTVAL) OBTAIN THE DATA VALUE A3300132 RAO* BUFIDX A3300133 RAO* BUFIDX INCREMENT THE DATA BUFFER INDEX A3300134 RTJ* DECCON CONVERT THE VALUE TO DECIMAL ASCII A3300135 SPC 1 A3300136 ENQ 0 A3300137 STQ* CONIDX INITIALIZE THE CONVERSION CHARACTER INDEX A3300138 LDQ* RECIDX A3300139 INQ -1 A3300140 STQ* BASIDX SAVE THE INITIAL CHARACTER INDEX A3300141 SPC 1 A3300142ÐÐSYS210 RTJ* GETCHR OBTAIN THE NEXT MESSAGE CHARACTER A3300143 ADC RECBUF A3300144 INA -DEC IS IT A DECIMAL SPECIFICATION A3300145 SAN SYS220 NO A3300146 INQ 1 YES A3300147 JMP* SYS210 CONTINUE A3300148 SPC 1 A3300149SYS220 RTJ* MOVDAT MOVE THE CONVERTED DATA INTO THE RECORD A3300150 JMP* SYS100 CONTINUE THE RECORD SCAN A3300151 SPC 4 A3300152SYS300 RTJ* (AGTVAL) OBTAIN THE DATA VALUE A3300153 RTJ* HEXCON CONVERT THE VALUE TO HEXIDECIMAL ASCII A3300154 SPC 1 A3300155 ENQ 0 A3300156 STQ* CONIDX INITIALIZE THE CONVERSION CHARACTER INDEX A3300157 LDQ* RECIDX A3300158 INQ -1 A3300159 STQ* BASIDX SAVE THE INITIAL CHARACTER INDEX A3300160 SPC 1 A3300161SYS310 RTJ* GETCHR OBTAIN THE NEXT MESSAGE CHARACTER A3300162 ADC RECBUF A3300163 INA -HEX IS IT A HEXIDECIMAL SPECIFICATION A3300164 SAN SYS320 NO A3300165 INQ 1 YES A3300166 JMP* SYS310 CONTINUE A3300167ÐÐ SPC 1 A3300168SYS320 RTJ* MOVDAT MOVE THE CONVERTED DATA INTO THE RECORD A3300169 JMP* SYS100 CONTINUE THE RECORD SCAN A3300170 SPC 2 A3300171BASIDX ADC 0 TEMPORARY STORAGE - BASE RECORD INDEX A3300172PUTIDX ADC 0 TEMPORARY STORAGE - DATA PLACEMENT INDEX A3300173AGTVAL ADC GETVAL ADDRESS OF THE DATA VALUE PICKUP ROUTINE A3300174 EJT A3300175 SPC 4 A3300176MOVDAT NOP 0 A3300177 SPC 1 A3300178MOV010 INQ -1 A3300179 STQ* PUTIDX A3300180 SPC 1 A3300181 LDQ* CONIDX A3300182 RTJ* GETCHR OBTAIN THE NEXT CONVERTED CHARACTER A3300183 ADC CONBUF A3300184 SPC 1 A3300185 INQ 1 A3300186 STQ* CONIDX A3300187 SPC 1 A3300188 LDQ* PUTIDX A3300189 RTJ* PUTCHR PLACE THE DATA IN THE RECORD A3300190 ADC RECBUF A3300191 TRQ A A3300192ÐÐ SUB* BASIDX HAS ALL THE DATA BEEN ENTERED A3300193 SAZ MOV020 YES A3300194 JMP* MOV010 NO, CONTINUE A3300195 SPC 1 A3300196MOV020 JMP* (MOVDAT) RETURN A3300197 EJT A3300198 SPC 4 A3300199SYS400 ENQ 0 DISPLAY THE MESSAGE ON THE USERS TERMINAL A3300200 RTJ* (AMESSG) A3300201 SPC 1 A3300202 LDA* MSGTYP IS IT ALSO REQUIRED AT THE MASTER TERMINAL A3300203 SAP SYS410 NO A3300204 SPC 1 A3300205 ENQ 1 YES, DISPLAY THE MESSAGE THERE ALSO A3300206 RTJ* (AMESSG) A3300207 SPC 1 A3300208SYS410 LDQ* SAVQ RESTORE THE Q-REGISTER A3300209 JMP (SYSMSG) RETURN A3300210 SPC 2 A3300211SYS450 ENQ 0 MESSAGE RECORD NOT AVAILABLE A3300212 LDA* RECNUM+1 A3300213 RTJ* DECCON CONVERT THE RECORD NUMBER A3300214 SPC 1 A3300215 LDA* CONBUF A3300216 ALS 8 EXCHANGE THE 2 LSD A3300217ÐÐ STA MESG02+9 A3300218 LDA* CONBUF+1 A3300219 ALS 8 EXCHANGE THE NEXT 2 DIGITS A3300220 STA MESG02+8 A3300221 SPC 1 A3300222 ENQ 2 DISPLAY THE MESSAGE RECORD NUMBER A3300223 RTJ* (AMESSG) A3300224 JMP* SYS410 CONTINUE A3300225 SPC 2 A3300226CONIDX ADC 0 MESSAGE DATA CHARACTER INDEX A3300227AMESSG ADC MESSAG ADDRESS OF THE MASSAGE DISPLAY ROUTINE A3300228 EJT A3300229GETCHR NOP 0 A3300230 LDA* (GETCHR) OBTAIN THE BUFFER ADDRESS A3300231 STA* CHRBUF AND SAVE A3300232 RAO* GETCHR A3300233 STQ* CHRTMP SAVE THE CHARACTER INDEX A3300234 SPC 1 A3300235 QRS 1 Q = WORD INDEX A3300236 LDA* (CHRBUF),Q OBTAIN THE WORD CONTAINING THE CHARACTER A3300237 LDQ* CHRTMP A3300238 QLS 15 IS THIS A RIGHT OR LEFT CHARACTER A3300239 SQM GET010 RIGHT A3300240 ARS 8 A3300241GET010 QLS 1 RESTORE THE CHARACTER INDEX A3300242ÐÐ AND- LPMASK+8 ISOLATE THE CHARACTER A3300243 JMP* (GETCHR) RETURN A3300244 SPC 2 A3300245CHRTMP ADC 0 TEMPORARY STORAGE - CHARACTER INDEX A3300246CHRBUF ADC 0 TEMPORARY STORAGE - BUFFER ADDRESS A3300247 SPC 4 A3300248PUTCHR NOP 0 A3300249 STQ* CHRTMP SAVE THE CHARACTER INDEX A3300250 LDQ* (PUTCHR) OBTAIN THE BUFFER ADDRESS A3300251 STQ* CHRBUF AND SAVE A3300252 RAO* PUTCHR A3300253 SPC 1 A3300254 LDQ* CHRTMP A3300255 ALS 9 A3300256 LRS 1 BITS 8-14 OF A = CHARACTER, Q = WORD INDEX A3300257 LDQ* (CHRBUF),Q OBTAIN THE CURRENT BUFFER WORD A3300258 SAM PUT010 SKIP IF THE CHARACTER IS ON THE RIGHT A3300259 LLS 16 A3300260 ALS 8 POSITION THE CHARACTER A3300261PUT010 AND- LPMASK+15 REMOVE THE LEFT / RIGHT INDICATOR A3300262 QRS 8 A3300263 LRS 8 FORM THE WORD A3300264 LDQ* CHRTMP A3300265 QRS 1 Q = WORD INDEX A3300266 STA* (CHRBUF),Q A3300267ÐÐ LDQ* CHRTMP RESTORE THE CHARACTER INDEX A3300268 JMP* (PUTCHR) RETURN A3300269 EJT A3300270DECCON NOP 0 A3300271 SPC 1 A3300272 DVI* TENKAY DIVIDE THE DATA INTO TWO PARTS A3300273 STQ* CONTMP SAVE THE LSD A3300274 SAZ DEC010 SKIP IF THE MSD IS ZERO A3300275 SPC 1 A3300276 ENQ 4 CONVERT THE MSD TO DECIMAL ASCII A3300277 RTJ* CONVRT A3300278 SPC 1 A3300279DEC010 ENQ 0 CONVERT THE LSD TO DECIMAL ASCII A3300280 LDA* CONTMP A3300281 RTJ* CONVRT A3300282 SPC 1 A3300283 JMP* (DECCON) RETURN A3300284 SPC 2 A3300285CONTMP ADC 0 TEMPORARY STORAGE A3300286TENKAY ADC 10000 DATA DIVISOR A3300287 SPC 4 A3300288HEXCON NOP 0 A3300289 SPC 1 A3300290 ENA 0 A3300291 STA* CONIDX INITIALIZE THE CONVERSION CHARACTER INDEX A3300292ÐÐ SPC 1 A3300293HEX010 LRS 4 A3300294 ARS 12 OBTAIN THE NEXT DIGIT A3300295 AND- LPMASK+4 A3300296 STQ* CONQUO SAVE THE QUOTIENT A3300297 INA -$A A3300298 SAM HEX020 CONVERT THE DIGIT TO ASCII A3300299 INA 7 A3300300HEX020 INA $3A A3300301 LDQ* CONIDX A3300302 RTJ* PUTCHR PLACE THE DIGIT IN THE CONVERSION BUFFER A3300303 ADC CONBUF A3300304 SPC 1 A3300305 INQ 1 A3300306 STQ* CONIDX A3300307 LDA* CONQUO A3300308 AND- LPMASK+12 A3300309 TRA Q IS MORE CONVERSION REQUIRED A3300310 SQZ HEX030 NO A3300311 JMP* HEX010 YES, CONTINUE A3300312 SPC 1 A3300313HEX030 JMP* (HEXCON) RETURN A3300314 EJT A3300315CONVRT NOP 0 A3300316 SPC 1 A3300317ÐÐCON010 STQ* CONIDX SAVE THE STORAGE INDEX A3300318 CLR Q A3300319 DVI- TEN OBTAIN THE NEXT DIGIT A3300320 STA* CONQUO SAVE THE QUOTIENT A3300321 TRQ A A3300322 INA $30 CONVERT THE DIGIT TO ASCII A3300323 LDQ* CONIDX A3300324 RTJ* PUTCHR PLACE THE DIGIT IN THE CONVERSION BUFFER A3300325 ADC CONBUF A3300326 SPC 1 A3300327 INQ 1 INCREMENT THE STORAGE INDEX A3300328 LDA* CONQUO IS MORE CONVERSION REQUIRED A3300329 SAZ CON020 NO A3300330 JMP* CON010 YES, CONTINUE A3300331 SPC 1 A3300332CON020 JMP* (CONVRT) RETURN A3300333 SPC 2 A3300334CONQUO ADC 0 TEMPORARY STORAGE - DIVISION QUOTIENT A3300335ABFIDX ADC BUFIDX ADDRESS OF THE DATA BUFFER INDEX A3300336 SPC 4 A3300337GETVAL NOP 0 A3300338 SPC 1 A3300339 ENQ 7 A3300340 LDA =A00 INITIALIZE THE CONVERSION BUFFER A3300341GEV010 STA* CONBUF,Q A3300342ÐÐ INQ -1 A3300343 SQM GEV020 A3300344 JMP* GEV010 A3300345 SPC 1 A3300346GEV020 LDQ* (ABFIDX) Q = DATA BUFFER CHARACTER INDEX A3300347 LRS 1 A3300348 SAP GEV030 CONVERT TO WORD INDEX A3300349 INQ 1 A3300350GEV030 ADQ DATBUF A3300351 LDA- 1,Q A = LSD OF THE VALUE A3300352 LDQ- (ZERO),Q Q = MSD OF THE VALUE A3300353 RAO* (ABFIDX) A3300354 RAO* (ABFIDX) INCREMENT THE DATA INDEX A3300355 JMP* (GETVAL) RETURN A3300356 SPC 2 A3300357CONBUF BZS CONBUF(8) A3300358 EJT A3300359 SPC 4 A3300360MESSAG NOP 0 A3300361 LDA* MESSAD,Q A3300362 STA* MESAD SPECIFY THE MESSAGE ADDRESS A3300363 LDA* MESLUN,Q A3300364 STA* MESLU SPECIFY THE MESSAGE LOGICAL UNIT A3300365 LDQ* MESLEN,Q A3300366 QRS 1 A3300367ÐÐ SPC 1 A3300368MES010 INQ -1 A3300369 SQM MES020 A3300370 LDA* (MESAD),Q A3300371 SUB =A IS THIS THE END OF THE SIGNIFICANT TEXT A3300372 SAN MES020 YES A3300373 JMP* MES010 NO, CONTINUE A3300374 SPC 1 A3300375MES020 INQ 1 A3300376 QLS 1 A3300377 STQ* MESLN SPECIFY THE MESSAGE LENGTH A3300378 SPC 1 A3300379 RTJ- (AMONI) DISPLAY THE MESSAGE A3300380 ADC $4C44 A3300381 ADC 0 A3300382 ADC 0 A3300383MESLU ADC 0 A3300384MESLN ADC 0 A3300385MESAD ADC 0 A3300386 SPC 1 A3300387 JMP* (MESSAG) RETURN A3300388 SPC 2 A3300389MESSAD ADC RECBUF 0 A3300390 ADC RECBUF 1 A3300391 ADC MESG02 2 A3300392ÐÐ SPC 1 A3300393MESLEN ADC 72 0 A3300394 ADC 72 1 A3300395 ADC 2*LMSG02 2 A3300396 SPC 1 A3300397MESLUN ADC TERMLU 0 A3300398 ADC $18FC 1 A3300399 ADC TERMLU 2 A3300400 EJT A3300401 SPC 4 A3300402MESG02 ALF $,SYSTEM MESSAGE XXXX$ A3300403 EQU LMSG02(*-MESG02) A3300404REQBUF BZS REQBUF(24) A3300405RECBUF BZS RECBUF(40) A3300406 END A3300407 NAM ULBUFF A34 A ITOS CCS 3.0 . SL-149 00001* LINKAGE BUFFER SWAP AREA 00002* CREDIT COLLECTION SYSTEM VERSION 3.0 00003* DATA SYSTEMS-LA JOLLA DIVISION,LA JOLLA,CALIFORNIA 00004* COPYRIGHT CONTROL DATA CORPORATION 1979 00005* 00006 SPC 2 00007* NUMBER OF TERMINALS = 57 (56 + MASTER CONSOLE) 00008* SECTORS / ENTRY = 3 00009* WORDS / SECTOR = 96 00010ÐÐ SPC 2 00011 BZS X(57*3*96) MASS MEMORY FOR LINKAGE BUFFERS 00012 END 00013 NAM FUNSEL A35 A ITOS CCS 3.0 . SL-149A3500001* FUNCTION MENU PROCESSOR A3500002* CREDIT COLLECTION SYSTEM VERSION 3.0 A3500003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A3500004* COPYRIGHT CONTROL DATA CORPORATION 1979 A3500005* A3500006 SPC 2 A3500007 EXT TSAREA START OF THE USER AREA A3500008 EXT TERMLU COMMUNICATIONS CONTROLLER LOGICAL UNIT A3500009 EXT SYSMSG SYSTEM MESSAGE PROCESSOR A3500010 EXT OPENFL OPEN FILE REQUEST A3500011 EXT GETS GET SEQUENTIAL RECORD REQUEST A3500012 EXT CLOSFL CLOSE FILE REQUEST A3500013 EXT WTREAD SYSTEM WRITE-READ REQUEST A3500014 EXT CHAIN PROGRAM CHAIN REQUEST A3500015 EXT PGMOUT PROGRAM EXIT A3500016 EQU TWO($24) LOCATION CONTAINING TWO A3500017 EQU HX00FF($A) A3500018 EQU ZERO($22) LOCATION CONTAINING ZERO A3500019 EQU USMODE(135) USER EXECUTION MODE INDICATOR A3500020 EQU FIRCNO(240) INPUT FILE RECORD NUMBER - 2 WORDS A3500021 EQU Z($5A) LETTER 'Z' A3500022ÐÐ EQU AMONI($F4) MONITOR REQUEST ENTRY A3500023 EQU MENUKY(133) REQUESTED FUNCTION MENU KEY A3500024 SPC 2 A3500025FUNSEL NOP 0 A3500026 SPC 1 A3500027 ENA 2 A3500028 STA* MSGIDX INITIALIZE THE DISPLAY INDEX A3500029 LDA+ TSAREA A3500030 STA- I SET I = START OF THE USER AREA A3500031 ENA 0 REWIND THE PROCEDURE FILE A3500032 STA- FIRCNO+1,I A3500033 SPC 1 A3500034 LDA- MENUKY,I IS A MENU KEY DEFINED A3500035 SAZ FUN005 NO A3500036 STA* IDATA+1 SPECIFY THE FILE NAME A3500037 SPC 1 A3500038 RTJ+ OPENFL OPEN THE FUNCTION MENU FILE A3500039 ADC REQBUF A3500040 ADC IDATA A3500041 ADC ISTAT A3500042 SPC 1 A3500043 LDA* ISTAT WERE THERE ANY FILE ERRORS A3500044 SAP FUN010 NO A3500045 RTJ+ SYSMSG YES, REPORT THE ERROR A3500046 ADC E19 A3500047ÐÐ ADC ISTAT A3500048FUN005 JMP* FUN060 EXIT A3500049 EJT A3500050 SPC 4 A3500051FUN010 RTJ+ GETS READ THE MENU FILE A3500052 ADC REQBUF A3500053 ADC RECBUF A3500054 ADC ZERO A3500055 ADC ISTAT A3500056 SPC 1 A3500057 LDA* ISTAT WERE THERE ANY FILE ERRORS A3500058 SAP FUN020 NO A3500059 RTJ+ SYSMSG YES, REPORT THE ERROR A3500060 ADC E22 A3500061 ADC ISTAT A3500062 JMP* FUN060 EXIT A3500063 SPC 1 A3500064FUN020 RTJ+ CLOSFL CLOSE THE FILE A3500065 ADC REQBUF A3500066 ADC ISTAT A3500067 SPC 1 A3500068 LDA* ISTAT WERE THERE ANY FILE ERRORS A3500069 SAP FUN030 NO A3500070 RTJ+ SYSMSG YES, REPORT THE ERROR A3500071 ADC E20 A3500072ÐÐ ADC ISTAT A3500073 JMP* FUN060 EXIT A3500074 SPC 1 A3500075FUN030 ENQ 0 CLEAR THE SCREEN A3500076 RTJ* MESSAG A3500077 SPC 1 A3500078FUN040 LDQ* MSGIDX A3500079 RTJ* MESSAG DISPLAY THE FUNCTION MENU A3500080 LDA REQBUF+14 A3500081 INA -1 DECREMENT THE RECORD COUNT A3500082 STA REQBUF+14 A3500083 SAZ FUN050 SKIP IF THE ENTIRE MENU IS DISPLAYED A3500084 RAO* MSGIDX A3500085 JMP* FUN040 CONTINUE A3500086 EJT A3500087FUN050 SET A INITIALIZE THE INPUT BUFFER A3500088 STA* INPUT A3500089 SPC 1 A3500090 RTJ+ WTREAD REQUEST THE SELECTION A3500091 ADC MSLU A3500092 ADC XYOUT A3500093 ADC REQMSG A3500094 ADC REQLEN A3500095 ADC XYINP A3500096 ADC INPUT A3500097ÐÐ ADC TWO A3500098 ADC TCODE A3500099 SPC 1 A3500100 LDA* INPUT A3500101 ALS 8 A3500102 SAM FUN055 SENSE ONLY 1 CHAR. ENTERED A3500103 JMP* FUN100 INDICATE INVALID ENTRY A3500104FUN055 AND- HX00FF A3500105 STA* INPUT A3500106 INA -Z WAS AN EXIT REQUESTED A3500107 SAN FUN070 NO A3500108 SPC 1 A3500109 ENQ 0 CLEAR THE SCREEN A3500110 RTJ* MESSAG A3500111 SPC 1 A3500112FUN060 ENA 0 RETURN TO INTERACTIVE MODE A3500113 STA- USMODE,I A3500114 RTJ+ PGMOUT EXIT A3500115 EJT A3500116 SPC 4 A3500117FUN070 LDQ =XRECBUF Q = RECORD BUFFER ADDRESS A3500118FUN080 LDA- (ZERO),Q A3500119 SUB =A * IS THIS A COMMENT A3500120 SAZ FUN090 YES A3500121 LDA- 5,Q NO A3500122ÐÐ ARS 8 A3500123 SUB* INPUT IS THIS THE REQUESTED FUNCTION A3500124 SAZ FUN110 YES A3500125 SPC 1 A3500126FUN090 INQ 40 INCREMENT TO THE NEXT RECORD A3500127 TRQ A A3500128 SUB =XRECEND HAS THE ENTIRE FILE BEEN SEARCHED A3500129 SAP FUN100 YES A3500130 JMP* FUN080 NO, CONTINUE A3500131 SPC 1 A3500132FUN100 ENQ 1 POSITION THE CURSOR A3500133 RTJ MESSAG A3500134 RTJ+ SYSMSG INDICATE AN INVALID ENTRY A3500135 ADC E15 A3500136 ADC INPUT A3500137 JMP* FUN050 REQUEST ANOTHER INPUT A3500138 SPC 1 A3500139FUN110 STQ* FUNPAR SPECIFY THE FUNCTION NAME A3500140 SPC 1 A3500141 ENQ 0 CLEAR THE SCREEN A3500142 RTJ* MESSAG A3500143 SPC 1 A3500144 RTJ+ CHAIN INITIATE THE REQUESTED FUNCTION A3500145FUNPAR ADC 0 A3500146 EJT A3500147ÐÐ SPC 4 A3500148* D A T A A N D S T O R A G E A3500149 SPC 2 A3500150MSGIDX ADC 0 DISPLAY MESSAGE INDEX A3500151XYOUT NUM -1 CURSOR POSITION PRIOR TO OUTPUT(15*$100+23) A3500152XYINP NUM -1 CURSOR POSITION PRIOR TO INPUT(28*$100+23) A3500153REQLEN ADC REQLN*2 A3500154TCODE ADC 0 TERMINATION CODE A3500155E15 ADC 15 MESSAGE INDEX A3500156E19 ADC 19 MESSAGE INDEX A3500157E20 ADC 20 MESSAGE INDEX A3500158E22 ADC 22 MESSAGE INDEX A3500159INPUT NUM 0,0 SELECTION INPUT BUFFER A3500160ISTAT ADC 0 FILE REQUEST STATUS A3500161IDATA ALF 4,$$ MENU FILE NAME A3500162 ALF 4,$$ FILE OWNER A3500163 ALF 4, FILE VOLUME A3500164 ADC 0 SEQUENTIAL ACCESS A3500165 ADC 24 NUMBER OF RECORDS A3500166 ADC 0 LOCK INDICATOR A3500167 EJT A3500168 SPC 4 A3500169* M E S S A G E D I S P L A Y R O U T I N E A3500170 SPC 2 A3500171MESSAG NOP 0 A3500172ÐÐ SPC 1 A3500173 LDA* MESADD,Q A3500174 STA* MESA SAVE THE MESSAGE ADDRESS A3500175 LDQ* MESLEN,Q A3500176 QRS 1 A3500177 SPC 1 A3500178MES010 INQ -1 A3500179 SQZ MES020 SENSE END OF MESSAGE A3500180 LDA* (MESA),Q A3500181 SUB =A IS THIS THE END OF THE TEXT A3500182 SAN MES020 YES A3500183 JMP* MES010 NO, CONTINUE A3500184 SPC 1 A3500185MES020 INQ 1 A3500186 QLS 1 A3500187 STQ* MESL SAVE THE MESSAGE LENGTH A3500188 SPC 1 A3500189 RTJ- (AMONI) A3500190 ADC $4C44 FORMATTED WRITE REQUEST A3500191 ADC 0 A3500192 ADC 0 A3500193MSLU ADC TERMLU A3500194MESL ADC 0 A3500195MESA ADC 0 A3500196 SPC 1 A3500197ÐÐ JMP* (MESSAG) RETURN A3500198 EJT A3500199MESADD ADC MESG00 00 A3500200 ADC MESG01 01 A3500201 ADC RECBUF+004 02 A3500202 ADC RECBUF+044 03 A3500203 ADC RECBUF+084 04 A3500204 ADC RECBUF+124 05 A3500205 ADC RECBUF+164 06 A3500206 ADC RECBUF+204 07 A3500207 ADC RECBUF+244 08 A3500208 ADC RECBUF+284 09 A3500209 ADC RECBUF+324 10 A3500210 ADC RECBUF+364 11 A3500211 ADC RECBUF+404 12 A3500212 ADC RECBUF+444 13 A3500213 ADC RECBUF+484 14 A3500214 ADC RECBUF+524 15 A3500215 ADC RECBUF+564 16 A3500216 ADC RECBUF+604 17 A3500217 ADC RECBUF+644 18 A3500218 ADC RECBUF+684 19 A3500219 ADC RECBUF+724 20 A3500220 ADC RECBUF+764 21 A3500221 ADC RECBUF+804 22 A3500222ÐÐ ADC RECBUF+844 23 A3500223 ADC RECBUF+884 24 A3500224 ADC RECBUF+924 25 A3500225 SPC 1 A3500226MESLEN ADC 2*LMES00 00 A3500227 ADC 2*LMES01 01 A3500228 ADC 2*32 02 A3500229 ADC 2*32 03 A3500230 ADC 2*32 04 A3500231 ADC 2*32 05 A3500232 ADC 2*32 06 A3500233 ADC 2*32 07 A3500234 ADC 2*32 08 A3500235 ADC 2*32 09 A3500236 ADC 2*32 10 A3500237 ADC 2*32 11 A3500238 ADC 2*32 12 A3500239 ADC 2*32 13 A3500240 ADC 2*32 14 A3500241 ADC 2*32 15 A3500242 ADC 2*32 16 A3500243 ADC 2*32 17 A3500244 ADC 2*32 18 A3500245 ADC 2*32 19 A3500246 ADC 2*32 20 A3500247ÐÐ ADC 2*32 21 A3500248 ADC 2*32 22 A3500249 ADC 2*32 23 A3500250 ADC 2*32 24 A3500251 ADC 2*32 25 A3500252 EJT A3500253 SPC 4 A3500254MESG00 ADC $181A A3500255 EQU LMES00(*-MESG00) A3500256 SPC 1 A3500257MESG01 ADC $1A1A A3500258 EQU LMES01(*-MESG01) A3500259 SPC 1 A3500260REQMSG NUM $D0A A3500261 NUM $A53 (LF,'S') A3500262 ALF $,ELECTION = $ A3500263 EQU REQLN(*-REQMSG) A3500264 SPC 1 A3500265REQBUF BZS REQBUF(9) FILE REQUEST BUFFER A3500266 ADC FCBUFF A3500267 BZS REQEND(14) A3500268 SPC 1 A3500269RECBUF BZS RECBUF(24*40) FILE RECORD BUFFER A3500270 EQU RECEND(*) RECORD BUFFER ENDING ADDRESS A3500271 SPC 1 A3500272ÐÐFCBUFF BZS FCBUFF(15) A3500273 SPC 2 A3500274 END A3500275 NAM NDWMTH A36 A ITOS CCS 3.0 SL-149A3600001* DOUBLE-WORD MATH SUBROUTINES - NONREETRANT VERSION A3600002* CREDIT COLLECTION SYSTEM VERSION 3.0 A3600003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A3600004* COPYRIGHT CONTROL DATA CORPORATION 1979 A3600005* A3600006* A3600007* THIS PACKAGE PROVIDES SUBROUTINES TO PERFORM A3600008* THREE DOUBLE WORD ARITHMETIC OPERATIONS. A3600009* THE DOUBLE WORD FORMAT IS THE SAME AS THE A3600010* MSB/LSB FORMAT USED FOR SECTOR AND WORD A3600011* ADDRESSING: WORD 1 OF A DOUBLE WORD VALUE A3600012* CONTAINS THE UPPER 15 BITS OF THE VALUE - AN A3600013* INTEGRAL MULTIPLE OF 32767, WORD 2 CONTAINS A3600014* THE LOWER 15 BITS OF THE VALUE (BIT 15 = 0). A3600015* IN THE FOLLOWING DESCRIPTIONS 'DWV' REFERS TO A3600016* 'DOUBLE WORD VALUE'. A3600017* A3600018* THE FOLLOWING OPERATIONS ARE IMPLEMENTED: A3600019* ADD A DWV TO A 2ND DWV A3600020* SUBTRACT A DWV FROM ANOTHER DWV A3600021* MULTIPLE A DWV BY A SINGLE WORD VALUE A3600022ÐÐ* A3600023* TO UTILIZE ONE OF THESE ROUITNES, THE CALLER A3600024* STORES THE VALUES TO BE OPERATED ON IN AN A3600025* ARRAY, SETS THE Q-REGISTER TO THE ADDRESS OF A3600026* THE ARRAY AND EXECUTES A RTJ TO THE APPROPRI- A3600027* ATE ROUTINE. THE I REGISTER CONTENTS WILL BE A3600028* SAVED AND RESTORED PRIOR TO RETURN TO THE A3600029* CALLER. THE COMPLETION STATUS WILL BE 0 IF A3600030* GOOD, ELSE IT WILL BE NON-ZERO. A3600031* A3600032* THE ENTRY POINT NAMES ARE AS FOLLOWS: A3600033 ENT DWADD DOUBLE WORD ADD A3600034 ENT DWSUB DOUBLE WORD SUBTRACT A3600035 ENT DWMUL DOUBLE WORD MULTIPLY A3600036* A3600037 EQU ZERO($22) A3600038 EQU ONEMSK(3) A3600039 EQU ONEBIT($23) A3600040 EJT A3600041* THE ARRAY PARAMETER LISTS ARE AS FOLLOWS: A3600042* FOR DWADD A3600043* WORD DESCRIPTION A3600044* 1 MSB OF 1ST DWV A3600045* 2 LSB OF 1ST DMV A3600046* 3 MSB OF 2ND DMV A3600047ÐÐ* 4 LSB OF 2ND DMV A3600048* 5 MSB OF RESULT DMV A3600049* 6 LSB OF RESULT DMV A3600050* 7 COMPLETION STATUS A3600051* A3600052* FOR DWSUB A3600053* WORD DESCRIPTION A3600054* 1 MSB OF MINUEND A3600055* 2 LSB OF MINUEND A3600056* 3 MSB OF SUBTRAHEND A3600057* 4 LSB OF SUBTRAHEND A3600058* 5 MSB OF RESULT A3600059* 6 LSB OF RESULT A3600060* 7 COMPLETION STATUS A3600061* FOR DWMUL A3600062* WORD DESCRIPTION A3600063* 1 MSB OF DWV A3600064* 2 LSB OF DMV A3600065* 3 SINGLE WORD VALUE A3600066* 4 MSB OF RESULT A3600067* 5 LSB OF RESULT A3600068* 6 COMPLETION STATUS A3600069* A3600070 EJT A3600071DWADD 000 000 DOUBLE WORD ADD ROUTINE A3600072ÐÐA1 LDA- I SAVE I-REG CONTENTS A3600073 STA* ISAVE A3600074 STQ- I SET I TO ARRAY ADDRESS A3600075 LDA- 1,I SET A TO LSB A3600076 ENQ 0 CLEAR Q FOR USE AS MSB OFFSET A3600077 SOV 0 CLEAR OVERFLOW STATUS A3600078 ADD- 3,I ADD LSB A3600079 SNO A2 SKIP TO A3 IF NO OVERFLOW A3600080 AND- ONEMSK+14 MASK OUT BIT 15 A3600081 INQ 1 BUMP Q TO PUT OVERFLOW IN MSB A3600082A2 SAP A3 SKIP IF RESULT POSITIVE A3600083 INQ -1 SUBTRACT 1 FROM Q FOR MSB OFFSET A3600084 ADD- ONEBIT+15 MAKE LSW POSITIVE A3600085A3 STA- 5,I STORE LSB A3600086 TRQ A TRANSFER MSB OFFSET TO A A3600087 SOV 0 CLEAR OVERFLOW A3600088 ADD- (ZERO),I ADD THE TWO MSBS TO THE OFFSET A3600089 ADD- 2,I A3600090 STA- 4,I STORE MSB A3600091 ENQ 0 CLEAR Q FOR COMPLETION STATUS A3600092 SOV A4 SET TO BAD COMPLETION IF OVERFLOW OR A-REG NEGA3600093 SAP A5 A3600094A4 ENQ 1 A3600095A5 STQ- 6,I A3600096 LDA- 2,I COMPLEMENT 2ND DWV IF COMPLEMENTED BY US A3600097ÐÐ SAP A6 SKIP IF NOT COMPLEMENTED A3600098 TCA A A3600099 STA- 2,I A3600100 LDA- 3,I A3600101 TCA A A3600102 STA- 3,I A3600103A6 LDA* ISAVE RESTORE I-REG A3600104 STA- I A3600105 JMP* (DWADD) A3600106 SPC 4 A3600107ISAVE NUM 0 A3600108 EJT A3600109DWSUB 000 0 DOUBLE WORD SUBTRACT ROUTINE A3600110 LDA* DWSUB A3600111 STA* DWADD STORE RETURN ADDRESS IN DWADD'S ENTRY POINT A3600112 LDA- 2,Q COMPLEMENT SUBTRAHEND AND USE DWADD TO ADD A3600113 TCA A A3600114 STA- 2,Q A3600115 LDA- 3,Q A3600116 TCA A A3600117 STA- 3,Q A3600118 JMP* A1 A3600119 EJT A3600120DWMUL 000 000 DOUBLE WORD MULTIPLY A3600121 LDA- I A3600122ÐÐ STA* ISAVE SAVE I-REG A3600123 STQ- I SET I TO ARRAY ADDRESS A3600124 LDA- 1,I SET A TO LSB OF DOUBLE WORD VALUE A3600125 MUI- 2,I MULTIPLY BY SINGLE WORD VALUE A3600126 LLS 1 A3600127 ALS 15 CONVERT TO DOUBLE PRECISION FORMAT A3600128 STQ* SAVE SAVE MSB A3600129 STA- 4,I STORE LSB IN RESULT A3600130 LDA- (ZERO),I A3600131 MUI- 2,I MULTIPLY MSB BY SINGLE WORD A3600132 LLS 1 A3600133 ALS 15 DOUBLE PRECISION FORMAT A3600134 SOV 0 CLEAR OVERFLOW A3600135 INQ 0 CHECK FOR OVERFLOW A3600136 SQZ 2 A3600137 LDQ- $11 SET OVERFLOW IND A3600138 INQ 1 A3600139 LDQ* SAVE ADD MSB THAT WAS SAVED A3600140 AAQ Q ADD IN RESULT FROM MSB MULTIPLY A3600141 STQ- 3,I STORE IN RESULT A3600142 CLR A A3600143 SOV M0 SKIP IF OVERFLOW A3600144 SQP M1 A3600145M0 INA 1 A3600146M1 STA- 5,I SET STATUS WORD, 0 IF GOOD, 1 IF BAD A3600147ÐÐ LDA* ISAVE RESTORE I-REG A3600148 STA- I A3600149 JMP* (DWMUL) RETURN TO CALLER A3600150 SPC 2 A3600151SAVE NUM 0 A3600152 END A3600153 NAM CHGTPT A37 A ITOS CCS 3.0 SL-149A3700001* TERMINAL MANAGER CHARACTER ROUTINES A3700002* CREDIT COLLECTION SYSTEM VERSION 3.0 A3700003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A3700004* COPYRIGHT CONTROL DATA CORPORATION 1979 A3700005* A3700006* CHARACTER HANDLING ROUTINES FOR ITOS TERMINAL MANAGER A3700007* INTEGER FUNCTION GETCHR(IARRAY,ICHAR) A3700008* SUBROUTINE PUTCHR(IVAR,IARRAY,ICHAR) A3700009 SPC 3 A3700010 ENT GETCHR A3700011 ENT PUTCHR A3700012 SPC 1 A3700013 EXT Q8PREP A3700014 EXT Q8PKUP A3700015 SPC 1 A3700016 EQU ZERO($22) A3700017 SPC 3 A3700018GETCHR NOP 0 A3700019ÐÐ STQ* SAVEQ SAVE CALLER'S Q-REGISTER A3700020 RTJ* (APREP) A3700021 ADC* GETCHR A3700022 RTJ* (APKUP) GET ARRAY ADDRESS A3700023 STA* IARRAY SAVE A3700024 RTJ* (APKUP) GET ADDRESS OF CHARACTER POSITION A3700025 LRQ- (ZERO),A CHARACTER POSITION TO Q A3700026 INQ -1 FORM CHARACTER INDEX A3700027 LCA* (IARRAY),Q PICK UP CHARACTER A3700028 LDQ* SAVEQ RESTORE CALLER'S Q-REGISTER A3700029 JMP* (GETCHR) RETURN WITH CHARACTER IN A A3700030 SPC 2 A3700031APREP ADC Q8PREP A3700032APKUP ADC Q8PKUP A3700033SAVEQ ADC 0 A3700034IARRAY ADC 0 ADDRESS OF ARRAY A3700035IVAR ADC 0 ADDRESS OF VARIABLE A3700036 SPC 2 A3700037PUTCHR NOP 0 A3700038 STQ* SAVEQ SAVE CALLER'S Q-REGISTER A3700039 RTJ* (APREP) A3700040 ADC* PUTCHR A3700041 RTJ* (APKUP) PICK UP CHARACTER ADDRESS A3700042 STA* IVAR SAVE A3700043 RTJ* (APKUP) GET ARRAY ADDRESS A3700044ÐÐ STA* IARRAY SAVE A3700045 RTJ* (APKUP) GET ADDRESS OF CHARACTER POSITION A3700046 LRQ- (ZERO),A PICK UP CHARACTER POSITION A3700047 INQ -1 FORM CHARACTER INDEX A3700048 LDA* (IVAR) CHARACTER TO A A3700049 SCA* (IARRAY),Q STORE CHARACTER IN ARRAY A3700050 LDQ* SAVEQ RESTORE CALLER'S Q-REGISTER A3700051 JMP* (PUTCHR) RETURN A3700052 END A3700053 NAM DBATOU A38 A ITOS CCS 3.0 SL-149A3800001* DEFERRED BATCH OUTPUT DRIVER A3800002* CREDIT COLLECTION SYSTEM VERSION 3.0 A3800003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A3800004* COPYRIGHT CONTROL DATA CORPORATION 1979 A3800005* A3800006**** A3800007*E A3800008* FUNCTION A3800009* -------- A3800010* A3800011* A3800012* A3800013* THIS PSEUDO DRIVER ROUTES THE OUTPUT FROM DEFERRED A3800014* BATCH PROCESSING TO FILE MANAGER FILES FOR SUBSEQUENT A3800015* LISTING OR REVIEW AT A PRINT DEVICE OR AN ITOS USER A3800016ÐÐ* TERMINAL. A3800017* A3800018* A3800019* A3800020* A3800021* A3800022* GENERAL DESCRIPTION A3800023* ------------------- A3800024* A3800025* A3800026* A3800027* A CHECK IS MADE ON ENTRY TO DETERMINE IF THE REQUEST A3800028* IS A MOTION COMMAND. IF NOT THEN A SCRATCH FILE IS A3800029* CREATED VIA THE FILE MANAGER IF ONE DOES NOT ALREADY A3800030* EXIST FOR THIS LOGICAL UNIT. IN ORDER TO IDENTIFY THE A3800031* JOB THE REQUESTOR'S BUFFER IS SEARCHED FOR THE FOL- A3800032* LOWING CHARACTER STRING: *JOB,JMNN ; WHERE MNN ARE A3800033* UNIQUE DIGITS. THE JOB ID, IF ANY, IS SAVED FOR LATTER A3800034* USE. THE REQUESTOR'S RECORD AND EACH SUBSEQUENT RECORD A3800035* IS PUT IN THE SCRATCH FILE. A3800036* A3800037* AN EOF MOTION REQUEST INDICATES END OF JOB FOR THIS A3800038* LOGICAL UNIT. THE NUMBER OF RECORDS IN THE SCRATCH A3800039* FILE IS THEN REDUCED TO THE ACTUAL NUMBER OF RECORDS A3800040* STORED IN IT. IF THE JOB HAS BEEN IDENTIFIED, THE A3800041ÐÐ* STATUS OF THE JOB IS UPDATED IN THE APPROPRIATE $$HOST A3800042* FILE ENTRY. IF THE JOB STATUS WAS DISCARD PENDING A3800043* THEN THE SCRATCH FILE IS DELETED. IF NOT, THE A3800044* APPROPRIATE $$BATCH FILE ENTRY IS UPDATED WITH THE A3800045* PRESENT DATE/TIME JOB RECEIVED AND THE SCRATCH FILE A3800046* IS RENAMED WITH THE JOB ID (JMNN). A3800047* A3800048* IF THE JOB IS UNIDENTIFIED, THE $$PRINT FILE IS A3800049* ACCESSED FOR AN AVAILABLE ENTRY AND UPDATED WITH FILE A3800050* VOLUME NAME, DATE/TIME OF ENTRY, AND NUMBER OF RECORDS A3800051* IN THE FILE. THE SCRATCH FILE IS THEN RENAMED PRXX A3800052* WHERE XX IS BASED ON THE $$PRINT FILE ENTRY. A3800053* A3800054* THE ONLY OTHER MOTION REQUEST ALLOWED IS BACKSPACE A3800055* ONE FILE. THIS CAUSES THE SCRATCH FILE TO BE DELETED A3800056* AND ALL RECORDS THEREIN ARE LOST. A3800057* A3800058* A3800059* A3800060* A3800061* A3800062* ENTRY A3800063* ----- A3800064* A3800065* A3800066ÐÐ* A3800067* ENTRY IS AT THE INITIATOR DBATOU VIA NORMAL FWRITE A3800068* AND MOTION REQUESTS. THERE ARE NO CONTINUATOR OR A3800069* ERROR ENTRIES. A3800070* A3800071* A3800072* A3800073* A3800074* A3800075* EXIT A3800076* ---- A3800077* A3800078* A3800079* A3800080* NORMAL EXIT IS MADE TO THE DISPATCHER AFTER ALL A3800081* REQUESTS ARE PROCESSED. A3800082* A3800083* EXIT ON ERROR IS TO THE ALTERNATE DEVICE HANDLER WITH A3800084* THE SOFTWARE DUMMY DEVICE AS ALTERNATE. A3800085* A3800086* A3800087* A3800088* A3800089* A3800090* ENTRY POINTS A3800091ÐÐ* ------------ A3800092* A3800093* A3800094* A3800095 ENT DBATOU INITIATOR ENTRY A3800096 ENT ABSADD ADDRESS ABSOLUTIZING ROUTINE A3800097* A3800098* A3800099* A3800100* A3800101* A3800102* EXTERNAL REFERENCES A3800103* ------------------- A3800104* A3800105* A3800106* A3800107 EXT ALTDEV ALTERNATE DEVICE HANDLER A3800108 EXT MAS300 A3800109 EXT DAYTO CURRENT DAY (INTEGER) A3800110 EXT MONTO CURRENT MONTH (INTEGER) A3800111 EXT YERTO CURRENT YEAR (INTEGER) A3800112 EXT HORTO CURRENT HOUR (INTEGER) A3800113 EXT MINTO CURRENT MINUTE (INTEGER) A3800114 EXT SECON CURRENT SECOND (INTEGER) A3800115 EXT WKSPLU VOLUME UNIT FOR SCRATCH FILE DEFINITION A3800116ÐÐ EXT MMLUTB FILE MANAGER VOLUME INFORMATION TABLE A3800117 EXT SYFAIL SYSTEM FAILURE PROCESSOR A3800118 EXT* CREAT FILE MANAGER CREATE FILE REQUEST. A3800119 EXT* DELET FILE MANAGER DELETE FILE REQUEST. A3800120 EXT* REDUC FILE MANAGER REDUCE FILE REQUEST. A3800121 EXT* PUTZ FILE MANAGER PUTS REQUEST. A3800122 EXT* RENAM FILE MANAGER RENAME FILE REQUEST. A3800123 EXT* BOPENF BATCH DRIVER OPEN FILE ROUTINE A3800124 EXT* OPHOST BATCH DRIVER OPEN $$HOST FILE ROUTINE A3800125 EXT* OPBATF BATCH DRIVER OPEN $$BATCH FILE ROUTINE A3800126 EXT* BCLOSF BATCH DRIVER CLOSE FILE ROUTINE A3800127 EXT* BREADR BATCH DRIVER READ SPECIFIC RECORD ROUTINE A3800128 EXT* BGETS BATCH DRIVER RETRIEVE NEXT RECORD ROUTINE A3800129 EXT* BUPREC BATCH DRIVER STORE UPDATED RECORD ROUTINE A3800130 EXT* BFWRIT BATCH DRIVER WRITE COMMENT DEVICE MSG A3800131 EXT* BTIMER BATCH DRIVER TIMER REQUEST ROUTINE A3800132* A3800133* A3800134* A3800135* A3800136* A3800137* EQUATES A3800138* ------- A3800139 EQU LPMSK(2) LOGICAL PRODUCT MASK A3800140 EQU ONE($3) LOCATION 3 CONTAINS $1 A3800141ÐÐ EQU NZERO($12) NEG-ZERO MASK ($FFFF) A3800142 EQU NONE($13) NEG-ONE IN LOCORE ($FFFE) A3800143 EQU ZERO($22) LOCATION $22 CONTAINS 0 A3800144 EQU TEN($46) DECIMAL TEN A3800145 EQU FNR($B5) ADDRESS OF FNR A3800146 EQU COMPRQ($B6) ADDRESS OF COMPRQ A3800147 EQU ECT($E9) ADDRESS OF EXTENDED CORE TABLE A3800148 EQU DISP($EA) LOCATION OF DISPATCHER A3800149* A3800150 EQU MAXTRY($B) MAXIMUM NUMBER OF RETRY PERMITTED ($01FF) A3800151 EQU EOF(2) EOF MOTION CODE A3800152 EQU BSF(6) BACKSPACE FILE MOTION CODE A3800153 EQU MOT(14) MOTION REQUEST CODE A3800154 EQU ESC($1B) ESCAPE CODE USED BY HASP OUTPUT A3800155 EQU MAXWDS(72) MAX NUMBER WORDS PER USER REQUEST A3800156 EQU RECBFL(74) RECBUF LENGTH -1 A3800157 EQU RCLENG(146) RECORD LENGTH IN BYTES OF SCRATCH FILE A3800158 EQU NUMRC(9999) MAXIMUM NUMBER OF RECORDS SCRATCH FILE A3800159 EQU BCMSK($6420) CREATE FILE BUSY MASK, RETRY PERMITTED A3800160 EQU BOSMSK($6A27) OPEN SCRATCH FILE BUSY MASK A3800161 EQU HBMSKO($6A23) BUSY MASK FOR $$HOST OPEN REQUEST A3800162 EQU BGETSM($61B0) BUSY MASK FOR GETS REQUEST A3800163 EQU HBMSKR($6334) BUSY MASK FOR HOST READR RQST A3800164* A3800165* RELATIVE ADDRESSES INTO PHYSICAL DEVICE TABLE A3800166ÐÐ* -------------- A3800167* A3800168* A3800169* A3800170 EQU ELVL(0) PBATXX ADC $5200+LVL SCHDL CALL A3800171 EQU EDIN(1) ADC DBATIN INITIATOR A3800172 EQU EDCN(2) ADC 0 (NOT USED) A3800173 EQU EDPGM(3) ADC 0 (NOT USED) A3800174 EQU EDCLK(4) NUM -1 (NOT USED) A3800175 EQU ELU(5) NUM 0 LOGICAL UNIT A3800176 EQU EPTR(6) NUM 0 REQ LOCATION A3800177 EQU EWES(7) NUM 0 (NOT USED) A3800178 EQU EREQST(8) NUM $08A4 REQ. STATUS A3800179 EQU ESTAT1(9) NUM 0 DRIVER STATUS A3800180 EQU ECCOR(10) NUM 0 CURRENT LOC. A3800181 EQU ELSTWD(11) NUM 0 LWA+1 A3800182 EQU ESTAT2(12) NUM 0 DEVICE STATUS A3800183 EQU MASLGN(13) NUM 0 MM LENGTH A3800184 EQU MASSEC(14) NUM $7FFF MM SECTOR A3800185 EQU RETURN(15) NUM 0 RESERVED A3800186 EQU HSTRNO(16) NUM 0,0 $$HOST REL A3800187* REC. NO. A3800188 EQU HSTNN(18) NUM 0 TERM/JOB ID A3800189 EQU ERSTAT(19) NUM 0 FM ERR STATUS A3800190 EQU TIMTRY(20) NUM $8000 ENABLE DIAG/ A3800191ÐÐ* FM CODE/TRYS A3800192 EQU JOBKEY(21) ALF 2,J $$BATCH KEY A3800193 EQU MOTPAR(23) NUM 0 MOTION PARM. A3800194 EQU RTJCAL(24) BZS RTJBF(13) FM/MONI CALLS A3800195 EQU REQBUF(37) BZS REQBUF(24) FM 'REQBUF' A3800196 EQU IDATA(61) BZS IDATBF(24) FM 'IDATA' A3800197 EQU ISTAT(85) BZS ISTABF(1) FM 'ISTAT' A3800198 EQU RECBUF(86) BZS RECBF(75) FM 'RECBUF' A3800199* A3800200 EQU NEWNAM(IDATA+15) A3800201 EQU NMBREC(IDATA+22) A3800202 EQU RELREC(IDATA+23) A3800203**** A3800204 EJT A3800205STARTM STQ- I MASS MEMORY ENTRY TO DRIVER A3800206 LDQ =XDBATOU-STARTM A3800207 AAQ Q A3800208 STQ- 1,I SET UP INITIATOR ENTRY A3800209 JMP* DBO010 A3800210MS300 ADC MAS300 A3800211DBATOU EQU DBATOU(*) INITIATOR ENTRY A3800212 STQ- I PHYTAB ADR TO I-REG A3800213DBO010 EQU DBO010(*) A3800214 RTJ- (FNR) FIND NEXT RQST A3800215 JMP* (MS300) NO RQST OUTSTANDING A3800216ÐÐ* A3800217* START PROCESSING REQUEST A3800218* A3800219 ENA 0 INITIALIZE PHYTAB- A3800220 STA- ERSTAT,I REPORTED FM ERROR STATUS A3800221 SFA- TIMTRY,14,15,I FM RQST CODE/TIMER TRYS A3800222 STA- MOTPAR,I MOTION PARAMETER A3800223* A3800224* CHECK FOR MOTION REQUEST A3800225* A3800226 LDQ- EPTR,I PARAMETER LOCATION IN Q-REG A3800227 LFA- (ZERO),13,5,Q A-REG = RQST CODE A3800228 INA -MOT SUBTRACT MOTION RQST CODE ($E) A3800229 SAN DBO020 SKIP IF NOT MOTION RQST A3800230 JMP DBO320 GO PROCESS MOTION RQST A3800231* A3800232* PROCESS FWRITE REQUEST A3800233* A3800234DBO020 EQU DBO020(*) A3800235 SFZ- HSTNN,13,1,I SKIP IF SCRATCH FILE NOT CREATED A3800236 JMP* DBO130 CONTINUE PROCESSING A3800237* A3800238* SETUP TO CREATE SCRATCH FILE A3800239DBO030 EQU DBO030(*) A3800240 ENA 0 A3800241ÐÐ STA- JOBKEY,I INIT JOBKEY A3800242 STA- JOBKEY+1,I A3800243 ENQ 23 CLEAR IDATA A3800244DBO040 EQU DBO040(*) A3800245 STA- IDATA,B A3800246 DQP *-DBO040 A3800247 ENA 5 SET CODE FOR 'CREATE' A3800248 SFA- TIMTRY,12,4,I A3800249 RTJ DBO570 SETUP NAME, OWNER, VOLUME IN IDATA 1-12 A3800250 LDA* RECLEN RECORD LENGTH IN BYTES A3800251 STA- IDATA+12,I A3800252 LDA* NUMREC LSB NUMBER OF RECORDS A3800253 STA- IDATA+14,I A3800254 JMP* DBO045 GO SETUP 'CREATE' REQUEST A3800255RECLEN ADC RCLENG RECORD LENGTH IN BYTES A3800256NUMREC ADC NUMRC MAXIMUM NUMBER OF RECORDS TO BE STORED A3800257 EJT A3800258* A3800259* THE FOLLOWING CODE STARTING AT LABEL 'CENTRY' THRU A3800260* LABEL 'CCALTH' IS NOT EXECUTED IN THE DRIVER, BUT IS A3800261* BUILT AND MOVED TO THE PHYSTB. THE CODE IS THEN A3800262* EXECUTED FROM THE PHYSTB WITH RETURN TO THE DRIVER. A3800263* A3800264CENTRY NUM 0 ENTRY A3800265CEN010 RTJ+ SYFAIL CREATE FILE REQUEST A3800266ÐÐ ADC (REQBUF-RTJCAL-3) REL ADR TO 'REQBUF' PARAMETER A3800267 ADC (IDATA-RTJCAL-4) A3800268 ADC (ISTAT-RTJCAL-5) A3800269 LDA- ISTAT,I PICKUP 'CREATE' REQUEST STATUS A3800270 STA- ERSTAT,I SAVE REQUEST STATUS A3800271 JMP* (CENTRY) RETURN TO CALLER A3800272CCALTH EQU CCALTH(*-CENTRY-1) A3800273* A3800274* CALLER'S Q/I REGISTERS PRESERVED BY FM A3800275* A3800276 EJT A3800277DBO045 RTJ ABSADD ABSOLUTIZE THE FILE REQUEST ADDRESS A3800278 ADC* CREAT A3800279 STA* CEN010+1 STORE IN THE REQUEST A3800280 ENQ CCALTH MOVE 'CREATE' ROUTINE TO PHYSTB A3800281DBO047 EQU DBO047(*) A3800282 LDA* CENTRY,Q A3800283 STA- RTJCAL,B A3800284 DQP *-DBO047 A3800285DBO050 EQU DBO050(*) A3800286 RTJ- RTJCAL,I GO EXECUTE ROUTINE IN PHYSTB A3800287* A3800288* RETURN FROM 'CREATE' ROUTINE IN PHYSTB, A-REG = ISTAT A3800289* A3800290* A3800291ÐÐ* CHECK FM STATUS A3800292* A3800293* REG A IS RQST STATUS A3800294 LR1- NZERO REG 1 IS NO REJECT MASK A3800295 LDQ =XBCMSK REG Q IS REJECT BUSY MASK A3800296 RTJ RETRY CHECK IF BUSY, RETRY PERMITTED A3800297 JMP* DBO050 BUSY, RETRY A3800298* A3800299* IF ERROR RETURN IS TO ERROR ROUTINE. A3800300* RETURN HERE IF NO ERROR. A3800301* A3800302* A3800303* OPEN SCRATCH FILE WITH FILE LOCK A3800304* A3800305DBO080 EQU DBO080(*) A3800306 SEF- HSTNN,13,1,I SET SCRATCH FILE CREATED FLAG A3800307 ENA 0 A3800308 STA- IDATA+12,I IDATA(13) ACCESS INDICATOR A3800309 INA 1 A3800310 STA- IDATA+13,I IDATA(14) NUMBER RECORDS PER RETRIEVE A3800311 INA -2 A3800312 STA- IDATA+14,I IDATA(15) LOCK ENTIRE FILE (<0) A3800313DBO090 EQU DBO090(*) A3800314 RTJ BOPENF OPEN THE SCRATCH FILE A3800315* A3800316ÐÐ* CHECK FM STATUS, IF PERMITTED RETRY ON ERROR A3800317* A3800318* REG A IS RQST STATUS A3800319 ENQ -4 A3800320 XFQ 1 REG 1 IS NO REJECT MASK A3800321 LDQ =XBOSMSK REG Q IS REJECT BUSY MASK A3800322 RTJ RETRY CHECK IF BUSY, RETRY PERMITTED A3800323 JMP* DBO090 BUSY, RETRY A3800324* A3800325* IF ERROR RETURN IS TO ERROR ROUTINE. A3800326* RETURN HERE IF NO ERROR. A3800327* A3800328* A3800329* PROCESS REQUESTOR'S BUFFER A3800330* A3800331DBO130 EQU DBO130(*) A3800332 LDA =A PREPARE TO BLANK RECBUF A3800333DBO135 EQU DBO135(*-1) A3800334 ENQ RECBFL RECBUF LENGTH -1 A3800335DBO140 EQU DBO140(*) A3800336 STA- RECBUF,B BLANK RECBUF A3800337 DQP *-DBO140 A3800338 LDA- ELSTWD,I COMPUTE LENGTH OF RQST A3800339 SUB- ECCOR,I A3800340 STA- RELREC,I SAVE RQST LENGTH TEMPORARILY A3800341ÐÐ INA -9 BYPASS CHARACTER CHECKING IF .LT. 9 A3800342 SAP DBO150 SKIP IF MORE THAN 8 A3800343 JMP* DBO220 BYPASS CHARACTER CHECK A3800344* A3800345* SETUP TO BYPASS ESCAPE, CARRIAGE CONTROL SEQUENCE A3800346* IF HASP JOB A3800347* A3800348DBO150 EQU DBO150(*) A3800349 ENQ 0 Q-REG IS CHARACTER INDEX A3800350 LDA- ECCOR,I A3800351 STA* START START IS 1ST LOCATION IN RQST BFR A3800352DBO160 EQU DBO160(*) A3800353 ENA ESC A-REG HAS ESCAPE CHAR A3800354 CCE* (START),Q A3800355 JMP* DBO170 NO COMPARE, NOT ESCAPE A3800356 INQ 2 ESCAPE, SET TO CHECK NEXT PAIR A3800357 TRQ A SEE IF RQST BFR EXHAUSTED A3800358 SUB- RELREC,I SUBTRACT BFR LENGTH A3800359 SAP DBO185 SKIP IF BFR EXHAUSTED A3800360 JMP* DBO160 A3800361START NUM 0 A3800362* A3800363* SETUP TO CHECK FOR - *JOB,J - CHARACTERS A3800364* A3800365DBO170 EQU DBO170(*) A3800366ÐÐ QRS 1 Q-REQ IS NOW WORD INDEX IN RQST BFR A3800367 ADQ* START A3800368 STQ* START START IS NOW 1ST WORD ADR TO SEARCH A3800369 ENQ 5 COMPARE NEXT 2-6 CHARACTERS A3800370* JOB PROCESSOR CHANGES ASTERISK A3800371* TO CONTROL CHARACTER A3800372 ENA 4 A3800373 XFA 1 A3800374DBO180 EQU DBO180(*) A3800375 LCA* (START),Q A3800376 CCE* JOB,Q A3800377DBO185 JMP* DBO200 NO COMPARE, NOT - *JOB,J - STRING A3800378 INQ -1 A3800379 D1P *-DBO180 COMPARED OK, CHECK NEXT WORD A3800380* A3800381* IT IS A *JOB RECORD, PICKUP AND SAVE JOB NUMBER A3800382* A3800383 ENQ 5 Q-REG IS CHARACTER INDEX TO START A3800384 ENA 0 A3800385 XFA 2 REG-2 IS CHARACTER INDEX TO STORE A3800386 ENA 3 A3800387 XFA 1 REG-1 IS LOOP INDEX A3800388DBO190 EQU DBO190(*) A3800389 LCA* (START),Q PICKUP JOB NAME (JMNN) A3800390 SCA- JOBKEY,2,I AND SAVE FOR JOBKEY A3800391ÐÐ AR2- ONE A3800392 INQ 1 A3800393 D1P *-DBO190 A3800394 JMP* DBO220 JOBNAM SAVED, CONTINUE PROCESSING A3800395 SPC 2 A3800396JOB ALF 3,*JOB,J JOB IDENTIFICATION RECORD A3800397 EJT A3800398* A3800399* SETUP TO CHECK FOR - END OF JOB - CHARACTERS A3800400* IN POSITION 15-24 (ONLY USED FOR 200UT JOBS) A3800401* **** N O T E **** A3800402* THE TECHNIQUE USED FOR 200UT END-OF-JOB A3800403* DETERMINATION IS SPECIFIC FOR THE A3800404* SUNNYVALE HOST. OTHER 200UT HOSTS MAY A3800405* OR MAY NOT MEET THESE REQUIREMENTS. A3800406* ****************** A3800407* A3800408DBO200 EQU DBO200(*) A3800409 SFZ- HSTNN,12,1,I A3800410 JMP* DBO220 EOJ ALREADY FOUND, CONTINUE PROCESSING A3800411 ENQ 14 SETUP TO SEARCH AT CHARATER 15 A3800412 ENA 0 A3800413 XFA 1 REG-1 IS CHARACTER INDEX TO COMPARE A3800414 ENA 9 A3800415 XFA 2 REG-2 IS LOOP COUNTER (10 CHARACTERS) A3800416ÐÐDBO210 EQU DBO210(*) A3800417 LCA* (START),Q A3800418 CCE* EOJ,1 A3800419 JMP* DBO220 NOT EQUAL, CONTINUE PROCESSING A3800420 INQ 1 CHAR MATCH, CHECK NEXT ONE A3800421 AR1- ONE A3800422 D2P *-DBO210 A3800423 SEF- HSTNN,12,1,I SET 200UT END OF JOB FLAG A3800424 SEF- HSTNN,8,1,I THERE IS 1 MORE RECORD (ALL BLANKS) AFTER EOJ A3800425 JMP* DBO240 GO STORE THE RECORD A3800426 SPC 2 A3800427EOJ ALF 5,END OF JOB 200UT EOJ RECORD IN CHARACTERS 15-24 A3800428 EJT A3800429* A3800430* CHECK TO SEE IF AT END OF SCRATCH FILE A3800431* A3800432DBO220 EQU DBO220(*) A3800433 SFZ- HSTNN,11,1,I SKIP IF INSUFFIEIENT SPACE FLAG NOT SET A3800434 JMP* DBO310 OUT OF SPACE, IGNORE RECORD A3800435 SFN- TIMTRY,12,4,I SKIP IF LAST FM RQST NOT OPEN A3800436 JMP* DBO240 SCRATCH FILE JUST OPENED A3800437 LDA- REQBUF+16,I LSB RELATIVE RECORD LAST STORED A3800438 SUB NUMREC MAX NUMBER OF RECORDS DEFINED A3800439 INA 1 LOOKING FOR LAST RECORD MINUS ONE A3800440 SAP DBO225 SKIP IF SPACE NOT AVAILABLE A3800441ÐÐ JMP* DBO240 SPACE AVAILABLE, GO SETUP TO STORE RECORD A3800442DBO225 EQU DBO225(*) A3800443 SEF- HSTNN,11,1,I THIS IS THE LAST RECORD, SET FLAG A3800444 ENQ LNALRT LENGTH OF ALERT MSG A3800445 STQ- RECBUF,I A3800446 INQ -1 A3800447DBO230 EQU DBO230(*) A3800448 LDA* ALRT,Q MOVE ALERT MSG TO RECBUF A3800449 STA- RECBUF+1,B A3800450 DQP *-DBO230 A3800451 SEF- HSTNN,10,1,I SET ALERT OPERATOR FLAG A3800452 JMP* DBO280 GO STORE THE RECORD IN SCRATCH FILE A3800453* A3800454* ALERT MESSAGE, SCRATCH FILE SPACE EXCEEDED A3800455* A3800456ALRT EQU ALRT(*) A3800457 ALF ., WARNING: OUTPUT DATA EXCEEDED OUTPUT FILE SPACE. A3800458LNALRT EQU LNALRT(*-ALRT) A3800459 EJT A3800460* A3800461* SETUP TO WRITE THE RECORD TO THE SCRATCH FILE A3800462* A3800463DBO240 EQU DBO240(*) A3800464 ENA MAXWDS MAKE SURE RQST .LE. MAX WORDS PERMITTED A3800465 SUB- RELREC,I A3800466ÐÐ SAP DBO250 SKIP IF LENGTH OF RQST OK A3800467 ENQ MAXWDS OTHERWISE MAK LENGTH .EQ. MAX WORDS A3800468 JMP* DBO260 A3800469DBO250 EQU DBO250(*) A3800470 LDQ- RELREC,I A3800471DBO260 EQU DBO260(*) A3800472 STQ- RECBUF,I SAVE NUMBER OF WORDS A3800473 INQ -1 SETUP INDEX TO MOVE RECORD A3800474 LR1- ELSTWD,I A3800475DBO270 EQU DBO270(*) A3800476 AR1- NONE MOVE RECORD TO RECBUF A3800477 LRA- (ZERO),1 A3800478 STA- RECBUF+1,B A3800479 DQP *-DBO270 A3800480* A3800481* STORE RECORD SEQUENTIALLY IN SCRATCH FILE A3800482* A3800483DBO280 EQU DBO280(*) A3800484 ENA 8 SET CODE FOR 'PUTS' A3800485 SFA- TIMTRY,12,4,I A3800486 ENA 1 ONE RECORD TO BE STORED A3800487 STA- NMBREC,I A3800488 RTJ* ABSADD ABSOLUTIZE THE FILE REQUEST ADDRESS A3800489 ADC* PUTZ A3800490 STA* PEN010+1 STORE IN THE REQUEST A3800491ÐÐ ENQ PCALTH MOVE 'PUTS' ROUTINE TO PHYSTB A3800492DBO285 EQU DBO285(*) A3800493 LDA* PENTRY,Q A3800494 STA- RTJCAL,B A3800495 DQP *-DBO285 A3800496 RTJ- RTJCAL,I GO EXECUTE ROUTINE IN PHYSTB A3800497* A3800498* RETURN FROM 'PUTS' ROUTINE IN PHYSTB, A-REG = ISTAT A3800499* A3800500 SAP DBO286 SKIP IF RQST NOT REJECTED A3800501 JMP* DBO340 GO CLOSE AND DELETE SCRATCH FILE A3800502DBO286 EQU DBO286(*) A3800503 AND- LPMSK+4 A3800504 SAZ DBO287 SKIP IF RECORD STORED A3800505 SEF- HSTNN,10,1,I SET ALERT OPERATOR FLAG A3800506DBO287 EQU DBO287(*) A3800507 LDA- REQBUF+16,I SAVE RELATIVE RECORD NUMBER STORED A3800508 STA- RELREC,I A3800509 SFN- HSTNN,12,1,I SKIP IF 200UT END OF JOB RECORD A3800510 JMP* DBO290 GO CHECK FOR ALERT OPR A3800511 SFN- HSTNN,8,1,I SKIP, ONE MORE 200UT RECORD TO PROCESS A3800512 JMP* DBO288 LAST RECORD A3800513 CLF- HSTNN,8,1,I A3800514 JMP* DBO290 A3800515DBO288 EQU DBO288(*) A3800516ÐÐ ENA EOF EOF MOTION PARAMETER A3800517 STA- MOTPAR,I HANDLE 200UT END OF JOB AS IF EOF A3800518 JMP* DBO340 A3800519 EJT A3800520* A3800521* THE FOLLOWING CODE STARTING AT LABEL 'PENTRY' THRU A3800522* LABEL 'PCALTH' IS NOT EXECUTED IN THE DRIVER, BUT IS A3800523* BUILT AND MOVED TO THE PHYSTB. THE CODE IS THEN A3800524* EXECUTED FROM THE PHYSTB WITH RETURN TO THE DRIVER. A3800525* A3800526PENTRY NUM 0 ENTRY A3800527PEN010 RTJ+ SYFAIL PUTS FILE REQUEST A3800528 ADC (REQBUF-RTJCAL-3) REL ADR TO 'REQBUF' PARAMETER A3800529 ADC (RECBUF-RTJCAL-4) REL ADR TO 'RECBUF' PARAMETER A3800530 ADC (NMBREC-RTJCAL-5) REL ADR TO 'NUMREC' PARAMETER A3800531 ADC (ISTAT-RTJCAL-6) REL ADR TO 'ISTAT' PARAMETER A3800532 LDA- ISTAT,I A3800533 STA- ERSTAT,I A3800534 JMP* (PENTRY) A3800535PCALTH EQU PCALTH(*-PENTRY-1) A3800536* A3800537* CALLER'S Q/I REGISTERS PRESERVED BY FM A3800538* A3800539 EJT A3800540DBO290 EQU DBO290(*) A3800541ÐÐ SFN- HSTNN,10,1,I SKIP IF ALERT OPERATOR SET A3800542 JMP* DBO310 GO COMPLETE REQUEST A3800543* A3800544* MOVE ALERT MSG TO RECBUF, WRITE ON COMMENT DEVICE A3800545* A3800546 ENQ LNALRT LENGTH OF MSG A3800547 INQ -1 A3800548DBO300 EQU DBO300(*) A3800549 LDA* ALRT,Q MOVE MSG TO RECBUF A3800550 STA- RECBUF,B A3800551 DQP *-DBO300 A3800552 ENA LNALRT MSG LENGTH A3800553 RTJ BFWRIT WRITE THE MSG A3800554 ENA 2 A3800555 SFA- HSTNN,11,2,I SET INSUFFICIENT SPACE, RESET ALERT OPR A3800556* A3800557* COMPLETE THE REQUEST A3800558* A3800559DBO310 EQU DBO310(*) A3800560 RTJ- (COMPRQ) COMPLETE REQUEST A3800561 JMP DBO010 GO FIND NEXT RQST A3800562 EJT A3800563* A3800564* MOTION REQUEST HANDLING A3800565* A3800566ÐÐDBO320 EQU DBO320(*) A3800567 LFA- 4,14,3,Q Q-REG IS PARAMETER ADR, GET CODE A3800568 STA- MOTPAR,I SAVE CODE, IGNORE REPEAT BIT A3800569 INA -2 CHECK FOR EOF A3800570 SAZ DBO330 SKIP IF EOF A3800571 INA -4 CHECK FOR BSF A3800572 SAZ DBO330 SKIP IF BSF A3800573 ENA 0 MOTION RQST NOT VALID A3800574 STA- MOTPAR,I CLEAR THE MOTION PARAMETER A3800575 JMP* DBO310 AND COMPLETE THE RQST A3800576DBO330 EQU DBO330(*) A3800577 SFN- HSTNN,13,1,I SKIP IF SCRATCH FILE IS CREATED A3800578 JMP* DBO310 SCRATCH FILE DOES NOT EXIST, COMPLETE A3800579* A3800580* SETUP TO CLOSE THE SCRATCH FILE A3800581* A3800582DBO340 EQU DBO340(*) A3800583 RTJ BCLOSF CLOSE SCRATCH FILE A3800584 STA- ERSTAT,I A3800585 INA -4 A=ISTAT ON RETURN A3800586 SAZ DBO350 SKIP IF NO ERROR A3800587 ENA 1 'CLOSE' RQST CODE A3800588 SFA- TIMTRY,12,4,I A3800589 ENA 0 INDICATE CANNED MSG A3800590 RTJ BFWRIT POST DIAGNOSTIC MSG A3800591ÐÐ LDA- ERSTAT,I GET STATUS A3800592 SAP DBO350 SKIP IF NO REJECT,BUT FILE NOT UNLOCKED A3800593 JMP* DBO387 GO HANDLE ERROR A3800594DBO350 EQU DBO350(*) A3800595 LDA- MOTPAR,I A3800596 INA -2 SEE IF MOTION RQST FOR EOF A3800597 SAN DBO360 SKIP IF NOT EOF A3800598 JMP* DBO380 GO PROCESS EOF A3800599* A3800600* SETUP TO DELETE SCRATCH FILE A3800601* A3800602DBO360 EQU DBO360(*) A3800603 RTJ DBO570 SETUP IDATA A3800604 ENA 9 SET RQST CODE FOR 'DELETE' A3800605 SFA- TIMTRY,12,4,I A3800606 RTJ* ABSADD ABSOLUTIZE THE FILE REQUEST ADDRESS A3800607 ADC* DELET A3800608 STA* DEN010+1 STORE IN THE REQUEST A3800609 ENQ DCALTH MOVE 'DELETE' ROUTINE TO PHYSTB A3800610DBO365 EQU DBO365(*) A3800611 LDA* DENTRY,Q A3800612 STA- RTJCAL,B A3800613 DQP *-DBO365 A3800614 RTJ- RTJCAL,I GO EXECUTE ROUTINE IN PHYSTB A3800615* A3800616ÐÐ* RETURN FROM 'DELETE' ROUTINE IN PHYSTB, A-REG = ISTAT. A3800617* A3800618 SAZ DBO370 A=ISTAT ON RETURN, SKIP IF NO ERROR A3800619 JMP* DBO387 GO POST THE ERROR A3800620DBO370 EQU DBO370(*) A3800621 LFA- MOTPAR,2,3,I PICKUP MOTION RQST A3800622 SAN DBO375 SKIP IF MOTION RQST A3800623 JMP DBO920 GO TO ERROR EXIT A3800624DBO375 EQU DBO375(*) A3800625 CLF- HSTNN,13,5,I CLEAR STATUS BITS A3800626 JMP* DBO310 GO COMPLETE RQST A3800627 SPC 2 A3800628* A3800629* ADDRESS ABSOLUTIZING ROUTINE A3800630* A3800631ABSADD NOP 0 A3800632 SPC 1 A3800633 LDA* (ABSADD) A = RELATIVE ADDRESS OF FILE REQUEST A3800634 ADD* ABSADD A = ABSOLUTE ADDRESS OF FILE REQUEST A3800635 RAO* ABSADD A3800636 SPC 1 A3800637 JMP* (ABSADD) RETURN A3800638 EJT A3800639* A3800640* THE FOLLOWING CODE STARTING AT LABEL 'DENTRY' THRU A3800641ÐÐ* LABEL 'DCALTH' IS NOT EXECUTED IN THE DRIVER, BUT IS A3800642* BUILT AND MOVED TO THE PHYSTB. THE CODE IS THEN A3800643* EXECUTED FROM THE PHYSTB WITH RETURN TO THE DRIVER. A3800644* A3800645DENTRY NUM 0 ENTRY A3800646DEN010 RTJ+ SYFAIL DELETE FILE REQUEST A3800647 ADC (REQBUF-RTJCAL-3) REL ADR TO 'REQBUF' PARAMETER A3800648 ADC (IDATA-RTJCAL-4) REL ADR TO 'IDATA' PARAMETER A3800649 ADC (ISTAT-RTJCAL-5) REL ADR TO 'ISTAT' PARAMETER A3800650 LDA- ISTAT,I PICKUP 'DELETE' REQUEST STATUS A3800651 STA- ERSTAT,I AND SAVE A3800652 JMP* (DENTRY) A3800653DCALTH EQU DCALTH(*-DENTRY-1) A3800654* A3800655* CALLER'S Q/I REGISTERS PRESERVED BY FM A3800656* A3800657 EJT A3800658* A3800659* END-OF-FILE MOTION REQUEST A3800660* A3800661DBO380 EQU DBO380(*) A3800662 SFZ- HSTNN,11,1,I SKIP IF SCRATCH FILE SPACE REMAINING A3800663 JMP* DBO390 INSUFFICIENT SPACE BYPASS REDUCE A3800664 RTJ DBO570 SET IDATA FOR SCRATCH FILE A3800665 ENA 0 A3800666ÐÐ STA- IDATA+12,I MSB NEW NUMBER OF RECORDS A3800667 LDA- RELREC,I A3800668 STA- IDATA+13,I LSB NEW NUMBER OF RECORDS A3800669 ENA 7 SET RQST CODE FOR 'REDUCE' A3800670 SFA- TIMTRY,12,4,I A3800671 RTJ* ABSADD ABSOLUTIZE THE FILE REQUEST ADDRESS A3800672 ADC* REDUC A3800673 STA* REN010+1 STORE IN THE REQUEST A3800674 ENQ RCALTH MOVE 'REDUCE' ROUTINE TO PHYSTB A3800675DBO385 EQU DBO385(*) A3800676 LDA* RENTRY,Q A3800677 STA- RTJCAL,B A3800678 DQP *-DBO385 A3800679 RTJ- RTJCAL,I GO EXECUTE ROUTINE IN PHYSTB A3800680* A3800681* RETURN FROM 'REDUCE' ROUTINE IN PHYSTB, A-REG = ISTAT. A3800682* A3800683 SAZ DBO390 SKIP IF NO FM ERRORS A3800684DBO387 EQU DBO387(*) A3800685 JMP* DBO495 GO POST THE ERROR A3800686 EJT A3800687* A3800688* THE FOLLOWING CODE STARTING AT LABEL 'RENTRY' THRU A3800689* LABEL 'RCALTH' IS NOT EXECUTED IN THE DRIVER, BUT IS A3800690* BUILT AND MOVED TO THE PHYSTB. THE CODE IS THEN A3800691ÐÐ* EXECUTED FROM THE PHYSTB WITH RETURN TO THE DRIVER. A3800692* A3800693RENTRY NUM 0 ENTRY A3800694REN010 RTJ+ SYFAIL REDUCE FILE REQUEST A3800695 ADC (REQBUF-RTJCAL-3) REL ADR TO 'REQBUF' PARAMETER A3800696 ADC (IDATA-RTJCAL-4) REL ADR TO 'IDATA' PARAMETER A3800697 ADC (ISTAT-RTJCAL-5) REL ADR TO 'ISTAT' PARAMETER A3800698 LDA- ISTAT,I PICKUP 'REDUCE' REQUEST STATUS A3800699 STA- ERSTAT,I AND SAVE A3800700 JMP* (RENTRY) A3800701RCALTH EQU RCALTH(*-RENTRY-1) A3800702* A3800703* CALLER'S Q/I REGISTERS PRESERVED BY FM A3800704* A3800705 EJT A3800706DBO390 EQU DBO390(*) A3800707 LDA- JOBKEY,I A3800708 SAN DBO395 SKIP IF JOB HAS BEEN IDENTIFIED A3800709 JMP DBO610 UNIDENTIFIED JOB A3800710DBO395 EQU DBO395(*) A3800711 CLF- TIMTRY,8,9,I A3800712DBO400 EQU DBO400(*) A3800713 RTJ OPHOST OPEN THE $$HOST FILE A3800714 ENQ -1 A3800715 XFQ 1 REG 1 IS NO REJECT MASK A3800716ÐÐ LDQ =XHBMSKO REG Q IS REJECT BUSY MASK A3800717DBO410 EQU DBO410(*-1) A3800718 RTJ RETRY CHECK IF BUSY, RETRY PERMITTED A3800719 JMP* DBO400 BUSY, RETRY A3800720* IF ERROR, MSG POSTED A3800721* A3800722* NO ERROR, SETUP TO READ $$HOST, RELATIVE RECORD A3800723* NUMBER FROM JOBNAME A3800724* A3800725 LFA- JOBKEY,3,4,I 4 LSB OF ASCII HOST NUMBER A3800726 SFZ- JOBKEY,7,2,I SKIP IF NUMBER IS 0-9 A3800727 INA 9 NUMBER IS A-F A3800728 INA 1 A3800729 STA- HSTRNO+1,I LSB REL RECORD NUMBER A3800730DBO420 EQU DBO420(*) A3800731 ENQ HSTRNO PASS RELATIVE INDEX OF REL REC NO. A3800732 RTJ BREADR READ THE HOST ENTRY A3800733 LDQ- NZERO CHECK FOR ERROR, RETRY PERMITTED A3800734 XFQ 1 NO REJECT MASK A3800735 LDQ =XHBMSKR REJECT,BUSY MASK A3800736DBO430 EQU DBO430(*-1) A3800737 RTJ RETRY IF ERROR, MSG POST AND ATTEMPT TO CLOSE A3800738 JMP* DBO420 BUSY, RETRY A3800739 LFA- JOBKEY+1,11,4,I NO ERROR, SETUP TO CHECK JOB STATUS A3800740 MUI- TEN MS DIGIT (N) OF JMNN *10 A3800741ÐÐ TRA Q A3800742 LFA- JOBKEY+1,3,4,I LS DIGIT N A3800743 AAQ Q A3800744 INQ -1 Q-REG IS DECIMAL EQUIVALENT OF NN-1 A3800745 ENA 0 A3800746 LRS 2 DIVIDE BY 4, Q=WORD A3800747 INQ 3 PLUS 3 WORD OFFSET A3800748 XFQ 3 SAVE STATUS WORD INDEX IN REG 3 A3800749 ALS 2 A-REG IS 4 BIT STATUS INDICATOR A3800750 XFA 1 SAVE INDICATOR IN REG 1 AND 2 A3800751 XFA 2 A3800752 LDA- RECBUF,B PICKUP WORD CONTAINING STATUS A3800753DBO440 EQU DBO440(*) A3800754 ALS 4 SHIFT STATUS CODE TO 4 LSB OF A-REG A3800755 D1P *-DBO440 A3800756 XFA 4 SAVE STATUS CODES A3800757 AND- LPMSK+4 ISOLATE THIS JOB STATUS CODE A3800758 SFZ- HSTNN,15,2,I CHECK IF LOCL HOST A3800759 JMP* DBO444 NO - GO CK REMOTE HOST STATUS A3800760 INA -2 YES- CK FOR SENDING , OR A3800761 SAN DBO442 SENT STATUS. A3800762 JMP* DBO460 STATUS IS SENDING. A3800763DBO442 INA -1 A3800764 SAZ DBO460 SKIP IF STATUS IS SENT A3800765 SAP DBO446 SKIP IF STATUS VALID A3800766ÐÐ JMP* DBO450 INVALID STATUS A3800767DBO444 INA -3 A3800768 SAZ DBO460 SKIP IF STATUS IS SENT A3800769 SAM DBO450 SKIP IF INVALID STATUS A3800770DBO446 INA -4 A3800771 SAZ DBO460 SKIP IF STATUS IS JOB ABORTED A3800772 SAM DBO450 SKIP IF INVALID STATUS A3800773 INA -2 A3800774 ENQ 0 JOB STATUS WILL BE SET TO ZERO A3800775 SEF- HSTNN,9,1,I SET DISCARD JOB FLAG A3800776 SAZ DBO470 SKIP IF STATUS IS SENT, DISCARD PENDING A3800777DBO450 EQU DBO450(*) A3800778 JMP DBO725 JOB STATUS IS INVALID OR ILLEGAL A3800779DBO460 EQU DBO460(*) A3800780 ENQ 4 A3800781DBO470 EQU DBO470(*) A3800782 XF4 A REG A IS STATUS CODES A3800783 AND- NZERO+4 MASK OUT OLD STATUS THIS JOB A3800784 EAQ A PUT IN NEW STATUS CODE THIS JOB (0 OR 4) A3800785 XF2 Q REG Q IS STATUS CODE IN WORD INDICATOR A3800786 JMP* DBO480,Q REPOSITION THE STATUS WORD A3800787DBO480 EQU DBO480(*) A3800788 ALS 4 A3800789 ALS 4 A3800790 ALS 4 A3800791ÐÐ XF3 Q REG Q IS STATUS WORD INDEX A3800792 STA- RECBUF,B STORE THE NEW STATUS CODE A3800793 RTJ BUPREC UPDATE THE $$HOST RECORD A3800794 SAP DBO490 REG A IS ISTAT ON RETURN, SKIP NO ERR A3800795 JMP* DBO537 ERROR - CLOSE, POST MSG, EXIT A3800796DBO490 EQU DBO490(*) A3800797 RTJ BCLOSF CLOSE THE $$HOST FILE A3800798 SAP DBO500 A = ISTAT, SKIP IF NO ERRORS A3800799 STA- ERSTAT,I A3800800 ENA 1 'CLOSE' RQST CODE A3800801 SFA- TIMTRY,12,4,I A3800802DBO495 EQU DBO495(*) A3800803 JMP* DBO545 ERROR - POST MSG, EXIT A3800804DBO500 EQU DBO500(*) A3800805 SFN- HSTNN,9,1,I SKIP IF JOB DISCARDED A3800806 JMP* DBO510 A3800807 ENA 6 A3800808 STA- MOTPAR,I MAKE MOTION PARAMETER LOOK LIKE BSF A3800809DBO505 EQU DBO505(*) A3800810 JMP DBO360 GO DELETE THE SCRATCH FILE A3800811* A3800812* SETUP TO UPDATE THE $$BATCH FILE FOR THIS JOB A3800813* A3800814DBO510 EQU DBO510(*) A3800815 RTJ OPBATF OPEN THE $$BATCH FILE A3800816ÐÐ ENQ -1 A3800817 XFQ 1 REG 1 IS NO REJECT MASK A3800818 LDQ* DBO410 REG Q IS REJECT BUSY MASK A3800819 RTJ RETRY CHECK FOR ERROR OR BUSY,RETRY A3800820 JMP* DBO510 BUSY, RETRY A3800821* NO RETURN IF ERROR, MSG POSTED AND EXIT A3800822* A3800823* IF NO ERROR, RETURNS HERE A3800824* A3800825DBO520 EQU DBO520(*) A3800826 ENQ JOBKEY PASS RELATIVE INDEX OF JOBKEY A3800827 RTJ BREADR READ THIS JOB $$BATCH FILE RECORD A3800828 LDQ- NZERO A3800829 XFQ 1 REG 1 IS NO REJECT MASK A3800830 LDQ* DBO430 REQ Q IS REJECT BUSY MASK A3800831 RTJ RETRY CHECK FOR ERROR OR BUSY, RETRY A3800832 JMP* DBO520 BUSY, RETRY A3800833* NO RETURN IF ERROR, MSG POSTED AND EXIT A3800834 LDA- JOBKEY,I MOVE JOBKEY TO NEWNAM A3800835 STA- NEWNAM,I A3800836 LDA- JOBKEY+1,I A3800837 STA- NEWNAM+1,I A3800838 LDA =A A3800839DBO525 EQU DBO525(*-1) A3800840 STA- NEWNAM+2,I A3800841ÐÐ STA- NEWNAM+3,I A3800842* A3800843* MOVE DATE/TIME TO RECORD A3800844* A3800845 ENQ 5 A3800846 XFQ 1 A3800847DBO530 EQU DBO530(*) A3800848 XF1 Q A3800849 LDQ* DAYTIM,Q GET DATE/TIME ADR A3800850 LDA- (ZERO),Q PICKUP THE INTEGER A3800851 RTJ* DECASC CONVERT TO ASCII A3800852 XF1 Q A3800853 STA- RECBUF+26,B PUT IT IN THE RECORD A3800854 D1P *-DBO530 A3800855 JMP* DBO535 A3800856 SPC 2 A3800857DAYTIM ADC DAYTO A3800858 ADC MONTO A3800859 ADC YERTO A3800860 ADC HORTO A3800861 ADC MINTO A3800862 ADC SECON A3800863 SPC 2 A3800864DECASC NUM 0 CONVERT DATE/TIME INTEGER TO ASCII A3800865 CLR Q A3800866ÐÐ DVI- TEN A3800867 INA $30 A3800868 INQ $30 A3800869 ALS 8 A3800870 EAQ A A3800871 JMP* (DECASC) A3800872 SPC 2 A3800873DBO535 EQU DBO535(*) A3800874 RTJ BUPREC UPDATE THE FILE RECORD A3800875 SAP DBO540 SKIP IF NO ERROR A3800876DBO537 EQU DBO537(*) A3800877 JMP DBO900 ERROR, ATTEMPT TO CLOSE, POST MSG, EXIT A3800878DBO540 EQU DBO540(*) A3800879 RTJ BCLOSF CLOSE THE FILE A3800880 SAP DBO550 SKIP IF NO ERROR A3800881 STA- ERSTAT,I A3800882 ENA 1 'CLOSE' RQST CODE A3800883 SFA- TIMTRY,12,4,I A3800884DBO545 EQU DBO545(*) A3800885 JMP DBO910 ERROR - POST MSG, EXIT A3800886* A3800887* A3800888* RENAME THE SCRATCH FILE TO THE JOBKEY A3800889* A3800890DBO550 EQU DBO550(*) A3800891ÐÐ ENQ 3 MOVE OWNER TO NEWNAM A3800892DBO560 EQU DBO560(*) A3800893 LDA* SNAM+4,Q A3800894 STA- NEWNAM+4,B A3800895 DQP *-DBO560 A3800896 RTJ* DBO570 A3800897 JMP* DBO590 GO SETUP RENAME REQUEST A3800898 EJT A3800899* A3800900* ROUTINE SETS UP SCRATCH FILE NAME, USER, VOLUMN A3800901* A3800902DBO570 EQU DBO570(*) A3800903 NUM 0 ENTRY, SETUP SCRATCH FILE NAME A3800904 LDA- ELU,I A3800905 ENQ 0 A3800906 DVI- TEN CONVERT BINARY LU TO ASCII A3800907 INA $30 FOR LU = 1, 99 A3800908 ALS 8 A3800909 INQ $30 A3800910 EAQ A A3800911 STA* SNAM+2 A3800912 LDQ+ WKSPLU A3800913 LDQ+ MMLUTB,Q Q = VOLUME TABLE FOR SCRATCH FILES A3800914 INQ 1 A3800915 STQ* VOLNAM A3800916ÐÐ ENQ 3 A3800917DBO575 LDA* (VOLNAM),Q MOVE THE VOLUME NAME A3800918 STA* SVOL,Q A3800919 DQP *-DBO575 A3800920 ENQ 11 A3800921DBO580 EQU DBO580(*) A3800922 LDA* SNAM,Q MOVE OLD NAME, OWNER, VOLUME TO IDATA A3800923 STA- IDATA,B A3800924 DQP *-DBO580 A3800925 JMP* (DBO570) RETURN A3800926 SPC 2 A3800927VOLNAM ADC 0 TEMPORARY STORAGE A3800928 EJT A3800929* A3800930* THE FOLLOWING CODE STARTING AT LABEL 'ENTRY' THRU A3800931* LABEL 'CALTH' IS NOT EXECUTED IN THE DRIVER, BUT IS A3800932* BUILT AND MOVED TO THE PHYSTB. THE CODE IS THEN A3800933* EXECUTED FROM THE PHYSTB WITH RETURN TO THE DRIVER. A3800934* A3800935ENTRY NUM 0 RTJ ENTRY A3800936ENT010 RTJ+ SYFAIL RENAME FILE REQUEST A3800937 ADC (REQBUF-RTJCAL-3) REL ADR TO 'REQBUF' PARAMETER A3800938 ADC (IDATA-RTJCAL-4) REL ADR TO 'IDATA' PARAMETER A3800939 ADC (NEWNAM-RTJCAL-5) REL ADR TO 'NEWNAM' PARAMETER A3800940 ADC (ISTAT-RTJCAL-6) REL ADR TO 'ISTAT' PARAMETER A3800941ÐÐ LDA- ISTAT,I PICKUP 'RENAME' REQUST STATUS A3800942 STA- ERSTAT,I SAVE REQUEST STATUS A3800943 JMP* (ENTRY) RETURN TO CALLER A3800944CALTH EQU CALTH(*-ENTRY-1) A3800945* A3800946* CALLER'S Q/I REGISTERS PRESERVED BY FM A3800947* A3800948 EJT A3800949DBO590 EQU DBO590(*) A3800950 ENA 6 SET RQST CODE FOR 'RENAME' A3800951 SFA- TIMTRY,12,4,I A3800952 RTJ ABSADD ABSOLUTIZE THE FILE REQUEST ADDRESS A3800953 ADC* RENAM A3800954 STA* ENT010+1 STORE IN THE REQUEST A3800955 ENQ CALTH MOVE 'RENAME' ROUTINE TO PHYSTAB A3800956DBO600 EQU DBO600(*) A3800957 LDA* ENTRY,Q A3800958 STA- RTJCAL,B A3800959 DQP *-DBO600 A3800960 RTJ- RTJCAL,I GO EXECUTE ROUTINE IN PHYSTB A3800961* A3800962* RETURN FROM 'RENAME ROUTINE IN PHYSTB. A-REG = ISTAT. A3800963* A3800964 SAM DBO605 SKIP IF REJECTED A3800965 CLF- HSTNN,13,6,I CLEAR DRIVER STATUS FLAGS A3800966ÐÐ JMP DBO310 GO COMPLETE THE REQUEST A3800967DBO605 EQU DBO605(*) A3800968 ENA 0 ERROR, POST DIAG MSG A3800969 STA- MOTPAR,I A3800970 RTJ BFWRIT A3800971DBO607 EQU DBO607(*) A3800972 JMP* DBO505 GO DELETE THE SCRATCH FILE, EXIT A3800973 SPC 2 A3800974PRTNAM ALF 4,$$PRINT PRINT FILE NAME A3800975 SPC 2 A3800976SNAM ALF 4,$$BD SCRATCH FILE NAME A3800977SOWN ALF 4,$$ FILE OWNER NAME A3800978SVOL ALF 4,SYSVOL VOLUME NAME A3800979 EJT A3800980* A3800981* PROCESS UNIDENTIFIED FILE, I.E., NO '*JOB,JMNN,' A3800982* RECORD WAS FOUND. FIND AN AVAILABLE ENTRY IN THE A3800983* $$PRINT FILE, UPDATE IT, AND RENAME THE SCRATCH A3800984* FILE ACCORDINGLY. A3800985* A3800986DBO610 EQU DBO610(*) A3800987 ENQ 3 MOVE $$PRINT FILE NAME TO IDATA 1-4 A3800988DBO620 EQU DBO620(*) A3800989 LDA* PRTNAM,Q A3800990 STA- IDATA,B A3800991ÐÐ DQP *-DBO620 A3800992 ENQ 7 MOVE OWNER NAME AND VOLUME A3800993DBO630 EQU DBO630(*) NAME TO IDATA 5-12 A3800994 LDA* SOWN,Q A3800995 STA- IDATA+4,B A3800996 DQP *-DBO630 A3800997 ENA 0 ACCESS INDICATOR, RETRIEVAL BY A3800998 STA- IDATA+12,I RELATIVE RECORD NUMBER A3800999 ENA 1 NUMBER OF RECORDS PER RETRIEVAL A3801000 STA- IDATA+13,I A3801001 STA- IDATA+14,I RECORD LOCK ON RETRIEVAL A3801002DBO640 EQU DBO640(*) A3801003 RTJ BOPENF OPEN PRINT FILE, A=ISTAT ON RETURN A3801004 ENQ -1 A3801005 XFQ 1 NO REJECT MASK A3801006 LDQ =XBOSMSK REJECT, BUSY MASK A3801007 RTJ RETRY CHECK FOR ERRORS, RETRY IF BUSY A3801008* NO RETURN IF OTHER ERRORS A3801009 JMP* DBO640 BUSY, RETRY A3801010DBO650 EQU DBO650(*) NO ERRORS A3801011 RTJ BGETS GET THE NEXT SEQUENTIAL RECORD A3801012 SFZ- ISTAT,8,1,I SKIP IF NOT EOF A3801013 JMP* DBO705 NO AVAILABLE ENTRIES IN PRINT FILE A3801014 LDQ- NZERO A3801015 XFQ 1 A3801016ÐÐ LDQ =XBGETSM A3801017 RTJ RETRY A3801018 JMP* DBO650 BUSY, RETRY A3801019* NO ERROR A3801020 LDA- RECBUF+15,I SEE IF THIS RECORD IS AN AVAILABLE ENTRY A3801021 EOR DBO525 ENTRY AVAILABLE IF NO. OF RECORDS=2 BLANKS A3801022 SAZ DBO660 SKIP IF AVAILABLE A3801023 JMP* DBO650 GO GET NEXT RECORD A3801024DBO660 EQU DBO660(*) A3801025 ENQ 2 MOVE PRINT FILE NAME TO NEWNAM A3801026DBO670 EQU DBO670(*) A3801027 LDA- RECBUF,B A3801028 STA- NEWNAM,B A3801029 DQP *-DBO670 A3801030 LDA- RECBUF+2,I COMPLETE FILE NAME WITH 2 MORE BLANKS A3801031 STA- NEWNAM+3,I A3801032 ENQ 5 MOVE DATE/TIME TO RECORD A3801033 XFQ 1 A3801034DBO680 EQU DBO680(*) A3801035 XF1 Q A3801036 LDQ DAYTIM,Q GET DATE/TIME ADR A3801037 LDA- (ZERO),Q PICKUP THE INTEGER A3801038 RTJ DECASC CONVERT TO ASCII A3801039 XF1 Q A3801040 STA- RECBUF+8,B PUT IT IN THE RECORD A3801041ÐÐ D1P *-DBO680 A3801042 ENA 0 SETUP TO GET NUMBER OF RECORDS IN A3801043 XFA 1 SCRATCH FILE (LAST RELATIVE RECORD A3801044 ENA 3 STORED), CONVERT TO ASCII AND A3801045 XFA 2 PUT IN PRINT FILE RECORD. A3801046 LDQ- RELREC,I Q = NUMBER RECORDS A3801047DBO690 EQU DBO690(*) A3801048 ENA 0 A3801049 LLS 4 A = NEXT DIGIT (HEX) A3801050 INA -$A A3801051 SAM DBO700 SKIP IF DIGIT 0-9 A3801052 INA 7 BIAS FOR A-F A3801053DBO700 EQU DBO700(*) A3801054 INA $3A = ASCII REPRESENTATION THIS DIGIT A3801055 SCA- RECBUF+15,1,I PUT IT IN THE PRINT FILE RECORD A3801056 AR1- ONE A3801057 D2P *-DBO690 A3801058 JMP DBO535 GO UPDATE PRINT FILE AND RENAME SCRATCH A3801059 EJT A3801060* A3801061* THE $$PRINT FILE IS FULL, NO AVAILABLE ENTRIES FOUND. A3801062* ALERT THE OPERATOR AND DELETE THE SCRATCH FILE. A3801063* A3801064DBO705 EQU DBO705(*) A3801065 ENQ PMSGL MOVE WARNING MSG TO RECBUF A3801066ÐÐDBO710 EQU DBO710(*) A3801067 LDA* PMSG,Q A3801068 STA- RECBUF,B A3801069 DQP *-DBO710 A3801070 ENA PMSGL PASS MSG LENGTH IN A-REG A3801071 INA 1 A3801072 RTJ BFWRIT POST THE MSG A3801073 RTJ BCLOSF CLOSE THE $$PRINT FILE A3801074 SAP DBO720 SKIP IF NO ERROR A3801075 STA- ERSTAT,I A3801076 ENA 1 'CLOSE' RQST CODE A3801077 SFA- TIMTRY,12,4,I A3801078DBO715 EQU DBO715(*) A3801079 JMP* DBO910 A3801080DBO720 EQU DBO720(*) A3801081 ENA BSF MAKE MOTION PARAMETER LOOK LIKE BSF A3801082 STA- MOTPAR,I A3801083 JMP* DBO607 GO DELETE SCRATCH FILE A3801084 SPC 2 A3801085PMSG ALF ., $$PRINT FILE FULL, FILES ARE BEING LOST. A3801086PMSGL EQU PMSGL(*-PMSG-1) A3801087 EJT A3801088* A3801089* THE JOB HAS BEEN IDENTIFIED, HOWEVER, THE CORRESPONDING A3801090* STATUS CODE IS INVALID. ALERT THE OPERATOR AND SAVE THE A3801091ÐÐ* OUTPUT DATA AS A PRINT FILE. A3801092* A3801093DBO725 EQU DBO725(*) A3801094 RTJ BCLOSF CLOSE THE $$HOST FILE A3801095 SAP DBO730 SKIP IF NO ERROR A3801096 ENA 0 A3801097 STA- MOTPAR,I A3801098 JMP DBO607 GO DELETE THE SCRATCH FILE AND ERROR EXIT A3801099DBO730 EQU DBO730(*) A3801100 ENQ IMSGL MOVE THE MSG TO RECBUF A3801101DBO740 EQU DBO740(*) A3801102 LDA* IMSG,Q A3801103 STA- RECBUF,B A3801104 DQP *-DBO740 A3801105 LDA- JOBKEY,I PUT JOB NAME IN MSG A3801106 STA- RECBUF+1,I A3801107 LDA- JOBKEY+1,I A3801108 STA- RECBUF+2,I A3801109 ENA IMSGL PASS MSG LENGTH IN A-REG A3801110 INA 1 A3801111 RTJ BFWRIT POST THE MSG A3801112 JMP DBO610 GO SAVE THE OUTPUT DATA AS A PRINT FILE A3801113 SPC 2 A3801114IMSG ALF ., *JMNN RECEIVED, STATUS INVALID. A3801115IMSGL EQU IMSGL(*-IMSG-1) A3801116ÐÐ EJT A3801117* A3801118* ERROR EXIT FOR FM REJECT ON CALLS WHEN THE FILE IS A3801119* ACTUALLY OPEN TO THE DRIVER. A3801120* A3801121DBO900 EQU DBO900(*) A3801122 RTJ BCLOSF ATTEMPT TO CLOSE THE FILE, IGNORE REJECT A3801123* A3801124* ERROR EXIT FOR FM REJECT ON CALLS WHEN THE FILE IS A3801125* NOT OPEN TO THE DRIVER AND DIAGNOSTIC MESSAGE POSTING A3801126* IS REQUIRED. A3801127* A3801128DBO910 EQU DBO910(*) A3801129 SFN- ERSTAT,15,16,I SKIP IF THERE IS ERROR TO POST A3801130 JMP* DBO920 OTHERWISE, BYPASS A3801131 ENA 0 INDICATE CANNED MSG A3801132 RTJ BFWRIT POST THE DIAGNOSTIC MSG A3801133* A3801134* GENERAL ERROR EXIT FOR ALL DRIVER ERRORS. CLEAR THE A3801135* DRIVER STATUS BITS AND SETUP TO GO TO ALTERNATE DEVICE A3801136* HANDLER A3801137* A3801138DBO920 EQU DBO920(*) A3801139 CLF- HSTNN,13,6,I CLEAR DRIVER STATUS FLAGS A3801140 LDQ- ELU,I GET LU NUMBER A3801141ÐÐ QLS 6 POSITION TO MERGE ERROR CODE A3801142 ENA 28 NO FILE ERROR CODE A3801143 EAQ Q LU/ERROR CODE A3801144 JMP+ ALTDEV GO TO ALTERNATE DEVICE HANDLER A3801145 EJT A3801146* A3801147* RETRY CHECKS THE REQUEST STATUS BASED ON THE INFORMATION A3801148* PASSED IN REGISTERS Q, A AND 1. IF RETRY IS PERMITTED A3801149* RETURN IS TO P, IF REQUEST ACCEPTED RETURN IS TO P+1. A3801150* IF REQUEST REJECTED RETURN IS TO ERROR ROUTINE. A3801151* ON ENTRY - Q = REJECT, BUSY MASK A3801152* A = ISTAT A3801153* 1 = NO REJECT MASK A3801154* A3801155RETRY NUM 0 ENTRY A3801156 SAM REJ SKIP IF REJECT A3801157 XF1 Q A3801158 LAQ A A3801159 SAN ERR SKIP IF ERROR A3801160 SFA- TIMTRY,8,9,I CLEAR RETRIES A3801161 RAO* RETRY A3801162 JMP* (RETRY) NO ERROR RETURN A3801163REJ LAQ A A3801164 SAN ERR SKIP IF ERROR A3801165 LFA- TIMTRY,8,9,I GET NUMBER OF TRIES A3801166ÐÐ SUB- MAXTRY A3801167 SAP ERR SKIP IF EXCEEDED MAX NUMBER OF TRIES A3801168 RTJ BTIMER DELAY A3801169 JMP* (RETRY) RETURN A3801170ERR LFA- TIMTRY,12,4,I GET REQUEST CODE A3801171 INA -2 A3801172 SAM ERR1 SKIP IF RQST WAS 'OPEN' OR 'CLOSE' A3801173 INA -3 A3801174 SAZ ERR1 SKIP IF RQST WAS 'CREATE' A3801175 JMP* DBO900 ATTEMPT TO CLOSE AND POST MSG A3801176ERR1 JMP* DBO910 POST MSG A3801177 END A3801178 NAM DBATIN A39 A ITOS CCS 3.0 SL-149A3900001* DEFERRED BATCH INPUT DRIVER A3900002* CREDIT COLLECTION SYSTEM VERSION 3.0 A3900003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A3900004* COPYRIGHT CONTROL DATA CORPORATION 1979 A3900005* A3900006**** A3900007*E A3900008* FUNCTION A3900009* -------- A3900010* A3900011* A3900012* A3900013ÐÐ* THIS PSEUDO DRIVER READS INPUT FROM FILE MANAGER A3900014* FILES FOR JOBS SUBMITTED FOR DEFERRED BATCH PROCESSING A3900015* FROM AN ITOS USER TERMINAL. A3900016* A3900017* A3900018* A3900019* A3900020* A3900021* GENERAL DESCRIPTION A3900022* ------------------- A3900023* A3900024* A3900025* A3900026* IF THE REQUEST IS A MOTION REQUEST THEN, A3900027* A3900028* IF MOTION REQUEST IS VALID THEN, A3900029* A3900030* SLEW TO EOF - POINTERS TO THE CURRENT JOB A3900031* IN THE $$HOST FILE ARE ADJUSTED A3900032* TO POINT TO THE NEXT QUEUED JOB. A3900033* (I.E., TERMINATE JOB) A3900034* A3900035* BACKSPACE - POINTERS TO THE CURRENT JOB A3900036* FILE IN THE $$HOST FILE ARE ADJUSTED A3900037* TO POINT TO THE CURRENT JOB AS A3900038ÐÐ* THE NEXT QUEUED JOB. A3900039* (I.E., RESTART JOB) A3900040* A3900041* OTHERWISE THE MOTION REQUEST IS IGNORED. A3900042* A3900043* A3900044* OTHERWISE EACH REQUEST IS PROCESSED AS A FREAD REQUEST A3900045* AS FOLLOWS: A3900046* A3900047* IF THE DRIVER IS NOT LOGICALLY CONNECTED TO A A3900048* HOST (I.E., A RECORD IN $$HOST FILE) THEN, A3900049* A3900050* A SEARCH OF THE $$HOST FILE IS MADE TO FIND A3900051* A HOST ASSIGNED TO THE SAME LOGICAL UNIT A3900052* ASSOCIATED WITH THE REQUEST. WHEN FOUND A3900053* THE DRIVER LOGICALLY CONNECTS TO THAT HOST A3900054* AND ASCERTAINS THE NEXT QUEUED JOB 'NOT SENT' A3900055* FOR THAT HOST AND MARKS THE JOB 'BEING SENT', A3900056* AND LOGICALLY CONNECTS TO THAT JOB. A3900057* A3900058* LOGICAL CONNECTION TO A JOB ENTAILS: A3900059* 1. CONSTRUCT A JOBKEY BASED ON HOST ID A3900060* AND JOB ID TO ACESS THE $$BATCH FILE. A3900061* 2. THE JOB STATUS IN $$HOST FILE IS A3900062* UPDATED TO 'BEING SENT' FOR JMNN. A3900063ÐÐ* 3. RETRIEVE FROM THE $$BATCH FILE THE A3900064* RECORD FOR JOBKEY (JNMM) AND EXTRACT A3900065* THE USER'S INPUT TEXT FILE NAME. A3900066* 4. UPDATE DATE/TOD TEXT TRANSMITTED A3900067* IN JMNN $BATCH RECORD. A3900068* 5. RETRIEVE THE FIRST RECORD FROM THE A3900069* USER'S INPUT AND RETURN IT TO THE A3900070* REQUESTOR. A3900071* A3900072* OTHERWISE LOGICAL CONNECTION TO A HOST IS IMPLIED. A3900073* A3900074* A3900075* IF THE DRIVER IS ALSO LOGICALLY CONNECTED A3900076* TO A JOB FOR THIS HOST THEN, A3900077* A3900078* THE NEXT RECORD IS SEQUENTIALLY RETRIEVED A3900079* FROM THE USER'S INPUT FILE. A3900080* A3900081* IF AN EOF IS DETECTED THEN, A3900082* A3900083* A EOF INDICATION IS RETURNED TO A3900084* THE REQUESTOR AND THE A3900085* BATCH WORKSTATION AND THE DRIVER A3900086* IS LOGICALLY DISCONNECTED FROM THE A3900087* JOB. A3900088ÐÐ* THE STATUS OF THE JOB IS MARKED A3900089* 'SENT' FOR JMNN IN THE $$HOST A3900090* FILE. A3900091* A3900092* OTHERWISE THE RETRIEVED USER RECORD IS A3900093* RETURNED TO THE CALLER. A3900094* A3900095* A3900096* OTHERWISE THE DRIVER ATTEMPTS TO CONNECT TO A3900097* THE NEXT QUEUED JOB FOR THE HOST. A3900098* A3900099* IF ALL QUEUED JOBS FOR THE HOST HAVE A3900100* BEEN 'SENT' THEN, A3900101* A3900102* THE DRIVER LOGICALLY DISCONNECTS A3900103* FROM THE HOST AND RETURNS AN A3900104* END-OF-BATCH INDICATION TO THE A3900105* REQUESTOR. A3900106* A3900107* A3900108* OTHERWISE THE DRIVER LOGICALLY CONNECTS A3900109* TO THE NEXT QUEUED JOB FOR THE HOST AND A3900110* RETURNS THE FIRST USER'S INPUT RECORD A3900111* FOR THAT JOB TO THE REQUESTOR. A3900112* A3900113ÐÐ* A3900114* SUMMARIZING DATA RETURNED TO FREAD REQUESTORS BASED A3900115* ON TYPE OF BATCH WORKSTATION: A3900116* A3900117* 200UT HASP MSOS 5 A3900118* ----- ---- ------ A3900119* A3900120* 1-ST JOB 1-ST JOB 1-ST JOB A3900121* EOF EOF EOF,EOF A3900122* 2-ND JOB 2-ND JOB 2-ND JOB A3900123* EOF EOF EOF,EOF A3900124* . . . A3900125* . . . A3900126* LAST JOB LAST JOB LAST JOB A3900127* EOF ( ) EOF ( ) EOF,EOF A3900128* EOF (EOB) EOF (EOB) '*Z' (EOB) A3900129* A3900130* (EOF = $0200 (EOF = $0F00) (EOF = $0F00) A3900131* A3900132* 2-EOF = END- 2-EOF = END- *Z = END- A3900133* OF- OF- OF- A3900134* BATCH BATCH BATCH A3900135* A3900136* '**EOR' IS EDITED A3900137* TO=$0400 A3900138ÐÐ* A3900139* A3900140* A3900141* A3900142* A3900143* ENTRY A3900144* ----- A3900145* A3900146* A3900147* A3900148* THE DRIVER IS ENTERED AT THE INITIATOR VIA THE A3900149* READ-WRITE REQUEST PROCESSOR WITH THE PHYSICAL DEVICE A3900150* TABLE ADDRESS IN THE Q-REGISTER. THERE ARE NO A3900151* CONTINUTOR OR TIMEOUT ENTRIES. A3900152* A3900153* A3900154* A3900155* A3900156* A3900157* EXIT A3900158* ---- A3900159* A3900160* A3900161* A3900162* NORMAL EXIT IS TO THE DISPATCHER AFTER COMPLETING A3900163ÐÐ* REQUEST FOR ALL REQUESTS QUEUED TO THE PHTSICAL A3900164* DEVICE TABLE. A3900165* A3900166* ERROR EXIT IS TO THE ALTERNATE DEVICE HANDLER WITH A3900167* ERROR CODE = 28(NO FILE). ALL ERRORS ARISE FROM A3900168* FILE MANAGER ERROR STATUS AND RESULT IN ANY CONNECTED A3900169* JOB BEING DISCONNECT AND MARKED 'INACTIVE' IN THE A3900170* $$HOST FILE. THUS THE SOFTWARE DUMMY DEVICE SHOULD A3900171* BE SPECIFED FOR ALL APPLICABLE LOGICAL UNITS TO A3900172* RESULT IN AUTOMATIC REQUEST COMPLETION WITH ERROR. A3900173* A3900174* ON ERROR EXITS THE DRIVER WILL POST ON THE SYSTEM A3900175* COMMENT DEVICE THE FOLLOWING DIAGNOSTIC MESSAGE IF IT A3900176* IS ENABLED FOR THE FAILING PSEUDO DEVICE: A3900177* A3900178* ' JMNN FM RJT =$XXXX, REQTYP FILENAME/ USERNAME' A3900179* A3900180* WHERE - A3900181* A3900182* 'JMNN' IS JOB NAME (JOBKEY), M=HOST ID, NN=JOB ID A3900183* 'XXXX' IS FILE MANAGER ERROR STATUS(HEXDEC) A3900184* REQTYP IS 'OPENFL','CLOSFL','READR','GETS','UPDREC', A3900185* 'CREATE','RENAME','PUTS ','DELETE', A3900186* 'REDUCE'. A3900187* FILE- IS THE ASCII NAME OF FILE AND ITS USER NAME A3900188ÐÐ* NAME/ ENCOUNTERING THE FAILURE. A3900189* USER- A3900190* NAME A3900191* A3900192* A3900193* A3900194* A3900195* A3900196* ENTRY POINTS A3900197* ------------ A3900198* A3900199* A3900200* A3900201 ENT DBATIN INITIATOR ENTRY A3900202 ENT ABSADD ADDRESS ABSOLUTIZING ROUTINE A3900203* A3900204* A3900205* A3900206* A3900207* A3900208* EXTERNAL REFERENCES A3900209* ------------------- A3900210* A3900211* A3900212* A3900213ÐÐ EXT* OPHOST BATCH DRIVER OPEN $$HOST FILE ROUTINE A3900214 EXT* OPBATF BATCH DRIVER OPEN $$BATCH FILE ROUTINE A3900215 EXT* BOPENF BATCH DRIVER 'OPENFL' ROUTINE A3900216 EXT* BCLOSF BATCH DRIVER 'CLOSFL' ROUTINE A3900217 EXT* BREADR BATCH DRIVER 'READR' ROUTINE A3900218 EXT* BGETS BATCH DRIVER 'GETS' ROUTINE A3900219 EXT* BUPREC BATCH DRIVER 'UPDREL' ROUTINE A3900220 EXT* BFWRIT BATCH DRIVER MSOS FWRITE REQUEST A3900221 EXT* BTIMER BATCH DRIVER MSOS TIMER REQUEST A3900222 EXT HORTO MSOS CURRENT HOUR (INTEGER) A3900223 EXT MINTO MSOS CURRENT MINUTE (INTEGER) A3900224 EXT SECON MSOS CURRENT SECOND (INTEGER) A3900225 EXT DAYTO MSOS CURRENT DAY (INTEGER) A3900226 EXT MONTO MSOS CURRENT MONTH (INTEGER) A3900227 EXT YERTO MSOS CURRENT YEAR (INTEGER) A3900228 EXT ALTDEV MSOS ALTERNATE DEVICE HANDLER A3900229 EXT MAS300 A3900230 EXT FMEOFC FM/ITOS END-OF-FILE CODE A3900231 EXT JOBIND JOB PROCESSOR IN CORE A3900232 EXT SWTCH LOCK-OUT SWITHC FOR JP A3900233 EXT LOADIN LOADER IN CORE FLAG A3900234 EXT MIBUF ADDRESS OF MIINP BUFFER IN JOBENT A3900235 EXT JBCNCL JOB CANCEL PROCESSOR A3900236 EXT AUTON AUTO MODE IN SYSDAT, MINUS = NOT ALLOWED A3900237* 0 = NOT ENABLED A3900238ÐÐ* 1 = ENABLED A3900239 EXT* DELET FILE MANAGER DELETE FILE REQUEST PROCESSOR. A3900240 EXT SYFAIL SYSTEM FAILURE PROCESSOR A3900241 EXT WKSPLU FILE MANAGER UNIT FOR SCRATCH FILES A3900242 EXT MMLUTB FILE MANAGER MASS MEMORY UNIT TABLE A3900243 EXT AUTOBT AUTOMATIC BATCH MODE ROUTINE A3900244* A3900245* A3900246* A3900247* A3900248* A3900249* SYSTEM EQUATES A3900250* -------------- A3900251* A3900252* A3900253* A3900254 EQU FNR($B5) MSOS FIND NEXT REQUEST A3900255 EQU COMPRQ($B6) MSOS COMPLETE REQUEST A3900256 EQU AMONI($F4) MONITOR REQUEST ENTRY A3900257 EQU ADISP($EA) MSOS DISPATCHER A3900258 EQU MOT(14) MOTION REQUEST CODE A3900259* A3900260* A3900261* A3900262* A3900263ÐÐ* A3900264* MASKING EQUATES A3900265* --------------- A3900266* A3900267* A3900268* A3900269 EQU FOUR($25) MSOS MASK = $0004 A3900270 EQU MAXTRY($B) MSOS MASK = $01FF A3900271 EQU M0020($28) MSOS MASK = $0020 A3900272 EQU M00FF($A) MSOS MASK = $00FF A3900273 EQU M0200($2C) MSOS MASK = $0200 A3900274 EQU ONE(3) MSOS MASK = $0001 A3900275 EQU TEN($46) MSOS MASK = $000A A3900276 EQU ZERO($22) MSOS MASK = $0000 A3900277 EQU ONEBIT($23) A3900278* A3900279* A3900280* A3900281* A3900282* A3900283* PHYSTB EQUATES A3900284* -------------- A3900285* A3900286* A3900287* A3900288ÐÐ EQU ELVL(0) PBATXX ADC $5200+LVL SCHDL CALL A3900289 EQU EDIN(1) ADC DBATIN INITIATOR A3900290 EQU EDCN(2) ADC 0 (NOT USED) A3900291 EQU EDPGM(3) ADC 0 (NOT USED) A3900292 EQU EDCLK(4) NUM -1 (NOT USED) A3900293 EQU ELU(5) NUM 0 LOGICAL UNIT A3900294 EQU EPTR(6) NUM 0 REQ LOCATION A3900295 EQU EWES(7) NUM 0 (NOT USED) A3900296 EQU EREQST(8) NUM $08A2 REQ. STATUS A3900297 EQU ESTAT1(9) NUM 0 DRIVER STATUS A3900298 EQU ECCOR(10) NUM 0 CURRENT LOC. A3900299 EQU ELSTWD(11) NUM 0 LWA+1 A3900300 EQU ESTAT2(12) NUM 0 DEVICE STATUS A3900301 EQU MASLGN(13) NUM 0 MM LENGTH A3900302 EQU MASSEC(14) NUM $7FFF MM SECTOR A3900303 EQU RETURN(15) NUM 0 RESERVED A3900304 EQU HSTRNO(16) NUM 0,0 $$HOST REL A3900305* REC. NO. A3900306 EQU HSTNN(18) NUM 0 TERM/JOB ID A3900307 EQU ERSTAT(19) NUM 0 FM ERR STATUS A3900308 EQU TIMTRY(20) NUM $8000 ENABLE DIAG/ A3900309* FM CODE/TRYS A3900310 EQU JOBKEY(21) ALF 2,J $$BATCH KEY A3900311 EQU MOTPAR(23) NUM 0 MOTION PARM. A3900312 EQU RTJCAL(24) BZS RTJBF(13) FM/MONI CALLS A3900313ÐÐ EQU REQBUF(37) BZS REQBUF(24) FM 'REQBUF' A3900314 EQU IDATA(61) BZS IDATBF(24) FM 'IDATA' A3900315 EQU ISTAT(85) BZS ISTABF(1) FM 'ISTAT' A3900316 EQU RECBUF(86) BZS RECBF(40) FM 'RECBUF' A3900317* A3900318* A3900319* 'HSTNN' BYTE EQUATES A3900320* -------------------- A3900321* A3900322* A3900323* JOB ID NN=1,99 JOB ID FOR HOST 'M' A3900324* A3900325 EQU JNNSTR(7) FLDSTR = BIT7 A3900326 EQU JNNLTH(8) FLDLTH = 8 BITS A3900327* A3900328* MSOS END-OF-JOB (EOJ) STATUS A3900329 EQU EOJSTR(13) FLDSTR = BIT13 A3900330 EQU EOJLTH(1) FLDLTH = 1 BIT A3900331* A3900332* WORKSTATION TYPE = 0 MSOS, = 1 200UT, = 2 HASP A3900333* A3900334 EQU TYPSTR(15) FLDSTR = BIT15 A3900335 EQU TYPLTH(2) FLDLTH = 2 BITS A3900336* A3900337* A3900338ÐÐ* 'TIMTRY' BYTE EQUATES A3900339* ---------------------- A3900340* A3900341* A3900342* TALLY OF TIMER TRYS FOR LOCK FILE/RECORD ACCESS A3900343* A3900344 EQU TIMSTR(8) FLDSTR = BIT8 A3900345 EQU TIMLTH(9) FLDLTH = 9 BITS A3900346* A3900347* CURRENT FILE MGR ACCESS REQUEST CODE A3900348* = 0 'OPENFL', =1 'CLOSFL', =2 'READR', =3 'GETS', A3900349* = 4 'UPDREC', =5 'CREATE', =6 'RENAME', A3900350* = 7 'REDUCE', =8 'PUTS ', =9 'DELETE'. A3900351* A3900352 EQU FMCSTR(12) FLDSTR = BIT12 A3900353 EQU FMCLTH(4) FLDLTH = 4 BITS A3900354* A3900355* USER TEXT FILE TRANSMISSION STATUS A3900356* =0 TRANSMISSION IN-PROGRESS A3900357* =1 INITIATING TRANSMISSION A3900358* A3900359 EQU XMTSTR(14) FLDSTR = BIT14 A3900360 EQU XMTLTH(1) FLDLTH = 1 BIT A3900361* A3900362* ERROR DIAGNOSTIC POSTING = 0 DISABLED, =1 ENABLE A3900363ÐÐ* A3900364* FLDSTR= BIT15, FLDLTH = 1 BIT A3900365* A3900366* A3900367* 'JOBKEY' - KEY TO $$BATCH FILE RECORD (ASCII) = 'JMNN' A3900368* 'MNN' = BLANK, NO JOB CONNECTED A3900369* A3900370 EQU MSTR(7) FLDSTR = BIT7 (REL REC NO OF $$HOST A3900371 EQU MLTH(8) FLDLTH = 8 BITS (FILE RECORD MINUS ONE) A3900372* A3900373 EQU N1STR(15) FLDSTR = BIT 15 ) A3900374 EQU N1LTH(8) FLDLTH = 8 BITS) JOBKEY+1 A3900375 EQU N2STR(7) FLDSTR = BIT7 ) A3900376 EQU N2LTH(8) FLDLTH = 8 BITS) A3900377* A3900378* A3900379* 'HSTRNO' - $$HOST FILE RELATIVE RECORD NUMBER A3900380* - = 0,0 NOT CONNECTED TO A HOST A3900381**** A3900382 EJT A3900383START STQ- I MASS MEMORY ENTRY TO DRIVER A3900384 LDQ =XDBATIN-START A3900385 AAQ Q A3900386 STQ- 1,I SET UP INITIATOR ENTRY A3900387 JMP* DI0010 A3900388ÐÐMS300 ADC MAS300 A3900389* A3900390* INITIATOR ENTRY A3900391* A3900392 SPC 2 A3900393DBATIN STQ- I SAVE PHYSTB ADDR A3900394 SPC 2 A3900395* A3900396* FIND NEXT REQUEST, NORMAL EXIT IF NONE. A3900397* A3900398 SPC 2 A3900399DI0010 RTJ- (FNR) A3900400 JMP* (MS300) NO RQST OUTSTANDING A3900401* A3900402* FOUND A REQUEST, INITIALIZE PHYSTB FOR THIS REQUEST A3900403* A3900404DI0020 ENA 0 A3900405 SFA- TIMTRY,XMTSTR,15,I CLR ALL BUT MSG ENABLE A3900406 STA- ERSTAT,I CLR FM ERROR STATUS A3900407 STA- MOTPAR,I CLR MOTION PARAMETER A3900408 STA- ESTAT2,I CLR ESTAT2 A3900409 CLF- ESTAT1,15,3,I CLR V-FIELD A3900410 SPC 3 A3900411* A3900412* IF MOTION REQUEST THEN A3900413ÐÐ* A3900414 LDQ- EPTR,I GET REQ PARM ADDR A3900415 LFA- (ZERO),13,5,Q PICK REQ CODE A3900416 INA -MOT A3900417 SAN FR0010 A3900418* A3900419* GO TO MOTION REQUEST PROCESSOR A3900420* A3900421 JMP MT0010 A3900422* A3900423* OTHERWISE EACH REQUEST IS PROCESSED AS A FREAD REQUEST A3900424* A3900425 SPC 4 A3900426* A3900427* IF THE DRIVER IS NOT LOGICALLY CONNECTED TO A A3900428* HOST (REL REC NO. = 0,0) THEN, A3900429* A3900430* A3900431FR0010 LDA- HSTRNO+1,I GET REL RECORD LSB A3900432 SAZ FR0020 A3900433 JMP FR0500 CONNECTED TO A HOST A3900434* A3900435* SEARCH $$HOST FILE TO LOGICALLY CONNECT TO A3900436* A HOST WITH SAME LU AS THIS REQUEST. A3900437* A3900438ÐÐFR0020 RTJ OPHOST OPENFL ON $$HOST A3900439 SAZ FR0050 CK FM 'ISTAT' A3900440 AND* HOPBSY RJT- CK IF BUSY A3900441 SAN FR0030 STATUS. A3900442* NO- FM ERROR XIT A3900443 LFA- TIMTRY,TIMSTR,TIMLTH,I YES- CK IF MAX A3900444 SUB- MAXTRY TRYS A3900445 SAM FR0040 ATTEMPTED. A3900446FR0030 JMP ER0020 YES - ERR XIT A3900447FR0040 RTJ BTIMER NO - DELAY A3900448 JMP* FR0020 RETRY A3900449 SPC 2 A3900450HOPBSY NUM $6A23 BSY STATUS 'OPENFL' $$HOST/$$BATCH A3900451 EQU BOPBSY(HOPBSY) A3900452HGTBSY NUM $6120 BSY STATUS 'GETS' $$HOST A3900453 SPC 2 A3900454* NO FM RJT A3900455FR0050 CLF- TIMTRY,TIMSTR,TIMLTH,I CLR RETRY COUNTS A3900456FR0060 ENA 0 ZERO FM 'RECBUF' A3900457 ENQ 39 A3900458FR0070 STA- RECBUF,B A3900459 DQP *-FR0070 A3900460FR0075 ENQ HSTRNO SET Q-REG FOR BGETS A3900461 RTJ BGETS RTV NEXT $$HOST REC A3900462 SAN FR0077 CK FM ISTAT A3900463ÐÐ JMP* FR0100 A3900464FR0077 EQU FR0077(*) A3900465 AND* HGTBSY RJT CK IF BUSY A3900466 SAN FR0080 STATUS. A3900467* NO-FM ERROR XIT A3900468 LFA- TIMTRY,TIMSTR,TIMLTH,I YES- CK IF MAX A3900469 SUB- MAXTRY TRYS A3900470 SAP FR0080 ATTEMPTED A3900471 JMP* FR0090 A3900472FR0080 EQU FR0080(*) A3900473 AND- ONEBIT+8 A3900474 SAN FR0081 SKIP IF END-OF-FILE A3900475 JMP* FR0085 A3900476FR0081 EQU FR0081(*) A3900477 ENQ 0 PUT LU IN ALRT MSG A3900478 LDA- ELU,I A3900479 DVI- TEN A3900480 ALS 8 A3900481 AAQ A A3900482 ADD =N$3030 A3900483 STA* ALRT+10 A3900484 ENQ LNALRT ALERT OPERATOR HOST IS NOT SET TO LU A3900485 INQ -1 A3900486FR0082 EQU FR0082(*) A3900487 LDA* ALRT,Q MOVE MSG TO RECBUF A3900488ÐÐ STA- RECBUF,B A3900489 DQP *-FR0082 A3900490 ENA LNALRT MSG LENGTH A3900491 RTJ BFWRIT WRITE THE MSG A3900492FR0085 EQU FR0085(*) A3900493 JMP ER0010 YES - ERROR EXIT A3900494 SPC 2 A3900495ALRT EQU ALRT(*) A3900496 ALF ., HOST NOT SET TO LU XX. A3900497LNALRT EQU LNALRT(*-ALRT) A3900498FR0090 RTJ BTIMER NO - DELAY A3900499 JMP* FR0075 RETRY A3900500* NO FM RJT, COMPARE A3900501FR0100 LFA- RECBUF+2,7,8,I THE LU ASSIGNED A3900502 EOR- ELU,I TO $$HOST RECORD A3900503 SAZ FR0110 WITH REQUESTORS LU. A3900504 JMP* FR0050 MISMATCH,NEXT REC. A3900505* MATCH - CONNECT TO A3900506FR0110 LDA- REQBUF+15,I THIS HOST. SAVE A3900507 STA- HSTRNO,I REL RECORD NUMBER'S A3900508 LDA- REQBUF+16,I 16-BIT LSB. A3900509 STA- HSTRNO+1,I A3900510 INA $2F CONSTRUCT JOBKEY, A3900511 SFA- JOBKEY,MSTR,MLTH,I 'M' = RECNO-1 A3900512 LFA- RECBUF+2,9,2,I SAVE WORKSTATION A3900513ÐÐ SFA- HSTNN,TYPSTR,TYPLTH,I TYPE. A3900514* A3900515* ASCERTAIN THE NEXT QUEUED JOB 'NOT SENT' A3900516* FOR THIS HOST(I.E., STNN = 1) A3900517* A3900518* A3900519FR0115 CLF- HSTNN,JNNSTR,JNNLTH,I CLR JOB ID (NN) A3900520 ENA 24 SET WD LOOP CONTROL A3900521 XFA 2 FOR ST01 TO ST99 A3900522 ENQ 0 SET Q FOR ST01-ST04 A3900523 SPC 2 A3900524* MAIN LOOP OVER R2. A3900525FR0120 ENA 3 LOOP CONTROL OVER A3900526 XFA 1 4 STATUS 4-BIT BYTES A3900527 LDA- RECBUF+3,B GET NEXT 4 BYTES. A3900528 XFQ 3 SAVE INDEX TO RECBUF. A3900529* * * SECONDARY LOOP OVER 4 BYTES A3900530FR0130 RAO- HSTNN,I SAVE CURRENT JOB ID A3900531 CLR Q ISOLATE NEXT STATUS A3900532 LLS 4 BYTE IN Q-REG. A3900533 INQ -1 CK IF STNN=1 A3900534 SQZ FR0150 YES - CONNECT IT. A3900535 D1P *-FR0130 * * SECONDARY LOOP,A-REG PRESERVED A3900536 XF3 Q NO- RESTORE INDEX A3900537 INQ 1 TO NEXT RECBUF A3900538ÐÐ D2P *-FR0120 CK IF ST99 DONE A3900539* A3900540* KILL BATCH - DISCONNECT HOST AND JOB. A3900541* A3900542FR0140 CLF- RECBUF+2,10,1,I JA=SAVJA=0,NO A3900543 CLF- TIMTRY,13,1,I JOB ACTIVITY. A3900544 JMP FR2000 EXIT TO A3900545* TERMINATION. A3900546* A3900547* LOGICALLY CONNECT TO QUEUED JOB NN BY A3900548* COMPLETING ASCII 'NN' IN JOBKEY 'JMNN'. A3900549* A3900550FR0150 LFA- HSTNN,JNNSTR,JNNLTH,I NN ISOLATED BY A3900551 CLR Q RAO AT FR0130. A3900552 DVI- TEN NN/10 = A3900553 INA $30 N1 IN A-REG A3900554 SFA- JOBKEY+1,N1STR,N1LTH,I N2 IN Q-REG A3900555 TRQ A A3900556 INA $30 'N1' = N1+$30 A3900557 SFA- JOBKEY+1,N2STR,N2LTH,I 'N2' = N2+$30 A3900558* A3900559* UPDATE STATUS STNN IN $$HOST RECORD A3900560* TO 'BEING SENT' (I.E. STNN=2) A3900561* A3900562 XF1 A R1 = 4 BIT BYTE IDX A3900563ÐÐ ALS 2 = 0, FLDSTR = 3 A3900564 INA 3 = 3, FLDSTR = 15 A3900565 SFA- MOTPAR,3,4,I SAVE FLDSTR FOR A3900566* STNN RECOVERY A3900567 SFA* STNN+1,15,4 FLDSTR = 4*R1 + 3 A3900568* A3900569 XF2 Q R2 = (RECBUF+3) IDX A3900570 TCQ Q = 24, IDX = 0 A3900571 INQ 24 = 23, IDX = 1 A3900572 TRQ A SAVE Q-IDX FOR A3900573 SFA- MOTPAR,8,5,I ERR RECOVERY. A3900574 ADQ- I = 0, IDX =24 A3900575 ENA 2 STNN = 2, IDX= 24-R2 A3900576STNN SFA- RECBUF+3,15,4,Q Q = IDX + PHYSTB ADR A3900577* A3900578* MARK $$HOST RECORD THAT BATCH DRIVER A3900579* ACTIVITY PROCESSING HOST'S JOBS (JA=1) A3900580* FOR ITOS UTILTY PROCESSORS. A3900581* A3900582 SEF- RECBUF+2,10,1,I A3900583* A3900584* UPDATE $$HOST RECORD, RECORD LOCKED ON RTV A3900585* A3900586 RTJ BUPREC FM 'UPPREC' REQUEST A3900587 SAZ FR0160 CK FM 'ISTAT' A3900588ÐÐ JMP ER0010 YES - FM ERR XIT A3900589* A3900590* CLOSE $$HOST FILE AND RETRIEVE BY JOBKEY A3900591* 'JMNN' THE JOB'S RECORD FROM THE $$BATCH A3900592* FILE INORDER TO RECORD DATE/TIME TEXT A3900593* TRANSMITTED. A3900594* A3900595FR0160 RTJ BCLOSF FM 'CLOSFL' REQUEST A3900596 SAM FR0165 CK FM 'ISTAT' A3900597 JMP* FR0210 NO RTJ - CONTINUE A3900598FR0165 STA- ERSTAT,I A3900599 ENA 1 SET 'CLOSFL' CODE. A3900600 SFA- TIMTRY,FMCSTR,FMCLTH,I FOR DIAG. MSG. A3900601 ENA 0 RJT-LOG DIAG MSG A3900602 RTJ BFWRIT IF ENABLED. A3900603FR0170 ENA 0 CLR TRY COUNTS A3900604 SFA- TIMTRY,TIMSTR,TIMLTH,I A3900605FR0175 ENQ HSTRNO RTV $$HOST A3900606 RTJ BREADR RECORD. A3900607 SAZ FR0200 CK FM 'ISTAT' A3900608 AND BRDBSY RTJ - CK BSY A3900609 SAN FR0180 STATUS. A3900610* NO-ERXIT A3900611 LFA- TIMTRY,TIMSTR,TIMLTH,I RETRY IF A3900612 SUB- MAXTRY OK A3900613ÐÐ SAM FR0190 A3900614FR0180 JMP ER0010 NO-ERXIT A3900615FR0190 RTJ BTIMER YES,DLY A3900616 JMP* FR0175 RETRY A3900617 SPC 2 A3900618FR0200 LFA- MOTPAR,3,4,I ERR RECOVERY EXIT A3900619 SFA* RSTNN+1,15,4 RESTORE STNN FLDSTR A3900620 LFA- MOTPAR,8,5,I RESTORE Q-IDX A3900621 TRA Q A3900622 ADQ- I A3900623 ENA 0 STNN=0, IDX=RESTORED A3900624RSTNN SFA- RECBUF+3,15,4,Q Q = IDX + PHYSTB A3900625 CLF- RECBUF+2,11,2,I JA=0, AI=0 INACTIVE A3900626 RTJ BUPREC 'UPDREC' REQUEST A3900627 JMP ER0010 FM ERR XIT A3900628* A3900629* OPEN $$BATCH FILE, LOCK RECORD ON RTV A3900630* A3900631FR0210 CLF- TIMTRY,TIMSTR,TIMLTH,I CLR TRY COUNTS A3900632FR0220 RTJ OPBATF 'OPENFL' REQUEST A3900633 SAM FR0225 CK FM 'ISTAT' A3900634 JMP* FR0320 NO RTJ - RTV RECORD A3900635FR0225 AND BOPBSY RJT - CK IF BUSY A3900636 SAZ FR0240 A3900637FR0230 ENA 0 NO- DIAG MSG A3900638ÐÐ RTJ BFWRIT AND A3900639 JMP* FR0260 ERR RECOVERY A3900640FR0240 LFA- TIMTRY,TIMSTR,TIMLTH,I YES- CK IF A3900641 SUB- MAXTRY OK TO A3900642 SAM FR0250 RETRY. A3900643 JMP* FR0230 NO-ERR XIT A3900644FR0250 RTJ BTIMER YES-DELAY A3900645 JMP* FR0220 RETRY A3900646* MARK STNN=0, JA=0 A3900647FR0260 CLF- TIMTRY,TIMSTR,TIMLTH,I CLR RETRY COUNTS A3900648FR0270 RTJ OPHOST 'OPENFL' FOR $$HOST A3900649 SAM FR0280 CK FM 'ISTAT' A3900650 JMP* FR0170 NO RJT- ERR RECOVERY A3900651FR0280 AND HOPBSY RJT - CK IF BUSY A3900652 SAZ FR0290 A3900653 JMP* FR0300 NO-FM ERR XIT A3900654FR0290 LFA- TIMTRY,TIMSTR,TIMLTH,I YES- CK IF OK A3900655 SUB- MAXTRY TO RETRY. A3900656 SAM FR0310 A3900657FR0300 JMP ER0020 NO-ER XIT A3900658FR0310 RTJ BTIMER YES-DELAY A3900659 JMP* FR0270 RETRY A3900660* A3900661* RETRIEVE 'JOBKEY' $$BATCH RECORD A3900662* A3900663ÐÐFR0320 CLF- TIMTRY,TIMSTR,TIMLTH,I CLR RETRY COUNT A3900664FR0330 ENQ JOBKEY 'RECSPC' = JOBKEY A3900665 RTJ BREADR 'READR' REQUEST A3900666 SAN FR0340 CK FM 'ISTAT' A3900667 JMP* FR0400 NO RTJ - SET DATE A3900668FR0340 SAP FR0350 VERIFY NON-RJT STAT A3900669 AND BRDBSY RJT - CK IF BUSY A3900670 SAZ FR0360 A3900671FR0350 ENA 0 NO, DIAG MSG A3900672 RTJ BFWRIT THEN, ERROR A3900673 JMP* FR0380 RECOVERY. A3900674FR0360 LFA- TIMTRY,TIMSTR,TIMLTH,I YES- CK IF A3900675 SUB- MAXTRY RETRY OK A3900676 SAM FR0370 A3900677 JMP* FR0380 NO-RECOVER A3900678FR0370 RTJ BTIMER YES-DELAY A3900679 JMP* FR0330 RETRY A3900680* MARK STNN=0, JA=0 A3900681FR0380 RTJ BCLOSF 'CLOSFL' ON $$BATCH A3900682 SAP FR0390 CK FM 'ISTAT' A3900683FR0385 STA- ERSTAT,I RJT - DIAG MSG A3900684 ENA 1 SET 'CLOSFL' CODE. A3900685 SFA- TIMTRY,FMCSTR,FMCLTH,I FOR DIAG. MSG. A3900686 ENA 0 A3900687 RTJ BFWRIT A3900688ÐÐFR0390 JMP* FR0260 ERROR RECOVERY A3900689* A3900690* SET DATE/TOD TEXT TRANSMITTED A3900691* A3900692DECASI NUM 0 ENTRY TO CONVERT A3900693 CLR Q 2-DIGIT DECIMAL A3900694 DVI- TEN TO ASCII. A3900695 INA $30 IT/10 = A-REG TENS A3900696 INQ $30 Q-REG ONES A3900697 ALS 8 A-REG = MSB IS TENS A3900698 EAQ A A-REG = LSB IS ONES A3900699 JMP* (DECASI) A3900700 SPC 2 A3900701DATOD ADC DAYTO CURRENT DAY (BIN) A3900702 ADC MONTO CURRENT MONTH (BIN) A3900703 ADC YERTO CURRENT YEAR (BIN) A3900704 ADC HORTO CURRENT HOUR (BIN) A3900705 ADC MINTO CURRENT MINUTE (BIN) A3900706 ADC SECON CURRENT SECOND (BIN) A3900707 SPC 2 A3900708FR0400 ENQ 5 USE R1 TO SAVE Q-REG A3900709 XFQ 1 AND FOR LOOP CONTROL A3900710FR0410 XF1 Q GET UPDATED R1 A3900711 LDQ* DATOD,Q GET ADDR OF ITEM A3900712 LDA- (ZERO),Q PICKUP ITEM A3900713ÐÐ RTJ* DECASI CONVERT TO ASCII A3900714 XF1 Q RESTORE Q-REG A3900715 STA- RECBUF+20,B STORE ITEM A3900716 D1P *-FR0410 DO NEXT ITEM A3900717* A3900718* UPDATE JOBKEY $$BATCH RECORD A3900719* A3900720 RTJ BUPREC A3900721 SAZ FR0420 A3900722 ENA 0 A3900723 RTJ BFWRIT A3900724 JMP* FR0380 A3900725* A3900726* CLOSE $$BATCH FILE A3900727* A3900728FR0420 RTJ BCLOSF 'CLOSFL' REQUEST A3900729 SAP FR0430 CK FM 'ISTAT' A3900730 JMP* FR0385 RJT -ERR RECOVERY A3900731* A3900732* OPEN USER TEXT FILE TO RETRIEVE A3900733* FIRST INPUT RECORD. A3900734FR0430 ENQ 3 MOVE USER FILE NAME A3900735FR0431 LDA- RECBUF+10,B FROM JMNN $$BATCH A3900736 STA- IDATA,B RECORD TO IDATA(1) A3900737 DQP *-FR0431 THRU IDATA(4). A3900738ÐÐ* A3900739 ENQ 3 MOVE USER'S NAME A3900740FR0435 LDA* TXTOWN,Q (TEXT FILES ARE $$ ) A3900741 STA- IDATA+4,B RECORD TO IDATA(5) A3900742 DQP *-FR0435 THRU IDATA(8). A3900743* A3900744 LDQ+ WKSPLU A3900745 LDQ+ MMLUTB,Q A3900746 INQ 1 A3900747 STQ* VOLADD ADDRESS OF SCRATCH VOLUME NAME A3900748 ENQ 3 MOVE USER'S VOLUMN A3900749FR0440 LDA* (VOLADD),Q FROM VOLUME INFORMATION TABLE A3900750 STA- IDATA+8,B RECORD TO IDATA(9) A3900751 DQP *-FR0440 THRU IDATA(12). A3900752* A3900753 ENA 0 IDATA(13)=0, ACCESS A3900754 STA- IDATA+12,I BY REL RECORD NO. A3900755 ENA 1 IDATA(14)=1, ONE A3900756 STA- IDATA+13,I RECORD PER RTV A3900757 ENA -1 IDATA(15)<0, FILE A3900758 STA- IDATA+14,I LOCKED ON ACESS. A3900759* A3900760 CLF- TIMTRY,TIMSTR,TIMLTH,I CLR RETRY COUNTS A3900761FR0450 RTJ BOPENF 'OPENFL' REQUEST A3900762 SAP FR0480 CK FM 'ISTAT' A3900763ÐÐ AND* TXTBSY RTJ- CK IF BUSY A3900764 SAZ FR0470 A3900765FR0460 ENA 0 NO-DIAG MSG A3900766 RTJ BFWRIT AND ERROR A3900767 JMP* FR0260 RECOVERY. A3900768FR0470 LFA- TIMTRY,TIMSTR,TIMLTH,I YES-CK IF RETRY A3900769 SUB- MAXTRY OK. A3900770 SAM FR0475 A3900771 JMP* FR0460 NO-RECOVERY A3900772FR0475 RTJ BTIMER YES-DELAY, A3900773 JMP* FR0450 RETRY A3900774* A3900775FR0480 SEF- TIMTRY,XMTSTR,XMTLTH,I NO RJT, MARK INIT. A3900776 JMP* FR0510 XMIT,AND TRV RECORD. A3900777TXTBSY NUM $6A22 BSY MASK 'OPENFL' TEXT A3900778TXTOWN ALF 4,$$ A3900779* A3900780* OTHERWISE DRIVER IS IMPLIED ALREADY CONNECTED A3900781* TO A HOST. A3900782* A3900783* A3900784* IF THE DRIVER IS ALSO LOGICALLY CONNECTED A3900785* TO A JOB FOR THIS HOST THEN, A3900786* A3900787FR0500 LDA- JOBKEY+1,I COMARE LSB OF JOBKEY A3900788ÐÐ EOR =A TO BLANKS A3900789 SAN FR0510 A3900790 JMP* FR0620 NOT CONNECTED A3900791* A3900792* THE NEXT RECORD IS SEQUENTIALLY A3900793* RETRIEVED FROM THE USER'S INPUT A3900794* TEXT FILE. A3900795* A3900796FR0510 ENQ HSTRNO DUMMY KEYNAL A3900797 RTJ BGETS SEQ RTV A3900798* A3900799* IF AN EOF(OR ERROR) IS DETECTED THEN, A3900800* A3900801 SAM FR0520 CK FM 'ISTAT' A3900802 EOR- FOUR NO RJT -VERIFY LOCK A3900803 SAN FR0520 FILE ONLY. A3900804 LDA- RECBUF,I YES-LOOK FOR A3900805 EOR* TXTEOF TEXT EDITOR EOF A3900806 SAZ FR0520 CK FOR TEXT RECD A3900807 JMP* FR0550 YES-XMIT RECORD A3900808 SPC 2 A3900809TXTEOF ADC FMEOFC ITOS TEXT EDITOR EOF A3900810VOLADD ADC 0 ADDRESS OF SCRATCH VOLUME NAME A3900811 EJT A3900812* A3900813ÐÐ* FOR ONE OR MORE TEXT RECORDS XMIT, A3900814* AN EOF INDICATION IS RETURNED TO A3900815* THE REQUESTOR AND THE BATCH A3900816* WORKSTATION AND DRIVER ARE A3900817* LOGICALLY DISOCNNECTED FROM A3900818* THE JOB. A3900819* A3900820* A3900821* IF NO TEXT RECORDS TRANS- A3900822* MITTED THEN, A3900823* A3900824FR0520 LFA- TIMTRY,XMTSTR,XMTLTH,I NO-CK FOR A3900825 SAZ FR0540 RECORDS XMIT. A3900826* A3900827* JOB IS MARKED INACTIVE A3900828* (I.E., STNN = 0) A3900829* A3900830FR0530 ENA 0 YES-DIAG MSG A3900831 RTJ BFWRIT 'CLOSFL' A3900832 RTJ BCLOSF ON TEXT. A3900833 SAP FR0535 RECOVERY A3900834 STA- ERSTAT,I A3900835 ENA 1 SET 'CLOSFL' CODE. A3900836 SFA- TIMTRY,FMCSTR,FMCLTH,I FOR DIAG. MSG. A3900837 JMP* FR0460 EXIT. A3900838ÐÐFR0535 JMP FR0260 STNN=0. A3900839* A3900840* OTHERWISE A3900841* A3900842* JOB IS MARKED 'SENT' A3900843* (I.E., STNN = 0) A3900844* A3900845FR0540 STA- MOTPAR,I CLEAR TEMP USEAGE A3900846 JMP FR0800 OF MOTPAR, CLOSE TEXT A3900847* FILE, MARK STNN = 3. A3900848* A3900849* OTHERWISE THE RETRIEVED TEXT RECORD IS A3900850* RETURNED TO THE CALLER. A3900851* A3900852* IF WORKSTATION IS 200UT AND RECORD A3900853* IS '**EOR' THEN, A3900854* A3900855FR0550 LFA- HSTNN,TYPSTR,TYPLTH,I CK IF TYPE = 1 A3900856 INA -1 (200UT) A3900857 SAN FR0570 A3900858* A3900859* EDIT '**EOR' TO $0400 A3900860* A3900861 ENQ 4 LOOP OVER 5 CHAR. A3900862FR0560 LCA* UTEOR,Q A3900863ÐÐ CCE- RECBUF,Q,I A3900864 JMP* FR0570 A3900865 DQP *-FR0560 A3900866 LDA =N$0400 A3900867 STA- RECBUF,I A3900868 LDA* ETX A3900869 STA- RECBUF+1,I A3900870* A3900871* OTHERWISE, CONTINUE. A3900872* A3900873* MOVE TEXT RECORD TO REQUESTOR'S A3900874* I/O BUFFER. A3900875* A3900876FR0570 EQU FR0570(*) A3900877 LDA- ECCOR,I PREVENT USER FROM TURNING OFF BATCH A3900878 EOR+ MIBUF A3900879 SAN FR0575 SKIP IF INPUT BFR NOT MIBUF A3900880 LDA- RECBUF,I GET 1ST 2 CHARS FROM BFR A3900881 SUB =A*Z A3900882 SAN FR0575 SKIP IF NOT '*Z' A3900883 JMP* FR0520 CLOSE TEXT INPUT A3900884FR0575 EQU FR0575(*) A3900885 LDA- ELSTWD,I CALL REQUESTOR'S I/O A3900886 SUB- ECCOR,I LENGTH-1. A3900887 INA -1 CK FOR ZERO LENGTH A3900888ÐÐ SAN FR0580 REQ L1 CHAR. REQ) A3900889 LDA- M00FF YES - NULL 2-CHAR A3900890 SFA- RECBUF,7,8,I A3900891 ENA 0 XFR 1-WORD A3900892 JMP* FR0590 TO CALLER. A3900893* NO - CK FOR REQ A3900894FR0580 TRA Q LENGTH.GT. A3900895 INQ -40 80 CHAR. A3900896 SQM FR0590 A3900897 LDQ- ELSTWD,I YES-MARK REQ A3900898 INQ -1 FOR SHORT A3900899 LDA- ECCOR,I READ. A3900900 INA 40 SAVE LWA+1 A3900901 STA- (ZERO),Q FOR XFR. A3900902* SHORT READ, A3900903 SEF- ESTAT1,14,2,I DEVICE RDY. A3900904 ENA 39 LENGTH=40 A3900905* A-REG= TRF LENGTH-1 A3900906FR0590 XFA 1 REG 1 FOR LOOP CONTRL A3900907 ENQ 0 INIT TRF CONTROL A3900908 LDA- ECCOR,I INDEX AND ADDRESS A3900909 STA* ACALBF A3900910FR0600 LDA- RECBUF,B XFR TEXT RECORD TO A3900911 STA* (ACALBF),Q REQUESTOR'S BUFFER. A3900912 EOR* ETX IF ETX,BLANK FILL A3900913ÐÐ SAN FR0610 REST OF ACALBF. A3900914 LDA* SPACE A3900915FR0605 STA* (ACALBF),Q A3900916 INQ 1 FINISH REG 1 A3900917 D1P *-FR0605 LOOP HERE, A3900918 JMP* FR0615 A3900919FR0610 INQ 1 BUMP INDEX A3900920 D1P *-FR0600 XFR LOOP CONTROL A3900921* A3900922* COMPLETE THE REQUEST AND RETURN TO A3900923* INITIATOR FOR NEXT REQUEST. A3900924FR0615 RTJ- (COMPRQ) A3900925 JMP DI0010 A3900926 SPC 3 A3900927BRDBSY NUM $6320 BSY MASK 'READR' $$HOST/$$BATCH A3900928UTEOR ALF 3,**EOR 200UT EOR RECORD (EDIT TO $0400)A3900929ETX NUM $0303 EDITING DELIMITOR FOR START A3900930SPACE ALF 1, ETX EDITING TO SPACES. A3900931ACALBF ADC 0 ABS ADDR OF REQUESTOR'S I/O BUFFER. A3900932 SPC 2 A3900933* SPECIAL FOR MSOS 5.0 *BATCH A3900934* A3900935JOBI ADC JOBIND JOB PROCESSOR IN CORE A3900936STH ADC SWTCH JP LOCK-OUT FOR LIBEDT/RECOVERY A3900937LDIN ADC LOADIN LOADER IN CORE FLAG A3900938ÐÐ EJT A3900939* A3900940* OTHERWISE THE DRIVER ATTEMPTS TO CONNECT TO A3900941* THE NEXT QUEUED JOB FOR THE HOST. A3900942* A3900943* A3900944* FOR MSOS 5 BATCH INPUT PROTECT USERS A3900945* JOB STREAM FROM BAD JOB CONTROL TEXT A3900946* FROM PREVIOUS JOB. IF THIS READ REQUEST A3900947* NOT ORIGINATING FROM JOBPRO THEN A3900948* CANCEL CURRENT JOB BEFORE STARTING NEXT A3900949* QUEUED JOB. A3900950* HOWEVER, IF THE RQUEST IS FROM JOBENT, A3900951* ISSUE EOF, AND DEFER STARING THE NEXT A3900952* JOB UNTIL THE NEXT READ REQUEST. A3900953* A3900954* A3900955* A3900956FR0620 SFZ- HSTNN,TYPSTR,TYPLTH,I CK FOR MSOS HOST A3900957 JMP* FR0629 NO - GET NEXT JOB A3900958 LDA+ MIBUF COMPARE INPUT BUFFER A3900959 EOR- ECCOR,I FOR JOBPRO TO A3900960 SAZ FR0621 REQUESTORS BUFFER. A3900961 JMP* FR0623 NO - ABORT A3900962FR0621 LFA- HSTNN,EOJSTR,EOJLTH,I YES- CK IF EOJ A3900963ÐÐ SAZ FR0622 ISSUED. A3900964 CLF- HSTNN,EOJSTR,EOJLTH,I YES-CLR EOJ, A3900965 JMP* FR0629 GET NXT JOB A3900966FR0622 SEF- HSTNN,EOJSTR,EOJLTH,I NO-ISSUE EOF A3900967 SEF- ESTAT2,11,1,I FOR A3900968 SEF- ESTAT1,15,3,I END-OF-JOB A3900969 LDA =N$00F0 TO JOBPRO. A3900970 STA- RECBUF,I DEFER NEXT A3900971 LDA* ETX JOB UNTIL A3900972 STA- RECBUF+1,I NEXT READ A3900973 JMP* FR0575 REQUEST. A3900974* NO -ABORT CURRENT A3900975FR0623 LDA* (JOBI) JOB (BAD JCL). A3900976 SAZ FR0624 CK IF JP IN CORE A3900977 JMP* FR0628 YES - CANCEL JOB A3900978FR0624 LDA* (STH) NO - CK JP LOCK-OUT A3900979 SAN FR0626 FOR LIBEDT, A3900980 JMP* FR0629 OR RECOVERY. A3900981FR0626 ENA 0 YES - A3900982 STA* (LDIN) CLR LOADIN A3900983 ENA 1 SET SWITCH A3900984 STA* (STH) POSITIVE, A3900985FR0628 RTJ- (AMONI) CANCEL JOB AND A3900986 NUM $5202 COMPLETE REQUEST A3900987 ADC JBCNCL WITH BLANK RECORD, A3900988ÐÐ LDA* ETX DEFER JOB UNTIL A3900989 STA- RECBUF,I SLEW TO EOF AND A3900990 JMP* FR0575 NEXT READ. A3900991* A3900992* GET NEXT JOB FOR THE HOST FROM ITS A3900993* RECORD IN THE $$HOST FILE. A3900994* A3900995FR0629 CLF- TIMTRY,TIMSTR,TIMLTH,I CLR RETRY COUNTS A3900996FR0630 RTJ OPHOST 'OPENFL' ON $$HOST A3900997 SAP FR0660 CK FM 'ISTAT' A3900998 AND HOPBSY RTJ -CK FOR BUSY A3900999 SAN FR0640 STATUS. A3901000* NO-FM ERR XIT A3901001 LFA- TIMTRY,TIMSTR,TIMLTH,I YES- CK IF MAX A3901002 SUB- MAXTRY TRYS A3901003 SAM FR0650 ATTEMPED. A3901004FR0640 JMP ER0020 YES- ERR XIT A3901005FR0650 RTJ BTIMER NO- DELAY, A3901006 JMP* FR0630 RETRY. A3901007* NO FM RJT A3901008FR0660 CLF- TIMTRY,TIMSTR,TIMLTH,I CLR RETRY COUNTS A3901009FR0670 ENA 0 ZERO FM 'RELBUF' A3901010 ENQ 39 A3901011FR0680 STA- RECBUF,B A3901012 DQP *-FR0680 A3901013ÐÐFR0690 ENQ HSTRNO 'READR' REQ FOR A3901014 RTJ BREADR $$HOST RECORD. A3901015 SAZ FR0720 CK FM 'ISTAT' A3901016 AND* BRDBSY RTJ - CK IF BUSY A3901017 SAN FR0700 STATUS A3901018 LFA- TIMTRY,TIMSTR,TIMLTH,I YES-CK FOR MAX A3901019 SUB- MAXTRY RETRYS. A3901020 SAM FR0710 A3901021FR0700 JMP ER0010 YES-ER XIT A3901022FR0710 RTJ BTIMER NO- DELAY, A3901023 JMP* FR0690 RETRY. A3901024* A3901025* IF OPERATOR REQUESTED BATCH TERM- A3901026* INATION ON COMPLETION OF CURRENT A3901027* JOB, THEN A3901028* A3901029FR0720 LFA- RECBUF+2,11,1,I A3901030 SAZ FR0730 A3901031* A3901032* DRIVER LOGICALLY DISCONNECTS FROM A3901033* THE HOST AND RETURNS AN END-OF- A3901034* BATCH INDICATION TO THE REQUESTOR. A3901035* A3901036 JMP FR0140 DISCONNECT, EOB. A3901037* A3901038ÐÐ* OTHERWISE, GO SEARCH FOR NEXT JOB A3901039* 'NOT SENT' (STNN =1) IN $$HOST A3901040* RECORD JUST RETRIEVED. A3901041* A3901042FR0730 JMP FR0115 NEXT QUUED JOB. A3901043 SPC 2 A3901044* A3901045* ADDRESS ABSOLUTIZING ROUTINE A3901046* A3901047ABSADD NOP 0 A3901048 SPC 1 A3901049 LDA* (ABSADD) A = RELATIVE ADDRESS OF FILE REQUEST A3901050 ADD* ABSADD A = ABSOLUTE ADDRESS OF FILE REQUEST A3901051 RAO* ABSADD A3901052 SPC 1 A3901053 JMP* (ABSADD) RETURN A3901054 EJT A3901055* THE FOLLOWING IS ENTERED TO OBTAIN THE HOST'S RECORD A3901056* FROM THE $$HOST INORDER TO UPDATE JOB 'JMNN' STATUS A3901057* STNN. A3901058* A3901059* ENTERED FROM FREAD PROCESSING _ A3901060* A3901061* A TEXT FILE EOF, OR ERROR OCCURRED A3901062* A3901063ÐÐ* ENTERED FROM MOTION PROCESSING S A3901064* A3901065* ISSUE MOTION REQUEST. A3901066 SPC 2 A3901067FR0800 RTJ BCLOSF 'CLOSFL' ON TEXT FILE A3901068 SAP FR0805 CK FM 'ISTAT' A3901069 STA- ERSTAT,I A3901070 ENA 1 SET 'CLOSFL' CODE. A3901071 SFA- TIMTRY,FMCSTR,FMCLTH,I FOR DIAG. MSG. A3901072 ENA 0 RJT- POST DIAG A3901073 RTJ BFWRIT MSG A3901074* DELETE TEXT FILE A3901075FR0805 EQU FR0805(*) A3901076 ENA 9 SET REQUEST CODE FOR 'DELETE' A3901077 SFA- TIMTRY,12,4,I A3901078 RTJ* ABSADD ABSOLUTIZE THE FILE REQUEST ADDRESS A3901079 ADC* DELET A3901080 STA* DEN010+1 STORE IN THE REQUEST A3901081 ENQ DCALTH MOVE 'DELETE' ROUTINE TO PHYSTB A3901082FR0807 EQU FR0807(*) A3901083 LDA* DENTRY,Q A3901084 STA- RTJCAL,B A3901085 DQP *-FR0807 A3901086 RTJ- RTJCAL,I GO EXECUTE ROUTINE IN PHYSTB A3901087* A3901088ÐÐ* RETURN FROM 'DELETE' ROUTINE IN PHYSTB, A-REG = ISTAT. A3901089* A3901090 SAP FR0810 SKIP IF NO ERROR A3901091 ENA 0 REJECT, POST DIAG MSG A3901092 RTJ BFWRIT A3901093 JMP* FR0810 A3901094 SPC 2 A3901095* A3901096* THE FOLLOWING CODE STARTING AT LABEL 'DENTRY' THRU A3901097* LABEL 'DCALTH' IS NOT EXECUTED IN THE DRIVER, BUT IS A3901098* BUILT AN D MOVED TO THE PHYSTB. THE CODE IS THEN A3901099* EXECUTED FROM THE PHYSTB WITH RETURN TO THE DRIVER. A3901100* A3901101DENTRY NUM 0 ENTRY A3901102DEN010 RTJ+ SYFAIL DELETE FILE REQUEST A3901103 ADC (REQBUF-RTJCAL-3) REL ADR TO 'REQBUF' PARAMETER A3901104 ADC (IDATA-RTJCAL-4) REL ADR TO 'IDATA' PARAMETER A3901105 ADC (ISTAT-RTJCAL-5) REL ADR TO 'ISTAT' PARAMETER A3901106 LDA- ISTAT,I PICKUP REQUEST STATUS A3901107 STA- ERSTAT,I AND SAVE A3901108 JMP* (DENTRY) A3901109DCALTH EQU DCALTH(*-DENTRY-1) A3901110* A3901111* CALLER'S Q/I REGISTERS PRESERVED BY FILE MANAGER A3901112* A3901113ÐÐ SPC 2 A3901114FR0810 CLF- TIMTRY,TIMSTR,TIMLTH,I CLR RETRY COUNTS A3901115FR0820 RTJ OPHOST 'OPENFL' ON $$HOST A3901116 SAM FR0825 CK FM 'INSTAT' A3901117 JMP* FR0860 NORTJ ' RTV REC A3901118FR0825 AND HOPBSY RTJ- CK FOR BUSY A3901119 SAZ FR0840 STATUS. A3901120FR0830 ENA 0 NO-DIAG MSG A3901121 RTJ BFWRIT KILL A3901122* BATCH A3901123FR0835 CLF- TIMTRY,13,1,I FOR THIS A3901124 JMP* FR2000 HOST. A3901125FR0840 LFA- TIMTRY,TIMSTR,TIMLTH,I YES-CK FOR A3901126 SUB- MAXTRY RETRY. A3901127 SAM FR0850 A3901128 JMP* FR0830 A3901129FR0850 RTJ BTIMER YES-DELAY, A3901130 JMP* FR0820 RETRY. A3901131* A3901132FR0860 CLF- TIMTRY,TIMSTR,TIMLTH,I CLRRETRY COUNTS A3901133FR0870 ENQ HSTRNO RTV $$HOST RECORD A3901134 RTJ BREADR BY REC REC ND. A3901135 SAM FR0880 CK FM 'ISTAT' A3901136 JMP* FR0920 NO RJT- TERM JOB A3901137FR0880 AND BRDBSY RTJ_ CK IF BMSY A3901138ÐÐ SAZ FR0900 STATUS. A3901139FR0885 ENA 0 NO-DIAG MSG A3901140 RTJ BFWRIT 'CLOSFL' REQ ON A3901141 RTJ BCLOSF TEXT FILE. A3901142 SAP FR0890 CK FM 'ISTAT' A3901143 STA- ERSTAT,I A3901144 ENA 1 SET 'CLOSFL' CODE. A3901145 SFA- TIMTRY,FMCSTR,FMCLTH,I FOR DIAG. MSG. A3901146 JMP* FR0830 KILL BATCH. A3901147FR0890 JMP* FR0835 NO RJT, KILL A3901148* RTJ, BUSY STATUS A3901149FR0900 LFA- TIMTRY,TIMSTR,TIMLTH,I CK IF MAX RETRY A3901150 SUB- MAXTRY ATTEMPTS. A3901151 SAM FR0910 A3901152 JMP* FR0885 YES-KILL BATCH A3901153FR0910 RTJ BTIMER NO - DELAY A3901154 JMP* FR0870 RETRY. A3901155* A3901156* UPDATE JOB 'JMNN' STATUS IN $$HOST RECORD, A3901157* END-OF-JOB TERMINATION. A3901158* A3901159FR0920 LFA- RECBUF+2,10,1,I GET JOB ACTIVITY(JA), A3901160 SFA- TIMTRY,13,1,I SAVE FOR KILBATCH TST A3901161 LFA- HSTNN,JNNSTR,JNNLTH,I GET JOB ID = NN A3901162 INA -1 (NN-1)14 GIVES: A3901163ÐÐ CLR Q A-REG= RECBUF+3 IDX A3901164 DVI- FOUR Q-REG= BYTE INDEX A3901165 ADD- I SAVE RECBUF+3 IDX A3901166 XFA 1 IN REG 1. A3901167 QLS 2 CALC 'FLDSTR' = A3901168 TCQ Q =(15 - 4*Q-REG) A3901169 ENA 15 A3901170 AAQ A MODIFY FLDSTR IW A3901171 SFA* GTSTNN+1,15,4 GET STNN INSTR, A3901172 SFA* UPSTNN+1,15,4 STORE STNN INSTR. A3901173* A3901174* STNN UPDATED BASED ON CURRENT VALUE AND A3901175* REQUEST BEING PROCESSED. A3901176* A3901177* ----------------- ------------ A3901178* - PRESENT VALUE UPDATED VALUE A3901179* FWRITE REQUESTS: A3901180* A3901181* =2(BEING SENT) =3(SENT) A3901182* . =8(DISCARD) =9(SENT,DISCARD) A3901183* A3901184* MOTION REQUEST(SLEW TO EOF): A3901185* A3901186* =2(BEING SENT) =7(JOB ABORTED) A3901187* =8(DISCARD) =9(SENT,DISCARD) A3901188ÐÐ* A3901189* MOTION REQUEST(BACKSPACE FILE): A3901190* A3901191* =2(BEING SENT) =1(NOT SENT) A3901192* =8(DISCARD) =9(SENT,DISCARD) A3901193* A3901194GTSTNN LFA- RECBUF+3,15,4,1 GET CURRENT STNN A3901195 XFA 3 SAVE IN REG 3 A3901196 LFA- MOTPAR,15,4,I GET MOTION P1. A3901197* REG 1 = INDEX TO RECBUF+3 A3901198* FOR STNN. A3901199* REG 3 = STNN A3901200 SAN FR0950 A3901201* FWRITE REQUEST A3901202 XF3 A RESTORE STNN A3901203 INA -2 A3901204 SAZ FR0930 CK IF STNN=2 A3901205 INA -6 A3901206 SAN FR0940 CK IF STNN=8 A3901207FR0930 AR3- ONE REG3=STNN+1 A3901208FR0940 JMP* FR1010 UPDATE STNN W1REG 3 A3901209* MOTION REQUEST A3901210FR0950 INA -6 CK FOR SLEW EOF A3901211 SAZ FR0990 A3901212 XF3 A YES- MOTPAR=5 A3901213ÐÐ INA -2 CK STNN=2 A3901214 SAN FR0960 A3901215 ENA 7 SET STNN=7 A3901216 JMP* UPSTNN A3901217FR0960 INA -6 NO - CK STNN=8 A3901218 SAN FR1010 A3901219 ENA 9 SET STNN=9 A3901220FR0980 JMP* UPSTNN UPDATE STNN A3901221* NOTPAR=6, A3901222FR0990 XF3 A DO FILE BACKSPACE. A3901223 INA -2 CK FOR STNN=2 A3901224 SAN FR1000 A3901225 ENA 1 YES- SET STNN=1 A3901226 JMP* UPSTNN A3901227FR1000 JMP* FR0960 NO - CK FOR STNN=8 A3901228* UPDATE STNN IN RECORD FROM REG 3 A3901229* INDEXED BY REG 1. A3901230FR1010 XF3 A VALID STNN VALUE A3901231UPSTNN SFA- RECBUF+3,15,4,1 SAVED IN HOST RECORD A3901232 SPC 2 A3901233* KILL JOB BY DISCONNECTING FROM A3901234* JOB 'JMNN'. A3901235 EJT A3901236* THE FOLLOWING ENTERED TO DISCONNECT FROM A JOB IF: A3901237* 1. CURRENT JOB TERMINATED EITHER BY NORMAL OR A3901238ÐÐ* ERROR COMPLETION. A3901239* 2. CURRENT JOB TERMINATED BY MOTION REQUEST. A3901240* MOTPAR=5, SLEW EOF(JOB CONSIDERED SENT). A3901241* MOTPAR=6, BKSPC FILE,(JOB CANBE RESTARTED). A3901242* A3901243* IN ADDITION, ENTRY IS MADE TO TERMINATE BATCH A3901244* PROCESSING FOR THE HOST (DISCONNECT FROM HOST WITH A3901245* END-OF-BATCH INDICATION) IF: A3901246* 1. ALL QUEUED JOBS COMPLETED FOR THE HOST. A3901247* 2. OPERATOR INDICATES BATCH TERMINATION ON A3901248* COMPLETION OF CURRENT JOB. A3901249* 3. IRRECOVERABLE FILE MANAGER ERROR ENCOUNTERED A3901250* WITH $$HOST FILE WHILE DISCONNECTING FROM A3901251* A JOB. A3901252 SPC 2 A3901253* A3901254* DISCONNECT FROM CURRENT JOB ('JMNN' SET 'JM ') A3901255* A3901256FR2000 LDA =A SET 'NN' BLANK A3901257 STA- JOBKEY+1,I IN JOBKEY. A3901258* A3901259* IF MOTION REQUEST THEN A3901260* A3901261 LDA- MOTPAR,I A3901262 SAN FR2005 A3901263ÐÐ JMP* FR2040 A3901264* A3901265* COMPLETE REQUEST WITH, OR WITHOUT ERROR A3901266* A3901267FR2005 LDA- ERSTAT,I CK IF ERROR DURING A3901268 SAP FR2007 MOTION REQUEST. A3901269 JMP ER0030 YES- ERR POSTED A3901270FR2007 ENQ HSTRNO NO - UPDATE $$HOST A3901271 RTJ BUPREC FILE, 'UPDREC' A3901272 SAZ FR2010 CK FM 'ISTAT' A3901273 JMP ER0010 RTJ A3901274FR2010 RTJ BCLOSF OK, 'CLOSFL' A3901275 SAP FR2015 CK ISTAT A3901276 STA- ERSTAT,I A3901277 ENA 1 SET 'CLOSFL' CODE. A3901278 SFA- TIMTRY,FMCSTR,FMCLTH,I FOR DIAG. MSG. A3901279 JMP ER0020 A3901280FR2015 RTJ- (COMPRQ) OK-COMPLETE A3901281 JMP DI0010 REQ, FNR. A3901282* A3901283* OTHERWISE A3901284* A3901285* ISSUE TO FWRITE REQUESTOR EOF, OR END-OF- A3901286* BATCH(EOB) INDICATION AFTER UPDATING A3901287* $$HOST FILE AND ESTAT1, ESTAT2. A3901288ÐÐ* A3901289* EOF CONDITION (EOF) A3901290* ------------------- (SAVJA=1) A3901291* A3901292* MSOS(TYP=0) 200UT(TYP=1) HASP(TYP=2) A3901293* ---------- ------------ ---------- A3901294* EOF DATA $00F0 $0200 $00F0 A3901295* V-FLD(ESTAT1) 7 7 7 A3901296* ESTAT2(BIT11) 1 1 1 A3901297* A3901298FR2040 SEF- ESTAT2,11,1,I SET ESTAT2 EOF STATUS A3901299 SEF- ESTAT1,15,3,I SHORT RD, READY A3901300 LDQ =N$00F0 SET EOF DATA BASED A3901301 LFA- HSTNN,TYPSTR,TYPLTH,I ON STATION TYPE A3901302 INA -1 CK FOR 200UT A3901303 SAN FR2050 A3901304 LDQ- M0200 YES, EOF=$0200 A3901305FR2050 STQ- MOTPAR,I SAVE EOF DATA A3901306* A3901307* EOB CONDITION (EOB) A3901308* ------------------- (SAVJA=0) A3901309* A3901310* MSOS 200UT HASP A3901311* ---------------- ----- ---- A3901312* A3901313ÐÐ* EOB DATA '*Z' $0200 $00F0 A3901314* V-FLD(ESTAT1) 1 4 4 A3901315* ESTAT2(BIT11) 0 1 1 A3901316* A3901317 LFA- TIMTRY,13,1,I GET 'SAVJA' A3901318 SAZ FR2060 CK FOR EOB A3901319 JMP* FR2100 NO -UPDATE $$HOST A3901320* A3901321* EOB FLAGGED. A3901322* A3901323* SET NORMAL EOB CONDITION A3901324* A3901325FR2060 LFA- HSTNN,TYPSTR,TYPLTH,I CK FOR MSOS STATION A3901326 SAN FR2080 A3901327 LDA* MSOS YES - SET AND SAVE A3901328 STA- MOTPAR,I EOB DATA A3901329 CLF- ESTAT1,15,2,I NO ERR, READY A3901330 CLF- ESTAT2,11,1,I NO EOF A3901331 JMP* FR2090 DISCONNECT A3901332* FROM HOST. A3901333* A3901334* CLEAR V-FIELD (ESTAT1) BIT13,14 A3901335* FOR DEVICE NOT READY. A3901336* A3901337FR2080 CLF- ESTAT1,14,2,I V-FIELD = 4 A3901338ÐÐ* A3901339* DISCONNECT FROM HOST 'M'. A3901340* A3901341FR2090 LDA- M0020 BLANK 'M' IN A3901342 SFA- JOBKEY,MSTR,MLTH,I JOBKEY. A3901343 ENA 0 ZERO $$HOST REL A3901344 STA- HSTRNO+1,I RECORD NUMBER. A3901345* A3901346* IF POSSIBLE TO UPDATE $$HOST A3901347* FILE, THEN A3901348* A3901349 LDA- ERSTAT,I CK IF FM ERR DIS- A3901350 SAP FR2095 CONNECTING JOB. A3901351 JMP* FR2140 A3901352* A3901353* NO DISCONNECT ERROR, A3901354* CLEAR JOB ACTIVITY (JA) A3901355* AND ABORT INPUT (AI) FLAGS. A3901356* A3901357FR2095 CLF- RECBUF+2,11,2,I A3901358 EJT A3901359 SPC 2 A3901360* AUTOMATIC BATCH MODE A3901361 LDA+ AUTON A3901362 SAN FR2100 SKIP IF AUTO MODE NOT A3901363ÐÐ* ALLOWED OR ALREADY ENABLED A3901364 RAO+ AUTON SET AUTO BATCH ENABLED A3901365 RTJ- (AMONI) SCHEDULE AUTO BATCH IN 15 SEC. A3901366 NUM $1E27 A3901367 ADC AUTOBT A3901368 NUM 15 A3901369 SPC 2 A3901370* A3901371* UPDATE $$HOST FILE RECORD A3901372* 'HSTRNO'. A3901373FR2100 RTJ BUPREC A3901374 SAZ FR2110 A3901375 ENA 0 A3901376 RTJ BFWRIT A3901377FR2110 RTJ BCLOSF A3901378 SAP FR2140 A3901379 STA- ERSTAT,I A3901380 ENA 1 SET 'CLOSFL' CODE. A3901381 SFA- TIMTRY,FMCSTR,FMCLTH,I FOR DIAG. MSG. A3901382 ENA 0 A3901383 RTJ BFWRIT A3901384* A3901385* A3901386* IF MSOS EOF AND LIBEDT IS IN THEN, A3901387* A3901388ÐÐ* RETURN *Z, ERASE EOF STATUS. A3901389* A3901390FR2140 SFZ- HSTNN,TYPSTR,TYPLTH,I CK IF LOCL HOST A3901391 JMP* FR2200 NO - RETURN DAT A3901392 LDA- MOTPAR,I YES- CK IF EOF A3901393 EOR =N$00F0 A3901394 SAZ FR2150 A3901395 JMP* FR2200 NO-RTN DATA. A3901396FR2150 LDA (JOBI) YES-CK IF A3901397 SAZ FR2160 JOBPRO. A3901398 JMP* FR2200 NO-EXIT. A3901399FR2160 LDA (STH) YES-CK A3901400 SAN FR2170 IF LIBEDT. A3901401 JMP* FR2200 NO-EXIT. A3901402FR2170 LDA* MSOS YES-ISSUE A3901403 STA- MOTPAR,I *Z, CLR A3901404 CLF- ESTAT2,11,1,I EOF A3901405 CLF- ESTAT1,15,2,I STATUS. A3901406* A3901407* OTHERWISE, RETURN DESIGNATED DATA. A3901408* A3901409FR2200 LDA- MOTPAR,I RESTORE EOF/EOB DATA, A3901410 STA- RECBUF,I RETURN IT TO CALLER. A3901411 LDA ETX SET BLANK FILL DELIM- A3901412 STA- RECBUF+1,I ITOR ($0303). A3901413ÐÐFR2210 EQU FR2210(*) A3901414 JMP FR0575 MOVE TEXT TO CALLER. A3901415 SPC 2 A3901416MSOS ALF 1,*Z MSOS EOB DATA A3901417 EJT A3901418* A3901419* MOTION REQUEST PROCESSING, REQUEST ADDRESS A3901420* IN Q-REGISTER. A3901421* A3901422* A3901423MT0010 LDA- 4,Q PICK P1 THRU P3 A3901424 STA- MOTPAR,I SAVE MOTION PARAMETER A3901425* A3901426* IF P1 NOT VALID, OR NOT CONNECTED TO A3901427* A JOB, THEN A3901428* A3901429* IGNORE REQUEST, COMPLETE WITHOUT ERROR A3901430* A3901431 LFA- MOTPAR,15,4,I GET AND PROCESS ONLY A3901432 INA -5 P1. A3901433 SAZ MT0020 CK IF P1=5 A3901434 INA -1 NO - CK IF P1=6 A3901435 SAN MT0030 A3901436MT0020 LDA- HSTRNO+1,I YES-CK IF CONN'T A3901437 SAZ MT0030 TO HOST. A3901438ÐÐ LDA- JOBKEY+1,I YES-CK CONN'T A3901439 EOR =A TO JOB. A3901440 SAN MT0040 A3901441MT0030 RTJ- (COMPRQ) NO-COMPL A3901442 JMP DI0010 REQUEST. A3901443* A3901444* OTHERWISE A3901445* A3901446* P1 = 5, SLEW-TO-EOF A3901447* P1 = 6, BACKSPACE FILE A3901448* A3901449MT0040 JMP FR0800 XEQ MOTION REQUEST A3901450 EJT A3901451* A3901452* COMMON ERROR EXIT FOR FM ERRORS ENCOUNTERED, OTHER A3901453* THAN ERRORS DISCONNECTING FROM A JOB. A3901454* A3901455* A3901456ER0010 RTJ BCLOSF 'CLOSFL' ON EXISTING A3901457* FILE. IGNORE 'ISTAT' A3901458 SPC 2 A3901459ER0020 ENA 0 POST ERROR'S DIAG A3901460 RTJ BFWRIT MSG WITH 'ERSTAT' A3901461 SPC 2 A3901462ER0030 LDA =A DISCONNECT FROM A3901463ÐÐ STA- JOBKEY+1,I HOST AND JOB A3901464 SFA- JOBKEY,MSTR,MLTH,I 'JMNN' TO 'J ' A3901465 ENA 0 ZERO REL REC NO. A3901466 STA- HSTRNO+1,I TO $$HOST RECORD. A3901467 SPC 2 A3901468 SEF- ESTAT1,15,2,I SET V-FLD, NOT RDY A3901469 SPC 2 A3901470 LDQ- ELU,I SET DEV FAILURE A3901471 QLS 6 CODE = 28 (NO FILE) A3901472 ENA 28 A3901473 EAQ Q LU/FAILURE CODE A3901474 JMP+ ALTDEV EXIT TO ALTDEV A3901475 SPC 2 A3901476 END A3901477 NAM BOPENF A40 A ITOS CCS 3.0 SL-149A4000001* BATCH DRIVER OPEN FILE PROCESSOR A4000002* CREDIT COLLECTION SYSTEM VERSION 3.0 A4000003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A4000004* COPYRIGHT CONTROL DATA CORPORATION 1979 A4000005* A4000006**** A4000007*E A4000008* FUNCTION A4000009* -------- A4000010*S3 PROVIDES INTERFACE BETWEEN BATCH DRIVERS AND FILE MANAGER 2.0 A4000011ÐÐ* FOR 'OPENFL' REQUESTS PERTAINING TO ANY BATCH DRIVER FILE. FOR A4000012* THE PARTICULAR SYSTEM FILES $$HOST AND $$BATCH THE 'IDATA' ARRAY A4000013* IS INITIALIZED. USEAGE OF THE ROUTINE FOR OTHER FILES REQUIRES A4000014* THE CALLER TO PRE-SET THE 'IDATA' ARRAY BEFORE CALLING A4000015* THE ROUTINE. A4000016* A4000017*S4 GENERAL DESCRIPTION A4000018* ------------------- A4000019*S3 THE ROUTINE PERFORMS DRIVER/FILE MANAGER INTERFACE BY BUILDING A4000020* THE 'OPENFL' REQUEST IN THE PHYSICAL DEVICE TABLE SPECIFIED IN A4000021* SUCH A MANNER THAT CONTROL RETURNS TO THE CALLER UPON COMPLETION A4000022* OF THE 'OPENFL' REQUEST. ALL PARAMETERS PERTINENT TO THE REQUESTA4000023* ARE AT PRESPECIFIED RELATIVE LOCATIONS IN THE PHYSTB. A4000024* THE FOLLOWING AUXILARY FUNCTIONS ARE PROVIDED: A4000025*S1 1. THE FM REQUEST FOR 'OPENFL' (=0) IS SET IN PHYSTB, WD 20. A4000026* 2. THE REQUEST 'REQBUF' ARRAY BACKGROUND TO BINARY ZEROS. A4000027* 3. THE $$HOST 'OPENFL' IDATA ARRAY IS SPECIFIED FOR: A4000028* RECORD ACCESS BY RELATIVE RECORD NUMBER, A4000029* BLOCK TRANSFER OF ONE RECORD, A4000030* RECORD LOCKED ON RETRIEVAL. A4000031* 4 THE $$BATCH 'OPENFL' IDATA ARRAY IS SPECIFIED FOR: A4000032* RECORD ACCESS BY 'KEY1', A4000033* BLOCK TRANSFER OF ONE RECORD, A4000034* RECORD LOCKED ON RETRIEVAL. A4000035* A4000036ÐÐ*S4 ENTRY/EXIT CONDITIONS A4000037* --------------------- A4000038*S3 THE ADDRESS OF THE PHYSICAL DEVICE TABLE IS PASSED VIA THE A4000039* I-REGISTER ON ENTRY BY A RELATIVE 2-WORD RTJ TO ENTRY POINT NAME.A4000040* UPON RETURN TO THE CALLER AFTER COMPLETION OF THE 'OPENFL' REQUESA4000041* BOTH THE I AND Q-REGISTERS ARE RESTORED AND CONTENTS OF THE A4000042* REQUEST PARAMETER STATUS WORD 'ISTAT' IS SAVED IN PHYSTB WD 19, A4000043* 'ERSTAT' FOR DIAGNOSTIC MESSAGE POSTING. A-REG ='ISTAT'CONTENTS.A4000044* A4000045*S4 ENTRY POINTS A4000046* ------------ A4000047*S3 BOPENF - ENTRY FOR 'OPENFL'REQUEST ON 'IDATA' ARRAY SPECIFIED A4000048* BY CALLER. A4000049* A4000050* OPHOST - ENTRY FOR 'OPENFL' REQUEST FOR $$HOST SYSTEM FILE. A4000051* THE 'IDATA' ARRAY IS INITIALIZED BY THIS ENTRY. A4000052* A4000053* OPBATF - ENTRY FOR 'OPENFL' REQUEST FOR $$BATCH SYSTEM FILE. A4000054* THE 'IDATA' ARRAY IS INITIALIZED BY THIS ENTRY. A4000055* A4000056*E ENTRY, EXTERNAL AND PHYSTB EQUATES SPECIFICATIONS A4000057* ------------------------------------------------- A4000058*S3 ENTRY POINTS A4000059* A4000060 ENT BOPENF,OPHOST,OPBATF A4000061ÐÐ*S3 EXTERNAL A4000062* A4000063 EXT SYFAIL SYSTEM FAILURE PROCESSOR A4000064 EXT* ABSADD ADDRESS ABSOLUTIZING ROUTINE A4000065 EXT* OPENF FILE MANAGER OPEN FILE REQUEST PROCESSOR. A4000066*S3 PHYSTB EQUATES A4000067* A4000068 EQU ERSTAT(19) SAVE 'OPENFL' REQUEST STATUS A4000069 EQU TIMTRY(20) FM REQ CODE = 0 FOR 'OPENFL' (BITS 9 THRU 12) A4000070 EQU RTJCAL(24) PHYSTB FILE MGR CALLING SEQUENCE, 9 WORDS. A4000071 EQU REQBUF(37) OPENFL PARAMETER, 24 WORDS. A4000072 EQU IDATA(61) OPENFL PARAMETER, ONLY FIRST 15 WORDS. A4000073 EQU ISTAT(85) OPENFL PARAMETER, 1 WORD. A4000074* A4000075*S4 STRUCTURE OF 'OPENFL' PHYSTB ROUTINE A4000076* ------------------------------------ A4000077*S3 STARTS AT PHYSTB INDEX 'RTJCAL' A4000078* A4000079 EQU P1(REQBUF-RTJCAL-3) A4000080 EQU P5(IDATA-RTJCAL-4) A4000081 EQU P3(ISTAT-RTJCAL-5) A4000082* A4000083ENTRY NUM 0 PSEUDO RTJ ENTRY, CALLERS RETURN ADDRESS A4000084ENT010 RTJ+ SYFAIL OPEN FILE REQUEST A4000085 ADC (P1) REL ADDR TO 'REQBUF' PARAMETER A4000086ÐÐ ADC (P5) REL ADDR TO 'IDATA ' PARAMETER A4000087 ADC (P3) REL ADDR TO 'ISTAT' PARAMETER A4000088 LDA- ISTAT,I PICKUP 'OPENFL' REQUEST STATUS A4000089 STA- ERSTAT,I AND SAVE IN 'ERSTAT' A4000090CALXIT JMP* (ENTRY) RETURN TO BOPENF,OPHOST,OPBATF CALLER.A4000091 EQU CALTH(CALXIT-ENTRY) A4000092**** CALLER'S Q/I-REGISTERS SAVED/RESTORED BY FM. A4000093 EJT A4000094* IDATA ARRAY FOR $$HOST FILE A4000095* A4000096HSTDAT ALF 4,$$HOST FILE NAME A4000097 ALF 4,$$ USER NAME IS ITOS MASTER TERMINAL A4000098 ALF 4,SYSVOL VOLUMN NAME IS SYSTEM VOLUMN A4000099 NUM 0,1,1 ACCESS BY REL REC NO, 1 REC, LOCK ON RTV A4000100 SPC 2 A4000101* IDATA ARRAY FOR $$BATCH FILE A4000102* A4000103BATDAT ALF 4,$$BATCH FILE NAME A4000104 ALF 4,$$ USER NAME IS ITOS MASTER TERMINAL A4000105 ALF 4,SYSVOL VOLUMN NAME IS SYSTEM VOLUMN A4000106 NUM 1,1,1 ACCESS BY KEY1, 1 REC, LOCK ON RTV A4000107 SPC 2 A4000108DATLTH EQU DATLTH(14) IDATA XFR LENGTH CONTROL A4000109 EJT A4000110* ENTRY TO 'OPENFL' FILE WITH 'IDATA' SPECIFIED BY CALLER A4000111ÐÐ* A4000112BOPENF NUM 0 CALLER'S RTN ADDR ON ENTRY A4000113 XFQ 1 SAVE CALLER'S Q-REG FOR RESTORATION IN R1 A4000114 LDA* BOPENF SAVE CALLER'S RTN ADDR A4000115 STA* ENTRY IN 'OPENFL' ROUTINE. A4000116 SPC 4 A4000117* COMMON EXIT FROM 'OPHOST' AND 'OPBATF' ENTRIES A4000118BOP01 ENQ 23 BACKGROUND 24-WD 'REQBUF' A4000119 ENA 0 ARRAY IN PHYSTB. A4000120BOP05 STA- REQBUF,B A4000121 DQP *-BOP05 A4000122 SPC 2 A4000123* SET REQ CODE FOR 'OPENFL'(BITS 12-9)=0 A4000124BOP10 CLF- TIMTRY,12,4,I IN PHYSTB. A4000125 SPC 2 A4000126 RTJ ABSADD ABSOLUTIZE THE FILE REQUEST ADDRESS A4000127 ADC* OPENF A4000128 STA* ENT010+1 STORE IN THE REQUEST A4000129 SPC 1 A4000130 ENQ CALTH MOVE 'OPENFL' ROUTINE TO PHYSTB 'RTJCAL' A4000131BOP15 LDA* ENTRY,Q A4000132 STA- RTJCAL,B A4000133 DQP *-BOP15 A4000134 SPC 2 A4000135BOP20 XF1 Q RESTORE CALLER'S Q-REG FROM REG 1 AND A4000136ÐÐ JMP- RTJCAL+1,I PERFORM PSUEDO RTJ TO PHYSTB ROUTINE. A4000137 SPC 2 A4000138 EJT A4000139* ENTRY TO 'OPENFL' $$HOST FILE A4000140* A4000141OPHOST NUM 0 A4000142 LDA* BOP45 INDEX TO $$HOST IDATA A4000143 STA* BOP35+1 ARRAY 'HSTDAT'. A4000144 LDA* OPHOST PICKUP CALLER'S RTN ADDR A4000145 JMP* BOP30 A4000146 SPC 4 A4000147* ENTRY TO 'OPENFL' $$BATCH FILE A4000148* A4000149OPBATF NUM 0 A4000150 LDA* BOP50 INDEX TO $$BATCH IDATA A4000151 STA* BOP35+1 ARRAY 'BATDAT'. A4000152 LDA* OPBATF PICKUP CALLER'S RTN ADDR A4000153 SPC 4 A4000154* MOVE INDICATED IDATA ARRAY INTO PHYSTB. A4000155* A4000156BOP30 XFQ 1 SAVE CALLER'S Q-REG. IN ENHANCED REG 1 A4000157 STA* ENTRY SAVE CALLER'S RTN ADDR A4000158 ENQ DATLTH A4000159BOP35 LDA HSTDAT,Q LOOP OVER SPECIFIED IDATA ARRAY. A4000160 STA- IDATA,B A4000161ÐÐ DQP *-BOP35 A4000162 SPC 2 A4000163* EXIT VIA 'BOPENF' ROUTINE TO MOVE 'OPENFL' REQUEST TO PHYSTB A4000164* A4000165BOP40 JMP* BOP01 A4000166 SPC 3 A4000167* RELATIVE ADDRESS TO INTERNAL IDATA ARRAYS A4000168* A4000169BOP45 ADC (HSTDAT-BOP35-1) $$HOST IDATA ARRAY A4000170BOP50 ADC (BATDAT-BOP35-1) $$BATCH IDATA ARRAY A4000171 END A4000172 NAM BCLOSF A41 A ITOS CCS 3.0 SL-149A4100001* BATCH DRIVER CLOSE FILE ROUTINE A4100002* CREDIT COLLECTION SYSTEM VERSION 3.0 A4100003* DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A4100004* COPYRIGHT CONTROL DATA CORPORATION 1979 A4100005* A4100006**** A4100007*E A4100008* FUNCTION A4100009* -------- A4100010*S3 PROVIDES INTERFACE BETWEEN BATCH DRIVERS AND FILE MANAGER 2.0 A4100011* FOR 'CLOSFL' REQUESTS PERTAINING TO ANY BATCH DRIVER FILE. A4100012* A4100013*S4 GENERAL DESCRIPTION A4100014ÐÐ* ------------------- A4100015*S3 THE ROUTINE PERFORMS DRIVER/FILE MANAGER INTERFACE BY BUILDING A4100016* THE 'CLOSFL' REQUEST IN THE PHYSICAL DEVICE TABLE SPECIFIED IN A4100017* SUCH A MANNER THAT CONTROL RETURNS TO THE CALLER UPON COMPLETION A4100018* OF THE 'CLOSFL' REQUEST. ALL PARAMETERS PERTINENT TO THE REQUESTA4100019* ARE AT PRESPECIFIED RELATIVE LOCATIONS IN THE PHYSTB. A4100020* THE FOLLOWING AUXILARY FUNCTION IS PROVIDED: A4100021*S1 THE FM REQUEST FOR 'CLOSFL' IS NOT SET IN PHYSTB, WD 20. A4100022* A4100023*S4 ENTRY/EXIT CONDITIONS A4100024* --------------------- A4100025*S3 THE ADDRESS OF THE PHYSICAL DEVICE TABLE IS PASSED VIA THE A4100026* I-REGISTER ON ENTRY BY A RELATIVE 2-WORD RTJ TO ENTRY 'BCLOSF'. A4100027* A4100028* UPON RETURN TO THE CALLER AFTER COMPLETION OF THE 'CLOSFL' REQUESA4100029* BOTH THE I AND Q-REGISTERS ARE RESTORED AND CONTENTS OF THE A4100030* REQUEST PARAMETER STATUS WORD 'ISTAT' IS RETURNED IN A4100031* THE A-REGISTER. A4100032* A4100033*S4 ENTRY, EXTERNAL AND PHYSTB EQUATE SPECIFICATIONS A4100034* ------------------------------------------------ A4100035*S3 ENTRY POINT A4100036* A4100037 ENT BCLOSF ROUTINE'S ENTRY POINT A4100038*S3 EXTERNAL A4100039ÐÐ* A4100040 EXT SYFAIL SYSTEM FAILURE PROCESSOR A4100041 EXT* ABSADD ADDRESS ABSOLUTIZING ROUTINE A4100042 EXT* CLOSF FILE MANAGER CLOSE FILE REQUEST PROCESSOR A4100043*S3 PHYSTB EQUATES A4100044* A4100045 EQU TIMTRY(20) FM REQ CODE = 1 FOR 'CLOSFL' (BITS 9 THRU 12) A4100046 EQU RTJCAL(24) PHYSTB FILE MGR CALLING SEQUENCE, 7 WORDS. A4100047 EQU REQBUF(37) CLOSFL PARAMETER, 24 WORDS. A4100048 EQU ISTAT(85) CLOSFL PARAMETER, 1 WORD. A4100049* A4100050*S4 STRUCTURE OF 'CLOSFL' PHYSTB ROUTINE A4100051* ------------------------------------ A4100052*S3 STARTS AT PHYSTB INDEX 'RTJCAL' A4100053* A4100054 EQU P1(REQBUF-RTJCAL-3) A4100055 EQU P3(ISTAT-RTJCAL-4) A4100056* A4100057ENTRY NUM 0 PSEUDO RTJ ENTRY, CALLERS RETURN ADDRESS A4100058ENT010 RTJ+ SYFAIL CLOSE FILE REQUEST A4100059 ADC (P1) REL ADDR TO 'REQBUF' PARAMETER A4100060 ADC (P3) REL ADDR TO 'ISTAT' PARAMETER A4100061 LDA- ISTAT,I PICKUP 'CLOSFL' REQUEST STATUS A4100062CALXIT JMP* (ENTRY) RETURN TO BCLOSF CALLER. A4100063 EQU CALTH(CALXIT-ENTRY) A4100064ÐÐ**** CALLER'S Q/I-REGISTERS SAVED/RESTORED BY FM. A4100065 EJT A4100066* ENTRY TO 'CLOSFL' ON ANY BATCH DRIVER FILE A4100067* A4100068BCLOSF NUM 0 CALLER'S RTN ADDR ON ENTRY A4100069 XFQ 1 SAVE CALLER'S Q-REG FOR RESTORATION IN R1. A4100070 LDA* BCLOSF SAVE CALLER'S RTN ADDR A4100071 STA* ENTRY IN 'CLOSFL' ROUTINE. A4100072 SPC 2 A4100073 RTJ ABSADD ABSOLUTIZE THE FILE REQUEST ADDRESS A4100074 ADC* CLOSF A4100075 STA* ENT010+1 STORE IN THE REQUEST A4100076 SPC 1 A4100077 ENQ CALTH MOVE 'CLOSFL' ROUTINE TO PHYSTB 'RTJCAL' A4100078BCL01 LDA* ENTRY,Q A4100079 STA- RTJCAL,B A4100080 DQP *-BCL01 A4100081 SPC 2 A4100082BCL05 XF1 Q RESTORE CALLER'S Q-REG FROM R1 AND A4100083 JMP- RTJCAL+1,I PERFORM PSUEDO RTJ TO PHYSTB ROUTINE. A4100084 SPC 2 A4100085 END A4100086 NAM BREADR A42 A ITOS CCS 3.0 SL-149A4200001* BATCH DRIVER READ RECORD ROUTINE A4200002* CREDIT COLLECTION SYSTEM VERSION 3.0 A4200003ÐÐ* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A4200004* COPYRIGHT CONTROL DATA CORPORATION 1979 A4200005* A4200006**** A4200007*E A4200008* FUNCTION A4200009* -------- A4200010*S3 PROVIDES INTERFACE BETWEEN BATCH DRIVERS AND FILE MANAGER 2.0 A4200011* FOR 'READR' REQUESTS PERTAINING TO ANY BATCH DRIVER FILE. A4200012* A4200013*S4 GENERAL DESCRIPTION A4200014* ------------------- A4200015*S3 THE ROUTINE PERFORMS DRIVER/FILE MANAGER INTERFACE BY BUILDING A4200016* THE 'READR' REQUEST IN THE PHYSICAL DEVICE TABLE SPECIFIED IN A4200017* SUCH A MANNER THAT CONTROL RETURNS TO THE CALLER UPON COMPLETION A4200018* OF THE 'READR' REQUEST. ALL PARAMETERS PERTINENT TO THE REQUEST A4200019* ARE AT PRESPECIFIED RELATIVE LOCATIONS IN THE PHYSTB. A4200020* THE FOLLOWING AUXILARY FUNCTION IS PROVIDED: A4200021* THE FM REQUEST FOR 'READR' (=2) IS SET IN PHYSTB, WD 20. A4200022* A4200023*S4 ENTRY/EXIT CONDITIONS A4200024* --------------------- A4200025*S3 ON ENTRY THE ADDRESS OF THE PHYSICAL DEVICE TABLE IS IN THE A4200026* I-REGISTER AND THE PHYSTB INDEX TO PARAMETER 'RELSPC' IS A4200027* IN THE Q-REGISTER. CALLING SEQUENCE FOR ACCESS BY: A4200028ÐÐ* REL RECORD NO: KEY VALUE(2-WD): A4200029* ENQ HSTRNO ENQ JOBKEY A4200030* RTJ BREADR RTJ BREADR A4200031* RECURSIVE CALLS TO 'BREADR' MAY REFERENCE THE 'RECSPC' PARAMETER A4200032* STORED IN THE PHYSTB 'READR' CALLING SEQUENCE STARTING AT PHYSTB A4200033* INDEX 'RTJCAL+10'. A4200034* A4200035* UPON RETURN TO THE CALLER AFTER COMPLETION OF THE 'READR' REQUESTA4200036* BOTH THE I AND Q-REGISTERS ARE RESTORED AND CONTENTS OF THE A4200037* REQUEST PARAMETER STATUS WORD 'ISTAT' IS SAVED IN PHYSTB WD 19, A4200038* 'ERSTAT' FOR DIAGNOSTIC MESSAGE POSTING. A-REG ='ISTAT' CONTENTSA4200039* NOTE - FOR KEY VALUE RECORD ACCESS THE FILE MGR MAY HAVE A4200040* MODIFIED THE CONTENTS OF 'RECSPC' (RTJCAL+10). A4200041* A4200042*S4 ENTRY, EXTERNAL AND PHYSTB EQUATE SPECIFICATIONS A4200043* ------------------------------------------------ A4200044*S3 ENTRY POINT A4200045* A4200046 ENT BREADR ROUTINE'S ENTRY POINT A4200047*S3 EXTERNAL A4200048* A4200049 EXT SYFAIL SYSTEM FAILURE PROCESSOR A4200050 EXT* ABSADD ADDRESS ABSOLUTIZING ROUTINE A4200051 EXT* READRX FILE MANAGER READ RECORD ROUTINE. A4200052*S3 PHYSTB EQUATES A4200053ÐÐ* A4200054 EQU ERSTAT(19) SAVE 'READR' REQUEST STATUS A4200055 EQU TIMTRY(20) FM REQ CODE = 2 FOR 'READR' (BITS 9 THRU 12) A4200056 EQU RTJCAL(24) PHYSTB FILE MGR CALLING SEQUENCE, 12 WORDS A4200057 EQU REQBUF(37) READR PARAMETER, 24 WORDS A4200058 EQU ISTAT(85) READR PARAMETER, 1 WORD A4200059 EQU RECBUF(86) READR PARAMETER, PHYSTB DEPENDANT A4200060* A4200061*S4 STRUCTURE OF 'READR' PHYSTB ROUTINE A4200062* ----------------------------------- A4200063*S3 STARTS AT PHYSTB INDEX 'RTJCAL' A4200064* A4200065 EQU P1(REQBUF-RTJCAL-3) A4200066 EQU P2(RECBUF-RTJCAL-4) A4200067 EQU P3(ISTAT-RTJCAL-6) A4200068* A4200069ENTRY NUM 0 PSEUDO RTJ ENTRY, CALLERS RETURN ADDRESS A4200070ENT010 RTJ+ SYFAIL READR FILE REQUEST A4200071 ADC (P1) REL ADDR TO 'REQBUF' PARAMETER A4200072 ADC (P2) REL ADDR TO 'RECBUF' PARAMETER A4200073 ADC (RECSPC-*) REL ADDR TO 'RECSPC' PARAMETER A4200074 ADC (P3) REL ADDR TO 'ISTAT' PARAMETER A4200075 LDA- ISTAT,I PICKUP 'READR ' REQUEST STATUS A4200076 STA- ERSTAT,I AND SAVE IN 'ERSTAT'. A4200077 JMP* (ENTRY) RETURN TO BREADR CALLER A4200078ÐÐRECSPC BZS RECSPC(2) 2-WD 'RECSPC' PARAMETER A4200079 EQU CALTH(RECSPC+1-ENTRY) A4200080**** CALLER'S Q/I-REGISTERS SAVED/RESTORED BY FM. A4200081 EJT A4200082* ENTRY TO 'READR' FOR ANY BATCH DRIVER FILE A4200083* A4200084BREADR NUM 0 CALLER'S RTN ADDR ON ENTRY A4200085 XFQ 1 SAVE CALLERS Q-REG FOR RESTORATION IN R1. A4200086 LDA* BREADR SAVE CALLER'S RTN ADDR A4200087 STA* ENTRY IN 'READR' ROUTINE. A4200088 ENA 2 SET REQ CODE A4200089 SFA- TIMTRY,12,4,I FOR 'READR' (BITS 12-9)=2 A4200090 SPC 2 A4200091* MOVE 'RECSPC' DATA INTO PHYSTB ROUTINE A4200092 LDA- ($22),B A4200093 STA* RECSPC A4200094 LDA- 1,B A4200095 STA* RECSPC+1 A4200096 SPC 2 A4200097 RTJ ABSADD ABSOLUTIZE THE FILE REQUEST ADDRESS A4200098 ADC* READRX A4200099 STA* ENT010+1 STORE IN THE REQUEST A4200100 SPC 1 A4200101 ENQ CALTH MOVE 'READR' ROUTINE TO PHYSTB 'RTJCAL' A4200102BRD01 LDA* ENTRY,Q A4200103ÐÐ STA- RTJCAL,B A4200104 DQP *-BRD01 A4200105 SPC 2 A4200106BRD05 XF1 Q RESTORE CALLER'S Q-REG FROM R1 AND A4200107 JMP- RTJCAL+1,I PERFORM PSUEDO RTJ TO PHYSTB ROUTINE A4200108 SPC 2 A4200109 END A4200110 NAM BGETS A43 A ITOS CCS 3.0 SL-149A4300001* BATCH DRIVER GET SEQUENTIAL RECORD ROUTINE A4300002* CREDIT COLLECTION SYSTEM VERSION 3.0 A4300003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A4300004* COPYRIGHT CONTROL DATA CORPORATION 1979 A4300005* A4300006**** A4300007*E A4300008* FUNCTION A4300009* -------- A4300010*S3 PROVIDES INTERFACE BETWEEN BATCH DRIVERS AND FILE MANAGER 2.0 A4300011* FOR 'GETS' REQUESTS PERTAINING TO ANY BATCH DRIVER FILE. A4300012* A4300013*S4 GENERAL DESCRIPTION A4300014* ------------------- A4300015*S3 THE ROUTINE PERFORMS DRIVER/FILE MANAGER INTERFACE BY BUILDING A4300016* THE 'GETS' REQUEST IN THE PHYSICAL DEVICE TABLE SPECIFIED IN A4300017* SUCH A MANNER THAT CONTROL RETURNS TO THE CALLER UPON COMPLETION A4300018ÐÐ* OF THE 'GETS' REQUEST. ALL PARAMETERS PERTINENT TO THE REQUEST A4300019* ARE AT PRESPECIFIED RELATIVE LOCATIONS IN THE PHYSTB. A4300020* THE FOLLOWING AUXILARY FUNCTION IS PROVIDED: A4300021* THE FM REQUEST FOR 'GETS' (=3) IS SET IN PHYSTB, WD 20. A4300022* A4300023*S4 ENTRY/EXIT CONDITIONS A4300024* --------------------- A4300025*S3 ON ENTRY THE ADDRESS OF THE PHYSICAL DEVICE TABLE IS IN THE A4300026* I-REGISTER AND THE PHYSTB INDEX TO PARAMETER 'KEYVAL' IS A4300027* IN THE Q-REGISTER. CALLING SEQUENCE FOR ACCESS BY: A4300028* REL RECORD NO: KEY VALUE(2-WD): A4300029* (Q-REG ARBITRARY) ENQ JOBKEY A4300030* RTJ BGETS RTJ BGETS A4300031* RECURSIVE CALLS TO 'BGETS' MUST REFERENCE THE 'KEYVAL' PARAMETER A4300032* STORED IN THE PHYSTB 'GETS' CALLING SEQUENCE STARTING AT PHYSTB A4300033* INDEX 'RTJCAL+10'. A4300034* A4300035* UPON RETURN TO THE CALLER AFTER COMPLETION OF THE 'GETS' REQUEST A4300036* BOTH THE I AND Q-REGISTERS ARE RESTORED AND CONTENTS OF THE A4300037* REQUEST PARAMETER STATUS WORD 'ISTAT' IS SAVED IN PHYSTB WD 19, A4300038* 'ERSTAT' FOR DIAGNOSTIC MESSAGE POSTING. A-REG ='ISTAT' CONTENTSA4300039* NOTE - FOR RECURSIVE CALLS TO 'BGETS' USING KEY VALUE ACCESS A4300040* THE CONTENTS OF 'KEYVAL' (RTJCAL+10) MUST NOT BE ALTERED A4300041* BY THE CALLER. A4300042* A4300043ÐÐ*S4 ENTRY, EXTERNAL AND PHYSTB EQUATE SPECIFICATIONS A4300044* ------------------------------------------------ A4300045*S3 ENTRY POINT A4300046* A4300047 ENT BGETS A4300048*S3 EXTERNAL A4300049* A4300050 EXT SYFAIL SYSTEM FAILURE PROCESSOR A4300051 EXT* ABSADD ADDRESS ABSOLUTIZING ROUTINE A4300052 EXT* GETZ FILE MANAGER GET NEXT RECORD REQUEST. A4300053*S3 PHYSTB EQUATES A4300054* A4300055 EQU ERSTAT(19) SAVE 'GETS' REQUEST STATUS A4300056 EQU TIMTRY(20) FM REQ CODE = 2 FOR 'GETS' (BITS 9 THRU 12) A4300057 EQU RTJCAL(24) PHYSTB FILE MGR CALLING SEQUENCE, 12 WORDS A4300058 EQU REQBUF(37) GETS PARAMETER, 24 WORDS A4300059 EQU ISTAT(85) GETS PARAMETER, 1 WORD A4300060 EQU RECBUF(86) GETS PARAMETER, PHYSTB DEPENDANT A4300061* A4300062*S4 STRUCTURE OF 'GETS' PHYSTB ROUTINE A4300063* ---------------------------------- A4300064*S3 STARTS AT PHYSTB INDEX 'RTJCAL' A4300065* A4300066 EQU P1(REQBUF-RTJCAL-3) A4300067 EQU P2(RECBUF-RTJCAL-4) A4300068ÐÐ EQU P3(ISTAT-RTJCAL-6) A4300069* A4300070ENTRY NUM 0 PSEUDO RTJ ENTRY, CALLERS RETURN ADDRESS A4300071ENT010 RTJ+ SYFAIL GETS FILE REQUEST A4300072 ADC (P1) REL ADDR TO 'REQBUF' PARAMETER A4300073 ADC (P2) REL ADDR TO 'RECBUF' PARAMETER A4300074 ADC (KEYVAL-*) REL ADDR TO 'KEYVAL' PARAMETER A4300075 ADC (P3) REL ADDR TO 'ISTAT' PARAMETER A4300076 LDA- ISTAT,I PICKUP 'GETS ' REQUEST STATUS A4300077 STA- ERSTAT,I AND SAVE IN 'ERSTAT'. A4300078 JMP* (ENTRY) RETURN TO BGETS CALLER A4300079KEYVAL BZS KEYVAL(2) 2-WD 'KEYVAL' PARAMETER A4300080 EQU CALTH(KEYVAL+1-ENTRY) A4300081**** CALLER'S Q/I-REGISTERS SAVED/RESTORED BY FM. A4300082 EJT A4300083* ENTRY TO 'GETS' FOR ANY BATCH DRIVER FILE A4300084* A4300085BGETS NUM 0 CALLER'S RTN ADDR ON ENTRY A4300086 XFQ 1 SAVE CALLERS Q-REG FOR RESTORATION IN R1. A4300087 LDA* BGETS SAVE CALLER'S RTN ADDR A4300088 STA* ENTRY IN 'GETS' ROUTINE. A4300089 ENA 3 SET REQ CODE A4300090 SFA- TIMTRY,12,4,I FOR 'GETS' (BITS 12-9)=3 A4300091 SPC 2 A4300092* MOVE 'KEYVAL' DATA INTO PHYSTB ROUTINE A4300093ÐÐ LDA- ($22),B A4300094 STA* KEYVAL A4300095 LDA- 1,B A4300096 STA* KEYVAL+1 A4300097 SPC 2 A4300098 RTJ ABSADD ABSOLUTIZE THE FILE REQUEST ADDRESS A4300099 ADC* GETZ A4300100 STA* ENT010+1 STORE IN THE REQUEST A4300101 SPC 1 A4300102 ENQ CALTH MOVE 'GETS' ROUTINE TO PHYSTB 'RTJCAL' A4300103BGET01 LDA* ENTRY,Q A4300104 STA- RTJCAL,B A4300105 DQP *-BGET01 A4300106 SPC 2 A4300107BGET05 XF1 Q RESTORE CALLER'S Q-REG FROM R1 AND A4300108 JMP- RTJCAL+1,I PERFORM PSEUDO RTJ TO PHYSTB ROUTINE A4300109 SPC 2 A4300110 END A4300111 NAM BUPREC A44 A ITOS CCS 3.0 SL-149A4400001* BATCH DRIVER UPDATE RECORD PROCESSOR A4400002* CREDIT COLLECTION SYSTEM VERSION 3.0 A4400003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A4400004* COPYRIGHT CONTROL DATA CORPORATION 1979 A4400005* A4400006**** A4400007ÐÐ*E A4400008* FUNCTION A4400009* -------- A4400010*S3 PROVIDES INTERFACE BETWEEN BATCH DRIVERS AND FILE MANAGER 2.0 A4400011* FOR 'UPDREC' REQUESTS PERTAINING TO ANY BATCH DRIVER FILE. A4400012* A4400013*S4 GENERAL DESCRIPTION A4400014* ------------------- A4400015*S3 THE ROUTINE PERFORMS DRIVER/FILE MANAGER INTERFACE BY BUILDING A4400016* THE 'UPDREC' REQUEST IN THE PHYSICAL DEVICE TABLE SPECIFIED IN A4400017* SUCH A MANNER THAT CONTROL RETURNS TO THE CALLER UPON COMPLETION A4400018* OF THE 'UPDREC' REQUEST. ALL PARAMETERS PERTINENT TO THE REQUESTA4400019* ARE AT PRESPECIFIED RELATIVE LOCATIONS IN THE PHYSTB. A4400020* THE FOLLOWING AUXILARY FUNCTION IS PROVIDED: A4400021* THE FM REQUEST FOR 'UPDREC' (=4) IS SET IN PHYSTB, WD 20. A4400022* A4400023*S4 ENTRY/EXIT CONDITIONS A4400024* --------------------- A4400025*S3 THE ADDRESS OF THE PHYSICAL DEVICE TABLE IS PASSED VIA THE A4400026* I-REGISTER ON ENTRY BY A RELATIVE 2-WORD RTJ TO ENTRY 'BUPREC'. A4400027* A4400028* UPON RETURN TO THE CALLER AFTER COMPLETION OF THE 'UPDREC' REQUESA4400029* BOTH THE I AND Q-REGISTERS ARE RESTORED AND CONTENTS OF THE A4400030* REQUEST PARAMETER STATUS WORD 'ISTAT' IS SAVED IN PHYSTB WD 19, A4400031* 'ERSTAT' FOR DIAGNOSTIC MESSAGE POSTING. A-REG = 'ISTAT' CONTENTA4400032ÐÐ* A4400033*S4 ENTRY, EXTERNAL AND PHYSTB EQUATE SPECIFICATIONS A4400034* ------------------------------------------------ A4400035*S3 ENTRY POINT A4400036* A4400037 ENT BUPREC ROUTINE'S ENTRY POINT A4400038*S3 EXTERNAL A4400039* A4400040 EXT SYFAIL SYSTEM FAILURE PROCESSOR A4400041 EXT* ABSADD ADDRESS ABSOLUTIZING ROUTINE A4400042 EXT* UPREC FILE MANAGER UPDATE RECORD REQUEST. A4400043*S3 PHYSTB EQUATES A4400044* A4400045 EQU TIMTRY(20) FM REQ CODE = 4 FOR 'UPDREC' (BITS 9 THRU 12) A4400046 EQU RTJCAL(24) PHYSTB FILE MGR CALLING SEQUENCE, 9 WORDS A4400047 EQU REQBUF(37) UPDREC PARAMETER, 24 WORDS A4400048 EQU ISTAT(85) UPDREC PARAMETER, 1 WORD A4400049 EQU RECBUF(86) UPDREC PARAMETER, PHYSTB DEPENDANT A4400050 EQU ERSTAT(19) SAVE 'UPDREC' REQUEST STATUS A4400051* A4400052*S4 STRUCTURE OF 'UPDREC' PHYSTB ROUTINE A4400053* ------------------------------------ A4400054*S3 STARTS AT PHYSTB INDEX 'RTJCAL' A4400055* A4400056 EQU P1(REQBUF-RTJCAL-3) A4400057ÐÐ EQU P2(RECBUF-RTJCAL-4) A4400058 EQU P3(ISTAT-RTJCAL-5) A4400059* A4400060ENTRY NUM 0 PSEUDO RTJ ENTRY, CALLERS RETURN ADDRESS A4400061ENT010 RTJ+ SYFAIL UPDREC FILE REQUEST A4400062 ADC (P1) REL ADDR TO 'REQBUF' PARAMETER A4400063 ADC (P2) REL ADDR TO 'RECBUF' PARAMETER A4400064 ADC (P3) REL ADDR TO 'ISTAT' PARAMETER A4400065 LDA- ISTAT,I PICKUP 'UPDREC' REQUEST STATUS A4400066 STA- ERSTAT,I AND SAVE IN 'ERSTAT'. A4400067CALXIT JMP* (ENTRY) RETURN TO BUPREC CALLER. A4400068 EQU CALTH(CALXIT-ENTRY) A4400069**** CALLER'S Q/I-REGISTERS SAVED/RESTORED BY FM. A4400070 EJT A4400071* ENTRY TO 'UPDREC' FOR ANY BATCH DRIVER FILE A4400072* A4400073BUPREC NUM 0 CALLER'S RTN ADDR ON ENTRY A4400074 XFQ 1 SAVE CALLERS Q-REG FOR RESTORATION IN R1. A4400075 LDA* BUPREC SAVE CALLER' RTN ADDR A4400076 STA* ENTRY IN 'UPDREC' ROUTINE. A4400077 ENA 4 SET REQ CODE A4400078 SFA- TIMTRY,12,4,I FOR 'UPDREC' (BITS 12-9)=4 A4400079 SPC 2 A4400080 RTJ ABSADD ABSOLUTIZE THE FILE REQUEST ADDRESS A4400081 ADC* UPREC A4400082ÐÐ STA* ENT010+1 STORE IN THE REQUEST A4400083 SPC 1 A4400084 ENQ CALTH MOVE 'UPDREC' ROUTINE TO PHYSTB 'RTJCAL' A4400085BUP01 LDA* ENTRY,Q A4400086 STA- RTJCAL,B A4400087 DQP *-BUP01 A4400088 SPC 2 A4400089BUP05 XF1 Q RESTORE CALLER'S Q-REG FROM R1 AND A4400090 JMP- RTJCAL+1,I PERFORM PSUEDO RTJ TO PHYSTB ROUTINE A4400091 SPC 2 A4400092 END A4400093 NAM BTIMER A45 A ITOS CCS 3.0 SL-149A4500001* BATCH DRIVER TIMER REQUEST PROCESSOR A4500002* CREDIT COLLECTION SYSTEM VERSION 3.0 A4500003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A4500004* COPYRIGHT CONTROL DATA CORPORATION 1979 A4500005* A4500006**** A4500007*E A4500008* FUNCTION A4500009* -------- A4500010*S3 PROVIDES FOR BATCH DRIVER QUEUING REQUESTS FOR ACCESS TO A4500011* FILES/RECORDS THAT ARE FOUND LOCKED BY THE BATCH DRIVER. A4500012* A4500013*S4 GENERAL DESCRIPTION A4500014ÐÐ* ------------------- A4500015*S3 THE ROUTINE ALLOWS BATCH DRIVERS TO DELAY REPEATING FILE MANAGER A4500016* ACCESS REQUESTS BY BUIDING A MSOS TIMER CALL IN THE PHYSICAL A4500017* DEVICE TABLE IN SUCH A MANNER THAT CONTROL RETURNS TO THE CALLER A4500018* UPON EXPIRATION OF A PRESPECIFIED TIME DELAY. A4500019* A4500020*S4 ENTRY/EXIT CONDITIONS A4500021* --------------------- A4500022*S3 THE ADDRESS OF THE PHYSICAL DEVICE TABLE IS PASSED VIA THE A4500023* I-REGISTER ON ENTRY BY A RELATIVE 2-WORD RTJ TO ENTRY 'BTIMER'. A4500024* A4500025* UPON RETURN TO THE CALLER AFTER COMPLETION OF THE MSOS TIMER A4500026* CALL THE I-REGISTER IS RESTORED. BOTH A/Q-REGISTERS ARE A4500027* DESTROYED. A4500028* A4500029*S4 ENTRY AND EQUATE SPECIFICATIONS A4500030* ------------------------------- A4500031*S3 ENTRY POINT A4500032* A4500033 ENT BTIMER A4500034*S3 EQUATES A4500035* A4500036 EQU PRLVL($EF) CALLER CURRENT RUNNING LEVEL A4500037 EQU AMONI($F4) MONITOR REQUEST ENTRY PROCESSOR ADDRESS A4500038 EQU ADISP($EA) MONITOR DISPATCHER ADDRESS A4500039ÐÐ EQU TIMTRY(20) PHYSTB TIMER TRY COUNTS (BITS 0 THRU 8) A4500040 EQU RTJCAL(24) MSOS TIMER CALL SEQUENCE, 12 WORDS A4500041* A4500042*S4 STRUCTURE OF TIMER PHYSTB ROUTINE A4500043* --------------------------------- A4500044*S3 STARTS AT PHYSTB INDEX 'RTJCAL' A4500045* A4500046 EQU LVL(9) SET DUMMY COMPLETION PRIORITY A4500047ENTRY NUM 0 PSEUDO RTJ ENTRY, CALLERS RETURN ADDRESS A4500048 RTJ- (AMONI) A4500049TIMREQ ADC $1110+LVL DELAY IN 0.1 SEC UNITS/MERGED CURRENT LEVEL A4500050 ADC ICMPL-TIMREQ COMPLETION ADDRESS A4500051 NUM 1 1 TIME UNIT DELAY A4500052 JMP- (ADISP) EXIT DISPATCHER, AWAIT TIME EXPIRATION. A4500053ICMPL LDA =N0 UPON TIME EXPIRATION, RESTORE I-REG TO A4500054 EQU PHYADR(ICMPL+1) PHYSTB ADDRESS A4500055 STA- I AND A4500056 RAO- TIMTRY,I BUMP TALLY OF TIMER TRYS. A4500057CALXIT JMP* (ENTRY) RETURN TO BTIMER CALLER WITH CALLER'S A4500058 EQU CALTH(CALXIT-ENTRY) I-REGISTER RESTORED, CALLER'S A4500059**** A/Q-REGISTERS DESTROYED. A4500060 EJT A4500061* ENTRY TO PROVIDE BATCH DRIVER TIME DELAY A4500062* A4500063BTIMER NUM 0 CALLER'S RTN ADDR ON ENTRY A4500064ÐÐ LDA* BTIMER SAVE CALLER'S RTN ADDR A4500065 STA* ENTRY IN TIMER CALL ROUTINE. A4500066* A4500067 LDA- PRLVL MERGE CURRENT PRIORITY LEVEL A4500068 SFA* TIMREQ,3,4 INTO TIMER CALL FOR COMPLETION PRIORITY. A4500069* A4500070 LDA- I SAVE PHYSTB ADDRESS A4500071 STA* PHYADR IN TIMER CALL ROUTINE. A4500072 SPC 2 A4500073 ENQ CALTH MOVE TIMER CALL ROUTINE TO PHYSTB 'RTJCAL' A4500074BTIM01 LDA* ENTRY,Q A4500075 STA- RTJCAL,B A4500076 DQP *-BTIM01 A4500077BTIM05 JMP- RTJCAL+1,I PERFORM PSEUDO RTJ TO PHYSTB ROUTINE A4500078 SPC 2 A4500079 END A4500080 NAM BFWRIT A46 A ITOS CCS 3.0 SL-149A4600001* BATCH DRIVER FORMATTED WRITE REQUEST PROCESSOR A4600002* CREDIT COLLECTION SYSTEM VERSION 3.0 A4600003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A4600004* COPYRIGHT CONTROL DATA CORPORATION 1979 A4600005* A4600006**** A4600007*E A4600008* FUNCTION A4600009ÐÐ* -------- A4600010*S3 PROVIDES BATCH DRIVERS THE CAPABILITY OF LOGGING ABNORMAL OR A4600011* DIAGNOSTIC ERROR INFORMATION ON THE SYSTEM COMMENT DEVICE. A4600012* A4600013*S4 GENERAL DESCRIPTION A4600014* ------------------- A4600015*S3 THE ROUTINE ALLOWS BATCH DRIVERS TO LOG 2 CLASSES OF MESSAGES: A4600016* CLASS A - UNCONDITIONAL LOGGING OF MESSAGE SPECIFIED BY A4600017* THE BATCH DRIVER. A4600018* CLASS B - CONDITIONAL LOGGING OF THE FOLLOWING DIAGNOSTIC: A4600019* A4600020* ' JMNN FM RTJ =$XXXX, REQTYP FILENAME/ USERNAME' A4600021* ---- ---- ------ -------- ---------- A4600022* JOBKEY --- - - - - A4600023* 'ERSTAT' ---- - - - A4600024* - IDATA(1)- IDATA(5)- A4600025* OPENFL, CLOSFL, READR, GETS---- THRU - THRU - A4600026* UPDREC, CREATE, RENAME,PUTS---- IDATA(4)- IDATA(8)- A4600027* DELETE, REDUCE----------------- A4600028* A4600029* CLASS B MESSAGE IS LOGGED ONLY IF FM DIAGNOSTIC POSTING IS A4600030* ENABLED IN THE PHYSTB (BIT15=1) WD 20) AND A4600031* FM ERROR STATUS (WD 19) IS NON-ZERO. A4600032* A4600033* CLASS A MESSAGE ENCODED BY BATCH DRIVER IN PHYSTB 'RECBUF' A4600034ÐÐ* ARRAY BEFORE CALLING BFWRIT. A4600035* A4600036* THE ROUTINE BUILDS A MSOS FWRITE REQUEST IN THE PHYSICAL DEVICE A4600037* TABLE IN SUCH A MANNER THAT CONTROL RETURNS TO THE CALLER UPON A4600038* I/O COMPLETION OF THE REQUEST. A4600039* A4600040*S4 ENTRY/EXIT CONDITIONS A4600041* --------------------- A4600042*S3 THE ADDRESS OF THE PHYSICAL DEVICE TABLE IS PASSED VIA THE A4600043* I-REGISTER AND THE MESSAGE CLASS IS SPECIFIED IN THE A-REGISTER A4600044* ON ENTRY BY A RELATIVE 2-WORD RTJ TO ENTRY 'BFWRIT'. A4600045* A-REG = 0, CLASS B A4600046* A-REG = MESSAGE LENGTH, CLASS A (LENGTH.LE.40) A4600047* A4600048* UPON RETURN TO THE CALLER AFTER I/O COMPLETION OF THE MSOS FWRITEA4600049* REQUEST, THE I-REGISTER IS RESTORED. BOTH A/Q-REGISTERS ARE A4600050* DESTROYED. A4600051* A4600052*E ENTRY AND EQUATE SPECIFICATIONS A4600053* ------------------------------- A4600054*S3 ENTRY POINT A4600055* A4600056 ENT BFWRIT A4600057*S3 EQUATES A4600058* A4600059ÐÐ EQU PRLVL($EF) CALLER CURRENT RUNNING LEVEL A4600060 EQU AMONI($F4) MONITOR REQUEST ENTRY PROCESSOR ADDRESS A4600061 EQU ADISP($EA) MONITOR DISPATCHER ADDRESS A4600062 EQU ONE(3) LOCORE MASK = $0001 A4600063 EQU THREE(4) LOCORE MASK = $0003 A4600064 EQU ERSTAT(19) PHYSTB FILE MGR ERROR STATUS A4600065 EQU TIMTRY(20) DIAGNOSTIC POSTING (BIT15=0,DISABLED A4600066* BIT15=1,ENABLED) A4600067* FM REG CODE (BIT 12-9)=0, OPENFL A4600068* =1, CLOSFL A4600069* =2, READR A4600070* =3, GETS A4600071* =4, UPDREC A4600072* =5, CREATE A4600073* =6, RENAME A4600074* =7, REDUCE A4600075* =8, PUTS A4600076* =9, DELETE A4600077* =10-15, UNUSED A4600078 EQU JOBKEY(21) PHYSTB JOB NUMBER A4600079 EQU RTJCAL(24) MSOS FWRITE REQUEST A4600080 EQU IDATA(61) FILE MGR REQUEST PARAMETER 'IDATA' A4600081 EQU ISTAT(85) FILE MGR REQUEST PARAMETER 'ISTAT' A4600082 EQU RECBUF(86) FWRITE OUTPUT BUFFER A4600083* A4600084ÐÐ*S4 STRUCTURE OF FWRITE PHYSTB ROUTINE A4600085* ---------------------------------- A4600086*S3 STARTS AT PHYSTB INDEX 'RTJCAL' A4600087* A4600088 EQU P2(RECBUF-RTJCAL-2) A4600089 EQU LVL(9) SET DUMMY RP, LP A4600090ENTRY NUM 0 PSEUDO RTJ ENTRY, CALLERS RETURN ADDRESS A4600091 RTJ- (AMONI) A4600092FWRITE ADC $0D00+$10*LVL+LVL MERGED CURRENT LEVEL TO RP, CP A4600093 ADC ICMPL-FWRITE COMPLETION ADDRESS A4600094 NUM 0 REQUEST THREAD A4600095LOGLU NUM $18FC STD COMMENT LU (ASCII MODE) A4600096LNGTH NUM 0 I/O LENGTH SET BY 'BFWRIT' A4600097 ADC P2 MESSAGE OUTPUT BUFFER A4600098 JMP- (ADISP) EXIT DISPATCHER, AWAIT OUTPUT COMPLETION A4600099ICMPL LDA =N0 UPON OUTPUT COMPLETION, RESTORE I-REG TO A4600100 EQU PHYADR(ICMPL+1) PHYSTB ADDRESS A4600101 STA- I AND A4600102CALXIT JMP* (ENTRY) RETURN TO BFWRIT CALLER WITH CALLER'S A4600103 EQU CALTH(CALXIT-ENTRY) I-REGISTER RESTORED, CALLER'S A4600104**** A/Q-REGISTERS DESTROYED. A4600105 EJT A4600106* ENTRY TO PROVIDE BATCH DRIVER MESSAGE LOGGING A4600107* A4600108BFWRIT NUM 0 CALLER'S RTN ADDR ON ENTRY A4600109ÐÐ STA* LNGTH SAVE A-REG = MSG LENGTH (=0, CANNED MSG) A4600110 LDA* BFWRIT SAVE CALLER'S RTN ADDR A4600111 STA* ENTRY IN FWRITE CALL ROUTINE A4600112* A4600113 LDA- I SAVE PHYSTB ADDRESS A4600114 STA* PHYADR IN FWRITE CALL ROUTINE. A4600115* A4600116 LDA- PRLVL GET CURRENT (CALLER'S) RUNNING LEVEL A4600117 SFA* FWRITE,3,4 SET COMPLETION PRIORITY (CP) A4600118 SFA* FWRITE,7,4 SET REQUEST PRIORITY (RP) A4600119 SPC 2 A4600120* BRANCH ON MESSAGE CLASS A4600121 LDA* LNGTH A4600122 SAZ BFWT20 A4600123 SPC 3 A4600124* CLASS A MSG - OUTPUT BUFFER IN PHYSTB (RECBUF) PRESET A4600125* BY CALL. OUTPUT LENGTH.LE.40 WORDS A4600126* A4600127BFWT01 SAM BFWT05 VERIFY POSITIVE LENGTH A4600128 INA -41 VERIFY LENGTH.LE.40 A4600129 SAM BFWT10 A4600130BFWT05 ENA 40 INVALID LENGTH, A4600131 STA* LNGTH SET TO 40 WORDS. A4600132BFWT10 JMP BFWT70 MOVE FWRITE TO PHYSTB AND XEQ IT A4600133 SPC 4 A4600134ÐÐ* CLASS B MSG - VERIFY CONDITIONAL OUTPUT IS PERMISIVE A4600135* A4600136BFWT20 LDA- ERSTAT,I VERIFY THERE IS NON-ZERO A4600137 SAN BFWT25 FM ERROR STATUS. A4600138 JMP* (BFWRIT) NO - OMIT DIAG MESSAGE AND RETURN A4600139* A4600140BFWT25 LDA- TIMTRY,I VERIFY IF DIAGNOSTIC MESSAGE A4600141 SAM BFWT30 POSTING IS ENABLED. A4600142 JMP* (BFWRIT) NO - DIAG MSG POSTING DISABLED, RETURN A4600143 EJT A4600144* STRUCTURE CANNED DIAGNOSTIC MESSAGE IN PHYSTB (RECBUF) A4600145* ' JMNN FM RJT =$XXXX, REQTYP FILENAME/ USERNAME' A4600146* A4600147BFWT30 LDA- JOBKEY,I MOVE ASCII JOBKEY A4600148 STA* BFWT81 INTO DIAG MSG. A4600149 LDA- JOBKEY+1,I A4600150 STA* BFWT81+1 A4600151* CONVERT'ERSTAT' TO ASCII AND MOVE TO DIAG MSG A4600152 ENA 0 INITIAL CHAR ADDR A4600153 XFA 1 REG 1. A4600154 LFA- ERSTAT,15,4,I GET HI-ORDER HEXDEC DIGIT A4600155 RTJ* HEXASC AND CONVERT TO ASCII, STORE IN DIAG MSG. A4600156 LFA- ERSTAT,11,4,I GET NEXT HEXDEC DIGIT A4600157 RTJ* HEXASC A4600158 LFA- ERSTAT,7,4,I A4600159ÐÐ RTJ* HEXASC A4600160 LFA- ERSTAT,3,4,I GET LO-ORDER HEXDEC DIGIT A4600161 RTJ* HEXASC AND CONVERT TO ASCII, STORE IN DIAG MSG A4600162* ENCODE REQTYP INTO DIAG MSG. A4600163 LFA- TIMTRY,12,4,I GET FM REQTYP CODE (BITS 12-9) A4600164 MUI- THREE CALC INDEX INTO 'REQTYP' ARRAY A4600165 TRA Q AND SAVE FOR INDEXING. A4600166 SUB* INVADR INSURE INDEX TO REQTPY DESCRIPTOR VALID A4600167 SAM BFWT40 A4600168 LDQ* INVADR NO - ENCODE BLANKS FOR INVALID CODE A4600169* ENCODE ASCII REQTYP DESCRIPTOR A4600170BFWT40 ENA 5 USE R1 FOR INDEX AND LOOP CONTROL A4600171 XFA 1 A4600172BFWT45 LCA* REQTYP,1,Q MOVE DESCRIPTOR TO DIAG. MSG A4600173 SCA* BFWT83,1 A4600174 D1P *-BFWT45 A4600175* MOVE FILENAME FROM PHYSTB TO DIAG MSG A4600176 ENQ 3 A4600177BFWT50 LDA- IDATA,B IDATA(4) TO IDATA(1) A4600178 STA* BFWT84,Q A4600179 DQP *-BFWT50 A4600180* MOVE USERNAME FROM PHYSTB TO DIAG MSG A4600181 ENQ 3 A4600182BFWT55 LDA- IDATA+4,B IDATA(8) TO IDATA(5) A4600183 STA* BFWT85,Q A4600184ÐÐ DQP *-BFWT55 A4600185* A4600186 LDQ* DIALTH SET LENGTH OF DIAG. MSG A4600187 STQ* LNGTH IN FWRITE REQUEST A4600188 INQ -1 MOVE ENCODED DIAGNOSTIC MSG A4600189* A4600190BFWT60 LDA* BFWT80,Q TO OUTPUT BUFFER IN PHYSTB (RECBUF) A4600191 STA- RECBUF,B A4600192 DQP *-BFWT60 A4600193 EJT A4600194* MOVE FWRITE ROUTINE TO PHYSTB AND XEQ IT A4600195* A4600196BFWT70 ENQ CALTH A4600197BFWT72 LDA* ENTRY,Q A4600198 STA- RTJCAL,B A4600199 DQP *-BFWT72 A4600200BFWT74 JMP- RTJCAL+1,I PERFORM PSEUDO RTJ TO PHYSTB ROUTINE A4600201 SPC 10 A4600202* ROUTINE CONVERTS HEXDEC DIGIT IN LO-ORDER A-REG A4600203* AND STORES INTO THE CHARACTER ADDRESS SPECIFIED A4600204* BY REG 1. A4600205HEXASC NUM 0 ENTRY A4600206 INA -10 CK IF DIGIT .LE.9 A4600207 SAM HEX01 A4600208 INA 7 NO - RESTORE DIGIT, ADD $37 A4600209ÐÐHEX01 INA $3A YES- RESTORE DIGIT, ADD $30 A4600210 SCA* BFWT82,1 STORE ASCII DIGIT INTO CHARACTER ADDRESS A4600211 AR1- ONE BUMP CHARACTER ADDRESS A4600212 JMP* (HEXASC) RETURN A4600213 EJT A4600214* INTERNAL TABLES FOR DIAGNOSTIC MSG ENCODING A4600215 SPC 4 A4600216* CANNED DIAGNOSTIC MESSAGE A4600217* A4600218BFWT80 ALF 1, BLANKS A4600219BFWT81 ALF 2, ASCII 4-CHAR JOBKEY A4600220 ALF 5, FM RJT =$ A4600221BFWT82 ALF 2, ASCII 4-CHAR 'ERSTAT' A4600222 ALF 1,, A4600223BFWT83 ALF 4, ASCII 6-CHAR REQTYP + 2 BLANKS A4600224BFWT84 ALF 4, ASCII 8-CHAR FILENAME A4600225 ALF 1,/ A4600226BFWT85 ALF 4, ASCII 8-CHAR USERNAME A4600227* A4600228DIALTH ADC *-BFWT80 DIAGNOSTIC MESSAGE LENGTH A4600229 SPC 4 A4600230* TABLE OF ASCII FM REQUEST TYPES A4600231* A4600232REQTYP ALF 3,OPENFL CODE = 0 A4600233 ALF 3,CLOSFL = 1 A4600234ÐÐ ALF 3,READR = 2 A4600235 ALF 3,GETS = 3 A4600236 ALF 3,UPDREC = 4 A4600237 ALF 3,CREATE = 5 A4600238 ALF 3,RENAME = 6 A4600239 ALF 3,REDUCE = 7 A4600240 ALF 3,PUTS = 8 A4600241 ALF 3,DELETE = 9 A4600242* INSERT ADDITIONS AFTER LAST ENTRY ABOVE A4600243INVALD ALF 3, USE BLANK FOR INVALID REQTYP CODES A4600244INVADR ADC INVALD-REQTYP A4600245 SPC 2 A4600246 END A4600247 NAM AUTOBT A47 A ITOS CCS 3.0 . SL-149A4700001* AUTOMATIC DEFERRED BATCH PROCESSOR A4700002* CREDIT COLLECTION SYSTEM VERSION 3.0 A4700003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A4700004* COPYRIGHT CONTROL DATA CORPORATION 1979 A4700005* A4700006**** A4700007*E A4700008* FUNCTION A4700009* -------- A4700010* A4700011* A4700012ÐÐ* A4700013* THIS PROCESSOR MONITORS FILE $$HOST FOR JOBS SUBMITTED FOR A4700014* DEFERRED BATCH PROCESSING FROM AN ITOS USER TERMINAL. IF A4700015* JOBS HAVE BEEN SUBMITTED AND PROCESSING IS NOT IN PROGRESS, A4700016* IT IS INITIATED BY THIS PROCESSOR. A4700017* A4700018* A4700019* A4700020* A4700021* A4700022* GENERAL DESCRIPTION A4700023* ------------------- A4700024* A4700025* A4700026* A4700027* READ THE $$HOST FILE. A4700028* A4700029* IF THE HOST IS SET TO A LU THEN, A4700030* A4700031* IF THE HOST IS NOT ACTIVE THEN, A4700032* A4700033* IF JOBS ARE QUEUED THEN, A4700034* A4700035* IF THE HOST TYPE IS LOCAL THEN, A4700036* A4700037ÐÐ* SIMULATE: MI A4700038* *BATCH A4700039* CHECK NEXT HOST. A4700040* OTHERWISE, CHECK NEXT HOST (200UT AND HASP A4700041* AUTOMATIC MODE IS NOT CURRENTLY IMPLEMENTED). A4700042* A4700043* OTHERWISE, SET CONTINUE TO MONITOR FLAG. A4700044* A4700045* OTHERWISE, CHECK NEXT HOST. A4700046* A4700047* OTHERWISE, CHECK NEXT HOST. A4700048* A4700049* IF THE CONTINUE TO MONITOR FLAG SET WHEN DONE THEN, A4700050* A4700051* MAKE A TIMER CALL FOR SELF AND RELEASE. A4700052* A4700053* OTHERWISE, RESET RUNNING FLAG AND RELEASE. A4700054* A4700055* A4700056* A4700057* A4700058* A4700059* ENTRY A4700060* ----- A4700061* A4700062ÐÐ* A4700063* A4700064* ENTRY IS VIA A TIMER CALL FROM EITHER DBATIN OR FROM A4700065* THE ROUTINE ITSELF. THERE ARE NO PARAMETERS PASSED. A4700066* A4700067* A4700068* A4700069* A4700070* A4700071* EXIT A4700072* ---- A4700073* A4700074* A4700075* A4700076* IF ANY HOST IS NOT STOPPED AND IS NOT ACTIVE A TIMER A4700077* CALL IS MADE FOR ITSELF AND THE ROUTINE IS RELEASED. A4700078* OTHERWISE, THE ROUTINE ACTIVE FLAG IS RESET AND THE A4700079* ROUTINE IS RELEASED. A4700080* A4700081* A4700082* A4700083* A4700084* A4700085* ENTRY POINTS A4700086* ------------ A4700087ÐÐ* A4700088* A4700089* A4700090* NONE A4700091* A4700092* A4700093* A4700094* A4700095* A4700096* EXTERNAL REFERENCES A4700097* ------------------- A4700098* A4700099* A4700100* A4700101 EXT AUTOBT AUTOMATIC BATCH MODE ORDINAL A4700102 EXT* OPENFL FILE MANAGER OPEN FILE REQUEST A4700103 EXT* GETS FILE MANAGER GETS FILE REQUEST A4700104 EXT* CLOSFL FILE MANAGER CLOSE FILE REQUEST A4700105 EXT BAITOS CONCURRENT BATCH INDICATOR A4700106 EXT TSNABL ITOS ENABLED INDICATOR A4700107 EXT AUTON AUTO MODE IN SYSDAT: MINUS = NOT ALLOWED A4700108* 0 = NOT ACTIVE A4700109* 1 = ACTIVE A4700110 EXT MIB MANUAL INTERRUPT A4700111 EXT MIBX LOCK OUT FLAGS A4700112ÐÐ EXT MIINP MI INPUT BFR IN SYSDAT A4700113 EXT JOBIND JOB PROCESSOR IN MEMORY FLAG A4700114 EXT SWTCH LIBEDT LOCK OUT SWITCH A4700115 EXT JOBSTR JOB PROCESSOR START IN MINT A4700116* A4700117* A4700118* A4700119* A4700120* A4700121* EQUATES A4700122* ------- A4700123* A4700124* A4700125* A4700126 EQU ONEBIT($23) A4700127 EQU AMONI($F4) MONITOR REQUEST ENTRY A4700128 EQU ADISP($EA) DISPATCHER A4700129 EQU PRLVL($EF) CURRENT PRIORITY LEVEL A4700130 EQU OPNBSY($6A23) OPEN FILE BUSY STATUS A4700131 EQU GTSBSY($6120) SET RECORD BUSY STATUS A4700132 EQU L(36) LENGTH OF MI BUFFER A4700133 EJT A4700134AUT000 RTJ OPENFL OPEN THE $$HOST FILE A4700135 ADC (REQBUF-AUT000-2) A4700136 ADC (IDATA-AUT000-3) A4700137ÐÐ ADC (ISTAT-AUT000-4) A4700138 LDA* ISTAT REQUEST STATUS A4700139 SAP AUT030 SKIP IF REQUEST NOT REJECTED A4700140 AND =XOPNBSY CHECK IF BUSY A4700141 SAN AUT010 SKIP IF REJECT A4700142 LDA* TIMTRY CHECK NUMBER OF REQUESTS TRIED A4700143 INA -11 MAX TRIES 127*5131A4700144 SAM AUT020 SKIP IF RETRY PERMITTED A4700145AUT010 JMP AUTERR ERROR EXIT A4700146AUT020 RTJ ATIMER DELAY A4700147 JMP* AUT000 RETRY A4700148AUT030 ENA 0 CLEAR RECBUF A4700149 ENQ 27 A4700150AUT040 STA RECBUF,Q 127*5131A4700151 DQP *-AUT040 A4700152 STA* TIMTRY CLEAR NUMBER OF TRYS A4700153AUT050 RTJ GETS GET THE NEXT SEQUENTIAL RECORD A4700154 ADC (REQBUF-AUT050-2) A4700155 ADC (RECBUF-AUT050-3) A4700156 ADC (KEYVAL-AUT050-4) A4700157 ADC (ISTAT-AUT050-5) A4700158 LDA* ISTAT REQUEST STATUS A4700159 SAM AUT055 SKIP IF REJECT A4700160 JMP* AUT120 PROCESS THIS HOST A4700161AUT055 AND =XGTSBSY CHECK IF BUSY A4700162ÐÐ SAN AUT060 SKIP IF REJECT A4700163 LDA* TIMTRY CHECK NUMBER TRIED A4700164 INA -25 MAX TRIES 127*5131A4700165 SAP AUT065 SKIP IF EXCEEDED TRYS PERMITTED A4700166 RTJ ATIMER DELAY A4700167 JMP* AUT050 RETRY A4700168AUT060 AND- ONEBIT+8 A4700169 SAN AUT070 SKIP IF END-OF-FILE A4700170 LDA* ERRFLG HAS ERROR MESSAGE ALREADY BEEN ISSUED 127*5131A4700171 SAN AUT070 YES 127*5131A4700172AUT065 JMP AUTERR ERROREXIT A4700173AUT070 RTJ CLOSFL EOF, ALL $$HOST RECORDS CHECKED, CLOSE FILE A4700174 ADC (REQBUF-AUT070-2) A4700175 ADC (ISTAT-AUT070-3) A4700176 LDA* ISTAT CHECK REQUEST STATUS A4700177 SAP AUT080 SKIP IF REQUEST NOT REJECTED A4700178 LDA* ERRFLG HAS ERROR MESSAGE ALREADY BEEN ISSUED 127*5131A4700179 SAZ AUT075 NO 127*5131A4700180 ENA 0 127*5131A4700181 STA+ AUTON 127*5131A4700182 JMP* AUT110 127*5131A4700183* 127*5131A4700184AUT075 JMP AUTERR ERROR EXIT 127*5131A4700185AUT080 LDA* CTC CHECK CONTINUE TO CYCLE FLAG A4700186 SAN AUT090 SKIP IF CONTINUE A4700187ÐÐ STA+ AUTON RESET AUTO MODE ACTIVE FLAG A4700188 JMP* AUT110 EXIT A4700189AUT090 LDA- PRLVL TIMER REQUEST FOR SELF A4700190 SFA* AUT100,3,4 MERGE CPL IN TIMER REQUEST A4700191 RTJ- (AMONI) A4700192AUT100 NUM $1020 DELAY IN 1 SEC UNITS/MERGED CPL A4700193 ADC (AUTOBT) SCHEDULE SELF A4700194 NUM 15 15 TIME UNIT DELAY A4700195AUT110 RTJ- (AMONI) RELEASE AND DISP REQUEST A4700196 NUM $1901 REL ALLOC AND DISP A4700197 ADC (AUT000-AUT110-1) A4700198 EJT A4700199AUT120 SFN* RECBUF+2,7,8 SKIP IF LU ASSIGNED TO HOST A4700200 JMP* AUT030 GET NEXT RECORD A4700201 SFZ* RECBUF+2,11,2 SKIP IF HOST NOT ACTIVE OR ABORTED A4700202 JMP* AUT030 GET NEXT RECORD A4700203* CHECK THIS HOST FOR ANY QUEUED JOB 'NOT SENT' A4700204 ENA 14 SET WORD LOOP CONTROL A4700205 XFA 2 FOR ST01 TO ST99 A4700206 ENQ 0 SET Q FOR ST01-ST04 A4700207* MAIN LOOP OVER R2 A4700208AUT130 ENA 3 LOOP CONTROL OVER A4700209 XFA 1 4 STATUS 4-BIT BYTES A4700210 LDA* RECBUF+3,Q GET NEXT 4 BYTES A4700211 XFQ 3 SAVE INDEX TO RECBUF A4700212ÐÐ* SECONDARY LOOP OVER 4 BYTES A4700213AUT140 CLR Q ISOLATE NEXT STATUS A4700214 LLS 4 BYTE IN Q-REG A4700215 INQ -1 CK IF STNN=1 A4700216 SQZ AUT150 YES - INITIATE BATCH FOR HOST TYPE A4700217 D1P *-AUT140 SECONDARY LOOP, A-REG PRESERVED A4700218 XF3 Q NO - RESTORE INDEX A4700219 INQ 1 TO NEXT RECBUF A4700220 D2P *-AUT130 CK IF ST99 DONE A4700221* THIS HOST HAS NO QUEUED JOBS A4700222 RAO* CTC AT PRESENT, SET CONTINUE TO A4700223 JMP* AUT030 CYCLE FLAG AND GET NEXT RECORD A4700224AUT150 LFA* RECBUF+2,9,2 A4700225 TRA Q A4700226 JMP* AUTYP,Q A4700227AUTYP JMP* LOCAL LOCAL BATCH PROCESSING A4700228 JMP* UT200 200UT SIMULATOR A4700229 JMP* HASP HASP WORK STATION SIMULATOR A4700230 JMP* AUT030 INVALID TYPE A4700231 EJT A4700232TIMTRY NUM 0 FILE MANAGER REQUEST TRYS ATTEMPTED A4700233CTC NUM 0 CONTINUE TO CYCLE AUTO BATCH MODE FLAG A4700234ERRFLG NUM 0 ERROR MESSAGE FLAG 127*5131A4700235 SPC 2 A4700236* A4700237ÐÐ* FILE MANAGER REQUEST BUFFERS A4700238* A4700239ISTAT NUM 0 FILE MANAGWER STATUS A4700240REQBUF BZS REQBUF(24) A4700241IDATA ALF 4,$$HOST FILE NAME A4700242 ALF 4,$$ FILE OWNER A4700243 ALF 4,SYSVOL VOLUME NAME A4700244 NUM 0 ACCESS FOR RELATIVE RECORD RETRIEVAL A4700245 NUM 1 NUMBER OF RECORDS TO RETRIEVE PER REQUEST A4700246 NUM 0 NO FILE LOCKING A4700247RECBUF BZS RECBUF(28) FILE MANAGER RETRIEVED RECORD A4700248KEYVAL BZS KEYVAL(2) KEY VALUE IGNORED IF NOT RETRIEVE BY KEY A4700249 EJT A4700250* A4700251* PROVIDES DELAY FOR REQUST RETRY IF FILE FOUND LOCKED A4700252* A4700253ATIMER NUM 0 ENTRY A4700254 LDA- PRLVL MERGE CURRENT PRIORITY LEVEL A4700255 SFA* TIMREQ,3,4 A4700256 RTJ- (AMONI) A4700257TIMREQ NUM $1110 DELAY IN 0.1 SECS UNITS/MERGED CPL A4700258 ADC ICMPL-TIMREQ COMPLETION ADR A4700259 NUM 1 1 TIME UNIT DELAY A4700260 JMP- (ADISP) EXIT DISPATCHER, AWAIT TIME EXPIRATION A4700261ICMPL RAO* TIMTRY BUMP TALLY OF TIMER TRYS A4700262ÐÐ JMP* (ATIMER) RETURN A4700263 EJT A4700264* A4700265* COMMON ERROR ROUTINE A4700266* A4700267AUTERR ENA 0 DISABLE AUTO MODE A4700268 STA* CTC A4700269 RAO* ERRFLG SET ERROR FLAG. 127*5131A4700270 LDA- PRLVL MERGE CPL IN RQST A4700271 SFA* ERR,3,4 A4700272 RTJ- (AMONI) ALERT OPERATOR AUTO MODE DISABLED A4700273ERR NUM $0D07 A4700274 ADC AUT070-ERR COMPLETION ATTEMPTS TO CLOSE FILE A4700275 ADC 0 A4700276 ADC $18FC A4700277 ADC 13 A4700278 ADC ERRM-ERR A4700279 JMP- (ADISP) A4700280 SPC 2 A4700281ERRM ALF 13, AUTO BATCH MODE DISABLED. A4700282 EJT A4700283* A4700284* 200UT SIMULATION PROCESSING A4700285* NOT CURRENTLY IMPLEMENTED A4700286* A4700287ÐÐUT200 JMP AUT030 GET NEXT HOST RECORD A4700288 SPC 2 A4700289* A4700290* HASP WORK STATION SIMULATION PROCESSING A4700291* NOT CURRENTLY IMPLEMENTED A4700292* A4700293HASP JMP AUT030 GET NEXT HOST RECORD A4700294 SPC 2 A4700295 EJT A4700296* A4700297* LOCAL BATCH PROCESSING - SIMULATE MI, *BATCH A4700298* A4700299LOCAL LDA* ABITOS IS CONCURRENT BATCH ALLOWED A4700300 SAN AUT155 YES A4700301 LDA* (ATSNBL) NO, IS ITOS ENABLED A4700302 SAN AUT160 YES, DO NOT PROCESS LOCAL BATCH THIS CYCLE A4700303AUT155 LDA* (MIBA) A4700304 ADD* (MIBXA) BOTH LOCK OUT FLAGS MUST BE ZERO A4700305 SAZ AUT165 A4700306AUT160 JMP* AUT187 DO LOCAL HOST NEXT CYCLE A4700307 SPC 1 A4700308AUT165 RAO* (MIBA) SET LOCK OUT FLAG A4700309 ENA -0 A4700310 ENQ L-1 A4700311AUT170 STA* (MIBFAD),Q LOAD MI BFR WITH NULL CHARS A4700312ÐÐ DQP *-AUT170 A4700313 ENQ 3 A4700314AUT180 LDA* BATCH,Q MOVE *BATCH TO MI BUFFER A4700315 STA* (MIBFAD),Q A4700316 DQP *-AUT180 A4700317 LDA* (JOBI) CK IF JOB PROCESSOR IN MEMORY A4700318 SAZ AUT190 SKIP IF NOT A4700319AUT185 ENA 0 RESET MI BUSY FLAG A4700320 STA* (MIBA) A4700321AUT187 RAO CTC OTHERWISE, SET CONTINUE TO CYCLE FLAG A4700322 JMP AUT030 AND GET NEXT HOST RECORD A4700323AUT190 LDA* (STH) CK JP LOCK OUT SWITCH A4700324 SAZ AUT200 SKIP IF NOT A4700325 JMP* AUT185 DO LOCAL HOST NEXT CYCLE A4700326AUT200 LFA* RECBUF+2,7,8 LU OF LOCAL HOST INPUT A4700327 STA- $F9 IS STANDARD INPUT DEVICE A4700328 RTJ- (AMONI) A4700329 NUM $5207 SCHEDULE MINT JOBSTR ENTRY AT LEVEL 7 A4700330 ADC JOBSTR A4700331 JMP AUT030 GET NEXT HOST RECORD A4700332 SPC 2 A4700333ABITOS ADC BAITOS A4700334ATSNBL ADC TSNABL A4700335MIBA ADC MIB A4700336MIBXA ADC MIBX A4700337ÐÐMIBFAD ADC MIINP A4700338JOBI ADC JOBIND A4700339STH ADC SWTCH A4700340BATCH ALF 4,*BATCH,F A4700341 END A4700342 NAM COMINT A48 A ITOS CCS 3.0 SL-149A4800001* COMM18 INITIALIZATION ROUTINE A4800002* CREDIT COLLECTION SYSTEM VERSION 3.0 A4800003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A4800004* COPYRIGHT CONTROL DATA CORPORATION 1979 A4800005 SPC 3 A4800006* THIS PROGRAM PATCHES SYSDAT TO MODIFY IT FOR COMM18 USE. IT ALSO A4800007* UNPATCHES SYSDAT UPON COMPLETION OF COMM18 USE. A4800008 SPC 3 A4800009* ENTRY A4800010* A = 1 INITIALIZE SYSDAT A4800011* A = 0 UNPATCH SYSDAT A4800012 SPC 2 A4800013* EXTERNALS A4800014 EXT PHYEQI FIRST PHYSTAB ADDRESS OF 1X2 CLA DRIVER A4800015 EXT AMINTX MINT ENTRY POINT FOR QMINTX ADDRESS PATCH A4800016 EXT QMINTX EXTENDED COMM18 MINT A4800017 EXT I8431S,C8431S,E8431S 1X2 CLA INT,CONT,ERROR ENTRIES A4800018 EXT INTRSP INTERRUPT RESPONS ROUTINE IN SYSDAT A4800019 EXT PHYTHD WORD NUMBER OF PHYSTAB THREAD WORD A4800020ÐÐ EXT COMM18 COMM18 FLAG WORD IN SYSDAT A4800021 SPC 2 A4800022* ENTRY POINTS A4800023 ENT COMINT INITIALIZE COMM18 A4800024 ENT COMUNP UNPATCH COMM18 A4800025* A4800026* A4800027 SPC 3 A4800028COMINT NOP 0 A4800029 SAN COMIN1 A4800030 JMP* COMUNP A4800031COMIN1 LDA* MICOMM PATCH QMINTX INTO MINT A4800032 STA AMINTX A4800033 SPC 3 A4800034* A4800035* PATCH INTERRUPT RESPONSE ROUTINE A4800036* A4800037 LDA =N$1C00 A4800038 LDQ* RESPON A4800039 STA- (ZERO),Q A4800040 LDA PHYEQI A4800041 INA 2 A4800042 SUB* RESPON CAL. RELATIVE DISTANCE A4800043 INA -1 A4800044 STA- 1,Q A4800045ÐÐ SPC 3 A4800046* A4800047* PATCH PHYSTABS WITH INIT,CONT., AND ERROR ENTRIES A4800048 LDQ PHYEQI A4800049PHYLOP INQ 1 A4800050 LDA* ICLA A4800051 STA- (ZERO),Q A4800052 LDA* CCLA A4800053 STA- 1,Q A4800054 LDA* ECLA A4800055 STA- 2,Q A4800056 INQ -1 A4800057 ADQ PHYTHD PICKUP PHYSTAB THREAD ADDRESS TO SEE IF DONE A4800058 LDA- (ZERO),Q A4800059 TRA Q A4800060 SUB PHYEQI SEE IF ALL DONE A4800061 SAZ COMDON A4800062 JMP* PHYLOP A4800063* A4800064COMDON STQ COMM18 SET COMM18 FLAG IN SYSDAT A4800065 JMP* (COMINT) A4800066 EJT A4800067COMUNP NOP 0 A4800068 LDA =N$14EA A4800069 STA INTRSP A4800070ÐÐ LDA- $11 $7FFF A4800071 STA AMINTX PATCH OUT QMINTX IN MINT A4800072 ENQ 0 SET COMM18 NOT BUSY A4800073 JMP* COMDON A4800074 SPC 3 A4800075ICLA ADC I8431S A4800076CCLA ADC C8431S A4800077ECLA ADC E8431S A4800078MICOMM ADC QMINTX A4800079RESPON ADC INTRSP A4800080 EQU ZERO($22) A4800081 END A4800082 MON 00001 SUBROUTINE SUBRCM(BUFR,RQTYPE,BLEN,RCODE,MASK,DTYPE) A5000001 1 /A50 F ITOS CCS 3.0 SL-149A5000002C ITOS TERMINAL MANAGER A5000003C CREDIT COLLECTION SYSTEM VERSION 3.0ED SYSTEM VERSION 1.0 A5000004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A5000005C COPYRIGHT CONTROL DATA CORPORATION 1979 A5000006C A50000073 A5000008 INTEGER BUFR(1),RQTYPE,BLEN,RCODE,MASK,DTYPE A5000009 INTEGER GETCHR A5000010 INTEGER ERRBAS A5000011* 122*4879A5000012ÐÐ INTEGER CLRLEN,CLEN A5000013 DATA CLRLEN/0/ A5000014 EXTERNAL DATFMT A5000015 INTEGER DLOC(3),MLOC(3) A5000016 DATA DLOC/2,1,3/ A5000017 DATA MLOC/1,2,2/ A5000018* 122*4879A5000019 DATA ERRBAS/90/ A5000020 INTEGER OLEN A5000021 INTEGER TERMLU A5000022 DATA TERMLU/0/ A5000023* 122*4879A5000024 INTEGER RTYPEC(9),RTYPE A5000025 DATA NTYPES/9/ A5000026 DATA RTYPEC/1RS,1RT,1RA,1RR,1RP,1RC,1RF,1RN,1RB/ A5000027* 122*4879A5000028 INTEGER CPOS,XPOS,YPOS A5000029 DATA CPOS/0/ A5000030 BYTE(XPOS,CPOS(15=8)),(YPOS,CPOS(7=0)) A5000031 INTEGER TC,TCODE(5) A5000032 DATA TCODE/1HO,1HN,1HC,1HL,1HR/ A5000033 INTEGER RESPCD(3) A5000034 DATA RESPCD/1HC,1HE,1HR/ A5000035 INTEGER UCHR(1),LCHR(1) A5000036 BYTE(UCHR,BUFR(15=8)),(LCHR,BUFR(7=0)) A5000037ÐÐ. A5000038* FIND REQUEST TYPE A50000391 A5000040 DO 10 RTYPE=1,NTYPES A5000041 IF(EOR(RQTYPE/$100,RTYPEC(RTYPE)).EQ.0) GO TO 20 A5000042 10 CONTINUE A50000432 A5000044* ILLEGAL REQUEST TYPE A50000451 A5000046 IERR=1 A5000047 GO TO 9900 A50000482 A5000049* FOUND THE REQUEST TYPE, VECTOR TO PROCESSOR A50000501 A5000051* 122*4879A5000052* S T A R P C F N B A5000053 20 GO TO (100,100,300,400,500,600,9990,300,700),RTYPE A5000054* 122*4879A5000055. A5000056* REQUEST TYPE 'S' - OUTPUT BUFFER. CURSOR AT END +1 A5000057* REQUEST TYPE 'T' - OUTPUT BUFFER. CURSOR TO X(0) OF NEXT LINE A50000581 A5000059 100 CONTINUE A5000060 IF(BLEN.LT.1.OR.BLEN.GT.80) GO TO 9200 A5000061 CALL WTREAD(TERMLU,CPOS,BUFR,BLEN,0,0,0,0) A5000062ÐÐ XPOS=XPOS+BLEN A5000063 IF(XPOS.LT.80) GO TO 110 A5000064 XPOS=XPOS-80 A5000065 YPOS=YPOS+1 A5000066 IF(YPOS.GE.24) YPOS=0 A5000067 110 IF(RTYPE.NE.2) RETURN A5000068 XPOS=0 A5000069 YPOS=YPOS+1 A5000070 IF(YPOS.GE.24) YPOS=0 A5000071 RETURN A5000072. A5000073* REQUEST TYPE 'A' - INPUT BUFFER FROM TERMINAL A50000741 A5000075 300 CONTINUE A5000076 IF(BLEN.LT.1.OR.BLEN.GT.80) GO TO 9200 A5000077 IFLAG=1 A5000078 ILEN=BLEN A5000079 IF(XPOS+BLEN.LE.80) GO TO 305 A5000080 IFLAG=2 A5000081 ILEN=80-XPOS A5000082 305 LLOC=((ILEN+1)/2)+1 A5000083 LSAVE=BUFR(LLOC) A5000084* 122*4879A5000085 IF(RTYPE.NE.8) GO TO 308 A5000086 OLEN=2 A5000087ÐÐ ISTART=$8007 A5000088* 122*4879A5000089 GO TO 310 A5000090 308 OLEN=1 A5000091 ISTART=$0700 A5000092 310 CALL WTREAD(TERMLU,-1,ISTART,OLEN,CPOS,BUFR,ILEN,TC) A5000093 JLEN=BUFR(LLOC) A5000094 BUFR(LLOC)=LSAVE A5000095* 122*4879A5000096 IDTYPE=DTYPE+1 A5000097* DTYPE = 0 1 2 3 A5000098 GO TO (328,312,315,320),IDTYPE A5000099* ONLY 0 TO 9 ALLOWED A5000100 312 DO 313 I=1,JLEN A5000101 ICHR=GETCHR(BUFR,I) A5000102 IF(ICHR.LT.1R0.OR.ICHR.GT.1R9) GO TO 305 A5000103 313 CONTINUE A5000104 GO TO 328 A5000105* FIELD MUST BE NON BLANK A5000106 315 DO 316 I=1,JLEN A5000107 ICHR=GETCHR(BUFR,I) A5000108 IF(ICHR.NE.1R ) GO TO 328 A5000109 316 CONTINUE A5000110 GO TO 305 A5000111* FIELD MUST BE A VALID DATE A5000112ÐÐ 320 IF(JLEN.NE.6) GO TO 305 A5000113 DO 321 I=1,6 A5000114 ICHR=GETCHR(BUFR,I) A5000115 IF(ICHR.LT.1R0.OR.ICHR.GT.1R9) GO TO 305 A5000116 321 CONTINUE A5000117 ASSEM $C000,+DATFMT A5000118+ LDA =XDATFMT A5000119 ASSEM $6400,+IFMT A5000120+ STA+ IFMT A5000121 ILOC=MLOC(IFMT+1) A5000122 IF(BUFR(ILOC).LT.2H01.OR.BUFR(ILOC).GT.2H12) GO TO 305 A5000123 ILOC=DLOC(IFMT+1) A5000124 IF(BUFR(ILOC).LT.2H01.OR.BUFR(ILOC).GT.2H31) GO TO 305 A5000125* 122*4879A5000126 328 CONTINUE A5000127* 122*4879A5000128 IF(TC.EQ.7) TC=2 A5000129 IF(TC.NE.8) GO TO 329 A5000130 TC=2 A5000131 BUFR(JLEN)=BUFR(JLEN)+$19 A5000132 IF(BUFR(JLEN).EQ.$49) BUFR(JLEN)=$7D A5000133 329 CONTINUE A5000134 IF(TC.EQ.2.AND.JLEN.EQ.ILEN) TC=0 A5000135* 122*4879A5000136 IF(TC.NE.0) GO TO 330 A5000137ÐÐ RCODE=TCODE(IFLAG) A5000138 GO TO 340 A5000139 330 RCODE=TCODE(TC+1) A5000140 340 XPOS=XPOS+JLEN A5000141 IF(XPOS.LT.80) GO TO 350 A5000142 XPOS=XPOS-80 A5000143 YPOS=YPOS+1 A5000144 IF(YPOS.GE.24) YPOS=0 A5000145 350 ISTART=JLEN+1 A5000146* 122*4879A5000147 CLEN=CLRLEN A5000148 IF(CLEN.EQ.0) CLEN=BLEN A5000149 DO 355 I=ISTART,CLEN A5000150* 122*4879A5000151 CALL PUTCHR($20,BUFR,I) A5000152 355 CONTINUE A5000153 RETURN A5000154. A5000155* REQUEST TYPE 'R' - OUTPUT ERROR MESSAGE AND INPUT RESPONSE A50001561 A5000157 400 CALL WTREAD(TERMLU,CPOS,BUFR,50,-1,RCODE,1,TC) A5000158 XPOS=XPOS+50 A5000159 IF(XPOS.LT.80) GO TO 410 A5000160 XPOS=XPOS-80 A5000161 YPOS=YPOS+1 A5000162ÐÐ IF(YPOS.GE.24) YPOS=0 A5000163 410 J=$8000 A5000164 DO 420 I=1,3 A5000165 J=J*2 A5000166 IF(AND(EOR(RCODE,RESPCD(I)),$FF00).EQ.0) GO TO 430 A5000167 420 CONTINUE A5000168 GO TO 450 A5000169 430 IF(AND(MASK,J).EQ.0) GO TO 450 A5000170 GO TO (9990,440,440),I A5000171 440 XPOS=XPOS+1 A5000172 IF(XPOS.LT.80) RETURN A5000173 XPOS=XPOS-80 A5000174 YPOS=YPOS+1 A5000175 IF(YPOS.GE.24) YPOS=0 A5000176 RETURN A5000177 450 CALL WTREAD(TERMLU,-1,$0708,2,CPOS,RCODE,1,TC) A5000178 GO TO 410 A50001792 A5000180* REQUEST TYPE 'P' - POSITION CURSOR A50001811 A5000182 500 XPOS=(UCHR(1)-$30)*10+(LCHR(1)-$30) A5000183 IF(XPOS.LT.0.OR.XPOS.GT.79) GO TO 9100 A5000184 YPOS=(UCHR(2)-$30)*10+(LCHR(2)-$30) A5000185 IF(YPOS.LT.0.OR.YPOS.GT.23) GO TO 9100 A5000186 RETURN A5000187ÐÐ2 A5000188* REQUEST TYPE 'C' - CLEAR SCREEN A50001891 A5000190 600 CALL WTREAD(TERMLU,-1,$1800,1,-1,0,0,TC) A5000191 CPOS=0 A5000192 RETURN A5000193* 122*4879A50001942 A5000195* REQUEST TYPE 'B' - SET BUFFER CLEAR LENGTH A50001961 A5000197 700 IF(BLEN.LT.0.OR.BLEN.GT.80) GO TO 9200 A5000198 CLRLEN=BLEN A5000199 RETURN A5000200* 122*4879A5000201. A5000202* ERROR HANDLING SECTION A50002032 A5000204* INVALID CURSOR POSITION A50002051 A5000206 9100 CONTINUE A5000207 IF(XPOS.LT.0) IERR=2 A5000208 IF(XPOS.GT.79) IERR=3 A5000209 IF(YPOS.LT.0) IERR=4 A5000210 IF(YPOS.GT.23) IERR=5 A5000211 GO TO 9900 A5000212ÐÐ2 A5000213* INVALID BUFFER LENGTH A50002141 A5000215 9200 CONTINUE A5000216 IERR=6 A5000217 IF(BLEN.GT.80) IERR=7 A5000218 GO TO 9900 A50002192 A5000220* OUTPUT ERROR MESSAGE AND TERMINATE A50002211 A5000222 9900 CONTINUE A5000223 IERR=IERR+ERRBAS A5000224 CALL SYSMSG(IERR,0) A5000225 9990 CALL PGMOUT A5000226 END A5000227 MON 00001 NAM MINT M01 A ITOS CCS 3.0 SL-149M0100001* MANUAL INTERRUPTS PROCESSOR M0100002* CREDIT COLLECTION SYSTEM VERSION 3.0 M0100003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA M0100004* COPYRIGHT CONTROL DATA CORPORATION 1979 M0100005* M0100006 SPC 2 M0100007* MANUAL INTERRUPTS PROCESSOR M0100008 ENT MINT M0100009ÐÐ EQU MINT(*) M0100010 SPC 1 M0100011 SPC 1 M0100012* THIS IS THE MANUAL INTERRUPT ROUTINE M0100013* NO ATTEMPT IS MADE TO INTERRUPT REQUESTS IN PROGRESS M0100014 SPC 1 M0100015 ENT MI M0100016 ENT MIB M0100017 ENT MIBX M0100018 ENT RELFLE M0100019 ENT JOBSTR M0100020 ENT AMINTX ADDRESS LOCATION OF COMM18 QMINTX M0100021 EXT LSTOUT,STDINP M0100022 EXT BATLST,BATINP M0100023 EXT AUTF9,AUTFB M0100024* E X T E R N A L S 116*4377M0100025 SPC 1 116*4377M0100026 EXT MIINP 'MI' INPUT BUFFER (IN 'SYSDAT') 116*4377M0100027 EXT BAITOS ITOS CONCURRENT BATCH FLAG M0100028 EXT TSNABL ITOS ENABLED FLAG M0100029 SPC 1 M0100030 EXT JOBIND M0100031 EXT FILE1 M0100032 EXT SWTCH M0100033 EXT JOBENT M0100034ÐÐ EXT BATCLU 116*4377M0100035 EXT JBCNCL M0100036 EXT MIPRO M0100037 EXT LVLSTR,SWAPON,LEND M0100038 EXT RESTOR M0100039 EXT JPCHGE M0100040 EXT LOADIN LOADER IN CORE FLAG *444**** M0100041 EXT QMINTX EXTENDED MINT ROUTINE FOR COMM18 M0100042 EXT COMM18 M0100043 EXT TSAREA M0100044 SPC 1 116*4377M0100045* S Y S T E M E Q U I V A L E N C E 116*4377M0100046 EQU MONIT($F4) LOCATION CONTAINS MONITOR ADDRESS 116*4377M0100047 EQU LPMSK(2) 116*4377M0100048 EQU ZERO($22) LOCATION CONTAINS ZERO 116*4377M0100049 EQU LOCORE($F7) LOW CORE STARTING ADDRESS 116*4377M0100050 EQU CREXTB($E9) LOCATION CONTAINS CORE EXTENDED TABLE 116*4377M0100051 EQU CHARSK($2A) CHARACTER * 116*4377M0100052 SPC 1 M0100053 EQU DISP($EA) M0100054 EQU L(36) BUFFER LENGTH **MSOS 4.0M0100055 EQU RP(1) M0100056 EQU HICORE($F6) M0100057 SPC 2 M0100058MI LDA MIB M0100059ÐÐ SAZ MIGO M0100060 JMP- (DISP) NOT ZERO, JUST GO AWAY 116*4377M0100061MIGO RAO MIB M0100062 RTJ- (MONIT) OUTPUT 'MI' 116*4377M0100063 NUM $4CE3 M0100064 ADC $0,$0,$18FC,$2,MIOUT M0100065 ENA -0 M0100066 ENQ L-1 **MSOS 4.0M0100067MI1 STA* (MIBFAD),Q 116*4377M0100068 INQ -1 M0100069 SQM MI2-*-1 M0100070 JMP* MI1 M0100071 SPC 1 M0100072MI2 RTJ- (MONIT) INPUT STATEMENT 116*4377M0100073 NUM $48E7 116*4377M0100074 ADC MI2AX COMPLETION ADDRESS TO BE ENTERED 116*4377M0100075* AT LEVEL 7 116*4377M0100076THR ADC $0,$18FD,L+1,MIINP **MSOS 4.0M0100077 EQU MIBFAD(*-1) 'MI' INPUT BUFFER ADDRESS 116*4377M0100078 RTJ- (MONIT) SCHEDULE DOWN TO 116*4377M0100079 NUM $5203 LEVEL 3. 116*4377M0100080 ADC MI2AA 116*4377M0100081 JMP- (DISP) 116*4377M0100082MI2AA LDA* THR THIS LOOP RUNS AT LEVEL 3. ITS 116*4377M0100083 SAZ MI2AE PURPOSE IS TO INHIBIT THE BACKGROUND 116*4377M0100084ÐÐ JMP* MI2AA PROGRAMS FROM EXECUTING UNTIL THE MI 116*4377M0100085MI2AE JMP- (DISP) INPUT REQUEST IS COMPLETED 116*4377M0100086* (AT LEVEL 7) 116*4377M0100087 SPC 2 116*4377M0100088* THE INPUT REQUEST IS SATISFIED. 116*4377M0100089* 116*4377M0100090MI2AX SQP MI21 SKIP IF NO INPUT ERROR. 116*4377M0100091 JMP MI16 IGNORE INPUT AND EXIT. 116*4377M0100092MI21 LDA* (MIBFAD) 116*4377M0100093 SUB* Z WAS A *Z ENTERED M0100094 SAZ MI3 YES, CONTINUE PROCESSING THE INPUT M0100095 LDA* MIBX NO, IS A REQUEST CURRENTLY IN PROCESS M0100096 SAZ MI22 NO, CONTINUE M0100097 JMP- (DISP) YES, IGNORE THE MANUAL INTERRUPT M0100098MI22 LDA* (MIBFAD) NO, CONTINUE M0100099 ARS 8 M0100100 INA -CHARSK CHECK FOR '*' 116*4377M0100101 SAZ MI3-*-1 M0100102 JMP MI10 M0100103* M0100104ACOM18 ADC COMM18 M0100105 SPC 2 M0100106Z ALF 1,*Z M0100107STH ADC SWTCH M0100108 SPC 2 M0100109ÐÐMI3 LDA =XBAITOS PICK UP ITOS CONCURRENT BATCH FLAG M0100110 SAN MI31 SKIP IF CONCURRENT BATCH ALLOWED M0100111 LDA TSNABL PICK UP ITOS ENABLED FLAG M0100112 SAZ MI31 SKIP IF NOT ENABLED M0100113MMMII JMP MI12 GO PRINT A JP05 ERROR MESSAGE M0100114MI31 LDA* ACOM18 SEE IF COMM18 IN SYSTEM M0100115 EOR- LPMSK+15 M0100116 SAZ MI31A NOT IN SYSTEM M0100117 LDA* (ACOM18) SEE IF ACTIVE M0100118 SAZ MI31A M0100119 LDA- $F7 ACTIVE, SEE IF THEY USE THE SAME AREA TO RUN M0100120 INA 1 M0100121 SUB TSAREA M0100122 SAN MI31A GO AHEAD AND RUN BATCH M0100123 JMP* MMMII ERROR M0100124* M0100125MI31A LDA* (JOBI) M0100126 SAZ 1 IN CORE. M0100127 JMP* MI5 M0100128 LDA* (STH) CHECK JP LOCK-OUT SWITCH IF M0100129 SAZ NLO-*-1 LIBEDIT OR RECOVERY PROGRAM M0100130 LDA* (MIBFAD) CHECK IF *Z 116*4377M0100131 SUB* Z M0100132 SAZ NLA-*-1 M0100133 JMP* MI6 CK FOR *, *R, *K M0100134ÐÐNLA STA LOADIN CLEAR LOADER IN CORE FLAG *444*****M0100135 ENA 1 *444**** M0100136 STA* (STH) FLAG POSITIVE. M0100137 JMP* MI5AA GO CANCEL LIBEDT AS ANY OTHER JOB 116*4377M0100138NLO EQU NLO(*) M0100139 LDA* (MIBFAD) 116*4377M0100140 SUB =A*R **MSOS 4.0M0100141ASTSKR EQU ASTSKR(*-1) 116*4377M0100142 SAN 2 **MSOS 4.0M0100143 LDQ* MIP LET AN *R THRU **MSOS 4.0M0100144 JMP* MI9B FOR FOREGROUND UNITS **MSOS 4.0M0100145 ENQ 2 116*4377M0100146MORE LDA* (MIBFAD),Q 116*4377M0100147 SUB* BATCH,Q 116*4377M0100148 SAN ERR **MSOS 4.0M0100149 SQZ JOBSTR 116*4377M0100150 INQ -1 116*4377M0100151 JMP* MORE **MSOS 4.0M0100152ERR JMP* MI12 **MSOS 4.0M0100153JOBSTR LDQ* MIBFAD SEE IF FILE OR LOCAL BATCH M0100154 LDA- 3,Q M0100155 SUB =A,F M0100156 TRA Q M0100157 SQN JOBST1 LOCAL BATCH M0100158 LDA =XBATINP SET BATCH DRIVER STANDARD INPUT M0100159ÐÐ JMP* JOBST2 M0100160JOBST1 LDA =XSTDINP SET LOCAL BATCH STD. INPUT M0100161* M0100162JOBST2 STA+ AUTF9 M0100163 SQN JOBST3 M0100164 LDA =XBATLST SET BATCH LIST STD. M0100165 JMP* JOBST4 M0100166JOBST3 LDA =XLSTOUT SET LOCAL BATCH LIST STD. M0100167* M0100168JOBST4 STA+ AUTFB IN TRVEC M0100169 LDQ- $E9 127*5195M0100170 STA- 3,Q SET COSY STANDARD LIST 127*5179M0100171* M0100172 LDQ- CREXTB M0100173 LDA- 11,Q TEST FOR AND SKIP IF SWAP NOT ALLOWED M0100174 SAN SJOB SWAPPING NOT ALLOWED M0100175 LDA- 10,Q TEST FOR AND SKIP IF UNPROTEC IN PART M0100176 SAZ JOBA PART 0 SWAPPED M0100177 RTJ- (MONIT) REQ FOR PARTITION 16 116*4377M0100178 ADC $6200 BEFORE CALLING IN **MSOS 4.0M0100179 ADC SJOB JOB PROCESSOR **MSOS 4.0M0100180 NUM 0,0 **MSOS 4.0M0100181 NUM 10 **MSOS 4.0M0100182 NUM 16 **MSOS 4.0M0100183 JMP- (DISP) **MSOS 4.0M0100184ÐÐJOBA RTJ- (MONIT) RELEASE PART 0 116*4377M0100185 NUM $1800 M0100186RELSWP ADC 0 M0100187 SPC 2 M0100188* THE JOB PROCESSOR IS NOW SCHEDULED BUT M0100189* CANNOT RUN UNTIL THE SWAPPED AREA IS M0100190* AVAILABLE AND THE LEVEL 2 LOOP IN THE M0100191* SPACE DRIVER IS TURNED OFF. M0100192 SPC 2 M0100193SJOB LDQ* MIP **MSOS 4.0M0100194 RTJ- (MONIT) SCHEDULE JOB PROCESSOR 116*4377M0100195 NUM $2400 PART 1 DIRECTORY SCHEDULE M0100196 ADC JOBENT **MSOS 4.0M0100197 JMP- (DISP) M0100198 SPC 1 M0100199MIB NUM 0 **MSOS 4.0M0100200MIBX NUM 0 **MSOS 4.0M0100201JOBI ADC JOBIND **MSOS 4.0M0100202MI5 LDA* (MIBFAD) CHECK IF *Z 122*4569M0100203 SUB* Z M0100204 SAN MI5A M0100205MI5AA LDA- $FD SET CONTROL LU TO COMMENT DEVICE 116*4377M0100206 STA+ BATCLU 116*4377M0100207 RTJ- (MONIT) SCHEDULE JOB CANCEL 116*4377M0100208 NUM $5202 AT LEVEL TWO **MSOS 4.0M0100209ÐÐ ADC JBCNCL M0100210 JMP* MI16 RESET MIB M0100211MI5A LDA (MIBFAD) M0100212 EOR =A*K CHECK FOR *K STATEMENT M0100213 SAZ MI5B **MSOS 4.0M0100214 INA -8 *C **MSOS 4.0M0100215 SAN MI6 **MSOS 4.0M0100216MI5B LDQ* MIP **MSOS 4.0M0100217 RAO* MIBX **MSOS 4.0M0100218 RTJ- (MONIT) 116*4377M0100219 NUM $2403 M0100220 ADC JPCHGE M0100221 JMP* MI16 **MSOS 4.0M0100222MI6 LDA (MIBFAD) M0100223 EOR =X$2AFF CK FOR * CR M0100224 SAN MI9 M0100225 JMP* MI16 * CR - JUST CONTINUE M0100226MI9 LDQ* MIP Q POINTS TO INPUT BUFFER M0100227 LDA (MIBFAD) M0100228 EOR* ASTSKR CHECK FOR RESTORE A DEVICE 116*4377M0100229 SAZ MI9B YES - SCHEDULE RESTOR M0100230 JMP* MI12 NO - J05 ERROR M0100231MI9B RAO* MIBX SET LOCK OUT FLAG M0100232 RTJ- (MONIT) 116*4377M0100233 NUM $2403 M0100234ÐÐ ADC RESTOR M0100235 JMP* MI16 EXIT M0100236MIP ADC MIINP **MSOS 4.0M0100237 SPC 1 M0100238MI10 LDA* AMINTX IS QMINTX PATCHED TO COMM18 M0100239 EOR- LPMSK+15 M0100240 SAZ MI11 NO, COMM18 IS NOT IN M0100241 RTJ+ QMINTX YES, TEST FOR SPECIAL COMM18 COMMANDS M0100242 EQU AMINTX(*-1) M0100243MI11 LDA* AMIPRO SEE IF MIPRO IN SYSTEM M0100244 ADD- $32 8000 **MSOS 4.0M0100245 INA 0 M0100246 SAZ MI12-*-1 SKIP IF NOT PRESENT M0100247 LDQ* MIP M0100248 RAO* MIBX SET MIBX FLAG - RECOVER, MIPRO M0100249 RTJ- (MONIT) SCHEDULE PROCESSOR 116*4377M0100250 NUM $2447 116*4377M0100251AMIPRO ADC MIPRO SYSTEM DIRECTORY ENTRY **MSOS 4.0M0100252 JMP* MI16 M0100253 SPC 1 M0100254MI12 RTJ- (MONIT) NO PROCESSOR 116*4377M0100255 NUM $4C00 ERROR - JP05 **MSOS 4.0M0100256 ADC $0,$0,$18FC,$2 M0100257 ADC MI14 M0100258MI16 ENA 0 M0100259ÐÐ STA* MIB SET MI NOT BUSY M0100260 JMP- (DISP) M0100261 SPC 1 M0100262* 116*4377M0100263*---- KEY WORD, ADDRESSES AND STORAGE 116*4377M0100264* 116*4377M0100265 SPC 1 116*4377M0100266BATCH ALF 3,*BATCH **MSOS 4.0M0100267* 1 CARD DELETED 116*4377M0100268F1 ADC FILE1 M0100269MI14 ALF 2,JP05 **MSOS 4.0M0100270MIOUT NUM $184D M0100271 NUM $490D M0100272ALVLST ADC LVLSTR ADR OF START OF RP=0 ALLOCATABLE M0100273 ADC LEND ADR OF END OF ALLOCATABLE AREA M0100274 ADC SWAPON ADR OF UNPROTECTED INDICATOR M0100275LVLSTV ADC 0 M0100276 EJT M0100277* THIS ROUTINE IS ENTERED WHEN THE JOB PROCESSOR M0100278* IS SIGNED OFF OR CANCELLED. M0100279* THE JOB AREA IS MADE AVAILABLE TO THE M0100280* PROTECTED PROGRAMS. THIS IS DONE BY M0100281* FORCING A CORE-SWAP WHICH WILL NOT BE M0100282* TERMINATED UNTIL THE JOB PROCESSOR IS M0100283* REQUESTED AGAIN M0100284ÐÐ* CORE SWAP IS NOT FORCED IN PART 0 IF **MSOS 4.0M0100285* NOSWAP FLAG IS SET **MSOS 4.0M0100286 SPC 2 M0100287RELFLE NOP 0 RELEASE ALL FILES ROUTINE M0100288 RAO* MIB SET MIB - LOCK OUT FOR MANUAL INTERRUPT M0100289 EIN 0 M0100290 ENQ 3 M0100291RELFL0 LDA* (F1),Q RELEASE LAST FILE FIRST M0100292 SAZ RELFL1-*-1 IF ZERO, SKIP RELEASE M0100293 STA* RELFL M0100294 RTJ- (MONIT) RELEASE FILE 116*4377M0100295 NUM $1800 M0100296RELFL NUM $0000 M0100297 ENA 0 M0100298 STA* (F1),Q ZERO FILE LOCATION M0100299RELFL1 INQ -1 M0100300 SQM RELFL2-*-1 M0100301 JMP* RELFL0 M0100302RELFL2 ENA 0 ZERO JP IN-CORE SWITCH. M0100303 STA* (JOBI) 116*4377M0100304 LDQ- CREXTB 116*4377M0100305 LDA- 11,Q M0100306 SAZ RELFL3 SKIP IF SWAP ALLOWED M0100307 JMP* MI16 NO SWAP ALLOWED M0100308RELFL3 LDA- 10,Q M0100309ÐÐ SAZ RELFL4 SKIP IF UNPROTECTED IN PART 0 M0100310 JMP* RELPRT UNPROTECTED IN PART 1 M0100311 SPC 2 M0100312* FORCE A CORE SWAP M0100313 SPC 2 M0100314RELFL4 ENQ RP SET REQUEST PRIORITY M0100315 LDA* (ALVLST),Q SAVE START OF ALLOCATABLE FOR THIS RP M0100316 STA* LVLSTV M0100317 LDA- HICORE M0100318 INA -5 M0100319 STA* (ALVLST),Q M0100320 RTJ- (MONIT) SPACE REQUEST 116*4377M0100321 ADC RP*16+$5403 61*1285 M0100322 ADC SWAPPD,0,0,0 LENGTH 0 M0100323 JMP- (DISP) M0100324 SPC 2 M0100325SWAPPD LDA* LVLSTV SWAP COMPLETED M0100326 STQ RELSWP SAVE ADR FOR RELEASE **MSOS 4.0M0100327 ENQ RP M0100328 STA* (ALVLST),Q RESTORE LVLSTR + RP M0100329 JMP* MI16 RELEASE MIB AND EXIT M0100330* **MSOS 4.0M0100331* **MSOS 4.0M0100332RELPRT LDA- LOCORE 116*4377M0100333 INA 1 **MSOS 4.0M0100334ÐÐ STA* RELUP **MSOS 4.0M0100335 STA* RELUPA **MSOS 4.0M0100336 RTJ- (MONIT) 116*4377M0100337 ADC $5800 PARTITION CORE RELEASE M0100338RELUP NUM 0 OF BACKGROUND **MSOS 4.0M0100339 RTJ- (MONIT) 116*4377M0100340 ADC $62F3 REQ OF PART 16 AT CP^2 **MSOS 4.0M0100341 ADC RELA WILL CAUSE PROTECT BITS **MSOS 4.0M0100342 NUM 0,0 TO BE SET, THEN PARTITION **MSOS 4.0M0100343 NUM 10 16 IS RELEASED FOR **MSOS 4.0M0100344 NUM 16 SYSTEM USE **MSOS 4.0M0100345 JMP- (DISP) 116*4377M0100346RELA RTJ- (MONIT) 116*4377M0100347 ADC $5800 **MSOS 4.0M0100348RELUPA ADC 0 **MSOS 4.0M0100349 JMP* MI16 **MSOS 4.0M0100350 END M0100351 NAM SPACE M02 A ITOS CCS 3.0 . SL-149M0200001* SPACE REQUEST PROCESSOR, ALLOCATABLE SPACE AND RESTART M0200002* CREDIT COLLECTION SYSTEM VERSION 3.0 M0200003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA M0200004* COPYRIGHT CONTROL DATA CORPORATION 1979 M0200005* M0200006 SPC 2 M0200007 ENT SPACE M0200008ÐÐ EQU SPACE(*) M0200009 SPC 1 M0200010 SPC 1 M0200011*********************************************************************** M0200012* ENTRY POINTS M0200013*********************************************************************** M0200014 ENT T10 SPACE REQUEST PROCESSOR M0200015 ENT STMSV4 START OF SPACE PROGRAM M0200016 ENT T17 PARTITION CORE REQUEST PROCESSOR M0200017 ENT AREAC TOTAL LENGTH OF ALLOCATABLE M0200018 ENT ALCLGH ALLOCATABLE CORE LENGTH TABLE M0200019*********************************************************************** M0200020* EXTERNALS M0200021*********************************************************************** M0200022 EXT UBPROT LOCATION CONTAINS UPPER BOUND REGISTER DATA M0200023 EXT LBPROT LOWER M0200024 EXT UPBDTB UPPER BOUND REGISTER DATA TABLE BASE M0200025 EXT LOBDTB LOWER BOUND REGISTER DATA TABLE BASE M0200026 EXT CKTHRD CHECK THREAD FOR NON-ZERO ENTRY(RW SUB.) M0200027 EXT SAVLU ENTRY IN RW PROGRAM FOR SPACE PROCESSOR M0200028 EXT RPMASK REQUEST PRIORITY MASK M0200029 EXT LVLSTR LEVEL START TABLE M0200030 EXT LEND LOCATION CONTAINING END OF ALLOCATABLE M0200031 EXT CALTHD LOCATION CONTAINING NO. OF AVAIL ALLOCATABLE M0200032 EXT DTIMER DIAGNOSTIC TIMER PROGRAM M0200033ÐÐ EXT IDLE IDLE PROGRAM M0200034 EXT DMICOD DEFINE MICRO-INTRPT CODE MP MSOSM0200035 EXT TBLADR ADT TABLE ADDRESS MP MSOSM0200036 EXT EMPSRT RESET/START FUNCTION CODE MP MSOSM0200037 EXT END0V4 LAST LOCATION IN PART 0 M0200038 EXT SYFAIL SYSTEM FAILURE ROUTINE M0200039 EXT MMLUTB MASS STORAGE LU TABLE M0200040 EXT MNTCHK MOUNT CHECKING ORDINAL M0200041 EXT UPTOD TIME OF DAY PROGRAM **MSOS 4.1**M0200042 EXT TMRTYP TIMER TYPE DESIGNATOR **MSOS 4.1**M0200043 EXT LOG1A TABLE OF P.D.T. ADDRESSES **MSOS 4.1**M0200044 EXT JOBENT INDEX TO JOBENT DIRECTORY ENTRY M0200045 EXT LIBEDT INDEX TO LIBEDT DIRECTORY ENTRY M0200046 EXT PROTEC INDEX TO PROTEC DIRECTORY ENTRY M0200047 EXT SYSLVL SYSTEM LEVEL (*S STATEMENT) M0200048 EXT K65T10 ENTRY TO PARTITION CORE DRIVER (PRTCDR) M0200049 EXT IUP STANDARD INPUT (TRVEC) M0200050 EXT INPTV4 INPUT UNIT FOR JOB PROCESSOR (TRVEC) M0200051 EXT AUTF9 AUTOLOAD STD INPUT (TRVEC) 86*2718M0200052 EXT AUTFA AUTOLOAD STD PUNCH (TRVEC) 86*2718M0200053 EXT AUTFB AUTOLOAD STD LIST (TRVEC) 86*2718M0200054 EXT N1,N2,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15 **MSOS 4.1**M0200055 EXT LSIZV4 OVERLAY LENGTH OF LIBEDT **MSOS 4.0M0200056 EXT PSIZV4 OVERLAY LENGTH OF PROTECT PROCESSOR **MSOS 4.0M0200057 EXT EFLOCK LOCK OUT LOGGER FLAG **MSOS 4.1**M0200058ÐÐ EXT MIBX LOCK OUT MIPRO M0200059 EXT TDFUNC TIME/DATE FUNCTION ORDINAL **MSOS 4.1**M0200060 EXT SYSMON MONTH SYSTEM WAS LAST BUILT **MSOS 4.1**M0200061 EXT SYSDAY DAY SYSTEM WAS LAST BUILT **MSOS 4.1**M0200062 EXT SYSYER YEAR SYSTEM WAS LAST BUILT **MSOS 4.1**M0200063 EXT SYSID SYSTEM IDENTIFICATION BUFFER **MSOS 4.1**M0200064 EXT OUTPUT SWAP ROUTINE WRITE REQUEST (DCORE) 83*2390M0200065 EXT SPACE4 SPACE REQUEST TO UNSWAP (DCORE) 83*2390M0200066 EXT NOG30A SWAP ROUTINE READ REQUEST (DCORE) 83*2390M0200067 EXT REL RELEASE ROUTINE (DCORE) 83*2390M0200068 EXT SCH SCHEDULE ROUTINE (DCORE) 83*2390M0200069 EXT PTNALC SCHEDULE PRTCDR (PRTCDR) 83*2390M0200070 EXT PTNREL RELEASE PRTCDR (PRTCDR) 83*2390M0200071 EXT SPCEV4 PRT 16 PARTITION CORE REQ. (PRTCDR) 83*2390M0200072 EXT RDPTV4 PRT 16 SWAP AREA READ REQ. (PRTCDR) 83*2390M0200073 EXT OUTPV4 PRT 16 SWAP AREA WRITE REQ.(PRTCDR) 83*2390M0200074 EXT PCORE PHYSTAB FOR CORE DRIVER (SYSDAT) 83*2390M0200075 EXT P83310 UNIT 0 PHY. DEV. TBL. M0200076*********************************************************************** M0200077* EQUIVALENCES M0200078*********************************************************************** M0200079 EQU LOCORE($F7) SYSTEM LOW CORE DATA M0200080 EQU HICORE($F6) SYSTEM HIGH CORE DATA M0200081 EQU LUCORE(1) LOGICAL UNIT OF CORE ALLOCATOR M0200082 EQU LABLEN(34) LENGTH OF VOLUME LABEL M0200083ÐÐ EQU VR(3) RETURN IN VOLATILE M0200084 EQU VPL(4) PRIORITY IN VOLATILE M0200085 EQU ZERO($22) ZERO M0200086 EQU ONEBIT($23) M0200087 EQU ZROBIT($33) M0200088 EQU VTMP(7) TEMP IN VOLATILE M0200089 EQU LPMSK(2) M0200090 EQU AMONI($F4) M0200091 EQU FOUR($25) M0200092 EQU SYDIR($EB) M0200093 EQU H7FFF($11) M0200094 EJT M0200095* VOLUME LABEL M0200096 EQU VLIFLG(0) VOLUME INITIALIZED FLAG M0200097 EQU VLNAME(2) VOLUME NAME M0200098 EQU VLNMBR(6) VOLUME NUMBER M0200099 EQU VLSER(7) VOLUME SERIAL M0200100 EQU VLSEC(12) VOLUME SECURITY CODE M0200101 EQU VLDATE(16) VOLUME CREATE DATE M0200102 EQU VLBMSM(20) BEGINNING OF MANAGEABLE SPACE (MSB) M0200103 EQU VLBMSL(21) BEGINNING OF MANAGEABLE SPACE (LSB) M0200104 EQU VLASDM(22) ALLOCATABLE SPACE DIRECTORY SECTOR (MSB) M0200105 EQU VLASDL(23) ALLOCATABLE SPACE DIRECTORY SECTOR (LSB) M0200106 EQU VLASDS(24) SIZE OF ALLOCATABLE SPACE DIRECTORY M0200107 EQU VLLBA(25) LARGEST BLOCK AVAILABLE(MSB) M0200108ÐÐ EQU VLWPS(27) # WORDS/SECTOR M0200109 EQU VLFDD(28) ADDRESS OF FILE DIRECTORY M0200110 EQU VLMAXF(30) MAXIMUM NUMBER OF FILES M0200111 EQU VLCURF(31) CURRENT NUMBER OF FILES M0200112 EQU VLNFDB(32) NUMBER OF BLOCKS IN FILE DIRECTORY M0200113 EQU VLNXTB(33) NEXT AVAILABLE FILE DIRECTORY BLOCK M0200114 SPC 3 M0200115* VOLUME INFORMATION TABLE M0200116* M0200117 EQU VISLUN(2) SYSTEM LOGICAL UNIT NUMBER (BIT 15=1,NOT READYM0200118* ACCESS VISLUN INDIRECTLY M0200119 EQU VINAME(1) VOLUME NAME - ASCII CHARACTERS 1 AND 2 M0200120* VOLUME NAME - ASCII CHARACTERS 3 AND 4 M0200121* VOLUME NAME - ASCII CHARACTERS 5 AND 6 M0200122* VOLUME NAME - ASCII CHARACTERS 7 AND 8 M0200123 EQU VINMBR(5) VOLUME NUMBER - (2 ASCII CHARACTERS) M0200124 EQU VIBMSM(6) BEGINNING OF MANAGEABLE SPACE - MSB M0200125 EQU VIBMSL(7) BEGINNING OF MANAGEABLE SPACE - LSB M0200126 EQU VIASDM(8) AVAILABLE SPACE DIRECTORY ADDRESS - MSB M0200127 EQU VIASDL(9) AVAILABLE SPACE DIRECTORY ADDRESS - LSB M0200128 EQU VIASDS(10) # SECTORS IN AVAILABLE SPACE DIRECTORY M0200129 EQU VILBAM(11) LARGEST BLOCK OF SPACE AVAILABLE - MSB M0200130 EQU VILBAL(12) LARGEST BLOCK OF SPACE AVAILABLE - LSB M0200131 EQU VIWPS(13) WORDS/SECTOR FOR VOLUME M0200132 EQU VIFDDM(14) FILE DEFINITION DIRECTORY ADDRESS - MSB M0200133ÐÐ EQU VIFDDL(15) FILE DEFINITION DIRECTORY ADDRESS - LSB M0200134 EQU VIMAXF(16) MAX. NUMBER OF FILES PERMITTED ON VOLUME M0200135 EQU VICURF(17) CURRENT NUMBER OF FILES EXISTING ON VOLUME M0200136 EQU VINFDB(18) NUMBER OF BLOCKS IN FILE DEFINITION DIRECTORY M0200137 EQU VINXTB(19) NEXT AVAILABLE BLOCK IF FILE DEF. DIRECTORY M0200138 EQU VINOOF(20) NUMBER OF OPEN FILES ON VOLUME M0200139 SPC 2 M0200140* M0200141* SMD PHYSICAL DEVICE TABLE EQUIVALENCES M0200142* M0200143 EQU NUMHDS(49) NUMBER OF HEADS (5 OR 19) M0200144 EQU DRVSAK(68) DEVICE SELECT ACK. STATSU & MASK M0200145 SPC 1 M0200146 EQU DIFMSB($16) DIFFERENCE IN NO. OF MAX. SECTORS BETWEEN M0200147 EQU DIFLSB($4080) 50MB AND 180MB DRIVES M0200148 EQU NOHDS(19) NO. OF HEADS ON 180MB DRIVE M0200149 EJT M0200150* M0200151* RW REQUEST PROCESSOR MUST BE PRESENT M0200152* FOR OPERATION OF THIS MODULE. M0200153* M0200154* LUCORE MUST BE EQUATED TO THE LOGICAL M0200155* UNIT ASSIGNED TO THE CORE ALLOCATOR. M0200156 SPC 1 M0200157 EQU T17(*) **MSOS 4.0M0200158ÐÐT10 TRA Q M0200159 LDA- 8,I **MSOS 4.0M0200160 SAM COR1 SKIP IF INDIRECT REQ **MSOS 4.0M0200161 ENA 5 INCREMENT RETURN ADDRESS M0200162* FOR DIRECT M0200163 ADD- VR,I CALL M0200164 STA- VR,I M0200165COR1 LDA- (ZERO),Q GET REQUEST PRIORITY M0200166 AND RPMASK M0200167 STA- VPL,I M0200168 RTJ CKTHRD CHK FOR ZERO THREAD LOC. M0200169 LDA- VTMP,I CHECK REQ CODE **MSOS 4.0M0200170 INA -10 **MSOS 4.0M0200171 SAZ CORZ SPACE REQUEST **MSOS 4.0M0200172 JMP K65T10 A PARTITIONED REQ **MSOS 4.0M0200173CORZ ENQ LUCORE **MSOS 4.0M0200174 JMP SAVLU SET UP LU FOR ALLOCATOR M0200175 SPC 2 **MSOS 4.1**M0200176TOIDLE ENQ 1 ENTER TIME/DATE Q CODE **MSOS 4.1**M0200177 SCHDLE (TDFUNC),4 **MSOS 4.1**M0200178 SCHDLE (MNTCHK),5 M0200179 JMP+ IDLE GO TO IDLE LOOP **MSOS 4.1**M0200180 SPC 2 M0200181*********************************************************************** M0200182AREAC ADC 0 TOTAL LENGTH OF ALLOCATABLE CORE M0200183ÐÐ ADC ($7FFF) THREAD M0200184*********************************************************************** M0200185 EJT M0200186* THIS IS THE RESTART ROUTINE. ITS PURPOSE IS - M0200187* M0200188* 1. SET UP THE CORE ALLOCATION TABLE M0200189* 2. PROTECT AND UNPROTECT APPROPRIATE CORE LOCATIONS M0200190* 3. SET UP THE SYSTEM DIRECTORY ENTRY OF CERTAIN JOB M0200191* PROCESSOR MODULES M0200192* 4. START THE SYSTEM TIMER, AND INITIATE THE DIAGNOSTIC M0200193* TIMER AND TIME-OF-DAY PROGRAMS M0200194* 5. PRINT THE SYSTEM PSR LEVEL MESSAGE M0200195* 6. REQUEST THAT THE PROGRAM PROTECT SWITCH BE ENABLED M0200196* IF IT IS NOT M0200197* 7. PRINT THE SYSTEM IDENTIFICATION M0200198* 8. PRINT THE SYSTEM CORE SIZE MODE M0200199* 9. PERFORM A VALIDITY CHECK ON THE SYSTEM FILES (IF ANY) M0200200* 10. INITIATE A REQUEST FOR THE TIME AND DATE M0200201* 11. TRANSFER CONTROL TO THE SYSTEM IDLE LOOP M0200202 SPC 2 M0200203* SET UP THE CORE ALLOCATION TABLE M0200204* M0200205RESTRT LDA ALCLGH M0200206 INA 2 ALLOW ROOM FOR THREAD BETWEEN AREA 0-1 85*2565M0200207 STA ALCLGH M0200208ÐÐRST1 ENQ 15 M0200209 LDA =XAREAC M0200210SETTBL INQ -1 SETUP ALLOCATION TABLE (LVLSTR) M0200211 STA- I M0200212 LDA ALCLGH,Q M0200213 SAZ CHKEND NO ALLOCATION, SEE IF DONE M0200214 INA 2 M0200215CHKEND ADD- I M0200216 SQZ SETEND M0200217 STA LVLSTR,Q M0200218 JMP* SETTBL M0200219 EJT M0200220SETEND INA 1 SETUP END OF PROTECTED ALLOCATABLE AREA M0200221 STA LEND M0200222 ENQ 10 M0200223 LDQ- ($E9),Q IS UNPROTECTED IN PART 1 M0200224 SQN FIX4 YES M0200225 JMP* FIX4Y NO M0200226FIX4 TCA Q -(END OF ALLOCATABLE) TO Q M0200227 LDA =XEND0V4 ADDRESS OF LAST LOCATION IN PART 0 TO A M0200228 AAQ A COMPUTE # EXTRA LOCATIONS M0200229 SAP FIX4A SKIP IF EXTRA.GE.ZERO M0200230 JMP* NTENUF GO AWAY IF NOT ENOUGH ROOM M0200231FIX4A SAZ FIX4X SKIP IF ZERO EXTRA MEMORY M0200232 LDQ =XALCLGH START OF LENGTH TABLE TO A M0200233ÐÐ ADD- 3,Q ADD EXTRA TO REQUESTED AREA 4 M0200234 STA- 3,Q STORE BACK IN TABLE M0200235 JMP* RST1 SET UP ALLOCATABLE WITH NEW AREA 4 M0200236FIX4X TCQ A SET A TO END OF ALLOCATABLE M0200237 JMP* SKIPIT M0200238FIX4Y TRA Q IS THE SIZE OF ALLOCATABLE GREATER M0200239 SUB- $F7 THAN SPECIFIED BY THE INITIALIZER M0200240 SAM SKIPIT-1 NO M0200241 STQ- $F7 YES, SPECIFY THE NEW SIZE M0200242 STQ- $ED M0200243 TRQ A M0200244SKIPIT SUB =XAREAC-1 M0200245 STA* AREAC SETUP TOTAL AVAILABLE PROTECTED ALLOCATABLE M0200246 STA CALTHD M0200247 STA MIBX LOCK OUT MIPRO M0200248 STA EFLOCK LOCK OUT LOGGER **MSOS 4.1**M0200249 JMP* INIT M0200250 EJT M0200251NTENUF RTJ- (AMONI) PRINT INSUFFICIENT MEMORY MESSAGE M0200252 ADC $0C00 M0200253 ADC 0 M0200254NTETHD ADC 0 M0200255 NUM $18FC M0200256 ADC NTEMSL M0200257 ADC NTEMSG M0200258ÐÐ SPC 2 M0200259NTEWAT LDA* NTETHD M0200260 SAZ 1 M0200261 JMP* NTEWAT WAIT FOR COMPLETION M0200262 RTJ SYFAIL KILL SYSTEM M0200263 SPC 2 M0200264NTEMSG ALF *,INSUFFICIENT ALLOCATABLE MEMORY* M0200265NTEMSL EQU NTEMSL(*-NTEMSG) M0200266 EJT 0 M0200267* M0200268* INITIALIZE ALL LOCATIONS ABOVE PHYSICAL LOCATION $FFFF M0200269* M0200270* M0200271* 1. SET PAGE REGS 0-15 TO 0-15 BECAUSE M0200272* THIS CODE IS IN THE LOWEST 32K OF MEMORY M0200273* ---------- M0200274* 2. GO TO PAGE MODE 0 M0200275* 3. USE PAGE REG 16 TO INDEX PAGE (2K) TO WORK ON M0200276* START WITH PAGE 127 (POSSIBLE LAST PAGE IN MACHINE) M0200277* 4. WRITE $18FF TO ALL LOCATIONS IN CURRENT PAGE M0200278* AND SET PROTECT BIT ON M0200279* 5. DECREMENT PAGE NUMBER UNTIL ALL PAGES ABOVE $FFFF IN BOTH M0200280* CPUS HAVE BEEN COVERED. M0200281* IF A PAGE DOES NOT EXIST, THE WRITE OPERATION WILL M0200282* BE ABORTED AND PARITY ERROR SET M0200283ÐÐ* 6. GO TO ABSOLUTE MODE M0200284* 7. SET UP PAGE REGS 16-31 TO CONTAIN 16-31. THUS M0200285* PHYSICAL ADDRESS = LOGICAL ADDRESS FOR THE LOWEST 65K. M0200286* M0200287INIT APM 0 GO TO ABSOLUTE MODE M0200288 CLR A ASSUME THIS CODE IS IN THE LOWEST 32K OF M0200289 ENQ 15 MACHINE. THUS M0200290SETUP WPR A FILL PAGE REGS 0-15 WITH 0-15 M0200291* WRITE IN PAGE REG M0200292 ADD =N$0801 INCREMENT PAGE REG AND ITS CONTENT BY ONE M0200293 DQP *-SETUP M0200294* M0200295 IIN 0 INHIBIT INTERRUPT FROM PARITY ERROR M0200296 PM0 0 GO TO PAGE MODE 0 M0200297 ENA $10 M0200298 ALS 11 USE PAGE REG $10 TO INDEX EACH PAGE M0200299 STA- I CURRENTLY BEING WRITTEN M0200300 INA $7F MAX PAGE IN MACHINE M0200301 XFA 1 REG 1 CONTAINS CURRENT PAGE (BITS 0-8) M0200302* AND PAGE REG (BITS 10-15) M0200303 ENA $5F TOTAL NO. OF PAGES = 96 ($60) FROM PAGE 127 M0200304* TO 31 (ALL LOCATIONS ABOVE PHYSICAL $FFFF) M0200305 XFA 2 M0200306 LDA LOC0 DATA TO WRITE IN REGISTER A ($18FF) M0200307NXTPGE EQU NXTPGE(*) REPEAT M0200308ÐÐ WPR 1 WRITE CURRENT PAGE IN PAGE REG $10 M0200309 LR3- LPMSK+11 TOTAL NO. OF LOCATIONS IN ONE PAGE = $800 M0200310* (2K) M0200311 LDQ- I M0200312 ADQ- LPMSK+11 REG Q CONTAINS THE LOGICAL ADDRESS OF M0200313* LOCATIONS IN PAGE, LAST LOCATION=$7FF M0200314NXTLOC EQU NXTLOC(*) REPEAT M0200315 STA- (ZERO),Q WRITE 16 BIT DATA M0200316 SPB 0 SET PROTECT BIT TO ONE M0200317 INQ -1 DECREMENT LOGICAL ADDRESS BY ONE M0200318 D3P *-NXTLOC UNTIL ALL LOCATIONS IN A PAGE WERE WRITTEN M0200319* ENDREPEAT M0200320 SB1- LPMSK+1 DECREMENT PAGE NUMBER BY ONE M0200321 D2P *-NXTPGE UNTIL ALL 96 PAGES HAS BEEN WRITTEN M0200322* ENDREPEAT M0200323 SPE 0 CLEAR PARITY ERRORS WHICH MIGHT BE CAUSED BY M0200324* WRITING INTO NON-EXISTING MEMORY M0200325 SPC 5 M0200326* M0200327* FILL PAGE REGS 16-31 WITH 16-31 SUCH THAT PHYSICAL ADDRESS M0200328* =LOGICAL ADDRESS FOR LOWEST 65K OF MEMORY M0200329* M0200330 APM 0 M0200331 ENQ 15 M0200332 LDA =N$8010 M0200333ÐÐSETUP1 WPR A M0200334 ADD =N$0801 M0200335 DQP *-SETUP1 M0200336 EJT M0200337* PROTECT AND UNPROTECT APPROPRIATE CORE LOCATIONS M0200338 SPC 2 M0200339 LDQ- $F5 **MSOS 4.1**M0200340SPBLOP SPB 0 PROTECT ALL OF AVAILABLE CORE **MSOS 4.0M0200341 SQZ CLRPB SKIP IF ALL UNPROTECTED **MSOS 4.0M0200342 INQ -1 **MSOS 4.0M0200343 JMP* SPBLOP **MSOS4.0*M0200344* M0200345*----- SPECIAL INSTRUCTION ON SETTING UPPER AND LOWER M0200346*----- BOUND REGISTERS : M0200347* (1) SET UPPER BOUND REGISTER TO ZERO -- TURN OFF M0200348* BOUNDS M0200349* (2) SET LOWER BOUND REGISTER, AND M0200350* (3) SET UPPER BOUND REGISTER. M0200351* M0200352CLRPB IIN 0 DISABLE INTERRUPT M0200353 ENA 0 M0200354 LUB A M0200355 LDA- LOCORE M0200356 STA LBPROT M0200357 LLB A M0200358ÐÐ LDA- HICORE M0200359 STA UBPROT M0200360 LUB A M0200361 LDA- LOCORE GET LOW CORE DATA AND SET FOR LOWER BOUND M0200362 ENQ 1 REGISTER DATA FOR TABLE M0200363 STA LOBDTB,Q LEVEL -1, 0 AND 1 LOWER BOUND REGISTER TABLE M0200364 EQU LOBDAD(*-1) M0200365 STA* (LOBDAD) INITIALIZATION M0200366 ENQ -1 M0200367 STA* (LOBDAD),Q M0200368 LDA- HICORE GET HI-CORE DATA M0200369 ENQ 1 INITIALIZE LEVEL -1, 0 AND 1 UPPER BOUND M0200370 STA UPBDTB,Q REGISTER TABLE DATA M0200371 EQU UPBDAD(*-1) M0200372 STA* (UPBDAD) M0200373 ENQ -1 M0200374 STA* (UPBDAD),Q M0200375 SPC 1 M0200376RSTRT2 LDQ =N$F3 CLEAR SPECIAL COMMUNICATION AREA M0200377 CPB 0 M0200378 INQ $C M0200379 CPB 0 M0200380 INQ -$3A UNPROTECT FORTRAN AREA ($C5-$E5) M0200381RSTRT3 CPB 0 M0200382 LDA =N$E5 M0200383ÐÐ EAQ A M0200384 INQ 1 M0200385 SAZ 1 M0200386 JMP* RSTRT3 M0200387 LDQ- $F4 UNPROTECTED REQUEST ENTRY M0200388 CPB 0 POINT M0200389 SPC 1 M0200390 LDA- $F2 UNPROTECT PRESET LOCATIONS M0200391 STA- I M0200392 ENQ 2 M0200393RSTRT4 TCQ A M0200394 ADD- $F1 LENGTH OF TABLE OF PRESETS M0200395 SAM RSTRT6 M0200396 STQ* RSTRT5 M0200397 LDQ- 1,B M0200398 CPB 0 M0200399 LDQ* RSTRT5 M0200400 INQ 4 M0200401 JMP* RSTRT4 M0200402 SPC 1 M0200403RSTRT5 NUM 0 COUNTER M0200404 SPC 3 M0200405RSTRT6 RTJ- (AMONI) CLEAR CRT SCREEN M0200406 ADC $0C00 M0200407 ADC 0 M0200408ÐÐCLRTHD ADC 0 M0200409 ADC $18FC M0200410 ADC 1 M0200411 ADC CLRSCR M0200412CLRWAT LDA* CLRTHD M0200413 SAZ RSTRT7 M0200414 JMP* CLRWAT M0200415 SPC 1 M0200416CLRSCR NUM $1800 M0200417 EJT M0200418* SET UP SYSTEM DIRECTORY FOR JOBENT, LIBEDT, AND PROTEC M0200419 SPC 2 M0200420SDJOB ADC JOBENT M0200421SDLIB ADC LIBEDT M0200422SDPRO ADC PROTEC M0200423LOC0 ADC $18FF M0200424 SPC 2 M0200425RSTRT7 LDQ- SYDIR M0200426 ADQ* SDJOB M0200427 ENA $10 SET PRIORITY OF JOBENT TO 1 M0200428 STA- (ZERO),Q M0200429 LDQ- SYDIR M0200430 ADQ* SDLIB SET LIMITS FOR INITIAL LOAD M0200431 LDA =XLSIZV4 LIBEDT LOAD LENGTH **MSOS 4.0M0200432 STA- (FOUR),Q **MSOS 4.1* M0200433ÐÐ LDQ- SYDIR M0200434 ADQ* SDPRO SET LIMITS FOR INITIAL LOAD M0200435 LDA =XPSIZV4 PROTEC LOAD LENGTH **MSOS 4.0M0200436 STA- (FOUR),Q M0200437 LDA- $FB GET STANDARD LIST 86*2718M0200438 STA+ AUTFB SAVE IN TRVEC 86*2718M0200439 LDA- $FA GET STD PUNCH 86*2718M0200440 STA+ AUTFA SAVE IN TRVEC 86*2718M0200441 LDA- $F9 GET STANDARD INPUT **MSOS 4.0M0200442 STA+ AUTF9 SAVE IN TRVEC 86*2718M0200443 ADD- $2F ADD ASCII MODE **MSOS 4.0M0200444 STA IUP **MSOS 4.0M0200445 STA INPTV4 SET UP FOR JOB PROCESSOR INPUT **MSOS 4.0M0200446 EJT M0200447* START THE SYSTEM TIMER M0200448 SPC 2 M0200449* TIMER INITIATION CODING **MSOS 4.1**M0200450* **MSOS 4.1**M0200451TIMSRT LDQ DMICOD ENABLE ADT/MICRO INTERRUPT NUMBER M0200452 LDA+ TBLADR ADT TABLE ADDRESS MP MSOSM0200453 DMI 0 DEFINE MICRO INTERRUPT M0200454 LDQ+ EMPSRT RESET AND START FUNCTION CODE MP MSOSM0200455 OUT REJ-* M0200456 EJT **MSOS 4.1**M0200457* INITIATE THE DIAGNOSTIC TIMER AND TIME-OF-DAY PROGRAMS M0200458ÐÐ SPC 2 M0200459CHKTMR LDA* RSTRTA M0200460 EOR- LPMSK+15 M0200461 SAN 1 M0200462 JMP* RSTRTT SKIP IF DTIMER NOT PRESENT **MSOS 4.1**M0200463 SPC 1 M0200464 RTJ- (AMONI) START DIAG TIMER M0200465 NUM $5206 ***MSOS4.0M0200466RSTRTA ADC DTIMER M0200467 SPC 1 M0200468RSTRTT LDA* TTRSTR **MSOS 4.1**M0200469 EOR- LPMSK+15 **MSOS 4.1**M0200470 SAN 1 SKIP IF TOD PRESENT **MSOS 4.1**M0200471 JMP* RSTRT9 **MSOS 4.1**M0200472 SPC 1 M0200473 RTJ- (AMONI) START TOD PROGRAM **MSOS 4.1**M0200474 NUM $5206 **MSOS 4.1**M0200475TTRSTR ADC UPTOD **MSOS 4.1**M0200476 JMP* RSTRT9 **MSOS 4.1**M0200477 EJT M0200478* TIMER REJECT MESSAGE M0200479 SPC 2 M0200480REJ NOP 0 M0200481 LDQ =XLOG1A **MSOS 4.1**M0200482 LDQ- 1,Q **MSOS 4.1**M0200483ÐÐ LDA- 13,Q **MSOS 4.1**M0200484 AND- LPMSK+15 **MSOS 4.1**M0200485 EOR- ONEBIT+15 DISABLE DELAYED CORE SWAPS **MSOS 4.1**M0200486 STA- 13,Q **MSOS 4.1**M0200487 ENA 0 INDICATE NO TIMER **MSOS 4.1**M0200488 STA+ TMRTYP **MSOS 4.1**M0200489 SPC 1 M0200490 RTJ- (AMONI) PRINT TIMER REJECT MSG M0200491 ADC $0C00 M0200492 ADC 0 M0200493REJTH ADC 0 M0200494 ADC $18FC M0200495 ADC 6 M0200496 ADC REJMSG M0200497 SPC 1 M0200498REJCK LDA* REJTH M0200499 SAZ 1 M0200500 JMP* REJCK WAIT FOR COMPLETION M0200501 JMP* RSTRT9 M0200502 SPC 2 M0200503REJMSG ALF 6,TIMER REJECT **MSOS 4.1**M0200504 EJT M0200505* M0200506******* CLEAR POLL TABLE STATUS FOR SMD DRIVES M0200507* M0200508ÐÐ SPC 2 M0200509 EQU CLRSEK($701) CLEAR SEEK IN POLL TABLE M0200510 EQU CONCU($703) CU CONNECT CODE M0200511 EQU DIRFNC($708) DIRECTOR FUNCTION CODE M0200512 SPC 1 M0200513COUNTQ NUM 0 M0200514 SPC 1 M0200515RSTRT9 ENA 0 M0200516 LDQ =XCONCU M0200517 OUT 1 CONNECT TO CU M0200518 NOP 0 M0200519 SOV *+1 M0200520 LDA =N$FF00 M0200521 STA* COUNTQ M0200522 LDQ =XDIRFNC M0200523RSTR9A INP 1 READ DA STATUS M0200524 NOP 0 M0200525 ALS 13 M0200526 SAM RSTR9B SENSE CU CONNECTED M0200527 RAO* COUNTQ M0200528 SOV RSTR10 SENSE WAIT CU CONNECT EXPIRED M0200529 JMP* RSTR9A M0200530RSTR9B SOV *+1 M0200531 LDA =N$7FF0 (SET TO LOOP 16 TIMES) M0200532 STA* COUNTQ M0200533ÐÐ LDQ =XCLRSEK M0200534 ENA $60 M0200535RSTR9C OUT 1 CLEAR SEEK PENDING/SEEKCOMPLETE M0200536 NOP 0 FROM POLL TABLE FOR EACH DRIVE M0200537 INA 1 M0200538 RAO* COUNTQ M0200539 SOV RSTR10 SENSE DONE M0200540 JMP* RSTR9C M0200541 EJT M0200542* M0200543****** THE FOLLOWING LOGIC MUST BE MANUALLY ENABLED AND DISABLED VIA M0200544****** DEBUG BY SETTING OR RESETTING 'SMDFLG' FLAG. IT IS EXECUTED 1 M0200545****** TIME AFTER INITIAL AUTOLOAD FOLLOWING ENABLING OF LOGIC. M0200546****** ENABLING SHOULD BE DONE PRIOR TO TAKING DTLP OR EDTLP SO THAT M0200547****** LOGIC IS EXECUTED FIRST TIME AUTOLOAD OCCURS AFTER DTLP IS M0200548****** LOADED. IF ENABLED, THE LOGIC DOES THE FOLLOWING: M0200549****** A) STATUS DRIVE FOR SELECT ACKNOWLEDGE STATUS M0200550****** B) DETERMINE IF DRIVE IS 50MB OR 180MB M0200551****** C) IF 50MB, DO NOTHING M0200552****** IF 180MB, DO THE FOLLOWING: M0200553****** 1) CHANGE PHY. DEV. TBL. FOR 180MB DRIVE M0200554****** 2) ADD TO LENGTH OF AVAILABLE SPACE IN SYSVOL VOLUME M0200555****** LABEL THE DIFFERENCE BETWEEN 50MB AND 180MB M0200556****** MAX. SECTORS. M0200557****** 3) UPDATE SAME VALUE IN VIT TABLE ON CORE IMAGE M0200558ÐÐ****** 4) INCREASE LAST ENTRY IN ALLOCATABLE SPACE DIRECTORY M0200559****** BY SAME DIFFERENCE. M0200560* M0200561 SPC 2 M0200562SMDFLG NUM 1 ENABLE/DISABLE FLAG M0200563 SPC 1 M0200564RSTR10 LDA* SMDFLG M0200565 SAN RST10A SENSE SMD CONFIG LOGIC ENABLED M0200566 JMP* RS10AA M0200567 SPC 1 M0200568RST10A LDQ =XCONCU M0200569 ENA 0 (SET FOR DRIVE 0/DRIVE STATUS) M0200570 OUT 1 CONNECT TO DRIVE(PRIVIOUS LOGIC CONNECTED CU) M0200571 NOP 0 M0200572 INP 1 READ SELECT ACKNOWLEDGE STATUS M0200573 NOP 0 M0200574 ALS 9 (BIT 6 = 1 MEANS 300MB DRIVE) M0200575 SAM RST10B SENSE 180MB DRIVE M0200576RS10AA JMP RSTR11 DO NOTHING IF 50MB DRIVE M0200577****** REDEFINE PHYSICAL DEVICE TABLE REQUIREMENTS M0200578AP8331 ADC P83310 ADDR. OF SMD UNIT 0 PHY. DEV. TBL. M0200579RST10B LDQ* AP8331 M0200580 ENA NOHDS M0200581 STA- NUMHDS,Q REDEFINE NO. OF HEADS M0200582 LDA =N$C0EF M0200583ÐÐ STA- DRVSAK,Q REDEFINE DEVICE SELECT ACK. MASK M0200584 LDQ- $E9 CALC. WORD ADDRESS OF SMD UNIT 0 P. D. T. M0200585 LDA- 4,Q NO. OF HEADS WORD ON MM. M0200586 MUI =N96 M0200587 ADD* AP8331 M0200588 INA NUMHDS M0200589 STA* LSBNHD M0200590 LDA* AP8331 CALC. CORE ADDRESS OF NO. OF HEADS WORD M0200591 INA NUMHDS M0200592 STA* SNHDS M0200593 RTJ- (AMONI) WRITE CHANGED P. D. T. TO CORE IMAGE M0200594 NUM $4400 WRITE REQUEST M0200595 NUM 0 M0200596THDWM1 NUM 0 M0200597 NUM 8 LU M0200598 NUM 20 LENGTH(FROM NUMHDS TO DRVSAK) M0200599SNHDS NUM 0 M0200600 NUM 0 MSB M0200601LSBNHD NUM 0 LSB M0200602 SPC 1 M0200603****** REDEFINE 'SYSVOL' VOLUME LABEL M0200604 SPC 1 M0200605 RTJ- (AMONI) READ IN VOLUME LABEL M0200606 NUM $4800 FREAD M0200607 NUM 0 M0200608ÐÐTHDR NUM 0 M0200609 NUM 8 LU M0200610 ADC LABLEN M0200611 ADC LABEL M0200612 NUM 0,0 M0200613RST10C LDA* THDR M0200614 SAZ RST10D SENSE READ DONE M0200615 JMP* RST10C M0200616RST10D LDA ALABEL M0200617 INA VLLBA M0200618 STA- I M0200619 LDQ- (ZERO),I M0200620 LDA- 1,I M0200621 ADQ* MSBDIF INCREASE AVAILABLE SPACE BY DIFERENCE M0200622 ADD* LSBDIF BETWEEN 50MB AND 180MB M0200623 SAP RST10E M0200624 INQ 1 M0200625 AND- H7FFF M0200626RST10E STQ- (ZERO),I REDEFINE LENGTH OF ALLOCATABLE M0200627 STA 1,I FILE MANAGER SPACE M0200628 RTJ- (AMONI) WRITE BACK VOLUME LABEL M0200629 NUM $4C00 FWRITE M0200630 NUM 0 M0200631THDW NUM 0 M0200632 NUM 8 LU M0200633ÐÐ ADC LABLEN M0200634 ADC LABEL M0200635 NUM 0,0 M0200636RST10F LDA* THDW M0200637 SAZ RST10G SENSE WRITE DONE M0200638 JMP* RST10F M0200639****** REDEFINE LENGTH OF AVAILABLE SPACE IN VIT TBL. ON CORE IMAGE. M0200640RST10G LDQ- $E9 =ADDR. OF EXTENDED CORE TABLE M0200641 LDA- 4,Q =SECTOR ADDR. OF CORE IMAGE M0200642 MUI =N96 =WORD ADDR. OF CORE IMAGE M0200643 ENQ 1 M0200644 ADD* (AMLUT),Q =WORD ADDR. OF FM UNIT 0 VIT TBL. ON MM M0200645 INA VILBAM M0200646 STA* LSB1 M0200647 RTJ- (AMONI) WRITE REDEFINED LENGTH OF AVAILABLE SPACE M0200648 NUM $4400 (WRITE) TO VIT ON CORE IMAGE M0200649 NUM 0 M0200650THDW2 NUM 0 M0200651 NUM 8 LU M0200652 NUM 2 LENGTH M0200653 ADC LABEL+VLLBA M0200654 NUM 0 M0200655LSB1 NUM 0 M0200656RST10H LDA* THDW2 M0200657 SAZ RST10I SENSE WRITE DONE M0200658ÐÐ JMP* RST10H M0200659 SPC 1 M0200660AMLUT ADC MMLUTB ADDR. OF FM VECTOR TBL. TO VIT TBLS. M0200661NUMENT ADC -96/4+1 NO. OF ENTRIES IN SEGMENT(ADJ. FOR OVRFLW CHK.M0200662MSBDIF ADC DIFMSB (SEE EQUS) M0200663LSBDIF ADC DIFLSB (SEE EQUS) M0200664 SPC 1 M0200665****** REDEFINE LAST ENTRY IN ALLOCATABLE FILE SPACE DIRECTORY M0200666****** TO INCREASE AVAILABLE SPACE BY DIFFERENCE BETWEEN 50MB AND M0200667****** 180MB MAX. SECTORS. M0200668 SPC 1 M0200669RST10I ENQ VLASDM GET SECTOR ADDR. OF MSB,LSB OF AVAIL. SPACE DRM0200670 LDA LABEL,Q M0200671 STA* ASDSEC M0200672 ENQ VLASDL M0200673 LDA LABEL,Q M0200674 STA* ASDSEC+1 M0200675 RTJ- (AMONI) READ A DIRECTORY SEGMENT(1 96 WD. SECTOR) M0200676 NUM $4800 FREAD M0200677 NUM 0 M0200678THDR2 NUM 0 M0200679 NUM 8 LU M0200680 NUM 96 M0200681 ADC DIRSEG M0200682ASDSEC NUM 0,0 MSB,LSB M0200683ÐÐRST10J LDA* THDR2 M0200684 SAZ RST10K SENSE READ DONE M0200685 JMP* RST10J M0200686****** SCAN FOR LAST 4-WORD ENTRY(END FLAG = -1) M0200687RST10K SOV 0 M0200688 LDA* NUMENT M0200689 STA- I M0200690 ENQ 0 M0200691RST10L LDA DIRSEG,Q M0200692 SAM RST10P SENSE LAST ENTRY + 1 FOUND M0200693 INQ 4 M0200694 RAO- I M0200695 SOV RST10M SENSE LAST NOT FOUND IN SEGMENT M0200696 JMP* RST10L M0200697RST10M RAO* ASDSEC+1 BUMP TO NEXT SEGMENT M0200698 ENQ VLASDS M0200699 LDA* ASDSEC+1 M0200700 SUB LABEL,Q -NO. OF SECTORS IN AVAIL. SPACE DIRECTORY M0200701 ENQ VLASDL M0200702 SUB LABEL,Q -ADDR. OF START OF AVAIL. SPACE DIR. M0200703 SAP RST10N SENSE END FLAG NOT FOUND IN DIRECTORY M0200704 JMP* RST10I GO BACK AND READ NEXT SEGMENT M0200705RST10N JMP* RST10U M0200706 SPC 1 M0200707RST10P INQ -4 M0200708ÐÐ STQ- I M0200709 LDQ* DIRSEG,I M0200710 LDA* DIRSEG+1,I M0200711 ADQ* MSBDIF INCREASE AVAIL. SPACE BY DIFF.BETWEN 50MB&180MM0200712 ADD* LSBDIF M0200713 SAP RST10Q SENSE NO OVERFLOW M0200714 INQ 1 M0200715 AND- H7FFF M0200716RST10Q STQ* DIRSEG,I M0200717 STA* DIRSEG+1,I M0200718 LDA* ASDSEC SET UP SECTOR ADDR. OF SEGMENT M0200719 STA* ASDSCW M0200720 LDA* ASDSEC+1 M0200721 STA* ASDSCW+1 M0200722 RTJ- (AMONI) WRITE SEGMENT BACK TO MM M0200723 NUM $4C00 FWRITE M0200724 NUM 0 M0200725THDW3 NUM 0 M0200726 NUM 8 LU M0200727 NUM 96 LENGTH M0200728 ADC DIRSEG M0200729ASDSCW NUM 0,0 MSB,LSB M0200730RST10S LDA* THDW3 M0200731 SAZ RST10T SENSE WRITE DONE M0200732 JMP* RST10S M0200733ÐÐRST10T LDQ- $E9 (CALC. WORD ADDR. OF SMDFLG ON CORE IMAGE) M0200734 LDA- 4,Q M0200735 MUI =N96 M0200736 ADD =XSMDFLG M0200737 STA* LSBFLG M0200738 RTJ- (AMONI) CLEAR SMDFLG ON CORE IMAGE M0200739 NUM $4400 WRITE M0200740 NUM 0 M0200741THDW5 NUM 0 M0200742 NUM 8 LU M0200743 NUM 1 LENGTH M0200744 ADC ZERO M0200745 NUM 0 MSB M0200746LSBFLG NUM 0 LSB M0200747RST10X LDA* THDW5 M0200748 SAZ RST10Y SENSE WRITE DONE M0200749 JMP* RST10X M0200750RST10Y JMP* RSTR11 GO TO NEXT LOGIC M0200751 SPC 2 M0200752RST10U RTJ- (AMONI) PRINT FM SPACE DIRECTORY ERROR M0200753 NUM $0C00 M0200754 NUM 0 M0200755THDW4 NUM 0 M0200756 NUM $18FC M0200757 ADC SDELEN M0200758ÐÐ ADC SDEMSG M0200759RST10V LDA* THDW4 M0200760 SAZ RST10W M0200761 JMP* RST10V M0200762RST10W RTJ SYFAIL KILL SYSTEM M0200763 SPC 1 M0200764SDEMSG ALF *,FILE MGR. SPACE DIRECTORY ERROR* M0200765SDELEN EQU SDELEN(*-SDEMSG) M0200766DIRSEG BZS DIRSEG(96) AREA FOR AVAILABLE SPACE DIRECTORY SEGMENT M0200767 EJT M0200768* PRINT THE SYSTEM PSR LEVEL AND DATE OF BUILD M0200769 SPC 2 M0200770RSTR11 LDA MONTH M0200771 EOR- LPMSK+15 IS THE BUILD DATE PATCHED **MSOS 4.1**M0200772 SAN 1 **MSOS 4.1**M0200773 JMP* PSRMSG NO **MSOS 4.1**M0200774 LDA MONTH **MSOS 4.1**M0200775 ENQ $20 ADD LEADING SPACE **MSOS 4.1**M0200776 LLS 8 **MSOS 4.1**M0200777 INA $2F ADD TRAILING SLASH **MSOS 4.1**M0200778 STQ DATE+1 **MSOS 4.1**M0200779 STA DATE+2 FORM SYSTEM BUILD DATE **MSOS 4.1**M0200780 LDA DAY **MSOS 4.1**M0200781 STA DATE+3 **MSOS 4.1**M0200782 LDA YEAR **MSOS 4.1**M0200783ÐÐ ENQ $2F ADD LEADING SLASH **MSOS 4.1**M0200784 LLS 8 **MSOS 4.1**M0200785 INA $20 ADD TRAILING SPACE **MSOS 4.1**M0200786 STQ DATE+4 **MSOS 4.1**M0200787 STA DATE+5 **MSOS 4.1**M0200788 SPC 1 M0200789PSRMSG RTJ- (AMONI) PRINT THE MESSAGE **MSOS 4.1**M0200790 ADC $0C01 M0200791 ADC 0 M0200792TX ADC 0 M0200793 ADC $18FC M0200794 ADC LSUMLV M0200795 ADC SUMLVL M0200796 SPC 1 M0200797LTX LDA* TX M0200798 SAZ MAT100 M0200799 JMP* LTX WAIT FOR COMPLETION M0200800 EJT M0200801************************************************************************M0200802* *M0200803* THIS CODE DETERMINES THE AMOUNT OF MEMORY INSTALLED IN THE *M0200804* MACHINE. *M0200805* IT THEN DETERMINES IF THE AMOUNT INSTALLED IS EQUAL TO OR *M0200806* GREATER THAN THE MINIMUM AMOUNT NECESSARY TO RUN THE *M0200807* CCS 2.0 APPLICATION PACKAGE. IF THERE IS INSUFFICIENT MEMORY, *M0200808ÐÐ* A MESSAGE IS WRITTEN ON THE COMMENT DEVICE AND SYFAIL IS CALLED.*M0200809* IF SUFFICIENT MEMORY EXISTS, THE MEMORY ALLOCATION TABLE IS *M0200810* SET UP TO MATCH THE REAL MEMORY CONFIGURATION AND A MESSAGE *M0200811* STATING THE AMOUNT OF MEMORY IN THE MACHINE IS WRITTEN ON THE *M0200812* COMMENT DEVICE. *M0200813* THE FOLLOWING RESTRICTIONS ARE PLACED ON THE CONSTRUCTION *M0200814* OF THE XMAT TABLE IN SYSDAT: *M0200815* *M0200816* 1. ONLY TABLE ENTRIES = -1 ARE CANDIDATES TO BE UPDATED. *M0200817* 2. THE FIRST PAGE OF REMOTE MEMORY MUST NOT BE REPRESENTED *M0200818* IN THE SAME WORD AS THE LAST PAGE OF LOCAL MEMORY. *M0200819* 3. THE FIRST PAGE OF REMOTE MEMORY IS REPRESENTED *M0200820* IN A WORD DEFINED AS XMATR. *M0200821* *M0200822************************************************************************M0200823 SPC 2 M0200824 EXT XMAT MEMORY ALLOCATION TABLE, LOCAL BANK. M0200825 EXT XMATR MEMORY ALLOCATION TABLE, REMOTE BANK. M0200826 SPC 2 M0200827MAT100 IIN 0 M0200828 ENQ 31 Q = 8K BLOCK NUMBER. M0200829MAT110 RTJ SIZE FIND OUT IF THIS 8K BLOCK EXISTS. M0200830 STA MAT900,Q SAVE RETURNED FLAG. M0200831 SAN MAT120 SKIP IF NO PAGE REGISTER ERRORS HAVE OCCURRED.M0200832 JMP* MAT800 A PAGE REGISTER ERROR HAS OCCURRED. M0200833ÐÐMAT120 DQP *-MAT110 GO CHECK THE NEXT 8K BLOCK. M0200834 SPC 2 M0200835 ENQ 15 COUNT THE NUMBER OF 2K PAGES IN LOCAL BANK. M0200836MAT200 LDA MAT900,Q M0200837 SAM MAT220 SKIP IF THIS 8K BLOCK NOT IN MACHINE. M0200838 ADD MAT901 M0200839 STA MAT901 UPDATE NUMBER OF 2K PAGES IN LOCAL BANK. M0200840 JMP* MAT250 CHECK NEXT 8K BLOCK. M0200841MAT220 LDA MAT901 M0200842 SAM MAT250 SKIP IF CONTIGUOUS MEMORY IN LOCAL BANK. M0200843 JMP* MAT810 NONCONTIGUOUS MEMORY IN LOCAL BANK-ERROR. M0200844MAT250 DQP *-MAT200 CHECK THE NEXT 8K BLOCK. M0200845 SPC 2 M0200846 ENQ 15 COUNT THE NUMBER OF 2K PAGES IN REMOTE BANK. M0200847MAT260 LDA MAT900+16,Q M0200848 SAM MAT270 SKIP IF THIS 8K BLOCK IS NOT IN THE MACHINE. M0200849 ADD MAT902 M0200850 STA MAT902 UPDATE NUMBER OF 2K PAGES IN REMOTE BANK. M0200851 JMP* MAT280 CHECK THE NEXT 8K BLOCK. M0200852MAT270 LDA MAT902 M0200853 SAM MAT280 SKIP IF CONTIGUOUS MEMORY IN REMOTE BANK. M0200854 JMP* MAT820 NONCONTIGUOUS MEMORY IN REMOTE BANK - ERROR. M0200855MAT280 DQP *-MAT260 CHECK THE NEXT 8K BLOCK. M0200856 SPC 2 M0200857 LDA MAT901 M0200858ÐÐ SUB MAT903 M0200859 SAP MAT310 SKIP IF SUFFICIENT LOCAL MEMORY. M0200860 JMP* MAT830 INSUFFICIENT LOCAL MEMORY. M0200861 SPC 2 M0200862MAT310 LDA MAT902 M0200863 SUB MAT904 M0200864 SAP MAT320 SKIP IF SUFFICIENT REMOTE MEMORY. M0200865 JMP* MAT840 INSUFFICIENT LOCAL MEMORY. M0200866 EJT 0 M0200867*********************************************************************** M0200868* * M0200869* UPDATE MEMORY ALLOCATION TABLE FOR * M0200870* THE LOCAL BANK. * M0200871* * M0200872*********************************************************************** M0200873 SPC 2 M0200874MAT320 LRI- ZERO I = 0 M0200875 LDQ MAT901 Q = NUMBER OF 2K PAGES IN LOCAL BANK. M0200876MAT330 ADQ+ XMAT,I M0200877 SQM MAT350 SKIP IF XMAT UPDATE IS COMPLETE. M0200878 LDA+ XMAT,I M0200879 INA 1 M0200880 SAN MAT340 SKIP IF XMAT TABLE ENTRY IS NOT -1 M0200881 STA+ XMAT,I MARK THIS PAGE AVAILABLE. M0200882MAT340 SQZ MAT350 SKIP IF XMAT UPDATE IS COMPLETE. M0200883ÐÐ RAO- I M0200884 JMP* MAT330 CHECK NEXT ENTRY IN XMAT TABLE. M0200885 EJT 0 M0200886*********************************************************************** M0200887* * M0200888* UPDATE MEMORY ALLOCATION TABLE * M0200889* FOR THE REMOTE BANK. * M0200890* * M0200891*********************************************************************** M0200892 SPC 2 M0200893MAT350 LRI- ZERO I = 0 M0200894 LDQ* MAT902 Q = NUMBER OF 2K PAGES IN REMOTE BANK. M0200895MAT360 ADQ+ XMATR,I M0200896 SQM MAT380 SKIP IF XMATR UPDATE COMPLETE. M0200897 LDA+ XMATR,I M0200898 INA 1 M0200899 SAN MAT370 SKIP IF XMATR ENTRY IS NOT -1. M0200900 STA+ XMATR,I MARK THIS PAGE AVAILABLE. M0200901MAT370 SQZ MAT380 SKIP IF XMATR UPDATE COMPLETE. M0200902 RAO- I M0200903 JMP* MAT360 CHECK NEXT ENTRY IN XMATR TABLE. M0200904 EJT 0 M0200905*********************************************************************** M0200906* * M0200907* MEMORY ALLOCATION TABLE UPDATE SUCCESSFUL. PRINT * M0200908ÐÐ* MEMORY CONFIGURATION MESSAGES. * M0200909* * M0200910*********************************************************************** M0200911 SPC 2 M0200912MAT380 LDA* MAT901 A = NUMBER OF 2K PAGES IN LOCAL BANK. M0200913 ALS 2 M0200914 LDQ MES801 M0200915 RTJ BINDEC CONVERT LOCAL BANK MEMORY SIZE TO ASCII. M0200916 ENQ 1 M0200917 RTJ MESAGE WRITE LOCAL BANK MEMORY SIZE ON CONSOLE. M0200918 LDA* MAT902 A = NUMBER OF 2K PAGES IN REMOTE BANK. M0200919 ALS 2 M0200920 LDQ MES802 M0200921 RTJ BINDEC CONVERT REMOTE BANK MEMORY SIZE TO ASCII. M0200922 ENQ 2 M0200923 RTJ MESAGE WRITE REMOTE BANK MEMORY SIZE TO CONSOLE. M0200924 JMP CONFIG GO CONFIGURE MAG TAPES AND LINE PRINTERS. M0200925 SPC 2 M0200926 EJT 0 M0200927MAT800 ENQ 5 PAGE REGISTER ERROR. M0200928 RTJ MESAGE M0200929 RTJ* (MAT905) HANG. M0200930 SPC 2 M0200931MAT810 ENQ 6 NONCONTIGUOUS MEMORY IN THE LOCAL BANK. M0200932 RTJ MESAGE M0200933ÐÐ RTJ* (MAT905) HANG. M0200934 SPC 2 M0200935MAT820 ENQ 7 NONCONTIGUOUS MEMORY IN THE REMOTE BANK. M0200936 RTJ MESAGE M0200937 RTJ* (MAT905) HANG. M0200938 SPC 2 M0200939MAT830 ENQ 3 INSUFFICIENT MEMORY IN LOCAL BANK. M0200940 RTJ MESAGE M0200941 LDA* MAT901 A = NUMBER OF 2K PAGES IN LOCAL BANK. M0200942 ALS 2 M0200943 LDQ MES808 M0200944 RTJ* BINDEC M0200945 ENQ 8 M0200946 RTJ MESAGE M0200947 LDA* MAT903 A = NUMBER OF PAGES REQUIRED IN LOCAL BANK. M0200948 ALS 2 M0200949 LDQ MES809 M0200950 RTJ* BINDEC M0200951 ENQ 9 M0200952 RTJ MESAGE M0200953 RTJ* (MAT905) HANG. M0200954 SPC 2 M0200955MAT840 ENQ 4 INSUFFICIENT MEMORY IN THE REMOTE BANK. M0200956 RTJ MESAGE M0200957 LDA* MAT902 A = NUMBER OF 2K PAGES IN THE REMOTE BANK. M0200958ÐÐ ALS 2 M0200959 LDQ MES808 M0200960 RTJ* BINDEC M0200961 ENQ 8 M0200962 RTJ* MESAGE M0200963 LDA* MAT904 A = NUMBER OF 2K PAGES REQUIRED IN REM BANK. M0200964 ALS 2 M0200965 LDQ MES809 M0200966 RTJ* BINDEC M0200967 ENQ 9 M0200968 RTJ* MESAGE M0200969 RTJ* (MAT905) HANG. M0200970MAT900 BZS MAT900(32) 8K BLOCK EXISTANCE TABLE. M0200971MAT901 NUM $FFFF NUMBER OF 2K PAGES IN THE LOCAL BANK. M0200972MAT902 NUM $FFFF NUMBER OF 2K PAGES IN THE REMOTE BANK. M0200973MAT903 NUM 48 MINIMUM NUMBER OF 2K PAGES IN THE LOCAL BANK. M0200974MAT904 NUM 24 MINIMUM NUMBER OF 2K PAGES IN REMOTE BANK. M0200975MAT905 ADC SYFAIL ADDRESS OF THE SYSTEM FAILURE ROUTINE. M0200976 EJT 0 M0200977************************************************************************M0200978* *M0200979* THIS ROUTINE DETERMINES IF A PARTICULAR 8K BLOCK OF MEMORY *M0200980* EXISTS IN THE MACHINE. A CYBER 18-30 HAS A MAXIMUM OF 32 8K *M0200981* BLOCKS OF MEMORY = 256K WORDS IN THE MAXIMUM CONFIGURATION. *M0200982* THE BLOCKS ARE NUMBERED 0 - 31. *M0200983ÐÐ* *M0200984* ENTRY *M0200985* Q = BLOCK NUMBER *M0200986* RTJ SIZE *M0200987* *M0200988* EXIT *M0200989* A = -1 IF BLOCK DOES NOT EXIST. *M0200990* A = 4 IF BLOCK DOES EXIST. (4 2K PAGES PER 8K BLOCK) *M0200991* A = 0 IF A PAGE REGISTER ERROR HAS BEEN DETECTED. *M0200992* *M0200993************************************************************************M0200994 SPC 2 M0200995SIZE 0 M0200996 STQ* SIZ900 SAVE THE 8K BLOCK NUMBER M0200997 TRQ A TRANSLATE 8K BLOCK M0200998 ALS 2 NUMBER TO 2K PAGE NUMBER. M0200999 INA 3 M0201000 STA* SIZ901 SAVE THE 2K PAGE NUMBER. M0201001 LDQ* SIZ902 PAGE REGISTER NUMBER TO Q15-Q11. M0201002 RPR Q READ OLD PAGE REGISTER VALUE. M0201003 AND- LPMSK+9 M0201004 STA* SIZ906 SAVE OLD PAGE REGISTER VALUE. M0201005 LDA* SIZ901 A = NEW PAGE REGISTER VALUE. M0201006 AAQ Q PAGE REGISTER VALUE TO Q08-Q00. M0201007 WPR Q WRITE INTO THE PAGE REGISTER. M0201008ÐÐ LDQ* SIZ902 M0201009 RPR Q READ PAGE REGISTER VALUE BACK FROM PAGE REG. M0201010 AND- LPMSK+9 M0201011 STA* SIZ903 M0201012 CAE* SIZ901 SKIP IF REQ VALUE = ACTUAL VALUE. M0201013 JMP* SIZ800 PAGE REGISTER ERROR. M0201014 SPC 2 M0201015* PAGE REGISTER IS WORKING OK. M0201016 PM0 0 SET PAGE MODE 0 M0201017 LR1* (SIZ904) SAVE CONTENT OF LOCATION TO BE TESTED. M0201018 LR2* (SIZ905) SAVE CONTENT OF LOCATION TO BE TESTED. M0201019 LDQ* SIZ901 Q = PAGE NUMBER (USED AS A PATTERN) M0201020 STQ* (SIZ904) STORE THE PATTERN. M0201021 SET A M0201022 STA* (SIZ905) PUT $FFFF ON THE DATA BUS. M0201023 LDA* (SIZ905) M0201024 LDA* (SIZ904) READ THE PATTERN FROM MEMORY TO A REGISTER. M0201025 SR1* (SIZ904) RESTORE THE TESTED LOCATION. M0201026 SR2* (SIZ905) RESTORE THE TESTED LOCATION. M0201027 EAQ A M0201028 APM RESTORE ABSOLUTE PAGE MODE. M0201029 SPE 0 CLEAR PARITY ERROR INDICATOR WHICH MIGHT M0201030* GET SET WHEN WRITTING INTO NON-EXISTANT MEM. M0201031 LDQ* SIZ902 M0201032 ADQ* SIZ906 M0201033ÐÐ WPR Q RESTORE OLD PAGE REGISTER VALUE. M0201034 SAZ SIZ100 SKIP IF THE 8K BLOCK OF MEMORY EXISTS. M0201035 ENA -1 THE MEMORY DOES NOT EXIST. M0201036 JMP* SIZ850 M0201037SIZ100 ENA 4 THE MEMORY EXISTS. M0201038 JMP* SIZ850 M0201039SIZ800 ENA 0 A PAGE REGISTER ERROR HAS OCCURRED. M0201040SIZ850 LDQ* SIZ900 RESTORE Q. M0201041 JMP* (SIZE) RETURN. M0201042 SPC 2 M0201043SIZ900 NUM 0 REQUESTED 8K BLOCK NUMBER. M0201044SIZ901 NUM 0 2K PAGE NUMBER CORRESPONDING TO REQUESTED M0201045* 8K BLOCK NUMBER. M0201046SIZ902 NUM $8000 PAGE REGISTER 16 USED TO TEST MEMORY. M0201047SIZ903 NUM 0 VALUE READ BACK FROM PAGE REGISTER. SHOULD M0201048* EQUAL (SIZ901). M0201049SIZ904 NUM $87FF LAST ADDRESS OF PAGE USED TO TEST REQUESTED M0201050* 8K BLOCK OF MEMORY. M0201051SIZ905 NUM $87FE AN ADDRESS IN THE TEST PAGE. M0201052SIZ906 NUM 0 INITIAL PAGE REGISTER VALUE. M0201053 EJT 0 M0201054*********************************************************************** M0201055* * M0201056* THIS ROUTINE CONVERTS A BINARY NUMBER INTO A DECIMAL * M0201057* NUMBER IN ASCII FORMAT. * M0201058ÐÐ* IT WILL CONVERT FOUR DIGITS. * M0201059* ENTRY: * M0201060* A = BINARY VALUE TO BE CONVERTED. * M0201061* Q = ADDRESS OF OUTPUT BUFFER. * M0201062* * M0201063* EXIT: * M0201064* THE FOUR CONVERTED DIGITS ARE STORED INTO * M0201065* THE FIRST FOUR CHARACTERS OF THE OUTPUT BUFFER. * M0201066* * M0201067*********************************************************************** M0201068 SPC 2 M0201069BINDEC 0 0 M0201070 STA* BIN101 SAVE VALUE TO BE CONVERTED. M0201071 STQ* BIN100 SAVE BUFFER BASE ADDRESS. M0201072 ENA 3 M0201073 XFA 1 SET UP TO CONVERT 4 DIGITS. M0201074BIN010 LDA* BIN101 A = VALUE TO BE CONVERTED. M0201075 CLR Q M0201076 DVI* BIN102 DIVIDE BY 10. M0201077 STA* BIN101 M0201078 TRQ A M0201079 ADD* BIN103 ADD $30 TO MAKE AN ASCII DIGIT. M0201080 SCA* (BIN100),1 STORE CHARACTER INTO OUTPUT BUFFER. M0201081 D1P *-BIN010 CONVERT NEXT CHARACTER. M0201082 JMP* (BINDEC) RETURN. M0201083ÐÐ SPC 5 M0201084BIN100 NUM 0 OUTPUT BUFFER ADDRESS. M0201085BIN101 NUM 0 VALUE TO BE CONVERTED. M0201086BIN102 NUM 10 M0201087BIN103 NUM $30 M0201088 EJT 0 M0201089*********************************************************************** M0201090* * M0201091* THIS ROUTINE IS USED TO WRITE MESSAGES ON THE * M0201092* SYSTEM CONSOLE CRT. IT HANGS ON THE I/O THREAD * M0201093* UNTIL THE OUTPUT IS COMPLETE. * M0201094* * M0201095* ENTRY: * M0201096* Q = MESSAGE NUMBER. * M0201097* RTJ MESAGE * M0201098* * M0201099* EXIT: * M0201100* RETURNS TO USER AFTER THE OUTPUT IS COMPLETE. * M0201101* * M0201102*********************************************************************** M0201103 SPC 2 M0201104MESAGE 0 0 M0201105 LDA* MES800,Q M0201106 STA* MES020 SET UP THE ADDRESS OF THE OUTPUT BUFFER. M0201107 LDA* MES700,Q M0201108ÐÐ STA* MES014 SET UP THE OUTPUT MESSAGE LENGTH. M0201109 SPC 2 M0201110 RTJ- (AMONI) M0201111 NUM $4C00 REQUEST = FORMAT WRITE. M0201112 NUM 0 COMPLETION. M0201113MES010 NUM 0 THREAD M0201114 NUM $18FC LOGICAL UNIT. M0201115MES014 NUM 0 OUTPUT MESSAGE LENGTH (PLUGGED). M0201116MES020 NUM 0 BUFFER ADDRESS (PLUGGED). M0201117MES025 LDA* MES010 M0201118 SAZ MES030 WAIT FOR THE THREAD TO CLEAR. M0201119 JMP* MES025 M0201120MES030 JMP* (MESAGE) M0201121 EJT 0 M0201122MES700 NUM 0 MESSAGE LENGTH TABLE. M0201123 ADC MES902-MES901 M0201124 ADC MES903-MES902 M0201125 ADC MES904-MES903 M0201126 ADC MES905-MES904 M0201127 ADC MES906-MES905 M0201128 ADC MES907-MES906 M0201129 ADC MES908-MES907 M0201130 ADC MES909-MES908 M0201131 ADC MES910-MES909 M0201132 ADC MES911-MES910 M0201133ÐÐ ADC MES912-MES911 M0201134 SPC 4 M0201135MES800 NUM 0 MESSAGE ADDRESS TABLE. M0201136MES801 ADC MES901 M0201137MES802 ADC MES902 M0201138MES803 ADC MES903 M0201139MES804 ADC MES904 M0201140MES805 ADC MES905 M0201141MES806 ADC MES906 M0201142MES807 ADC MES907 M0201143MES808 ADC MES908 M0201144MES809 ADC MES909 M0201145MES810 ADC MES910 M0201146MES811 ADC MES911 M0201147 SPC 4 M0201148MES901 ALF *,XXXXK BYTES OF MEMORY - CPU I.* M0201149MES902 ALF *,XXXXK BYTES OF MEMORY - CPU II.* M0201150MES903 ALF *,INSUFFICIENT MEMORY - CPU I.* M0201151MES904 ALF *,INSUFFICIENT MEMORY - CPU II.* M0201152MES905 ALF *,PAGE REGISTER ERROR.* M0201153MES906 ALF *,NONCONTIGUOUS MEMORY - CPU I.* M0201154MES907 ALF *,NONCONTIGUOUS MEMORY - CPU II.* M0201155MES908 ALF *,XXXXK BYTES EXIST.* M0201156MES909 ALF *,XXXXK BYTES ARE REQUIRED.* M0201157MES910 ALF *,SYSTEM CONFIGURED FOR USE OF 1860-5 DUAL MODE MAG TAPES* M0201158ÐÐ ALF *, (50 IPS DRIVES)* M0201159MES911 ALF *,SYSTEM CONFIGURED FOR USE OF 1860-4 NRZI MAG TAPES* M0201160 ALF *, (25 IPS DRIVES)* M0201161MES912 EQU MES912(*) M0201162 EJT 0 M0201163*********************************************************************** M0201164* * M0201165* THIS CODE CONFIGURES THE SYSTEM FOR EITHER 1860-5 * M0201166* DUAL MODE 50 IPS TAPES OR 1860-4 NRZI TAPES. * M0201167* IF THE 1860-5 CONTROLLER RESPONDS TO A STATUS FUNCTION * M0201168* THE SYSTEM WILL BE CONFIGURED FOR 1860-5 TAPES. IF AN * M0201169* INTERNAL REJECT OCCURS WHEN STATUS IS TAKEN, THE * M0201170* SYSTEM WILL BE CONFIGURED FOR 1860-4 TAPES. A MESSAGE * M0201171* WILL BE WRITTEN ON THE CONSOLE ADVISING THE OPERATOR * M0201172* WHICH TAPES HAVE BEEN CONFIGURED INTO THE SYSTEM. * M0201173* * M0201174*********************************************************************** M0201175 SPC 2 M0201176 EXT MT25U0 LOG1A LOCATION CONTAINING 1860-4 PHYSTAB ADD. M0201177 EXT MT25U1 LOG1A LOCATION CONTAINING 1860-4 PHYSTAB ADD. M0201178 EXT MT50U0 LOG1A LOCATION CONTAINING 1860-5 PHYSTAB ADD. M0201179 EXT MT50U1 LOG1A LOCATION CONTAINING 1860-5 PHYSTAB ADD. M0201180 SPC 2 M0201181CONFIG LDQ MT50U0 Q = PHYSTAB ADDRESS OF 1860-5, UNIT 0. M0201182 LDQ- 7,Q Q = EQUIPMENT CODE OF 1860-5 MAG TAPE. M0201183ÐÐ INQ $F M0201184 INP CON100-* READ STATUS TO SEE IF THE DEVICE EXISTS. M0201185* NO REJECT, ASSUME IT DOES EXIST. M0201186CON050 ENQ 10 M0201187 RTJ MESAGE WRITE 1860-5 CONFIGURATION MESSAGE. M0201188 JMP* CON900 CONTINUE PROCESSING. M0201189 SPC 2 M0201190CON100 JMP* CON110 INTERNAL REJECT, ASSUME 1860-4 MAG TAPES. M0201191 JMP* CON050 EXTERNAL REJECT, ASSUME 1860-5 MAG TAPES. M0201192CON110 ENQ 11 M0201193 RTJ MESAGE WRITE 1860-4 CONFIGURATION MESSAGE. M0201194 LDA MT25U0 SWAP THE PHYSTAB ADDRESSES IN LOG1A. M0201195 LDQ MT50U0 M0201196 STA MT50U0 M0201197 STQ MT25U0 M0201198 LDA MT25U1 M0201199 LDQ MT50U1 M0201200 STQ MT25U1 M0201201 STA MT50U1 M0201202 ENQ 11 M0201203 STA LOG1A,Q M0201204CON900 NOP 0 CONTINUE WITH NORMAL RESTART PROCESSING. M0201205 JMP* A101M M0201206 EJT M0201207* DETERMINE THE POSITION OF THE PROGRAM PROTECT SWITCH M0201208ÐÐ SPC 2 M0201209A101M IIN 0 **MSOS 4.1**M0201210A101 LDA+ $101 SAVE THE CONTENTS OF THE TRAP 50*919 M0201211 STA* S101+1 50*919 M0201212A102 LDA+ $102 50*919 M0201213 STA* S102+1 50*919 M0201214 TRM A SAVE THE CONTENTS OF 'M' 50*919 M0201215 STA* SM+1 50*919 M0201216 LDA =N$1400 SET UP RETURN 50*919 M0201217 STA* (A101+1) 50*919 M0201218 LDQ =XFAULT 50*919 M0201219 CPB 0 50*919 M0201220 ENA 1 50*919 M0201221 TRA M ALLOW ONLY A PP FAULT 50*919 M0201222 INQ 6 **MSOS 4.1**M0201223 STQ* (A102+1) 50*919 M0201224 EIN 0 51*919 M0201225FAULT STQ* (A102+1) 50*919 M0201226 LDA* PPFLAG IS THIS FIRST PASS **MSOS 4.1**M0201227 SAZ HANGIT NO, HANG WAITING FOR PP SET **MSOS 4.1**M0201228 RAO* FLAGIT SET FLAG FOR SET PP MESSAGE **MSOS 4.1**M0201229 JMP* GOPP GO TO RESTORE PROTECT SETUP **MSOS 4.1**M0201230 SPC 3 M0201231PPFLAG NUM 1 M0201232FLAGIT NUM 0 M0201233ÐÐ SPC 3 M0201234HANGIT JMP* FAULT WAIT FOR PP FAULT **MSOS 4.1**M0201235GOPP SPF 0 CLEAR PROTECT FAULT **MSOS 4.1**M0201236 INQ -6 **MSOS 4.1**M0201237 SPB 0 RETURN TO PRIOR STATUS 50*919 M0201238 EJT M0201239S101 LDA =N0 50*919 M0201240 STA* (A101+1) 50*919 M0201241S102 LDA =N0 50*919 M0201242 STA* (A102+1) 50*919 M0201243SM LDA =N0 50*919 M0201244 TRA M 50*919 M0201245 EIN 0 50*919 M0201246 LDA* PPFLAG IS THIS FIRST TIME THROUGH **MSOS 4.1**M0201247 SAZ MOUNT SKIP IS SECOND PASS M0201248 LDA* FLAGIT IS THIS FIRST TIME BUT NEED MSG **MSOS 4.1**M0201249 SAZ MOUNT SKIP IF NO MESSAGE NEEDED M0201250 CLR A NEED TO SET PP **MSOS 4.1**M0201251 STA* PPFLAG SECOND TIME FLAG **MSOS 4.1**M0201252 SPC 1 M0201253 RTJ- (AMONI) WRITE PP MESSAGE **MSOS 4.1**M0201254 ADC $0C01 **MSOS 4.1**M0201255 ADC 0 **MSOS 4.1**M0201256PPTH ADC 0 **MSOS 4.1**M0201257 ADC $18FC **MSOS 4.1**M0201258ÐÐ ADC PPLEN M0201259 ADC PP **MSOS 4.1**M0201260 SPC 1 M0201261PPWAIT LDA* PPTH **MSOS 4.1**M0201262 SAZ OUTPP **MSOS 4.1**M0201263 JMP* PPWAIT WAIT FOR COMPLETION **MSOS 4.1**M0201264OUTPP JMP* A101M GO WAIT FOR PP SET **MSOS 4.1**M0201265 EJT M0201266* MOUNT THE SYSTEM VOLUME M0201267 SPC 3 M0201268MOUNT ENQ 1 M0201269 LDQ* (AMMLUT),Q PICK UP ADDRESS OF VIT00 M0201270 STQ* AVIT00 SAVE FOR LATER M0201271 LDA* (AVIT00) PICK UP SYSTEM LU FROM VIT M0201272 AND- ZROBIT+15 DROP 'NOT MOUNTED' FLAG M0201273 STA* (AVIT00) STORE BACK M0201274 STA* MASLU SAVE IN READ REQUEST M0201275 RTJ- (AMONI) READ IN THE VOLUME LABEL M0201276 ADC $4800 FREAD M0201277 ADC 0 M0201278TL ADC 0 M0201279MASLU ADC 0 M0201280 ADC LABLEN M0201281 ADC LABEL M0201282 ADC 0 M0201283ÐÐ ADC 0 M0201284MNT1 LDA* TL PICK UP THREAD M0201285 SAZ MNT2 SKIP IF REQUEST COMPLETED M0201286 JMP* MNT1 WAIT FOR COMPLETION M0201287 SPC 2 M0201288* MOVE VOLUME NAME AND NUMBER TO VIT M0201289 SPC 1 M0201290MNT2 LDA* ALABEL PICK UP ADDRESS OF LABEL M0201291 INA VLNAME COMPUTE ADDRESS OF VOLUME NAME IN LABEL M0201292 STA* LPTR SAVE AS POINTER TO LABEL M0201293 LDA* AVIT00 PICK UP ADDRESS OF VIT00 M0201294 INA VINAME COMPUTE ADDRESS OF VOLUME NAME IN VIT M0201295 STA* VPTR STORE AS POINTER TO VIT M0201296 ENQ 4 M0201297MNT3 LDA* (LPTR),Q PICK UP WORD FROM LABEL M0201298 STA* (VPTR),Q STORE IN VIT M0201299 INQ -1 DECREMENT COUNT M0201300 SQM MNT4 SKIP IF DONE M0201301 JMP* MNT3 GO BACK AND MOVE NEXT M0201302 EJT M0201303* MOVE REST OF INFO FROM LABEL TO VIT M0201304 SPC 1 M0201305MNT4 LDA* ALABEL PICK UP ADDRESS OF LABEL M0201306 INA VLBMSM COMPUTE ADDRESS OF NEXT BLOCK TO BE MOVED M0201307 STA* LPTR SAVE AS POINTER TO LABEL M0201308ÐÐ LDA* AVIT00 PICK UP ADDRESS OF VIT00 M0201309 INA VIBMSM COMPUTE ADDRESS IN VIT M0201310 STA* VPTR SAVE AS POINTER TO VIT M0201311 ENQ 13 M0201312MNT5 LDA* (LPTR),Q PICK UP WORD FROM LABEL M0201313 STA* (VPTR),Q STORE INTO VIT M0201314 INQ -1 DECREMENT COUNTER M0201315 SQP MNT6 SKIP IF NOT DONE M0201316 JMP* OUTID M0201317MNT6 JMP* MNT5 GO BACK AND MOVE ANOTHER WORD M0201318 SPC 3 M0201319AMMLUT ADC MMLUTB ADDRESS OF MASS MEMORY LU TABLE M0201320AVIT00 ADC 0 ADDRESS OF VIT00 M0201321ALABEL ADC LABEL ADDRESS OF LABEL BUFFER M0201322LPTR NUM 0 POINTER TO LABEL M0201323VPTR NUM 0 POINTER TO VIT M0201324LABEL BSS LABEL(LABLEN) BUFFER FOR VOLUME LABEL M0201325 EJT **MSOS 4.1**M0201326* PRINT THE SYSTEM IDENTIFICATION **MSOS 4.1**M0201327 SPC 2 **MSOS 4.1**M0201328OUTID LDA =XSYSID **MSOS 4.1**M0201329 EOR- LPMSK+15 IS THE IDENTIFICATION PATCHED **MSOS 4.1**M0201330 SAN ID1 **MSOS 4.1**M0201331 JMP* MODE NO, DONT PRINT IT **MSOS 4.1**M0201332ID1 LDA+ SYSID **MSOS 4.1**M0201333ÐÐ STA* SAVID **MSOS 4.1**M0201334 AND- LPMSK+7 **MSOS 4.1**M0201335 EOR =N$0D00 ADD AN EXTRA CARRIAGE RETURN **MSOS 4.1**M0201336 STA+ SYSID **MSOS 4.1**M0201337 SPC 1 **MSOS 4.1**M0201338 ENQ 15 FIND THE END OF THE TRAILING **MSOS 4.1**M0201339ID2 LDA+ SYSID,Q BLANKS IN THE IDENTIFICATION **MSOS 4.1**M0201340 SUB =A **MSOS 4.1**M0201341 SAN ID3 FOUND THE END **MSOS 4.1**M0201342 DQP *-ID2 GO BACK IF NOT ALL BLANK M0201343 JMP* ID4 ALL BLANK, DON'T PRINT M0201344ID3 INQ 1 **MSOS 4.1**M0201345 STQ* IDL FORM THE MESSAGE LENGTH **MSOS 4.1**M0201346 SPC 1 **MSOS 4.1**M0201347 RTJ- (AMONI) PRINT THE IDENTIFICATION **MSOS 4.1**M0201348 ADC $0C01 **MSOS 4.1**M0201349 ADC 0 **MSOS 4.1**M0201350 ADC 0 M0201351 ADC $18FC **MSOS 4.1**M0201352IDL ADC 0 **MSOS 4.1**M0201353 ADC SYSID **MSOS 4.1**M0201354 RTJ- (AMONI) PRINT CR/LF,NULL M0201355 ADC $0C01 M0201356 ADC 0 M0201357IDTH ADC 0 M0201358ÐÐ ADC $18FC M0201359 ADC 1 M0201360 ADC ZERO M0201361 SPC 1 **MSOS 4.1**M0201362IDWAIT LDA* IDTH **MSOS 4.1**M0201363 SAZ ID4 **MSOS 4.1**M0201364 JMP* IDWAIT WAIT FOR COMPLETION **MSOS 4.1**M0201365 SPC 1 M0201366ID4 LDA* SAVID **MSOS 4.1**M0201367 STA+ SYSID RESTORE LEADING BLANK IN THE ID **MSOS 4.1**M0201368 EJT M0201369* DETERMINE THE CORE SIZE MODE, AND PRINT IT M0201370 SPC 2 M0201371MODE LDA* (I1) CHECK MULTI-LEVEL INDIRECT **MSOS 4.1**M0201372 EOR* I3 FOR MODE **MSOS 4.1**M0201373 SAZ M32K **MSOS 4.1**M0201374 ENQ 1 **MSOS 4.1**M0201375 STQ- ($E9) SET MODE FLAG **MSOS 4.1**M0201376 JMP* T0 M0201377 SPC 2 M0201378M32K RTJ- (AMONI) WRITE MODE ERROR MESSAGE M0201379 ADC $0C01 **MSOS 4.1**M0201380 ADC 0 **MSOS 4.1**M0201381MODETH ADC 0 **MSOS 4.1**M0201382 ADC $18FC **MSOS 4.1**M0201383ÐÐ ADC LMDERR M0201384 ADC MODERR M0201385 SPC 1 M0201386MODWAT LDA* MODETH **MSOS 4.1**M0201387 SAZ QUIT KILL SYSTEM WHEN DONE M0201388 JMP* MODWAT WAIT FOR COMPLETION **MSOS 4.1**M0201389QUIT RTJ SYFAIL KILL THE SYSTEM M0201390 SPC 2 M0201391T0 IIN 0 INHIBIT INTERRUPTS WHILE SETTING PRIORITIES M0201392T1 LDQ* ATC LOAD Q WITH COUNT VALUE 83*2390M0201393 LDQ* T,Q GET ADDRESS FROM TABLE 83*2390M0201394 TRQ A DO NOT SET PRIORITY IF 83*2390M0201395 EOR- LPMSK+15 EXTERNAL IS UNPATCHED 83*2390M0201396 SAZ T1B 83*2390M0201397 LDA- (ZERO),Q IF VALUE OF ADDRESS IS ZERO 83*2390M0201398 SAZ T1AA TABLE IS COMPLETED 83*2390M0201399 LDA PCORE GET CORE DRIVER COMPLETION PRIORITY 83*2390M0201400 AND- LPMSK+4 83*2390M0201401 EOR- (ZERO),Q AND 83*2390M0201402 STA- (ZERO),Q STORE BACK INTO REQUEST 83*2390M0201403T1B RAO* ATC CONTINUE SETTING PRIORITIES 83*2390M0201404 JMP* T1 83*2390M0201405T1AA EIN 0 83*2390M0201406 ENA 0 **MSOS 4.1**M0201407 STA MIBX CLEAR MIPRO AND M0201408ÐÐ STA EFLOCK LOGGER LOCKOUT FLAGS **MSOS 4.1**M0201409 JMP TOIDLE GO TO IDLE EXIT **MSOS 4.1**M0201410 SPC 2 M0201411 SPC 1 M0201412I1 ADC (I2) **MSOS 4.1**M0201413I2 ADC I3 **MSOS 4.1**M0201414I3 NUM $7F9C **MSOS 4.1**M0201415SAVID NUM 0 **MSOS 4.1**M0201416 SPC 2 83*2390M0201417ATC NUM 0 INDEX FOR TABLE 83*2390M0201418T ADC OUTPUT 83*2390M0201419 ADC SPACE4 83*2390M0201420 ADC NOG30A 83*2390M0201421 ADC REL 83*2390M0201422 ADC SCH 83*2390M0201423 ADC PTNALC 83*2390M0201424 ADC PTNREL 83*2390M0201425 ADC SPCEV4 83*2390M0201426 ADC RDPTV4 83*2390M0201427 ADC OUTPV4 83*2390M0201428 ADC ZERO THIS IS USED TO INDICATE THE END 83*2390M0201429 EJT M0201430SUMLVL NUM $0D0A M0201431 ALF $,CCS 3.0 -- PSR LEVEL$ M0201432 NUM $2031 FOR PSR SUMMARIES OVER 100 100*3663M0201433ÐÐ ADC SYSLVL SYSLVL ISC2 LEAST SIGNIFICANT DIGITS 100*3663M0201434DATE ALF 6, **MSOS 4.1**M0201435 NUM $200D M0201436 EQU LSUMLV(*-SUMLVL) **MSOS 4.1**M0201437 SPC 1 M0201438PP NUM $200D M0201439 ALF *,SET PROGRAM PROTECT (ESC J28@)* M0201440 NUM $200D **MSOS 4.1**M0201441PPLEN EQU PPLEN(*-PP) M0201442MODERR ALF 1,:R:L M0201443 ALF *,ERROR - MULTI LEVEL INDIRECT ADDRESSING SELECTED* M0201444LMDERR EQU LMDERR(*-MODERR) M0201445MONTH ADC SYSMON **MSOS 4.1**M0201446DAY ADC SYSDAY **MSOS 4.1**M0201447YEAR ADC SYSYER **MSOS 4.1**M0201448 EJT M0201449* ALLOCATION LENGTHS M0201450* M0201451* AREAS 1, 2, AND 3 ARE SETUP BY *S CONTROL CARDS IN **MSOS 4.1**M0201452* SYSTEM INSTALLATION FILE. AREAS 4-15 ARE SETUP BY **MSOS 4.1**M0201453* EQUATES IN SYSDAT **MSOS 4.1**M0201454 SPC 2 M0201455ALCLGH ADC N1 ALLOCATION LENGTH FOR AREA 1 M0201456 ADC N2 ALLOCATION LENGTH FOR AREA 2 M0201457 ADC PSIZV4 ALLOCATION LENGTH FOR AREA 3 **MSOS 4.1**M0201458ÐÐ ADC N4 ALLOCATION LENGTH FOR AREA 4 M0201459 ADC N5 ALLOCATION LENGTH FOR AREA 5 M0201460 ADC N6 ALLOCATION LENGTH FOR AREA 6 M0201461 ADC N7 ALLOCATION LENGTH FOR AREA 7 M0201462 ADC N8 ALLOCATION LENGTH FOR AREA 8 M0201463 ADC N9 ALLOCATION LENGTH FOR AREA 9 M0201464 ADC N10 ALLOCATION LENGTH FOR AREA 10 M0201465 ADC N11 ALLOCATION LENGTH FOR AREA 11 M0201466 ADC N12 ALLOCATION LENGTH FOR AREA 12 M0201467 ADC N13 ALLOCATION LENGTH FOR AREA 13 M0201468 ADC N14 ALLOCATION LENGTH FOR AREA 14 M0201469 ADC N15 ALLOCATION LENGTH FOR AREA 15 M0201470 SPC 4 M0201471 JMP RESTRT MUST ALWAYS BE 2 WORD INSTRUCTION **MSOS4.0*M0201472* AUTOLOAD PROGRAM MOVED TO HERE M0201473* *M0201474STMSV4 JMP RESTRT FIRST WORD OF AUTOLOAD PROGRAM **MSOS4.0*M0201475 SPC 4 M0201476 BSS (2) RESERVE TWO WORD FOR THE ALLOCATABLE M0201477* CORE THREAD M0201478 END M0201479 NAM MIPRO M03 A ITOS CCS 3.0 SL-149M0300001* MANUAL INTERRUPT RESPONSE HANDLER FOR INPUTS OTHER THAN * M0300002* CREDIT COLLECTION SYSTEM VERSION 3.0 M0300003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA M0300004ÐÐ* COPYRIGHT CONTROL DATA CORPORATION 1979 M0300005* M0300006 SPC 5 M0300007* THE PROGRAM BASICALLY INVOLVES ENTRY FROM MINT (IN **MSOS 4.1**M0300008* MONITOR) WHEN THE FIRST CHARACTER INPUT AFTER A MANUAL **MSOS 4.1**M0300009* INTERRUPT IS NOT AN *. IF THE INPUT CHARACTER STRING **MSOS 4.1**M0300010* IS MATCHED IN TABLE -FUNCTN-, THE REQUESTED ACTION IS **MSOS 4.1**M0300011* TAKEN. IF THE ACTION INVOLVES STARTING OR STOPPING A **MSOS 4.1**M0300012* TIMER AND A REJECT IS FOUND, THE MESSAGE -TIMER REJECT-**MSOS 4.1**M0300013* UNLINKED, OR THE INPUT IS OTHERWISE IN ERROR, THE **MSOS 4.1**M0300014* MESSAGE, -MI INPUT ERROR IS PRINTED. THE FOLLOWING **MSOS 4.1**M0300015* LIST OF INPUT CODES IS CONSIDERED BASIC TO THE PROGRAM.**MSOS 4.1**M0300016* ADDITIONS TO THIS LIST MAY BE MADE BY USERS AS REQUIRED**MSOS 4.1**M0300017 SPC 2 **MSOS 4.1**M0300018* INPUT FUNCTION **MSOS 4.1**M0300019 SPC 1 **MSOS 4.1**M0300020* =S FOR SCHEDULING SYSTEM LIBRARY ORDINAL WITH **MSOS 4.1**M0300021* THE INPUT FORMAT =SXXX,Y,ZZZZ WHERE XXX IS**MSOS 4.1**M0300022* THE 3-DIGIT DECIMAL ORDINAL NUMBER (NUMBER**MSOS 4.1**M0300023* CORRESPONDS TO DIRECTORY POSITION), Y IS **MSOS 4.1**M0300024* THE HEX PRIORITY FOR EXECUTION, AND ZZZZ **MSOS 4.1**M0300025* IS A HEX PARAMETER PASSED TO THE PROGRAM **MSOS 4.1**M0300026* IN THE Q-REGISTER. **MSOS 4.1**M0300027 SPC 1 **MSOS 4.1**M0300028* EF SCHEDULES ORDINAL EFLIST TO PRINT **MSOS 4.1**M0300029ÐÐ* ENGINEERING FILE DATA FOR ALL LOGICAL **MSOS 4.1**M0300030* UNITS **MSOS 4.1**M0300031 SPC 1 **MSOS 4.1**M0300032* EFMM SCHEDULES ORDINAL EFLIST TO PRINT **MSOS 4.1**M0300033* ENGINEERING FILE DATA FOR MASS MEMORY **MSOS 4.1**M0300034* UNITS **MSOS 4.1**M0300035 SPC 1 **MSOS 4.1**M0300036* EFLU SCHEDULES ORDINAL EFLIST TO PRINT **MSOS 4.1**M0300037* ENGINEERING FILE DATA FOR SPECIFIED **MSOS 4.1**M0300038* LOGICAL UNIT **MSOS 4.1**M0300039 SPC 1 **MSOS 4.1**M0300040* TON STARTS SYSTEM HARDWARE TIME BASE AS DEFINED **MSOS 4.1**M0300041* IN SYSDAT **MSOS 4.1**M0300042 SPC 1 **MSOS 4.1**M0300043* TOFF STOPS SYSTEM HARDWARE TIME BASE AS DEFINED **MSOS 4.1**M0300044* IN SYSDAT **MSOS 4.1**M0300045 SPC 1 **MSOS 4.1**M0300046* SYSCOP SCHEDULES SYSTEM CHECKOUT PACKAGE LOADED **MSOS 4.1**M0300047* UNDER ORDINAL NAME SYSCOP **MSOS 4.1**M0300048 SPC 1 **MSOS 4.1**M0300049* DB STARTS ON-LINE DEBUG PACKAGE, ODEBUG, LOADED**MSOS 4.1**M0300050* UNDER ORDINAL NAME ODEBUG. **MSOS 4.1**M0300051 SPC 1 **MSOS 4.1**M0300052* DX STOPS ON-LINE DEBUG PACKAGE BY CLEARING **MSOS 4.1**M0300053* CHRSFG IN SYSDAT **MSOS 4.1**M0300054ÐÐ SPC 1 **MSOS 4.1**M0300055* DATE ALLOWS THE USER TO ENTER A NEW DATE AND **MSOS 4.1**M0300056* TIME. ROUTINE IS A SUB-FUNCTION OF TDFUNC**MSOS 4.1**M0300057* LOADED UNDER ORDINAL NAME TDFUNC. **MSOS 4.1**M0300058 SPC 1 **MSOS 4.1**M0300059* TIME CAUSES THE CURRENT DATE AND TIME TO BE **MSOS 4.1**M0300060* PRINTED ON THE COMMENT UNIT. ROUTINE IS A**MSOS 4.1**M0300061* SUB-FUNCTION OF TDFUNC LOADED UNDER **MSOS 4.1**M0300062* ORDINAL NAME TDFUNC. **MSOS 4.1**M0300063 SPC 1 M0300064* VERIFY SCHEDULES THE MSOS VERIFICATION PACKAGE LOADED M0300065* UNDER ORDINAL NAME VERIFY. M0300066 SPC 1 **MSOS 4.1**M0300067* INIT INITIALIZES THE ITOS SYSTEM VOLUME FILES M0300068 SPC 1 M0300069* START STARTS THE ITOS SYSTEM M0300070 SPC 1 M0300071* STOP STOPS THE ITOS SYSTEM M0300072 SPC 1 M0300073* PASSWRD DEFINES THE ITOS SYSTEM PASSWORD M0300074 SPC 1 M0300075* WRON,LU ENABLE THE WRITE RING FEATURE ON THE MAG TAPE M0300076* SIMULATOR SPECIFIED BY LU. M0300077 SPC 1 M0300078* WROF,LU DISABLE THE WRITE RING FEATURE ON THE MAG TAPE M0300079ÐÐ* SIMULATOR SPECIFIED BY LU. M0300080 SPC 1 SCAD MODM0300081* JIN,LU CHANGE JOB PROC. INPUT DEVICE M0300082* WHERE: LU IS A 1 OR 2 DIGIT SCAD MODM0300083* DECIMAL NUMBER. SCAD MODM0300084 SPC 1 SCAD MODM0300085* JLT,LU CHANGE JOB PROC. LIST DEVICE SCAD MODM0300086* WHERE: LU IS A 1 OR 2 DIGIT SCAD MODM0300087* DECIMAL NUMBER. SCAD MODM0300088 SPC 1 SCAD MODM0300089* INP,LU CHANGE STANDARD INPUT DEVICE SCAD MODM0300090* WHERE: LU IS A 1 OR 2 DIGIT SCAD MODM0300091* DECIMAL NUMBER. SCAD MODM0300092 SPC 1 SCAD MODM0300093* OUT,LU CHANGE STANDARD OUTPUT DEVICE SCAD MODM0300094* WHERE: LU IS A 1 OR 2 DIGIT SCAD MODM0300095* DECIMAL NUMBER. SCAD MODM0300096 SPC 1 SCAD MODM0300097* LST,LU CHANGE STANDARD LIST DEVICE SCAD MODM0300098* WHERE: LU IS A 1 OR 2 DIGIT SCAD MODM0300099* DECIMAL NUMBER. SCAD MODM0300100 SPC 1 SCAD MODM0300101* CARDNN CHANGE CARD READER MODE (1829-30/60) SCAD MODM0300102* WHERE: NN = 26 FOR 026 MODE SCAD MODM0300103* NN = 29 FOR 029 MODE SCAD MODM0300104ÐÐ SPC 1 SCAD MODM0300105* REW,LU REWIND MAG TAPE LU SCAD MODM0300106* WHERE: LU IS A 1 OR 2 DIGIT SCAD MODM0300107* DECIMAL NUMBER. SCAD MODM0300108 SPC 1 SCAD MODM0300109* RSV,XX,Y RESERVE BUFFER SPACE FOR COMM-18 SCAD MODM0300110* SIMULATORS. SCAD MODM0300111 SPC 1 SCAD MODM0300112* UT2,LU ACTIVATE A UT200 TERMINAL AND ATTACH SCAD MODM0300113* IT TO COMMUNICATIONS CHANNEL 'LU'. SCAD MODM0300114 SPC 1 SCAD MODM0300115* HWS,LU,I,O ACTIVATE A HASP WORKSTATION TERMINAL SCAD MODM0300116* AND ATTACH IT TO COMMUNICATIONS SCAD MODM0300117* CHANNEL 'LU' WITH 'I' INPUT SCAD MODM0300118* STREAMS AND 'O' OUTPUT STREAMS. SCAD MODM0300119 SPC 1 M0300120* SCOM STOP COMM18 SIMULATORS M0300121* M0300122 SPC 1 M0300123* CCSDB INITIATES CCS ON-LINE DEBUG M0300124 SPC 1 M0300125* UP ATTEMPTS TO PUT A DOWN TERMINAL M0300126* BACK INTO SERVICE. M0300127 SPC 1 M0300128* DENSITY SETS DENSITY AND SELECTS MODE (NRZI OR M0300129ÐÐ* PHASE ENCODE) FOR DUAL MODE MAG TAPES. M0300130 SPC 1 M0300131* SMDC ORDINAL TO CONFIGURE SMD PHY. DEV. TBLS. M0300132* FOR 50MB AND 300MB DRIVES, AT 96 OR M0300133* 569 WORDS PER SECTOR. M0300134* M0300135 EJT M0300136* THE TABLE -FUNCTN- CONTAINS A 6-WORD DATA BLOCK FOR EACH **MSOS 4.1**M0300137* PARAMETERIZED INPUT MNEMONIC. THE DATA BLOCK IS **MSOS 4.1**M0300138* DEFINED AS FOLLOWS... **MSOS 4.1**M0300139 SPC 2 **MSOS 4.1**M0300140* WORDS 0-1 A MNEMONIC CODE WHICH MAY CONTAIN **MSOS 4.1**M0300141* 2-4 CHARACTERS. UNUSED CHARACTERS **MSOS 4.1**M0300142* MUST BE SPACES. ANY LEGAL ASCII **MSOS 4.1**M0300143* CODE MAY BE USED BUT A SPACE. **MSOS 4.1**M0300144 SPC 1 **MSOS 4.1**M0300145* WORD 2 THE RELATIVE DISTANCE BETWEEN THE **MSOS 4.1**M0300146* LABEL JMP AND ANY DESIRED FUNCTION**MSOS 4.1**M0300147* PRE-PROCESSOR. IF A DATA STRING **MSOS 4.1**M0300148* FOLLOWS THE MNEMONIC, THE PRE- **MSOS 4.1**M0300149* PROCESSOR MAY BE USED FOR ITS **MSOS 4.1**M0300150* ANALYSIS. IN THIS CASE, THE **MSOS 4.1**M0300151* ADDRESS OF THE INPUT BUFFER IS **MSOS 4.1**M0300152* CONTAINED IN LOCATION, QSAVE. IF **MSOS 4.1**M0300153* NO PRE-PROCESSING IS REQUIRED, **MSOS 4.1**M0300154ÐÐ* CONTROL SHOULD BE PASSED TO LABEL,**MSOS 4.1**M0300155* GETIND. **MSOS 4.1**M0300156 SPC 1 **MSOS 4.1**M0300157* WORD 3 A SCHEDULER CALL (SYSCHD TYPE) FOR THE M0300158* DESIRED PROCESSOR M0300159 SPC 1 **MSOS 4.1**M0300160* WORD 4 AN INDEX TO THE ORDINAL TABLE (ORDTBL) M0300161* SET TO $FFFF IF NO ORDINAL M0300162 SPC 1 M0300163* WORD 5 THE PARAMETER TO BE PASSED TO THE **MSOS 4.1**M0300164* PROCESSOR PROGRAM IN THE Q- **MSOS 4.1**M0300165* REGISTER. **MSOS 4.1**M0300166 SPC 3 **MSOS 4.1**M0300167* EACH ENTRY IN THIS TABLE MUST CONTAIN SIX WORDS EVEN IF **MSOS 4.1**M0300168* LESS ARE USED. A SAMPLE ENTRY FOLLOWS... **MSOS 4.1**M0300169 SPC 1 **MSOS 4.1**M0300170* ALF 2,SAMPLE MNEMONIC NAME **MSOS 4.1**M0300171* ADC PREPRO-JMP INCREMENT FROM PRE-PROCESSOR TO **MSOS 4.1**M0300172* JMP LABEL **MSOS 4.1**M0300173* NUM $240X SYSTEM SCHEDULER CALL AT PRIORITY M0300174* X. **MSOS 4.1**M0300175* NUM X OR $FFFF WHERE X IS THE INDEX TO TABLE ORDTBL M0300176* $FFFF IS USED IF NO ORDINAL REQUIRED M0300177* NUM XXXX PARAMETER TO BE PASSED IN THE Q- **MSOS 4.1**M0300178* REGISTER. **MSOS 4.1**M0300179ÐÐ EJT **MSOS 4.1**M0300180* PROGRAM ENTRY POINTS **MSOS 4.1**M0300181 ENT MIPROC TRANSFER ADDRESS **MSOS 4.1**M0300182 SPC 2 **MSOS 4.1**M0300183* PROGRAM EXTERNAL POINTS **MSOS 4.1**M0300184 EXT LOG1A TABLE OF P.D.T. ADDRESSES **MSOS 4.1**M0300185 EXT MIBX MANUAL INTERRUPT BUSY FLAG **MSOS 4.1**M0300186 EXT CHRSFG ODEBUG ACTIVE FLAG **MSOS 4.1**M0300187 EXT SYSCOP SYSTEM CHECKOUT ORDINAL **MSOS 4.1**M0300188 EXT ODEBUG ON-LINE DEBUG ORDINAL **MSOS 4.1**M0300189 EXT ODBSIZ ON-LINE DEBUG OVERLAY SIZE M0300190 EXT EFLIST ENGINEERING FILE LIST ORDINAL **MSOS 4.1**M0300191 EXT TDFUNC TIME/DATE FUNCTION ORDINAL **MSOS 4.1**M0300192 EXT VERIFY MSOS VERIFICATION ORDINAL M0300193 EXT SYUTIL ITOS SYSTEM UTILITIES M0300194 EXT TMRTYP TIMER TYPE DESIGNATOR **MSOS 4.1**M0300195 EXT TMCODE TIMER TYPE CODE **MSOS 4.1**M0300196 EXT DMICOD CODE TO DEFINE MICRO-INTRPT MP MSOSM0300197 EXT TBLADR ADDRESS OF ADT TABLE FOR CLOCK MP MSOSM0300198 EXT EMPSRT RESET/START FUNCTION CODE MP MSOSM0300199 EXT EMPSTP STOP FUNCTION CODE MP MSOSM0300200 EXT SIMRSV RESERVE BUFFER SPACE FOR COMM-18 SIMS SCAD MODM0300201 EXT U2INIT ACTIVATE A UT200 TERMINAL SCAD MODM0300202 EXT HWINIT ACTIVATE A HASP WORKSTATION TERMINAL SCAD MODM0300203 EXT TSAREA M0300204ÐÐ EXT PARTBL M0300205 EXT TRMLUP RESTORE DOWN TERMINAL. M0300206 EXT TAPSET SELECT MAG TAPE DENSITY AND MODE. M0300207 EXT SAVLAB SAVE SYSVOL VOLUME LABEL. M0300208 EXT RESLAB RESTORE SYSVOL VOLUME LABEL. M0300209 EXT SMDCFG CONFIGURE SMD PHY. DEV. TBL. M0300210 SPC 2 **MSOS 4.1**M0300211* PROGRAM EQUIVALENCES **MSOS 4.1**M0300212 EQU LPMSK($2) RIGHT JUSTIFIED MASKS **MSOS 4.1**M0300213 EQU NZERO($12) LEFT JUSTIFIED MASKS **MSOS 4.1**M0300214 EQU ONEBIT($23) SINGLE BIT MASKS **MSOS 4.1**M0300215 EQU ZERO($22) CELL CONTAINING ZERO **MSOS 4.1**M0300216 EQU FOUR($25) CELL CONTAINING FOUR **MSOS 4.1**M0300217 EQU SIX($44) CELL CONTAINING SIX **MSOS 4.1**M0300218 EQU ADISP($EA) ADDRESS OF DISPATCHER **MSOS 4.1**M0300219 EQU AMONI($F4) ADDRESS OF MONITOR **MSOS 4.1**M0300220 EJT **MSOS 4.1**M0300221MIPRO ENA 0 INITIALIZE INDEX **MSOS 4.1**M0300222 STA- I **MSOS 4.1**M0300223 STA* ISAVE **MSOS 4.1**M0300224 STQ* QSAVE SAVE LOCATION OF INPUT CHAR BUFFER**MSOS 4.1**M0300225 SPC 1 **MSOS 4.1**M0300226REPEAT LDQ* QSAVE **MSOS 4.1**M0300227 LDA- (ZERO),Q PICKUP FIRST 2 CHAR INPUT **MSOS 4.1**M0300228 SUB* FUNCTN,I DO THEY MATCH **MSOS 4.1**M0300229ÐÐ SAZ CHAR2 YES **MSOS 4.1**M0300230 JMP* NEXT NO, TRY AGAIN **MSOS 4.1**M0300231 SPC 1 **MSOS 4.1**M0300232CHAR2 LDA* FUNCTN+1,I **MSOS 4.1**M0300233 SUB =A IS THIS A 2 CHARACTER INPUT **MSOS 4.1**M0300234 SAN NOT2 NO **MSOS 4.1**M0300235 LDA- I SAVE INDEX TO 2 CHAR INPUT MATCH **MSOS 4.1**M0300236 STA* FOUND2 **MSOS 4.1**M0300237 JMP* NEXT CONTINUE TO SEE IF 3 OR 4 CHAR **MSOS 4.1**M0300238NOT2 LDA* FUNCTN+1,I **MSOS 4.1**M0300239 AND- LPMSK+8 NO, IS IT 3 CHARACTERS **MSOS 4.1**M0300240 INA -$20 **MSOS 4.1**M0300241 SAN CHAR4 NO, IT IS 4 CHAR. **MSOS 4.1**M0300242 LDA- 1,Q 3 CHARACTER INPUT **MSOS 4.1**M0300243 ALS 8 MERGE THE 4TH CHAR OF THE INPUT **MSOS 4.1**M0300244 LDQ* FUNCTN+1,I WITH THE 3RD CHAR OF THE FUNCTION **MSOS 4.1**M0300245 QRS 8 **MSOS 4.1**M0300246 LRS 8 **MSOS 4.1**M0300247 STA* FUNCTN+1,I **MSOS 4.1**M0300248 LDQ* QSAVE **MSOS 4.1**M0300249 LDA* FUNCTN+1,I SEE IF THREE CHAR MATCH **MSOS 4.1**M0300250 SUB- 1,Q **MSOS 4.1**M0300251 SAN NEXT SKIP IF NO MATCH **MSOS 4.1**M0300252 LDA- I SAVE INDEX TO 3 CHAR MATCH **MSOS 4.1**M0300253 STA* FOUND3 **MSOS 4.1**M0300254ÐÐ JMP* NEXT SEE IF SIMILAR 4 CHAR MATCH **MSOS 4.1**M0300255CHAR4 LDA* FUNCTN+1,I **MSOS 4.1**M0300256 SUB- 1,Q DO THE SECOND SET OF CHAR MATCH **MSOS 4.1**M0300257 SAN NEXT NO **MSOS 4.1**M0300258 SPC 1 **MSOS 4.1**M0300259FOUND LDA* FUNCTN+2,I YES, PROCESS THE REQUEST **MSOS 4.1**M0300260 INA -1 **MSOS 4.1**M0300261 STA* JMP+1 **MSOS 4.1**M0300262JMP JMP ERROR **MSOS 4.1**M0300263 EJT M0300264 SPC 2 **MSOS 4.1**M0300265NEXT RAO* ISAVE **MSOS 4.1**M0300266 LDA* ISAVE **MSOS 4.1**M0300267 MUI- SIX SET UP FOR NEXT GROUP **MSOS 4.1**M0300268 STA- I **MSOS 4.1**M0300269 SUB MAX ARE WE THROUGH M0300270 SAP FINI YES **MSOS 4.1**M0300271 JMP* REPEAT NO, TRY AGAIN **MSOS 4.1**M0300272 SPC 1 **MSOS 4.1**M0300273FINI LDQ* QSAVE **MSOS 4.1**M0300274 LDA* FOUND3 SEE IF 3 CHAR MATCH FOUND **MSOS 4.1**M0300275 SAM TRY2 SKIP IF NOT **MSOS 4.1**M0300276SMALL STA- I SETUP MATCH INDEX **MSOS 4.1**M0300277 JMP* FOUND PROCESS INPUT **MSOS 4.1**M0300278TRY2 LDA* FOUND2 SEE IF 2 CHAR MATCH **MSOS 4.1**M0300279ÐÐ SAM GERROR SKIP IF NO **MSOS 4.1**M0300280 JMP* SMALL PROCESS INPUT **MSOS 4.1**M0300281GERROR JMP ERROR ILLEGAL REQUEST **MSOS 4.1**M0300282 SPC 1 **MSOS 4.1**M0300283FOUND3 NUM -1 **MSOS 4.1**M0300284FOUND2 NUM -1 **MSOS 4.1**M0300285QSAVE NUM 0 **MSOS 4.1**M0300286ISAVE NUM 0 **MSOS 4.1**M0300287 EJT **MSOS 4.1**M0300288FUNCTN ALF 2,=S =S SCHEDULE ORDINAL **MSOS 4.1**M0300289 ADC EQUALS-JMP **MSOS 4.1**M0300290 NUM $2404 M0300291 NUM $FFFF **MSOS 4.1**M0300292 NUM 0 **MSOS 4.1**M0300293 SPC 2 **MSOS 4.1**M0300294 SPC 2 **MSOS 4.1**M0300295 ALF 2,EF EF LIST ALL UNITS **MSOS 4.1**M0300296 ADC GETIND-JMP **MSOS 4.1**M0300297 NUM $2404 M0300298 NUM 1 EFLIST M0300299 NUM 0 **MSOS 4.1**M0300300 SPC 2 **MSOS 4.1**M0300301 ALF 2,EFMM EF LIST MASS MEMORY **MSOS 4.1**M0300302 ADC GETIND-JMP **MSOS 4.1**M0300303 NUM $2404 M0300304ÐÐ NUM 1 EFLIST M0300305 NUM 2 **MSOS 4.1**M0300306 SPC 2 **MSOS 4.1**M0300307 ALF 2,EFLU EF LIST SPECIFIED LU **MSOS 4.1**M0300308 ADC GETIND-JMP **MSOS 4.1**M0300309 NUM $2404 M0300310 NUM 1 EFLIST M0300311 NUM 1 **MSOS 4.1**M0300312 SPC 2 **MSOS 4.1**M0300313 ALF 2,TON START TIMER **MSOS 4.1**M0300314 ADC TIMER-JMP **MSOS 4.1**M0300315 NUM $2404 M0300316 NUM $FFFF **MSOS 4.1**M0300317 NUM 0 **MSOS 4.1**M0300318 SPC 2 **MSOS 4.1**M0300319 ALF 2,TOFF STOP TIMER **MSOS 4.1**M0300320 ADC MOTIME-JMP **MSOS 4.1**M0300321 NUM $2404 M0300322 NUM $FFFF **MSOS 4.1**M0300323 NUM 0 **MSOS 4.1**M0300324 SPC 2 **MSOS 4.1**M0300325 ALF 2,SYSCOP SYSTEM CHECKOUT **MSOS 4.1**M0300326 ADC GETIND-JMP **MSOS 4.1**M0300327 NUM $2404 M0300328 NUM 2 SYSCOP M0300329ÐÐ NUM 0 **MSOS 4.1**M0300330 SPC 2 **MSOS 4.1**M0300331 ALF 2,DB START ODEBUG **MSOS 4.1**M0300332 ADC DB-JMP **MSOS 4.1**M0300333 NUM $2407 M0300334 NUM 3 ODEBUG M0300335 NUM 0 **MSOS 4.1**M0300336 SPC 2 **MSOS 4.1**M0300337 ALF 2,DX STOP ODEBUG **MSOS 4.1**M0300338 ADC DX-JMP **MSOS 4.1**M0300339 NUM $2404 M0300340 NUM $FFFF **MSOS 4.1**M0300341 NUM 0 **MSOS 4.1**M0300342 SPC 2 **MSOS 4.1**M0300343 ALF 2,DATE ENTER DATE/TIME **MSOS 4.1**M0300344 ADC GETIND-JMP **MSOS 4.1**M0300345 NUM $2404 M0300346 NUM 4 TDFUNC M0300347 NUM 1 **MSOS 4.1**M0300348 SPC 3 M0300349 ALF 2,VERIFY MSOS VERIFICATION M0300350 ADC GETIND-JMP M0300351 NUM $2404 M0300352 NUM 5 VERIFY M0300353 NUM 0 M0300354ÐÐ SPC 2 **MSOS 4.1**M0300355 ALF 2,TIME PRINT CURRENT DATE AND TIME **MSOS 4.1**M0300356 ADC GETIND-JMP **MSOS 4.1**M0300357 NUM $2404 M0300358 NUM 4 TDFUNC M0300359 NUM 2 **MSOS 4.1**M0300360 SPC 2 **MSOS 4.1**M0300361 ALF 2,INIT INITIALIZE SYSTEM VOLUME FILES M0300362 ADC GETIND-JMP M0300363 NUM $2406 M0300364 NUM 6 SYUTIL M0300365 NUM 0 M0300366 SPC 2 M0300367 ALF 2,START ACTIVATE THE ITOS SYSTEM M0300368 ADC GETIND-JMP M0300369 NUM $2406 M0300370 NUM 6 SYUTIL M0300371 NUM 1 M0300372 SPC 2 M0300373 ALF 2,STOP DE-ACTIVATE THE ITOS SYSTEM M0300374 ADC GETIND-JMP M0300375 NUM $2406 M0300376 NUM 6 SYUTIL M0300377 NUM 2 M0300378 SPC 2 M0300379ÐÐ ALF 2,PASSWD DEFINE THE SYSTEM PASSWORD M0300380 ADC GETIND-JMP M0300381 NUM $2406 M0300382 NUM 6 SYUTIL M0300383 NUM 3 M0300384 SPC 2 SCAD MODM0300385 ALF 2,JIN, CHANGE JOB PROC. INPUT DEVICE SCAD MODM0300386 ADC JOBINP-JMP SCAD MODM0300387 NUM $2404 SCAD MODM0300388 NUM $FFFF SCAD MODM0300389 NUM 0 SCAD MODM0300390 SPC 2 SCAD MODM0300391 ALF 2,JLT, CHANGE JOB PROC. LIST DEVICE SCAD MODM0300392 ADC JOBLST-JMP SCAD MODM0300393 NUM $2404 SCAD MODM0300394 NUM $FFFF SCAD MODM0300395 NUM 0 SCAD MODM0300396 SPC 2 SCAD MODM0300397 ALF 2,INP, CHANGE STANDARD INPUT DEVICE SCAD MODM0300398 ADC STDEV-JMP SCAD MODM0300399 NUM $2404 SCAD MODM0300400 NUM $FFFF SCAD MODM0300401 NUM 0 SCAD MODM0300402 SPC 2 SCAD MODM0300403 ALF 2,OUT, CHANGE STANDARD OUTPUT DEVICE SCAD MODM0300404ÐÐ ADC STDEV-JMP SCAD MODM0300405 NUM $2404 SCAD MODM0300406 NUM $FFFF SCAD MODM0300407 NUM 1 SCAD MODM0300408 SPC 2 SCAD MODM0300409 ALF 2,LST, CHANGE STANDARD LIST DEVICE SCAD MODM0300410 ADC STDEV-JMP SCAD MODM0300411 NUM $2404 SCAD MODM0300412 NUM $FFFF SCAD MODM0300413 NUM 2 SCAD MODM0300414 SPC 2 SCAD MODM0300415 ALF 2,CARD CHANGE CARD READ MODE (1829-30/60) SCAD MODM0300416 ADC CARDMD-JMP SCAD MODM0300417 NUM $2404 SCAD MODM0300418 NUM 0 SCAD MODM0300419 NUM 43 SCAD MODM0300420 SPC 2 SCAD MODM0300421 ALF 2,REW, REWIND A MAG TAPE SCAD MODM0300422 ADC REWMGT-JMP SCAD MODM0300423 NUM $2404 SCAD MODM0300424 NUM $FFFF SCAD MODM0300425 NUM 0 SCAD MODM0300426 SPC 2 SCAD MODM0300427 ALF 2,RSV, RESERVE BUFFER SPACE FOR COMM-18 SIMS SCAD MODM0300428 ADC RSV-JMP M0300429ÐÐ NUM $2404 SCAD MODM0300430 NUM 7 M0300431 NUM 0 SCAD MODM0300432 SPC 2 SCAD MODM0300433 ALF 2,SAVE SAVE SYSVOL VOLUME LABEL. M0300434 ADC GETIND-JMP SCAD MODM0300435 NUM $2407 M0300436 NUM 8 M0300437 NUM 0 SCAD MODM0300438 SPC 2 SCAD MODM0300439 ALF 2,RESTORE RESTORE SYSVOL VOLUME LABLE. M0300440 ADC GETIND-JMP SCAD MODM0300441 NUM $2407 M0300442 NUM 9 M0300443 NUM 0 SCAD MODM0300444 SPC 2 M0300445 ALF 2,SCOM M0300446 ADC COMSTP-JMP M0300447 NUM $2402 M0300448 NUM $FFFF M0300449 NUM 0 M0300450 SPC 2 M0300451 ALF 2,WRON ENABLE WRITE RING M0300452 ADC WRNGON-JMP M0300453 NUM $2402 M0300454ÐÐ NUM $FFFF M0300455 NUM 0 M0300456 SPC 2 M0300457 ALF 2,WROF DISABLE WRITE RING M0300458 ADC WRNGOF-JMP M0300459 NUM $2402 M0300460 NUM $FFFF M0300461 NUM 0 M0300462 SPC 2 M0300463 ALF 2,CCSD CCS 2.0 DEBUG M0300464 ADC DB-JMP M0300465 NUM $2407 M0300466 NUM 3 M0300467 NUM 0 M0300468 SPC 2 M0300469 ALF 2,UP RESTORE DOWN TERMINAL. M0300470 ADC GETIND-JMP M0300471 NUM $2407 M0300472 NUM 10 M0300473 NUM 0 M0300474 SPC 2 M0300475 ALF 2,DENSITY MAG TAPE DENSITY AND MODE SELECT. M0300476 ADC GETIND-JMP M0300477 NUM $2407 M0300478 NUM 11 M0300479ÐÐ NUM 0 M0300480 SPC 2 M0300481 ALF 2,SMDC CONFIGURE SMD PHY. DEV. TBL. M0300482 ADC GETIND-JMP M0300483 NUM $2404 M0300484 NUM 12 M0300485 NUM 0 M0300486 SPC 2 M0300487 ALF 2,SYID DEFINE SYSTEM IDENTIFICATION M0300488 ADC GETIND-JMP M0300489 NUM $2404 M0300490 NUM 12 M0300491 NUM 1 M0300492 SPC 2 M0300493 ALF 2,LPCF CONFIGURE LINE PRINTER LOWER CASE OPTION M0300494 ADC GETIND-JMP M0300495 NUM $2404 M0300496 NUM 12 M0300497 NUM 2 M0300498 EJT M0300499 SPC 2 **MSOS 4.1**M0300500MAX ADC *-FUNCTN FUNCTION TABLE SIZE **MSOS 4.1**M0300501ORDTBL ADC 0 ORDINAL TABLE FOR MNEMONICS M0300502 ADC EFLIST M0300503 ADC SYSCOP M0300504ÐÐ ADC ODEBUG M0300505 ADC TDFUNC M0300506 ADC VERIFY M0300507 ADC SYUTIL ITOS SYSTEM UTILITIES M0300508 ADC SIMRSV SCAD MODM0300509 ADC SAVLAB M0300510 ADC RESLAB M0300511 ADC TRMLUP RESTORE DOWN TERMINAL. M0300512 ADC TAPSET SELECT MAG TAPE DENSITY AND MODE. M0300513 ADC SMDCFG 12 CONFIGURE SMD PHY. DEV. TBL. M0300514 EJT **MSOS 4.1**M0300515* TIMER INITIATION CODING **MSOS 4.1**M0300516* **MSOS 4.1**M0300517* MP17 REAL-TIME CLOCK 8 M0300518* **MSOS 4.1**M0300519* **MSOS 4.1**M0300520TIMER LDQ =XLOG1A **MSOS 4.1**M0300521 LDQ- 1,Q **MSOS 4.1**M0300522 LDA- 13,Q **MSOS 4.1**M0300523 INA 1 IS THERE A SWAP TIME DEFINED **MSOS 4.1**M0300524 SAZ TIMER1 NO **MSOS 4.1**M0300525 LDA- 13,Q **MSOS 4.1**M0300526 AND- LPMSK+15 RE-ENABLE CORE SWAP DELAYS **MSOS 4.1**M0300527 STA- 13,Q **MSOS 4.1**M0300528TIMER1 LDQ =XTMCODE **MSOS 4.1**M0300529ÐÐ STQ+ TMRTYP RESTORE THE TIMER TYPE CODE **MSOS 4.1**M0300530* MP MSOSM0300531* MP17 REAL-TIME ADT CLOCK MP MSOSM0300532* MP MSOSM0300533MP17CK ENA 0 CLEAR A MP MSOSM0300534 LDQ+ TBLADR GET ADDR OF ADT TABLE MP MSOSM0300535 STA- 1,Q AND CLEAR CLOCK CYCLE COUNTER MP MSOSM0300536 ENA 5 M0300537 STA- 2,Q SET CYCLE LIMIT M0300538 TRQ A ADT TABLE ADDR TO A MP MSOSM0300539 LDQ+ DMICOD DEFINE/U-INT NO. IN Q MP MSOSM0300540 DMI DEFINE MICRO-INTRPT M0300541 LDQ+ EMPSRT RESET/START FUNCTION CODE MP MSOSM0300542 OUT REJ-* M0300543 JMP* MIDONE M0300544 SPC 3 MP MSOSM0300545 EJT M0300546* MAKE SYSTEM DIRECTORY SCHEDULER CALL IF PROGRAM SUPPLIED M0300547 SPC 3 M0300548GETIND LDQ FUNCTN+4,I GET ORDINAL INDEX M0300549 LDA ORDTBL,Q GET ORDINAL M0300550 EOR- LPMSK+15 M0300551 SAN GET1 SKIP IF ENTRY PRESENT M0300552 JMP ERROR M0300553GET1 LDA ORDTBL,Q GET ORDINAL M0300554ÐÐ STA* CALL+1 STORE ORDINAL IN SCHEDULER CALL M0300555 TRA Q M0300556 ADQ- $EB M0300557 LDA- 4,Q HAS THE ORDINAL BEEN LOADED M0300558 SAN GET2 YES M0300559GETERR JMP ERROR PROGRAM IS UNLINKED OR NOT LOADED M0300560GET2 LDA FUNCTN+3,I M0300561 STA* CALL SET THE LEVEL OF THE PROGRAM **MSOS 4.1**M0300562 LDQ FUNCTN+5,I OBTAIN THE PARAMETER TO PASS **MSOS 4.1**M0300563SCHDRP RTJ- (AMONI) SCHEDULE REQUESTED PROGRAM *MSOS V4.0 M0300564CALL NUM $5204 M0300565 ADC 0 **MSOS 4.1**M0300566 SPC 3 M0300567* EXIT PATH FROM MIPRO M0300568 SPC 3 M0300569MIDONE ENA 0 M0300570 STA+ MIBX CLEAR BUSY FLAG IN MANINT PROGRAM M0300571 RTJ- (AMONI) RELEASE CORE AND EXIT M0300572LIST NUM $1901 M0300573 ADC (MIPRO-LIST) M0300574* REJECT EXIT M0300575REJ NOP 0 M0300576 ENA 0 M0300577 STA+ TMRTYP INDICATE NO TIMER M0300578REJ1 LDA =XMSG2-REF TO PRINT -TIMER REJECT- M0300579ÐÐ JMP* STORIT M0300580 EJT M0300581 SPC 2 M0300582* TIMER TERMINATION CODING **MSOS 4.1**M0300583* **MSOS 4.1**M0300584* TIMER TERMINATION SEQUENCE IS BASED ON TIMER TYPE **MSOS 4.1**M0300585* AS DEFINED ABOVE **MSOS 4.1**M0300586* **MSOS 4.1**M0300587MOTIME LDQ =XLOG1A **MSOS 4.1**M0300588 LDQ- 1,Q **MSOS 4.1**M0300589 LDA- 13,Q **MSOS 4.1**M0300590 AND- LPMSK+15 **MSOS 4.1**M0300591 EOR- ONEBIT+15 DISABLE DELAYED CORE SWAPS **MSOS 4.1**M0300592 STA- 13,Q **MSOS 4.1**M0300593 LDQ =XTMCODE **MSOS 4.1**M0300594 ENA 0 **MSOS 4.1**M0300595 STA+ TMRTYP INDICATE NO TIMER **MSOS 4.1**M0300596* MP MSOSM0300597* MP17 REAL-TIME ADT CLOCK MP MSOSM0300598* MP MSOSM0300599NMP17 LDQ+ EMPSTP TIMER STOP FUNCTION CODE MP MSOSM0300600 OUT REJ-* STOP THE TIMER,'A' NOT USED MP MSOSM0300601 LDA+ DMICOD ENABLE/U-INTRPT NO. MP MSOSM0300602 AND- LPMSK+15 CHANGE TO DISABLE MP MSOSM0300603 TRA Q CODE TO Q-REG MP MSOSM0300604ÐÐ LDA+ TBLADR ADT TABLE ADDRESS MP MSOSM0300605 DMI CLEAR MICRO-INTRPT M0300606 JMP* MIDONE EXIT MP MSOSM0300607 SPC 3 MP MSOSM0300608 EJT M0300609* MAG TAPE SIMULATOR WRITE RING PROCESSOR M0300610* THIS ROUTINE ENABLES OR DISABLES THE WRITE RING ON THE M0300611* SPECIFIED MAG TAPE SIMULATOR UNIT. M0300612* M0300613* THE LOGICAL UNIT SPECIFIED MUST CONTAIN 2 DIGITS M0300614* EXAMPLE... WRON,09 M0300615* WROF,28 M0300616 SPC 2 M0300617WRNGON LDA- ONEBIT+15 SET ON FLAG M0300618 JMP* TAPSIM M0300619WRNGOF ENA 0 SET OFF FLAG M0300620TAPSIM STA* FLAGPS M0300621 LDQ QSAVE M0300622 LDA- 2,Q ISOLATE FIELD SEPARATOR M0300623 ALS 8 M0300624 AND- LPMSK+8 M0300625 INA -$2C IS IT A COMMA M0300626 SAZ NOERR M0300627 JMP* TAPERR M0300628NOERR LDA- 3,Q TEST IF ONE OR TWO CHARS SCAD MODM0300629ÐÐ SAP TWOCHA IS 2 CHARS SCAD MODM0300630 LDA- 2,Q IS 1 CHAR SCAD MODM0300631 JMP* ONECHA SCAD MODM0300632* SCAD MODM0300633TWOCHA LDA- 2,Q GET AND ISOLATE 1ST CHAR SCAD MODM0300634 RTJ DCK SCAD MODM0300635 ALS 4 SCAD MODM0300636 STA TEMP SAVE IT SCAD MODM0300637 LDA- 3,Q GET 2ND CHAR SCAD MODM0300638 ALS 8 SCAD MODM0300639ONECHA RTJ DCK CHECK IF A DECIMAL DIGIT SCAD MODM0300640 RTJ TSTLU TEST RANGE OF LOGICAL UNIT SCAD MODM0300641 JMP* OKTAP2 SCAD MODM0300642* SCAD MODM0300643TAPERR LDA =XMSG3-REF TO PRINT -TAPE SIM ERROR- M0300644 JMP* STORIT M0300645* SCAD MODM0300646OKTAP2 LDQ+ LOG1A,Q M0300647 STQ- I SAVE THE PHYSTAB ADDRESS M0300648 LDA- 8,I ISOLATE THE EQUIPMENT TYPE CODE M0300649 ARS 4 M0300650 AND- LPMSK+7 M0300651 INA -60 IS IT A MAG TAPE SIMULATOR M0300652 SAZ OKTAP3 M0300653 JMP* TAPERR NO, ERROR M0300654ÐÐOKTAP3 IIN 0 M0300655 LDA- 12,I GET THE HARDWARE STATUS WORD M0300656 AND- LPMSK+15 CLEAR THE WRITE RING BIT M0300657 EOR* FLAGPS SET/CLEAR THE BIT M0300658 STA- 12,I RESTORE THE STATUS WORD M0300659 EIN 0 M0300660 JMP MIDONE EXIT M0300661* M0300662FLAGPS NUM 0 M0300663 SPC 3 M0300664* 6 CARDS DELETED M0300665 EJT M0300666 SPC 3 M0300667* ERROR EXIT M0300668 SPC 3 M0300669ERROR LDA =XMSG1-REF TO PRINT -MI INPUT ERROR- **MSOS 4.1**M0300670STORIT STA* MSGLOC **MSOS 4.1**M0300671 RTJ- (AMONI) M0300672REF NUM $0D37 M0300673 ADC MIDONE-REF M0300674 ADC 0 M0300675 ADC $18FC M0300676 ADC 7 **MSOS 4.1**M0300677MSGLOC ADC 0 **MSOS 4.1**M0300678 JMP- ($EA) M0300679ÐÐ SPC 2 M0300680MSG1 ALF 7,MI INPUT ERROR **MSOS 4.1**M0300681MSG2 ALF 7,TIMER REJECT **MSOS 4.1**M0300682MSG3 ALF 7,TAPE SIM ERROR M0300683 SPC 5 M0300684 SPC 2 M0300685* INITIATE DEBUG PACKAGE M0300686 SPC 1 M0300687DBSYSD ADC ODEBUG REL. INCREMENT TO DEBUG ENTRY IN SYS. DIR. M0300688DB LDQ- $EB STORE CORRECT LENGTH M0300689 ADQ* DBSYSD IN SYS. DIR. ENTRY M0300690 LDA =XODBSIZ CHANGE DIR. LENGTH M0300691 STA- (FOUR),Q M0300692DBCKIT LDA+ CHRSFG IS DEBUG IN M0300693 SAZ DBRQIT-*-1 SKIP NO M0300694 JMP* ERROR PRINT ERROR MSG. M0300695DBRQIT JMP GETIND SCHEDULE OBEDUG M0300696* TURN OFF DEBUG PKG. M0300697 SPC 1 SCAD MODM0300698DX ENA 0 M0300699 STA+ CHRSFG M0300700 JMP MIDONE M0300701 EJT M0300702 SPC 5 M0300703* EQUAL S ROUTINE TO START SYSTEM DIRECTORY PROGRAMS. M0300704ÐÐ SPC 3 M0300705EQUALS LDA- 1,Q PICKUP TWO DIGITS OF DIRECTORY NUMBER M0300706 STQ- I SAVE BUFFER ADDRESS M0300707 RTJ* CK CHECK AND CONVERT TO HEX M0300708 STA* HOLD SAVE SECOND DIGIT M0300709 LDA- 1,Q M0300710 ALS 8 DO SECOND DIGIT FIRST M0300711 RTJ* CK NOW FIRST DIGIT M0300712 ALS 4 X 16 M0300713 ADD* HOLD FORM COMPLETE DIRECTORY NUMBER M0300714 ALS 4 M0300715 STA* HOLD M0300716 LDA- 2,Q M0300717 ALS 8 RIGHT JUSTIFY 3RD DIGIT M0300718 RTJ* CK M0300719 ADD* HOLD M0300720 RTJ* DEOCT CONVERT FROM DECIMAL TO HEX M0300721 INA -1 REFERENCE TO ZERO M0300722 MUI- $5 X 7 M0300723 ADD- $E7 ADDRESS OF 1ST MASS STORAGE ENTRY M0300724 STA CALL+1 STORE SCHEDULER CALL M0300725 AND- $42 REMOVE BIT 15 M0300726 LDQ- $EB 53*1069 M0300727 AAQ Q 53*1069 M0300728 LDQ- 4,Q CHECK FOR ZERO LENGTH ORDINAL 53*1069 M0300729ÐÐ SQN SPICI SKIP IF OK 53*1069 M0300730 JMP* ERROR **MSOS 4.1**M0300731SPICI SUB- $E6 CHECK IF WITHIN LIMITS 53*1069 M0300732 SAM SPIC2 SK-P IF WITHIN LIMITS M0300733 JMP* ERROR TO ERROR ROUTINE **MSOS 4.1**M0300734 SPC 1 M0300735* SET PRIORITY LEVEL M0300736 SPC 1 M0300737SPIC2 LDA- 3,I M0300738 ALS 8 M0300739 RTJ* CK M0300740 AND- LPMSK+4 SCHEDULE PRIORITY/ **MSOS 4.1**M0300741 ADD =N$2400 M0300742 STA CALL **MSOS 4.1**M0300743 SPC 1 M0300744* CHECK FOR A PARAMETER TO PASS M0300745 SPC 1 M0300746 LDA- 3,I M0300747 AND- $A FFMASK M0300748 EOR =N$2C , M0300749 SAZ SPIC3 SKIP IF NEXT CHARACTER COMMA M0300750 JMP SCHDRP SCHEDL. REQSED. PROGR. M0300751SPIC3 LDA- 4,I M0300752 ALS 8 M0300753 RTJ* CK M0300754ÐÐ ALS 4 M0300755 STA* HOLD SAVE DIGIT 1 M0300756 LDA- 4,I M0300757 RTJ* CK M0300758 ADD* HOLD M0300759 ALS 4 M0300760 STA* HOLD SAVE DIGITS 1 AND 2 M0300761 LDA- 5,I M0300762 ALS 8 M0300763 RTJ* CK M0300764 ADD* HOLD M0300765 ALS 4 M0300766 STA* HOLD SAVE DIGITS 1,2 AND 3 M0300767 LDA- 5,I M0300768 RTJ* CK M0300769* THIS INSTRUCTION ORS IN CASE OF NEGATIVE ZERO IS PASSED M0300770 EOR* HOLD FORM COMPLETE PARAMETER *629 M0300771 TRA Q PUT IN Q TO PASS M0300772 SPC 1 M0300773* SCHEDULE THE PROGRAM M0300774 SPC 1 M0300775 JMP SCHDRP SCHEDL. REQSED. PROGR. M0300776HOLD 0 0 TEMPORARY STORAGE CELL M0300777 SPC 1 M0300778* INPUT DATA CHECK AND CONVERSION ROUTINE M0300779ÐÐ SPC 1 M0300780CK 0 0 M0300781 AND- $A FF MASK M0300782 INA -$30 M0300783 SAM ER-*-1 SKIP IF LESS THAN $30 M0300784 INA -$17 *629 M0300785 SAP ER NOT 0 THRU $F *629 M0300786 INA 6 *629 M0300787 SAP ATHRUF DO NOT ALLOW ASCII M0300788 INA 7 CODES *3A THRU *40 M0300789 SAP ER TO PASS THRU THIS M0300790ATHRUF INA 10 ROUTINE M0300791 JMP* (CK) M0300792ER JMP ERROR ILLEGAL CHARACTER INPUT M0300793DEOCT 0 0 M0300794 LDQ- $1E SET ALL THRU FLAG M0300795 LLS 20 FIRST DIGIT TO A, REST TO Q M0300796 STQ* BAKER SAVE REST M0300797 EOR* MINUS CHECK FOR MINUS SIGN M0300798 STA* ABLE SET INDICATOR FOR LATER M0300799 SAZ ADEOCT-*-1 START TO CONVERT M0300800 EOR* MINUS SET FIRST DIGIT BACK IF NOT - M0300801 INA -10 DO NOT ALLOW INPUT OF M0300802 SAM DDEOCT A THRU F TO THIS DECIMAL/HEX M0300803 JMP* ER CONVERSION ROUTINE M0300804ÐÐDDEOCT INA 10 M0300805ADEOCT MUI- $46 CONVERT THIS PART (TIMES 10) M0300806 STA* CHARLE PUT NEW VALUE TO TEMP M0300807 CLR A CLEAR A M0300808 LDQ* BAKER GET SAVED NEXT PORTION M0300809 LLS 4 NEXT FOUR TO A M0300810 INA -10 DO NOT ALLOW INPUT OF M0300811 SAM EDEOCT A THRU F TO THIS DECIMAL/HEX M0300812 JMP* ER CONVERSION ROUTINE M0300813EDEOCT INA 10 M0300814 ADD* CHARLE ADD THE PREVIOUS M0300815 STQ* BAKER SAVE THE REST M0300816 ADQ- $E CHECK FOR DONE M0300817 SQZ BDEOCT-*-1 ZERO MEANS DONE M0300818 JMP* ADEOCT GO BACK FOR ANOTHER TRY M0300819BDEOCT LDQ* ABLE CHECK FOR MINUS SIGN M0300820 SQN CDEOCT-*-1 ZERO IS MINUS M0300821 TCA A COMPLEMENT THE ANSWER M0300822CDEOCT JMP* (DEOCT) GO BACK HOME M0300823MINUS NUM $D MINUS SIGN M0300824ABLE 0 0 M0300825BAKER 0 0 M0300826CHARLE 0 0 M0300827 EJT SCAD MODM0300828* ROUTINE TO CHANGE THE JOB PROCESSOR INPUT DEVICE SCAD MODM0300829ÐÐ* SCAD MODM0300830* JIN,NN CHANGE JOB PROCESSOR INPUT SCAD MODM0300831* DEVICE TO LU NN. SCAD MODM0300832* SCAD MODM0300833* NOTE: NN MAY BE A 1 OR 2 CHAR SCAD MODM0300834* DECIMAL LOGICAL UNIT SCAD MODM0300835* NUMBER. SCAD MODM0300836* SCAD MODM0300837 SPC 2 SCAD MODM0300838* SCAD MODM0300839 EXT INPTV4 JOB PROCESSOR INPUT LOGICAL UNIT SCAD MODM0300840 EXT AUTF9 STD INPUT SLOT IN TRVEC SCAD MODM0300841* SCAD MODM0300842 SPC 2 SCAD MODM0300843JOBINP RTJ* GETLU PICK UP LOGICAL UNIT SCAD MODM0300844 RTJ* TSTLU TEST RANGE OF LOGICAL UNIT SCAD MODM0300845 ENA 2 MASK FOR READ TYPE DEVICE SCAD MODM0300846 LDQ+ LOG1A,Q GET POINTER TO PHYSTB SCAD MODM0300847 AND- 8,Q TEST IF DEVICE IS READ TYPE SCAD MODM0300848 SAN READOK IF NOT ZERO, OK SCAD MODM0300849 JMP* UNITER IF ZERO, REJECT THE REQUEST SCAD MODM0300850* SCAD MODM0300851READOK RTJ* TSTCLS CHECK DEVICE CLASS SCAD MODM0300852 LDA* TEMP GET LOGICAL UNIT AGAIN SCAD MODM0300853 STA+ INPTV4 STORE IN JOB INPUT DEVICE SLOT SCAD MODM0300854ÐÐ STA+ AUTF9 AND AUTF9 SLOT IN TRVEC. SCAD MODM0300855 STA- $F9 STORE IN COMMUNICATIONS REGION SCAD MODM0300856 JMP MIDONE EXIT M0300857* SCAD MODM0300858* SCAD MODM0300859 EJT SCAD MODM0300860* ROUTINE TO CHANGE THE JOB PROCESSOR LIST DEVICE SCAD MODM0300861* SCAD MODM0300862* JLT,NN CHANGE JOB PROCESSOR LIST SCAD MODM0300863* DEVICE TO LU NN. SCAD MODM0300864* SCAD MODM0300865* NOTE: NN MAY BE A 1 OR 2 CHAR SCAD MODM0300866* DECIMAL LOGICAL UNIT SCAD MODM0300867* NUMBER. SCAD MODM0300868* SCAD MODM0300869 SPC 2 M0300870* SCAD MODM0300871 EXT AUTFB JOB PROCESSOR LIST LOGICAL UNIT SCAD MODM0300872* SCAD MODM0300873 SPC 2 SCAD MODM0300874JOBLST RTJ* GETLU PICK UP LOGICAL UNIT SCAD MODM0300875 RTJ* TSTLU TEST RANGE OF LOGICAL UNIT SCAD MODM0300876 ENA 4 MASK FOR WRITE TYPE DEVICE SCAD MODM0300877 LDQ+ LOG1A,Q GET POINTER TO PHYSTB SCAD MODM0300878 AND- 8,Q TEST IF DEVICE IS WRITE TYPE SCAD MODM0300879ÐÐ SAN WRITOK IF NOT ZERO, OK SCAD MODM0300880 JMP* UNITER IF ZERO, REJECT THE REQUEST SCAD MODM0300881* SCAD MODM0300882WRITOK RTJ* TSTCLS CHECK DEVICE CLASS SCAD MODM0300883 LDA* TEMP GET LOGICAL UNIT AGAIN SCAD MODM0300884 STA+ AUTFB STORE IN JOB LIST DEVICE SLOT SCAD MODM0300885 STA- $FB STORE IN COMMUNICATIONS REGION SCAD MODM0300886 LDQ- $E9 ADDR OF EXTENDED CORE TABLE SCAD MODM0300887 STA- 3,Q STORE IN CSYLST IN EXT CORE TABLE SCAD MODM0300888 JMP MIDONE EXIT M0300889* ONE CARD DELETED 127-5180M0300890* SCAD MODM0300891* SCAD MODM0300892 EJT SCAD MODM0300893* ROUTINE TO CHANGE STANDARD LOGICAL UNITS SCAD MODM0300894* SCAD MODM0300895* INP,NN CHANGE STD INPUT DEV TO LU NN SCAD MODM0300896* OUT,NN CHANGE STD OUTPUT DEV TO LU NN SCAD MODM0300897* LST,NN CHANGE STD LIST DEV TO LU NN SCAD MODM0300898* SCAD MODM0300899* NOTE: NN MAY BE A 1 OR 2 CHAR SCAD MODM0300900* DECIMAL LOGICAL UNIT SCAD MODM0300901* NUMBER. SCAD MODM0300902* SCAD MODM0300903 SPC 2 SCAD MODM0300904ÐÐSTDEV LDA FUNCTN+5,I SAVE FLAG FOR SCAD MODM0300905 STA* DEVFLG STD DEVICE TYPE. SCAD MODM0300906 RTJ* GETLU PICK UP LOGICAL UNIT SCAD MODM0300907 RTJ* TSTLU TEST RANGE OF LOGICAL UNIT SCAD MODM0300908 LDA* DEVFLG GET DEVICE TYPE FLAG SCAD MODM0300909 SAN WRTDEV IF .NE. 0, DEVICE MUST WRITE SCAD MODM0300910 ENA 2 IF .EQ. 0, DEVICE MUST READ SCAD MODM0300911 JMP* CHKTYP SCAD MODM0300912WRTDEV ENA 4 SCAD MODM0300913CHKTYP LDQ+ LOG1A,Q GET POINTER TO PHYSTB SCAD MODM0300914 AND- 8,Q TEST IF DEVICE HAS CORRECT MODE SCAD MODM0300915 SAN CAPOK IF NOT ZERO, OK SCAD MODM0300916 JMP* UNITER IF ZERO, REJECT THE REQUEST SCAD MODM0300917* SCAD MODM0300918CAPOK RTJ* TSTCLS CHECK DEVICE CLASS SCAD MODM0300919 LDQ* DEVFLG GET STD DEVICE TYPE SCAD MODM0300920 LDA* TEMP GET LU SCAD MODM0300921 STA- $F9,Q STORE IN COMMUN. REGION SLOT SCAD MODM0300922* SCAD MODM0300923* SCAD MODM0300924DEVFLG NUM 0 SCAD MODM0300925TEMP NUM 0 SCAD MODM0300926* SCAD MODM0300927* SCAD MODM0300928 SPC 3 SCAD MODM0300929ÐÐDCK NUM 0 SCAD MODM0300930 AND- LPMSK+8 ISOLATE CHAR SCAD MODM0300931 INA -$30 TEST FOR SCAD MODM0300932 SAM DER RANGE IS 0 SCAD MODM0300933 INA -$A TO 9. SCAD MODM0300934 SAM DOK SCAD MODM0300935DER JMP ERROR SCAD MODM0300936DOK INA $A SCAD MODM0300937 AND- LPMSK+4 ISOLATE HEX VALUE SCAD MODM0300938 JMP* (DCK) SCAD MODM0300939* SCAD MODM0300940* SCAD MODM0300941 SPC 3 SCAD MODM0300942GETLU NUM 0 SCAD MODM0300943 LDA- 2,Q GET LU CHARS SCAD MODM0300944 AND- LPMSK+8 IS LU ONE SCAD MODM0300945 SUB- LPMSK+8 OR TWO CHARS. SCAD MODM0300946 SAN TWOCHR NOT ZERO, TWO CHARS SCAD MODM0300947 LDA- 2,Q GET AND SCAD MODM0300948 ALS 8 ISOLATE CHAR. SCAD MODM0300949 JMP* ONECHR SCAD MODM0300950* SCAD MODM0300951TWOCHR LDA- 2,Q GET AND SCAD MODM0300952 ALS 8 ISOLATE 1ST CHAR. SCAD MODM0300953 RTJ* DCK CHECK IF A DECIMAL DIGIT SCAD MODM0300954ÐÐ ALS 4 SCAD MODM0300955 STA* TEMP SAVE IT SCAD MODM0300956 LDA- 2,Q GET 2ND CHAR SCAD MODM0300957ONECHR RTJ* DCK CHECK IF A DECIMAL DIGIT SCAD MODM0300958 JMP* (GETLU) SCAD MODM0300959* SCAD MODM0300960* SCAD MODM0300961 SPC 3 SCAD MODM0300962TSTLU NUM 0 SCAD MODM0300963 ADD* TEMP COMBINE WITH 1ST CHAR SCAD MODM0300964 RTJ DEOCT CONVERT FROM DEC TO HEX SCAD MODM0300965 STA* TEMP SAVE IT SCAD MODM0300966 TRA Q PLACE IN Q REG SCAD MODM0300967 INA -2 SCAD MODM0300968 SAM UNITER IF LU IS .LE. 1 -- AN ERROR SCAD MODM0300969 LDA+ LOG1A SCAD MODM0300970 SUB* TEMP TEST IF LU IS TOO LARGE SCAD MODM0300971 SAP RNGOK SCAD MODM0300972UNITER JMP ERROR YES, INPUT ERROR SCAD MODM0300973* SCAD MODM0300974RNGOK JMP* (TSTLU) SCAD MODM0300975* SCAD MODM0300976* SCAD MODM0300977 SPC 3 SCAD MODM0300978TSTCLS NUM 0 PHYSTB ADDRESS IN Q-REG SCAD MODM0300979ÐÐ LDA- 8,Q GET AND ISOLATE EQUIPMENT CLASS SCAD MODM0300980 ALS 5 SCAD MODM0300981 AND- LPMSK+3 SCAD MODM0300982 SAZ CLSERR IS CLASS 0 (UNDEFINED) -- ERROR SCAD MODM0300983 INA -2 SCAD MODM0300984 SAZ CLSERR IS CLASS 2 (MASS MEM) -- ERROR SCAD MODM0300985 INA -5 SCAD MODM0300986 SAZ CLSERR IS CLASS 7 (RESERVED) -- ERROR SCAD MODM0300987 JMP* (TSTCLS) SCAD MODM0300988* SCAD MODM0300989CLSERR JMP* UNITER REPORT ERROR SCAD MODM0300990* SCAD MODM0300991* SCAD MODM0300992 EJT SCAD MODM0300993* ROUTINE TO CHANGE CARD READER AND PUNCH MODES SCAD MODM0300994* SCAD MODM0300995* (1829-30/60) CARD26 CHANGE TO 026 MODE SCAD MODM0300996* (1829-30/60) CARD29 CHANGE TO 029 MODE SCAD MODM0300997* SCAD MODM0300998* SCAD MODM0300999 EXT P1829 PHYSTB FOR 1829-30/60 SCAD MODM0301000* SCAD MODM0301001CARDMD STQ* CRDFLG SAVE Q REGISTER SCAD MODM0301002 LDQ FUNCTN+4,I GET DEVICE INDEX SCAD MODM0301003 LDA* CRDTBL,Q GET PHYSTB ADDRESS SCAD MODM0301004ÐÐ EOR- LPMSK+15 IS PHYSTB PATCHED SCAD MODM0301005 SAN CRDPOK YES, CONTINUE SCAD MODM0301006 JMP* CRDERR NO, REPORT ERROR SCAD MODM0301007* SCAD MODM0301008CRDPOK LDQ* CRDFLG RESTORE Q REGISTER SCAD MODM0301009 LDA FUNCTN+5,I SAVE READER SCAD MODM0301010 STA* CRDFLG OR PUNCH FLAG. SCAD MODM0301011 LDA- 2,Q GET 26 OR 29 MESSAGE SCAD MODM0301012 SUB =N$3236 IS IT 26 SCAD MODM0301013 SAZ IS026-*-1 YES SCAD MODM0301014 LDA- 2,Q NO, GET MESSAGE AGAIN SCAD MODM0301015 SUB =N$3239 IS IT 29 SCAD MODM0301016 SAZ IS029-*-1 YES SCAD MODM0301017CRDERR JMP ERROR NOT 26 OR 29 -- AN INPUT ERROR SCAD MODM0301018* SCAD MODM0301019IS029 ENA 1 IS 029, SET FLAG SCAD MODM0301020IS026 LDQ FUNCTN+4,I GET DEVICE INDEX INTO TABLE SCAD MODM0301021 LDQ* CRDTBL,Q SCAD MODM0301022 ADQ* CRDFLG GET FLAG FOR READ OR PUNCH SCAD MODM0301023 STA- (ZERO),Q SET OR CLEAR MODE FLAG SLOT SCAD MODM0301024 JMP MIDONE EXIT M0301025* SCAD MODM0301026* SCAD MODM0301027CRDFLG NUM 0 SCAD MODM0301028* SCAD MODM0301029ÐÐCRDTBL ADC P1829 PHYSTB FOR 1829-30/60 SCAD MODM0301030 ADC $7FFF NO PUNCH FOR ITOS M0301031* SCAD MODM0301032* SCAD MODM0301033 EJT SCAD MODM0301034* ROUTINE TO REWIND MAG TAPE 'LU' SCAD MODM0301035* SCAD MODM0301036 SPC 2 SCAD MODM0301037REWMGT RTJ* GETLU PICK UP LOGICAL UNIT SCAD MODM0301038 RTJ* TSTLU TEST LOGICAL UNIT RANGE M0301039* SCAD MODM0301040 STQ* TEMPLU SAVE LU NUMBER IN REQUEST SCAD MODM0301041 LDQ+ LOG1A,Q GET PHYSTB LOCATION SCAD MODM0301042 LDA- 8,Q ISOLATE SCAD MODM0301043 ALS 5 EQUIPMENT SCAD MODM0301044 AND- LPMSK+3 CLASS. SCAD MODM0301045 INA -1 IS IT MAG TAPE CLASS SCAD MODM0301046 SAZ TAPOK2 YES, CONTINUE SCAD MODM0301047 JMP ERROR NO -- INPUT ERROR SCAD MODM0301048* SCAD MODM0301049TAPOK2 RTJ- (AMONI) TAPE MOTION REQUEST FOR REWIND SCAD MODM0301050 VFD N1/0,N1/0,N5/14,N1/1,N4/3,N4/3 SCAD MODM0301051 ADC MIDONE-*+1 M0301052 NUM 0 SCAD MODM0301053TEMPLU NUM 0 SCAD MODM0301054ÐÐ VFD N4/3,N4/0,N4/0,N4/0 SCAD MODM0301055* SCAD MODM0301056 JMP- (ADISP) SCAD MODM0301057* SCAD MODM0301058* SCAD MODM0301059 EJT SCAD MODM0301060* M0301061* RSV RESERVE SPACE FOR COMM18 SIMULATORS M0301062* M0301063 EXT* LOCATE M0301064 EXT COMM18 M0301065 EXT* XMRESV M0301066 EXT* XMRETN M0301067 EXT JOBIND,SWTCH M0301068* M0301069* M0301070RSV LDA- I SAVE I M0301071 STA* ISAV+1 M0301072 LDA JOBIND SEE IF BACKGROUND BATCH IS ACTIVE M0301073 SAZ RSV02 M0301074 JMP* RSV03 M0301075RSV02 LDA SWTCH M0301076 SAZ RSV08 M0301077RSV03 LDA- $F7 BATCH IS BUSY, SEE IF THEY USE THE SAME AREA M0301078 INA 1 M0301079ÐÐ SUB TSAREA M0301080 SAZ RSV08 USE DIFFERENT AREAS GO AND LOAD COMM18 M0301081 JMP ERROR M0301082* M0301083RSV08 LDA COMM18 SEE IF COMM18 ALREADY ACTIVE M0301084 SAZ RSV10 M0301085 JMP* ISAV ALREADY ACTIVE M0301086 SPC 2 M0301087* SEE IF COMM18 IN PROGRAM LIBRARY M0301088* M0301089RSV10 RTJ* CNAME PICKUP ADDRESS OF COMM18 NAME IN Q M0301090 RTJ LOCATE M0301091 SAP RSV20 M0301092 JMP ERROR NOT IN PROGRAM LIBRARY M0301093RSV20 STA* MSECTR START SECTOR M0301094 STQ* MLGTH LENGTH OF COMM18 M0301095 SPC 2 M0301096* M0301097* DETERMINE NUMBER OF PAGES TO ALLOCATE M0301098* M0301099 RTJ* NPAGES M0301100 SPC 2 M0301101* GO ALLOCATE MEMORY M0301102* M0301103 RTJ XMRESV M0301104ÐÐ SPC 2 M0301105* READ OVER FILE INTO AREA ALLOCATED M0301106 RTJ FILRED M0301107 SQP RSV30 M0301108 JMP ERROR READ ERROR M0301109RSV30 LDQ =XPARTBL M0301110 LDQ- 2,Q M0301111 ENA 1 M0301112 RTJ- (ZERO),Q GO INITIALIZE COMM18 M0301113ISAV LDA =N0 M0301114 STA- I RESTORE I M0301115 JMP GETIND M0301116 EJT M0301117* M0301118* SCOM STOP COMM18 AFTER ALL SIMULATORS HAVE BEEN M0301119* RELEASED. M0301120 SPC 2 M0301121COMSTP LDA COMM18 SEE IF COMM18 ALREADY RELEASED M0301122 SAN SCOM10 M0301123 JMP ERROR ALREADY RELEASED M0301124 SPC 2 M0301125* SEARCH PROGRAM LIBRARY FOR COMM18 M0301126* M0301127SCOM10 RTJ* CNAME PICKUP ADDRESS OF COMM18 NAME IN Q M0301128 RTJ LOCATE SEARCH LIBRARY M0301129ÐÐ SAP SCOM20 M0301130 JMP ERROR NOT IN SYSTEM M0301131 SPC 2 M0301132* UNPATCH COMM18 FROM SYSDAT M0301133* M0301134SCOM20 STQ* MLGTH SAVE LENGTH M0301135 LDQ =XPARTBL M0301136 LDQ- 2,Q M0301137 ENA 0 M0301138 RTJ- (ZERO),Q RELEASE COMM18 FROM SYSDAT M0301139 SPC 2 M0301140* RELEASE USER AREA BACK TO ITOS EXECUTIVE M0301141* M0301142 RTJ* NPAGES DETERMINE NUMBER OF PAGES TO RELASE M0301143 RTJ XMRETN M0301144 JMP MIDONE M0301145 EJT M0301146* READ FILE FROM PROGRAM LIBRARY M0301147* M0301148* M0301149FILRED NOP 0 M0301150 RTJ* FILR1 M0301151FILR1 NUM 0 M0301152 LDA* FILR1 M0301153 INA COMPLA M0301154ÐÐ STA* FILCOM M0301155 LDQ =XPARTBL M0301156 LDA- 2,Q M0301157 STA* MBUFAD M0301158* M0301159 RTJ- (AMONI) M0301160 ADC $4844 M0301161FILCOM NUM 0 M0301162 ADC 0,$08C2 M0301163MLGTH NUM 0 M0301164MBUFAD NUM 0 M0301165 ADC 0 M0301166MSECTR ADC 0 M0301167 JMP- (ADISP) M0301168 EQU COMPLA(*-FILR1) M0301169COMPL JMP* (FILRED) M0301170 EJT M0301171* M0301172* CNAME STUFF INTO Q THE ADDRESS OF THE NAME OF COMM18 M0301173* M0301174CNAME NOP 0 M0301175 RTJ* RSVXX M0301176RSVXX NUM 0 M0301177 LDQ* RSVXX M0301178 INQ COMADD M0301179ÐÐ JMP* (CNAME) M0301180COMNAM ALF 3,COMM18 M0301181 EQU COMADD(COMNAM-RSVXX) M0301182 EJT M0301183* M0301184* NPAGES DETERMINES THE NUMBER OF PAGES TO ALLOCATE M0301185* AND RETURNS THE INFO. IN A,Q M0301186* M0301187NPAGES NOP 0 M0301188 LDQ =XPARTBL M0301189 LDA- 2,Q M0301190 SUB- 1,Q A = SIZE OF PARTITION (1) M0301191 ADD* MLGTH DETERMINE THE NUMBER OF PAGES REQUIRED M0301192 ENQ 0 M0301193 LLS 5 M0301194 SAZ PAGE1 M0301195 INQ 1 M0301196PAGE1 LDA TSAREA M0301197 AND- $1D $F800 M0301198 JMP* (NPAGES) M0301199MIPROC EQU MIPROC(MIPRO) M0301200 END MIPROC M0301201 NAM JCRDV4 M05 A ITOS CCS 3.0 SL-149M0500001* MASS STORAGE OPERATING SYSTEM VERSION 5.0 M0500002* SMALL SYSTEMS DIVISION, LA JOLLA, CALIFORNIA M0500003ÐÐ* COPYRIGHT CONTROL DATA CORPORATION 1976 M0500004 SPC 2 M0500005* JCRDV4-STATEMENT PROCESSOR FOR *JOB, *CTO, *PAUS **MSOS 4.0M0500006 SPC 1 **MSOS 4.0M0500007 ENT CRDV4 **MSOS 4.0M0500008 EXT JBPROE **MSOS 4.0M0500009 EXT MIBUF **MSOS 4.0M0500010 EXT TRNVEC **MSOS 4.0M0500011 EXT AUTF9 (TRVEC) M0500012 EXT AUTFA (TRVEC) M0500013 EXT AUTFB (TRVEC) M0500014 EXT FILE2 **MSOS 4.0M0500015 EXT MIB M0500016 EXT LOG1A M0500017 EXT FMPFLG FILEMANAGER M0500018 EXT LOG1A M0500019 EQU EQ(8) M0500020 EQU LPMSK(2) M0500021 EQU H0007($5) M0500022 EQU M7FFF($42) M0500023 EQU HFF(10) **MSOS 4.0M0500024 SPC 1 **MSOS 4.0M0500025CRDV4 NUM $C8FE **MSOS 4.0M0500026 STA ABS M0500027 STA (F2) SET JCRDV4 ADDRESS IN FILE2 M0500028ÐÐ CLR A **MSOS 4.0M0500029 STA MIB CLEAR LOCKOUT **MSOS 4.0M0500030 LDA MIBUF ADDRESS OF INPUT BUFFER **MSOS 4.0M0500031 STA ISAVE M0500032 STA- I **MSOS 4.0M0500033 LDA- 2,I **MSOS 4.0M0500034 LDQ- 1,I **MSOS 4.0M0500035 LRS 8 **MSOS 4.0M0500036 LDQ TRNVEC TRANTA TABLE ADD. IN JOBENT **MSOS 4.0M0500037 EQU TARD(*-1) **MSOS 4.0M0500038 LDQ- 10,Q J.P. REQUEST CODE **MSOS 4.0M0500039 INQ -13 M0500040 LDQ* TAB,Q **MSOS 4.0M0500041 JMP* CRDV4,Q GO TO PROPER ROUTINE **MSOS 4.0M0500042TAB ADC JO-CRDV4 **MSOS 4.0M0500043 ADC CTO-CRDV4 **MSOS 4.0M0500044 ADC PA-CRDV4 **MSOS 4.0M0500045CTO SUB =N$4F2C LOOK FOR O, **MSOS 4.0M0500046 SAZ CT1 FOUND IT **MSOS 4.0M0500047LOAD ENA 2 NOT A $CTO GET JPLOAD AND **MSOS 4.0M0500048 JMP* EXIT+1 TRY TO LOAD IT **MSOS 4.0M0500049CT1 ENQ L-1 INPUT BUFFER LENGTH-1 **MSOS 4.0M0500050 EQU L(36) **MSOS 4.0M0500051CT2 LDA- (ZERO),B LAST WORD OF BUFFER **MSOS 4.0M0500052 EQU ZERO($22) **MSOS 4.0M0500053ÐÐ INA 0 GET RID OF BACKGROUND **MSOS 4.0M0500054 SAZ CT3 **MSOS 4.0M0500055 STA* CTOBUF,Q OVERLAID BUFFER **MSOS 4.0M0500056 RAO* CWD BUMP WORD COUNT **MSOS 4.0M0500057CT3 INQ -1 **MSOS 4.0M0500058 SQM CT4 **MSOS 4.0M0500059 JMP* CT2 GET MORE **MSOS 4.0M0500060CT4 RTJ- ($F4) **MSOS 4.0M0500061CT5 NUM $D00,0 **MSOS 4.0M0500062TR NUM 0 **MSOS 4.0M0500063 NUM $18FC **MSOS 4.0M0500064CWD NUM 0 **MSOS 4.0M0500065 ADC CTOBUF-CT5 **MSOS 4.0M0500066 LDA* TR **MSOS 4.0M0500067 SAZ 1 **MSOS 4.0M0500068 JMP* *-2 **MSOS 4.0M0500069 SQP 1 **MSOS 4.0M0500070 JMP* CT5-1 I/O ERROR TRY AGAIN **MSOS 4.0M0500071 ENA 1 SCHEDULE JBPRO **MSOS 4.0M0500072 JMP* EXIT **MSOS 4.0M0500073CTOBUF BZS CTOBUF(36) M0500074PA SUB =N$5553 WAS STATMENT PAUS **MSOS 4.0M0500075 SAN PAX **MSOS 4.0M0500076 LDA- 2,I MAKE SURE REST **MSOS 4.0M0500077 LDQ- 3,I IS BACKGROUND **MSOS 4.0M0500078ÐÐ LLS 8 **MSOS 4.0M0500079 INA 0 **MSOS 4.0M0500080 SAZ PA1-1 YES **MSOS 4.0M0500081PAX JMP* LOAD NO - TRY TO LOAD IT **MSOS 4.0M0500082 RTJ- ($F4) **MSOS 4.0M0500083PA1 NUM $D00,0 **MSOS 4.0M0500084TR1 NUM 0 **MSOS 4.0M0500085 NUM $18FC,3 **MSOS 4.0M0500086 ADC PABUF-PA1 READY **MSOS 4.0M0500087 LDA* TR1 **MSOS 4.0M0500088 SAZ PA2 **MSOS 4.0M0500089 JMP* *-2 **MSOS 4.0M0500090PA2 LDA* TR1+1 127*5196M0500091 SAP PA3-1 127*5196M0500092 JMP* PA1-1 I/O ERROR TRY AGAIN **MSOS 4.0M0500093 RTJ- ($F4) INPUT A CR **MSOS 4.0M0500094PA3 NUM $0900,0 127*5185M0500095TR2 NUM 0 **MSOS 4.0M0500096 NUM $18FD,0 **MSOS 4.0M0500097 ADC CR-PA3 **MSOS 4.0M0500098 LDA* TR2 **MSOS 4.0M0500099 SAZ PA4 **MSOS 4.0M0500100 JMP* *-2 **MSOS 4.0M0500101PA4 LDA* TR2+1 127*5196M0500102 SAP PA5 127*5196M0500103ÐÐ JMP* PA1-1 I/O ERROR START OVER **MSOS 4.0M0500104PA5 ENA 1 127*5185M0500105 JMP* EXIT **MSOS 4.0M0500106CR NUM 0 **MSOS 4.0M0500107PABUF ALF 3,READY? **MSOS 4.0M0500108ABS NUM 0 ABSOLUTE LOAD ADDRESS **MSOS 4.0M0500109CHCT NUM 0 CHARACTER COUNT **MSOS 4.0M0500110 ENA 1 **MSOS 4.0M0500111EXIT ENQ 14 **MSOS 4.0M0500112 STA* RMOD **MSOS 4.0M0500113 LDA JBPROE **MSOS 4.0M0500114 STA- I **MSOS 4.0M0500115 LDA* RMOD **MSOS 4.0M0500116ERR JMP- (I) **MSOS 4.0M0500117 ENA 1 **MSOS 4.0M0500118 ENQ 6 TERMINATE IN JOBPRO **MSOS 4.0M0500119 JMP* EXIT+1 **MSOS 4.0M0500120RMOD NUM 0 **MSOS 4.0M0500121 EQU PARAM(RMOD) **MSOS 4.0M0500122F2 ADC FILE2 **MSOS 4.0M0500123JO SUB =N$422C IS IT A B, **MSOS 4.0M0500124 EQU NAME(JO) **MSOS 4.0M0500125 SAZ JO1 YES **MSOS 4.0M0500126 SUB =N$D3 LOOK FOR BACKGROUND **MSOS 4.0M0500127 SAN JO11 **MSOS 4.0M0500128ÐÐ RAO* PARAM JOB CARD NO PARAMETERS **MSOS 4.0M0500129 JMP* JO1 **MSOS 4.0M0500130JO11 LDQ (TARD) IS A JOB IN PROGRESS M0500131 LDA- 12,Q M0500132 SAZ J012 NO, OUTPUT JP15 ERROR M0500133 JMP LOAD YES, LET JPLOAD HANDLE IT M0500134JO1 LDQ (TARD) M0500135 LDA- 12,Q IS A JOB IN PROGRESS **MSOS 4.0M0500136 SAZ JO3 **MSOS 4.0M0500137J012 LDA =N$3135 OUTPUT JP15 ERROR M0500138 STA- 10,Q **MSOS 4.0M0500139 JMP* ERR+1 **MSOS 4.0M0500140ISAVE NUM 0 **MSOS 4.0M0500141JO3 LDQ- $FB GET LIST LU M0500142 STQ* WEOFB+4 M0500143 LDQ LOG1A,Q GET PHYSTB ADDRESS M0500144 LDA- EQ,Q GET EQUIPMENT CLASS, TYPE M0500145 AND- LPMSK+14 M0500146 ARS 4 M0500147 SUB =N$28A IS LIST = BATCH OUTPUT DEVICE M0500148 SAN NOEOF SKIP IF NOT M0500149WEOFB RTJ- ($F4) WRITE EOF TO LIST DEVICE M0500150 ADC $1D00 M0500151 ADC 0 M0500152TR3 ADC 0 M0500153ÐÐ ADC 0 M0500154 NUM $2000 M0500155TRL LDA* TR3 M0500156 SAZ NOEOF M0500157 JMP* TRL M0500158NOEOF LDQ (TARD) M0500159 LDA+ AUTF9 RESTORE LOCATIONS $F9,FA,FB M0500160 STA- $F9 TO AUTOLOAD VALUES M0500161 LDA+ AUTFA IN CASE M0500162 STA- $FA PREVIOUS USER M0500163 LDA+ AUTFB HAS CHANGED THEM M0500164 STA- $FB TO SUIT HIS OWN PURPOSES M0500165 LDA FMPFLG IS FILE MANAGER PRESENT M0500166 EOR- M7FFF SEE IF UNPATCHED M0500167 SAN JO31 M0500168 STA FMPFLG CLEAR FMPFLG JUST IN CASE SOMEONE SET IT M0500169JO31 RAO- 12,Q M0500170 LDA* PARAM **MSOS 4.0M0500171 SAZ JO33 **MSOS 4.0M0500172 SET A FLAG ABSENSE OF NAME **MSOS 4.0M0500173 STA- 15,Q **MSOS 4.0M0500174 JMP* JO1A-1 **MSOS 4.0M0500175JO33 RAO- I **MSOS 4.0M0500176 RAO- I **MSOS 4.0M0500177 ENQ 6 M0500178ÐÐ ENA $20 M0500179BLN STA* NAME,Q BLANK OUT NAME BUFFER M0500180 INQ -1 M0500181 SQM 1 M0500182 JMP* BLN M0500183GOON RTJ* CRACK GET THE JOB NAME **MSOS 4.0M0500184 LDA* CT M0500185 SAN 1 M0500186 JMP* ERRX M0500187 ENA 15 M0500188 RTJ PACK PUT NAME IN WORD 15 OF TRANTA M0500189 ENA 0 **MSOS 4.0M0500190 STA* CT **MSOS 4.0M0500191 RTJ* CRACK GET THE ACCOUNT NUMBER **MSOS 4.0M0500192 LDA* CT M0500193 SAN 1 M0500194 JMP* ERRX M0500195 ENA 18 M0500196 RTJ PACK PUT ACCT. IN WORD 18 OF TRANTA M0500197 LDA* ISAVE **MSOS 4.0M0500198 STA- I **MSOS 4.0M0500199 ENQ L-1 **MSOS 4.0M0500200JO1A LDA- (ZERO),B **MSOS 4.0M0500201 INA 0 **MSOS 4.0M0500202 SAZ JO2 **MSOS 4.0M0500203ÐÐ STA CTOBUF,Q M0500204JO2 INQ -1 **MSOS 4.0M0500205 SQM JO3A **MSOS 4.0M0500206 JMP* JO1A **MSOS 4.0M0500207JO3A LDA- $FB STANDARD LIST **MSOS 4.0M0500208 SUB- $FC LU OF OUTPUT COMMENT DEVICE M0500209 SAN TAG100 LIST AND COMMENT UNITS NOT THE SAME M0500210 JMP* EXIT-1 SAME - DO NOT PRINT TWICE M0500211TAG100 LDA- $FB M0500212 EOR- $2F ADD MOBE BIT **MSOS 4.0M0500213 STA* LU **MSOS 4.0M0500214 LDA* ABS **MSOS 4.0M0500215 ADD =XCTOBUF-CRDV4 **MSOS 4.0M0500216 STA* BF **MSOS 4.0M0500217 LDA CTOBUF **MSOS 4.0M0500218 SUB =N$1E00 CHANGE THE * TO A **MSOS 4.0M0500219 STA CTOBUF PAGE EJECT($0C) **MSOS 4.0M0500220 RTJ- ($F4) **MSOS 4.0M0500221JO5 NUM $C00,0 **MSOS 4.0M0500222TR4 NUM 0 **MSOS 4.0M0500223LU NUM 0 **MSOS 4.0M0500224WORDS NUM $24 M0500225BF ADC 0 **MSOS 4.0M0500226 LDA* TR4 **MSOS 4.0M0500227 SAZ JO6 **MSOS 4.0M0500228ÐÐ JMP* *-2 **MSOS 4.0M0500229JO6 SQP JO7 **MSOS 4.0M0500230 JMP* JO5-1 I/O ERROR **MSOS 4.0M0500231JO7 LDQ- $FB LU OF STD LIST DEVICE M0500232 LDQ LOG1A,Q PHYSTB ADDRESS TO Q M0500233 LDA- 8,Q WORD 8 OF PHYSTB TO A M0500234 ARS 11 CLASS CODE TO A 2-0 M0500235 AND- H0007 MASK OFF UPPER BITS M0500236 INA -6 CHECK FOR TTY CLASS M0500237 SAZ JO7A DONT PRINT BLOCK JOB NAME IF TTY M0500238 ENA 8 **MSOS 4.0M0500239 JMP EXIT PRINT THE NAME M0500240JO7A JMP EXIT-1 DON'T PRINT IT M0500241CT NUM 0 M0500242CRACK NOP 0 **MSOS 4.0M0500243JO41 LDA* RL M0500244 SAZ 1 **MSOS 4.0M0500245 JMP* JO4B COMMA WAS IN RIGHT CHAR. POSITION **MSOS 4.0M0500246JO4A LDA- (ZERO),I **MSOS 4.0M0500247 AND- HFF **MSOS 4.0M0500248 RTJ* SUB **MSOS 4.0M0500249 SQZ 1 **MSOS 4.0M0500250 JMP* ASCH1 END OF FIELD **MSOS 4.0M0500251 SAN 1 **MSOS 4.0M0500252 JMP* ASCH2 **MSOS 4.0M0500253ÐÐ RAO* CT M0500254 LDQ* CT INDEX **MSOS 4.0M0500255 STA NAME,Q M0500256JO4B RAO- I **MSOS 4.0M0500257 LDA- (ZERO),I **MSOS 4.0M0500258 TRA Q **MSOS 4.0M0500259JO4 ADQ =N$D3D3 **MSOS 4.0M0500260 SQN 1 **MSOS 4.0M0500261 JMP* ERRX TWO COMMAS IN A ROW **MSOS 4.0M0500262 ARS 8 **MSOS 4.0M0500263 AND- HFF **MSOS 4.0M0500264 RTJ* SUB **MSOS 4.0M0500265 SQN ASCH1 END OF FIELD **MSOS 4.0M0500266 SAZ ASCH1 COMMA **MSOS 4.0M0500267 RAO* CT M0500268 LDQ* CT INDEX **MSOS 4.0M0500269 STA NAME,Q **MSOS 4.0M0500270 JMP* JO41 **MSOS 4.0M0500271ASCH2 ENA 1 M0500272 STA* RL M0500273 JMP* (CRACK) M0500274ASCH1 ENA 0 M0500275 STA* RL M0500276 JMP* (CRACK) M0500277ERRX LDQ (TARD) **MSOS 4.0M0500278ÐÐ LDA =N$3033 **MSOS 4.0M0500279 STA- 10,Q **MSOS 4.0M0500280 JMP ERR+1 **MSOS 4.0M0500281SUB NOP 0 **MSOS 4.0M0500282 ENQ $2C COMMA **MSOS 4.0M0500283 EAQ Q **MSOS 4.0M0500284 SQN SUB2 **MSOS 4.0M0500285SUB5 ENA 0 **MSOS 4.0M0500286 ENQ 0 **MSOS 4.0M0500287 JMP* (SUB) **MSOS 4.0M0500288SUB0 SET Q **MSOS 4.0M0500289SUB1 JMP* (SUB) **MSOS 4.0M0500290SUB2 LDQ- HFF **MSOS 4.0M0500291 EAQ Q **MSOS 4.0M0500292 SQZ SUB2A **MSOS 4.0M0500293 ENQ $20 **MSOS 4.0M0500294 EAQ Q **MSOS 4.0M0500295 SQN SUB3 **MSOS 4.0M0500296SUB2A JMP* SUB0 **MSOS 4.0M0500297SUB3 JMP* SUB5+1 **MSOS 4.0M0500298RL NUM 0 M0500299PACK NUM 0 M0500300 LDQ (TARD) M0500301 AAQ Q M0500302 STQ* ADR M0500303ÐÐ ENQ 1 M0500304ANOT LDA NAME,Q M0500305 ALS 8 M0500306 INQ 1 M0500307 ADD NAME,Q M0500308 STA* (ADR) M0500309 RAO* ADR M0500310 INQ 1 M0500311 INQ -7 M0500312 SQZ DONE M0500313 INQ 7 M0500314 JMP* ANOT M0500315DONE JMP* (PACK) M0500316ADR NUM 0 M0500317 END M0500318 NAM CONTRL M06 A ITOS CCS 3.0 SL-149M0600001* CONTROL STATEMENT PROCESSOR FOR SYSTEM INITIALIZER M0600002* CREDIT COLLECTION SYSTEM VERSION 3.0 M0600003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA M0600004* COPYRIGHT CONTROL DATA CORPORATION 1979 M0600005* M0600006 SPC 2 M0600007 SPC 8 M0600008* E N T R Y P O I N T T A B L E M0600009 SPC 3 M0600010ÐÐ ENT RSTART STARTING ADDRESS OF SYSTEM INITIALIZER M0600011 ENT TCODE FLAG FOR SYSTEM DIRECTORY CORE OR MASS LOAD M0600012 ENT IN INPUT LOGICAL UNIT M0600013 ENT OU MASS STORAGE LOGICAL UNIT M0600014 ENT CO COMMENT DEVICE LOGICAL UNIT M0600015 ENT COMMA ENTRY TO TEST FOR COMMA AS FIELD DEVIMETER M0600016 ENT VALID ENTRY TO TEST FOR A VALID FIELD DELIMETER M0600017 ENT CM45 ENTRY TO READ IN NEXT CONTROL STATEMENT M0600018 ENT CM65 ROUTINE TO PROCESS NEXT CONTROL STATEMENT M0600019 ENT BACKGR ROUTINE TO BACKROUND INPUT BUFFER TO ALL ONES M0600020 ENT LSSECT NEXT AVAILABLE MASS STORAGE SECTOR M0600021 ENT TYPEQ ROUTINE TO GET NEXT CONTROL STATEMENT M0600022* FROM COMMENT DEVICE M0600023 ENT QTYPE ROUTINE TO LOG ERRORS ON TTY M0600024 ENT ERFLAG FLAG INDICATING IF ANY LOADER ERRORS OCCURED M0600025 ENT FMXSEC ROUTINE TO FIND ADDRESS OF MAXSEC M0600026 EJT 1 M0600027* E X T E R N A L T A B L E M0600028 SPC 5 M0600029* EXTERNAL LOCATION IN 'IDRIV' TO PASS 'MSIZV4' M0600030 EXT* I2MZV4 'IDRIV' LOCATION TO BE CONTAINED 'MSIZV4' M0600031 EXT* I1 ROUTINE TO BUILD SYSTEM DIRECTORY M0600032 EXT* I2 CONTROL MODULE FOR MASS STORAGE DRIVERS M0600033 EXT* ISAV STARTING ADDRESS OF LOADER TABLE M0600034 EXT* CONENT ROUTINE TO INITIALIZE LOADER TABLE M0600035ÐÐ EXT* CONMAS ROUTINE TO INITIALIZE MASS STORAGE CONSTANTS M0600036 EXT* CONMS1 ROUTINE TO BUILD PAGE FLAGS IN LDRTBL M0600037 EXT* CONMS M0600038 EXT* ILOAD START OF LOADER FUNCTION M0600039 EXT* TABLE TABLE OF LOGICAL UNITS IN IDRIV M0600040 EXT* IDRIV CONTROL MODULE FOR INPUT DEVICE DRIVERS M0600041 EXT* OETERM ROUTINE TO TEST FOR FIELD TERMINATORS - IN I2 M0600042 EXT* MDRIV MASS STORAGE DRIVER ENTRY M0600043 EXT* QCOM COMMENT DRIVER ENTRY M0600044 EXT* TELOUT ENTRY FOR TELETYPE OUTPUT - NOT COMMENT OUTPUTM0600045 EXT* IDRIV INPUT DRIVER ENTRY M0600046 EXT* FORMFD TOP OF FORM FUNCTION IN LPRINT M0600047 EXT* SIB STANDARD BINARY INPUT LOGICAL UNIT - IN IDRIV M0600048 EXT* MASS MASS STORAGE DEVICE LOGICAL UNIT - IN IDRIV M0600049 EXT* COLU COMMENT DEVICE LOGICAL UNIT - IN IDRIV M0600050 EXT* EPTAPE EQUIPMENT CODE FOR PAPER TAPE **MSOS 4.1**M0600051 EXT* ECARD EQUIPMENT CODE FOR CARD READER **MSOS 4.1**M0600052 EXT* EMTAPE EQUIPMENT CODE FOR MAG TAPE **MSOS 4.1**M0600053 EXT* EMASS EQUIPMENT CODE FOR MASS MEMORY M0600054 EXT* ECOM EQUIPMENT CODE FOR COMMENT **MSOS 4.1**M0600055 EXT* EPRINT EQUIPMENT CODE FOR PRINTER **MSOS 4.1**M0600056 EXT* ENTSTR ROUTINE TO STORE NEW ENTRY POINTS IN ILOAD M0600057 EXT* DISKWR ROUTINE TO STORE A WORD IN CSQ M0600058 EXT* WRTOUT ROUTINE TO WRITE OUT ALL PAGES THAT HAVE M0600059* BEEN MODIFIED M0600060ÐÐ EXT* HEADR1 DATE BUFFER IN LPRINT M0600061 EXT* FNDSEC ROUTINE TO CONVERT PAGE NUMBER TO SECTOR M0600062 EXT* LENSDT NUMBER OF CORE RESIDENT PAGES 66*1455 M0600063 EXT* DATBS0,DATLM0 DATA BASE AND LIMIT FOR PART 0 M0600064 EXT* DATBS1,DATLM1 DATA BASE AND LIMIT FOR PART 1 M0600065 EXT* PART1L MODIFIED LENGTH OF PART1 M0600066 EXT* PART1A MODIFIED ADDRESS OF PART1 M0600067 EXT* SIGNCK 65K SIGN CHECK ROUTINE M0600068 EXT* PART1C STARTING SECTOR OF PART1 IMAGE M0600069 EXT* PARSTR START ADDRESS OF PARTITION LOAD M0600070 EXT* QMASS MASS MEMORY DRIVER ENTRY M0600071 EJT 1 M0600072* LOADER TABLE ENTRIES M0600073 EQU PGENUM(1) CELL FOR PAGE NUMBER IN FLAG TABLE ENTRY M0600074 EQU REFER(2) NUMBER OF TIMES A PAGE HAS BEEN MODIFIED M0600075 EQU MODIFY(3) FLAG SAYING THAT THIS PAGE HAS BEEN MODIFIED M0600076 SPC 3 M0600077 EQU COMBAS(1) RELOCATION BASE FOR COMMON STORAGE M0600078 EQU DATBAS(2) RELOCATION BASE FOR DATA STORAGE M0600079 EQU PROBAS(3) RELOCATION BASE FOR PROGRAM BEING LOADED M0600080 EQU COMLIM(4) HIGHEST ADDRESS OF COMMON STORAGE +1 M0600081 EQU DATLIM(5) HIGHEST ADDRESS OF DATA STORAGE +1 M0600082 EQU CSQLIM(6) HIGHEST ADDRESS OF COMMAND SEQUENCE STORAGE +1M0600083 EQU EXTCTR(7) NEXT AVAILABLE LOCATION IN EXTERNAL TABLE M0600084 EQU ENDSW(8) =1 IF LAST BYTE IN RBD OR BZS BLOCK M0600085ÐÐ EQU ABRLSW(9) 0 IF ABSOLUTE EXTERNAL, 1 IF RELATIVE EXTERNALM0600086 EQU INPWRD(10) END OF COMMAND SEQUENCE STORAGE M0600087 EQU INPREL(11) CONTAINS RELATIVE FLAG FOR WORD OF COMMAND M0600088* SEQUENCE IN RBD OR BZS BLOCK M0600089 EQU CSQNUM(12) NUMBER OF SECTORS RESERVED BEFORE START M0600090* OF COMMAND SEQUENCE STORAGE M0600091 EQU ENTPNT(13) CONTAINS THE ADDRESS ASSOCIATED WITH THE M0600092* NAME IN A ENTRY OR EXTERNAL BLOCK M0600093 EQU LINK(14) CONTAINS ADDRESS ASSOCIATED WITH NAME M0600094* IN LOADER TABLE M0600095 EQU INPCTR(15) USED TO ADDRESS CORE LOCATION OF COMMAND M0600096* SEQUENCE STORAGE AT LOAD TIME M0600097* USED TO HOLD ADDRESS OF ENTRY FOR TABLE M0600098* SEARCH AND TABLE STORE ROUTINES M0600099 EQU NOTLNK(16) FLAG =1 IF UNPATCHED EXTERNALS EXIST M0600100 EQU ENDINP(17) LAST STORAGE ADDRESS +1 AT END OF M0600101* RELOCATABLE BINARY LOAD M0600102 EQU BLANKS(18) ASCII CODE FOR TWO SPACES M0600103 EQU SYMSTR(19) SET TO THE ASCII CODE FOR THE CHARACTERS IN M0600104* EQU SYMSTR+1(20) THE FIELD BEING PROCESSED BY SCAN. IF FIELD M0600105* EQU SYMSTR+2(21) IS NUMERIC SYMSTR=0. M0600106 EQU SCANSW(22) IF BIT ZERO =0 AND FIELD BEING PROCESSED IS M0600107* NUMERIC, THE NUMBER WILL BE PROCESSED AS M0600108* DECIMAL UNLESS PRECEEDED BY $ M0600109* IF BIT ZERO =1 AND FIELD BEING PROCESSED IS M0600110ÐÐ* NUMERIC, THE NUMBER WILL BE PROCESSED AS M0600111* HEXIDECIMAL REGARDLESS OF OCCURENCE OF $ M0600112 EQU BASE(23) BASE OF SYSTEM INITIALIZER M0600113 EQU WRDCNT(24) CHARACTER REFERENCE COUNTER - SET TO STORAGE M0600114* ADDRESS OF THE FIRST CHARACTER OF A FIELD M0600115* TO BE PROCESSED. BIT ZERO IS R/L INDICATER M0600116* 0 = FIRST CHARACTER IN LEFT HALF OF WORD M0600117* 1 = FIRST CHARACTER IN RIGHT HALF OF WORD M0600118 EQU COUNT1(25) CHARACTER COUNTER- SET TO COMPLEMENT OF M0600119* MAXIMUM NUMBER OF CHARACTERS A FIELD MAY HAVE M0600120 EQU BZSSW(26) USED BY SUBROUTINES COMMON TO RBDPRO AND M0600121* BZSPRO TO DETERMINE BLOCK TYPE. M0600122* 0= RBD BLOCK -1= BZS BLOCK M0600123 EQU COUNT2(27) COUNTER USED BY SCAN M0600124 EQU BLKCNT(27) BLOCK COUNTER CONTAINS WORD COUNT FOR M0600125* NUMBER OF SEQUENTIAL LOCATIONS TO BE SET M0600126* TO ZERO IN A BZS BLOCK ENTRY M0600127 EQU SW6(28) FLAGWORD FOR LOADER TABLE SEARCH ROUTINE M0600128* =0 MATCH HAS BEEN FOUND IN TABLE M0600129* =- (NEGATIVE) MATCHING NAME NOT FOUND M0600130 EQU ASAV(29) TEMPORY STORAGE FOR A-REQISTER M0600131 EQU QSAV(30) TEMPORY STORAGE FOR Q-REQISTER M0600132* EQU ISAV(31) TEMPORY STORAGE FOR I-REQISTER M0600133 EQU XFRNAM(32) STORAGE OF SIX CHARACTER TRANSFER ADDRESS M0600134 EQU NAME(35) ASCII CODED INFORMATION M0600135ÐÐ EQU SCHXIT(39) EXIT FROM TABLE SEARCH ROUTINE M0600136 EQU TABSCH(40) ENTRY ADDRESS FOR RTJ TO ROUTINE FOR M0600137* SEARCHING LOADER TABLE FOR ENTRIES OR EXTERNALM0600138 EQU CENTAD(43) ADDRESS OF ENTRY BEING CURRENTLY EXAMINED M0600139* IN ENTRY POINT TABLE M0600140 EQU MAXENT(44) LARGEST ADDRESS BEING USED IN ENTRY POINT TBL M0600141 EQU TEMP(45) TABLE OF TEMPORY LOCATIONS USED BY HASH M0600142 EQU NOJUMP(49) FLAG = 0 IF NO JUMP INSTRUCTION IS M0600143* NEEDED TO JUMP AROUND DATA OR COMMON M0600144 EQU FLGLGN(50) NUMBER OF CORE FLAGS PER PAGE M0600145 EQU BINASC(51) STORAGE OF ASCII CODE FOR NUMBER CONVERSION M0600146 EQU PRINT3(54) ENTRY TO ERROR OUTPUT ROUTINE M0600147 EQU INPXC0(57) CONTAINS ADDRESS CONSTANT INPUT M0600148 EQU INPADR(57) SAME AS INPXCO - ADDRESS OF INPUT BUFFER M0600149 EQU INPXC1(58) CONTAINS ADDRESS CONSTANT INPUT + 1 M0600150 EQU PRINT2(59) ENTRY TO FATAL ERROR OUTPUT ROUTINE M0600151 EQU INPXCC(62) CONTAINS ADDRESS CONSTANT INPUT - 3 M0600152 EQU NXTINP(63) JMP INSTRUCTION TO READ NEXT BLOCK M0600153 EQU M7FFF(65) MASK OF $7FFF M0600154 EQU M8000(66) MASK OF $8000 M0600155 EQU MFF00(68) MASK OF $FF00 M0600156 EQU M00FF(69) MASK OF $00FF M0600157 EQU ASKII(70) ASCII MODE SWITCH FOR 405 AND MAG TAPE M0600158 EQU NEGSW(71) SET BY SCAN TO VALUE OF LEGAL ALGEBRAIC SIGN M0600159 EQU SCNTRM(72) SET BY SCAN TO ASCII CODE FOR FIELD TERMINATORM0600160ÐÐ EQU SCNINP(73) SET BY SCAN TO THE BINARY VALUE OF A NUMERIC M0600161* OPERAND AFTER ITS CONVERSION FROM ASCII M0600162 EQU SCNXIT(74) EXIT FROM SCAN ROUTINE M0600163 EQU SCAN(75) ENTRY TO SCAN ROUTINE M0600164 EQU CSNAME(78) CODE FOR CONTROL STATEMENT BEING PROCESSED M0600165* =1 *Y STATEMENT M0600166* =2 *YM STATEMENT M0600167* =3 *L STATEMENT M0600168* =4 *LP STATEMENT M0600169* =5 *M STATEMENT M0600170* =6 *MP STATEMENT M0600171 EQU XCSNAM(79) CODE FOR LAST CONTROL STATEMENT PROCESSED M0600172 EQU INMED(80) INPUT MEDIUM SWITCH M0600173* 0 = USE COMMENT DEVICE M0600174* 1 = USE STANDARD BINARY INPUT DEVICE M0600175 EQU ADJOVF(82) ENTRY CELL FOR ADDRESS ARITHMETIC SUBROUTINE M0600176 EQU EXTPCH(85) FLAG - NEGATIVE IF EXTERNAL NOT PATCHED M0600177 EQU NGRLSW(86) FLAG - 0= POSITIVE RELOCATION M0600178* 1= NEGATIVE ADDRESS RELOCATION M0600179 EQU ARIT15(87) 0 = USE 15 BIT ARITHMETIC M0600180* 1 = USE 16 BIT ARITHMETIC M0600181 EQU PRESET(88) USED TO HOLD CONTENTS OF A WORD READ INTO COREM0600182* BY THE PAGING ROUTINE DURING A TABLE SEARCH M0600183 EQU CONVRT(90) ENTRY FOR BINARY TO ASCII CONVERSION ROUTINE M0600184 EQU AINPUT(101) A-REGISTER CONTENTS UPON ENTRY TO LOADER M0600185ÐÐ EQU SYSPGE(102) NUMBER OF SYSTEM PAGES M0600186 EQU LINK1(104) ENTRY FOR LINK ROUTINE M0600187 EQU ENTPGS(107) STARTING ADDRESS OF ENTRY POINT TABLE *EXTRA* M0600188 EQU TOP(108) HIGHEST CORE LOCATION AVAILABLE FOR THIS LOAD M0600189 EQU PGEWRT(109) FLAG =1 IF ANY PAGE WRITTEN TO MASS STORAGE M0600190 EQU LGEPGE(110) LARGEST COMMAND SEQUENCE PAGE USED M0600191 EQU IGNORE(111) FLAG SAYING TO IGNORE DUPLICATE ENTRY POINTS M0600192* WHEN LINKING *M OR *MP TO CREP OR CREP1 M0600193 EQU LNKSTR(112) ADDRESS OF LINK TABLE M0600194 EQU LNKCTR(113) NEXT AVAILABLE LOCATION IN LINK TABLE M0600195 EQU LNKEND(114) LAST ADDRESS +1 IN LINK TABLE M0600196 EQU ENTST0(115) STARTING ADDRESS OF PART 0 ENTRY POINTS M0600197 EQU ENTST1(116) STARTING ADDRESS OF PART 1 ENTRY POINTS M0600198 EQU EXTSTR(118) WORD ADDRESS OF START OF EXTERNAL TABLE M0600199 EQU CORADR(119) LOWEST LOCATION AVAILABLE FOR USE BY LOADER M0600200 EQU PRODAT(120) FLAG - NON-ZERO IF PROTECTED DATA IS DECLARED M0600201 EQU PROCOM(121) FLAG - NON-ZERO IF PROTECTED COMMON DECLARED M0600202 EQU PAGE(122) LENGTH OF PAGE FOR MASS MEMORY - MUST BE M0600203* A MULTIPLE OF 96 M0600204 EQU CSQCTR(123) LAST ADDRESS OF PROGRAM COMMAND SEQUENCE M0600205* STORAGE +1 M0600206 EQU CEXTAD(124) ADDRESS OF EXTERNAL BEING CURRENTLY PROCESSED M0600207* FROM EXTERNAL TABLE M0600208 EQU MINEXT(125) FIRST WORD ADDRESS OF SYSTEM EXTERNAL TABLE M0600209 EQU MAXEXT(126) LAST WORD ADDRESS OF SYSTEM EXTERNAL TABLE M0600210ÐÐ EQU ENTSEC(127) STARTING SECTOR OF ENTRY/EXTERNAL TABLES M0600211 EQU CSQSEC(128) STARTING SECTOR OF COMMAND SEQUENCE IMAGE M0600212 EQU MAXPGE(129) MAXIMUM PAGE NUMBER THAT CAN BE USED ON DISK M0600213 EQU NOPAGE(130) NUMBER OF PAGES IN CORE M0600214 EQU PARBAS(131) ADDRESS OF STARTING PARTITION M0600215 EQU PARLIM(132) LAST WORD ADDRESS +1 OF LAST PARTITION M0600216 EQU STRSEC(133) STARTING SECTOR OF IMAGE ON MASS MEMORY M0600217 EQU MSDWCT(134) NUMBER OF WORDS STORED ON MASS MEMORY M0600218 EQU XFRADR(135) TRANSFER ADDRESS OF NAME FROM XFR BLOCK M0600219 EQU AHOLD(136) TEMPORY M0600220 EQU QHOLD(137) TEMPORY M0600221 EQU SECTOR(138) NUMBER OF WORDS IN A SECTOR M0600222 EQU ECREP(139) END ADDRESS OF CREP TABLE M0600223 EQU ECREP1(140) END ADDRESS OF CREP1 TABLE M0600224 EQU EXTSWT(141) FLAG - NON-ZERO IF PROCESSING EXTERNAL BLOCK M0600225 EQU SAVEA(142) TEMPORARY M0600226 EQU JUMP(143) JUMP FLAG FOR I1 M0600227 EQU TEMP3(144) TEMPORARY M0600228 EQU FLGBSE(145) BASE ADDRESS OF CORE FLAGS TABLE M0600229 EQU PROGCT(146) LENGTH OF PROGRAM FROM NAM CARD M0600230 EQU ONTAB(147) *Y ORDINAL COUNTER FOR I1 M0600231 EQU MONTAB(148) *YM COUNTER FOR I1 M0600232 EQU FLGBS1(149) INITIAL ADDRESS OF SYSTEM FLAG TABLE M0600233 EQU INPUT(150) INPUT BUFFER M0600234 SPC 3 M0600235ÐÐ* EQUIVALENCES M0600236 SPC 1 M0600237 EQU SYSECT(16) FIRST SECTOR OF SYSTEM CORE IMAGE M0600238 EJT 1 M0600239* OPERATING SYSTEM INITIALIZER M0600240* ERROR CODES M0600241* M0600242* 1 ASTERISK INITIATOR MISSING M0600243* 2 NUMBER APPEARS IN NAME FIELD M0600244* 3 ILLEGAL CONTROL STATEMENT NAME M0600245* 4 INPUT MODE ILLEGAL M0600246* 5 STATEMENT OTHER THAN *Y OR *YM PREVIOUSLY ENTERED M0600247* 7 *Y NOT ENTERED PRIOR TO FIRST *L STATEMENT M0600248* 6 STATEMENT OTHER THAN *Y PREVIOUSLY ENTERED M0600249* 8 NAME APPEARS IN NUMBER FIELD M0600250* 9 ILLEGAL HEX CORE RELOCATION FIELD M0600251* A ILLEGAL MASS STORAGE SECTOR NUMBER M0600252* B NO DATA RETURN FROM LOADER M0600253* C UNPATCHED EXTERNAL AT CONCLUSION OF SYS DIR LOAD M0600254* D UNPATCHED EXTERNAL AT CONCLUSION OF *L LOAD M0600255* E FIELD TERMINATOR INVALID M0600256* F MORE THAN 120 CHARACTERS IN CONTROL STATEMENT M0600257*10 ORDINAL NAME WITHOUT ORDINAL NUMBER M0600258*11 NAME APPEARED PREVIOUSLY IN LOADER TABLE M0600259*12 INVALID ORDINAL NUMBER M0600260ÐÐ*13 LOADER CONTROL STATEMENT OUT OF ORDER. CORRECT ORDER = L,LP,M,MP M0600261*14 DATA DECLARED DURING *M LOAD BUT NOT BY FIRST M0600262* SEGMENT. INITIALIZATION RESTARTED. M0600263*15 ATTEMPT MADE TO ENTER DATA INTO LOCATION 0 OR M0600264* ABOVE LOCATION $FE. INITIALIZATION RESTARTED. M0600265*16 UNRECOVERABLE MASS STORAGE I/O ERROR M0600266*17 LOADER SLEWING ALL BLOCKS UNTIL NEXT NAM BLOCK. M0600267*18 FIRST STATEMENT INPUT TO INITIALIZER DID NOT DEFINE M0600268* THE MASS STORAGE DEVICE. M0600269*19 UNABLE TO READ IN BAD SECTOR DIRECTORY M0600270*20 *S,END0V4,HHHH NOT DEFINED BEFORE FIRST *L CONTROL STATEMENT M0600271*21 *S,MSIZV4,HHHH NOT DEFINED BEFORE FIRST *LP CONTROL STATEMENT M0600272*22 ATTEMPT TO LOAD PART 1 CORE RESIDENT INTO UNAVAILABLE MEMORY M0600273*23 THE NAME USED IN THE SECOND FIELD OF A *M CONTROL STATEMENT M0600274* WAS NOT PREVIOUSLY DEFINED AS AN ENTRY POINT M0600275*24 THE ENTRY POINT SECTOR WAS NOT DEFINED AT THE START OF M0600276* INITIALIZATION AND IS NOT AVAILABLE TO THE INITIALIZER M0600277*25 ILLEGAL PARTITION NUMBER IN FIRST FIELD OF *MP STATEMENT M0600278* OR ILLEGAL NUMBER OF PARTITIONS IN SECOND FIELD OF STATEMENT M0600279*26 AN ATTEMPT WAS MADE TO LOAD *MP PROGRAMS WHEN NO PARTITIONED M0600280* CORE TABLE EXISTS IN SYSDAT M0600281* ********************************************************************M0600282 EJT 1 M0600283RSTART IIN 0 CAUSE PROTECT ERROR IF CALLED AS 122*4842M0600284* AN ITOS USER PROGRAM 122*4842M0600285ÐÐ RTJ CONENT 122*4842M0600286 ENA SYSECT SET STARTING AREA OF DISK M0600287 STA LSSECT M0600288 LDA COLU INITIALIZE COMMENT DEVICE LOGICAL UNIT M0600289 STA CO M0600290 LDA SIB INITIALIZE STANDARD BINARY INPUT LOGICAL UNIT M0600291 STA IN M0600292 LDA MASS INITIALIZE MASS STORAGE UNIT **MSOS 4.1**M0600293 STA OU **MSOS 4.1**M0600294 LDA CONENT PICKUP STARTING ADDRESS OF CONTROL M0600295 INA -3 122*4842M0600296 RTJ- CONVRT,I CONVERT TO ASCII M0600297 LDA- BINASC,I PICKUP FIRST WORD OF ADDRESS M0600298 STA* SI+23 STORE IN OUTPUT BUFFER **MSOS 4.1**M0600299 LDA- BINASC+1,I PICKUP SECOND WORD OF ADDRESS M0600300 STA* SI+24 STORE IN OUTPUT BUFFER **MSOS 4.1**M0600301 RTJ* CNTR1 GENERATE BUFFER ADDRESS M0600302SI ALF 14,ITOS 1.2 SYSTEM INITIALIZER M0600303 NUM $0D0A CARRIAGE RETURN - LINE FEED M0600304 ALF *,FWA OF CONTRL = * M0600305 NUM 0,0 RESERVED FOR ADDRESS OF CONTROL M0600306 NUM $0D0A CARRIAGE RETURN - LINE FEED M0600307CNTR1 NOP 0 STORAGE FOR RUN-TIME BUFFER ADDRESS M0600308 LDA* CNTR1 PICKUP BUFFER ADDRESS M0600309CNTR2 ENQ 26 PICKUP WORD COUNT **MSOS 4.1**M0600310ÐÐ RTJ TELOUT OUTPUT MESSAGE TO TELETYPE M0600311CNTR3 RTJ BACKGR BACKROUND INPUT BUFFER TO ALL ONES M0600312 CLR A **MSOS 4.1**M0600313 RTJ I2 INITIALIZE FOR AUTOLOAD **MSOS 4.1**M0600314 RTJ* CNTR9 JUMP AROUND BUFFER M0600315 NUM $0D0A CARRIAGE RETURN - LINE FEED M0600316DATE1 ALF 7,DATE MM/DD/YY M0600317CNTR9 NOP 0 RUN TIME BUFFER ADDRESS M0600318 ENQ 8 SETUP WORD COUNT M0600319 LDA* CNTR9 PICKUP BUFFER ADDRESS M0600320 RTJ TELOUT OUTPUT MESSAGE TO TELETYPE M0600321 CLR Q SET FLAG FOR COMMENT INPUT M0600322 LDA- INPADR,I SETUP POINTER TO BUFFER M0600323 RTJ QCOM READ IN DATE M0600324 SPC 2 M0600325 ENQ 3 MOVE DATE TO BUFFER IN LPRINT M0600326CNTR10 LDA- INPUT,B M0600327 INA 0 M0600328 STA HEADR1,Q M0600329 INQ -1 M0600330 SQM CNTR11-*-1 SKIP OUT IF ENTIRE DATE MOVED M0600331 JMP* CNTR10 MOVE NEXT WORD OF DATE M0600332CNTR11 RTJ CONMAS INITIALIZE MASS STORAGE CONSTANTS M0600333 CLR A ZERO THE FOLLOWING LOCATIONS M0600334 STA FORMFD M0600335ÐÐ STA YORDNL CLEAR CORE RESIDENT ORDINAL COUNTER M0600336 STA I1CALL M0600337 STA ERFLAG M0600338 STA PART1C M0600339 STA PART1L M0600340 STA PART1A M0600341 STA FRSTLP M0600342 STA PARDEF M0600343 STA CRPFLG M0600344 STA YPOINT M0600345 STA END0V4 M0600346 STA PARTBL M0600347 STA LSTLOC M0600348 STA MSIZV4 M0600349 STA MAXSEC M0600350 STA YCNTER M0600351 STA ENTTMP M0600352 STA STRTEX M0600353 STA TEMPEX M0600354 STA ENDEXT M0600355 STA YMCNTR M0600356 STA YMORDN M0600357 STA PP M0600358 STA NN M0600359 STA SECVAL M0600360ÐÐ STA BLDADD M0600361 STA PCOUNT M0600362 STA PAGADD M0600363 STA TMPSEC M0600364 STA LENDC M0600365 STA LPENDC M0600366 STA DATBS0 CLEAR PART 0 DATA BASE M0600367 STA DATLM0 CLEAR PART 0 DATA LIMIT M0600368 STA DATBS1 CLEAR PART 1 DATA BASE M0600369 STA DATLM1 CLEAR PART 1 DATA LIMIT M0600370 LDA =N$7FFF M0600371 STA (MSIZV4) M0600372 JMP* CM20 GET NEXT CONTROL STATEMENT M0600373CMASKT NUM $002A MASK FOR ASTERISK M0600374 EJT 1 M0600375* ********************************************************************M0600376* BACKGROUND BUFFER TO ALL ONES M0600377* SETUP CALL TO COMMENT OR INPUT MEDIUM DRIVER M0600378* ********************************************************************M0600379CM20 RTJ BACKGR BACKGROUND INPUT BUFFER M0600380* M0600381CM40 LDA- INPADR,I ADDRESS OF INPUT BUFFER TO A M0600382 LDQ- INMED,I FETCH INPUT MEDIUM SWITCH M0600383 SQZ CM44-*-1 M0600384 JMP* CM50 M0600385ÐÐCM44 ENQ 1 NO ERROR IF Q = 1 M0600386 RTJ TYPEQ TYPE Q M0600387CM45 CLR Q Q ZERO FOR INPUT OPERATION M0600388 RTJ QCOM CALL COMMENT MEDIUM DRIVER M0600389CM45A SAN CM65 **MSOS 4.1**M0600390 JMP* CM44 TYPE Q, INTERROGATE COMM MEDIUM **MSOS 4.1**M0600391CM50 ENQ 96 SETUP WORD COUNT FOR READ M0600392 TCA A A-= BINARY MODE FOR CARD READER M0600393 RTJ IDRIV CALL INPUT MEDIUM DRIVER M0600394CM60 SAN CM65-*-1 NO DATA RETURN IF ZERO M0600395 JMP* CM44 TYPE Q, INTERROGATE COMM MED M0600396CM65 LDA- INPADR,I ADDR OF INPUT BUFFER M0600397 ENQ 30 PRINT 30 WORDS M0600398 RTJ QCOM CALL COMMENT DRIVER M0600399 EJT 1 M0600400* M0600401* TEST FIRST CHARACTER IN INPUT BUFFER FOR AN ASTERISK M0600402* M0600403 LDQ- INPADR,I PICKUP ADDRESS OF INPUT BUFFER **MSOS 4.1**M0600404 LDA- CSNAME,I CURRENT CONT STMNT NAME CODE M0600405 STA- XCSNAM,I TO PREVIOUS M0600406 INQ -1 Q = ADDR OF INPUT BUFFER - 1 M0600407 LDA- 1,Q FETCH FIRST WORD OF INPUT BUFFER M0600408 ARS 8 SHIFT OFF RIGHT HAND HALF M0600409 EOR* CMASKT TEST FOR AN ASTERISK (*) M0600410ÐÐ SAZ CM80-*-1 ZERO IMPLIES CHAR IS ASTERISK M0600411 ENA 1 ASTERISK INITIATOR MISSING M0600412 JMP* CM195X+1 TYPE Q AND INTERROGATE COM MED M0600413CM80 LDA- INPADR,I ADDRESS OF INPUT BUFFER M0600414 ALS 1 TO BITS (15 - 1) M0600415 INA 1 SET RIGHT HALF WORD SWITCH TO ON M0600416 STA- WRDCNT,I PLACE IN SCAN CONTROL WORD M0600417 ENA $8 LEADING + OR - ILLEG, NAME OR M0600418 STA- SCANSW,I DEC NBR OK. TO SCAN CONTROL WD M0600419 CLR A CLEAR A PRIOR TO CALLING SCAN M0600420 RTJ- SCAN,I FETCH A CONTROL STATEMENT CODE M0600421 LDA- SYMSTR,I ZERO IMPLIES A NUMBER M0600422 SUB- 18,I TWO BLANKS 2020 M0600423 SAN CM90-*-1 ZERO IMPLIES NO FIELD PRESENT M0600424 JMP* CM190 TEST FOR *CR M0600425 EJT 1 M0600426* C O N T R O L S T A T E M E N T R E C O G N I Z E R M0600427 SPC 1 M0600428CM90 CLR Q CLEAR TABLE INDEX M0600429CM72 LDA* STTYP1,Q PICKUP TABLE ENTRY M0600430 SAN CM74-*-1 GO ON IF NOT AT END OF TABLE M0600431 JMP* CM195X END OF TABLE - ERROR M0600432CM74 EOR- SYMSTR,I COMPARE TABLE ENTRY TO INPUT M0600433 SAZ CM76-*-1 ENTRY COMPARES CHECK SECOND WORD M0600434 INQ 1 NO COMPARE, CHECK NEXT TABLE ENTRY M0600435ÐÐ JMP* CM72 M0600436CM76 LDA- BLANKS,I MAKE SURE THAT SECOND WORD OF M0600437 EOR- SYMSTR+1,I CONTROL STATEMENT IS BLANKS M0600438 SAZ CM78-*-1 M0600439 JMP* CM195X ERROR UNRECOGNIZEABLE CONTROL STATEMENT M0600440CM78 LDA- CSNAME,I PICKUP CODE OF LAST CONTROL STATEMENT M0600441 QLS 1 MULTIPLY TABLE INDEX BY TWO M0600442 JMP* STTYP3,Q GO TO PROCESS CONTROL STATEMENT M0600443CM190 LDA- INPREL,I TEST FOR CARRIAGE RETURN M0600444 LDQ- CSNAME,I CONTROL STATEMENT NAME M0600445CM195 SQN CM196-*-1 NON-ZERO IMPLIES *CR M0600446CM195X ENA 3 ILLEGAL CONTROL STMNT NAME M0600447HOP2 JMP* YM2 ZERO IMPLIES ILLEGAL STATEMENT, OUTPUT ERROR M0600448CM196 JMP* CM20 HANDLE ASTERISK FOLLOWED BY BLANK M0600449* AS COMMENT CARD. COMMENT CARDS MUST BE M0600450* FOLLOWED BY ANOTHER COMMENT CARD OR M0600451* BY A CONTROL STATEMENT. THEY ARE NOT M0600452* ALLOWED BETWEEN TWO PROGRAMS OR M0600453* IMMEDIATELY PRECEEDING A PROGRAM. M0600454 SPC 2 M0600455STTYP1 ALF 1,L *L CORE RESIDENT PART 0 M0600456 ALF 1,LP *LP CORE RESIDENT PART 1 M0600457 ALF 1,M *M MASS RESIDENT PART 0 M0600458 ALF 1,MP *MP MASS RESIDENT PART 1 M0600459 ALF 1,S *S DEFINE ENTRY POINT M0600460ÐÐ ALF 1,Y *Y DEFINE CORE RESIDENT DIRECTORY ENTRY M0600461 ALF 1,YM *YM DEFINE MASS RESIDENT DIRECTORY ENTRY M0600462 ALF 1,V *V CONTROL TO STANDARD BINARY INPUT M0600463 ALF 1,U *U CONTROL TO STANDARD COMENT DEVICE M0600464 ALF 1,I *I ASSIGN STANDARD BINARY INPUT DEVICE M0600465 ALF 1,O *O ASSIGN STANDARD LIBRARY DEVICE M0600466 ALF 1,C *C ASSIGN STANDARD LIST DEVICE M0600467 ALF 1,T *T END OF BINARY INPUT M0600468 ALF 1,D *D DEFINE DATA M0600469 ALF 1,G *G WRITE DISK ADDRESS TAGS M0600470 ALF 1,H *H PERFORM DISK SURFACE TEST M0600471 NUM 0 *** END OF TABLE *** M0600472STTYP3 JMP STARL *L M0600473 JMP STARLP *LP M0600474 JMP STARM *M M0600475 JMP STARMP *MP M0600476 JMP STARS *S M0600477 JMP STARY *Y M0600478 JMP STARYM *YM M0600479 JMP STARV *V M0600480 JMP STARU *U M0600481 JMP STARI *I M0600482 JMP STARO *O M0600483 JMP STARC *C M0600484 JMP START *T M0600485ÐÐ JMP STARD *D M0600486 JMP STARG *G M0600487 JMP STARH *H M0600488 EJT 1 M0600489* R O U T I N E T O G E T A H E X I D E C I M A L M0600490* M0600491* V A L U E F R O M A F I E L D O F A M0600492* M0600493* C O N T R O L S T A T E M E N T A N D R E T U R N M0600494* M0600495* I T S B I N A R Y V A L U E I N ' A ' M0600496 SPC 3 M0600497GETHEX NOP 0 ENTRY LOCATION FOR STORAGE OF RETURN ADDRESS M0600498 ENA 9 SET BIT 0 OF SCANSW SAYING GET HEX FIELD M0600499 STA- SCANSW,I SET BIT 3 OF SCANSW SAYING SAVE ASCII CODES M0600500 CLR A M0600501 RTJ- SCAN,I CHECK INPUT FIELD M0600502 JMP* (GETHEX) RETURN TO CALLER WITH BINARY VALUE IN SCNINP M0600503 SPC 8 M0600504* R O U T I N E T O C H E C K F O R C O M M A M0600505 SPC 3 M0600506* C A L L I N G S E Q U E N C E M0600507 SPC 3 M0600508* RTJ* COMMA CALL ROUTINE M0600509* XXX P+1 - ERROR RETURN, NO COMMA M0600510ÐÐ* XXX P+2 - NORMAL RETURN, COMMA DELIMETER FOUND M0600511 SPC 2 M0600512COMMA NOP 0 ENTRY LOCATION FOR STORAGE OF RETURN ADDRESS M0600513 RTJ OETERM GO TO I1 TO FIND TERMINATOR TYPE M0600514 INQ -2 OETERM RETURNS 2 IN Q-REGISTER IF COMMA FOUND M0600515 SQN 1 SKIP IF NOT COMMA M0600516 RAO* COMMA UPDATE RETURN ADDRESS, COMMA FOUND M0600517 JMP* (COMMA) RETURN TO CALLER M0600518 EJT 1 M0600519* R O U T I N E T O P R O C E S S * Y O R * Y M M0600520 SPC 3 M0600521STARYM INA -3 MAKE SURE CSNAME IS LESS THAN TWO MEANING M0600522 SAM YM1-*-1 THAT STATEMENTS ARE IN ORDER M0600523 ENA 5 ERROR 5, STATEMENT OTHER THAN *Y OR *YM M0600524YM2 JMP* LSTM4 PREVIOUSLY ENTERED M0600525YM1 ENA 2 SET UP CONTROL STATEMENT NAME CODE M0600526 JMP* Y0 GO TO PROCESS ORDINAL M0600527STARY INA -2 MAKE SURE THAT CSNAME IS LESS THAN OR EQUAL M0600528 SAM Y1-*-1 TO ONE MEANING THAT ONLY *Y'S HAVE BEEN INPUT M0600529 ENA 6 ERROR 6, STATEMENT OTHER THAN M0600530 JMP* YM2 *Y PREVIOUSLY DEFINED M0600531Y1 ENA 1 SETUP CONTROL STATEMENT NAME CODE M0600532Y0 STA- CSNAME,I SAVE CODE FOR STATEMENT TYPE M0600533 LDQ- INPXC0,I LOAD Q WITH THE ADDRESS OF THE INPUT BUFFER M0600534 RTJ I1 CALL I1 TO BUILD SYSTEM DIRECTORY M0600535ÐÐ JMP CM20 READ NEXT CONTROL STATEMENT **MSOS 4.1**M0600536I1CALL NUM 0 ZERO IF MODULE I1 NOT CALLED M0600537 EJT 1 M0600538* R O U T I N E T O P R O C E S S * L S T A T E M E N T M0600539 SPC 3 M0600540STARL SAN LSTM1-*-1 HAS I1 ALREADY RUN M0600541 ENA 7 ERROR 7, NO SYSTEM DIRECTORY BUILT M0600542 JMP* LSTM4 BEFORE PROGRAM LOAD M0600543LSTM1 INA -3 M0600544 SAM LSTM3A-*-1 LAST STATEMENT WAS *Y OR *YM M0600545 SAN LSTM2 STATEMENT BAD M0600546 JMP* LSTM3D LAST STATEMENT WAS *L M0600547LSTM2 ENA $13 STATEMENT IS OUT OF ORDER M0600548 JMP* LSTM4 M0600549LSTM3A RTJ* LSTM3B PICKUP RUN-TIME ADDRESS OF ENTRY POINT NAME M0600550 ALF 3,END0V4 NAME FOR END ADDRESS OF PART 0 M0600551LSTM3B NOP 0 ENTRY POINT ADDRESS M0600552 LDA* LSTM3B M0600553 STA- INPCTR,I MAKE SURE THAT END OF PART 0 WAS DEFINED M0600554 RTJ- TABSCH,I BEFORE BEGINNING *L LOAD M0600555 LDQ- SW6,I HAS THIS NAME BEEN DEFINED M0600556 SQM LSTM3C-*-1 NO, PRINT ERROR M0600557 STA- COMLIM,I YES, SAVE AS UPPER BOUND FOR LOAD M0600558 STA- TOP,I SAVE AS END OF PART 0 M0600559 STA END0V4 SAVE END ADDRESS OF PART 0 M0600560ÐÐLSTM3D JMP* LSTM4A GO TO EXIMINE *L CONTROL STATEMENT M0600561LSTM3C ENA $20 ERROR 20, *S,END0V4,HHHH NOT ENTERED M0600562 JMP* LSTM4 BEFORE THE FIRST *L CONTROL STATEMENT M0600563LSTM4A ENA 3 SET CSNAME=3, SAYING *L IS BEING PROCESSED M0600564 STA- CSNAME,I M0600565LSTM40 RTJ* COMMA IS FIELD DELIMETER A COMMA M0600566 JMP* LSTM41 NO, CHECK FOR END OF STATEMENT M0600567 RTJ* GETHEX YES, PICKUP THE LOAD ADDRESS M0600568 LDA- SYMSTR,I MAKE SURE THAT THE FIELD IS NUMERIC M0600569 SAN LSTM4Q THIS FEILD NOT NUMERIC M0600570 JMP* LSTM5 THIS FIELD NUMERIC, CHECK IF VALID M0600571LSTM4Q SUB- BLANKS,I IS THIS FIELD EMPTY M0600572 SAZ LSTM43-*-1 YES GO ON TO LOAD STAGE M0600573 ENA 8 ERROR 8, NAME APPEARS IN NUMBER FIELD M0600574LSTM4 JMP QTYPE M0600575LSTM41 RTJ VALID TEST FOR CARRIAGE RETURN OR BLANK DELIMETER M0600576 SQZ LSTM43 TERMINATOR IS VALID M0600577LSTM42 ENA $E ERROR E, INVALID FIELD TERMINATOR M0600578 JMP* LSTM4 M0600579LSTM43 LDA- PROBAS,I IS THIS *L FOR SYSDAT M0600580 SAZ LSTM4X YES M0600581 SUB- $EB NO, DOES *L IMMEDIATELY FOLLOW SYSDAT M0600582 SAN LSTM4X NO, JUST LOAD AT PROBAS M0600583 LDA- $EB YES, INCREASE PROBAS PAST SYSTEM M0600584 ADD- $E6 DIRECTORY M0600585ÐÐ STA- PROBAS,I M0600586 CLR Q COMPUTE NUMBER OF PAGES USED FOR M0600587 DVI =N$60 SYSDAT AND DIRECTORY M0600588 SQZ EVPG M0600589 INA 1 M0600590EVPG STA LENSDT NUMBER OF CORE RESIDENT PAGES M0600591LSTM4X JMP* LSTM8 GO LOAD PROGRAM STARTING AT PROBAS M0600592LSTM5 LDA- PROBAS,I CHECK FOR A VALID LOAD ADDRESS M0600593 SAZ LSTM6-*-1 SKIP IF LOADER PROGRAM BASE IS ZERO M0600594 SUB- $EB DOES THIS *L IMMEDIATELY FOLLOW THE SYSDAT M0600595 SAN LSTM6-*-1 NO, COMPARE THE LOAD ADDRESS TO PROBAS M0600596 LDA- $EB YES, INCREASE PROBAS PAST THE SYSTEM M0600597 ADD- $E6 DIRECTORY AND THEN COMPARE THE LOAD ADDRESS M0600598 STA- PROBAS,I TO PROBAS M0600599 CLR Q M0600600 DVI =N96 COMPUTE NUMBER OF PAGES USED FOR M0600601 SQZ EVENPG SYSDAT AND DIRECTORY M0600602 INA 1 M0600603EVENPG STA LENSDT NUMBER OF CORE RESIDENT PAGES M0600604LSTM6 LDA- SCNINP,I HEX LOAD ADDRESS M0600605 LDQ- PROBAS,I LOAD PROGRAM BASE M0600606* M0600607* SIGN CHECK COMPARES A AND Q, M0600608 RTJ SIGNCK IF A.GT.Q OR A.EQ.Q, A RETURNS M0600609* A POSITIVE VALUE, IF A.LT.Q THEN M0600610ÐÐ* A RETURNS NEGATIVE M0600611* M0600612 SAP LSTM7 NEW BASE IS GREATER THAN PROBAS M0600613 JMP* LSTM6A ILLEGAL PROGRAM RELOCATION BASE M0600614LSTM7 LDQ* CRPFLG IF WE ARE IN PART1 (*LP LOADS) M0600615 SQN LSTM7X NO NEED TO CHECK COMLIM M0600616 LDA- COMLIM,I IS THE RELOCATION BASE BELOW THE M0600617 LDQ- SCNINP,I BEGINNING OF SYSTEM COMMON M0600618 RTJ SIGNCK M0600619 SAP LSTM7A YES, CONTINUE THE LOAD M0600620 JMP* LSTM6A ILLEGAL PROGRAM RELOCATION BASE M0600621LSTM7A LDQ- SCNINP,I UPDATE PROBAS TO THE NEW LOAD ADDRESS MAKING M0600622 STQ- PROBAS,I THE AREA BETWEEN THE OLD AND NEW ADDRESSES M0600623 STQ- CSQCTR,I UNAVAILABLE FOR LOADING M0600624LSTM7L RTJ VALID TEST FOR VALID RECORD TERMINATOR M0600625 SQZ LSTM8-*-1 SKIP IF TERMINATOR IS VALID M0600626 JMP* LSTM42 ERROR E, ILLEGAL FIELD TERMINATOR M0600627LSTM7X ADD- CSQCTR,I A-REG NOW CONTAINS RELATIVE DISTANCE M0600628 STA- CSQCTR,I FROM PROBAS,I TO SCNINP,I M0600629 LDQ- SCNINP,I CSQCTR,I IN PART 1 LOADS CONTAINS M0600630 STQ- PROBAS,I AN ACCUMULATION OF PROGRAM LENGTHS M0600631 JMP* LSTM7L ADDED TO PART1L FOR LENGTH OF PART 1. M0600632LSTM6A ENA 9 ILLEGAL PROGRAM RELOCATION BASE M0600633 JMP* LSTM4 OUTPUT THE ERROR M0600634LSTM8 RAO* YORDNL INCREMENT THE ORDINAL COUNTER M0600635ÐÐ LDQ- ONTAB,I PICKUP THE NEXT ADDRESS TO CHECK IN THE M0600636* *Y ORDINAL TABLE M0600637 SQZ LSTM9-*-1 SKIP IF THERE WERE NO *Y STATEMENTS M0600638 LDA* YORDNL PICKUP THE ORDINAL OF THIS *L STATEMENT M0600639 SUB- 1,Q COMPARE IT TO THE NEXT ENTRY IN THE M0600640* *Y ORDINAL TABLE M0600641 SAZ LSTM8A-*-1 SKIP IF THIS ORDINAL IS IN THE TABLE M0600642LSTM9 JMP* LSTM9A M0600643YORDNL NUM 0 ORDINAL OF CURRENT *L STATEMENT M0600644LSTM8A RAO- ONTAB,I INCREMENT POINTER FOR ORDINAL TABLE M0600645 RAO* YCNTER INCREMENT COUNTER OF CORE RESIDENT ORDINALS M0600646 ENA 4 LENGTH OF SYSTEM DIRECTORY ENTRY TIMES M0600647 MUI* YCNTER COUNTER OF CORE RESIDENT ORDINALS EQUALS M0600648 TRA Q THE INDEX TO THE SYSTEM DIRECTORY ENTRY M0600649 INQ -3 DECREMENT INDEX TO WORDQ OF ENTRY M0600650 LDA- PROBAS,I PICKUP RELOCATION BASE FOR PROGRAM BEING M0600651 STA- ($EB),Q LOADED AND STORE IN WORD 2 OF THE SYSTEM M0600652* DIRECTORY ENTRY M0600653 STQ* YPOINT M0600654 LDA- CSNAME,I CHECK FOR *L OR *LP TO DETERMINE M0600655 INA -3 REQUEST CODE FOR SYSTEM DIRECTORY ENTRY M0600656 SAZ LSTM8B-*-1 *L M0600657 LDA =N$4200 *LP REQUEST CODE NEEDS D-BIT SET = 4200 M0600658 JMP* LSTM8C M0600659LSTM8B LDA =N$200 *L REQUEST CODE = 0200 M0600660ÐÐLSTM8C INQ -1 DECREMENT POINTER TO START OF ENTRY M0600661 STA- ($EB),Q STORE REQUEST CODE IN WORD 0 OF ENTRY M0600662LSTM9A LDA- CSNAME,I M0600663 INA -4 IS THIS A *LP STATEMENT M0600664 SAN LSTM9B-*-1 NO, M0600665 LDA* FRSTLP YES, IS THIS THE FIRST *LP M0600666 SAN LSTM9B-*-1 NO, GO TO LOAD M0600667 RTJ* LPBNDY YES, GO TO SETUP AUTOLOAD PARAMETERS M0600668LSTM9B LDA- PROBAS,I M0600669 STA* STLOAD M0600670 CLR A,Q SETUP A RELOCATABLE LOAD FUNCTION M0600671 RTJ ILOAD LOAD THE PROGRAM M0600672 LDA- CSNAME,I M0600673 INA -4 IS THIS A *LP LOAD M0600674 SAN LSTM9C NO M0600675 LDQ (PARTBL) Q = START ADDRESS OF PARTITION 0 M0600676 TCQ Q M0600677 LDA* STLOAD A = START OF LAST PROGRAM LOAD M0600678 AAQ A COMPUTE STLOAD - PARTBL(0) M0600679 SAZ LSTMER ERROR, PROGRAM OVERLAYS PARTITION 0 M0600680 SAP LSTM9C SKIP IF PROGRAM STARTS ABOVE THE PARTITIONS M0600681 LDA- PROBAS,I M0600682 AAQ A COMPUTE PROBAS - PARTBL(0) M0600683 SAM LSTM9C OK, PROGRAM ENDS BELOW BELOW PARTITION 0 M0600684LSTMER ENA 5 ERROR 5 M0600685ÐÐ JMP* LSTM4 OUTPUT THE ERROR M0600686 SPC 1 M0600687LSTM9C LDQ* YPOINT PICKUP THE INDEX FOR THIS SYSTEM DIRECTORY M0600688* ENTRY M0600689 LDA- ($EB),Q FETCH THE INITIAL EXECUTION ADDRESS FOR THIS M0600690 SUB- DATBAS,I BLOCK OF PROGRAMS AND COMPARE IT TO THE M0600691 SAN LSTM9D-*-1 RELOCATION BASE FOR DATA STORAGE M0600692 LDA- DATLIM,I IF THEY ARE EQUAL RESET THE FIRST EXECUTABLE M0600693 STA- ($EB),Q ADDRESS TO THE END OF THE DATA BLOCK M0600694LSTM9D LDA- CSNAME,I M0600695 INA -4 IS THIS A *LP M0600696 SAN LSTM9E-*-1 NO, GO TO GET NEXT STATEMENT M0600697 RAO* FRSTLP YES, SET FLAG SAYING LP PROCESSED M0600698LSTM9E JMP CM65 GO TO PROCESS THE NEXT CONTROL STATEMENT M0600699PARDEF NUM 0 FLAG SAYING IF PARTITIONS WERE DEFINED M0600700CRPFLG NUM 0 FLAG INDICATING IF CREP1 OR CREP IS USED M0600701YPOINT NUM 0 TEMPOTARY HOLDER FOR ORDINAL M0600702END0V4 NUM 0 ENDING ADDRESS OF PART 0 M0600703YCNTER NUM 0 COUNTER OF ORDINAL PROGRAMS M0600704FRSTLP NUM 0 FLAG INDICATING IF LP HAS BEEN PROCESSED M0600705STLOAD NUM 0 PREVIOUS *LP LOAD ADDRESS M0600706 SPC 1 M0600707LPBNDY NOP 0 M0600708 LDA- PROBAS,I PICKUP PROGRAM BASE FOR FIRST LP M0600709 CLR Q M0600710ÐÐ DVI =N96 DEVIDE BY SECTOR LENGTH M0600711 ADD LSSECT ADD STARTING SECTOR OF CORE IMAGE M0600712 STA PART1C SAVE STARTING SECTOR OF PART1 CORE IMAGE M0600713 STQ PART1L SAVE INCREMENTAL PART OF PART 1 IMAGE M0600714 TCQ Q M0600715 ADQ- PROBAS,I M0600716 STQ PART1A SAVE MODIFIED CORE ADDRESS OF PART1 M0600717 JMP* (LPBNDY) M0600718 EJT 1 M0600719* R O U T I N E T O P R O C E S S * L P S T A T E M E N T M0600720 SPC 5 M0600721STARLP INA -3 WAS THE LAST STATEMENT *L M0600722 SAZ LP2-*-1 YES M0600723 INA -1 NO, WAS THE LAST STATEMENT *LP M0600724 SAZ LP1-*-1 YES, GO TO PROCESS THIS *LP M0600725 ENA $13 NO, ERROR 13 CONTROL STATEMENT OUT OF ORDER M0600726LP0 JMP LSTM4 OUTPUT THE ERROR M0600727LP1 JMP LSTM40 M0600728LP2 CLR Q ISSUE A PATCH ENTRY POINTS FUNCTION TO M0600729 ENA 1 LINK TOGETHER THE PART 0 ENTRY POINTS M0600730 RTJ ILOAD M0600731 RTJ WRTOUT WRITE OUT ALL PAGES THAT HAVE BEEN USED M0600732 LDA- CSQCTR,I SAVE THE LENGTH OF PART O FOR USE AS A M0600733 STA LENDC BOUND OF UNPROTECTED M0600734 LDA- COMLIM,I SAVE THE TOP OF SYSTEM COMMON AS BOUND M0600735ÐÐ STA COMM0 OF UNPROTECTED M0600736 RTJ* LP3 FIND THE STARTING ADDRESS OF THE PARTITIONED M0600737 ALF 3,PARTBL CORE TABLE M0600738LP3 NOP 0 M0600739 LDA* LP3 PUT ADDRESS OF THE ENTRY POINT NAME M0600740 STA- INPCTR,I INTO THE POINTER FOR THE ENTRY SEARCH ROUTINE M0600741 RTJ- TABSCH,I SEARCH FOR THE NAME M0600742 LDQ- SW6,I IS PARTBL DEFINED M0600743 SQP LP4-*-1 YES, GO GET THE ADDRESS OF THE FIRST PARTITIONM0600744 JMP* LP6 NO, IS LSTLOC DEFINED M0600745LP4 STA* PARTBL SAVE THE STARTING ADDRESS OF THE TABLE M0600746 INA -1 M0600747 TRA Q PICKUP THE FIRST WORD OF THE M0600748 LDA- 1,Q PARTITIONED CORE TABLE M0600749 SAP LP5-*-1 SKIP IF ADDRESS LESS THAN $8000 M0600750 INA 0 M0600751 SAN LP5-*-1 SKIP IF ADDRESS NOT EQUAL $FFFF M0600752 ENA 0 CLEAR THE PARTITIONED CORE FLAG INDICATING M0600753 STA* PARDEF NO PARTITIONS M0600754 JMP* LP6 M0600755LP5 ENA 1 SET THE PARDEF FLAG SAYING THAT PARTITIONED M0600756 STA* PARDEF CORE EXISTS IN THIS SYSTEM M0600757LP6 RTJ* LP7 FIND THE LAST LOCATION OF PARTITIONED CORE +1 M0600758 ALF 3,LSTLOC M0600759LP7 NOP 0 M0600760ÐÐ LDA* LP7 STORE RUN TIME ADDRESS OF ENTRY POINT NAME M0600761 STA- INPCTR,I INTO POINTER FOR ENTRY SEARCH ROUTINE M0600762 RTJ- TABSCH,I SEARCH FOR NAME M0600763 LDQ- SW6,I IS LSTLOC DEFINED M0600764 SQP LP8-*-1 YES, CHECK IT FOR USE AS THE START OF *LP LOADM0600765 LDA* END0V4 NO, USE END0V4 FOR *LP RELOCATION BASE M0600766 JMP* LP9 M0600767LP8 STA* LSTLOC SAVE THE ADDRESS OF LSTLOC M0600768 INA -1 M0600769 TRA Q PICKUP LSTLOC TO SEE WHERE TO BEGIN M0600770 LDA- 1,Q THE *LP LOADING M0600771 SAP LP9-*-1 SKIP IF LSTLOC LESS THAN $8000 M0600772 INA 0 M0600773 SAZ LP10-*-1 SKIP IF LSTLOC =$FFFF M0600774LP9 STA- PROBAS,I USE LSTLOC AS THE PART 1 RELOCATION BASE M0600775 JMP* LP12A GO TO PROCESS THE CONTROL STATEMENT M0600776LP10 LDA* PARDEF IS LSTLOC = $FFFF AND DO PARTITIONS EXIST M0600777 SAZ LP11-*-1 M0600778 ENA $22 ERROR 22, ATTEMPT TO LOAD PART 1 CORE M0600779 JMP* LP0 RESIDENT INTO NON-EXISTANT MEMORY M0600780LP11 LDA- COMLIM,I IF THERE ARE NO PARTITIONS AND LSTLOC = FFFF M0600781 INA 1 THEN USE END0V4+1 AS RELOCATION BASE FOR M0600782 STA- PROBAS,I PART 1 CORE RESIDENT M0600783LP12A STA- CSQLIM,I SAVE NEW COMMAND SEQUENCE LIMIT M0600784 RTJ* LP11A M0600785ÐÐ JMP* LP14A M0600786LP11A NOP 0 M0600787LP12 RTJ* LP13 TEST TO DETERMINE IF MSIZV4 IS DEFINED M0600788 ALF 3,MSIZV4 M0600789LP13 NOP 0 M0600790 LDA* LP13 PICKUP THE RUN-TIME ADDRESS OF THE NAME M0600791 STA- INPCTR,I M0600792 RTJ- TABSCH,I SEARCH FOR THE NAME MSIZV4 M0600793 LDQ- SW6,I IS MSIZV4 DEFINED M0600794 SQP LP14-*-1 YES, SETUP NEW TOP OF CORE M0600795 ENA $21 NO, ERROR 21 MSIZV4 NOT DEFINED M0600796 JMP QTYPE M0600797LP14 JMP* (LP11A) M0600798LP14A STA* MSIZV4 SAVE THE TOP OF CORE M0600799 STA I2MZV4 PASS 'MSIZV4' TO IDRIV FOR AUTOLOAD CLEAR PAR.M0600800 STA- TOP,I SETUP THE NEW TOP OF CORE FOR THE LOADER M0600801 ENA 0 M0600802 STA- CSQCTR,I CLEAR LENGTH OF PART1 CORE RESIDENT TO ZERO M0600803 ENA 1 M0600804 STA* CRPFLG SET FLAG SAYING USE PART1 ENTRY POINT TABLE M0600805 STA- ARIT15,I SET THE ARITHMETIC TYPE FLAG TO 16 BIT M0600806 ENA 4 SET CSNAME = 4 SAYING THAT A *LP IS M0600807 STA- CSNAME,I BEING PROCESSED M0600808 LDA- PROBAS,I SAVE PROGRAM RELOCATION BASE M0600809 STA LPENDC M0600810ÐÐ RTJ* LP15 GO TO END CREP TABLE M0600811 JMP LSTM40 GO TO PROCESS THE CONTROL STATEMENT M0600812LP15 NOP 0 END THE CREP TABLE M0600813 LDA- MAXENT,I SAVE THE ENDING ADDRESS OF THE CREP TABLE M0600814 STA- ECREP,I FOR LATER USE IN PATCHING EXTERNALS M0600815 CLR Q COMPUTE THE STARTING ADDRESS FOR THE M0600816 DVI- SECTOR,I CREP1 TABLE SO THAT THE TABLE BEGINS M0600817 INA 20 ON A SECTOR BOUNDARY STILL LEAVING M0600818 MUI- SECTOR,I ROOM FOR FURTHER CREP ENTRIES M0600819 STA- ENTST1,I SAVE THE STARTING ADDRESS OF CREP1 M0600820 STA- ENTPGS,I SETUP THE NEW STARTING SECTOR OF ENTRY TABLE M0600821 STA- MAXENT,I SETUP THE NEW MAXIMUM VALUE IN ENTRY TABLE M0600822 JMP* (LP15) M0600823PARTBL NUM 0 ADDRESS OF PARTITIONED CORE TABLE M0600824LSTLOC NUM 0 ADDRESS OF WORD CONTAINING LWA+1 OF PARTITIONSM0600825MSIZV4 NUM 0 LAST WORD ADDRESS OF MEMORY M0600826 EJT 1 M0600827* R O U T I N E T O P R O C E S S * M S T A T E M E N T S M0600828 SPC 3 M0600829STARM INA -3 WAS THE LAST STATEMENT *L M0600830 SAZ M0-*-1 YES, COMPLETE IT M0600831 JMP* M2 NO, TEST FOR *LP AS LAST ENTRY M0600832M0 CLR Q THE ENTRY POINTERS POINT TO THE CREP M0600833 ENA 1 TABLE SO ISSUE A PATCH EXTERNAL FUNCTION TO M0600834 RTJ ILOAD LINK ALL OF CORE RESIDENT M0600835ÐÐ LDA- CSQCTR,I SAVE THE LENGTH OF PART O FOR USE AS A M0600836 STA LENDC BOUND OF UNPROTECTED M0600837 LDA- COMLIM,I SAVE THE TOP OF SYSTEM COMMON AS BOUND M0600838 STA COMM0 OF UNPROTECTED M0600839 RTJ FMXSEC MAKE SURE ENTRY SECTOR IS DEFINED M0600840 RTJ* LP15 GO TO END THE CREP TABLE M0600841 RTJ* ENDET1 SETUP VALUES FOR TEMPORARY ENT/EXT TABLES M0600842M1 RTJ CONMS GO TO SETUP THE NEW PAGES M0600843 JMP* M7 GO TO PROCESS THE *M M0600844M2 INA -1 WAS THE LAST STATEMENT *LP M0600845 SAZ M3-*-1 YES,COMPLETE *LP PROCESSING M0600846 JMP* M5 NO, GO TO CHECK FOR *M AS LAST STATEMENT M0600847M3 LDA PART1L UPDATE THE LENGTH OF PART 1 M0600848 ADD- CSQCTR,I IN THE AUTOLOAD PROGRAM M0600849 STA PART1L M0600850 LDA- CSQCTR,I SAVE THE LENGTH OF PART1 FOR USE AS THE M0600851 ADD LPENDC LOWER BOUND OF UNPROTECTED CORE M0600852 STA LPENDC M0600853 STA- CSQCTR,I UPDATE CSQCTR SO THE *M SECTORS ARE CORRECT M0600854 RTJ* ENDET1 CLOSE OFF CREP1 TABLE AND SAVE ITS ADDRESS M0600855 RTJ LCREP SETUP POUNTERS TO CREP TABLE M0600856 RTJ FMXSEC MAKE SURE ENTRY SECTOR IS DEFINED M0600857 RTJ LCREP1 RESET POINTERS BACK TO CREP1 TABLE M0600858 JMP* M3A CONTINUE FINISHING *LP M0600859ENDET1 NOP 0 ROUTINE TO FIND BOUNDS FOR TEMPORARY ENT/EXT M0600860ÐÐ LDA- ENTPGS,I TABLES USED FOR *M AND *MP PROCESSING M0600861 STA- ENTST1,I SAVE THE STARTING ADDRESS OF THE ENTRY TABLE M0600862 LDA- MAXENT,I M0600863 STA- ECREP1,I SAVE THE ENDING ADDRESS OF THE CREP OR CREP1 M0600864 CLR Q TABLE FOR LATER USE M0600865 DVI- SECTOR,I COMPUTE THE STARTING VALUE FOR THE M0600866 INA 1 TEMPORARY ENTRY POINT TABLE SO THAT THE M0600867 MUI- SECTOR,I TABLE BEGINS ON A SECTOR BOUNDARY. M0600868 STA* ENTTMP SAVE THIS STARTING VALUE M0600869 STA- ENTPGS,I SETUP THE NEW STARTING SECTOR OF ENTRY TABLE M0600870 STA- MAXENT,I SETUP THE NEW MAXIMUM VALUE OF ENTRY TABLE M0600871 LDA- EXTSTR,I PICKUP THE START OF THE SYSTEM EXTERNAL M0600872 STA* STRTEX TABLE AND SAVE IT LOCALLY M0600873 LDA- EXTCTR,I PICKUP THE END OF THE SYSTEM EXTERNAL M0600874 STA* ENDEXT TABLE AND SAVE IT LOCALLY M0600875 CLR Q M0600876 DVI- SECTOR,I COMPUTE THE STARTING VALUE FOR THE TEMPORARY M0600877 INA 1 EXTERNAL TABLE SO THAT THE TABLE BEGINS M0600878 MUI- SECTOR,I ON A NEW PAGE. M0600879 STA* TEMPEX SAVE THIS VALUE FOR SETTING UP THE M0600880 JMP* (ENDET1) EXTERNAL TABLE BEFORE BEGINNING LOADING M0600881ENTTMP NUM 0 STARTING VALUE OF TEMPORARY ENTRY POINT TABLE M0600882STRTEX NUM 0 STARTING ADDRESS OF SYSTEM EXTERNAL TABLE M0600883TEMPEX NUM 0 STARTING ADDRESS OF TEMPORARY EXTERNAL TABLE M0600884ENDEXT NUM 0 END ADDRESS OF SYSTEM EXTERNAL TABLE M0600885ÐÐM3A CLR Q ISSUE A PATCH EXTERNALS FUNCTION TO LINK M0600886 ENA 1 THE PART 1 CORE RESIDENT M0600887 RTJ ILOAD M0600888 SQZ M4-*-1 SKIP IF NO UNPATCHED EXTERNALS EXIST M0600889 RTJ LCREP SWAP THE TABLE POINTERS FOR LINKING PART 1 M0600890 CLR Q CORE RESIDENT TO CREP TABLE M0600891 ENA 1 ISSUE PATCH EXTERNAL FUNCTION TO LINK M0600892 RTJ ILOAD PART1 TO PART0 M0600893M4 JMP* M1 GO TO PROCESS THE *M M0600894M5 INA -1 WAS THE LAST STATEMENT *M M0600895 SAZ M6A-*-1 YES, HANDLE THIS *M M0600896 ENA $13 ERROR 13, OUT OF ORDER CONTROL STATEMENT M0600897M6 JMP QTYPE OUTPUT THE ERROR M0600898M6A RTJ WRTOUT OUTPUT THE *M OR *MP PROGRAMS AND ENTRIES M0600899M7 LDA =N$FFFE LARGEST SIZE FOR *M AND *MP M0600900 STA- TOP,I LOADS WILL BE $FFFE M0600901 RTJ* M7A UPDATE LSSECT AND PAGES M0600902 JMP* M10A M0600903M7A NOP 0 M0600904 LDA- CSQCTR,I UPDATE LSSECT SO THAT THE NEXT *M OR *MP M0600905 RTJ NXTSEC LOAD WILL BEGIN ON A NEW SECTOR M0600906 LDA- NOPAGE,I PICKUP THE NUMBER OF PAGES IN CORE M0600907 STA- COUNT1,I SETUP THE COUNTER FOR THE PAGE BUILD ROUTINE M0600908 RTJ CONMS1 GO TO RESET THE PAGE FLAGS M0600909 LDQ- CORADR,I PICKUP THE STARTING ADDRESS OF THE PAGING M0600910ÐÐM9 CLR A AREA IN CORE M0600911 STA- 1,Q CLEAR A WORD OF THE PAGING AREA M0600912 INQ 1 M0600913 TRQ A HAS THE ENTIRE PAGING AREA BEEN CLEARED M0600914 SUB- FLGBSE,I M0600915 SAZ M10-*-1 YES, CONTINUE *M PROCESSING M0600916 JMP* M9 NO, GO BACK TO CLEAR THE NEXT WORD M0600917M10 STA- CSQCTR,I CLEAR PROGRAM LENGTH TO ZERO M0600918 JMP* (M7A) M0600919M10A ENA 5 SET CSNAME = 5 TO SAY THAT A *M IS M0600920 STA- CSNAME,I CURRENTLY BEING PROCESSED M0600921 LDA DATBS0 GET DATA BASE FOR PART 0 LOAD M0600922 STA- DATBAS,I M0600923 LDA DATLM0 GET DATA LIMIT FOR PART 0 LOAD M0600924 STA- DATLIM,I M0600925 RTJ COMMA IS FIELD TERMINATOR A COMMA M0600926 JMP* M11 NO, CHECK FOR END OF STATEMENT M0600927 JMP* M13 YES, PICKUP NEXT FIELD M0600928M11 RTJ VALID IS FIELD TERMINATOR BLANK OR CARRIAGE RETURN M0600929 SQZ M12-*-1 YES, FINISH PROCESSING STATEMENT M0600930MTRMER JMP LSTM42 NO, ERROR E - INVALID FIELD TERMINATOR M0600931M12 STQ- PROBAS,I ABSOLUTIZE THE PROGRAM TO LOCATION 0 M0600932 JMP* M20A GO TO LOAD THE PROGRAMS M0600933M13 ENA 8 SET BIT 3 OF SCAN SWITCH SAYING PICKUP AN M0600934 STA- SCANSW,I ASCII FIELD. SAVE THE ASCII CHARACTER CODES M0600935ÐÐ CLR A IN THE SYMSTR BLOCK AND IF THE FIELD IS M0600936 RTJ- SCAN,I NUMERIC, CONVERT THE NUMBER TO BINARY. M0600937 LDA- SYMSTR,I IS THE FIELD NUMERIC M0600938 SAN M15-*-1 NO, DETERMINE THE SECTOR ADDRESS M0600939 LDA END0V4 YES, IS IT A VALID PROGRAM BASE M0600940 SUB- SCNINP,I M0600941 SAP M14-*-1 PROGRAM BASE IS LESS THAN ENDOV4 M0600942 ENA 9 ERROR 9, ILLEGAL HEX CORE RELOCATION BASE M0600943MERROR JMP QTYPE OUTPUT ERROR MESSAGE M0600944M14 LDA- SCNINP,I UPDATE THE PROGRAM RELOCATION BASE TO THE M0600945 STA- PROBAS,I VALUE SPECIFIED ON THE CONTROL STATEMENT M0600946 JMP* M19 GO TO CHECK IF A SECTOR ADDRESS IS SPECIFIED M0600947M15 LDA- SYMSTR,I PICKUP THE FIELD TO SEE IF IT IS EMPTY M0600948 SUB- BLANKS,I M0600949 SAN M15A-*-1 SKIP IF FIELD IS NOT EMPTY M0600950 STA- PROBAS,I FIELD IS EMPTY - ABSOLUTIZE PROGRAM TO ZERO M0600951 JMP* M19 CHECK NEXT FIELD M0600952M15A LDA- SCNTRM,I IS THE ENTRY POINT NAME FOLLOWED M0600953 AND =N$7F BY A PLUS SIGN (ASCII CODE = $2B) M0600954 INA -$2B M0600955 SAZ M16-*-1 YES, FIND THE SECTOR VALUE M0600956 JMP* MTRMER NO, ERROR 14 ILLEGAL FIELD TERMINATOR M0600957M16 LDA- I M0600958 INA SYMSTR M0600959 STA- INPCTR,I SETUP THE POINTER FOR THE LOADER TO SEARCH M0600960ÐÐ RTJ- TABSCH,I FOR THE NAME ON THE CONTROL STATEMENT. M0600961 LDQ- SW6,I IS THE NAME DEFINED M0600962 SQP M17-*-1 YES, COMPUTE THE SECTOR ADDRESS M0600963 ENA $23 ERROR 23, NAME USED IN *M CONTROL STATEMENT M0600964 JMP* MERROR IS NOT A DEFINED ENTRY POINT M0600965M17 RTJ GETHEX GET THE SPECIFIED SECTOR INCREMENT M0600966 LDA- SYMSTR,I IS THE FIELD NUMERIC M0600967 SAZ M18-*-1 YES, CONTINUE PROCESSING M0600968M17A ENA 8 NO, ERROR 8 NAME APPEARS IN NUMBER FIELD M0600969 JMP* MERROR M0600970M18 LDA- ENTPNT,I PICKUP THE ENTRY POINT VALUE M0600971 ADD- SCNINP,I ADD THE SPECIFIED INCREMENT M0600972 STA SECVAL SAVE THE SECTOR VALUE TEMPORARILY M0600973 RTJ CHKSEC GO TO VERIFY THAT THE SECTOR IS VALID M0600974 LDA SECVAL UPDATE LSSECT TO THE NEW SECTOR VALUE M0600975 STA LSSECT GIVEN ON THE CONTROL STATEMENT M0600976 ENA 0 M0600977 STA- PROBAS,I RESET THE PROGRAM BASE TO ZERO M0600978 JMP* M19A GO TO LOAD THE PROGRAM M0600979M19 RTJ COMMA IS THE FIELD DELIMETER A COMMA M0600980 JMP* M19A NO, TEST FOR END OF STATEMENT M0600981 RTJ GETHEX YES, GO TO PICKUP THE SECTOR VALUE M0600982 LDA- SYMSTR,I IS THE FIELD NUMERIC M0600983 SAZ M20-*-1 YES, CHECK ITS VALIDITY M0600984 SUB- BLANKS,I IS THE FIELD EMPTY M0600985ÐÐ SAZ M20A-*-1 YES, GO TO LOAD PROGRAMS M0600986 JMP* M17A NO, ERROR - NAME APPEARS IN NUMBER FIELD M0600987M19A RTJ VALID IS TERMINATOR BLANK OR CARRIAGE RETURN M0600988 SQZ M20A-*-1 YES, GO TO PERFORM LOAD M0600989 JMP* MTRMER NO, ERROR E - ILLEGAL TERMINATOR M0600990M20 LDA- SCNINP,I PICKUP THE VALUE GIVEN FOR THE PROGRAM M0600991 STA SECVAL ADDRESS ON MASS STORAGE. M0600992 RTJ CHKSEC CHECK IF THE VALUE IS LEGAL M0600993 LDA SECVAL UPDATE LSSECT TO THE VALUE GIVEN ON M0600994 STA LSSECT THE CONTROL STATEMENT M0600995M20A LDA ENTTMP PICKUP THE ADDRESS OF THE TEMPORARY ENTRY M0600996 STA- ENTPGS,I POINT TABLE AND USE IT AS THE START AND M0600997 STA- MAXENT,I END OF THE LOADER ENTRY POINT TABLE. M0600998 LDA TEMPEX PICKUP THE ADDRESS OF THE TEMPORARY EXTERNAL M0600999 STA- EXTSTR,I TABLE AND USE IT AS THE START AND END OF M0601000 STA- EXTCTR,I THE LOADER EXTERNAL TABLE. M0601001 LDA- LNKSTR,I 120*4607M0601002 STA- LNKCTR,I RESET LINK TABLE POINTER 120*4607M0601003M20B CLR A,Q SETUP THE ADDRESS ARITHMETIC FLAG TO TELL M0601004 STA- ARIT15,I THE LOADER TO USE 15 BIT ARITHMETIC. M0601005 RTJ ILOAD ISSUE RBD LOAD FUNCTION M0601006 ENA 1 SETUP AND ISSUE A PATCH EXTERNALS FUNCTION M0601007 RTJ ILOAD TO LINK ALL THE *M PROGRAMS M0601008 SQZ M21-*-1 SKIP IF ALL EXTERNALS HAVE BEEN PATCHED M0601009 RTJ LCREP SETUP ENTRY POINTERS TO LINK TO CREP M0601010ÐÐ ENA 1 M0601011 RTJ ILOAD ISSUE A PATCH TO CREP FUNCTION M0601012M21 SQZ M22-*-1 SKIP IF ALL EXTERNALS HAVE BEEN PATCHED M0601013 RTJ LCREP1 SETUP POINTERS FOR A LINK TO CREP1 M0601014 ENA 1 M0601015 RTJ ILOAD ISSUE A PATCH TO CREP1 FUNCTION M0601016M22 SQZ M23-*-1 SKIP IF ALL EXTERNALS HAVE BEEN PATCHED M0601017 ENA 2 M0601018 RTJ ILOAD ISSUE PRINT UNPATCHED EXTERNAL FUNCTION M0601019M23 RAO* YMORDN INCREMENT THE *Y/*YM PROGRAM COUNTER M0601020 LDQ- MONTAB,I WERE THERE ANY *YM STATEMENTS M0601021 SQN M23A-*-1 YES, MAKE DIRECTORY ENTRY M0601022 JMP* M26 NO, SKIP DIRECTORY BUILD M0601023M23A LDA* YMORDN IS THIS LOAD TO BE PUT IN DIRECTORY M0601024 SUB- 1,Q SUBTRACT THE YM ORDINAL IN MONTAB M0601025 SAZ M25-*-1 SKIP IF DIRECTORY ENTRY TO BE MADE M0601026M24 JMP* M26 GO TO GET NEXT CONTROL STATEMENT M0601027M25 RAO- MONTAB,I BUMP COUNTER FOR MASS STORAGE ORDINAL TABLE M0601028 RAO* YMCNTR BUMP THE ORDINAL COUNTER M0601029 ENA 7 M0601030 MUI* YMCNTR COMPUTE AN INDEX TO THE SYSTEM DIRECTORY M0601031 ADD- $E7 TO USE FOR BUILDING THIS ENTRY. M0601032 INA -1 M0601033 TRA Q M0601034 LDA LSSECT STORE THE PROGRAM SECTOR ADDRESS IN M0601035ÐÐ STA- ($EB),Q WORD SEVEN OF THE DIRECTORY ENTRY M0601036 INQ -2 M0601037 LDA- CSQCTR,I STORE THE PROGRAM LENGTH OF THE LOAD M0601038 STA- ($EB),Q IN WORD FIVE OF THE DIRECTORY ENTRY M0601039 LDA- CSNAME,I M0601040 INA -5 IS THIS A *M LOAD M0601041 SAZ M26-*-1 YES, GO TO GET NEXT STATEMENT PROCESSED M0601042 INQ -3 NO, PUT PROGRAM BASE IN WORD 2 OF DIRECTORY M0601043 LDA PARSTR USING START OF PARTITION ADDRESS M0601044 STA- ($EB),Q M0601045 LDA =N$4000 M0601046 INQ -1 M0601047 STA- ($EB),Q SET D-BIT IN DIRECTORY M0601048* SETUP THE POINTERS SO THE NEXT ENTRY POINT M0601049M26 RTJ LCREP PROCESSED GOES INTO CREP IN CASE A *S FOLLOWS M0601050 JMP CM65 M0601051YMCNTR NUM 0 YM ORDINAL COUNTER M0601052YMORDN NUM 0 M/MP PROGRAM COUNTER M0601053 EJT 1 M0601054* R O U T I N E T O P R O C E S S * M P S T A T E M E N T S M0601055 SPC 5 M0601056STARMP INA -3 WAS THE LAST STATEMENT *L M0601057 SAZ MP0-*-1 YES, COMPLETE IT M0601058 JMP* MP2 NO, CONTINUE CHECKING M0601059MP0 CLR Q ISSUE A PATCH EXTERNAL FUNCTION TO LINK M0601060ÐÐ ENA 1 TOGETHER ALL OF CORE RESIDENT. ( IF *L WAS M0601061 RTJ ILOAD LAST THEN CORE RESIDENT IS PART 0 ONLY) M0601062 LDA- CSQCTR,I SAVE THE LENGTH OF PART 1 FOR USE AS A M0601063 STA LENDC BOUND OF UNPROTECTED M0601064 LDA- COMLIM,I SAVE THE TOP OF SYSTEM COMMON AS BOUND M0601065 STA COMM0 OF UNPROTECTED M0601066 RTJ FMXSEC MAKE SURE ENTRY SECTOR IS DEFINED M0601067MP1 RTJ ENDET1 COMPUTE START VALUES FOR TEMP ENT/EXT TABLES M0601068 RTJ CONMS REALLOCATE CORE FOR NEW PAGES M0601069 JMP* MP4 GO TO PROCESS THE *MP CONTROL STATEMENT M0601070MP2 INA -1 WAS THE LAST STATEMENT *LP M0601071 SAZ MP2A-*-1 YES, COMPLETE THE *LP M0601072 JMP* MP3A NO, COMPLETE THE *M OR *MP M0601073MP2A RTJ FMXSEC MAKE SURE ENTRY M0601074 LDA- CSQCTR,I SAVE THE LENGTH OF PART 1 FOR USE AS A M0601075 STA LPENDC BOUND OF UNPROTECTED M0601076 CLR Q YES, ISSUE A PATCH EXTERNALS FUNCTION M0601077 ENA 1 TO LINK TOGETHER THE PART1 CORE RESIDENT M0601078 RTJ ILOAD M0601079 SQZ MP3-*-1 SKIP IF NO UNPATCHED EXTERNALS M0601080 RTJ LCREP SWAP TABLE POINTERS FOR A LINK TO CREP M0601081 ENA 1 ISSUE A PATCH EXTERNALS FUNCTION TO LINK PART1M0601082 RTJ ILOAD CORE RESIDENT TO PART 0 ENTRIES M0601083MP3 JMP* MP1 GO TO PROCESS THIS *MP M0601084 SPC 2 M0601085ÐÐ* COME HERE AFTER COMPLETING *L OR *LP M0601086* FALL THROUGH TO HERE IF THE LAST STATEMENT WAS *M OR *MP M0601087MP3A RTJ WRTOUT OUTPUT THE *M OR *MP PROGRAMS AND ENTRIES M0601088MP4 RTJ M7A GO TO ALLOCATE TEMPORARY PAGES M0601089 RTJ GETHEX PICKUP THE STARTING PARTITION NUMBER M0601090 LDA- SYMSTR,I IS THE FIELD NUMERIC M0601091 SAZ MP5-*-1 YES, ANALYZE THE PARAMETER M0601092 RTJ NAMBAS NO, GO CHECK FOR A BASE NAME M0601093 JMP* MP15B BASE NAME FOUND, CONTINUE M0601094MP4A ENA 8 ERROR 8, NAME APPEARS IN NUMBER FIELD M0601095MPERR JMP QTYPE M0601096MP5 LDA- SCNINP,I SAVE THE STARTING PARTITION NUMBER M0601097 STA PP M0601098 SAM MP6-*-1 SKIP IF PARTITION NUMBER IS NEGATIVE - ILLEGALM0601099 INA -16 IS THE PARTITION NUMBER LESS THAN 16 M0601100 SAM MP7-*-1 YES, THE NUMBER IS VALID (0-15) M0601101MP6 ENA $25 NO, ILLEGAL PARTITION NUMBER M0601102 JMP* MPERR OUTPUT ERROR 9 M0601103MP7 RTJ COMMA IS THE FIELD TERMINATOR A COMMA M0601104 JMP* MPTERM NO, OUTPUT ERROR E M0601105 RTJ GETHEX YES, GET THE NEXT PARAMETER M0601106 LDA- SYMSTR,I IS THE FIELD NUMERIC M0601107 SAZ MP8-*-1 YES, CHECK THE PARAMETER M0601108 JMP* MP4A NO, ERROR 8 - NAME APPEARS IN NUMBER FIELD M0601109MP8 LDA- SCNINP,I SAVE THE NUMBER OF PARTITIONS M0601110ÐÐ STA* NN M0601111 SAM MP9-*-1 SKIP IF NUMBER IS NEGATIVE - ILLEGAL M0601112 ADD* PP ADD THE STARTING PARTITION TO NUMBER OF M0601113 INA -17 PARTITIONS AND CHECK FOR PARTITION OVERFLOW M0601114 SAM MP10-*-1 SKIP IF NUMBER IS VALID M0601115MP9 JMP* MP6 ERROR 25, ILLEGAL PARTITION NUMBER M0601116MP10 RTJ COMMA IS THE TERMINATOR A COMMA M0601117 JMP* MP12 NO, CHECK FOR BLANK OR CARRIAGE RETURN M0601118 RTJ GETHEX YES, PICKUP THE SECTOR NUMBER M0601119 LDA- SYMSTR,I IS THE FIELD NUMERIC M0601120 SAZ MP11-*-1 YES, CHECK IT FOR VALIDITY M0601121 JMP* MP4A NO, ERROR 8 - NAME APPEARS IN NUMBER FIELD M0601122MP11 LDA- SCNINP,I PICKUP THE SECTOR NUMBER FROM THE CONTROL M0601123 STA SECVAL STATEMENT AND SAVE IT M0601124 RTJ CHKSEC MAKE SURE THAT THE SECTOR NUMBER IS LEGAL M0601125 LDA SECVAL M0601126 STA LSSECT M0601127MP12 RTJ VALID IS TERMINATOR BLANK OR CARRIAGE RETURN M0601128 SQZ MP13-*-1 YES, CONTINUE PROCESSING THE *MP M0601129MPTERM ENA $E NO, ERROR E - INVALID FIELD TERMINATOR M0601130 JMP* MPERR M0601131MP13 LDA PARTBL HAS PARTBL BEEN DEFINED FOR THE INITIALIZER M0601132 SAZ MP13A M0601133 JMP* MP15A YES, FIND THE BOUNDS FOR THIS LOAD M0601134MP13A RTJ* MP14 NO, SEE IF PARTBL IS DEFINED AS AN M0601135ÐÐ ALF 3,PARTBL ENTRY POINT IN SYSDAT M0601136MP14 NOP 0 M0601137 LDA* MP14 PICKUP RUNTIME ADDRESS OF ENTRY POINT NAME M0601138 STA- INPCTR,I FOR TABLE SEARCH POINTER M0601139 RTJ LCREP SETUP THE POINTERS TO USE THE CREP TABLE M0601140 RTJ- TABSCH,I SEARCH CREP FOR PARTBL M0601141 LDQ- SW6,I WAS IT DEFINED M0601142 SQP MP15-*-1 YES, SAVE ITS VALUE M0601143 ENA $26 NO, OUTPUT ERROR $26 - NO PARTBL IN SYSDAT M0601144 JMP* MPERR M0601145MP15 STA PARTBL SAVE THE ADDRESS OF THE PARTITIONED CORE TABLEM0601146MP15A LDQ* PP PICKUP THE STARTING ADDRESS FOR THE LOAD M0601147 LDA (PARTBL),Q M0601148 STA- PROBAS,I SAVE THE PROGRAM RELOCATION BASE FOR THIS LOADM0601149 STA PARSTR SAVE FOR CHECK ON NAME PRINT IN ILOAD M0601150 LDA =N$FFFE SET UPPER BOUND FOR THIS LOAD M0601151 STA- TOP,I AND SAVE IT IN LOCATION TOP M0601152 ADQ* NN ADD # PARTITIONS TO START PARTITION M0601153 LDA (PARTBL),Q PICK UP START OF NEXT PARTITION M0601154 STA- COMLIM,I SETUP UPPER BOUND OF COMMON FOR PARTITION M0601155MP15B ENA 6 SETUP CSNAME = 6 SAYING THAT A M0601156 STA- CSNAME,I *MP IS BEING PROCESSED M0601157 LDA DATBS1 GET DATA BASE FOR PART 1 LOAD M0601158 STA- DATBAS,I M0601159 LDA DATLM1 GET DATA LIMIT FOR PART 1 LOAD M0601160ÐÐ STA- DATLIM,I M0601161 LDA ENTTMP PICKUP THE STARTING ADDRESS FOR THE TEMPORARY M0601162 STA- ENTPGS,I ENTRY POINT TABLE AND SAVE AS THE START AND M0601163 STA- MAXENT,I END OF THE TABLE FOR THIS LOAD. M0601164 LDA TEMPEX PICK UP START OF TEMPORARY EXTERNAL M0601165 STA- EXTSTR,I TABLE AND USE AS THE START AND END OF THE M0601166 STA- EXTCTR,I EXTERNAL TABLE FOR THIS LOAD M0601167 ENA 1 SETUP THE ADDRESS ARITHMETIC FLAG TO TELL M0601168 STA- ARIT15,I THE LOADER TO USE 16 BIT ARITHMETIC M0601169 LDA =X$1400 STORE JUMP INSTRUCTION AS FIRST TWO M0601170 STA VALUE1 CSQ VALUES M0601171 LDA- PROBAS,I M0601172 STA- PARBAS,I SAVE BASE ADDRESS M0601173 RTJ* STORE M0601174 LDA =X($7FFF) M0601175 STA VALUE1 TEMPORARILY SET SECOND WORD $FFFF M0601176 RAO- PROBAS,I INCREMENT BASE COUNT M0601177 LDA- PROBAS,I M0601178 RTJ* STORE M0601179 RAO- PROBAS,I INCREMENT BASE COUNT M0601180 LDA- CSQCTR,I M0601181 INA 2 M0601182 STA- CSQCTR,I INCREMENT LENGTH TO INCLUDE 2 WORD JMP M0601183 LDA- LNKSTR,I 120*4607M0601184 STA- LNKCTR,I RESET LINK TABLE POINTER 120*4607M0601185ÐÐ RAO- NOJUMP,I SET NOJUMP TO FLAG TRANSFER ADDRESS M0601186* NEEDED FOR JUMP INSTRUCTION M0601187 CLR A,Q M0601188MP16 RTJ ILOAD ISSUE RBD LOAD FUNCTION M0601189 ENA 1 ISSUE PATCH EXTERNAL FUNCTION TO LINK THE M0601190 RTJ ILOAD PROGRAMS OF THIS LOAD TOGETHER M0601191 SQZ MP17-*-1 SKIP IF NO UNPATCHED EXTERNALS EXIST M0601192 RTJ* LCREP1 RESET ENTRY POINTERS FOR LINK TO CREP1 M0601193 ENA 1 ISSUE PATCH EXTERNAL FUNCTION TO LINK THE M0601194 RTJ ILOAD PROGRAMS OF THIS LOAD TO CREP1 M0601195MP17 SQZ MP18-*-1 SKIP IF NO UNPATCHED EXTERNALS EXIST M0601196 RTJ* LCREP RESET ENTRY POINTERS FOR LINK TO CREP M0601197 ENA 1 ISSUE PATCH EXTERNAL FUNCTION TO LINK THE M0601198 RTJ ILOAD PROGRAMS OF THIS LOAD TO CREP M0601199MP18 SQZ MP19-*-1 SKIP IF NO UNPATCHED EXTERNALS EXIST M0601200 ENA 2 ISSUE PRINT UNPATCHED EXTERNALS FUNCTION M0601201 RTJ ILOAD BEFORE COMPLETING LOAD M0601202MP19 JMP M23 GO TO TERMINATE THIS LOAD M0601203PP NUM 0 STARTING PARTITION NUMBER M0601204NN NUM 0 NUMBER OF PARTITIONS TO USE M0601205 EJT M0601206 SPC 4 M0601207STORE NUM 0 SECTION TO STORE A WORD IN CSQ M0601208 RTJ DISKWR M0601209VALUE1 NUM 0 M0601210ÐÐ NUM 0 M0601211 JMP* (STORE) M0601212 EJT M0601213* R O U T I N E T O P R O C E S S * M P B A S E M0601214 SPC 1 M0601215* A D D R E S S L A B E L N A M E M0601216 SPC 8 M0601217NAMBAS NOP 0 M0601218 SPC 1 M0601219 LDA- SYMSTR,I M0601220 STA* BASBUF M0601221 LDA- SYMSTR+1,I M0601222 STA* BASBUF+1 MOVE THE BASE NAME M0601223 LDA- SYMSTR+2,I M0601224 STA* BASBUF+2 M0601225 SPC 1 M0601226 RTJ* NAM010 M0601227 BZS BASBUF(3) M0601228NAM010 NOP 0 M0601229 SPC 1 M0601230 LDA* NAM010 M0601231 STA- INPCTR,I M0601232 RTJ- TABSCH,I SEARCH FOR AN ENTRY POINT WITH THE NAME M0601233 LDQ- SW6,I WAS IT FOUND M0601234 SQP NAM020 YES, CONTINUE M0601235ÐÐ RAO* NAMBAS NO, SPECIFY AN ERROR RETURN M0601236 JMP* (NAMBAS) INDICATE AN ILLEGAL *MP STATEMENT M0601237 SPC 1 M0601238NAM020 STA- PROBAS,I SPECIFY THE NEW BASE ADDRESS M0601239 STA PARSTR M0601240 LDA MSIZV4 END OF LOAD = MAXIMUM SYSTEM ADDRESS M0601241 STA- TOP,I M0601242 STA- COMLIM,I M0601243 SPC 1 M0601244 JMP* (NAMBAS) RETURN M0601245 EJT 1 M0601246* R O U T I N E T O V E R I F Y T H A T A M0601247 SPC 1 M0601248* G I V E N V A L U E I S G R E A T E R T H A N M0601249 SPC 1 M0601250* L S S E C T A N D L E S S T H A N T H E M0601251 SPC 1 M0601252* V A L U E O F E N T R Y P O I N T S E C T O R . M0601253 SPC 8 M0601254FMXSEC NOP 0 M0601255 LDQ* MAXSEC HAS SECTOR BEEN DEFINED IN CONTRL M0601256 SQZ CKSEC1 NO, SEE IF IT HAS BEEN OPERATOR DEFINED M0601257 TRQ A RETURN ADDRESS OF MAXSEC IN A M0601258 JMP* (FMXSEC) YES, RETURN TO CALLER M0601259CKSEC1 RTJ* CKSEC2 M0601260ÐÐ ALF 3,SECTOR M0601261CKSEC2 NOP 0 M0601262 LDA* CKSEC2 PICKUP THE RUN TIME ADDRESS OF THE ENTRY M0601263 STA- INPCTR,I POINT NAME FOR THE TABLE SEARCH ROUTINE M0601264 RTJ- TABSCH,I SEARCH TO SEE IF SECTOR HAS BEEN DEFINED M0601265 LDQ- SW6,I IS SECTOR DEFINED M0601266 SQP CKSEC3-*-1 YES, SAVE ITS VALUE M0601267 ENA $24 NO, ERROR SECTOR IS NOT DEFINED M0601268CKSERR JMP* QTYPE M0601269CKSEC3 STA* MAXSEC SAVE THE VALUE OF SECTOR M0601270 JMP* (FMXSEC) M0601271 SPC 3 M0601272CHKSEC NOP 0 M0601273CKSEC LDA* SECVAL IS THE NEW SECTOR VALUE GREATER THAN OR M0601274 SUB LSSECT EQUAL TO THE CURRENT VALUE OF LSSECT M0601275 SAP CKSEC5-*-1 YES, CHECK FOR MASS STORAGE OVERFLOW M0601276CKSEC4 ENA $A ERROR A, ILLEGAL SECTOR SPECIFIED ON M0601277 JMP* CKSERR INITIALIZER CONTROL STATEMENT M0601278CKSEC5 LDA* MAXSEC IS THE NEW SECTOR VALUE LESS THAN OR M0601279 SUB* SECVAL EQUAL TO THE MAXIMUM SECTOR ALLOWABLE M0601280 SAP CKSEC6-*-1 YES, RETURN TO CALLER M0601281 JMP* CKSEC4 NO, OUTPUT THE ERROR TO THE USER M0601282CKSEC6 JMP* (CHKSEC) RETURN TO CALLER M0601283MAXSEC NUM 0 MAXIMUM SYSTEM SECTOR SPECIFIED BY THE USER M0601284SECVAL NUM 0 SECTOR VALUE SPECIFIED ON *M OR *MP M0601285ÐÐ* CONTROL STATEMENT M0601286 EJT 1 M0601287* ********************************************************************M0601288* ROUTINE TO SETUP POINTERS FOR A LINK TO THE CREP TABLE M0601289* ********************************************************************M0601290 SPC 1 M0601291LCREP NOP 0 M0601292 LDA- ENTST0,I SET THE START OF THE ENTRY POINT TABLE M0601293 STA- ENTPGS,I TO POINT TO THE START OF THE CREP TABLE. M0601294 LDA- ECREP,I SET THE END OF THE ENTRY POINT TABLE M0601295 STA- MAXENT,I TO POINT TO THE END OF THE CREP TABLE M0601296 JMP* (LCREP) M0601297 SPC 10 M0601298* ********************************************************************M0601299* ROUTINE TO SETUP POINTERS FOR A LINK TO THE CREP1 TABLE M0601300* ********************************************************************M0601301 SPC 1 M0601302LCREP1 NOP 0 M0601303 LDA- ENTST1,I SET THE START OF THE ENTRY POINT TABLE TO M0601304 STA- ENTPGS,I POINT TO THE START OF THE CREP1 TABLE. M0601305 LDA- ECREP1,I SET THE END OF THE ENTRY POINT TABLE TO M0601306 STA- MAXENT,I POINT TO THE END OF THE CREP1 TABLE. M0601307 JMP* (LCREP1) M0601308 EJT 1 M0601309* ********************************************************************M0601310ÐÐ* ROUTINE FOR BACKGROUNDING INPUT BUFFER M0601311* ********************************************************************M0601312BACKGR ADC 0 ADDR FROM WHENCE WE CAME M0601313 LDQ ISAV RESTORE INDEX I M0601314 LDA- INPADR,Q ADDR OF INPUT BUFFER M0601315 INA -1 M0601316 STA- I TO INDEX I M0601317 ENQ 59 M0601318 SET A SET A TO ALL ONES M0601319BG10 STA- 1,B ALL ONES TO INPUT BUFFER M0601320 INQ -1 M0601321 SQM BG20-*-1 MINUS IMPLIES BUFFER BACKGROUNDED M0601322 JMP* BG10 M0601323BG20 LDA ISAV RESTORE INDEX I M0601324 STA- I ONE OF CONTAB M0601325 JMP* (BACKGR) RETURN M0601326 EJT 1 M0601327* ********************************************************************M0601328* ROUTINE FOR OUTPUTTING THE MESSAGE M0601329* ERROR XX M0601330* ********************************************************************M0601331TYPEQ ADC 0 A = ERROR NBR ON ENTRY M0601332 JMP* TYPEQ9 Q = 0 IF ERROR, 1 OTHERWISE M0601333TYPEQ1 ADC 0 M0601334 SQZ QERR-*-1 M0601335ÐÐ JMP* QOUT M0601336QERR LDQ ISAV RESTORE INDEX I M0601337 STQ- I M0601338 RTJ- CONVRT,I CONVERT NBR IN A REG M0601339 LDQ- INPADR,I ADDR OF INPUT BUFFER M0601340 LDA- BINASC+1,I CONVERSION RESULTANT M0601341 ARS 8 TEST LEFT HALF CHARACTER M0601342 INA -$30 FOR A ZERO M0601343 SAN TYPEQ2-*-1 NON-ZERO IF NUMBER M0601344 LDA- BINASC+1,I CHANGE ZERO TO A BLANK M0601345 SUB =N$1000 M0601346 JMP* TYPEQ3 M0601347TYPEQ2 LDA- BINASC+1,I CONVERSION RESULTANT M0601348TYPEQ3 STA* ERNBR STORE IN OUTPUT BUFFER M0601349 LDA* TYPEQ1 ADDRESS OF QBUFR M0601350 INA 1 ADDRESS OF EBUFR M0601351 ENQ 5 5 WORDS OUT M0601352 RTJ TELOUT OUTPUT MESSAGE TO TELETYPE M0601353 SPC 5 M0601354* ********************************************************************M0601355* ROUTINE FOR OUTPUTTING Q TO THE COMMENT DEVICE M0601356* M0601357* ********************************************************************M0601358QOUT LDA* TYPEQ1 ADDRESS OF QBUFR M0601359 LDQ ISAV RESTORE INDEX I M0601360ÐÐ STQ- I M0601361 ENQ 1 M0601362 RTJ TELOUT OUTPUT MESSAGE TO TELETYPE M0601363 RTJ* BACKGR M0601364 LDA- INPADR,I ADDR OF INPUT BUFFER M0601365 JMP CM45 M0601366TYPEQ9 RTJ* TYPEQ1 M0601367QBUFR NUM $0A51 LINE FEED AND CHARACTER Q M0601368EBUFR NUM $0A45 LINE FEED AND CHAR E M0601369 ALF 3,RROR ERROR MESSAGE M0601370ERNBR ADC 0 ASCII ERROR NBR M0601371QTYPE CLR Q ERROR IF Q = 0 M0601372 RTJ TYPEQ TYPE ERROR AND Q, COMM MED M0601373 EJT 1 M0601374* ********************************************************************M0601375* PROCESS *I, *O, AND *C CONTROL STATEMENTS M0601376* M0601377* ACCEPTABLE LU ASSIGNMENTS M0601378* INPUT................LU M0601379* PAPER TAPE 1 M0601380* CARD 2 **MSOS 4.1**M0601381* MAG TAPE 3 **MSOS 4.1**M0601382* M0601383* OUTPUT...............LU M0601384* MASS MEMORY 4 M0601385ÐÐ* UNUSED(RESERVED) 5 M0601386* M0601387* LIST.................LU M0601388* TELETYPE 6 M0601389* PRINTER 7 M0601390* DUMMY 8 M0601391* ********************************************************************M0601392 SPC 2 M0601393STARI ENA 0 PROCESS STATEMENT OF FORM *I,LU,EQUIP M0601394 JMP* SETIO M0601395 SPC 2 M0601396STARO ENA 1 PROCESS STATEMENT OF FORM *O,LU,EQUIP M0601397 JMP* SETIO M0601398 SPC 2 M0601399STARC ENA 2 PROCESS STATEMENT OF FORM *C,LU,EQUIP M0601400 SPC 2 M0601401SETIO STA* SWTHIO 0=INPUT, 1=OUTPUT, 2=LIST M0601402 RTJ COMMA IS DELIMETER A COMMA M0601403 JMP* ILDEL NO, TYPE ERROR E, Q M0601404 ENA 8 YES, PICKUP LOGICAL UNIT NUMBER M0601405 STA- SCANSW,I SETTING BIT 3 OF SCANSW SAYS FETCH A NAME M0601406 CLR A OR DECIMAL NUMBER M0601407 RTJ- SCAN,I M0601408 LDA- SYMSTR,I IF SYMSTR EQUALS ZERO THE FIELD WAS NUMERIC M0601409 SAZ OKNB-*-1 M0601410ÐÐNOKNB ENA 8 NAME APPEARS IN NUMBER FIELD M0601411 JMP* QTYPEX TYPE ERROR 8, Q M0601412OKNB LDQ- SCNINP,I PICKUP BINARY VALUE OF NUMBER M0601413 ADQ TABLE IS THE NUMBER VALID (TABLE= -MAXLU-1 ) M0601414 SQM LUOK-*-1 YES M0601415STIOER ENA $12 NO, TYPE ERROR 12, Q M0601416QTYPEX JMP QTYPE M0601417LUOK LDQ SCNINP,I M0601418 RTJ* ABS CALCULATE THE ABSOLUTE ADDRESS **MSOS 4.1**M0601419ABS NUM 0 OF THE L. U. TABLE **MSOS 4.1**M0601420 LDA* ABS **MSOS 4.1**M0601421 ADD* REL **MSOS 4.1**M0601422 ADD* ATABLE **MSOS 4.1**M0601423 AAQ A ADDRESS OF THIS L.U. ENTRY **MSOS 4.1**M0601424 LDQ TABLE,Q REL. ADDRESS OF THIS L.U. DRIVER **MSOS 4.1**M0601425 AAQ Q **MSOS 4.1**M0601426 LDA* (ZERO),Q IS THE REQUIRED MODULE LOADED **MSOS 4.1**M0601427 SAZ DEVDEF YES **MSOS 4.1**M0601428 INA 0 **MSOS 4.1**M0601429 SAN DEVDEF-*-1 YES M0601430 JMP* STIOER NO, OUTPUT ERROR 12, Q M0601431ATABLE ADC TABLE **MSOS 4.1**M0601432REL ADC ATABLE-ABS **MSOS 4.1**M0601433ZERO NUM 0 **MSOS 4.1**M0601434DEVDEF LDA SCNINP,I **MSOS 4.1**M0601435ÐÐ LDQ SWTHIO M0601436 STA* IN,Q STORE ADDRESS OF DRIVER IN UNIT WORD M0601437 RTJ* VALID IS DELIMITER BLANK OR CARRIAGE RETURN M0601438 SQN OKNB1-*-1 NO, CHECK FOR COMMA M0601439 JMP* CM44EX YES, TYPE Q AND INTERROGATE COMMENT MEDIUM M0601440OKNB1 RTJ COMMA IS DELIMETER A COMMA M0601441 JMP* ILDEL NO, OUTPUT ERROR E, Q M0601442 RTJ GETHEX YES, GET EQUIPMENT CODE M0601443 LDA- SYMSTR,I IS FIELD NUMERIC M0601444 SAZ OKNB2-*-1 YES M0601445 JMP* NOKNB NO,OUTPUT ERROR 8, Q M0601446OKNB2 RTJ* VALID IS DELIMETER BLANK OR CARRIAGE RETURN M0601447 SQZ OKNB3-*-1 YES M0601448 JMP* ILDEL NO, OUTPUT ERROR E, Q M0601449OKNB3 LDA- SCNINP,I PICKUP FOUR DIGIT EQUIPMENT CODE M0601450 LDQ* SWTHIO PICKUP INDEX TO CONTROL STATEMENT TYPE M0601451 LDQ* IN,Q PICKUP LOGICAL UNIT BEING SETUP BY STATEMENT M0601452 STQ* SWTHIO SAVE LOGICAL UNIT M0601453 QLS 1 MULTIPLY LOGICAL UNIT BY THREE TO M0601454 ADQ* SWTHIO FORM INDEX TO UNIT TABLE M0601455 JMP* IN,Q STORE EQUIP CODE THEN GET NEXT STATEMENT M0601456DUMMY NUM 0 SLOT FOR DUMMY DEVICES M0601457ILDEL ENA 14 ERROR E, ILLEGAL FIELD DELIMETER M0601458TYPIO JMP* QTYPE OUTPUT ERROR XX, Q M0601459SWTHIO NUM 0 SWITCH DEFINING I/O DEVICE TYPE M0601460ÐÐIN NUM 0 INPUT UNIT M0601461OU NUM 0 OUTPUT UNIT M0601462CO NUM 0 COMMENT UNIT M0601463 STA EPTAPE SAVE EQUIPMENT FOR PAPER TAPE **MSOS 4.1**M0601464 JMP* CM44EX M0601465 STA ECARD SAVE EQUIPMENT FOR CARD READER **MSOS 4.1**M0601466 JMP* CM44EX M0601467 STA EMTAPE SAVE EQUIPMENT FOR MAG TAPE **MSOS 4.1**M0601468 JMP* CM44EX M0601469 STA EMASS SAVE EQUIPMENT FOR MASS MEMORY M0601470 JMP* CM44EX M0601471 NOP 0 NO EQUIPMENT---UNUSED(RESERVED) M0601472 NOP 0 M0601473 JMP* CM44EX M0601474 STA ECOM SAVE EQUIPMENT FOR COMMENT **MSOS 4.1**M0601475 JMP* CM44EX M0601476 STA EPRINT SAVE EQUIPMENT FOR PRINTER **MSOS 4.1**M0601477 JMP* CM44EX M0601478 STA DUMMY SLOT FOR DUMMY DEVICE L.U. 8 M0601479CM44EX JMP CM44 NO, PROCESS NEXT CONTROL STATEMENT**MSOS 4.1**M0601480 EJT 1 M0601481* ********************************************************************M0601482* TEST FOR BLANK OR CARRIAGE RETURN AS FIELD TERM M0601483* ********************************************************************M0601484VALID ADC 0 TEST FOR BLANK OR CARR RET M0601485ÐÐ RTJ OETERM FETCH TERMINATOR M0601486 INQ -1 TEST CONST FOR CARR RETURN M0601487 SQN VAL10-*-1 M0601488 JMP* (VALID) CARRIAGE RETURN M0601489VAL10 INQ -2 TEST CONST FOR BLANK M0601490 JMP* (VALID) RETURN M0601491 SPC 5 M0601492* ********************************************************************M0601493* COMPUTE NEXT MASS STORAGE SECTOR NUMBER M0601494* ********************************************************************M0601495NXTSEC ADC 0 M0601496 CLR Q M0601497 DVI =N96 96 WORDS PER SECTOR M0601498 SQZ NXT10-*-1 ZERO IMPLIES NO REMAINDER M0601499 INA 1 M0601500NXT10 ADD LSSECT LSB OF MASS STG SECT NBR M0601501 STA LSSECT LSB OF MASS STG SECT NBR M0601502 JMP* (NXTSEC) M0601503 EJT 1 M0601504* R O U T I N E T O P R O C E S S * S , N A M E , H H H H M0601505 SPC 1 M0601506* C O N T R O L S T A T E M E N T M0601507 SPC 5 M0601508* STATEMENT *S,NAME,H H H H WHERE NAME IS A ONE TO SIX M0601509* CHARACTER NAME THAT WILL BE ENTERED INTO THE LOADER TABLE M0601510ÐÐ* WITH A VALUE OF H H H H. IF THE *S STATEMENT IS ENTERED BEFORE M0601511* THE FIRST *LP STATEMENT, THEN THE NAME AND ENTRY POINT WILL M0601512* RESIDE IN THE CREP TABLE AT TERMINATION OF INITIALIZATION. M0601513* IF THE *S STATEMENT FOLLOWS THE FIRST *LP STATEMENT, THEN M0601514* THE NAME AND VALUE WILL RESIDE IN THE CREP1 TABLE AFTER M0601515* INITIALIZATION IS COMPLETED. M0601516* M0601517STARS RTJ COMMA IS DELIMETER COMMA M0601518SERR1 JMP* ILDEL NO, TYPE ERROR E, Q M0601519 ENA 8 SET BIT 3 OF SCAN SWITCH SAYING PICKUP AN M0601520 STA- SCANSW,I ASCII FIELD, SAVE THE ASCII CHARACTER CODES M0601521 CLR A IN THE SYMSTR BLOCK, AND IF THE FIELD IS M0601522 RTJ- SCAN,I NUMERIC CONVERT THE NUMBER TO BINARY. M0601523 RTJ COMMA IS FIELD DELIMETER A COMMA M0601524 JMP* SERR1 NO, TYPE ERROR E, Q M0601525 LDA- SYMSTR,I YES, CHECK FOR NAME AND SAVE IT M0601526 SAZ SERR2-*-1 SYMSTR=0 IF A NUMERIC OPERAND WAS PROCESSED M0601527 SUB- BLANKS,I CHECK TO SEE IF NAME FIELD WAS BLANK M0601528 SAN SOK1-*-1 NOT BLANK M0601529SERR2 ENA 2 OUTPUT ERROR 2 - NUMBER APPEARS IN NAME FIELD M0601530 JMP* TYPIO OR NAME FIELD IS BLANK M0601531SOK1 LDA- SYMSTR,I NAME OCCURRED SO SAVE IT M0601532 STA* ENTRY M0601533 LDA- SYMSTR+1,I M0601534 STA* ENTRY+1 M0601535ÐÐ LDA- SYMSTR+2,I M0601536 STA* ENTRY+2 M0601537 RTJ* LOCENT RETURN JUMP TO THE NEXT EXECUTABLE STATEMENT M0601538 BZS ENTRY(3) SO THE ADDRESS OF THE CODES FOR THIS NAME M0601539VALUE ADC 0 CAN BE PASSED TO THE LOADER M0601540LOCENT NOP 0 ADDRESS OF ENTRY NAME IS STORED HERE BY RTJ M0601541 RTJ GETHEX PICKUP HEX FIELD M0601542 RTJ* VALID WAS DELIMETER CARRIAGE RETURN OR BLANK M0601543 SQZ SOK2-*-1 YES M0601544 JMP* ILDEL NO, OUTPUT ERROR E, Q M0601545SOK2 LDA- SYMSTR,I WAS FIELD NUMERIC M0601546 SAN TESTAL-*-1 NO M0601547 LDA- SCNINP,I YES, PICKUP THE VALUE M0601548VALU STA* VALUE AND SAVE IT M0601549 JMP* LDRTAB MAKE ENTRY TO LOADER TABLE M0601550TESTAL ARS 8 COME HERE IF FIELD 2 IS NOT NUMERIC M0601551 INA -$50 IS THE FIELD P M0601552 SAN NOTP-*-1 NO M0601553 LDA- PROBAS,I IF FIELD CONTAINED P AS FIRST CHARACTER, THEN M0601554 JMP* VALU SET THE ENTRY POINT TO THE PROGRAM BASE M0601555NOTP INA -3 IS THE FIELD S M0601556 SAZ SOK3-*-1 NO, M0601557 JMP* SERR2 ILLEGAL STATEMENT FORMAT M0601558SOK3 LDA LSSECT YES, PICKUP THE LSB OF CURRENT MASS STORAGE M0601559 JMP* VALU SECTOR AS VALUE FOR ENTRY POINT M0601560ÐÐLDRTAB STA- ENTPNT,I VALUE ASSOCIATED WITH ENTRY POINT NAME M0601561 LDA* LOCENT M0601562 STA- INPCTR,I ADDRESS OF ENTRY POINT NAME M0601563 RTJ- TABSCH,I IS THIS NAME ALREADY IN THE LOADER TABLE M0601564 LDQ- SW6,I M0601565 SQM NIN-*-1 NO, GO DOWN AND PUT IT INTO THE TABLE M0601566 JMP* CM20EX YES, IGNORE THIS *S STATEMENT M0601567NIN ENA 4 M0601568 SUB- CSNAME,I IS THIS AN *M OR *MP LOAD M0601569 SAP NIN1-*-1 NO, STORE ENTRY M0601570 LDA- ECREP,I YES, BUMP END OF CREP TABLE M0601571 INA 4 M0601572 STA- ECREP,I M0601573NIN1 RTJ ENTSTR PUT NEW ENTRY POINT INTO TABLE M0601574CM20EX JMP CM20 GET NEXT CONTROL STATEMENT M0601575LSSECT NUM 0 STARTING COMMAND SEQUENCE SECTOR M0601576 EJT 1 M0601577 SPC 5 M0601578* M0601579* *********************************************************************M0601580* M0601581* PROCESS *U STATEMENT M0601582* M0601583* *********************************************************************M0601584STARU RTJ* VALID IS DELIMETER CR OR BLANK M0601585ÐÐ SQN ILDEL2-*-1 M0601586 CLR A YES, SET FOR INITIALIZER TO INTERROGATE M0601587 STA- INMED,I COMMENT MEDIUM. M0601588 JMP CM44 *U..TYPE Q, INTERROGATE COMMENT MEDIUM M0601589* M0601590* *********************************************************************M0601591* M0601592* PROCESS *V STATEMENT M0601593* M0601594* *********************************************************************M0601595STARV RTJ* VALID IS DELIMETER CR OR BLANK M0601596 SQN ILDEL2-*-1 M0601597 ENA 1 YES, SET FOR INITIALIZER TO INTERROGATE M0601598 STA- INMED,I INPUT MEDIUM. M0601599 JMP CM20 BACKGROUND BUFFER, GET NEXT INPUT M0601600ILDEL2 JMP* SERR1 TYPE ERROR E, Q M0601601* M0601602*************************************************************** M0601603* * M0601604* PROCESS *D STATEMENT * M0601605* * M0601606*************************************************************** M0601607* M0601608STARD RTJ* VALID IS DELIMITER CARRIAGE RETURN M0601609* OR A BLANK M0601610ÐÐ SQZ CONT M0601611 JMP* ILDEL2 M0601612CONT ENA 0 ZERO TO RELOCATION M0601613 STA- DATBAS,I BASE FOR DATA STORAGE M0601614 STA- DATLIM,I HIGHEST ADDR.DATA STG+1 M0601615 CLR A,Q M0601616 RTJ ILOAD LOAD THE PROGRAM M0601617 JMP CM65 GO PROCESS NEXT CONTROL STATEMENT M0601618 EJT M0601619************************************************************************M0601620* *M0601621* PROCESS *G STATEMENT *M0601622* *M0601623************************************************************************M0601624 SPC 2 M0601625STARG RTJ* VALID CHECK VALID DELIMITER M0601626 SQZ VALOK M0601627 JMP* ILDEL2 ERROR * AND REQUEST WITH Q M0601628VALOK LDQ EMASS GET DISK STATUS ADDRESS M0601629 INP ERDISK-* TAKE STATUS TO DETERMINE ACTIVE DISK M0601630 RTJ* WAT GET ADDRESS M0601631 ALF 15,ENABLE ADDRESS WRITE--THEN CR M0601632 NUM $0D0A CR,LF M0601633WAT NUM 0 M0601634 ENQ 16 WRITE 16 WORDS M0601635ÐÐ LDA* WAT OUTPUT BUFFER ADDRESS M0601636 RTJ TELOUT WRITE MESSAGE M0601637 CLR Q READ CR ENTRY M0601638 LDA- INPADR,I M0601639 RTJ QCOM M0601640 SET A SET FLAG FOR ADDRESS WRITE M0601641 RTJ QMASS WRITE TAGS M0601642 SAZ DKERR (A)=0 INDICATES ERROR M0601643 JMP CM20 NO ERROR -- PRINT Q M0601644DKERR RTJ* DSKER PRINT ERROR M0601645 ALF 06,DISK ERROR M0601646 NUM $0D0A M0601647DSKER NUM 0 M0601648 ENQ 7 PRINT ERROR MESSAGE M0601649 LDA* DSKER M0601650 RTJ TELOUT M0601651 JMP CM20 GO TO PRINT Q M0601652ERDISK NOP 0 REJECT PATH M0601653 RTJ* DISKER M0601654 ALF 6,DISK REJECT M0601655 NUM $0D0A M0601656DISKER NUM 0 M0601657 ENQ 7 PRINT REJECT MESSAGE M0601658 LDA* DISKER M0601659 RTJ TELOUT M0601660ÐÐ JMP CM20 GO TO PRINT Q M0601661 EJT M0601662************************************************************************M0601663* *M0601664* PROCESS *H STATEMENT *M0601665* *M0601666************************************************************************M0601667 SPC 2 M0601668STARH RTJ COMMA IS DELIMITER A COMMA M0601669 JMP* ILDEL2 NO, ERROR E M0601670 RTJ GETHEX GET STOP SECTOR M0601671 LDA- SYMSTR,I CHECK NUMERIC FIELD M0601672 SAZ OKNH M0601673 JMP NOKNB NO, ERROR 8 M0601674OKNH LDA- SCNINP,I SAVE STOP SECTOR NUMBER M0601675 STA TSECT M0601676 RTJ VALID CHECK FOR CR OR BLANK M0601677 SQZ TERMH M0601678 JMP* ILDEL2 NO, ERROR E M0601679TERMH SET A FIRST PATTERN - ALL ONES M0601680 STA* PTN M0601681 LDA- I M0601682 STA* PTNI SAVE TABLE POINTER M0601683 RTJ* SETPTN M0601684 SET A M0601685ÐÐ STA* PTN1 M0601686 RTJ* WPTN M0601687 RTJ* RPTN M0601688 LDA =N$5555 PATTERN $5555 M0601689 STA* PTN M0601690 CLR A M0601691 STA* PTN1 M0601692 RTJ* SETPTN M0601693 RTJ* WPTN M0601694 RTJ* RPTN M0601695 LDA =N$AAAA PATTERN $AAAA M0601696 STA* PTN M0601697 RTJ* SETPTN M0601698 RTJ* WPTN M0601699 RTJ* RPTN M0601700 CLR A PATTERN 0 M0601701 STA* PTN M0601702 RTJ* SETPTN M0601703 RTJ* WPTN M0601704 RTJ* RPTN M0601705 JMP CM20 COMPLETED M0601706 SPC 4 M0601707SETPTN NUM 0 SET BUFFER TO PATTERN M0601708 ENQ 95 M0601709 LDA* PTN GET DATA PATTERN M0601710ÐÐPTNSET STA PTNBUF,Q M0601711 INQ -1 M0601712 SQM RTNPTN M0601713 JMP* PTNSET M0601714RTNPTN JMP* (SETPTN) M0601715PTN NUM 0 M0601716 SPC 4 M0601717WPTN NUM 0 WRITE DATA M0601718 ENQ 0 SET ZERO SECTOR ADDRESS M0601719 STQ- I SECTOR ADDRESS M0601720LWPTN RTJ* FWA M0601721FWA NUM 0 M0601722 LDA* FWA COMPUTE BUFFER ADDRESS M0601723 ADD =XPTNBUF-FWA M0601724 ENQ -96 M0601725 RTJ QMASS WRITE SECTOR M0601726 SAM GODY SKIP, NO ERROR M0601727 TRQ A M0601728 INA -7 M0601729 SAN BADERR SKIP NO COMPARE ERROR M0601730 LDA* PTN1 M0601731 SAM GODY FIRST WRITE--COMPARE OK M0601732BADERR JMP* PTNERR PRINT ERROR M0601733GODY RAO- I CHECK LIMITS M0601734 LDA- I M0601735ÐÐ* 1 CARD DELETED M0601736 SUB TSECT M0601737 SAZ WDONE SKIP IF ALL WRITTEN M0601738 JMP* LWPTN DO MORE M0601739WDONE JMP* (WPTN) M0601740PTN1 NUM 0 M0601741PTNI NUM 0 M0601742* 1 CARD DELETED M0601743 SPC 4 M0601744RPTN NUM 0 READ DATA M0601745 ENQ 0 SET ZERO SECTOR ADDRESS M0601746 STQ CURSCT M0601747LRPTN STQ- I M0601748 RTJ* RFWA M0601749RFWA NUM 0 READ DATA SUBROUTINE M0601750 LDA* RFWA M0601751 ADD =XPTNBUF-RFWA COMPUTE BUFFER ADDRESS M0601752 ENQ 96 M0601753 RTJ QMASS READ SECTOR OF DATA M0601754 SAM RGODY M0601755 JMP* PTNERR DISK ERROR - PRINT MESSAGE AND EXIT M0601756RGODY ENQ 95 LOOP TO CHECK PATTERN M0601757RGODYA LDA* PTNBUF,Q M0601758 EOR* PTN M0601759 SAN NOMTCH ZERO INDICATES GOOD MATCH M0601760ÐÐ INQ -1 SEE IF SECTOR DONE M0601761 SQM SECNXT M0601762 JMP* RGODYA MORE THIS SECTOR M0601763SECNXT JMP* BMPSCT GO TO NEXT SECTOR M0601764NOMTCH LDA* PTNI FAILED SECTOR, RESTORE TABLE POINTER M0601765 STA- I M0601766 LDA CURSCT M0601767* 1 CARD REMOVED FOR PSR 90*2673 M0601768 RTJ- CONVRT,I CONVERT TO ASCII M0601769 LDA- BINASC,I STORE IN MESSAGE BUFFER M0601770 STA* COMBUF+13 M0601771 LDA- BINASC+1,I M0601772 STA* COMBUF+14 M0601773 TRQ A FAILED WORD M0601774 RTJ- CONVRT,I M0601775 LDA- BINASC,I M0601776 STA* COMBUF+18 M0601777 LDA- BINASC+1,I M0601778 STA* COMBUF+19 M0601779 LDA* PTNBUF,Q BAD PATTERN READ M0601780 RTJ- CONVRT,I M0601781 LDA- BINASC,I M0601782 STA* COMBUF+22 M0601783 LDA- BINASC+1,I M0601784 STA* COMBUF+23 M0601785ÐÐ LDA* PTN EXPECTED PATTERN M0601786 RTJ- CONVRT,I M0601787 LDA- BINASC,I M0601788 STA* COMBUF+26 M0601789 LDA- BINASC+1,I M0601790 STA* COMBUF+27 M0601791 RTJ* COMMSG PRINT MESSAGE M0601792COMBUF ALF 28,DISK COMPARE ERROR SECT XXXX WORD XXXX IS XXXX SB XXXX M0601793 NUM $0D0A M0601794COMMSG NUM 0 M0601795 LDA* COMMSG M0601796 ENQ 29 M0601797 RTJ TELOUT M0601798BMPSCT LDQ CURSCT LOOK AT NEXT SECTOR-ONE ERROR PER SECT M0601799 INQ 1 HAVE ALL SECTORS BEEN READ M0601800 STQ CURSCT M0601801 TRQ A M0601802* 1 CARD DELETED M0601803 SUB* TSECT M0601804 SAZ RDONE ZERO INDICATES ALL DONE M0601805 JMP* LRPTN GO TO NEXT SECTOR M0601806RDONE JMP* (RPTN) RETURN - ALL READS DONE M0601807 SPC 4 M0601808PTNERR LDA* PTNI DISK FAILURE ERROR M0601809 STA- I M0601810ÐÐ TRQ A M0601811 RTJ- CONVRT,I CONVERT ERROR TO ASCII M0601812 LDA- BINASC,I STORE IN MESSAGE M0601813 STA* DFAIL+7 M0601814 LDA- BINASC+1,I M0601815 STA* DFAIL+8 M0601816 RTJ* FALMSG PRINT MESSAGE M0601817DFAIL ALF 09,DISK FAILURE XXXX M0601818 NUM $0D0A M0601819FALMSG NUM 0 M0601820 LDA* FALMSG M0601821 ENQ 10 M0601822 RTJ TELOUT M0601823 JMP CM20 FATAL ERROR, EXIT TO GET NEXT STATEMEN M0601824PTNBUF BZS PTNBUF(96) M0601825TSECT NUM 0 M0601826CURSCT NUM 0 M0601827 EJT 1 M0601828* R O U T I N E T O P R O C E S S * T M0601829 SPC 5 M0601830START RTJ WRTOUT WRITE OUT THE RESULT OF THE LAST *M OR *MP M0601831 RTJ M7A UPDATE LSSECT AND PAGES M0601832 ENA 0 M0601833 STA- CSNAME,I CLEAR CONTROL STATEMENT INDICATOR M0601834 STA- CORADR,I RESET THE START OF THE PAGING AREA TO ZERO M0601835ÐÐ LDA- FLGBS1,I RESET THE BASE OF THE FLAG TABLE TO M0601836 STA- FLGBSE,I THE FLAGS FOR SYSTEM PAGES M0601837 LDA- SYSPGE,I REBUILD THOSE PAGES WRITTEN OUT TO M0601838 STA- NOPAGE,I MAKE ROOM FOR *M AND *MP LOADS M0601839 LDA LENSDT SETUP COUNTER EQUAL TO THE COMPLIMENT66*1455 M0601840 TCA A OF THE NUMBER OF PAGES (LENSDT) M0601841 STA* PCOUNT M0601842 LDQ- FLGBSE,I PICKUP THE START OF THE FLAG TABLE M0601843T0 ENA 1 M0601844 STA- MODIFY,Q SET THE MODIFIED FLAG FOR THIS PAGE M0601845 RAO* PCOUNT INCREMENT THE PAGE COUNTER M0601846 LDA* PCOUNT HAS THE FLAG BEEN SET FOR ALL LENSDT PAGES M0601847 SAZ T0A-*-1 YES M0601848 INQ 3 NO,INCREMENT POINTER TO THE NEXT SET OF FLAGS M0601849 JMP* T0 LOOP BACK TO SET NEXT FLAG M0601850T0A LDA LSSECT TEMPORARILY SAVE LSSECT M0601851 STA* TMPSEC M0601852 ENA SYSECT RESTORE LSSECT SO IT WILL POINT TO M0601853 STA LSSECT THE START OF CORE IMAGE M0601854 LDA LENSDT NUMBER OF CORE RESIDENT PAGES 66*1455 M0601855 MUI- FLGLGN,I MULTIPLY BY THE NUMBER OF FLAGS/PAGE AND M0601856 ADD- FLGBSE,I ADD ON THE BASE OF THE FLAG TABLE TO M0601857 STA* BLDADD FIND THE START OF THE PAGES TO REBUILD M0601858 LDA LENSDT NUMBER OF CORE RESIDENT PAGES 66*1455 M0601859 SUB- NOPAGE,I COMPUTE A COUNTER FOR THE PAGES TO BE M0601860ÐÐ STA* PCOUNT READ IN FROM MASS STORAGE M0601861 LDA LENSDT COMPUTE ADDRESS OF THE PAGE TO - 66*1455 M0601862 MUI- PAGE,I BE READ IN M0601863 STA* PAGADD M0601864T1 LDQ* BLDADD PICKUP THE BASE FLAG ADDRESS FOR REBUILD M0601865 LDA- PGENUM,Q READ THE PAGE BACK INTO CORE M0601866 RTJ FNDSEC CONVERT PAGE NUMBER TO SECTOR ADDRESS M0601867 LDA* PAGADD PICKUP ADDRESS TO READ INTO M0601868 RTJ MDRIV READ THE PAGE INTO CORE M0601869 LDQ ISAV M0601870 STQ- I RESTORE THE I-REGISTER M0601871 SAN T2-*-1 SKIP IF NO ERROR M0601872 JMP* T21 IRRECOVERABLE MASS STORAGE ERROR M0601873T2 RAO* PCOUNT INCREMENT THE PAGE COUNTER M0601874 LDA* PCOUNT HAVE ALL PAGES BEEN READ BACK IN M0601875 SAZ T2A-*-1 YES, GO ON TO LINK STAGE M0601876 LDQ* BLDADD UPDATE THE POINTER TO THE FLAGS FOR THE M0601877 INQ 3 NEXT PAGE TO REBUILD M0601878 STQ* BLDADD M0601879 LDA* PAGADD INCREMENT THE ADDRESS COUNTER TO THE M0601880 ADD- PAGE,I CORE ADDRESS FOR THE NEXT PAGE M0601881 STA* PAGADD M0601882 JMP* T1 GO TO GET NEXT PAGE M0601883T2A LDA STRTEX RESTORE THE EXTERNAL POINTER TO THE START M0601884 STA- EXTSTR,I OF THE SYSTEM EXTERNAL TABLE M0601885ÐÐ LDA ENDEXT RESTORE THE EXTERNAL POINTER TO THE END M0601886 STA- EXTCTR,I OF THE SYSTEM EXTERNAL TABLE M0601887 RTJ LCREP SETUP POINTERS FOR A LINK TO CREP M0601888 RTJ* T20 M0601889 ALF 3,STMSV4 M0601890T20 NOP 0 M0601891 LDA* T20 M0601892 STA- INPCTR,I M0601893 RTJ- TABSCH,I FIND THE ENTRY POINT STMSV4 M0601894 LDQ- SW6,I M0601895 SQM T21-*-1 SKIP IF STMSV4 NOT DEFINED M0601896 RTJ I2 WRITE OUT THE AUTOLOAD SECTOR M0601897 LDQ ISAV M0601898 STQ- I RESTORE THE I-REGISTER M0601899 SAZ T21-*-1 SKIP IF ERROR M0601900 JMP* T3 M0601901T21 ENA $16 IRRECOVERABLE MASS STORAGE ERROR M0601902 JMP QTYPE M0601903T3 LDA- COMBAS,I SET START OF SYSTEM COMMON M0601904 ENQ 16 INTO THE EXTENDED CORE TABLE. M0601905 STA- ($E9),Q M0601906 ENQ 10 PICK UP UNPROTECTED FLAG FROM WORD M0601907 LDQ- ($E9),Q 10 OF EXTENDED CORE TABLE M0601908 SQN T3A-*-1 SKIP IF UNPROTECTED IN PART1 M0601909 JMP* T10 GO TO HANDLE UNPROTECTED IN PART 0 M0601910ÐÐT3A RTJ* T3B LOOK UP ENTRY POINT 'UNPEND' 120*4614M0601911 ALF 3,UNPEND 120*4614M0601912T3B NOP 0 120*4614M0601913 LDA* T3B 120*4614M0601914 STA- INPCTR,I 120*4614M0601915 RTJ- TABSCH,I 120*4614M0601916 LDQ- SW6,I IS 'UNPEND' DEFINED ? 120*4614M0601917 SQM T3C IF 'UNPEND' NOT DEFINED USE 'MSIZV4' 120*4614M0601918 INA 1 120*4614M0601919 JMP* T4 USE 'UNPEND' AS END OF UNPROTECTED 120*4614M0601920T3C LDA MSIZV4 120*4614M0601921 SAZ T5-*-1 SKIP IF MSIZV4 HAS NOT BEEN USED BY SI M0601922T4 STA- $F6 SET F6 TO MSIZV4 (END OF PART1) M0601923 JMP* T6 M0601924T5 RTJ LP11A GO TO GET MSIZV4 M0601925 JMP* T4 M0601926T6 RTJ* T6A LOOK UP ENTRY POINT 'UNPSRT' 120*4614M0601927 ALF 3,UNPSRT 120*4614M0601928T6A NOP 0 120*4614M0601929 LDA* T6A 120*4614M0601930 STA- INPCTR,I 120*4614M0601931 RTJ- TABSCH,I 120*4614M0601932 LDQ- SW6,I IS 'UNPSRT' DEFINED ? 120*4614M0601933 SQM T6B IF 'UNPSRT' UNDEFINED USE OLD METHOD 120*4614M0601934 INA -1 120*4614M0601935ÐÐ JMP* T7 120*4614M0601936T6B LDA LPENDC WERE THERE ANY *LP LOADS ? 120*4614M0601937 SAZ T8-*-1 NO, USE LSTLOC FOR END OF PART1 M0601938T7 STA- $F7 YES, USE END OF *LP LOADS FOR END OF PART1 M0601939 JMP* T11 M0601940BLDADD NUM 0 M0601941PCOUNT NUM 0 M0601942PAGADD NUM 0 M0601943TMPSEC NUM 0 M0601944T8 LDA LSTLOC HAS LSTLOC BEEN DEFINED M0601945 SAZ T8A-*-1 NO, SEE IF IT EXISTS M0601946 JMP* T7 YES, USE LSTLOC FOR F7 M0601947T8A RTJ LCREP POINT TO CREP TO FIND LSTLOC M0601948 RTJ* T8B M0601949 ALF 3,LSTLOC M0601950T8B NOP 0 M0601951 LDA* T8B M0601952 STA- INPCTR,I M0601953 RTJ- TABSCH,I M0601954 LDQ- SW6,I IS LSTLOC DEFINED M0601955 SQP T8C-*-1 YES, USE IT AS THE START OF UNPROTECTED M0601956 JMP* T9 NO, USE END0V4 AS THE START OF UNPROTECTED M0601957T8C INA -1 M0601958 TRA Q M0601959 LDA- 1,Q PICKUP THE VALUE OF LSTLOC M0601960ÐÐ INA -1 DECREMENT TO THE END OF PROTECTED M0601961 JMP* T7 M0601962T9 LDA END0V4 USE END0V4 FOR F7 M0601963 JMP* T7 M0601964T10 LDA- COMBAS,I SET F6 = START OF SYSTEM COMMON 61*1287 M0601965 SAN 2 61*1287 M0601966 LDA COMM0 61*1287 M0601967 STA- $F6 M0601968 RTJ LCREP SET ENTRY TABLE TO CREP0 M0601969 RTJ* TAG001 M0601970 ALF 3,AREAC M0601971TAG001 ADC 0 M0601972 LDA* TAG001 M0601973 STA- INPCTR,I M0601974 RTJ- TABSCH,I PICKUP ADDRESS OF AREAC M0601975 STA- $F7 M0601976T11 LDA- $F6 SETUP THE TEMPORARY BOUNDS OF UNPROTECTED M0601977 STA- $EC M0601978 LDA- $F7 M0601979 STA- $ED M0601980 RTJ* T13 M0601981 BZS OHS(96) M0601982T13 NOP 0 ADDRESS OF 96 WORD BUFFER FOR I/O USE M0601983 LDA TMPSEC M0601984 STA LSSECT RESTORE NEXT AVAILABLE SECTOR M0601985ÐÐ* 3 CARDS DELETED M0601986 STA- $C4 M0601987 ENQ -96 M0601988 STQ* T13A M0601989 LDQ* T13 PICKUP ADDRESS OF 96 WORD BUFFER M0601990 INQ 94 M0601991T13C CLR A M0601992 STA- 1,Q CLEAR A WORD OF THE BUFFER M0601993 RAO* T13A M0601994 INQ -1 M0601995 LDA* T13A M0601996 SAZ T13B-*-1 M0601997 JMP* T13C M0601998T13A NUM 0 M0601999T13B LDA* T13 M0602000 LDQ LSSECT M0602001 STQ- I M0602002 ENQ -96 WRITE THE FIRST SECTOR OF PROGRAM LIBRARY M0602003 RTJ MDRIV DIRECTORY FOR LIBEDT M0602004 SAN T13D-*-1 SKIP IF NO ERROR M0602005 JMP T21 IRRECOVERABLE MASS STORAGE ERROR M0602006T13D LDA ISAV M0602007 STA- I RESTORE THE I-REGISTER M0602008 RTJ* T14A M0602009 ALF 3,DATBAS M0602010ÐÐT14 NUM 0 ADDRESS OF SYSTEM DATA M0602011T14A NOP 0 M0602012 LDA- DATBAS,I M0602013 STA* T14 M0602014 STA- ENTPNT,I SAVE THE ADDRESS ASSOCIATED WITH THE NAME M0602015 LDA* T14A M0602016 STA- INPCTR,I M0602017 RTJ ENTSTR SAVE DATBAS IN THE CREP TABLE M0602018 LDA- DATLIM,I SAVE DATLIM IN EXTENDED COMM. REGION M0602019 ENQ 25 WORD 25 M0602020 STA- ($E9),Q M0602021 RAO LSSECT INCREMENT SECTOR COUNTER PAST LIBRARY DIRECT. M0602022 LDA LSSECT M0602023 STA* SWAPSC SAVE STARTING SECTOR OF SWAP AREA M0602024 RTJ* T12 M0602025 ALF 3,SWAPAR M0602026SWAPSC NUM 0 M0602027T12 NOP 0 M0602028 LDA* SWAPSC M0602029 STA- ENTPNT,I SAVE THE ADDRESS ASSOCIATED WITH THE NAME M0602030 LDA* T12 M0602031 STA- INPCTR,I STUFF SWAPAR INTO CREP M0602032 RTJ ENTSTR M0602033 LDA- ECREP,I BUMP THE END OF THE CREP TABLE TO M0602034 INA 8 INCLUDE THE TWO NEW ENTRIES M0602035ÐÐ STA- ECREP,I M0602036 RTJ WRTOUT UPDATE CREP WITH NEW ENTRIES M0602037 LDA- $F6 M0602038 SUB- $F7 M0602039 RTJ NXTSEC FIND STARTING SECTOR FOR CREP M0602040 LDA LSSECT M0602041 ENQ 6 PUT THE STARTING SECTOR OF THE CREP TABLE M0602042 STA- ($E9),Q INTO WORD 6 OF THE EXTENDED CORE TABLE M0602043 RTJ LCREP PICKUP THE MOST RECENT LENGTH OF THE CREP M0602044 LDA- ENTSEC,I PICKUP STARTING SECTOR OF CREP M0602045 RTJ* MOVDSK MOVE THE CREP TABLE UP ON THE DISK M0602046 LDA- MAXENT,I M0602047 SUB- ENTPGS,I M0602048 RTJ NXTSEC COMPUTE SECTOR FOR THE CREP1 TABLE M0602049 RTJ LCREP1 SETUP POINTERS FOR THE CREP1 TABLE M0602050 LDA- MAXENT,I M0602051 SUB- ENTPGS,I IS THERE A CREP1 TABLE M0602052 SAZ T12AA-*-1 NO M0602053 SAP T12A-*-1 YES,MOVE IT UP ON THE DISK M0602054T12AA ENQ 7 NO, STORE A ZERO IN WORD 7 OF THE M0602055 STA- ($E9),Q EXTENDED CORE TABLE AND GO ON TO SAT M0602056 JMP* T12B M0602057T12A LDA LSSECT M0602058 ENQ 7 PUT THE STARTING SECTOR OF THE CREP1 M0602059 STA- ($E9),Q TABLE IN WORD 7 OF EXTENDED CORE TABLE M0602060ÐÐ LDA- ENTST1,I COMPUTE THE STARTING SECTOR OF CREP1 M0602061 CLR Q M0602062 DVI- SECTOR,I M0602063 ADD- ENTSEC,I M0602064 RTJ* MOVDSK MOVE THE CREP1 TABLE UP ON THE DISK M0602065 LDA- MAXENT,I M0602066 SUB- ENTPGS,I M0602067 RTJ NXTSEC M0602068T12B LDA LSSECT M0602069 ENQ 20 PUT START OF EF DATA IN WORD 20 **MSOS 4.1**M0602070 STA- ($E9),Q OF EXT. CORE TABLE **MSOS 4.1**M0602071 STA* EFSECT SAVE STARTING SECTOR OF EF DATA **MSOS 4.1**M0602072 INA 99 99 SECTORS OF EF DATA **MSOS 4.1**M0602073 ENQ 5 PUT STARTING SECTOR OF SAT IN WORD 5 M0602074 STA- ($E9),Q OF EXTENDED CORE TABLE M0602075 STA TMPSEC SAVE STARTING SECTOR OF SAT M0602076 INA 30 **MSOS 4.1**M0602077 STA- $C1 PUT START OF SCRATCH IN C1 M0602078 STA* ENDBSY M0602079 ENA SYSECT CORE IMAGE SECTOR TO A M0602080 ENQ 4 PUT THE STARTING SECTOR OF THE CORE IMAGE M0602081 STA- ($E9),Q INTO WORD 4 OF THE EXTENDED CORE TABLE M0602082 LDA LPENDC IS THERE A PART1 CORE RESIDENT M0602083 SAZ T22A-*-1 NO, USE 15 BIT ARITHMETIC FOR PATCHING M0602084 ENA 1 YES, USE 16 BIT ARITHMETIC FOR PATCHING M0602085ÐÐT22A STA- ARIT15,I M0602086* 1 CARD DELETED M0602087 RTJ LCREP PICKUP CREP POINTERS M0602088 ENA SYSECT M0602089 STA LSSECT SETUP LSSECT TO POINT TO CORE IMAGE M0602090 ENA 1 M0602091 RTJ ILOAD PATCH TO CREP USING 15 BIT ARITHMETIC M0602092 SQZ T30-*-1 SKIP IF NO UNPATCHED EXTERNALS M0602093 RTJ LCREP1 SWAP POINTERS TO LINK TO CREP1 M0602094 ENA 1 M0602095 STA- ARIT15,I ISSUE PATCH TO CREP1 USING 16-BIT ARITHMETIC M0602096 RTJ ILOAD M0602097 SQZ T30-*-1 SKIP IF NO UNPATCHED EXTERNALS M0602098 ENA 2 M0602099 RTJ ILOAD PRINT UNPATCHED EXTERNALS M0602100T30 ENA SYSECT SET LSSECT TO POINT TO CORE IMAGE M0602101 STA LSSECT M0602102 RTJ WRTOUT WRITE CORE IMAGE AND CREP/CREP1 TABLES M0602103 LDA TMPSEC M0602104 STA LSSECT RESTORE STARTING SECTOR OF SAT M0602105 JMP* BLDSAT GO TO BUILD SAT M0602106COMM0 NUM 0 M0602107LENDC NUM 0 LENGTH OF PART 0 M0602108LPENDC NUM 0 LENGTH OF PART 1 M0602109MOVDSK NOP 0 M0602110ÐÐ STA* MOVE1 SAVE SECTOR TO MOVE FROM M0602111 LDA- MAXENT,I M0602112 SUB- ENTPGS,I COMPUTE WORD LENGTH OF TABLE M0602113 CLR Q M0602114 DVI- SECTOR,I CONVERT WORD LENGTH TO SECTOR LENGTH M0602115 SQZ MOV1-*-1 M0602116 INA 1 M0602117MOV1 TCA A M0602118 STA* MOVE2 M0602119 LDA LSSECT M0602120 STA* MOVE3 M0602121MOV2 LDA T13 PICKUP ADDRESS OF 96 WORD BUFFER M0602122 LDQ* MOVE1 PICKUP SECTOR ADDRESS FOR READ M0602123 STQ- I M0602124 ENQ 96 SETUP WORD COUNT OF 96 M0602125 RTJ MDRIV READ IN SECTOR M0602126 LDQ* MOVE3 PICKUP SECTOR TO WRITE ON M0602127 STQ- I M0602128 ENQ -96 COMPLEMENT WORD COUNT TO SIGNAL WRITE M0602129 LDA T13 PICKUP BUFFER ADDRESS M0602130 RTJ MDRIV WRITE OUT THE SECTOR M0602131 RAO* MOVE1 INCREMENT SECTOR TO READ M0602132 RAO* MOVE2 INCREMENT SECTOR TO WRITE M0602133 RAO* MOVE3 INCREMENT COMPLEMENT OF COUNT M0602134 LDA* MOVE2 HAVE ALL SECTORS BEEN MOVED M0602135ÐÐ SAZ MOV3-*-1 YES - EXIT M0602136 JMP* MOV2 NO, LOOP BACK FOR NEXT SECTOR M0602137MOV3 LDA ISAV M0602138 STA- I RESTORE THE I-REGISTER M0602139 JMP* (MOVDSK) M0602140MOVE1 NUM 0 SECTOR TO BE READ M0602141MOVE2 NUM 0 COMPLEMENT OF NUMBER OF SECTORS TO MOVE M0602142MOVE3 NUM 0 SECTOR TO BE WRITTEN M0602143 EJT 1 M0602144* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ******M0602145* *****M0602146* THIS ROUTINE WILL WRITE THE SECTOR AVAILABILITY *****M0602147* TABLE (SAT). THIS IS A 30-SECTOR TABLE CONTAINING A PICTURE*****M0602148* OF ALL THE SECTORS ON THE DISK. ONE BIT REPRESENTS EACH *****M0602149* SECTOR. IF THE BIT IS ON--THIS SECTOR IS AVAILABLE FOR *****M0602150* STORAGE OF THE PROGRAM LIBRARY AND DIRECTORY. *****M0602151* IF THE BIT IS ZERO, THIS SECTOR IS USED, EITHER BY SWAP AREA*****M0602152* SYSTEM LIBRARY, OR PROGRAM LIBRARY AND DIRECTORY. *****M0602153* THE TABLE IS UPDATED BY LIBEDT, AND IS USED TO FIND HOLES *****M0602154* FOR PROGRAMS IN THE PROGRAM LIBRARY. *****M0602155* *****M0602156* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ******M0602157* *****M0602158SATGO NUM 256 STARTING WORD OF SAT (LATER LAST BUSY SECTOR )M0602159* 1-CARD DELETED M0602160ÐÐEFSECT NUM 0 **MSOS 4.1**M0602161ENDBSY NUM 0 LAST SECTOR BUSY IN SAT M0602162* 1-CARD DELETED M0602163SIXTEN NUM 16 M0602164ENDSAT NUM 0 M0602165BLDSAT LDA =N$100 SETUP STARTING WORD OF SAT M0602166 STA* SATGO M0602167 LDQ- BASE,I M0602168 INQ -10 M0602169 CLR A M0602170SAT0 STA- 1,Q CLEAR ALL OF CORE BELOW THE INITIALIZER M0602171 INQ -1 TO ZEROS M0602172 SQZ SAT1-*-1 M0602173 JMP* SAT0 M0602174SAT1 LDA =N$100 MOVE EF DATA BLOCK OF ZEROS **MSOS 4.1**M0602175 LDQ* EFSECT POINTS TO EF BLOCK **MSOS 4.1**M0602176 STQ- I **MSOS 4.1**M0602177 LDQ =N-9504 WRITE 99 SECTORS **MSOS 4.1**M0602178 RTJ MDRIV **MSOS 4.1**M0602179 CLR Q M0602180 LDA* ENDBSY COMPUTE THE BIT ADDRESS OF THE LAS**MSOS 4.1**M0602181 DVI* SIXTEN SECTOR TO SET BUSY M0602182 ADD* SATGO M0602183* 1-CARD DELETED M0602184 STA* SATGO SAVE LAST BUSY SECTOR M0602185ÐÐ SET A M0602186 SQZ SAT3 M0602187 ENA 1 M0602188 INQ -16 M0602189SAT2 INQ 1 SET THE BITS FOR THE FIRST AVAILABLE SECTOR M0602190 SQZ SAT3-*-1 M0602191 ALS 1 M0602192 INA 1 SKIP IF DONE WITH FIRST WORD M0602193 JMP* SAT2 SET THE NEXT SECTOR AVAILABLE M0602194SAT3 STA* (SATGO) SETUP THE FIRST WORD WITH AVAILABLE SECTORS M0602195 RAO* SATGO M0602196 LDA MAXSEC M0602197 INA 1 INCREMENT MAXSEC FOR TOTAL SECTORS M0602198 CLR Q M0602199 DVI* SIXTEN FIND THE LAST WORD WITH AVAILABLE SECTORS M0602200 ADD* BLDSAT+1 OFFSET LAST AVAILABLE WORD M0602201* 1-CARD DELETED M0602202 STA* ENDSAT M0602203 CLR A M0602204 SQZ SAT5-*-1 M0602205 LDA =N$8000 M0602206SAT4 INQ -1 SETUP LAST WORD WITH AVAILABLE SECTORS M0602207 SQZ SAT5-*-1 M0602208 ARS 1 M0602209 JMP* SAT4 M0602210ÐÐSAT5 STA* (ENDSAT) M0602211 SET A PICKUP FIRST WORD TO BE SET FOR M0602212SAT6 STA* (SATGO) M0602213 RAO* SATGO INCREMENT STORAGE ADDRESS M0602214 LDQ* SATGO M0602215 TCQ Q M0602216 ADQ* ENDSAT M0602217 SQZ SATDON-*-1 M0602218 JMP* SAT6 M0602219SATDON LDQ LSSECT M0602220 STQ- I M0602221 LDA =N$100 M0602222 LDQ =N-2880 SETUP WRITE OF 30 SECTORS **MSOS 4.1**M0602223 RTJ MDRIV WRITE SAT TABLE M0602224 LDA* ERFLAG WERE THERE ANY ERRORS M0602225 SAZ SAT9-*-1 NO, PRINT AUTOLOAD MESSAGE M0602226 JMP* SAT10 YES, PRINT AUTOLOAD ERROR MESSAGE M0602227SAT9 RTJ* SAT7 M0602228SAT8 ALF 22,INITIALIZATION COMPLETED - YOU MAY AUTOLOAD M0602229SAT7 NOP 0 M0602230 LDA* SAT7 PICKUP BUFFER ADDRESS M0602231 ENQ SAT7-SAT8 M0602232 RTJ TELOUT M0602233 NUM $18FF M0602234SAT10 RTJ* SAT11 M0602235ÐÐ ALF *,ERRORS OCCURED - YOU MAY ATTEMPT TO AUTOLOAD* M0602236SAT11 NOP 0 M0602237 LDA* SAT11 M0602238 ENQ SAT11-SAT10-1 M0602239 RTJ TELOUT M0602240 NUM $18FF M0602241ERFLAG NUM 0 M0602242TCODE NUM 0 M0602243 END M0602244 NAM I2 M07 A ITOS CCS 3.0 SL-149M0700001* INITIALIZER CONTROLLER FOR DISK/DRUM AUTOLOAD AREA M0700002* CREDIT COLLECTION SYSTEM VERSION 3.0 M0700003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA M0700004* COPYRIGHT CONTROL DATA CORPORATION 1979 M0700005* M0700006 SPC 2 M0700007************************************************************************M0700008* ENTRY PARAMETERS *M0700009* (A) = 0 - INITIALIZE DRIVER *M0700010* (A) = ADDRESS OF STMSV4 IN MSOS SPACE*M0700011************************************************************************M0700012 SPC 1 M0700013 ENT I2 M0700014 ENT I2RETN M0700015 ENT PART1A,PART1L,PART1C M0700016ÐÐ EXT* OU M0700017 EXT* MMINIT DRIVER ENTRY FOR MASS MEMORY SETUP M0700018 EXT* MDRIV IN MDRIV M0700019 EXT* FMXSEC RETURNS "MAXSEC" IN A M0700020 EXT* HEADR1 DATE INPUT BY OPERATOR M0700021 EXT* SIZMAS ROUTINE TO COMPUTE AND RETURN MM SIZE M0700022 EXT NFILES MAX. NUMBER OF FILES ON SYSTEM VOLUME 121*4743M0700023* M0700024I2 NOP 0 M0700025 SAZ FIRST-*-1 SKIP IF DRIVER INITIALIZATION M0700026 JMP* IOTYPE M0700027FIRST STA* PART1C CLEAR PART 1 CORE IMAGE SECTOR NO. M0700028 JMP MMINIT GO TO SETUP AUTOLOAD AREA POINTERS M0700029I2RETN NOP 0 ADDRESS OF THE AUTOLOAD PROGRAM M0700030 STQ* LENGTH LENGTH OF THE AUTOLOAD PROGRAM M0700031 ADD* I2RETN M0700032 STA* PUTTER TABLE ADDRESS IN THE AUTOLOAD PROGRAM M0700033 JMP* (I2) EXIT M0700034 SPC 3 M0700035IOTYPE STA* STMSV4 M0700036 ENQ 3 M0700037LOOPDT LDA* PART1C,Q MOVE THE TABLE TO M0700038 STA* (PUTTER),Q THE AUTOLOAD PROGRAM M0700039 SQZ GOON-*-1 SKIP WHEN ALL MOVED M0700040 INQ -1 M0700041ÐÐ JMP* LOOPDT M0700042GOON ENQ 1 SET FOR AUTOLOAD SECTOR M0700043 STQ- I M0700044 LDQ* LENGTH LENGTH OF AUTOLOAD PROGRAM 68*1529 M0700045 TCQ Q M0700046 LDA* I2RETN FWAB M0700047 RTJ MDRIV WRITE OUT AUTOLOAD PGM SECTS 0-4 **MSOS 4.1**M0700048 EJT M0700049* MOVE DATE INTO LABEL M0700050 ENQ 3 M0700051LB1 LDA HEADR1,Q PICK UP WORD OF DATE M0700052 STA* VLDATE,Q STORE IN LABEL M0700053 INQ -1 M0700054 SQM LB2 SKIP IF ALL OF DATE MOVED M0700055 JMP* LB1 GO BACK AND DO NEXT WORD M0700056* SET UP DIRECTORY AND START ALLOCATABLE SECTORS M0700057LB2 RTJ FMXSEC PICK UP "MAXSEC" M0700058 INA 1 DIRECTORY IS NEXT SECTOR M0700059 STA* VLASDL SAVE IN LABEL M0700060 LDA* VLMAXF PICK UP MAXIMUM NUMBER OF FILES 121*4743M0700061* THE FOLLOWING TWO LINES OF CODE FIX A BUG. THE BUG IS THAT M0700062* THE FILE MANAGER'S AVAILABLE SPACE DIRECTORY HAD BEEN M0700063* DEFINED ABOUT HALF THE SIZE IT SHOULD HAVE BEEN. M0700064* M0700065 INA 1 COMPUTE MAX # ENTRIES IN DIRECTORY M0700066ÐÐ ALS 2 M0700067 CLR Q 121*4743M0700068 DVI* VLWPS COMPUTE DIRECTORY SIZE IN SECTORS 121*4743M0700069 SQZ LB2A SKIP IF NO PARTIAL SECTOR 121*4743M0700070 INA 1 ADD 1 SECTOR 121*4743M0700071LB2A STA* VLASDS SAVE AS DIRECTORY SIZE 121*4743M0700072 ADD* VLASDL ADD START ADDRESS OF DIRECTORY 121*4743M0700073 STA* VLBMSL SAVE AS FIRST ALLOCATABLE SECTOR M0700074 STA* ASDIR+3 SAVE AS START OF BLOCK IN DIRECTORY M0700075 RTJ SIZMAS GO GET SECTOR SIZE OF MM DEVICE M0700076 SUB* VLBMSL SUBTRACT SECTORS ALREADY USED M0700077 SAP LB3 SKIP IF RESULT CORRECT M0700078 AND =N$7FFF M0700079 INQ -1 M0700080LB3 STQ* VLLBA SAVE IN LABEL M0700081 STA* VLLBA+1 M0700082 STQ* ASDIR SAVE IN DIRECTORY M0700083 STA* ASDIR+1 M0700084 RTJ* HERE FIND OUT WHERE WE ARE M0700085HERE NUM 0 M0700086 LDA =XLABEL-HERE M0700087 ADD* HERE COMPUTE ADDRESS OF LABEL M0700088 ENQ 0 SET FOR SECTOR 0 M0700089 STQ- I M0700090 ENQ LABLEN LENGTH OF LABEL TO Q M0700091ÐÐ TCQ Q COMPLEMENT FOR WRITE M0700092 RTJ MDRIV WRITE OUT LABEL M0700093* WRITE OUT DIRECTORY M0700094 LDA =XASDIR-HERE M0700095 ADD* HERE COMPUTE ADDRESS OF DIRECTORY M0700096 LDQ* VLASDL PICK UP SECTOR ADDRESS OF DIRECTORY M0700097 STQ- I SAVE IN I M0700098 ENQ 5 SET Q TO LENGTH OF DIRECTORY M0700099 TCQ Q COMPLEMENT Q FOR WRITE M0700100 RTJ MDRIV WRITE OUT DIRECTORY M0700101 JMP* (I2) EXIT M0700102LENGTH NUM 0 LENGTH OF AUTOLOAD PROGRAM M0700103PUTTER NUM 0 M0700104PART1C NUM 0 STARTING SECTOR ADDRESS OF PART 1 IMAGE M0700105PART1L NUM 0 MODIFIED LENGTH OF PART 1 M0700106PART1A NUM 0 MODIFIED CORE ADDRESS OF PART 1 M0700107STMSV4 NUM 0 ADDRESS IN SPACE WHERE TO MOVE THE AUTOLOAD M0700108 SPC 3 M0700109LABEL JMP $60 SET TO JUMP OVER LABEL M0700110VLNAME ALF 4,SYSVOL VOLUME NAME M0700111VLNMBR ALF 1,00 VOLUME NUMBER M0700112VLSER ALF 5, VOLUME SERIAL NUMBER M0700113VLSEC ALF 4, VOLUME SECURITY CODE M0700114VLDATE ALF 4, VOLUME CREATE DATE M0700115VLBMSM NUM 0 BEGINNING OF MANAGEABLE SPACE (MSB) M0700116ÐÐVLBMSL NUM 0 BEGINNING OF MANAGEABLE SPACE (LSB) M0700117VLASDM NUM 0 ALLOCATABLE SPACE DIRECTORY SECTOR (MSB) M0700118VLASDL NUM 0 ALLOCATABLE SPACE DIRECTORY SECTOR (LSB) M0700119VLASDS NUM 22 SIZE OF ALLOCATABLE SPACE DIRECTORY M0700120VLLBA NUM 0 LARGEST AVAILABLE BLOCK (MSB) M0700121 NUM 0 LARGEST AVAILABLE BLOCK (LSB) M0700122VLWPS NUM 96 WORDS/SECTOR M0700123VLFDD NUM 0 ADDRESS OF FILE DIRECTORY (MSB) M0700124 NUM 0 ADDRESS OF FILE DIRECTORY (LSB) M0700125VLMAXF ADC NFILES MAXIMUM NUMBER OF FILES 121*4743M0700126VLCURF NUM 0 CURRENT NUMBER OF FILES M0700127VLNFDB NUM 0 NUMBER OF BLOCKS IN FILE DIRECTORY M0700128VLNXTB NUM 0 NEXT AVAILABLE FILE DIRECTORY BLOCK M0700129LABLEN EQU LABLEN(*-LABEL) M0700130 SPC 2 M0700131ASDIR NUM 0 # FREE SECTORS IN THIS BLOCK (MSB) M0700132 NUM 0 # FREE SECTORS IN THIS BLOCK (LSB) M0700133 NUM 0 START SECTOR OF THIS BLOCK (MSB) M0700134 NUM 0 START SECTOR OF THIS BLOCK (LSB) M0700135 NUM -1 END OF DIRECTORY M0700136 END M0700137 NAM FMULOD B01 A ITOS CCS 3.0 SL-149B0100001* FILE MANAGER UTILITY START PROGRAM B0100002* CREDIT COLLECTION SYSTEM VERSION 3.0 B0100003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B0100004ÐÐ* COPYRIGHT CONTROL DATA CORPORATION 1979 B0100005* B0100006**** B0100007* B0100008* FILE MANAGER UTILITY START PROGRAM B0100009* B0100010* B0100011* FUNCTION B0100012* B0100013* THIS ROUTINE STARTS THE UTIL 1.0 EXECUTIVE B0100014* B0100015* B0100016* GENERAL DESCRIPTION B0100017* B0100018* THIS MUST BE THE FIRST PROGRAM LOADED B0100019* IT WILL JUMP TO THE UTIL 1.0 EXECUTIVE B0100020* PAST THE LABELED COMMON AREA B0100021* B0100022* B0100023* ENTRY B0100024* B0100025* TO ENTER THE UTILITIES TYPE UTIL AND PRESS THE B0100026* CARRIAGE RETURN FOLLOWING THE ITOS REQUEST= MESSAGE B0100027* B0100028* B0100029ÐÐ* ENTRY POINT B0100030* B0100031 ENT FMULOD START ADDR. OF THE UTILITIES B0100032* B0100033* B0100034* EXTERNAL B0100035* B0100036 EXT FMUTEX UTIL 1.0 EXECUTIVE PROGRAM B0100037* B0100038**** B0100039FMULOD NOP 0 B0100040 JMP FMUTEX B0100041* B0100042 END B0100043 NAM FMUTEX B02 A ITOS CCS 3.0 SL-149B0200001* FILE MANAGER UTILITY EXECUTIVE PROGRAM B0200002* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4867B0200003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B0200004* COPYRIGHT CONTROL DATA CORPORATION 1979 B0200005* B0200006**** B0200007* B0200008* FMUTEX : FILE-MANAGER UTILITY EXECUTIVE 122*4873B0200009* B0200010* B0200011ÐÐ* FUNCTION B0200012* B0200013* THE EXECUTIVE DISPLAYS THE PROMPTING LINE(S) IF APPLICABLE B0200014* READS THE INPUT RECORD(S),CHECKS THE REQUESTED COMMAND CODE B0200015* LOADS AND TRANSFERS CONTROL TO THE REQUESTED PROCESSOR B0200016* B0200017* B0200018* GENERAL DESCRIPTION B0200019* B0200020* THE EXECUTIVE ACCEPTS INPUT FROM EITHER AN INTERACTIVE DEVICE B0200021* OR THE DEVICE IT WAS INITIATED ON B0200022* THE EXECUTIVE AND ITS PROCESSORS RUN UNDER THE ITOS 1.0 EXECUTIVEB0200023* IT ACCEPTS INPUT-STRINGS LIKE B0200024* B0200025* COMMAND CODE,PARAMETER-STRING (CR) B0200026* OR B0200027* COMMAND CODE,PARAMETER-STRING;(CR) B0200028* PARAMETER-STRING (CR) B0200029* PARAMETER STRINGS ARE B0200030* P1,P2,P3 (P IS PARAMETER VALUE) B0200031* OR B0200032* P1,,P3 OR P1, ,P3 B0200033* OR B0200034* I1=P1,I2=P2,,I4=P4, ,I6=P6 (I=PARAMETER IDENT) B0200035* B0200036ÐÐ* ONLY THE FIRST FOUR CHARACTERS OF THE COMMAND CODE ARE CHECKED B0200037* B0200038* CONTROL LU IS ASSUMED TO BE THE INTERACTIVE DEVICE OR THE B0200039* DECLARED INPUT DEVICE,WHOEVER CALLED UTIL B0200040* B0200041* B0200042* FLOW B0200043* B0200044* ON ENTRY A RETURN JMP IS DONE TO PGMIN IN ORDER TO OBTAIN B0200045* THE ENTRY PARAMETERS (ID-USER,LUN,MODE,NOPORT) B0200046* BIT 12 OF LUNIT IS SET TO SPECIFY WORD-MODE I/O B0200047* INTERRUPT ADDR IS FMUT1 B0200048* IF IN INTERACTIVE MODE (MODE=0) A PROMPTING MSG IS DISPLAYED B0200049* TO INDICATE THE UTILITIES ARE LOADED B0200050* THE MSG IS B0200051* UTIL IN B0200052* READY B0200053* AND THE PROMPTING INDICATOR(PIND) IS SET TO ZERO B0200054* IF IN BATCH-MODE(MODE=NOT EQ 0) PIND=-1 B0200055* NEXT A READ WILL BE DONE TO READ IN THE REQUIRED COMMAND B0200056* AT COMPLETION OF THE READ,A CALL TO THE SUBROUTINE B0200057* GETFLD IS DONE TO OBTAIN THE FIRST FIELD OF THE INPUTBUFFER B0200058* (INBUF).THE FIRST FIELD IS MOVED TO ANOTHER BUFFER(CODE) B0200059* A CHECK IS DONE TO SEE IF CODE CONTAINS: B0200060* 1. EXIT B0200061ÐÐ* 2. INPUT B0200062* 3. OUTPUT B0200063* 4. HELP B0200064* IF ONE OF THESE IS FOUND,A JUMP TO THE CORRESPONDING B0200065* SUBPROGRAM WITHIN FMUTEX IS DONE B0200066* IF NONE OF THE ABOVE IS FOUND A CALL IS DONE TO THE B0200067* SUBROUTINE COMSEK B0200068* IF THE COMMAND CODE CANNOT BE FOUND,ERROR 31 IS DISPLAYED B0200069* ELSE A CHECK IS DONE TO SEE IF THE COMMAND IS ALLOWED TO B0200070* BE EXECUTED FROM THIS TERMINAL AND IF ITOS SHOULD OR B0200071* SHOULD NOT BE DISABLED. B0200072* THE 6 CHARACTER COMMAND NAME FOUND BY COMSEK WILL NOW B0200073* BE MOVED TO A BUFFER(CLBUF1) AND TO CODE B0200074* THE SCREEN WILL BE CLEARED AND THE COMMAND-NAME IS B0200075* DISPLAYED IF IN INTERACTIVE MODE B0200076* NEXT A FM-CALL IS MADE TO OBTAIN THE INFORMATION B0200077* NECESSARY TO READ IN THE COMMAND-PROCESSOR B0200078* THIS INFO IS CONTAINED IN FILE $$PGMNAM B0200079* THE COMMAND PROCESSOR IS READ INTO THE USER AREA(UTSTRT) B0200080* AND CONTROL IS TRANSFERRED TO THE COMMAND PROCESSOR B0200081* B0200082* B0200083* OUTPUT B0200084* B0200085* WHEN A JMP IS DONE TO UTSTRT TO START THE COMMAND B0200086ÐÐ* PROCESSOR THE FOLLOWING BUFFERS ARE SET B0200087* B0200088* INBUF CONTAINS THE FIRST LINE OF DATA IF READ FROM B0200089* A BATCH DEVICE B0200090* ELSE THE COMMAND-CODE B0200091* CODE CONTAINS THE 6 CHAR COMMAND-CODE B0200092* LUNIT CONTAINS THE LOG.UNIT NUMBER OF THE DEVICE B0200093* MODE IF 0 ,INTERACTIVE-ELSE BATCH-MODE B0200094* IDUSER USER-ID LOGGED IN WITH B0200095* NOPORT TERMINAL PORT NO. B0200096* SWORD START INDEX OF NEXT FIELD WORD IN INBUF B0200097* SBYTE START INDEX OF NEXT FIELD BYTE IN INBUF B0200098* PARLST ADDR OF THE CORRESPONDING PARAMETER LIST TABLE B0200099* PIND PROMPTING LEVEL INDICATOR (-1,0,+1) B0200100* B0200101* B0200102* SUBROUTINES B0200103* B0200104* PGMIN OBTAIN INPUT PARAMETERS B0200105* PGMOUT EXIT TO ITOS 1.0 EXECUTIVE B0200106* PGMINT ALLOW INTERRUPT B0200107* WTREAD TERMINAL WRITE/READ REQUEST B0200108* GETFLD GET NEXT FLD B0200109* OUTEQ SET OUTPUT TO BE THE SPECIFIED DEVICE B0200110* INPEQ SET INPUT TO BE THE SPECIFIED DEVICE B0200111ÐÐ* COMSEK SEARCH FOR COMMAND CODE B0200112* READR FM 2.0 READ FILE REQUEST B0200113* OPENFL FM 2.0 OPEN FILE REQUEST B0200114* CLOSFL FM 2.0 CLOSE FILE REQUEST B0200115* UTSTRT UTIL 1.0 PROCESSOR AREA B0200116* SYSMSG SYSTEM ERROR MSG ROUTINE B0200117* B0200118* PARAMETERS B0200119* B0200120* LABELED COMMON AREA B0200121* B0200122* COMCOD(133) COMMAND CODE TABLE B0200123* FOUR WORD ENTRIES B0200124* 0-2 6 CHARACTER COMMAND CODE B0200125* 3 ADDR OF CORRESPONDING PARAMETER B0200126* PROCESSING TABLE B0200127* B0200128* PARNAM(124) PARAMETER MNEMONIC TABLE B0200129* THREE WORD PER ENTRY B0200130* 1 TWO CHAR.PARAMETER IDENTIFIER B0200131* 2 LENGTH OF PARAMETER VALUE B0200132* WHEN ENTERED B0200133* 3 STORE AREA B0200134* PPHELP(2) PARAMETER PROCESSING TABLE FOR HELP B0200135* PPINIT(4) INIT B0200136ÐÐ* PPDEFI(16) DEFINE B0200137* PPSTAT(4) STATUS B0200138* PPRELO(5) RELOAD 122*4875B0200139* PPDUMP(5) DUMP 122*4875B0200140* PPCOPY(6) COPY B0200141* PPDELE(3) DELETE B0200142* PPCLEA(3) CLEAR B0200143* PPLIST(6) LIST 122*4875B0200144* PPREANA(5) RENAME B0200145* PPCOMM(2) COMMAND B0200146* PPEXIT(1) EXIT B0200147* PPMOUN(3) MOUNT B0200148* PPDISM(2) DISMOUNT B0200149* PPSAVE(3) SAVE B0200150* PPBATC(8) BATCH B0200151* PPLOAD(5) LOAD B0200152* PPPURG(3) PURGE B0200153* PPINPU(2) INPUT B0200154* PPOUTP(2) OUTPUT B0200155* PPCOMP(3) COMPRESS B0200156* PPHOST(4) HOST B0200157* PPSET(3) SET B0200158* PPBATS(4) BATCH STATUS B0200159* PPDISC(2) DISCARD B0200160* PPDISP(7) DISPOSE B0200161ÐÐ* PPFLUSH(3) FLUSH B0200162* PPPRINT(3) PRINT B0200163* DUMMY(6) TEMPORARY STORE AREA OF SOME PARAMETERS B0200164* INBUF(41) INPUT BUFFER TO READ IN B0200165* CODE(20) OUTPUT BUFFER FROM GETFLD B0200166* LUNIT LOGICAL UNIT NO OF THIS TERMINAL B0200167* MODE INDICATES INTERACTIVE MODE OR BATCH MODE B0200168* IDUSER(4) USER-ID LOGGED IN WITH B0200169* NOPORT TERMINAL PORT NO B0200170* SWORD INDEX USED BY GETFLD B0200171* SBYTE INDEX USED BY GETFLD B0200172* PARLST ADDR OF PARAMETER PROCESSING TABLE B0200173* NOCOD ALARM INDICATOR USED BY COMSEK B0200174* PIND PROMPTING LEVEL INDICATOR B0200175* REQBUF(24) USED BY FM 2.0 CALLS REFER TO ERS FM 2.0 B0200176* IDATA(24) USED BY FM 2.0 CALLS REFER TO ERS FM 2.0 B0200177* PARDEF(24) CONTAINS DEFAULTS FOR IDATA B0200178* FCBHDR(5) REFER TO ERS FM 2.0 B0200179* FDBBUF(96) FILE CONTROL BLOCK REFER TO ERS FM 2.0 B0200180* B0200181* B0200182* MESSAGES B0200183* B0200184* UTIL IN INDICATES THE UTILITIES ARE LOADED B0200185* READY READY TO ACCEPT NEXT UTIL 1.0 COMMAND B0200186ÐÐ* B0200187* ERROR MESSAGES B0200188* B0200189* 30 REQUESTED PROCESSOR NOT FOUND B0200190* 31 REQUESTED UTIL COMMAND ILLEGAL B0200191* 32 ILLEGAL COMMAND FORMAT B0200192* 75 ITOS SHOULD BE DISABLED B0200193* 76 SUPERVISOR COMMAND ONLY B0200194* B0200195* MISC B0200196* B0200197* SUPERVISOR COMMAND TABLE SUPCOM B0200198* B0200199**** B0200200 EJT B0200201* B0200202* ENTRY POINTS B0200203* B0200204 ENT FMUTEX B0200205* B0200206* EXTERNALS B0200207* B0200208 EXT PGMIN B0200209 EXT PGMOUT B0200210 EXT PGMINT B0200211ÐÐ EXT WTREAD B0200212 EXT GETFLD B0200213 EXT OUTEQ B0200214 EXT INPEQ B0200215 EXT COMSEK B0200216 EXT READR B0200217 EXT OPENFL B0200218 EXT CLOSFL B0200219 EXT UTSTRT B0200220 EXT SYSMSG B0200221 EXT TSNABL ITOS ENABLE FLAG B0200222* B0200223* EQUATES B0200224* B0200225 EQU INPLEN(40) LENGTH OF INPUT BUFFER B0200226 EQU ZROBIT($33) B0200227 EQU ONEBIT($23) B0200228 EQU ONE($03) B0200229 EQU TWO($24) B0200230 EJT B0200231* B0200232* LABELED COMMON AREA B0200233* B0200234 DAT COMCOD(133),PARNAM(124) B0200235 DAT PPHELP(2) B0200236ÐÐ DAT PPINIT(4) B0200237 DAT PPDEFI(16) B0200238 DAT PPSTAT(4) B0200239 DAT PPRELO(5) 122*4875B0200240 DAT PPDUMP(5) 122*4875B0200241 DAT PPCOPY(6) B0200242 DAT PPDELE(3) B0200243 DAT PPCLEA(3) B0200244 DAT PPLIST(6) 122*4875B0200245 DAT PPRENA(5) B0200246 DAT PPCOMM(2) B0200247 DAT PPEXIT(1) B0200248 DAT PPMOUN(3) B0200249 DAT PPDISM(2) B0200250 DAT PPSAVE(3) B0200251 DAT PPBATC(8) BATCH B0200252 DAT PPLOAD(5) B0200253 DAT PPPURG(3) B0200254 DAT PPINPU(2) B0200255 DAT PPOUTP(2) B0200256 DAT PPCOMP(3) B0200257 DAT PPHOST(4) HOST B0200258 DAT PPSET(3) SET B0200259 DAT PPBATS(4) BATCH STATUS B0200260 DAT PPDISC(2) DISCARD B0200261ÐÐ DAT PPDISP(7) B0200262 DAT PPFLUS(3) FLUSH B0200263 DAT PPPRIN(3) PRINT B0200264 DAT DUMMY(6) B0200265 DAT INBUF(41),CODE(20) B0200266 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B0200267 DAT REQBUF(24),IDATA(24) B0200268 DAT PARDEF(24) B0200269 DAT FCBHDR(5) B0200270 DAT FCBBUF(96) B0200271 DAT ISPARE(72) SPARE LABELED COMMON B0200272 EQU ENDCOM(ISPARE+72) END OF COMMON AREA B0200273 EQU COMLEN(ENDCOM-COMCOD) B0200274 EJT B0200275* B0200276* ZEROISE ALL OF LABELED COMMON B0200277* B0200278 ORG COMCOD B0200279 BZS ZEROES(COMLEN) B0200280* B0200281 ORG PIND B0200282 NUM -1 PRESET PROMPTING LEVEL B0200283* B0200284* COMMAND CODE TABLE B0200285* B0200286ÐÐ ORG COMCOD B0200287 ALF 3,HELP B0200288 ADC PPHELP B0200289 ALF 3,INIT B0200290 ADC PPINIT B0200291 ALF 3,DEFINE B0200292 ADC PPDEFI B0200293 ALF 3,STATUS B0200294 ADC PPSTAT B0200295 ALF 3,RELOAD B0200296 ADC PPRELO B0200297 ALF 3,DUMP B0200298 ADC PPDUMP B0200299 ALF 3,COPY B0200300 ADC PPCOPY B0200301 ALF 3,DELETE B0200302 ADC PPDELE B0200303 ALF 3,CLEAR B0200304 ADC PPCLEA B0200305 ALF 3,LIST B0200306 ADC PPLIST B0200307 ALF 3,RENAME B0200308 ADC PPRENA B0200309 ALF 3,COMMAND B0200310 ADC PPCOMM B0200311ÐÐ ALF 3,EXIT B0200312 ADC PPEXIT B0200313 ALF 3,MOUNT B0200314 ADC PPMOUN B0200315 ALF 3,DISMOUNT B0200316 ADC PPDISM B0200317 ALF 3,SAVE B0200318 ADC PPSAVE B0200319 ALF 3,BATCH B0200320 ADC PPBATC B0200321 ALF 3,LOAD B0200322 ADC PPLOAD B0200323 ALF 3,PURGE B0200324 ADC PPPURG B0200325 ALF 3,INPUT B0200326 ADC PPINPU B0200327 ALF 3,OUTPUT B0200328 ADC PPOUTP B0200329 ALF 3,COMPRES B0200330 ADC PPCOMP B0200331 ALF 3,HOST B0200332 ADC PPHOST B0200333 ALF 3,SET B0200334 ADC PPSET B0200335 ALF 3,BATS BATCH FILE STATUS. B0200336ÐÐ ADC PPBATS B0200337 ALF 3,DISCARD B0200338 ADC PPDISC B0200339 ALF 3,DISPOSE B0200340 ADC PPDISP B0200341 ALF 3,FLUSH B0200342 ADC PPFLUSH B0200343 ALF 3,PRINT B0200344 ADC PPPRIN B0200345 NUM $FFFF END OF TABLE B0200346 EJT B0200347* B0200348 ORG PARNAM B0200349* B0200350* PARAMETER MNEMONIC TABLE B0200351* B0200352* WORD 1 = TWO CHAR.PARAMETER IDENTIFIER B0200353* B0200354* 2 = PARAMETER VALUE LENGTH IN BYTES B0200355* B0200356* 3 = POINTER TO IDATA IF APPLICABLE B0200357* POINTER TO FCBBUF IF APPLICABLE B0200358* OR TO TEMPORARY SAVE AREA (DUMMY) B0200359* B0200360* FOR IDATA REFER TO FILE-MANAGER 2.0 ERS B0200361ÐÐ* B0200362 ALF 1,FN 1 FILE-NAME B0200363 NUM 8 B0200364 ADC IDATA B0200365 ALF 1,OW 2 OWNER-NAME B0200366 NUM 8 B0200367 ADC IDATA+4 B0200368 ALF 1,VL 3 VOLUME-NAME B0200369 NUM 8 B0200370 ADC IDATA+8 B0200371 ALF 1,DK 4 DISK-UNIT B0200372 NUM 2 B0200373 ADC DUMMY+2 B0200374 ALF 1,NF 5 NO.OF FILES B0200375 NUM 4 B0200376 ADC DUMMY B0200377 ALF 1,ED 6 EXPIRATION DATE B0200378 NUM 6 B0200379 ADC FCBBUF+88 B0200380 ALF 1,TY 7 FILE-TYPE B0200381 NUM 1 B0200382 ADC IDATA+15 B0200383 ALF 1,LR 8 LENGTH OF RECORD B0200384 NUM 5 B0200385 ADC IDATA+12 B0200386ÐÐ ALF 1,NR 9 NO. OF RECORDS B0200387 NUM 8 B0200388 ADC IDATA+13 B0200389 ALF 1,K1 10 KEY1 B0200390 NUM 2 B0200391 ADC IDATA+16 B0200392 ALF 1,P1 11 KEY11 POSTION B0200393 NUM 4 B0200394 ADC IDATA+17 B0200395 ALF 1,K2 12 KEY2 B0200396 NUM 2 B0200397 ADC IDATA+18 B0200398 ALF 1,P2 13 KEY2 POSITION B0200399 NUM 4 B0200400 ADC IDATA+19 B0200401 ALF 1,K3 14 KEY3 B0200402 NUM 2 B0200403 ADC IDATA+20 B0200404 ALF 1,P3 15 KEY3 POSITION B0200405 NUM 4 B0200406 ADC IDATA+21 B0200407 ALF 1,K4 16 KEY4 B0200408 NUM 2 B0200409 ADC IDATA+22 B0200410 ALF 1,P4 17 KEY4 POSITION B0200411ÐÐ NUM 4 B0200412 ADC IDATA+23 B0200413 ALF 1,SA 18 SECTOR ALIGNMENT B0200414 NUM 1 B0200415 ADC IDATA+15 B0200416 ALF 1,I 19 INPUT-UNIT B0200417 NUM 8 B0200418 ADC DUMMY B0200419 ALF 1,P 20 OUTPUT-UNIT B0200420 NUM 8 B0200421 ADC DUMMY B0200422 ALF 1,M 21 MODE B0200423 NUM 1 B0200424 ADC DUMMY+5 B0200425 ALF 1,L 22 LIST-UNIT B0200426 NUM 8 B0200427 ADC DUMMY B0200428 ALF 1,F2 23 FILE-NAME 2 B0200429 NUM 8 B0200430 ADC IDATA B0200431 ALF 1,V2 24 VOLUME-NAME 2 B0200432 NUM 8 B0200433 ADC IDATA+8 B0200434 ALF 1,D2 25 DISK 2 B0200435 NUM 2 B0200436ÐÐ ADC DUMMY+2 B0200437 ALF 1,PN 26 PROGRAM NAME B0200438 NUM 6 B0200439 ADC DUMMY B0200440 ALF 1,F 27 FORMAT SPECIFICATION 122*4869B0200441 NUM 1 122*4869B0200442 ADC DUMMY+4 122*4869B0200443 ALF 1,HO 28 HOST NAME B0200444 NUM 4 B0200445 ADC DUMMY+4 B0200446 ALF 1,OP 29 OPTION B0200447 NUM 6 B0200448 ADC IDATA+19 B0200449 ALF 1,NC 30 NUMBER OF CHARACTERS B0200450 NUM 3 B0200451 ADC DUMMY B0200452 ALF 1,SC 31 STARTING CHARACTER B0200453 NUM 3 B0200454 ADC DUMMY+4 B0200455 ALF 1,DO 32 DAYS OLD B0200456 NUM 3 B0200457 ADC DUMMY B0200458 ALF 1,PT 33 PROTOCOL TYPE B0200459 NUM 2 B0200460 ADC DUMMY B0200461ÐÐ ALF 1,JN 34 JOB NUMBER B0200462 NUM 4 B0200463 ADC IDATA+22 B0200464 ALF 1,LU 35 BATCH INPUT LU B0200465 NUM 2 B0200466 ADC DUMMY B0200467 ALF 1,M 36 BATCH MODE B0200468 NUM 1 B0200469 ADC IDATA+17 B0200470 NUM 0 END OF TABLE B0200471* B0200472 EJT B0200473* B0200474* PARAMETER PROCESSING TABLE B0200475* B0200476* BIT SET TO DESCRIPTION B0200477* B0200478* 00-07 NN INDEX TO PARAMETER MNEMONIC TABLE (PARNAM)B0200479* 08 0 RIGHT JUSTIFY B0200480* 1 LEFT JUSTIFY B0200481* 09 0 NO CONVERSION B0200482* 1 ASCII-BINARY CONVERSION B0200483* 10 0 ONE-WORD BINARY OUTPUT B0200484* 1 TWO-WORD BINARY OUTPUT B0200485* 11 0 STANDARD PROCESSING B0200486ÐÐ* 1 SPECIAL PROCESSING(SA,TY) B0200487* 12 0 REQUIRED PARAMETER B0200488* 1 OPTIONAL PARAMETER B0200489* 13-14 NOT USED B0200490* 15 FOUND FLAG B0200491* B0200492 ORG PPHELP B0200493 NUM $1015 B0200494 NUM 0 B0200495 ORG PPINIT B0200496 NUM $0103 INIT VL B0200497 NUM $1205 NF B0200498 NUM $0204 DK B0200499 NUM 0 END OF PARAMETER STRING B0200500 ORG PPDEFI B0200501 NUM $0101 DEFINE FN B0200502 NUM $1103 VL B0200503 NUM $1006 ED B0200504 NUM $1807 TY B0200505 NUM $1208 LR B0200506 NUM $1609 NR B0200507 NUM $120A K1 B0200508 NUM $120B P1 B0200509 NUM $120C K2 B0200510 NUM $120D P2 B0200511ÐÐ NUM $120E K3 B0200512 NUM $120F P3 B0200513 NUM $1210 K4 B0200514 NUM $1211 P4 B0200515 NUM $1812 SA B0200516 NUM 0 END OF PARAMETER STRING B0200517 ORG PPSTAT B0200518 NUM $1101 STATUS FN B0200519 NUM $1102 OW B0200520 NUM $1103 VL B0200521 NUM 0 B0200522 ORG PPRELO B0200523 NUM $1101 RELOAD FN B0200524 NUM $1102 OW 122*4870B0200525 NUM $1103 VL B0200526 NUM $1813 I 122*4861B0200527 NUM 0 B0200528 ORG PPDUMP B0200529 NUM $1101 DUMP FN B0200530 NUM $1102 OW B0200531 NUM $1103 VL B0200532 NUM $1814 P 122*4861B0200533 NUM $0 B0200534 ORG PPCOPY B0200535 NUM $0101 COPY FN B0200536ÐÐ NUM $1103 VL B0200537 NUM $0117 F2 B0200538 NUM $1102 OW B0200539 NUM $1118 V2 B0200540 NUM 0 B0200541 ORG PPDELE B0200542 NUM $0101 DELETE FN B0200543 NUM $1103 VL B0200544 NUM 0 B0200545 ORG PPCLEA B0200546 NUM $0101 CLEAR FN B0200547 NUM $1103 VL B0200548 NUM 0 B0200549 ORG PPLIST B0200550 NUM $0101 LIST FN B0200551 NUM $1103 VL B0200552 NUM $1815 M B0200553 NUM $1816 L B0200554 NUM $181B F 122*4869B0200555 NUM 0 B0200556 ORG PPRENA B0200557 NUM $0101 RENAME FN B0200558 NUM $1103 VL B0200559 NUM $1117 F2 B0200560 NUM $1006 ED B0200561ÐÐ NUM 0 B0200562 ORG PPCOMM B0200563 NUM $1015 COMMAND M B0200564 NUM 0 B0200565 ORG PPEXIT B0200566 NUM 0 B0200567 ORG PPMOUN B0200568 NUM $0103 MOUNT VL B0200569 NUM $0204 DK B0200570 NUM 0 B0200571 ORG PPDISM B0200572 NUM $0204 DISMOUNT DK B0200573 NUM 0 B0200574 ORG PPSAVE B0200575 NUM $204 SAVE DK B0200576 NUM $219 D2 B0200577 NUM 0 B0200578 ORG PPBATC B0200579 NUM $0101 BATCH FN B0200580 NUM $1102 OW B0200581 NUM $1103 VL B0200582 NUM $111C HO B0200583 NUM $1807 TY B0200584 NUM $111A PN B0200585 NUM $1824 BATCH MODE B0200586ÐÐ NUM 0 B0200587 ORG PPLOAD B0200588 NUM $0101 LOAD FN B0200589 NUM $1103 VL B0200590 NUM $1813 I B0200591 NUM $1815 M B0200592 NUM 0 B0200593 ORG PPPURG B0200594 NUM $1102 PURGE OW B0200595 NUM $1103 VL B0200596 NUM 0 B0200597 ORG PPINPU B0200598 NUM $0813 I B0200599 NUM 0 B0200600 ORG PPOUTP B0200601 NUM $0814 P B0200602 NUM 0 B0200603 ORG PPCOMP B0200604 NUM $0101 COMPRESS FN B0200605 NUM $1103 VL B0200606 NUM 0 B0200607 ORG PPHOST B0200608 NUM $011C HO B0200609 NUM $011D OP B0200610 NUM $0121 PT B0200611ÐÐ NUM 0 B0200612 ORG PPSET B0200613 NUM $011C HO B0200614 NUM $0223 LU B0200615 NUM 0 B0200616 ORG PPBATS B0200617 NUM $1122 JN B0200618 NUM $111C HO B0200619 NUM $1116 L B0200620 NUM 0 B0200621 ORG PPDISC B0200622 NUM $0122 JN B0200623 NUM 0 B0200624 ORG PPDISP B0200625 NUM $0122 JN B0200626 NUM $011D OP B0200627 NUM $121E NC B0200628 NUM $121F SC B0200629 NUM $1118 V2 B0200630 NUM $101 FN B0200631 NUM 0 B0200632 ORG PPFLUS B0200633 NUM $011C HO B0200634 NUM $0220 DO B0200635 NUM 0 B0200636ÐÐ ORG PPPRIN B0200637 NUM $011D OP B0200638 NUM $1116 L B0200639 NUM 0 B0200640 NUM 0 END OF PPTAB B0200641 EJT B0200642* B0200643 ORG PARDEF B0200644**** B0200645* B0200646* PARAMETER DEFAULT VALUES ********* B0200647* B0200648 ALF 4, FILE NAME B0200649 ALF 4, OWNER NAME B0200650 ALF 4, VOLUME NAME B0200651 NUM 192 RECORD LENGTH (BYTES) B0200652 NUM 0,1024 NO. OF RECORDS B0200653 NUM 0 S/A=N,SEQUENTIAL FILE 122*4874B0200654 NUM 1,1 LENGTH AND POSITION OF KEY 1 B0200655 NUM 0,0 LENGTH AND POSITION OF KEY 4 B0200656 NUM 0,0 LENGTH AND POSITION OF KEY 2 B0200657 NUM 0,0 LENGTH AND POSITION OF KEY 3 B0200658**** B0200659 ORG* B0200660 EJT B0200661ÐÐ* B0200662* START OF FILE-MANAGER UTILITIES EXECUTIVE B0200663* B0200664FMUTEX NOP B0200665 RTJ PGMIN OBTAIN ENTRY PARAMETERS B0200666 ADC IDUSER ASCII USER INFO B0200667 ADC LUNIT SYST LOG UNIT B0200668 ADC MODE CURRENT MODE OF OPERATION B0200669 ADC NOPORT USER TMNL PORT NO B0200670* B0200671 LDA LUNIT SET BIT 12 OF LUNIT FOR WORD-MODE B0200672 AND- ZROBIT+12 $EFFF B0200673 EOR- ONEBIT+12 $1000 B0200674 STA LUNIT B0200675* B0200676 RTJ PGMINT ALLOW INTERRUPT(EXCLAMATION MARK) B0200677 ADC IADDR B0200678 ADC ZRO B0200679* B0200680 LDA MODE ARE WE IN INTERACTIVE MODE B0200681 SAN FMUT0 NO B0200682 STA PIND SET PROMPTING LEVEL 0 B0200683* B0200684 RTJ WTREAD DISPLAY 'UTIL' B0200685 ADC LUNIT LOGIGAL UNIT NUMBER B0200686ÐÐ ADC NOCUR NO CURSOR POSITIONING REQUESTED B0200687 ADC MSG1 OUTPUT BUFFER ADDRESS B0200688 ADC LENG1 LENGTH OF MSG 1 B0200689 ADC NOCUR NO CURSOR POSITIONING REQUESTED B0200690 ADC DUMMY B0200691 ADC ZRO B0200692 ADC TC TERMINATION CODE B0200693 JMP* FMUT2 B0200694FMUT0 ENA -1 B0200695 STA PIND SET PROMPTING LEVEL -1 B0200696 EJT B0200697* B0200698* READ NEXT LINE OF DATA FROM INPUT DEVICE B0200699* B0200700FMUT1 RTJ PROMPT GO DISPLAY READY B0200701FMUT2 RTJ WTREAD B0200702 ADC LUNIT B0200703 ADC NOCUR NO CURSOR POSITIONING REQUESTED B0200704 ADC DUMMY B0200705 ADC ZRO B0200706 ADC NOCUR NO CURSOR POSITIONING REQUESTED B0200707 ADC INBUF B0200708 ADC BUFLEN B0200709 ADC TC B0200710* B0200711ÐÐ* INITIALIZE FOR COMMAND SEEK B0200712* B0200713 ENA 0 B0200714 STA END B0200715 STA SWORD B0200716 STA SBYTE B0200717 RTJ GETFLD B0200718 ADC INBUF INPUT STRING BUFFER (40 WORDS) B0200719 ADC CODE OUTPUT BUFFER (20 WORDS B0200720 ADC SWORD STARTING WORD INDEX B0200721 ADC SBYTE STARTING CHAR INDEX B0200722 ADC STATUS STATUS TO RETURN B0200723 LDA STATUS IS IT END OF STRING B0200724 SUB N2 B0200725 SAN SCOMSK NO B0200726 RAO END YES,SET END FLAG B0200727 EJT B0200728* B0200729* START OF CHECKING COMMAND CODES B0200730* B0200731SCOMSK LDA CODE IS IT AN EXIT COMMAND B0200732 SUB EXCOM B0200733 SAN NOEND NO B0200734 JMP ENDUT1 YES,STOP EXECUTION B0200735* B0200736ÐÐNOEND LDA CODE IS IT AN INPUT COMMAND B0200737 SUB INPCOM B0200738 SAN NOINP NO B0200739 LDA CODE+1 B0200740 SUB INPCOM+1 CHECK FOR PU B0200741 SAN NOINP B0200742 JMP CINPUT B0200743NOINP LDA CODE IS IT AN OUTPUT COMMAND B0200744 SUB OUTCOM B0200745 SAN NOOUT NO B0200746 JMP COUPU B0200747* B0200748NOOUT LDA CODE IS IT A HELP COMMAND B0200749 SUB HLPCOM B0200750 SAZ CSTAT IT IS A HELP-COMMAND B0200751 JMP* NOHELP B0200752* B0200753CSTAT LDA STATUS FIELD TERMINATED BY AN EOL B0200754 INA -2 B0200755 SAZ PRO2 YES B0200756 INA 2 NO,TERMINATED BY A COMMA B0200757 SAZ PRO1 YES,PROMPTING LEVEL 1 IS SET B0200758 ENA 2 ILLEGAL COMMAND FORMAT B0200759 JMP ALARM B0200760PRO1 ENA 1 B0200761ÐÐSETPRO STA PIND B0200762 JMP* FMUT1 GO,READ NEXT LINE B0200763* B0200764PRO2 LDA MODE ARE WE IN INTERACTIVE MODE B0200765 SAN NOPRO NO B0200766 CLR A YES B0200767 JMP* SETPRO B0200768* B0200769NOPRO ENA -1 NO PROMPTING B0200770 JMP* SETPRO B0200771* B0200772NOHELP RTJ COMSEK SEARCH COMCOD FOR CODE MATCH B0200773 ADC CODE B0200774 ADC NOCOD B0200775 ADC PARLST B0200776* B0200777 LDQ NOCOD IS COMMAND LEGAL B0200778 SQP CMDFND YES B0200779 ENA 1 ILLEGAL COMMAND B0200780 JMP ALARM B0200781* B0200782CMDFND TRQ A CALCULATE INDEX TO SUPCOM B0200783 ARS 2 B0200784 STA- I B0200785 LDA SUPCOM,I B0200786ÐÐ SAP CNDCHK CHECK CONDITIONS B0200787 ENA 1 31 REQUESTED COMMAND NOT LEGAL B0200788 JMP ALARM B0200789* B0200790* CONDITION CHECK B0200791* B0200792CNDCHK AND- ONE SHOULD ITOS BE DISABLED ? B0200793 SAZ CHKTML NO,CHECK FOR SUPERVISOR ONLY B0200794 LDA TSNABL GET ITOS ENABLED FLAG B0200795 SAZ CHKTML ITOS IS DISABLED B0200796 ENA 45 75 ITOS SHOULD BE DISABLED B0200797 JMP ALARM B0200798* B0200799* CHECK FOR SUPERVISOR TERMINAL ONLY COMMAND B0200800* B0200801CHKTML LDA SUPCOM,I B0200802 ARS 1 B0200803 AND- ONE B0200804 SAZ MOVCOM NOT A SUPERVISOR COMMAND B0200805 LDA NOPORT CHECK IF TERMINAL IS SUPERVISOR B0200806 SAZ MOVCOM YES,IT IS A SUPERVISOR B0200807 ENA 46 76 SUPERVISOR COMMAND ONLY B0200808 JMP ALARM B0200809* B0200810MOVCOM CLR A MOVE 6 CHAR. COMMAND CODE B0200811ÐÐ STA- I B0200812 LDA UT STORE UT IN FRONT OF THE B0200813 STA CODE PROCESSOR NAME TO CALL IN THE FILE B0200814MVCMD LDA COMCOD,B GET COMMAND FROM COMCOD TABLE B0200815 STA CODE+1,I B0200816 STA CLBUF1,I B0200817 LDA- I CHECK IF COMMAND MOVED COMPLETELY B0200818 SUB- TWO B0200819 SAZ DSPPRG DISPLAY PROCESSOR NAME B0200820 RAO- I B0200821 JMP* MVCMD B0200822* B0200823DSPPRG LDA MODE INTERACTIVE ? B0200824 SAN LDPGM NO B0200825 RTJ WTREAD CLEAR SCREEN AND DISPLAY PROC.NAME B0200826 ADC LUNIT B0200827 ADC NOCUR B0200828 ADC CLBUF B0200829 ADC LENCL B0200830 ADC NOCUR B0200831 ADC DUMMY B0200832 ADC ZRO B0200833 ADC TC B0200834* B0200835* CLEAR REQUEST BUFFER B0200836ÐÐ* B0200837LDPGM LDQ =N23 B0200838LDP1 CLR A B0200839 STA REQBUF,Q B0200840 INQ -1 B0200841 SQM LDPG B0200842 JMP* LDP1 B0200843* B0200844LDPG LDA =XFCBHDR B0200845 STA REQBUF+9 B0200846* B0200847 RTJ OPENFL OPEN THE PROG.NAME FILE B0200848 ADC REQBUF B0200849 ADC NDATA B0200850 ADC STATUS RETURN STATUS OF FM REQUEST B0200851* B0200852 LDA STATUS CHECK IF OPENED CORRECTLY B0200853 SAZ RDNAM YES B0200854 ENA 3 NO,FILE REQUEST REJECTED B0200855 JMP ALARM B0200856* B0200857RDNAM RTJ READR READ THE DESIRED ENTRY B0200858 ADC REQBUF B0200859 ADC INFO 6 WORD OUTPUT BUFFER B0200860 ADC CODE CONTAINS THE PRG.NAME ASKED FOR B0200861ÐÐ ADC STATUS B0200862* B0200863 RTJ CLOSFL CLOSE THE PGMNAM FILE B0200864 ADC REQBUF B0200865 ADC ISTAT B0200866* B0200867 LDA STATUS CHECK IF PROGRAM FOUND B0200868 SAZ BLDREQ B0200869* B0200870 ENA 0 UTILITY PROCESSOR NOT FOUND B0200871 JMP* ALARM B0200872* B0200873BLDREQ LDA INFO+3 BUILD THE PGM READ REQUEST B0200874 STA* MSBP B0200875 LDA INFO+4 B0200876 STA* LSBP B0200877 LDA INFO+5 B0200878 STA* PLEN B0200879* B0200880* READ IN THE DESIRED COMMAND PROCESSOR B0200881* B0200882REDPRO RTJ- ($F4) B0200883 NUM $4844 FREAD REQUEST B0200884 NUM 0 B0200885 NUM 0 B0200886ÐÐ NUM $08C2 SYSTEM DISK B0200887PLEN NUM 0 B0200888 ADC UTSTRT B0200889MSBP NUM 0 B0200890LSBP NUM 0 B0200891* B0200892 RTJ UTSTRT START THE COMMAND PROCESSOR B0200893* B0200894 RTJ PGMINT RESET CONTROL D ENTRY B0200895 ADC IADDR B0200896 ADC ZRO B0200897 RTJ PGMIN OBTAIN ENTRY PARAMETERS B0200898 ADC IDUSER ASCII USER INFO B0200899 ADC LUNIT SYST LOG UNIT B0200900 ADC MODE CURRENT MODE OF OPERATION B0200901 ADC NOPORT USER TMNL PORT NO B0200902* B0200903 LDA LUNIT SET BIT 12 FOR WORD MODE B0200904 AND- ZROBIT+12 B0200905 EOR- ONEBIT+12 B0200906 STA LUNIT B0200907* B0200908 LDA MODE HAS MODE CHANGED TO INTERACTIVE ? B0200909 SAN RDNXT NO B0200910 LDA PIND YES,CHECK PROMPTING INDICATOR B0200911ÐÐ SAP RDNXT SET FOR PROMPTING ALREADY B0200912 CLR A SET FOR HELP MODE PROMPTING B0200913 STA PIND B0200914RDNXT JMP FMUT1 GO,READ NEXT COMAND B0200915 EJT B0200916* B0200917* CHANGE INPUT UNIT B0200918* B0200919CINPUT LDA* STATUS B0200920 SUB* N3 TERMINATED ON A =SIGN B0200921 SAZ RUNAM YES B0200922 ENA 2 ILLEGAL COMMAND FORMAT B0200923 JMP* ALARM NO B0200924* B0200925* READ UNIT NAME B0200926* B0200927RUNAM RTJ GETFLD B0200928 ADC INBUF B0200929 ADC CODE B0200930 ADC SWORD B0200931 ADC SBYTE B0200932 ADC STATUS B0200933* B0200934 LDA* STATUS B0200935 SUB* N2 IS IT END OF LINE B0200936ÐÐ SAN CINP2 NO B0200937 RAO* END B0200938CINP2 RTJ INPEQ B0200939 ADC CODE B0200940 ADC STATUS B0200941* B0200942 LDA* STATUS IS COMMAND ACCEPTED ? B0200943 SAN IOER B0200944 JMP FMUT1 B0200945* B0200946IOER ENA $22 B0200947 JMP* ALARM B0200948 EJT B0200949* B0200950* CHANGE OUTPUT UNIT B0200951* B0200952COUPU RTJ GETFLD B0200953 ADC INBUF B0200954 ADC CODE B0200955 ADC SWORD B0200956 ADC SBYTE B0200957 ADC STATUS B0200958* B0200959 RTJ OUTEQ B0200960 ADC CODE B0200961ÐÐ ADC STATUS B0200962* B0200963 LDA* STATUS B0200964 SAN OUTERR B0200965 JMP FMUT1 B0200966* B0200967OUTERR JMP* IOER B0200968 EJT B0200969* B0200970* DISPLAY READY DEPENDING UPON PIND B0200971* B0200972PROMPT NOP B0200973 LDA PIND PROMPTING WANTED B0200974 SAM EXT0 NO B0200975* B0200976 RTJ WTREAD B0200977 ADC LUNIT B0200978 ADC NOCUR NO CURSOR POSITIONING REQUESTED B0200979 ADC MSG2 B0200980 ADC LENG2 B0200981 ADC NOCUR NO CURSOR POSITIONING REQUESTED B0200982 ADC DUMMY B0200983 ADC ZRO B0200984 ADC TC B0200985* B0200986ÐÐEXT0 JMP* (PROMPT) B0200987* B0200988ENDUT1 RTJ WTREAD DISPLAY END OF UTIL MESSAGE B0200989 ADC LUNIT B0200990 ADC NOCUR B0200991 ADC ENDMSG B0200992 ADC ELENG B0200993 ADC NOCUR B0200994 ADC DUMMY B0200995 ADC ZRO B0200996 ADC TC B0200997* B0200998 RTJ PGMOUT CONTROL GOES BACK TO ITOS B0200999 EJT B0201000* B0201001* ALARM ROUTINE B0201002* B0201003ALARM ADD* ERNUM ADD BASE ERROR NO. TO ERROR CODE B0201004 STA* INDEX B0201005 LDA MODE INTERACTIVE ? B0201006 SAN ALARM1 NO B0201007 RTJ SYSMSG DISPLAY ERROR B0201008 ADC INDEX B0201009 ADC ERBUF B0201010* B0201011ÐÐALARM1 JMP FMUT1 READ NEXT LINE B0201012* B0201013INDEX NUM 0 B0201014ERBUF NUM 0 B0201015ERNUM NUM 30 ERROR BASE NUMBER B0201016 EJT B0201017* B0201018* LOCAL VARIABLES B0201019* B0201020N2 NUM 2 B0201021N3 NUM 3 B0201022HLPCOM ALF 1,HE B0201023OUTCOM ALF 1,OU B0201024INPCOM ALF 2,INPU INPUT-COMMAND B0201025EXCOM ALF 1,EX EXIT-COMMAND B0201026TC NUM 0 B0201027END NUM 0 B0201028STATUS NUM 0 B0201029IADDR ADC FMUT1 B0201030NDATA ALF 4,$$PGMNAM B0201031 ALF 4,$$ B0201032 ALF 4, B0201033 NUM 1,1,0 B0201034INFO BZS INFO(6) B0201035ISTAT NUM 0 B0201036ÐÐ* B0201037* FMUTEX MESSAGES B0201038* B0201039MSG1 NUM $1800 CLEAR SCREEN B0201040 ALF 4, UTIL IN B0201041 NUM $0A0D LF/CR B0201042 ALF 4, READY B0201043 EQU MSG1L(*-MSG1) B0201044MSG2 NUM $0A0D LF/CR B0201045 ALF 4, READY B0201046 EQU MSG2L(*-MSG2) B0201047CLBUF NUM $1800 CLEAR SCREEN B0201048CLBUF1 ALF 3, B0201049 NUM $0A0D LF/CR B0201050 EQU LCL(*-CLBUF) B0201051ENDMSG NUM $0A0D LF/CR B0201052 ALF 10, END UTIL B0201053 NUM $0A0D LF/CR B0201054 EQU EMSGL(*-ENDMSG) B0201055* B0201056NOCUR NUM -1 B0201057ZRO NUM 0 B0201058BUFLEN ADC INPLEN B0201059LENG1 ADC MSG1L B0201060LENG2 ADC MSG2L B0201061ÐÐLENCL ADC LCL B0201062ELENG ADC EMSGL B0201063UT ALF 1,UT B0201064 EJT B0201065**** B0201066* B0201067* SUPERVISOR COMMAND TABLE B0201068* B0201069* THE ORDER OF THIS TABLE MUST BE THE SAME AS COMCOD-TABLE B0201070* B0201071* BIT 0 = 1 ITOS MUST BE DISABLED B0201072* BIT 1 = 1 ONLY ALLOWED FOR MASTER TERMINAL B0201073* B0201074* BIT 15 = 1 NON-EXCISTING COMMAND B0201075* B0201076SUPCOM NUM 0 HELP B0201077 NUM 2 INIT B0201078 NUM 0 DEFINE B0201079 NUM 0 STATUS 122*4867B0201080 NUM 2 RELOAD B0201081 NUM 2 DUMP B0201082 NUM 0 COPY B0201083 NUM 0 DELETE B0201084 NUM 0 CLEAR B0201085 NUM 0 LIST B0201086ÐÐ NUM 0 RENAME B0201087 NUM 0 COMMAND B0201088 NUM 0 EXIT B0201089 NUM 2 MOUNT B0201090 NUM 2 DISMOUNT B0201091 NUM 3 SAVE B0201092 NUM 0 BATCH B0201093 NUM 0 LOAD B0201094 NUM 3 PURGE B0201095 NUM 2 INPUT B0201096 NUM 2 OUTPUT B0201097 NUM 0 COMPRESS B0201098 NUM 2 HOST B0201099 NUM 2 SET B0201100 NUM 0 BATCH STATUS (BATS) B0201101 NUM 0 DISCARD B0201102 NUM 0 DISPOSE B0201103* ALLOW FLUSH FROM PROCEDURE STREAM B0201104 NUM 0 FLUSH B0201105 NUM 2 PRINT B0201106 NUM $FFFF B0201107* B0201108**** B0201109 END B0201110 NAM SEKVIT B03 A ITOS CCS 3.0 SL-149B0300001ÐÐ* SEARCH VIT FOR MATCH AGAINST VOLUME NAME B0300002* CREDIT COLLECTION SYSTEM VERSION 3.0 B0300003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B0300004* COPYRIGHT CONTROL DATA CORPORATION 1979 B0300005* B0300006**** B0300007* FUNCTION B0300008* B0300009* B0300010* THIS ROUTINE SEARCHES THE CORE-RESIDENT VOLUME-INFORMATION TABLES B0300011* FOR A MATCH AGAINST A PASSED VOLUME-NAME.IF A MATCH IS FOUND THEN B0300012* THE CORE-ADDRESS AND THE MASS-MEMORY UNIT NO.OF THE SELECTED VIT B0300013* ARE RETURNED . IF NO MATCH IS FOUND,AN ADDRESS OF ZERO IS RETURNED B0300014* B0300015* CALLING SEQUENCE B0300016* B0300017* CALL SEKVIT (NAME,VITADR,MMUNIT) B0300018* B0300019* B0300020* INPUT B0300021* B0300022* NAME VOLUME NAME B0300023* B0300024* B0300025* OUTPUT B0300026ÐÐ* B0300027* VITADR VOLUME INFORMATION TABLE ADDR B0300028* MMUNIT PHYSICAL MM UNIT NO B0300029* B0300030* PARAMETER B0300031* B0300032* NAME 4 WORD ASCII BUFFER CONTAINING THE VOLUME-NAME B0300033* VITADR SELECTED VIT OR ZERO B0300034* MMUNIT VOLUME'S MASS MEMORY UNIT NO(INDEX TO MMLUTB) B0300035* B0300036* ENTRY POINTS B0300037* B0300038 ENT SEKVIT B0300039* B0300040* EXTERNALS B0300041* B0300042 EXT MMLUTB MASS MEMORY LU TABLE B0300043 EXT Q8PREP B0300044 EXT Q8PKUP B0300045* B0300046* EQUIVALENCES B0300047* B0300048 EQU ZERO(2) B0300049* B0300050* VOLUME INFORMATION TABLE B0300051ÐÐ* B0300052 EQU VISLUN(2) SYSTEM LOGICAL UNIT NUMBER (BIT 15=1,NOT READYB0300053* ACCESS VISLUN INDIRECTLY B0300054 EQU VINAME(1) VOLUME NAME - ASCII CHARACTERS 1 AND 2 B0300055* VOLUME NAME - ASCII CHARACTERS 3 AND 4 B0300056* VOLUME NAME - ASCII CHARACTERS 5 AND 6 B0300057* VOLUME NAME - ASCII CHARACTERS 7 AND 8 B0300058 EQU VINMBR(5) VOLUME NUMBER - (2 ASCII CHARACTERS) B0300059 EQU VIBMSM(6) BEGINNING OF MANAGEABLE SPACE - MSB B0300060 EQU VIBMSL(7) BEGINNING OF MANAGEABLE SPACE - LSB B0300061 EQU VIASDM(8) AVAILABLE SPACE DIRECTORY ADDRESS - MSB B0300062 EQU VIASDL(9) AVAILABLE SPACE DIRECTORY ADDRESS - LSB B0300063 EQU VIASDS(10) # SECTORS IN AVAILABLE SPACE DIRECTORY B0300064 EQU VILBAM(11) LARGEST BLOCK OF SPACE AVAILABLE - MSB B0300065 EQU VILBAL(12) LARGEST BLOCK OF SPACE AVAILABLE - LSB B0300066 EQU VIWPS(13) WORDS/SECTOR FOR VOLUME B0300067 EQU VIFDDM(14) FILE DEFINITION DIRECTORY ADDRESS - MSB B0300068 EQU VIFDDL(15) FILE DEFINITION DIRECTORY ADDRESS - LSB B0300069 EQU VIMAXF(16) MAX. NUMBER OF FILES PERMITTED ON VOLUME B0300070 EQU VICURF(17) CURRENT NUMBER OF FILES EXISTING ON VOLUME B0300071 EQU VINFDB(18) NUMBER OF BLOCKS IN FILE DEFINITION DIRECTORY B0300072 EQU VINXTB(19) NEXT AVAILABLE BLOCK IF FILE DEF. DIRECTORY B0300073 EQU VINOOF(20) NUMBER OF OPEN FILES ON VOLUME B0300074**** B0300075* B0300076ÐÐ* B0300077* START OF VIT SEARCH B0300078* B0300079SEKVIT NOP B0300080 STQ* QSAVE SAVE Q REGISTER B0300081 LDA- I B0300082 STA* ISAVE SAVE I REGISTER B0300083* B0300084 RTJ Q8PREP B0300085 ADC* SEKVIT ABSOLUTISE PARAMETER ADDRESS B0300086* B0300087HERE RTJ Q8PKUP B0300088 STA* NAME SAVE BUFFER ADDRESS B0300089 RTJ* (HERE+1) B0300090 STA* VITADR SAVE VITADR ADDRESS B0300091 RTJ* (HERE+1) B0300092 STA* MMUNIT SAVE MMUNIT ADDRESS B0300093* B0300094* START TABLE LOOP B0300095* B0300096 ENQ 1 B0300097 STQ* (MMUNIT) B0300098* B0300099TLOOP LDQ* (MMUNIT) Q=CURRENT INDEX TO MMLUTB B0300100ADDR LDA MMLUTB,Q GET TABLE ADDRESS B0300101ÐÐ STA- I B0300102 LDA- (VISLUN),I CHECK IF VOLUME IS MOUNTED B0300103 SAM NEXT SKIP IF NOT MOUNTED B0300104 LDA- I B0300105 INA VINAME SAVE VOLUME NAME ADDRESS B0300106 STA- I B0300107 ENQ 3 CHECK IF NAME MATCHES B0300108* B0300109NLOOP LDA* (NAME),Q B0300110 EOR- (ZERO),B B0300111 SAN NEXT SKIP IF NOT EQUAL B0300112 INQ -1 B0300113 SQM FOUND B0300114 JMP* NLOOP B0300115* B0300116NEXT LDA* (MMUNIT) ALL TABLES SEARCHED B0300117 SUB* (ADDR+1) B0300118 SAZ FAIL YES B0300119 RAO* (MMUNIT) NO B0300120 JMP* TLOOP B0300121* B0300122FOUND LDA- I RETURN VIT ADDRESS B0300123 INA -VINAME B0300124 JMP* EXIT B0300125* B0300126ÐÐFAIL ENA 0 B0300127* B0300128EXIT STA* (VITADR) B0300129 LDQ* QSAVE RESTORE Q REGISTER B0300130 LDA* ISAVE B0300131 STA- I RESTORE I REGISTER B0300132* B0300133 JMP* (SEKVIT) B0300134* B0300135* LOCAL VARIABLES B0300136* B0300137QSAVE NUM 0 LOCATION TO SAVE Q REGISTER B0300138ISAVE NUM 0 LOCATION TO SAVE I REGISTER B0300139NAME NUM 0 LOCATION TO SAVE VOLNAM ADDRESS B0300140VITADR NUM 0 B0300141MMUNIT NUM 0 B0300142* B0300143 END B0300144 NAM REDLAB B04 A ITOS CCS 3.0 SL-149B0400001* READ LABEL FROM SPECIFIED VOLUME B0400002* CREDIT COLLECTION SYSTEM VERSION 3.0 B0400003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B0400004* COPYRIGHT CONTROL DATA CORPORATION 1979 B0400005* B0400006**** B0400007ÐÐ* B0400008* FUNCTION B0400009* B0400010* THIS ROUTINE READS THE VOLUME LABEL FROM THE SPECIFIED B0400011* VOLUME B0400012* B0400013* B0400014* GENERAL DESCRIPTION B0400015* B0400016* A MSOS FREAD REQUEST IS DONE TO READ THE LABEL OF THE B0400017* MOUNTED VOLUME ON THE SPECIFIED DISK B0400018* B0400019* B0400020* INPUT REQUIREMENTS B0400021* B0400022* VITADR VIT ADDR OF SPECIFIED DISK B0400023* MMUNIT PHYSICAL DISK NO B0400024* B0400025* B0400026* OUTPUT B0400027* B0400028* LABEL THIS BUFFER WILL CONTAIN THE LABEL READ B0400029* B0400030* B0400031* CALLING SEQUENCE B0400032ÐÐ* B0400033* CALL REDLAB (LABEL,VITADR,MMUNIT) B0400034* B0400035* B0400036* ENTRY POINTS B0400037* B0400038 ENT REDLAB B0400039* B0400040* EXTERNALS B0400041* B0400042 EXT Q8PREP B0400043 EXT Q8PKUP B0400044* B0400045* EQUIVALENCES B0400046* B0400047 EQU LABSIZ(96) LENGTH OF LABEL (IN WORDS) B0400048 EQU VIWPS(13) B0400049 EQU LMSB(21) LABEL MSB 121*4742B0400050 EQU LLSB(22) LABEL LSB 121*4742B0400051 EQU ZERO($22) B0400052* B0400053* VOLUME LABEL B0400054* B0400055 EQU VLIFLG(0) VOLUME INITIALIZED FLAG B0400056 EQU VLNAME(2) VOLUME NAME B0400057ÐÐ EQU VLNMBR(6) VOLUME NUMBER B0400058 EQU VLSER(7) VOLUME SERIAL B0400059 EQU VLSEC(12) VOLUME SECURITY CODE B0400060 EQU VLDATE(16) VOLUME CREATE DATE B0400061 EQU VLBMSM(20) BEGINNING OF MANAGEABLE SPACE (MSB) B0400062 EQU VLBMSL(21) BEGINNING OF MANAGEABLE SPACE (LSB) B0400063 EQU VLASDM(22) ALLOCATABLE SPACE DIRECTORY SECTOR (MSB) B0400064 EQU VLASDL(23) ALLOCATABLE SPACE DIRECTORY SECTOR (LSB) B0400065 EQU VLASDS(24) SIZE OF ALLOCATABLE SPACE DIRECTORY B0400066 EQU VLLBA(25) LARGEST BLOCK AVAILABLE(MSB) B0400067 EQU VLWPS(27) # WORDS/SECTOR B0400068 EQU VLFDD(28) ADDRESS OF FILE DIRECTORY B0400069 EQU VLMAXF(30) MAXIMUM NUMBER OF FILES B0400070 EQU VLCURF(31) CURRENT NUMBER OF FILES B0400071 EQU VLNFDB(32) NUMBER OF BLOCKS IN FILE DIRECTORY B0400072 EQU VLNXTB(33) NEXT AVAILABLE FILE DIRECTORY BLOCK B0400073* B0400074**** B0400075REDLAB NOP B0400076 STQ* QSAVE SAVE Q REGISTER B0400077 LDA- I B0400078 STA* ISAVE SAVE I-REGISTER B0400079* B0400080 RTJ Q8PREP B0400081 ADC* REDLAB B0400082ÐÐ* B0400083HERE RTJ Q8PKUP B0400084 STA* LABBUF STORE BUFFER WHERE TO READ INTO B0400085 RTJ* (HERE+1) B0400086 STA* VITAD STORE VIT-ADDRESS B0400087 RTJ* (HERE+1) B0400088 STA* MMUNIT B0400089* B0400090* PREPARE MASS MEMORY READ REQUEST B0400091* B0400092 LDQ* (VITAD) B0400093 LDA- (ZERO),Q B0400094 STA* REQLUN MASS MEMORY UNIT TO RED FROM B0400095 LDA* LABBUF B0400096 STA* REQBUF BUFFER TO READ INTO B0400097 LDA* (VITAD) VITADR TO A 121*4742B0400098 INA LMSB 121*4742B0400099 TRA Q 121*4742B0400100 LDA- (ZERO),Q GET LABEL MSB 121*4742B0400101 STA* REQMSB STORE INTO REQUEST 121*4742B0400102 INQ 1 121*4742B0400103 LDA- (ZERO),Q GET LABEL LSB 121*4742B0400104 STA* REQLSB STORE INTO REQUEST 121*4742B0400105* B0400106* MAKE A REQUEST TO READ IN THE LABEL INFORMATION B0400107ÐÐ* B0400108 RTJ- ($F4) B0400109 NUM $4800 B0400110 NUM 0,0 NOT USED UNDER ITOS-DIALOG B0400111REQLUN NUM 0 B0400112 ADC LABSIZ B0400113REQBUF NUM 0 B0400114REQMSB NUM 0 121*4742B0400115REQLSB NUM 0 121*4742B0400116* B0400117 LDQ* QSAVE RESTORE Q REGISTER B0400118 LDA* ISAVE RESTORE I REGISTER B0400119 STA- I B0400120 JMP* (REDLAB) RETURN B0400121* B0400122* LOCAL VARIABLES B0400123* B0400124QSAVE NUM 0 LOCATION TO SAVE Q REGISTER B0400125ISAVE NUM 0 LOCATION TO SAVE I REGISTER B0400126LABBUF NUM 0 LOCATION OF BUFFER ADDRESS B0400127VITAD NUM 0 LOCATION OF VIT ADDRESS B0400128MMUNIT NUM 0 MASS MEMORY LU NUMBER B0400129* B0400130 END B0400131 NAM NXTVOL B05 A ITOS CCS 3.0 SL-149B0500001ÐÐ* GET LU OF NEXT MOUNTED VOLUME B0500002* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B0500003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B0500004* COPYRIGHT CONTROL DATA CORPORATION 1979 B0500005* B0500006**** B0500007* B0500008* FUNCTION B0500009* B0500010* THIS ROUTINE SEARCHES THE NEXT MOUNTED VOLUME B0500011* B0500012* B0500013* GENERAL DESCRIPTION B0500014* B0500015* ON ENTRY THE PARAMETER MMUNIT IS CHECKED TO SEE IF IT B0500016* IS WITHIN THE RANGE OF THE NO OF DISK-UNITS ATTACHED B0500017* TO THE SYSTEM (NO OF DISK UNITS IS IN MMLUTB) B0500018* THE CORE-RESIDENT VOLUME INFORMATION TABLE CORRESPONDING B0500019* WITH MMUNIT IS NOW CHECKED TO SEE IF A VOLUME IS MOUNTED B0500020* IF SO, THE VOLUME-NAME FROM THE VIT IS TRANSFERRED TO B0500021* THE COMMON AREA IDATA(9)-IDATA(12) B0500022* IF NOT,MMUNIT IS INCREMENTED BY ONE AND SEARCH WILL B0500023* CONTINUE B0500024* IF THE END OF MMLUTB IS REACHED AND NO VOLUME IS FOUND B0500025* TO BE MOUNTED,MMUNIT IS SET TO ZERO B0500026ÐÐ* B0500027* B0500028* INPUT REQUIREMENTS B0500029* B0500030* MMUNIT PHYSICAL DISK-UNIT NO. STARTING AT 1 B0500031* B0500032* B0500033* OUTPUT B0500034* B0500035* IF A MOUNTED VOLUME IS FOUND,IDATA(9-12) CONTAINS B0500036* VOLUME-NAME B0500037* ELSE MMUNIT=0 B0500038* B0500039* B0500040* CALLING SEQUENCE B0500041* B0500042* CALL NXTVOL (MMUNIT) B0500043* B0500044* B0500045* ENTRY POINT B0500046* B0500047 ENT NXTVOL B0500048* B0500049* EXTERNALS B0500050* B0500051ÐÐ EXT MMLUTB B0500052 EXT Q8PREP B0500053 EXT Q8PKUP B0500054* B0500055* LABELED COMMON AREA B0500056* B0500057 DAT COMCOD(133),PARNAM(124) B0500058 DAT PPHELP(2) B0500059 DAT PPINIT(4) B0500060 DAT PPDEFI(16) B0500061 DAT PPSTAT(4) B0500062 DAT PPRELO(5) 122*4875B0500063 DAT PPDUMP(5) 122*4875B0500064 DAT PPCOPY(6) B0500065 DAT PPDELE(3) B0500066 DAT PPCLEA(3) B0500067 DAT PPLIST(6) 122*4875B0500068 DAT PPRENA(5) B0500069 DAT PPCOMM(2) B0500070 DAT PPEXIT(1) B0500071 DAT PPMOUN(3) B0500072 DAT PPDISM(2) B0500073 DAT PPSAVE(3) B0500074 DAT PPBATC(8) BATCH B0500075 DAT PPLOAD(5) B0500076ÐÐ DAT PPPURG(3) B0500077 DAT PPINPU(2) B0500078 DAT PPOUTP(2) B0500079 DAT PPCOMP(3) B0500080 DAT PPHOST(4) HOST B0500081 DAT PPSET(3) SET B0500082 DAT PPBATS(4) BATCH STATUS B0500083 DAT PPDISC(2) DISCARD B0500084 DAT PPDISP(7) DISPOSE B0500085 DAT PPFLUS(3) FLUSH B0500086 DAT PPPRIN(3) PRINT B0500087 DAT DUMMY(6) B0500088 DAT INBUF(41),CODE(20) B0500089 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B0500090 DAT REQBUF(24),IDATA(24) B0500091 DAT PARDEF(24) B0500092 DAT FCBHDR(5) B0500093 DAT FCBBUF(96) B0500094 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B0500095 EQU COMLEN(ENDCOM-COMCOD) B0500096* B0500097* B0500098* EQUIVALENCES B0500099* B0500100 EQU ZERO(2) B0500101ÐÐ* B0500102* VOLUME INFORMATION TABLE B0500103* B0500104 EQU VISLUN(2) SYSTEM LOGICAL UNIT NUMBER (BIT 15=1,NOT READYB0500105* ACCESS VISLUN INDIRECTLY B0500106 EQU VINAME(1) VOLUME NAME - ASCII CHARACTERS 1 AND 2 B0500107* VOLUME NAME - ASCII CHARACTERS 3 AND 4 B0500108* VOLUME NAME - ASCII CHARACTERS 5 AND 6 B0500109* VOLUME NAME - ASCII CHARACTERS 7 AND 8 B0500110 EQU VINMBR(5) VOLUME NUMBER - (2 ASCII CHARACTERS) B0500111 EQU VIBMSM(6) BEGINNING OF MANAGEABLE SPACE - MSB B0500112 EQU VIBMSL(7) BEGINNING OF MANAGEABLE SPACE - LSB B0500113 EQU VIASDM(8) AVAILABLE SPACE DIRECTORY ADDRESS - MSB B0500114 EQU VIASDL(9) AVAILABLE SPACE DIRECTORY ADDRESS - LSB B0500115 EQU VIASDS(10) # SECTORS IN AVAILABLE SPACE DIRECTORY B0500116 EQU VILBAM(11) LARGEST BLOCK OF SPACE AVAILABLE - MSB B0500117 EQU VILBAL(12) LARGEST BLOCK OF SPACE AVAILABLE - LSB B0500118 EQU VIWPS(13) WORDS/SECTOR FOR VOLUME B0500119 EQU VIFDDM(14) FILE DEFINITION DIRECTORY ADDRESS - MSB B0500120 EQU VIFDDL(15) FILE DEFINITION DIRECTORY ADDRESS - LSB B0500121 EQU VIMAXF(16) MAX. NUMBER OF FILES PERMITTED ON VOLUME B0500122 EQU VICURF(17) CURRENT NUMBER OF FILES EXISTING ON VOLUME B0500123 EQU VINFDB(18) NUMBER OF BLOCKS IN FILE DEFINITION DIRECTORY B0500124 EQU VINXTB(19) NEXT AVAILABLE BLOCK IF FILE DEF. DIRECTORY B0500125 EQU VINOOF(20) NUMBER OF OPEN FILES ON VOLUME B0500126ÐÐ* B0500127**** B0500128NXTVOL NOP B0500129 STQ* QSAVE SAVE Q REGISTER B0500130 LDA- I B0500131 STA* ISAVE SAVE I REGISTER B0500132* B0500133 RTJ Q8PREP B0500134 ADC* NXTVOL PICK UP PARAMETERS B0500135* B0500136HERE RTJ Q8PKUP B0500137 STA* MMUNIT SAVE MMUNIT ADDRESS B0500138 CLR Q CHECK IF MMUNIT B0500139 LDA MMLUTB,Q IS WITHIN RANGE B0500140 SUB* (MMUNIT) B0500141 SAP TLOOP IT IS B0500142 JMP* ENDTAB B0500143* B0500144* GET NEXT MOUNTED VOLUME-NAME B0500145* B0500146TLOOP LDQ* (MMUNIT) Q=CUURENT INDEX B0500147ADDR LDA MMLUTB,Q GET TABLE ADDRESS B0500148 STA- I B0500149 LDA- (VISLUN),I IS VOLUME MOUNTED ? B0500150 SAM NEXT SKIP IF NOT B0500151ÐÐ LDA- I B0500152 INA VINAME B0500153 STA- I B0500154 ENQ 3 B0500155* B0500156NLOOP LDA- (ZERO),B TRANSFER VOLUME NAME B0500157 STA IDATA+8,Q B0500158 INQ -1 B0500159 SQM END NAME TRANSFERRED B0500160 JMP* NLOOP NOT YET B0500161* B0500162NEXT LDA* (MMUNIT) SET READY TO GET NEXT VIT B0500163 SUB* (ADDR+1) B0500164 SAZ ENDTAB END OF VITTAB REACHED B0500165 RAO* (MMUNIT) NO B0500166 JMP* TLOOP B0500167* B0500168ENDTAB ENA 0 B0500169 STA* (MMUNIT) B0500170* B0500171END LDQ* QSAVE RESTORE Q REGISTER B0500172 LDA* ISAVE RESTORE I REGISTER B0500173 STA- I B0500174 JMP* (NXTVOL) RETURN B0500175* B0500176ÐÐ* LOCAL VARIABLES B0500177* B0500178MMUNIT NUM 0 B0500179QSAVE NUM 0 B0500180ISAVE NUM 0 B0500181 END B0500182 NAM COMSEK B06 A ITOS CCS 3.0 SL-149B0600001* SEARCH FOR VALID COMMAND CODE B0600002* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B0600003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B0600004* COPYRIGHT CONTROL DATA CORPORATION 1979 B0600005* B0600006**** B0600007* B0600008* COMSEK :COMMAND-CODE SEEK ROUTINE B0600009* B0600010* FUNCTION B0600011* B0600012* THIS ROUTINE SEARCHES A COMMAND-CODE TABLE (COMCOD) B0600013* TO CHECK IF THE COMMAND ENTERED (CODE) IS LEGAL B0600014* B0600015* GENERAL DESCRIPTION B0600016* B0600017* CONSEK TESTS IF THE COMMAND CODE CONTAINED IN A B0600018* TWO-WORD BUFFER (CODE) CORRESPONDS WITH ONE OF B0600019ÐÐ* THE ENTRIES IN THE COMCOD-TABLE B0600020* B0600021* IF NO MATCH IS FOUND AN ERROR MSG WILL BE FORWARDED B0600022* B0600023* CALLING PROCEDURE B0600024* B0600025* CALL COMSEK (CODE,STAT,PARLST) B0600026* B0600027* CODE = ADDRESS OF INPUT STRING B0600028* STAT = INDEX IN COMCOD TABLE B0600029* PARLST= ADDRESS OF PARAMETER PROCESSING TABLE B0600030* B0600031* INPUT REQUIREMENTS B0600032* B0600033* CODE CONTAINS THE FOUR CHARACTER COMMAND-CODE B0600034* B0600035* B0600036* OUTPUT B0600037* B0600038* STAT IF COMMAND FOUND CONTAINS INDEX TO COMCOD B0600039* ELSE IS SET TO MINUS B0600040* PARLST CONTAINS ADDR OF PARAMETER PROCESSING TABLE B0600041* B0600042* B0600043* TABLES USED B0600044ÐÐ* B0600045* COMCOD COMMAND CODE TABLE B0600046* B0600047* B0600048* ENTRY POINTS B0600049* B0600050 ENT COMSEK B0600051* B0600052* LABELED COMMON AREA B0600053* B0600054 DAT COMCOD(133),PARNAM(124) B0600055 DAT PPHELP(2) B0600056 DAT PPINIT(4) B0600057 DAT PPDEFI(16) B0600058 DAT PPSTAT(4) B0600059 DAT PPRELO(5) 122*4875B0600060 DAT PPDUMP(5) 122*4875B0600061 DAT PPCOPY(6) B0600062 DAT PPDELE(3) B0600063 DAT PPCLEA(3) B0600064 DAT PPLIST(6) 122*4875B0600065 DAT PPRENA(5) B0600066 DAT PPCOMM(2) B0600067 DAT PPEXIT(1) B0600068 DAT PPMOUN(3) B0600069ÐÐ DAT PPDISM(2) B0600070 DAT PPSAVE(3) B0600071 DAT PPBATC(8) BATCH B0600072 DAT PPLOAD(5) B0600073 DAT PPPURG(3) B0600074 DAT PPINPU(2) B0600075 DAT PPOUTP(2) B0600076 DAT PPCOMP(3) B0600077 DAT PPHOST(4) HOST B0600078 DAT PPSET(3) SET B0600079 DAT PPBATS(4) BATCH STATUS B0600080 DAT PPDISC(2) DISCARD B0600081 DAT PPDISP(7) DISPOSE B0600082 DAT PPFLUS(3) FLUSH B0600083 DAT PPPRIN(3) PRINT B0600084 DAT DUMMY(6) B0600085 DAT INBUF(41),CODE(20) B0600086 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B0600087 DAT REQBUF(24),IDATA(24) B0600088 DAT PARDEF(24) B0600089 DAT FCBHDR(5) B0600090 DAT FCBBUF(96) B0600091 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B0600092 EQU COMLEN(ENDCOM-COMCOD) B0600093**** B0600094ÐÐ* B0600095COMSEK NOP B0600096 LDA* (COMSEK) B0600097 STA* ICODE B0600098 RAO* COMSEK B0600099 LDA* (COMSEK) B0600100 STA* STAT B0600101 RAO* COMSEK B0600102 LDA* (COMSEK) B0600103 STA* PPTAB B0600104 RAO* COMSEK B0600105* B0600106 ENQ 0 B0600107 STQ- I B0600108CONTC LDA COMCOD,Q IS THIS END OF TABLE B0600109 SAP NOTEND NO B0600110 JMP* WRONG YES,ILLEGAL COMMAND CODE B0600111NOTEND SUB* (ICODE) B0600112 SAZ MATCH1 B0600113 INQ 1 B0600114NOMTCH INQ 3 B0600115 JMP* CONTC B0600116* B0600117MATCH1 INQ 1 FIRST TWO CHAR ARE EQUAL B0600118 ENA 1 B0600119ÐÐ STA- I B0600120 LDA COMCOD,Q B0600121 SUB* (ICODE),I B0600122 SAZ FOUND COMMAND FOUND B0600123 JMP* NOMTCH B0600124* B0600125FOUND INQ -1 B0600126 STQ* (STAT) B0600127 INQ 3 B0600128 LDQ COMCOD,Q B0600129 STQ* (PPTAB) STORE PARAMETER LIST ADDRESS B0600130 JMP* (COMSEK) B0600131* B0600132* COMMAND DOES NOT EXCIST B0600133* B0600134WRONG ENA -1 B0600135 STA* (STAT) B0600136 JMP* (COMSEK) B0600137* B0600138* LOCAL VARIABLES B0600139* B0600140ICODE NUM 0 B0600141STAT NUM 0 B0600142PPTAB NUM 0 B0600143* B0600144ÐÐ END B0600145 NAM MOVEL B07 A ITOS CCS 3.0 SL-149B0700001* MOVE FIELD LEFT JUSTIFIED, BLANK FILL B0700002* CREDIT COLLECTION SYSTEM VERSION 3.0 B0700003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B0700004* COPYRIGHT CONTROL DATA CORPORATION 1979 B0700005* B0700006**** B0700007* B0700008* FUNCTION B0700009* B0700010* MOVE FIELD LEFT JUSTIFIED WITH BLANK FILL B0700011* B0700012* B0700013* GENERAL DESCRIPTION B0700014* B0700015* MOVEL PICKS UP CHAR. FROM THE INPUT FIELD (INP) B0700016* AND TRANSFERS THE NUMBER OF CHAR. SPECIFIED(LNGO) B0700017* LEFT JUSTIFIED TO THE OUTPUT FIELD (OUTP) B0700018* B0700019* FIELD WILL BE TRUNCATED AT RIGHT END IF IT EXCEEDS B0700020* LNGO CHARACTERS B0700021* B0700022* B0700023* INPUT REQUIREMENTS B0700024ÐÐ* B0700025* INP ADDRESS OF THE INPUT BUFFER B0700026* OUTP ADDRESS CONTAINING THE OUTPUT ADDRESS B0700027* LNGO ADDRESS CONTAINING THE NO. OF CHAR TO MOVE B0700028* B0700029* B0700030* CALLING SEQUENCE B0700031* B0700032* CALL MOVEL (INP,OUTP,LNGO) B0700033* B0700034* B0700035* EQUATES B0700036* B0700037 EQU LPMASK(2) B0700038 EQU NZERO($12) B0700039 EQU ONEBIT($23) B0700040* B0700041* B0700042* ENTRY POINT B0700043* B0700044 ENT MOVEL B0700045* B0700046**** B0700047MOVEL NOP B0700048 LDA* (MOVEL) PICK UP PARAMETERS B0700049ÐÐ STA* INP INPUT BUFFER ADDRESS B0700050 RAO* MOVEL B0700051 LDA* (MOVEL) B0700052 STA* OUTP OUTPUT FIELD ADDRESS B0700053 LDA* (OUTP) B0700054 STA* OUTP B0700055 RAO* MOVEL B0700056 LDA* (MOVEL) B0700057 STA* LNGO NO.OF CHAR.TO MOVE B0700058 RAO* MOVEL B0700059 ENA 0 INITIALISE POINTERS B0700060 STA* OUTWRD OUTPUT-WORD POINTER B0700061 STA* INPCHR INPUT-CHAR LEFT/RIGHT POINTER B0700062 STA* OUTCHR OUTPUT-CHAR LEFT/RIGHT POINTER B0700063 STA* INPWRD INPUT-WORD POINTER B0700064 CLR Q B0700065 LDA* (LNGO) CALCULATE NO OF WORDS TO BE MOVED B0700066 DVI* N2 B0700067 SQZ MOV1 EVEN NO OF BYTES B0700068 INA 1 ODD NO OF BYTES (ROUND UP) B0700069MOV1 STA* ENDFLD NO OF WORDS TO BE MOVED B0700070* B0700071* PRESET OUTPUT-FIELD WITH SPACES B0700072* B0700073 ENQ 0 B0700074ÐÐMOV2 LDA* BLANK B0700075 STA* (OUTP),Q STORE SPACE TO OUTPUT-FIELD B0700076 INQ 1 B0700077 TRQ A B0700078 SUB* ENDFLD ALL SET B0700079 SAZ MOV3 YES B0700080 JMP* MOV2 NO,CONTINUE B0700081* B0700082MOV3 LDQ* INPWRD GET NEXT INPUT CHAR B0700083 LDA* (INP),Q GET WORD B0700084 LDQ* INPCHR IS A LOWER HALF CHAR B0700085 SQN MOV4 YES B0700086 ARS 8 NO,SHIFT UPPER CHAR B0700087MOV4 AND- LPMASK+8 $00FF B0700088 STA* TEMP SAVE NEXT CHAR B0700089 INA -$20 IS IT A BLANK B0700090 SAN MOV5 NO B0700091 JMP* MOV7 B0700092* B0700093MOV5 LDQ* OUTWRD GET OUTPUT WORD B0700094 LDA* (OUTP),Q B0700095 LDQ* OUTCHR LOWER HALF B0700096 SQN MOV6 YES B0700097 AND- LPMASK+8 NO,MASK OUT UPPER PART B0700098 LDQ* TEMP B0700099ÐÐ QLS 8 B0700100 EAQ A MERGE TO ONE WORD B0700101 LDQ* OUTWRD B0700102 STA* (OUTP),Q B0700103 JMP* MOV7 SEE IF FINISHED B0700104* B0700105MOV6 LDQ* OUTWRD B0700106 AND- NZERO+8 B0700107 EOR* TEMP MERGE WITH LOWER PART CHAR B0700108 STA* (OUTP),Q B0700109* B0700110MOV7 LDA* (LNGO) B0700111 INA -1 B0700112 STA* (LNGO) B0700113 SAN MOV8 NOT ALL MOVED B0700114FINIS JMP* (MOVEL) READY B0700115* B0700116MOV8 LDA* OUTWRD LAST WORD REACHED B0700117 SUB* ENDFLD B0700118 SAN MOV9 NO B0700119 LDA* OUTCHR YES,IS IT LAST CHAR B0700120 SAZ MOV9 NO B0700121 JMP* FINIS YES B0700122* B0700123MOV9 LDA* OUTCHR SWITCH OUTPUT-CHAR POSITION B0700124ÐÐ EOR- ONEBIT B0700125 STA* OUTCHR B0700126 SAN MOV10 NEXT OUTPUT CHAR TO SAME WORD B0700127 RAO* OUTWRD NEXT OUTPUT CHAR TO NEXT WORD B0700128* B0700129* B0700130* B0700131MOV10 LDA* INPCHR SWITCH INPUT-CHAR POSITION B0700132 EOR- ONEBIT B0700133 STA* INPCHR B0700134 SAN MOV11 NEXT INPUT CHAR IS IN SAME WORD B0700135 RAO* INPWRD NEXT INPUT CHAR IS IN NEXT WORD B0700136* B0700137MOV11 JMP* MOV3 GO,GET NEXT INPUT CHAR B0700138* B0700139* LOCAL VARIABLES B0700140* B0700141BLANK ALF 1, B0700142N2 NUM 2 B0700143OUTCHR NUM 0 B0700144INPCHR NUM 0 B0700145ENDFLD NUM 0 B0700146LNGO NUM 0 B0700147OUTP NUM 0 B0700148INP NUM 0 B0700149ÐÐINPWRD NUM 0 B0700150TEMP NUM 0 B0700151OUTWRD NUM 0 B0700152* B0700153 END B0700154 NAM MOVER B08 A ITOS CCS 3.0 SL-149B0800001* MOVE FIELD RIGHT JUSTIFIED, ZERO FILL B0800002* CREDIT COLLECTION SYSTEM VERSION 3.0 B0800003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B0800004* COPYRIGHT CONTROL DATA CORPORATION 1979 B0800005* B0800006**** B0800007* B0800008* FUNCTION B0800009* B0800010* MOVE FIELD RIGHT JUSTIFIED WITH ZERO FILL B0800011* B0800012* B0800013* GENERAL DESCRIPTION B0800014* B0800015* MOVER ZEROES THE OUTPUT-FIELD PRIOR TO THE TRANSFER B0800016* OF CHARACTERS.IT PICKS UP CHAR.FROM RIGHT TO LEFT B0800017* AND STORES THEM IN THE SAME ORDER B0800018* B0800019* BLANKS DETECTED IN THE INPUT-FIELD WILL BE IGNORED B0800020ÐÐ* WHEN THE MOVE IS DONE LNGI WILL BE SET TO ZERO B0800021* B0800022* B0800023* INPUT REQUIREMENTS B0800024* B0800025* INP INPUT BUFFER ADDRESS B0800026* LNGI ADDR CONTAINING NO OF CHAR IN INP TO MOVE B0800027* OUTP ADDR CONTAINING THE OUTPUT BUFFER ADDR B0800028* LNGO ADDR CONTAINING NO OF CHAR IN OUTPUT BUFFER B0800029* B0800030* B0800031* CALLING SEQUENCE B0800032* B0800033* CALL MOVER (INP,LNGI,OUTP,LNGO) B0800034* B0800035* B0800036* ENTRY POINT B0800037* B0800038 ENT MOVER B0800039* B0800040* B0800041* EQUATES B0800042* B0800043 EQU LPMASK(2) B0800044 EQU NZERO($12) B0800045ÐÐ EQU ONEBIT($23) B0800046* B0800047* B0800048* PARAMETERS B0800049* B0800050* OUTCHR POINTER TO BYTE IN OUTPUTWORD B0800051* OUTWRD POINTER TO OUTPUT WORD B0800052* INPCHR POINTER TO BYTE IN INPUT WORD B0800053* INPWRD POINTER TO INPUT WORD B0800054* ENDFLD NO OF WORDS IN INPUTFIELD B0800055* B0800056* B0800057**** B0800058MOVER NOP B0800059* B0800060 LDA* (MOVER) PICK UP PARAMETERS B0800061 STA* INP INPUT BUFFER ADDRESS B0800062 RAO* MOVER B0800063 LDA* (MOVER) B0800064 STA* LNGI B0800065 RAO* MOVER B0800066 LDA* (MOVER) B0800067 STA* OUTP OUTPUT BUFFER ADDRESS B0800068 LDA* (OUTP) B0800069 STA* OUTP B0800070ÐÐ RAO* MOVER B0800071 LDA* (MOVER) B0800072 STA* LNGO NO OF CHAR. TO TRANSFER B0800073 RAO* MOVER B0800074* B0800075* INITIALISATION B0800076* B0800077 ENA 1 INITIALISE POINTERS B0800078 STA* INPCHR TO POINT TO LOWER HALF B0800079 STA* OUTCHR B0800080 ENA 0 B0800081 STA* INPWRD B0800082 STA* OUTWRD B0800083* B0800084 CLR Q B0800085 LDA* (LNGO) CALCULATE NO OF WORDS OF OUTPUT FIELD B0800086 DVI N2 B0800087 SQZ MOV1 EVEN NO OF CHAR B0800088 INA 1 ODD B0800089MOV1 STA* ENDFLD NO OF WORDS B0800090* B0800091 CLR Q B0800092 LDA* (LNGI) CALCULATE NO OF WORDS OF INPUT FIELD B0800093 DVI* N2 B0800094 SQZ MOV15 B0800095ÐÐ* B0800096 TRA Q B0800097 LDA* INPCHR SWITCH INPCHR TO UPPER HALF B0800098 EOR- ONEBIT IF ODD NO OF CHAR INPUT B0800099 STA* INPCHR B0800100 TRQ A B0800101* B0800102 INA 1 B0800103MOV15 STA* ENDINP B0800104* B0800105 LDA* INP CALCULATE END OF FIELD ADDRESS B0800106 ADD* ENDINP B0800107 INA -1 B0800108 STA* INPL END INPUT FIELD ADDRESS B0800109* B0800110 LDA* OUTP CALCULATE END ADDRESS OF B0800111 ADD* ENDFLD OUTPUT-FIELD B0800112 INA -1 B0800113 STA* OUTPL END OUTPUT FIELD ADDRESS B0800114* B0800115* PRESET OUTPUT FIELD WITH ZEROES B0800116* B0800117 LDQ* ENDFLD B0800118MOV2 INQ -1 B0800119 LDA* ZEROES B0800120ÐÐ STA* (OUTP),Q STORE ZEROES TO OUTPUT FIELD B0800121 TRQ A B0800122 SAZ MOV3 ALL ZEROED B0800123 JMP* MOV2 NO.CONTINUE B0800124* B0800125* GET NEXT INPUT CHARACTER B0800126* B0800127MOV3 LDQ* INPWRD B0800128 LDA* (INPL),Q GET WORD OF INPUT FIELD B0800129 LDQ* INPCHR IS IT A LOWER CHAR B0800130 SQN MOV4 YES B0800131 ARS 8 NO,SHIFT UPPER B0800132MOV4 AND- LPMASK+8 MASK OUT B0800133 STA* TEMP SAVE TEMPORARILY B0800134 INA -$20 IS IT A BLANK B0800135 SAN MOV5 NO B0800136 JMP* MOV9 YES,IGNORE B0800137* B0800138MOV5 LDQ* OUTWRD GET OUTPUT WORD B0800139 LDA* (OUTPL),Q B0800140 LDQ* OUTCHR LOWER CHAR B0800141 SQN MOV6 YES B0800142 AND- LPMASK+8 NO,MASK OUT B0800143 LDQ* TEMP COMBINE WITH CHAR STORED B0800144 QLS 8 B0800145ÐÐ EAQ A B0800146 LDQ* OUTWRD B0800147 STA* (OUTPL),Q B0800148 JMP* MOV7 NEXT TO BE DONE ? B0800149* B0800150MOV6 LDQ* OUTWRD B0800151 AND- NZERO+8 B0800152 EOR* TEMP COMBINE WITH STORED ONE B0800153 STA* (OUTPL),Q B0800154* B0800155MOV7 LDA* (LNGI) B0800156 INA -1 B0800157 STA* (LNGI) B0800158 SAN MOV8 NOT ALL MOVED B0800159FINIS JMP* (MOVER) FINISHED,EXIT B0800160* B0800161MOV8 LDA* OUTCHR SWITCH OUTPUT CHAR POINTER B0800162 EOR- ONEBIT B0800163 STA* OUTCHR B0800164 SAZ MOV10 WORD NOT YET COMPLETED B0800165 LDA* OUTWRD UPDATE FOR NEXT WORD B0800166 INA -1 B0800167 STA* OUTWRD B0800168 JMP* MOV10 B0800169* B0800170ÐÐMOV9 LDA* (LNGI) DECREMENT NO OF CHAR TO MOVE B0800171 INA -1 B0800172 STA* (LNGI) B0800173 SAN MOV10 ALL MOVED ? B0800174 JMP* FINIS YES B0800175* B0800176MOV10 LDA* INPCHR SWITCH INPUT CHAR B0800177 EOR- ONEBIT B0800178 STA* INPCHR B0800179 SAZ MOV11 UPPER HALF B0800180 LDA* INPWRD LOWER HALF,SO B0800181 INA -1 UPDATE INPUT WORD B0800182 STA* INPWRD B0800183MOV11 JMP* MOV3 GET NEXT CHAR B0800184* B0800185* LOCAL VARIABLES B0800186* B0800187ZEROES ALF 1,00 B0800188N2 NUM 2 B0800189OUTCHR NUM 0 B0800190INPCHR NUM 0 B0800191OUTWRD NUM 0 B0800192INPWRD NUM 0 B0800193ENDFLD NUM 0 B0800194LNGO NUM 0 B0800195ÐÐINPL NUM 0 B0800196OUTPL NUM 0 B0800197INP NUM 0 B0800198OUTP NUM 0 B0800199TEMP NUM 0 B0800200ENDINP NUM 0 B0800201LNGI NUM 0 B0800202* B0800203 END B0800204 NAM GETFLD B09 A ITOS CCS 3.0 SL-149B0900001* GET NEXT INPUT FIELD B0900002* CREDIT COLLECTION SYSTEM VERSION 3.0 B0900003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B0900004* COPYRIGHT CONTROL DATA CORPORATION 1979 B0900005* B0900006**** B0900007* B0900008* FUNCTION B0900009* B0900010* THIS ROUTINE SEARCHES AN ASCII BUFFER AND RETURNS WITH THE B0900011* FIELD CONTENTS IN AN OUTPUT BUFFER(SBUF) B0900012* THE FIELDS ARE CONTROLLED BY DELIMETERS AND BLANKS ARE IGNORED B0900013* B0900014* GENERAL DESCRIPTION B0900015* B0900016ÐÐ* GETFLD SEARCHES THE ASCII INPUT BUFFER (IBUF),STARTING AT A B0900017* SPECIFIED WORD LOCATION(SWORD) AND A SPECIFIED BYTE LOCATION B0900018* WITHIN THE WORD (SCHAR) B0900019* CHARACTERS ARE EXTRACTED FROM THE STRING AND STORED INTO THE B0900020* OUTPUT BUFFER (SBUF) B0900021* AT RETURN THE LOCATIONS SWORD AND SCHAR WILL BE UPDATED FOR B0900022* THE NEXT CALL B0900023* B0900024* A STATUS WORD (STAT) WILL BE RETURNED,INDICATING THE TERMINATION B0900025* OF THE SEARCH B0900026* STAT = 0 SEARCH TERMINATED AT A COMMA B0900027* 1 A SEMI-COLON B0900028* 2 AN END-OF-LINE B0900029* 3 AN EQUAL-SIGN B0900030* B0900031* BLANKS ARE IGNORED B0900032* B0900033* CALLING PROCEDURE B0900034* B0900035* CALL GETFLD(IBUF,SBUF,SWORD,SCHAR,STAT) B0900036* B0900037* IBUF = INPUT BUFFER (40 WORDS) B0900038* SBUF = OUTPUT BUFFER (20 WORDS) B0900039* SWORD= START WORD LOCATION INDEX (0-39) B0900040* SCHAR= START BYTE LOCATION INDICATOR(0=UPPER,1=LOWER) B0900041ÐÐ* STAT = STATUS TO BE RETURNED B0900042* B0900043* ENTRY POINT B0900044* B0900045 ENT GETFLD B0900046* B0900047* EQUIVALENCES B0900048* B0900049 EQU ZERO($22) B0900050 EQU ONEBIT($23) B0900051 EQU LPMASK(2) B0900052 EQU NZERO($12) B0900053 EQU BLANK($20) B0900054 EQU ETX($03) B0900055 EQU EQUAL($3D) B0900056 EQU COMMA($2C) B0900057 EQU SEMCOL($3B) B0900058**** B0900059 EJT B0900060GETFLD NOP B0900061 LDQ* (GETFLD) PICK UP THE PARAMETERS B0900062 STQ* IBUF B0900063 RAO* GETFLD B0900064 LDQ* (GETFLD) B0900065 STQ* SBUF B0900066ÐÐ RAO* GETFLD B0900067 LDQ* (GETFLD) B0900068 STQ* SWORD B0900069 RAO* GETFLD B0900070 LDQ* (GETFLD) B0900071 STQ* SCHAR B0900072 RAO* GETFLD B0900073 LDQ* (GETFLD) B0900074 STQ* STAT B0900075 RAO* GETFLD B0900076* B0900077* INITIALIZATION B0900078* B0900079 ENA 0 B0900080 STA* END CLEAR END FLAG B0900081 STA* (STAT) STATUS B0900082* B0900083* SET AN ETX AFTER THE LAST INPUT CHARACTER B0900084* B0900085 ENQ 40 B0900086 LDQ* (IBUF),Q GET NO OF CHAR READ B0900087* B0900088 TRQ A 120*4570B0900089 INA -80 IS THIS A 40 WORD REQUEST (80 CH.) 120*4570B0900090 SAZ OKA YES 120*4570B0900091ÐÐ* B0900092OK LRS 1 CONVERT TO NO OF WORDS B0900093 SAP GF0 SKIP IF EVEN B0900094 LDA* (IBUF),Q ODD B0900095 AND- NZERO+8 MASK OUT LOWER HALF B0900096 INA BLANK REPLACE WITH BLANK B0900097 STA* (IBUF),Q B0900098 INQ 1 B0900099 TRQ A GET NUMBER OF WORDS READ 120*4570B0900100 INA -36 HAS THE LAST COLUMN BEEN REACHED 120*4570B0900101 SAM GF0 NO 120*4570B0900102OKA ENQ 36 YES, SET LAST TO 72 120*4570B0900103* B0900104GF0 LDA* ETXCOD STORE ETX-CODE B0900105 STA* (IBUF),Q B0900106* B0900107OKD ENQ 19 B0900108 LDA SPACES B0900109GF1 STA* (SBUF),Q WITH SPACES B0900110 SQZ GF2 B0900111 INQ -1 B0900112 JMP* GF1 B0900113GF2 STQ* OWORD SET OUTPUT POINTER WORD LOCATION B0900114 STQ* OCHAR BYTE INDICATOR B0900115* B0900116ÐÐ* GET NEXT CHARACTER FROM INPUT STRING B0900117* B0900118GF3 LDQ* (SWORD) GET NEXT INPUT WORD B0900119 LDA* (IBUF),Q B0900120 LDQ* (SCHAR) UPPER OR LOWER HALF B0900121 SQN GF4 B0900122 ARS 8 UPPER HALF B0900123GF4 AND- LPMASK+8 $00FF B0900124 STA* TEMP SAVE TEMPORARELY B0900125 TRA Q B0900126* B0900127* CHECK FOR SPECIAL CHARACTERS B0900128* B0900129 INA -BLANK IS IT A SPACE ? B0900130 SAN GF5 NO B0900131 JMP* NXTCHR YES,IGNORE B0900132GF5 LDA* END FIELD TERMINATOR ALREADY DETECTED B0900133 SAZ GF51 NO B0900134 JMP* (GETFLD) YES,EXIT B0900135GF51 TRQ A B0900136 INA -ETX IS IT END OF INPUT ? B0900137 SAN GF61 NO B0900138 JMP* GF11 YES,SET END STATUS AND EXIT B0900139GF61 TRQ A IS IT AN EQUAL-SIGN ? B0900140 INA -EQUAL IS IT AN EQUAL-SIGN ? B0900141ÐÐ SAN GF7 NO B0900142 ENA 3 YES,SET STATUS = 3 B0900143 STA* (STAT) B0900144 RAO* END SET END B0900145 JMP* NXTCHR CONTINUE TO NEXT NON-BLANK CHAR B0900146GF7 TRQ A IS IT A COMMA B0900147 INA -COMMA IS IT A COMMA ? B0900148 SAN GF75 NO B0900149 ENA 0 YES,STATUS=0 B0900150GF77 STA* (STAT) B0900151 RAO* END B0900152 JMP* NXTCHR B0900153GF75 TRQ A B0900154 INA -SEMCOL IS IT A SEMI-COLON ? B0900155 SAN GF8 NO B0900156 ENA 1 YES,STATUS=1 B0900157 JMP* GF115 B0900158* B0900159* LOCAL VARIABLES B0900160* B0900161IBUF NUM 0 B0900162SBUF NUM 0 B0900163SWORD NUM 0 B0900164SCHAR NUM 0 B0900165STAT NUM 0 B0900166ÐÐEND NUM 0 B0900167OWORD NUM 0 B0900168OCHAR NUM 0 B0900169TEMP NUM 0 B0900170SPACES ALF 1, B0900171ETXCOD NUM $0320 B0900172 EJT B0900173* B0900174* STORE CHARACTERS IN OUTPUT BUFFER B0900175* B0900176GF8 LDQ* OWORD B0900177 LDA* (SBUF),Q B0900178 LDQ* OCHAR UPPER OF LOWER BYTE TO STORE B0900179 SQN GF9 LOWER B0900180 AND- LPMASK+8 $00FF UPPER BYTE MUST BE STORED B0900181 LDQ* TEMP B0900182 QLS 8 B0900183 EAQ A B0900184 LDQ* OWORD B0900185 STA* (SBUF),Q B0900186 JMP* GF10 B0900187GF9 LDQ* OWORD STORE LOWER BYTE IN SBUF B0900188 AND- NZERO+8 $FF00 B0900189 EOR* TEMP B0900190 STA* (SBUF),Q B0900191ÐÐGF10 LDA* OCHAR B0900192 EOR- ONEBIT B0900193 STA* OCHAR B0900194 SAN NXTCHR B0900195 LDA* OWORD B0900196 INA 1 B0900197 STA* OWORD B0900198 INA -20 EXCEEDED SBUF SIZE 132*5346B0900199 SAP GF11 YES, SET LAST CHARACTER STATUS 132*5346B0900200* B0900201* END OF FIELD PROCESSING B0900202* B0900203NXTCHR LDA* (SWORD) LAST WORD OF INPUT BUFFER REACHED B0900204 INA -35 120*4570B0900205 SAN GF12 NO B0900206 LDA* (SCHAR) YES,IS IT LAST CHAR B0900207 SAZ GF12 NO B0900208GF11 ENA 2 YES,SET STATUS =2 B0900209GF115 STA* (STAT) B0900210 JMP* (GETFLD) B0900211GF12 LDA* (SCHAR) B0900212 EOR- ONEBIT SWITCH CHARACTER B0900213 STA* (SCHAR) B0900214 SAN GF13 LOWER HALF OF SAME WORD B0900215 LDA* (SWORD) UPPER HALF OF NXT WORD B0900216ÐÐ INA 1 B0900217 STA* (SWORD) B0900218GF13 JMP* GF3 GET NEXT CHAR B0900219 END B0900220 NAM MMSIZ B10 A ITOS CCS 3.0 SL-149 00001* GET MAX SECTOR NO. FOR SPECIFIED UNIT AND WORDS PER SECTOR 00002* CREDIT COLLECTION SYSTEM VERSION 3.0 00003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00004* COPYRIGHT CONTROL DATA CORPORATION 1978 00005* 00006**** 00007* 00008* FUNCTION 00009* 00010* THIS ROUTINE SEARCHES A TABLE (MMTC) TO OBTAIN THE 00011* MAXIMUM NO OF SECTORS FOR A GIVEN MASS-MEMORY 00012* EQUIPMENT TYPE IF CDD OR COMPUTES THE MAXIMUM NO. OF 00013* SECTORS FROM PDT PARAMETERS FOR SMDS. IT ALSO PROVIDES 00014* WORDS PER SECTOR FOR SMD 00015* 00016* 00017* GENERAL DESCRIPTION 00018* 00019* 00020* SMD 00021ÐÐ* USING THE LOGICAL UNIT AS INPUT, INFORMATION IS EXTRACTED 00022* FROM THE PDT TO COMPUTE THE MAXIMUM SECTOR. (NOTE THAT THE 00023* LAST TWO TRACKS ARE ASSUMED TO BE FOR BAD SECTOR ADDRESSING 00024* 00025* 00026* INPUT REQUIREMENTS 00027* 00028* LU LOGICAL UNIT OF MM DEVICE 00029* 00030* 00031* OUTPUT 00032* 00033* SECTM MAXIMUM SECTOR NO MSB 00034* SECTL MAXIMUM SECTOR NO LSB 00035* WPS WORDS PER SECTOR (SMD ONLY) 00036* SECTRK SECTORS PER TRACK (SMD ONLY) 00037* 00038* 00039* CALLING SEQUENCE 00040* 00041* CALL MMSIZ (LU,SECTM,SECTL,WPS,SECTRK) 00042* 00043* 00044* SUBROUTINE 00045* 00046ÐÐ* SYSMSG SYSTEM ERROR MESSAGE ROUTINE 00047* 00048* 00049* PARAMETERS 00050* 00051* MMTC MASS MEMORY TYPE CODE TABLE (CDD ONLY) 00052* 00053* WORD 1 EQUIPMENT TYPE CODE 00054* WORD 2 MSB OF MAX SECTOR NO 00055* WORD 3 LSB OF MAX SECTOR NO 00056* 00057* 00058* MESSAGES 00059* 00060* 46 EQUIPMENT TYPE CANNOT BE FOUND 00061* 74 CLASS CODE NOT A DISK 00062* 00063* 00064* ENTRY POINT 00065* 00066 ENT MMSIZ 00067* 00068* EXTERNALS 00069* 00070 EXT SYSMSG 00071ÐÐ* 00072* EQUIVALENCES 00073* 00074 EQU LPMASK(2) 00075 EQU LOG1A(28) ADDRESS POSITION IN ADRECT 00076 EQU ADRECT($E9) ADDRESS OF EXTENDED CORE TABLE 00077 EQU EREQST(8) PDT LOCATION OF REQUEST STATUS 00078 EQU NOTDSK(74) SYSMSG ERROR NUMBER 00079 EQU NRWHD(49) PDT LOCATION OF # OF RW HEADS(TRKS/CYL) 00080 EQU NSECT(71) PDT LOCATION OF # OF SECTORS/TRACK 00081 EQU NWPS(70) PDT LOCATION OF # OF WORDS/SECTOR 00082 EQU ZERO($22) 00083* 00084**** 00085MMSIZ NOP 00086 STQ* QSAVE SAVE Q AND I REGISTER 00087 LDA- I 00088 STA* ISAVE 00089* 00090 LDA* (MMSIZ) PICK UP PARAMETERS 00091 STA* LU 00092 RAO* MMSIZ 00093 LDA* (MMSIZ) 00094 STA* SECTM 00095 RAO* MMSIZ 00096ÐÐ LDA* (MMSIZ) 00097 STA* SECTL 00098 RAO* MMSIZ 00099 LDA* (MMSIZ) 00100 STA* WPS 00101 RAO* MMSIZ 00102 LDA* (MMSIZ) 00103 STA* SECTRK 00104 RAO* MMSIZ 00105* 00106* DETERMINE EQUIPMENT TYPE 00107* 00108 ENQ LOG1A 00109 LDQ- (ADRECT),Q 00110 ADQ (LU) 00111 LDA- (ZERO),Q GET PDT LOCATION FOR ASSOCIATED LU 00112 STA- I SAVE PDT IN I 00113 LDA- EREQST,I GET REQUEST STATUS 00114 ARS 11 00115 AND- LPMASK+3 $0007 00116 SUB =N2 CHECK CLASS CODE FOR DISK 00117 SAZ OK 00118 ENA NOTDSK CLASS CODE IS NOT A DISK 00119 JMP* ENDTB1 REPORT ERROR 00120OK LDA- EREQST,I GET REQUEST STATUS 00121ÐÐ ARS 4 00122 AND- LPMASK+7 $007F 00123 STA* EQTYP SAVE EQUIPMENT TYPE 00124* 00125* S M D PICK UP PARAMETERS FROM PDT 00126* 00127 LDA- NRWHD,I 00128 STA* TRKCYL TRACKS PER CYLINDER 00129 LDA- NSECT,I 00130 STA* (SECTRK) SECTORS PER TRACK 00131 LDA- NWPS,I 00132 STA (WPS) WORDS PER SECTOR 00133 LDQ =XSMDTB SEARCH FOR EQUIPMENT TYPE CODE TO GET 00134SLOOP LDA- (ZERO),Q CORRECT CYLINDERS PER DEVICE 00135 SAP T2 00136 JMP* ENDTAB EQUIPMENT TYPE NOT FOUND 00137* 00138T2 SUB* EQTYP 00139 SAZ GOTIT SKIP IF FOUND 00140 INQ 2 00141 JMP* SLOOP 00142* 00143* EQUIPMENT CODE FOUND, GET CYLINDERS / DEVICE 00144* 00145GOTIT INQ 1 00146ÐÐ LDA- (ZERO),Q 00147 STA* CYLDEV 00148* 00149* COMPUTE MAX SECTOR 00150* 00151* MAX SECTOR = CYLDEV * TRKCYL * SECTRK - 2 * SECTRK 00152* 00153S SOV 0 CLEAR OVERFLOW FLAG 00154 LDA* CYLDEV 00155 MUI* TRKCYL 00156 MUI* (SECTRK) 00157 SNO 1 SKIP IF NO OVERFLOW 00158 STA- 1 FATAL ERROR - FORCE PROTECT VIOLATION 00159 LLS 1 CONVERT TO MSB/LSB FORMAT 00160 ALS 15 00161 SUB* (SECTRK) ADJUST FOR LAST TWO TRACKS NOT AVAILABLE 00162 SUB* (SECTRK) 00163 INA -1 ADJUST TO SECTOR ADDRESS FROM # SECTORS 00164 SAP GOON ADJUST FOR LSB FORMAT 00165 AND =N$7FFF 00166 INQ -1 00167GOON STA* (SECTL) STORE LSB 00168 STQ* (SECTM) STORE MSB 00169 JMP* EXIT 00170ENDTAB LDA* ERNUM 00171ÐÐENDTB1 STA* INDEX 00172* 00173* 00174* DISPLAY ERROR MSG 00175* 00176 RTJ SYSMSG 00177 ADC INDEX 00178 ADC ERBUF 00179* 00180EXIT LDQ* QSAVE RESTORE Q AND I REGISTER 00181 LDA* ISAVE 00182 STA- I 00183 JMP* (MMSIZ) RETURN 00184* 00185* LOCAL VARIABLES 00186* 00187LU NUM 0 ADDRESS OF LOGICAL UNIT 00188WPS NUM 0 ADDRESS OF WORDS/SECTOR PARAMETER 00189TRKCYL NUM 0 TRACKS PER CYLINDER 00190SECTRK NUM 0 SECTORS PER TRACK 00191CYLDEV NUM 0 CYLINDERS PER DEVICE 00192QSAVE NUM 0 00193ISAVE NUM 0 00194INDEX NUM 0 00195ERBUF NUM 0 00196ÐÐERNUM NUM 46 00197SECTM NUM 0 00198SECTL NUM 0 00199EQTYP NUM 0 00200* 00201* SMDTB TABLE 00202* WORD 1 = EQUIPMENT TYPE CODE 00203* WORD 2 = # OF CYLINDERS PER DEVICE 00204* 00205SMDTB NUM 69 1833-1/1867-10 00206 NUM 411 00207 NUM 70 1833-1/1867-20 00208 NUM 823 00209 NUM -1 00210 END 00211 NAM GETVIT B11 A ITOS CCS 3.0 SL-149B1100001* GET VIT FOR SPECIFIED VOLUME B1100002* CREDIT COLLECTION SYSTEM VERSION 3.0 B1100003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B1100004* COPYRIGHT CONTROL DATA CORPORATION 1979 B1100005* B1100006**** B1100007* B1100008* FUNCTION B1100009* B1100010ÐÐ* THIS ROUTINE GETS THE CONTENTS OF THE VIT SPECIFIED BY MMUNIT B1100011* AND MOVES IT TO A TABLE POINTED TO BY OUTP B1100012* B1100013* CALLING SEQUENCE B1100014* B1100015* CALL GETVIT(MMUNIT,OUTP) B1100016* B1100017* PARAMETERS B1100018* B1100019* MMUNIT MASS MEMORY LOGICAL UNIT NO B1100020* B1100021* OUTP TABLE ADDR TO READ IN THE SPECIFIED VIT B1100022* B1100023* B1100024* ENTRY POINT B1100025* B1100026 ENT GETVIT B1100027* B1100028* EXTERNALS B1100029* B1100030 EXT MMLUTB B1100031* B1100032* EQUIVALENCES B1100033* B1100034 EQU ZERO($22) B1100035ÐÐ* B1100036* START OF GETVIT B1100037* B1100038**** B1100039GETVIT NOP B1100040 STQ* QSAVE SAVE Q REGISTER B1100041 LDA- I B1100042 STA* ISAVE SAVE I REGISTER B1100043* B1100044 LDA* (GETVIT) PICK-UP PARAMETERS B1100045 STA* MMUNIT B1100046 RAO* GETVIT B1100047 LDA* (GETVIT) B1100048 STA* OUTP B1100049 RAO* GETVIT B1100050* B1100051 LDQ =XMMLUTB B1100052 ADQ* (MMUNIT) B1100053 INQ 1 PASS UNIT 0,SYSTEM DISK B1100054 LDQ- (ZERO),Q VIT-ADDR IN Q B1100055 ENA 0 SET POINTER TO 0 B1100056 STA- I B1100057* B1100058LOOP LDA- (ZERO),Q TRANSFER VIT CONTENTS TO OUTP B1100059 STA* (OUTP),I B1100060ÐÐ* B1100061 RAO- I INCREMENT POINTER B1100062 LDA- I CHECK IF ALL DONE B1100063 INA -21 END OF VIT REACHED B1100064 SAZ ENDVIT YES B1100065 INQ 1 NO CONTINUE B1100066 JMP* LOOP B1100067* B1100068ENDVIT LDQ* QSAVE RESTORE REGISTERS B1100069 LDA* ISAVE B1100070 STA- I B1100071 JMP* (GETVIT) RETURN B1100072* B1100073* LOCAL VARIABLES B1100074* B1100075MMUNIT NUM 0 B1100076OUTP NUM 0 B1100077QSAVE NUM 0 B1100078ISAVE NUM 0 B1100079 END B1100080 NAM UTSTRT B12 A ITOS CCS 3.0 SL-149B1200001* OVERLAY AREA FOR FILE MANAGER UTILITY PROCESSORS. B1200002* CREDIT COLLECTION SYSTEM VERSION 3.0 B1200003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B1200004* COPYRIGHT CONTROL DATA CORPORATION 1979 B1200005ÐÐ* B1200006* B1200007* OVERLAY AREA FOR FILE-MANAGER UTILITY COMMAND PROCESSOR B1200008* B1200009 ENT UTSTRT B1200010* B1200011* OVERLAY AREA = ENDING ADDRESS OF BIGGEST OVERLAY + 1 - ADDRESS B1200012* OF UTSTRT B1200013* $2974 = $AFF0 - $867C (12-04-79) B1200014 BSS UTSTRT($2974) B1200015 END B1200016 NAM GTINIT B13 A ITOS CCS 3.0 SL-149B1300001* START ROUTINE FOR COMMAND PROCESSOR INIT B1300002* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B1300003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B1300004* COPYRIGHT CONTROL DATA CORPORATION 1979 B1300005* B1300006* B1300007* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B1300008* AN ENTRY POINT FOR THE COMMAND PROCESSOR INIT B1300009* IN OREDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B1300010* B1300011* B1300012* B1300013* LABELED COMMON AREA B1300014ÐÐ* B1300015 DAT COMCOD(89),PARNAM(83) 122*4875B1300016 DAT PPHELP(2) B1300017 DAT PPINIT(4) B1300018 DAT PPDEFI(16) B1300019 DAT PPSTAT(4) B1300020 DAT PPRELO(5) 122*4875B1300021 DAT PPDUMP(5) 122*4875B1300022 DAT PPCOPY(6) B1300023 DAT PPDELE(3) B1300024 DAT PPCLEA(3) B1300025 DAT PPLIST(6) 122*4875B1300026 DAT PPRENA(5) B1300027 DAT PPCOMM(2) B1300028 DAT PPEXIT(1) B1300029 DAT PPMOUN(3) B1300030 DAT PPDISM(2) B1300031 DAT PPSAVE(3) B1300032 DAT PPBATC(7) 122*4875B1300033 DAT PPLOAD(5) B1300034 DAT PPPURG(3) B1300035 DAT PPINPU(2) B1300036 DAT PPOUTP(2) B1300037 DAT PPCOMP(3) B1300038 DAT DUMMY(6) B1300039ÐÐ DAT INBUF(41),CODE(20) B1300040 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B1300041 DAT REQBUF(24),IDATA(24) B1300042 DAT PARDEF(24) B1300043 DAT FCBHDR(5) B1300044 DAT FCBBUF(96) B1300045 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B1300046 EQU COMLEN(ENDCOM-COMCOD) B1300047* B1300048 ENT MARKER B1300049 ENT UTSTRT B1300050* B1300051 EXT INIT B1300052* B1300053MARKER NOP 0 B1300054 RTJ INIT B1300055 JMP* (MARKER) B1300056* B1300057 EQU UTSTRT(MARKER) B1300058* B1300059 END B1300060 NAM GETDEF B14 A ITOS CCS 3.0 SL-149B1400001* START ROUTINE FOR COMMAND PROCESSOR DEFINE B1400002* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B1400003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B1400004ÐÐ* COPYRIGHT CONTROL DATA CORPORATION 1979 B1400005* B1400006* B1400007* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B1400008* AN ENTRY POINT FOR THE COMMAND PROCESSOR DEFINE B1400009* IN OREDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B1400010* B1400011* B1400012* B1400013* LABELED COMMON AREA B1400014* B1400015 DAT COMCOD(89),PARNAM(83) 122*4875B1400016 DAT PPHELP(2) B1400017 DAT PPINIT(4) B1400018 DAT PPDEFI(16) B1400019 DAT PPSTAT(4) B1400020 DAT PPRELO(5) 122*4875B1400021 DAT PPDUMP(5) 122*4875B1400022 DAT PPCOPY(6) B1400023 DAT PPDELE(3) B1400024 DAT PPCLEA(3) B1400025 DAT PPLIST(6) 122*4875B1400026 DAT PPRENA(5) B1400027 DAT PPCOMM(2) B1400028 DAT PPEXIT(1) B1400029ÐÐ DAT PPMOUN(3) B1400030 DAT PPDISM(2) B1400031 DAT PPSAVE(3) B1400032 DAT PPBATC(7) 122*4875B1400033 DAT PPLOAD(5) B1400034 DAT PPPURG(3) B1400035 DAT PPINPU(2) B1400036 DAT PPOUTP(2) B1400037 DAT PPCOMP(3) B1400038 DAT DUMMY(6) B1400039 DAT INBUF(41),CODE(20) B1400040 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B1400041 DAT REQBUF(24),IDATA(24) B1400042 DAT PARDEF(24) B1400043 DAT FCBHDR(5) B1400044 DAT FCBBUF(96) B1400045 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B1400046 EQU COMLEN(ENDCOM-COMCOD) B1400047* B1400048 ENT MARKER B1400049 ENT UTSTRT B1400050* B1400051 EXT DEFINE B1400052* B1400053MARKER NOP 0 B1400054ÐÐ RTJ DEFINE B1400055 JMP* (MARKER) B1400056* B1400057 EQU UTSTRT(MARKER) B1400058* B1400059 END B1400060 NAM GTSTAT B15 A ITOS CCS 3.0 SL-149B1500001* START ROUTINE FOR COMMAND PROCESSOR STATUS B1500002* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B1500003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B1500004* COPYRIGHT CONTROL DATA CORPORATION 1979 B1500005* B1500006* B1500007* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B1500008* AN ENTRY POINT FOR THE COMMAND PROCESSOR STATUS B1500009* IN OREDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B1500010* B1500011* B1500012* B1500013* LABELED COMMON AREA B1500014* B1500015 DAT COMCOD(89),PARNAM(83) 122*4875B1500016 DAT PPHELP(2) B1500017 DAT PPINIT(4) B1500018 DAT PPDEFI(16) B1500019ÐÐ DAT PPSTAT(4) B1500020 DAT PPRELO(5) 122*4875B1500021 DAT PPDUMP(5) 122*4875B1500022 DAT PPCOPY(6) B1500023 DAT PPDELE(3) B1500024 DAT PPCLEA(3) B1500025 DAT PPLIST(6) 122*4875B1500026 DAT PPRENA(5) B1500027 DAT PPCOMM(2) B1500028 DAT PPEXIT(1) B1500029 DAT PPMOUN(3) B1500030 DAT PPDISM(2) B1500031 DAT PPSAVE(3) B1500032 DAT PPBATC(7) 122*4875B1500033 DAT PPLOAD(5) B1500034 DAT PPPURG(3) B1500035 DAT PPINPU(2) B1500036 DAT PPOUTP(2) B1500037 DAT PPCOMP(3) B1500038 DAT DUMMY(6) B1500039 DAT INBUF(41),CODE(20) B1500040 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B1500041 DAT REQBUF(24),IDATA(24) B1500042 DAT PARDEF(24) B1500043 DAT FCBHDR(5) B1500044ÐÐ DAT FCBBUF(96) B1500045 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B1500046 EQU COMLEN(ENDCOM-COMCOD) B1500047* B1500048 ENT MARKER B1500049 ENT UTSTRT B1500050* B1500051 EXT STATUS B1500052* B1500053MARKER NOP 0 B1500054 RTJ STATUS B1500055 JMP* (MARKER) B1500056* B1500057 EQU UTSTRT(MARKER) B1500058* B1500059 END B1500060 NAM GTDUMP B16 A ITOS CCS 3.0 SL-149B1600001* START ROUTINE FOR COMMAND PROCESSOR DUMP B1600002* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B1600003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B1600004* COPYRIGHT CONTROL DATA CORPORATION 1979 B1600005* B1600006* B1600007* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B1600008* AN ENTRY POINT FOR THE COMMAND PROCESSOR DUMP B1600009ÐÐ* IN ORDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B1600010* B1600011* B1600012* B1600013* LABELED COMMON AREA B1600014* B1600015 DAT COMCOD(89),PARNAM(83) 122*4875B1600016 DAT PPHELP(2) B1600017 DAT PPINIT(4) B1600018 DAT PPDEFI(16) B1600019 DAT PPSTAT(3) B1600020 DAT PPRELO(5) 122*4875B1600021 DAT PPDUMP(5) 122*4875B1600022 DAT PPCOPY(5) B1600023 DAT PPDELE(3) B1600024 DAT PPCLEA(3) B1600025 DAT PPLIST(6) 122*4875B1600026 DAT PPRENA(5) B1600027 DAT PPCOMM(2) B1600028 DAT PPEXIT(1) B1600029 DAT PPMOUN(3) B1600030 DAT PPDISM(2) B1600031 DAT PPSAVE(3) B1600032 DAT PPBATC(7) 122*4875B1600033 DAT PPLOAD(5) B1600034ÐÐ DAT PPPURG(3) B1600035 DAT PPINPU(2) B1600036 DAT PPOUTP(2) B1600037 DAT PPCOMP(3) B1600038 DAT DUMMY(6) B1600039 DAT INBUF(41),CODE(20) B1600040 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B1600041 DAT REQBUF(24),IDATA(24) B1600042 DAT PARDEF(24) B1600043 DAT FCBHDR(5) B1600044 DAT FCBBUF(96) B1600045 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B1600046 EQU COMLEN(ENDCOM-COMCOD) B1600047* B1600048 ENT MARKER B1600049 ENT UTSTRT B1600050* B1600051 EXT DMPFIL B1600052* B1600053MARKER NOP 0 B1600054 RTJ DMPFIL B1600055 JMP* (MARKER) B1600056* B1600057 EQU UTSTRT(MARKER) B1600058* B1600059ÐÐ END B1600060 NAM GTCOPY B17 A ITOS CCS 3.0 SL-149B1700001* START ROUTINE FOR COMMAND PROCESSOR COPY B1700002* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B1700003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B1700004* COPYRIGHT CONTROL DATA CORPORATION 1979 B1700005* B1700006* B1700007* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B1700008* AN ENTRY POINT FOR THE COMMAND PROCESSOR COPY B1700009* IN OREDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B1700010* B1700011* B1700012* B1700013* LABELED COMMON AREA B1700014* B1700015 DAT COMCOD(89),PARNAM(83) 122*4875B1700016 DAT PPHELP(2) B1700017 DAT PPINIT(4) B1700018 DAT PPDEFI(16) B1700019 DAT PPSTAT(4) B1700020 DAT PPRELO(5) 122*4875B1700021 DAT PPDUMP(5) 122*4875B1700022 DAT PPCOPY(6) B1700023 DAT PPDELE(3) B1700024ÐÐ DAT PPCLEA(3) B1700025 DAT PPLIST(6) 122*4875B1700026 DAT PPRENA(5) B1700027 DAT PPCOMM(2) B1700028 DAT PPEXIT(1) B1700029 DAT PPMOUN(3) B1700030 DAT PPDISM(2) B1700031 DAT PPSAVE(3) B1700032 DAT PPBATC(7) 122*4875B1700033 DAT PPLOAD(5) B1700034 DAT PPPURG(3) B1700035 DAT PPINPU(2) B1700036 DAT PPOUTP(2) B1700037 DAT PPCOMP(3) B1700038 DAT DUMMY(6) B1700039 DAT INBUF(41),CODE(20) B1700040 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B1700041 DAT REQBUF(24),IDATA(24) B1700042 DAT PARDEF(24) B1700043 DAT FCBHDR(5) B1700044 DAT FCBBUF(96) B1700045 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B1700046 EQU COMLEN(ENDCOM-COMCOD) B1700047* B1700048 ENT MARKER B1700049ÐÐ ENT UTSTRT B1700050* B1700051 EXT COPY B1700052* B1700053MARKER NOP 0 B1700054 RTJ COPY B1700055 JMP* (MARKER) B1700056* B1700057 EQU UTSTRT(MARKER) B1700058* B1700059 END B1700060 NAM GETDEL B18 A ITOS CCS 3.0 SL-149B1800001* START ROUTINE FOR COMMAND PROCESSOR DELETE B1800002* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B1800003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B1800004* COPYRIGHT CONTROL DATA CORPORATION 1979 B1800005* B1800006* B1800007* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B1800008* AN ENTRY POINT FOR THE COMMAND PROCESSOR DELETE B1800009* IN OREDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B1800010* B1800011* B1800012* B1800013* LABELED COMMON AREA B1800014ÐÐ* B1800015 DAT COMCOD(89),PARNAM(83) 122*4875B1800016 DAT PPHELP(2) B1800017 DAT PPINIT(4) B1800018 DAT PPDEFI(16) B1800019 DAT PPSTAT(4) B1800020 DAT PPRELO(5) 122*4875B1800021 DAT PPDUMP(5) 122*4875B1800022 DAT PPCOPY(6) B1800023 DAT PPDELE(3) B1800024 DAT PPCLEA(3) B1800025 DAT PPLIST(6) 122*4875B1800026 DAT PPRENA(5) B1800027 DAT PPCOMM(2) B1800028 DAT PPEXIT(1) B1800029 DAT PPMOUN(3) B1800030 DAT PPDISM(2) B1800031 DAT PPSAVE(3) B1800032 DAT PPBATC(7) 122*4875B1800033 DAT PPLOAD(5) B1800034 DAT PPPURG(3) B1800035 DAT PPINPU(2) B1800036 DAT PPOUTP(2) B1800037 DAT PPCOMP(3) B1800038 DAT DUMMY(6) B1800039ÐÐ DAT INBUF(41),CODE(20) B1800040 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B1800041 DAT REQBUF(24),IDATA(24) B1800042 DAT PARDEF(24) B1800043 DAT FCBHDR(5) B1800044 DAT FCBBUF(96) B1800045 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B1800046 EQU COMLEN(ENDCOM-COMCOD) B1800047* B1800048 ENT MARKER B1800049 ENT UTSTRT B1800050* B1800051 EXT DELET B1800052* B1800053MARKER NOP 0 B1800054 RTJ DELET B1800055 JMP* (MARKER) B1800056* B1800057 EQU UTSTRT(MARKER) B1800058* B1800059 END B1800060 NAM GTCLEA B19 A ITOS CCS 3.0 SL-149B1900001* START ROUTINE FOR COMMAND PROCESSOR CLEAR B1900002* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B1900003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B1900004ÐÐ* COPYRIGHT CONTROL DATA CORPORATION 1979 B1900005* B1900006* B1900007* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B1900008* AN ENTRY POINT FOR THE COMMAND PROCESSOR CLEAR B1900009* IN OREDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B1900010* B1900011* B1900012* B1900013* LABELED COMMON AREA B1900014* B1900015 DAT COMCOD(89),PARNAM(83) 122*4875B1900016 DAT PPHELP(2) B1900017 DAT PPINIT(4) B1900018 DAT PPDEFI(16) B1900019 DAT PPSTAT(3) B1900020 DAT PPRELO(5) 122*4875B1900021 DAT PPDUMP(5) 122*4875B1900022 DAT PPCOPY(5) B1900023 DAT PPDELE(3) B1900024 DAT PPCLEA(3) B1900025 DAT PPLIST(6) 122*4875B1900026 DAT PPRENA(5) B1900027 DAT PPCOMM(2) B1900028 DAT PPEXIT(1) B1900029ÐÐ DAT PPMOUN(3) B1900030 DAT PPDISM(2) B1900031 DAT PPSAVE(3) B1900032 DAT PPBATC(7) 122*4875B1900033 DAT PPLOAD(5) B1900034 DAT PPPURG(3) B1900035 DAT PPINPU(2) B1900036 DAT PPOUTP(2) B1900037 DAT PPCOMP(3) B1900038 DAT DUMMY(6) B1900039 DAT INBUF(41),CODE(20) B1900040 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B1900041 DAT REQBUF(24),IDATA(24) B1900042 DAT PARDEF(24) B1900043 DAT FCBHDR(5) B1900044 DAT FCBBUF(96) B1900045 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B1900046 EQU COMLEN(ENDCOM-COMCOD) B1900047* B1900048 ENT MARKER B1900049 ENT UTSTRT B1900050* B1900051 EXT CLEER B1900052* B1900053MARKER NOP 0 B1900054ÐÐ RTJ CLEER B1900055 JMP* (MARKER) B1900056* B1900057 EQU UTSTRT(MARKER) B1900058* B1900059 END B1900060 NAM GTLIST B20 A ITOS CCS 3.0 SL-149B2000001* START ROUTINE FOR COMMAND PROCESSOR LIST B2000002* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B2000003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B2000004* COPYRIGHT CONTROL DATA CORPORATION 1979 B2000005* B2000006* B2000007* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B2000008* AN ENTRY POINT FOR THE COMMAND PROCESSOR LIST B2000009* IN OREDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B2000010* B2000011* B2000012* B2000013* LABELED COMMON AREA B2000014* B2000015 DAT COMCOD(89),PARNAM(83) 122*4875B2000016 DAT PPHELP(2) B2000017 DAT PPINIT(4) B2000018 DAT PPDEFI(16) B2000019ÐÐ DAT PPSTAT(4) B2000020 DAT PPRELO(5) 122*4875B2000021 DAT PPDUMP(5) 122*4875B2000022 DAT PPCOPY(6) B2000023 DAT PPDELE(3) B2000024 DAT PPCLEA(3) B2000025 DAT PPLIST(6) 122*4875B2000026 DAT PPRENA(5) B2000027 DAT PPCOMM(2) B2000028 DAT PPEXIT(1) B2000029 DAT PPMOUN(3) B2000030 DAT PPDISM(2) B2000031 DAT PPSAVE(3) B2000032 DAT PPBATC(7) 122*4875B2000033 DAT PPLOAD(5) B2000034 DAT PPPURG(3) B2000035 DAT PPINPU(2) B2000036 DAT PPOUTP(2) B2000037 DAT PPCOMP(3) B2000038 DAT DUMMY(6) B2000039 DAT INBUF(41),CODE(20) B2000040 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B2000041 DAT REQBUF(24),IDATA(24) B2000042 DAT PARDEF(24) B2000043 DAT FCBHDR(5) B2000044ÐÐ DAT FCBBUF(96) B2000045 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B2000046 EQU COMLEN(ENDCOM-COMCOD) B2000047* B2000048 ENT MARKER B2000049 ENT UTSTRT B2000050* B2000051 EXT LIST B2000052* B2000053MARKER NOP 0 B2000054 RTJ LIST B2000055 JMP* (MARKER) B2000056* B2000057 EQU UTSTRT(MARKER) B2000058* B2000059 END B2000060 NAM ASCEBC B21 A ITOS CCS 3.0 SL-149B2100001* ASCII-EBCDIC/EBCDIC-ASCII CONVERSION ROUTINE B2100002* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4873B2100003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B2100004* COPYRIGHT CONTROL DATA CORPORATION 1979 B2100005* B2100006**** 122*4873B2100007* 122*4873B2100008* FUNCTION 122*4873B2100009ÐÐ* 122*4873B2100010* B2100011* THIS ROUTINE CONVERTS A SPECIFIED BUFFER FROM ASCII TO EBCDIC B2100012* OR FROM EBCDIC TO ASCII ACCORDING TO A SWITCH(ASEBSW) B2100013* IF ASEBSW=0 ASCII-EBCDIC B2100014* =1 EBCDIC-ASCII B2100015* B2100016* CALLING SEQUENCE B2100017* B2100018* CALL ASCEBC (OUTBUF,ASEBSW,BUFLEN) B2100019* B2100020* PARAMETERS B2100021* B2100022* OUTBUF BUFFER TO BE CONVERTED B2100023* ASEBSW SWITCH TO INDICATE WHICH CONVERSION B2100024* BUFLEN LENGTH OF BUFFER B2100025* B2100026* EQUATES B2100027* B2100028 EQU MASK($1A) B2100029 EQU MASK1($A) B2100030* B2100031 ENT ASCEBC B2100032* B2100033**** 122*4873B2100034ÐÐASCEBC NOP B2100035 LDA* (ASCEBC) PICK UP PARAMET+RS B2100036 STA* OUTBUF B2100037 RAO* ASCEBC B2100038 LDA* (ASCEBC) B2100039 STA* ASEBSW B2100040 RAO* ASCEBC B2100041 LDA* (ASCEBC) B2100042 STA* LENGTH B2100043 RAO* ASCEBC B2100044* B2100045 LDA* (ASEBSW) GET ASCII-EBCDIC SWITCH B2100046 SAZ CON1 B2100047 ENQ $40 EBCDIC-ASCII B2100048 LDA- MASK B2100049 SAN CON2 B2100050CON1 ENQ $20 ASCII-EBCDIC B2100051 LDA- MASK1 B2100052CON2 STQ* ASEBCO STORE IN ASCII-EBCDIC CONSTANT B2100053 STA* ASEBMS B2100054 LDA* (LENGTH) B2100055 INA -1 B2100056 STA* CONTER B2100057CONVLP LDQ* CONTER B2100058 LDA* (OUTBUF),Q B2100059ÐÐ STA* CHAR GET CHAR TO BE CONVERTED B2100060 AND- MASK1 B2100061 RTJ* CONLOP B2100062 STA* CHAR+1 B2100063 LDA* CHAR B2100064 AND- MASK B2100065 ALS 8 B2100066 RTJ* CONLOP B2100067 STA* CHAR B2100068 LDQ* (ASEBSW) B2100069 SQN 1 B2100070 ALS 8 B2100071 STA* CHAR B2100072 LDA* CHAR+1 B2100073 SQZ 1 B2100074 ALS 8 B2100075 EOR* CHAR B2100076 LDQ* CONTER B2100077 STA* (OUTBUF),Q B2100078 INQ -1 B2100079 STQ* CONTER B2100080 SQM 1 B2100081 JMP* CONVLP B2100082 JMP* (ASCEBC) B2100083* B2100084ÐÐCONLOP NOP 0 CONVERSION LOOP B2100085 SUB* ASEBCO B2100086 SAP 1 B2100087 CLR A B2100088 TRA Q B2100089 LDA* TABLE,Q B2100090 AND* ASEBMS B2100091 JMP* (CONLOP) B2100092* B2100093* LOCAL VARIABLES B2100094* B2100095ASEBCO NUM 0 B2100096ASEBSW NUM 0 B2100097ASEBMS NUM 0 B2100098CHAR NUM 0,0 B2100099CONTER NUM 0 B2100100OUTBUF NUM 0 B2100101LENGTH NUM 0 B2100102TABLE NUM $2040,$205A,$207F,$207B,$205B B2100103 NUM $206C,$2050,$207D,$204D,$205D B2100104 NUM $205C,$2E4E,$3C6B,$2860,$2B4B B2100105 NUM $2061,$26F0,$20F1,$20F2,$20F3 B2100106 NUM $20F4,$20F5,$20F6,$20F7,$20F8 B2100107 NUM $20F9,$217A,$245E,$2A4C,$297E B2100108 NUM $3B6E,$206F,$2D7C,$2FC1,$20C2 B2100109ÐÐ NUM $20C3,$20C4,$20C5,$20C6,$20C7 B2100110 NUM $20C8,$20C9,$20D1,$2CD2,$25D3 B2100111 NUM $5FD4,$3ED5,$3FD6,$20D7,$20D8 B2100112 NUM $20D9,$20E2,$20E3,$20E4,$20E5 B2100113 NUM $20E6,$20E7,$20E8,$3AE9,$234D B2100114 NUM $4040,$275D,$3D40,$226D,$2040 B2100115 NUM $6181,$6282,$6383,$6484,$6585 B2100116 NUM $6686,$6787,$6888,$6989,$2091 B2100117 NUM $2092,$2093,$2094,$2095,$2096 B2100118 NUM $2097,$6A98,$6B99,$6CA2,$6DA3 B2100119 NUM $6EA4,$6FA5,$70A6,$71A7,$72A8 B2100120 NUM $20A9,$2040,$2040,$2040,$2040 B2100121 NUM $2040,$2040,$2040 B2100122 NUM $7340,$7440,$7540,$7640,$7740 B2100123 NUM $7840,$7940,$7A40 B2100124 NUM $2040,$2040,$2040,$2040,$2040 B2100125 NUM $2040,$2040,$2040,$2040,$2040 B2100126 NUM $2040,$2040,$2040,$2040,$2040 B2100127 NUM $2040,$2040,$2040,$2040,$2040 B2100128 NUM $2040,$2040,$2040,$4140,$4240 B2100129 NUM $4340,$4440,$4540,$4640,$4740 B2100130 NUM $4840,$4940,$2040,$2040,$2040 B2100131 NUM $2040,$2040,$2040,$2040,$4A40 B2100132 NUM $4B40,$4C40,$4D40,$4E40,$4F40 B2100133 NUM $5040,$5140,$5240,$2040,$2040 B2100134ÐÐ NUM $2040,$2040,$2040,$2040,$2040 B2100135 NUM $2040,$5340,$5440,$5540,$5640 B2100136 NUM $5740,$5840,$5940,$5A40,$2040 B2100137 NUM $2040,$2040,$2040,$2040,$2040 B2100138 NUM $3040,$3140,$3240,$3340,$3440 B2100139 NUM $3540,$3640,$3740,$3840,$3940 B2100140 NUM $2040,$2040,$2040,$2040,$2040,$2040 B2100141 END B2100142 NAM GTRENA B22 A ITOS CCS 3.0 SL-149B2200001* START ROUTINE FOR COMMAND PROCESSOR RENAME B2200002* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B2200003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B2200004* COPYRIGHT CONTROL DATA CORPORATION 1979 B2200005* B2200006* B2200007* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B2200008* AN ENTRY POINT FOR THE COMMAND PROCESSOR RENAME B2200009* IN OREDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B2200010* B2200011* B2200012* B2200013* LABELED COMMON AREA B2200014* B2200015 DAT COMCOD(89),PARNAM(83) 122*4875B2200016 DAT PPHELP(2) B2200017ÐÐ DAT PPINIT(4) B2200018 DAT PPDEFI(16) B2200019 DAT PPSTAT(4) B2200020 DAT PPRELO(5) 122*4875B2200021 DAT PPDUMP(5) 122*4875B2200022 DAT PPCOPY(6) B2200023 DAT PPDELE(3) B2200024 DAT PPCLEA(3) B2200025 DAT PPLIST(6) 122*4875B2200026 DAT PPRENA(5) B2200027 DAT PPCOMM(2) B2200028 DAT PPEXIT(1) B2200029 DAT PPMOUN(3) B2200030 DAT PPDISM(2) B2200031 DAT PPSAVE(3) B2200032 DAT PPBATC(7) 122*4875B2200033 DAT PPLOAD(5) B2200034 DAT PPPURG(3) B2200035 DAT PPINPU(2) B2200036 DAT PPOUTP(2) B2200037 DAT PPCOMP(3) B2200038 DAT DUMMY(6) B2200039 DAT INBUF(41),CODE(20) B2200040 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B2200041 DAT REQBUF(24),IDATA(24) B2200042ÐÐ DAT PARDEF(24) B2200043 DAT FCBHDR(5) B2200044 DAT FCBBUF(96) B2200045 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B2200046 EQU COMLEN(ENDCOM-COMCOD) B2200047* B2200048 ENT MARKER B2200049 ENT UTSTRT B2200050* B2200051 EXT RENAM B2200052* B2200053MARKER NOP 0 B2200054 RTJ RENAM B2200055 JMP* (MARKER) B2200056* B2200057 EQU UTSTRT(MARKER) B2200058* B2200059 END B2200060 NAM COMAND B23 A ITOS CCS 3.0 SL-149B2300001* COMMAND PROCESSOR FOR COMMAND B2300002* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B2300003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B2300004* COPYRIGHT CONTROL DATA CORPORATION 1979 B2300005* B2300006**** B2300007ÐÐ* B2300008* FUNCTION B2300009* B2300010* THIS FMU-COMMAND PROCESSOR PRINTS A LIST OF ALL POSSIBLE B2300011* FMUTIL COMMANDS ON THE SELECTED OUTPUT DEVICE B2300012* B2300013* B2300014* GENERAL DESCRIPTION B2300015* B2300016* ON ENTRY IT WILL SKIP PAST THE FIRST FIELD OF THE INPUT-BUFFER B2300017* (INBUF). IF THIS FIELD IS TERMINATED ON A COMMA IT WILL DO B2300018* ANOTHER GETFLD AND CHECK IF THIS IS A NON-BLANK FIELD B2300019* IF SO,IT WILL PRINT THE CORRESPONDING PARAMETER LIST OF THE B2300020* COMMAND TOO B2300021* B2300022* B2300023* COMMAND FORMAT B2300024* B2300025* COMMAND B2300026* COMMAND,X B2300027* B2300028* B2300029* ENTRY POINTS B2300030* B2300031 ENT COMAND B2300032ÐÐ ENT UTSTRT B2300033* B2300034* B2300035* EXTERNALS B2300036* B2300037 EXT WTREAD B2300038 EXT PGMOUT B2300039 EXT GETFLD B2300040 EXT CLRSCR B2300041* B2300042* B2300043* EQUATES B2300044* B2300045 EQU ZERO($22) B2300046 EQU LPMASK(2) B2300047* B2300048* LABELED COMMON AREA B2300049* B2300050 DAT COMCOD(133),PARNAM(124) B2300051 DAT PPHELP(2) B2300052 DAT PPINIT(4) B2300053 DAT PPDEFI(16) B2300054 DAT PPSTAT(4) B2300055 DAT PPRELO(5) 122*4875B2300056 DAT PPDUMP(5) 122*4875B2300057ÐÐ DAT PPCOPY(6) B2300058 DAT PPDELE(3) B2300059 DAT PPCLEA(3) B2300060 DAT PPLIST(6) 122*4875B2300061 DAT PPRENA(5) B2300062 DAT PPCOMM(2) B2300063 DAT PPEXIT(1) B2300064 DAT PPMOUN(3) B2300065 DAT PPDISM(2) B2300066 DAT PPSAVE(3) B2300067 DAT PPBATC(8) BATCH B2300068 DAT PPLOAD(5) B2300069 DAT PPPURG(3) B2300070 DAT PPINPU(2) B2300071 DAT PPOUTP(2) B2300072 DAT PPCOMP(3) B2300073 DAT PPHOST(4) HOST B2300074 DAT PPSET(3) SET B2300075 DAT PPBATS(4) BATCH STATUS B2300076 DAT PPDISC(2) DISCARD B2300077 DAT PPDISP(7) DISPOSE B2300078 DAT PPFLUS(3) FLUSH B2300079 DAT PPPRIN(3) PRINT B2300080 DAT DUMMY(6) B2300081 DAT INBUF(41),CODE(20) B2300082ÐÐ DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B2300083 DAT REQBUF(24),IDATA(24) B2300084 DAT PARDEF(24) B2300085 DAT FCBHDR(5) B2300086 DAT FCBBUF(96) B2300087 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B2300088 EQU COMLEN(ENDCOM-COMCOD) B2300089* B2300090**** B2300091 EJT B2300092* B2300093* START OF THE LIST PROCESSOR B2300094* B2300095COMAND NOP B2300096 ENA 0 B2300097 STA SWORD B2300098 STA SBYTE B2300099* B2300100 RTJ GETFLD SKIP PAST FIRST FIELD B2300101 ADC INBUF B2300102 ADC CODE B2300103 ADC SWORD B2300104 ADC SBYTE B2300105 ADC STATUS B2300106* B2300107ÐÐ LDA STATUS B2300108 SAZ NXTFLD THERE IS A NEXT FIELD B2300109 JMP* NOLST NO PARAMETER LIST DESIRED B2300110* B2300111NXTFLD RTJ GETFLD SEE IF THERE IS A PARAMETER LIST DESIRED B2300112 ADC INBUF ADDRESS OF INPUT BUFFER B2300113 ADC CODE ADDRESS OF OUTPUT BUFFER B2300114 ADC SWORD START WORD IN INPUT BUFFER B2300115 ADC SBYTE START BYTE OF INPUT BUFFER B2300116 ADC STATUS STATUS TO RETURN B2300117* B2300118 LDA CODE B2300119 SUB BLANK CHECK IF BLANK B2300120 SAZ NOLST YES,NO PARMMLIST REQUIRED B2300121* B2300122 ENA -1 B2300123 STA PARMIN SET PARLST REQ. INDICATOR B2300124 JMP* LST1 B2300125* B2300126NOLST CLR A NO PARLST REQ B2300127 STA PARMIN RESET PARLST REQ. INDICAROR B2300128* B2300129LST1 ENQ 0 B2300130NXTCOM ENA 0 GET NEXT COMMAND B2300131 STA- I B2300132ÐÐNXT LDA COMCOD,Q B2300133 SAP STOR B2300134 JMP* (COMAND) B2300135* B2300136STOR STA OUTBUF,I B2300137 RAO- I B2300138 INQ 1 B2300139 LDA- I COMMAND COMPLETE B2300140 SUB N3 B2300141 SAZ DISPLY YES B2300142 JMP* NXT B2300143DISPLY LDA FTSW IS IT FIRST TIME ? B2300144 SAN CMDDIS NO,DISPLY COMMAND B2300145 RTJ CLRSCR CLEAR THE SCREEN B2300146 ADC LUNIT B2300147* B2300148 ENA -1 B2300149 STA FTSW SET FIRST TIME SWITCH NON-ZERO B2300150CMDDIS LDA COMCOD,Q B2300151 STA PPTAB B2300152 RAO LINCNT INCREMENT LINE COUNTER B2300153 LDA LINCNT CHECK IF SCREEN FULL B2300154 SUB =N24 B2300155 SAZ PAUSE B2300156* B2300157ÐÐ RTJ WTREAD B2300158 ADC LUNIT B2300159 ADC NOCUR NO CURSOR POSITIONING REQUESTED B2300160 ADC DISBUF B2300161 ADC MESLEN B2300162 ADC NOCUR NO CURSOR POSITIONING REQUESTED B2300163 ADC DUMMY B2300164 ADC ZRO B2300165 ADC TC B2300166 LDA* PARMIN IS PARLST REQUIRED B2300167 SAN LST2 YES B2300168 INQ 1 B2300169 JMP* NXTCOM B2300170LST2 JMP* PRMLST B2300171* B2300172PAUSE RTJ WTREAD B2300173 ADC LUNIT B2300174 ADC NOCUR B2300175 ADC PAUSBF B2300176 ADC MSPAUS B2300177 ADC NOCUR B2300178 ADC DUMMY B2300179 ADC N3 B2300180 ADC TC B2300181 CLR A RESET FIRST TIME SWITCH B2300182ÐÐ STA FTSW B2300183 STA* LINCNT RESET LINE COUNTER B2300184 JMP* DISPLY B2300185PRMLST STQ* QSAV SAVE Q TEMP B2300186* B2300187 LDA* PPTAB GET PPTAB ADDRESS B2300188 STA- I B2300189NXTPAR LDA- (ZERO),I IS THERE A PARAMETER LIST B2300190 SAN PRM1 YES B2300191 JMP* INCR NO B2300192PRM1 LDA* BCOM STORE BLANK COMMA FIRST B2300193 LDQ* LSTWRD POINTER IN PARMLST BUFFER B2300194 STA* PARBUF,Q B2300195 RAO* LSTWRD UPDATE POINTER B2300196 LDA- (ZERO),I GET FIRST ENTRY IN PPTAB SPECIFIED B2300197 SAZ ENDLST END OF PPTAB B2300198* B2300199 AND- LPMASK+8 MASK OUT INDEX B2300200 INA -1 CALCULATE INDEX TO PARNAM B2300201 MUI* N3 B2300202 TRA Q B2300203* B2300204 LDA PARNAM,Q GET PARAMETER IDENTIFIER B2300205 LDQ* LSTWRD B2300206 STA* PARBUF,Q B2300207ÐÐ* B2300208 RAO- I B2300209 RAO* LSTWRD B2300210 LDA- (ZERO),I B2300211 SAZ ENDLST END OF PARAMETER LIST B2300212 JMP* NXTPAR GET NEXT PARAMETER B2300213* B2300214ENDLST RTJ WTREAD DISPLAY PARAMETER LIST B2300215 ADC LUNIT B2300216 ADC NOCUR B2300217 ADC PARBUF B2300218 ADC LSTWRD B2300219 ADC NOCUR B2300220 ADC DUMMY B2300221 ADC ZRO B2300222 ADC TC B2300223* B2300224INCR LDA- I B2300225 INA 1 B2300226 STA- I B2300227 STA* PPTAB SET READY FOR NEXT PARAMETER MNEMONIC B2300228 LDA- (ZERO),I CHECK IF NEXT WORD NON-ZERO B2300229 SAN NXTLST THIS WORD IS START OF NXT LIST B2300230 JMP* INCR NXT LIST NOT YET REACHED B2300231* B2300232ÐÐNXTLST CLR A B2300233 STA* LSTWRD B2300234 LDQ* QSAV B2300235 INQ 1 B2300236 JMP NXTCOM B2300237* B2300238* LOCAL VARIABLES B2300239* B2300240BCOM ALF 1, , B2300241LSTWRD NUM 0 B2300242QSAV NUM 0 B2300243PARMIN NUM 0 B2300244PARBUF BSS PARBUF(32) B2300245STATUS NUM 0 B2300246* B2300247DISBUF NUM $0A0D LF/CR B2300248 BSS OUTBUF(3) B2300249 EQU DISBL(*-DISBUF) B2300250MESLEN ADC DISBL B2300251PAUSBF NUM $0A0D LF/CR B2300252 ALF 3,PAUSE B2300253 EQU PAUSLN(*-PAUSBF) B2300254MSPAUS ADC PAUSLN B2300255LINCNT NUM 0 LINE COUNTER B2300256N3 NUM 3 B2300257ÐÐTC NUM 0 B2300258NOCUR NUM -1 B2300259ZRO NUM 0 B2300260BLANK ALF 1, B2300261PPTAB ADC PPHELP B2300262FTSW NUM 0 B2300263 EQU UTSTRT(COMAND) B2300264* B2300265 END B2300266 NAM GTMOUN B24 A ITOS CCS 3.0 SL-149B2400001* START ROUTINE FOR COMMAND PROCESSOR MOUNT B2400002* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B2400003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B2400004* COPYRIGHT CONTROL DATA CORPORATION 1979 B2400005* B2400006* B2400007* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B2400008* AN ENTRY POINT FOR THE COMMAND PROCESSOR MOUNT B2400009* IN ORDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B2400010* B2400011* B2400012* B2400013* LABELED COMMON AREA B2400014* B2400015 DAT COMCOD(89),PARNAM(83) 122*4875B2400016ÐÐ DAT PPHELP(2) B2400017 DAT PPINIT(4) B2400018 DAT PPDEFI(16) B2400019 DAT PPSTAT(4) B2400020 DAT PPRELO(5) 122*4875B2400021 DAT PPDUMP(5) 122*4875B2400022 DAT PPCOPY(6) B2400023 DAT PPDELE(3) B2400024 DAT PPCLEA(3) B2400025 DAT PPLIST(6) 122*4875B2400026 DAT PPRENA(5) B2400027 DAT PPCOMM(2) B2400028 DAT PPEXIT(1) B2400029 DAT PPMOUN(3) B2400030 DAT PPDISM(2) B2400031 DAT PPSAVE(3) B2400032 DAT PPBATC(7) 122*4875B2400033 DAT PPLOAD(5) B2400034 DAT PPPURG(3) B2400035 DAT PPINPU(2) B2400036 DAT PPOUTP(2) B2400037 DAT PPCOMP(3) B2400038 DAT DUMMY(6) B2400039 DAT INBUF(41),CODE(20) B2400040 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B2400041ÐÐ DAT REQBUF(24),IDATA(24) B2400042 DAT PARDEF(24) B2400043 DAT FCBHDR(5) B2400044 DAT FCBBUF(96) B2400045 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B2400046 EQU COMLEN(ENDCOM-COMCOD) B2400047* B2400048 ENT MARKER B2400049 ENT UTSTRT B2400050* B2400051 EXT MOUNT B2400052* B2400053MARKER NOP 0 B2400054 RTJ MOUNT B2400055 JMP* (MARKER) B2400056* B2400057 EQU UTSTRT(MARKER) B2400058* B2400059 END B2400060 NAM GTDISM B25 A ITOS CCS 3.0 SL-149B2500001* START ROUTINE FOR COMMAND PROCESSOR DISMOUNT B2500002* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B2500003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B2500004* COPYRIGHT CONTROL DATA CORPORATION 1979 B2500005* B2500006ÐÐ* B2500007* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B2500008* AN ENTRY POINT FOR THE COMMAND PROCESSOR DISMOUNT B2500009* IN OREDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B2500010* B2500011* B2500012* B2500013* LABELED COMMON AREA B2500014* B2500015 DAT COMCOD(89),PARNAM(83) 122*4875B2500016 DAT PPHELP(2) B2500017 DAT PPINIT(4) B2500018 DAT PPDEFI(16) B2500019 DAT PPSTAT(4) B2500020 DAT PPRELO(5) 122*4875B2500021 DAT PPDUMP(5) 122*4875B2500022 DAT PPCOPY(6) B2500023 DAT PPDELE(3) B2500024 DAT PPCLEA(3) B2500025 DAT PPLIST(6) 122*4875B2500026 DAT PPRENA(5) B2500027 DAT PPCOMM(2) B2500028 DAT PPEXIT(1) B2500029 DAT PPMOUN(3) B2500030 DAT PPDISM(2) B2500031ÐÐ DAT PPSAVE(3) B2500032 DAT PPBATC(7) 122*4875B2500033 DAT PPLOAD(5) B2500034 DAT PPPURG(3) B2500035 DAT PPINPU(2) B2500036 DAT PPOUTP(2) B2500037 DAT PPCOMP(3) B2500038 DAT DUMMY(6) B2500039 DAT INBUF(41),CODE(20) B2500040 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B2500041 DAT REQBUF(24),IDATA(24) B2500042 DAT PARDEF(24) B2500043 DAT FCBHDR(5) B2500044 DAT FCBBUF(96) B2500045 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B2500046 EQU COMLEN(ENDCOM-COMCOD) B2500047* B2500048 ENT MARKER B2500049 ENT UTSTRT B2500050* B2500051 EXT DSMOUN B2500052* B2500053MARKER NOP 0 B2500054 RTJ DSMOUN B2500055 JMP* (MARKER) B2500056ÐÐ* B2500057 EQU UTSTRT(MARKER) B2500058* B2500059 END B2500060 NAM GTSAVE B26 A ITOS CCS 3.0 SL-149B2600001* START ROUTINE FOR COMMAND PROCESSOR SAVE B2600002* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B2600003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B2600004* COPYRIGHT CONTROL DATA CORPORATION 1979 B2600005* B2600006* B2600007* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B2600008* AN ENTRY POINT FOR THE PROCESSOR SAVE B2600009* IN OREDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B2600010* B2600011* B2600012* B2600013* LABELED COMMON AREA B2600014* B2600015 DAT COMCOD(89),PARNAM(83) 122*4875B2600016 DAT PPHELP(2) B2600017 DAT PPINIT(4) B2600018 DAT PPDEFI(16) B2600019 DAT PPSTAT(4) B2600020 DAT PPRELO(5) 122*4875B2600021ÐÐ DAT PPDUMP(5) 122*4875B2600022 DAT PPCOPY(6) B2600023 DAT PPDELE(3) B2600024 DAT PPCLEA(3) B2600025 DAT PPLIST(6) 122*4875B2600026 DAT PPRENA(5) B2600027 DAT PPCOMM(2) B2600028 DAT PPEXIT(1) B2600029 DAT PPMOUN(3) B2600030 DAT PPDISM(2) B2600031 DAT PPSAVE(3) B2600032 DAT PPBATC(7) 122*4875B2600033 DAT PPLOAD(5) B2600034 DAT PPPURG(3) B2600035 DAT PPINPU(2) B2600036 DAT PPOUTP(2) B2600037 DAT PPCOMP(3) B2600038 DAT DUMMY(6) B2600039 DAT INBUF(41),CODE(20) B2600040 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B2600041 DAT REQBUF(24),IDATA(24) B2600042 DAT PARDEF(24) B2600043 DAT FCBHDR(5) B2600044 DAT FCBBUF(96) B2600045 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B2600046ÐÐ EQU COMLEN(ENDCOM-COMCOD) B2600047* B2600048 ENT MARKER B2600049 ENT UTSTRT B2600050* B2600051 EXT SAVE B2600052* B2600053MARKER NOP 0 B2600054 RTJ SAVE B2600055 JMP* (MARKER) B2600056* B2600057 EQU UTSTRT(MARKER) B2600058* B2600059 END B2600060 NAM MMCOPY B27 A ITOS CCS 3.0 . SL-149 00001* DISK COPY ROUTINE 00002* CREDIT COLLECTION SYSTEM VERSION 3.0 00003* DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00004* COPYRIGHT CONTROL DATA CORPORATION 1979 00005* 00006 SPC 1 00007* LOGIC FOR 'MULTIPLE COPY' SAVE REMAINS IN CODE 00008* BUT HAS NOT BEEN IMPLEMENTED. SPECIFICALLY, FLAGS 00009* 'MPCYFG' AND 'TOFMFG'. 00010**** 00011ÐÐ* 00012* FUNCTION 00013* 00014* 00015* THIS ROUTINE COPIES ONE DISK UNIT TO ANOTHER DISK UNIT. 00016* 00017* 00018* EXPLANATION -- 00019* 00020* MMCOPY DETERMINES WHICH ONE OF THE FOUR BELOW LISTED TYPES OF COPY 00021* SCHEMES IS GOING TO BE USED DEPENDING ON THE PARAMETERS IN THE PDT 00022* OF THE LOGICAL UNITS SPECIFIED AND ON THE VOLUME 1 LABEL. THE 4 00023* TYPES ARE: 00024* 00025* 1. SAME SIZE WORDS PER SECTOR ON BOTH PACKS ARE EQUAL. 00026* 2. SMALL TO LARGE WORDS PER SECTOR ON FROM PACK IS SMALLER. 00027* 3. LARGE TO SMALL WORDS PER SECTOR ON FROM PACK IS LARGER. 00028* 4. SMALL TO LARGE(RV) WORDS PER SECTOR ON FROM PACK IS SMALLER 00029* THIS IS THE REVERSE OF SCHEME 3. 00030* 00031* 00032* THE COPY IS PERFORMED OFF-LINE AFTER ALL CHECKS AND PRELIMINARY 00033* PROCESSING HAVE BEEN COMPLETED AND AFTER REQUESTING THAT THE PROTECT 00034* SWITCH BE DISABLED, AND DISABLING THE SYSTEM TIMER, MANUAL INTERRUPT, 00035* MIRRO INTERRUPT, AND DEVICE ERROR LOGGING. THE MASK TABLE IS MODIFI- 00036ÐÐ* ED TO ENSURE THAT NO UNWANTED INTERRUPTS CAN BE SERVICED. 00037* 00038* PART OF THE CODE IS MOVED INTO THE FILE MANAGER PARTITION AND EXECU- 00039* TED FROM THERE. 00040* THE TRANSFER BUFFER IS POSITIONED AT THE BEGINNING OF BACKGROUND 00041* AND PAGING IS TURNED OFF TO ACCOMPLISH THE TRANSFER. 00042* 137*A107 00043* DEPENDING ON THE VALUE OF THE SYSDAT RESIDENT PARAM SAVOPT, 137*A107 00044* A VERIFICATION WIL BE MADE TO ASSURE THAT THE PACK TO PACK 137*A107 00045* TRANSFER IS COMPLETED WITHOUT ERROR (NO DIFFERENCES IN THE 137*A107 00046* DATA ON THE TWO PACKS). THIS VERIFICATION WILL BE MADE IF 137*A107 00047* SAVOPT IS NON-ZERO. THE VERIFICATION WILL BE MADE ON A TRACK137*A107 00048* BY TRACK BASIS - IMMEDIATELY AFTER EACH TRACK IS COPIED. 137*A107 00049* 137*A107 00050* 00051* CALLING SEQUENCE 00052* 00053* CALL MMCOPY (LU1,LU2) 00054* 00055* PARAMETERS 00056* 1 CARD DELETED 137*A107 00057* LU1 DISK-UNIT TO COPY FROM 00058* LU2 DISK-UNIT TO COPY TO 00059 EJT 00060* ENTRY POINTS 00061ÐÐ* 00062 ENT MMCOPY 00063* 00064* EXTERNALS 00065* 00066 EXT Q8PKUP 00067 EXT Q8PREP 00068 EXT SYSMSG 00069 EXT MMSIZ 00070 EXT EMPSTP 00071 EXT DMICOD 00072 EXT TBLADR 00073 EXT EFSTOR 00074 EXT MIBX 00075 EXT JOBIND 00076 EXT SWTCH 00077 EXT TODAY 00078 EXT PARTBL 00079 EXT CPSET 00080 EXT* VERWPS VERIFY COMPATIBILITY OF SMD LU PARTS. 00081 EXT LVERWP LENGTH OF 'VERWPS' SUBROUTINE 00082* 00083* EQUATES 00084* 00085 EQU DISP($EA) 00086ÐÐ EQU ZERO($22) 00087 EQU ONEMSK(3) 00088 EQU LPMASK($2) 00089 EQU ZROBIT($33) 00090 EQU ONEBIT($23) ONE BIT TABLE 00091 EQU MTBADR($B7) ADDRESS OF MASK TABLE 00092 EQU ADRECT($E9) ADDRESS OF EXTENDED COMMUNICATION TABLE 00093 EQU LOG1A(28) ADDRESS OF LOG1A TABLE (IN EXT COM TABLE) 00094 EQU MMLUTB(29) FWA OF FM LOGICAL UNIT TABLE (IN EXT COM TBL) 00095 EQU NRWHD(49) DISK # OF RW HEADS IN PDT 00096 EQU UNPBGN($F7) LOCATION OF ADDRESS OF BEGINNING OF BACKGROUND 00097************************************************** 00098 EQU TERMLU(5) TERMINAL LOGICAL UNIT 00099************************************************** 00100 EQU LABMSB(21) LABEL SECTOR MSB 00101 EQU LABLSB(22) LABEL SECTOR LSB 00102 SPC 3 00103* ERROR CODES 00104 EQU NOTDSK(74) CLASS CODE IS NOT OF A DISK 00105 EQU IOECOD(35) I/O ERROR CODE 00106 EQU NCOMDE(88) NON-COMPATIBLE TYPE DEVICES ERROR CODE 00107 EQU TOMUCH(399) TOO MUCH MM SPACE USED ON LARGE DISK 00108 EQU JPORLA(398) JOB PROCESSOR OR LIBEDT ACTIVE 00109 EJT 00110* VOLUME LABEL EQUIVALENCES 00111ÐÐ EQU VLNAM1(2) VOLUME NAME - 1ST WORD 00112 EQU VLNAM2(3) VOLUME NAME - 2ND WORD 00113 EQU VLNAM3(4) VOLUME NAME - 3RD WORD 00114 EQU VLNAM4(5) VOLUME - 4TH WORD 00115 EQU VLASDM(22) AVAILABLE SPACE DIRECTORY SECTOR ADDRESS - MSB 00116 EQU VLASDL(23) AVAILABLE SPACE DIRECTORY SECTOR ADDRESS - LSB 00117 EQU VLASDS(24) AVAILABLE SPACE DIRECTORY NO. OF SECTORS 00118 EQU VLLBMB(25) LARGEST AVAILABLE BLOCK SIZE - MSB 00119 EQU VLLBLB(26) LARGEST AVAILABLE BLOCK SIZE - LSB 00120 EQU VLFDD1(28) FILE DEFINITION DIR. SECTOR ADDRESS - MSB 00121 EQU VLFDD2(29) FILE DEFINITION DIR. SECTOR ADDRESS - LSB 00122 EQU VLNFDB(32) NO. OF BLOCKS IN FDD 00123 EQU VLSDT1(35) LAST SAVE DATE - 1ST WORD 00124 EQU VLSDT2(36) LAST SAVE DATE - 2ND WORD 00125 EQU VLSDT3(37) LAST SAVE DATE - 3RD WORD 00126 EQU VLTYPE(38) VOLUME TYPE 00127 EJT 00128MMCOPY NOP 0 00129* 00130 RTJ Q8PREP PREPARE FOR PARAMETER PICK-UP 00131 ADC* MMCOPY 00132* 00133HERE RTJ Q8PKUP PICK-UP PARAMETERS 00134 STA LU1 00135 RTJ* (HERE+1) 00136ÐÐ STA LU2 00137 JMP* GO8 00138 EJT 00139GO8 LDA JOBIND CHECK IF JOB PROCESSOR ACTIVE 00140 SAN GO8A SKIP IF YES 00141 LDA SWTCH CHECK IF LIBEDT ACTIVE 00142 SAZ GO8B SKIP IF NO 00143GO8A LDA =XJPORLA SET ERROR MESSAGE AND EXIT 00144 JMP GO235 00145* 00146GO8B RTJ TODAY GET TODAY'S DATE 00147 ADC ITEMP 00148 ADC ITEMP+1 00149******* GET 'FROM' DISK DATA 00150* 00151GO9 ENQ MMLUTB GET ACTUAL LOGICAL NO. 00152 LDQ- (ADRECT),Q 00153 ADQ (LU1) 00154 INQ 1 00155 LDA- (ZERO),Q 00156 STA- I 00157 LDA- (ZERO),I 00158 AND- LPMASK+8 $00FF 00159 STA DISK1 STORE INTO REQUEST PARAMETER LIST 00160 STA LUF 00161ÐÐ STA LUA 00162 STA LUNIT1 00163 LDA- LABMSB,I BEGIN TRANSFER AT THE VOLUME LABEL 00164 STA MSB 00165 STA SAVMB1 00166 STA MSBC 00167 STA VLMSB1 00168 LDA- LABLSB,I 00169 STA LSB 00170 STA SAVLB1 00171 STA LSBC 00172 STA VLLSB1 00173 EJT 00174******* GET 'TO' DISK DATA 00175 ENQ MMLUTB GET ACTUAL L.U. NUMBER OF 2ND DISK 00176 LDQ- (ADRECT),Q 00177 ADQ (LU2) 00178 INQ 1 00179 LDA- (ZERO),Q 00180 STA- I 00181 LDA- (ZERO),I 00182 AND- LPMASK+8 $00FF 00183 STA DISK2 STORE IN PARAMETER LIST OF REQUEST 00184 STA LUNIT2 00185 STA LU2A 00186ÐÐ STA LUT 00187 STA LU2B XXXX 00188 LDA- LABMSB,I BEGIN TRANSFER AT THE VOLUME LABEL 00189 STA MSB2 00190 STA SAVMB2 00191 STA VLMSB2 00192 STA MSB2A 00193 STA MSB2B XXXX 00194 LDA- LABLSB,I 00195 STA LSB2 00196 STA SAVLB2 00197 STA VLLSB2 00198 STA LSB2A 00199 STA LSB2B XXXX 00200* 00201 CLR A 00202 STA MSB3 INITIALIZE THE TRANSFER COUNT 00203 STA LSB3 00204* 00205* GET MAXIMUM SECTOR VALUES, SECTORS/TRACK, AND WORDS/SECTOR OF 1ST DIS 00206* 00207 RTJ MMSIZ 00208 ADC LUF 00209 ADC MSMF 00210 ADC MSLF 00211ÐÐ ADC WPSF 00212 ADC SPTF 00213* 00214* GET MAXIMUM SECTOR VALUES, SECTORS/TRACK, AND WORDS/SECTOR OF 2ND DIS 00215* 00216 RTJ MMSIZ 00217 ADC LUT 00218 ADC MSMT 00219 ADC MSLT 00220 ADC WPST 00221 ADC SPTT 00222* INITIALIZE CONTROL VARIABLES 00223 LDA SPTF 00224 STA READU 00225 STA WRITU 00226 MUI WPSF 00227 STA FTRKLN 00228 JMP* GO250 00229 SPC 1 00230* OUTPUT ERROR MESSAGE LOGIC 00231 SPC 1 00232GO235 STA* ERCODE STORE ERROR CODE FOR SYSMSG 00233 RTJ SYSMSG REPORT MESSAGE 00234 ADC ERCODE 00235 ADC ERBUF 00236ÐÐ JMP (MMCOPY) 00237 SPC 2 00238ERCODE NUM 0 00239 EJT 00240GO250 RTJ MESAGE REQUEST THE PROTECT SWITCH DISABLE 00241 RTJ INPUT1 AWAIT A REPLY 00242 SPC 1 00243 LDQ+ EMPSTP DISABLE TIMER 00244REJ ENA 0 00245 OUT REJ-* 00246 LDA+ DMICOD 00247 AND- LPMASK+15 00248 TRA Q 00249 LDA+ TBLADR 00250 DMI DISABLE THE MICRO-INTERRUPT 00251 SPC 1 00252 SPC 2 00253 LDA- MTBADR GET FWA OF MASK TABLE 00254 INA -1 00255 STA* MASKTA STORE LOCALLY 00256 ENQ 16 SET Q TO INDEX 00257GO260 LDA* (MASKTA),Q RESET MASK TABLE WORD BY ANDING WITH SYSDAT 00258 AND* MASKAD VALUE OF SAVMSK 00259 STA* (MASKTA),Q 00260 INQ -1 DECREMENT INDEX 00261ÐÐ SQM GO270 SKIP IF DONE 00262 JMP* GO260 REPEAT 00263* 00264MASKTA NUM 0 MASK TABLE FWA 00265MASKAD NUM $4003 REMOVED - MASKAD ADC SAVMSK, EXT SAVMSK 00266PT ADC PARTBL 00267 EJT 00268* MOVE 'MMCOPY' TO FILE MGR AREA (PARTITION 0) 00269GO270 LDQ PT 00270 LDA- (ZERO),Q SET UP TO MOVE ALL CODE FROM 00271 STA* STORE LABEL 'START' TO END OF MMCOPY 00272* LOGIC TO FILE MANAGER PARTIT. 00273 LDA =XSTART 00274 STA* LOAD DEFINE LOAD AND STORE ADDRESSES 00275* 00276 LDQ =XPGMEND-START LENGTH OF MMCOPY TO XFER 00277 ADQ =XLVERWPS LENGTH OF VERWPS SUBROUTINE 00278 INQ -1 00279LOOP LDA* (LOAD),Q MOVE ONE WORD 00280 STA* (STORE),Q 00281 INQ -1 DECREMENT INDEX 00282 SQM DONE SKIP IF DONE 00283 JMP* LOOP GO MOVE NEXT WORD 00284 SPC 2 00285STORE NUM 0 STORE ADDRESS (IN FM SPACE) 00286ÐÐLOAD NUM 0 LOAD ADDRESS (IN MMCOPY) 00287 SPC 2 00288DONE JMP* (STORE) TRANSFER CONTROL TO START 00289* (NOW IN FM'S PARTITION) 00290 EJT 00291* BEGINING OF MOVED LOGIC. 00292START RTJ- ($F4) DISABLE THE ERROR LOGGING ROUTINE 00293 ADC $26FF 00294 ADC EFSTOR GETS INITIALIZED TO EFSTOR 00295 RAO+ MIBX DISABLE MANUAL INTERRUPT 00296 SPC 2 00297FMNT ENQ 0 REQUEST THE VOLUME MOUNTING 00298 RTJ MESSAG 00299 RTJ INPUT2 AWAIT THE REPLY 00300 SPC 1 00301 LDA INPBUF CHECK IF 'OK' ENTERED 00302 SUB =N$4F4B 00303 SAZ GETABS SKIP IF YES 00304 JMP* FMNT REPEAT MOUNTING REQUEST 00305 SPC 2 00306GETABS RTJ* ABS 00307ABS 000 000 00308 LDA* ABS 00309 ADD =XVLBUF1-ABS 00310 STA BUF1 00311ÐÐ* 00312 LDA* ABS 00313 ADD =XVLBUF2-ABS 00314 STA BUF2 00315 LDA* ABS 00316 ADD =XVLTYP-ABS 00317 STA VLBUF 00318 ENA 1 00319 STA PACKNO 00320 EJT 00321* 00322* VERIFY COMPATIBILITY OF DISK, DRIVE, AND PDT AS TO WORDS PER SECTOR 00323* 00324 SPC 3 00325* VERIFY DISK1 00326 RTJ* MYLOC CALC. ABS. LOC. OF 'VERWPS' PARAMETERS 00327MYLOC NUM 0 00328 LDA* MYLOC 00329 INA VWPSS-MYLOC 00330 STA* AVWPS1 00331 STA* AVWPS2 00332 ADD =XLUF-VWPSS 00333 STA* ALUF 00334 INA LUT-LUF 00335 STA* ALUT 00336ÐÐ RTJ VERWPS CALL VERIFY ROUTINE 00337ALUF NUM 0 00338AVWPS1 NUM 0 00339 LDA* VWPSS CHECK FOR COMPATIBILITY ERROR 00340 SAZ NV 00341 JMP* VERERR 00342 SPC 3 00343* VERIFY DISK 2 00344 SPC 2 00345NV RTJ VERWPS CALL VERIFY ROUTINE 00346ALUT NUM 0 00347AVWPS2 NUM 0 00348 LDA* VWPSS CHECK FOR COMPATIBILITY ERROR 00349 SAZ UPDPRO 00350VERERR ENQ 16 00351 RTJ MESSAG ISSUE INCOMPATIBILITY MESSAGE 00352 JMP* FMNT GO AND TRY MOUNT AGAIN 00353VWPSS NUM 0 STATUS RETURNED FROM 'VERWPS' ROUTINE 00354 SPC 3 00355* UPDATE CONTROL PARAMTERS TO REFLECT DISKS MOUNTED. 00356UPDPRO LDA ABS 00357 ADD =XVLTYP-ABS 00358 STA* VLBUF 00359 RTJ MMREAD READ IN VOLUME TYPE 00360VLBUF ADC VLTYP 1. BUFFER ADDRESS 00361ÐÐ ADC 1 2. NUMBER OF WORDS 00362LUA ADC 0 3. LOGICAL UNIT 00363 ADC 38 4. INDEX OFFSET 00364 ADC 0 5. MSB SECTOR ADDRESS 00365 ADC 0 6. LSB SECTOR ADDRESS 00366 SQP OKVLRD SKIP IF NO I/O ERROR 00367 ENA IOECOD SET ERROR MESSAGE CODE - I/O ERROR 00368 JMP GO235 00369OKVLRD LDA VLTYP 00370 AND =N$BFFF MASK BIT 14 OUT 00371 STA MPCYFG 00372 LDA FTRKLN COMPUTE ADJUST READU OR WRITU 00373 DVI WPST 00374 SQZ 1 ROUND UP TO NEXT INTEGER 00375 INA 1 00376 TRA Q SAVE IN Q 00377 LDA WPSF COMPUTE SIZE DIFFERENCE (WPS) 00378 SUB WPST 00379 SAZ EQ IF WORDS/SECTOR ARE EQUAL SKIP. 00380 JMP* NOTEQ IF WORDS/SECTOR ARE NOT EQUAL JUMP. 00381 EJT 00382* 00383* WORDS/SECTOR ARE EQUAL, SET CONTROL PARAMETERS 00384* 00385EQ ENA 0 INITIALIZE FORCED SINGLE COPY FLAG 00386ÐÐ STA FSCFG 00387 LDA MPCYFG DETERMINE IF FORCED SINGLE COPY IS SPECIFIED 00388 SAP NEQ SKIP IF NOT FORCED SINGLE COPY 00389 JMP* EQB1 00390NEQ AND =N$7FFF AND OUT BIT 15 00391 INA -2 00392 STA MPCYFG STORE ADJUSTED MULTIPLE COPY FLAG 00393* 00394* DETERMINE IF DIFFERENT CAPACITY DISKS FOR MULTIPLE COPY 00395* 00396 ENQ LOG1A 00397 LDQ- (ADRECT),Q 00398 ADQ LUNIT1 00399 LDQ- (ZERO),Q GET PDT LOCATION FOR UNIT 1 00400 LDA- NRWHD,Q GET NUMBER OF R/W HEADS 00401 STA TYPE1 SAVE IN TYPE1 00402 ENQ LOG1A 00403 LDQ- (ADRECT),Q 00404 ADQ LUNIT2 00405 LDQ- (ZERO),Q GET PDT LOCATION FOR UNIT 2 00406 LDA- NRWHD,Q GET NUMBER OF R/W HEADS 00407 SUB TYPE1 DETERMINE IF DIFFERENCE EXISTS 00408 SAN EQT1 SKIP IF NOT SAME SIZE 00409 JMP* EQ1 00410EQT1 SAM T35 SKIP IF FROM PACK IS LARGER 00411ÐÐ LDA MPCYFG SET FORCED SINGLE COPY FLAG IF NECESSARY 00412 SAP M53 SKIP IF NOT 00413 LDA =N$8000 00414 STA FSCFG SAVE FLAG 00415 JMP* EQ1 00416 EQU M53(*) 00417T35 JMP* NOTEQ 00418* FORCED SINGLE COPY PER 'MPCYFG' FLAG 00419EQB1 AND =N$7FFF ADJUST MPCYFG FOR FORCED SINGLE COPY 00420 STA MPCYFG 00421 LDA FTRKLN SET TRANSFER LENGTH TO ONE TRACK OF FROM PACK 00422 STA LENGTH 00423 STA LENG2 00424 ENA 1 00425 STA NUMPKS INDICATE ONE PACK 00426 LDA MSMT SET MAX SECTORS TO 'TO' PACK 00427 STA SECTM 00428 LDA MSLT 00429 STA SECTL 00430 JMP COMAL 00431 EJT 00432* 00433* SAME CAPACITY, SAME WPS SIZE COPY 00434* 00435EQ1 LDA FTRKLN SET TRANSFER LENGTH TO ONE TRACK OF FROM PACK 00436ÐÐ STA LENGTH 00437 STA LENG2 00438 ENA 1 00439 STA NUMPKS SET NUMBER OF PACKS = 1 00440 TCA A 00441 STA MPCYFG SET MULTIPLE COPY FLAG TO -1 (NO MULTIPLE COPY 00442 LDA MSMF 00443 STA SECTM SET MSB,LSB OF TRANSFER MAXIMUM SECTOR 00444 LDA MSLF 00445 STA SECTL 00446 JMP COMAL 00447 EJT 00448* 00449* NUMBER OF WORDS PER SECTOR ARE DIFFERENT. 00450* 00451NOTEQ LDA FTRKLN 00452 STA LENGTH SET READ AND WRITE 00453 STA LENG2 LENGTHS TO $1800. 00454 ENA 1 00455 STA NUMPKS ONE PACK. 00456 TCA A 00457 STA MPCYFG NO MULTIPLE COPIES. 00458 LDA SPTF 00459 STA READU SEC/TRK FOR READ DEVICE. 00460 LDA SPTT 00461ÐÐ STA WRITU SEC/TRK FOR WRITE DEVICE 00462 LDA MSMF 00463 STA SECTM MSB,LSB OF READ DEVICE. 00464 LDA MSLF 00465 STA SECTL 00466 EJT 00467COMAL LDA* NUMPKS SET PACKS LEFT PARAMETER 00468 INA -1 00469 STA* PACLFT 00470* GET READY TO DISPLAY VOL LABELS OF MOUNTED 00471* VOLUMES FOR OPERATOR VERIFICATION 00472NXTPK RTJ MMREAD READ IN LABEL OF VOLUME 1 00473BUF1 ADC VLBUF1 1. BUFFER ADDRESS 00474 ADC 96 2. NO. OF WORDS 00475LUNIT1 ADC 0 3. LOGIC UNIT 00476 ADC 0 4. INDEX OFFSET 00477VLMSB1 ADC 0 5. MSB SECTOR ADDRESS 00478VLLSB1 ADC 0 6. LSB SECTOR ADDRESS 00479 SPC 1 00480 SQM RDE SKIP IF I/O ERROR 00481 JMP* GO280 00482RDE ENA IOECOD SET ERROR MESSAGE CODE - I/O ERROR 00483 JMP GO235 00484* 00485* CONTROL VARIABLES 00486ÐÐ* 00487LUF NUM 0 LOGICAL UNIT OF FROM DISK 00488WPSF NUM 0 WORDS/SECTOR OF FROM DISK 00489MSMF NUM 0 MAX SECTOR (MSB) FROM DISK 00490MSLF NUM 0 MAX SECTOR (LSB) FROM DISK 00491SPTF NUM 0 SECTORS/TRACK OF FROM DISK 00492READU NUM 0 SECTOR UPDATE FOR READ FROM DISK 00493* 00494LUT NUM 0 LOGICAL UNIT OF TO DISK 00495WPST NUM 0 WORDS/SECTOR (MSB) TO DISK 00496MSMT NUM 0 MAX SECTOR (MSB) TO DISK 00497MSLT NUM 0 MAX SECTOR (LSB) TO DISK 00498SPTT NUM 0 SECTORS/TRACK OF TO DISK 00499WRITU NUM 0 SECTOR UPDATE FOR WRITE TO DISK 00500* 00501FTRKLN NUM 0 TRACK LENGTH OF FROM DISK 00502NUMPKS NUM 0 NUMBER OF PACKS TO BE USED 00503MPCYFG NUM 0 MULTIPLE COPY FLAG (NEG. = NO MULTIPLE COPY) 00504SECTM NUM 0 MSB OF MAXIMUM SECTOR FOR TRANSFER 00505SECTL NUM 0 LSB OF MAXIMUM SECTOR FOR TRANSFER 00506SECTMR NUM 0 MSB OF REMAINDER SECTOR FOR TRANSFER 00507SECTLR NUM 0 LSB OF REMAINDER SECTOR FOR TRANSFER 00508VLTYP NUM 0 VOLUME TYPE FOR FROM DISK 00509PACLFT NUM 0 NUMBER OF PACKS LEFT TO COPY TO/FROM 00510PACKNO NUM 0 PACK NUMBER (CURRENT) MULTIPLE COPY 00511ÐÐTOFMFG NUM 0 TO/FROM MULTIPLY COPY FLAG (1 = TO) 00512FSCFG NUM 0 FORCED SINGLE COPY FLAG(0,$8000) 00513 SPC 1 00514GO280 LDA* BUF1 STORE VOL NAME 00515 STA- I 00516 LDA- VLNAM1,I 00517 SAN N1 CONVERT ZEROES TO BLANKS. 00518 LDA =N$2020 00519N1 STA NAME1 00520 LDA- VLNAM2,I 00521 SAN N2 00522 LDA =N$2020 00523N2 STA NAME1+1 00524 LDA- VLNAM3,I 00525 SAN N3 00526 LDA =N$2020 00527N3 STA NAME1+2 00528 LDA- VLNAM4,I 00529 SAN N4 00530 LDA =N$2020 00531N4 STA NAME1+3 00532 LDA- VLSDT1,I STORE LAST SAVE DATE 00533 SAN D1 00534 LDA =N$2A2A CONVERT BLANK DATE TO ****** 00535D1 STA DATE1 00536ÐÐ LDA- VLSDT2,I 00537 SAN D2 00538 LDA =N$2A2A 00539D2 STA DATE1+1 00540 LDA- VLSDT3,I 00541 SAN D3 00542 LDA =N$2A2A 00543D3 STA DATE1+2 00544 LDA- VLTYPE,I STORE VOL TYPE 00545 STA TYPE1 00546 SPC 2 00547 00548 RTJ MMREAD READ IN LABEL OF VOLUME 2 00549BUF2 ADC VLBUF2 1. BUFFER ADDRESS 00550 ADC 96 2. NO. OF WORDS 00551LUNIT2 ADC 0 3. LOGIC UNIT 00552 ADC 0 4. INDEX OFFSET 00553VLMSB2 ADC 0 5. MSB OF SECTOR ADDRESS 00554VLLSB2 ADC 0 6. LSB OF SECTOR ADDRESS 00555 SPC 1 00556 SQP GO290 SKIP IF NO I/O ERROR 00557 ENA IOECOD SET ERROR MESSAGE CODE - I/O ERROR 00558 JMP GO235 00559 SPC 1 00560GO290 LDA* BUF2 STORE VOL NAME 00561ÐÐ STA- I 00562 LDA- VLNAM1,I 00563 SAN N5 00564 LDA =N$2020 00565N5 STA NAME2 00566 LDA- VLNAM2,I 00567 SAN N6 00568 LDA =N$2020 00569N6 STA NAME2+1 00570 LDA- VLNAM3,I 00571 SAN N7 00572 LDA =N$2020 00573N7 STA NAME2+2 00574 LDA- VLNAM4,I 00575 SAN N8 00576 LDA =N$2020 00577N8 STA NAME2+3 00578 LDA- VLSDT1,I STORE LAST SAVE DATE 00579 SAN D4 00580 LDA =N$2A2A 00581D4 STA DATE2 00582 LDA- VLSDT2,I 00583 SAN D5 00584 LDA =N$2A2A 00585D5 STA DATE2+1 00586ÐÐ LDA- VLSDT3,I 00587 SAN D6 00588 LDA =N$2A2A 00589D6 STA DATE2+2 00590 LDA- VLTYPE,I STORE VOL TYPE 00591 STA TYPE2 00592 SPC 2 00593 LDA =N$4241 CHECK TYPE OF VOLS FOR DISPLAY PURPOSES 00594 STA V1TYP 00595 STA V2TYP 00596 LDA =N$434B 00597 STA V1TYP+1 00598 STA V2TYP+1 00599 LDA =N$5550 00600 STA V1TYP+2 00601 STA V2TYP+2 00602 LDA TYPE1 00603 SAN GO295 SKIP IF NOT MASTER 00604 LDA =N$4D41 00605 STA V1TYP 00606 LDA =N$5354 00607 STA V1TYP+1 00608 LDA =N$4552 00609 STA V1TYP+2 00610GO295 LDA TYPE2 00611ÐÐ SAN GO300 SKIP IF NOT MASTER 00612 LDA =N$4D41 00613 STA V2TYP 00614 LDA =N$5354 00615 STA V2TYP+1 00616 LDA =N$4552 00617 STA V2TYP+2 00618* 00619 SPC 2 00620* DISPLAY VOL NAME, DATE AND TYPE 00621* GET VERIFICATION FROM OPERATOR 00622GO300 ENQ 4 WRITE HEADER MESSAGE 00623 RTJ MESSAG 00624 SPC 1 00625 ENQ 5 DISPLAY VOLUME NAMES, DATES AND TYPES 00626 RTJ MESSAG 00627 SPC 1 00628 ENQ 6 00629 RTJ MESSAG 00630 SPC 1 00631 ENQ 7 00632 RTJ MESSAG 00633 SPC 1 00634 SPC 4 00635* 00636ÐÐ* OUTPUT MSG 9 ONLY IF COPYING FROM BACKUP TO MASTER. 00637* 00638CHKM9 LDA TYPE1 00639 SAZ GO310 SKIP IF 'FROM' PACK IS MASTER. 00640 LDA TYPE2 00641 SAN GO310 SKIP IF 'TO' PACK IS NOT MASTER. 00642 ENQ 8 00643 RTJ MESSAG OUTPUT WARNING MSG. 00644 SPC 4 00645 SPC 2 00646GO310 ENQ 0 VERIFY NAMES ON BOTH VOLUMES ARE SAME 00647GO320 LDA NAME1,Q 00648 SUB NAME2,Q 00649 SAN DIFNM 00650 INQ 1 00651 TRQ A 00652 INA -4 00653 SAZ CKDAT YES 00654 JMP* GO320 00655DIFNM ENQ 9 NO - ISSUE WARNING MESSAGE 00656 RTJ MESSAG 00657 SPC 4 00658* 00659* IF COPYING FROM MASTER TO BACKUP - DO NOT OUTPUT MSG 11 00660* 00661ÐÐCKDAT LDA TYPE1 00662 SAN CKDATE SKIP IF 'FROM' IS NOT MASTER. 00663 LDA TYPE2 00664 SAZ CKDATE SKIP IF 'TO' IS MASTER. 00665 JMP* GO330 JUMP AROUND MSG 11. 00666 SPC 4 00667CKDATE ENQ 2 VERIFY THAT THE LAST SAVE DATE ON THE VOLUME 00668 LDA DATE1,Q TO BE COPIED FROM IS LATER THAN THE LAST SAVE 00669 SUB DATE2,Q DATE ON THE VOLUME TO BE COPIED TO 00670 SAM DIFDT1 00671 SAZ 1 00672 JMP* GO330 00673 ENQ 0 00674 LDA DATE1,Q 00675 SUB DATE2,Q 00676DIFDT1 SAM DIFDT 00677 SAZ 1 00678 JMP* GO330 00679 ENQ 1 00680 LDA DATE1,Q 00681 SUB DATE2,Q 00682 SAM DIFDT 00683 SAZ DIFDT 00684 JMP* GO330 00685DIFDT ENQ 10 NO - ISSUE WARNING MESSAGE 00686ÐÐ RTJ MESSAG 00687 SPC 2 00688GO330 ENQ 11 ASK IF WANT TO ABORT SAVE 00689 RTJ MESSAG 00690 SPC 1 00691 RTJ INPUT2 AWAIT REPLY 00692 LDA INPBUF 00693 SUB =N$474F 00694 SAZ GETIT GO 00695 JMP FMNT EX 00696 SPC 2 00697* 00698GETIT RTJ* ABSADR GET ABSOLUTE ADDRESS 00699ABSADR 000 000 00700 LDA* ABSADR SET COMPLETION ADDRESS FOR READ 00701 ADD =XRDCOMP-ABSADR 00702 STA* COMP1 00703 ADD =XWTCOMP-RDCOMP 00704 STA* COMP2 SET COMPLETION ADDRESS FOR WRITE 00705 LDA* ABSADR 00706 ADD =XMSB-ABSADR 00707 STA* AMSB 00708 ADD =XMSB2-MSB 00709 STA* AMSB2 00710 ADD =XMSB3-MSB2 00711ÐÐ STA* AMSB3 00712* 00713 LDA* ABSADR 00714 ADD =XITEMP-ABSADR 00715 STA ATEMP 00716* 00717* COMPARE VLTYPE AGAINST SEQUENCE NUMBER IF MULTIPLE COPY FROM 00718* 00719 LDA MPCYFG 00720 SAP COMPR 00721 JMP* COPTRK NOT MULTIPLE COPY 00722COMPR LDA TOFMFG 00723 SAN COMPR1 00724 JMP* COPTRK NOT FROM MULTIPLE COPY 00725COMPR1 LDA* TYPE1 00726 AND =N$BFFF MASK BIT 14 00727 INA -1 00728 SUB PACKNO COMPARE PACKNO TO SEQUENCE NUMBER 00729 SAN NOTSEQ NOT CORRECT 00730 JMP* COPTRK OK CONTINUE 00731NOTSEQ ADD PACKNO STORE PACK NO. IN MESSAGE 00732 AND =N$2030 00733 STA SPKNO 00734 LDA PACKNO SET PACK NO. IN MESSAGE 00735 AND =N$2030 00736ÐÐ STA PKNO 00737RESEQM ENQ 14 00738 RTJ MESSAG ISSUE WRONG SEQUENCED PACK NO. MESSAGE 00739 RTJ INPUT2 CHECK VERIFY REPLY 00740 LDA INPBUF 00741 SUB =N$4F4B 00742 SAZ AGAIN 00743 JMP* RESEQM TRY AGAIN 00744AGAIN JMP NXTPK START PACK VERIFY AGAIN. 00745 EJT 00746* 00747* 137*A107 00748COPTRK LDA =N$4C44 SET UP 2ND MONITOR REQUEST FOR WRITE 137*A107 00749 STA* WRTRED 137*A107 00750 ENQ 0 TURN OFF PAGING 00751 RTJ+ CPSET 00752 LDA- UNPBGN SET TRANSFER BUFFER ADDRESS TO BACKGROUND 00753 INA 1 00754 STA* BUFAD1 00755 STA* BUFAD2 137*A107 00756 CLR A SET READ/WRITE FLAG TO INDICATE WRITE 137*A107 00757 STA* RWFLAG 137*A107 00758 STA* BUFIDX CLEAR BUFFER INDEX FOR VERIFY 137*A107 00759 JMP* REDTRK 137*A107 00760* 137*A107 00761ÐÐVSETUP LDA =N$4844 VERIFICATION SET-UP 137*107 00762 STA* WRTRED SET UP 2ND MONITOR REQUEST FOR READ 137*A107 00763 LDA* BUFAD2 137*A107 00764 ADD* LENGTH RESET BUFFER ADDR TO SPACE OVER INIT 137*A107 00765 STA* BUFAD2 INPUT BUFFER 137*A107 00766 RAO* RWFLAG BUMP READ/WRITE FLAG TO INDICATE READ 137*A107 00767* 137*A107 00768REDTRK RTJ- ($F4) 137*A107 00769* 137*A107 00770 NUM $4844 FREAD 00771COMP1 ADC RDCOMP (GETS RESET) 00772 NUM 0 THREAD 00773DISK1 NUM 0 LOGICAL UNIT NUMBER 00774LENGTH NUM 0 BUFFER LENGTH 00775* 137*A107 00776BUFAD1 NUM 0 BUFFER ADDRESS 00777* 137*A107 00778MSB NUM 0 MSB OF START READ 00779LSB NUM 0 LSB OF START READ 00780* 00781 JMP- (DISP) 00782RDCOMP SQP WRTTRK NO ERROR 00783 JMP EREND ERROR, TERMINATE 00784* 00785WRTTRK RTJ- ($F4) 00786ÐÐ* 137*A107 00787WRTRED NUM $4C44 FWRITE - GETS RESET TO FREAD 137*A107 00788* 137*A107 00789COMP2 ADC WTCOMP (GETS RESET) 00790 NUM 0 THREAD 00791DISK2 NUM 0 LOGICAL UNIT NO 00792LENG2 NUM 0 LENGTH OF BUFFER 00793* 137*A107 00794BUFAD2 ADC 0 ADDRESS OF I/O BUFFER 137*A107 00795* 137*A107 00796MSB2 NUM 0 START MSB OF WRITE 00797LSB2 NUM 0 START LSB OF WRITE 00798 JMP- (DISP) 00799WTCOMP SQP CL 00800 JMP EREND ERROR TERMINATE 00801CL JMP* COMPL 00802 SPC 3 00803MSB3 NUM 0 00804LSB3 NUM 0 00805AMSB ADC 0 00806AMSB2 ADC 0 00807AMSB3 ADC 0 00808SAVMB1 NUM 0 SAVED MSB/LSB OF START READ SECTOR ADDRESS 00809SAVLB1 NUM 0 00810SAVMB2 NUM 0 SAVED MSB/LSB OF START WRITE SECTOR 00811ÐÐSAVLB2 NUM 0 00812* 137*A107 00813RWFLAG NUM 0 READ/WRITE FLAG 0=WRITE, 1=READ 137*A107 00814VERIFY NUM 0 REMOVED - VERIFY ADC SAVOPT, EXT SAVOPT 00815BUFIDX NUM 0 BUFFER INDEX 137*A107 00816TYPE1 BZS TYPE1(1) TYPE OF VOLUME 2 00817TYPE2 BZS TYPE2(1) TYPE OF VOLUME 2 00818* 137*A107 00819 EJT 00820* 137*A107 00821COMPL LDA* VERIFY CHECK IF VERIFY NEEDED 00822 SAZ COMPLA SKIP IF NO 137*A107 00823 LDA* RWFLAG CHECK IF READS NEEDED 137*A107 00824 SAN LOOOP SKIP IF READS WERE MADE 137*A107 00825 JMP* VSETUP GO SETUP FOR VERIFICATION READS 137*A107 00826* 137*A107 00827LOOOP LDQ* BUFIDX SET Q TO BUFFER INDEX 137*A107 00828 LDA* (BUFAD1),Q CHECK IF TWO WORDS COMPARE 137*A107 00829 EOR* (BUFAD2),Q 137*A107 00830 SAZ OKCMPR SKIP IF TWO WORD COMPARE WAS GOOD 137*A107 00831 JMP CMPERR GO LOG COMPARE ERROR 137*A107 00832* 137*A107 00833OKCMPR RAO* BUFIDX BUMP BUFFER INDEX 137*A107 00834 LDA* BUFIDX CHECK IF DONE 137*A107 00835 SUB* LENGTH 137*A107 00836ÐÐ SAZ COMPLA SKIP IF YES 137*A107 00837 JMP* LOOOP REPEAT TO CONTINUE VERIFY 137*A107 00838* 137*A107 00839COMPLA LDA* AMSB 137*A107 00840* 137*A107 00841 STA- I 00842 LDQ READU 00843 RTJ ADD INCREMENT THE READ SECTOR ADDRESS 00844* 00845 LDA* AMSB2 00846 STA- I 00847 LDQ WRITU 00848 RTJ ADD INCREMENT THE WRITE SECTOR ADDRESS 00849* 00850 LDA* AMSB3 00851 STA- I 00852 LDQ READU 00853 RTJ ADD INCREMENT THE SECTOR COUNTER 00854* 00855 LDA* MSB3 CHECK FOR END MSB 00856 SUB SECTM 00857 SAZ TSTLSB END MSB REACHED ,CHECK LSB END 00858 SAM CT CHECK FOR END 00859 JMP* END 00860CT JMP* CONT 00861ÐÐ* 00862TSTLSB LDA* LSB3 CHECK FOR LAST LSB 00863 SUB SECTL 00864 INA -1 00865 SAP END 00866 ADD READU CHECK FOR A REMAINDER 00867 SAM CONT 00868 SUB READU 00869 TCA A 00870 MUI WPSF CALCULATE THE NUMBER OF WRODS REMAINING. 00871 STA* LENGTH 00872 STA* LENG2 00873* 00874CONT JMP* COPTRK 00875* 00876 EJT 00877END LDA* DISK2 FIRST, SET UP TO UPDATE VOLUME LABEL 00878 STA* LUC 00879 TRA Q 00880 LDA MPCYFG 00881 SAM GOON1 00882 LDA TOFMFG 00883 SAN GOON1 SKIP TO MULTIPLE FROM COPY 00884 LDA PACKNO 00885 INA 1 INCREMENT PACKNO 00886ÐÐ LDQ PACLFT 00887 SQN STTYP SKIP IF NOT LAST PACK 00888 ADD =N$4000 SET BIT 14 FOR LAST PACK 00889STTYP STA- VLTYPE,I STORE NEW VOLUME TYPE WORD IN LABEL BUFFER 00890GOON1 LDA* COMP2 00891 ADD =XVLBUF1-WTCOMP 00892 STA* BAC SET ABSOLUTE ADDRESS OF VOL. LABEL BUFFER 00893 RTJ MMWRIT WRITE OUT VOLUME LABLE 00894BAC ADC 0 1. BUFFER ADDRESS 00895 ADC 96 2. NO. OF WORDS 00896LUC ADC 0 3. LOG UNIT 00897 ADC 0 4. INDEX OFFSET 00898MSBC ADC 0 5. MSB SECTOR ADDRESS 00899LSBC ADC 0 6. LSB SECTOR ADDRESS 00900* 00901 SQP SAVDT SKIP IF NO I/O ERROR 00902 JMP EREND GO NOTE I/O ERROR 00903 SPC 2 00904* STORE TODAYS DATE AS LAST SAVE DATE ON 00905* DISK COPIED TO 00906 SPC 1 00907SAVDT RTJ MMWRIT 00908ATEMP ADC ITEMP 1. BUFFER ADDRESS 00909 ADC 3 2. NO. OF WORDS 00910LU2A ADC 0 3. LOGIC UNIT 00911ÐÐ ADC 35 4. INDEX OFFSET 00912MSB2A ADC 0 5. MSB OF SECTOR ADDRESS 00913LSB2A ADC 0 6. LSB OF SECTOR ADDRESS 00914REALEN LDA MPCYFG 00915 SAM GOON5 00916 LDA TOFMFG 00917 SAN GOON5 SKIP IF MULTIPLE COPY FROM 00918* JMP* GOON6 THIS JMP MADE A COMMENT TO INSURE REQUEST 00919* FOR PACK DESIGNATE MODE. 00920GOON5 ENQ 12 00921 RTJ MESSAG ASK FOR DESIGNATION OF VOLUME TYPE 00922 RTJ INPUT2 GET ANSWER XXXX 00923 LDA INPBUF XXXX 00924 ALS 8 (USE ONLY FIRST CHAR. ENTERED) 00925 AND =N$0001 CONVERT TO 0 OR 1 XXXX 00926 TCA A FLIP BITS. 00927 AND- $3 0=M, 1=B 00928 STA ITEMP XXXX 00929 RTJ* VADDR 00930VADDR 0 0 00931 LDA* VADDR 00932 ADD =XITEMP-VADDR 00933 STA* AITEMP 00934 RTJ MMWRIT WRITE LABEL WITH UPDATED VOLUME TYPE XXXX 00935AITEMP ADC ITEMP 1. BUFFER ADDRESS 00936ÐÐ ADC 1 2. NO. OF WORDS XXXX 00937LU2B ADC 0 3. LOGIC UNIT XXXX 00938 ADC 38 4. INDEX OFFSET XXXX 00939MSB2B ADC 0 5. MSB OF SECTOR ADDRESS XXXX 00940LSB2B ADC 0 6. LSB OF SECTOR ADDRESS XXXX 00941GOON6 LDA SAVMB1 RESET START READ ADDRESS 00942 STA MSB 00943 LDA SAVLB1 00944 STA LSB 00945 LDA SAVMB2 RESET START WRITE ADDRESS 00946 STA MSB2 00947 LDA SAVLB2 00948 STA LSB2 00949 CLR A 00950 STA MSB3 CLEAR SECTOR COUNTER 00951 STA LSB3 00952 ENQ 1 00953 RTJ* MESSAG OUTPUT 'VOLUME SAVE COMPLETE'. 00954 SPC 2 00955FINI IIN 0 00956 JMP* FINI WAIT FOR AUTO LOAD 00957 SPC 2 00958EREND ENQ 2 GIVE ERROR MESSAGE 00959 RTJ MESSAG 00960 JMP* FINI 00961ÐÐ EJT 00962 EJT 00963* 00964* LOCAL VARIABLES 00965* 00966INDEX NUM 74 74 CLASS CODE IS NOT OF A DISK 00967ERBUF NUM 0 00968LU1 NUM 0 00969LU2 NUM 0 00970 SPC 1 121*4758 00971MESADD ADC MESS01-MSGRQT 0 - OUTPUT MESSAGE ADDRESS 00972 ADC MESS02-MSGRQT 1 00973 ADC MESS03-MSGRQT 2 00974* 137*A107 00975 ADC MESS04-MSGRQT 3 137*A107 00976 ADC MESS05-MSGRQT 4 00977 ADC MESS06-MSGRQT 5 00978 ADC MESS07-MSGRQT 6 00979 ADC MESS08-MSGRQT 7 00980 ADC MESS09-MSGRQT 8 00981 ADC MESS10-MSGRQT 9 00982 ADC MESS11-MSGRQT 10 00983 ADC MESS12-MSGRQT 11 00984 ADC MESS13-MSGRQT 12 00985 ADC MESS14-MSGRQT 13 00986ÐÐ ADC MESS15-MSGRQT 14 00987 ADC MESS16-MSGRQT 15 00988 ADC MESS17-MSGRQT 16 00989* 137*A107 00990 SPC 1 121*4758 00991MESLEN ADC MESLN1 0 - OUTPUT MESSAGE LENGTH 00992 ADC MESLN2 1 00993 ADC MESLN3 2 00994* 137*A107 00995 ADC MESLN4 137*A107 00996 ADC MESLN5 4 00997 ADC MESLN6 5 00998 ADC MESLN7 6 00999 ADC MESLN8 7 01000 ADC MESLN9 8 01001 ADC MESL10 9 01002 ADC MESL11 10 01003 ADC MESL12 11 01004 ADC MESL13 12 01005 ADC MESL14 13 01006 ADC MESL15 14 01007 ADC MESL16 15 01008 ADC MESL17 16 01009* 137*A107 01010 SPC 1 01011ÐÐINPBUF NUM 0 BUFFER FOR OPERATOR REPLY 01012 EJT 01013 SPC 5 01014* 01015* DOUBLE WORD MATH ERROR - FORCE PROTECT VIOLATION 01016* 01017 SPC 2 01018DWERR NOP 0 01019 STA- 1 01020 EJT 01021MESSAG NOP 0 01022 SPC 1 01023 LDA* MESADD,Q SET UP THE REQUIRED MESSAGE 01024 STA* MESAD 01025 LDA* MESLEN,Q AND THE LENGTH 01026 STA* MESLN 01027 SPC 1 01028 RTJ- ($F4) OUTPUT THE MESSAGE 01029MSGRQT ADC $0D44 01030 ADC MES010-MSGRQT 01031 ADC 0 01032 ADC $1004 01033MESLN ADC 0 01034MESAD ADC 0 01035 JMP- (DISP) 01036ÐÐ SPC 1 01037MES010 JMP* (MESSAG) RETURN 01038 SPC 2 01039ADD NOP 0 01040 SPC 1 01041 STQ* UPD 01042 LDQ- (I) Q = MSB OF SECTOR 01043 LDA- 1,I A = LSB OF SECTOR 01044 ADD* UPD INCREMENT 01045 SAP ADD010 01046 AND- LPMASK+15 MAINTAIN SECTOR FORMAT 01047 INQ 1 01048ADD010 STQ- (I) SPECIFY NEW SECTOR ADDRESS 01049 STA- 1,I 01050 SPC 1 01051 JMP* (ADD) RETURN 01052UPD NUM 0 UPDATE AMOUNT 01053 SPC 2 01054MESAGE NOP 0 01055 RTJ- ($F4) OUTPUT PROTECT SWITCH MESSAGE 01056 ADC $4C44 01057 ADC MSG10 01058 ADC 0 01059 ADC $1005 01060 ADC MESLN0 01061ÐÐ ADC MESS00 01062 JMP- (DISP) 01063 SPC 1 01064MSG10 JMP* (MESAGE) RETURN 01065 EJT 01066INPUT1 NOP 0 01067 SPC 1 01068 RTJ- ($F4) INPUT THE REPLY 01069 ADC $4844 01070 ADC 0 01071 ADC 0 01072 ADC TERMLU 01073 ADC 1 01074 ADC INPBUF 01075 SPC 1 01076 JMP* (INPUT1) RETURN 01077 SPC 2 01078INPUT2 NOP 0 01079 SPC 1 01080 RTJ- ($F4) INPUT THE REPLY 01081INPRQT ADC $0944 01082 ADC INP010-INPRQT 01083 ADC 0 01084 ADC $1004 01085 ADC 1 01086ÐÐ ADC INPBUF-INPRQT 01087 JMP- (DISP) 01088 SPC 1 01089INP010 JMP* (INPUT2) RETURN 01090* 137*A107 01091 EJT 137*A107 01092CMPERR TRQ A COMPARE ERROR NOTED 137*A107 01093 ENQ 0 137*A107 01094 DVI =N96 GET RELATIVE SECTOR INDEX 137*A107 01095 ADD LSB ADD SECTOR INDEX TO BASE SECTOR ADDR 137*A107 01096 LDQ MSB 137*A107 01097 SAP CMP10 137*A107 01098 AND- ONEMSK+14 137*A107 01099 INQ 1 137*A107 01100CMP10 STA* LSBSAV SAVE LSB TEMPORARILY 137*A107 01101 RTJ* CNVRT CONVERT DIGIT 5 137*A107 01102 STA* C5 SAVE IT 137*A107 01103 QRS 4 SHIFT TO DIGIT 6 137*A107 01104 RTJ* CNVRT CONVERT DIGIT 6 137*A107 01105 STA* C6 137*A107 01106 QRS 4 137*A107 01107 RTJ* CNVRT CONVERT DIGIT 7 137*A107 01108 STA* C7 137*A107 01109 QRS 4 137*A107 01110 RTJ* CNVRT CONVERT DIGIT 8 137*A107 01111ÐÐ STA* C8 137*A107 01112 LDQ* LSBSAV PICKUP SAVED LSB 137*A107 01113 RTJ* CNVRT CONVERT DIGIT 1 137*A107 01114 STA* C1 SAVE IT 137*A107 01115 QRS 4 137*A107 01116 RTJ* CNVRT DIGIT 2 137*A107 01117 STA* C2 137*A107 01118 QRS 4 137*A107 01119 RTJ* CNVRT DIGIT 3 137*A107 01120 STA* C3 137*A107 01121 QRS 4 137*A107 01122 RTJ* CNVRT DIGIT 4 137*A107 01123 STA* C4 137*A107 01124 EJT 137*A107 01125 ENQ $20 137*A107 01126 LDA* C8 BLANK OUT LEADING DIGITS 137*A107 01127 INA -$30 137*A107 01128 SAN CMP20 137*A107 01129 STQ* C8 137*A107 01130 LDA* C7 137*A107 01131 INA -$30 137*A107 01132 SAN CMP20 137*A107 01133 STQ* C7 137*A107 01134 LDA* C6 137*A107 01135 INA -$30 137*A107 01136ÐÐ SAN CMP20 137*A107 01137 STQ* C6 137*A107 01138 LDA* C5 137*A107 01139 INA -$30 137*A107 01140CMP20 SAN CMP30 137*A107 01141 STQ* C5 137*A107 01142 LDA* C4 137*A107 01143 INA -$30 137*A107 01144 SAN CMP30 137*A107 01145 STQ* C4 137*A107 01146 LDA* C3 137*A107 01147 INA -$30 137*A107 01148 SAN CMP30 137*A107 01149 STQ* C3 137*A107 01150 LDA* C2 137*A107 01151 INA -$30 137*A107 01152 SAN CMP30 137*A107 01153 STQ* C2 137*A107 01154 EJT 137*A107 01155* ASSEMBLE ASCII DIGITS FOR OUTPUT 137*A107 01156CMP30 LDA* C8 137*A107 01157 ALS 8 137*A107 01158 ADD* C7 137*A107 01159 STA* BADADR 137*A107 01160 LDA* C6 137*A107 01161ÐÐ ALS 8 137*A107 01162 ADD* C5 137*A107 01163 STA* BADADR+1 137*A107 01164 LDA* C4 137*A107 01165 ALS 8 137*A107 01166 ADD* C3 137*A107 01167 STA* BADADR+2 137*A107 01168 LDA* C2 137*A107 01169 ALS 8 137*A107 01170 ADD* C1 137*A107 01171 STA* BADADR+3 137*A107 01172* 137*A107 01173 ENQ 3 OUTPUT ERROR MESSAGE 137*A107 01174 RTJ MESSAG 137*A107 01175 JMP SAVDT GO PRINT OUT END MESSAGE 137*A107 01176 SPC 1 137*A107 01177LSBSAV NUM 0 137*A107 01178C8 NUM 0 137*A107 01179C7 NUM 0 137*A107 01180C6 NUM 0 137*A107 01181C5 NUM 0 137*A107 01182C4 NUM 0 137*A107 01183C3 NUM 0 137*A107 01184C2 NUM 0 137*A107 01185C1 NUM 0 137*A107 01186ÐÐDIGSAV NUM 0 137*A107 01187 SPC 1 137*A107 01188CNVRT 000 000 CNVRT LOW 4 BITS OF Q TO ASCII HEX DGT137*A107 01189 TRQ A 137*A107 01190 AND- ONEMSK+3 137*A107 01191 STA* DIGSAV 137*A107 01192 TCA A 137*A107 01193 INA 9 137*A107 01194 SAM CN10 137*A107 01195 LDA* DIGSAV DIGIT IN RANGE 0-9 137*A107 01196 INA $30 137*A107 01197 JMP* (CNVRT) 137*A107 01198* 137*A107 01199CN10 LDA* DIGSAV DIGIT IN RANGE A-F 137*A107 01200 INA $37 137*A107 01201 JMP* (CNVRT) 137*A107 01202 EJT 01203MESS00 ALF $,TURN OFF PROTEC SWITCH (ESC J20@):R$ 01204 ALF $,AND TYPE CARRIAGE RETURN$ 01205 EQU MESLN0(*-MESS00) 01206MESS01 ALF $,SET UP VOLUME(S) TO BE SAVED :R$ 01207 ALF $,AND VERIFY :R$ 01208 EQU MESLN1(*-MESS01) 01209 EJT 01210MESS02 NUM $1800 01211ÐÐ ALF $, VOLUME SAVE COMPLETE.$ 01212 EQU MESLN2(*-MESS02) 01213MESS03 ALF $,I/O ERROR NOTED.$ 01214 EQU MESLN3(*-MESS03) 01215* 137*A107 01216MESS04 ALF $,VERIFICATION FAILED AT SECTOR $ 137*A107 01217 BZS BADADR(4) 137*A107 01218 NUM $200D 137*A107 01219 EQU MESLN4(*-MESS04) 137*A107 01220* 01221MESS05 ALF $,VERIFICATION OF CORRECT SAVE VOLUMES $ 01222 EQU MESLN5(*-MESS05) 01223* 01224MESS06 NUM $0A0D 01225 ALF $, PACK VOLUME NAME LAST SAVE DATE$ 01226 ALF $, TYPE$ 01227 EQU MESLN6(*-MESS06) 01228* 137*A107 01229MESS07 ALF $, FROM $ 01230NAME1 BZS NAME1(4) NAME OF VOLUME 1 01231 ALF $, $ 01232DATE1 BZS DATE1(3) LAST SAVE DATE OF VOL 1 01233 ALF $, $ 01234V1TYP BZS V1TYP(3) TYPE OF VOLUME 1 01235 EQU MESLN7(*-MESS07) 01236ÐÐ* 01237MESS08 ALF $, TO $ 01238NAME2 BZS NAME2(4) NAME OF VOLUME 2 01239 ALF $, $ 01240DATE2 BZS DATE2(3) LAST SAVE DATE OF VOL 2 01241 ALF $, $ 01242V2TYP BZS V2TYP(3) TYPE OF VOLUME 2 01243 EQU MESLN8(*-MESS08) 01244* 01245MESS09 NUM $0A0D 01246 ALF $,WARNING - YOU ARE COPYING FROM A BACKUP TO A MASTER $ 01247 ALF $,VOLUME$ 01248 EQU MESLN9(*-MESS09) 01249* 01250MESS10 NUM $0A0D 01251 ALF $,WARNING - VOLUME NAMES DO NOT COINCIDE$ 01252 EQU MESL10(*-MESS10) 01253* 01254MESS11 NUM $0A0D 01255 ALF $,WARNING - DATE ON COPY TO VOLUME IS THE SAME AS OR$ 01256 ALF $, LATER THAN $ 01257 NUM $000D 01258 ALF $, DATE ON COPY FROM VOLUME$ 01259 EQU MESL11(*-MESS11) 01260* 01261ÐÐMESS12 NUM $0A0D 01262 ALF $,TYPE GO TO CONTINUE, EX TO EXIT$ 01263 EQU MESL12(*-MESS12) 01264* 01265MESS13 NUM $0A0D XXXX 01266 ALF $, DESIGNATE COPY 'TO' PACK AS: MASTER=1 BACKUP=0 ?$ 01267 EQU MESL13(*-MESS13) XXXX 01268MESS14 NUM $1800 01269 ALF $,NUMBER OF PACKS NEEDED FOR THIS COPY = $ 01270NWMP NUM $2020 01271 EQU MESL14(*-MESS14) 01272* 01273MESS15 ALF $,PACK NUMBER $ 01274PKNO NUM $2020 01275 ALF $,MOUNTED, SHOULD BE PACK NUMBER $ 01276SPKNO NUM $2020 01277 ALF $, VERIFY $ 01278 EQU MESL15(*-MESS15) 01279* 01280MESS16 ALF $, MULTIPLE COPY - MOUNT NEXT PACK NUMBER $ 01281PKM NUM $2020 01282 ALF $, VERIFY $ 01283 EQU MESL16(*-MESS16) 01284* 01285MESS17 ALF $, DRIVE/DISK ARE INCOMPATIBLE AS TO WORDS/SECTOR $ 01286ÐÐ ALF $, REMOUNT AND TRY AGAIN $ 01287 EQU MESL17(*-MESS17) 01288 EJT 01289* MASS MEMORY READ/WRITE ROUTINES 01290* 01291* CALL SEQUENCE IS: 01292* RTJ MMREAD/MMWRIT 01293* ADC ---- 1. BUFFER ADDRESS 01294* ADC ---- 2. NO. OF WORDS 01295* ADC ---- 3. LOGICAL UNIT 01296* ADC ---- 4. INDEX OFFSET FROM 1ST WORD 01297* ADC ---- 5. MSB SECTOR ADDERSS 01298* ADC ---- 6. LSB SECTOR ADDRESS 01299* 01300* NOTE THAT WORDS 2-6 ARE VALUES - NOT ADDRESSES OF WORDS CONTAIN- 01301* ING THE VALUES 01302 SPC 2 01303* M A S S M E M O R Y R E A D R O U T I N E 01304* 01305MMREAD 000 000 01306 LDQ* MMREAD 01307 LDA =N$420 SET A TO READ CODE PLUS D BIT 01308 JMP* REDWRT 01309 SPC 2 01310* M A S S M E M O R Y W R I T E R O U T I N E 01311ÐÐ* 01312MMWRIT 000 000 01313 LDQ* MMWRIT 01314 LDA =N$440 SET A TO WRITE CODE PLUS D BIT 01315 SPC 2 01316REDWRT EOR- $EF 01317 ALS 4 USE PRIORITY LEVEL FOR RP AND CP 01318 EOR- $EF 01319 STA* DICODE STORE IN I/O REQUEST 01320 STQ- I Q= ADDRESS OF FIRST PARAMETER 01321 INQ 6 01322 STQ* MMWRIT SETUP RETURN 01323* 01324 LDA- (ZERO),I 01325 STA* DIBADR SET STARTING ADDRESS 01326 LDA- 1,I 01327 STA* DINWDS SET NUMBER OF WORDS 01328 LDA- 2,I 01329 STA* DILOGU SET LOGICAL UNIT 01330* 01331 EJT 01332 LDA- 4,I COMPUTE MSB/LSB MASS MEMORY ADDRESS 01333 STA* MB 01334 LDA- 5,I SET UP FOR USE OF DWMUL 01335 STA* LB 01336ÐÐ RTJ* IMHERE GET ABSOLUTE ADDRESS OF DICOMP AND PARBUF 01337IMHERE 000 000 01338 LDA* IMHERE 01339 ADD =XDICOMP-IMHERE 01340 STA* DICADR STORE COMPLETION ADDRESS 01341 INA 1 01342 TRA Q ABS ADDRESS OF PARBUF TO Q 01343 RTJ DWMUL MULTIPLY SECTOR ADDRESS BY WORDS PER SECTOR 01344 LDQ* MBRSLT GET RESULT AND DO DOUBLE PRECISION ADD OF 01345 LDA* LBRSLT INDEX OFFSET 01346 ADD- 3,I 01347 SAP STORIT 01348 INQ 1 01349 AND- ONEMSK+14 01350STORIT STQ* DIOMSB STORE MSB/LSB RESULT 01351 STA* DIOLSB 01352* 01353 RTJ- ($F4) PLACE I/O REQUEST 01354DICODE NUM 0 1. I/O CODE, RP, CP 01355DICADR NUM 0 2. COMPLETION ADDRESS 01356 NUM 0 3. THREAD WORD 01357DILOGU NUM 0 4. LOGICAL UNIT NUMBER 01358DINWDS NUM 96 5. BUFFER LENGTH 01359DIBADR ADC DABUFR 6. BUFFER ADDRESS 01360DIOMSB NUM 0 7. MSB FOR I/O 01361ÐÐDIOLSB NUM 0 8. LSB FOR I/O 01362 JMP- (DISP) 01363* 01364DICOMP JMP* (MMWRIT) RETURN WITH COMPLETION STATUS IN Q-REG 01365 SPC 2 01366* PARAMETER LIST FOR DWMUL CALL - MUST FOLLOW 01367* DICOMP. 01368MB NUM 0 DWV - MSB 01369LB NUM 0 DWV - LSB 01370 NUM 96 NUMBER TO MULTIPLY BY - WORDS PER SECTOR 01371MBRSLT NUM 0 RESULT - MSB 01372LBRSLT NUM 0 01373 NUM 0 STATUS WORD 01374 EJT 01375* THIS PACKAGE PROVIDES SUBROUTINES TO PERFORM 01376* FOUR DOUBLE WORD ARITHMETIC OPERATIONS. 01377* THE DOUBLE WORD FORMAT IS THE SAME AS THE 01378* MSB/LSB FORMAT USED FOR SECTOR AND WORD 01379* ADDRESSING: WORD 1 OF A DOUBLE WORD VALUE 01380* CONTAINS THE UPPER 15 BITS OF THE VALUE - AN 01381* INTEGRAL MULTIPLE OF 32767, WORD 2 CONTAINS 01382* THE LOWER 15 BITS OF THE VALUE (BIT 15 = 0). 01383* IN THE FOLLOWING DESCRIPTIONS 'DWV' REFERS TO 01384* 'DOUBLE WORD VALUE'. 01385* 01386ÐÐ* THE FOLLOWING OPERATIONS ARE IMPLEMENTED: 01387* ADD A DWV TO A 2ND DWV 01388* SUBTRACT A DWV FROM ANOTHER DWV 01389* MULTIPLE A DWV BY A SINGLE WORD VALUE 01390* DIVIDE A DWV BY A SINGLE WORD VALUE 01391* 01392* TO UTILIZE ONE OF THESE ROUITNES, THE CALLER 01393* STORES THE VALUES TO BE OPERATED ON IN AN 01394* ARRAY, SETS THE Q-REGISTER TO THE ADDRESS OF 01395* THE ARRAY AND EXECUTES A RTJ TO THE APPROPRI- 01396* ATE ROUTINE. THE I REGISTER CONTENTS WILL BE 01397* SAVED AND RESTORED PRIOR TO RETURN TO THE 01398* CALLER. THE COMPLETION STATUS WILL BE 0 IF 01399* GOOD, ELSE IT WILL BE NON-ZERO. 01400 EJT 01401* THE ARRAY PARAMETER LISTS ARE AS FOLLOWS: 01402* FOR DWADD 01403* WORD DESCRIPTION 01404* 1 MSB OF 1ST DWV 01405* 2 LSB OF 1ST DMV 01406* 3 MSB OF 2ND DMV 01407* 4 LSB OF 2ND DMV 01408* 5 MSB OF RESULT DMV 01409* 6 LSB OF RESULT DMV 01410* 7 COMPLETION STATUS 01411ÐÐ* 01412* FOR DWSUB 01413* WORD DESCRIPTION 01414* 1 MSB OF MINUEND 01415* 2 LSB OF MINUEND 01416* 3 MSB OF SUBTRAHEND 01417* 4 LSB OF SUBTRAHEND 01418* 5 MSB OF RESULT 01419* 6 LSB OF RESULT 01420* 7 COMPLETION STATUS 01421* FOR DWMUL 01422* WORD DESCRIPTION 01423* 1 MSB OF DWV 01424* 2 LSB OF DMV 01425* 3 SINGLE WORD VALUE 01426* 4 MSB OF RESULT 01427* 5 LSB OF RESULT 01428* 6 COMPLETION STATUS 01429* 01430 EJT 01431DWADD 000 000 DOUBLE WORD ADD ROUTINE 01432A1 LDA- I SAVE I-REG CONTENTS 01433 STA* ISAVE 01434 STQ- I SET I TO ARRAY ADDRESS 01435 LDA- 1,I SET A TO LSB 01436ÐÐ ENQ 0 CLEAR Q FOR USE AS MSB OFFSET 01437 SOV 0 CLEAR OVERFLOW STATUS 01438 ADD- 3,I ADD LSB 01439 SNO A2 SKIP TO A3 IF NO OVERFLOW 01440 AND- ONEMSK+14 MASK OUT BIT 15 01441 INQ 1 BUMP Q TO PUT OVERFLOW IN MSB 01442A2 SAP A3 SKIP IF RESULT POSITIVE 01443 INQ -1 SUBTRACT 1 FROM Q FOR MSB OFFSET 01444 ADD- ONEBIT+15 MAKE LSW POSITIVE 01445A3 STA- 5,I STORE LSB 01446 TRQ A TRANSFER MSB OFFSET TO A 01447 SOV 0 CLEAR OVERFLOW 01448 ADD- (ZERO),I ADD THE TWO MSBS TO THE OFFSET 01449 ADD- 2,I 01450 STA- 4,I STORE MSB 01451 ENQ 0 CLEAR Q FOR COMPLETION STATUS 01452 SOV A4 SET TO BAD COMPLETION IF OVERFLOW OR A-REG NEG 01453 SAP A5 01454A4 ENQ 1 01455A5 STQ- 6,I 01456 LDA- 2,I COMPLEMENT 2ND DWV IF COMPLEMENTED BY US 01457 SAP A6 SKIP IF NOT COMPLEMENTED 01458 TCA A 01459 STA- 2,I 01460 LDA- 3,I 01461ÐÐ TCA A 01462 STA- 3,I 01463A6 LDA* ISAVE RESTORE I-REG 01464 STA- I 01465 JMP* (DWADD) 01466 SPC 4 01467ISAVE NUM 0 01468 EJT 01469DWSUB 000 0 DOUBLE WORD SUBTRACT ROUTINE 01470 LDA* DWSUB 01471 STA* DWADD STORE RETURN ADDRESS IN DWADD'S ENTRY POINT 01472 LDA- 2,Q COMPLEMENT SUBTRAHEND AND USE DWADD TO ADD 01473 TCA A 01474 STA- 2,Q 01475 LDA- 3,Q 01476 TCA A 01477 STA- 3,Q 01478 JMP* A1 01479 EJT 01480DWMUL 000 000 DOUBLE WORD MULTIPLY 01481 LDA- I 01482 STA* ISAVE SAVE I-REG 01483 STQ- I SET I TO ARRAY ADDRESS 01484 LDA- 1,I SET A TO LSB OF DOUBLE WORD VALUE 01485 MUI- 2,I MULTIPLY BY SINGLE WORD VALUE 01486ÐÐ LLS 1 01487 ALS 15 CONVERT TO DOUBLE PRECISION FORMAT 01488 STQ* SAVE SAVE MSB 01489 STA- 4,I STORE LSB IN RESULT 01490 LDA- (ZERO),I 01491 MUI- 2,I MULTIPLY MSB BY SINGLE WORD 01492 LLS 1 01493 ALS 15 DOUBLE PRECISION FORMAT 01494 SOV 0 CLEAR OVERFLOW 01495 INQ 0 CHECK FOR OVERFLOW 01496 SQZ 2 01497 LDQ- $11 SET OVERFLOW IND 01498 INQ 1 01499 LDQ* SAVE ADD MSB THAT WAS SAVED 01500 AAQ Q ADD IN RESULT FROM MSB MULTIPLY 01501 STQ- 3,I STORE IN RESULT 01502 CLR A 01503 SOV M0 SKIP IF OVERFLOW 01504 SQP M1 01505M0 INA 1 01506M1 STA- 5,I SET STATUS WORD, 0 IF GOOD, 1 IF BAD 01507 LDA* ISAVE RESTORE I-REG 01508 STA- I 01509 JMP* (DWMUL) RETURN TO CALLER 01510 SPC 2 01511ÐÐSAVE NUM 0 01512 EJT 01513 SPC 1 01514VLBUF1 BZS VLBUF1(96) VOLUME ONE LABEL BUFFER 01515VLBUF2 BZS VLBUF2(96) VOLUME TWO LABEL BUFFER 01516 SPC 1 01517DABUFR BZS DABUFR(96) DATA BUFFER 01518ITEMP BZS ITEMP(3) DATE BUFFER 01519 SPC 2 01520PGMEND EQU PGMEND(*) 01521 END 01522 NAM GTLOAD B28 A ITOS CCS 3.0 SL-149B2800001* START ROUTINE FOR COMMAND PROCESSOR LOAD B2800002* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B2800003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B2800004* COPYRIGHT CONTROL DATA CORPORATION 1979 B2800005* B2800006* B2800007* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B2800008* AN ENTRY POINT FOR THE COMMAND PROCESSOR LOAD B2800009* IN OREDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B2800010* B2800011* B2800012* B2800013 ENT MARKER B2800014ÐÐ ENT UTSTRT B2800015* B2800016 EXT PRELOD B2800017* B2800018MARKER NOP 0 B2800019 RTJ PRELOD B2800020 JMP* (MARKER) B2800021* B2800022 EQU UTSTRT(MARKER) B2800023* B2800024 END B2800025 NAM REDREC B29 A ITOS CCS 3.0 SL-149B2900001* READ ONE RECORD FROM SPECIFIED UNIT B2900002* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4863B2900003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B2900004* COPYRIGHT CONTROL DATA CORPORATION 1979 B2900005* B2900006* B2900007**** B2900008* B2900009* FUNCTION B2900010* B2900011* THIS ROUTINE READS ONE RECORD FROM THE SPECIFIED LU B2900012* INTO A SPECIFIED BUFFER B2900013* B2900014ÐÐ* B2900015* CALLING SEQUENCE B2900016* B2900017* CALL REDREC (LOGUNT,RECLEN,RECBUF,ISTAT) B2900018* B2900019* LOGUNT = LOGICAL UNIT NO TO READ FROM B2900020* RECLEN = RECORD LENGTH IN WORDS B2900021* RECBUF = BUFFER TO READ INTO B2900022* ISTAT = RETURN STATUS OF READ RECORD B2900023* B2900024* B2900025* ENTRY POINT B2900026* B2900027 ENT REDREC B2900028* B2900029* B2900030* EXTERNALS B2900031* B2900032 EXT Q8PKUP B2900033 EXT Q8PREP B2900034* B2900035 EQU DISP($EA) B2900036 EQU ZROBIT($33) B2900037 EQU ONEBIT($23) B2900038 EQU ZERO($22) B2900039ÐÐ* B2900040**** B2900041REDREC NOP B2900042 STQ* QSAVE SAV Q-REGISTER B2900043 LDA- I B2900044 STA* ISAVE SAVE I-REGISTER B2900045* B2900046 RTJ Q8PREP ABSOLUTIZE PARAMETER ADDR B2900047 ADC* REDREC B2900048HERE RTJ Q8PKUP PICK UP THE PARAMETERS B2900049 STA* LUNIT B2900050 RTJ* (HERE+1) B2900051 STA* RECLEN B2900052 RTJ* (HERE+1) B2900053 STA* RECBUF B2900054 RTJ* (HERE+1) B2900055 STA* ISTAT B2900056* B2900057 LDA* (LUNIT) SET UP THE READ PARAMETER LIST B2900058 AND- ZROBIT+12 B2900059 EOR- ONEBIT+12 SET BIT 12 FOR WORD MODE B2900060 STA* UNIT B2900061 LDA* (RECLEN) B2900062 STA* LNG B2900063* B2900064ÐÐ* PERFORM THE READ REQUEST B2900065* B2900066 RTJ- ($F4) B2900067 NUM $4800 FREAD B2900068 ADC COMPL B2900069 NUM 0 B2900070UNIT NUM 0 B2900071LNG NUM 0 B2900072RECBUF NUM 0 B2900073 JMP- (DISP) B2900074C B2900075COMPL SQM EOF B2900076 LDA* (RECBUF) CHECK FOR PSEUDO EOF (/*) B2900077 SUB* PSDEOF B2900078 SAZ EOF1 PSEUDO EOF FOUND B2900079 CLR A B2900080 STA* (ISTAT) B2900081* B2900082EXIT LDQ* QSAVE B2900083 LDA* ISAVE B2900084 STA- I B2900085 JMP* (REDREC) B2900086* B2900087* ERROR WAS DETECTED,TRADE LIKE AN EOF B2900088* B2900089ÐÐEOF STQ* (ISTAT) B2900090 JMP* EXIT B2900091* B2900092EOF1 ENQ -1 B2900093 JMP* EOF B2900094* B2900095* LOCAL VARIABLES B2900096* B2900097QSAVE NUM 0 B2900098ISAVE NUM 0 B2900099LUNIT NUM 0 B2900100RECLEN NUM 0 B2900101ISTAT NUM 0 B2900102PSDEOF NUM $2F21 /! 122*4863B2900103 END B2900104 NAM GTPURG B30 A ITOS CCS 3.0 SL-149B3000001* START ROUTINE FOR COMMAND PROCESSOR PURGE B3000002* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B3000003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B3000004* COPYRIGHT CONTROL DATA CORPORATION 1979 B3000005* B3000006* B3000007* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B3000008* AN ENTRY POINT FOR THE COMMAND PROCESSOR PURGE B3000009* IN OREDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B3000010ÐÐ* B3000011* B3000012* B3000013* LABELED COMMON AREA B3000014* B3000015 DAT COMCOD(89),PARNAM(83) 122*4875B3000016 DAT PPHELP(2) B3000017 DAT PPINIT(4) B3000018 DAT PPDEFI(16) B3000019 DAT PPSTAT(4) B3000020 DAT PPRELO(5) 122*4875B3000021 DAT PPDUMP(5) 122*4875B3000022 DAT PPCOPY(6) B3000023 DAT PPDELE(3) B3000024 DAT PPCLEA(3) B3000025 DAT PPLIST(6) 122*4875B3000026 DAT PPRENA(5) B3000027 DAT PPCOMM(2) B3000028 DAT PPEXIT(1) B3000029 DAT PPMOUN(3) B3000030 DAT PPDISM(2) B3000031 DAT PPSAVE(3) B3000032 DAT PPBATC(7) 122*4875B3000033 DAT PPLOAD(5) B3000034 DAT PPPURG(3) B3000035ÐÐ DAT PPINPU(2) B3000036 DAT PPOUTP(2) B3000037 DAT PPCOMP(3) B3000038 DAT DUMMY(6) B3000039 DAT INBUF(41),CODE(20) B3000040 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B3000041 DAT REQBUF(24),IDATA(24) B3000042 DAT PARDEF(24) B3000043 DAT FCBHDR(5) B3000044 DAT FCBBUF(96) B3000045 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B3000046 EQU COMLEN(ENDCOM-COMCOD) B3000047* B3000048 ENT MARKER B3000049 ENT UTSTRT B3000050* B3000051 EXT PURGE B3000052* B3000053MARKER NOP 0 B3000054 RTJ PURGE B3000055 JMP* (MARKER) B3000056* B3000057 EQU UTSTRT(MARKER) B3000058* B3000059 END B3000060ÐÐ NAM GETBAT B31 A ITOS CCS 3.0 SL-149B3100001* START ROUTINE FOR COMMAND PROCESSOR BATCH B3100002* CREDIT COLLECTION SYSTEM VERSION 3.0 B3100003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B3100004* COPYRIGHT CONTROL DATA CORPORATION 1979 B3100005* B3100006* LABELED COMMON AREA B3100007* B3100008 DAT COMCOD(133),PARNAM(121) B3100009 DAT PPHELP(2) B3100010 DAT PPINIT(4) B3100011 DAT PPDEFI(16) B3100012 DAT PPSTAT(4) B3100013 DAT PPRELO(4) B3100014 DAT PPDUMP(4) B3100015 DAT PPCOPY(6) B3100016 DAT PPDELE(3) B3100017 DAT PPCLEA(3) B3100018 DAT PPLIST(5) B3100019 DAT PPRENA(5) B3100020 DAT PPCOMM(2) B3100021 DAT PPEXIT(1) B3100022 DAT PPMOUN(3) B3100023 DAT PPDISM(2) B3100024 DAT PPSAVE(3) B3100025ÐÐ DAT PPBATC(5) B3100026 DAT PPLOAD(5) B3100027 DAT PPPURG(3) B3100028 DAT PPINPU(2) B3100029 DAT PPOUTP(2) B3100030 DAT PPCOMP(3) B3100031 DAT PPHOST(4) B3100032 DAT PPSET(3) B3100033 DAT PPBATS(4) B3100034 DAT PPDISC(2) B3100035 DAT PPDISP(7) B3100036 DAT PPFLUS(3) B3100037 DAT PPPRIN(3) B3100038 DAT DUMMY(6) B3100039 DAT INBUF(41),CODE(20) B3100040 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B3100041 DAT REQBUF(24),IDATA(24) B3100042 DAT PARDEF(24) B3100043 DAT FCBHDR(5) B3100044 DAT FCBBUF(96) B3100045 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B3100046 EQU COMLEN(ENDCOM-COMCOD) B3100047 ENT MARKER B3100048 ENT UTSTRT B3100049* B3100050ÐÐ EXT BATC B3100051MARKER NOP 0 B3100052 RTJ BATC B3100053 JMP* (MARKER) B3100054* B3100055 EQU UTSTRT(MARKER) B3100056* B3100057 END B3100058 NAM CNTCHR B32 A ITOS CCS 3.0 SL-149B3200001* COUNT NO. OF CHAR IN INPUT FIELD B3200002* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4873B3200003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B3200004* COPYRIGHT CONTROL DATA CORPORATION 1979 B3200005* B3200006**** 122*4873B3200007* 122*4873B3200008* FUNCTION 122*4873B3200009* 122*4873B3200010* B3200011* THIS PROGRAM COUNTS THE NUMBER OF CHARACTERS OF THE INPUT FIELD B3200012* B3200013* CALLING SEQUENCE B3200014* B3200015* CALL CNTCHR(BUF,CNT) B3200016* B3200017ÐÐ* BUF INPUT BUFFER B3200018* CNT CHAR. COUNT B3200019* B3200020 EQU LPMASK($2) B3200021 EQU BLANK($20) B3200022* B3200023 EXT Q8PREP B3200024 EXT Q8PKUP B3200025 ENT CNTCHR B3200026* B3200027**** 122*4873B3200028CNTCHR NOP 0 B3200029 STQ* QSAVE SAVE REGISTERS B3200030 LDA- I B3200031 STA* ISAVE B3200032* B3200033 RTJ Q8PREP GET PARAMETERS B3200034 ADC* CNTCHR B3200035* B3200036HERE RTJ Q8PKUP B3200037 STA* BUF B3200038 RTJ* (HERE+1) B3200039 STA* CNT B3200040* B3200041 CLR Q B3200042ÐÐ STQ* (CNT) B3200043* B3200044LOOP LDA* (BUF),Q GET NEXT WORD OF INPUT B3200045 ARS 8 TEST UPPER HALF B3200046 AND- LPMASK+8 B3200047 INA -BLANK B3200048 SAZ TSTLOW UPPER HALF IS A BLANK B3200049 RAO* (CNT) NOT A BLANK,INCR COUNTER B3200050* B3200051TSTLOW LDA* (BUF),Q TST LOWER HALF B3200052 AND- LPMASK+8 B3200053 INA -BLANK B3200054 SAZ TSTEND B3200055 RAO* (CNT) B3200056* B3200057TSTEND INQ -2 ALL DONE ? B3200058 SQZ END YES B3200059 INQ 3 NO B3200060 JMP* LOOP B3200061* B3200062END LDQ* QSAVE RESTORE REGISTERS B3200063 LDA* ISAVE B3200064 STA- I B3200065 JMP* (CNTCHR) B3200066* B3200067ÐÐ* LOCAL VARIABLES B3200068* B3200069QSAVE NUM 0 B3200070ISAVE NUM 0 B3200071BUF NUM 0 B3200072CNT NUM 0 B3200073* B3200074 END B3200075 NAM GTCOMP B33 A ITOS CCS 3.0 SL-149B3300001* START ROUTINE FOR COMMAND PROCESSOR COMPRESS B3300002* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B3300003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B3300004* COPYRIGHT CONTROL DATA CORPORATION 1979 B3300005* B3300006* B3300007* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B3300008* AN ENTRY POINT FOR THE COMMAND PROCESSOR COMPRES B3300009* IN OREDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B3300010* B3300011* B3300012* B3300013* LABELED COMMON AREA B3300014* B3300015 DAT COMCOD(89),PARNAM(83) 122*4875B3300016 DAT PPHELP(2) B3300017ÐÐ DAT PPINIT(4) B3300018 DAT PPDEFI(16) B3300019 DAT PPSTAT(4) B3300020 DAT PPRELO(5) 122*4875B3300021 DAT PPDUMP(5) 122*4875B3300022 DAT PPCOPY(6) B3300023 DAT PPDELE(3) B3300024 DAT PPCLEA(3) B3300025 DAT PPLIST(6) 122*4875B3300026 DAT PPRENA(5) B3300027 DAT PPCOMM(2) B3300028 DAT PPEXIT(1) B3300029 DAT PPMOUN(3) B3300030 DAT PPDISM(2) B3300031 DAT PPSAVE(3) B3300032 DAT PPBATC(7) 122*4875B3300033 DAT PPLOAD(5) B3300034 DAT PPPURG(3) B3300035 DAT PPINPU(2) B3300036 DAT PPOUTP(2) B3300037 DAT PPCOMP(3) B3300038 DAT DUMMY(6) B3300039 DAT INBUF(41),CODE(20) B3300040 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B3300041 DAT REQBUF(24),IDATA(24) B3300042ÐÐ DAT PARDEF(24) B3300043 DAT FCBHDR(5) B3300044 DAT FCBBUF(96) B3300045 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B3300046 EQU COMLEN(ENDCOM-COMCOD) B3300047* B3300048 ENT MARKER B3300049 ENT UTSTRT B3300050* B3300051 EXT COMPRES B3300052* B3300053MARKER NOP 0 B3300054 RTJ COMPRES B3300055 JMP* (MARKER) B3300056* B3300057 EQU UTSTRT(MARKER) B3300058* B3300059 END B3300060 NAM GTRELO B34 A ITOS CCS 3.0 SL-149B3400001* START ROUTINE FOR COMMAND PROCESSOR RELOAD B3400002* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B3400003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B3400004* COPYRIGHT CONTROL DATA CORPORATION 1979 B3400005* B3400006* B3400007ÐÐ* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B3400008* AN ENTRY POINT FOR THE COMMAND PROCESSOR RELOAD B3400009* IN ORDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B3400010* B3400011* B3400012* B3400013* LABELED COMMON AREA B3400014* B3400015 DAT COMCOD(89),PARNAM(83) 122*4875B3400016 DAT PPHELP(2) B3400017 DAT PPINIT(4) B3400018 DAT PPDEFI(16) B3400019 DAT PPSTAT(3) B3400020 DAT PPRELO(5) 122*4875B3400021 DAT PPDUMP(5) 122*4875B3400022 DAT PPCOPY(5) B3400023 DAT PPDELE(3) B3400024 DAT PPCLEA(3) B3400025 DAT PPLIST(6) 122*4875B3400026 DAT PPRENA(5) B3400027 DAT PPCOMM(2) B3400028 DAT PPEXIT(1) B3400029 DAT PPMOUN(3) B3400030 DAT PPDISM(2) B3400031 DAT PPSAVE(3) B3400032ÐÐ DAT PPBATC(7) 122*4875B3400033 DAT PPLOAD(5) B3400034 DAT PPPURG(3) B3400035 DAT PPINPU(2) B3400036 DAT PPOUTP(2) B3400037 DAT PPCOMP(3) B3400038 DAT DUMMY(6) B3400039 DAT INBUF(41),CODE(20) B3400040 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B3400041 DAT REQBUF(24),IDATA(24) B3400042 DAT PARDEF(24) B3400043 DAT FCBHDR(5) B3400044 DAT FCBBUF(96) B3400045 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B3400046 EQU COMLEN(ENDCOM-COMCOD) B3400047* B3400048 ENT MARKER B3400049 ENT UTSTRT B3400050* B3400051 EXT RELOAD B3400052* B3400053MARKER NOP 0 B3400054 RTJ RELOAD B3400055 JMP* (MARKER) B3400056* B3400057ÐÐ EQU UTSTRT(MARKER) B3400058* B3400059 END B3400060 NAM CHARMV B35 A ITOS CCS 3.0 SL-149B3500001* CHARACTER MOVE ROUTINE B3500002* CREDIT COLLECTION SYSTEM VERSION 3.0 B3500003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B3500004* COPYRIGHT CONTROL DATA CORPORATION 1979 B3500005* B3500006* CALLING SEQUENCE B3500007* CALL CHARMV (IBUFRM,IFRMX,IBUFTO,ITOX,INOZMV) B3500008* WHERE - IBUFRM = ARRAY FROM WHICH CHAR IS TO BE MOVED B3500009* IFRMX = CHAR INDEX INTO IBUFRM(0-N) B3500010* IBUFTO = ARRAY TO WHICH CHAR IS TO BE MOVED B3500011* ITOX = CHAR INDEX INTO BUFTO (0-N) B3500012* INOZMV = NO. OF CHARACTERS TO MOVE (1-P) B3500013 SPC 2 B3500014 ENT CHARMV B3500015 EXT Q8PREP,Q8PKUP B3500016 EQU ZERO($22) B3500017CHARMV 0 0 B3500018 STQ* QSAVE B3500019 RTJ Q8PREP B3500020 ADC (CHARMV-*) B3500021 RTJ Q8PKUP B3500022ÐÐ STA* AIBUFR =ADDR OF IBUFRM ARRAY B3500023 RTJ Q8PKUP B3500024 TRA Q B3500025 LDA- (ZERO),Q B3500026 STA* IFRMX B3500027 RTJ Q8PKUP B3500028 STA* AIBUFT =ADDR OF IBUFTO ARRAY B3500029 RTJ Q8PKUP B3500030 TRA Q B3500031 LDA- (ZERO),Q B3500032 STA* ITOX B3500033 RTJ Q8PKUP B3500034 TRA Q B3500035 LDQ- (ZERO),Q =NO OF CHAR TO MOVE B3500036 LR1* IFRMX B3500037 LR2* ITOX B3500038CHAR01 INQ -1 B3500039 SQP CHAR04 B3500040 JMP* JMPIT B3500041CHAR04 LDA* ESC CHECK FOR ESCAPE CODE ($1B) B3500042 CCE* (AIBUFR),1 B3500043 JMP* CHAR00 NO COMPARE, NOT ESCAPE CODE B3500044 LDA* TWENTY BLANK ESCAPE CODE AND FOLLOWING CONTROL CHARACB3500045 RTJ* STORIT B3500046 RTJ* STORIT B3500047ÐÐ INQ -1 B3500048 JMP* CHAR01 B3500049CHAR00 LCA* (AIBUFR),1 B3500050 SUB* SIXTY CHECK IF CHAR GREATER THAN $5F B3500051 SAM CHKAGN B3500052 LDA* TWENTY REPLACE ILLEGAL CHAR WITH A BLANK B3500053 RTJ* STORIT B3500054 JMP* CHAR01 B3500055JMPIT JMP* CHAR02 B3500056CHKAGN LCA* (AIBUFR),1 B3500057 STA* TEMP B3500058 LDA* NINTEN B3500059 SUB* TEMP CHECK IF CHAR LESS THAN $20 B3500060 SAM OK B3500061 LDA* TWENTY REPLACE ILLEGAL CHAR WITH A BLANK B3500062 RTJ* STORIT B3500063 JMP* CHAR01 B3500064OK LCA* (AIBUFR),1 LEGAL ASCII CHARACTER B3500065 RTJ* STORIT B3500066 JMP* CHAR01 B3500067STORIT NUM 0 B3500068 SCA* (AIBUFT),2 B3500069 AR1* ONE B3500070 AR2* ONE B3500071 JMP* (STORIT) B3500072ÐÐCHAR02 LDQ* QSAVE B3500073 JMP* (CHARMV) B3500074ONE NUM 1 B3500075QSAVE NUM 0 B3500076IFRMX NUM 0 B3500077ITOX NUM 0 B3500078AIBUFR NUM 0 B3500079AIBUFT NUM 0 B3500080NINTEN NUM $1F B3500081TWENTY NUM $20 B3500082SIXTY NUM $60 B3500083ESC NUM $1B B3500084TEMP NUM 0 B3500085 END B3500086 NAM BMPRRN B36 A ITOS CCS 3.0 SL-149B3600001* BUMP RELATIVE RECORD/BLOCK NUMBER B3600002* CREDIT COLLECTION SYSTEM VERSION 3.0 B3600003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B3600004* COPYRIGHT CONTROL DATA CORPORATION 1979 B3600005* B3600006**** B3600007* BMPRRN BUMPS RELATIVE RECORD NUMBER OR RELATIVE BLOCK B3600008* NUMBER BY 1. THE CALL SEQUENCE IS: B3600009* B3600010* CALL BMPRRN (RRN) B3600011ÐÐ* B3600012* WHERE RRN IS THE RELATIVE RECORD/BLOCK NUMBER TO BE B3600013* INCREMENTED. B3600014**** B3600015 SPC 2 B3600016 ENT BMPRRN ENTRY POINT B3600017 SPC 1 B3600018 EXT Q8PREP PREPARE TO PICKUP PARAMS B3600019 EXT Q8PKUP PICKUP PARAMS B3600020 SPC 2 B3600021BMPRRN NUM 0 ENTRY B3600022 STQ* QSAVE SAVE Q B3600023 RTJ Q8PREP PREPARE TO PICKUP PARAM B3600024 ADC* BMPRRN B3600025 RTJ Q8PKUP GET RRN ADDRESS B3600026 TRA Q B3600027 STA* RRNADR SAVE ADDRESS B3600028 LDA- 1,Q SET A TO LSB AND Q TO MSB B3600029 LDQ* (RRNADR) B3600030 SAP BMP10 SKIP IF LSB IS 0-$7FFF B3600031 INA 0 CHECK FOR $FFFF B3600032 SAN BMP10 SKIP IF OLD LSB .NE. $FFFF B3600033 INQ 1 BUMP MSB B3600034 JMP* BMP20 B3600035* B3600036ÐÐBMP10 INA 1 BUMP LSB WORD B3600037 SAN BMP20 SKIP IF OLD LSB .NE. $FFFE B3600038 SET A WAS $FFFE SO SET IT TO $FFFF B3600039BMP20 STQ* (RRNADR) STORE NEW MSB/LSB B3600040 RAO* RRNADR B3600041 STA* (RRNADR) B3600042 LDQ* QSAVE RESTORE Q B3600043 JMP* (BMPRRN) RETURN B3600044 SPC 2 B3600045QSAVE NUM 0 B3600046RRNADR NUM 0 B3600047 END B3600048 NAM GTBATS B37 A ITOS CCS 3.0 SL-149B3700001* START ROUTINE FOR COMMAND PROCESSOR BATS B3700002* CREDIT COLLECTION SYSTEM VERSION 3.0 B3700003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B3700004* COPYRIGHT CONTROL DATA CORPORATION 1979 B3700005* B3700006* LABELED COMMON AREA B3700007* B3700008 DAT COMCOD(133),PARNAM(121) B3700009 DAT PPHELP(2) B3700010 DAT PPINIT(4) B3700011 DAT PPDEFI(16) B3700012 DAT PPSTAT(4) B3700013ÐÐ DAT PPRELO(4) B3700014 DAT PPDUMP(4) B3700015 DAT PPCOPY(6) B3700016 DAT PPDELE(3) B3700017 DAT PPCLEA(3) B3700018 DAT PPLIST(5) B3700019 DAT PPRENA(5) B3700020 DAT PPCOMM(2) B3700021 DAT PPEXIT(1) B3700022 DAT PPMOUN(3) B3700023 DAT PPDISM(2) B3700024 DAT PPSAVE(3) B3700025 DAT PPBATC(5) B3700026 DAT PPLOAD(5) B3700027 DAT PPPURG(3) B3700028 DAT PPINPU(2) B3700029 DAT PPOUTP(2) B3700030 DAT PPCOMP(3) B3700031 DAT PPHOST(4) B3700032 DAT PPSET(3) B3700033 DAT PPBATS(4) B3700034 DAT PPDISC(2) B3700035 DAT PPDISP(7) B3700036 DAT PPFLUS(3) B3700037 DAT PPPRIN(3) B3700038ÐÐ DAT DUMMY(6) B3700039 DAT INBUF(41),CODE(20) B3700040 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B3700041 DAT REQBUF(24),IDATA(24) B3700042 DAT PARDEF(24) B3700043 DAT FCBHDR(5) B3700044 DAT FCBBUF(96) B3700045 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B3700046 EQU COMLEN(ENDCOM-COMCOD) B3700047 ENT MARKER B3700048 ENT UTSTRT B3700049* B3700050 EXT BATS B3700051MARKER NOP 0 B3700052 RTJ BATS B3700053 JMP* (MARKER) B3700054* B3700055 EQU UTSTRT(MARKER) B3700056* B3700057 END B3700058 NAM GTDISC B38 A ITOS CCS 3.0 SL-149B3800001* START ROUTINE FOR COMMAND PROCESSOR DISCARD B3800002* CREDIT COLLECTION SYSTEM VERSION 3.0 B3800003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B3800004* COPYRIGHT CONTROL DATA CORPORATION 1979 B3800005ÐÐ* B3800006* LABELED COMMON AREA B3800007* B3800008 DAT COMCOD(133),PARNAM(121) B3800009 DAT PPHELP(2) B3800010 DAT PPINIT(4) B3800011 DAT PPDEFI(16) B3800012 DAT PPSTAT(4) B3800013 DAT PPRELO(4) B3800014 DAT PPDUMP(4) B3800015 DAT PPCOPY(6) B3800016 DAT PPDELE(3) B3800017 DAT PPCLEA(3) B3800018 DAT PPLIST(5) B3800019 DAT PPRENA(5) B3800020 DAT PPCOMM(2) B3800021 DAT PPEXIT(1) B3800022 DAT PPMOUN(3) B3800023 DAT PPDISM(2) B3800024 DAT PPSAVE(3) B3800025 DAT PPBATC(5) B3800026 DAT PPLOAD(5) B3800027 DAT PPPURG(3) B3800028 DAT PPINPU(2) B3800029 DAT PPOUTP(2) B3800030ÐÐ DAT PPCOMP(3) B3800031 DAT PPHOST(4) B3800032 DAT PPSET(3) B3800033 DAT PPBATS(4) B3800034 DAT PPDISC(2) B3800035 DAT PPDISP(7) B3800036 DAT PPFLUS(3) B3800037 DAT PPPRIN(3) B3800038 DAT DUMMY(6) B3800039 DAT INBUF(41),CODE(20) B3800040 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B3800041 DAT REQBUF(24),IDATA(24) B3800042 DAT PARDEF(24) B3800043 DAT FCBHDR(5) B3800044 DAT FCBBUF(96) B3800045 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B3800046 EQU COMLEN(ENDCOM-COMCOD) B3800047 ENT MARKER B3800048 ENT UTSTRT B3800049* B3800050 EXT DISC B3800051MARKER NOP 0 B3800052 RTJ DISC B3800053 JMP* (MARKER) B3800054* B3800055ÐÐ EQU UTSTRT(MARKER) B3800056* B3800057 END B3800058 NAM GTDISP B39 A ITOS CCS 3.0 SL-149B3900001* START ROUTINE FOR COMMAND PROCESSOR DISPOSE B3900002* CREDIT COLLECTION SYSTEM VERSION 3.0 B3900003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B3900004* COPYRIGHT CONTROL DATA CORPORATION 1979 B3900005* B3900006* LABELED COMMON AREA B3900007* B3900008 DAT COMCOD(133),PARNAM(121) B3900009 DAT PPHELP(2) B3900010 DAT PPINIT(4) B3900011 DAT PPDEFI(16) B3900012 DAT PPSTAT(4) B3900013 DAT PPRELO(4) B3900014 DAT PPDUMP(4) B3900015 DAT PPCOPY(6) B3900016 DAT PPDELE(3) B3900017 DAT PPCLEA(3) B3900018 DAT PPLIST(5) B3900019 DAT PPRENA(5) B3900020 DAT PPCOMM(2) B3900021 DAT PPEXIT(1) B3900022ÐÐ DAT PPMOUN(3) B3900023 DAT PPDISM(2) B3900024 DAT PPSAVE(3) B3900025 DAT PPBATC(5) B3900026 DAT PPLOAD(5) B3900027 DAT PPPURG(3) B3900028 DAT PPINPU(2) B3900029 DAT PPOUTP(2) B3900030 DAT PPCOMP(3) B3900031 DAT PPHOST(4) B3900032 DAT PPSET(3) B3900033 DAT PPBATS(4) B3900034 DAT PPDISC(2) B3900035 DAT PPDISP(7) B3900036 DAT PPFLUS(3) B3900037 DAT PPPRIN(3) B3900038 DAT DUMMY(6) B3900039 DAT INBUF(41),CODE(20) B3900040 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B3900041 DAT REQBUF(24),IDATA(24) B3900042 DAT PARDEF(24) B3900043 DAT FCBHDR(5) B3900044 DAT FCBBUF(96) B3900045 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B3900046 EQU COMLEN(ENDCOM-COMCOD) B3900047ÐÐ ENT MARKER B3900048 ENT UTSTRT B3900049* B3900050 EXT DISPOS B3900051MARKER NOP 0 B3900052 RTJ DISPOS B3900053 JMP* (MARKER) B3900054* B3900055 EQU UTSTRT(MARKER) B3900056* B3900057 END B3900058 NAM GTFLUS B40 A ITOS CCS 3.0 SL-149B4000001* START ROUTINE FOR COMMAND PROCESSOR FLUSH B4000002* CREDIT COLLECTION SYSTEM VERSION 3.0 B4000003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B4000004* COPYRIGHT CONTROL DATA CORPORATION 1979 B4000005* B4000006* LABELED COMMON AREA B4000007* B4000008 DAT COMCOD(133),PARNAM(121) B4000009 DAT PPHELP(2) B4000010 DAT PPINIT(4) B4000011 DAT PPDEFI(16) B4000012 DAT PPSTAT(4) B4000013 DAT PPRELO(4) B4000014ÐÐ DAT PPDUMP(4) B4000015 DAT PPCOPY(6) B4000016 DAT PPDELE(3) B4000017 DAT PPCLEA(3) B4000018 DAT PPLIST(5) B4000019 DAT PPRENA(5) B4000020 DAT PPCOMM(2) B4000021 DAT PPEXIT(1) B4000022 DAT PPMOUN(3) B4000023 DAT PPDISM(2) B4000024 DAT PPSAVE(3) B4000025 DAT PPBATC(5) B4000026 DAT PPLOAD(5) B4000027 DAT PPPURG(3) B4000028 DAT PPINPU(2) B4000029 DAT PPOUTP(2) B4000030 DAT PPCOMP(3) B4000031 DAT PPHOST(4) B4000032 DAT PPSET(3) B4000033 DAT PPBATS(4) B4000034 DAT PPDISC(2) B4000035 DAT PPDISP(7) B4000036 DAT PPFLUS(3) B4000037 DAT PPPRIN(3) B4000038 DAT DUMMY(6) B4000039ÐÐ DAT INBUF(41),CODE(20) B4000040 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B4000041 DAT REQBUF(24),IDATA(24) B4000042 DAT PARDEF(24) B4000043 DAT FCBHDR(5) B4000044 DAT FCBBUF(96) B4000045 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B4000046 EQU COMLEN(ENDCOM-COMCOD) B4000047 ENT MARKER B4000048 ENT UTSTRT B4000049* B4000050 EXT FLUSH B4000051MARKER NOP 0 B4000052 RTJ FLUSH B4000053 JMP* (MARKER) B4000054* B4000055 EQU UTSTRT(MARKER) B4000056* B4000057 END B4000058 NAM GTHOST B41 A ITOS CCS 3.0 SL-149B4100001* START ROUTINE FOR COMMAND PROCESSOR HOST B4100002* CREDIT COLLECTION SYSTEM VERSION 3.0 B4100003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B4100004* COPYRIGHT CONTROL DATA CORPORATION 1979 B4100005* B4100006ÐÐ* LABELED COMMON AREA B4100007* B4100008 DAT COMCOD(133),PARNAM(121) B4100009 DAT PPHELP(2) B4100010 DAT PPINIT(4) B4100011 DAT PPDEFI(16) B4100012 DAT PPSTAT(4) B4100013 DAT PPRELO(4) B4100014 DAT PPDUMP(4) B4100015 DAT PPCOPY(6) B4100016 DAT PPDELE(3) B4100017 DAT PPCLEA(3) B4100018 DAT PPLIST(5) B4100019 DAT PPRENA(5) B4100020 DAT PPCOMM(2) B4100021 DAT PPEXIT(1) B4100022 DAT PPMOUN(3) B4100023 DAT PPDISM(2) B4100024 DAT PPSAVE(3) B4100025 DAT PPBATC(5) B4100026 DAT PPLOAD(5) B4100027 DAT PPPURG(3) B4100028 DAT PPINPU(2) B4100029 DAT PPOUTP(2) B4100030 DAT PPCOMP(3) B4100031ÐÐ DAT PPHOST(4) B4100032 DAT PPSET(3) B4100033 DAT PPBATS(4) B4100034 DAT PPDISC(2) B4100035 DAT PPDISP(7) B4100036 DAT PPFLUS(3) B4100037 DAT PPPRIN(3) B4100038 DAT DUMMY(6) B4100039 DAT INBUF(41),CODE(20) B4100040 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B4100041 DAT REQBUF(24),IDATA(24) B4100042 DAT PARDEF(24) B4100043 DAT FCBHDR(5) B4100044 DAT FCBBUF(96) B4100045 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B4100046 EQU COMLEN(ENDCOM-COMCOD) B4100047 ENT MARKER B4100048 ENT UTSTRT B4100049* B4100050 EXT HOST B4100051MARKER NOP 0 B4100052 RTJ HOST B4100053 JMP* (MARKER) B4100054* B4100055 EQU UTSTRT(MARKER) B4100056ÐÐ* B4100057 END B4100058 NAM GTPRIN B42 A ITOS CCS 3.0 SL-149B4200001* START ROUTINE FOR COMMAND PROCESSOR PRINT B4200002* CREDIT COLLECTION SYSTEM VERSION 3.0 B4200003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B4200004* COPYRIGHT CONTROL DATA CORPORATION 1979 B4200005* B4200006* LABELED COMMON AREA B4200007* B4200008 DAT COMCOD(133),PARNAM(121) B4200009 DAT PPHELP(2) B4200010 DAT PPINIT(4) B4200011 DAT PPDEFI(16) B4200012 DAT PPSTAT(4) B4200013 DAT PPRELO(4) B4200014 DAT PPDUMP(4) B4200015 DAT PPCOPY(6) B4200016 DAT PPDELE(3) B4200017 DAT PPCLEA(3) B4200018 DAT PPLIST(5) B4200019 DAT PPRENA(5) B4200020 DAT PPCOMM(2) B4200021 DAT PPEXIT(1) B4200022 DAT PPMOUN(3) B4200023ÐÐ DAT PPDISM(2) B4200024 DAT PPSAVE(3) B4200025 DAT PPBATC(5) B4200026 DAT PPLOAD(5) B4200027 DAT PPPURG(3) B4200028 DAT PPINPU(2) B4200029 DAT PPOUTP(2) B4200030 DAT PPCOMP(3) B4200031 DAT PPHOST(4) B4200032 DAT PPSET(3) B4200033 DAT PPBATS(4) B4200034 DAT PPDISC(2) B4200035 DAT PPDISP(7) B4200036 DAT PPFLUS(3) B4200037 DAT PPPRIN(3) B4200038 DAT DUMMY(6) B4200039 DAT INBUF(41),CODE(20) B4200040 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B4200041 DAT REQBUF(24),IDATA(24) B4200042 DAT PARDEF(24) B4200043 DAT FCBHDR(5) B4200044 DAT FCBBUF(96) B4200045 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B4200046 EQU COMLEN(ENDCOM-COMCOD) B4200047 ENT MARKER B4200048ÐÐ ENT UTSTRT B4200049* B4200050 EXT PRINT B4200051MARKER NOP 0 B4200052 RTJ PRINT B4200053 JMP* (MARKER) B4200054* B4200055 EQU UTSTRT(MARKER) B4200056* B4200057 END B4200058 NAM GTSET B43 A ITOS CCS 3.0 SL-149B4300001* START ROUTINE FOR COMMAND PROCESSOR SET B4300002* CREDIT COLLECTION SYSTEM VERSION 3.0 B4300003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B4300004* COPYRIGHT CONTROL DATA CORPORATION 1979 B4300005* B4300006* LABELED COMMON AREA B4300007* B4300008 DAT COMCOD(133),PARNAM(121) B4300009 DAT PPHELP(2) B4300010 DAT PPINIT(4) B4300011 DAT PPDEFI(16) B4300012 DAT PPSTAT(4) B4300013 DAT PPRELO(4) B4300014 DAT PPDUMP(4) B4300015ÐÐ DAT PPCOPY(6) B4300016 DAT PPDELE(3) B4300017 DAT PPCLEA(3) B4300018 DAT PPLIST(5) B4300019 DAT PPRENA(5) B4300020 DAT PPCOMM(2) B4300021 DAT PPEXIT(1) B4300022 DAT PPMOUN(3) B4300023 DAT PPDISM(2) B4300024 DAT PPSAVE(3) B4300025 DAT PPBATC(5) B4300026 DAT PPLOAD(5) B4300027 DAT PPPURG(3) B4300028 DAT PPINPU(2) B4300029 DAT PPOUTP(2) B4300030 DAT PPCOMP(3) B4300031 DAT PPHOST(4) B4300032 DAT PPSET(3) B4300033 DAT PPBATS(4) B4300034 DAT PPDISC(2) B4300035 DAT PPDISP(7) B4300036 DAT PPFLUS(3) B4300037 DAT PPPRIN(3) B4300038 DAT DUMMY(6) B4300039 DAT INBUF(41),CODE(20) B4300040ÐÐ DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B4300041 DAT REQBUF(24),IDATA(24) B4300042 DAT PARDEF(24) B4300043 DAT FCBHDR(5) B4300044 DAT FCBBUF(96) B4300045 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B4300046 EQU COMLEN(ENDCOM-COMCOD) B4300047 ENT MARKER B4300048 ENT UTSTRT B4300049* B4300050 EXT SET B4300051MARKER NOP 0 B4300052 RTJ SET B4300053 JMP* (MARKER) B4300054* B4300055 EQU UTSTRT(MARKER) B4300056* B4300057 END B4300058 NAM PRINZ B44 A ITOS CCS 3.0 SL-149B4400001* PRINT ROUTINE FOR PRINT UTILITY B4400002* CREDIT COLLECTION SYSTEM VERSION 3.0 B4400003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B4400004* COPYRIGHT CONTROL DATA CORPORATION 1979 B4400005 SPC 2 B4400006* THIS ROUTINE PRINTS A LINE OF DATA ON THE B4400007ÐÐ* SPECIFIED LOGICAL UNIT. NUMBER OF WORDS TO B4400008* PRINT ARE SPECIFIED IN FIRST WORD OF SPECIFIED B4400009* BUFFER. B4400010* IF CARRIAGE CONTROL IS INCLUDED IN DATA,A WRITE REQUEST B4400011* IS MADE. OTHERWISE,A FORMAT WRITE REQUEST IS MADE. B4400012* CALLING SEQUENCE- B4400013* CALL PRINZ(J,LINBUF,LOGUNT) B4400014* WHERE- J = INDEX INTO 'LINBUF' B4400015* LINBUF = ARRAY OF 73 WORD RECORDS B4400016* LOGUNT = LOGICAL UNIT OF PRINT DEVICE B4400017 SPC 2 B4400018 ENT PRINZ B4400019 SPC 1 B4400020 EXT Q8PREP,Q8PKUP B4400021 SPC 1 B4400022 EQU ZERO($22) B4400023 EQU MONI($F4) B4400024 EQU DISP($EA) B4400025 EQU HFF00($1A) B4400026 SPC 2 B4400027PRINZ 0 0 B4400028 STQ* QSAVE B4400029 RTJ Q8PREP B4400030 ADC (PRINZ-*) B4400031 RTJ Q8PKUP B4400032ÐÐ TRA Q B4400033 LDA- (ZERO),Q B4400034 STA* J B4400035 RTJ Q8PKUP B4400036 ADD* J B4400037 INA -1 ADJUST FOR INDEX STARTING AT 1 B4400038 TRA Q B4400039 LDA- (ZERO),Q =NO, OF WORDS TO PRINT B4400040 STA* N B4400041 INQ 1 B4400042 STQ* S B4400043 LDA* RCFW INITIALIZE FOR FORMAT WRITE B4400044 STA* RC B4400045 LDA- (ZERO),Q B4400046 AND- HFF00 B4400047 EOR =N$1B00 B4400048 SAN PRIN10 SENSE 1ST CHAR NOT ESCAPE CODE B4400049 LDA* RCW (ESCAPE CODE IMPLIES CARRIAGE CONTROL B4400050 STA* RC IN DATA) B4400051PRIN10 EQU PRIN10(*) B4400052 RTJ Q8PKUP B4400053 TRA Q B4400054 LDA- (ZERO),Q B4400055 ADD =N$1000 SET FOR LENGTH = WORD B4400056 STA* LU B4400057ÐÐ RTJ- (MONI) B4400058RC NUM $4C00 RC B4400059 ADC CA CA B4400060 NUM 0 THREAD B4400061LU NUM 0 B4400062N NUM 0 B4400063S NUM 0 B4400064 JMP- (DISP) B4400065CA LDQ* QSAVE B4400066 JMP* (PRINZ) B4400067QSAVE NUM 0 B4400068J NUM 0 B4400069RCW NUM $4400 B4400070RCFW NUM $4C00 B4400071 END B4400072 NAM MPWRXX B45 A ITOS CCS 3.0 SL-149B4500001* UTILITY READ/WRITE RECORD ROUTINE B4500002* CREDIT COLLECTION SYSTEM VERSION 3.0 B4500003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B4500004* COPYRIGHT CONTROL DATA CORPORATION 1979 B4500005* B4500006* B4500007* *****************************************'****** B4500008* * * B4500009* * ROUTINE FOR READ/WRITE RECORD(S) FOR * B4500010ÐÐ* * 'DUMP FILE' AND 'RELOAD' (FORMATTED) * B4500011* * (REQUEST) * B4500012* * * B4500013* ************************************************ B4500014* B4500015* B4500016* B4500017* B4500018***** ROUTINE FUNCTION : B4500019* B4500020* THIS ROUTINE IS USE FOR READ/WRITE (FORMATTED) B4500021* OPERATION (MAINLY FOR MAG. TAPE) FOR FILE DUMP B4500022* OR RELOAD. B4500023* B4500024* B4500025 SPC 2 B4500026* B4500027**** B4500028* B4500029**** THIS ROUTINE IS AN INTEGER FUNCTION --- B4500030* B4500031* CALLING SEQUENCES : B4500032* B4500033* (1) ASSEM : B4500034* B4500035ÐÐ* RTJ MPWRXX B4500036* ADC LU LOGICAL UNIT B4500037* ADC BUFFER BUFFER ADDRESS B4500038* ADC SIZE SIZE OF DATA B4500039* B4500040* A-REGISTER CONTAIN LOGICAL UNIT STAUTUS B4500041* B4500042* (2) FORTRAN : B4500043* B4500044* MSTATS = MPWRXX(LU,KBUF,KSIZE) B4500045* B4500046* B4500047* B4500048 SPC 2 B4500049* B4500050***** ***** E N T R Y P O I N T S B4500051* B4500052 SPC 1 B4500053 ENT MPWRIX WRITE ENTRY B4500054 ENT MPREDX READ ENTRY B4500055 SPC 2 B4500056* B4500057***** ***** E U Q I V A L E N C E S B4500058* B4500059 SPC 1 B4500060ÐÐ* MSOS EQUIVALENCES B4500061 SPC 1 B4500062ADISP EQU ADISP($EA) DISPATCHER B4500063CURLV EQU CURLV($EF) CURRENT PRIORITY LEVEL B4500064AMONI EQU AMONI($F4) MONITOR B4500065 SPC 1 B4500066* I/O REQUEST EQUIVALENCES B4500067 SPC 1 B4500068D EQU D(1) 'D' BIT B4500069X EQU X(0) 'X' BIT B4500070RP EQU RP(4) REQUEST PRIORITY B4500071NULL EQU NULL(0) NULL B4500072READCD EQU READCD(4) F-READ B4500073WRITCD EQU WRITCD(6) F-WRITE B4500074 SPC 1 B4500075* MSOS LOW CORE EQUIVALENCE B4500076 SPC 1 B4500077ZERO EQU ZERO(2) LOCATION CONTAINS ZERO B4500078 SPC 5 B4500079* B4500080***** ***** P R O G R A M S T A R T ***** B4500081* B4500082 SPC 3 B4500083MPWRIX NOP 0 WRITE REQUEST ENTRY B4500084 LDA* MPWRIX MOVE RETURN ADDRESS B4500085ÐÐ STA* MPREDX B4500086 ENA WRITCD SET TO WRITE REQUEST B4500087 JMP* COMPRO TO COMMON PROCESSING SEQUENCE B4500088 SPC 2 B4500089* READ ENTRY B4500090 SPC 1 B4500091MPREDX NOP 0 READ ENTRY B4500092 ENA READCD SET FOR READ CODE B4500093* B4500094COMPRO ALS 9 ASSEMBLE I/O REQUEST CODE B4500095 ADD- CURLV + CURRENT PRIORITY LEVEL B4500096 ADD* CALBAS + CALL CODE BASE B4500097 STA* CALPAR SAVE CALL CODE B4500098 STQ* QSAVE SAVE Q-REGISTER B4500099 LDA- I I B4500100 STA* ISAVE B4500101 SPC 1 B4500102* GET PARAMETERS FOR I/O REQUEST B4500103 SPC 1 B4500104 LDQ* (MPREDX) GET LOGICAL B4500105 LDA- (ZERO),Q B4500106 STA* LU B4500107 RAO* MPREDX BUMP TO NEXT ONE B4500108 LDQ* (MPREDX) GET SIZE B4500109 STQ* BUF B4500110ÐÐ RAO* MPREDX BUMP TO NEXT ONE B4500111 LDQ* (MPREDX) GET BUFFER ADDRESS B4500112 LDA- (ZERO),Q GET SIZE B4500113 STA* SIZE B4500114 SPC 2 B4500115* I/O REQUEST VIA MONITOR B4500116 SPC 1 B4500117 RTJ- (AMONI) B4500118CALPAR NUM 0 0. CALL CODE (FILLED) B4500119 ADC RETURN 1. COMPLETION ADDRESS B4500120 NUM 0 2. THREAD B4500121LU NUM 0 3. LOGICAL UNIT B4500122SIZE NUM 0 4. SIZE (FILLED) B4500123BUF NUM 0 5. BUFFER ADDRESS (FILLED) B4500124 JMP- (ADISP) B4500125 SPC 1 B4500126* B4500127CALBAS VFD X2/D,X5/NULL,X1/X,X4/RP,X4/NULL B4500128 SPC 1 B4500129* RETURN FROM I/O B4500130 SPC 1 B4500131RETURN TRQ A STATUS TO A B4500132 LDQ* ISAVE RESTORE I-REGISTER B4500133 STQ- I B4500134 LDQ* QSAVE Q B4500135ÐÐ RAO* MPREDX BUMP TO EXIT B4500136 JMP* (MPREDX) RETURN TO SENDER B4500137* B4500138ISAVE NUM 0 I-SAVE B4500139QSAVE NUM 0 Q-SAVE B4500140 END B4500141 NAM OBFIMK B46 A ITOS CCS 3.0 SL-149B4600001* UTILITY E-O-F CODE PICKUP ROUTINE B4600002* CREDIT COLLECTION SYSTEM VERSION 3.0 B4600003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B4600004* COPYRIGHT CONTROL DATA CORPORATION 1979 B4600005* B4600006* *********'*******************************'**** B4600007* * * B4600008* * GET EOF OR DELETE CODE FROM SYSTEM * B4600009* * * B4600010* *****************************************'**** B4600011* B4600012* B4600013 SPC 1 B4600014* B4600015***** ROUTINE FUNCTION : B4600016* B4600017* THIS ROUTINE IS USED TO OBTAIN EOF AND DELETE CODES B4600018* FROM SYSTEM. B4600019ÐÐ* B4600020* B4600021 SPC 1 B4600022* B4600023* B4600024***** CALLING SEQUENCES : B4600025* B4600026* (1) ASSEM : B4600027* B4600028* RTJ OBFIMK B4600029* ADC BUF BUFFER FOR DATA B4600030* B4600031* (2) FORTRAN : B4600032* B4600033* CALL OBFIMK(KBUF) B4600034* B4600035* B4600036 SPC 2 B4600037* B4600038***** ***** E N T R Y P O I N T B4600039* B4600040 SPC 1 B4600041 ENT OBFIMK ENTRY POINT B4600042 SPC 2 B4600043* B4600044ÐÐ***** ***** E X T E R N A L S B4600045* B4600046 SPC 1 B4600047 EXT FMEOFC EOF CODE B4600048 EXT FMRDEL DELETE CODE B4600049 SPC 1 B4600050* B4600051***** ***** E Q U I V A L E N C E B4600052* B4600053 SPC 1 B4600054ZERO EQU ZERO(2) ZERO B4600055 SPC 4 B4600056* B4600057***** ***** P R O G R A M S T A R T ***** B4600058* B4600059 SPC 2 B4600060OBFIMK NOP 0 ENTRY B4600061 STQ* QSAVE SAVE Q-REGISTER B4600062 LDQ* (OBFIMK) GET SAVE DATA BUFFER ADDRESS B4600063 LDA* EXT1 GET EOF CODE AND SAVE B4600064 STA- (ZERO),Q B4600065 LDA* EXT2 GET DELETE CODE AND SAVE B4600066 STA- 1,Q B4600067* B4600068 LDQ* QSAVE RESTORE Q B4600069ÐÐ RAO* OBFIMK BUMP TO EXIT B4600070 JMP* (OBFIMK) RETURN TO CALLER B4600071* B4600072QSAVE NUM 0 Q B4600073EXT1 ADC FMEOFC EOF B4600074EXT2 ADC FMRDEL DELETE B4600075 END B4600076 NAM OBL000 B47 A ITOS CCS 3.0 SL-149B4700001* UTILITY I/O BUFFER SIZING ROUTINE B4700002* CREDIT COLLECTION SYSTEM VERSION 3.0 B4700003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B4700004* COPYRIGHT CONTROL DATA CORPORATION 1979 B4700005* B4700006* *****************************************'*********** B4700007* * * B4700008* * ROUTINE TO GET ITOS MAG. TAPE BUFFER SIZE * B4700009* * * B4700010* *****************************************'*********** B4700011* B4700012* B4700013* B4700014**** ROUTINE FUNCTION : B4700015* B4700016* THIS ROUTINE IS USED TO GET THE ITOS EXECTUE MAG. B4700017* TAPE BUFFER SIZE FROM 'SYSDAT' FOR BLOCKING. B4700018ÐÐ* B4700019* B4700020 SPC 1 B4700021* B4700022* B4700023* THIS ROUTINE IS AN INTEGER FUNCTION AND THE CALL B4700024* SEQUENCES ARE : B4700025* B4700026* (1) ASSEM : B4700027* B4700028* RTJ OBL000 B4700029* ADC DUMY DUMMY PARAMETER B4700030* B4700031* A-REGISTER CONTAINS BUFFER SIZE IN RETURN B4700032* B4700033* B4700034* (2) FORTRAM : B4700035* B4700036* INTEGER OBL000 B4700037* B4700038* MAGSIZ = OBL000( 0) B4700039* B4700040* B4700041* B4700042 SPC 2 B4700043ÐÐ* B4700044****** ***** E X T E R N A L B4700045* B4700046 SPC 1 B4700047 EXT L000 LOCATION CONTAINS ITOS MAG. TAPE BUFFER SIZE B4700048 SPC 2 B4700049* B4700050****** ***** E N T R Y P O I N T B4700051* B4700052 SPC 1 B4700053 ENT OBL000 ENTRY POINT B4700054 SPC 4 B4700055* B4700056****** ***** P R O G R A M S T A R T ***** B4700057* B4700058 SPC 2 B4700059OBL000 NOP 0 ENTRY B4700060 RAO* OBL000 BUMP TO EXIT LOCATION B4700061 LDA* L00EXT GET BUFFER SIZE B4700062 JMP* (OBL000) EXIT B4700063* B4700064L00EXT ADC L000 ITOS MAG. TAPE BUFFER SIZE ADDRESS B4700065 END B4700066 NAM RWBUWM B48 A ITOS CCS 3.0 SL-149B4800001* UTILITY MOTION CONTROL ROUTINE B4800002ÐÐ* CREDIT COLLECTION SYSTEM VERSION 3.0 B4800003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B4800004* COPYRIGHT CONTROL DATA CORPORATION 1979 B4800005* B4800006* B4800007* *****************************************'********** B4800008* * * B4800009* * ROUTINE TO PERFORM MOTION CONTROL OPTION * B4800010* * * B4800011* **************************************************** B4800012* B4800013* B4800014* B4800015 SPC 1 B4800016* B4800017***** ROUTINE FUNCTION : B4800018* B4800019* ROUTINE TO PERFORM MOTION CONTROL FUNCTIONS, THEY B4800020* ARE : (1) 1 = BACKSPACE, 2 = WRITE EOF, 3 = REWIND, B4800021* 4 = REWIND AND UNLOAD, 5 = SKIP FILE FORWARD, B4800022* 6 = SKIP BACKWARD 1 FILE, 7 = ADVANCE 1 RECORD, B4800023* B4800024* B4800025* B4800026***** CALLING SEQUENCES : B4800027ÐÐ* B4800028* B4800029* (1) ASSEM : B4800030* B4800031* RTJ RWBUWM B4800032* ADC LU LOGICAL UNIT B4800033* ADC TYPE REQUEST TYPE B4800034* B4800035* B4800036* B4800037 SPC 2 B4800038* B4800039***** ***** E N T R Y P O I N T B4800040* B4800041 SPC 1 B4800042 ENT RWBUWM ENTRY NAME B4800043 SPC 2 B4800044* B4800045***** ***** E Q U I V A L E N C E S B4800046* B4800047 SPC 1 B4800048 SPC 1 B4800049* MSOS EQUIVALENCES B4800050 SPC 1 B4800051ADISP EQU ADISP($EA) DISPATCHER B4800052ÐÐAMONI EQU AMONI($F4) MONITOR B4800053CURLV EQU CURLV($EF) CURRENT PRIORITY LEVEL B4800054 SPC 1 B4800055* I/O REQUEST EQUIVALENCES B4800056 SPC 1 B4800057D EQU D(1) 'D' BIT B4800058X EQU X(0) 'X' BIT B4800059RP EQU RP(4) REQUEST PRIORITY B4800060NULL EQU NULL(0) NULL B4800061MOTCOD EQU MOTCOD(14) MOTION REQUEST CODE B4800062 SPC 1 B4800063* MSOS LOW CORE EQUIVALENCE B4800064 SPC 1 B4800065ZERO EQU ZERO(2) LOCATION CONTAINS ZERO B4800066 SPC 5 B4800067* B4800068***** ***** P R O G R A M S T A R T ***** B4800069* B4800070 SPC 2 B4800071RWBUWM NOP 0 ENTRY B4800072 STQ* QSAVE SAVE Q-REGISTER B4800073 LDQ- I B4800074 STQ* ISAVE I B4800075* B4800076 LDQ* (RWBUWM) GET LOGICAL UNIT B4800077ÐÐ LDA- (ZERO),Q B4800078 STA* LU B4800079 RAO* RWBUWM BUMP TO NEXT PARAMETER B4800080 LDQ* (RWBUWM) B4800081 LDA- (ZERO),Q GET TYPE CODE B4800082 ALS 12 AND POSITION TO HIGH 4-BITS B4800083 STA* MOTCON B4800084 RAO* RWBUWM BUMP RETURN ADDRESS FOR CORRECT RTN 132*5336B4800085 SPC 1 B4800086* B4800087 LDA- CURLV ASSEMBLE CURRENT PRIORITY LEVEL WITH CALL B4800088 ADD* CALCOD B4800089 STA* CALPAR B4800090 SPC 1 B4800091* B4800092 RTJ- (AMONI) B4800093CALPAR NUM 0 0. CALL CODE (FILLED) B4800094 ADC RETURN 1. RETURN ADDRESS B4800095 NUM 0 2. THREAD B4800096LU NUM 0 3. LOGICAL UNIT (FILLED) B4800097MOTCON NUM 0 4. CONTROL MOTION CODE (FILLED) B4800098 JMP- (ADISP) B4800099 SPC 1 B4800100* B4800101CALCOD VFD X2/D,X5/MOTCOD,X1/X,X4/RP,X4/NULL B4800102ÐÐ* B4800103 SPC 1 B4800104* I/O REQUEST RETURN B4800105 SPC 1 B4800106RETURN TRQ A STATUS TO A-REGISTER B4800107 LDQ* ISAVE RESTORE I-REGISTER B4800108 STQ- I B4800109 LDQ* QSAVE Q B4800110* B4800111 JMP* (RWBUWM) RETURN TO CALLER B4800112* B4800113QSAVE NUM 0 Q B4800114ISAVE NUM 0 I B4800115 END B4800116 NAM UTEFCK B49 A ITOS CCS 3.0 SL-149B4900001* UTILITY EOF MASK PICKUP ROUTINE B4900002* CREDIT COLLECTION SYSTEM VERSION 3.0 B4900003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B4900004* COPYRIGHT CONTROL DATA CORPORATION 1979 B4900005* B4900006* B4900007* ************************************************* B4900008* * * B4900009* * ROUTINE TO GET EOF MASK FORM 'PHYTAB' * B4900010* * * B4900011ÐÐ* *****************************************'******* B4900012* B4900013* B4900014* B4900015 SPC 2 B4900016* B4900017* B4900018******* ROUTINE FUNCTION : B4900019* B4900020* THIS ROUTINE IS USED TO GET EOF MASK CODE FROM B4900021* THE DEVICE PHYSCIAL TABLE B4900022* B4900023* B4900024* B4900025 SPC 1 B4900026* B4900027* B4900028***** CALLING SEQUENCES : B4900029* B4900030* (1) ASSEM : B4900031* B4900032* RTJ UTEFCK B4900033* ADC LU LOGICAL UNIT B4900034* A-REGISTER = EOF (NON-ZERO) OR NOT (ZERO) B4900035* B4900036ÐÐ* (2) FORTRAN : B4900037* B4900038* (2) FORTRAN : B4900039* B4900040* MEOFMK = UTEFCK(LU) B4900041* B4900042* B4900043 SPC 2 B4900044* B4900045***** ***** E N T R Y P O I N T B4900046* B4900047 SPC 1 B4900048 ENT UTEFCK ENTRY POINT B4900049 SPC 2 B4900050* B4900051***** ***** E X T E R N A L B4900052* B4900053 SPC 1 B4900054 EXT LOG1A LOG 1A TABLE ENTRY B4900055 SPC 2 B4900056* B4900057***** ***** E Q U I V A L E N C E S B4900058* B4900059 SPC 1 B4900060ZERO EQU ZERO(2) ZERO B4900061ÐÐLPMSK EQU LPMSK(2) BIT MASK B4900062 SPC 1 B4900063* B4900064ESTAT2 EQU ESTAT2(12) STATUS WORD 12 OF 'PHYTAB' B4900065 SPC 3 B4900066* B4900067***** ***** P R O G R A M S T A R T ***** B4900068* B4900069 SPC 1 B4900070UTEFCK NOP 0 ENTRY B4900071 STQ* QSAVE SAVE Q-REGISTER B4900072 LDQ* (UTEFCK) GET LOGICAL UNIT B4900073 LDA- (ZERO),Q GET AND ISOLATE LOGICAL UNIT , THEN TO Q B4900074 AND- LPMSK+8 B4900075 TRA Q B4900076 LDQ LOG1A,Q B4900077 LDA- ESTAT2,Q B4900078 LDQ* QSAVE RESTORE Q-REGISTER B4900079 RAO* UTEFCK BUMP TO EXIT B4900080 JMP* (UTEFCK) RETURN TO CALLER B4900081* B4900082QSAVE NUM 0 Q B4900083 END B4900084 NAM AS2 B50 A ITOS CCS 3.0 SL-149B5000001* UTILITY CHARACTER ASSEMBLY ROUTINE B5000002ÐÐ* CREDIT COLLECTION SYSTEM VERSION 3.0 B5000003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B5000004* COPYRIGHT CONTROL DATA CORPORATION 1979 B5000005* B5000006* ************************************************ B5000007* * * B5000008* * ROUTINE TO ASSEMBLE 1 CHAR/WORD INTO * B5000009* * 2 CHAR/WORD * B5000010* * * B5000011* ************************************************ B5000012* B5000013* B5000014****** CALLING SEQUENCE : B5000015* B5000016* RTJ AS2 B5000017* ADC SOURCE 4 WORDS OF 1 CHAR./WORD B5000018* ADC TARGET 2 WORDS OF 2 CHAR./WORD B5000019* B5000020* B5000021****** ROUTINE FUNCTION : B5000022* B5000023* THIS ROUTINE IS USED TO ASSEMBLE 4-WORD OF 1 CHAR./ B5000024* WORD (RIGHT JUSTIFIED AND NULL FILL HIGH BYTE) INTO B5000025* 2-WORD OF 2 CHAR./WORD. B5000026* B5000027ÐÐ* B5000028* B5000029 SPC 3 B5000030* B5000031****** *** E N T R Y N A M E B5000032* B5000033 SPC 1 B5000034 ENT AS2 ENTRY NAME B5000035 SPC 2 B5000036* B5000037****** *** E Q U I V A L E N C E B5000038* B5000039ZERO EQU ZERO(2) CONSTANT ZERO B5000040 SPC 5 B5000041* B5000042****** ***** P R O G R A M S T A R T ***** B5000043* B5000044 SPC 2 B5000045AS2 NOP 0 ENTRY B5000046 STQ* QSAVE SAVE Q B5000047 LDA- I I B5000048 STA* ISAVE B5000049* B5000050 LDA* (AS2) GET SOURCE DATA ARRAY ADDRESS B5000051 STA- I B5000052ÐÐ RAO* AS2 BUMP TO NEXT PARAMETER B5000053 LDQ* (AS2) GET TARGET DATA ARRAY ADDRESS B5000054* B5000055 LDA- (ZERO),I ASSEMBLE FIRST 2 CHARACTERS B5000056 ALS 8 (FIRST TO HIGH BYTE) B5000057 ADD- 1,I (ADD LOW BYTE) B5000058 STA- (ZERO),Q SAVE B5000059 LDA- 2,I ASSEMBLE SECOND AND LAST 2 CHARACTERS B5000060 ALS 8 B5000061 ADD- 3,I B5000062 STA- 1,Q B5000063* B5000064 RAO* AS2 SET EXIT B5000065 LDQ* QSAVE RESTORE Q AND I B5000066 LDA* ISAVE B5000067 STA- I B5000068 JMP* (AS2) RETURN B5000069 SPC 1 B5000070ISAVE NUM 0 B5000071QSAVE NUM 0 B5000072 END B5000073 NAM CHO2LR B51 A ITOS CCS 3.0 SL-149B5100001* UTILITY CHARACTER ASSEMBLY ROUTINE B5100002* CREDIT COLLECTION SYSTEM VERSION 3.0 B5100003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B5100004ÐÐ* COPYRIGHT CONTROL DATA CORPORATION 1979 B5100005* B5100006* *****************************************'****** B5100007* * * B5100008* * ROUTINE TO ASSEMBLE 1 CHAR/WORD INTO * B5100009* * 2 CHAR/WORD, EITHER LEFT OR RIGHT * B5100010* * JUSTIFIED * B5100011* * * B5100012* ************************************************ B5100013* B5100014* B5100015****** CALLING SEQUENCE : B5100016* B5100017* RTJ CH02LR B5100018* ADC SOURCE SOURCE DATA ARRAY (1 CHAR/WORD) B5100019* ADC TARGET TARGET DATA ARRAY B5100020* ADC SIZELR SIZE AND LEFT/RIGHT B5100021* B5100022* B5100023* CALL CH02LR(SOURCE,TARGET,SIZELR) (FORTRAN CALLB5100024* B5100025* B5100026****** ROUTINE FUNCTION B5100027* B5100028* THIS ROUTINE IS USED TO ASSEMBLE 1 CHAR/WORD DATA B5100029ÐÐ* INTO 2 CHAR/WORD DATA EITHER LEFT/RIGHT (0/1) B5100030* JUSTIFIED OF THE 2 CHAR/WORD B5100031* B5100032* B5100033* B5100034 SPC 3 B5100035* B5100036****** *** E N T R Y N A M E B5100037* B5100038 SPC 1 B5100039 ENT CHO2LR ENTRY NAME B5100040 SPC 2 B5100041* B5100042****** *** E Q U I V A L E N C E B5100043* B5100044 SPC 1 B5100045LPMSK EQU LPMSK(2) BIT MASK B5100046ONE EQU ONE(3) CONSTANT ONE B5100047ZERO EQU ZERO(2) CONSTANT ZERO B5100048 SPC 4 B5100049* B5100050****** ***** P R O G R A M S T A R T ***** B5100051* B5100052 SPC 2 B5100053CHO2LR NOP 0 ENTRY B5100054ÐÐ STQ* QSAVE SAVE Q-REGISTER B5100055 LDA- I I B5100056 STA* ISAVE B5100057* B5100058 LDA* (CHO2LR) GET SOURCE DATA BUFFER ADDRESS B5100059 STA- I B5100060 RAO* CHO2LR BUMP TO NEXT PARAMETER B5100061 SPC 1 B5100062 LDA* (CHO2LR) GET TARGET BUFFER ADDRESS B5100063 STA* TARGET B5100064 RAO* CHO2LR BUMP TO THIRD PARAMETER B5100065* B5100066 LDQ* (CHO2LR) GET SIZE/LEFT-RIGHT INDICATOR PARA. ADD. B5100067 LDA- (ZERO),Q FETCH SIZE AND SAVE B5100068 STA* NOCHAR B5100069 LDA- 1,Q OBTAIN LEFT/RIGHT INDICATOR (0/1) B5100070 STA* HILO B5100071 SPC 1 B5100072*** GET CHARACTER AND ASSEMBLE B5100073 SPC 1 B5100074GETCHA LDA- (ZERO),I GET CHARACTER FROM SOURCE B5100075 AND- LPMSK+8 B5100076 LDQ* HILO FETCH HI/LO INSERTION FLAG AND POSITION CHAR. B5100077 SQN CHAPOS B5100078 ALS 8 B5100079ÐÐCHAPOS STA* TEMP B5100080 LDA* (TARGET) GET TARGET WORD AND SAVE THE PROPER BYTE B5100081 AND* BYTMSK,Q B5100082 ADD* TEMP INSERT CURRENT BYTE AND SAVE B5100083 STA* (TARGET) B5100084 SPC 2 B5100085* B5100086*---- UPDATE POINTERS B5100087* B5100088 SPC 1 B5100089 LDA* NOCHAR DECREMENT SIZE BY 1 AND CHECK IF DONE B5100090 INA -1 B5100091 SAN UPTR SKIP, NO DONE B5100092 LDA* ISAVE RESTORE I AND Q-REGISTERS PRIOR TO RETURN B5100093 STA- I B5100094 LDQ* QSAVE B5100095 RAO* CHO2LR SET EXIT ADDRESS AND B5100096 JMP* (CHO2LR) RETURN B5100097* B5100098UPTR STA* NOCHAR SAVE REMAINDER SIZE B5100099 LDA* HILO UPDATE HI/LOW POINTER B5100100 INA 1 B5100101 AND- ONE B5100102 STA* HILO B5100103 SAN NOBUMP B5100104ÐÐ RAO* TARGET BUMP TARGET ADD. BY 1 IF 2 CHAR. INSERTED B5100105NOBUMP RAO- I INCREMENT SOURCE B5100106 JMP* GETCHA B5100107 SPC 2 B5100108*** STORAGES B5100109 SPC 1 B5100110TEMP NUM 0 B5100111QSAVE NUM 0 B5100112ISAVE NUM 0 B5100113NOCHAR NUM 0 SIZE B5100114HILO NUM 0 HI/LO BYTE B5100115TARGET NUM 0 TARGET BUFFER ADD. B5100116BYTMSK NUM $00FF,$FF00 MASK B5100117 END B5100118 NAM CNVRT B52 A ITOS CCS 3.0 SL-149B5200001* UTILITY DECIMAL ASCII TO HEXIDECIMAL ROUTINE B5200002* CREDIT COLLECTION SYSTEM VERSION 3.0 B5200003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B5200004* COPYRIGHT CONTROL DATA CORPORATION 1979 B5200005* B5200006* **************************************************** B5200007* * * B5200008* * ROUTINE TO CONVERT 8 BYTES ASCII NUMERIC * B5200009* * (DECIMAL) INTO A TWO WORDS BINARY VALUE * B5200010* * * B5200011ÐÐ* **************************************************** B5200012* B5200013* B5200014****** CALLING SEQUENCE : B5200015* B5200016* RTJ CNVRT B5200017* ADC ASCII 4-WORD ASCII DATA TO BE CONVERTED B5200018* ADC BINVA 2-WORD BINARY VALUE B5200019* B5200020* B5200021* CALL CNVRT(ASCII,BINVA) (FORTRAN CALL SEQUENCE, B5200022* INTEGER PARAMETERS) B5200023* B5200024* B5200025****** ROUTINE FUNCTION : B5200026* B5200027* THE 8 ASCII CHARACTERS ARE CHECKED TO ENSURE THEY B5200028* ARE DECIMAL DIGITALS. THEN VALUE IS CONVERTED BY B5200029* THIS METHOD : B5200030* VALUE = 10 X (LAST VALUE) + (CURRENT VALUE) B5200031* THE ABOVE EQUATION IS REPEATED 8 TIMES FOR ALL 8 B5200032* ASCII CHARACTER WITH 'VALUE' INITIALIZED TO ZERO B5200033* AT ENTRY. B5200034* B5200035* THE 2-WORD BINARY VALUE IS THE STANDARD MSB + LSB B5200036ÐÐ* TYPE 2-WORD FORMAT AND IS UNSIGNED B5200037* B5200038* B5200039* B5200040****** SUBROUTINES USED : B5200041* B5200042* DWADD = DOUBLE-WORD ADDITION B5200043* DWMUL = DOUBLE-WORD MULTIPLY B5200044* SYSMSG = SYSTEM ERROR MESSAGE B5200045* B5200046* B5200047****** EXIT CONDITION : B5200048* B5200049* A-REGISTER CONTAIN ZERO FOR NO ERROR AND 2-WORD B5200050* VALUE IN CALLER BUFFER B5200051* A-REGISTER CONTAINS A CONSTATNT 1 FOR ERROR AND B5200052* ERROR MESSAGE IS PRINTED. 2-WORD VALUE BUFFER B5200053* UNALTERED. B5200054* B5200055* B5200056* B5200057 SPC 3 B5200058* B5200059****** *** E N T R Y N A M E B5200060* B5200061ÐÐ SPC 1 B5200062 ENT CNVRT ENTRY NAME B5200063 SPC 2 B5200064* B5200065****** *** E X T E R N A L S B5200066* B5200067 SPC 1 B5200068 EXT DWADD DOUBLE-WORD ADDITION B5200069 EXT DWMUL DOUBLE-WORD MULTIPLY B5200070 EXT SYSMSG SYSTEM MESSAGE PROCESSOR B5200071 SPC 2 B5200072* B5200073****** *** E Q U I V A L E N C E S B5200074* B5200075 SPC 1 B5200076LPMSK EQU LPMSK(2) BIT MASK B5200077ZERO EQU ZERO(2) CONSTANT ZERO B5200078 SPC 5 B5200079* B5200080****** ***** P R O G R A M S T A R T ***** B5200081* B5200082 SPC 2 B5200083CNVRT NOP 0 ENTRY B5200084 STQ* QSAVE SAVE Q-REGISTER B5200085 LDA- I I B5200086ÐÐ STA* ISAVE B5200087* B5200088 LDA* (CNVRT) GET ASCII INPUT DATA BUFFER ADDRESS B5200089 STA- I B5200090 RAO* CNVRT BUMP TO NEXT PARAMETER B5200091 LDA* (CNVRT) GET DOUBLE WORD VALUE PARAMETER ADDRESS B5200092 STA* BINAD B5200093 RAO* CNVRT SET TO EXIT B5200094 SPC 2 B5200095* INITIALIZE B5200096 SPC 1 B5200097 ENQ STKSZ-1 B5200098 CLR A CLEAR LOCAL ARRAY B5200099CLEAR STA* ADDSTK,Q B5200100 INQ -1 B5200101 SQM SEPCHA B5200102 JMP* CLEAR B5200103 SPC 1 B5200104* EXTRACT AND CHECK ASCII B5200105 SPC 1 B5200106SEPCHA LDQ* INDEX SET GET INPUT ASCII WORD INDEX B5200107 LDA- (ZERO),B AND OBTAIN INPUT WORD B5200108 STA* TEMP B5200109 LDQ* COUNT GET STORE CHARACTER INDEX TO Q B5200110 AND- LPMSK+8 EXTRACT LOWER BYTE AND SAVE B5200111ÐÐ STA* ONECHA+1,Q B5200112 LDA* TEMP SHIFT HIGH BYTE TO LOW AND ISOLATE THEN SAVE B5200113 ALS 8 B5200114 AND- LPMSK+8 B5200115 STA* ONECHA,Q B5200116 INQ 2 UPDATE STORAGE COUNT BY 2 B5200117 STQ* COUNT B5200118 LDQ* INDEX UPDATE INPUT WORD COUNT BY 1 AND CHECK IF B5200119 INQ 1 ALL 4 WORDS BE SEPARATED B5200120 STQ* INDEX B5200121 INQ -4 B5200122 SQZ DONSEP SKIP, ALL DONE B5200123 JMP* SEPCHA NO, GO REPEAT B5200124 SPC 2 B5200125* B5200126***** CONVERT AND ASSEMBLE VALUE (2-WORD VALUE) B5200127* B5200128 SPC 2 B5200129DONSEP STQ* COUNT INITIALIZE B5200130 STQ* NOZOIN B5200131 SPC 1 B5200132* CALCULATE VALUE = 10 * LAST VALUE B5200133 SPC 1 B5200134SKPCHK LDA* NOZOIN CHECK IF NON-ZERO INTEGER ENCOUNTERED B5200135 SAZ GETA SKIP, NO CALCULATION FOR NO VALUE YET B5200136ÐÐ ENA 10 SET MULTIPLY BY 10 B5200137 STA* MULSTK+2 B5200138 LDQ =XMULSTK SET ADD. TO MULTIPLY LAST VALUE BY 10 B5200139 RTJ DWMUL B5200140* B5200141 LDA* MULSTK+5 CHECK IF ERROR ENCOUNTERED B5200142 SAZ MVMLRE SKIP, NO ERROR B5200143 JMP* ERGO GO TO ERROR B5200144 SPC 1 B5200145* MOVE MULTIPLY RESULT TO ADD STACK B5200146 SPC 1 B5200147MVMLRE LDA* MULSTK+3 MOVE MULTIPLY RESULT TO SECOND ADD VALUE B5200148 STA* ADDSTK+2 B5200149 LDA* MULSTK+4 B5200150 STA* ADDSTK+3 B5200151 SPC 1 B5200152* EXTRACT INPUT CHARACTER B5200153GETA LDQ* COUNT GET CURRENT CHARACTER INDEX AND FETCH B5200154 LDA* ONECHA,Q CHARACTER AND CHECK TO ENSURE IT IS B5200155 INA -$30 BETWEEN 0 - 9 B5200156 SAN KARCHK B5200157 LDQ* NOZOIN CHAR. IS ZERO, IF LEADING ZERO, SKIP B5200158 SQZ UPPTR B5200159KARCHK INA -10 B5200160 SAP ERGO B5200161ÐÐ INA 10 B5200162KAROK STA* ADDSTK+1 B5200163 RAO* NOZOIN B5200164 SPC 1 B5200165* CALCULATE = CURRENT VALUE + LAST VALUE (ADJUSTED) B5200166 SPC 1 B5200167 LDQ =XADDSTK SET ADD STACK ADDRESS AND TO ADD B5200168 RTJ DWADD B5200169 LDA* ADDSTK+6 CHECK IF ERROR ENCOUNTERED DURING ADD B5200170 SAZ UPPTR SKIP OK B5200171ERGO JMP* PTER TO PRINT ERROR B5200172 SPC 2 B5200173* B5200174*** CHECK IF DONE B5200175* B5200176 SPC 1 B5200177UPPTR RAO* COUNT BUMP COUNT BY 1 AND CHECK IF DONE B5200178 LDA* COUNT B5200179 INA -8 B5200180 SAZ DONCAL SKIP, DONE B5200181 JMP* SKPCHK GO TO PROCESS NEXT CHARACTER B5200182* B5200183*----- DONE, MOVE DATA TO CALLER BUFFER FROM ADD STACK B5200184* B5200185DONCAL LDA* ADDSTK+4 MOVE MSB B5200186ÐÐ STA* (BINAD) B5200187 LDA* ADDSTK+5 LSB B5200188 RAO* BINAD B5200189 STA* (BINAD) B5200190 ENA 0 CLEAR NO ERROR B5200191RESREG LDQ* ISAVE RESTORE I-REGISTER B5200192 STQ- I B5200193 LDQ* QSAVE Q B5200194 JMP* (CNVRT) RETURN TO SENDER B5200195 SPC 4 B5200196* B5200197*******************************************************'********** B5200198* B5200199* STORAGES B5200200* B5200201ADDSTK NUM 0,0 1. FIRST 2-WORD FOR ADD B5200202 NUM 0,0 2. SECOND B5200203MULSTK NUM 0,0 3. RESULT 2-WORD FOR ADD (FIRST 2 FOR MUL) B5200204 NUM 0 4. STATUS FOR ADD (VALUE FOR MULTIPLY) B5200205 NUM 0,0 5. RESULT 2-WORD (FOR MULTIPLY) B5200206 NUM 0 6. STATUS FOR MULTIPLY B5200207ONECHA BZS ONECHA(8) B5200208COUNT NUM 0 B5200209TEMP NUM 0 B5200210INDEX NUM 0 B5200211ÐÐNOZOIN EQU NOZOIN(INDEX) B5200212STKSZ EQU STKSZ(*-ADDSTK) SIZE OF STORAGE LOCATIONS B5200213ISAVE NUM 0 I-SAVE B5200214QSAVE NUM 0 Q-SAVE B5200215BINAD NUM 0 2-WORD RESULT VALUE ADD. (FILLED) B5200216 SPC 3 B5200217* B5200218*******************************************************'******** B5200219* B5200220* ERROR ERROR ERROR B5200221* B5200222 SPC 1 B5200223PTER RTJ SYSMSG CALL SYSTEM MESSAGE ROUTINE B5200224 ADC ER307 B5200225 ADC TEMP B5200226 ENA 1 SET ERROR EXIT B5200227 JMP* RESREG B5200228ER307 NUM 307 ERROR MESSAGE INDEX B5200229 END B5200230 NAM FRHX B53 A ITOS CCS 3.0 SL-149B5300001* UTILITY HEXIDECIMAL CONVERSION ROUTINE B5300002* CREDIT COLLECTION SYSTEM VERSION 3.0 B5300003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B5300004* COPYRIGHT CONTROL DATA CORPORATION 1979 B5300005* B5300006ÐÐ* *********'*******************************'***** B5300007* * * B5300008* * ROUTINE TO CONVERT A VALUE INTO HEX * B5300009* * * B5300010* *****************************************'***** B5300011* B5300012* B5300013****** CALLING SEQUENCES : B5300014* B5300015* RTJ FRHX B5300016* ADC DATBUF 5-WORD ARRAY, WORD 1 FOR VALUE B5300017* THE LAST 4 WORDS ARE FOR HEX. VALUE B5300018* (BITS 15-08-NULL, BITS 07-00-HEX) B5300019* B5300020* CALL FRHX(LVALUE) (FORTRAN SEQUENCE) B5300021* B5300022* B5300023****** FOUTINE FUNCTION : B5300024* B5300025* THE VALUE IS CONVERTED INTO 4 ASCII CHARACTERS, B5300026* RIGHT JUSTIFIED AND NULL FILLES BITS 15-08. B5300027* B5300028* B5300029* B5300030 SPC 3 B5300031ÐÐ* B5300032****** *** E N T R Y N A M E B5300033* B5300034 SPC 1 B5300035 ENT FRHX ROUTINE ENTRY NAME B5300036 SPC 2 B5300037* B5300038****** *** E Q U I V A L E N C E S B5300039* B5300040 SPC 1 B5300041LPMSK EQU LPMSK(2) BIT MASK B5300042ZERO EQU ZERO(2) CONSTANT ZERO B5300043 SPC 4 B5300044* B5300045****** ***** P R O G R A M S T A R T ***** B5300046* B5300047 SPC 2 B5300048FRHX NOP 0 ENTRY B5300049 STQ* QSAVE SAVE Q-REGISTER B5300050 LDA- I B5300051 STA* ISAVE SAVE I-REGISTER B5300052* B5300053 LDA* (FRHX) GET PARAMETER ADDRESS AND SAVE IN I-REG. B5300054 STA- I B5300055 LDA- (ZERO),I GET VALUE AND SAVE B5300056ÐÐ STA* TEMP B5300057 SPC 2 B5300058* EXTRACT VALUE B5300059 SPC 1 B5300060 CLR A CLEAR CHARACTER COUNT B5300061 STA* INDEX B5300062GETVAL LDA* TEMP GET VALUE AND EXTRACT 4 BIT B5300063 CLR Q B5300064 LLS 4 B5300065 STA* TEMP SAVE REMAINDER B5300066 TRQ A 4-BIT VALUE IN BOTH A AND Q B5300067 SPC 2 B5300068* ASSEMBLE VALUE EITHER NUMERIC OR ALPHABETIC CHARACTER B5300069 SPC 1 B5300070 INA $30 SET FOR NUMERIC B5300071 INQ -10 B5300072 SQM SAVCHA B5300073 INA 7 BUMP TO ALPHABETIC CHARACTER B5300074 SPC 2 B5300075* GET INDEX, STORE, INCREMENT COUNT AND CHECK IF DONE B5300076 SPC 1 B5300077SAVCHA LDQ* INDEX GET STORAGE INDEX AND SAVE CHARACTER B5300078 STA- 1,B B5300079 INQ 1 INCREMENT INDEX BY 1 AND CHECK IF DONE B5300080 STQ* INDEX B5300081ÐÐ INQ -4 B5300082 SQZ TOREST SKIP, ON DONE B5300083 JMP* GETVAL NOT DONE, TO REPEAT B5300084 SPC 2 B5300085* RESTORE REGISTERS AND EXIT B5300086 SPC 1 B5300087TOREST RAO* FRHX SET EXIT ADDRESS B5300088 LDA* ISAVE RESTORE I-REGISTER B5300089 STA- I B5300090 LDQ* QSAVE B5300091 JMP* (FRHX) RETURN TO SENDER B5300092 SPC 2 B5300093* STORAGES B5300094 SPC 1 B5300095ISAVE NUM 0 I-REGISTER SAVE LOCATION B5300096QSAVE NUM 0 Q B5300097TEMP NUM 0 VALUE TEMPORARY STORAGE B5300098INDEX NUM 0 NUMBER OF CHARACTER COUNT B5300099 END B5300100 NAM GENEOF B54 A ITOS CCS 3.0 SL-149B5400001* UTILITY FILE MARK GENERATION ROUTINE B5400002* CREDIT COLLECTION SYSTEM VERSION 3.0 B5400003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B5400004* COPYRIGHT CONTROL DATA CORPORATION 1979 B5400005* B5400006ÐÐ* ************************************* B5400007* * * B5400008* * ROUTINE TO WRITE EOF MARK * B5400009* * * B5400010* ************************************* B5400011* B5400012* B5400013******* ROUTINE FUNCTION : B5400014* B5400015* THIS ROUTINE IS USED TO WRITE END OF FILE MARK TO B5400016* THE LOGICAL UNIT SUPPLIED BY THE CALLER. B5400017* B5400018* B5400019******* CALLING SEQUENCE : B5400020* B5400021* RTJ GENEOF B5400022* ADC LOGUNT LOGICAL UNIT B5400023* B5400024* B5400025* B5400026 SPC 2 B5400027* B5400028******* E N T R Y N A M E B5400029* B5400030 SPC 1 B5400031ÐÐ ENT GENEOF ENTRY NAME B5400032 SPC 2 B5400033* B5400034******* E Q U I V A L E N C E S B5400035* B5400036 SPC 1 B5400037ADISP EQU ADISP($EA) DISPATCHER B5400038AMONI EQU AMONI($F4) MONITOR B5400039CURLV EQU CURLV($EF) CURRENT PRIORITY LEVEL B5400040* B5400041D EQU D(1) 'D' BIT IN REQUEST B5400042MOTCD EQU MOTCD(14) MOTION REQUEST CODE B5400043NULL EQU NULL(0) NULL FIELD B5400044RP EQU RP(4) REQUEST PRIORITY B5400045EOF EQU EOF(2) EOF MARK WITHIN MOTION REQUEST B5400046 SPC 1 B5400047* LOW CORE EQUIVALENCE B5400048 SPC 1 B5400049ZERO EQU ZERO(2) CONSTANT ZERO B5400050 SPC 5 B5400051* B5400052****** ***** P R O G R A M S T A R T ***** B5400053* B5400054 SPC 2 B5400055GENEOF NOP 0 ENTRY B5400056ÐÐ STQ* QSAVE SAVE Q-REGISTER B5400057 LDA- I I B5400058 STA* ISAVE B5400059 LDQ* (GENEOF) GET LOGICAL UNIT B5400060 LDA- (ZERO),Q B5400061 STA* LU B5400062 RAO* GENEOF SET TO EXIT B5400063 SPC 2 B5400064* B5400065* ASSEMBLE CURRENT PRIORITY WITH CALL CODE AND B5400066* WRITE END OF FILE B5400067* B5400068 SPC 1 B5400069 LDA- CURLV ASSEMBLE CURRENT PRIORITY LEVEL WITH CALL B5400070 ADD* CALCOD CODE B5400071 STA* CALPAR B5400072* B5400073 RTJ- (AMONI) B5400074CALPAR NUM 0 0. CALL CODE (FILLED) B5400075 ADC DONEOF 1. COMPLETION ADDRESS B5400076 NUM 0 2. THREAD B5400077LU NUM 0 3. LOGICAL UNIT (FILLED) B5400078 VFD X4/EOF,N12/0 4. EOF CODE B5400079 JMP- (ADISP) B5400080 SPC 1 B5400081ÐÐ* RETURN FROM EOF WRITE. IGNORE ERROR B5400082 SPC 1 B5400083DONEOF LDA* ISAVE RESTORE I-REGISTER B5400084 STA- I B5400085 LDQ* QSAVE Q B5400086 JMP* (GENEOF) RETURN TO CALLER B5400087 SPC 1 B5400088* STORAGES STORAGES B5400089 SPC 1 B5400090ISAVE NUM 0 B5400091QSAVE NUM 0 B5400092CALCOD VFD X2/D,X5/MOTCD,X1/NULL,X4/RP,X4/NULL B5400093 END B5400094 NAM BLD2 B55 A ITOS CCS 3.0 SL-149B5500001* UTILITY CHARACTER ASSEMBLY ROUTINE B5500002* CREDIT COLLECTION SYSTEM VERSION 3.0 B5500003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B5500004* COPYRIGHT CONTROL DATA CORPORATION 1979 B5500005* B5500006* *****************************************'****** B5500007* * * B5500008* * ROUTINE TO ASSEMBLE 1 CHARACTER/WORD * B5500009* * INTO 2 CHARACTERS/WORD * B5500010* * * B5500011* *****************************************'****** B5500012ÐÐ* B5500013* B5500014****** CALLING SEQUENCE : B5500015* B5500016* RTJ BLD2 B5500017* ADC LSOUR SOURCE DATA BUFFER (1 CHAR./WORD) B5500018* ADC TARGT TARGET DATA BUFFER (2 CHAR./WORD) B5500019* ADC SIZE SIZE (NO. OF CHARACTERS) B5500020* B5500021* B5500022****** ROUTINE FUNCTION : B5500023* B5500024* THIS ROUTINE IS USED TO ASSEMBLE A SINGLE CHARACTER B5500025* WORD INTO 2 CHARACTERS WORD. IT IS ALWAYS ASSUMED B5500026* LEFT JUSTIFIED. B5500027* B5500028* B5500029* B5500030 SPC 3 B5500031* B5500032****** *** E N T R Y N A M E B5500033* B5500034 SPC 1 B5500035 ENT BLD2 ENTRY NAME B5500036 SPC 2 B5500037ÐÐ* B5500038****** *** E Q U I V A L E N C E S B5500039* B5500040 SPC 1 B5500041LPMSK EQU LPMSK(2) BIT MASK B5500042ONE EQU ONE(3) CONSTANT ONE B5500043ZERO EQU ZERO(2) CONSTANT ZERO B5500044 SPC 5 B5500045* B5500046****** ***** P R O G R A M S T A R T ***** B5500047* B5500048 SPC 2 B5500049BLD2 NOP 0 ENTRY B5500050 STQ* QSAVE SAVE Q-REGISTER B5500051 LDA- I I B5500052 STA* ISAVE B5500053* B5500054 LDA* (BLD2) GET SOURCE BUFFER ADDRESS B5500055 STA- I B5500056 RAO* BLD2 BUMP TO NEXT PARAMETER ADD. B5500057 LDA* (BLD2) FETCH TARGET BUFFER ADDRESS B5500058 STA* TARGET B5500059 RAO* BLD2 INCREMENT TO THIRD PARAMETER ADD. B5500060* B5500061 LDQ* (BLD2) OBTAIN NO. OF CHARACTER IN SOURCE BUFFER B5500062ÐÐ LDA- (ZERO),Q B5500063 STA* SIZE B5500064 RAO* BLD2 SET EXIT LOCATION B5500065 SPC 1 B5500066* INITIALIZATION B5500067 SPC 1 B5500068 CLR A CLEAR HIGH/LOW BYTE FLAG AND STORAGE INDEX B5500069 STA* HILO B5500070 STA* INDEX B5500071 STA* FETCH B5500072 SPC 1 B5500073* GET CHARACTER AND ASSEMBLE B5500074 SPC 1 B5500075AGAIN LDQ* FETCH SET GET CHARACTER INDEX B5500076 LDA- (ZERO),B B5500077 LDQ* HILO POSITION CHARACTER ACCORDING TO HI/LO FLAG B5500078 SQN POSCHA B5500079 ALS 8 B5500080POSCHA STA* TEMP B5500081* B5500082 LDA* EXTMSK,Q GET MASK, RETAIN THE PROPER BYTE AND INSERT B5500083 LDQ* INDEX WITH CURRENT CHARACTER. THEN SAVE B5500084 AND* (TARGET),Q B5500085 ADD* TEMP B5500086 STA* (TARGET),Q B5500087ÐÐ SPC 1 B5500088* INCREMENT POINTERS AND CHECK IF DONE B5500089 SPC 1 B5500090 RAO* FETCH BUMP CHARACTER BEEN PROCESSED BY 1 B5500091 LDA* FETCH CHECK IF DONE B5500092 SUB* SIZE B5500093 SAN BMPTR SKIP, NOT DONE B5500094* B5500095 LDA* ISAVE DONE, RESTORE I AND Q-REGISTERS B5500096 STA- I B5500097 LDQ* QSAVE B5500098 JMP* (BLD2) RETURN TO CALLER B5500099 SPC 1 B5500100* B5500101BMPTR LDA* HILO UPDATE HIGH/LOW BYTE FLAG B5500102 ADD- ONE B5500103 AND- ONE B5500104 STA* HILO B5500105 SAN TOREP B5500106 RAO* INDEX UPDATE SOTRAGE INDE IF 2 CHAR. BEEN PROCESSED B5500107TOREP JMP* AGAIN TO REPEAT B5500108 SPC 2 B5500109* CONSTANTS AND STORAGES B5500110 SPC 1 B5500111EXTMSK NUM $00FF,$FF00 EXTRACT CHARACTER MASKS B5500112ÐÐTARGET NUM 0 TARGET BUFFER ADD. B5500113TEMP NUM 0 CHARACTER TEMPORARY STORAGE B5500114INDEX NUM 0 SAVE INDEX B5500115HILO NUM 0 HI/LO FLAG B5500116FETCH NUM 0 GET INDEX B5500117ISAVE NUM 0 I-REGISTER B5500118QSAVE NUM 0 Q B5500119SIZE NUM 0 B5500120 END B5500121 NAM ORDER B56 A ITOS CCS 3.0 SL-149B5600001* UTILITY DUMMY INTERFACE ROUTINE B5600002* CREDIT COLLECTION SYSTEM VERSION 3.0 B5600003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B5600004* COPYRIGHT CONTROL DATA CORPORATION 1979 B5600005* B5600006* ********************************************* B5600007* * * B5600008* * DUMMY INTERFACE BETWEEN PROCESSOR * B5600009* * AND LOAD OPTION ANALYZER * B5600010* * * B5600011* *****************************************'*** B5600012* B5600013* B5600014******* ROUTINE ENTRY METHOD : B5600015* B5600016ÐÐ* THIS ROUTINE IS ENTERED BY JUMP FROM PRE-LOAD WITH B5600017* RETURN ADDRESS IN A-REGISTER B5600018* B5600019* B5600020******* EXIT CONDITION : B5600021* B5600022* EXIT BACK TO PRE-LOAD ROUTINE WITH A-REGISTER B5600023* CONTAINS EXIT INDICATOR (O FOR EXIT, NON-ZERO FOR B5600024* OVERLAY NEXT MODULE). A-REGISTER IS SET BY B5600025* PROCESSOR. B5600026* B5600027* B5600028******* ROUTINE FUNCTION : B5600029* B5600030* THIS ROUTINE IS A DUMMY AND SERVES TWO MAJOR B5600031* FUNCTIONS. THEY ARE : (1) UNIQUE LOAD PROCESSOR B5600032* ENTRY NAME, AND (2) BINARY FILE ENTRY NAME. B5600033* B5600034* B5600035* B5600036 SPC 3 B5600037* B5600038******* *** E N T R Y N A M E B5600039* B5600040 SPC 1 B5600041ÐÐ ENT UTSPEC LOAD SPECIAL OVERLAY MARKER B5600042 SPC 2 B5600043* B5600044****** *** E X T E R N A L B5600045* B5600046 SPC 1 B5600047 EXT LDIXOD ORDERED INDEXED FILE B5600048 SPC 5 B5600049* B5600050****** ***** P R O G R A M S T A R T ***** B5600051* B5600052 SPC 2 B5600053UTSPEC NOP 0 ENTRY B5600054 STA* RETADD RETURN ADDRESS SAVE B5600055 RTJ LDIXOD CALL ORDERED INDEX FILE LOAD B5600056 ADC UTSPEC DUMMY PARAMETER B5600057 JMP* (RETADD) RETURN TO SENDER B5600058RETADD NUM 0 RETURN ADDRESS (FILLED) B5600059 END B5600060 NAM PRELOD B57 A ITOS CCS 3.0 SL-149B5700001* UTILITY LOAD FUNCTION MODE ANALYZER B5700002* CREDIT COLLECTION SYSTEM VERSION 3.0 B5700003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B5700004* COPYRIGHT CONTROL DATA CORPORATION 1979 B5700005* B5700006ÐÐ* *****************************************' B5700007* * * B5700008* * ROUTINE TO DETERMINE LOAD MODE * B5700009* * * B5700010* ****************************************** B5700011* B5700012* B5700013****** ROUTINE FUNCITON : B5700014* B5700015* THIS ROUTINE SERVES AS BUFFERING TO DETERMINE WHICH B5700016* 'LOAD' MODULE TO BE EXECUTED. THE NORMAL LOAD MODULEB5700017* IS CALLED AT ENTRY, REGARDLESS. AFTER ANALYSIS THE B5700018* PARAMETER, THIS ROUTINE IS CALLED,IF IT IS 'INDEXED B5700019* FILE', TO OVERLAY THE PROPER PROCESSING MODULE. B5700020* OTHERWISE LOADING IS COMPLETED PRIOR TO CONTROL TO B5700021* RETURN TO THIS MODULE. B5700022* B5700023* OVERLAY FLAG (IN A-REGISTER) FROM MODULE 'LOAD'. B5700024* B5700025* 0 = LOADING DONE (EXIT) B5700026* 1 = ORDERED INDEXED FILE LOADING B5700027* 2 = NON-ORDERED INDEXED FILE LOADING B5700028* B5700029* B5700030****** CALLING SEQUENCE : B5700031ÐÐ* B5700032* RTJ PRELOD B5700033* B5700034* B5700035* B5700036****** CALL METHOD TO PROCESSOR : B5700037* B5700038* JMP NEXTLO+1 LAST LOCATION OF THIS ROUTINE + 1 B5700039* B5700040* A-REGISTER = RETURN ADDRESS B5700041* B5700042 SPC 3 B5700043* B5700044****** *** E N T R Y N A M E B5700045* B5700046 SPC 1 B5700047 ENT PRELOD ENTRY NAME B5700048 SPC 2 B5700049* B5700050****** *** E X T E R N A L S B5700051* B5700052 SPC 1 B5700053 EXT FMULOD MODULE STARTING LOCATION B5700054 EXT CLOSFL CLOSE FILE B5700055 EXT OPENFL OPEN FILE B5700056ÐÐ EXT READR READ 1 RECORD B5700057 EXT SYSMSG PRINT ERROR MESSAGE B5700058 SPC 3 B5700059* B5700060****** *** E Q U I V A L E N C E S B5700061* B5700062 SPC 1 B5700063AMONI EQU AMONI($F4) MONITOR B5700064ADISP EQU ADISP($EA) DISPATCHER B5700065CURLV EQU CURLV($EF) CURRENT PRIORITY LEVEL B5700066D EQU D(1) 'D' BIT B5700067FRED EQU FRED(4) F-READ REQUEST CODE B5700068NULL EQU NULL(0) NULL B5700069RP EQU RP(4) REQUEST PRIORITY B5700070THREE EQU THREE(4) CONSTANT 3 B5700071 SPC 1 B5700072* ERROR CODE B5700073 SPC 1 B5700074ER30 EQU ER30(30) UTILITY PROCESSOR NOT FOUND B5700075ER33 EQU ER33(33) OPEN FILE REJECT B5700076 SPC 3 B5700077* B5700078* B5700079* LABELED COMMON AREA B5700080* B5700081ÐÐ DAT COMCOD(133),PARNAM(121) B5700082 DAT PPHELP(2) B5700083 DAT PPINIT(4) B5700084 DAT PPDEFI(16) B5700085 DAT PPSTAT(4) B5700086 DAT PPRELO(5) 122*4875B5700087 DAT PPDUMP(5) 122*4875B5700088 DAT PPCOPY(6) B5700089 DAT PPDELE(3) B5700090 DAT PPCLEA(3) B5700091 DAT PPLIST(6) 122*4875B5700092 DAT PPRENA(5) B5700093 DAT PPCOMM(2) B5700094 DAT PPEXIT(1) B5700095 DAT PPMOUN(3) B5700096 DAT PPDISM(2) B5700097 DAT PPSAVE(3) B5700098 DAT PPBATC(5) BATCH B5700099 DAT PPLOAD(5) B5700100 DAT PPPURG(3) B5700101 DAT PPINPU(2) B5700102 DAT PPOUTP(2) B5700103 DAT PPCOMP(3) B5700104 DAT PPHOST(4) HOST B5700105 DAT PPSET(3) SET B5700106ÐÐ DAT PPBATS(4) BATCH STATUS B5700107 DAT PPDISC(2) DISCARD B5700108 DAT PPDISP(7) DISPOSE B5700109 DAT PPFLUS(3) FLUSH B5700110 DAT PPPRIN(3) PRINT B5700111 DAT DUMMY(6) B5700112 DAT INBUF(41),CODE(20) B5700113 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B5700114 DAT REQBUF(24),IDATA(24) B5700115 DAT PARDEF(24) B5700116 DAT FCBHDR(5) B5700117 DAT FCBBUF(96) B5700118 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B5700119 EQU COMLEN(ENDCOM-COMCOD) B5700120 SPC 5 B5700121* B5700122****** ***** P R O G R A M S T A R T ***** B5700123* B5700124 SPC 2 B5700125PRELOD NOP 0 ENTRY B5700126SETUP LDA =XCOMBAK GET UP RETURN ADDRESS B5700127TOEX LDQ =XNEXTLO SET PROCESSOR ADDRESS (MINUS 1) B5700128 JMP- 1,Q JUMP TO PROCESSOR B5700129COMBAK SAN INDEX SKIP ON REQUEST FOR INDEXED FILE MODULE B5700130GETOUT JMP* (PRELOD) RETURN TO SENDER. DONE B5700131ÐÐ SPC 2 B5700132* B5700133*----- SET UP GET FILE REQUEST TO OVERLAY PROPER LOAD MODULE B5700134* B5700135* 1 = ORDERED INDEX REQUEST B5700136* 2 = RANDOM INDEX REQUEST B5700137* B5700138 SPC 1 B5700139INDEX INA -1 CALCULATE INDEX TO MOVE FILE NAME FOR B5700140 MUI- THREE REQUEST B5700141 STA- I B5700142RLDNAM LDA* NAME,B B5700143 STA* CODEX,Q B5700144 INQ 1 B5700145 TRQ A B5700146 INA -3 B5700147 SAZ TOCLR B5700148 JMP* RLDNAM B5700149 SPC 2 B5700150* CLEAR REQUEST BUFFER AND OPEN FILE B5700151 SPC 1 B5700152TOCLR ENQ 23 CLERE REQUEST BUFFER B5700153 CLR A B5700154CLREQB STA* REQBUX,Q B5700155 SQZ TOPNFL B5700156ÐÐ INQ -1 B5700157 JMP* CLREQB B5700158* B5700159TOPNFL LDA =XFCBHDR B5700160 STA* REQBUX+9 B5700161 RTJ OPENFL OPEN FILE (SYSTEM PROGRAM FILE) B5700162 ADC REQBUX B5700163 ADC NDATA B5700164 ADC STATUS B5700165 SPC 1 B5700166* UPON RETURN, CHECK STATUS B5700167 SPC 1 B5700168 LDA* STATUS CHECK IF OK B5700169 SAZ REDNAM B5700170 ENA ER33 B5700171 JMP* ERROR B5700172* B5700173REDNAM RTJ READR READ THE DESIRE ENTRY RECORD B5700174 ADC REQBUX B5700175 ADC INFO B5700176 ADC CODEX B5700177 ADC STATUS B5700178* B5700179 RTJ CLOSFL CLOSE FILE B5700180 ADC REQBUX B5700181ÐÐ ADC STATUS+1 B5700182* B5700183 SPC 1 B5700184* CHECK IF PROGRAM FOUND B5700185 SPC 1 B5700186 LDA* STATUS CHECK IF PROCESSOR FOUND B5700187 SAZ LODPFD YES, SKIP B5700188 ENA ER30 NO, SET ERROR CODE AND TO ERROR PROCESSING B5700189 JMP* ERROR B5700190 SPC 3 B5700191* B5700192* B5700193*----- GET MM ADDRESS AND READ B5700194* B5700195* B5700196 SPC 1 B5700197LODPFD LDA* INFO+3 GET PROCESS PROGRAM FILE MASS MEMORY ADDRESS B5700198 STA* MSB MSB B5700199 LDA* INFO+4 LSB B5700200 STA* LSB B5700201 LDA* INFO+5 LENGTH B5700202 STA* LENGTH B5700203 LDA- CURLV ASSEMBLE CALL CODE WITH CURRENT PRIORITY B5700204 ADD* CALCOD B5700205 STA* REQCOD B5700206ÐÐ LDA* TOEX+1 GENERATE OVERLAY ADDRESS AND SAVE B5700207 INA 1 B5700208 STA* STADDR B5700209* B5700210* READ INTO OVERLAY AREA B5700211* B5700212 RTJ- (AMONI) B5700213REQCOD VFD X2/D,X5/FRED,X1/NULL,X4/RP,X4/NULL B5700214 ADC TOSTAR 1. COMPLETION ADD. B5700215 NUM 0 2. THREAD B5700216 NUM $08C2 3. LU (LIBRARY) B5700217LENGTH NUM 0 4. LENGTH (FILLED) B5700218STADDR NUM 0 5. OVERLAY STARTING ADD. (FILLED) B5700219MSB NUM 0 6. MSB OF MM ADD. (FILLED) B5700220LSB NUM 0 7. LSB (FILLED) B5700221 JMP- (ADISP) B5700222 SPC 2 B5700223* B5700224***** TO START PROGRAM B5700225* B5700226 SPC 1 B5700227TOSTAR JMP* SETUP TO TRANSFER CONTROL TO PROCESSOR B5700228 SPC 3 B5700229* B5700230*----- *** ERROR ERROR B5700231ÐÐ* B5700232 SPC 1 B5700233ERROR STA* STATUS B5700234 RTJ SYSMSG B5700235 ADC STATUS B5700236 ADC NONE B5700237 ENA 0 B5700238 JMP* GETOUT B5700239 SPC 3 B5700240* B5700241****** ***** ***** ***** ***** ***** B5700242* B5700243* B5700244* CONSTANTS AND STORAGES B5700245* B5700246 SPC 1 B5700247STATUS NUM 0,0 B5700248CALCOD VFD X2/D,X5/FRED,X1/NULL,X4/RP,X4/NULL B5700249 SPC 1 B5700250* INDEXED FILE LOAD NAMES B5700251NAME ALF *,UTORLD* 1- ORDERED INDEX LOAD B5700252 ALF *,UTRMLD* 2. RANDOM INDEX LOAD B5700253INFO BZS INFO(6) B5700254CODEX BZS CODEX(4) B5700255REQBUX BZS REQBUX(24) B5700256ÐÐNDATA ALF *,$$PGMNAM$$ * B5700257 NUM 1,1,0 B5700258NONE EQU NONE(*-1) B5700259NEXTLO EQU NEXTLO(*-1) B5700260 END B5700261 NAM RANDOM B58 A ITOS CCS 3.0 SL-149B5800001* UTILITY DUMMY INTERFACE ROUTINE B5800002* CREDIT COLLECTION SYSTEM VERSION 3.0 B5800003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B5800004* COPYRIGHT CONTROL DATA CORPORATION 1979 B5800005* B5800006* *****************************************'*** B5800007* * * B5800008* * DUMMY INTERFACE BETWEEN PROCESSOR * B5800009* * AND LOAD OPTION ANALYZER * B5800010* * * B5800011* ********************************************* B5800012* B5800013* B5800014******* ROUTINE ENTRY METHOD : B5800015* B5800016* THIS ROUTINE IS ENTERED BY JUMP FROM PRE-LOAD WITH B5800017* RETURN ADDRESS IN A-REGISTER B5800018* B5800019* B5800020ÐÐ******* EXIT CONDITION : B5800021* B5800022* EXIT BACK TO PRE-LOAD ROUTINE WITH A-REGISTER B5800023* CONTAINS EXIT INDICATOR (O FOR EXIT, NON-ZERO FOR B5800024* OVERLAY NEXT MODULE). A-REGISTER IS SET BY B5800025* PROCESSOR. B5800026* B5800027* B5800028******* ROUTINE FUNCTION : B5800029* B5800030* THIS ROUTINE IS A DUMMY AND SERVES TWO MAJOR B5800031* FUNCTIONS. THEY ARE : (1) UNIQUE LOAD PROCESSOR B5800032* ENTRY NAME, AND (2) BINARY FILE ENTRY NAME. B5800033* B5800034* B5800035* B5800036 SPC 3 B5800037* B5800038******* *** E N T R Y N A M E B5800039* B5800040 SPC 1 B5800041 ENT UTSPEC LOAD SPECIAL OVERLAY MARKER B5800042 SPC 2 B5800043* B5800044****** *** E X T E R N A L B5800045ÐÐ* B5800046 SPC 1 B5800047 EXT BLDIDR RANDOM INDEXED FILE B5800048 SPC 5 B5800049* B5800050****** ***** P R O G R A M S T A R T ***** B5800051* B5800052 SPC 2 B5800053UTSPEC NOP 0 ENTRY B5800054 STA* RETADD RETURN ADDRESS SAVE B5800055 RTJ BLDIDR RANDOM INDEXED FILE PROCESSOR B5800056 ADC UTSPEC DUMMY PARAMETER B5800057 JMP* (RETADD) RETURN TO SENDER B5800058RETADD NUM 0 RETURN ADDRESS (FILLED) B5800059 END B5800060 NAM SEQLOD B59 A ITOS CCS 3.0 SL-149B5900001* UTILITY DUMMY INTERFACE ROUTINE B5900002* CREDIT COLLECTION SYSTEM VERSION 3.0 B5900003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B5900004* COPYRIGHT CONTROL DATA CORPORATION 1979 B5900005* B5900006* *****************************************'*** B5900007* * * B5900008* * DUMMY INTERFACE BETWEEN PROCESSOR * B5900009* * AND LOAD OPTION ANALYZER * B5900010ÐÐ* * * B5900011* ********************************************* B5900012* B5900013* B5900014******* ROUTINE ENTRY METHOD : B5900015* B5900016* THIS ROUTINE IS ENTERED BY JUMP FROM PRE-LOAD WITH B5900017* RETURN ADDRESS IN A-REGISTER B5900018* B5900019* B5900020******* EXIT CONDITION : B5900021* B5900022* EXIT BACK TO PRE-LOAD ROUTINE WITH A-REGISTER B5900023* CONTAINS EXIT INDICATOR (O FOR EXIT, NON-ZERO FOR B5900024* OVERLAY NEXT MODULE). A-REGISTER IS SET BY B5900025* PROCESSOR. B5900026* B5900027* B5900028******* ROUTINE FUNCTION : B5900029* B5900030* THIS ROUTINE IS A DUMMY AND SERVES TWO MAJOR B5900031* FUNCTIONS. THEY ARE : (1) UNIQUE LOAD PROCESSOR B5900032* ENTRY NAME, AND (2) BINARY FILE ENTRY NAME. B5900033* B5900034* B5900035ÐÐ* B5900036 SPC 2 B5900037* B5900038****** *** E X T E R N A L B5900039* B5900040 SPC 1 B5900041 EXT LOAD SEQUENCE FILE LOAD B5900042 SPC 5 B5900043* B5900044****** ***** P R O G R A M S T A R T ***** B5900045* B5900046 SPC 2 B5900047UTSPEC NOP 0 ENTRY B5900048 STA* RETADD RETURN ADDRESS SAVE B5900049 RTJ LOAD CALL ORDERED INDEX FILE LOAD B5900050 ADC UTSPEC DUMMY PARAMETER B5900051 JMP* (RETADD) RETURN TO SENDER B5900052RETADD NUM 0 RETURN ADDRESS (FILLED) B5900053 END B5900054 NAM TOWT B60 A ITOS CCS 3.0 SL-149B6000001* UTILITY UNFORMATTED WRITE PROCESSOR B6000002* CREDIT COLLECTION SYSTEM VERSION 3.0 B6000003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B6000004* COPYRIGHT CONTROL DATA CORPORATION 1979 B6000005* B6000006ÐÐ* ************************************************* B6000007* * * B6000008* * * ROUTINE TO WRITE DATA TO PRINT DEVICE * B6000009* * VIA MONITOR WITH NORMAL WRITE REQUEST * B6000010* * * B6000011* *********'*******************************'******* B6000012* B6000013* B6000014****** CALLING SEQUENCE : B6000015* B6000016* RTJ TOWT B6000017* ADC LU LOGICAL UNIT B6000018* ADC MES MESSAGE BUFFER B6000019* ADC SIZE SIZE OF MESSAGE B6000020* B6000021* B6000022* CALL TOWT(LU,MES,SIZE) (FORTRAN CALL) B6000023* B6000024* B6000025* B6000026****** ROUTINE FUNCTION : B6000027* B6000028* THIS ROUTINE IS USED TO OUTPUT A CALLER'S MESSAGE B6000029* WITH CALLER SUPPLIED LOGICAL UNIT. CURRENT ROUTINE B6000030* EXECUTION PRIORITY IS USED FOR COMPLETION PRIORITY B6000031ÐÐ* B6000032* B6000033* B6000034 SPC 3 B6000035* B6000036****** *** E N T R Y N A M E B6000037* B6000038 SPC 1 B6000039 ENT TOWT ENTRY NAME B6000040 SPC 2 B6000041* B6000042****** *** E Q U I V A L E N C E S B6000043* B6000044 SPC 1 B6000045AMONI EQU AMONI($F4) MSOS MONITOR ENTRY B6000046ADISP EQU ADISP($EA) MSOS DISPATCHER ENTRY B6000047CURPL EQU CURPL($EF) MSOS CURRENT PRIORITY LEVEL B6000048 SPC 1 B6000049WTCD EQU WTCD(2) WRITE REQUEST CODE B6000050RQPL EQU RQPL(4) REQUEST PRIORITY LEVEL B6000051D EQU D(1) PART 1 REQUEST FLAG B6000052X EQU X(0) RELATIVE REQUEST FLAG B6000053NULL EQU NULL(0) NULL FIELD B6000054ZERO EQU ZERO(2) CONSTANT ZERO B6000055 SPC 5 B6000056ÐÐ* B6000057****** ***** P R O G R A M S T A R T ***** B6000058* B6000059 SPC 2 B6000060TOWT NOP 0 ENTRY B6000061 STQ* QSAVE SAVE Q-REGISTER B6000062 LDA- I I B6000063 STA* ISAVE B6000064* B6000065 LDQ* (TOWT) GET OUTPUT DEVICE LOGICAL UNIT B6000066 LDA- (ZERO),Q B6000067 STA* LU B6000068 RAO* TOWT BUMP TO NEXT PARAMETER ADD. B6000069* B6000070 LDA* (TOWT) GET MESSAGE BUFFER ADDRESS B6000071 STA* BUFAD B6000072 RAO* TOWT SET TO NEXT PARAMETER ADD. B6000073* B6000074 LDQ* (TOWT) GET MESSAGE SIZE B6000075 LDA- (ZERO),Q B6000076 STA* SIZE B6000077 RAO* TOWT SET EXIT LOCATION B6000078 SPC 2 B6000079* ASSEMBLE CALL CODE B6000080 SPC 1 B6000081ÐÐ LDA- CURPL INSERT CURRENT PRIORITY LEVEL IN CALL CODE B6000082 ADD* CALCOD B6000083 STA* CALPAR B6000084 RTJ- (AMONI) B6000085CALPAR NUM 0 0. CALL PARAMETER (FILLED) B6000086 ADC COMPAD 1. COMPLETION ADDRESS B6000087 NUM 0 2. THREAD B6000088LU NUM 0 3. LOGICAL UNIT (FILLED) B6000089SIZE NUM 0 4. SIZE (FILLED) B6000090BUFAD NUM 0 5. BUFFER (FILLED) B6000091 JMP- (ADISP) B6000092 SPC 2 B6000093* RETURN FROM WRITE B6000094 SPC 1 B6000095COMPAD LDA* ISAVE RESTORE I-REGISTER B6000096 STA- I B6000097 LDQ* QSAVE RECALL Q-REGISTER B6000098 JMP* (TOWT) RETURN B6000099 SPC 3 B6000100* STORAGES B6000101 SPC 1 B6000102ISAVE NUM 0 I-REGISTER B6000103QSAVE NUM 0 Q-REGISTER B6000104CALCOD VFD X2/D,X5/WTCD,X1/X,X4/RQPL,X4/NULL B6000105 END B6000106ÐÐ NAM VLTOI B61 A ITOS CCS 3.0 SL-149B6100001* UTILITY INTEGER CONVERSION ROUTINE B6100002* CREDIT COLLECTION SYSTEM VERSION 3.0 B6100003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B6100004* COPYRIGHT CONTROL DATA CORPORATION 1979 B6100005* B6100006* *****************************************'***** B6100007* * * B6100008* * ROUTINE TO CONVERT VALUE TO INTEGER * B6100009* * * B6100010* *********'************************************* B6100011* B6100012* B6100013****** CALLING SEQUENCE : B6100014* B6100015* RTJ VLTOI B6100016* ADC DATBUF 6-WORD ARRAY WITH WORD 1 AS VALUE AND B6100017* LAST 5 WORDS FOR ASCII INTEGERS B6100018* B6100019* CALL VLTOI(DATBUF) (FORTRAN SEQUENCE) B6100020* B6100021* B6100022****** ROUTINE FUNCTION : B6100023* B6100024* THIS ROUTINE CONVERTS AN UNSIGN VALUE TO 5 ASCII B6100025ÐÐ* INTEGER AND RIGHT JUSTIFIED WITH NULL FILLED LEFT B6100026* PORTION. LEADING ZERO IS SPACE FILLED. B6100027* B6100028* B6100029* B6100030 SPC 3 B6100031* B6100032****** *** E N T R Y N A M E B6100033* B6100034 SPC 1 B6100035 ENT VLTOI ENTRY NAME B6100036 SPC 2 B6100037* B6100038****** *** E Q U I V A L E N C E S B6100039* B6100040 SPC 1 B6100041LPMSK EQU LPMSK(2) BIT MASK B6100042ZERO EQU ZERO(2) CONSTANT ZERO B6100043 SPC 1 B6100044* SYSTEM DEPENDENT VARIABLE B6100045 SPC 1 B6100046MAXDIG EQU MAXDIG(5) MAX. NO. OF DIGITS TO BE CONVERTED B6100047 SPC 5 B6100048* B6100049****** ***** P R O G R A M S T A R T ***** B6100050ÐÐ* B6100051 SPC 3 B6100052VLTOI NOP 0 ENTRY B6100053 STQ* QSAVE SAVE Q-REGISTER B6100054 LDA- I I B6100055 STA* ISAVE B6100056 SPC 1 B6100057* GET PARAMETER B6100058 SPC 1 B6100059 LDA* (VLTOI) GET PARAMETER ADDRESS B6100060 STA- I B6100061 STA* PARADD B6100062 LDA- (ZERO),I GET VALUE TO BE CONVERTED B6100063 STA* VALUE B6100064* B6100065 CLR A B6100066 STA* INDEX B6100067 STA* LEDZRO B6100068 SPC 1 B6100069* REPEAT DIVIDE VALUE BY 10**I B6100070 SPC 1 B6100071REPEAT LDA* INDEX GET CHARACTER INDEX B6100072 STA- I B6100073 CLR Q B6100074 LDA* VALUE CONVERT VALUE BY DIVIDING TO TEN POWER B6100075ÐÐ DVI* POWER,I B6100076 STQ* VALUE B6100077* B6100078 LDQ* LEDZRO GET LEADING ZERO FLAG B6100079 SAZ CHARO B6100080 RAO* LEDZRO SET NON-LEADING ZERO FOR VALUE OTHER THAN 0 B6100081ASMASC INA $30 CONVERT AS ASCII B6100082* B6100083 LDQ* INDEX BUMP INDEX AND SAVE CHARACTER B6100084 INQ 1 B6100085 STA* (PARADD),Q B6100086 STQ* INDEX B6100087 INQ -MAXDIG CHECK IF DONE B6100088 SQZ DONASM YES, SKIP (DONE) B6100089 JMP* REPEAT NO, REPEAT B6100090 SPC 1 B6100091* CHARACTER IS ZERO, CHECK IF LEADING ZERO B6100092* IF SO IGNORE IT AND REPLACE WITH SPACE B6100093 SPC 1 B6100094CHARO SQN TOASM B6100095 ENA $20-$30 B6100096TOASM JMP* ASMASC B6100097 SPC 2 B6100098* DONE CONVERSION B6100099* CHECK IF ALL ZERO, IF SO, SET ONE ZERO B6100100ÐÐ SPC 1 B6100101DONASM LDQ* LEDZRO CHECK IF ANY VALUE (NON-ZERO) B6100102 SQN RESTR YES, SKIP B6100103 ENQ MAXDIG B6100104 ENA $30 SAVE ZERO B6100105 STA* (PARADD),Q B6100106 SPC 1 B6100107* B6100108RESTR LDQ* QSAVE RESTORE Q-REGISTER B6100109 LDA* ISAVE I B6100110 STA- I B6100111 RAO* VLTOI SET EXIT B6100112 JMP* (VLTOI) RETURN TO CALLER B6100113 SPC 3 B6100114* CONSTANTS AND STORAGES B6100115 SPC 1 B6100116POWER NUM 10000,1000,100,10,1 B6100117VALUE NUM 0 B6100118QSAVE NUM 0 Q-REGISTER B6100119ISAVE NUM 0 I B6100120PARADD NUM 0 PARAMETER ADDRESS B6100121LEDZRO NUM 0 LEADING ZERO FLAG (NON-ZERO FOR NON-ZERO) B6100122INDEX NUM 0 CHARACTER STORAGE INDEX B6100123 END B6100124 NAM KIBMGR B62 A ITOS CCS 3.0 SL-149B6200001ÐÐ* KEY INFORMATION BLOCK MANAGER B6200002* CREDIT COLLECTION SYSTEM VERSION 3.0 B6200003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B6200004* COPYRIGHT CONTROL DATA CORPORATION 1979 B6200005* B6200006* KIBMGR WILL PERFORM SATISFACTORILY AS LONG AS SECTOR B6200007* SIZE IS GREATER THAN OR EQUAL TO 96 WORDS AND LESS THAN B6200008* OR EQUAL TO 572 WORDS. KIBMGR WILL EFFICIENTLY MANAGE B6200009* KIB BUFFER SPACE AS LONG AS THIS REQUIREMENT IS MET. B6200010* THIS BUFFER IS CURRENTLY SIZED FOR FOURTEEN 288 WORD KIBS. B6200011* B6200012* B6200013* ENTRY POINTS B6200014 ENT INIKIB INITIALIZE KIB CONTROL TABLES B6200015 ENT NXTKIB GET RELATIVE KIB NO. FOR NEXT FREE KIB SPACE B6200016 ENT MRKKIB MARK KIB IN COMMON BUFFER AS CHANGED B6200017 ENT FREEUP FREE UP BUFFER FOR NEW KIB. B6200018 ENT GETKIB GET SPECIFIED KIB B6200019 ENT WRTKIB WRITE ALL CHANGED RESIDENT KIBS TO MASS MEMORYB6200020 SPC 3 B6200021* EXTERNALS B6200022 EXT READR READ RECORD (KIB) RANDOMLY B6200023 EXT UPDREC UPDATE RECORD (KIB) B6200024 EXT FMEOFC FILE MANAGER END OF FILE CODE B6200025 EXT DWSUB DOUBLE WORD SUBTRACT B6200026ÐÐ EXT DWADD DOUBLE WORD ADD B6200027 SPC 2 B6200028* EQUIVALENCES B6200029 EQU ONEMSK(3) ONE MASK TABLE B6200030 EQU ZERO($22) SYSTEM ZERO B6200031 EQU ONEBIT($23) ONE BIT TABLE B6200032 SPC 2 B6200033* DEFINITION OF BUILD INDEX COMMON B6200034 DAT RQBADR REQUEST BUFFER ADDRESS B6200035 DAT FCBADR FCB ADDRESS (INCLUDES HEADER) B6200036 DAT IDUM1(23) B6200037 DAT KIBBUF(572) B6200038 DAT IDUM2(83) B6200039 DAT NEWKBM NEW KIB MSB B6200040 DAT NEWKBL NEW KIB LSB B6200041 DAT IDUM3(7) B6200042 DAT REQSTA B6200043 DAT RKIBNO(2) REL. KIB. NO. OF COMMON BUFFER KIB B6200044 DAT IDUM4(4) B6200045 DAT WPS WORDS PER SECTOR B6200046 DAT ZERO2(2) B6200047 DAT BUFIDX OFFSET INDEX FROM KIBBUF TO CURRENT KIB B6200048 EJT B6200049* FILE CONTROL BLOCK EQUIVALENCES B6200050 EQU FH(4) LENGTH -1 OF FCB HEADER B6200051ÐÐ EQU FILEID(ZERO) FILE IDENTIFIER B6200052* ACCESS FILEID INDIRECTLY B6200053* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBERB6200054* BITS 10-00 INDEX OF FCB IN FCB TABLE B6200055 EQU FCBFLG(1) FCB FLAGS B6200056* BITS 15-8, SPARE B6200057* BITS 7-00, NUMBER OF USERS USING FILE B6200058 EQU FILOCK(2) FILE LOCK FLAG (IF NON-0, CONTAINS USER ID) B6200059 EQU NUMSET(3) NUMBER OF SETS OF LOCKED RECORDS IN FILE B6200060 EQU NUMNEW(4) NUMBER OF NEW RECORDS SINCE FCB UPDATED ON MM B6200061 SPC 1 B6200062 EQU RECLEN(FH+1) RECORD LENGTH IN WORDS B6200063 EQU TDATRM(FH+2) TOTAL NUMBER OF DATA RECORDS, MSB B6200064 EQU TDATRL(FH+3) TOTAL NUMBER OF DATA RECORDS, LSB B6200065 EQU DATBAM(FH+4) DATA RECORDS BEGINNING SECTOR ADDRESS, MSB B6200066 EQU DATBAL(FH+5) DATA RECORDS BEGINNING SECTOR ADDRESS,LMSB B6200067 EQU FCBIND(FH+6) FCB INDICATORS B6200068* BIT 15 , SECTOR ALLIGNED RECORDS IF =1 B6200069* BIT 14 , STORAGE MODE FOR INDEXED FILE B6200070* =0, RECORDS STORED RANDOMLY WITHB6200071* RESPECT TO PRIMARY KEY B6200072* =1, RECORDS STORED IN ORDER WIT B6200073* RESPECT TO PRIMARY KEY B6200074* BIT 13 , =1, FILE IS CURRENTLY OPEN B6200075* =0, FILE IS CURRENTLY CLOSED B6200076ÐÐ* BIT 12 , =1, FILE IS BEING COMPRESSED B6200077* =0, FILE IS NOT BEING COMPRESSEDB6200078* BIT 0 , FILE TYPE B6200079* =0, SEQUENTIAL FILE B6200080* =1, INDEXED FILE B6200081 EQU NEDATM(FH+7) NUMBER OF EXISTING DATA RECORDS, MSB B6200082 EQU NEDATL(FH+8) NUMBER OF EXISTING DATA RECORDS, LSB B6200083 EQU SEQLTH(NEDATL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION B6200084* OF FCB FOR A SEQUENTIAL FILE B6200085 SPC 1 B6200086 EQU NEXTBM(FH+9) NEXT FREE KEY INDEX BLOCK, MSB B6200087 EQU NEXTBL(FH+10) NEXT FREE KEY INDEX BLOCK, LSB B6200088 EQU TNKEYM(FH+11) TOTAL NUMBER OF KEY INDEX BLOCKS, MSB B6200089 EQU TNKEYL(FH+12) TOTAL NUMBER OF KEY INDEX BLOCKS, LSB B6200090 EQU KEYBAM(FH+13) KEY INDEX BEGINNING SECTOR ADDRESS, MSB B6200091 EQU KEYBAL(FH+14) KEY INDEX BEGINNING SECTOR ADDRESS, LSB B6200092 EQU LENKY1(FH+15) LENGTH OF KEY NO. 1 B6200093 EQU POSKY1(FH+16) BYTE POSITION OF KEY NO. 1 B6200094 EQU LENKY2(FH+17) LENGTH OF KEY NO. 2 B6200095 EQU POSKY2(FH+18) BYTE POSITION OF KEY NO. 2 B6200096 EQU LENKY3(FH+19) LENGTH OF KEY NO. 3 B6200097 EQU POSKY3(FH+20) BYTE POSITION OF KEY NO. 3 B6200098 EQU LENKY4(FH+21) LENGTH OF KEY NO. 4 B6200099 EJT B6200100*E B6200101ÐÐ EQU POSKY4(FH+22) BYTE POSITION OF KEY NO. 4 B6200102 EQU INDLEN(POSKY4-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION B6200103* OF FCB FOR AN INDEXED FILE B6200104* THE FOLLOWING PORTION OF THE FCB EXISTS ONLY B6200105* ON MASS MEMORY. THESE 10 WORDS ARE NOT LOADEDB6200106* INTO EITHER OF THE FILE MANAGER CONTROLLED FCBB6200107* TABLES. B6200108 EQU TSFILM(FH+23) TOTAL NUMBER OF SECTORS IN FILE, MSB B6200109 EQU TSFILL(FH+24) TOTAL NUMBER OF SECTORS IN FILE, LSB B6200110 EQU NAME12(FH+25) FILE NAME, CHARACTERS 1 AND 2 B6200111 EQU NAME34(FH+26) FILE NAME, CHARACTERS 3 AND 4 B6200112 EQU NAME56(FH+27) FILE NAME, CHARACTERS 5 AND 6 B6200113 EQU NAME78(FH+28) FILE NAME, CHARACTERS 7 AND 8 B6200114 EQU OWNR12(FH+29) OWNER NAME, CHARACTERS 1 AND 2 B6200115 EQU OWNR34(FH+30) OWNER NAME, CHARACTERS 3 AND 4 B6200116 EQU OWNR56(FH+31) OWNER NAME, CHARACTERS 5 AND 6 B6200117 EQU OWNR78(FH+32) OWNER NAME, CHARACTERS 7 AND 8 B6200118 EQU BYTLEN(FH+33) BYTE LENGTH OF RECORD B6200119* B6200120* FOR COMPRESS ONLY B6200121* B6200122 EQU PRSRNM(FH+34) RRN OF LAST PROCESSED RECORD - MSB B6200123 EQU PRSRNL(FH+35) RRN OF LAST PROCESSED RECORD - LSB B6200124 EQU NEWRNM(FH+36) RRN OF THE LATEST 'NEW' RECORD - MSB B6200125 EQU NEWRNL(FH+37) RRN OF THE LATEST 'NEW' RECORD - LSB B6200126ÐÐ SPC 4 B6200127* WORDS 0 THRU 4 OF THE FCB HEADER AND WORDS B6200128* 6 THRU 10 OF THE FCB ARE REFERRED TO AS THE B6200129* SHARED SUBSET OF THE FCB. THEY INCLUDE THE B6200130* ONLY FCB WORDS THAT CAN BE MODIFIED AFTER FILEB6200131* CREATION. IF TWO OR MORE USERS HAVE THE SAME B6200132* FILE OPEN, THERE HAS TO BE A SINGLE MASTER B6200133* COPY OF THE SUBSET THAT RECEIVES (AND RECORDS)B6200134* ALL OF THE UPDATES. THE CONTROLLED SUBSET B6200135* WILL ALWAYS BE PART OF A MAIN MEMORY RESIDENT B6200136* FCB IF THE FCB IS IN A FM CONTROLLED TABLE. B6200137* IF THE FCB IS IN USER SPACE, THE SUBSET MAY ATB6200138* TIMES RESIDE IN THE SUBSET CONTROL TABLE. B6200139 SPC 2 B6200140* ALTERNATE NAMES FOR SUBSET WORDS B6200141 EQU SAFCBI(FH+1) SUBSET ALTERNATE NAME FOR FCBIND B6200142 EQU SADATM(FH+2) SUBSET ALTERNATE NAME FOR NEDATM B6200143 EQU SADATL(FH+3) SUBSET ALTERNATE NAME FOR NEDATL B6200144 EQU SANXTM(FH+4) SUBSET ALTERNATE NAME FOR NEXTBM B6200145 EQU SANXTL(FH+5) SUBSET ALTERNATE NAME FOR NEXTBL B6200146 EJT B6200147 EQU KIBLEN(288) KIB LENGTH - DEFAULT FOR 96 WORD SECTOR B6200148 EQU KIBBLN(572) KIB BUFFER LENGTH B6200149 EQU NUMKIB(14) NUMBER OF KIBS IN BUFFER B6200150 EQU BUFLEN(NUMKIB*KIBLEN) KIB BUFFER LENGTH B6200151ÐÐ BSS BUFFER(BUFLEN) KIB BUFFER ADDRESS B6200152 BSS RKNMSB(NUMKIB+1) RELATIVE KIB NUMBERS - MSBS B6200153 BSS RKNLSB(NUMKIB+1) RELATIVE KIB NUMBERS - LSBS B6200154 BSS KIBCHG(NUMKIB+1) KIB CHANGED FLAGS B6200155 BSS KIBUSE(NUMKIB+1) KIB USAGE COUNTERS B6200156* B6200157SAVEDI NUM 0 SAVED CURRENT VALUE OF BUFIDX B6200158CIDENT NUM 0 CURRENT KIB BUFFER IDENTIFIER (SPECIFIES B6200159* BUFFER RESIDENCY OF KIB DEFINED BY RKIBNO) B6200160* WHERE 0 SIGNIFIES KIBBUF (COMMON) B6200161* 1 SIGNIFIES 1ST SPACE IN BUFFER B6200162* 2 SIGNIFIES 2ND SPACE IN BUFFER B6200163* . B6200164* . B6200165* N SPECIFIES NTH SPACE IN BUFFER B6200166AKIBLN ADC KIBLEN ACTUAL KIB LENGTH B6200167ANUMKB ADC NUMKIB ACTUAL NUMBER OF KIBS B6200168 SPC 2 B6200169 EQU REWARD(6) REWARD VALUE FOR USE OF KIB B6200170 EQU PENALT(1) PENALTY VALUE FOR NON-USE OF KIB B6200171 EJT B6200172* INITIALIZE KIB CONTROL TABLES B6200173 SPC 2 B6200174* INIKIB SHOULD BE CALLED AS A SUBROUTINE WITH B6200175* NO PARAMETERS. AS NO I/O IS PERFORMED, NO B6200176ÐÐ* STATUS IS NEEDED. B6200177 SPC 2 B6200178INIKIB NUM 0 ENTRY B6200179 STQ QRSAVE SAVE Q-REG. LOCALLY B6200180 LDA WPS CHECK SECTOR SIZE B6200181 INA -96 B6200182 SAN INI05 SENSE NOT 96 B6200183 ENA NUMKIB B6200184 JMP* INI07 B6200185* B6200186INI05 ENQ 0 COMPUTE KIB LENGTH B6200187 LDA =N572 B6200188 DVI WPS EQUAL TO INTEGRAL NUMBER B6200189 MUI WPS OF SECTORS THAT WILL FIT IN B6200190 STA* AKIBLN 572 WORD BUFFER. B6200191 STA LENGTH SAVE LENGTH B6200192 STA LEN B6200193 ENQ 0 B6200194 LDA =XBUFLEN B6200195 DVI* AKIBLN COMPUTE NUMBER OF KIB SPACES IN BUFFER B6200196 STA* ANUMKB B6200197INI07 TRA Q B6200198 INQ 1 SET UP TO CLEAR RKN TABLES B6200199 CLR A B6200200INI10 INQ -1 DECREMENT COUNT B6200201ÐÐ SQM INI20 SKIP IF DONE B6200202 STA* RKNMSB,Q CLEAR MSB B6200203 STA* RKNLSB,Q CLEAR LSB B6200204 STA* KIBCHG,Q CLEAR KIB CHANGED FLAG B6200205 STA* KIBUSE,Q CLEAR KIB USAGE FLAG B6200206 JMP* INI10 REPEAT B6200207* B6200208* B6200209INI20 LDQ =XKIBBLN B6200210INI30 INQ -1 B6200211 SQM INI40 SKIP IF FINISHED B6200212 STA KIBBUF,Q B6200213 JMP* INI30 B6200214* B6200215INI40 LDQ =XBUFLEN CLEAR BIG BUFFER B6200216INI45 INQ -1 B6200217 SQM INI50 SKIP IF FINISHED B6200218 STA BUFFER,Q B6200219 JMP* INI45 B6200220* B6200221INI50 STA* SAVEDI CLEAR LOCAL AND COMMON INDEXES B6200222 STA* CIDENT B6200223 STA BUFIDX B6200224 LDA RQBADR SET UP REQBUF ADDRESS FOR FILE MANAGER CALLS B6200225 STA RQBUF1 B6200226ÐÐ STA RQBUF2 B6200227 STA RQBUF3 B6200228 STA RQBUF5 B6200229 LDA FCBADR STORE FCB ADDRESS FOR SETUP AND RESET B6200230 INA 5 SUBROUTINES. B6200231 STA ADFCB B6200232 LDQ* QRSAVE RELOAD Q-REG B6200233 JMP* (INIKIB) RETURN B6200234 EJT B6200235* GET NEXT AVAILABLE KIB NUMBER B6200236 SPC 2 B6200237* NXTKIB SHOULD BE CALLED AS A SUBROUTINE WITH B6200238* NO PARAMETERS. STATUS IS PASSED BACK VIA B6200239* REQSTA WHERE 0 SIGNIFIES OK AND NOT 0 SIGNI- B6200240* FIES THAT INSUFFICIENT FILE SPACE WAS B6200241* AVAILABLE FOR THE INDEX. REQSTA CAN BE USED B6200242* AS AN APPROPRIATE STATUS FOR ERCHK (REQBUF(4) B6200243* WILL BE SET AS IF A WRITER REQUEST REQUEST HADB6200244* JUST BEEN MADE. B6200245* B6200246* THE NEW RELATIVE KIB NUMBER WILL BE STORED IN B6200247* NEWKBM/NEWKBL OF COMMON. B6200248 SPC 2 B6200249NXTKIB NUM 0 B6200250 STQ* QRSAVE SAVE Q-REG CONTENTS B6200251ÐÐ LDA- I SAVE I B6200252 STA* IRSAVE B6200253 LDQ FCBADR FIRST, CHECK IF CURRENT NEXT KIB IS VALID FOR B6200254 STQ- I USE B6200255 LDQ- NEXTBM,I B6200256 LDA- NEXTBL,I B6200257 LLS 1 CONVERT TO 15 BIT FORMAT B6200258 ALS 15 B6200259 STQ* PARLST+2 B6200260 STQ* PARAMS B6200261 STA* PARLST+3 STORE NEXT KIB NO. AS SUBTRAHEND B6200262 STA* PARAMS+1 STORE ALSO FOR ADD TO 1 B6200263 LDQ- TNKEYM,I B6200264 LDA- TNKEYL,I B6200265 LLS 1 B6200266 ALS 15 B6200267 STQ* PARLST STORE TOTAL NO. OF KIB SPACES B6200268 STA* PARLST+1 B6200269 CLR A B6200270 STA* PARLST+6 CLEAR STATUS WORD B6200271 LDQ =XPARLST B6200272 RTJ DWSUB PERFORM SUBTRACT B6200273 LDA* PARLST+6 CHECK STATUS B6200274 SAZ NXT10 SKIP IF 0 - OK B6200275 LDQ RQBADR SET REQBUF(4) TO INDICATE WRITER CALL B6200276ÐÐ ENA 12 B6200277 STA- 3,Q B6200278 LDA =N$8800 SET REQSTA TO REFLECT ERROR B6200279 STA REQSTA B6200280NXT05 LDA* IRSAVE B6200281 STA- I RESTORE I-REG B6200282 LDQ* QRSAVE RESET Q AND RETURN - NO MORE KIB SPACE B6200283 JMP* (NXTKIB) B6200284 EJT B6200285NXT10 LDQ =XPARAMS B6200286 RTJ DWADD COMPUTE NEXT AVAILABLE KIB NUMBER B6200287 LDQ FCBADR B6200288 STQ- I B6200289 LDA- NEXTBM,I SET NEW KIB NUMBER TO OLD NEXT KIB NUMBER B6200290 STA NEWKBM B6200291 LDA- NEXTBL,Q B6200292 STA NEWKBL B6200293 LDQ* PARAMS+4 SET NEW NEXT KIB NUDB5R B6200294 LDA* PARAMS+5 B6200295 ALS 1 CONVERT TO 24 BIT FORMAT B6200296 LRS 1 B6200297 STQ- NEXTBM,I B6200298 STA- NEXTBL,I B6200299 CLR A CLEAR REQSTA - SIGNIFIES GOOD COMPLETION B6200300 STA REQSTA B6200301ÐÐ JMP* NXT05 SET UP FOR RETURN B6200302 SPC 3 B6200303IRSAVE NUM 0 SAVED I-REGISTER B6200304QRSAVE NUM 0 SAVED Q-REGISTER B6200305PARLST BSS PARLST(7) PARAM LIST FOR DWSUB B6200306PARAMS NUM 0,0,0,1,0,0,0 PARAM LIST FOR DWADD B6200307 EJT B6200308* MARK CURRENT KIB AS CHANGED B6200309 SPC 2 B6200310* MRKKIB SHOULD BE CALLED AS A SUBROUTINE WITH B6200311* NO PARAMETERS. AS NO I/O IS PERFORMED, NO B6200312* STATUS IS NEEDED. B6200313 SPC 2 B6200314MRKKIB NUM 0 ENTRY B6200315 ENA 1 SET A=1 FOR KIB CHANGED FLAG B6200316 LDQ CIDENT GET CURRENT KIB BUFFER IDENTIFIER B6200317 STA KIBCHG,Q STORE CHANGED FLAG IN KIBS WORD B6200318 JMP* (MRKKIB) RETURN B6200319 EJT B6200320* FREE UP KIB BUFFER FOR NEW KIB B6200321* B6200322* FREEUP SHOULD BE CALLED AS A SUBROUTINE WITH B6200323* NO PARAMETERS. STATUS IS PASSED BACK VIA B6200324* REQSTA WHERE 0 SIGNIFIES OK AND NOT 0 SIGNI- B6200325* FIES A FILE MANAGER ERROR WAS NOTED. REQSTA B6200326ÐÐ* CONTAINS THE REQUEST STATUS. B6200327* B6200328* THE NEW KIB THAT IS TO BE CREATED IS DEFINED B6200329* BY RKIBNO. B6200330* B6200331* FEEUP SETS BIT 15 OF RKIBNO(1) AND EXECUTES B6200332* GETKIB TO FREE THE KIB BUFFER FOR IT. UPON B6200333* RETURN, FREEUP CLEARS BIT 15 OF RKIBNO AND B6200334* CKBMSB. GETKIB USES BIT 15 (SET) OF RKIBNO(1)B6200335* AS A FLAG TO SIGNAL THAT THE KIB DOES NOT B6200336* EXIST AND THUS SHOULD NOT BE READ IN. B6200337* B6200338* B6200339* B6200340FREEUP NUM 0 ENTRY POINT B6200341 LDA* (KIBADR) SET BIT 15 OF RKIBNO(1) B6200342 EOR- ONEBIT+15 B6200343 STA* (KIBADR) B6200344* B6200345 RTJ GETKIB B6200346* B6200347 LDA* (KIBADR) CLEAR BIT 15 OF RKIBNO(1) B6200348 AND- ONEMSK+14 B6200349 STA* (KIBADR) B6200350 JMP* (FREEUP) B6200351ÐÐ SPC 2 B6200352KIBADR ADC RKIBNO B6200353 EJT B6200354* GET SPECIFIED KIB B6200355 SPC 2 B6200356* GETKIB SHOULD BE CALLED AS A SUBROUTINE WITH B6200357* NO PARAMETERS. STATUS IS PASSED BACK VIA B6200358* REQSTA WHERE 0 SIGNIFIES OK AND NOT 0 SIGNI- B6200359* FIES A FILE MANAGER ERROR WAS NOTED. REQSTA B6200360* CONTAINS THE REQUEST STATUS. B6200361 SPC 2 B6200362* THE REQUIRED KIB IS SPECIFIED BY RKIBNO OF B6200363* LABELLED COMMON B6200364* B6200365* IF THE SPECIFIED KIB IS IN KIBBUF OR BUFFER, B6200366* BUFIDX WILL BE SET TO AN APPROPRIATE INDEX B6200367* OFFSET SUCH THAT THE CONSTRUCTION B6200368* KIBBUF(BUFIDX+1) WILL REFERENCE THE FIRST WORDB6200369* OF THE SPECIFIED KIB. CIDENT WILL BE SET TO B6200370* IDENTIFY THE CURRENTLY SPECIFIED KIB. B6200371* B6200372* IF THE SPECIFIED KIB IS NOT IN THE LARGE KIB B6200373* BUFFER, THE RESULTING PROCESSING DEPENDS ON B6200374* WHETHER OR NOT THERE IS AN EMPTY KIB SPACE IN B6200375* THE LARGE BUFFER. B6200376ÐÐ* B6200377* IF THERE IS AN EMPTY KIB SPACE: B6200378* 1. BUFIDX AND CIDENT WILL BE SET TO ENABLE B6200379* USE OF THE EMPTY KIB SPACE. B6200380* 2. THE SPECIFIED KIB WILL BE READ INTO THE B6200381* EMPTY KIB SPACE. B6200382* 3. THE RELATED TABLES WILL BE SET TO DEFINE B6200383* THE KIB. B6200384* B6200385* IF THERE IS NO EMPTY KIB SPACE: B6200386* 1. THE KIB WITH THE SMALLEST USAGE COUNTER B6200387* (OR FIRST OF SEVERAL WITH THE SAME SMALL- B6200388* EST USAGE COUNTER) IS LOCATED. B6200389* 2. IF THE KIB HAS BEEN CHANGED, IT IS B6200390* WRITTEN TO MASS MEMORY. B6200391* 3. THE SPECIFIED KIB WILL BE READ INTO THE B6200392* EMPTIED KIB SPACE. B6200393* 4. BUFIDX AND CIDENT WILL BE SET TO ENABLE B6200394* USE OF THE KIB'S APACE. B6200395* 5. THE RELATED TABLES WILL BE SET TO DEFINE B6200396* THE KIB. B6200397 EJT B6200398* EACH TIME A KIB IS LOCATED VIA GETKIB, ALL KIBB6200399* USAGE COUNTERS ARE CHANGED. B6200400* 1. IF THE KIB WAS ALREADY RESIDENT, ITS USAGEB6200401ÐÐ* COUNTER IS INCREMENTED BY 'REWARD' AND THEB6200402* USAGE COUNTERS OF ALL OTHER RESIDENT KIBS B6200403* ARE DECREMENTED BY 'PENALT'. B6200404* 2. IF THE KIB WAS NOT ALREADY RESIDENT, ALL B6200405* REMAINING KIB'S USAGE COUNTERS ARE DECRE- B6200406* MENTED BY 'PENALT' AND THE NEW KIB'S USAGEB6200407* COUNTER IS SET TO THE HIGEST COUNTER VALUEB6200408* OF THE REMAINING KIBS. B6200409 EJT B6200410GETKIB NUM 0 ENTRY B6200411 STQ* QREG SAVE Q AND I REGISTERS B6200412 LDQ- I B6200413 STQ* IREG B6200414* B6200415 LDA* KIBADR SET I-REG TO ADDRESS OF RKIBNO B6200416 STA- I B6200417* INITIALIZE TO SEARCH KIB REL. KIB NO. TABLES B6200418* FOR REQUIRED KIB B6200419 ENA -1 B6200420 STA* IND SET SEARCH INDEX TO -1 B6200421 STA* FOUND FOUND KIB FLAG TO -1 B6200422 STA* MININD INDEX OF MINIMUM USE KIB TO -1 B6200423 CLR A B6200424 STA* MAXCNT MAXIMUM COUNT VALUE TO 0 B6200425* B6200426ÐÐ* SEARCH FOR NEEDED KIB B6200427GET10 LDQ* IND BUMP SEARCH INDEX BY 1 B6200428 INQ 1 B6200429 STQ* IND B6200430 TRQ A CHECK IF SEARCH PROCESS IS FINISHED B6200431 SUB ANUMKB B6200432 INA -1 B6200433 SAN GET20 B6200434 JMP* GET140 SEARCH IS FINISHED B6200435* B6200436GET20 LDA* (ADRMSB),Q CHECK IF A KIB IS DEFINED BY THE SLOT IND OF B6200437 SAN GET30 THE KIB TABLES B6200438 LDA* (ADRLSB),Q B6200439 SAN GET30 SKIP IF EITHER MSB OR LSB OF REL. KIB. NO. B6200440 JMP* GET130 NOT 0. ELSE GO TO GET130 B6200441* B6200442GET30 LDA* (ADRUSE),Q DECREMENT USAGE COUNTER BY PENALT - DO NOT B6200443 INA -PENALT DROP BELOW 0 B6200444 SAP GET40 B6200445 CLR A B6200446GET40 STA* (ADRUSE),Q B6200447* B6200448* CHECK IF THIS IS LARGEST USAGE COUNT - SAVE ITB6200449 SUB* MAXCNT IF YES B6200450 SAM GET45 B6200451ÐÐ LDA* (ADRUSE),Q B6200452 STA* MAXCNT B6200453 EJT B6200454GET45 LDA- (I) CHECK IF THIS IS THE REQUIRED KIB B6200455 SUB* (ADRMSB),Q B6200456 SAN GET50 B6200457 LDA- 1,I B6200458 SUB* (ADRLSB),Q B6200459 SAZ GET60 B6200460GET50 JMP* GET80 GO TO GET80 IF NOT B6200461* B6200462GET60 LDA* (ADRUSE),Q BUMP THIS KIBS COUNTER BY REWARD + PENALTY B6200463 INA REWARD+PENALT B6200464 STA* (ADRUSE),Q B6200465 STQ* FOUND SET FOUND FLAG TO KIB INDEX B6200466 STQ CIDENT SET CURRENT KIB BUFFER IDENTIFIER B6200467* B6200468* SET BUFFER INDEX FOR OTHER PROCESSORS B6200469 SQN GET70 SKIP IF NOT IN COMMON BUFFER B6200470 CLR A USE 0 AS COMMON BUFFER INDEX OFFSET B6200471 JMP* GET75 B6200472* B6200473GET70 TRQ A COMPUTE INDEX OFFSET TO ENABLE USE OF BUFFER B6200474 INA -1 KIB AS IF IT WERE IN THE COMMON BUFFER B6200475 MUI* LENGTH B6200476ÐÐ ADD =XBUFFER B6200477 SUB =XKIBBUF B6200478GET75 STA BUFIDX STORE THE INDEX OFFSET B6200479 STA SAVEDI SAVE ALSO LOCALLY B6200480 JMP GET10 GO CHECK IF THERE ARE MORE KIB SPACES TO CHECKB6200481* B6200482* A KIB SPACE EXISTS THAT HAS THE WRONG KIB B6200483GET80 LDA* MININD CHECK IF MINIMUM COUNT USAGE HAS BEEN SET YET B6200484 SAP GET100 SKIP IF YES B6200485* B6200486GET90 STQ* MININD SET INDEX OF CURRENT MINIMUM USE KIB B6200487 LDA* (ADRUSE),Q B6200488 STA* MINCNT SET USAGE COUNT B6200489 LDA* (ADRCHG),Q B6200490 STA* MINCHG SET CHANGE FLAG B6200491 JMP* GET10 GO CHECK FOR MORE KIB SPACES B6200492 EJT B6200493GET100 LDA* (ADRUSE),Q CHECK IF CURRENT KIB'S USAGE COUNT IS THE SAMEB6200494 SUB* MINCNT AS THE SAVED MIN COUNT B6200495 SAN GET110 SKIP IF NO B6200496 LDA* (ADRCHG),Q HAS THIS KIB BEEN CHANGED B6200497 SAZ GET115 SKIP IF NO B6200498 LDA* MINCHG WAS THE PREVIOUS MIN USE KIB CHANGED B6200499 SAZ GET115 SKIP IF NO B6200500 JMP* GET90 GO SWAP MIN USE KIB INFO B6200501ÐÐ* B6200502GET110 LDA* MINCNT CHECK IF THIS KIB HAS LOWER USAGE COUNT THAN B6200503 SUB* (ADRUSE),Q SAVE MIN USE KIB B6200504 SAP GET120 SKIP IF YES B6200505GET115 JMP* GET10 GO CHECK FOR MORE KIB SPACES B6200506* B6200507GET120 JMP* GET90 GO SWAP MIN USE KIB INFO B6200508 SPC 3 B6200509IND NUM 0 INDEX/COUNTER FOR KIB SEARCH B6200510FOUND NUM 0 NEEDED KIB FOUND FLAG, POSITIVE IF FOUND B6200511MININD NUM 0 INDEX OF MINIMUM USAGE COUNT KIB B6200512MINCNT NUM 0 COUNT FOR MINIMUM USAGE COUNT KIB B6200513MINCHG NUM 0 CHANGE FLAG OF MINIMUM USAGE COUNT KIB B6200514MAXCNT NUM 0 MAXIMUM USAGE COUNT B6200515QREG NUM 0 SAVED Q-REGISTER B6200516IREG NUM 0 SAVED I-REGISTER B6200517LENGTH ADC KIBLEN REAL LENGTH OF KIB (MAY BE RESET) B6200518KIBIDX NUM 0 SAVED KIB INDEX B6200519ADCBUF ADC KIBBUF ADDRESS OF COMMON BUFFER KIB B6200520ADRUSE ADC KIBUSE ADDRESS OF USAGE COUNTERS B6200521ADRCHG ADC KIBCHG ADDRESS OF CHANGE FLAGS B6200522ADRMSB ADC RKNMSB ADDRESS OF RKN MSBS B6200523ADRLSB ADC RKNLSB ADDRESS OF RKN MSBS B6200524STAT1 NUM 0 STATUS WORD FOR READ REQUEST B6200525 EJT B6200526ÐÐ* AN EMPTY KIB SPACE EXISTS SO USE IT FOR B6200527GET130 STQ* MININD NEEDED KIB B6200528 CLR A SET MIN USE KIB INDEX TO CURRENT INDEX AND B6200529 STA* MINCHG CLEAR KIB CHANGE FLAG B6200530 SPC 2 B6200531GET140 LDA* FOUND CHECK IF NEEDED KIB WAS FOUND IN A TABLE SPACEB6200532 SAM GET150 SKIP IF NO B6200533* B6200534 CLR A CLEAR A AS COMPLETION STATUS B6200535GET145 STA REQSTA STORE COMPLETION STATUS B6200536 LDQ* IREG RESTORE Q AND I-REGS AND RETURN B6200537 STQ- I B6200538 LDQ* QREG B6200539 JMP* (GETKIB) RETURN B6200540* B6200541GET150 LDA* MINCHG CHECK IF A KIB NEEDS TO BE WRITTEN OUT TO MASSB6200542 SAN GET160 MEMORY B6200543 JMP* GET180 GO TO GET180 IF WRITE NOT NEEDED B6200544* B6200545GET160 LDQ* MININD SET Q TO INDEX OF KIB TO WRITE OUT B6200546 RTJ* SETUP SET UP REQBUF AND THE FCB TO WRITE OUT THE KIBB6200547 LDA* MININD CHECK IF KIB IS IN COMMON BUFFER B6200548 SAN GET170 SKIP IF NO B6200549* B6200550 LDA* ADCBUF GET ADDRESS OF COMMON BUFFER B6200551ÐÐ JMP* GET175 B6200552* B6200553GET170 INA -1 COMPUTE ADDRESS OF KIBS SPACE WITHIN BIG B6200554 MUI* LENGTH BUFFER B6200555 ADD =XBUFFER B6200556GET175 STA* ADDR1 STORE ADDRESS FOR I/O CALL B6200557* B6200558 RTJ UPDREC STORE KIB VIA UPDATE RECORD CALL B6200559RQBUF1 ADC 0 REQBUF ADDRESS B6200560ADDR1 ADC 0 BUFFER ADDRESS B6200561 ADC STAT1 STATUS WORD B6200562* B6200563 RTJ* RESET RESET REQBUF AND FCB FOR RECORD I/O B6200564 LDA* STAT1 CHECK IF FM ERROR NOTED B6200565 SAP GET180 SKIP IF NO B6200566 JMP* GET145 GO EXIT TO CALLER B6200567* B6200568* KIB SPACE IS NOW FREE FOR NEW KIB B6200569GET180 LDA* MININD FIRST, SET INDEX OFFSET FOR OTHER PROCESSORS B6200570 SAN GET190 SKIP IF KIB SPACE NOT IN KIBBUF B6200571 LDA* ADCBUF STORE KIBBUF ADDRESS IN FM CALL FOR READ B6200572 STA* ADDR2 B6200573 CLR A B6200574 JMP* GET195 GO STORE A (=0) AS INDEX OFFSET B6200575 EJT B6200576ÐÐGET190 INA -1 COMPUTE ADDRESS OF KIBS SPACE WITHIN BIG B6200577 MUI* LENGTH BUFFER B6200578 ADD =XBUFFER B6200579 STA* ADDR2 STORE THIS AS ABSOLUTE ADDRESS FOR I/O B6200580 SUB* ADCBUF SUBTRACT KIBBUF ADDR TO GET OFFSET B6200581GET195 STA BUFIDX STORE THE INDEX OFFSET B6200582 STA SAVEDI SAVE ALSO LOCALLY B6200583 LDA =XRKIBNO B6200584 STA- I B6200585 LDA- (I) CHECK IF THIS KIB EXISTS ON MASS MEMORY B6200586 SAP GET200 B6200587 JMP* GET210 B6200588* B6200589GET200 RTJ* SETUP SET UP THE FCB AND THE REQUEST BUFFER TO B6200590* PERMIT READING IN THE NEEDED KIB B6200591 RTJ READR B6200592RQBUF2 ADC 0 REQBUF ADDRESS B6200593ADDR2 ADC 0 BUFFER ADDRESS B6200594 ADC RKIBNO RELATIVE KIB NO. - IN COMMON B6200595 ADC STAT1 STATUS WORD B6200596* B6200597 RTJ* RESET RESET THE FCB AND REQBUF FOR REG. RECORD I/O B6200598* B6200599 LDA* STAT1 CHECK IF FM ERROR RETURNED B6200600 SAP GET210 SKIP IF NO B6200601ÐÐ JMP* GET145 RETURN TO CALLER WITH ERROR B6200602* B6200603GET210 LDA* MAXCNT SET USAGE COUNT FOR NEW KIB TO MAX COUNT B6200604 LDQ* MININD B6200605 STA* (ADRUSE),Q B6200606 LDA =XRKIBNO B6200607 STA- I B6200608 LDA- (I) STORE REL. KIB NO. IN KIB BUFFER CONTROL B6200609 AND- ONEMSK+14 TABLE B6200610 STA* (ADRMSB),Q B6200611 LDA- 1,I B6200612 STA* (ADRLSB),Q B6200613 CLR A CLEAR KIB CHANGE WORD FOR NEW KIB B6200614 STA* (ADRCHG),Q B6200615 STQ CIDENT SAVE CURRENT KIB SPACE INDEX B6200616 JMP* GET145 GO RETURN TO CALLER WITH STATUS = 0 (OK) B6200617 EJT B6200618* SET UP FCB AND REQBUF FOR READ OR WRITE OF B6200619* A KIB B6200620SETUP NUM 0 ENTRY B6200621 STQ* SAVIDX SAVE Q AS INDEX TO KIB CONTROL TABLES B6200622 ENQ 8 SAVE THE FIRST 8 WORDS OF THE FCB 127*5170B6200623SET10 INQ -1 DECREMENT COUNTER B6200624 SQM SET20 B6200625 LDA* (ADFCB),Q MOVE 1 WORD B6200626ÐÐ STA* BUF1,Q B6200627 JMP* SET10 REPEAT B6200628* B6200629SET20 LDA AKIBLN RESET THE FIRST 6 WORDS TO REFLECT RECORDS. B6200630 LDQ* ADFCB THAT ARE KIB SIZED AND RECORD SPACE STARTING B6200631 STA- (ZERO),Q AT KIB SPACE. B6200632 LDA- 10,Q MOVE WORD 11 TO WORD 2 B6200633 STA- 1,Q B6200634 STA- 6,Q AND WORD 7 127*5170B6200635 LDA- 11,Q WORD 12 TO WORD 3 B6200636 STA- 2,Q B6200637 STA- 7,Q AND WORD 8 127*5170B6200638 LDA- 12,Q WORD 13 TO WORD 4 B6200639 STA- 3,Q B6200640 LDA- 13,Q WORD 14 TO WORD 5 B6200641 STA- 4,Q B6200642 LDA- 5,Q CLEAR BITS 0 AND 15 OF FCBIND WORD B6200643 AND =N$7FFE B6200644 STA- 5,Q B6200645* B6200646SET25 LDA RQBADR SAVE WORDS 13-20 OF REQBUF B6200647 INA 12 B6200648 STA- I SET I TO ADDRESS OF REQBUF(13) B6200649 ENQ 8 SET COUNTER B6200650SET30 INQ -1 B6200651ÐÐ SQM SET40 SKIP IF DONE B6200652 LDA- (ZERO),B B6200653 STA* BUF2,Q SAVE A WORD B6200654 JMP* SET30 REPEAT B6200655* B6200656SET40 LDQ* (SET25+1) SET I TO REQBUF ADDRESS B6200657 STQ- I B6200658 ENA 1 SET REQBUF(13)=1 - FOR READ B6200659 STA- 12,I B6200660 STA- 14,I SET REQBUF(15)=1 - FOR UPDATE RECORD CALL B6200661 LDQ* SAVIDX SET WORDS 16-17 TO REL. KIB NUMBER FOR UPDATE B6200662 LDA RKNMSB,Q RECORD CALL B6200663 STA- 15,I B6200664 LDA RKNLSB,Q B6200665 STA- 16,I B6200666 JMP* (SETUP) ALL SET UP - RETURN B6200667 SPC 3 B6200668BUF1 BSS BUF1(8) BUFFER TO SAVE 1ST 8 WORDS OF FCB 127*5170B6200669BUF2 BSS BUF2(8) BUFFER TO SAVE WORDS 13-20 OF REQBUF B6200670SAVIDX NUM 0 SAVED FCB SPACE INDEX B6200671ADFCB NUM 0 ADDRESS OF MAIN BODY OF THE FCB B6200672 EJT B6200673* RESET THE FCB FOR REGULAR RECORD I/O. B6200674* SETUP MUST HAVE BEEN CALLED PRIOR TO A RESET B6200675* CALL. B6200676ÐÐRESET NUM 0 ENTRY B6200677 ENQ 8 RESTORE WORDS 1-8 OF THE FCB 127*5170B6200678RES10 INQ -1 B6200679 SQM RES20 B6200680 LDA* BUF1,Q B6200681 STA* (ADFCB),Q B6200682 JMP* RES10 B6200683* B6200684RES20 LDA RQBADR RESTORE WORDS 13-20 OF REQBUF B6200685 INA 12 B6200686 STA- I B6200687 ENQ 8 B6200688RES30 INQ -1 B6200689 SQM RES40 B6200690 LDA* BUF2,Q B6200691 STA- (ZERO),B B6200692 JMP* RES30 B6200693* B6200694RES40 JMP* (RESET) ALL DONE - RETURN B6200695 EJT B6200696* WRITE ALL CHANGED RESIDENT KIBS TO MASS MEMORYB6200697 SPC 2 B6200698* WRTKIB SHOULD BE CALLED AS A SUBROUTINE WITH B6200699* NO PARAMETERS. STATUS IS PASSED BACK VIA B6200700* REQSTA WHERE 0 SIGNIFIES OK AND NOT 0 SIGNI- B6200701ÐÐ* FIES A FILE MANAGER ERROR WAS NOTED. REQSTA B6200702* CONTAINS THE REQUEST STATUS. B6200703 SPC 2 B6200704WRTKIB NUM 0 ENTRY B6200705 STQ* QSAVE SAVE Q AND I REGISTERS LOCALLY B6200706 LDQ- I B6200707 STQ* ISAVE B6200708* B6200709 LDA ANUMKB B6200710 INA 1 B6200711 STA* CNTR INITIALIZE COUNTER TO NUMBER OF KIBS B6200712* B6200713WRT10 LDQ* CNTR DECREMENT COUNTER/INDEX B6200714 INQ -1 B6200715 STQ* CNTR B6200716 SQP WRT20 SKIP IF NOT DONE B6200717 JMP* WRT60 B6200718* B6200719WRT20 LDA KIBCHG,Q CHECK IF QTH KIB WAS CHANGED B6200720 SAN WRT25 SKIP IF YES B6200721 JMP* WRT50 B6200722* B6200723WRT25 RTJ* SETUP SET UP FOR OUTPUT OF KIB (VIA UPDREC CALL) B6200724 LDA* CNTR COMPUTE AND STORE START ADDRESS OF QTH KIB B6200725 SAZ WRT30 SKIP IF INDEX IS FOR KIBBUF KIB B6200726ÐÐ INA -1 DECREMENT INDEX AS 1 IS FOR FIRST BUFFER KIB B6200727 MUI* LEN B6200728 ADD =XBUFFER B6200729 JMP* WRT40 B6200730* B6200731WRT30 LDA =XKIBBUF USE KIBBUF ADDRESS B6200732* B6200733WRT40 STA* ADDR3 B6200734* B6200735 RTJ UPDREC B6200736RQBUF3 ADC 0 REQBUF ADDRESS B6200737ADDR3 ADC 0 KIB START ADDRESS B6200738 ADC STAT2 STATUS WORD B6200739* B6200740 RTJ* RESET RESET THE FCB AND REQBUF FOR REGULAR PROCESSINB6200741 LDA* STAT2 B6200742 SAP WRT50 CHECK STATUS - SKIP IF OK B6200743 JMP* WRT80 EXIT WITH ERROR STATUS IN A-REG B6200744* B6200745WRT50 JMP* WRT10 GO CHECK NEXT KIB B6200746* B6200747* ALL CHANGED KIBS HAVE BEEN OUTPUT B6200748WRT60 LDQ FCBADR CHECK IF THE LAST KIB POSITION HAS BEEN USED B6200749 STQ- I B6200750 LDQ- NEXTBM,I B6200751ÐÐ LDA- NEXTBL,I B6200752 STQ RKNMSB STORE FOR POSSIBLE WRITE B6200753 STA RKNLSB B6200754 LLS 1 CONVERT TO 15 BIT FORMAT B6200755 ALS 15 B6200756 STQ* PLIST+2 SET UP TO SUBTRACT NEXT KIB FROM TOTAL KIBS B6200757 STA* PLIST+3 B6200758 LDQ- TNKEYM,I B6200759 LDA- TNKEYL,I B6200760 LLS 1 CONVERT TO 15 BIT FORMAT B6200761 ALS 15 B6200762 STQ* PLIST B6200763 STA* PLIST+1 B6200764 LDQ =XPLIST B6200765 RTJ DWSUB PERFORM THE SUBTRACT B6200766 LDA* PLIST+6 CHECK STATUS B6200767 SAZ WRT65 SKIP IF NO ERROR B6200768 JMP* WRT70 B6200769* B6200770WRT65 ENQ 0 B6200771 RTJ SETUP SET UP FOR KIB OUTPUT FROM 1ST KIB SPACE B6200772* B6200773 LDA =XFMEOFC STORE END OF FILE CODE IN FIRST 2 WORDS OF B6200774 LDQ* BADR BUFFER B6200775 STA- (ZERO),Q B6200776ÐÐ STA- 1,Q B6200777 EJT B6200778 RTJ UPDREC OUTPUT THE KIB B6200779RQBUF5 ADC 0 REQBUF ADDRESS B6200780BADR ADC BUFFER KIB BUFFER ADDRESS B6200781 ADC STAT2 STATUS WORD B6200782* B6200783 RTJ RESET RESET REQBUF AND THE FCB B6200784 LDA* STAT2 SET A TO STATUS B6200785 JMP* WRT80 B6200786* B6200787WRT70 CLR A CLEAR A AS COMPLETION STATUS B6200788WRT80 LDQ* ISAVE B6200789 STQ- I B6200790 LDQ* QSAVE RESTORE Q AND I REGS B6200791 STA REQSTA STORE COMPLETION STATUS B6200792 JMP* (WRTKIB) RETURN TO CALLER B6200793 SPC 3 B6200794LEN ADC KIBLEN REAL LENGTH OF KIB (MAY BE RESET) B6200795ISAVE NUM 0 B6200796QSAVE NUM 0 B6200797CNTR NUM 0 LOOP COUNTER B6200798STAT2 NUM 0 FILE REQUEST STATUS B6200799 BSS PLIST(7) PARAMETER LIST FOR DWSUB B6200800 SPC 3 B6200801ÐÐ END B6200802 NAM GETSSZ B63 A ITOS CCS 3.0 SL-149 00001* GET SECTOR SIZE ROUTINE 00002* CREDIT COLLECTION SYSTEM VERSION 3.0 00003* DATA SYSTEMS- LA JOLLA DIVISION, LA JOLLA CALIFORNIA 00004* COPYRIGHT CONTROL DATA CORPORATION 1979 00005* 00006 SPC 2 00007 ENT GETSSZ 00008 SPC 2 00009 EXT Q8PREP 00010 EXT Q8PKUP 00011 EXT MMLUTB FM TABLE IN SYSDAT 00012 SPC 2 00013 EQU ONEMSK(3) BIT TABLE IN SYSDAT 00014 EQU VIWPS(13) WORDS PER SECTOR ENTRY OF VIT TBL. IN SYSDAT 00015 SPC 2 00016GETSSZ 0 0 00017 STQ* QSAVE 00018 RTJ Q8PREP 00019 ADC* GETSSZ 00020 RTJ Q8PKUP 00021 STA* PSUFID 00022 RTJ Q8PKUP 00023 STA* SIZE ADDRESS OF SIZE PARAMETER 00024ÐÐ LDA* (PSUFID) GET PSEUDO FILE ID OF FILE 00025 ARS 11 AND EXTRACT MM LU PORTION 00026 AND- ONEMSK+4 00027 TRA Q 00028 LDQ MMLUTB,Q 00029 LDA- VIWPS,Q GET WPS FOR THAT UNIT 00030 STA* (SIZE) 00031 LDQ* QSAVE 00032 JMP* (GETSSZ) 00033 SPC 2 00034QSAVE NUM 0 00035PSUFID NUM 0 00036SIZE NUM 0 00037 END 00038 NAM UTCKLN B64 A ITOS CCS 3.0 . SL-149 00001* COMPUTE LENGTH OF KIB IN SECTORS 00002* CREDIT COLLECTION SYSTEM VERSION 3.0 00003* DATA SYSTEM-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00004* COPYRIGHT CONTROL DATA CORPORATION 1979 00005* 00006**** 00007* 00008* THIS ROUTINE COMPUTES THE LENGTH OF A KIB IN WORDS. 00009* IF SECTOR LENGTH = 96 WORDS, KIB LENGTH IS SET TO 3 00010* SECTORS($120 WORDS) TO REMAIN COMPATIBLE WITH PREVIOUS VERSIONS 00011ÐÐ* 00012* IF SECTOR LENGTH IS NOT 96 WORDS, KIB LENGTH IS SET TO THE NUMBER 00013* OF SECTORS OF DATA THAT WILL FIT INTO A 572 WORD BUFFER. 00014* 00015* CALLING SEQUENCE: 00016* CALL UTCKLN (WPS,KIBLEN) 00017* 00018* PARAMETERS: 00019* WPS - SECTOR SIZE (IN WORDS) 00020* KIBLEN - PASSED BACK TO CALLER 00021* 00022* EXIT: 00023* Q AND I REGISTERS ARE PRESERVED 00024* 00025*E 00026 ENT UTCKLN PROGRAM ENTRY POINT 00027* 00028* EXTERNALS 00029 EXT Q8PREP PREPARE TO PICKUP PARAMETER ADDRESS 00030 EXT Q8PKUP PICKUP/ABSOLUTIZE PARAMETER ADDRESS 00031* 00032* EQUIVALENCES 00033 EQU ZERO($22) 00034 SPC 2 00035UTCKLN 0 0 00036ÐÐ STQ* QSAVE 00037 RTJ Q8PREP 00038 ADC* UTCKLN 00039 RTJ Q8PKUP 00040 TRA Q 00041 LDA- (ZERO),Q = WPS 00042 STA* WPS 00043 RTJ Q8PKUP 00044 STA* KIBLEN = ADDRESS OF KIBLEN 00045* 00046CP00 LDA* WPS 00047 INA -96 00048 SAN CP10 SENSE NOT 96 WORD SECTORS 00049 LDA =N$120 USE 3 SECTORS AS KIB LENGTH. 00050 JMP* CP20 00051* 00052CP10 LDA =N572 COMPUTE LENGTH = 572/VIWPS 00053 ENQ 0 00054 DVI* WPS 00055 MUI* WPS 00056CP20 STA* (KIBLEN) STORE IT FOR USER 00057 LDQ* QSAVE 00058 JMP* (UTCKLN) RETURN 00059* 00060QSAVE NUM 0 00061ÐÐWPS NUM 0 00062KIBLEN NUM 0 00063 END 00064 NAM VERWPS B65 A ITOS CCS 3.0 SL-149 00001* CHECK COMPATIBILITY BETWEEN DISK PACK AND DISK DRIVE 00002* CREDIT COLLECTION SYSTEM VERSION 3.0 00003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00004* COPYRIGHT CONTROL DATA CORPORATION 1979 00005 SPC 2 00006* FUNCTION 00007 SPC 1 00008* THIS ROUTINE CHECKS THE COMPATIBILITY OF THE DISK PACK 00009* FORMAT, THE DISK DRIVE SECTORS/TRACK PLUG WIRING AND THE 00010* PHYSICAL DEVICE TABLE DEFINITIONS FOR A SPECIFIED LOGICAL 00011* UNIT. A STATUS IS RETURNED. 00012 SPC 1 00013* CALLING SEQUENCE 00014 SPC 1 00015* CALL VERWPS(LU,STATUS) 00016* LU = MSOS LOGICAL UNIT NO. FOR A MM DEVICE 00017* STATUS = 0 RETURNED IF FOUND COMPATIBLE 00018* 1 RETURNED IF FOUND INCOMPATIBLE 00019 SPC 2 00020 ENT VERWPS 00021 ENT LVERWP LENGTH OF VERWPS SUBROUTINE 00022ÐÐ SPC 2 00023 EXT LOG1A LOGICAL UNIT VECTOR TABLE 00024 SPC 2 00025 EQU AMONI($F4),ADISP($EA) 00026 EQU ZERO($22),H7FFF($11) 00027 EQU DIAGLU(17),WDSSEC(70) 00028 SPC 2 00029VERWPS 0 0 00030 STQ* QSAVE 00031 LDA- I 00032 STA* ISAVE 00033 LDA* (VERWPS) GET ADDRESS OF PARAMETERS 00034 STA* ALU 00035 RAO* VERWPS 00036 LDA* (VERWPS) 00037 STA* ASTAT 00038 RAO* VERWPS (BUMP FOR RETURN) 00039******** GET DIAGNOSTIC LU CORRESPONDING TO GIVEN LU FROM P. D. T. 00040 LDQ =XLOG1A 00041 ADQ* (ALU) 00042 LDQ- (ZERO),Q 00043 STQ* APDT 00044 LDA- DIAGLU,Q 00045 STA* LU 00046 RTJ* MYLOC 00047ÐÐMYLOC NUM 0 00048 LDA* MYLOC 00049 INA CA-MYLOC 00050 STA* REQ1+1 00051 INA TAGBUF-CA 00052 STA* REQ1+5 00053******** READ IN TWO TAGS 00054 RTJ- (AMONI) 00055REQ1 ADC $4244,CA,0 00056LU ADC 0,10,TAGBUF,0,0 (10 WORDS FROM SECTORS 0,1) 00057 JMP- (ADISP) 00058* 00059CA SQP CA01 SENSE NO I/O ERROR 00060 JMP* CA06 00061******** VERIFY PACK SECTOR SIZE(FIELD LENGTH) AND P. D. T. 00062******** WORDS/SECTOR ARE EQUAL. 00063CA01 LDQ* APDT 00064 LDA- WDSSEC,Q (=WORDS/SECTOR) 00065 ALS 1 00066 INA -1 (= FIELD LENGTH FORMAT) 00067 TRA Q 00068 LDA* TAGBUF+4 (= FIELD LENGTH, TAG 0) 00069 ALS 8 (TAGS HAVE FIELD LENGTH BYTES REVERSED) 00070 AND- H7FFF (REMOVE BAD SECTOR FLAG) 00071 EAQ A 00072ÐÐ SAZ CA02 SENSE TAG 0 FIELD LENGTH OK 00073 JMP* CA06 00074******** VERIFY TAG 1 FORMAT 00075CA02 LDA* TAGBUF+9 (= FIELD LENGTH, TAG 1) 00076 ALS 8 (TAGS HAVE FIELD LENGTH BYTES REVERSED) 00077 AND- H7FFF (REMOVE BAD SECTOR FLAG) 00078 EAQ A 00079 SAZ CA03 SENSE TAG 1 FIELD LENGTH OK 00080 JMP* CA06 00081* 00082CA03 ENQ 4 00083CA04 INQ -1 00084 SQM CA05 SENSE TAG 1 VERIFY DONE W/O ERROR 00085 LDA* TAGBUF+5,Q 00086 SUB* TAG1,Q 00087 SAN CA06 SENSE TAG 1 FORMAT INCORRECT 00088 JMP* CA04 00089******** DISK PACK/DISK DRIVE COMPATIBLE 00090CA05 ENA 0 SET STATUS COMPATIBLE 00091 JMP* CA07 00092******** DISK PACK/DISK DRIVE NOT COMPATIBLE 00093CA06 ENA 1 SET STATUS INCOMPATIBLE 00094CA07 STA* (ASTAT) 00095 LDA* ISAVE 00096 STA- I 00097ÐÐ LDQ* QSAVE 00098 JMP* (VERWPS) RETURN 00099 SPC 2 00100QSAVE NUM 0 00101ISAVE NUM 0 00102ALU NUM 0 00103ASTAT NUM 0 00104APDT NUM 0 00105TAGBUF BZS TAGBUF(10) 00106TAG1 NUM 0,0,0,1 TAG 1 FORMAT(WDS 0-3) 00107LVERWP EQU LVERWP(*-VERWPS) 00108 END 00109 MON 00001 MACRO FMUCOM C0100001C C01 F ITOS CCS 3.0 SL-149C0100002C COMMON MACRO FOR UTILITY FORTRAN PROGRAMS C0100003C ************************************************************* 122*4875C0100004C CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.1 C0100005C ************************************************************* 122*4875C0100006C THIS IS THE LABELED COMMON AREA FOR THE FILE-MANAGER UTILITY PROGRAMSC0100007C C0100008 INTEGER COMCOD,PARNAM,PPHELP,PPINIT,PPDEFI C0100009 INTEGER PPSTAT,PPRELO,PPDUMP,PPCOPY,PPDELE C0100010 INTEGER PPCLEA,PPLIST,PPRENA,PPCOMM,PPEXIT C0100011 INTEGER PPMOUN,PPDISM,PPSAVE,PPBATC,PPLOAD C0100012ÐÐ INTEGER PPPURG,PPINPU,PPOUTP,PPCOMP,DUMMY C0100013 INTEGER CODE,SWORD,SBYTE,PARLST,PIND,REQBUF C0100014 INTEGER PARDEF C0100015 INTEGER PPHOST,PPSET,PPBATS,PPDISC C0100016 INTEGER PPDISP,PPFLUS,PPPRIN C0100017 INTEGER FCBHDR,FCBBUF C0100018C C0100019C ************************************************************* 122*4875C0100020 COMMON /AA/COMCOD(133),PARNAM(124) C0100021C ************************************************************* 122*4875C0100022 COMMON /AA/PPHELP(2),PPINIT(4),PPDEFI(16) C0100023C ************************************************************* 122*4875C0100024 COMMON /AA/PPSTAT(4),PPRELO(5),PPDUMP(5) C0100025C ************************************************************* 122*4875C0100026 COMMON /AA/PPCOPY(6),PPDELE(3),PPCLEA(3) C0100027C ************************************************************* 122*4875C0100028 COMMON /AA/PPLIST(6),PPRENA(5),PPCOMM(2) C0100029C ************************************************************* 122*4875C0100030 COMMON /AA/PPEXIT(1),PPMOUN(3),PPDISM(2) C0100031C ************************************************************* 122*4875C0100032 COMMON /AA/PPSAVE(3),PPBATC(8),PPLOAD(5) C0100033C ************************************************************* 122*4875C0100034 COMMON /AA/PPPURG(3),PPINPU(2),PPOUTP(2) C0100035 COMMON /AA/PPCOMP(3) C0100036 COMMON /AA/PPHOST(4),PPSET(3),PPBATS(4),PPDISC(2) C0100037ÐÐ COMMON /AA/PPDISP(7),PPFLUS(3),PPPRIN(3) C0100038 COMMON /AA/DUMMY(6) C0100039 COMMON /AA/INBUF(41),CODE(20) C0100040 COMMON /AA/LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST C0100041 COMMON /AA/NOCOD,PIND,REQBUF(24),IDATA(24) C0100042 COMMON /AA/PARDEF(24) C0100043 COMMON /AA/FCBHDR(5),FCBBUF(96) C0100044 COMMON /AA/ISPARE(72) C0100045C THE ISPARE ARRAY WAS ADDED TO MAKE THE LENGTH C0100046C OF THIS DEFINITION OF COMMON TO BE THE SAME AS C0100047C FMCOM'S DEFINITION. THIS WAS LENGTHENED FOR LARGE C0100048C SECTOR IMPLEMENTATION. C0100049C .................... END OF FMUCOM MACRO ..................... C0100050 END C0100051 MACRO FMCOM C0100052C DECK-ID C01 CCS 2.1 SUMMARY-126C0100053**** C0100054C MACRO DEFINING COMMON FOR SPECIAL INDEXED LOAD PROGRAMS OF THE C0100055C UTILITIES. C0100056 COMMON /AA/RQBADR C0100057 COMMON /AA/FCBADR C0100058 COMMON /AA/EOF C0100059 COMMON /AA/FTHRUD C0100060 COMMON /AA/I C0100061 COMMON /AA/J C0100062ÐÐ COMMON /AA/KEYFND C0100063 COMMON /AA/KEYLNG C0100064 COMMON /AA/KEYLWD C0100065 COMMON /AA/KEYTYP C0100066 COMMON /AA/KEYVAL(15) C0100067 COMMON /AA/KIBBUF(572) C0100068 COMMON /AA/KIBHRL C0100069 COMMON /AA/KIBLEN C0100070 COMMON /AA/KIBTYP C0100071 COMMON /AA/KISA (17) C0100072 COMMON /AA/KISA1 (17) C0100073 COMMON /AA/KISBUF(17) C0100074 COMMON /AA/KISD (17) C0100075 COMMON /AA/KISFND C0100076 COMMON /AA/KISIDX C0100077 COMMON /AA/KISLNG C0100078 COMMON /AA/KLIDX (4) C0100079 COMMON /AA/LASTKB C0100080 COMMON /AA/LASTSS C0100081 COMMON /AA/LCKFLG C0100082 COMMON /AA/MAXKIS C0100083 COMMON /AA/NEWBUF C0100084 COMMON /AA/NEWKBM C0100085 COMMON /AA/NEWKBL C0100086 COMMON /AA/NOROOT C0100087ÐÐ COMMON /AA/NKIBNL C0100088 COMMON /AA/NKIBNM C0100089 COMMON /AA/NUMKIS C0100090 COMMON /AA/PKIBNL C0100091 COMMON /AA/PKIBNM C0100092 COMMON /AA/RECLNG C0100093 COMMON /AA/REQSTA C0100094 COMMON /AA/RKIBNO(2) C0100095 COMMON /AA/ROOT C0100096 COMMON /AA/RRDATA(2) C0100097 COMMON /AA/SSET C0100098 COMMON /AA/WPS C0100099 COMMON /AA/ZERO2 (2) C0100100 COMMON /AA/BUFIDX C0100101 INTEGER BUFIDX, CMPSTG, EOF , FCBAD C0100102 INTEGER FCBADR, FTHRUD, FWAKIS, KEYFND, KEYLNG C0100103 INTEGER KEYLWD, KEYTYP, KEYVAL, KIBBUF, KIBHRL C0100104 INTEGER KEYLEN, KIBSEC, KIBTYP, KISA , KISA1 C0100105 INTEGER KISBUF, KISD , KISFND, KISIDX, KISLNG, KLIDX , LASTKB C0100106 INTEGER LASTSS, LCKFLG, MAXKIS, NEWBUF, NEWKBL C0100107 INTEGER NEWKIB(2) , NKIBNL, NKIBNM, NOROOT, NUMKIS C0100108 INTEGER PKIBNL, PKIBNM, RECLNG C0100109 INTEGER REQSTA, RKIBNO, ROOT , RQBADR, RRDATA, SSET C0100110 INTEGER VIWPS, WPS, ZERO2 C0100111 EQUIVALENCE (NEWKIB (1) ,NEWKBM) C0100112ÐÐ EQUIVALENCE (NEWKIB (2) ,NEWKBL) C0100113**** C0100114 END C0100115 MACRO FMCOM2 C0100116C DECK-ID C01 ITOS 1.2 SUMMARY-126C0100117**** C0100118C MACRO CONTAINING BIT DEFINITIONS OF THE REQUEST STATUS WORD. C0100119C C0100120 INTEGER ERRIDC, BADREQ, DATFUL, KIDERR, KIDFUL, BADKEY, NOKEY C0100121 INTEGER HITEOF, RCDLCK, MMIOER, RECDUP, LCKIDC C0100122 BYTE (ERRIDC, REQSTA(15=15)) C0100123 BYTE (BADREQ, REQSTA(13=13)) C0100124 BYTE (DATFUL, REQSTA(12=12)) C0100125 BYTE (KIDERR, REQSTA(11=11)) C0100126 BYTE (KIDFUL, REQSTA(11=11)) C0100127 BYTE (BADKEY, REQSTA(9=9)) C0100128 BYTE (NOKEY , REQSTA( 9= 9)) C0100129 BYTE (HITEOF, REQSTA( 8= 8)) C0100130 BYTE (RCDLCK, REQSTA (7= 7)) C0100131 BYTE (MMIOER, REQSTA( 5= 5)) C0100132 BYTE (RECDUP, REQSTA( 4= 4)) C0100133 BYTE (LCKIDC, REQSTA( 2= 2)) C0100134**** C0100135 END C0100136 MACRO FMCOM3 C0100137ÐÐC DECK-ID C01 ITOS 1.2 SUMMARY-126C0100138**** C0100139C MACRO CONTAINING DEFINITIONS FOR SPECIAL INDEXED LOAD PROGRAMS OFC0100140C UTILITIES. C0100141C C0100142C BUFIDX - KIBBUF INDEX - APPLY TO NORMAL LOCAL INDEX C0100143C CMPSTG - INTEGER FUNCTION C0100144C DATFUL - STATUS BIT: INSUFFICIENT ROOM TO STORE DATA C0100145C EOF - EOF ENCOUNTERED FLAG C0100146C FCBADR - ADDRESS OF FCB FOR FILE (IN BLDIDR) C0100147C FTHRUD - FATHER KIB ALREADY UPDATED FLAG C0100148C FWAKIS - INTEGER FUNCTION C0100149C I - SCRTACH C0100150C J - SCRTACH C0100151C KEYFND - EXACT KEY VALUE FOUND, SET BY POSKID C0100152C KEYLNG - LENGTH OF KEY (IN BYTES) CURRENTLY WORKED ON C0100153C KEYLWD - LENGTH OF KEY IN WORDS C0100154C KEYTYP - KEY TYPE FOR KEY BEING WORKED ON (1<=KEYTYP<=4) C0100155C KEYVAL - VALUE OF KEY BEING WORKED ON C0100156C KIBBUF - BUFFER FOR KIB CURRENTLY WORKED ON C0100157C KIBHRL - LENGTH OF HEADER IN KIB BLOCK, BEFORE KIS STARTS C0100158C KIBLEN - LENGTH OF KIB IN WORDS C0100159C KIBSEC - NO. OF SECTORS PER KIB C0100160C KIBTYP - POSITION OF KIB TYPE IB KIB HEADER C0100161C KIDERR - KID IS NOT FULLY UPDATED BECASUE IT IS MESS UP C0100162ÐÐC KIDFUL - STATUS BIT: INDEXES NOT FULLY UPDATED DUE TO C0100163C INSUFFICIENT ROOM IN KEY INFO C0100164C KISA - KIS TO BE ADDED IN AN UPDATE C0100165C KISA1 - KIS TO BE ADDED IN AN UPDATE C0100166C KISBUF - KIS BUFFER CURRENTLY WORKED ON C0100167C KISD - KIS TO BE DELETED IN AN UPDATE C0100168C KISFND - FLAG WHETHER THE EXACT KIS IS FOUND C0100169C SET BY POSKID C0100170C KISLNG - LENGHT OF A KIS IN WORDS C0100171C KLIDX - INDEX INTO ENTRIES IN FCB FOR KEY LENGTH C0100172C OF THE DIFFERENT KEY TYPE C0100173C LASTKB - FLAG THAT THE LAST KIB IS BEGIN USED C0100174C LASTSS - LAST S.S. ENCOUNTERED FLAG. SET IN SUBROUTINE C0100175C NEXTSS C0100176C LCKFLG - RECORD IS TO BE LOCKED FLAG C0100177C LCKIDC - STATUS BIT: FILE IS LOCKED INDICATOR C0100178C MAXKIS - MAX NUMBER OF KISES IN A KIB C0100179C MMIOER - STATUS BIT: MASS MEMORY I/O ERROR C0100180C NEWBUF - FLAG THAT T[ KIB IS A NEW ONE C0100181C NEWKBL - NEW KIB NUMBER, LSB C0100182C NEWKBM - NEW KIB NUMBER, MSB C0100183C NEWKIB - RELATIVE KIB NUMBER OF LASTEST KIB C0100184C NKIBNL - POSITION OF NEXT KIB, LEAST SIGNIFICANT BITS C0100185C NKIBNM - POSITION OF NEXT KIB, MOST SIGNIFICANT BITS C0100186C NOKEY - STATUS BIT: KEY IS NOT FOUND C0100187ÐÐC NOROOT - KIB TYPE FOR NOT ROOT, NOR S.S C0100188C NUMKIS - POSITION OF NUMBER OF KIS IN KIB C0100189C PKIBNL - POSITION OF PREVIOUS KIB, LEAST SIGNIFICANT BITS C0100190C PKIBNM - POSITION OF PREVIOUS KIB, MOST SIGNIFICANT BITS C0100191C RECDUP - STATUS BIT: KEY IS DUPLICATED C0100192C RECLNG - RECORD LENGTH IN WORDS C0100193C REQSTA - STATUS OF REQUEST ,LOCAL VERSION OF ISTAT C0100194C RKIBNO - RELATIVE KIB NUMBER IN KEY INFO SECTION C0100195C ROOT - KIB TYPE FOR ROOT C0100196C RQBADR - ADDRESS OF REQBUF (IN BLDIDR) C0100197C RRDATA - RELATIVE RECORD NO. IN DATA FILE C0100198C SSET - KIB TYPE FOR SEQUENCE SET C0100199C VIWPS - WORDS PER SECTOR IN VOLUME C0100200C WPS - WORDS PER SECTOR FOR THIS VOLUME C0100201C ZERO2 - CONSTANT C0100202C C0100203C ENTRY IN REQBUF C0100204C WORD 1 - Q REGISTER C0100205C WORD 2 - I REGISTER GC0100206C WORD 3 - ADDRESS OF PARAMETER LIST C0100207C WORD 4 - UCT ENTRY INDEX AND ACESS MODE C0100208C WORD 5 - USER IDENTIFIER C0100209C WORD 6 - FCB ADDRESS C0100210C WORD 7 RETURN ADDRESS TO INTERCEPTOR C0100211C WORD 8 REQUEST PROCESSOR INDEX C0100212ÐÐC WORD 9 BIT 15 = 0 DO NOT LOCK RECORD ON RETRIEVAL C0100213C BIT 15 = 1 LOCK RECORD ON RETRIEVAL C0100214C BITS 14-00 NUMBER OF RECORDS PER CALL C0100215C WORD 10 - KEY TYPE C0100216C WORD 11 - NO. OF RECORDS ACTUALLY RETRIEVED C0100217C WORD 12 - REL REC NO. OF FIRST RECORD STORED/RETRIEVED,MSB C0100218C WORD 13 - REL REC NO. OF FIRST RECORD STORED/RETRIEVED,LSB C0100219C WORD 14 - REL KIB NO. OF LAST RETRIEVED KIB, MSB C0100220C WORD 15 - REL KIB NO. OF LAST RETRIEVED KIB, LSB C0100221C WORD 16 - INDEX OF KIS POINTING TO RECORD LAST RETRIEVED C0100222C WORD 17 - REL REC NO. OF LAST RETRIEVED RECORD, MSB C0100223C WORD 18 - REL REC NO. OF LAST RETRIEVED RECORD, LSB C0100224C------------------------------------------------------ -------------- C0100225**** C0100226. C0100227 END C0100228 SUBROUTINE TODAY(ARG) C0200001 1 /C02 F ITOS CCS 3.0 SL-149C0200002C GET TODAY'S DATE C0200003C CREDIT COLLECTION SYSTEM VERSION 3.0 C0200004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C0200005C COPYRIGHT CONTROL DATA CORPORATION 1979 C0200006C C0200007 INTEGER TEMP(3),ARG(3),AMONTO,ADAYTO,AYERTO C0200008 EXTERNAL AMONTO,ADAYTO,AYERTO C0200009ÐÐC BELOW IS: C0200010C LDA+ AMONTO C0200011C STA FCBBUF+91 C0200012C LDA+ ADAYTO C0200013C STA FCBBUF+92 C0200014C LDA+ AYERTO C0200015C STA FCBBUF+93 C0200016 ASSEM $C400,+AMONTO,$6800,TEMP(1) C0200017 ASSEM $C400,+ADAYTO,$6800,TEMP(2) C0200018 ASSEM $C400,+AYERTO,$6800,TEMP(3) C0200019 ARG(1)=TEMP(1) C0200020 ARG(2)=TEMP(2) C0200021 ARG(3)=TEMP(3) C0200022 RETURN C0200023 END C0200024 SUBROUTINE ERCHK(ISTAT,ICALL) C0300001 1 /C03 F ITOS CCS 3.0 SL-149C0300002C DETERMINES WHICH FM ERROR OCCURRED C0300003C CREDIT COLLECTION SYSTEM VERSION 3.0 C0300004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C0300005C COPYRIGHT CONTROL DATA CORPORATION 1979 C0300006C C0300007C C0300008C FUNCTION C0300009C C0300010ÐÐC THIS ROUTINE DETERMINES WHICH BIT OF ISTAT IS SET AND C0300011C SUBMITS THE ERROR MSG CORRESPONDING TO THE TYPE(ICALL) OF C0300012C FILE MANAGER REQUEST MADE C0300013C C0300014C GENERAL DESCRIPTION C0300015C C0300016C UPON ENTRY A CHECK IS MADE WHICH FM-REQ STATUS HAS TO BE C0300017C EXAMINED.IMSK IS THE BIT TO CHECK AND ALL ERNUM ARE RELATIVE C0300018C TO THE ERROR-BASE NUMBER(ERBAS) C0300019C C0300020C CALLING SEQUENCE C0300021C CALL ERCHK(ISTAT,ICALL) C0300022C C0300023C ISTAT = STATUS RETURNING FROM FM-REQUEST C0300024C ICALL = TYPE NO OF FM-REQUEST (CONTAINED IN REQBUF(4)) C0300025C C0300026 INTEGER ERBAS,ERNUM,ERBUF C0300027C C0300028C EXTERNAL C0300029C C0300030 EXTERNAL SYSMSG C0300031C C0300032 ERBAS=30 C0300033+ ERROR BASE NO C0300034 ICNT=0 C0300035ÐÐC C0300036C FIND ERROR BIT C0300037C C0300038 IMSK=1 C0300039 DO 30 I=0,14 C0300040 IF(AND(ISTAT,IMSK)) 10,20,10 C0300041 10 ICNT=I C0300042 GO TO 40 C0300043 20 IMSK=IMSK*2 C0300044 30 CONTINUE C0300045C C0300046C WHICH FM-REQUEST C0300047C C0300048 40 GO TO (100,200,200,400,500,600,700,800,800,1000,1100,1200,1300, C0300049 *1300,1500,1600,1700,1800),ICALL C0300050C C0300051C C0300052C CREATE FILE C0300053C C0300054 100 ICNT=ICNT+1 C0300055 GO TO (9998,9998,9998,9998,9998,105,9998,9998,9998,9998,110,111, C0300056 *112,113,114,9998),ICNT C0300057 105 ERNUM=5 C0300058 GO TO 9999 C0300059 110 ERNUM=27 C0300060ÐÐ GO TO 9999 C0300061 111 ERNUM=25 C0300062 GO TO 9999 C0300063 112 ERNUM=25 C0300064 GO TO 9999 C0300065 113 ERNUM=6 C0300066 GO TO 9999 C0300067 114 ERNUM=7 C0300068 GO TO 9999 C0300069C C0300070C CLEAR FILE/DELETE FILE C0300071C C0300072 200 ICNT=ICNT+1 C0300073 GO TO (210,211,9998,9998,9998,215,9998,9998,9998,9998,9998,9998, C0300074 *9998,223,224,9998),ICNT C0300075C C0300076 210 ERNUM=8 C0300077 GO TO 9999 C0300078 211 ERNUM=4 C0300079 GO TO 9999 C0300080 215 ERNUM=5 C0300081 GO TO 9999 C0300082 223 ERNUM=6 C0300083 GO TO 9999 C0300084 224 ERNUM=7 C0300085ÐÐ GO TO 9999 C0300086C C0300087C OPEN FILE C0300088C C0300089 400 ICNT=ICNT+1 C0300090 GO TO (210,211,412,9998,9998,215,9998,9998,9998,9998,420,421,422, C0300091 *223,224,9998),ICNT C0300092 412 ERNUM=12 C0300093 GO TO 9999 C0300094 420 ERNUM=13 C0300095 GO TO 9999 C0300096 421 ERNUM=14 C0300097 GO TO 9999 C0300098 422 ERNUM=15 C0300099 GO TO 9999 C0300100C C0300101C CLOSE FILE C0300102C C0300103 500 ICNT=ICNT+1 C0300104 GO TO(9998,9998,9998,9998,9998,215,9998,9998,9998,9998,9998,9998, C0300105 *9998,510,224,9998),ICNT C0300106 510 ERNUM=29 C0300107 GO TO 9999 C0300108C C0300109C LOCK FILE C0300110ÐÐC C0300111 600 ICNT=ICNT+1 C0300112 GO TO (610,9998,9998,620,9998,9998,9998,9998,9998,9998,9998,9998, C0300113 *9998,510,224,9998),ICNT C0300114 610 ERNUM=51 C0300115 GO TO 9999 C0300116 620 ERNUM=52 C0300117 GO TO 9999 C0300118C C0300119C UNLOCK FILE C0300120C C0300121 700 ICNT=ICNT+1 C0300122 GO TO (9998,9998,710,9998,9998,9998,9998,9998,9998,9998,9998,9998,C0300123 *9998,510,9998,9998),ICNT C0300124 710 ERNUM=53 C0300125 GO TO 9999 C0300126C C0300127C GET FCB/UPDATE FCB C0300128C C0300129 800 ICNT=ICNT+1 C0300130 GO TO (9998,9998,9998,9998,9998,215,9998,9998,9998,9998,9998,9998,C0300131 *810,223,224,9998),ICNT C0300132 810 ERNUM=28 C0300133 GO TO 9999 C0300134C C0300135ÐÐC RENAME C0300136C C0300137 1000 ICNT=ICNT+1 C0300138 GO TO (210,211,9998,9998,9998,215,9998,9998,9998,9998,1010,1011, C0300139 *9998,223,224,9998),ICNT C0300140 1010 ERNUM=27 C0300141 GO TO 9999 C0300142 1011 ERNUM=26 C0300143C C0300144C VOLUSE C0300145C C0300146 1800 ICNT=ICNT+1 C0300147 GO TO(9998,1801,9998,9998,9998,215,9998,9998,9998,9998,9998,9998, C0300148 *9998,223,224,9998),ICNT C0300149 1801 ERNUM=17 C0300150 GO TO 9999 C0300151C C0300152C PUTS C0300153C C0300154 1100 ICNT=ICNT+1 C0300155 GO TO (9998,9998,412,9998,9998,215,9998,9998,9998,9998,9998,9998, C0300156 *1112,223,224,9998),ICNT C0300157 1112 ERNUM=25 C0300158 GO TO 9999 C0300159C C0300160ÐÐC WRITER C0300161C C0300162 1200 ICNT=ICNT+1 C0300163 GO TO (9998,9998,412,9998,1204,215,9998,9998,9998,1209,9998,1211, C0300164 *1112,223,224,9998),ICNT C0300165 1204 ERNUM=38 C0300166 GO TO 9999 C0300167 1209 ERNUM=38 C0300168 GO TO 9999 C0300169 1211 ERNUM=25 C0300170 GO TO 9999 C0300171C C0300172C READR/GETS C0300173C C0300174 1300 ICNT=ICNT+1 C0300175 GO TO (9998,9998,412,9998,1304,215,1306,1307,9998,9998,9998,9998, C0300176 *9998,223,224,9998),ICNT C0300177 1304 ERNUM=31 C0300178 GO TO 9999 C0300179 1306 ERNUM=47 C0300180 GO TO 9999 C0300181 1307 ERNUM=48 C0300182 GO TO 9999 C0300183C C0300184C UPDATE RECORD C0300185ÐÐC C0300186 1500 ICNT=ICNT+1 C0300187 GO TO(9998,9998,9998,9998,9998,215,9998,1507,9998,9998,9998,9998, C0300188 *9998,223,224,9998),ICNT C0300189 1507 ERNUM=54 C0300190 GO TO 9999 C0300191C C0300192C DELETE RECORD C0300193C C0300194 1600 ICNT=ICNT+1 C0300195 GO TO (9998,9998,9998,9998,9998,215,9998,1507,9998,9998,9998,1611,C0300196 *9998,223,224,9998),ICNT C0300197 1611 ERNUM=55 C0300198 GO TO 9999 C0300199C C0300200C COMPRESS FILE C0300201C C0300202 1700 ICNT=ICNT+1 C0300203 GO TO (9998,9998,9998,9998,9998,215,9998,9998,1708,9998,9998,9998,C0300204 *9998,223,224,9998),ICNT C0300205 1708 ERNUM=56 C0300206 GO TO 9999 C0300207 9999 ERNUM=ERNUM+ERBAS C0300208C C0300209 CALL SYSMSG (ERNUM,ERBUF) C0300210ÐÐ 9998 RETURN C0300211 END C0300212 SUBROUTINE INIT C0400001 1 /C04 F ITOS CCS 3.0 SL-149C0400002C COMMAND PROCESSOR FOR INIT C0400003C CREDIT COLLECTION SYSTEM VERSION 3.0 C0400004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C0400005C COPYRIGHT CONTROL DATA CORPORATION 1979 C0400006C C0400007C*** C0400008C C0400009C C0400010C FUNCTION C0400011C C0400012C THIS COMMAND PROCESSOR WILL WRITE A VOLUME LABEL TO C0400013C A MASS MEMORY DEVICE AND IS TO BE USED IN AN INTERACTIVE MODE ONLY C0400014C C0400015C GENERAL DESCRIPTION C0400016C C0400017C ON ENTRY THE PARAMETER PROCESSING TABLE (PPINIT) IS C0400018C COPIED INTO A TEMPORARILY TABLE (PPTEMP) C0400019C AFTER ALL REQUIRED PARAMETERS HAVE BEEN ENTERED AND C0400020C CHECKED,THE DISK NO IS CONVERTED AND THE CORRESPONDING C0400021C VIT-ADDR IS OBTAINED C0400022C NEXT A FREAD REQUEST IS DONE TO READ IN SECTOR 0 C0400023ÐÐC FROM THE SPECIFIED DISK C0400024C IF WORD 0 CONTAINS A $1400 THE DISK IS CONSIDERED TO C0400025C BE LABELED AND THE VOLUME-NAME,VOLUME-NO,SEC.CODE AND C0400026C CREATION DATE IS DISPLAYED FOLLOWED BY C0400027C RENAME= C0400028C IF 'NO' IS ENTERED,THE DISK WILL BE TREATED AS AN C0400029C UNLABELED DISK AND A NEW LABEL AND AVAILABLE SPACE C0400030C DIRECTORY IS WRITTEN C0400031C IF ANYGHING ELSE IS ENTERED,ONLY THE SPECIFIED VOLUME- C0400032C NAME IS TRANSFERRED INTO THE LABEL AND THIS NEW LABEL C0400033C IS WRITTEN BACK TO DISK C0400034C IF THE DISK IS UNLABELED,NOTHING WILL BE DISPLAYED C0400035C TODAYS DATE IS MOVED TO THE LABEL CREATE DATE ACCORDING C0400036C TO DATFMT (0=MMDDYY,ELSE DDMMYY) C0400037C THE NO OF FILES IS CONVERTED AND MOVED C0400038C THE ALLOCATABLE AREA AND DIRECTORY SIZE ARE COMPUTED C0400039C NEXT THE NEW LABEL AND AVAILABLE SPACE DIRECTORY ARE C0400040C WRITTEN TO THE DISK C0400041C C0400042C C0400043C SUBROUTINES C0400044C C0400045C CNVRT CONVERSION ASCII-TO-BINARY C0400046C GETFLD GET NEXT FIELD C0400047C SYSMSG SYSTEM ERROR MSG ROUTINE C0400048ÐÐC MMSIZ GET MAX SECTOR MSB AND LSB C0400049C MOVE MOVE FIELD LEFT JUSTIFIED,BLANK FILL C0400050C MOVER MOVE FIELD RIGHT JUSTIFIED,ZERO FILL C0400051C MVCHAR MOVE CHARACTERS C0400052C PGMINT ALLOW INTERRUPT C0400053C TODAY GET DATE OF TODAY C0400054C WTREAD TERMINAL WRITE/READ C0400055C C0400056C C0400057C MESSAGES C0400058C C0400059C 39 PARAMETER MISSING C0400060C 47 WRONG MM UNIT DEFINED C0400061C 81 ILLEGAL TO INIT A SYSTEM DISK C0400062C C0400063C C0400064C COMMAND FORMAT C0400065C C0400066C INIT,VL=AAAAAAAA,DK=NN C0400067C OR C0400068C INIT,AAAAAAAA,NN C0400069C C0400070C C0400071C C0400072M FMUCOM C0400073ÐÐC C0400074 INTEGER DSK,DSK1,DSK2,VLINIT,VLNAME,VLNMBR,VLSER C0400075 INTEGER VLSEC,VLDATE,VLBMS,VLASDM,VLASDL,VLBBA,VLWPS C0400076 INTEGER VLFDD,VLMAXF,VLCURF,VLNFDB,VLNXTB,ENDLAB C0400077 INTEGER OUTP,SECTM,SECTL C0400078 INTEGER DIRSIZ,VLLBAL,VLLBAM C0400079 INTEGER ZRO,ERBUF,PARNUM,PARID,PPTEMP(17),PPTAB(4) C0400080 INTEGER BUFLEN,TC,BLANK,QUEST,STAT,DATSEP,DATFMT,ASDIR(5),WPS C0400081 INTEGER VLBMSL,VLBMSM,VLLBA C0400082 INTEGER VLASDS C0400083 INTEGER IDUM1,IDUM2 C0400084C C0400085 DIMENSION IPNAM(17) C0400086 DIMENSION IJUST(17) C0400087 DIMENSION ICONV(17) C0400088 DIMENSION IREQ(17) C0400089 DIMENSION IFND(17) C0400090 DIMENSION NAME(18) C0400091 DIMENSION ITEMP(3) C0400092 DIMENSION LABEL(572) C0400093 DIMENSION NF(2) C0400094 DIMENSION NR(4) C0400095 DIMENSION VLDATE(4) C0400096 DIMENSION VLBMS(2) C0400097 DIMENSION VLLBA(2) C0400098ÐÐ DIMENSION MSG1(24) C0400099 DIMENSION VLSER(5),VLSEC(4) C0400100 DIMENSION VLFDD(2) C0400101C C0400102C EXTERNALS C0400103C C0400104 EXTERNAL MOVER C0400105 EXTERNAL MOVEL C0400106 EXTERNAL LOG1A C0400107 EXTERNAL MMSIZ C0400108 EXTERNAL DATSEP C0400109 EXTERNAL MMLUTB C0400110 EXTERNAL DATFMT C0400111 EXTERNAL SYSMSG C0400112C C0400113 INTEGER CNVRT C0400114C C0400115 BYTE (DSK1,DSK(3=0)) C0400116 BYTE (DSK2,DSK(11=8)) C0400117 BYTE (LUN1,MMUNIT(6=0)) C0400118C C0400119 BYTE (IFND,PPTEMP(15=15)) C0400120 BYTE (IREQ,PPTEMP(12=12)) C0400121 BYTE (ICONV,PPTEMP(10=9)) C0400122 BYTE (IJUST,PPTEMP(8=8)) C0400123ÐÐ BYTE (IPNAM,PPTEMP(7=0)) C0400124C C0400125 EQUIVALENCE (VLINIT,LABEL(1)) C0400126 EQUIVALENCE (VLNAME,LABEL(3)) C0400127 EQUIVALENCE (VLNMBR,LABEL(7)) C0400128 EQUIVALENCE (VLSER,LABEL(8)) C0400129 EQUIVALENCE (VLSEC,LABEL(13)) C0400130 EQUIVALENCE (VLDATE,LABEL(17)) C0400131 EQUIVALENCE (VLBMS,LABEL(21)) C0400132 EQUIVALENCE (VLASDM,LABEL(23)) C0400133 EQUIVALENCE (VLASDL,LABEL(24)) C0400134 EQUIVALENCE (VLASDS,LABEL(25)) C0400135 EQUIVALENCE (VLLBA,LABEL(26)) C0400136 EQUIVALENCE (VLWPS,LABEL(28)) C0400137 EQUIVALENCE (VLFDD,LABEL(29)) C0400138 EQUIVALENCE (VLMAXF,LABEL(31)) C0400139 EQUIVALENCE (VLCURF,LABEL(32)) C0400140 EQUIVALENCE (VLNFDB,LABEL(33)) C0400141 EQUIVALENCE (VLNXTB,LABEL(34)) C0400142 EQUIVALENCE (ENDLAB,LABEL(96)) C0400143C C0400144 EQUIVALENCE (NOF,DUMMY(1)) C0400145 EQUIVALENCE (DSK,DUMMY(3)) C0400146 EQUIVALENCE (PPINIT,PPTAB) C0400147C*** C0400148ÐÐC C0400149 DATA NAME/'VOLUME-NAME=NO.OF.FILES=DISK-UNIT ='/ C0400150 DATA MSG1/$0A0D,' ',$0A0D,'VOLUC0400151 *ME= '/ C0400152 DATA ZRO/0/,NOCUR/-1/ C0400153 DATA BUFLEN/40/ C0400154 DATA LENG1/24/ C0400155 DATA QUEST/'? '/ C0400156C C0400157 DATA BLANK / $2020/ C0400158C C0400159C INITIALISATION C0400160C C0400161 11 INDEX=0 C0400162+ ERROR MSG NO. C0400163C 3 CARDS DELETED 121*4741C0400164 ASDIR(5)=-1 C0400165 ERBUF=0 C0400166+ ERROR MSG BUF C0400167 ISTAT=0 C0400168+ STATUS OF FM-REQUEST C0400169 LNGO=0 C0400170+ LENGTH OF FIELD TO MOVE C0400171 MORPAR=0 C0400172+ INDICATOR IF MORE PARAMETERS NEEDED C0400173ÐÐ MORLIN=0 C0400174+ INDICATOR IF MORE LINES NEED TO BE READ C0400175 PARNUM=0 C0400176+ COUNT OF REQ.AND NOT FOUND PARAMETERS C0400177 PARID=0 C0400178 MORFIL=0 C0400179 IFTSW=0 C0400180 MMUNIT=0 C0400181 IRNFLG=0 C0400182+ RENAME FLAG 1 IF RENAME IS REQUIRED C0400183 IFLAG=0 C0400184 IP=1 C0400185 NR(1) = $3030 C0400186 NR(2) = $3030 C0400187 NR(3) = $3030 C0400188 NR(4) = $3030 C0400189 ASSEM $C000,+DATSEP C0400190 ASSEM $6800,ISPRT C0400191C C0400192 ASSIGN 9998 TO INTLOC C0400193 CALL PGMINT(INTLOC,IFLAG) C0400194C C0400195C COPY THE PARAMETER PROCESSING TABLE C0400196C C0400197 I=0 C0400198ÐÐ 10 I=I+1 C0400199 PPTEMP(I)=PPTAB(I) C0400200 IF(PPTEMP(I))10,20,10 C0400201C C0400202C C0400203C C0400204 20 DO 30 I=1,24 C0400205 REQBUF(I)=0 C0400206 IDATA(I)=PARDEF(I) C0400207 30 CONTINUE C0400208C C0400209 35 IF(PIND)110,70,40 C0400210C C0400211C PROMPTING LEVEL = 1 FULL PARAMETERS WILL BE DISPLAYED C0400212C C0400213 40 KI=IP C0400214 I=(IP-1)*6+1 C0400215 IF(IPNAM(IP))50,100,50 C0400216C C0400217 50 J=I+5 C0400218 K=1 C0400219 CODE(K)=$0A0D C0400220+ SET CR/LF C0400221 DO 60 I=I,J C0400222 K=K+1 C0400223ÐÐ CODE(K)=NAME(I) C0400224 60 CONTINUE C0400225C C0400226 I=KI C0400227 LNGO=7 C0400228 GO TO 90 C0400229C C0400230C PROMPTING LEVEL = 0 PARAMETER ABBREVIATIONS WILL BE DISPLAYED C0400231C C0400232 70 I=IP C0400233 K=IPNAM(IP) C0400234+ INDEX TO PARAM.MNEM.TABLE C0400235 IF(K)80,100,80 C0400236 80 K=(K-1)*3+1 C0400237C C0400238 CODE(1)=$0A0D C0400239 CODE(2)=PARNAM(K) C0400240 CODE(3)=$3D20 C0400241 LNGO=3 C0400242C C0400243C DISPLAY NEXT PARAMETER-IDENT C0400244C C0400245 90 CALL WTREAD (LUNIT,NOCUR,CODE,LNGO,NOCUR,DUMMY,ZRO,TC) C0400246C C0400247 PARID=IP C0400248ÐÐ+ INDEX IN PARNAM-TABLE C0400249 IFND(I)=1 C0400250+ SET FOUND FLAG C0400251 IP=IP+1 C0400252+ INCR. INDEX TO PPTEMP C0400253 MORPAR=1 C0400254+ SET INDICATOR FOR MORE PARAMETERS NEEDED C0400255 GO TO 120 C0400256C C0400257C END OF PARAMETER LIST, ISSUE FM-REQUEST C0400258C C0400259 100 MORPAR=0 C0400260 GO TO 320 C0400261C C0400262C PROMPTING LEVEL = -1, NO PROMPTING DONE C0400263C C0400264 110 IF(MORLIN) 115,130,130 C0400265+ DO WE NEED TO READ MORE LINES C0400266 115 MORLIN=0 C0400267C C0400268C READ NEXT LINE C0400269C C0400270 120 CALL WTREAD (LUNIT,NOCUR,DUMMY,ZRO,NOCUR,INBUF,BUFLEN,TC) C0400271C C0400272C RESET SWORD AND SBYTE C0400273ÐÐC C0400274 SBYTE=0 C0400275 SWORD=0 C0400276C C0400277 130 CALL GETFLD (INBUF,CODE,SWORD,SBYTE,STAT) C0400278C C0400279 140 IF (STAT-2)150,160,200 C0400280 150 IF (STAT-1)260,250,250 C0400281C C0400282C EOL DETECTED,COUNT NO OF REQUIRED AND NOT FOUND PARAMETERS (STATUS=1)C0400283C C0400284 160 IF(PIND)161,162,162 C0400285 161 MORPAR=0 C0400286C C0400287C CHECK IF FULL NAME DESIRED C0400288C C0400289 162 IF (CODE(1)-QUEST)164,163,164 C0400290C C0400291C YES,FULL NAME FOR THIS PARAMETER ONLY C0400292C C0400293 163 IF (PIND .NE. -1) IP=IP-1 C0400294 GO TO 40 C0400295C C0400296C CHECK IF PARAMETER ENTERED C0400297C C0400298ÐÐ 164 IF(CODE(1)-BLANK)270,165,270 C0400299 165 IFND(IP-1)=0 C0400300 IF (PIND .EQ. -1) GO TO 320 C0400301 GO TO 35 C0400302C C0400303C PARAMETER-ID FOUND (STATUS=3) C0400304C C0400305 200 I=1 C0400306 210 K=IPNAM(I) C0400307 K=(K-1)*3+1 C0400308C C0400309 IF (CODE(1)-PARNAM(K))230,220,230 C0400310C C0400311C PARAMETER-ID CORRESPONDS WITH PARAM.MNEMONIC TABLE C0400312C C0400313 220 PARID=I C0400314 IFND(I)=1 C0400315 IP = IP + 1 C0400316 GO TO 130 C0400317C C0400318 230 I=I+1 C0400319+ NO MATCH,CONTINUE C0400320 IF(IPNAM(I))210,240,210 C0400321C C0400322 240 INDEX=39 C0400323ÐÐ+ PARAMETER ILLEGAL C0400324 GO TO 9999 C0400325C C0400326C FIELD TERMINATED ON A SEMI-COLON (STATUS=1) C0400327C C0400328 250 MORLIN=-1 C0400329+ SET INDICATOR TO READ MORE LINES C0400330C C0400331C FIELD TERMINATED ON A COMMA (STATUS=0) C0400332C C0400333 260 MORPAR=1 C0400334+ SET INDICATOR FOR MORE PARAMETERS C0400335 IF(CODE(1) .NE. BLANK)GO TO 270 C0400336 IFND(IP)=0 C0400337 IP=IP+1 C0400338 GO TO 35 C0400339C C0400340C STORE PARAMETER VALUES INTO REQUIRED LOCATIONS C0400341C C0400342 270 IF (PARID)290,290,280 C0400343+ PARAMETER-ID FOUND C0400344 280 I=PARID C0400345+ YES C0400346 GO TO 300 C0400347C C0400348ÐÐ 290 I=IP C0400349 IF (CODE(1) .NE. BLANK) IFND(I)=1 C0400350 IP=IP+1 C0400351C C0400352 300 I=(IPNAM(I)-1)*3+1 C0400353C C0400354 LNGO=PARNAM(I+1) C0400355 OUTP=PARNAM(I+2) C0400356C C0400357C STORE INTO DESIGNATED OUTPUT FIELD C0400358C C0400359 IF(ICONV(IP-1)-1)302,304,302 C0400360C C0400361 302 CALL MOVEL (CODE,OUTP,LNGO) C0400362 GO TO 306 C0400363C C0400364 304 LNGI=LNGO C0400365 CALL MOVER (CODE,LNGI,OUTP,LNGO) C0400366C C0400367 306 PARID=0 C0400368 IF(MORPAR)310,320,310 C0400369+ ARE THERE MORE PARAM TO BE PROCESSED C0400370 310 IF(PIND)110,70,40 C0400371+ YES C0400372C C0400373ÐÐC C0400374C ARE ALL REQUIRED PARAMETERS FOUND ? C0400375C C0400376 320 I=0 C0400377 330 I=I+1 C0400378 IF(PPTEMP(I))330,360,340 C0400379C C0400380C PARAMETER NOT FOUND,IS IT REQUIRED ? C0400381C C0400382 340 IF(IREQ(I))330,350,330 C0400383C C0400384C YES IT IS REQUIRED C0400385C C0400386 350 PARNUM=PARNUM+1 C0400387 GO TO 330 C0400388C C0400389C END OF PPTAB C0400390C C0400391 360 IF(PARNUM)240,400,240 C0400392+ ARE ALL REQUIRED PARAMETERS FOUND C0400393C C0400394C C0400395C C0400396C C0400397C READ LABEL FROM DESIGNATED MASS-STORAGE DEVICE C0400398ÐÐC C0400399C GET ACTUAL SYSTEM-LOGICAL UNIT NO AND VIT-ADDR. C0400400C C0400401 400 MMUNIT=DSK1+DSK2*10 C0400402C C0400403 IF (MMUNIT .EQ. 0) GO TO 560 C0400404 MMUNIT=MMUNIT+1 C0400405+ FM UNITS ARE 1,2,3,4...... C0400406C C0400407 ASSEM $0842 C0400408+ CLR Q C0400409 ASSEM $C600,+MMLUTB C0400410+ LDA MMLUTB,Q C0400411 ASSEM $6800,NLUN C0400412+ STA NLUN C0400413C C0400414 IF(MMUNIT .GT. NLUN) GO TO 550 C0400415C C0400416C C0400417 ASSEM $E800,MMUNIT C0400418+ LDQ MMUNIT C0400419 ASSEM $C600,+MMLUTB C0400420+ LDA MMLUTB,Q C0400421 ASSEM $60FF C0400422+ STA- I C0400423ÐÐ ASSEM $C502 C0400424+ LDA- (VISLUN),I C0400425C C0400426C SAVE FOR MOUNT AND DISMOUNT CHECK C0400427C C0400428 ASSEM $6800,KMODSM C0400429+ STA KMODSM C0400430 ASSEM $A00A C0400431+ AND- LPMASK+8 C0400432 ASSEM $6800,MMUNIT C0400433+ STA MMUNIT C0400434 ASSEM $C10D C0400435+ LDA- VIWPS,I C0400436 ASSEM $6800,WPS C0400437+ STA WPS C0400438C***************************************************************121*4741C0400439 ASSEM $C115 C0400440+ LDA- LMSB,I C0400441 ASSEM $6800,404 C0400442+ STA* REQMSB C0400443 ASSEM $6800,1104 C0400444 ASSEM $C116 C0400445+ LDA- LLSB,I C0400446 ASSEM $6800,405 C0400447 ASSEM $6800,1105 C0400448ÐÐ+ STA* REQLSB C0400449C***************************************************************121*4741C0400450C CHECK COMPATIBILITY OF P. D. T., DISK DRIVE AND DISK PACK C0400451 CALL VERWPS(MMUNIT, ISTAT) C0400452 IF (ISTAT .NE. 0) GO TO 580 C0400453C C0400454C BUILD THE READ REQUEST C0400455C C0400456 ASSEM $C800,MMUNIT C0400457+ LDA MMUNIT C0400458 ASSEM $680B C0400459+ STA *+11 C0400460 ASSEM $C800,WPS C0400461+ LDA WPS C0400462 ASSEM $6809 C0400463+ STA *+9 C0400464 ASSEM $C000,+LABEL C0400465+ LDA =XLABEL C0400466 ASSEM $6807 C0400467+ STA *+7 C0400468C C0400469C READ SECTOR 0 OF MMUNIT C0400470C C0400471C******************************************************'********121*4741C0400472 ASSEM $54F4,$4800,$0,$0,$0,$0,$0 C0400473ÐÐ 404 ASSEM $0 C0400474 405 ASSEM $0 C0400475C******************************************************'********121*4741C0400476C C0400477 IF(LABEL(1) .EQ. $1400) GO TO 5000 C0400478C C0400479C VOLUME IS UNLABELED C0400480* C0400481 LABEL(1)=$1400 C0400482 LABEL(2)=$0060 C0400483* C0400484C MOVE TODAY'S DATE INTO LABEL C0400485C C0400486 410 CALL TODAY(ITEMP) C0400487C C0400488 ASSEM $C000,+DATFMT C0400489 ASSEM $6800,IDATFM C0400490 IF(IDATFM) 500,420,500 C0400491C C0400492C DATFMT=0 MMDDYY C0400493C C0400494 420 VLDATE(1)=ITEMP(1) C0400495 CALL MVCHAR(ISPRT,2,1,VLDATE(2),1) C0400496 CALL MVCHAR(ITEMP(2),1,2,VLDATE(2),2) C0400497 CALL MVCHAR(ISPRT,2,1,VLDATE(3),2) C0400498ÐÐ GO TO 505 C0400499C C0400500C DATFMT=1 DDMMYY C0400501C C0400502 500 VLDATE(1)=ITEMP(2) C0400503 CALL MVCHAR(ISPRT,2,1,VLDATE(2),1) C0400504 CALL MVCHAR(ITEMP(1),1,2,VLDATE(2),2) C0400505 CALL MVCHAR(ISPRT,2,1,VLDATE(3),2) C0400506 505 VLDATE(4)=ITEMP(3) C0400507C C0400508C MOVE VOLUME-NAME INTO LABEL C0400509C C0400510 ASSEM $C000,+VLNAME C0400511+ LDA =XVLNAME C0400512 ASSEM $6800,OUTP C0400513+ STA OUTP C0400514 LNGO=8 C0400515 CALL MOVEL (IDATA(9),OUTP,LNGO) C0400516C C0400517C CONVERT NF AND MOVE INTO LABEL C0400518C C0400519 ASSEM $C000,+NR(3) C0400520+ LDA =XNR C0400521 ASSEM $6800,OUTP C0400522 LNGO=4 C0400523ÐÐ LNGI=LNGO C0400524C C0400525C CHECK IF DATA INPUT C0400526C C0400527 IF (PPTEMP(2) .LT. 0) CALL MOVER(NOF, LNGI, OUTP, LNGO) C0400528 NR(1)=$3030 C0400529 NR(2)=$3030 C0400530 IF (CNVRT(NR,NF) .NE. 0) GO TO 511 C0400531 IF (NF( 1) .NE. 0) GO TO 507 C0400532C C0400533 IF (NF( 2) .EQ. 0) NF( 2) = 256 C0400534 IF (NF(2) .GT. 2048) GO TO 507 C0400535 VLMAXF = NF(2) C0400536 GO TO 600 C0400537C C0400538 507 CONTINUE C0400539 INDEX=52 C0400540+ 52 PARAMETER ENTRY ERROR C0400541 IF(AND(MODE,$EFFF))9999,510,9999 C0400542C C0400543 510 CALL SYSMSG(INDEX,ERBUF) C0400544 511 CONTINUE C0400545 IP = IP - 2 C0400546 GO TO 35 C0400547C C0400548ÐÐC SET UP START OF ALLOC SECTOR DIR C0400549C C0400550 600 VLASDM=0 C0400551C***************************************************************121*4741C0400552 ASSEM $C800,1105 C0400553+ LDA 1105 C0400554 ASSEM $0901 C0400555+ INA 1 C0400556 ASSEM $6800,VLASDL C0400557+ STA VLASDL C0400558C***************************************************************121*4741C0400559 VLWPS=WPS C0400560C C0400561C C0400562C COMPUTE DIRECTORY SIZE BASED ON NF C0400563C C0400564C THE FOLLOWING LINE OF CODE FIXS A BUG. THE BUG WAS THAT C0400565C THE FILE MANAGER'S AVAILABLE SPACE DIRECTORY HAD BEEN DEFINED C0400566C ABOUT HALF THE SIZE IT SHOULD HAVE BEEN. C0400567C C0400568 IRF = NF(2) + 1 C0400569 IRF=IRF*4 C0400570 DIRSIZ=IRF/VLWPS C0400571 IF(DIRSIZ*VLWPS .NE. IRF) DIRSIZ=DIRSIZ+1 C0400572C C0400573ÐÐ VLASDS=DIRSIZ C0400574 VLNMBR=$3031 C0400575C C0400576 DO 7000 N=1,4 C0400577 VLSER(N)=$2020 C0400578 VLSEC(N)=$2020 C0400579 7000 CONTINUE C0400580 VLSER(5)=$2020 C0400581 VLBMS(1)=VLASDM C0400582C***************************************************************121*4741C0400583 VLBMS(2)=VLASDL+DIRSIZ C0400584C******************************************************'********121*4741C0400585 VLCURF=0 C0400586 VLNFDB=0 C0400587 VLNXTB=0 C0400588 VLFDD(1)=0 C0400589 VLFDD(2)=0 C0400590C C0400591C WRITE VOLUME LABEL C0400592C C0400593C C0400594C GET EQUIPMENT TYPE FOR THIS MMUNIT C0400595C C0400596 1000 ASSEM $E800,LUN1 C0400597+ LDQ LUN1 Q=LOG. UNIT C0400598ÐÐC C0400599C TEST IF VOLUME IS MOUNTED. IF SO, ERROR OUT C0400600C C0400601 IF (KMODSM .GE. 0) GO TO 570 C0400602C C0400603C GET MAX. NO. OF SECTORS FOR MM DEVICE. C0400604C C0400605 CALL MMSIZ (MMUNIT,SECTM,SECTL,IDUM1,IDUM2) C0400606C C0400607C CHECK IF RENAME IS REQUIRED C0400608C C0400609 IF(IRNFLG .EQ. 1) GO TO 1100 C0400610C C0400611 VLLBA(1)=SECTM C0400612 VLLBA(2)=SECTL-DIRSIZ-1 C0400613 ASDIR(1)=VLLBA(1) C0400614 ASDIR(2)=VLLBA(2) C0400615 ASDIR(3)=VLBMS(1) C0400616 ASDIR(4)=VLBMS(2) C0400617C C0400618C PREPARE FOR WRITE LABEL C0400619C C0400620 1100 ASSEM $C800,MMUNIT C0400621 ASSEM $680B C0400622 ASSEM $C800,WPS C0400623ÐÐ ASSEM $6809 C0400624 ASSEM $C000,+LABEL C0400625 ASSEM $6807 C0400626C C0400627C***************************************************************121*4741C0400628 ASSEM $54F4,$4C00,$0,$0,$0,$0,$0 C0400629 1104 ASSEM $0 C0400630 1105 ASSEM $0 C0400631C***************************************************************121*4741C0400632 IF(IRNFLG .EQ. 1) GO TO 9998 C0400633C C0400634C WRITE THE AVAILABLE SPACE DIRECTORY C0400635C C0400636 ASSEM $C800,MMUNIT C0400637+ LDA MMUNIT C0400638 ASSEM $6800,1110 C0400639+ STA =X1110 C0400640C***************************************************************121*4741C0400641 ASSEM $C800,1105 C0400642 ASSEM $0901 C0400643 ASSEM $6800,ILLSB C0400644 ASSEM $C800,1104 C0400645 ASSEM $6800,ILMSB C0400646 IF(ILLSB .LT. 0) ILMSB=ILMSB+1 C0400647 ILLSB=AND(ILLSB,$7FFF) C0400648ÐÐ ASSEM $C800,ILMSB C0400649 ASSEM $6800,1114 C0400650 ASSEM $C800,ILLSB C0400651 ASSEM $6800,1115 C0400652C***************************************************************121*4741C0400653 ASSEM $54F4,$4C00,$0,$0 C0400654C***************************************************************121*4741C0400655 1110 ASSEM $0,$5,+ASDIR C0400656 1114 ASSEM $0 C0400657 1115 ASSEM $0 C0400658C***************************************************************121*4741C0400659C C0400660C C0400661 GO TO 9998 C0400662C C0400663C VOLUME HAS A LABEL ALREADY,DISPLAY RENAME C0400664C C0400665 5000 DO 5010 I=1,18 C0400666 MSG1(I+1)=LABEL(I+2) C0400667 5010 CONTINUE C0400668C C0400669 CALL WTREAD(LUNIT,NOCUR,MSG1,LENG1,NOCUR,DUMMY,ZRO,TC) C0400670C C0400671C READ ANSWER C0400672C C0400673ÐÐ CALL WTREAD (LUNIT,NOCUR,DUMMY,ZRO,NOCUR,INBUF,BUFLEN,TC) C0400674C C0400675 SBYTE=0 C0400676 SWORD=0 C0400677C C0400678 CALL GETFLD (INBUF,CODE,SWORD,SBYTE,STAT) C0400679C C0400680 IF (CODE( 1) .EQ. BLANK) GO TO 410 C0400681 LNGO=8 C0400682 ASSEM $C000,+VLNAME C0400683 ASSEM $6800,OUTP C0400684 CALL MOVEL (IDATA(9),OUTP,LNGO) C0400685 IRNFLG=1 C0400686C C0400687C NO CHANGE IN ALLOCATION SECTOR DIRECTORY C0400688C IGNORE 'FN( 2)' C0400689C C0400690 GO TO 1000 C0400691C C0400692 550 INDEX=47 C0400693 GO TO 9999 C0400694C C0400695C C0400696C TEMPARORY INDEX C0400697C C0400698ÐÐ 560 CONTINUE C0400699 INDEX = 47 C0400700 GO TO 9999 C0400701C C0400702C TEMPARORY INDEX C0400703 570 CONTINUE C0400704 INDEX = 48 C0400705C C0400706 GO TO 9999 C0400707C C0400708C P. D. T., DISK DRIVE, DISK PACK NOT COMPATIBLE C0400709C C0400710 580 INDEX = 86 C0400711 GO TO 9999 C0400712 9999 CALL SYSMSG(INDEX,ERBUF) C0400713 IF(PIND) 9996,9996,11 C0400714 9996 IF(MODE) 9997,9998,9997 C0400715 9997 ASSEM $E400,+MODE C0400716 ASSEM $D622 C0400717C C0400718 9998 RETURN C0400719 END C0400720 SUBROUTINE HOST C0500001 1 /C05 F ITOS CCS 3.0 SL-149C0500002C ADDS OR DELETES ENTRIES IN THE HOST FILE. C0500003ÐÐC CREDIT COLLECTION SYSTEM VERSION 3.0 C0500004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C0500005C COPYRIGHT CONTROL DATA CORPORATION 1979 C0500006C C0500007C** C0500008C COMMAND PROCESSOR FOR HOST C0500009C CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.0 C0500010C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C0500011C COPYRIGHT CONTROL DATA CORPORATION 1977 C0500012C C0500013C C0500014C FUNCTION C0500015C C0500016C THIS PROCESSOR CREATES OR REMOVES ENTRIES IN HOST FILE. C0500017C C0500018C C0500019C GENERAL DESCRIPTION C0500020C C0500021C THIS PROCESSOR ACCEPTS INPUT FROM EITHER AN INTERACTIVE C0500022C DEVICE OR THE DEVICE IT WAS INITIATED ON. THE PROCESSOR C0500023C RUNS UNDER THE FILE MANAGER UTILITY EXECUTIVE PROGRAM. C0500024C THE COMMAND FORMAT IS C0500025C HOST,HO=AAAA,OP=AAA,PT=AAAAA C0500026C HO=HOST NAME C0500027C OP=OPTION (ADD OR DEL) C0500028ÐÐC PT=PROTOCALL TYPE (HASP OR 200UT) C0500029C C0500030C C0500031C FLOW C0500032C C0500033C THE HOST PROCESSOR DETERMINES THE LEVEL OF PROMPTING REQUIRED, C0500034C DISPLAYS THE PARAMETERS AND STORES THE PARAMETER VALUES C0500035C INTO THE REQUIRED LOCATIONS C0500036C C0500037C THE PROCESSOR THEN READS IN THE HOST FILE AND CHECKS C0500038C IF THE OPTION ENTERED WAS ADD OR DELETE. FOR THE ADD C0500039C OPTION, A SEARCH IS MADE FOR A DUPLICATE NAME AND C0500040C FOR ROOM IN THE HOST FILE. IF THERE IS NO DUPLICATE C0500041C NAME AND ROOM IN THE FILE, THE PROCESSOR THEN CHECKS C0500042C THE PROTOCALL TYPE AND SETS WORD 3, BITS 9-8, TO A 1 C0500043C FOR 200UT AND TO A 2 FOR HASP. THE HOST NAME IS MOVED C0500044C TO THE RECORD AND THE HOST FILE IS UPDATED. C0500045C C0500046C FOR THE DELETE OPTION, A SEARCH IS MADE OF THE HOST FILE C0500047C FOR THE HOST NAME (LOCAL HOST CANNOT BE DELETED). A CHECK C0500048C IS THEN MADE TO DETERMINE THAT THE BATCH DRIVER IS NOT C0500049C WORKING ON THIS HOST AND THAT ALL STATUS WORDS ARE ZERO C0500050C (ALL JOBS FOR THIS HOST ARE INACTIVE). IF THESE CONDITIONS C0500051C ARE MET, THEN HOST NAME IS BLANKED OUT, THE TYPE IS SET C0500052C TO ZERO AND THE HOST FILE IS UPDATED. C0500053ÐÐC C0500054C ERROR MESSAGES C0500055C C0500056C 900 NO ROOM IN HOST FILE C0500057C 901 HOST NAME NOT FOUND C0500058C 902 PARAMETER MUST BE ADD OR DEL C0500059C 903 DUPLICATE HOST NAME C0500060C 904 PROTOCALL TYPE MUST BE 200UT OR HASP C0500061C 905 BATCH DRIVER BUSY ON THIS HOST C0500062C 906 JOB(S) PENDING FOR THIS HOST C0500063C 912 CAN'T DELETE LOCAL HOST C0500064C C0500065C C0500066C C0500067C C0500068C C0500069M FMUCOM C0500070. C0500071C C0500072 INTEGER OWNR12,OWNR34,OWNR56,OWNR78,RECLEN,TDATRM,TDATRL C0500073 INTEGER DATBAM,DATBAL,FCBIND,TNKEYM,TNKEYL,POSKY1,POSKY2 C0500074 INTEGER POSKY3,POSKY4,TSFILM,TSFILL,EXPDAT,CRTDAT,FILTYP C0500075 INTEGER NOCUR,ZRO,ERBUF,PARNUM,PARID,PPTEMP(17),PPTAB(6) C0500076 INTEGER BUFLEN,TC,OUTP,BLANK,QUEST,STAT,OPN,WVL,FTYPE C0500077 INTEGER OPN,WVL C0500078ÐÐ INTEGER RECBUF C0500079 INTEGER CPDAT(24),CPREQ(24),CPVOL,CPHDR(5),CPFCB(96),CPWIND C0500080 INTEGER CPRECL,CPFIND,CPLEN1,CPPOS1 C0500081 INTEGER STAT1(18),STAT2(18),STAT3(18),STAT4(18) C0500082C C0500083 DIMENSION IPNAM(17) C0500084 DIMENSION IREQ(17) C0500085 DIMENSION IFND(17) C0500086 DIMENSION NAME(18) C0500087 DIMENSION NAME12(4) C0500088 DIMENSION OWNR12(4) C0500089 DIMENSION KEYVAL(15) C0500090 DIMENSION RECBUF(322) C0500091C C0500092 EQUIVALENCE (PPHOST,PPTAB) C0500093 EQUIVALENCE (CPRECL,CPFCB(1)) C0500094 EQUIVALENCE (CPFIND,CPFCB(6)) C0500095 EQUIVALENCE (CPLEN1,CPFCB(15)) C0500096 EQUIVALENCE (CPPOS1,CPFCB(16)) C0500097 BYTE (IDEL,ISTAT(4=4)) C0500098. C0500099C C0500100C FILE CONTROL BLOCK C0500101C C0500102 EQUIVALENCE (RECLEN,FCBBUF(1)) C0500103ÐÐ EQUIVALENCE (TDATRM,FCBBUF(2)) C0500104 EQUIVALENCE (TDATRL,FCBBUF(3)) C0500105 EQUIVALENCE (DATBAM,FCBBUF(4)) C0500106 EQUIVALENCE (DATBAL,FCBBUF(5)) C0500107 EQUIVALENCE (FCBIND,FCBBUF(6)) C0500108 EQUIVALENCE (NEDATM,FCBBUF(7)) C0500109 EQUIVALENCE (NEDATL,FCBBUF(8)) C0500110 EQUIVALENCE (NEXTBM,FCBBUF(9)) C0500111 EQUIVALENCE (NEXTBL,FCBBUF(10)) C0500112 EQUIVALENCE (TNKEYM,FCBBUF(11)) C0500113 EQUIVALENCE (TNKEYL,FCBBUF(12)) C0500114 EQUIVALENCE (KEYBAM,FCBBUF(13)) C0500115 EQUIVALENCE (KEYBAL,FCBBUF(14)) C0500116 EQUIVALENCE (LENKY1,FCBBUF(15)) C0500117 EQUIVALENCE (POSKY1,FCBBUF(16)) C0500118 EQUIVALENCE (LENKY2,FCBBUF(17)) C0500119 EQUIVALENCE (LENKY3,FCBBUF(19)) C0500120 EQUIVALENCE (LENKY4,FCBBUF(21)) C0500121 EQUIVALENCE (TSFILM,FCBBUF(23)) C0500122 EQUIVALENCE (TSFILL,FCBBUF(24)) C0500123 EQUIVALENCE (NAME12,FCBBUF(25)) C0500124 EQUIVALENCE (OWNR12,FCBBUF(29)) C0500125 EQUIVALENCE (EXPDAT,FCBBUF(89)) C0500126 EQUIVALENCE (CRTDAT,FCBBUF(92)) C0500127 EQUIVALENCE (FTYPE,FCBBUF(95)) C0500128ÐÐC C0500129C EXTERNALS C0500130C C0500131 EXTERNAL MMLUTB C0500132 EXTERNAL WTREAD C0500133 EXTERNAL GETFLD C0500134 EXTERNAL SYSMSG C0500135 EXTERNAL MOVEL C0500136 EXTERNAL OPENFL C0500137 EXTERNAL GETFCB C0500138C C0500139C C0500140 BYTE (IFND,PPTEMP(15=15)) C0500141 BYTE (IREQ,PPTEMP(12=12)) C0500142 BYTE (IPNAM,PPTEMP(7=0)) C0500143C C0500144 BYTE (OPN,ISTAT(0=0)) C0500145 BYTE (NFD,ISTAT(1=1)) C0500146 BYTE (LOK,ISTAT(2=2)) C0500147 BYTE (IRLOK,ISTAT(3=3)) C0500148 BYTE (INUNK,ISTAT(4=4)) C0500149 BYTE (MME,ISTAT(5=5)) C0500150 BYTE (MFOS,ISTAT(11=11)) C0500151 BYTE (MFO,ISTAT(12=12)) C0500152 BYTE (IOUT,ISTAT(12=12)) C0500153ÐÐ BYTE (WVL,ISTAT(13=13)) C0500154 BYTE (ILR,ISTAT(14=14)) C0500155 BYTE(STAT1,RECBUF(15=12)) C0500156 BYTE(STAT2,RECBUF(11=8)) C0500157 BYTE(STAT3,RECBUF(7=4)) C0500158 BYTE(STAT4,RECBUF(3=0)) C0500159C C0500160 DATA NOCUR/-1/,ZRO/0/ C0500161 DATA BUFLEN/40/ C0500162 DATA BLANK/$2020/ C0500163 DATA QUEST/'? '/ C0500164 DATA NAME/'HOST NAME = OPTION = PROTO TYPE ='/ C0500165C C0500166 DATA KERBAS/ 400/ C0500167. C0500168C C0500169C INITIALIZATION C0500170C C0500171 11 INDEX=0 C0500172+ ERROR MSG NO. C0500173 ERBUF=0 C0500174+ ERROR MSG BUF C0500175 ISTAT=0 C0500176+ STATUS OF FM-REQUEST C0500177 LNGO=0 C0500178ÐÐ+ LENGTH OF FIELD TO MOVE C0500179 MORPAR=0 C0500180+ INDICATOR IF MORE PARAMETERS NEEDED C0500181 MORLIN=0 C0500182+ INDICATOR IF MORE LINES NEED TO BE READ C0500183 PARNUM=0 C0500184+ COUNT OF REQ.AND NOT FOUND PARAMETERS C0500185 PARID=0 C0500186 IFLAG=0 C0500187 IP=1 C0500188C C0500189 ASSIGN 9998 TO INTLOC C0500190 CALL PGMINT(INTLOC,IFLAG) C0500191C C0500192C COPY THE PARAMETER PROCESSING TABLE C0500193C C0500194 I=0 C0500195 10 I=I+1 C0500196 PPTEMP(I)=PPTAB(I) C0500197 IF(PPTEMP(I))10,20,10 C0500198C C0500199C C0500200C C0500201 20 DO 30 I=1,24 C0500202 REQBUF(I)=0 C0500203ÐÐ IDATA(I)=PARDEF(I) C0500204 30 CONTINUE C0500205C C0500206 35 IF(PIND)110,70,40 C0500207C C0500208C PROMPTING LEVEL = 1 FULL PARAMETERS WILL BE DISPLAYED C0500209C C0500210 40 KI=IP C0500211 I=(IP-1)*6+1 C0500212 IF(IPNAM(IP))50,100,50 C0500213C C0500214 50 J=I+5 C0500215 K=1 C0500216 CODE(K)=$0A0D C0500217+ SET CR/LF C0500218 DO 60 I=I,J C0500219 K=K+1 C0500220 CODE(K)=NAME(I) C0500221 60 CONTINUE C0500222C C0500223 I=KI C0500224 LNGO=7 C0500225 GO TO 90 C0500226. C0500227C C0500228ÐÐC PROMPTING LEVEL = 0 PARAMETER ABBREVIATIONS WILL BE DISPLAYED C0500229C C0500230 70 I=IP C0500231 K=IPNAM(IP) C0500232+ INDEX TO PARAM.MNEM.TABLE C0500233 IF(K)80,100,80 C0500234 80 K=(K-1)*3+1 C0500235C C0500236 CODE(1)=$0A0D C0500237 CODE(2)=PARNAM(K) C0500238 CODE(3)=$3D20 C0500239 LNGO=3 C0500240C C0500241C DISPLAY NEXT PARAMETER-IDENT C0500242C C0500243 90 CALL WTREAD (LUNIT,NOCUR,CODE,LNGO,NOCUR,DUMMY,ZRO,TC) C0500244C C0500245 PARID=IP C0500246+ INDEX IN PARNAM-TABLE C0500247 IFND(I)=1 C0500248+ SET FOUND FLAG C0500249 IP=IP+1 C0500250+ INCR. INDEX TO PPTEMP C0500251 MORPAR=1 C0500252+ SET INDICATOR FOR MORE PARAMETERS NEEDED C0500253ÐÐ GO TO 120 C0500254C C0500255C END OF PARAMETER LIST, ISSUE FM-REQUEST C0500256C C0500257 100 MORPAR=0 C0500258 GO TO 320 C0500259C C0500260C PROMPTING LEVEL = -1, NO PROMPTING DONE C0500261C C0500262 110 IF(MORLIN)115,130,130 C0500263+ DO WE NEED TO READ MORE LINES C0500264 115 MORLIN=0 C0500265C C0500266C READ NEXT LINE C0500267C C0500268 120 CALL WTREAD (LUNIT,NOCUR,DUMMY,ZRO,NOCUR,INBUF,BUFLEN,TC) C0500269C C0500270C RESET SWORD AND SBYTE C0500271C C0500272 SBYTE=0 C0500273 SWORD=0 C0500274. C0500275 130 CALL GETFLD (INBUF,CODE,SWORD,SBYTE,STAT) C0500276C C0500277C C0500278ÐÐ 140 IF (STAT-2)150,160,200 C0500279 150 IF (STAT-1)260,250,250 C0500280C C0500281C EOL DETECTED,COUNT NO OF REQUIRED AND NOT FOUND PARAMETERS (STATUS=1)C0500282C C0500283 160 IF(PIND)161,162,162 C0500284 161 MORPAR=0 C0500285C C0500286C CHECK IF FULL NAME DESIRED C0500287C C0500288 162 IF (CODE(1)-QUEST)164,163,164 C0500289C C0500290C YES,FULL NAME FOR THIS PARAMETER ONLY C0500291C C0500292 163 IF (PIND .NE. -1) IP=IP-1 C0500293 GO TO 40 C0500294C C0500295C CHECK IF PARAMETER ENTERED C0500296C C0500297 164 IF(CODE(1)-BLANK)270,165,270 C0500298 165 IFND(IP-1)=0 C0500299 IF (PIND .EQ. -1) GO TO 320 C0500300 GO TO 35 C0500301C C0500302C PARAMETER-ID FOUND (STATUS=3) C0500303ÐÐC C0500304 200 I=1 C0500305 210 K=IPNAM(I) C0500306 K=(K-1)*3+1 C0500307C C0500308 IF (CODE(1)-PARNAM(K))230,220,230 C0500309C C0500310C PARAMETER-ID CORRESPONDS WITH PARAM.MNEMONIC TABLE C0500311C C0500312 220 PARID=I C0500313 IFND(I)=1 C0500314 GO TO 130 C0500315C C0500316 230 I=I+1 C0500317+ NO MATCH,CONTINUE C0500318 IF(IPNAM(I))210,240,210 C0500319C C0500320 240 INDEX=39 C0500321+ PARAMETER ILLEGAL C0500322 GO TO 9999 C0500323C C0500324C FIELD TERMINATED ON A SEMI-COLON (STATUS=1) C0500325C C0500326 250 MORLIN=-1 C0500327+ SET INDICATOR TO READ MORE LINES C0500328ÐÐC C0500329C FIELD TERMINATED ON A COMMA (STATUS=0) C0500330C C0500331 260 MORPAR=1 C0500332+ SET INDICATOR FOR MORE PARAMETERS C0500333 IF(CODE(1) .NE. BLANK)GO TO 270 C0500334 IFND(IP)=0 C0500335 IP=IP+1 C0500336 GO TO 35 C0500337C C0500338C STORE PARAMETER VALUES INTO REQUIRED LOCATIONS C0500339C C0500340 270 IF (PARID)290,290,280 C0500341+ PARAMETER-ID FOUND C0500342 280 I=PARID C0500343+ YES C0500344 GO TO 300 C0500345C C0500346 290 I=IP C0500347 IF (CODE(1) .NE. BLANK) IFND(I)=1 C0500348 IP=IP+1 C0500349C C0500350 300 I=(IPNAM(I)-1)*3+1 C0500351C C0500352 LNGO=PARNAM(I+1) C0500353ÐÐ OUTP=PARNAM(I+2) C0500354C C0500355C STORE INTO DESIGNATED OUTPUT FIELD C0500356C C0500357 CALL MOVEL (CODE,OUTP,LNGO) C0500358C C0500359 PARID=0 C0500360 IF(MORPAR)310,320,310 C0500361+ ARE THERE MORE PARAM TO BE PROCESSED C0500362 310 IF(PIND) 110,70,40 C0500363+ YES C0500364C C0500365C C0500366C ARE ALL REQUIRED PARAMETERS FOUND ? C0500367C C0500368 320 I=0 C0500369 330 I=I+1 C0500370 IF(PPTEMP(I))330,360,340 C0500371C C0500372C PARAMETER NOT FOUND,IS IT REQUIRED ? C0500373C C0500374 340 IF(IREQ(I))330,350,330 C0500375C C0500376C YES IT IS REQUIRED C0500377C C0500378ÐÐ 350 PARNUM=PARNUM+1 C0500379 GO TO 330 C0500380C C0500381C END OF PPTAB C0500382C C0500383 360 IF(PARNUM) 240,400,240 C0500384+ ARE ALL REQUIRED PARAMETERS FOUND C0500385C C0500386C ALL REQUIRED PARAMETERS HAVE BEEN FOUND C0500387C C0500388 400 IF(MORPAR .NE. 0) GO TO 310 C0500389C C0500390C SET UP FOR HOST FILE MANAGER CALLS C0500391C C0500392 IDATA(1)=$2424 C0500393 IDATA(2)=$484F C0500394 IDATA(3)=$5354 C0500395 IDATA(5)=$2424 C0500396 IDATA(9)=$5359 C0500397 IDATA(10)=$5356 C0500398 IDATA(11)=$4F4C C0500399 IDATA(13)=0 C0500400 IDATA(14)=1 C0500401 IDATA(15)=-1 C0500402 REQBUF(13)=0 C0500403ÐÐC C0500404C GET FCB HEADER C0500405C LDA =XFCBHDR C0500406C STA+ REQBUF+9 C0500407C C0500408 ASSEM $C000,+FCBHDR C0500409 ASSEM $6400,+REQBUF(10) C0500410C C0500411C OPEN AND LOCK HOST FILE C0500412C C0500413 CALL OPENFL(REQBUF,IDATA,ISTAT) C0500414 IF(ISTAT)8000,447,447 C0500415 447 REQBUF(13)=TDATRL C0500416C C0500417C READ IN HOST FILE C0500418C C0500419 CALL GETS(REQBUF,RECBUF,KEYVAL,ISTAT) C0500420 IF(ISTAT)8000,450,450 C0500421C C0500422C CHECK IF FIRST PARAMETER IS ADD OR DELETE C0500423C C0500424 450 IF(IDATA(20).EQ.$4445) GO TO 520 C0500425 IF(IDATA(20).NE.$4144) GO TO 8010 C0500426C C0500427C ADD HOST NAME. SEARCH FOR DUPLICATE NAME. C0500428ÐÐC C0500429 K=RECLEN*TDATRL C0500430 DO 460 I=1,K,RECLEN C0500431 IF(RECBUF(I).EQ.DUMMY(5).AND.RECBUF(I+1).EQ.DUMMY(6)) C0500432 1 GO TO 8020 C0500433 460 CONTINUE C0500434C C0500435C NO DUPLICATE NAME FOUND. CHECK FOR ROOM IN FILE. C0500436C C0500437 DO 470 I=1,K,RECLEN C0500438 IF(RECBUF(I).EQ.BLANK.AND.RECBUF(I+1).EQ.BLANK) GO TO 480 C0500439 470 CONTINUE C0500440C C0500441C NO ROOM IN FILE. GO TO ERROR. C0500442C C0500443 INDEX = KERBAS C0500444 GO TO 9999 C0500445C C0500446C CHECK IF SIMULATOR IS 200UT C0500447C C0500448 480 IF(DUMMY(1).EQ.$3230) GO TO 490 C0500449C C0500450C CHECK IF SIMULATOR IS HASP C0500451C C0500452 IF(DUMMY(1).NE.$4841) GO TO 8030 C0500453ÐÐC C0500454C SET TYPE TO 2 FOR HASP C0500455C C0500456 RECBUF(I+2)=$200 C0500457 GO TO 500 C0500458C C0500459C SET TYPE TO 1 FOR 200UT C0500460C C0500461 490 RECBUF(I+2)=$100 C0500462C C0500463C MOVE HOST NAME TO HOST RECORD C0500464C C0500465 500 RECBUF(I)=DUMMY(5) C0500466 RECBUF(I+1)=DUMMY(6) C0500467C C0500468C PUT NEW RECORD IN HOST FILE C0500469C C0500470 510 CALL UPDREC(REQBUF,RECBUF,ISTAT) C0500471 IF(ISTAT)8000,9998,9998 C0500472C C0500473C DELETE PROCESSING SECTION. LOOK FOR HOST NAME C0500474C C0500475 520 K=RECLEN*TDATRL C0500476 DO 530 I=1,K,RECLEN C0500477 IF(RECBUF(I).EQ.DUMMY(5).AND.RECBUF(I+1).EQ.DUMMY(6)) C0500478ÐÐ 1 GO TO 540 C0500479 530 CONTINUE C0500480C C0500481C HOST NAME NOT FOUND. GO TO ERROR C0500482C C0500483 INDEX = KERBAS + 1 C0500484 GO TO 9999 C0500485C C0500486C NAME FOUND. CHECK IF BATCH DRIVER WORKING ON THIS HOST C0500487C C0500488 540 IF(AND(RECBUF(I+2),$400).NE.0) GO TO 8040 C0500489C C0500490C LOCAL HOST CANNOT BE DELETED C0500491C C0500492 IF(RECBUF(I).EQ.$4C4F.AND.RECBUF(I+1).EQ.$434C) GO TO 8060 C0500493C C0500494C ALL STATUS WORDS MUST BE ZERO IN ORDER TO DELETE THIS RECORD C0500495C C0500496 DO 550 J=3,RECLEN C0500497 IF(STAT1(J).NE.0) GO TO 8050 C0500498 IF(STAT2(J).NE.0) GO TO 8050 C0500499 IF(STAT3(J).NE.0) GO TO 8050 C0500500 IF(STAT4(J).NE.0) GO TO 8050 C0500501 550 CONTINUE C0500502C C0500503ÐÐC SET HOST NAME TO BLANKS AND TYPE TO ZERO C0500504C C0500505 RECBUF(I)=BLANK C0500506 RECBUF(I+1)=BLANK C0500507 RECBUF(I+2)=0 C0500508 GO TO 510 C0500509 8000 CALL ERCHK(ISTAT,REQBUF(4)) C0500510 GO TO 9993 C0500511C C0500512C SET INDEX = PARAMETER MUST BE ADD OR DEL C0500513C C0500514 8010 CONTINUE C0500515 INDEX = KERBAS + 2 C0500516 GO TO 9999 C0500517C C0500518C SET INDEX = DUPLICATE HOST NAME C0500519C C0500520 8020 CONTINUE C0500521 INDEX = KERBAS + 3 C0500522 GO TO 9999 C0500523C C0500524C SET INDEX = PROTOCOL TYPE MUST BE 200UT OR HASP C0500525C C0500526 8030 CONTINUE C0500527 INDEX = KERBAS + 4 C0500528ÐÐ GO TO 9999 C0500529C C0500530C SET INDEX = BATCH DRIVER BUSY ON THIS HOST C0500531C C0500532 8040 CONTINUE C0500533 INDEX = KERBAS + 5 C0500534 GO TO 9999 C0500535C C0500536C SET INDEX = JOB(S) PENDING FOR THIS HOST C0500537C C0500538 8050 CONTINUE C0500539 INDEX = KERBAS +6 C0500540 GO TO 9999 C0500541C C0500542C SET INDEX = ILLEGAL TO DELETE LOCAL HOST C0500543C C0500544 8060 CONTINUE C0500545 INDEX = KERBAS + 12 C0500546C C0500547C ERROR ROUTINE C0500548C C0500549 9999 CALL SYSMSG (INDEX,ERBUF) C0500550C C0500551 9993 IF (PIND) 9994,9994,11 C0500552 9994 IF (MODE) 9995,9998,9995 C0500553ÐÐ 9995 ASSEM $E400,+MODE C0500554 ASSEM $D622 C0500555C C0500556 9998 CALL CLOSFL(REQBUF,ISTAT) C0500557 9997 RETURN C0500558 END C0500559 SUBROUTINE MVCHAR (BUFFER,INITS,NCHAR,TARGET,INIT1) C0600001 1 /C06 F ITOS CCS 3.0 SL-149C0600002C MOVE CHARACTER ROUTINE C0600003C ************************************************************* 122*4873C0600004C CREDIT COLLECTION SYSTEM VERSION 3.0 C0600005C ************************************************************* 122*4873C0600006C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C0600007C COPYRIGHT CONTROL DATA CORPORATION 1979 C0600008C ************************************************************* 122*4873C0600009C*** C0600010C C0600011C FUNCTION C0600012C C0600013C ************************************************************* 122*4873C0600014C C0600015C C0600016C THIS ROUTINE MOVES NCHAR CHARACTERS STARTING AT BYTE INITS OF C0600017C BUFFER TO TARGET AT INIT1 BYTE C0600018C C0600019ÐÐ INTEGER BUFFER,TARGET C0600020C ************************************************************* 122*4873C0600021C*** C0600022C ************************************************************* 122*4873C0600023C C0600024C THE DIMENSION MAY BE ONE HERE BECAUSE THE SPACE IS OUTSIDE THIS C0600025C ROUTINE AND THE COMPILER DOES NOT CHECK THE LENGTH HERE C0600026C C0600027 DIMENSION BUFFER(1),TARGET(1) C0600028C C0600029 ISTART=INITS C0600030 IEND=ISTART+NCHAR-1 C0600031 INIT=INIT1 C0600032C C0600033 DO 20 I=ISTART,IEND C0600034 ISW=(I-1)/2+1 C0600035+ COMPUTE START WORD ADDR IN BUFFER C0600036 ICHAR=AND(BUFFER(ISW),$FF00)/$100 C0600037C C0600038C CHECK IF LOWER OR UPPER CHAR DESIRED C0600039C C0600040 IF (AND(I,1) .EQ. 0) ICHAR=AND(BUFFER(ISW),$FF) C0600041C C0600042C COMPUTE OUTPUT ADDR IN TARGET C0600043C C0600044ÐÐ IOW=(INIT-1)/2+1 C0600045 IOC=AND(INIT,1) C0600046 IF (IOC .EQ. 1) GO TO 10 C0600047C C0600048 TARGET(IOW)=AND(TARGET(IOW),$FF00)+ICHAR C0600049 GO TO 20 C0600050C C0600051 10 TARGET(IOW)=AND(TARGET(IOW),$FF)+ICHAR*$100 C0600052 20 INIT=INIT+1 C0600053 RETURN C0600054 END C0600055 SUBROUTINE DEFINE C0700001 1 /C07 F ITOS CCS 3.0 . SL-149C0700002C CREDIT COLLECTON SYSTEM VERSION 3.0 C0700003C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C0700004C COPYRIGHT CONTROL DATA CORPORATION 1979 C0700005C *****************************************************'******* 122*4874C0700006C CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.1 C0700007C *****************************************************'******* 122*4591C0700008C *****************************************************'******* 122*4866C0700009C ************************************************************* 122*4874C0700010C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C0700011C COPYRIGHT CONTROL DATA CORPORATION 1977 C0700012C C0700013C C0700014ÐÐM FMUCOM C0700015C C0700016 INTEGER OWNR12,OWNR34,OWNR56,OWNR78,RECLEN,TDATRM,TDATRL C0700017 INTEGER DATBAM,DATBAL,FCBIND,TNKEYM,TNKEYL,POSKY1,POSKY2 C0700018 INTEGER POSKY3,POSKY4,TSFILM,TSFILL,EXPDAT(3),CRTDAT(3),FILTYP C0700019 INTEGER NOCUR,ZRO,ERBUF,PARNUM,PARID,PPTEMP(17),PPTAB(17) C0700020 INTEGER BUFLEN,TC,OUTP,BLANK,QUEST,STAT,OPN,WVL C0700021 INTEGER VLASDL,VLASDM,RECCNT,FSTAT,FTYPE,FCBAD C0700022 INTEGER SEQTYP,INDTYP,ADRTYP,DIRTYP C0700023 INTEGER TODAY,FCBTEM(3),VOLNAM(4) C0700024 INTEGER GOINDX,DSIZ,FLGTYP,RECBUF C0700025 INTEGER DESTIN C0700026+ DESTINATION ADDRESS FOR MOVER (SOMETIMES) C0700027C C0700028 DIMENSION IPNAM(17) C0700029 DIMENSION IJUST(17) C0700030 DIMENSION ICONV(17) C0700031 DIMENSION IREQ(17) C0700032 DIMENSION IFND(17) C0700033 DIMENSION NAME(90) C0700034 DIMENSION NREC(2),NR(4) C0700035 DIMENSION GOINDX(17) C0700036C ************************************************************* 130*5291C0700037 DIMENSION RECBUF(8602) C0700038C ************************************************************* 130*5291C0700039ÐÐC C0700040. C0700041 EQUIVALENCE (PPDEFI,PPTAB) C0700042C C0700043C FILE CONTROL BLOCK C0700044C C0700045 EQUIVALENCE (RECLEN,FCBBUF(1)) C0700046 EQUIVALENCE (TDATRM,FCBBUF(2)) C0700047 EQUIVALENCE (TDATRL,FCBBUF(3)) C0700048 EQUIVALENCE (DATBAM,FCBBUF(4)) C0700049 EQUIVALENCE (DATBAL,FCBBUF(5)) C0700050 EQUIVALENCE (FCBIND,FCBBUF(6)) C0700051 EQUIVALENCE (NEDATM,FCBBUF(7)) C0700052 EQUIVALENCE (NEDATL,FCBBUF(8)) C0700053 EQUIVALENCE (NEXTBM,FCBBUF(9)) C0700054 EQUIVALENCE (NEXTBL,FCBBUF(10)) C0700055 EQUIVALENCE (TNKEYM,FCBBUF(11)) C0700056 EQUIVALENCE (TNKEYL,FCBBUF(12)) C0700057 EQUIVALENCE (KEYBAM,FCBBUF(13)) C0700058 EQUIVALENCE (KEYBAL,FCBBUF(14)) C0700059 EQUIVALENCE (LENKY1,FCBBUF(15)) C0700060 EQUIVALENCE (POSKY1,FCBBUF(16)) C0700061 EQUIVALENCE (LENKY2,FCBBUF(17)) C0700062 EQUIVALENCE (POSKY2,FCBBUF(18)) C0700063 EQUIVALENCE (LENKY3,FCBBUF(19)) C0700064ÐÐ EQUIVALENCE (POSKY3,FCBBUF(20)) C0700065 EQUIVALENCE (LENKY4,FCBBUF(21)) C0700066 EQUIVALENCE (POSKY4,FCBBUF(22)) C0700067 EQUIVALENCE (TSFILM,FCBBUF(23)) C0700068 EQUIVALENCE (TSFILL,FCBBUF(24)) C0700069 EQUIVALENCE (NAME12,FCBBUF(25)) C0700070 EQUIVALENCE (OWNR12,FCBBUF(29)) C0700071 EQUIVALENCE (EXPDAT(1),FCBBUF(89)) C0700072 EQUIVALENCE (CRTDAT(1),FCBBUF(92)) C0700073 EQUIVALENCE (FILTYP,FCBBUF(95)) C0700074 EQUIVALENCE (MAXREC,IDATA(13)) C0700075+ RECORD LENGTH FOR DEFINED FILE C0700076C C0700077C EXTERNALS C0700078C C0700079 EXTERNAL WTREAD C0700080 EXTERNAL GETFLD C0700081 EXTERNAL ITSERR C0700082 EXTERNAL MOVEL C0700083 EXTERNAL MOVER C0700084 EXTERNAL OPENFL C0700085 EXTERNAL GETFCB C0700086 EXTERNAL TODAY C0700087 EXTERNAL SEKVIT C0700088 EXTERNAL GETSSZ C0700089ÐÐC C0700090 INTEGER CNVRT C0700091C ************************************************************* 130*5291C0700092 INTEGER RCBLEN C0700093 INTEGER SECLEN C0700094C ************************************************************* 130*5291C0700095C C0700096. C0700097 BYTE (IFN,IPROC(0=0)) C0700098 BYTE (IOW,IPROC(1=1)) C0700099 BYTE (IVL,IPROC(2=2)) C0700100C C0700101 BYTE (IFND,PPTEMP(15=15)) C0700102 BYTE (IREQ,PPTEMP(12=12)) C0700103 BYTE (ICONV,PPTEMP(10=9)) C0700104 BYTE (IJUST,PPTEMP(8=8)) C0700105 BYTE (IPNAM,PPTEMP(7=0)) C0700106C C0700107 BYTE (ICHAR,CODE(1)(15=8)) C0700108C C0700109 BYTE (IOUT,ISTAT(12=12)) C0700110 BYTE(GOINDX,PPTEMP(11=8)) C0700111C C0700112 DATA NAME/'FILE-NAME =VOLUME-NAME=EXPIRE DATE=FILE TYC0700113 1PE =RCRD LENGTH=NUMBR RCRDS=KEY1 LENGTH=KEY1 POSITN=KEY2 LENGTH=KC0700114ÐÐ 2EY2 POSITN=KEY3 LENGTH=KEY3 POSITN=KEY4 LENGTH=KEY4 POSITN=SCTR ALC0700115 3GNED='/ C0700116 DATA NOCUR/-1/,ZRO/0/ C0700117 DATA BUFLEN/40/ C0700118 DATA BLANK/$2020/ C0700119 DATA QUEST/'? '/ C0700120 DATA SEQTYP/' S'/ C0700121 DATA INDTYP/' I'/ C0700122 DATA ADRTYP/' A'/ C0700123 DATA DIRTYP/' D'/ C0700124C ************************************************************* 130*5291C0700125 C0700126 DATA RCBLEN/9600/ C0700127C ************************************************************* 130*5291C0700128C C0700129C INITIALISATION C0700130C C0700131 11 INDEX=0 C0700132+ ERROR MSG NO. C0700133 ERBUF=0 C0700134+ ERROR MSG BUF C0700135 ISTAT=0 C0700136+ STATUS OF FM-REQUEST C0700137 LNGO=0 C0700138+ LENGTH OF FIELD TO MOVE C0700139ÐÐ MORPAR=0 C0700140+ INDICATOR IF MORE PARAMETERS NEEDED C0700141 MORLIN=0 C0700142+ INDICATOR IF MORE LINES NEED TO BE READ C0700143 PARNUM=0 C0700144+ COUNT OF REQ.AND NOT FOUND PARAMETERS C0700145 IP=1 C0700146 PARID=0 C0700147 MORFIL=0 C0700148 IFTSW=0 C0700149 IDFLG=0 C0700150 FLGTYP=0 C0700151 LENREC=0 C0700152 LENKEY=0 C0700153 IFLTYP=0 C0700154+ (DEFAULT IS SEQUENTIAL) C0700155. C0700156. C0700157 IINTRP=0 C0700158 ASSIGN 9998 TO INTLOC C0700159 CALL PGMINT(INTLOC,IINTRP) C0700160C C0700161C COPY THE PARAMETER PROCESSING TABLE C0700162C C0700163 I=0 C0700164ÐÐ 10 I=I+1 C0700165 PPTEMP(I)=PPTAB(I) C0700166 IF(PPTEMP(I))10,20,10 C0700167C C0700168C C0700169C C0700170 20 DO 30 I=1,24 C0700171 REQBUF(I)=0 C0700172 IDATA(I)=PARDEF(I) C0700173 30 CONTINUE C0700174 IDATA(9)=$5359 C0700175+ SET VOLUME LABEL = 'SYSVOL ' C0700176 IDATA(10)=$5356 C0700177 IDATA(11)=$4F4C C0700178 CALL TODAY(FCBTEM) C0700179 EXPDAT(1)=FCBTEM(1) C0700180+ DEFAULT EXPIRE DATE = TODAY C0700181 EXPDAT(2)=FCBTEM(2) C0700182 EXPDAT(3)=FCBTEM(3) C0700183C C0700184 35 IF(FLGTYP)38,36,38 C0700185+ TEST FOR SEQUENTIAL(0=YES, NZ=NO) C0700186 36 I=(IPNAM(IP)-1)*3+1 C0700187+ CALCULATE SUBSCRIPT INTO MNEMONIC TABLC0700188 IF(PARNAM(I).NE.$4B31)GO TO 38 C0700189ÐÐ+ TEST FOR K1-IF SO, GO TO SA PARMC0700190 DO 37 I=17,24 C0700191+ ZERO OUT IDATA FOR SEQUENTIAL C0700192 37 IDATA(I)=0 C0700193 IP=IP+8 C0700194+ GO TO SA PARAMETER C0700195 38 IF(PIND)109,70,40 C0700196C C0700197C PROMPTING LEVEL = 1 FULL PARAMETERS WILL BE DISPLAYED C0700198C C0700199 40 KI=IP C0700200 I=(IP-1)*6+1 C0700201 IF(IPNAM(IP))50,420,50 C0700202C C0700203 50 J=I+5 C0700204 K=1 C0700205 CODE(K)=$0A0D C0700206+ SET CR/LF C0700207 DO 60 I=I,J C0700208 K=K+1 C0700209 CODE(K)=NAME(I) C0700210 60 CONTINUE C0700211 I=KI C0700212C C0700213 LNGO=7 C0700214ÐÐ GO TO 90 C0700215C C0700216. C0700217C PROMPTING LEVEL = 0 PARAMETER ABBREVIATIONS WILL BE DISPLAYED C0700218C C0700219 70 I=IP C0700220 K=IPNAM(IP) C0700221+ INDEX TO PARAM.MNEM.TABLE C0700222 IF(K)80,100,80 C0700223 80 K=(K-1)*3+1 C0700224C C0700225 CODE(1)=$0A0D C0700226 CODE(2)=PARNAM(K) C0700227 CODE(3)=$3D20 C0700228 LNGO=3 C0700229C C0700230C DISPLAY NEXT PARAMETER-IDENT C0700231C C0700232 90 CALL WTREAD (LUNIT,NOCUR,CODE,LNGO,NOCUR,DUMMY,ZRO,TC) C0700233C C0700234 PARID=IP C0700235+ INDEX IN PARNAM-TABLE C0700236 IFND(I)=1 C0700237+ SET FOUND FLAG C0700238 IP=IP+1 C0700239ÐÐ+ INCR. INDEX TO PPTEMP C0700240 MORPAR=1 C0700241+ SET INDICATOR FOR MORE PARAMETERS NEEDED C0700242 GO TO 120 C0700243C C0700244C END OF PARAMETER LIST, ISSUE FM-REQUEST C0700245C C0700246 100 MORPAR=0 C0700247 GO TO 420 C0700248C C0700249C PROMPTING LEVEL = -1, NO PROMPTING DONE C0700250C C0700251 109 I=0 C0700252 110 IF(MORLIN)115,130,130 C0700253+ DO WE NEED TO READ MORE LINES C0700254 115 MORLIN=0 C0700255C C0700256C READ NEXT LINE C0700257C C0700258 120 CALL WTREAD (LUNIT,NOCUR,DUMMY,ZRO,NOCUR,INBUF,BUFLEN,TC) C0700259C C0700260C RESET SWORD AND SBYTE C0700261C C0700262 SBYTE=0 C0700263 SWORD=0 C0700264ÐÐC C0700265 130 CALL GETFLD (INBUF,CODE,SWORD,SBYTE,STAT) C0700266C C0700267 140 IF (STAT-2)150,160,200 C0700268 150 IF (STAT-1)260,250,250 C0700269C C0700270. C0700271C EOL DETECTED,COUNT NO OF REQUIRED AND NOT FOUND PARAMETERS (STATUS=2)C0700272C C0700273 160 IF(PIND)161,162,162 C0700274 161 MORPAR=0 C0700275C C0700276C CHECK IF FULL NAME DESIRED. . . . C0700277C C0700278 162 IF(CODE(1)-QUEST)164,163,164 C0700279 163 IF (PIND .NE. -1) IP=IP-1 C0700280 GO TO 40 C0700281C C0700282C CHECK IF PARAMETER ENTERED C0700283C C0700284 164 IF(ICHAR.NE.$20)GO TO 170 C0700285C C0700286+ NO - NOT ENTERED C0700287 IFND(IP-1)=0 C0700288 I=(IPNAM(IP-1)-1)*3+1 C0700289ÐÐ IF(PARNAM(I).EQ.$4B31)LENKEY=1 C0700290 IF(IREQ(IP-1).EQ.0)PARNUM=PARNUM+1 C0700291 IF (PIND .EQ. -1) GO TO 420 C0700292 GO TO 35 C0700293C C0700294 170 I=I+1 C0700295 IF(PPTEMP(I))170,270,180 C0700296. C0700297C C0700298C PARAMETER NOT FOUND,IS IT REQUIRED C0700299C C0700300 180 IF(IREQ(I))170,190,170 C0700301C C0700302C YES IT IS REQUIRED C0700303C C0700304 190 PARNUM=PARNUM+1 C0700305+ NO OF REQ PARAMETERS C0700306 GO TO 170 C0700307C C0700308C PARAMETER-ID FOUND (STATUS=3) C0700309C C0700310 200 I=1 C0700311 210 K=IPNAM(I) C0700312 K=(K-1)*3+1 C0700313C C0700314ÐÐ IF (CODE(1)-PARNAM(K))230,220,230 C0700315C C0700316C PARAMETER-ID CORRESPONDS WITH PARAM.MNEMONIC TABLE C0700317C C0700318 220 PARID=I C0700319 IP=I+1 C0700320 IFND(I)=1 C0700321 GO TO 130 C0700322C C0700323 230 I=I+1 C0700324+ NO MATCH,CONTINUE C0700325 IF(IPNAM(I))210,240,210 C0700326C C0700327 240 INDEX=69 C0700328+ 69 - PARAMETER ENTRY ERROR C0700329 GO TO 9999 C0700330C C0700331. C0700332C FIELD TERMINATED ON A SEMI-COLON (STATUS=1) C0700333C C0700334 250 MORLIN=-1 C0700335+ SET INDICATOR TO READ MORE LINES C0700336C C0700337C FIELD TERMINATED ON A COMMA (STATUS=0) C0700338C C0700339ÐÐ 260 MORPAR=1 C0700340+ SET INDICATOR FOR MORE PARAMETERS C0700341C C0700342C CHECK IF PARAMETER ENTERED C0700343C C0700344 IF(ICHAR.NE.$20)GO TO 270 C0700345 I=(IPNAM(IP-1)-1)*3+1 C0700346 IF(PARNAM(I).EQ.$4B31)LENKEY=1 C0700347 IFND(IP)=0 C0700348 IP=IP+1 C0700349+ NO C0700350 GO TO 400 C0700351C C0700352C STORE PARAMETER VALUES INTO REQUIRED LOCATIONS C0700353C C0700354 270 IF (PARID)290,290,280 C0700355+ PARAMETER-ID FOUND C0700356 280 I=PARID C0700357+ YES C0700358 GO TO 300 C0700359C C0700360 290 I=IP+1 C0700361 IF (ICHAR .NE. $20) IFND(I)=1 C0700362 IP=IP+1 C0700363C C0700364ÐÐ 300 IPNAMI=IPNAM(I) C0700365 I=(IPNAM(I)-1)*3+1 C0700366+ CALCULATE SUBSCRIPT INTO MNEMONIC TABLC0700367C C0700368 LNGO=PARNAM(I+1) C0700369 OUTP=PARNAM(I+2) C0700370C C0700371C STORE INTO DESIGNATED OUTPUT FIELD C0700372C C0700373C GET ADDRESS OF NR C0700374C C0700375 ASSEM $C000,+NR C0700376 ASSEM $6800,IADR C0700377C C0700378C C0700379. C0700380C COMPUTED GO TO BASED ON PPTAB BITS WHICH DESIGNATE C0700381C SHIFTING, CONVERSION, ETC. AS FOLLOWS: C0700382C ******************************************************************** C0700383C C0700384C BIT VALUE MEANING C0700385C C0700386C 8 0 RIGHT JUSTIFY C0700387C 1 LEFT JUSTIFY C0700388C C0700389ÐÐC 9 0 NO CONVERSION C0700390C 1 ASCII-BINARY CONVERSION C0700391C C0700392C 10 0 ONE-WORD BINARY OUTPUT C0700393C 1 TWO-WORD BINARY OUTPUT C0700394C C0700395C 11 0 STANDARD PROCESSING AS ABOVE C0700396C 1 SPECIAL PROCESSING (SA,TY) C0700397C C0700398C ******************************************************************** C0700399C C0700400 IF(GOINDX(PARID))906,304,301 C0700401 301 GO TO(302,306,906,906,906,308,906,310,310,310,310,310,310,310 C0700402 1,310),GOINDX(PARID) C0700403C C0700404C LEFT JUSTIFIED, NO CONVERSION C0700405C C0700406 302 CALL MOVEL(CODE,OUTP,LNGO) C0700407 GO TO 314 C0700408C C0700409C RIGHT JUSTIFIED, NO CONVERSION C0700410C C0700411 304 CALL MOVER(CODE,LNGO,OUTP,LNGO) C0700412 GO TO 314 C0700413C C0700414ÐÐC ASCII - BINARY CONVERSION, ONE-WORD OUTPUT C0700415C C0700416 306 DSIZ=8 C0700417 CALL MOVER(CODE,LNGO,IADR,DSIZ) C0700418 IF (CNVRT(NR,NREC) .NE. 0) GO TO 911 C0700419C C0700420C MOVE BINARY OUTPUT TO DESTINATION . . . C0700421C C0700422 ASSEM $E400,+OUTP C0700423 ASSEM $C400,+NREC(2) C0700424 ASSEM $6622 C0700425C C0700426 GO TO 314 C0700427C C0700428C ASCII - BINARY CONVERSION, TWO-WORD OUTPUT C0700429C C0700430 308 DSIZ=8 C0700431 CALL MOVER(CODE,LNGO,IADR,DSIZ) C0700432 IF (CNVRT(NR,NREC) .NE. 0) GO TO 911 C0700433C C0700434C MOVE BINARY OUTPUT TO DESTINATION . . . C0700435C C0700436C ************************************************************* 130*5306C0700437 ASSEM $C0FF C0700438+ LDA- I C0700439ÐÐ ASSEM $680E C0700440+ STA* *+14 C0700441 ASSEM $C400,+OUTP C0700442+ LDA+ OUTP C0700443 ASSEM $60FF C0700444+ STA- I C0700445 ASSEM $E400,+NREC(1) C0700446+ LDQ+ NREC(1) C0700447 ASSEM $C400,+NREC(2) C0700448+ LDA+ NREC(2) C0700449 ASSEM $0FC1 C0700450+ ALS 1 C0700451 ASSEM $0F61 C0700452+ LRS 1 C0700453 ASSEM $44FF C0700454+ STQ- (I) C0700455 ASSEM $D0FF C0700456+ RAO- I C0700457 ASSEM $64FF C0700458+ STA- (I) C0700459 ASSEM $C000,$0 C0700460+ LDA =N0 C0700461 ASSEM $60FF C0700462+ STA- I C0700463C ************************************************************* 130*5306C0700464ÐÐC C0700465 GO TO 314 C0700466C C0700467. C0700468C SPECIAL CASES . . . FURTHER TESTING REQUIRED C0700469C C0700470C C0700471C TEST FOR PARAMETER 07 (TYPE) C0700472 310 IF(IPNAM(IP-1).EQ.07)GO TO 312 C0700473 IF(IPNAM(IP-1).NE.$12)GO TO 904 C0700474C C0700475C PARAMETER IS 12 (SECTOR ALIGNED) C0700476C C0700477C ************************************************************* 122*4874C0700478 IF (CODE(1).NE.$4E20) IDATA(16)=AND(IDATA(16),$7FFF)+$8000 C0700479C ************************************************************* 122*4874C0700480 GO TO 314 C0700481C C0700482C PARAMETER IS 07 (TYPE) C0700483C C0700484 312 IF(CODE(1).EQ.$4F20.OR.CODE(1).EQ.$5220)IDATA(16)=OR(IDATA(16), C0700485 1$0001) C0700486C ************************************************************* 122*4866C0700487C IF THIS IS AN ORDERED FILE, SET THE ORDERED BIT IN IDATA(16) C0700488 IF (CODE(1).EQ.$4F20) IDATA(16)=OR(IDATA(16),$4000) C0700489ÐÐC *****************************************************'******* 122*4866C0700490C C0700491C TEST BELOW FOR 'D' (DIRECT) TYPE FILE . . . C0700492C C0700493 IF(CODE(1).EQ.$4420)IDFLG=1 C0700494C C0700495C ******************************************************************* C0700496C C0700497C PARAMETER LIMIT CHECKS C0700498C COMPUTED GO TO BASED ON PARAMETER ORDINAL; ROUTINES C0700499C WILL DO LIMIT CHECKS AND EITHER RETURN BELOW, OR C0700500C RE-PROMPT THE USER, OR HALT ON ERROR IF NON-INTERACTIVE. C0700501C C0700502 314 GO TO(700,700,700,710,720,730,750,760,770,780,790,780,790,780,790 C0700503 1,780,790,800,400,400,810,400),IPNAMI C0700504C C0700505C TEST FIRST CHARACTER FOR NON-BLANK C0700506C C0700507 700 IF(ICHAR.NE.$20)GO TO 400 C0700508 GO TO 900 C0700509C C0700510C CHECK DISK UNIT FOR.LE.MAXIMUM UNITS C0700511C C0700512 710 ASSEM $C000,MMLUTB C0700513 ASSEM $6800,MLUTB C0700514ÐÐ IF(NREC(2).LE.MLUTB)GO TO 400 C0700515 GO TO 900 C0700516C C0700517C CHECK NO. OF FILES FOR THE RANGE 1-1024 C0700518C C0700519 720 IF(NREC(2).GE.1.AND.NREC(2).LE.1024)GO TO 400 C0700520 GO TO 900 C0700521C C0700522. C0700523C CHECK EXPIRE DATE FOR LEGAL LIMITS(DATE GE TODAY, MONTH C0700524C LE 12, DAY LE 31; EXCEPTION - 999999 PERMISSIBLE) C0700525C C0700526 730 CALL TODAY(FCBTEM) C0700527 IF(CODE(3).LT.FCBTEM(3))GO TO 900 C0700528 IF(CODE(3).GT.FCBTEM(3))GO TO 740 C0700529C EXPIRE DATE IS THIS YEAR C0700530 IF(CODE(1).GT.$3132.OR.CODE(1).LT.FCBTEM(1))GO TO 735 C0700531 IF(CODE(1).GT.FCBTEM(1))GO TO 740 C0700532C EXPIRE DATE IS THIS MONTH C0700533 IF(CODE(2).GT.$3331.OR.CODE(2).LT.FCBTEM(2))GO TO 735 C0700534 GO TO 400 C0700535C AT THIS POINT,ONLY 999999 IS ACCEPTABLE C0700536 735 IF(CODE(1).NE.$3939.OR.CODE(2).NE.$3939.OR.CODE(3).NE.$3939) C0700537 1GO TO 900 C0700538 GO TO 400 C0700539ÐÐC NOW VERIFY MONTH, DAY FOR MAX VALUES C0700540 740 IF(CODE(1).LE.$3132.AND.CODE(1).GE.$3031.AND.CODE(2).LE.$3331.AND.C0700541 1CODE(2).GE.$3031)GO TO 400 C0700542 GO TO 735 C0700543C C0700544C CHECK TYPE FOR D,O,R,S AND FLAG IF NON-SEQUENTIAL(O,R) C0700545C C0700546 750 FLGTYP=0 C0700547+ SET TYPE FLAG SEQUENTIAL C0700548 IF(ICHAR.EQ.$53)GO TO 400 C0700549+ S TYPE C0700550 IF(ICHAR.EQ.$44)GO TO 752 C0700551+ D TYPE C0700552 IF(ICHAR.EQ.$52)GO TO 754 C0700553+ R TYPE C0700554 IF(ICHAR.EQ.$4F)GO TO 754 C0700555+ O TYPE C0700556 GO TO 900 C0700557+ NONE OF THE ABOVE = ERROR C0700558 752 IFLTYP=3 C0700559 GO TO 400 C0700560 754 IFLTYP=1 C0700561 755 FLGTYP=1 C0700562+ SET TYPE FLAG NON-SEQUENTIAL C0700563 GO TO 400 C0700564ÐÐC C0700565C CHECK RECORD LENGTH FOR THE RANGE 2-32766. C0700566C C0700567 760 LENREC=NREC(2) C0700568 IF(NREC(1))900,764,900 C0700569 764 IF(NREC(2)-2)900,400,767 C0700570 767 IF(NREC(2)-32766)400,400,900 C0700571C C0700572C CHECK NUMBER OF RECORDS FOR THE RANGE 1-16,777,215 C0700573C C0700574 770 IF(NREC(1))900,774,772 C0700575 772 IF(NREC(1)-127)400,400,900 C0700576C ************************************************************* 130*5306C0700577 774 IF (AND($FF,NREC(2)).EQ.0 .AND. AND((NREC(2)/$100),$FF).EQ.0) C0700578 1 GO TO 900 C0700579 GO TO 400 C0700580C ************************************************************* 130*5306C0700581. C0700582C C0700583C CHECK KEY LENGTH FOR THE RANGE 1-29, IF NON-SEQUENTIAL FILE. C0700584C C0700585 780 IF(FLGTYP.EQ.0)GO TO 900 C0700586 LENKEY=NREC(2) C0700587 IF(NREC(1))900,784,900 C0700588 784 IF(NREC(2))900,900,786 C0700589ÐÐ 786 IF(NREC(2)-29)400,400,900 C0700590C C0700591C CHECK KEY POSN FOR THE RANGE 1-(RECLENTH-KEYLENTH), IF NON-SEQ. C0700592C C0700593 790 IF(FLGTYP.EQ.0)GO TO 900 C0700594 IF(NREC(1))900,794,900 C0700595 794 IF(NREC(2))900,900,796 C0700596 796 IF(LENREC.EQ.0)LENREC=192 C0700597 IF((NREC(2)-1)-(LENREC-LENKEY))400,400,900 C0700598C C0700599C CHECK SA FOR YES OR NO C0700600C C0700601 800 IF(ICHAR.EQ.$59.OR.ICHAR.EQ.$4E)GO TO 400 C0700602 GO TO 900 C0700603C C0700604C CHECK MODE FOR A, E, OR B C0700605C C0700606 810 IF(ICHAR.EQ.$41.OR.ICHAR.EQ.$45.OR.ICHAR.EQ.$42)GO TO 400 C0700607 GO TO 900 C0700608C C0700609C PROCESS AND REPORT ERRORS C0700610C C0700611 900 INDEX=69 C0700612 910 CALL SYSMSG(INDEX,ERBUF) C0700613 911 CONTINUE C0700614ÐÐ IF(MODE.NE.0.AND.MODE.NE.$1000)GO TO 9996 C0700615 IF(PIND.EQ.-1)GO TO 9998 C0700616+ CHECK FOR NO PROMPTING C0700617 IP=IP-1 C0700618 GO TO 35 C0700619C C0700620C ******************************************************************* C0700621. C0700622C C0700623 400 PARID=0 C0700624 IF(MORPAR)35,420,35 C0700625+ ARE THERE MORE PARAM TO BE PROCESSED C0700626C C0700627 420 IF (PARNUM)240,430,240 C0700628+ ARE ALL REQUIRED PARAMETERS FOUND C0700629C C0700630 430 CONTINUE C0700631C C0700632C CREATE THE REQUESTED FILE C0700633C C0700634 1000 CALL CREATE (REQBUF,IDATA,ISTAT) C0700635 IF(ISTAT)1020,1100,1100 C0700636 1020 CALL ERCHK(ISTAT,REQBUF(4)) C0700637+ GO FIND WHICH ISTAT BIT IS ON C0700638 GO TO 9994 C0700639ÐÐC C0700640 1100 IREQ10=REQBUF(10) C0700641 DO 1110 I=1,24 C0700642 REQBUF(I)=0 C0700643 1110 CONTINUE C0700644 REQBUF(10)=IREQ10 C0700645 NREC(2)=MAXREC C0700646+ SAVE NO. OF RECORDS FOR LATER C0700647 IDATA(13)=0 C0700648 IDATA(14)=1 C0700649 IDATA(15)=-1 C0700650C SETUP FOR FCB IN USER SPACE C0700651 REQBUF(13) = 96 C0700652 ASSEM $C000,+FCBHDR C0700653+ LDA =FCBHDR C0700654 ASSEM $6400,+REQBUF(10) C0700655+ STA+ REQBUF+9 C0700656C SAVE EXPIRE DATE(IN FCBBUF+88-90) OVER OPENFL,GETFCB CALLS C0700657 FCBTEM(1) = EXPDAT(1) C0700658 FCBTEM(2) = EXPDAT(2) C0700659 FCBTEM(3) = EXPDAT(3) C0700660C C0700661 CALL OPENFL(REQBUF,IDATA,ISTAT) C0700662 IF(ISTAT)1120,1200,1200 C0700663 1120 CALL ERCHK(ISTAT,REQBUF(4)) C0700664ÐÐ+ GO FIND WHICH ISTAT BIT IS ON C0700665 GO TO 9994 C0700666C C0700667 1200 VOLNAM(1)=0 C0700668 CALL GETFCB(REQBUF,VOLNAM,INDEX,FCBBUF,ISTAT) C0700669 IF(ISTAT)1210,1240,1240 C0700670 1210 CALL ERCHK(ISTAT,REQBUF(4)) C0700671+ GO FIND WHICH ISTAT BIT IS ON C0700672 GO TO 9994 C0700673C C0700674C UPDATE FCB C0700675C C0700676 1240 EXPDAT(1)=FCBTEM(1) C0700677+ RESTORE EXPIRE DATE C0700678 EXPDAT(2)=FCBTEM(2) C0700679 EXPDAT(3)=FCBTEM(3) C0700680 CALL TODAY(FCBTEM) C0700681 CRTDAT(1) =FCBTEM(1) C0700682+ INSERT CREATE DATE C0700683 CRTDAT(2) =FCBTEM(2) C0700684 CRTDAT(3) =FCBTEM(3) C0700685 FILTYP=IFLTYP C0700686C C0700687 CALL UPDFCB(REQBUF,VOLNAM,INDEX,FCBBUF,ISTAT) C0700688 IF(ISTAT)1250,1255,1255 C0700689ÐÐ 1250 CALL ERCHK(ISTAT,REQBUF(4)) C0700690 GO TO 9994 C0700691+ GO FIND WHICH ISTAT BIT IS ON C0700692 1255 IF(IDFLG.EQ.0)GO TO 1300 C0700693+ CHECK FOR DIRECT FILE C0700694C C0700695C DIRECT FILE WANTED . . . C0700696C C0700697C ************************************************************* 122*4591C0700698 IF (NREC(2).LE.512) GO TO 1260 C0700699C ************************************************************* 122*4591C0700700+ CHECK RECORD LENGTH FOR MAX C0700701 INDEX=69 C0700702 GO TO 9999 C0700703C ************************************************************* 130*5291C0700704 1260 DO 1265 I = 1,RCBLEN C0700705C ************************************************************* 130*5291C0700706 1265 RECBUF(I)=$2020 C0700707+ BLANK OUT BUFFER C0700708C ************************************************************* 130*5291C0700709C COMPUTE NO. OF RECORDS PER BUFFERC0700710C C0700711C GET SECTOR LENGTH IN WORDS C0700712 CALL GETSSZ (FCBHDR,SECLEN) C0700713 NRECS = RCBLEN / FCBBUF(1) C0700714ÐÐ IF (AND(FCBIND,$8000) .EQ. 0) GO TO 1270 C0700715 NUMSEC = FCBBUF(1) / SECLEN C0700716 IF ((NUMSEC*SECLEN) .LT. RECLEN) NUMSEC = NUMSEC + 1 C0700717 NRECS = RCBLEN / (SECLEN*NUMSEC) C0700718C STORE A SET OF NRECS RECORDS C0700719 1270 CALL PUTS (REQBUF,RECBUF,NRECS,ISTAT) C0700720C ************************************************************* 130*5291C0700721 IF(IOUT)1300,1280,1300 C0700722+ CHECK FOR LAST RECORD C0700723 1280 IF(ISTAT)1285,1270,1270 C0700724 1285 CALL ERCHK(ISTAT,REQBUF(4)) C0700725+ GO FIND WHICH ISTAT BIT IS ON C0700726 GO TO 9994 C0700727 1300 CALL CLOSFL(REQBUF,ISTAT) C0700728 IF(ISTAT)1320,1400,1400 C0700729 1320 CALL ERCHK(ISTAT,REQBUF(4)) C0700730+ GO FIND WHICH ISTAT BIT IS ON C0700731 GO TO 9994 C0700732C C0700733 1400 RETURN C0700734C C0700735C C0700736 904 INDEX=69 C0700737+ 69 - PARAMETER ENTRY ERROR C0700738 GO TO 9999 C0700739ÐÐ 906 INDEX=70 C0700740+ 70 - PARAMETER ENTRY ERROR C0700741 9999 CALL SYSMSG(INDEX,ERBUF) C07007429994 IF(PIND)9995,9995,11 C0700743 9995 IF(MODE)9996,9998,9996 C0700744 9996 ASSEM $E400,+MODE C0700745 ASSEM $D622 C0700746 9998 CALL CLOSFL(REQBUF,ISTAT) C0700747+ CLOSE FILE FOR SAFETY C0700748 GO TO 1400 C0700749C C0700750 END C0700751 SUBROUTINE ERPROC(ISTAT,ICNT) C0800001 1 /C08 F ITOS CCS 3.0 SL-149C0800002C DETERMINES WHICH FM ERROR STATUS BITS ARE ON C0800003C CREDIT COLLECTION SYSTEM VERSION 3.0 C0800004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C0800005C COPYRIGHT CONTROL DATA CORPORATION 1979 C0800006C C0800007C C0800008C THIS SUBROUTINE STARTS AT THE LOW-ORDER END OF AN INPUT C0800009C WORD (TYPICALLY FM STATUS) AND DETERMINES WHICH BIT (OTHER C0800010C THAN 15) IS ON; THAT BIT'S ORDINAL (1-15) IS RETURNED TO C0800011C THE CALLER. C0800012C C0800013ÐÐC CALLING SEQUENCE: C0800014C CALL ERPROC(INPUT,OUTPUT) WHERE INPUT = WORD TO BE C0800015C SEARCHED FOR BITS, AND OUTPUT = ORDINAL OF FOUND BIT. C0800016C C0800017C C0800018 IMSK=1 C0800019 DO 100 I=0,14 C0800020 IF(AND(ISTAT,IMSK))25,50,25 C0800021 25 ICNT=I C0800022 RETURN C0800023 50 IMSK=IMSK*2 C0800024 100 CONTINUE C0800025 RETURN C0800026 END C0800027 SUBROUTINE STATUS C0900001 1 /C09 F ITOS CCS 3.0 SL-149C0900002C CREDIT COLLECTION SYSTEM VERSION 3.0 C0900003C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C0900004C COPYRIGHT CONTROL DATA CORPORATION 1979 C0900005C CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.1 C0900006C ************************************************************* 122*4865C0900007C *****************************************************'******* 122*4867C0900008C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C0900009C COPYRIGHT CONTROL DATA CORPORATION 1977 C0900010C C0900011ÐÐC*** C0900012C C0900013C FUNCTION C0900014C C0900015C THIS COMMAND PROCESSOR PRINTS THE STATUS OF THE C0900016C SPECIFIED FILE OR THE STATUS OFF ALL FILES ON THE C0900017C *****************************************************'******* 122*4867C0900018C STANDARD LIST DEVICE IF EXECUTED FROM THE MASTER-TERMINAL C0900019C ELSE A SHORT STATUS LIST IS DISPLAYED OF OWN FILES ON C0900020C THE NON-MASTER-TERMINAL C0900021C ************************************************************* 122*4867C0900022C ************************************************************* 122*4867C0900023C *****************************************************'******* 122*4867C0900024C C0900025C C0900026C GENERAL DESCRIPTION C0900027C C0900028C ON ENTRY THE PARAMETER PROCESSING TABLE(PPSTAT) IS C0900029C COPIED TO A TEMPORARILY TABLE(PPTEMP) C0900030C THE REASON WHY THE TABLE HAS TO BE COPIED IS THAT AS C0900031C PARAMETERS ARE FOUND,BITS WILL BE SET INTO PPTEMP C0900032C DEPENDING UPON PROMPTING LEVEL IT WILL DISPLAY EITHER C0900033C THE TWO-LETTER MNEMONIC CODE USED FOR PARAMETER-ID OR C0900034C THE FULL PARAMETER NAME (IN INTERACTIVE MODE ONLY) C0900035C WHEN THE MNEMONIC IS DISPLAYED AND ONE DOES NOT KNOW C0900036ÐÐC WHAT IT STANDS FOR,THE NAME WILL BE SPELLED OUT IF C0900037C A QUESTION-MARK(?) IS ENTERED AS THE FIRST AND ONLY C0900038C CHARACTER IN THE FIELD. C0900039C THE SYSTEM HOWEVER WILL RESUME ITS ORIGINAL PROMPTING C0900040C LEVEL C0900041C WHEN THE END OF THE PARAMETER STRING IS DETECTED,A C0900042C DECISION IS MADE TO DETERMINE WHICH TYPE OF STATUS IS C0900043C REQUIRED ACCORDING TO THE FOLLOWING DECISION TABLE. C0900044C C0900045C ***************************************** C0900046C *IPROC*VOLUME*OWNER*FILE-NAME*PROCESSING* C0900047C ***************************************** C0900048C * 1 * 0 * 0 * 0 * C * C0900049C * 2 * 0 * 0 * 1 * A * C0900050C * 3 * 0 * 1 * 0 * C * C0900051C * 4 * 0 * 1 * 1 * A * C0900052C * 5 * 1 * 0 * 0 * B * C0900053C * 6 * 1 * 0 * 1 * A * C0900054C * 7 * 1 * 1 * 0 * B * C0900055C * 8 * 1 * 1 * 1 * A * C0900056C ***************************************** C0900057C C0900058C 0 NOT SPECIFIED C0900059C 1 SPECIFIED C0900060C C0900061ÐÐC PROCESSING A C0900062C C0900063C THE FILE-NAME IS ALWAYS SPECIFIED C0900064C AS NEARLY ALL INFORMATION TO BE PRINTED IS CONTAINED C0900065C IN THE FCB,WE WANT TO FIND THE CORRESPONDING FCB C0900066C THE MOST EASY WAY OF ACCOMPLISHING THIS IS TO INITIALIZE C0900067C THE REQBUF. THIS IS DONE BY AN OPENFL REQUEST C0900068C IF THE FILE IS OPENED CORRECTLY A SEARCH TO GET THE VIT C0900069C IS DONE,FOLLOWED BY A READ OF THE VOLUMES-LABEL C0900070C NEXT A GETFCB REQUEST IS PERFORMED AND THE STATUS PRINT C0900071C OUT WILL BE DONE. C0900072C AT THE END OF EACH PRINTLINE A TEST IS DONE TO CHECK IF C0900073C MORE FILES HAVE TO BE PRINTED AND IF SO FTSW WILL BE SET C0900074C NEGATIVE TO SKIP PAST THE HEADER LINES C0900075C C0900076C C0900077C PROCESSING B. C0900078C C0900079C THE VOLUME NAME IS SELECTED ALWAYS C0900080C INDFCB IS SET TO ONE,AND A GETFCB REQUEST BY INDEX IS C0900081C DONE TO GET ALL FCB INFORMATION C0900082C IN CASE THE OWNER TOO IS SPECIFIED,ONLY THOSE FCB FOR C0900083C THE SPECIFIED OWNER WILL BE USED TO BUILD UP THE STATUS C0900084C PRINT-LINE. C0900085C THE INDICATOR FOR MORE FILES(MORFIL) IS SET NEGATIVE C0900086ÐÐC AND THE STATUS-LINE IS PRINTED C0900087C C0900088C C0900089C PROCESSING C C0900090C C0900091C THIS WILL PRINT THE STATUS OF ALL FILES FROM EITHER C0900092C A SPECIFIED OWNER OR FROM ALL OWNERS FROM ALL MOUNTED C0900093C VOLUMES. C0900094C C0900095C C0900096C C0900097C C0900098C COMMAND FORMAT C0900099C C0900100C STATUS C0900101C C0900102C STATUS,FN=AAAAAAAA,OW=AAAAAAAA,VL=AAAAAAAA C0900103C C0900104C STATUS,FFFFFFFF,OOOOOOOO,VVVVVVVV C0900105C C0900106C*** C0900107M FMUCOM C0900108. C0900109C C0900110 INTEGER OWNR12,OWNR34,OWNR56,OWNR78,RECLEN,TDATRM,TDATRL C0900111ÐÐ INTEGER DATBAM,DATBAL,FCBIND,TNKEYM,TNKEYL,POSKY1,POSKY2 C0900112 INTEGER POSKY3,POSKY4,TSFILM,TSFILL,EXPDAT,CRTDAT,FILTYP C0900113 INTEGER NOCUR,ZRO,ERBUF,PARNUM,PARID,PPTEMP(17),PPTAB(4) C0900114 INTEGER BUFLEN,TC,OUTP,BLANK,QUEST,STAT,OPN,WVL C0900115 INTEGER VLASDL,VLASDM,RECCNT,FSTAT,FTYPE,FCBAD C0900116C ************************************************************* 130*5245C0900117 INTEGER VLLBUF(2),LGSBLK(8) C0900118 EQUIVALENCE (VLASDM,VLLBUF(1)),(VLASDL,VLLBUF(2)) C0900119C ************************************************************* 130*5245C0900120 INTEGER VITADR C0900121 INTEGER DATSEP,DATFMT C0900122 INTEGER OPN,WVL C0900123 INTEGER ONE(2) C0900124 INTEGER ASDIR(572) C0900125 INTEGER ENTRY(4,1) C0900126C ************************************************************* 122*4865C0900127 INTEGER SECREC C0900128C *****************************************************'******* 122*4865C0900129C C0900130 DIMENSION IPNAM(17) C0900131 DIMENSION IREQ(17) C0900132 DIMENSION IFND(17) C0900133 DIMENSION NAME(18) C0900134 DIMENSION ITEMP(3) C0900135 DIMENSION LABEL(96) C0900136ÐÐ DIMENSION FSTAT( 6) C0900137 DIMENSION NAME12(4) C0900138 DIMENSION OWNR12(4) C0900139 DIMENSION CRTDAT(3) C0900140 DIMENSION EXPDAT(3) C0900141 DIMENSION RECCNT(2),MAXREC(2) C0900142 DIMENSION IEXREC(8),ITOTRC(8),NOAS(8) C0900143C ************************************************************* 122*4865C0900144 DIMENSION MSGPAU(3) C0900145 DIMENSION SECREC(2) C0900146C ************************************************************* 122*4865C0900147C ************************************************************* 130*5245C0900148 DIMENSION MES1(18),MES2(38),MES3(63),MES4(57),MS50(2),MS51(63), C0900149C ************************************************************* 130*5245C0900150 1 MES6(39),MES7(33) C0900151 DIMENSION MWRK( 7),MEXR( 2),MEXD( 2),MRDL( 4),MEXL( 2),KARTYP( 4)C0900152 INTEGER TWOLFT(2),TWORHT(2),FOURRT(2),FOURLT(2) C0900153C C0900154 EQUIVALENCE (ENTRY(1,1),ASDIR(1)) C0900155 EQUIVALENCE (PPSTAT,PPTAB) C0900156 EQUIVALENCE (IWPS,LABEL(28)) C0900157. C0900158C C0900159C FILE CONTROL BLOCK C0900160C C0900161ÐÐ EQUIVALENCE (RECLEN,FCBBUF(33)) C0900162 EQUIVALENCE (TDATRM,FCBBUF(2)) C0900163 EQUIVALENCE (TDATRL,FCBBUF(3)) C0900164 EQUIVALENCE (DATBAM,FCBBUF(4)) C0900165 EQUIVALENCE (DATBAL,FCBBUF(5)) C0900166 EQUIVALENCE (FCBIND,FCBBUF(6)) C0900167 EQUIVALENCE (NEDATM,FCBBUF(7)) C0900168 EQUIVALENCE (NEDATL,FCBBUF(8)) C0900169 EQUIVALENCE (NEXTBM,FCBBUF(9)) C0900170 EQUIVALENCE (NEXTBL,FCBBUF(10)) C0900171 EQUIVALENCE (TNKEYM,FCBBUF(11)) C0900172 EQUIVALENCE (TNKEYL,FCBBUF(12)) C0900173 EQUIVALENCE (KEYBAM,FCBBUF(13)) C0900174 EQUIVALENCE (KEYBAL,FCBBUF(14)) C0900175 EQUIVALENCE (LENKY1,FCBBUF(15)) C0900176 EQUIVALENCE (POSKY1,FCBBUF(16)) C0900177 EQUIVALENCE (LENKY2,FCBBUF(17)) C0900178 EQUIVALENCE (POSKY2,FCBBUF(18)) C0900179 EQUIVALENCE (LENKY3,FCBBUF(19)) C0900180 EQUIVALENCE (POSKY3,FCBBUF(20)) C0900181 EQUIVALENCE (LENKY4,FCBBUF(21)) C0900182 EQUIVALENCE (POSKY4,FCBBUF(22)) C0900183 EQUIVALENCE (TSFILM,FCBBUF(23)) C0900184 EQUIVALENCE (TSFILL,FCBBUF(24)) C0900185 EQUIVALENCE (NAME12,FCBBUF(25)) C0900186ÐÐ EQUIVALENCE (OWNR12,FCBBUF(29)) C0900187 EQUIVALENCE (EXPDAT,FCBBUF(89)) C0900188 EQUIVALENCE (CRTDAT,FCBBUF(92)) C0900189 EQUIVALENCE (FTYPE,FCBBUF(95)) C0900190C C0900191C EXTERNALS C0900192C C0900193 EXTERNAL MMLUTB C0900194 EXTERNAL WTREAD C0900195 EXTERNAL GETFLD C0900196 EXTERNAL SYSMSG C0900197 EXTERNAL MOVEL C0900198 EXTERNAL MOVER C0900199 EXTERNAL OPENFL C0900200 EXTERNAL GETFCB C0900201 EXTERNAL TODAY C0900202 EXTERNAL SEKVIT C0900203 EXTERNAL REDLAB C0900204 EXTERNAL DATFMT C0900205 EXTERNAL DATSEP C0900206 EXTERNAL NXTVOL C0900207C C0900208 BYTE (IFN,IPROC(0=0)) C0900209 BYTE (IOW,IPROC(1=1)) C0900210 BYTE (IVL,IPROC(2=2)) C0900211ÐÐC C0900212 BYTE (IFND,PPTEMP(15=15)) C0900213 BYTE (IREQ,PPTEMP(12=12)) C0900214 BYTE (IPNAM,PPTEMP(7=0)) C0900215C C0900216 BYTE (OPN,ISTAT(0=0)) C0900217 BYTE (NFD,ISTAT(1=1)) C0900218 BYTE (LOK,ISTAT(2=2)) C0900219 BYTE (MME,ISTAT(5=5)) C0900220 BYTE (IFE,ISTAT(10=10)) C0900221 BYTE (MFOS,ISTAT(11=11)) C0900222 BYTE (MFO,ISTAT(12=12)) C0900223 BYTE (WVL,ISTAT(13=13)) C0900224 BYTE (ILR,ISTAT(14=14)) C0900225 BYTE (IOUT,ISTAT(12=12)) C0900226. C0900227C C0900228 DATA NAME/'FILE-NAME =OWNER-NAME =VOLUME-NAME='/ C0900229 DATA NOCUR/-1/,ZRO/0/ C0900230 DATA BUFLEN/40/ C0900231 DATA BLANK/$2020/ C0900232 DATA QUEST/'? '/ C0900233 DATA ICNTL/$200C/ C0900234 DATA ONE/0,1/ C0900235 DATA MSGPAU/'PAUSE '/ C0900236ÐÐ DATA LPAUSE/3/ C0900237C C0900238C--SYSTEM MESSAGE FORMATS C0900239C C0900240 DATA MES1/ ' VOLUME: DATE ', $0D0A/, C0900241 1 MSZ1/ 18/ C0900242C ************************************************************* 130*5245C0900243 DATA MES2/ $0D0A,' AVAILABLE SPACE ON VOLUME SECTORS ', C0900244 1 'LARGEST BLOCK IS ',$0D0A/, C0900245 2 MSZ2/ 38/ C0900246C ************************************************************* 130*5245C0900247C *** PRINTER HEADER *** C0900248 DATA MES3/ $D0A,$D0A , ' FILENAME OWNER FILEDATE ' , C0900249 1 'FILE RECORD KEY1 KEY1 KEY2 KEY2 KEY3 KEY3 ' , C0900250 2 'KEY4 KEY4 START RECORD EXPIRE MAX. ' , C0900251 3 'STATUS S/A'/, MZ34/120/ C0900252 DATA MES4/ $D0A,14*$2020, 'TYPE LENGTH LNG POS LNG POS ' , C0900253 1 'LNG POS LNG POS SECT. COUNT DATE RECORD',C0900254 2 $0D0A/ C0900255 DATA MS50/ $2020, $0D0A/, MS51/ 63*$2020/, MSZ5/ 65/ C0900256C *** TERMINAL HEADER *** C0900257 DATA MES6/ $0D0A, $0D0A, ' FILENAME FILEDATE FILE ' , C0900258 1 'RECORD START RECORD EXPIRE MAX. STATUS S/A'/ C0900259 DATA MSZ6/39/ C0900260 DATA MES7/ $D0A,9*$2020, ' TYPE LENGTH SECT. COUNT ', C0900261ÐÐ 1 ' DATE RECORD', $0D0A/ C0900262 DATA MSZ7/33/ C0900263 DATA MEXR/ 8, 1/, MEXD/ 6, 0/, MRDL/ 5, 1, 5, 0/, C0900264 1 MEXL/ 8, 0/ C0900265 DATA TWOLFT/2,0/, TWORHT/2,1/, FOURRT/4,1/,FOURLT/4,0/ C0900266 DATA KARTYP/ 'S ', 'I ', 'A ', 'D '/, FSTAT/ 'CLOSED OPEN'/ C0900267C C0900268 DATA LUPNTR/ $1009/ C0900269. C0900270C C0900271C INITIALISATION C0900272C C0900273 11 INDEX=0 C0900274+ ERROR MSG NO. C0900275 ERBUF=0 C0900276+ ERROR MSG BUF C0900277 ISTAT=0 C0900278+ STATUS OF FM-REQUEST C0900279 LNGO=0 C0900280+ LENGTH OF FIELD TO MOVE C0900281 MORPAR=0 C0900282+ INDICATOR IF MORE PARAMETERS NEEDED C0900283 MORLIN=0 C0900284+ INDICATOR IF MORE LINES NEED TO BE READ C0900285 PARNUM=0 C0900286ÐÐ+ COUNT OF REQ.AND NOT FOUND PARAMETERS C0900287 PARID=0 C0900288 MORFIL=0 C0900289 IFTSW=0 C0900290 MMUNIT=0 C0900291 IPROC=0 C0900292 IFLAG=0 C0900293 IP=1 C0900294C ************************************************************* 130*5245C0900295 ISKIP = 0 C0900296+ SKIP FILE LINE PRINTOUT FLAG C0900297C ************************************************************* 130*5245C0900298C C0900299 ASSIGN 9998 TO INTLOC C0900300 CALL PGMINT(INTLOC,IFLAG) C0900301C C0900302C COPY THE PARAMETER PROCESSING TABLE C0900303C C0900304 I=0 C0900305 10 I=I+1 C0900306 PPTEMP(I)=PPTAB(I) C0900307 IF(PPTEMP(I))10,20,10 C0900308C C0900309C C0900310C C0900311ÐÐ 20 DO 30 I=1,24 C0900312 REQBUF(I)=0 C0900313 IDATA(I)=PARDEF(I) C0900314 30 CONTINUE C0900315C C0900316 35 IF(PIND)110,70,40 C0900317C C0900318C PROMPTING LEVEL = 1 FULL PARAMETERS WILL BE DISPLAYED C0900319C C0900320 40 KI=IP C0900321 I=(IP-1)*6+1 C0900322 IF(IPNAM(IP))50,100,50 C0900323C C0900324 50 J=I+5 C0900325 K=1 C0900326 CODE(K)=$0A0D C0900327+ SET CR/LF C0900328 DO 60 I=I,J C0900329 K=K+1 C0900330 CODE(K)=NAME(I) C0900331 60 CONTINUE C0900332C C0900333 I=KI C0900334 LNGO=7 C0900335 GO TO 90 C0900336ÐÐ. C0900337C C0900338C PROMPTING LEVEL = 0 PARAMETER ABBREVIATIONS WILL BE DISPLAYED C0900339C C0900340 70 I=IP C0900341 K=IPNAM(IP) C0900342+ INDEX TO PARAM.MNEM.TABLE C0900343 IF(K)80,100,80 C0900344 80 K=(K-1)*3+1 C0900345C C0900346 CODE(1)=$0A0D C0900347 CODE(2)=PARNAM(K) C0900348 CODE(3)=$3D20 C0900349 LNGO=3 C0900350C C0900351C DISPLAY NEXT PARAMETER-IDENT C0900352C C0900353 90 CALL WTREAD (LUNIT,NOCUR,CODE,LNGO,NOCUR,DUMMY,ZRO,TC) C0900354C C0900355 PARID=IP C0900356+ INDEX IN PARNAM-TABLE C0900357 IFND(I)=1 C0900358+ SET FOUND FLAG C0900359 IP=IP+1 C0900360+ INCR. INDEX TO PPTEMP C0900361ÐÐ MORPAR=1 C0900362+ SET INDICATOR FOR MORE PARAMETERS NEEDED C0900363 GO TO 120 C0900364C C0900365C END OF PARAMETER LIST, ISSUE FM-REQUEST C0900366C C0900367 100 MORPAR=0 C0900368 GO TO 320 C0900369C C0900370C PROMPTING LEVEL = -1, NO PROMPTING DONE C0900371C C0900372 110 IF(MORLIN)115,130,130 C0900373+ DO WE NEED TO READ MORE LINES C0900374 115 MORLIN=0 C0900375C C0900376C READ NEXT LINE C0900377C C0900378 120 CALL WTREAD (LUNIT,NOCUR,DUMMY,ZRO,NOCUR,INBUF,BUFLEN,TC) C0900379C C0900380C RESET SWORD AND SBYTE C0900381C C0900382 SBYTE=0 C0900383 SWORD=0 C0900384C C0900385 130 CALL GETFLD (INBUF,CODE,SWORD,SBYTE,STAT) C0900386ÐÐC C0900387 140 IF (STAT-2)150,160,200 C0900388 150 IF (STAT-1)260,250,250 C0900389C C0900390C EOL DETECTED,COUNT NO OF REQUIRED AND NOT FOUND PARAMETERS (STATUS=1)C0900391C C0900392 160 IF(PIND)161,162,162 C0900393 161 MORPAR=0 C0900394C C0900395C CHECK IF FULL NAME DESIRED C0900396C C0900397 162 IF (CODE(1)-QUEST)164,163,164 C0900398C C0900399C YES,FULL NAME FOR THIS PARAMETER ONLY C0900400C C0900401 163 IF (PIND .NE. -1) IP=IP-1 C0900402 GO TO 40 C0900403C C0900404C CHECK IF PARAMETER ENTERED C0900405C C0900406 164 IF(CODE(1)-BLANK)270,165,270 C0900407 165 IFND(IP-1)=0 C0900408 IF (PIND .EQ. -1) GO TO 320 C0900409 GO TO 35 C0900410C C0900411ÐÐC PARAMETER-ID FOUND (STATUS=3) C0900412C C0900413 200 I=1 C0900414 210 K=IPNAM(I) C0900415 K=(K-1)*3+1 C0900416C C0900417 IF (CODE(1)-PARNAM(K))230,220,230 C0900418C C0900419C PARAMETER-ID CORRESPONDS WITH PARAM.MNEMONIC TABLE C0900420C C0900421 220 PARID=I C0900422 IFND(I)=1 C0900423 GO TO 130 C0900424C C0900425 230 I=I+1 C0900426+ NO MATCH,CONTINUE C0900427 IF(IPNAM(I))210,240,210 C0900428C C0900429 240 INDEX=39 C0900430+ PARAMETER ILLEGAL C0900431 GO TO 9999 C0900432C C0900433C FIELD TERMINATED ON A SEMI-COLON (STATUS=1) C0900434C C0900435 250 MORLIN=-1 C0900436ÐÐ+ SET INDICATOR TO READ MORE LINES C0900437C C0900438C FIELD TERMINATED ON A COMMA (STATUS=0) C0900439C C0900440 260 MORPAR=1 C0900441+ SET INDICATOR FOR MORE PARAMETERS C0900442 IF(CODE(1) .NE. BLANK)GO TO 270 C0900443 IFND(IP)=0 C0900444 IP=IP+1 C0900445 GO TO 35 C0900446C C0900447C STORE PARAMETER VALUES INTO REQUIRED LOCATIONS C0900448C C0900449 270 IF (PARID)290,290,280 C0900450+ PARAMETER-ID FOUND C0900451 280 I=PARID C0900452+ YES C0900453 GO TO 300 C0900454C C0900455 290 I=IP C0900456 IF (CODE(1) .NE. BLANK) IFND(I)=1 C0900457 IP=IP+1 C0900458C C0900459 300 I=(IPNAM(I)-1)*3+1 C0900460C C0900461ÐÐ LNGO=PARNAM(I+1) C0900462 OUTP=PARNAM(I+2) C0900463C C0900464C STORE INTO DESIGNATED OUTPUT FIELD C0900465C C0900466 CALL MOVEL (CODE,OUTP,LNGO) C0900467C C0900468 PARID=0 C0900469 IF(MORPAR)310,320,310 C0900470+ ARE THERE MORE PARAM TO BE PROCESSED C0900471 310 IF(PIND)110,70,40 C0900472+ YES C0900473C C0900474C C0900475C ARE ALL REQUIRED PARAMETERS FOUND ? C0900476C C0900477 320 I=0 C0900478 330 I=I+1 C0900479 IF(PPTEMP(I))330,360,340 C0900480C C0900481C PARAMETER NOT FOUND,IS IT REQUIRED ? C0900482C C0900483 340 IF(IREQ(I))330,350,330 C0900484C C0900485C YES IT IS REQUIRED C0900486ÐÐC C0900487 350 PARNUM=PARNUM+1 C0900488 GO TO 330 C0900489C C0900490C END OF PPTAB C0900491C C0900492 360 IF(PARNUM)240,400,240 C0900493+ ARE ALL REQUIRED PARAMETERS FOUND C0900494C C0900495C C0900496C C0900497C C0900498C STORE FCB-ADDR IN REQBUF C0900499C C0900500 400 ASSEM $C000,+FCBHDR C0900501+ LDA =XFCBHDR C0900502 ASSEM $6400,+REQBUF(10) C0900503+ STA REQBUF+9 C0900504C C0900505 REQBUF(13)=96 C0900506+ SET TO READ FULL LENGTH FCB C0900507C C0900508 IDATA(13)=0 C0900509+ THESE SETTINGS ARE REQUIRED BY OPENFL C0900510 IDATA(14)=1 C0900511ÐÐ IDATA(15)=0 C0900512. C0900513C C0900514C CHECK WHICH PROCESSING IS REQUIRED C0900515C C0900516C C0900517C DECISION TABLE FOR PROCESSING METHOD C0900518C---------*-------*------*------*------- C0900519C IPROC * VL * OW * FN * LABEL C0900520C---------*-------*------*------*------- C0900521C 1 * 0 * 0 * 0 * 3000 C0900522C 2 * 0 * 0 * 1 * 1000 C0900523C 3 * 0 * 1 * 0 * 3000 C0900524C 4 * 0 * 1 * 1 * 1000 C0900525C 5 * 1 * 0 * 0 * 2000 C0900526C 6 * 1 * 0 * 1 * 1000 C0900527C 7 * 1 * 1 * 0 * 2000 C0900528C 8 * 1 * 1 * 1 * 1000 C0900529C C0900530C 0 = NOT SPECIFIED C0900531C 1 = SPECIFIED C0900532C C0900533C IS FN SPECIFIED C0900534C C0900535 IF(PPTEMP(1))410,420,420 C0900536ÐÐ 410 IFN=1 C0900537 GO TO 430 C0900538C C0900539 420 IFN=0 C0900540C C0900541C IS OW SPECIFIED C0900542C C0900543 430 IF(PPTEMP(2))440,450,450 C0900544 440 IOW=1 C0900545 GO TO 460 C0900546C C0900547 450 IOW=0 C0900548C C0900549C IS VL SPECIFIED C0900550C C0900551 460 IF(PPTEMP(3))470,480,480 C0900552 470 IVL=1 C0900553 GO TO 490 C0900554C C0900555 480 IVL=0 C0900556 490 IPROC=IPROC+1 C0900557C C0900558 GO TO (3000,1000,3000,1000,2000,1000,2000,1000),IPROC C0900559. C0900560C C0900561ÐÐC SPECIFIED FILE C0900562C C0900563 1000 CALL OPENFL (REQBUF,IDATA,ISTAT) C0900564C C0900565 IF(ISTAT)8000,1020,1020 C0900566C C0900567C SEARCH FOR VIT C0900568C C0900569 1020 CALL SEKVIT (IDATA(9),VITADR,MMUNIT) C0900570C C0900571 IF(VITADR) 1030,8200,1030 C0900572C C0900573C READ VOLUME LABEL C0900574C C0900575 1030 CALL REDLAB (LABEL,VITADR,MMUNIT) C0900576 IDATA(9)=0 C0900577C C0900578 1040 CALL CLOSFL(REQBUF,ISTAT) C0900579C C0900580 IF(ISTAT) 8000,5000,5000 C0900581. C0900582C C0900583C SPECIFIED VOLUME C0900584C C0900585 2000 CONTINUE C0900586ÐÐ INDFCB = 0 C0900587C C0900588C GET VIT-ADDR. C0900589C C0900590 CALL SEKVIT (IDATA(9),VITADR,MMUNIT) C0900591C C0900592 IF(VITADR) 2010,8200,2010 C0900593C C0900594C READ THE VOLUME LABEL C0900595C C0900596 2010 CALL REDLAB (LABEL,VITADR,MMUNIT) C0900597C C0900598C GET NEXT FCB C0900599C C0900600C C0900601C INCREMENT INDEX TO NEXT FCB C0900602C C0900603 2020 CONTINUE C0900604 INDFCB = INDFCB + 1 C0900605 CALL GETFCB (REQBUF,IDATA(9),INDFCB,FCBBUF,ISTAT) C0900606C C0900607C INDEX OUT OF RANGE ? C0900608C C0900609 2030 CONTINUE C0900610C ************************************************************* 130*5245C0900611ÐÐ IF (INDFCB .EQ. 1 .AND. ISTAT .EQ. $9000) GO TO 2090 C0900612C ************************************************************* 130*5245C0900613 IF (IOUT .EQ. 1) GO TO 4000 C0900614 IF (ISTAT .LT. 0) GO TO 8000 C0900615C C0900616C FCB OBTAINED,IS IT USED ? C0900617C C0900618 IF (FCBBUF( 1) .EQ. 0) GO TO 2020 C0900619C C0900620C CHECK OWNER-ID IF SPECIFIED C0900621C C0900622 2070 IF(IPROC .NE. 7 .OR. IPROC .NE. 3) GO TO 5000 C0900623C C0900624 DO 2080 I=1,4 C0900625 IF (IDATA(I+4) .NE. OWNR12(I)) GO TO 2020 C0900626 2080 CONTINUE C0900627 GO TO 5000 C0900628C ************************************************************* 130*5245C0900629C VOLUME HAS NO FILES C0900630C ************************************************************* 130*5245C0900631 2090 ISKIP = 1 C0900632 GO TO 6035 C0900633C ************************************************************* 130*5245C0900634. C0900635C C0900636ÐÐC ALL FILES ARE REQUIRED C0900637C C0900638 3000 MMUNIT=MMUNIT+1 C0900639C C0900640C GET THE NEXT MOUNTED AND READY VOLUME AND STORE VOLNAM INTO IDATA(9)C0900641C C0900642 CALL NXTVOL(MMUNIT) C0900643C C0900644C CHECK IF MMLUTB COMPLETELY CHECKED C0900645C C0900646 IF (MMUNIT .LE. 0) GO TO 7150 C0900647C C0900648C MORE VOLUMES TO BE CHECKED C0900649C C0900650 3010 MORVOL=-1 C0900651+ SET INDICATOR TO MORE VOLUMES C0900652 IFTSW=0 C0900653C ************************************************************* 130*5245C0900654 ISKIP = 0 C0900655C ************************************************************* 130*5245C0900656 GO TO 2000 C0900657C C0900658 4000 CONTINUE C0900659 IF (MORVOL .LT. 0) GO TO 3000 C0900660 GO TO 7150 C0900661ÐÐ. C0900662C C0900663C FCB IS FILLED IN C0900664C C0900665C ************************************************************* 122*4867C0900666 5000 IF (NOPORT .EQ. 0) GO TO 5002 C0900667C ************************************************************* 122*4867C0900668C C0900669C ************************************************************* 122*4867C0900670 DO 5003 I=1,4 C0900671 IDATA(I+4)=IDUSER(I) C0900672 5003 CONTINUE C0900673 GO TO 5004 C0900674C C0900675 5002 IF (IPROC .EQ. 3 .OR. IPROC .EQ. 7) GO TO 5004 C0900676 GO TO 5009 C0900677 5004 DO 5005 I=1,4 C0900678C *****************************************************'******* 122*4867C0900679C *****************************************************'******* 122*4867C0900680 IF (OWNR12(I) .NE. IDATA(I+4)) GO TO 2020 C0900681C ************************************************************* 122*4867C0900682 5005 CONTINUE C0900683 5009 CONTINUE C0900684 I = FTYPE C0900685 FTYPE = KARTYP(I+1) C0900686ÐÐC ************************************************************* 122*4867C0900687C IF THE SEQUENTIAL FILE INDICATOR IS SET IN THE EXTENDED FCB, C0900688C CHECK THE FCBIND WORD IN THE FILE MANAGER PORTION TO MAKE SURE C0900689C THAT IT ISN'T UNDEFINED IN THE EXTENDED PORTION C0900690 IF ( (I .EQ. 0) .AND. ( AND(FCBIND , 1) .EQ. 1) ) C0900691 1 FTYPE = KARTYP(2) C0900692C *****************************************************'******* 122*4867C0900693C C0900694C SET UP FILE STATUS INDEX (1=CLOSED, 4=OPEN) C0900695C C0900696 5090 CONTINUE C0900697 ITEST = 1 C0900698 IF ( AND(FCBIND , $2000) .NE. 0) ITEST = 4 C0900699C C0900700 6010 GO TO (6020,6030,6020,6030,6020,6030,6020,6030),IPROC C0900701C C0900702 6020 MORFIL=-1 C0900703+ SET MORE FILES TO BE DISPLAYED C0900704C C0900705C C0900706C CONVERT NO OF EXCISTING DATA RECORDS C0900707C C0900708C ************************************************************* 122*4865C0900709C C0900710C CHANGE 24-BIT TOTAL RECORD COUNT TO DOUBLE WORD SECTOR FORMAT C0900711ÐÐC LDQ NEDATM C0900712C LDA NEDATM+1 C0900713C LLS 1 C0900714C ALS 15 C0900715C STQ SECREC C0900716C STA SECREC+1 C0900717C C0900718 6030 ASSEM $E400,+NEDATM(1),$C400,+NEDATM(2) C0900719 ASSEM $0FE1,$0FCF,$4800,SECREC(1),$6800,SECREC(2) C0900720C C0900721 CALL CONVER(SECREC,IEXREC) C0900722C ************************************************************* 122*4865C0900723C C0900724C CONVERT MAXIMUM RECORD COUNT C0900725C C0900726C ************************************************************* 122*4867C0900727C C0900728C CHANGE 24-BIT MAXIMUM RECORD COUNT TO DOUBLE WORD SECTOR FORMAT C0900729C LDQ TDATRM C0900730C LDA TDATRM+1 C0900731C LLS 1 C0900732C ALS 15 C0900733C STQ SECREC C0900734C STA SECREC+1 C0900735C C0900736ÐÐ ASSEM $E400,+TDATRM(1),$C400,+TDATRM(2) C0900737 ASSEM $0FE1,$0FCF,$4800,SECREC(1),$6800,SECREC(2) C0900738C C0900739 CALL CONVER(SECREC,ITOTRC) C0900740 ISA=2HY C0900741 IF(AND(FCBIND,$8000) .EQ. 0) ISA=2HN C0900742C C0900743C IF THE DATA FOR THE EXPIRATION DATE IS ZEROS, C0900744C PUT BLANKS INTO THE PRINTOUT C0900745 IF (EXPDAT(1).NE.0) GO TO 6032 C0900746 DO 6031 I=1,3 C0900747 EXPDAT(I)=$2020 C0900748 6031 CONTINUE C0900749C IF THE DATA FOR THE CREATE DATE IS ZEROS, C0900750C PUT BLANKS INTO THE PRINTOUT C0900751 6032 IF (CRTDAT(1).NE.0) GO TO 6034 C0900752 DO 6033 I=1,3 C0900753 CRTDAT(I)=$2020 C0900754 6033 CONTINUE C0900755 6034 CONTINUE C0900756C ************************************************************* 122*4867C0900757 IF(IFTSW) 7090,6035,6035 C0900758C C0900759C CALCULATE AVAILABLE SPACE ON MASS MEMORY DEVICE SPECIFIED C0900760C C0900761ÐÐC BUILD THE READ REQUEST TO READ IN THE AVAILABLE SPACE DIRECTORY SECTOC0900762C C0900763 6035 VLASDL=LABEL(24) C0900764 VLASDM=LABEL(23) C0900765 LABEL(23)=0 C0900766 LABEL(24)=0 C0900767C C0900768 DO 6060 K=1,22 C0900769C C0900770 ASSEM $C800,VLASDL C0900771 ASSEM $6819 C0900772 ASSEM $C800,VLASDM C0900773 ASSEM $6815 C0900774 ASSEM $C800,IWPS C0900775 ASSEM $6810 C0900776 ASSEM $E800,MMUNIT C0900777 ASSEM $C600,+MMLUTB C0900778 ASSEM $60FF C0900779 ASSEM $C502 C0900780 ASSEM $6808 C0900781 ASSEM $C000,+ASDIR C0900782 ASSEM $6807 C0900783 ASSEM $54F4,$4800,$0,$0,$0,$0,$0,$0,$0 C0900784C C0900785 NUMENT=IWPS/4 C0900786ÐÐC C0900787 DO 6050 I=1,NUMENT C0900788C C0900789 6040 IF(ENTRY(1,I) .EQ. -1) GO TO 7050 C0900790C C0900791 CALL FDWADD(LABEL(23),ENTRY(1,I),LABEL(23),IOV) C0900792C C0900793 6050 CONTINUE C0900794C C0900795C ************************************************************* 130*5245C0900796 CALL FDWADD(VLLBUF,ONE,VLLBUF,IOV) C0900797C ************************************************************* 130*5245C0900798 6060 CONTINUE C0900799C C0900800 7050 CALL CONVER(LABEL(23),NOAS) C0900801C ************************************************************* 130*5245C0900802 CALL CONVER (LABEL(26),LGSBLK) C0900803 MES2(33) = LGSBLK(1) * 256 + LGSBLK(2) C0900804 MES2(34) = LGSBLK(3) * 256 + LGSBLK(4) C0900805 MES2(35) = LGSBLK(5) * 256 + LGSBLK(6) C0900806 MES2(36) = LGSBLK(7) * 256 + LGSBLK(8) C0900807C ************************************************************* 130*5245C0900808 CALL TODAY (ITEMP) C0900809C C0900810 ASSEM $C000,+DATSEP C0900811ÐÐ+ LDA DATSEP C0900812 ASSEM $0FC8 C0900813 ASSEM $6800,ISEPRT C0900814+ STA ISEPRT C0900815C C0900816 ASSEM $C000,+DATFMT C0900817 ASSEM $6800,IDATFM C0900818C C0900819C *****************************************************'******* 122*4867C0900820 LOGUNT = LUNIT C0900821 IF (NOPORT .EQ. 0) LOGUNT = LUPNTR C0900822 7058 IF(NOPORT .NE. 0) CALL CLRSCR(LUNIT) C0900823C *****************************************************'******* 122*4867C0900824C C0900825C DATE FORMAT IS MMDDYY C0900826C C0900827C ************************************************************* 122*4867C0900828 LT1 = 1 C0900829 LT2 = 2 C0900830 IF (IDATFM .EQ. 0) GO TO 7075 C0900831C ************************************************************* 122*4867C0900832C C0900833C DATE FORMAT IS DDMMYY C0900834C C0900835C ************************************************************* 122*4867C0900836ÐÐ LT1 = 2 C0900837 LT2 = 1 C0900838 7075 CONTINUE C0900839 MES1( 1) = ICNTL C0900840 MES1( 6) = LABEL( 3) C0900841 MES1( 7) = LABEL( 4) C0900842 MES1( 8) = LABEL( 5) C0900843 MES1( 9) = LABEL( 6) C0900844 MES1(14) = ITEMP(LT1) C0900845 MES1(15) = AND($FF,(ITEMP(LT2)/256)) + $2F00 C0900846 MES1(16) = AND($FF,(ITEMP(LT2))) * 256 + $2F C0900847 MES1(17) = ITEMP( 3) C0900848 CALL TOWT(LOGUNT, MES1( 1), MSZ1) C0900849C ************************************************************* 122*4867C0900850C C0900851C *****************************************************'******* 122*4867C0900852 7080 CONTINUE C0900853 MES2(15) = NOAS( 1) * 256 + NOAS( 2) C0900854 MES2(16) = NOAS( 3) * 256 + NOAS( 4) C0900855 MES2(17) = NOAS( 5) * 256 + NOAS( 6) C0900856 MES2(18) = NOAS( 7) * 256 + NOAS( 8) C0900857 CALL TOWT(LOGUNT, MES2( 1), MSZ2) C0900858C C0900859 IF (NOPORT .EQ. 0) GO TO 7085 C0900860C C0900861ÐÐC OUTPUT TERMINAL HEADER C0900862 CALL TOWT(LOGUNT, MES6( 1), MSZ6) C0900863 CALL TOWT(LOGUNT, MES7( 1), MSZ7) C0900864 ILINE=7 C0900865 GO TO 7090 C0900866 7085 CONTINUE C0900867C OUTPUT PRINTER HEADER C0900868 CALL TOWT( LOGUNT, MES3( 1), MZ34) C0900869C ************************************************************* 130*5245C0900870 7090 IF (ISKIP .EQ. 1) GO TO 4000 C0900871 IF (NOPORT .EQ. 0) GO TO 7094 C0900872C ************************************************************* 130*5245C0900873C C0900874C BEGIN TERMINAL LOGIC C0900875 CALL FL2SP(MS51(1), MSZ5-2) C0900876 CALL RIGJST( NAME12( 1),MS51( 1), 8) C0900877 CALL RIGJST( CRTDAT( 1),MS51( 6), 6) C0900878 MS51(11) = FTYPE C0900879C C0900880C ASSEMBLE RECORD LENGTH C0900881C C0900882 MWRK( 1) = RECLEN C0900883 CALL VLTOI(MWRK( 1)) C0900884 CALL CHO2LR(MWRK( 2),MS51(13),MRDL( 1)) C0900885C C0900886ÐÐC STARTING SECTOR C0900887C C0900888C PUT MSB C0900889 MWRK(1) = DATBAM C0900890 CALL FRHX(MWRK(1)) C0900891 CALL CHO2LR(MWRK( 4), MS51(16), TWORHT(1)) C0900892C PUT LSB C0900893 MWRK( 1) = DATBAL C0900894 CALL FRHX(MWRK( 1)) C0900895 CALL CHO2LR(MWRK(2), MS51(17), FOURRT(1)) C0900896C C0900897C RECORD COUNT AND EXPIRE DATE, ETC. C0900898C C0900899 CALL CHO2LR(IEXREC( 1), MS51(20), MEXL( 1)) C0900900 MS51(25) = EXPDAT(1) C0900901 MS51(26) = EXPDAT(2) C0900902 MS51(27) = EXPDAT(3) C0900903 CALL CHO2LR(ITOTRC( 1), MS51(28), MEXR( 1)) C0900904 MS51(33) = FSTAT(ITEST ) C0900905 MS51(34) = FSTAT(ITEST+1) C0900906 MS51(35) = FSTAT(ITEST+2) C0900907 MS51(37) = ISA C0900908 MS51(38) = $D0A C0900909 CALL TOWT( LOGUNT, MS51( 1), 38) C0900910 ILINE=ILINE+1 C0900911ÐÐ IF(ILINE .LT. 23) GO TO 7096 C0900912 CALL WTREAD(LUNIT,NOCUR,MSGPAU,LPAUSE,NOCUR,INBUF,BUFLEN,TC) C0900913 CALL CLRSCR (LUNIT) C0900914C C0900915 7092 ILINE=0 C0900916 GO TO 7096 C0900917C END TERMINAL LOGIC C0900918C C0900919C BEGIN PRINTER LOGIC C0900920C C0900921 7094 CONTINUE C0900922 CALL FL2SP(MS51( 1), MSZ5-2) C0900923C C0900924C INSERT FILE NAME, OWNER NAME, FILE DATE AND FILE TYPE C0900925C C0900926 CALL RIGJST( NAME12( 1), MS51( 1), 8) C0900927 DO 7095 LOOP = 1,4 C0900928 MS51(LOOP+5) = OWNR12(LOOP) C0900929 7095 CONTINUE C0900930 MS51(11) = CRTDAT( 1) C0900931 MS51(12) = CRTDAT( 2) C0900932 MS51(13) = CRTDAT( 3) C0900933 CALL RIGJST( FTYPE, MS51(15), 2) C0900934C C0900935C INSERT RECORD LENGTH (I5) C0900936ÐÐC C0900937 MWRK( 1) = RECLEN C0900938 CALL VLTOI(MWRK( 1) ) C0900939 CALL CHO2LR( MWRK( 2), MS51(18), MRDL( 3)) C0900940C C0900941C ASSEMBLE AND INSERT ALL KEY VALUES STUFF C0900942C C0900943 DO 7097 LOOP = 1, 8 C0900944 MWRK( 1) = FCBBUF(LOOP+14) C0900945 CALL VLTOI(MWRK( 1)) C0900946 LOFF = LOOP - 1 C0900947 MWRK( 2) = AND( 1,LOFF) C0900948 MWRK( 1) = 4 C0900949 LOFF = 21 + 2 * LOFF + LOFF / 2 C0900950 CALL CHO2LR(MWRK( 3), MS51(LOFF), MWRK( 1) ) C0900951 7097 CONTINUE C0900952C C0900953C ASSEMBLE STARTING SECTOR, RECORD COUNT, EXPIRE DATE C0900954C C0900955C PUT MSB C0900956 MWRK( 1) = DATBAM C0900957 CALL FRHX(MWRK( 1)) C0900958 CALL CHO2LR(MWRK( 4), MS51(41), TWOLFT(1)) C0900959C PUT LSB C0900960 MWRK( 1) = DATBAL C0900961ÐÐ CALL FRHX(MWRK( 1)) C0900962 CALL CHO2LR(MWRK(2), MS51(42), FOURLT(1)) C0900963 CALL CHO2LR(IEXREC( 1), MS51(44), MEXL( 1)) C0900964C C0900965C INSERT EXPIRE DATE, MAX. RECORD, STATUS AND S/A C0900966C C0900967 CALL RIGJST(EXPDAT( 1), MS51(48), 6) C0900968 CALL CHO2LR( ITOTRC( 1), MS51(52), MEXL( 1) ) C0900969 MS51(57) = FSTAT(ITEST ) C0900970 MS51(58) = FSTAT(ITEST+1) C0900971 MS51(59) = FSTAT(ITEST+2) C0900972 CALL RIGJST(ISA, MS51(61), 2) C0900973 CALL TOWT( LOGUNT, MS50( 1), MSZ5) C0900974C END PRINTER LOGIC C0900975C *****************************************************'******* 122*4867C0900976C C0900977C *****************************************************'******* 122*4867C0900978 7096 IFTSW=-1 C0900979C ************************************************************* 122*4867C0900980 IF (MORFIL .LT. 0) GO TO 2020 C0900981C C0900982C DONE WRITE END OF FILE C0900983C C0900984 7150 CONTINUE C0900985 CALL GENEOF(LOGUNT) C0900986ÐÐ RETURN C0900987C C0900988. C0900989C C0900990C FM-REQUEST TERMINATED WITH AN ERROR C0900991C C0900992 8000 CALL ERCHK(ISTAT,REQBUF(4)) C0900993 GO TO 9995 C0900994C C0900995C C0900996 8200 INDEX=41 C0900997+ VIT COULD NOT BE FOUND C0900998 GO TO 9999 C0900999C C0901000C ERROR ROUTINE C0901001C C0901002 9999 CALL SYSMSG(INDEX,ERBUF) C0901003C C0901004 9995 IF(PIND) 9996,9996,11 C0901005 9996 IF(MODE) 9997,9998,9997 C0901006 9997 ASSEM $E400,+MODE C0901007 ASSEM $D622 C0901008C C0901009 9998 RETURN C0901010 END C0901011ÐÐ SUBROUTINE CONVER(INP,IDIG) C1000001 1 /C10 F ITOS CCS 3.0 SL-149C1000002C CONVERT N BYTES BINARY TO ASCII C1000003C CREDIT COLLECTION SYSTEM VERSION 3.0 C1000004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C1000005C COPYRIGHT CONTROL DATA CORPORATION 1979 C1000006C C1000007C*** C1000008C C1000009C FUNCTION C1000010C C1000011C CONVERTS A SIXTEEN BIT BINARY NUMBER INTO AN EIGHT C1000012C DIGIT ASCII NUMBER LEFT JUSTIFIED,BLANK FILL C1000013C C1000014C C1000015C GENERAL DESCRIPTION C1000016C C1000017C THE FORTRAN ROUTINE FDWSUB IS CALLED CONTINEOUSLY UNTILL C1000018C THE OVERFLOW INDICATOR (IOV) IS SET OR UNTIL IT IS CALLED C1000019C FOR NINE SUCCESSIVE TIMES. C1000020C IF IOV IS SET FDWADD IS CALLED TO RESTORE THE LAST POSITIVE C1000021C VALUE IN THE INPUTWORDS (INP) AND THE ASCII OUTPUT DIGIT C1000022C IS STORED INTO THE OUTPUTBUFFER(IDIG) STARTING AT THE C1000023C HIGH-ORDER LOCATION C1000024C C1000025ÐÐC C1000026C INPUT C1000027C C1000028C INP TWO WORD ARRAY CONTAINING THE BINARY NO C1000029C C1000030C C1000031C OUTPUT C1000032C C1000033C IDIG EIGHT WORD ARRAY CONTAINING THE ASCII NO C1000034C C1000035C C1000036C MISCELLANEOUS C1000037C C1000038C JVAL TWO DIMENSIONAL ARRAY CONTAINING THE C1000039C DOUBLE PRECISION HEX.VALUE FOR THE VALUE C1000040C TO BE SUBTRACTED C1000041C C1000042C*** C1000043 DIMENSION JVAL(2,8),IDIG(8),INP(2) C1000044 DATA JVAL/$131,$1680,$1E,$4240,$3,$06A0,$0,$2710,$0,$3E8,$0,$64, C1000045 1 $0,$A,$0,$1/ C1000046C C1000047 IFLAG=0 C1000048 DO 100 J=1,8 C1000049 DO 50 I=1,9 C1000050ÐÐ CALL FDWSUB(INP,JVAL(1,J),INP,IOV) C1000051 IF(IOV .EQ. 1) GO TO 75 C1000052 50 CONTINUE C1000053 GO TO 80 C1000054 75 CALL FDWADD (INP,JVAL(1,J),INP,IOV) C1000055 80 IDIG(J)=(I-1)+$30 C1000056 IF (IFLAG .EQ. 1) GO TO 100 C1000057 IF (IDIG(J) .EQ. $30) GO TO 90 C1000058 IFLAG=1 C1000059 GO TO 100 C1000060 90 IDIG(J)=$20 C1000061 100 CONTINUE C1000062 IF(IDIG(8) .EQ. $20) IDIG(8)=$30 C1000063 RETURN C1000064 END C1000065 SUBROUTINE DMPFIL C1100001 1 /C11 F ITOS CCS 3.0 . SL-149C1100002C COMMAND PROCESSOR FOR DUMP C1100003C CREDIT COLLECTION SYSTEM VERSION 3.0 C1100004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C1100005C COPYRIGHT CONTROL DATA CORPORATION 1979 C1100006C C1100007C C1100008C FUNCTION C1100009C C1100010ÐÐC THIS IS THE REQUEST PROCESSOR FOR THE FILE-MANAGER UTILITY C1100011C ITS PURPOSE IS TO DUMP A MASS-STORAGE FILE TO A SEQUENTIAL C1100012C DEVICE FOR LATER RELOADING. C1100013C C1100014C GENERAL DESCRIPTION C1100015C C1100016C UPON ENTRY THE PARAMETER PROCESSING TABLE(PPDUMP) IS COPIED C1100017C INTO A TEMPORARY TABLE(PPTEMP) C1100018C REQBUF IS INITIALIZED TO ALL ZEROES C1100019C IDATA IS COPIED FROM THE DEFAULT TABLE (PARDEF) C1100020C NEXT A CHECK IS DONE WHICH PROMPTING LEVEL (PIND) IS REQUIRED C1100021C C1100022C COMMAND FORMAT C1100023C C1100024C DUMP,FN=AAAAAAAA,VL=VVVVVVVV,P=PPPPPPPP C1100025C C1100026C DUMP,AAAAAAAA,VVVVVVVV,PPPPPPPP C1100027C C1100028C DUMP,AAAAAAAA C1100029C C1100030C C1100031M FMUCOM C1100032C C1100033 INTEGER BUFLEN,TC,ZRO,OUTP C1100034 INTEGER BLANK,ERBUF C1100035ÐÐ INTEGER PARNUM,STATUS,PARID C1100036 INTEGER OPN,WVL C1100037 INTEGER PPTAB(5) C1100038 INTEGER STAT,VOLNAM(4) C1100039C C1100040 INTEGER PPTEMP(17) C1100041 INTEGER IPNAM(17) C1100042 INTEGER IJUST(17) C1100043 INTEGER ICONV(17) C1100044 INTEGER IREQ(17) C1100045 INTEGER IFND(17) C1100046 INTEGER QUEST,PPRENA,EXPFLG,EXPDAT,RENFLG C1100047 INTEGER FCBTEM(3),RECBUF(4002),RECLEN C1100048 INTEGER EOFREC C1100049 INTEGER OWNR12 C1100050 INTEGER VITADR C1100051C C1100052 BYTE (IPNAM,PPTEMP(7=0)) C1100053 BYTE (IJUST,PPTEMP(8=8)) C1100054 BYTE (ICONV,PPTEMP(10=9)) C1100055 BYTE (IREQ,PPTEMP(12=12)) C1100056 BYTE (IFND,PPTEMP(15=15)) C1100057C C1100058 DIMENSION NAME(24) C1100059 DIMENSION NR(4),EXPDAT(3) C1100060ÐÐ DIMENSION EOFREC(40) C1100061 DIMENSION OWNR12(4) C1100062 DIMENSION LABEL(96) C1100063 DIMENSION MSGTAP(17) C1100064C C1100065 BYTE(OPN,ISTAT(0=0)) C1100066 BYTE(NFD,ISTAT(1=1)) C1100067 BYTE(MME,ISTAT(5=5)) C1100068 BYTE(WVL,ISTAT(13=13)) C1100069 BYTE(ILR,ISTAT(14=14)) C1100070 BYTE (ICHAR,CODE(1)(15=8)) C1100071* C1100072 EQUIVALENCE (PPDUMP,PPTAB) C1100073* C1100074 BYTE (IFN,IPROC(0=0)) C1100075 BYTE (IOW,IPROC(1=1)) C1100076 BYTE (IVL,IPROC(2=2)) C1100077 BYTE (IOUT,ISTAT(12=12)) C1100078C FILE CONTROL BLOCK . . . . C1100079C C1100080 EQUIVALENCE(RECLEN,FCBBUF(1)) C1100081 EQUIVALENCE (OWNR12,FCBBUF(29)) C1100082 EQUIVALENCE (EXPDAT(1),FCBBUF(89)) C1100083 EQUIVALENCE (SECLEN,LABEL(28)) C1100084C C1100085ÐÐ DATA NAME/ 'FILE-NAME =OWNER-NAME =VOLUME-NAME=OUTPUT UNIT='/ C1100086 DATA BUFLEN/40/ C1100087 DATA BLANK/$2020/ C1100088 DATA QUEST/'? '/ C1100089 DATA ZRO/0/,NOCUR/-1/ C1100090 DATA EOFREC/20*'EOF '/ C1100091 DATA MSGTAP/'MOUNT NEXT TAPE - (CR) WHEN READY'/ C1100092 DATA LMSGT/17/ C1100093C C1100094 DIMENSION KSYSTF( 2) C1100095 DIMENSION KRELRC( 2) C1100096C C1100097 EQUIVALENCE (KEOFMK,KSYSTF( 1)),(KDELMK,KSYSTF( 2)) C1100098C C1100099 INTEGER OBL000 C1100100 INTEGER SECLEN C1100101 INTEGER UTEFCK C1100102C C1100103 DATA KBUFSZ/ 4000/ C1100104 DATA KEOF/ 2/, KBCKSP/ 1/, KBKFIL/ 6/ C1100105 DATA KRELRC/ 0 , 0/, IFSTIM/ 0/, IFILTY/ 0/ C1100106C C1100107 INTEGER MSG(12) C1100108 DATA MSG/' FILE NOT DUMPED'/ C1100109 INTEGER LENMSG C1100110ÐÐ DATA LENMSG/12/ C1100111C C1100112C EXTERNALS C1100113C C1100114 EXTERNAL WTREAD C1100115 EXTERNAL GETFLD C1100116 EXTERNAL ITSERR C1100117 EXTERNAL MOVEL C1100118 EXTERNAL MOVER C1100119 EXTERNAL GETFCB C1100120 EXTERNAL TODAY C1100121 EXTERNAL ERPROC C1100122C C1100123C*********************************** C1100124C C1100125C C1100126C S T A R T S T A R T S T A R T C1100127C C1100128C C1100129C INITIALISATION C1100130C C1100131 11 INDEX=0 C1100132+ ERROR MSG NO. C1100133 ERBUF=0 C1100134+ ERROR MSG BUF C1100135ÐÐ ISTAT=0 C1100136+ STATUS OF FM-REQUEST C1100137 LNGO=0 C1100138+ LENGTH OF FIELD TO MOVE C1100139 MORPAR=0 C1100140+ INDICATOR IF MORE PARAMETERS NEEDED C1100141 MORLIN=0 C1100142+ INDICATOR IF MORE LINES NEED TO BE READ C1100143 PARNUM=0 C1100144+ COUNT OF REQ.AND NOT FOUND PARAMETERS C1100145 IP=1 C1100146 PARID=0 C1100147 NAMFLG=0 C1100148+ NAME FLAG (0=CURRENT, 1=NEW) C1100149 EXPFLG=0 C1100150 NEWFLG=0 C1100151+ EXP.DATE FLAG (0=USE OLD, 1=NEW) C1100152 IINTRP=0 C1100153 DUMMY(1)=0 C1100154 ASSIGN 9998 TO INTLOC C1100155 CALL PGMINT(INTLOC,IINTRP) C1100156C C1100157C COPY THE PARAMETER PROCESSING TABLE C1100158 IFTSW=0 C1100159 MMUNIT=0 C1100160ÐÐ IPROC=0 C1100161C C1100162 I=0 C1100163 10 I=I+1 C1100164 PPTEMP(I)=PPTAB(I) C1100165 IF(PPTEMP(I))10,20,10 C1100166C C1100167C C1100168C C1100169 20 DO 30 I=1,24 C1100170 IDATA(I)=PARDEF(I) C1100171 REQBUF(I)=0 C1100172 30 CONTINUE C1100173C C1100174 35 IF(PIND)110,70,40 C1100175C C1100176C PROMPTING LEVEL = 1 FULL PARAMETERS WILL BE DISPLAYED C1100177C C1100178 40 KI=IP C1100179 I=(IP-1)*6+1 C1100180 IF(IPNAM(IP))50,100,50 C1100181C C1100182 50 J=I+5 C1100183 K=1 C1100184 CODE(K)=$0A0D C1100185ÐÐ+ SET CR/LF C1100186 DO 60 I=I,J C1100187 K=K+1 C1100188 CODE(K)=NAME(I) C1100189 60 CONTINUE C1100190C C1100191 I=KI C1100192 LNGO=7 C1100193 GO TO 90 C1100194C C1100195C PROMPTING LEVEL = 0 PARAMETER ABBREVIATIONS WILL BE DISPLAYED C1100196C C1100197 70 I=IP C1100198 K=IPNAM(IP) C1100199+ INDEX TO PARAM.MNEM.TABLE C1100200 IF(K)80,100,80 C1100201 80 K=(K-1)*3+1 C1100202C C1100203 CODE(1)=$0A0D C1100204 CODE(2)=PARNAM(K) C1100205 CODE(3)=$3D20 C1100206 LNGO=3 C1100207C C1100208C DISPLAY NEXT PARAMETER-IDENT C1100209C C1100210ÐÐ 90 CALL WTREAD (LUNIT,NOCUR,CODE,LNGO,NOCUR,DUMMY,ZRO,TC) C1100211C C1100212 PARID=IP C1100213+ INDEX IN PARNAM-TABLE C1100214 IFND(I)=1 C1100215+ SET FOUND FLAG C1100216 IP=IP+1 C1100217+ INCR. INDEX TO PPTEMP C1100218 MORPAR=1 C1100219+ SET INDICATOR FOR MORE PARAMETERS NEEDED C1100220 GO TO 120 C1100221C C1100222C END OF PARAMETER LIST, ISSUE FM-REQUEST C1100223C C1100224 100 MORPAR=0 C1100225 GO TO 320 C1100226C C1100227C PROMPTING LEVEL = -1, NO PROMPTING DONE C1100228C C1100229 110 IF(MORLIN)115,130,130 C1100230+ DO WE NEED TO READ MORE LINES C1100231 115 MORLIN=0 C1100232C C1100233C READ NEXT LINE C1100234C C1100235ÐÐ 120 CALL WTREAD (LUNIT,NOCUR,DUMMY,ZRO,NOCUR,INBUF,BUFLEN,TC) C1100236C C1100237C RESET SWORD AND SBYTE C1100238C C1100239 SBYTE=0 C1100240 SWORD=0 C1100241C C1100242 130 CALL GETFLD (INBUF,CODE,SWORD,SBYTE,STAT) C1100243C C1100244 140 IF (STAT-2)150,160,200 C1100245 150 IF (STAT-1)260,250,250 C1100246C C1100247C EOL DETECTED,COUNT NO OF REQUIRED AND NOT FOUND PARAMETERS (STATUS=1)C1100248C C1100249 160 IF(PIND)161,162,162 C1100250 161 MORPAR=0 C1100251C C1100252C CHECK IF FULL NAME DESIRED C1100253C C1100254 162 IF (CODE(1)-QUEST)164,163,164 C1100255C C1100256C YES,FULL NAME FOR THIS PARAMETER ONLY C1100257C C1100258 163 IF (PIND .NE. -1) IP=IP-1 C1100259 GO TO 40 C1100260ÐÐC C1100261C CHECK IF PARAMETER ENTERED C1100262C C1100263 164 IF(CODE(1)-BLANK)270,165,270 C1100264 165 IFND(IP-1)=0 C1100265 IF (PIND .EQ. -1) GO TO 320 C1100266 GO TO 35 C1100267C C1100268C PARAMETER-ID FOUND (STATUS=3) C1100269C C1100270 200 I=1 C1100271 210 K=IPNAM(I) C1100272 K=(K-1)*3+1 C1100273C C1100274 IF (CODE(1)-PARNAM(K))230,220,230 C1100275C C1100276C PARAMETER-ID CORRESPONDS WITH PARAM.MNEMONIC TABLE C1100277C C1100278 220 PARID=I C1100279 IFND(I)=1 C1100280 GO TO 130 C1100281C C1100282 230 I=I+1 C1100283+ NO MATCH,CONTINUE C1100284 IF(IPNAM(I))210,240,210 C1100285ÐÐC C1100286 240 INDEX=39 C1100287 CALL SYSMSG(INDEX,ERBUF) C1100288+ PARAMETER ILLEGAL C1100289 GO TO 9999 C1100290C C1100291C FIELD TERMINATED ON A SEMI-COLON (STATUS=1) C1100292C C1100293 250 MORLIN=-1 C1100294+ SET INDICATOR TO READ MORE LINES C1100295 GO TO 110 C1100296C FIELD TERMINATED ON A COMMA (STATUS=0) C1100297C C1100298 260 MORPAR=1 C1100299+ SET INDICATOR FOR MORE PARAMETERS C1100300 IF(CODE(1) .NE. BLANK)GO TO 270 C1100301 IFND(IP)=0 C1100302 IP=IP+1 C1100303 GO TO 35 C1100304C C1100305C STORE PARAMETER VALUES INTO REQUIRED LOCATIONS C1100306C C1100307 270 IF (PARID)290,290,280 C1100308+ PARAMETER-ID FOUND C1100309 280 I=PARID C1100310ÐÐ+ YES C1100311 GO TO 300 C1100312C C1100313 290 I=IP C1100314 IF (CODE(1) .NE. BLANK) IFND(I)=1 C1100315 IP=IP+1 C1100316C C1100317 300 IPNAMI=IPNAM(I) C1100318+ SAVE PARAMETER ORDINAL C1100319 I=(IPNAM(I)-1)*3+1 C1100320+ CALCULATE SUBSCRIPT INTO MNEMONIC TABLE C1100321C C1100322 LNGO=PARNAM(I+1) C1100323 OUTP=PARNAM(I+2) C1100324C C1100325C C1100326C C1100327C STORE INTO DESIGNATED OUTPUT FIELD C1100328C C1100329 308 CALL MOVEL(CODE,OUTP,LNGO) C1100330 316 PARID=0 C1100331C C1100332 IF(MORPAR)318,320,318 C1100333+ ARE THERE MORE PARAM TO BE PROCESSED C1100334 318 IF(PIND)110,70,40 C1100335ÐÐ+ YES C1100336C C1100337C ARE ALL REQUIRED PARAMETERS FOUND ? C1100338C C1100339 320 I=0 C1100340 330 I=I+1 C1100341 IF(PPTEMP(I))330,360,340 C1100342C C1100343C PARAMETER NOT FOUND,IS IT REQUIRED ? C1100344C C1100345 340 IF(IREQ(I))330,350,330 C1100346C C1100347C YES IT IS REQUIRED C1100348C C1100349 350 PARNUM=PARNUM+1 C1100350 GO TO 330 C1100351C C1100352C END OF PPTAB C1100353C C1100354 360 IF(PARNUM)240,400,240 C1100355+ ARE ALL REQUIRED PARAMETERS FOUND C1100356C C1100357. C1100358 400 CONTINUE C1100359 MORVOL = 0 C1100360ÐÐ IF (DUMMY(1) .NE. 0) GO TO 410 C1100361 DUMMY(1)=$5441 C1100362+ SET LU TO DEFAULT TAPE0 C1100363 DUMMY(2)=$5045 C1100364 DUMMY(3)=$3020 C1100365 DUMMY(4)=$2020 C1100366 410 CONTINUE C1100367 CALL LUNEQ(DUMMY,LUNOUT) C1100368+ GET LOGICAL UNIT NMBR C1100369 IF (LUNOUT .GT. 0) GO TO 420 C1100370 INDEX=52 C1100371+ 52 INVALID LOGICAL UNIT NMBR(PARAM ENTRY ERR) C1100372 CALL SYSMSG(INDEX,ERBUF) C1100373 GO TO 9999 C1100374 420 CONTINUE C1100375 LUNOUT = OR(LUNOUT , $1000) C1100376C* GET EOF AND DELETE MARK CODES C1100377 CALL OBFIMK(KSYSTF( 1)) C1100378 IDATA(13)=0 C1100379 IDATA(14)=1 C1100380 IDATA(15)=-1 C1100381+ SET TO OPEN WITH LOCK C1100382C C1100383C SET TO READ FULL FCB C1100384C C1100385ÐÐ REQBUF(13)=96 C1100386 ASSEM $C000,+FCBHDR C1100387 ASSEM $6400,+REQBUF(10) C1100388C C1100389C C1100390C CHECK WHICH PROCESSING IS REQUIRED C1100391C C1100392C C1100393C DECISION TABLE FOR PROCESSING METHOD C1100394C *---------*-------*------*------*-------* C1100395C * IPROC * VL * OW * FN * LABEL * C1100396C *---------*-------*------*------*-------* C1100397C * 1 * 0 * 0 * 0 * 600 * C1100398C * 2 * 0 * 0 * 1 * 1000 * C1100399C * 3 * 0 * 1 * 0 * 600 * C1100400C * 4 * 0 * 1 * 1 * 1000 * C1100401C * 5 * 1 * 0 * 0 * 610 * C1100402C * 6 * 1 * 0 * 1 * 1000 * C1100403C * 7 * 1 * 1 * 0 * 610 * C1100404C * 8 * 1 * 1 * 1 * 1000 * C1100405C *---------*-------*------*------*-------* C1100406C C1100407C 0 = NOT SPECIFIED C1100408C 1 = SPECIFIED C1100409C C1100410ÐÐC IF THIS IS NO OWNER SPECIFIED SET UP FOR COMMON USER C1100411 IF (PPTEMP(2).GE.0) IDATA(5)=0 C1100412C C1100413C IS THE FILE NAME (FN) SPECIFIED C1100414C C1100415 IFN = 0 C1100416 IF (PPTEMP(1) .LT. 0) IFN = 1 C1100417C C1100418C IS THE OWNER NAME (OW) SPECIFIED C1100419C C1100420 IOW = 0 C1100421 IF (PPTEMP(2) .LT. 0) IOW = 1 C1100422C **** 138*0045C1100423C C1100424C IF NEITHER NAME, OWNER OR VOLUME SPECIFIED, SET TO INDICATE VOLUMEC1100425C SPECIFIED. C1100426C C1100427 IVLSPC = 0 C1100428 IF (IDATA(1).EQ.BLANK .AND. IDATA(5).EQ.BLANK) IVLSPC = 1 C1100429C C1100430C ALSO, IF VOLUME SPECIFIED, SET SPECIFIED FLAG. C1100431C C1100432 IF (PPTEMP(3).LT.0) IVLSPC = 1 C1100433C **** 138*0045C1100434C C1100435ÐÐC IS THE VOLUME NAME (VL) SPECIFIED C1100436C C1100437 560 CONTINUE C1100438 IVL=0 C1100439 IF (PPTEMP(3) .LT. 0) IVL = 1 C1100440C C1100441 590 IPROC=IPROC+1 C1100442C C1100443C* GET ITOS MAG. TAPE BUFFER SIZE C1100444C C1100445 MAGBUF = OBL000( 0) C1100446C C1100447 GO TO (600,1000,600,1000,610,1000,610,1000),IPROC C1100448. C1100449C C1100450C ALL FILES ARE REQUIRED C1100451C C1100452 600 MMUNIT=MMUNIT+1 C1100453C C1100454C GET NEXT MOUNTED AND READY VOLUME. STORE VOLNAM INTO IDATA(9) C1100455C C1100456 CALL NXTVOL(MMUNIT) C1100457C C1100458C CHECK IF MMLUTB COMPLETELY CHECKED C1100459C C1100460ÐÐ IF (MMUNIT) 9998,9998,610 C1100461C C1100462C MORE VOLUMES TO BE CHECKED C1100463C C1100464 610 MORVOL=-1 C1100465+ SET INDICATOR TO MORE VOLUMES C1100466 IFTSW=0 C1100467 GO TO 800 C1100468C C1100469C **** 138*0045C1100470 900 IF (MORVOL.LT.0 .AND. IVLSPC.EQ.0) GO TO 600 C1100471 GO TO 9998 C1100472C **** 138*0045C1100473. C1100474C C1100475C SPECIFIED VOLUME C1100476C C1100477 800 INDFCB=1 C1100478C C1100479C GET THE VIT ADDRESS C1100480C C1100481 CALL SEKVIT(IDATA(9),VITADR,MMUNIT) C1100482C C1100483 IF (VITADR) 810,8200,810 C1100484C C1100485ÐÐC READ THE VOLUME LABEL C1100486C C1100487 810 CALL REDLAB(LABEL,VITADR,MMUNIT) C1100488C C1100489C GET THE NEXT FCB C1100490C C1100491 820 CALL GETFCB(REQBUF,IDATA(9),INDFCB,FCBBUF,ISTAT) C1100492C C1100493C IS THE INDEX OUT OF RANGE C1100494C C1100495 830 IF (IOUT-1) 840,900,900 C1100496 840 IF (ISTAT) 8000,850,850 C1100497C C1100498C IS THIS FCB BEING USED C1100499C C1100500 850 IF (FCBBUF(1)) 870,860,870 C1100501C C1100502C INCREMENT INDEX TO NEXT FCB C1100503C C1100504 860 INDFCB=INDFCB+1 C1100505 REQBUF(13) = 96 C1100506 GO TO 820 C1100507C C1100508C IS THE MAXIMUM RECORD SIZE EXCEEDED C1100509 870 CONTINUE C1100510ÐÐC C1100511C* FIRST CHECK IF ANY RECORD EXISTED C1100512C C1100513C******************CHECK FOR EXISTING RECORDS C1100514C**** 9/30 CHANGE TO SKIP DELETED RECORDS WHEN DUMPING C1100515C**** NO LEFT NODATA=1 IF DATA IS LEFT NODATA=0 C1100516 NODATA=0 C1100517 IF(FCBBUF(7).EQ.0.AND.FCBBUF(8).EQ.0) NODATA = 1 C1100518 KSIZE = KBUFSZ C1100519 IF (KBUFSZ .GT. MAGBUF) KSIZE = MAGBUF C1100520 IF (FCBBUF(1) .LE. KSIZE) GO TO 873 C1100521C DISPLAY 'FILE NOT DUMPED' MESSAGE C1100522C MOVE FILE NAME TO MSG. BUFFER C1100523 DO 872 IJ = 1,4 C1100524 MSG(IJ) = FCBBUF(IJ+24) C1100525 872 CONTINUE C1100526 CALL WTREAD (LUNIT,NOCUR,MSG,LENMSG,NOCUR,INBUF,0,TC) C1100527 GO TO 860 C1100528C C1100529C PUT FILE NAME INTO IDATA FOR OPEN REQUEST C1100530C MOVE THE USER ID IF ONE HAS BEEN SPECIFIED C1100531 873 MAXTRY = 4 C1100532 IF (PPTEMP(2).GE.0) MAXTRY=8 C1100533 DO 875 I=1,MAXTRY C1100534 IDATA(I)=FCBBUF(I+24) C1100535ÐÐ 875 CONTINUE C1100536C IF NO USER WAS ENTERED, SET UP FOR COMMON USER C1100537 IF (PPTEMP(2).GE.0.AND.FCBBUF(29).EQ.$2020) IDATA(5)=0 C1100538C CHECK OWNER ID IF SPECIFIED C1100539C C1100540 IF (IPROC.NE.7.AND.IPROC.NE.3) GO TO 1110 C1100541C C1100542 DO 880 I=1,4 C1100543 IF (IDATA(I+4).NE.OWNR12(I)) GO TO 860 C1100544 880 CONTINUE C1100545 GO TO 1110 C1100546. C1100547C C1100548C SPECIFIED FILE C1100549C C1100550 1000 CALL OPENFL(REQBUF,IDATA,ISTAT) C1100551C C1100552 IF (ISTAT) 8000,1020,1020 C1100553C C1100554C SEARCH FOR VIT C1100555C C1100556 1020 CALL SEKVIT(IDATA(9),VITADR,MMUNIT) C1100557C C1100558 IF (VITADR) 1030,8200,1030 C1100559C C1100560ÐÐC READ VOLUME LABEL C1100561C C1100562 1030 CALL REDLAB(LABEL,VITADR,MMUNIT) C1100563 IDATA(9)=0 C1100564C C1100565C GET THE FCB FROM THE SPECIFIED OPEN FILE C1100566C C1100567 CALL GETFCB(REQBUF,IDATA(9),INDEX,FCBBUF,ISTAT) C1100568 IF (ISTAT) 830,1040,1040 C1100569C C1100570 1040 CALL CLOSFL(REQBUF,ISTAT) C1100571C C1100572 IF (ISTAT) 8000,1110,1110 C1100573C C1100574 1110 DO 1115 I=1,24 C1100575 REQBUF(I)=0 C1100576 1115 CONTINUE C1100577C C1100578C** GENERATE BLOCKING FACTOR FOR THIS FILE C1100579C C1100580 KSIZE = KBUFSZ C1100581 IF (KBUFSZ .GT. MAGBUF) KSIZE = MAGBUF C1100582C C1100583C CLEAR FIRST TIME SWITCH AND EXTRACT FILE TPYE C1100584C C1100585ÐÐ IFSTIM = 0 C1100586 IFILTY = AND(FCBBUF(6) , $1) C1100587C C1100588C CALCULATE DEFAULT AS NON SECTOR ALIGNED C1100589C C1100590 ISECLN = FCBBUF( 1) C1100591 KSECLN = FCBBUF( 1) C1100592 NUMREC = KSIZE / FCBBUF( 1) C1100593 IF ( AND($8000 , FCBBUF(6)) .EQ. 0) GO TO 1117 C1100594C C1100595C* SECTOR ALIGNED C1100596C C1100597 NUMSEC = FCBBUF(1) / SECLEN C1100598 IF ( (NUMSEC * SECLEN) .LT. FCBBUF(1) ) NUMSEC = NUMSEC + 1 C1100599 ISECLN = NUMSEC * SECLEN C1100600 NUMREC = KSIZE / (SECLEN * NUMSEC) C1100601 KSECLN = ISECLN C1100602 1117 CONTINUE C1100603 IBLKSZ = NUMREC * KSECLN C1100604C C1100605C SET UP TO READ IN FULL FCB C1100606C LDA FCBHDR C1100607C STA REQBUF+9 C1100608 ASSEM $C000,+FCBHDR C1100609 ASSEM $6400,+REQBUF(10) C1100610ÐÐC MAKE SURE THE OWNER ID IS CORRECT C1100611 IF (PPTEMP(2).GE.0.AND.FCBBUF(29).EQ.$2020) IDATA(5)=0 C1100612C C1100613 CALL OPENFL(REQBUF,IDATA,ISTAT) C1100614 IF(ISTAT)1120,1200,1200 C1100615 1120 CALL ERCHK(ISTAT,REQBUF(4)) C1100616 GO TO 9999 C1100617 1200 VOLNAM(1)=0 C1100618 1250 KEYVAL=0 C1100619C C1100620C C1100621C WRITE ONE E-O-F C1100622C C1100623 CALL RWBUWM( LUNOUT, KEOF) C1100624C C1100625C* SET UP FCB AND 4 EXTRA WORDS (1. NO. OF RECORDS/BLOCK, 2. DATA C1100626C LENGTH, 3. BLOCK SIZE, AND 4. RESERVED) C1100627C C1100628 DO 1310 LOOP = 1 , 96 C1100629 RECBUF(LOOP) = FCBBUF(LOOP) C1100630 1310 CONTINUE C1100631 RECBUF( 97) = NUMREC C1100632 RECBUF( 98) = ISECLN C1100633 RECBUF( 99) = IBLKSZ C1100634 RECBUF(100) = 0 C1100635ÐÐC C1100636C WRITE THE FCB C1100637C C1100638 LOOP = MPWRIX(LUNOUT, RECBUF(1), 100) C1100639C CHECK FOR END OF TAPE C1100640 ASSIGN 1307 TO IRETN C1100641 GO TO 5000 C1100642C C1100643C C1100644C C1100645C------------------------------------------------------------------- C1100646C C1100647C C1100648C BLOCKING CONDITIONS : C1100649C C1100650C (1) NO DELETED RECORD WITHIN A FILE C1100651C (2) DELETED RECORD WITHIN A FILE C1100652C (A) EOF -- NO MORE 'GETC' C1100653C (B) NON-EOF -- READ MORE RECORDS TO FILL GAP C1100654C C1100655C C1100656C C1100657C** SET UP FOR READ RECORDS C1100658C C1100659 1307 CONTINUE C1100660ÐÐC******************9/30 CHANGE TO SKIP DELETED RECORDS WHEN DUMPING C1100661C**** IF NO DATA LEFT- BYPASS DELETE REC ROUTINE C1100662 IF(NODATA.EQ.0) GO TO 1800 C1100663 IDONE=1 C1100664 GO TO 1365 C1100665 1800 ICURNT=1 C1100666 NORCDR = NUMREC C1100667 ITOREC = 0 C1100668 IDONE = 0 C1100669 ITLRCD = 0 C1100670C C1100671C--GET RECORDS IN BLOCK MODE C1100672C C1100673 2000 CONTINUE C1100674 IDELRD = 0 C1100675 IDELOF = 0 C1100676 REQBUF(13) = NORCDR C1100677C C1100678C* FOR SEQUENTIAL FILE TYPE, NO INITIALZATION CHECK IS NEEDED C1100679C C1100680 IF (IFILTY .EQ. 0) GO TO 2050 C1100681 IF (IFSTIM .NE. 0) GO TO 2050 C1100682C C1100683C**--- FOR INDEX FILE AND FIRST TIME. SET UP RELATIVE RECORD NO. C1100684C TO BE 0,1 C1100685ÐÐC C1100686 KRELRC(1) = 0 C1100687 KRELRC(2) = 1 C1100688 IFSTIM = 1 C1100689 CALL READR(REQBUF( 1), RECBUF(1), KRELRC(1), ISTAT) C1100690C******************9/30 CHANGE TO SKIP DELETED RECORDS WHEN DUMPING C1100691C***** CHECK FOR ERROR C1100692 IF(ISTAT.LT.0) GO TO 8000 C1100693 GO TO 2055 C1100694C C1100695 2050 CONTINUE C1100696 CALL GETS(REQBUF(1), RECBUF(1), KEYVAL, ISTAT) C1100697 2055 CONTINUE C1100698 LPTOTL = REQBUF(15) C1100699C C1100700C* CHECK IF DELETE RECORD ENCOUNTERED C1100701C C1100702 IF ( AND(ISTAT , $10) .NE. 0) GO TO 2100 C1100703 IF ( AND(ISTAT , $100) .NE. 0) GO TO 2100 C1100704C CHECK IF ERROR ENCOUNTERED C1100705C******************9/30 CHANGE TO SKIP DELETED RECORDS WHEN DUMPING C1100706C**** GO TO ERCHK IF ERROR C1100707 IF(ISTAT.LT.0) GO TO 8000 C1100708C C1100709C------ DELETED RECORD(S) ENCOUNTERED. SEARCH FOR DELETED RECORD(C1100710ÐÐC C1100711C C1100712 2100 CONTINUE C1100713 DO 2400 LOOP = 1 , LPTOTL C1100714C******************9/30 CHANGE TO SKIP DELETED RECORDS WHEN DUMPING C1100715C**** CHECK FOR EOF IF FOUND BRANCH TO END OF DELETE ROUT. C1100716 IF(RECBUF(ICURNT).EQ.KEOFMK.AND.RECBUF(ICURNT+1).EQ.KEOFMK) C1100717 1 GO TO 2450 C1100718C******************9/30 CHANGE TO SKIP DELETED RECORDS WHEN DUMPING C1100719C**** CHECK IF RECORDS ARE DELETED CHECK FOR DELETE CODE C1100720C**** IN FIRST WORD OF RECORD C1100721 2150 IF(RECBUF(ICURNT).EQ.KDELMK)GO TO 2200 C1100722C**** C1100723C**** INCREMENT AND GO TO END OF DOLOOP 2400 C1100724 ICURNT = ICURNT + ISECLN C1100725 GO TO 2400 C1100726C C1100727C DELETET RECORD LOCATED, CHECK IF ANY MORE RECORD C1100728 2200 CONTINUE C1100729 IF (LOOP .EQ. LPTOTL) GO TO 2350 C1100730C C1100731C*** BUFFER EDITING DUE TO DELETED RECORD C1100732C C1100733C MOVE NON-DELETED RECORD UPWARD C1100734C C1100735ÐÐ IOLDLO = ICURNT C1100736 IMOVST = ICURNT + ISECLN C1100737 DO 2300 LOOP2 = IMOVST , IBLKSZ C1100738 RECBUF(IOLDLO) = RECBUF(LOOP2) C1100739 IOLDLO = IOLDLO + 1 C1100740 2300 CONTINUE C1100741C C1100742 2350 CONTINUE C1100743 IDELRD = IDELRD + 1 C1100744 IDELOF = IDELOF + ISECLN C1100745 2400 CONTINUE C1100746C******************9/30 CHANGE TP SKIP DELETED RECORDS WHEN DUMPING C1100747C**** BRANCH AROUND EOF ROUTINE C1100748 GO TO 2500 C1100749C******************9/30 CHANGE TO SKIP DELETED RECORDS WHEN DUMPING C1100750C**** ADD ROUTINE TO HANDLE EOF AND SET DONE SWITCH C1100751 2450 IDONE=1 C1100752 IDELRD=LPTOTL - LOOP + 1 + IDELRD C1100753C C1100754C---- DELETED RECORD(S), IF ANY, HAD BEEN ADJUSTED. CHECK IF EOF C1100755C C1100756 2500 CONTINUE C1100757 IF ( AND(ISTAT , $100) .NE. 0) IDONE = 1 C1100758 2550 CONTINUE C1100759C C1100760ÐÐC ADJUST POINTER AFTER 1 BLOCKING C1100761C C1100762 ITLRCD = ITLRCD - IDELRD + LPTOTL C1100763 IF (IDONE .NE. 0) GO TO 2800 C1100764C C1100765C------ ---------- ---------- C1100766C C1100767C NOT YET DONE (NOT EOF), DELETED RECORD(S) MAY ENCOUNTERED. C1100768CCHECK IF 'GAP' IN BUFFER (UNFULL) C1100769C C1100770C C1100771C * IF RECORD IN BUFFER = MAX. ALLOWED C1100772C C1100773 IF (ITLRCD .GE. NUMREC) GO TO 2850 C1100774 NORCDR = NUMREC - ITLRCD C1100775C******************9/30 CHANGE TO SKIP DELETED RECORDS WHEN DUMPING C1100776C**** COMPUTE NUMBER OF RECORDS TO ADD TO FILL BUFFER C1100777C**** READ IN MORE RECORDS AND RETURN TO CHECK IF ANY C1100778C**** OF THE NEW RECORDS HAVE BEEN DELETED C1100779 IDELRD=0 C1100780 REQBUF(13)=NORCDR C1100781 II=IBLKSZ - (NORCDR * ISECLN) + 1 C1100782 CALL GETS(REQBUF(1), RECBUF(II),KEYVAL,ISTAT) C1100783 GO TO 2055 C1100784C C1100785ÐÐC****** ********** C1100786C C1100787C RECORDS HAVE BEEN SET UP. IF DELETED IN SET EOF C1100788C (ALWAYS OUTPUT FULL SIZE) C1100789C C1100790 2800 CONTINUE C1100791 IF (ITLRCD .GE. NUMREC) GO TO 2850 C1100792 RECBUF(ICURNT ) = KEOFMK C1100793 RECBUF(ICURNT+1) = KEOFMK C1100794 2850 CONTINUE C1100795C C1100796C WRITE A RECORD C1100797C C1100798 LOOP = MPWRIX(LUNOUT, RECBUF(1), IBLKSZ) C1100799C CHECK FOR END OF TAPE C1100800 ASSIGN 1365 TO IRETN C1100801 GO TO 5000 C1100802C C1100803C C1100804C WRITE TWO E-O-F , THEN BACKSPACE OVER BOTH C1100805C C1100806 1365 CONTINUE C1100807 IF (IDONE .EQ. 0) GO TO 1307 C1100808 CALL RWBUWM( LUNOUT, KEOF) C1100809 CALL RWBUWM( LUNOUT, KEOF) C1100810ÐÐ CALL RWBUWM(LUNOUT, KBCKSP) C1100811 CALL RWBUWM(LUNOUT, KBCKSP) C1100812C C1100813 1400 CALL CLOSFL(REQBUF,ISTAT) C1100814 IF(ISTAT)1420,1500,1500 C1100815 1420 CALL ERCHK(ISTAT,REQBUF(4)) C1100816+ GO FIND WHICH ISTAT BIT IS ON C1100817 GO TO 9999 C1100818 1500 IFTSW=-1 C1100819 IF (MORVOL) 860,9998,9998 C1100820+ RETURN C1100821C C1100822C CHECK FOR END OF TAPE C1100823C C1100824 5000 CONTINUE C1100825 ITSTAT = UTEFCK(LUNOUT) C1100826C C1100827C WAS THERE AN END OF TAPE READ C1100828C C1100829 IF (AND(ITSTAT,$0200).EQ.0) GO TO IRETN C1100830C YES, BACKSPACE TO THE PREVIOUS FILE MARK (END OF LAST FILE DUMPED)C1100831C C1100832 CALL RWBUWM(LUNOUT, KBKFIL) C1100833C C1100834C WRITE TWO FILE MARKS AND UNLOAD THE TAPE C1100835ÐÐC C1100836 CALL RWBUWM( LUNOUT, KEOF) C1100837 CALL RWBUWM( LUNOUT, KEOF) C1100838C C1100839C OUTPUT NEXT TAPE MESSAGE AND WAIT FOR INPUT C1100840 CALL WTREAD(LUNIT,NOCUR,MSGTAP,LMSGT,NOCUR,INBUF,1,TC) C1100841C RESTART THE DUMP OF THE LAST FILE C1100842 GO TO 1040 C1100843C C1100844C FM REQUEST TERMINATED ON AN ERROR C1100845C C1100846 8000 CALL ERCHK(ISTAT,REQBUF(4)) C1100847 GO TO 9999 C1100848C C1100849 8200 INDEX=41 C1100850 CALL SYSMSG(INDEX,ERBUF) C1100851+ VIT COULD NOT BE FOUND C1100852 GO TO 9999 C1100853+ ALL DONE C1100854C C1100855C ERROR ROUTINE C1100856C C1100857 9999 IF(PIND)9995,9995,11 C1100858 9995 IF(MODE)9996,9998,9996 C1100859 9996 ASSEM $E400,+MODE C1100860ÐÐ ASSEM $D622 C1100861C C1100862 9998 CALL CLOSFL(REQBUF,ISTAT) C1100863+ CLOSE FILE FOR SAFETY C1100864 RETURN C1100865 END C1100866 SUBROUTINE COPY C1200001 1 /C12 F ITOS CCS 3.0 . SL-149C1200002C COMMAND PROCESSOR FOR COPY C1200003C CREDIT COLLECTION SYSTEM VERSION 3.0 C1200004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C1200005C COPYRIGHT CONTROL DATA CORPORATION 1979 C1200006C*** C1200007C ************************************************************* 122*4868C1200008C C1200009C C1200010C FUNCTION C1200011C C1200012C THIS PROCESSOR WILL COPY AN EXCISTING FILE INTO ANOTHER C1200013C EXCISTINF FILE WITH DELETION OF THE RECORDS MARKED AS SUCH C1200014C C1200015C C1200016C THIS REVISION FOR LARGE SECTOR DISK DRIVES, PERMITS C1200017C A FILE COPY TO BE PERFORMED FOR TWO FILES ON VOLUMES HAVING C1200018C DIFFERENT SECTOR SIZES ONLY IF THE FILES ARE C1200019ÐÐC SEQUENTIAL AND NOT SECTOR ALIGNED. C1200020C C1200021C ************************************************************* 122*4868C1200022C MAX RECORD SIZE IS 8000 BYTES C1200023C *********************'*******************************'******* 122*4868C1200024C C1200025C GENERAL DESCRIPTION C1200026C C1200027C C1200028C ************************************************************* 122*4868C1200029C AFTER ALL PARAMETERS HAVE BEEN READ,A CHECK FOR VALIDITY C1200030C IS DONE C1200031C BOTH FILES WILL BE OPENED WITH LOCK AND THE FCB OF BOTH FILES C1200032C IS OBTAINED C1200033C A CHECK IS DONE TO ENSURE THAT BOTH FILES HAVE THE SAME C1200034C RECORD-LENGTH AND THE FYLE-TYPE SHOULD ALSO BE EQUAL C1200035C IF NOT,AN APPROPRIATE ERROR MESSAGE(65,66) IS DISPLAYED C1200036C THE FILE SPECIFIED BY F2 IS CLEARED PRIOR TO THE COPY PROCESS C1200037C IF THE FILE IS AN INDEXED FILE,OR THE SECTOR ALIGNMENT IS C1200038C NOT EQUAL,THE COPY IS DONE ON A RECORD BASES C1200039C IF THE FILE IS SEQUENTIAL AND THE SECTOR ALIGNMENT OF BOTH C1200040C FILES IS EQUAL,THE COPY IS BLOCKED DEPENDING UPON RECORD-SIZE C1200041C RECORDS ARE OBTAINED USING THE GETS FILE-MANAGER REQUEST C1200042C IN CASE OF AN SEQUENTIAL FILE,THE COPY IS DONE USING PUTS REQUEST C1200043C ELSE THE PRIMARY KEY-VALUE IS EXTRACTED FROM THE RECORDBUFFER(RECBC1200044ÐÐC AND STORED INTO THE VARIABLE KEYVAL C1200045C NEXT A WRITER REQUEST IS PERFORMED C1200046C COPY STOPS AT DETECTION OF AN EOF AND BOTH FILES ARE CLOSED C1200047C *****************************************************'******* 122*4868C1200048C C1200049C COMMAND FORMAT C1200050C C1200051C COPY,FN=AAAAAAAA,VL=AAAAAAAA,F2=AAAAAAAA,OW=BBBBBBBB,V2=BBBBBBBC1200052C C1200053C COPY,AAAAAAAA,VVVVVVVV,BBBBBBBB,OOOOOOOO,BBBBBBBB C1200054C C1200055M FMUCOM C1200056. C1200057C C1200058 INTEGER OWNR12,OWNR34,OWNR56,OWNR78,RECLEN,TDATRM,TDATRL C1200059 INTEGER DATBAM,DATBAL,FCBIND,TNKEYM,TNKEYL,POSKY1,POSKY2 C1200060 INTEGER POSKY3,POSKY4,TSFILM,TSFILL,EXPDAT,CRTDAT,FILTYP C1200061 INTEGER NOCUR,ZRO,ERBUF,PARNUM,PARID,PPTEMP(17),PPTAB(6) C1200062 INTEGER BUFLEN,TC,OUTP,BLANK,QUEST,STAT,OPN,WVL,FTYPE C1200063 INTEGER OPN,WVL C1200064 INTEGER RECBUF C1200065 INTEGER CPDAT(24),CPREQ(24),CPVOL,CPHDR(5),CPFCB(96),CPWIND C1200066 INTEGER CPRECL,CPFIND,CPLEN1,CPPOS1 C1200067C ************************************************************* 122*4868C1200068 INTEGER BUFSIZ,SECLEN,FMRDEL C1200069ÐÐC ************************************************************* 122*4868C1200070C C1200071 DIMENSION IPNAM(17) C1200072 DIMENSION IREQ(17) C1200073 DIMENSION IFND(17) C1200074 DIMENSION NAME(30) C1200075 DIMENSION NAME12(4) C1200076 DIMENSION OWNR12(4) C1200077 DIMENSION KEYVAL(15) C1200078C ************************************************************* 122*4868C1200079 DIMENSION RECBUF(4002) C1200080C ************************************************************* 122*4868C1200081C C1200082 EQUIVALENCE (PPCOPY,PPTAB) C1200083 EQUIVALENCE (CPRECL,CPFCB(1)) C1200084 EQUIVALENCE (CPFIND,CPFCB(6)) C1200085 EQUIVALENCE (CPLEN1,CPFCB(15)) C1200086 EQUIVALENCE (CPPOS1,CPFCB(16)) C1200087 BYTE (IDEL,ISTAT(4=4)) C1200088. C1200089C C1200090C FILE CONTROL BLOCK C1200091C C1200092 EQUIVALENCE (RECLEN,FCBBUF(1)) C1200093 EQUIVALENCE (TDATRM,FCBBUF(2)) C1200094ÐÐ EQUIVALENCE (TDATRL,FCBBUF(3)) C1200095 EQUIVALENCE (DATBAM,FCBBUF(4)) C1200096 EQUIVALENCE (DATBAL,FCBBUF(5)) C1200097 EQUIVALENCE (FCBIND,FCBBUF(6)) C1200098 EQUIVALENCE (NEDATM,FCBBUF(7)) C1200099 EQUIVALENCE (NEDATL,FCBBUF(8)) C1200100 EQUIVALENCE (NEXTBM,FCBBUF(9)) C1200101 EQUIVALENCE (NEXTBL,FCBBUF(10)) C1200102 EQUIVALENCE (TNKEYM,FCBBUF(11)) C1200103 EQUIVALENCE (TNKEYL,FCBBUF(12)) C1200104 EQUIVALENCE (KEYBAM,FCBBUF(13)) C1200105 EQUIVALENCE (KEYBAL,FCBBUF(14)) C1200106 EQUIVALENCE (LENKY1,FCBBUF(15)) C1200107 EQUIVALENCE (POSKY1,FCBBUF(16)) C1200108 EQUIVALENCE (LENKY2,FCBBUF(17)) C1200109 EQUIVALENCE (LENKY3,FCBBUF(19)) C1200110 EQUIVALENCE (LENKY4,FCBBUF(21)) C1200111 EQUIVALENCE (TSFILM,FCBBUF(23)) C1200112 EQUIVALENCE (TSFILL,FCBBUF(24)) C1200113 EQUIVALENCE (NAME12,FCBBUF(25)) C1200114 EQUIVALENCE (OWNR12,FCBBUF(29)) C1200115 EQUIVALENCE (EXPDAT,FCBBUF(89)) C1200116 EQUIVALENCE (CRTDAT,FCBBUF(92)) C1200117 EQUIVALENCE (FTYPE,FCBBUF(95)) C1200118C C1200119ÐÐC EXTERNALS C1200120C C1200121 EXTERNAL MMLUTB C1200122 EXTERNAL WTREAD C1200123 EXTERNAL GETFLD C1200124 EXTERNAL SYSMSG C1200125 EXTERNAL MOVEL C1200126 EXTERNAL OPENFL C1200127 EXTERNAL GETFCB C1200128C ************************************************************* 122*4868C1200129 EXTERNAL FMRDEL C1200130C ************************************************************* 122*4868C1200131C C1200132C C1200133 BYTE (IFND,PPTEMP(15=15)) C1200134 BYTE (IREQ,PPTEMP(12=12)) C1200135 BYTE (IPNAM,PPTEMP(7=0)) C1200136C C1200137 BYTE (OPN,ISTAT(0=0)) C1200138 BYTE (NFD,ISTAT(1=1)) C1200139 BYTE (LOK,ISTAT(2=2)) C1200140 BYTE (IRLOK,ISTAT(3=3)) C1200141 BYTE (INUNK,ISTAT(4=4)) C1200142 BYTE (MME,ISTAT(5=5)) C1200143 BYTE (IEOF,ISTAT(8=8)) C1200144ÐÐ BYTE (IWKY,ISTAT(9=9)) C1200145 BYTE (IFE,ISTAT(10=10)) C1200146 BYTE (MFOS,ISTAT(11=11)) C1200147 BYTE (MFO,ISTAT(12=12)) C1200148 BYTE (IOUT,ISTAT(12=12)) C1200149 BYTE (WVL,ISTAT(13=13)) C1200150 BYTE (ILR,ISTAT(14=14)) C1200151C C1200152 DATA NAME/'FILE-NAME 1=VOLUME-NAME=FILE-NAME 2=OWNER-NAME =VOLUME-C1200153 *NAME='/ C1200154 DATA NOCUR/-1/,ZRO/0/ C1200155 DATA BUFLEN/40/ C1200156 DATA BLANK/$2020/ C1200157 DATA QUEST/'? '/ C1200158C ************************************************************* 122*4868C1200159 DATA BUFSIZ/4000/ C1200160 DIMENSION ISAVB1(10),ISAVB2(10) C1200161 INTEGER ONE(2) C1200162 DATA ONE/0,1/ C1200163C*** C1200164C ************************************************************* 122*4868C1200165. C1200166C C1200167C INITIALISATION C1200168C C1200169ÐÐ IFTSW=0 C1200170 11 INDEX=0 C1200171+ ERROR MSG NO. C1200172 ERBUF=0 C1200173+ ERROR MSG BUF C1200174 ISTAT=0 C1200175+ STATUS OF FM-REQUEST C1200176 LNGO=0 C1200177+ LENGTH OF FIELD TO MOVE C1200178 MORPAR=0 C1200179+ INDICATOR IF MORE PARAMETERS NEEDED C1200180 MORLIN=0 C1200181+ INDICATOR IF MORE LINES NEED TO BE READ C1200182 PARNUM=0 C1200183+ COUNT OF REQ.AND NOT FOUND PARAMETERS C1200184 PARID=0 C1200185 IFLAG=0 C1200186 IP=1 C1200187C ************************************************************* 122*4868C1200188 ASSEM $C000,+FMRDEL C1200189 ASSEM $6800,IFMDEL C1200190C *********************'*************************************** 122*4868C1200191C C1200192 ASSIGN 9998 TO INTLOC C1200193 CALL PGMINT(INTLOC,IFLAG) C1200194ÐÐC C1200195C COPY THE PARAMETER PROCESSING TABLE C1200196C C1200197 I=0 C1200198 10 I=I+1 C1200199 PPTEMP(I)=PPTAB(I) C1200200 IF(PPTEMP(I))10,20,10 C1200201C C1200202C C1200203C C1200204 20 DO 30 I=1,24 C1200205 REQBUF(I)=0 C1200206 CPREQ(I)=0 C1200207 IDATA(I)=PARDEF(I) C1200208 30 CONTINUE C1200209C C1200210 35 IF(PIND)110,70,40 C1200211C C1200212C PROMPTING LEVEL = 1 FULL PARAMETERS WILL BE DISPLAYED C1200213C C1200214 40 KI=IP C1200215 I=(IP-1)*6+1 C1200216 IF(IPNAM(IP))50,100,50 C1200217C C1200218 50 J=I+5 C1200219ÐÐ K=1 C1200220 CODE(K)=$0A0D C1200221+ SET CR/LF C1200222 DO 60 I=I,J C1200223 K=K+1 C1200224 CODE(K)=NAME(I) C1200225 60 CONTINUE C1200226C C1200227 I=KI C1200228 LNGO=7 C1200229 GO TO 90 C1200230. C1200231C C1200232C PROMPTING LEVEL = 0 PARAMETER ABBREVIATIONS WILL BE DISPLAYED C1200233C C1200234 70 I=IP C1200235 K=IPNAM(IP) C1200236+ INDEX TO PARAM.MNEM.TABLE C1200237 IF(K)80,100,80 C1200238 80 K=(K-1)*3+1 C1200239C C1200240 CODE(1)=$0A0D C1200241 CODE(2)=PARNAM(K) C1200242 CODE(3)=$3D20 C1200243 LNGO=3 C1200244ÐÐC C1200245C DISPLAY NEXT PARAMETER-IDENT C1200246C C1200247 90 CALL WTREAD (LUNIT,NOCUR,CODE,LNGO,NOCUR,DUMMY,ZRO,TC) C1200248C C1200249 PARID=IP C1200250+ INDEX IN PARNAM-TABLE C1200251 IFND(I)=1 C1200252+ SET FOUND FLAG C1200253 IP=IP+1 C1200254+ INCR. INDEX TO PPTEMP C1200255 MORPAR=1 C1200256+ SET INDICATOR FOR MORE PARAMETERS NEEDED C1200257 GO TO 120 C1200258C C1200259C END OF PARAMETER LIST, ISSUE FM-REQUEST C1200260C C1200261 100 MORPAR=0 C1200262 GO TO 320 C1200263C C1200264C PROMPTING LEVEL = -1, NO PROMPTING DONE C1200265C C1200266 110 IF(MORLIN)115,130,130 C1200267+ DO WE NEED TO READ MORE LINES C1200268 115 MORLIN=0 C1200269ÐÐC C1200270C READ NEXT LINE C1200271C C1200272 120 CALL WTREAD (LUNIT,NOCUR,DUMMY,ZRO,NOCUR,INBUF,BUFLEN,TC) C1200273C C1200274C RESET SWORD AND SBYTE C1200275C C1200276 SBYTE=0 C1200277 SWORD=0 C1200278C C1200279 130 CALL GETFLD (INBUF,CODE,SWORD,SBYTE,STAT) C1200280C C1200281 140 IF (STAT-2)150,160,200 C1200282 150 IF (STAT-1)260,250,250 C1200283C C1200284C EOL DETECTED,COUNT NO OF REQUIRED AND NOT FOUND PARAMETERS (STATUS=1)C1200285C C1200286 160 IF(PIND)161,162,162 C1200287 161 MORPAR=0 C1200288C C1200289C CHECK IF FULL NAME DESIRED C1200290C C1200291 162 IF (CODE(1)-QUEST)164,163,164 C1200292C C1200293C YES,FULL NAME FOR THIS PARAMETER ONLY C1200294ÐÐC C1200295 163 IF (PIND .NE. -1) IP=IP-1 C1200296 GO TO 40 C1200297C C1200298C CHECK IF PARAMETER ENTERED C1200299C C1200300 164 IF(CODE(1)-BLANK)270,165,270 C1200301 165 IFND(IP-1)=0 C1200302 IF (PIND .EQ. -1) GO TO 320 C1200303 GO TO 310 C1200304C C1200305C PARAMETER-ID FOUND (STATUS=3) C1200306C C1200307 200 I=1 C1200308 210 K=IPNAM(I) C1200309 K=(K-1)*3+1 C1200310C C1200311 IF (CODE(1)-PARNAM(K))230,220,230 C1200312C C1200313C PARAMETER-ID CORRESPONDS WITH PARAM.MNEMONIC TABLE C1200314C C1200315 220 PARID=I C1200316 IFND(I)=1 C1200317 IF(PARID .GT. 2 .AND. IFTSW .NE. -1) GO TO 400 C1200318 GO TO 130 C1200319ÐÐC C1200320 230 I=I+1 C1200321+ NO MATCH,CONTINUE C1200322 IF(IPNAM(I))210,240,210 C1200323C C1200324 240 INDEX=39 C1200325+ PARAMETER ILLEGAL C1200326 GO TO 9999 C1200327C C1200328C FIELD TERMINATED ON A SEMI-COLON (STATUS=1) C1200329C C1200330 250 MORLIN=-1 C1200331+ SET INDICATOR TO READ MORE LINES C1200332C C1200333C FIELD TERMINATED ON A COMMA (STATUS=0) C1200334C C1200335 260 MORPAR=1 C1200336+ SET INDICATOR FOR MORE PARAMETERS C1200337 IF(CODE(1) .NE. BLANK)GO TO 270 C1200338 IFND(IP)=0 C1200339 IP=IP+1 C1200340 GO TO 310 C1200341C C1200342C STORE PARAMETER VALUES INTO REQUIRED LOCATIONS C1200343C C1200344ÐÐ 270 IF (PARID)290,290,280 C1200345+ PARAMETER-ID FOUND C1200346 280 I=PARID C1200347+ YES C1200348 GO TO 300 C1200349C C1200350 290 I=IP C1200351 IF (CODE(1) .NE. BLANK) IFND(I)=1 C1200352 IP=IP+1 C1200353C C1200354 300 I=(IPNAM(I)-1)*3+1 C1200355C C1200356 LNGO=PARNAM(I+1) C1200357 OUTP=PARNAM(I+2) C1200358C C1200359C STORE INTO DESIGNATED OUTPUT FIELD C1200360C C1200361 CALL MOVEL (CODE,OUTP,LNGO) C1200362C C1200363 PARID=0 C1200364 IF(MORPAR)310,320,310 C1200365+ ARE THERE MORE PARAM TO BE PROCESSED C1200366 310 IF(IP-3) 315,400,315 C1200367 315 IF(PIND) 110,70,40 C1200368+ YES C1200369ÐÐC C1200370C C1200371C ARE ALL REQUIRED PARAMETERS FOUND ? C1200372C C1200373 320 I=0 C1200374 330 I=I+1 C1200375 IF(PPTEMP(I))330,360,340 C1200376C C1200377C PARAMETER NOT FOUND,IS IT REQUIRED ? C1200378C C1200379 340 IF(IREQ(I))330,350,330 C1200380C C1200381C YES IT IS REQUIRED C1200382C C1200383 350 PARNUM=PARNUM+1 C1200384 GO TO 330 C1200385C C1200386C END OF PPTAB C1200387C C1200388 360 IF(PARNUM) 240,400,240 C1200389+ ARE ALL REQUIRED PARAMETERS FOUND C1200390C C1200391C C1200392C C1200393C C1200394ÐÐC STORE FCB-ADDR IN REQBUF C1200395C C1200396C C1200397C ALL REQUIRED PARAMETERS OF FILE TO BE COPIED HAVE BEEN FOUND C1200398C C1200399 400 IF (IFTSW .EQ. -1) GO TO 430 C1200400C C1200401 DO 420 I=1,24 C1200402 CPDAT(I)=IDATA(I) C1200403 IDATA(I)=PARDEF(I) C1200404 420 CONTINUE C1200405C C1200406 IFTSW=-1 C1200407 GO TO 315 C1200408+ READ PARAMETERS OF FILE TO COPY TO C1200409C C1200410C ALL REQUIRED PARAMETERS HAVE BEEN FOUND C1200411C C1200412 430 IF(MORPAR .NE. 0) GO TO 315 C1200413C C1200414C SET UP DEFAULT VALUE FOR NO. OF RECORD TO BE PROCESSED C1200415C C1200416C C1200417C C1200418C SET UP OPEN FILE CONDITION ACCORDINGLY C1200419ÐÐC C1200420 ASSEM $C000,+FCBHDR C1200421 ASSEM $6400,+REQBUF(10) C1200422 ASSEM $C000,+CPHDR C1200423 ASSEM $6800,CPREQ(10) C1200424 REQBUF(13) = 96 C1200425 CPREQ (13) = 96 C1200426 IDATA (13) = 0 C1200427 CPDAT (13) = 0 C1200428 IDATA (14) = 1 C1200429 CPDAT (14) = 1 C1200430 IDATA (15) = -2 C1200431 CPDAT (15) = -2 C1200432C C1200433C IF NO USER ID PARAMETER WAS ENTERED, MAKE THE ID COMMON C1200434C C1200435 IF (PPTEMP(4) .GT. 0) IDATA(15) = 0 C1200436 CALL OPENFL( REQBUF(1), IDATA(1), ISTAT) C1200437 IF (ISTAT .LT. 0) GO TO 8000 C1200438 CALL OPENFL( CPREQ( 1), CPDAT( 1), ISTAT) C1200439 IF (ISTAT .LT. 0) GO TO 8010 C1200440C C1200441C C1200442C-------------------------------------------------------------------- C1200443C C1200444ÐÐC C1200445C GET SECTOR SIZE OF BOTH FILE'S VOLUMES C1200446C C1200447 CALL GETSSZ (FCBHDR,SECLEN) C1200448 CALL GETSSZ (CPHDR,ISECLN) C1200449 CALL CLOSFL (REQBUF,ISTAT) C1200450 IF (ISTAT) 8000,500,500 C1200451C C1200452 500 CALL CLOSFL (CPREQ,ISTAT) C1200453 IF (ISTAT .LT. 0) GO TO 8010 C1200454C ************************************************************* 122*4864C1200455C IF NO USER ID PARAMETER WAS ENTERED, MAKE THE ID COMMON C1200456 IF (PPTEMP(4).GT.0) IDATA(5)=0 C1200457C ************************************************************* 122*4864C1200458C C1200459C CHECK IF BOTH FILE-TYPES ARE EQUAL C1200460C C1200461 IF (RECLEN .NE. CPRECL) GO TO 8220 C1200462C **************************************************************122*4868C1200463 IF(RECLEN .GT. BUFSIZ) GO TO 8240 C1200464C *********************'*******************************'******* 122*4868C1200465C C1200466 IPWIND=AND(FCBIND,$1) C1200467 CPWIND=AND(CPFIND,$1) C1200468C C1200469ÐÐ IF (CPWIND .NE. IPWIND) GO TO 8230 C1200470 IF(FTYPE .NE. CPFCB(95)) GO TO 8230 C1200471C C1200472C ASSURE FILE'S SECTOR ALIGNMENTS ARE IDENTICAL C1200473C C1200474 IF (AND(FCBIND,$8000) .NE. AND(CPFIND,$8000)) GO TO 8230 C1200475C C1200476C ASSURE KEY DEFINITIONS ARE IDENTICAL C1200477C C1200478 DO 512 I = 15,22 C1200479 IF (FCBBUF(I).NE.CPFCB(I)) GO TO 8230 C1200480 512 CONTINUE C1200481 IF (FCBBUF(6).NE.CPFCB(6)) GO TO 8230 C1200482C C1200483C CHECK IF SECTOR SIZES ARE EQUAL. IF SO, GO ON TO 513. C1200484C C1200485 IF (SECLEN .EQ. ISECLN) GO TO 513 C1200486C C1200487C DO NOT ALLOWED COPY IF FILES ARE SECTOR ALLIGNED OR INDEXED. C1200488C C1200489 IF (AND(FCBIND,1).EQ.1 .OR. AND(FCBIND,$8000).EQ.$8000) C1200490 1 GO TO 8230 C1200491C C1200492 513 CONTINUE C1200493C C1200494ÐÐC CLEAR OUTPUT FILE C1200495C C1200496 CALL CLEAR( REQBUF(1), IDATA(1), ISTAT) C1200497 IF (ISTAT .LT. 0) GO TO 8000 C1200498 ASSEM $C000,+FCBHDR C1200499 ASSEM $6400,+REQBUF(10) C1200500 ASSEM $C000,+CPHDR C1200501 ASSEM $6800,CPREQ(10) C1200502 REQBUF(13) = 96 C1200503 CPREQ (13) = 96 C1200504 CALL OPENFL( REQBUF(1), IDATA(1), ISTAT) C1200505 IF (ISTAT .LT. 0) GO TO 8000 C1200506 CALL OPENFL(CPREQ(1), CPDAT(1), ISTAT) C1200507 IF (ISTAT .LT. 0) GO TO 8010 C1200508C C1200509C TRANSFER THE FILE'S RECORD SPACE FIRST C1200510C C1200511C SAVE FIRST 10 WORDS OF EACH FILE'S FCB C1200512C C1200513 515 CONTINUE C1200514 DO 520 I = 1,10 C1200515 ISAVB1(I) = FCBBUF(I) C1200516 520 ISAVB2(I) = CPFCB(I) C1200517C C1200518C SET NUMBER OF RECORDS FOR READ C1200519ÐÐC C1200520 NUMREC = BUFSIZ / RECLEN C1200521C C1200522C** CALCULATE SECTOR ALIGNED BLOCKING IF NEEDED C1200523C C1200524 IF (AND(FCBIND ,$8000) .EQ. 0) GO TO 521 C1200525 NUMSEC = RECLEN / SECLEN C1200526 IF ( (NUMSEC * SECLEN) .LT. RECLEN) NUMSEC = NUMSEC + 1 C1200527 NUMREC = BUFSIZ / (SECLEN * NUMSEC) C1200528 521 CONTINUE C1200529 CPREQ(13) = NUMREC C1200530C C1200531C REDEFINE BOTH FILES AS SEQUENTIAL - IF INDEXED C1200532C C1200533 FCBBUF(6) = AND($FFFE,FCBBUF(6)) C1200534 CPFCB(6) = AND($FFFE,CPFCB(6)) C1200535C C1200536C TRANSFER RECORDS TILL EOF REACHED C1200537C C1200538 IDONE = 0 C1200539 525 CALL GETS(CPREQ,RECBUF,KEYVAL,ISTAT) C1200540 NUMOUT = CPREQ(15) C1200541 IF (IEOF .NE. 0) GO TO 540 C1200542 IF (ISTAT)8010,530,530 C1200543C C1200544ÐÐ 530 CALL PUTS (REQBUF,RECBUF,NUMOUT,ISTAT) C1200545 IF (ISTAT) 8000,535,535 C1200546 535 IF (IOUT .NE. 1) GO TO 525 C1200547 537 CONTINUE C1200548 INDEX = 55 C1200549 GO TO 9999 C1200550C C1200551C EOF FOUND C1200552C C1200553 540 IF (ISTAT.LT. 0) GO TO 550 C1200554 CALL PUTS (REQBUF,RECBUF,NUMOUT,ISTAT) C1200555 IF (ISTAT) 8000,545,545 C1200556 545 CONTINUE C1200557 IF (IOUT .EQ. 1) GO TO 537 C1200558C C1200559C CHECK IF FILES ARE INDEXED, IF YES, COPY INDEX SPACE C1200560C C1200561 550 IF (IPWIND.EQ.0) GO TO 9998 C1200562C C1200563C REDEFINE FCBS TO HAVE 3 SECTOR LONG RECORDS, RECORD SPACE STARTINGC1200564C AT INDEX SPACE, TOTAL NUMBER OF RECORDS EQUAL TO TOTAL NUMBER C1200565C OF KIBS AND EXISTING NUMBER OF RECORDS IN INPUT FILE TO NUMBER OF C1200566C KIBS USED. C1200567C C1200568 FCBBUF(1) = 288 C1200569ÐÐ FCBBUF(2) = FCBBUF(11) C1200570 FCBBUF(3) = FCBBUF(12) C1200571 FCBBUF(4) = FCBBUF(13) C1200572 FCBBUF(5) = FCBBUF(14) C1200573 FCBBUF(7) = 0 C1200574 FCBBUF(8) = 0 C1200575 CPFCB(1) = 288 C1200576 CPFCB(2) = CPFCB(11) C1200577 CPFCB(3) = CPFCB(12) C1200578 CPFCB(4) = CPFCB(13) C1200579 CPFCB(5) = CPFCB(14) C1200580 CALL FDWSUB (CPFCB(09),ONE,CPFCB(7),ISTAT) C1200581C C1200582C SET NUMBER OF RECORDS FOR I/O C1200583C C1200584 NUMREC = BUFSIZ / 288 C1200585 CPREQ(13) = NUMREC C1200586C C1200587C INITIALIZE CPREQ FOR NEW GETS CALLS C1200588C C1200589 DO 555 I = 15,20 C1200590 555 CPREQ(I) = 0 C1200591C C1200592C TRANSFER KIBS TILL EOF REACHED C1200593C C1200594ÐÐ 560 CALL GETS (CPREQ,RECBUF,KEYVAL,ISTAT) C1200595 NUMOUT = CPREQ(15) C1200596 IF (IEOF .NE. 0) GO TO 575 C1200597 IF (ISTAT) 700,565,565 C1200598C C1200599 565 CALL PUTS (REQBUF,RECBUF,NUMOUT,ISTAT) C1200600 IF (ISTAT) 705,570,570 C1200601 570 IF (IOUT .NE. 1) GO TO 560 C1200602 GO TO 590 C1200603C C1200604C EOF FOUND C1200605C C1200606 575 IF (ISTAT.LT.0) GO TO 710 C1200607 CALL PUTS (REQBUF,RECBUF,NUMOUT,ISTAT) C1200608 IF (ISTAT) 705,580,580 C1200609 580 IF (IOUT .NE. 1) GO TO 710 C1200610 590 CONTINUE C1200611 INDEX = 55 C1200612 IDONE = 3 C1200613 GO TO 710 C1200614C C1200615C C1200616C ERROR NOTED ON FM CALL - INPUT FILE C1200617C C1200618 700 IDONE = 1 C1200619ÐÐ GO TO 710 C1200620C C1200621C ERROR NOTED ON FM CALL - OUTPUT FILE C1200622C C1200623 705 IDONE = 2 C1200624C C1200625C RESTORE INPUT FILE C1200626C C1200627 710 DO 715 I = 1,10 C1200628 715 CPFCB(I) = ISAVB2(I) C1200629C C1200630C RESTORE FIRST PART OF OUTPUT FILE FCB C1200631C C1200632 DO 720 I = 1,8 C1200633 720 FCBBUF(I) = ISAVB1(I) C1200634C C1200635C PROCESS ERROR IF REQUIRED C1200636C C1200637 GO TO ( 725,8010,8000,9999),IDONE + 1 C1200638C C1200639C SET UP OUTPUT FILE'S FCB C1200640C C1200641 725 CONTINUE C1200642 DO 730 I = 7,10 C1200643 730 FCBBUF(I) = CPFCB(I) C1200644ÐÐ GO TO 9998 C1200645C C1200646C C1200647C FM-REQUEST TERMINATED WITH AN ERROR C1200648C C1200649C C1200650C********** CLOSE FILE AND NO ERROR CHECK , DUE TO ERROR C1200651C C1200652 8000 CONTINUE C1200653 CALL ERCHK( ISTAT, REQBUF(4)) C1200654 CALL CLOSFL( REQBUF(1), IP) C1200655 GO TO 9993 C1200656C C1200657 8220 INDEX=65 C1200658+ 65 RECORD LENGTH NOT EQUAL C1200659 GO TO 9999 C1200660 8230 INDEX=66 C1200661+ 66 FILE TYPE NOT EQUAL C1200662 GO TO 9999 C1200663C C1200664C ************************************************************* 122*4868C1200665 8240 INDEX=64 C1200666+ 64 RECORD LENGTH TOO LARGE C1200667 GO TO 9999 C1200668C C1200669ÐÐC ************************************************************* 122*4868C1200670 8010 CONTINUE C1200671 CALL ERCHK(ISTAT,CPREQ(4)) C1200672 CALL CLOSFL( CPREQ(1), IP) C1200673 GO TO 9993 C1200674C C1200675C ERROR ROUTINE C1200676C C1200677 9999 CALL SYSMSG (INDEX,ERBUF) C1200678C C1200679 9993 IF (PIND) 9994,9994,11 C1200680 9994 IF (MODE) 9995,9998,9995 C1200681 9995 ASSEM $E400,+MODE C1200682 ASSEM $D622 C1200683C C1200684 9998 CALL CLOSFL(REQBUF,ISTAT) C1200685 9996 CALL CLOSFL (CPREQ,ISTAT) C1200686 9997 RETURN C1200687 END C1200688 SUBROUTINE DELET C1300001 1 /C13 F ITOS CCS 3.0 SL-149C1300002C COMMAND PROCESSOR FOR DELETE C1300003C CREDIT COLLECTION SYSTEM VERSION 3.0 C1300004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C1300005C COPYRIGHT CONTROL DATA CORPORATION 1979 C1300006ÐÐC C1300007C*** C1300008C C1300009C FUNCTION C1300010C C1300011C THIS IS THE REQUEST PROCESSOR FOR THE FILE-MANAGER UTILITY C1300012C ITS PURPOSE IS TO DELETE ALL SPACE ON MASS-STORAGE HELD BY C1300013C THE SPECIFIED FILE AND TO REMOVE THE ENTRY FROM THE DIRECTORY C1300014C C1300015C GENERAL DESCRIPTION C1300016C C1300017C UPON ENTRY THE PARAMETER PROCESSING TABLE(PPDELE) IS COPIED C1300018C INTO A TEMPORARILY TABLE(PPTEMP) C1300019C REQBUF IS INITIALIZED TO ALL ZEROES C1300020C IDATA IS COPIED FROM THE DEFAULT TABLE (PARDEF) C1300021C NEXT A CHECK IS DONE WHICH PROMPTING LEVEL (PIND) IS REQUIRED C1300022C C1300023C C1300024C INPUT REQUIREMENT S C1300025C C1300026C INBUF BUFFER CONTAINING COMMAND FORMAT INPUT C1300027C LUNIT LOGICAL UNIT NO TO READ FROM C1300028C MODE MODE OF OPERATION (0=INTERACTIVE ELSE BATCH) C1300029C PIND PROMPTING LEVEL INDICATOR (-1,0,1) C1300030C C1300031ÐÐC C1300032C MISCELLANEOUS C1300033C C1300034C MORPAR 0 IF END OF PARAMETER LIST IS DETECTED C1300035C 1 IF MORE PARAMETERS ARE NEEDED C1300036C MORLIN 0 IF PARAMETERLIST IS CONTAINED ON ONE RECORD C1300037C -1 IF PARAMETERLIST CONSISTS OF MORE RECORDS C1300038C IP INDEX TO PARAMETER PROCESSING TABLE C1300039C C1300040C COMMAND FORMAT C1300041C C1300042C DELETE,FN=AAAAAAAA,VL=AAAAAAAA C1300043C C1300044C DELETE,FFFFFFFF,VVVVVVVV C1300045C C1300046C DELETE,FN=AAAAAAAA C1300047C C1300048C C1300049C*** C1300050M FMUCOM C1300051C C1300052 INTEGER BUFLEN,TC,ZRO,OUTP C1300053 INTEGER BLANK,ERBUF C1300054 INTEGER PARNUM,STATUS,PARID C1300055 INTEGER OPN,WVL C1300056ÐÐ INTEGER PPTAB(4) C1300057 INTEGER STAT C1300058C C1300059 INTEGER PPTEMP(17) C1300060 INTEGER IPNAM(17) C1300061 INTEGER IJUST(17) C1300062 INTEGER ICONV(17) C1300063 INTEGER IREQ(17) C1300064 INTEGER IFND(17) C1300065 INTEGER QUEST C1300066C C1300067 BYTE (IPNAM,PPTEMP(7=0)) C1300068 BYTE (IJUST,PPTEMP(8=8)) C1300069 BYTE (ICONV,PPTEMP(10=9)) C1300070 BYTE (IREQ,PPTEMP(12=12)) C1300071 BYTE (IFND,PPTEMP(15=15)) C1300072C C1300073 DIMENSION NAME(12) C1300074C C1300075 BYTE(OPN,ISTAT(0=0)) C1300076 BYTE(NFD,ISTAT(1=1)) C1300077 BYTE(MME,ISTAT(5=5)) C1300078 BYTE(WVL,ISTAT(13=13)) C1300079 BYTE(ILR,ISTAT(14=14)) C1300080* C1300081ÐÐ EQUIVALENCE (PPDELE,PPTAB) C1300082* C1300083C C1300084 DATA NAME/'FILE-NAME =VOLUME-NAME='/ C1300085 DATA BUFLEN/40/ C1300086 DATA BLANK/$2020/ C1300087 DATA QUEST/'? '/ C1300088 DATA ZRO/0/,NOCUR/-1/ C1300089C C1300090C EXTERNALS C1300091C C1300092 EXTERNAL WTREAD C1300093 EXTERNAL GETFLD C1300094 EXTERNAL SYSMSG C1300095 EXTERNAL MOVEL C1300096 EXTERNAL MOVER C1300097 EXTERNAL DELETE C1300098C C1300099C INITIALISATION C1300100C C1300101 11 INDEX=0 C1300102+ ERROR MSG NO. C1300103 ERBUF=0 C1300104+ ERROR MSG BUF C1300105 ISTAT=0 C1300106ÐÐ+ STATUS OF FM-REQUEST C1300107 LNGO=0 C1300108+ LENGTH OF FIELD TO MOVE C1300109 MORPAR=0 C1300110+ INDICATOR IF MORE PARAMETERS NEEDED C1300111 MORLIN=0 C1300112+ INDICATOR IF MORE LINES NEED TO BE READ C1300113 PARNUM=0 C1300114+ COUNT OF REQ.AND NOT FOUND PARAMETERS C1300115 PARID=0 C1300116 IFLAG=0 C1300117 IP=1 C1300118C C1300119 ASSIGN 9998 TO INTLOC C1300120 CALL PGMINT(INTLOC,IFLAG) C1300121C C1300122C COPY THE PARAMETER PROCESSING TABLE C1300123C C1300124 I=0 C1300125 10 I=I+1 C1300126 PPTEMP(I)=PPTAB(I) C1300127 IF(PPTEMP(I))10,20,10 C1300128C C1300129C C1300130C C1300131ÐÐ 20 DO 30 I=1,24 C1300132 REQBUF(I)=0 C1300133 IDATA(I)=PARDEF(I) C1300134 30 CONTINUE C1300135C C1300136 35 IF(PIND)110,70,40 C1300137C C1300138C PROMPTING LEVEL = 1 FULL PARAMETERS WILL BE DISPLAYED C1300139C C1300140 40 KI=IP C1300141 I=(IP-1)*6+1 C1300142 IF(IPNAM(IP))50,100,50 C1300143C C1300144 50 J=I+5 C1300145 K=1 C1300146 CODE(K)=$0A0D C1300147+ SET CR/LF C1300148 DO 60 I=I,J C1300149 K=K+1 C1300150 CODE(K)=NAME(I) C1300151 60 CONTINUE C1300152C C1300153 I=KI C1300154 LNGO=7 C1300155 GO TO 90 C1300156ÐÐC C1300157C PROMPTING LEVEL = 0 PARAMETER ABBREVIATIONS WILL BE DISPLAYED C1300158C C1300159 70 I=IP C1300160 K=IPNAM(IP) C1300161+ INDEX TO PARAM.MNEM.TABLE C1300162 IF(K)80,100,80 C1300163 80 K=(K-1)*3+1 C1300164C C1300165 CODE(1)=$0A0D C1300166 CODE(2)=PARNAM(K) C1300167 CODE(3)=$3D20 C1300168 LNGO=3 C1300169C C1300170C DISPLAY NEXT PARAMETER-IDENT C1300171C C1300172 90 CALL WTREAD (LUNIT,NOCUR,CODE,LNGO,NOCUR,DUMMY,ZRO,TC) C1300173C C1300174 PARID=IP C1300175+ INDEX IN PARNAM-TABLE C1300176 IFND(I)=1 C1300177+ SET FOUND FLAG C1300178 IP=IP+1 C1300179+ INCR. INDEX TO PPTEMP C1300180 MORPAR=1 C1300181ÐÐ+ SET INDICATOR FOR MORE PARAMETERS NEEDED C1300182 GO TO 120 C1300183C C1300184C END OF PARAMETER LIST, ISSUE FM-REQUEST C1300185C C1300186 100 MORPAR=0 C1300187 GO TO 320 C1300188C C1300189C PROMPTING LEVEL = -1, NO PROMPTING DONE C1300190C C1300191 110 IF(MORLIN)115,130,130 C1300192+ DO WE NEED TO READ MORE LINES C1300193 115 MORLIN=0 C1300194C C1300195C READ NEXT LINE C1300196C C1300197 120 CALL WTREAD (LUNIT,NOCUR,DUMMY,ZRO,NOCUR,INBUF,BUFLEN,TC) C1300198C C1300199C RESET SWORD AND SBYTE C1300200C C1300201 SBYTE=0 C1300202 SWORD=0 C1300203C C1300204 130 CALL GETFLD (INBUF,CODE,SWORD,SBYTE,STAT) C1300205C C1300206ÐÐ 140 IF (STAT-2)150,160,200 C1300207 150 IF (STAT-1)260,250,250 C1300208C C1300209C EOL DETECTED,COUNT NO OF REQUIRED AND NOT FOUND PARAMETERS (STATUS=1)C1300210C C1300211 160 IF(PIND)161,162,162 C1300212 161 MORPAR=0 C1300213C C1300214C CHECK IF FULL NAME DESIRED C1300215C C1300216 162 IF (CODE(1)-QUEST)164,163,164 C1300217C C1300218C YES,FULL NAME FOR THIS PARAMETER ONLY C1300219C C1300220 163 IF (PIND .NE. -1) IP=IP-1 C1300221 GO TO 40 C1300222C C1300223C CHECK IF PARAMETER ENTERED C1300224C C1300225 164 IF(CODE(1)-BLANK)270,165,270 C1300226 165 IFND(IP-1)=0 C1300227 IF (PIND .EQ. -1) GO TO 320 C1300228 GO TO 35 C1300229C C1300230C PARAMETER-ID FOUND (STATUS=3) C1300231ÐÐC C1300232 200 I=1 C1300233 210 K=IPNAM(I) C1300234 K=(K-1)*3+1 C1300235C C1300236 IF (CODE(1)-PARNAM(K))230,220,230 C1300237C C1300238C PARAMETER-ID CORRESPONDS WITH PARAM.MNEMONIC TABLE C1300239C C1300240 220 PARID=I C1300241 IFND(I)=1 C1300242 GO TO 130 C1300243C C1300244 230 I=I+1 C1300245+ NO MATCH,CONTINUE C1300246 IF(IPNAM(I))210,240,210 C1300247C C1300248 240 INDEX=39 C1300249+ PARAMETER ILLEGAL C1300250 GO TO 9999 C1300251C C1300252C FIELD TERMINATED ON A SEMI-COLON (STATUS=1) C1300253C C1300254 250 MORLIN=-1 C1300255+ SET INDICATOR TO READ MORE LINES C1300256ÐÐC C1300257C FIELD TERMINATED ON A COMMA (STATUS=0) C1300258C C1300259 260 MORPAR=1 C1300260+ SET INDICATOR FOR MORE PARAMETERS C1300261 IF(CODE(1) .NE. BLANK)GO TO 270 C1300262 IFND(IP)=0 C1300263 IP=IP+1 C1300264 GO TO 35 C1300265C C1300266C STORE PARAMETER VALUES INTO REQUIRED LOCATIONS C1300267C C1300268 270 IF (PARID)290,290,280 C1300269+ PARAMETER-ID FOUND C1300270 280 I=PARID C1300271+ YES C1300272 GO TO 300 C1300273C C1300274 290 I=IP C1300275 IF (CODE(1) .NE. BLANK) IFND(I)=1 C1300276 IP=IP+1 C1300277C C1300278 300 I=(IPNAM(I)-1)*3+1 C1300279C C1300280 LNGO=PARNAM(I+1) C1300281ÐÐ OUTP=PARNAM(I+2) C1300282C C1300283C STORE INTO DESIGNATED OUTPUT FIELD C1300284C C1300285 CALL MOVEL (CODE,OUTP,LNGO) C1300286C C1300287 PARID=0 C1300288 IF(MORPAR)310,320,310 C1300289+ ARE THERE MORE PARAM TO BE PROCESSED C1300290 310 IF(PIND)110,70,40 C1300291+ YES C1300292C C1300293C ARE ALL REQUIRED PARAMETERS FOUND ? C1300294C C1300295 320 I=0 C1300296 330 I=I+1 C1300297 IF(PPTEMP(I))330,360,340 C1300298C C1300299C PARAMETER NOT FOUND,IS IT REQUIRED ? C1300300C C1300301 340 IF(IREQ(I))330,350,330 C1300302C C1300303C YES IT IS REQUIRED C1300304C C1300305 350 PARNUM=PARNUM+1 C1300306ÐÐ GO TO 330 C1300307C C1300308C END OF PPTAB C1300309C C1300310 360 IF(PARNUM)240,400,240 C1300311+ ARE ALL REQUIRED PARAMETERS FOUND C1300312C C1300313C C1300314C C1300315 400 CALL DELETE (REQBUF,IDATA,ISTAT) C1300316+ NO C1300317C C1300318 IF(ISTAT)8000,9000,9000 C1300319+ REQUEST OK C1300320C C1300321C FILE REQUEST REJECTED C1300322C C1300323 8000 CALL ERCHK(ISTAT,REQBUF(4)) C1300324 GO TO 9995 C1300325C C1300326 9000 GO TO 9998 C1300327C C1300328C ERROR ROUTINE C1300329C C1300330 9999 CALL SYSMSG(INDEX,ERBUF) C1300331ÐÐ 9995 IF(PIND) 9996,9996,11 C1300332 9996 IF(MODE) 9997,9998,9997 C1300333 9997 ASSEM $E400,+MODE C1300334 ASSEM $D622 C1300335C C1300336 9998 RETURN C1300337 END C1300338 SUBROUTINE CLEER C1400001 1 /C14 F ITOS CCS 3.0 SL-149C1400002C COMMAND PROCESSOR FOR CLEAR C1400003C CREDIT COLLECTION SYSTEM VERSION 3.0 C1400004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C1400005C COPYRIGHT CONTROL DATA CORPORATION 1979 C1400006C C1400007C C1400008C FUNCTION C1400009C C1400010C THIS IS THE REQUEST PROCESSOR FOR THE FILE-MANAGER UTILITY C1400011C ITS PURPOSE IS TO CLEAR ALL SPACE ON MASS-STORAGE HELD BY C1400012C THE SPECIFIED FILE BUT TO RETAIN THE ENTRY IN THE DIRECTORY C1400013C C1400014C GENERAL DESCRIPTION C1400015C C1400016C UPON ENTRY THE PARAMETER PROCESSING TABLE(PPCLEA) IS COPIED C1400017C INTO A TEMPORARILY TABLE(PPTEMP) C1400018ÐÐC REQBUF IS INITIALIZED TO ALL ZEROES C1400019C IDATA IS COPIED FROM THE DEFAULT TABLE (PARDEF) C1400020C NEXT A CHECK IS DONE WHICH PROMPTING LEVEL (PIND) IS REQUIRED C1400021C C1400022C COMMAND FORMAT C1400023C C1400024C CLEAR,FN=FFFFFFFF,VL=VVVVVVVV C1400025C C1400026C CLEAR,FFFFFFFF,VVVVVVVV C1400027C C1400028C CLEAR,FFFFFFFF C1400029C C1400030C C1400031M FMUCOM C1400032C C1400033 INTEGER BUFLEN,TC,ZRO,OUTP C1400034 INTEGER BLANK,ERBUF C1400035 INTEGER PARNUM,STATUS,PARID C1400036 INTEGER OPN,WVL C1400037 INTEGER PPTAB(4) C1400038 INTEGER STAT C1400039C C1400040 INTEGER PPTEMP(17) C1400041 INTEGER IPNAM(17) C1400042 INTEGER IJUST(17) C1400043ÐÐ INTEGER ICONV(17) C1400044 INTEGER IREQ(17) C1400045 INTEGER IFND(17) C1400046 INTEGER QUEST C1400047C ***** 138*0043C1400048 INTEGER RCBLEN,SECLEN,RECBUF(9002) C1400049C ***** 138*0043C1400050C C1400051 BYTE (IPNAM,PPTEMP(7=0)) C1400052 BYTE (IJUST,PPTEMP(8=8)) C1400053 BYTE (ICONV,PPTEMP(10=9)) C1400054 BYTE (IREQ,PPTEMP(12=12)) C1400055 BYTE (IFND,PPTEMP(15=15)) C1400056C C1400057 DIMENSION NAME(12) C1400058C C1400059 BYTE(OPN,ISTAT(0=0)) C1400060 BYTE(NFD,ISTAT(1=1)) C1400061 BYTE(MME,ISTAT(5=5)) C1400062C ***** 138*0043C1400063 BYTE(IOUT,ISTAT(12=12)) C1400064C ***** 138*0043C1400065 BYTE(WVL,ISTAT(13=13)) C1400066 BYTE(ILR,ISTAT(14=14)) C1400067* C1400068ÐÐ EQUIVALENCE (PPCLEA,PPTAB) C1400069* C1400070C C1400071 DATA NAME/'FILE-NAME =VOLUME-NAME='/ C1400072 DATA BUFLEN/40/ C1400073 DATA BLANK/$2020/ C1400074 DATA QUEST/'? '/ C1400075 DATA ZRO/0/,NOCUR/-1/ C1400076C ***** 138*0043C1400077 DATA RCBLEN/9000/ C1400078C ***** 138*0043C1400079C C1400080C EXTERNALS C1400081C C1400082 EXTERNAL WTREAD C1400083 EXTERNAL GETFLD C1400084 EXTERNAL MOVEL C1400085 EXTERNAL MOVER C1400086 EXTERNAL DELETE C1400087 EXTERNAL GETSSZ C1400088C C1400089C INITIALISATION C1400090C C1400091 11 INDEX=0 C1400092+ ERROR MSG NO. C1400093ÐÐ ERBUF=0 C1400094+ ERROR MSG BUF C1400095 ISTAT=0 C1400096+ STATUS OF FM-REQUEST C1400097 LNGO=0 C1400098+ LENGTH OF FIELD TO MOVE C1400099 MORPAR=0 C1400100+ INDICATOR IF MORE PARAMETERS NEEDED C1400101 MORLIN=0 C1400102+ INDICATOR IF MORE LINES NEED TO BE READ C1400103 PARNUM=0 C1400104+ COUNT OF REQ.AND NOT FOUND PARAMETERS C1400105 IP=1 C1400106 PARID=0 C1400107 IINTRP=0 C1400108 ASSIGN 9998 TO INTLOC C1400109 CALL PGMINT(INTLOC,IINTRP) C1400110C C1400111C COPY THE PARAMETER PROCESSING TABLE C1400112C C1400113 I=0 C1400114 10 I=I+1 C1400115 PPTEMP(I)=PPTAB(I) C1400116 IF(PPTEMP(I))10,20,10 C1400117C C1400118ÐÐC C1400119C C1400120 20 DO 30 I=1,24 C1400121 REQBUF(I)=0 C1400122 IDATA(I)=PARDEF(I) C1400123 30 CONTINUE C1400124C C1400125 35 IF(PIND)110,70,40 C1400126C C1400127C PROMPTING LEVEL = 1 FULL PARAMETERS WILL BE DISPLAYED C1400128C C1400129 40 KI=IP C1400130 I=(IP-1)*6+1 C1400131 IF(IPNAM(IP))50,100,50 C1400132C C1400133 50 J=I+5 C1400134 K=1 C1400135 CODE(K)=$0A0D C1400136+ SET CR/LF C1400137 DO 60 I=I,J C1400138 K=K+1 C1400139 CODE(K)=NAME(I) C1400140 60 CONTINUE C1400141C C1400142 I=KI C1400143ÐÐ LNGO=7 C1400144 GO TO 90 C1400145C C1400146C PROMPTING LEVEL = 0 PARAMETER ABBREVIATIONS WILL BE DISPLAYED C1400147C C1400148 70 I=IP C1400149 K=IPNAM(IP) C1400150+ INDEX TO PARAM.MNEM.TABLE C1400151 IF(K)80,100,80 C1400152 80 K=(K-1)*3+1 C1400153C C1400154 CODE(1)=$0A0D C1400155 CODE(2)=PARNAM(K) C1400156 CODE(3)=$3D20 C1400157 LNGO=3 C1400158C C1400159C DISPLAY NEXT PARAMETER-IDENT C1400160C C1400161 90 CALL WTREAD (LUNIT,NOCUR,CODE,LNGO,NOCUR,DUMMY,ZRO,TC) C1400162C C1400163 PARID=IP C1400164+ INDEX IN PARNAM-TABLE C1400165 IFND(I)=1 C1400166+ SET FOUND FLAG C1400167 IP=IP+1 C1400168ÐÐ+ INCR. INDEX TO PPTEMP C1400169 MORPAR=1 C1400170+ SET INDICATOR FOR MORE PARAMETERS NEEDED C1400171 GO TO 120 C1400172C C1400173C END OF PARAMETER LIST, ISSUE FM-REQUEST C1400174C C1400175 100 MORPAR=0 C1400176 GO TO 320 C1400177C C1400178C PROMPTING LEVEL = -1, NO PROMPTING DONE C1400179C C1400180 110 IF(MORLIN)115,130,130 C1400181+ DO WE NEED TO READ MORE LINES C1400182 115 MORLIN=0 C1400183C C1400184C READ NEXT LINE C1400185C C1400186 120 CALL WTREAD (LUNIT,NOCUR,DUMMY,ZRO,NOCUR,INBUF,BUFLEN,TC) C1400187C C1400188C RESET SWORD AND SBYTE C1400189C C1400190 SBYTE=0 C1400191 SWORD=0 C1400192C C1400193ÐÐ 130 CALL GETFLD (INBUF,CODE,SWORD,SBYTE,STAT) C1400194C C1400195 140 IF (STAT-2)150,160,200 C1400196 150 IF (STAT-1)260,250,250 C1400197C C1400198C EOL DETECTED,COUNT NO OF REQUIRED AND NOT FOUND PARAMETERS (STATUS=1)C1400199C C1400200 160 IF(PIND)161,162,162 C1400201 161 MORPAR=0 C1400202C C1400203C CHECK IF FULL NAME DESIRED C1400204C C1400205 162 IF (CODE(1)-QUEST)164,163,164 C1400206C C1400207C YES,FULL NAME FOR THIS PARAMETER ONLY C1400208C C1400209 163 IF (PIND .NE. -1) IP=IP-1 C1400210 GO TO 40 C1400211C C1400212C CHECK IF PARAMETER ENTERED C1400213C C1400214 164 IF(CODE(1)-BLANK)270,165,270 C1400215 165 IFND(IP-1)=0 C1400216 IF (PIND .EQ. -1) GO TO 320 C1400217 GO TO 35 C1400218ÐÐC C1400219C PARAMETER-ID FOUND (STATUS=3) C1400220C C1400221 200 I=1 C1400222 210 K=IPNAM(I) C1400223 K=(K-1)*3+1 C1400224C C1400225 IF (CODE(1)-PARNAM(K))230,220,230 C1400226C C1400227C PARAMETER-ID CORRESPONDS WITH PARAM.MNEMONIC TABLE C1400228C C1400229 220 PARID=I C1400230 IFND(I)=1 C1400231 GO TO 130 C1400232C C1400233 230 I=I+1 C1400234+ NO MATCH,CONTINUE C1400235 IF(IPNAM(I))210,240,210 C1400236C C1400237 240 CONTINUE C1400238 INDEX = 39 C1400239 CALL SYSMSG(INDEX,ERBUF) C1400240 GO TO 9999 C1400241C C1400242C FIELD TERMINATED ON A SEMI-COLON (STATUS=1) C1400243ÐÐC C1400244 250 MORLIN=-1 C1400245+ SET INDICATOR TO READ MORE LINES C1400246C C1400247C FIELD TERMINATED ON A COMMA (STATUS=0) C1400248C C1400249 260 MORPAR=1 C1400250+ SET INDICATOR FOR MORE PARAMETERS C1400251 IF(CODE(1) .NE. BLANK)GO TO 270 C1400252 IFND(IP)=0 C1400253 IP=IP+1 C1400254 GO TO 35 C1400255C C1400256C STORE PARAMETER VALUES INTO REQUIRED LOCATIONS C1400257C C1400258 270 IF (PARID)290,290,280 C1400259+ PARAMETER-ID FOUND C1400260 280 I=PARID C1400261+ YES C1400262 GO TO 300 C1400263C C1400264 290 I=IP C1400265 IF (CODE(1) .NE. BLANK) IFND(I)=1 C1400266 IP=IP+1 C1400267C C1400268ÐÐ 300 I=(IPNAM(I)-1)*3+1 C1400269C C1400270 LNGO=PARNAM(I+1) C1400271 OUTP=PARNAM(I+2) C1400272C C1400273C STORE INTO DESIGNATED OUTPUT FIELD C1400274C C1400275 CALL MOVEL (CODE,OUTP,LNGO) C1400276C C1400277 PARID=0 C1400278 IF(MORPAR)310,320,310 C1400279+ ARE THERE MORE PARAM TO BE PROCESSED C1400280 310 IF(PIND)110,70,40 C1400281+ YES C1400282C C1400283C ARE ALL REQUIRED PARAMETERS FOUND ? C1400284C C1400285 320 I=0 C1400286 330 I=I+1 C1400287 IF(PPTEMP(I))330,360,340 C1400288C C1400289C PARAMETER NOT FOUND,IS IT REQUIRED ? C1400290C C1400291 340 IF(IREQ(I))330,350,330 C1400292C C1400293ÐÐC YES IT IS REQUIRED C1400294C C1400295 350 PARNUM=PARNUM+1 C1400296 GO TO 330 C1400297C C1400298C END OF PPTAB C1400299C C1400300 360 IF(PARNUM)240,400,240 C1400301+ ARE ALL REQUIRED PARAMETERS FOUND C1400302C C1400303C C1400304C C1400305C ***** 138*0043C1400306C C1400307C SET UP TO OPEN FILE TO OBTAIN FCB C1400308C C1400309 400 CONTINUE C1400310 ASSEM $C000,+FCBHDR C1400311+ LDA =XFCBHDR C1400312 ASSEM $6400,+REQBUF(10) C1400313+ STA+ REQBUF+9 C1400314 REQBUF(13) = 96 C1400315+ SET TO READ FULL LENGTH FCB C1400316C C1400317 IDATA(13) = 0 C1400318ÐÐ IDATA(14) = 1 C1400319 IDATA(15) = 0 C1400320 CALL OPENFL (REQBUF,IDATA,ISTAT) C1400321 IF (ISTAT.LT.0) GO TO 440 C1400322C C1400323C CLOSE FILE C1400324C C1400325 CALL CLOSFL (REQBUF,ISTAT) C1400326 IF (ISTAT.LT.0) GO TO 440 C1400327C C1400328C CLEAR THE FILE C1400329C C1400330 CALL CLEAR (REQBUF,IDATA,ISTAT) C1400331 IF (ISTAT.LT.0) GO TO 440 C1400332C C1400333C CHECK IF FILE IS DIRECT. IF NO EXIT NOW C1400334C C1400335 IF (FCBBUF(95).NE.3) GO TO 9998 C1400336C C1400337C REOPEN THE FILE. MUST PRESET ALL RECORDS C1400338C C1400339 ASSEM $C000,+FCBHDR C1400340+ LDA =XFCBHDR C1400341 ASSEM $6400,+REQBUF(10) C1400342+ STA+ REQBUF+9 C1400343ÐÐ REQBUF(13) = 96 C1400344+ SET TO READ FULL LENGTH FCB C1400345 CALL OPENFL (REQBUF,IDATA,ISTAT) C1400346 IF (ISTAT.LT.0) GO TO 440 C1400347C C1400348C GET SECTOR SIZE C1400349C C1400350 CALL GETSSZ (FCBHDR,SECLEN) C1400351C C1400352C CLEAR THE RECORD BUFFER C1400353C C1400354 DO 410 I = 1,RCBLEN C1400355 410 RECBUF(I) = $2020 C1400356C C1400357C COMPUTE NUMBER OF RECORDS TO STORE PER PUTS REQUEST C1400358C C1400359 NRECS = RCBLEN/FCBBUF(1) C1400360 IF (AND(FCBIND,$8000).EQ.0) GO TO 420 C1400361C C1400362C COMPUTE EFFECTIVE RECORD LENGTH FOR BLOCKING C1400363C C1400364 NUMSEC = FCBBUF(1) / SECLEN C1400365 IF ((NUMSEC*SECLEN).LT.FCBBUF(1)) NUMSEC = NUMSEC + 1 C1400366 NRECS = RCBLEN/(SECLEN*NUMSEC) C1400367C C1400368ÐÐC STORE A SET OF NRECS RECORDS C1400369C C1400370 420 CALL PUTS (REQBUF,RECBUF,NRECS,ISTAT) C1400371C C1400372C CHECK FOR LAST RECORD C1400373C C1400374 IF (IOUT) 450,430,450 C1400375 430 IF (ISTAT) 440,420,420 C1400376 440 CALL ERCHK (ISTAT,REQBUF(4)) C1400377 CALL CLOSFL (REQBUF,ISTAT) C1400378 GO TO 9999 C1400379 450 CALL CLOSFL (REQBUF,ISTAT) C1400380 GO TO 9998 C1400381C ***** 138*0043C1400382C C1400383C ERROR ROUTINE C1400384C C1400385 9999 IF(PIND)9995,9995,11 C1400386 9995 IF(MODE)9996,9998,9996 C1400387 9996 ASSEM $E400,+MODE C1400388 ASSEM $D622 C1400389C C1400390 9998 RETURN C1400391 END C1400392 SUBROUTINE LIST C1500001ÐÐ 1 /C15 F ITOS CCS 3.0 SL-149C1500002C CREDIT COLLECTION SYSTEM VERSION 3.0 C1500003C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C1500004C COPYRIGHT CONTROL DATA CORPORATION 1979 C1500005C CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.1 C1500006C ************************************************************* 122*4869C1500007C *****************************************************'******* 122*4862C1500008C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C1500009C COPYRIGHT CONTROL DATA CORPORATION 1977 C1500010C *****************************************************'******* 122*4869C1500011C*** C1500012C ************************************************************* 122*4869C1500013C C1500014C C1500015C FUNCTION C1500016C C1500017C THIS PROCESSOR PRINTS THE CONTENTS OF THE SPECIFIED FILE C1500018C TO THE LIST-DEVICE SPECIFIED C1500019C IF NO LIST-DEVICE IS SPECIFIED THE TERMINAL IS ASSUMED C1500020C C1500021C MAX RECORD LENGTH IS 512 BYTES C1500022C C1500023C GENERAL DESCRIPTION C1500024C C1500025C *****************************************************'******* 122*4869C1500026ÐÐC AFTER ALL PARAMETERS ARE READ A VALIDITY CHECK IS PERFORMED C1500027C THE FILE IS OPENED AND THE FCB IS OBTAINED C1500028C IF RECLEN IS LESS THAN 256 WORDS THE FILE CAN BE LISTED,ELSE AN C1500029C ERROR 64 IS DISPLAYED C1500030C IF THE RECORD LENGTH EXCEEDS 40 WORDS,THE MULTIPLE LINE INDICATOR C1500031C MULLEN IS SET TO -1 C1500032C THE LOGICAL UNIT NO IS OBTAINED AND THE HEADER LINE IS PRINTED C1500033C EVERY RECORD IS OBTAINED BY A GETS REQUEST C1500034C RECORDS MARKED AS DELETED ARE IGNORED C1500035C ACCORDING TO THE OUTPUT MODE SELECTED AN ASCII OR HEX LIST C1500036C IS PRINTED C1500037C IN CASE EBCDIC IS SPECIFIED,THE INTERNAL EBCDIC FILE IS C1500038C CONVERTED TO ASCII TO BE PRINTED C1500039C THE FILE IS CLOSED AT EXIT C1500040C ************************************************************* 122*4869C1500041C C1500042C C1500043C COMMAND FORMAT C1500044C C1500045C ************************************************************* 122*4869C1500046C LIST,FN=AAAAAAAA,VL=AAAAAAAA,M=A,L=NNNNNN,F=U/F C1500047C ************************************************************* 122*4869C1500048C C1500049M FMUCOM C1500050. C1500051ÐÐC C1500052 INTEGER OWNR12,OWNR34,OWNR56,OWNR78,RECLEN,TDATRM,TDATRL C1500053 INTEGER DATBAM,DATBAL,FCBIND,TNKEYM,TNKEYL,POSKY1,POSKY2 C1500054 INTEGER POSKY3,POSKY4,TSFILM,TSFILL,EXPDAT,CRTDAT,FILTYP C1500055C ************************************************************* 122*4869C1500056 INTEGER NOCUR,ZRO,ERBUF,PARNUM,PARID,PPTEMP(17),PPTAB(7) C1500057C ************************************************************* 122*4869C1500058 INTEGER BUFLEN,TC,OUTP,BLANK,QUEST,STAT,OPN,WVL,FTYPE C1500059 INTEGER OPN,WVL C1500060 INTEGER RECBUF C1500061 INTEGER ASEBSW C1500062C C1500063 DIMENSION IPNAM(17) C1500064 DIMENSION IREQ(17) C1500065 DIMENSION IFND(17) C1500066C ************************************************************* 122*4869C1500067 DIMENSION NAME(30) C1500068C *****************************************************'******* 122*4869C1500069 DIMENSION NAME12(4) C1500070 DIMENSION OWNR12(4) C1500071 DIMENSION RECBUF(258) C1500072 DIMENSION ITEMP(3) C1500073 DIMENSION MSGPAU(3) C1500074 DIMENSION IODEF(4) C1500075C C1500076ÐÐ DIMENSION MES1(41),MS11( 1),MS12( 5),MS13( 5),MS14( 1),MS15( 1), C1500077 1 MS16( 1) C1500078 DIMENSION MES258(258),MES2( 42),LTEMP( 6) C1500079 DIMENSION KARAEH( 3) C1500080C C1500081 EQUIVALENCE (MES2 ,MES258( 1)) C1500082C C1500083 EQUIVALENCE (PPLIST,PPTAB) C1500084. C1500085C C1500086C FILE CONTROL BLOCK C1500087C C1500088 EQUIVALENCE (RECLEN,FCBBUF(1)) C1500089 EQUIVALENCE (TDATRM,FCBBUF(2)) C1500090 EQUIVALENCE (TDATRL,FCBBUF(3)) C1500091 EQUIVALENCE (DATBAM,FCBBUF(4)) C1500092 EQUIVALENCE (DATBAL,FCBBUF(5)) C1500093 EQUIVALENCE (FCBIND,FCBBUF(6)) C1500094 EQUIVALENCE (NEDATM,FCBBUF(7)) C1500095 EQUIVALENCE (NEDATL,FCBBUF(8)) C1500096 EQUIVALENCE (NEXTBM,FCBBUF(9)) C1500097 EQUIVALENCE (NEXTBL,FCBBUF(10)) C1500098 EQUIVALENCE (TNKEYM,FCBBUF(11)) C1500099 EQUIVALENCE (TNKEYL,FCBBUF(12)) C1500100 EQUIVALENCE (KEYBAM,FCBBUF(13)) C1500101ÐÐ EQUIVALENCE (KEYBAL,FCBBUF(14)) C1500102 EQUIVALENCE (LENKY1,FCBBUF(15)) C1500103 EQUIVALENCE (POSKY1,FCBBUF(16)) C1500104 EQUIVALENCE (LENKY2,FCBBUF(17)) C1500105 EQUIVALENCE (POSKY2,FCBBUF(18)) C1500106 EQUIVALENCE (LENKY3,FCBBUF(19)) C1500107 EQUIVALENCE (POSKY3,FCBBUF(20)) C1500108 EQUIVALENCE (LENKY4,FCBBUF(21)) C1500109 EQUIVALENCE (POSKY4,FCBBUF(22)) C1500110 EQUIVALENCE (TSFILM,FCBBUF(23)) C1500111 EQUIVALENCE (TSFILL,FCBBUF(24)) C1500112 EQUIVALENCE (NAME12,FCBBUF(25)) C1500113 EQUIVALENCE (OWNR12,FCBBUF(29)) C1500114 EQUIVALENCE (EXPDAT,FCBBUF(89)) C1500115 EQUIVALENCE (CRTDAT,FCBBUF(92)) C1500116 EQUIVALENCE (FTYPE,FCBBUF(95)) C1500117C C1500118C EXTERNALS C1500119C C1500120 EXTERNAL MMLUTB C1500121 EXTERNAL WTREAD C1500122 EXTERNAL GETFLD C1500123 EXTERNAL SYSMSG C1500124 EXTERNAL FMEOFC C1500125 EXTERNAL MOVEL C1500126ÐÐ EXTERNAL OPENFL C1500127 EXTERNAL GETFCB C1500128 EXTERNAL ASCEBC C1500129 EXTERNAL TODAY C1500130C C1500131C C1500132 BYTE (IFND,PPTEMP(15=15)) C1500133 BYTE (IREQ,PPTEMP(12=12)) C1500134 BYTE (IPNAM,PPTEMP(7=0)) C1500135C C1500136 BYTE (OPN,ISTAT(0=0)) C1500137 BYTE (NFD,ISTAT(1=1)) C1500138 BYTE (LOK,ISTAT(2=2)) C1500139 BYTE (IRLOK,ISTAT(3=3)) C1500140 BYTE (IDEL,ISTAT(4=4)) C1500141 BYTE (INUNK,ISTAT(4=4)) C1500142 BYTE (MME,ISTAT(5=5)) C1500143 BYTE (IEOF,ISTAT(8=8)) C1500144 BYTE (IWKY,ISTAT(9=9)) C1500145 BYTE (IFE,ISTAT(10=10)) C1500146 BYTE (MFOS,ISTAT(11=11)) C1500147 BYTE (MFO,ISTAT(12=12)) C1500148 BYTE (IOUT,ISTAT(12=12)) C1500149 BYTE (WVL,ISTAT(13=13)) C1500150 BYTE (ILR,ISTAT(14=14)) C1500151ÐÐC C1500152C ************************************************************* 122*4869C1500153 DATA NAME/'FILE-NAME =VOLUME-NAME=MODE =LIST DEVICE=FORMAT C1500154 *U/F ='/ C1500155C ************************************************************* 122*4869C1500156 DATA NOCUR/-1/,ZRO/0/ C1500157 DATA BUFLEN/40/ C1500158 DATA BLANK/$2020/ C1500159 DATA QUEST/'? '/ C1500160 DATA ICNTL/$200C/ C1500161 DATA MSGPAU/'PAUSE '/ C1500162 DATA LPAUSE/3/ C1500163 DATA IODEF/'TERMINAL'/ C1500164C C1500165 DATA KARAEH/ 'A ', 'E ', 'H '/ C1500166C C1500167C** FORMAT FOR MESSAGE C1500168C C1500169 DATA MES1/ $200C, ' FILE-NAME : OWNER-NAME : ', C1500170 1 ' MONTH DAY YEAR ', $0D0A/, C1500171 2 M1SZ/ 41/ C1500172 DATA MES258/ 258*$2020/, M2SZ/ 42/, M258Z/ 258/ C1500173. C1500174C C1500175C INITIALISATION C1500176ÐÐC C1500177 11 INDEX=0 C1500178+ ERROR MSG NO. C1500179 ERBUF=0 C1500180+ ERROR MSG BUF C1500181 ISTAT=0 C1500182+ STATUS OF FM-REQUEST C1500183 LNGO=0 C1500184+ LENGTH OF FIELD TO MOVE C1500185 MORPAR=0 C1500186+ INDICATOR IF MORE PARAMETERS NEEDED C1500187 MORLIN=0 C1500188+ INDICATOR IF MORE LINES NEED TO BE READ C1500189 PARNUM=0 C1500190+ COUNT OF REQ.AND NOT FOUND PARAMETERS C1500191 PARID=0 C1500192 IRCNT=0 C1500193 MULLEN=0 C1500194 LINCNT=0 C1500195 IFLAG=0 C1500196 IP=1 C1500197 IS=1 C1500198 IMAX=40 C1500199 DO 6 I=1,4 C1500200 DUMMY(I)=IODEF(I) C1500201ÐÐ 6 CONTINUE C1500202C ************************************************************* 122*4869C1500203 DUMMY(5)=2HF C1500204C ************************************************************* 122*4869C1500205 DUMMY(6)=$4120 C1500206+ SET ASCII OUTPUT AS DEFAULT C1500207 ASSEM $C000,+FMEOFC C1500208 ASSEM $6800,IFMEOF C1500209C C1500210 ASSIGN 9998 TO INTLOC C1500211 CALL PGMINT(INTLOC,IFLAG) C1500212C C1500213C COPY THE PARAMETER PROCESSING TABLE C1500214C C1500215 I=0 C1500216 10 I=I+1 C1500217 PPTEMP(I)=PPTAB(I) C1500218 IF(PPTEMP(I))10,20,10 C1500219C C1500220C C1500221C C1500222 20 DO 30 I=1,24 C1500223 REQBUF(I)=0 C1500224 IDATA(I)=PARDEF(I) C1500225 30 CONTINUE C1500226ÐÐC C1500227 35 IF(PIND)110,70,40 C1500228C C1500229C PROMPTING LEVEL = 1 FULL PARAMETERS WILL BE DISPLAYED C1500230C C1500231 40 KI=IP C1500232 I=(IP-1)*6+1 C1500233 IF(IPNAM(IP))50,100,50 C1500234C C1500235 50 J=I+5 C1500236 K=1 C1500237 CODE(K)=$0A0D C1500238+ SET CR/LF C1500239 DO 60 I=I,J C1500240 K=K+1 C1500241 CODE(K)=NAME(I) C1500242 60 CONTINUE C1500243C C1500244 I=KI C1500245 LNGO=7 C1500246 GO TO 90 C1500247. C1500248C C1500249C PROMPTING LEVEL = 0 PARAMETER ABBREVIATIONS WILL BE DISPLAYED C1500250C C1500251ÐÐ 70 I=IP C1500252 K=IPNAM(IP) C1500253+ INDEX TO PARAM.MNEM.TABLE C1500254 IF(K)80,100,80 C1500255 80 K=(K-1)*3+1 C1500256C C1500257 CODE(1)=$0A0D C1500258 CODE(2)=PARNAM(K) C1500259 CODE(3)=$3D20 C1500260 LNGO=3 C1500261C C1500262C DISPLAY NEXT PARAMETER-IDENT C1500263C C1500264 90 CALL WTREAD (LUNIT,NOCUR,CODE,LNGO,NOCUR,DUMMY,ZRO,TC) C1500265C C1500266 PARID=IP C1500267+ INDEX IN PARNAM-TABLE C1500268 IFND(I)=1 C1500269+ SET FOUND FLAG C1500270 IP=IP+1 C1500271+ INCR. INDEX TO PPTEMP C1500272 MORPAR=1 C1500273+ SET INDICATOR FOR MORE PARAMETERS NEEDED C1500274 GO TO 120 C1500275C C1500276ÐÐC END OF PARAMETER LIST, ISSUE FM-REQUEST C1500277C C1500278 100 MORPAR=0 C1500279 GO TO 320 C1500280C C1500281C PROMPTING LEVEL = -1, NO PROMPTING DONE C1500282C C1500283 110 IF(MORLIN)115,130,130 C1500284+ DO WE NEED TO READ MORE LINES C1500285 115 MORLIN=0 C1500286C C1500287C READ NEXT LINE C1500288C C1500289 120 CALL WTREAD (LUNIT,NOCUR,DUMMY,ZRO,NOCUR,INBUF,BUFLEN,TC) C1500290C C1500291C RESET SWORD AND SBYTE C1500292C C1500293 SBYTE=0 C1500294 SWORD=0 C1500295C C1500296 130 CALL GETFLD (INBUF,CODE,SWORD,SBYTE,STAT) C1500297C C1500298 140 IF (STAT-2)150,160,200 C1500299 150 IF (STAT-1)260,250,250 C1500300C C1500301ÐÐC EOL DETECTED,COUNT NO OF REQUIRED AND NOT FOUND PARAMETERS (STATUS=1)C1500302C C1500303 160 IF(PIND)161,162,162 C1500304 161 MORPAR=0 C1500305C C1500306C CHECK IF FULL NAME DESIRED C1500307C C1500308 162 IF (CODE(1)-QUEST)164,163,164 C1500309C C1500310C YES,FULL NAME FOR THIS PARAMETER ONLY C1500311C C1500312 163 IF (PIND .NE. -1) IP=IP-1 C1500313 GO TO 40 C1500314C C1500315C CHECK IF PARAMETER ENTERED C1500316C C1500317 164 IF(CODE(1)-BLANK)270,165,270 C1500318 165 IFND(IP-1)=0 C1500319 IF (PIND .EQ. -1) GO TO 320 C1500320 GO TO 35 C1500321C C1500322C PARAMETER-ID FOUND (STATUS=3) C1500323C C1500324 200 I=1 C1500325 210 K=IPNAM(I) C1500326ÐÐ K=(K-1)*3+1 C1500327C C1500328 IF (CODE(1)-PARNAM(K))230,220,230 C1500329C C1500330C PARAMETER-ID CORRESPONDS WITH PARAM.MNEMONIC TABLE C1500331C C1500332 220 PARID=I C1500333 IFND(I)=1 C1500334 GO TO 130 C1500335C C1500336 230 I=I+1 C1500337+ NO MATCH,CONTINUE C1500338 IF(IPNAM(I))210,240,210 C1500339C C1500340 240 INDEX=39 C1500341+ 39 PARAMETER ILLEGAL OR MISSING C1500342 GO TO 9999 C1500343C C1500344C FIELD TERMINATED ON A SEMI-COLON (STATUS=1) C1500345C C1500346 250 MORLIN=-1 C1500347+ SET INDICATOR TO READ MORE LINES C1500348C C1500349C FIELD TERMINATED ON A COMMA (STATUS=0) C1500350C C1500351ÐÐ 260 MORPAR=1 C1500352+ SET INDICATOR FOR MORE PARAMETERS C1500353 IF(CODE(1) .NE. BLANK)GO TO 270 C1500354 IFND(IP)=0 C1500355 IP=IP+1 C1500356 GO TO 35 C1500357C C1500358C STORE PARAMETER VALUES INTO REQUIRED LOCATIONS C1500359C C1500360 270 IF (PARID)290,290,280 C1500361+ PARAMETER-ID FOUND C1500362 280 I=PARID C1500363+ YES C1500364 GO TO 300 C1500365C C1500366 290 I=IP C1500367 IF (CODE(1) .NE. BLANK) IFND(I)=1 C1500368 IP=IP+1 C1500369C C1500370 300 I=(IPNAM(I)-1)*3+1 C1500371C C1500372 LNGO=PARNAM(I+1) C1500373 OUTP=PARNAM(I+2) C1500374C C1500375C STORE INTO DESIGNATED OUTPUT FIELD C1500376ÐÐC C1500377 CALL MOVEL (CODE,OUTP,LNGO) C1500378C C1500379 PARID=0 C1500380 IF(MORPAR)310,320,310 C1500381+ ARE THERE MORE PARAM TO BE PROCESSED C1500382 310 IF(PIND)110,70,40 C1500383+ YES C1500384C C1500385C C1500386C ARE ALL REQUIRED PARAMETERS FOUND ? C1500387C C1500388 320 I=0 C1500389 330 I=I+1 C1500390 IF(PPTEMP(I))330,360,340 C1500391C C1500392C PARAMETER NOT FOUND,IS IT REQUIRED ? C1500393C C1500394 340 IF(IREQ(I))330,350,330 C1500395C C1500396C YES IT IS REQUIRED C1500397C C1500398 350 PARNUM=PARNUM+1 C1500399 GO TO 330 C1500400C C1500401ÐÐC END OF PPTAB C1500402C C1500403 360 IF(PARNUM)240,400,240 C1500404+ ARE ALL REQUIRED PARAMETERS FOUND C1500405C C1500406C C1500407C C1500408C CHECK WHICH OUTPUT MODE IS SELECTED C1500409C C1500410 400 CONTINUE C1500411 DO 402 I = 1 , 3 C1500412 IF (DUMMY( 6) .EQ. KARAEH( I) ) GO TO 404 C1500413 402 CONTINUE C1500414 GO TO 8230 C1500415C C1500416C SAVE MODE CODE C1500417C C1500418 404 CONTINUE C1500419 IP = I C1500420C C1500421C C1500422C STORE FCB-ADDR IN REQBUF C1500423C C1500424 ASSEM $C000,+FCBHDR C1500425+ LDA =XFCBHDR C1500426ÐÐ ASSEM $6400,+REQBUF(10) C1500427+ STA REQBUF+9 C1500428C C1500429 REQBUF(13)=96 C1500430+ SET TO READ FULL LENGTH FCB C1500431C C1500432 IDATA(13)=0 C1500433+ THESE SETTINGS ARE REQUIRED BY OPENFL C1500434 IDATA(14)=1 C1500435 IDATA(15)=0 C1500436 CALL TODAY (ITEMP) C1500437. C1500438 CALL OPENFL (REQBUF,IDATA,ISTAT) C1500439C C1500440 IF (ISTAT) 8000,410,410 C1500441C C1500442 410 IVOLNM=IDATA(9) C1500443 IDATA(9)=0 C1500444C C1500445 CALL GETFCB (REQBUF,IDATA(9),INDEX,FCBBUF,ISTAT) C1500446C C1500447 IF (IOUT-1) 420,8000,8000 C1500448 420 IF (ISTAT) 8000,430,430 C1500449C C1500450 430 CALL CLOSFL (REQBUF,ISTAT) C1500451ÐÐC C1500452 IF (ISTAT) 8000,440,440 C1500453C C1500454 440 IF (RECLEN .GT. 256) GO TO 8210 C1500455 IDATA(9)=IVOLNM C1500456 IF(RECLEN .LT. 40) IMAX=RECLEN C1500457C C1500458 450 IF (RECLEN .GT. 40) MULLEN =-1 C1500459C C1500460C RECORD CAN BE CONTAINED ON ONE PRINT LINE C1500461C C1500462 455 REQBUF(13)=96 C1500463 IDATA(13)=0 C1500464 IDATA(14)=1 C1500465 IDATA(15)=0 C1500466C C1500467 CALL OPENFL (REQBUF,IDATA,ISTAT) C1500468 IF(ISTAT) 8000,500,500 C1500469C C1500470C GET LOGICAL UNT NO C1500471C C1500472 500 IF(DUMMY(1) .NE. 2HTE .AND. NOPORT .EQ. $0) GO TO 510 C1500473C C1500474 DO 505 I=1,4 C1500475 DUMMY(I)=IODEF(I) C1500476ÐÐ 505 CONTINUE C1500477C C1500478 510 CALL LUNEQ (DUMMY,LOGUNT) C1500479 IF ( AND($8000,LOGUNT) .EQ. $8000) GO TO 8200 C1500480C C1500481C PRINT HEADER LINE CONTAINING THE FILE NAME C1500482C C1500483 515 ASSEM $C800,LOGUNT C1500484 ASSEM $A03F C1500485 ASSEM $B02F C1500486 ASSEM $6800,LOGUNT C1500487 IF (LOGUNT .EQ. LUNIT) CALL CLRSCR(LUNIT) C1500488C ************************************************************* 122*4869C1500489C C1500490C CHECK IF RECORD NUMBERS ARE REQUIRED ON OUTPUT C1500491C C1500492 IF(DUMMY(5) .EQ. 2HU ) GO TO 520 C1500493C ************************************************************* 122*4869C1500494C C1500495C INSERT FILE NAME, OWNER NAME AND DATE C1500496C C1500497 CALL RIGJST(NAME12( 1),MES1(10), 8) C1500498 MES1(23) = OWNR12( 1) C1500499 MES1(24) = OWNR12( 2) C1500500 MES1(25) = OWNR12( 3) C1500501ÐÐ MES1(26) = OWNR12( 4) C1500502C DATE C1500503 MES1(31) = ITEMP( 1) C1500504 MES1(35) = ITEMP( 2) C1500505 MES1(39) = ITEMP( 3) C1500506 CALL TOWT(LOGUNT,MES1( 1),M1SZ) C1500507 LINCNT=LINCNT+1 C1500508C C1500509C C1500510C GET RECORD SEQUENTIALLY FROM FILE C1500511C C1500512 520 IF (LINCNT .GT. 18) GO TO 3000 C1500513C C1500514 525 CALL GETS (REQBUF,RECBUF,KEYVAL,ISTAT) C1500515C *****************************************************'******* 122*4862C1500516 IF (ISTAT .GE. 0) GO TO 527 C1500517C C1500518C** CHECK IF EOF C1500519C C1500520 IF ( AND($0100, ISTAT) .NE. 0) GO TO 9000 C1500521 GO TO 8000 C1500522 527 IF (IDEL.NE.0) GO TO 520 C1500523C ************************************************************* 122*4862C1500524 IF(RECBUF(1) .EQ. IFMEOF) GO TO 9000 C1500525C C1500526ÐÐ 530 IRCNT=IRCNT+1 C1500527C C1500528C GO BY MODE A E H C1500529C C1500530 IF (IP-2) 535 , 2000 , 1000 C1500531C C1500532C ************************************************************* 122*4869C1500533 535 IF(DUMMY(5) .EQ. 2HU ) GO TO 4000 C1500534 IF(DUMMY(1) .EQ. 2HTE) GO TO 536 C1500535C ************************************************************* 122*4869C1500536C C1500537C ASSEMBLE RECORD NUMBER AS HEADING AND INSERT DATA (WITH LINE FEED AND C1500538C 1 SPACE CODE) C1500539C C1500540 JUMP = 1 C1500541 GO TO 537 C1500542C C1500543C MODE = 'TE' (WITHOUT LINE FEED AND SPACE CODE) C1500544C C1500545 536 CONTINUE C1500546 JUMP = 2 C1500547 537 CONTINUE C1500548 CALL RDNP(IRCNT,LOGUNT,JUMP) C1500549C C1500550C FILL DATA BUFFER WITH SPACE CODES PRIOR TO MOVE OUTPUT DATA IN IT C1500551ÐÐC C1500552 CALL FL2SP(MES2( 1), M2SZ) C1500553 IF (JUMP .EQ. 1) GO TO 539 C1500554 I = 1 C1500555 DO 538 LOOP = IS , IMAX C1500556 MES2(I) = RECBUF(LOOP) C1500557 I = I + 1 C1500558 538 CONTINUE C1500559 GO TO 545 C1500560C C1500561 539 CONTINUE C1500562 CALL RIGJST(RECBUF(IS), MES2( 1), 2*(IMAX-IS+1) ) C1500563 545 CONTINUE C1500564 CALL TOWT(LOGUNT, MES2( 1), M2SZ) C1500565 LINCNT = LINCNT + 3 C1500566C C1500567 IF(MULLEN .EQ. -1) GOTO 540 C1500568 GO TO 520 C1500569C C1500570C MULTIPLE LINES PER RECORD C1500571C C1500572 540 IS=IS+40 C1500573 IF (IMAX .EQ. RECLEN) GO TO 570 C1500574 IMAX=IMAX+40 C1500575 IF(IMAX .GT. RECLEN) IMAX=RECLEN C1500576ÐÐC C1500577C C1500578C C1500579C MOVE MESSAGE TO OUTPUT BUFFER C1500580C C1500581 CALL FL2SP(MES2( 1), M2SZ) C1500582 CALL RIGJST(RECBUF(IS), MES2( 1), 2*(IMAX-IS+1) ) C1500583 CALL TOWT(LOGUNT,MES2( 1),M2SZ) C1500584 LINCNT=LINCNT+1 C1500585C C1500586 IF (IMAX .EQ. RECLEN) GO TO 560 C1500587C C1500588 550 GO TO 540 C1500589C C1500590 560 IMAX=40 C1500591 570 IS=1 C1500592 GO TO 520 C1500593C C1500594C HEXA-DECIMAL DUMP REQUIRED C1500595C C1500596C C1500597C ASSEMBLE RECORD NUMBER AND PRINT C1500598C C1500599 1000 CONTINUE C1500600 JUMP = 1 C1500601ÐÐ CALL RDNP(IRCNT,LOGUNT,0) C1500602 1002 CONTINUE C1500603C C1500604C TO ASSEMBLE HEX-DECIMAL DATA FOR DUMP (2 LINES) C1500605C C1500606 LSTART = IS C1500607 1005 CONTINUE C1500608 LPNTSZ = IMAX - (LSTART - 1) C1500609 IF (LPNTSZ .GT. 20) LPNTSZ = 20 C1500610 CALL FL2SP(MES2( 1), 51) C1500611 CALL FLHXLR( MES2( 1), RECBUF(LSTART), LPNTSZ) C1500612 CALL TOWT( LOGUNT, MES2( 1), 51) C1500613 LSTART = LSTART + LPNTSZ C1500614 IF (LSTART .LT . IMAX) GO TO 1005 C1500615 GO TO (1007, 1015) , JUMP C1500616 1007 CONTINUE C1500617 LINCNT=LINCNT+5 C1500618 IF (MULLEN .EQ. -1) GO TO 1010 C1500619 GO TO 520 C1500620C C1500621 1010 IS=IS+40 C1500622 IMAX=IMAX+40 C1500623 IF (IMAX .GT. RECLEN) IMAX=RECLEN C1500624C C1500625 JUMP = 2 C1500626ÐÐ GO TO 1002 C1500627 1015 CONTINUE C1500628 LINCNT=LINCNT+2 C1500629C C1500630 IF (IMAX .EQ. RECLEN) GO TO 1030 C1500631 1020 GO TO 1010 C1500632C C1500633 1030 IS=1 C1500634+ RESET PRINT PARAMETERS C1500635 IMAX=40 C1500636 GO TO 520 C1500637C C1500638C EBCDIC CONVERSION REQUIRED C1500639C C1500640C ************************************************************* 139*A038C1500641 2000 ASEBSW = 0 C1500642C ************************************************************* 139*A038C1500643C C1500644 CALL ASCEBC (RECBUF,ASEBSW,RECLEN) C1500645C C1500646 GO TO 535 C1500647C C1500648C C1500649 3000 IF (DUMMY(1) .NE. 2HTE) GO TO 3010 C1500650C C1500651ÐÐ CALL WTREAD (LUNIT,NOCUR,MSGPAU,LPAUSE,NOCUR,INBUF,BUFLEN,TC) C1500652 CALL CLRSCR(LUNIT) C1500653C C1500654 3010 LINCNT=0 C1500655 GO TO 525 C1500656C ************************************************************* 122*4869C1500657C C1500658C UNFORMATTED OUTPUT (NO HDR LINE AND RECORD NUMBERS ARE OUTPUT) C1500659C C1500660 4000 CONTINUE C1500661 CALL FL2SP( MES258( 1), M258Z) C1500662C C1500663C ** MOVE DATA TO OUTPUT BUFFER C1500664C C1500665 DO 4050 LOOP = 1 , RECLEN C1500666 MES258(LOOP) = RECBUF(LOOP) C1500667 4050 CONTINUE C1500668 MES258(LOOP) = $0D0A C1500669 CALL TOWT( LOGUNT, MES258( 1), LOOP) C1500670 LINCNT=LINCNT+2 C1500671 GO TO 520 C1500672C ************************************************************* 122*4869C1500673. C1500674C C1500675C FM-REQUEST TERMINATED WITH AN ERROR C1500676ÐÐC C1500677 8000 CALL ERCHK(ISTAT,REQBUF(4)) C1500678 GO TO 9994 C1500679C C1500680 8200 INDEX=63 C1500681+ 63 INVALID SYSTEM PERIPHERAL NAME C1500682 GO TO 9999 C1500683C C1500684 8210 INDEX=64 C1500685+ 64 RECORD LENGTH TOO LARGE FOR THIS COMMAC1500686 GO TO 9999 C1500687C C1500688 8230 INDEX=69 C1500689+ 69 ILLEGAL PARAMETER C1500690 GO TO 9999 C1500691C C1500692C ERROR ROUTINE C1500693C C1500694 9999 CALL SYSMSG (INDEX,ERBUF) C1500695C C1500696 9994 IF (PIND) 9995,9995,11 C1500697 9995 IF (MODE) 9996,9998,9996 C1500698 9996 ASSEM $E400,+MODE C1500699 ASSEM $D622 C1500700C C1500701ÐÐ 9998 CALL CLOSFL (REQBUF,ISTAT) C1500702C C1500703 9997 RETURN C1500704C C1500705C WRITE EOF C1500706C C1500707 9000 CONTINUE C1500708 CALL GENEOF(LOGUNT) C1500709 GO TO 9998 C1500710 END C1500711 SUBROUTINE CLRSCR(LUNIT) C1600001 1 /C16 F ITOS CCS 3.0 SL-149C1600002C CLEAR SCREEN ROUTINE C1600003C CREDIT COLLECTION SYSTEM VERSION 3.0 C1600004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C1600005C COPYRIGHT CONTROL DATA CORPORATION 1979 C1600006C C1600007C C1600008C THIS ROUTINE CLEARS THE SCREEN OF LUNIT C1600009C C1600010 INTEGER CLRBUF,DUM,ZRO,TC C1600011C NOTE - CLEAR SCREEN CHARACTER MUST BE FIRST CHAR. IN BUFFER. C1600012 DATA CLRBUF/$180D/ C1600013 DATA LENCLR/1/,ZRO/0/ C1600014 DATA NOCUR/-1/ C1600015ÐÐC C1600016 CALL WTREAD (LUNIT,NOCUR,CLRBUF,LENCLR,NOCUR,DUM,ZRO,TC) C1600017 RETURN C1600018 END C1600019 SUBROUTINE RENAM C1700001 1 /C17 F ITOS CCS 3.0 SL-149C1700002C COMMAND PROCESSOR FOR RENAME C1700003C ************************************************************* 122*4571C1700004C CREDIT COLLECTION SYSTEM VERSION 3.0 C1700005C ************************************************************* 122*4571C1700006C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C1700007C COPYRIGHT CONTROL DATA CORPORATION 1979 C1700008C C1700009C C1700010C FUNCTION C1700011C C1700012C THIS IS THE REQUEST PROCESSOR FOR THE FILE-MANAGER UTILITY C1700013C ITS PURPOSE IS TO RENAME ALL SPACE ON MASS-STORAGE HELD BY C1700014C THE SPECIFIED FILE. C1700015C C1700016C GENERAL DESCRIPTION C1700017C C1700018C UPON ENTRY THE PARAMETER PROCESSING TABLE(PPRENA) IS COPIED C1700019C INTO A TEMPORARILY TABLE(PPTEMP) C1700020C REQBUF IS INITIALIZED TO ALL ZEROES C1700021ÐÐC IDATA IS COPIED FROM THE DEFAULT TABLE (PARDEF) C1700022C NEXT A CHECK IS DONE WHICH PROMPTING LEVEL (PIND) IS REQUIRED C1700023C C1700024C COMMAND FORMAT C1700025C C1700026C RENAME,FN=AAAAAAAA,VL=VVVVVVVV,NF=NNNNNNNN,ED=EEEEEE C1700027C C1700028C RENAME,AAAAAAAA,VVVVVVVV,NNNNNNNN,EEEEEE C1700029C C1700030C RENAME,EEEEEE C1700031C C1700032C C1700033M FMUCOM C1700034C C1700035 INTEGER BUFLEN,TC,ZRO,OUTP C1700036 INTEGER BLANK,ERBUF C1700037 INTEGER PARNUM,STATUS,PARID C1700038 INTEGER OPN,WVL C1700039 INTEGER PPTAB(5) C1700040 INTEGER STAT,VOLNAM(4) C1700041C C1700042 INTEGER PPTEMP(17) C1700043 INTEGER IPNAM(17) C1700044 INTEGER IJUST(17) C1700045 INTEGER ICONV(17) C1700046ÐÐ INTEGER IREQ(17) C1700047 INTEGER IFND(17) C1700048 INTEGER QUEST,PPRENA,EXPFLG,EXPDAT,RENFLG C1700049 INTEGER FCBTEM(3) C1700050C C1700051 BYTE (IPNAM,PPTEMP(7=0)) C1700052 BYTE (IJUST,PPTEMP(8=8)) C1700053 BYTE (ICONV,PPTEMP(10=9)) C1700054 BYTE (IREQ,PPTEMP(12=12)) C1700055 BYTE (IFND,PPTEMP(15=15)) C1700056C C1700057 DIMENSION NAME(24) C1700058 DIMENSION NR(4),EXPDAT(3) C1700059 DIMENSION NEWRAY(8),NEWNAM(4),NEWOWN(4) C1700060C C1700061 BYTE(OPN,ISTAT(0=0)) C1700062 BYTE(NFD,ISTAT(1=1)) C1700063 BYTE(MME,ISTAT(5=5)) C1700064 BYTE(WVL,ISTAT(13=13)) C1700065 BYTE(ILR,ISTAT(14=14)) C1700066 BYTE (ICHAR,CODE(1)(15=8)) C1700067* C1700068 EQUIVALENCE (PPRENA,PPTAB) C1700069 EQUIVALENCE(NEWRAY,NEWNAM) C1700070 EQUIVALENCE(NEWRAY(5),NEWOWN(1)) C1700071ÐÐ* C1700072C FILE CONTROL BLOCK . . . . C1700073C C1700074 EQUIVALENCE (EXPDAT(1),FCBBUF(89)) C1700075C C1700076 DATA NAME/'FILE-NAME =VOLUME-NAME=NEW FIL-NAM=NEW EXPDATE='/ C1700077 DATA BUFLEN/40/ C1700078 DATA BLANK/$2020/ C1700079 DATA QUEST/'? '/ C1700080 DATA ZRO/0/,NOCUR/-1/ C1700081 DATA NEWOWN/' '/ C1700082C C1700083C EXTERNALS C1700084C C1700085 EXTERNAL WTREAD C1700086 EXTERNAL GETFLD C1700087 EXTERNAL ITSERR C1700088 EXTERNAL MOVEL C1700089 EXTERNAL MOVER C1700090 EXTERNAL GETFCB C1700091 EXTERNAL TODAY C1700092 EXTERNAL ERPROC C1700093 EXTERNAL RENAME C1700094C C1700095C INITIALISATION C1700096ÐÐC C1700097 11 INDEX=0 C1700098+ ERROR MSG NO. C1700099 ERBUF=0 C1700100+ ERROR MSG BUF C1700101 ISTAT=0 C1700102+ STATUS OF FM-REQUEST C1700103 LNGO=0 C1700104+ LENGTH OF FIELD TO MOVE C1700105 MORPAR=0 C1700106+ INDICATOR IF MORE PARAMETERS NEEDED C1700107 MORLIN=0 C1700108+ INDICATOR IF MORE LINES NEED TO BE READ C1700109 PARNUM=0 C1700110+ COUNT OF REQ.AND NOT FOUND PARAMETERS C1700111 IP=1 C1700112 PARID=0 C1700113 NAMFLG=0 C1700114+ NAME FLAG (0=CURRENT, 1=NEW) C1700115 EXPFLG=0 C1700116 NEWFLG=0 C1700117+ EXP.DATE FLAG (0=USE OLD, 1=NEW) C1700118 IINTRP=0 C1700119 ASSIGN 9998 TO INTLOC C1700120 CALL PGMINT(INTLOC,IINTRP) C1700121ÐÐC C1700122C COPY THE PARAMETER PROCESSING TABLE C1700123C C1700124 I=0 C1700125 10 I=I+1 C1700126 PPTEMP(I)=PPTAB(I) C1700127 IF(PPTEMP(I))10,20,10 C1700128C C1700129C C1700130C C1700131 20 DO 30 I=1,24 C1700132 REQBUF(I)=0 C1700133 IDATA(I)=PARDEF(I) C1700134 30 CONTINUE C1700135C C1700136 35 IF(PIND)110,70,40 C1700137C C1700138C PROMPTING LEVEL = 1 FULL PARAMETERS WILL BE DISPLAYED C1700139C C1700140 40 KI=IP C1700141 I=(IP-1)*6+1 C1700142 IF(IPNAM(IP))50,100,50 C1700143C C1700144 50 J=I+5 C1700145 K=1 C1700146ÐÐ CODE(K)=$0A0D C1700147+ SET CR/LF C1700148 DO 60 I=I,J C1700149 K=K+1 C1700150 CODE(K)=NAME(I) C1700151 60 CONTINUE C1700152C C1700153 I=KI C1700154 LNGO=7 C1700155 GO TO 90 C1700156C C1700157C PROMPTING LEVEL = 0 PARAMETER ABBREVIATIONS WILL BE DISPLAYED C1700158C C1700159 70 I=IP C1700160 K=IPNAM(IP) C1700161+ INDEX TO PARAM.MNEM.TABLE C1700162 IF(K)80,100,80 C1700163 80 K=(K-1)*3+1 C1700164C C1700165 CODE(1)=$0A0D C1700166 CODE(2)=PARNAM(K) C1700167 CODE(3)=$3D20 C1700168 LNGO=3 C1700169C C1700170C DISPLAY NEXT PARAMETER-IDENT C1700171ÐÐC C1700172 90 CALL WTREAD (LUNIT,NOCUR,CODE,LNGO,NOCUR,DUMMY,ZRO,TC) C1700173C C1700174 PARID=IP C1700175+ INDEX IN PARNAM-TABLE C1700176 IFND(I)=1 C1700177+ SET FOUND FLAG C1700178 IP=IP+1 C1700179+ INCR. INDEX TO PPTEMP C1700180 MORPAR=1 C1700181+ SET INDICATOR FOR MORE PARAMETERS NEEDED C1700182 GO TO 120 C1700183C C1700184C END OF PARAMETER LIST, ISSUE FM-REQUEST C1700185C C1700186 100 MORPAR=0 C1700187 GO TO 320 C1700188C C1700189C PROMPTING LEVEL = -1, NO PROMPTING DONE C1700190C C1700191 110 IF(MORLIN)115,130,130 C1700192+ DO WE NEED TO READ MORE LINES C1700193 115 MORLIN=0 C1700194C C1700195C READ NEXT LINE C1700196ÐÐC C1700197 120 CALL WTREAD (LUNIT,NOCUR,DUMMY,ZRO,NOCUR,INBUF,BUFLEN,TC) C1700198C C1700199C RESET SWORD AND SBYTE C1700200C C1700201 SBYTE=0 C1700202 SWORD=0 C1700203C C1700204 130 CALL GETFLD (INBUF,CODE,SWORD,SBYTE,STAT) C1700205C C1700206 140 IF (STAT-2)150,160,200 C1700207 150 IF (STAT-1)260,250,250 C1700208C C1700209C EOL DETECTED,COUNT NO OF REQUIRED AND NOT FOUND PARAMETERS (STATUS=1)C1700210C C1700211 160 IF(PIND)161,162,162 C1700212 161 MORPAR=0 C1700213C C1700214C CHECK IF FULL NAME DESIRED C1700215C C1700216 162 IF (CODE(1)-QUEST)164,163,164 C1700217C C1700218C YES,FULL NAME FOR THIS PARAMETER ONLY C1700219C C1700220 163 IF (PIND .NE. -1) IP=IP-1 C1700221ÐÐ GO TO 40 C1700222C C1700223C CHECK IF PARAMETER ENTERED C1700224C C1700225 164 IF(CODE(1)-BLANK)270,165,270 C1700226 165 IFND(IP-1)=0 C1700227 IF (PIND .EQ. -1) GO TO 320 C1700228 GO TO 35 C1700229C C1700230C PARAMETER-ID FOUND (STATUS=3) C1700231C C1700232 200 I=1 C1700233 210 K=IPNAM(I) C1700234 K=(K-1)*3+1 C1700235C C1700236 IF (CODE(1)-PARNAM(K))230,220,230 C1700237C C1700238C PARAMETER-ID CORRESPONDS WITH PARAM.MNEMONIC TABLE C1700239C C1700240 220 PARID=I C1700241 IFND(I)=1 C1700242 GO TO 130 C1700243C C1700244 230 I=I+1 C1700245+ NO MATCH,CONTINUE C1700246ÐÐ IF(IPNAM(I))210,240,210 C1700247C C1700248 240 INDEX=209 C1700249+ PARAMETER ILLEGAL C1700250 GO TO 9999 C1700251C C1700252C FIELD TERMINATED ON A SEMI-COLON (STATUS=1) C1700253C C1700254 250 MORLIN=-1 C1700255+ SET INDICATOR TO READ MORE LINES C1700256C C1700257C FIELD TERMINATED ON A COMMA (STATUS=0) C1700258C C1700259 260 MORPAR=1 C1700260+ SET INDICATOR FOR MORE PARAMETERS C1700261 IF(CODE(1) .NE. BLANK)GO TO 270 C1700262 IFND(IP)=0 C1700263 IP=IP+1 C1700264 GO TO 35 C1700265C C1700266C STORE PARAMETER VALUES INTO REQUIRED LOCATIONS C1700267C C1700268 270 IF (PARID)290,290,280 C1700269+ PARAMETER-ID FOUND C1700270 280 I=PARID C1700271ÐÐ+ YES C1700272 GO TO 300 C1700273C C1700274 290 I=IP C1700275 IF (CODE(1) .NE. BLANK) IFND(I)=1 C1700276 IP=IP+1 C1700277C C1700278 300 IPNAMI=IPNAM(I) C1700279+ SAVE PARAMETER ORDINAL C1700280 I=(IPNAM(I)-1)*3+1 C1700281+ CALCULATE SUBSCRIPT INTO MNEMONIC TABLE C1700282C C1700283 LNGO=PARNAM(I+1) C1700284 OUTP=PARNAM(I+2) C1700285C C1700286C GET ADDRESS OF TEMP STORAGE FOR NEW NAME. C1700287C C1700288 ASSEM $C000,+NEWNAM C1700289 ASSEM $6800,NEWADR C1700290C C1700291C C1700292C C1700293C STORE INTO DESIGNATED OUTPUT FIELD C1700294C C1700295 305 IF(NAMFLG.EQ.0.AND.IPNAMI.EQ.1)GO TO 306 C1700296ÐÐ+ CHECK FOR CURRENT NAME C1700297 IF(IPNAMI.EQ.3)GO TO 308 C1700298+ CHECK FOR VOLUME-LABEL C1700299 IF(IPNAMI.EQ.23)GO TO 309 C1700300+ CHECK FOR NEW NAME C1700301 IF(IPNAMI.EQ.6)GO TO 310 C1700302+ CHECK FOR EXPIRE DATE C1700303 INDEX=239 C1700304+ ILLEGAL PARAMETER C1700305 GO TO 910 C1700306 306 NAMFLG=1 C1700307 308 CALL MOVEL(CODE,OUTP,LNGO) C1700308 GO TO 316 C1700309 309 CALL MOVEL(CODE,NEWADR,LNGO) C1700310 NEWFLG=1 C1700311+ SET FLAG FOR NEW NAME ENTERED C1700312 GO TO 316 C1700313 310 EXPFLG=1 C1700314+ SET FLAG SHOWING EXPIRE DATE ENTERED C1700315 CALL MOVER(CODE,LNGO,OUTP,LNGO) C1700316C C1700317. C1700318C CHECK EXPIRE DATE FOR LEGAL LIMITS(DATE GE TODAY, MONTH C1700319C LE 12, DAY LE 31; EXCEPTION - 999999 PERMISSIBLE) C1700320C C1700321ÐÐ CALL TODAY(FCBTEM) C1700322 IF(CODE(3).LT.FCBTEM(3))GO TO 900 C1700323 IF(CODE(3).GT.FCBTEM(3))GO TO 312 C1700324C EXPIRE DATE IS THIS YEAR C1700325 IF(CODE(1).GT.$3132.OR.CODE(1).LT.FCBTEM(1))GO TO 311 C1700326 IF(CODE(1).GT.FCBTEM(1))GO TO 312 C1700327C EXPIRE DATE IS THIS MONTH C1700328 IF(CODE(2).GT.$3331.OR.CODE(2).LT.FCBTEM(2))GO TO 311 C1700329 GO TO 316 C1700330C AT THIS POINT,ONLY 999999 IS ACCEPTABLE C1700331 311 IF(CODE(1).NE.$3939.OR.CODE(2).NE.$3939.OR.CODE(3).NE.$3939) C1700332 1GO TO 900 C1700333 GO TO 316 C1700334C NOW VERIFY MONTH, DAY FOR MAX VALUES C1700335 312 IF(CODE(1).LE.$3132.AND.CODE(1).GE.$3031.AND.CODE(2).LE.$3331.AND.C1700336 1CODE(2).GE.$3031)GO TO 316 C1700337 GO TO 311 C1700338C C1700339 316 PARID=0 C1700340C C1700341 IF(MORPAR)318,320,318 C1700342+ ARE THERE MORE PARAM TO BE PROCESSED C1700343 318 IF(PIND)110,70,40 C1700344+ YES C1700345C C1700346ÐÐC ARE ALL REQUIRED PARAMETERS FOUND ? C1700347C C1700348 320 I=0 C1700349 330 I=I+1 C1700350 IF(PPTEMP(I))330,360,340 C1700351C C1700352C PARAMETER NOT FOUND,IS IT REQUIRED ? C1700353C C1700354 340 IF(IREQ(I))330,350,330 C1700355C C1700356C YES IT IS REQUIRED C1700357C C1700358 350 PARNUM=PARNUM+1 C1700359 GO TO 330 C1700360C C1700361C END OF PPTAB C1700362C C1700363 360 IF(PARNUM)240,400,240 C1700364+ ARE ALL REQUIRED PARAMETERS FOUND C1700365C C1700366C C1700367C C1700368 400 IF(EXPFLG)500,1400,1100 C1700369 500 INDEX=240 C1700370+ 240 - INTERNAL UTILITY ERROR C1700371ÐÐ GO TO 9999 C1700372C C1700373C REPORT ERROR AND TEST FOR POSSIBLE RE-PROMPTING C1700374C C1700375 900 INDEX=222 C1700376+ 222 - PARAMETER ENTRY ERROR C1700377 910 CALL SYSMSG(INDEX,ERBUF) C1700378 IF(MODE.NE.0.AND.MODE.NE.$1000)GO TO 9996 C1700379+ CHECK FOR INTERACTIVE C1700380 IF(PIND.EQ.-1)GO TO 9998 C1700381+ CHECK FOR NO PROMPTING C1700382 IP=IP-1 C1700383 GO TO 35 C1700384C C1700385C C1700386C RENAME THE FILE C1700387C C1700388 1000 NEWFLG=0 C1700389C ************************************************************* 122*4571C1700390C PUT THE USER ID INTO THE RENAME BUFFER C1700391 DO 1001 I=1,4 C1700392 NEWOWN(I)=IDUSER(I) C1700393 1001 CONTINUE C1700394C ************************************************************* 122*4571C1700395 CALL RENAME(REQBUF,IDATA,NEWNAM,ISTAT) C1700396ÐÐ IF(ISTAT)1010,1400,1400 C1700397 1010 CALL ERCHK(ISTAT,REQBUF(4)) C1700398 GO TO 9999 C1700399 1100 IREQ10=REQBUF(10) C1700400 DO 1110 I=1,24 C1700401 REQBUF(I)=0 C1700402 1110 CONTINUE C1700403 REQBUF(10)=IREQ10 C1700404+ SAVE NO. OF RECORDS FOR LATER C1700405 IDATA(13)=0 C1700406 IDATA(14)=1 C1700407 IDATA(15)=0 C1700408. C1700409 CALL OPENFL(REQBUF,IDATA,ISTAT) C1700410 IF(ISTAT)1120,1200,1200 C1700411 1120 CALL ERCHK(ISTAT,REQBUF(4)) C1700412 GO TO 9999 C1700413 1200 VOLNAM(1)=0 C1700414 FCBTEM(1)=EXPDAT(1) C1700415+ SAVE EXPIRE DATE C1700416 FCBTEM(2)=EXPDAT(2) C1700417 FCBTEM(3)=EXPDAT(3) C1700418C C1700419 CALL GETFCB(REQBUF,VOLNAM,INDEX,FCBBUF,ISTAT) C1700420 IF(ISTAT)1210,1250,1250 C1700421ÐÐ 1210 CALL ERCHK(ISTAT,REQBUF(4)) C1700422 GO TO 9999 C1700423C C1700424C UPDATE FCB C1700425C C1700426 1250 EXPDAT(1)=FCBTEM(1) C1700427+ RESTORE EXPIRE DATE C1700428 EXPDAT(2)=FCBTEM(2) C1700429 EXPDAT(3)=FCBTEM(3) C1700430 CALL UPDFCB(REQBUF,VOLNAM,INDEX,FCBBUF,ISTAT) C1700431 IF(ISTAT)1260,1300,1300 C1700432 1260 CALL ERCHK(ISTAT,REQBUF(4)) C1700433 GO TO 9999 C1700434 1300 CALL CLOSFL(REQBUF,ISTAT) C1700435 IF(ISTAT)1320,1400,1400 C1700436 1320 CALL ERCHK(ISTAT,REQBUF(4)) C1700437 GO TO 9999 C1700438 1400 IF(NEWFLG)500,1401,1000 C1700439+ CHECK WHETHER RENAME REQUIRED C1700440 1401 RETURN C1700441+ ALL DONE C1700442C C1700443C ERROR ROUTINE C1700444C C1700445 9999 IF(PIND)9995,9995,11 C1700446ÐÐ 9995 IF(MODE)9996,9998,9996 C1700447 9996 ASSEM $E400,+MODE C1700448 ASSEM $D622 C1700449C C1700450 9998 CALL CLOSFL(REQBUF,ISTAT) C1700451+ CLOSE FILE FOR SAFETY C1700452 RETURN C1700453 END C1700454 SUBROUTINE MOUNT C1800001 1 /C18 F ITOS CCS 3.0 SL-149C1800002C COMMAND PROCESSOR FOR MOUNT C1800003C CREDIT COLLECTION SYSTEM VERSION 3.0 C1800004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C1800005C COPYRIGHT CONTROL DATA CORPORATION 1979 C1800006C C1800007C*** C1800008C C1800009C FUNCTION C1800010C C1800011C THIS IS THE COMMAND PROCESSOR TO INDICATE THE SYSTEM C1800012C THAT THE VOLUME SPECIFIED IS MOUNTED AND READY ON THE C1800013C SPECIFIED MASS-STORAGE UNIT. C1800014C C1800015C C1800016C GENERAL DESCRIPTION C1800017ÐÐCC ON ENTRY THE PARAMETER PROCESSING TABLE (PPMOUN) IS C1800018C COPIED INTO A TEMPORARILY TABLE(PPTEMP) C1800019C ATER ALL REQUIRED PARAMETERS HAVE BEEN ENTERED IT C1800020C WILL CHECK WHETHER THE DISK NO ENTERED IS LEGAL OR NOT C1800021C IF LEGAL A CALL TO VOLUSE IS DONE TO INDICATE ITOS THAT C1800022C THE VOLUME IS MOUNTED C1800023C OTHERWISE AN ERROR MESSAGE WILL BE DISPLAYED C1800024C C1800025C C1800026C MESSAGES C1800027C C1800028C 47 VOLUME NOT ON SPECIFIED UNIT C1800029C 35 MM I/O ERROR C1800030C 36 DISK UNIT SPECIFIED ALREADY MOUNTED C1800031C 37 FILE REQUEST ILLEGAL C1800032C 86 DISK DRIVE/DISK PACK NOT COMPATIBLE C1800033C C1800034C C1800035C MISCELLANEOUS C1800036C C1800037C THE WORDS PER SECTOR (WPS) IS SET TO 96 C1800038C C1800039C C1800040C C1800041C C1800042ÐÐC COMMAND FORMAT C1800043C C1800044C MOUNT,VL=AAAAAAAA,DK=NN C1800045C OR C1800046C MOUNT,AAAAAAAA,NN C1800047C C1800048C THIS COMMAND IS NOT ALLOWED TO MOUNT THE SYSTEM DISK C1800049C C1800050C C1800051C*** C1800052M FMUCOM C1800053C C1800054 INTEGER NOCUR,ZRO,ERBUF,PARNUM,PARID,PPTEMP(17),PPTAB(17) C1800055 INTEGER BUFLEN,TC,OUTP,BLANK,QUEST,STAT C1800056 INTEGER VITADR C1800057 INTEGER DSK,DSK1,DSK2,VITTAB,WPS C1800058 INTEGER VISLUN,VINAME,VINMBR,VIBMSM,VIBMSL,VILBAM,VILBAL C1800059 INTEGER VIWPS,VIFDDM,VIFDDL,VIMAXF,VICURF,VINFDB,VINXTB,VINOOF C1800060 INTEGER VLNAME C1800061C C1800062 DIMENSION IPNAM(17) C1800063 DIMENSION IJUST(17) C1800064 DIMENSION ICONV(17) C1800065 DIMENSION IREQ(17) C1800066 DIMENSION IFND(17) C1800067ÐÐ DIMENSION NAME(18) C1800068 DIMENSION ITEMP(3) C1800069 DIMENSION VITTAB(96),LABEL(96) C1800070 DIMENSION VINAME(4) C1800071 DIMENSION VLNAME(4) C1800072C C1800073 EQUIVALENCE (VLNAME,LABEL(3)) C1800074 EQUIVALENCE (PPMOUN,PPTAB) C1800075 EQUIVALENCE (DSK,DUMMY(3)) C1800076C C1800077 EQUIVALENCE (VISLUN,VITTAB(1)) C1800078 EQUIVALENCE (VINAME,VITTAB(2)) C1800079 EQUIVALENCE (VINMBR,VITTAB(6)) C1800080 EQUIVALENCE (VIBMSM,VITTAB(7)) C1800081 EQUIVALENCE (VIBMSL,VITTAB(8)) C1800082 EQUIVALENCE (VILBAM,VITTAB(9)) C1800083 EQUIVALENCE (VILBAL,VITTAB(10)) C1800084 EQUIVALENCE (VIWPS,VITTAB(11)) C1800085 EQUIVALENCE (VIFDDM,VITTAB(12)) C1800086 EQUIVALENCE (VIFDDL,VITTAB(13)) C1800087 EQUIVALENCE (VIMAXF,VITTAB(14)) C1800088 EQUIVALENCE (VICURF,VITTAB(15)) C1800089 EQUIVALENCE (VINFDB,VITTAB(16)) C1800090 EQUIVALENCE (VINXTB,VITTAB(17)) C1800091 EQUIVALENCE (VINOOF,VITTAB(18)) C1800092ÐÐC C1800093C EXTERNALS C1800094C C1800095 EXTERNAL WTREAD C1800096 EXTERNAL GETFLD C1800097 EXTERNAL SYSMSG C1800098 EXTERNAL MOVEL C1800099 EXTERNAL MOVER C1800100 EXTERNAL SEKVIT C1800101 EXTERNAL REDLAB C1800102 EXTERNAL NXTVOL C1800103 EXTERNAL GETVIT C1800104 EXTERNAL MMLUTB C1800105C C1800106C C1800107 BYTE (IFND,PPTEMP(15=15)) C1800108 BYTE (IREQ,PPTEMP(12=12)) C1800109 BYTE (ICONV,PPTEMP(10=9)) C1800110 BYTE (IJUST,PPTEMP(8=8)) C1800111 BYTE (IPNAM,PPTEMP(7=0)) C1800112C C1800113 BYTE (IDISM,VISLUN(15=15)) C1800114 BYTE (DSK1,DSK(3=0)) C1800115 BYTE (DSK2,DSK(11=8)) C1800116 BYTE (IWVL,ISTAT(1=1)) C1800117ÐÐ BYTE (MME,ISTAT(5=5)) C1800118 BYTE (IVLM,ISTAT(13=13)) C1800119 BYTE (ILR,ISTAT(14=14)) C1800120C C1800121 DATA NAME/'VOLUME-NAME=MM UNIT NO.= '/ C1800122 DATA NOCUR/-1/,ZRO/0/ C1800123 DATA BUFLEN/40/ C1800124 DATA BLANK/$2020/ C1800125 DATA QUEST/'? '/ C1800126C C1800127C INITIALISATION C1800128C C1800129 11 INDEX=0 C1800130+ ERROR MSG NO. C1800131 ERBUF=0 C1800132+ ERROR MSG BUF C1800133 ISTAT=0 C1800134+ STATUS OF FM-REQUEST C1800135****************************** C1800136 WPS=96 C1800137+ * C1800138****************************** C1800139 LNGO=0 C1800140+ LENGTH OF FIELD TO MOVE C1800141 MORPAR=0 C1800142ÐÐ+ INDICATOR IF MORE PARAMETERS NEEDED C1800143 MORLIN=0 C1800144+ INDICATOR IF MORE LINES NEED TO BE READ C1800145 PARNUM=0 C1800146+ COUNT OF REQ.AND NOT FOUND PARAMETERS C1800147 PARID=0 C1800148 MORFIL=0 C1800149 MMUNIT=0 C1800150 IFLAG=0 C1800151 IP=1 C1800152C C1800153 ASSIGN 9998 TO INTLOC C1800154 CALL PGMINT(INTLOC,IFLAG) C1800155C C1800156C COPY THE PARAMETER PROCESSING TABLE C1800157C C1800158 I=0 C1800159 10 I=I+1 C1800160 PPTEMP(I)=PPTAB(I) C1800161 IF(PPTEMP(I))10,20,10 C1800162C C1800163C C1800164C C1800165 20 DO 30 I=1,24 C1800166 REQBUF(I)=0 C1800167ÐÐ IDATA(I)=PARDEF(I) C1800168 30 CONTINUE C1800169C C1800170 35 IF(PIND)110,70,40 C1800171C C1800172C PROMPTING LEVEL = 1 FULL PARAMETERS WILL BE DISPLAYED C1800173C C1800174 40 KI=IP C1800175 I=(IP-1)*6+1 C1800176 IF(IPNAM(IP))50,100,50 C1800177C C1800178 50 J=I+5 C1800179 K=1 C1800180 CODE(K)=$0A0D C1800181+ SET CR/LF C1800182 DO 60 I=I,J C1800183 K=K+1 C1800184 CODE(K)=NAME(I) C1800185 60 CONTINUE C1800186C C1800187 I=KI C1800188 LNGO=7 C1800189 GO TO 90 C1800190C C1800191C PROMPTING LEVEL = 0 PARAMETER ABBREVIATIONS WILL BE DISPLAYED C1800192ÐÐC C1800193 70 I=IP C1800194 K=IPNAM(IP) C1800195+ INDEX TO PARAM.MNEM.TABLE C1800196 IF(K)80,100,80 C1800197 80 K=(K-1)*3+1 C1800198C C1800199 CODE(1)=$0A0D C1800200 CODE(2)=PARNAM(K) C1800201 CODE(3)=$3D20 C1800202 LNGO=3 C1800203C C1800204C DISPLAY NEXT PARAMETER-IDENT C1800205C C1800206 90 CALL WTREAD (LUNIT,NOCUR,CODE,LNGO,NOCUR,DUMMY,ZRO,TC) C1800207C C1800208 PARID=IP C1800209+ INDEX IN PARNAM-TABLE C1800210 IFND(I)=1 C1800211+ SET FOUND FLAG C1800212 IP=IP+1 C1800213+ INCR. INDEX TO PPTEMP C1800214 MORPAR=1 C1800215+ SET INDICATOR FOR MORE PARAMETERS NEEDED C1800216 GO TO 120 C1800217ÐÐC C1800218C END OF PARAMETER LIST, ISSUE FM-REQUEST C1800219C C1800220 100 MORPAR=0 C1800221 GO TO 320 C1800222C C1800223C PROMPTING LEVEL = -1, NO PROMPTING DONE C1800224C C1800225 110 IF(MORLIN)115,130,130 C1800226+ DO WE NEED TO READ MORE LINES C1800227 115 MORLIN=0 C1800228C C1800229C READ NEXT LINE C1800230C C1800231 120 CALL WTREAD (LUNIT,NOCUR,DUMMY,ZRO,NOCUR,INBUF,BUFLEN,TC) C1800232C C1800233C RESET SWORD AND SBYTE C1800234C C1800235 SBYTE=0 C1800236 SWORD=0 C1800237C C1800238 130 CALL GETFLD (INBUF,CODE,SWORD,SBYTE,STAT) C1800239C C1800240 140 IF (STAT-2)150,160,200 C1800241 150 IF (STAT-1)260,250,250 C1800242ÐÐC C1800243C EOL DETECTED,COUNT NO OF REQUIRED AND NOT FOUND PARAMETERS (STATUS=1)C1800244C C1800245 160 IF(PIND)161,162,162 C1800246 161 MORPAR=0 C1800247C C1800248C CHECK IF FULL NAME DESIRED C1800249C C1800250 162 IF (CODE(1)-QUEST)164,163,164 C1800251C C1800252C YES,FULL NAME FOR THIS PARAMETER ONLY C1800253C C1800254 163 IF (PIND .NE. -1) IP=IP-1 C1800255 GO TO 40 C1800256C C1800257C CHECK IF PARAMETER ENTERED C1800258C C1800259 164 IF(CODE(1)-BLANK)270,165,270 C1800260 165 IFND(IP-1)=0 C1800261 IF (PIND .EQ. -1) GO TO 320 C1800262 GO TO 35 C1800263C C1800264C PARAMETER-ID FOUND (STATUS=3) C1800265C C1800266 200 I=1 C1800267ÐÐ 210 K=IPNAM(I) C1800268 K=(K-1)*3+1 C1800269C C1800270 IF (CODE(1)-PARNAM(K))230,220,230 C1800271C C1800272C PARAMETER-ID CORRESPONDS WITH PARAM.MNEMONIC TABLE C1800273C C1800274 220 PARID=I C1800275 IFND(I)=1 C1800276C ************************************************************* 123*4932C1800277 IP=IP+1 C1800278C ************************************************************* 123*4932C1800279 GO TO 130 C1800280C C1800281 230 I=I+1 C1800282+ NO MATCH,CONTINUE C1800283 IF(IPNAM(I))210,240,210 C1800284C C1800285 240 INDEX=39 C1800286+ PARAMETER ILLEGAL C1800287 GO TO 9999 C1800288C C1800289C FIELD TERMINATED ON A SEMI-COLON (STATUS=1) C1800290C C1800291 250 MORLIN=-1 C1800292ÐÐ+ SET INDICATOR TO READ MORE LINES C1800293C C1800294C FIELD TERMINATED ON A COMMA (STATUS=0) C1800295C C1800296 260 MORPAR=1 C1800297+ SET INDICATOR FOR MORE PARAMETERS C1800298 IF(CODE(1) .NE. BLANK)GO TO 270 C1800299 IFND(IP)=0 C1800300 IP=IP+1 C1800301 GO TO 35 C1800302C C1800303C STORE PARAMETER VALUES INTO REQUIRED LOCATIONS C1800304C C1800305 270 IF (PARID)290,290,280 C1800306+ PARAMETER-ID FOUND C1800307 280 I=PARID C1800308+ YES C1800309 GO TO 300 C1800310C C1800311 290 I=IP C1800312 IF (CODE(1) .NE. BLANK) IFND(I)=1 C1800313 IP=IP+1 C1800314C C1800315 300 I=(IPNAM(I)-1)*3+1 C1800316C C1800317ÐÐ LNGO=PARNAM(I+1) C1800318 OUTP=PARNAM(I+2) C1800319C C1800320C STORE INTO DESIGNATED OUTPUT FIELD C1800321C C1800322 IF(ICONV(IP-1)-1) 302,304,302 C1800323C C1800324 302 CALL MOVEL (CODE,OUTP,LNGO) C1800325 GO TO 306 C1800326C C1800327 304 LNGI=LNGO C1800328 CALL MOVER (CODE,LNGI,OUTP,LNGO) C1800329C C1800330 306 PARID=0 C1800331 IF(MORPAR)310,320,310 C1800332+ ARE THERE MORE PARAM TO BE PROCESSED C1800333 310 IF(PIND)110,70,40 C1800334+ YES C1800335C C1800336C C1800337C ARE ALL REQUIRED PARAMETERS FOUND ? C1800338C C1800339 320 I=0 C1800340 330 I=I+1 C1800341 IF(PPTEMP(I))330,360,340 C1800342ÐÐC C1800343C PARAMETER NOT FOUND,IS IT REQUIRED ? C1800344C C1800345 340 IF(IREQ(I))330,350,330 C1800346C C1800347C YES IT IS REQUIRED C1800348C C1800349 350 PARNUM=PARNUM+1 C1800350 GO TO 330 C1800351C C1800352C END OF PPTAB C1800353C C1800354 360 IF(PARNUM)240,400,240 C1800355+ ARE ALL REQUIRED PARAMETERS FOUND C1800356C C1800357C C1800358C C1800359C C1800360C CONVERT MASS STORAGE PHYSICAL UNIT NO. C1800361C C1800362 400 MMUNIT=DSK1+DSK2*10 C1800363 MMUNIT=MMUNIT+1 C1800364 IF(MMUNIT) 8200,8200,420 C1800365C C1800366C CHECK COMPATIBLITY OF P. D. T., DISK DRIVE, AND DISK PACK C1800367ÐÐ 420 ASSEM $E800,MMUNIT C1800368+ LDQ MMUNIT C1800369 ASSEM $C600,+MMLUTB C1800370+ LDA MMLUTB,Q C1800371 ASSEM $60FF C1800372+ STA- I C1800373 ASSEM $C502 C1800374+ LDA- (VISLUN),I C1800375 ASSEM $A00A C1800376+ AND- LPMASK+8 C1800377 ASSEM $6800,MMLU C1800378+ STA MMLU C1800379 CALL VERWPS (MMLU, ISTAT) C1800380 IF (ISTAT .NE. 0) GO TO 8300 C1800381C C1800382 CALL VOLUSE (REQBUF, IDATA(9), MMUNIT, ISTAT) C1800383C C1800384C CHECK IF VOLUME MOUNTED CORRECTLY C1800385C C1800386C ************************************************************* 124*4953C1800387 IF (ISTAT) 8000,500,500 C1800388C GET THE FDD ADDRESS FROM THIS VOLUMES VIT C1800389C LDQ MMUNIT C1800390C LDA MMLUTB,Q C1800391C STA- I C1800392ÐÐC C1800393 500 ASSEM $E800,MMUNIT,$C600,+MMLUTB,$60FF C1800394C C1800395C LDA- VIFDDM,I C1800396C STA VIFDDM C1800397C LDA- VIFDDL,I C1800398C STA VIFDDL C1800399C C1800400 ASSEM $C115,$6800,VIFDDM,$C116,$6800,VIFDDL C1800401C IF THE FDD HAS BEEN SET UP, THIS VOLUME HAS BEEN USED BEFORE C1800402C THERE IS NO NEED TO CREATE A FILE C1800403 IF (VIFDDM.NE.0.OR.VIFDDL.NE.0) GO TO 9998 C1800404C SET UP IDATA FOR A CREATE REQUEST C1800405 IDATA(1)=2H$$ C1800406 IDATA(2)=2HDU C1800407 IDATA(3)=2HMM C1800408 IDATA(4)=2HYX C1800409 IDATA(5)=2H$$ C1800410 IDATA(6)=2H C1800411 IDATA(7)=2H C1800412 IDATA(8)=2H C1800413 IDATA(13)=2 C1800414 IDATA(14)=0 C1800415 IDATA(15)=1 C1800416 DO 510 I=16,24 C1800417ÐÐ IDATA(I)=0 C1800418 510 CONTINUE C1800419C CLEAR THE REQUEST BUFFER C1800420 DO 520 I=1,24 C1800421 REQBUF(I)=0 C1800422 520 CONTINUE C1800423C CREATE THE FILE C1800424 CALL CREATE(REQBUF,IDATA,ISTAT) C1800425C ** 137*A020C1800426C DO NOT CHECK FOR ERROR C1800427C ** 137*A020C1800428C DELETE THE FILE C1800429 530 CALL DELETE(REQBUF,IDATA,ISTAT) C1800430C ** 137*A020C1800431C DO NOT CHECK FOR ERROR C1800432 GO TO 9998 C1800433C ** 137*A020C1800434C ************************************************************* 124*4953C1800435C C1800436C VOLUME NOT CORRECTLY MOUNTED C1800437C C1800438 8000 CALL ERCHK(ISTAT,REQBUF(4)) C1800439 GO TO 9995 C1800440C C1800441 8200 INDEX=47 C1800442ÐÐC 47 VOLUME NOT ON SPECIFIED UNIT C1800443 GO TO 9999 C1800444C 86 DISK DRIVE/DISK PACK NOT COMPATIBLE C1800445 8300 INDEX = 86 C1800446 GO TO 9999 C1800447C C1800448C ERROR ROUTINE C1800449C C1800450 9999 CALL SYSMSG(INDEX,ERBUF) C1800451C C1800452 9995 IF (PIND) 9990,9990,11 C1800453 9990 IF (MODE) 9991,9998,9991 C1800454 9991 ASSEM $E400,+MODE C1800455 ASSEM $D622 C1800456C C1800457 9998 RETURN C1800458C C1800459 END C1800460 SUBROUTINE DSMOUN C1900001 1 /C19 F ITOS CCS 3.0 SL-149C1900002C COMMAND PROCESSOR FOR DISMOUNT C1900003C ************************************************************* 122*4873C1900004C CREDIT COLLECTION SYSTEM VERSION 3.0 C1900005C **************************************************************123*4943C1900006C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C1900007ÐÐC COPYRIGHT CONTROL DATA CORPORATION 1979 C1900008C ************************************************************* 122*4873C1900009C*** C1900010C ************************************************************* 122*4873C1900011C C1900012C FUNCTION C1900013C C1900014C THIS PROCESSOR INDICATES THE SYSTEM THAT THE VOLUME ON THE UNIT C1900015C SPECIFIED,WILL BE NO LONGER AVAILABLE TO THE SYSTEM C1900016C C1900017C THIS MAY NOT BE USED TO DISMOUNT THE SYSTEM DISK C1900018C C1900019C GENERAL DESCRIPTION C1900020C C1900021C THE DK-PARAMETER IS AN INDEX TO THE MMLUTB TABLE AND IS USED TO C1900022C GET THE VOLUME INFORMATION TABLE (VIT) C1900023C IF THE VOLUME IS CURRENTLY MOUNTED A CHECK WILL BE DONE TO SEE C1900024C IF THERE ARE OPEN FILES C1900025C WHEN THIS CONDITION IS MET ERROR 223 WILL BE DISPLAYED AND THE C1900026C PROCESSOR RETURNS TO THE FMUTIL EXEC. C1900027C IF THERE ARE NO OPEN FILES THE DISMOUNT BIT WILL BE SET IN THE VIT C1900028C C1900029C COMMAND FORMAT C1900030C C1900031C DISMOUNT,DK=NN C1900032ÐÐC C1900033C DISMOUNT,NN C1900034C C1900035C C1900036M FMUCOM C1900037C C1900038 INTEGER NOCUR,ZRO,ERBUF,PARNUM,PARID,PPTEMP(17),PPTAB(17) C1900039 INTEGER BUFLEN,TC,OUTP,BLANK,QUEST,STAT C1900040 INTEGER VITADR C1900041 INTEGER DSK,DSK1,DSK2,VITTAB,WPS C1900042 INTEGER VISLUN,VINAME,VINMBR,VIBMSM,VIBMSL,VILBAM,VILBAL C1900043 INTEGER VIWPS,VIFDDM,VIFDDL,VIMAXF,VICURF,VINFDB,VINXTB,VINOOF C1900044 INTEGER VLNAME C1900045C C1900046 DIMENSION IPNAM(17) C1900047 DIMENSION IJUST(17) C1900048 DIMENSION ICONV(17) C1900049 DIMENSION IREQ(17) C1900050 DIMENSION IFND(17) C1900051 DIMENSION NAME(6) C1900052 DIMENSION ITEMP(3) C1900053 DIMENSION VITTAB(96),LABEL(96) C1900054 DIMENSION VINAME(4) C1900055 DIMENSION VLNAME(4) C1900056C C1900057ÐÐ EQUIVALENCE (VLNAME,LABEL(3)) C1900058 EQUIVALENCE (PPDISM,PPTAB) C1900059 EQUIVALENCE (DSK,DUMMY(3)) C1900060C C1900061 EQUIVALENCE (VISLUN,VITTAB(1)) C1900062 EQUIVALENCE (VINAME,VITTAB(2)) C1900063 EQUIVALENCE (VINMBR,VITTAB(6)) C1900064 EQUIVALENCE (VIBMSM,VITTAB(7)) C1900065 EQUIVALENCE (VIBMSL,VITTAB(8)) C1900066 EQUIVALENCE (VILBAM,VITTAB(9)) C1900067 EQUIVALENCE (VILBAL,VITTAB(10)) C1900068 EQUIVALENCE (VIWPS,VITTAB(11)) C1900069 EQUIVALENCE (VIFDDM,VITTAB(12)) C1900070 EQUIVALENCE (VIFDDL,VITTAB(13)) C1900071 EQUIVALENCE (VIMAXF,VITTAB(14)) C1900072 EQUIVALENCE (VICURF,VITTAB(15)) C1900073 EQUIVALENCE (VINFDB,VITTAB(16)) C1900074 EQUIVALENCE (VINXTB,VITTAB(17)) C1900075 EQUIVALENCE (VINOOF,VITTAB(18)) C1900076C C1900077C EXTERNALS C1900078C C1900079 EXTERNAL WTREAD C1900080 EXTERNAL GETFLD C1900081 EXTERNAL SYSMSG C1900082ÐÐ EXTERNAL MOVEL C1900083 EXTERNAL MOVER C1900084 EXTERNAL GETVIT C1900085 EXTERNAL MMLUTB C1900086C C1900087C C1900088 BYTE (IFND,PPTEMP(15=15)) C1900089 BYTE (IREQ,PPTEMP(12=12)) C1900090 BYTE (ICONV,PPTEMP(10=9)) C1900091 BYTE (IJUST,PPTEMP(8=8)) C1900092 BYTE (IPNAM,PPTEMP(7=0)) C1900093C C1900094 BYTE (IDISM,VISLUN(15=15)) C1900095 BYTE (DSK1,DSK(3=0)) C1900096 BYTE (DSK2,DSK(11=8)) C1900097 BYTE (IWVL,ISTAT(1=1)) C1900098 BYTE (MME,ISTAT(5=5)) C1900099 BYTE (IVLM,ISTAT(13=13)) C1900100 BYTE (ILR,ISTAT(14=14)) C1900101C C1900102 DATA NAME/'MM UNIT NO.='/ C1900103 DATA NOCUR/-1/,ZRO/0/ C1900104 DATA BUFLEN/40/ C1900105 DATA BLANK/$2020/ C1900106 DATA QUEST/'? '/ C1900107ÐÐC ************************************************************* 122*4873C1900108C*** C1900109C ************************************************************* 122*4873C1900110C C1900111C INITIALISATION C1900112C C1900113 11 INDEX=0 C1900114+ ERROR MSG NO. C1900115 ERBUF=0 C1900116+ ERROR MSG BUF C1900117 ISTAT=0 C1900118+ STATUS OF FM-REQUEST C1900119 LNGO=0 C1900120+ LENGTH OF FIELD TO MOVE C1900121 MORPAR=0 C1900122+ INDICATOR IF MORE PARAMETERS NEEDED C1900123 MORLIN=0 C1900124+ INDICATOR IF MORE LINES NEED TO BE READ C1900125 PARNUM=0 C1900126+ COUNT OF REQ.AND NOT FOUND PARAMETERS C1900127 PARID=0 C1900128 MORFIL=0 C1900129 MMUNIT=0 C1900130 IFLAG=0 C1900131 IP=1 C1900132ÐÐ****************************** C1900133 WPS=96 C1900134+ * C1900135****************************** C1900136 C1900137 ASSIGN 9998 TO INTLOC C1900138 CALL PGMINT(INTLOC,IFLAG) C1900139C C1900140C COPY THE PARAMETER PROCESSING TABLE C1900141C C1900142 I=0 C1900143 10 I=I+1 C1900144 PPTEMP(I)=PPTAB(I) C1900145 IF(PPTEMP(I))10,20,10 C1900146C C1900147C C1900148C C1900149 20 DO 30 I=1,24 C1900150 REQBUF(I)=0 C1900151 IDATA(I)=PARDEF(I) C1900152 30 CONTINUE C1900153C C1900154 35 IF(PIND)110,70,40 C1900155C C1900156C PROMPTING LEVEL = 1 FULL PARAMETERS WILL BE DISPLAYED C1900157ÐÐC C1900158 40 KI=IP C1900159 I=(IP-1)*6+1 C1900160 IF(IPNAM(IP))50,100,50 C1900161C C1900162 50 J=I+5 C1900163 K=1 C1900164 CODE(K)=$0A0D C1900165+ SET CR/LF C1900166 DO 60 I=I,J C1900167 K=K+1 C1900168 CODE(K)=NAME(I) C1900169 60 CONTINUE C1900170C C1900171 I=KI C1900172 LNGO=7 C1900173 GO TO 90 C1900174C C1900175C PROMPTING LEVEL = 0 PARAMETER ABBREVIATIONS WILL BE DISPLAYED C1900176C C1900177 70 I=IP C1900178 K=IPNAM(IP) C1900179+ INDEX TO PARAM.MNEM.TABLE C1900180 IF(K)80,100,80 C1900181 80 K=(K-1)*3+1 C1900182ÐÐC C1900183 CODE(1)=$0A0D C1900184 CODE(2)=PARNAM(K) C1900185 CODE(3)=$3D20 C1900186 LNGO=3 C1900187C C1900188C DISPLAY NEXT PARAMETER-IDENT C1900189C C1900190 90 CALL WTREAD (LUNIT,NOCUR,CODE,LNGO,NOCUR,DUMMY,ZRO,TC) C1900191C C1900192 PARID=IP C1900193+ INDEX IN PARNAM-TABLE C1900194 IFND(I)=1 C1900195+ SET FOUND FLAG C1900196 IP=IP+1 C1900197+ INCR. INDEX TO PPTEMP C1900198 MORPAR=1 C1900199+ SET INDICATOR FOR MORE PARAMETERS NEEDED C1900200 GO TO 120 C1900201C C1900202C END OF PARAMETER LIST, ISSUE FM-REQUEST C1900203C C1900204 100 MORPAR=0 C1900205 GO TO 320 C1900206C C1900207ÐÐC PROMPTING LEVEL = -1, NO PROMPTING DONE C1900208C C1900209 110 IF(MORLIN)115,130,130 C1900210+ DO WE NEED TO READ MORE LINES C1900211 115 MORLIN=0 C1900212C C1900213C READ NEXT LINE C1900214C C1900215 120 CALL WTREAD (LUNIT,NOCUR,DUMMY,ZRO,NOCUR,INBUF,BUFLEN,TC) C1900216C C1900217C RESET SWORD AND SBYTE C1900218C C1900219 SBYTE=0 C1900220 SWORD=0 C1900221C C1900222 130 CALL GETFLD (INBUF,CODE,SWORD,SBYTE,STAT) C1900223C C1900224 140 IF (STAT-2)150,160,200 C1900225 150 IF (STAT-1)260,250,250 C1900226C C1900227C EOL DETECTED,COUNT NO OF REQUIRED AND NOT FOUND PARAMETERS (STATUS=1)C1900228C C1900229 160 IF(PIND)161,162,162 C1900230 161 MORPAR=0 C1900231C C1900232ÐÐC CHECK IF FULL NAME DESIRED C1900233C C1900234 162 IF (CODE(1)-QUEST)164,163,164 C1900235C C1900236C YES,FULL NAME FOR THIS PARAMETER ONLY C1900237C C1900238 163 IF (PIND .NE. -1) IP=IP-1 C1900239 GO TO 40 C1900240C C1900241C CHECK IF PARAMETER ENTERED C1900242C C1900243 164 IF(CODE(1)-BLANK)270,165,270 C1900244 165 IFND(IP-1)=0 C1900245 IF (PIND .EQ. -1) GO TO 320 C1900246 GO TO 35 C1900247C C1900248C PARAMETER-ID FOUND (STATUS=3) C1900249C C1900250 200 I=1 C1900251 210 K=IPNAM(I) C1900252 K=(K-1)*3+1 C1900253C C1900254 IF (CODE(1)-PARNAM(K))230,220,230 C1900255C C1900256C PARAMETER-ID CORRESPONDS WITH PARAM.MNEMONIC TABLE C1900257ÐÐC C1900258 220 PARID=I C1900259 IFND(I)=1 C1900260 GO TO 130 C1900261C C1900262 230 I=I+1 C1900263+ NO MATCH,CONTINUE C1900264 IF(IPNAM(I))210,240,210 C1900265C C1900266 240 INDEX=39 C1900267+ PARAMETER ILLEGAL C1900268 GO TO 9999 C1900269C C1900270C FIELD TERMINATED ON A SEMI-COLON (STATUS=1) C1900271C C1900272 250 MORLIN=-1 C1900273+ SET INDICATOR TO READ MORE LINES C1900274C C1900275C FIELD TERMINATED ON A COMMA (STATUS=0) C1900276C C1900277 260 MORPAR=1 C1900278+ SET INDICATOR FOR MORE PARAMETERS C1900279 IF(CODE(1) .NE. BLANK)GO TO 270 C1900280 IFND(IP)=0 C1900281 IP=IP+1 C1900282ÐÐ GO TO 35 C1900283C C1900284C STORE PARAMETER VALUES INTO REQUIRED LOCATIONS C1900285C C1900286 270 IF (PARID)290,290,280 C1900287+ PARAMETER-ID FOUND C1900288 280 I=PARID C1900289+ YES C1900290 GO TO 300 C1900291C C1900292 290 I=IP C1900293 IF (CODE(1) .NE. BLANK) IFND(I)=1 C1900294 IP=IP+1 C1900295C C1900296 300 I=(IPNAM(I)-1)*3+1 C1900297C C1900298 LNGO=PARNAM(I+1) C1900299 OUTP=PARNAM(I+2) C1900300C C1900301C STORE INTO DESIGNATED OUTPUT FIELD C1900302C C1900303 IF (ICONV-1)302,304,302 C1900304C C1900305 302 CALL MOVEL (CODE,OUTP,LNGO) C1900306 GO TO 306 C1900307ÐÐC C1900308 304 LNGI=LNGO C1900309 CALL MOVER (CODE,LNGI,OUTP,LNGO) C1900310C C1900311 306 PARID=0 C1900312 IF(MORPAR)310,320,310 C1900313+ ARE THERE MORE PARAM TO BE PROCESSED C1900314 310 IF(PIND)110,70,40 C1900315+ YES C1900316C C1900317C C1900318C ARE ALL REQUIRED PARAMETERS FOUND ? C1900319C C1900320 320 I=0 C1900321 330 I=I+1 C1900322 IF(PPTEMP(I))330,360,340 C1900323C C1900324C PARAMETER NOT FOUND,IS IT REQUIRED ? C1900325C C1900326 340 IF(IREQ(I))330,350,330 C1900327C C1900328C YES IT IS REQUIRED C1900329C C1900330 350 PARNUM=PARNUM+1 C1900331 GO TO 330 C1900332ÐÐC C1900333C END OF PPTAB C1900334C C1900335 360 IF(PARNUM)240,400,240 C1900336+ ARE ALL REQUIRED PARAMETERS FOUND C1900337C C1900338C C1900339C C1900340C C1900341C CONVERT MASS STORAGE PHYSICAL UNIT NO. C1900342C C1900343 400 MMUNIT=DSK1+DSK2*10 C1900344 MMUNIT=MMUNIT+1 C1900345 IDATA(9)=0 C1900346C *************************************************************127*5171C1900347 IF (MMUNIT-1) 8200, 8200, 420 C1900348C *************************************************************127*5171C1900349C C1900350 420 CALL VOLUSE (REQBUF,IDATA(9),MMUNIT,ISTAT) C1900351C C1900352C CHECK IF VOLUME MOUNTED CORRECTLY C1900353C C1900354 IF (ISTAT) 8000,9998,9998 C1900355C C1900356C VOLUME NOT CORRECTLY MOUNTED C1900357ÐÐC C1900358 8000 CALL ERCHK(ISTAT,REQBUF(4)) C1900359 GO TO 9995 C1900360C C1900361 8200 INDEX=47 C1900362+ 47 WRONG MASS-MEMORY UNIT DEFINED C1900363 GO TO 9999 C1900364C C1900365C ERROR ROUTINE C1900366C C1900367 9999 CALL SYSMSG(INDEX,ERBUF) C1900368C C1900369 9995 IF (PIND) 9990,9990,11 C1900370 9990 IF (MODE) 9991,9998,9991 C1900371 9991 ASSEM $E400,+MODE C1900372 ASSEM $D622 C1900373C C1900374 9998 RETURN C1900375C C1900376 END C1900377 SUBROUTINE SAVE C2000001 1 /C20 F ITOS CCS 3.0 SL-149C2000002C COMMAND PROCESSOR FOR SAVE C2000003C ************************************************************* 122*487C2000004C CREDIT COLLECTION SYSTEM VERSION 3.0 C2000005ÐÐC ************************************************************* 122*4873C2000006C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C2000007C COPYRIGHT CONTROL DATA CORPORATION 1979 C2000008C ************************************************************* 122*4873C2000009C*** C2000010C ************************************************************* 122*4873C2000011C C2000012C C2000013C FUNCTION C2000014C C2000015C THIS PROCESSOR COPIES THE FIRST SPECIFIED DISK TO THE SECOND C2000016C C2000017C GENERAL DESCRIPTION C2000018C C2000019C TRACK TO TRACK WILL BE COPIED C2000020C ASSUMED IS 64 SECTORS/TRACK C2000021C ASSUMED IS 96 WORDS / SECTOR C2000022C C2000023C ITOS SHOULD BE DISABLED C2000024C C2000025C ACTUAL SAVE IS DONE BY MMCOPY C2000026C C2000027C COMMAND FORMAT C2000028C C2000029C SAVE,DK=A,DK=B C2000030ÐÐC C2000031M FMUCOM C2000032. C2000033C C2000034 INTEGER OWNR12,OWNR34,OWNR56,OWNR78,RECLEN,TDATRM,TDATRL C2000035 INTEGER DATBAM,DATBAL,FCBIND,TNKEYM,TNKEYL,POSKY1,POSKY2 C2000036 INTEGER POSKY3,POSKY4,TSFILM,TSFILL,EXPDAT,CRTDAT,FILTYP C2000037 INTEGER NOCUR,ZRO,ERBUF,PARNUM,PARID,PPTEMP(17),PPTAB(6) C2000038 INTEGER BUFLEN,TC,OUTP,BLANK,QUEST,STAT,OPN,WVL,FTYPE C2000039 INTEGER VITTAB(96),DSK,DSK1,DSK2 C2000040C C2000041 DIMENSION IPNAM(17) C2000042 DIMENSION IREQ(17) C2000043 DIMENSION IFND(17) C2000044 DIMENSION NAME(12) C2000045C C2000046 EQUIVALENCE (PPSAVE,PPTAB) C2000047C C2000048 EQUIVALENCE (DSK,DUMMY(3)) C2000049 BYTE (DSK1,DSK(3=0)) C2000050 BYTE (DSK2,DSK(11=8)) C2000051 BYTE (IPNAM,PPTEMP(7=0)) C2000052 BYTE (IFND,PPTEMP(15=15)) C2000053 BYTE (IREQ,PPTEMP(12=12)) C2000054C C2000055ÐÐC EXTERNALS C2000056C C2000057 EXTERNAL MMLUTB C2000058 EXTERNAL WTREAD C2000059 EXTERNAL GETFLD C2000060 EXTERNAL SYSMSG C2000061 EXTERNAL MOVEL C2000062C **** 138*0026C2000063 EXTERNAL SWTCH,JOBIND C2000064C C2000065 INTEGER SWTCH,JOBIND C2000066C **** 138*0026C2000067C C2000068 DATA NAME/'DISK FROM =DISK TO ='/ C2000069 DATA NOCUR/-1/,ZRO/0/ C2000070 DATA BUFLEN/40/ C2000071 DATA BLANK/$2020/ C2000072 DATA QUEST/'? '/ C2000073C ************************************************************* 122*4873C2000074C*** C2000075C ************************************************************* 122*4873C2000076. C2000077C C2000078C INITIALISATION C2000079C C2000080ÐÐ IFTSW=0 C2000081 11 INDEX=0 C2000082+ ERROR MSG NO. C2000083 ERBUF=0 C2000084+ ERROR MSG BUF C2000085 ISTAT=0 C2000086+ STATUS OF FM-REQUEST C2000087 LNGO=0 C2000088+ LENGTH OF FIELD TO MOVE C2000089 MORPAR=0 C2000090+ INDICATOR IF MORE PARAMETERS NEEDED C2000091 MORLIN=0 C2000092+ INDICATOR IF MORE LINES NEED TO BE READ C2000093 PARNUM=0 C2000094+ COUNT OF REQ.AND NOT FOUND PARAMETERS C2000095 PARID=0 C2000096 IFLAG=0 C2000097 IP=1 C2000098C C2000099 ASSIGN 9998 TO INTLOC C2000100 CALL PGMINT(INTLOC,IFLAG) C2000101C C2000102C COPY THE PARAMETER PROCESSING TABLE C2000103C C2000104 I=0 C2000105ÐÐ 10 I=I+1 C2000106 PPTEMP(I)=PPTAB(I) C2000107 IF(PPTEMP(I))10,20,10 C2000108C C2000109C C2000110C C2000111 20 DO 30 I=1,24 C2000112 REQBUF(I)=0 C2000113 IDATA(I)=PARDEF(I) C2000114 30 CONTINUE C2000115C C2000116 35 IF(PIND)110,70,40 C2000117C C2000118C PROMPTING LEVEL = 1 FULL PARAMETERS WILL BE DISPLAYED C2000119C C2000120 40 KI=IP C2000121 I=(IP-1)*6+1 C2000122 IF(IPNAM(IP))50,100,50 C2000123C C2000124 50 J=I+5 C2000125 K=1 C2000126 CODE(K)=$0A0D C2000127+ SET CR/LF C2000128 DO 60 I=I,J C2000129 K=K+1 C2000130ÐÐ CODE(K)=NAME(I) C2000131 60 CONTINUE C2000132C C2000133 I=KI C2000134 LNGO=7 C2000135 GO TO 90 C2000136. C2000137C C2000138C PROMPTING LEVEL = 0 PARAMETER ABBREVIATIONS WILL BE DISPLAYED C2000139C C2000140 70 I=IP C2000141 K=IPNAM(IP) C2000142+ INDEX TO PARAM.MNEM.TABLE C2000143 IF(K)80,100,80 C2000144 80 K=(K-1)*3+1 C2000145C C2000146 CODE(1)=$0A0D C2000147 CODE(2)=PARNAM(K) C2000148 CODE(3)=$3D20 C2000149 LNGO=3 C2000150C C2000151C DISPLAY NEXT PARAMETER-IDENT C2000152C C2000153 90 CALL WTREAD (LUNIT,NOCUR,CODE,LNGO,NOCUR,DUMMY,ZRO,TC) C2000154C C2000155ÐÐ PARID=IP C2000156+ INDEX IN PARNAM-TABLE C2000157 IFND(I)=1 C2000158+ SET FOUND FLAG C2000159 IP=IP+1 C2000160+ INCR. INDEX TO PPTEMP C2000161 MORPAR=1 C2000162+ SET INDICATOR FOR MORE PARAMETERS NEEDED C2000163 GO TO 120 C2000164C C2000165C END OF PARAMETER LIST, ISSUE FM-REQUEST C2000166C C2000167 100 MORPAR=0 C2000168 GO TO 320 C2000169C C2000170C PROMPTING LEVEL = -1, NO PROMPTING DONE C2000171C C2000172 110 IF(MORLIN)115,130,130 C2000173+ DO WE NEED TO READ MORE LINES C2000174 115 MORLIN=0 C2000175C C2000176C READ NEXT LINE C2000177C C2000178 120 CALL WTREAD (LUNIT,NOCUR,DUMMY,ZRO,NOCUR,INBUF,BUFLEN,TC) C2000179C C2000180ÐÐC RESET SWORD AND SBYTE C2000181C C2000182 SBYTE=0 C2000183 SWORD=0 C2000184C C2000185 130 CALL GETFLD (INBUF,CODE,SWORD,SBYTE,STAT) C2000186C C2000187 140 IF (STAT-2)150,160,200 C2000188 150 IF (STAT-1)260,250,250 C2000189C C2000190C EOL DETECTED,COUNT NO OF REQUIRED AND NOT FOUND PARAMETERS (STATUS=1)C2000191C C2000192 160 IF(PIND)161,162,162 C2000193 161 MORPAR=0 C2000194C C2000195C CHECK IF FULL NAME DESIRED C2000196C C2000197 162 IF (CODE(1)-QUEST)164,163,164 C2000198C C2000199C YES,FULL NAME FOR THIS PARAMETER ONLY C2000200C C2000201 163 IF (PIND .NE. -1) IP=IP-1 C2000202 GO TO 40 C2000203C C2000204C CHECK IF PARAMETER ENTERED C2000205ÐÐC C2000206 164 IF(CODE(1)-BLANK)270,165,270 C2000207 165 IFND(IP-1)=0 C2000208 GO TO 35 C2000209C C2000210C PARAMETER-ID FOUND (STATUS=3) C2000211C C2000212 200 I=1 C2000213 210 K=IPNAM(I) C2000214 K=(K-1)*3+1 C2000215C C2000216 IF (CODE(1)-PARNAM(K))230,220,230 C2000217C C2000218C PARAMETER-ID CORRESPONDS WITH PARAM.MNEMONIC TABLE C2000219C C2000220 220 PARID=I C2000221 IFND(I)=1 C2000222 GO TO 130 C2000223C C2000224 230 I=I+1 C2000225+ NO MATCH,CONTINUE C2000226 IF(IPNAM(I))210,240,210 C2000227C C2000228 240 INDEX=39 C2000229+ 39 PARAMETER ILLEGAL OR MISSING C2000230ÐÐ GO TO 9999 C2000231C C2000232C FIELD TERMINATED ON A SEMI-COLON (STATUS=1) C2000233C C2000234 250 MORLIN=-1 C2000235+ SET INDICATOR TO READ MORE LINES C2000236C C2000237C FIELD TERMINATED ON A COMMA (STATUS=0) C2000238C C2000239 260 MORPAR=1 C2000240+ SET INDICATOR FOR MORE PARAMETERS C2000241 IF(CODE(1) .NE. BLANK)GO TO 270 C2000242 IFND(IP)=0 C2000243 IP=IP+1 C2000244 GO TO 35 C2000245C C2000246C STORE PARAMETER VALUES INTO REQUIRED LOCATIONS C2000247C C2000248 270 IF (PARID)290,290,280 C2000249+ PARAMETER-ID FOUND C2000250 280 I=PARID C2000251+ YES C2000252 GO TO 300 C2000253C C2000254 290 I=IP C2000255ÐÐ IF (CODE(1) .NE. BLANK) IFND(I)=1 C2000256 IP=IP+1 C2000257C C2000258 300 I=(IPNAM(I)-1)*3+1 C2000259C C2000260 LNGO=PARNAM(I+1) C2000261 OUTP=PARNAM(I+2) C2000262C C2000263C STORE INTO DESIGNATED OUTPUT FIELD C2000264C C2000265 LNGI=LNGO C2000266 CALL MOVER (CODE,LNGI,OUTP,LNGO) C2000267 IF (IFTSW .EQ. -1) GO TO 315 C2000268 LU1=DSK1+DSK2*10 C2000269 IFTSW=-1 C2000270C C2000271 305 PARID=0 C2000272 IF(MORPAR)310,320,310 C2000273+ ARE THERE MORE PARAM TO BE PROCESSED C2000274 310 IF (PIND) 110,70,40 C2000275C C2000276 315 LU2=DSK1+DSK2*10 C2000277 GO TO 305 C2000278C C2000279C ARE ALL REQUIRED PARAMETERS FOUND ? C2000280ÐÐC C2000281 320 I=0 C2000282 330 I=I+1 C2000283 IF(PPTEMP(I))330,360,340 C2000284C C2000285C PARAMETER NOT FOUND,IS IT REQUIRED ? C2000286C C2000287 340 IF(IREQ(I))330,350,330 C2000288C C2000289C YES IT IS REQUIRED C2000290C C2000291 350 PARNUM=PARNUM+1 C2000292 GO TO 330 C2000293C C2000294C END OF PPTAB C2000295C C2000296 360 IF(PARNUM)240,400,240 C2000297+ ARE ALL REQUIRED PARAMETERS FOUND C2000298. C2000299 400 ASSEM $C000,+VITTAB C2000300 ASSEM $6800,OUTP C2000301 ASSEM $E000,+MMLUTB C2000302+ LDQ+ MMLUTB C2000303 ASSEM $C622 C2000304+ LDA- (ZERO),Q C2000305ÐÐ ASSEM $6800,MLUN C2000306+ STA* MLUN C2000307 MLUN=MLUN-1 C2000308+ CONVERT TO DISK ACTUAL NO C2000309C C2000310C 1 CARD DELETED 121*4757C2000311 IF(LU1 .GT. MLUN) GO TO 8210 C2000312 IF(LU2 .GT. MLUN) GO TO 8210 C2000313C 2 CARDS DELETED 121*4757C2000314C **** 138*0026C2000315C C2000316C PICKUP CONTENTS OF SWTCH AND JOBIND TO CHECK IF JOB PROCESSOR OR C2000317C LIBEDT IS ACTIVE C2000318C C2000319 ASSEM $C400,+SWTCH C2000320+ LDA+ SWTCH C2000321 ASSEM $6400,+I1 C2000322+ STA+ I1 C2000323 ASSEM $C400,+JOBIND C2000324+ LDA+ JOBIND C2000325 ASSEM $6400,+I2 C2000326+ STA+ I2 C2000327 IF (AND(I1,$7FFF).NE.0 .OR. AND(I2,$7FFF).NE.0) GO TO 8220 C2000328C **** 138*0026C2000329 CALL MMCOPY (LU1,LU2) C2000330ÐÐ GO TO 9998 C2000331C 3 CARDS DELETED 121*4757C2000332 8210 INDEX=47 C2000333+ 47 WRONG MM LU DEFINED C2000334 GO TO 9999 C2000335C **** 138*0026C2000336 8220 INDEX = 398 C2000337+ 398 JOBPRO OR LIBEDT ACTIVE C2000338C **** 138*0026C2000339C 4 CARDS DELETED 121*4757C2000340C C2000341 9999 CALL SYSMSG (INDEX,ERBUF) C2000342 IF (PIND) 9990,9990,11 C2000343 9990 IF (MODE) 9991,9998,9991 C2000344 9991 ASSEM $E400,+MODE C2000345 ASSEM $D622 C2000346 9998 RETURN C2000347 END C2000348 INTEGER FUNCTION LOAD(IXXXX) C2100001 1 /C21 F ITOS CCS 3.0 SL-149C2100002C COMMAND PROCESSOR FOR LOAD C2100003C CREDIT COLLECTION SYSTEM VERSION 3.0 C2100004C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CLAIFORNIA C2100005C COPYRIGHT CONTROL DATA CORPORATION 1979 C2100006C ************************************************************* 122*4872C2100007ÐÐC*** C2100008C *****************************************************'******* 122*4872C2100009C C2100010C C2100011C FUNCTION C2100012C C2100013C THIS PROCESSOR READS DATA RECORDS FROM A SPECIFIED UNIT RECORD C2100014C DEVICE INTO A FILE MANAGER FILE WHICH HAS BEEN DEFINED PRIOR C2100015C TO EXECUTING THIS COMMAND C2100016C C2100017C MAX RECORD LENGTH IS 512 BYTES C2100018C C2100019C GENERAL DESCRIPTION C2100020C C2100021C ************************************************************* 122*4872C2100022C AFTER ALL PARAMETERS HAVE BEEN READ A VALIDITY CHECK IS DONE C2100023C THE FILE IS OPENED AND THE FCB IS READ INTO USER-AREA C2100024C IF RECLEN EXCEEDS 512 BUYTES,ERROR 64 IS DISPLAYED C2100025C THE LOGICAL UNIT NO IS OBTAINED AND A READ OF ONE RECORD C2100026C IS DONE BY THE ROUTINE REDREC C2100027C EVERY ABNORMAL CONDITION IS TREATED AS AN EOF BY REDREC C2100028C LOAD WILL STOP WHEN THE FILE-SPACE IS FILLED INDICATING AN C2100029C ERROR MSG(55)OR WHEN REDREC DTECTS EITHER AN EOF OR A C2100030C PSEUDO-EOF (/*) C2100031C IF THE INPUT DATA IS SPECIFIED WITH M=A OR DEFAULT C2100032ÐÐC NO CONVERSION TAKES PLACE C2100033C IF M=E THE FILE WILL BE CONVERTED FROM EBCDIC TO ASCII USING C2100034C THE ASCEBC ROUTINE C2100035C A SEQUENTIAL FILE IS STORED BY MEANS OF PUTS REQUEST C2100036C AN INDEXED FILE IS STORED BY MEANS OF A WRITER USING THE EXTRACTEDC2100037C KEY-VALUE STORED IN KEYVAL C2100038C A LOAD OF A DIRECT FILE CHANGES THE FILETO SEQ. C2100039C ************************************************************* 122*4872C2100040C C2100041C C2100042C COMMAND FORMAT C2100043C C2100044C LOAD,FN=AAAAAAAA,VL=AAAAAAAA,I=NNNNNNNN,M=A C2100045C C2100046M FMUCOM C2100047. C2100048C C2100049 INTEGER OWNR12,OWNR34,OWNR56,OWNR78,RECLEN,TDATRM,TDATRL C2100050 INTEGER DATBAM,DATBAL,FCBIND,TNKEYM,TNKEYL,POSKY1,POSKY2 C2100051 INTEGER POSKY3,POSKY4,TSFILM,TSFILL,EXPDAT,CRTDAT,FILTYP C2100052 INTEGER NOCUR,ZRO,ERBUF,PARNUM,PARID,PPTEMP(17),PPTAB(6) C2100053 INTEGER BUFLEN,TC,OUTP,BLANK,QUEST,STAT,OPN,WVL,FTYPE C2100054 INTEGER OPN,WVL C2100055 INTEGER RECBUF C2100056 INTEGER ASEBSW C2100057ÐÐC C2100058 INTEGER BUFSIZ,SECLEN C2100059 INTEGER LOAD C2100060C ***** 138*A029C2100061 INTEGER TOTREC C2100062 INTEGER LOG1A C2100063 INTEGER OBL000 C2100064C ***** 138*A029C2100065C C2100066 DIMENSION IPNAM(17) C2100067 DIMENSION IREQ(17) C2100068 DIMENSION IFND(17) C2100069 DIMENSION NAME(24) C2100070 DIMENSION NAME12(4) C2100071 DIMENSION OWNR12(4) C2100072 DIMENSION KEYVAL(15) C2100073 DIMENSION IODEF(4) C2100074C C2100075 DIMENSION KARAEO( 7) C2100076 DIMENSION RECBUF(4002) C2100077C ***** 138*A029C2100078 DIMENSION TOTREC(2) C2100079C C2100080 EQUIVALENCE (PPLOAD,PPTAB) C2100081. C2100082ÐÐC C2100083C FILE CONTROL BLOCK C2100084C C2100085 EQUIVALENCE (RECLEN,FCBBUF(1)) C2100086 EQUIVALENCE (TDATRM,FCBBUF(2)) C2100087 EQUIVALENCE (TDATRL,FCBBUF(3)) C2100088 EQUIVALENCE (DATBAM,FCBBUF(4)) C2100089 EQUIVALENCE (DATBAL,FCBBUF(5)) C2100090 EQUIVALENCE (FCBIND,FCBBUF(6)) C2100091 EQUIVALENCE (NEDATM,FCBBUF(7)) C2100092 EQUIVALENCE (NEDATL,FCBBUF(8)) C2100093 EQUIVALENCE (NEXTBM,FCBBUF(9)) C2100094 EQUIVALENCE (NEXTBL,FCBBUF(10)) C2100095 EQUIVALENCE (TNKEYM,FCBBUF(11)) C2100096 EQUIVALENCE (TNKEYL,FCBBUF(12)) C2100097 EQUIVALENCE (KEYBAM,FCBBUF(13)) C2100098 EQUIVALENCE (KEYBAL,FCBBUF(14)) C2100099 EQUIVALENCE (LENKY1,FCBBUF(15)) C2100100 EQUIVALENCE (POSKY1,FCBBUF(16)) C2100101 EQUIVALENCE (LENKY2,FCBBUF(17)) C2100102 EQUIVALENCE (POSKY2,FCBBUF(18)) C2100103 EQUIVALENCE (LENKY3,FCBBUF(19)) C2100104 EQUIVALENCE (POSKY3,FCBBUF(20)) C2100105 EQUIVALENCE (LENKY4,FCBBUF(21)) C2100106 EQUIVALENCE (POSKY4,FCBBUF(22)) C2100107ÐÐ EQUIVALENCE (TSFILM,FCBBUF(23)) C2100108 EQUIVALENCE (TSFILL,FCBBUF(24)) C2100109 EQUIVALENCE (NAME12,FCBBUF(25)) C2100110 EQUIVALENCE (OWNR12,FCBBUF(29)) C2100111 EQUIVALENCE (EXPDAT,FCBBUF(89)) C2100112 EQUIVALENCE (CRTDAT,FCBBUF(92)) C2100113 EQUIVALENCE (FTYPE,FCBBUF(95)) C2100114C C2100115C EXTERNALS C2100116C C2100117 EXTERNAL MMLUTB C2100118 EXTERNAL WTREAD C2100119 EXTERNAL GETFLD C2100120 EXTERNAL ASCEBC C2100121 EXTERNAL SYSMSG C2100122 EXTERNAL MOVEL C2100123 EXTERNAL OPENFL C2100124 EXTERNAL GETFCB C2100125C ***** 138*A029C2100126 EXTERNAL LOG1A C2100127 EXTERNAL OBL000 C2100128C ***** 138*A029C2100129 EXTERNAL GETSSZ C2100130C C2100131C C2100132ÐÐ BYTE (IFND,PPTEMP(15=15)) C2100133 BYTE (IREQ,PPTEMP(12=12)) C2100134 BYTE (IPNAM,PPTEMP(7=0)) C2100135C C2100136 BYTE (OPN,ISTAT(0=0)) C2100137 BYTE (NFD,ISTAT(1=1)) C2100138 BYTE (LOK,ISTAT(2=2)) C2100139 BYTE (IRLOK,ISTAT(3=3)) C2100140 BYTE (INUNK,ISTAT(4=4)) C2100141 BYTE (MME,ISTAT(5=5)) C2100142 BYTE (IWKY,ISTAT(9=9)) C2100143 BYTE (IFE,ISTAT(10=10)) C2100144 BYTE (MFOS,ISTAT(11=11)) C2100145 BYTE (MFO,ISTAT(12=12)) C2100146 BYTE (IOUT,ISTAT(12=12)) C2100147 BYTE (WVL,ISTAT(13=13)) C2100148 BYTE (ILR,ISTAT(14=14)) C2100149C C2100150 DATA NAME/'FILE-NAME =VOLUME-NAME=INPUT UNIT =MODE ='/ C2100151 DATA NOCUR/-1/,ZRO/0/ C2100152 DATA BUFLEN/40/ C2100153 DATA BLANK/$2020/ C2100154 DATA QUEST/'? '/ C2100155 DATA IODEF/'TERMINAL'/ C2100156C C2100157ÐÐ DATA BUFSIZ/ 4000/ C2100158 DATA KARAEO/ 'A ', 'E ', 'AO', 'EO', 'OA', 'OE', 'O '/ C2100159 DATA LOAD/ 0/, NOFRCD/ 0/ C2100160C ************************************************************* 122*4872C2100161C*** C2100162C ************************************************************* 122*4872C2100163. C2100164C C2100165C INITIALISATION C2100166C C2100167 11 INDEX=0 C2100168+ ERROR MSG NO. C2100169 ERBUF=0 C2100170+ ERROR MSG BUF C2100171 ISTAT=0 C2100172+ STATUS OF FM-REQUEST C2100173 LNGO=0 C2100174+ LENGTH OF FIELD TO MOVE C2100175 MORPAR=0 C2100176+ INDICATOR IF MORE PARAMETERS NEEDED C2100177 MORLIN=0 C2100178+ INDICATOR IF MORE LINES NEED TO BE READ C2100179 PARNUM=0 C2100180+ COUNT OF REQ.AND NOT FOUND PARAMETERS C2100181 PARID=0 C2100182ÐÐ IFLAG=0 C2100183 IP=1 C2100184 DUMMY(6)=$4120 C2100185+ PRESET TO ASCII C2100186 DUMMY(1)=2HTE C2100187 DUMMY(2)=2HRM C2100188 DUMMY(3)=2HIN C2100189 DUMMY(4)=2HAL C2100190 LOAD = 0 C2100191C C2100192 ASSIGN 9998 TO INTLOC C2100193 CALL PGMINT(INTLOC,IFLAG) C2100194C C2100195C COPY THE PARAMETER PROCESSING TABLE C2100196C C2100197 I=0 C2100198 10 I=I+1 C2100199 PPTEMP(I)=PPTAB(I) C2100200 IF(PPTEMP(I))10,20,10 C2100201C C2100202C C2100203C C2100204 20 DO 30 I=1,24 C2100205 REQBUF(I)=0 C2100206 IDATA(I)=PARDEF(I) C2100207ÐÐ 30 CONTINUE C2100208C C2100209 35 IF(PIND)110,70,40 C2100210C C2100211C PROMPTING LEVEL = 1 FULL PARAMETERS WILL BE DISPLAYED C2100212C C2100213 40 KI=IP C2100214 I=(IP-1)*6+1 C2100215 IF(IPNAM(IP))50,100,50 C2100216C C2100217 50 J=I+5 C2100218 K=1 C2100219 CODE(K)=$0A0D C2100220+ SET CR/LF C2100221 DO 60 I=I,J C2100222 K=K+1 C2100223 CODE(K)=NAME(I) C2100224 60 CONTINUE C2100225C C2100226 I=KI C2100227 LNGO=7 C2100228 GO TO 90 C2100229. C2100230C C2100231C PROMPTING LEVEL = 0 PARAMETER ABBREVIATIONS WILL BE DISPLAYED C2100232ÐÐC C2100233 70 I=IP C2100234 K=IPNAM(IP) C2100235+ INDEX TO PARAM.MNEM.TABLE C2100236 IF(K)80,100,80 C2100237 80 K=(K-1)*3+1 C2100238C C2100239 CODE(1)=$0A0D C2100240 CODE(2)=PARNAM(K) C2100241 CODE(3)=$3D20 C2100242 LNGO=3 C2100243C C2100244C DISPLAY NEXT PARAMETER-IDENT C2100245C C2100246 90 CALL WTREAD (LUNIT,NOCUR,CODE,LNGO,NOCUR,DUMMY,ZRO,TC) C2100247C C2100248 PARID=IP C2100249+ INDEX IN PARNAM-TABLE C2100250 IFND(I)=1 C2100251+ SET FOUND FLAG C2100252 IP=IP+1 C2100253+ INCR. INDEX TO PPTEMP C2100254 MORPAR=1 C2100255+ SET INDICATOR FOR MORE PARAMETERS NEEDED C2100256 GO TO 120 C2100257ÐÐC C2100258C END OF PARAMETER LIST, ISSUE FM-REQUEST C2100259C C2100260 100 MORPAR=0 C2100261 GO TO 320 C2100262C C2100263C PROMPTING LEVEL = -1, NO PROMPTING DONE C2100264C C2100265 110 IF(MORLIN)115,130,130 C2100266+ DO WE NEED TO READ MORE LINES C2100267 115 MORLIN=0 C2100268C C2100269C READ NEXT LINE C2100270C C2100271 120 CALL WTREAD (LUNIT,NOCUR,DUMMY,ZRO,NOCUR,INBUF,BUFLEN,TC) C2100272C C2100273C RESET SWORD AND SBYTE C2100274C C2100275 SBYTE=0 C2100276 SWORD=0 C2100277C C2100278 130 CALL GETFLD (INBUF,CODE,SWORD,SBYTE,STAT) C2100279C C2100280 140 IF (STAT-2)150,160,200 C2100281 150 IF (STAT-1)260,250,250 C2100282ÐÐC C2100283C EOL DETECTED,COUNT NO OF REQUIRED AND NOT FOUND PARAMETERS (STATUS=1)C2100284C C2100285 160 IF(PIND)161,162,162 C2100286 161 MORPAR=0 C2100287C C2100288C CHECK IF FULL NAME DESIRED C2100289C C2100290 162 IF (CODE(1)-QUEST)164,163,164 C2100291C C2100292C YES,FULL NAME FOR THIS PARAMETER ONLY C2100293C C2100294 163 IF (PIND .NE. -1) IP=IP-1 C2100295 GO TO 40 C2100296C C2100297C CHECK IF PARAMETER ENTERED C2100298C C2100299 164 IF(CODE(1)-BLANK)270,165,270 C2100300 165 IFND(IP-1)=0 C2100301 IF (PIND .EQ. -1) GO TO 320 C2100302 GO TO 35 C2100303C C2100304C PARAMETER-ID FOUND (STATUS=3) C2100305C C2100306 200 I=1 C2100307ÐÐ 210 K=IPNAM(I) C2100308 K=(K-1)*3+1 C2100309C C2100310 IF (CODE(1)-PARNAM(K))230,220,230 C2100311C C2100312C PARAMETER-ID CORRESPONDS WITH PARAM.MNEMONIC TABLE C2100313C C2100314 220 PARID=I C2100315 IFND(I)=1 C2100316 GO TO 130 C2100317C C2100318 230 I=I+1 C2100319+ NO MATCH,CONTINUE C2100320 IF(IPNAM(I))210,240,210 C2100321C C2100322 240 INDEX=39 C2100323+ PARAMETER ILLEGAL C2100324 GO TO 9999 C2100325C C2100326C FIELD TERMINATED ON A SEMI-COLON (STATUS=1) C2100327C C2100328 250 MORLIN=-1 C2100329+ SET INDICATOR TO READ MORE LINES C2100330C C2100331C FIELD TERMINATED ON A COMMA (STATUS=0) C2100332ÐÐC C2100333 260 MORPAR=1 C2100334+ SET INDICATOR FOR MORE PARAMETERS C2100335 IF(CODE(1) .NE. BLANK)GO TO 270 C2100336 IFND(IP)=0 C2100337 IP=IP+1 C2100338 GO TO 35 C2100339C C2100340C STORE PARAMETER VALUES INTO REQUIRED LOCATIONS C2100341C C2100342 270 IF (PARID)290,290,280 C2100343+ PARAMETER-ID FOUND C2100344 280 I=PARID C2100345+ YES C2100346 GO TO 300 C2100347C C2100348 290 I=IP C2100349 IF (CODE(1) .NE. BLANK) IFND(I)=1 C2100350 IP=IP+1 C2100351C C2100352 300 I=(IPNAM(I)-1)*3+1 C2100353C C2100354 LNGO=PARNAM(I+1) C2100355 OUTP=PARNAM(I+2) C2100356C C2100357ÐÐC STORE INTO DESIGNATED OUTPUT FIELD C2100358C C2100359 CALL MOVEL (CODE,OUTP,LNGO) C2100360C C2100361 PARID=0 C2100362 IF(MORPAR)310,320,310 C2100363+ ARE THERE MORE PARAM TO BE PROCESSED C2100364 310 IF(PIND)110,70,40 C2100365+ YES C2100366C C2100367C C2100368C ARE ALL REQUIRED PARAMETERS FOUND ? C2100369C C2100370 320 I=0 C2100371 330 I=I+1 C2100372 IF(PPTEMP(I))330,360,340 C2100373C C2100374C PARAMETER NOT FOUND,IS IT REQUIRED ? C2100375C C2100376 340 IF(IREQ(I))330,350,330 C2100377C C2100378C YES IT IS REQUIRED C2100379C C2100380 350 PARNUM=PARNUM+1 C2100381 GO TO 330 C2100382ÐÐC C2100383C END OF PPTAB C2100384C C2100385 360 IF(PARNUM)240,400,240 C2100386+ ARE ALL REQUIRED PARAMETERS FOUND C2100387C C2100388 C2100389C C2100390C C2100391C------------------------------------------------------------------- C2100392C C2100393C C2100394C CHECK FOR MODE CHARACTER ENTRY C2100395C (SPECIAL ENTRIES ARE 3-7 FOR ORDERED INDEX INDEXED C2100396C C2100397C C2100398 400 CONTINUE C2100399 NOFRCD = 0 C2100400 IOVRFL = 0 C2100401 ITALR1 = 0 C2100402 ITALR2 = 0 C2100403 IP = 1 C2100404C CHECK FOR BLANK, DEFAULT TO 'A' C2100405 IF (CODE( 1) .EQ. BLANK) GO TO 402 C2100406 DO 401 IP = 1 , 7 C2100407ÐÐC C2100408 IF (CODE( 1) .EQ. KARAEO(IP) ) GO TO 402 C2100409 401 CONTINUE C2100410C C2100411C CHECK IF 'CARDPRO' AND DEFAULT C2100412C C2100413 IP = 1 C2100414 IF ((MODE .NE. 0) .AND. (DUMMY( 6) .EQ. $4120) ) GO TO 402 C2100415C C2100416C MODE INPUT ERROR C2100417 INDEX = 69 C2100418 IP = 4 C2100419C C2100420 CALL SYSMSG( INDEX, ERBUF) C2100421 MORPAR = 1 C2100422 GO TO 35 C2100423C C2100424C******** SAVE MODE ENTRY TYPE CODE C2100425C C2100426 402 CONTINUE C2100427 ASEBSW = 0 C2100428 IF ( AND(1,IP) .EQ. 0) ASEBSW = 1 C2100429C ***** 15 CARDS DELETED 138*A029C2100430C C2100431C GET LOGICAL UNIT NO C2100432ÐÐC C2100433 5010 CALL LUNEQ (DUMMY,LOGUNT) C2100434 IF ( AND($8000,LOGUNT) .EQ. $8000) GO TO 8200 C2100435C ***** 138*A029C2100436C C2100437C CHECK IF INPUT TO TERMINAL C2100438C C2100439 IF (DUMMY(1).EQ.2HTE .AND. DUMMY(2).EQ.2HRM) GO TO 403 C2100440C C2100441C NOT TERMINAL, GET CLASS CODE FOR THIS DEVICE C2100442C C2100443C C2100444 ASSEM $E000,+LOG1A C2100445+ LDQ =XLOG1A C2100446 ASSEM $F400,+LOGUNT C2100447+ ADQ+ LOGUNT C2100448 ASSEM $E622 C2100449+ LDQ- (ZERO),Q C2100450 ASSEM $C208 C2100451+ LDA- 8,Q C2100452 ASSEM $0F4B C2100453+ ARS 11 C2100454 ASSEM $A005 C2100455+ AND- ONEMSK+2 C2100456 ASSEM $6400,+ICLASS C2100457ÐÐ+ STA+ ICLASS C2100458C C2100459C CHECK IF CARD DEVICE. IF YES, GO TO 404 C2100460C C2100461 IF (ICLASS.EQ.3) GO TO 404 C2100462C C2100463C OTHER TYPE OF DEVICE, MAYBE TAPE. USE I/O BUFFER LENGTH C2100464C C2100465 MAXLEN = OBL000(0) C2100466 GO TO 405 C2100467C C2100468C TERMINAL INPUT. USE 68 AS MAX INPUT LENGTH. C2100469C C2100470 403 MAXLEN = 68 C2100471 GO TO 405 C2100472C C2100473C CARD INPUT . USE 40 AS MAX INPUT LENGTH C2100474C C2100475 404 MAXLEN = 40 C2100476 405 CONTINUE C2100477C ***** 138*A029C2100478C C2100479C----------------------------------------------------------------- C2100480C C2100481C C2100482ÐÐC STORE FCB-ADDR IN REQBUF C2100483C C2100484 ASSEM $C000,+FCBHDR C2100485+ LDA =XFCBHDR C2100486 ASSEM $6400,+REQBUF(10) C2100487+ STA REQBUF+9 C2100488C C2100489 REQBUF(13)=96 C2100490+ SET TO READ FULL LENGTH FCB C2100491C C2100492 IDATA(13)=0 C2100493+ THESE SETTINGS ARE REQUIRED BY OPENFL C2100494 IDATA(14)=1 C2100495 IDATA(15)=-1 C2100496. C2100497 CALL OPENFL (REQBUF,IDATA,ISTAT) C2100498C C2100499 IF (ISTAT .LT. 0) GO TO 8000 C2100500C C2100501C ***** 138*A029C2100502C C2100503C EXTRANEOUS CODE DELETED C2100504C C2100505C ***** 138*A029C2100506C C2100507ÐÐC GET SECTOR SIZE C2100508C C2100509 CALL GETSSZ (FCBHDR,SECLEN) C2100510 CALL CLOSFL (REQBUF,ISTAT) C2100511C C2100512 IF (ISTAT .LT. 0) GO TO 8000 C2100513C C2100514C ***** 138*A029C2100515C C2100516C COMPUTE LENGTH TO USE FOR INPUT C2100517C C2100518 INPLEN = RECLEN C2100519 IF (INPLEN.GT.BUFSIZ) GO TO 8210 C2100520 IF (RECLEN.GT.MAXLEN) INPLEN = MAXLEN C2100521C C2100522C CHECK IF FILE IS ALREADY FULL C2100523C C2100524 IF (FCBBUF(2).EQ.FCBBUF(7).AND.FCBBUF(3).EQ.FCBBUF(8)) GO TO 5060 C2100525C ***** 138*A029C2100526C C2100527 IPWIND=AND(FCBIND,$1) C2100528C C2100529C C2100530C** CHECK IF INDEXED FILE C2100531C C2100532ÐÐC C2100533C C2100534C C2100535C 'IP' SETTING IS BETWEEN 1 THROUGH 7 C2100536C INDEX VALUE IS SAME AS ARRAY 'KARAEF' SET-UP C2100537C (1 AND 2 ARE FOR 'A' AND 'E' ONLY) C2100538C C2100539 IF (IPWIND .EQ. 1) GO TO 7500 C2100540 IF (IP .LT. 3) GO TO 470 C2100541 450 CONTINUE C2100542 INDEX = 66 C2100543 GO TO 9999 C2100544C C2100545C C2100546C C2100547C C2100548C------- ---------- ---------- ------------- C2100549C C2100550C C2100551C*** SET UP BLOCKING FOR RECORD LOADING C2100552C C2100553C (BLOCKING IS USED TO SAVE THE NO. OF PUT CALL) C2100554C C2100555C C2100556C CALCULATE BLOCKING SIZE = MAX. NO. OF RECORDS CAN BE C2100557ÐÐC BUFFERED IN THE LOCAL BUFFER C2100558C C2100559C ---- SEQUENTIAL FILE : C2100560C C2100561C (A) SECTOR ALIGNED C2100562C NO. OF RECORD/BLOCK = (BUFFER SIZE) / C2100563C ( (NO. OF SECTOR) * (SECTOR SIZE) ) C2100564C C2100565C NO. OF SECTOR = (RECORD LENGTH)/(SECTOR SIZE) C2100566C C2100567C (B) NON-SECTOR ALIGNED C2100568C NO. OF RECORDS/BLOCK = (BUFFER SIZE)/(RECORD LENGTH) C2100569C C2100570C C2100571C CALCULATE DEFAULT VALUE (NON-SECTOR ALIGNED) C2100572C C2100573C C2100574 470 CONTINUE C2100575C ***** 138*A029C2100576 INCRBF = RECLEN C2100577C ***** 138*A029C2100578 MAXRED = BUFSIZ / RECLEN C2100579 IF ( AND(FCBIND , $8000) .EQ. 0) GO TO 501 C2100580 NUMSEC = RECLEN / SECLEN C2100581 IF ((NUMSEC * SECLEN) .LT. RECLEN) NUMSEC = NUMSEC + 1 C2100582ÐÐC ***** 138*A029C2100583 INCRBF = SECLEN * NUMSEC C2100584 MAXRED = BUFSIZ / INCRBF C2100585C ***** 138*A029C2100586C C2100587 501 CONTINUE C2100588C C2100589 REQBUF(13)=96 C2100590 IDATA(13)=0 C2100591 IDATA(14) = MAXRED C2100592C ***** 138*A029C2100593C C2100594C STORE FCB ADDRESS IN REQBUF C2100595C C2100596 ASSEM $C000,+FCBHDR C2100597+ LDA =XFCBHDR C2100598 ASSEM $6400,+REQBUF(10) C2100599+ STA+ REQBUF+9 C2100600C ***** 138*A029C2100601 CALL OPENFL (REQBUF,IDATA,ISTAT) C2100602C C2100603 IF (ISTAT .LT. 0) GO TO 8000 C2100604C C2100605 550 CONTINUE C2100606 ISTORE = 1 C2100607ÐÐ NOFRCD = 0 C2100608C ***** 138*A029C2100609C C2100610C PRESET TOTREC TO NUMBER OF EXISTING RECORDS C2100611C C2100612 TOTREC(1) = NEDATM C2100613 TOTREC(2) = NEDATL C2100614C ***** 138*A029C2100615C C2100616C** FILL INPUT BUFFER WITH SPACE CODES C2100617C C2100618 DO 560 ISTAT = 1 , BUFSIZ C2100619 RECBUF(ISTAT) = $2020 C2100620 560 CONTINUE C2100621C C2100622C READ ONE RECORD FROM THE SPECIFIED INPUT DEVICE C2100623C C2100624 5020 CONTINUE C2100625C ***** 138*A029C2100626C RESET NO OF CHARACTERS RECEIVED IN RECBUF(RECLEN+1) (SET BY THE C2100627C ITOS EXEC) TO BLANKS. THIS IS NOT MEANINGFUL THE FIRST TIME THRU C2100628C THIS LOGIC. C2100629 RECBUF(ISTORE) = $2020 C2100630 CALL REDREC (LOGUNT,INPLEN,RECBUF(ISTORE),ISTAT) C2100631C C2100632ÐÐC REBLANK 1ST WORD BEYOND LAST RECORD INPUT (MAY HAVE BEEN RESET BY C2100633C THE EXEC) C2100634C C2100635 IDX = ISTORE + INPLEN C2100636 RECBUF(IDX) = $2020 C2100637C ***** 138*A029C2100638C C2100639C CHECK FOR EOF C2100640C C2100641 IF (ISTAT .LT. 0) GO TO 9998 C2100642C C2100643C CHECK IF CONVERSION IS REQUIRED C2100644C C2100645C C2100646C 1 FOR EBCDIC CONVERSION C2100647C C2100648 IF (ASEBSW .EQ. 1) CALL ASCEBC(RECBUF(ISTORE),ASEBSW,RECLEN) C2100649C C2100650C INCREMENT NO. OF RECORD BY 1 AND CHECK IF REACH MAX. NO. OF RECORDS C2100651C IN THE BUFER. IF SO, SAVE DATA, OTHERWISE GO TO READ OTHER C2100652C RECORD. C2100653C C2100654C ***** 138*A029C2100655 ISTORE = ISTORE + INCRBF C2100656C ***** 138*A029C2100657ÐÐ NOFRCD = NOFRCD + 1 C2100658 IF (IOVRFL .NE. 0) GO TO 5035 C2100659C C2100660C INCREMENT NO. OF RECORD BY 1 AND CHECK IF REACH MAX. C2100661C ***** 138*A029C2100662 CALL BMPRRN (TOTREC) C2100663 IF (TOTREC(1).EQ.FCBBUF(2).AND.TOTREC(2).EQ.FCBBUF(3)) C2100664 1 IOVRFL = 1 C2100665C ***** 138*A029C2100666 IF (NOFRCD .LT. MAXRED) GO TO 5020 C2100667C C2100668C** FILE IS A SEQUENTIAL FILE, SAVE ALL RECORDS IN BUFFER C2100669C C2100670 5035 CONTINUE C2100671 CALL PUTS (REQBUF,RECBUF,NOFRCD,ISTAT) C2100672C C2100673 5040 CONTINUE C2100674 IF (ISTAT .LT. 0) GO TO 8000 C2100675 IF (IOUT .EQ. 1) GO TO 5060 C2100676 IF (IOVRFL .NE. 0) GO TO 9000 C2100677 GO TO 550 C2100678 5060 CONTINUE C2100679C C2100680 INDEX=55 C2100681+ 55 INSUFFICIENT MM FILE SPACE C2100682ÐÐ CALL SYSMSG(INDEX, ERBUF) C2100683 GO TO 9000 C2100684C C2100685C C2100686C------------------------------------------------------------------ C2100687C C2100688C C2100689C FM-REQUEST TERMINATED WITH AN ERROR C2100690C C2100691 8000 CONTINUE C2100692 8010 CONTINUE C2100693 CALL ERCHK(ISTAT,REQBUF(4)) C2100694 GO TO 9994 C2100695C C2100696 8200 INDEX=63 C2100697+ 63 INVALID SYSTEM PERIPHERAL NAME C2100698 GO TO 9999 C2100699C C2100700 8210 INDEX=64 C2100701+ 64 RECORD LENGTH TOO LARGE FOR THIS COMMAC2100702 GO TO 9999 C2100703C C2100704C C2100705C ERROR ROUTINE C2100706C C2100707ÐÐ 9999 CALL SYSMSG (INDEX,ERBUF) C2100708C C2100709 9994 IF (PIND) 9995,9995,11 C2100710 9995 IF (MODE) 9996,9998,9996 C2100711 9996 ASSEM $E400,+MODE C2100712 ASSEM $D622 C2100713C C2100714C********* END OF FILE DETECTED C2100715C C2100716C SAVE RECORDS, IF ANY, STILL IN BUFFER C2100717C C2100718 9998 CONTINUE C2100719 IF (NOFRCD .EQ. 0) GO TO 9000 C2100720 CALL PUTS(REQBUF, RECBUF, NOFRCD, ISTAT) C2100721 NOFRCD = 0 C2100722 IF (ISTAT .LT. 0) GO TO 8000 C2100723 9000 CONTINUE C2100724C C2100725 IF(FTYPE .EQ. 3) FTYPE=0 C2100726 CALL UPDFCB(REQBUF,0,INDEX,FCBBUF,ISTAT) C2100727 CALL CLOSFL(REQBUF,ISTAT) C2100728C C2100729 9997 RETURN C2100730C C2100731C C2100732ÐÐC--------------- INDEXED FILE OVERLAY INDEXED FILE C2100733C--------------- INDEXED FILE OVERLAY INDEXED FILE C2100734C--------------- INDEXED FILE OVERLAY INDEXED FILE C2100735C C2100736C C2100737C 'IP' CONTAINS ORDERED OR NON-ORDERED REQUEST C2100738C 'IP' IS EQUAL TO OR GREATWR THAN 3 IS FOR ORDERED C2100739C C2100740C C2100741C SET UP INPUT LOGICAL UNIT AND EBCDIC CONVERSION SWITCH C2100742C C2100743C C2100744C C2100745 7500 CONTINUE C2100746 IDATA(13) = 1 C2100747 IDATA(14) = LOGUNT C2100748 IDATA(15) = ASEBSW C2100749C ***** 138*A029C2100750 IDATA(16) = INPLEN C2100751C ***** 138*A029C2100752 LOAD = 2 C2100753 IF (IP .LE. 2) RETURN C2100754C C2100755C IT IS ORDERED INDEX FILE, BUT MUST CHECK C2100756C C2100757ÐÐC C2100758C**** CHECK IF RECORD NUMBER IN FILE IS NON-ZERO C2100759C C2100760 IF ( (FCBBUF(7) .EQ. 0) .AND. (FCBBUF(8) .EQ. 0) ) LOAD = 1 C2100761 RETURN C2100762 END C2100763 SUBROUTINE PURGE C2200001 1 /C22 F ITOS CCS 3.0 SL-149C2200002C COMMAND PROCESSOR FOR PURGE C2200003C ************************************************************* 122*4873C2200004C CREDIT COLLECTION SYSTEM VERSION 3.0 C2200005C ************************************************************* 122*4873C2200006C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C2200007C COPYRIGHT CONTROL DATA CORPORATION 1979 C2200008C ************************************************************* 122*4873C2200009C*** C2200010C ************************************************************* 122*4873C2200011C C2200012C C2200013C FUNCTION C2200014C C2200015C THIS PROCESSOR DELETES THE FILES WHICH EXPIRATION DATE IS EXPIRED C2200016C IF CONFIRMED BY OPERATOR C2200017C C2200018C GENERAL DESCRIPTION C2200019ÐÐC C2200020C ************************************************************* 122*4873C2200021C ON ENTRY THE PARAMETER TABLE(PPPURG) IS COPIED INTO A C2200022C TEMPORARY TABLE (PPTEMP) C2200023C AFTER ALL PARAMETERS HAVE BEEN READ A VALIDITY CHECK IS PERFORMED C2200024C NEXT A CHECK TO SEE IF THE VOLUME-NAME IS SPECIFIED IS DONE C2200025C IF NOT,IT WILL READ THE VOLUME-LABEL OF THE FIRST DISK C2200026C AND MOVE THE VOLUME-NAME TO IDATA C2200027C THEN A GETFCB USING THE INDEX METHOD WILL BE DONE C2200028C IN CASE THE OWNER-ID IS SPECIFIED,IT WILL CHECK FOR FCB C2200029C WITH MATCHING OWNER-NAME ONLY C2200030C NEXT THE EXPIRATION DATE IS CHECKED AND IF EXCEEDED,THE C2200031C FILE-NAME,OWNER-NAME IS DISPLAYED FOLLOWED BY 'PURGE=' C2200032C IF CONFIRMED(ANYTHING ELSE THEN 'NO')THE FILE IS DELETED C2200033C THE FCB INDEX IS INCREMENTED BY ONE AND THE NEXT FILE C2200034C IS SEARCHED C2200035C THIS WILL CONTINUE UNTILL THE INDEX IS OUT OF RANGE C2200036C IF NO VOLUME WAS SPECIFIED THE LABEL OF THE NEXT MOUNTED C2200037C VOLUME IS READ AND THE PROCESS WILL START AGAIN C2200038C ************************************************************* 122*4873C2200039C C2200040C C2200041C COMMAND FORMAT C2200042C C2200043C PURGE,OW=AAAAAAAA,VL=AAAAAAAA C2200044ÐÐC C2200045M FMUCOM C2200046. C2200047C C2200048 INTEGER OWNR12,OWNR34,OWNR56,OWNR78,RECLEN,TDATRM,TDATRL C2200049 INTEGER DATBAM,DATBAL,FCBIND,TNKEYM,TNKEYL,POSKY1,POSKY2 C2200050 INTEGER POSKY3,POSKY4,TSFILM,TSFILL,EXPDAT,CRTDAT,FILTYP C2200051 INTEGER NOCUR,ZRO,ERBUF,PARNUM,PARID,PPTEMP(17),PPTAB(6) C2200052 INTEGER BUFLEN,TC,OUTP,BLANK,QUEST,STAT,OPN,WVL,FTYPE C2200053 INTEGER OPN,WVL C2200054 INTEGER DISBUF(14) C2200055C C2200056 DIMENSION IPNAM(17) C2200057 DIMENSION IREQ(17) C2200058 DIMENSION IFND(17) C2200059 DIMENSION NAME(12) C2200060 DIMENSION NAME12(4) C2200061 DIMENSION OWNR12(4) C2200062 DIMENSION ITEMP(3) C2200063 DIMENSION EXPDAT(3) C2200064C C2200065 EQUIVALENCE (PPPURG,PPTAB) C2200066. C2200067C C2200068C FILE CONTROL BLOCK C2200069ÐÐC C2200070 EQUIVALENCE (RECLEN,FCBBUF(1)) C2200071 EQUIVALENCE (TDATRM,FCBBUF(2)) C2200072 EQUIVALENCE (TDATRL,FCBBUF(3)) C2200073 EQUIVALENCE (DATBAM,FCBBUF(4)) C2200074 EQUIVALENCE (DATBAL,FCBBUF(5)) C2200075 EQUIVALENCE (FCBIND,FCBBUF(6)) C2200076 EQUIVALENCE (NEDATM,FCBBUF(7)) C2200077 EQUIVALENCE (NEDATL,FCBBUF(8)) C2200078 EQUIVALENCE (NEXTBM,FCBBUF(9)) C2200079 EQUIVALENCE (NEXTBL,FCBBUF(10)) C2200080 EQUIVALENCE (TNKEYM,FCBBUF(11)) C2200081 EQUIVALENCE (TNKEYL,FCBBUF(12)) C2200082 EQUIVALENCE (KEYBAM,FCBBUF(13)) C2200083 EQUIVALENCE (KEYBAL,FCBBUF(14)) C2200084 EQUIVALENCE (LENKY1,FCBBUF(15)) C2200085 EQUIVALENCE (POSKY1,FCBBUF(16)) C2200086 EQUIVALENCE (LENKY2,FCBBUF(17)) C2200087 EQUIVALENCE (POSKY2,FCBBUF(18)) C2200088 EQUIVALENCE (LENKY3,FCBBUF(19)) C2200089 EQUIVALENCE (POSKY3,FCBBUF(20)) C2200090 EQUIVALENCE (LENKY4,FCBBUF(21)) C2200091 EQUIVALENCE (POSKY4,FCBBUF(22)) C2200092 EQUIVALENCE (TSFILM,FCBBUF(23)) C2200093 EQUIVALENCE (TSFILL,FCBBUF(24)) C2200094ÐÐ EQUIVALENCE (NAME12,FCBBUF(25)) C2200095 EQUIVALENCE (OWNR12,FCBBUF(29)) C2200096 EQUIVALENCE (EXPDAT,FCBBUF(89)) C2200097 EQUIVALENCE (CRTDAT,FCBBUF(92)) C2200098 EQUIVALENCE (FTYPE,FCBBUF(95)) C2200099C C2200100C EXTERNALS C2200101C C2200102 EXTERNAL WTREAD C2200103 EXTERNAL GETFLD C2200104 EXTERNAL SYSMSG C2200105 EXTERNAL MOVEL C2200106 EXTERNAL GETFCB C2200107 EXTERNAL TODAY C2200108C C2200109C C2200110 BYTE (IFND,PPTEMP(15=15)) C2200111 BYTE (IREQ,PPTEMP(12=12)) C2200112 BYTE (IPNAM,PPTEMP(7=0)) C2200113C C2200114 BYTE (MME,ISTAT(5=5)) C2200115 BYTE (IOUT,ISTAT(12=12)) C2200116 BYTE (WVL,ISTAT(13=13)) C2200117 BYTE (ILR,ISTAT(14=14)) C2200118C C2200119ÐÐ DATA NAME/'OWNER NAME =VOLUME NAME='/ C2200120 DATA NOCUR/-1/,ZRO/0/ C2200121 DATA BUFLEN/40/ C2200122 DATA BLANK/$2020/ C2200123 DATA QUEST/'? '/ C2200124 DATA LENDSP/14/ C2200125C ************************************************************* 122*4873C2200126C*** C2200127C ************************************************************* 122*4873C2200128. C2200129C C2200130C INITIALISATION C2200131C C2200132 11 INDEX=0 C2200133+ ERROR MSG NO. C2200134 ERBUF=0 C2200135+ ERROR MSG BUF C2200136 ISTAT=0 C2200137+ STATUS OF FM-REQUEST C2200138 LNGO=0 C2200139+ LENGTH OF FIELD TO MOVE C2200140 MORPAR=0 C2200141+ INDICATOR IF MORE PARAMETERS NEEDED C2200142 MORLIN=0 C2200143+ INDICATOR IF MORE LINES NEED TO BE READ C2200144ÐÐ PARNUM=0 C2200145+ COUNT OF REQ.AND NOT FOUND PARAMETERS C2200146 PARID=0 C2200147 INDFCB=0 C2200148+ FCB INDEX C2200149 MORVOL=0 C2200150+ MORE VOLUMES INDICATOR C2200151 IOW=0 C2200152+ OWNER SPECIFIED FLAG C2200153 MMUNIT=0 C2200154 IFLAG=0 C2200155 IP=1 C2200156 DISBUF(1)=$0A0D C2200157 DISBUF(6)=BLANK C2200158 DISBUF(11)=BLANK C2200159 DISBUF(12)=2HPU C2200160 DISBUF(13)=2HRG C2200161 DISBUF(14)=2HE= C2200162C C2200163 ASSIGN 9998 TO INTLOC C2200164 CALL PGMINT(INTLOC,IFLAG) C2200165C C2200166C COPY THE PARAMETER PROCESSING TABLE C2200167C C2200168 I=0 C2200169ÐÐ 10 I=I+1 C2200170 PPTEMP(I)=PPTAB(I) C2200171 IF(PPTEMP(I))10,20,10 C2200172C C2200173C C2200174C C2200175 20 DO 30 I=1,24 C2200176 REQBUF(I)=0 C2200177 IDATA(I)=PARDEF(I) C2200178 30 CONTINUE C2200179C C2200180 35 IF(PIND)110,70,40 C2200181C C2200182C PROMPTING LEVEL = 1 FULL PARAMETERS WILL BE DISPLAYED C2200183C C2200184 40 KI=IP C2200185 I=(IP-1)*6+1 C2200186 IF(IPNAM(IP))50,100,50 C2200187C C2200188 50 J=I+5 C2200189 K=1 C2200190 CODE(K)=$0A0D C2200191+ SET CR/LF C2200192 DO 60 I=I,J C2200193 K=K+1 C2200194ÐÐ CODE(K)=NAME(I) C2200195 60 CONTINUE C2200196C C2200197 I=KI C2200198 LNGO=7 C2200199 GO TO 90 C2200200. C2200201C C2200202C PROMPTING LEVEL = 0 PARAMETER ABBREVIATIONS WILL BE DISPLAYED C2200203C C2200204 70 I=IP C2200205 K=IPNAM(IP) C2200206+ INDEX TO PARAM.MNEM.TABLE C2200207 IF(K)80,100,80 C2200208 80 K=(K-1)*3+1 C2200209C C2200210 CODE(1)=$0A0D C2200211 CODE(2)=PARNAM(K) C2200212 CODE(3)=$3D20 C2200213 LNGO=3 C2200214C C2200215C DISPLAY NEXT PARAMETER-IDENT C2200216C C2200217 90 CALL WTREAD (LUNIT,NOCUR,CODE,LNGO,NOCUR,DUMMY,ZRO,TC) C2200218C C2200219ÐÐ PARID=IP C2200220+ INDEX IN PARNAM-TABLE C2200221 IFND(I)=1 C2200222+ SET FOUND FLAG C2200223 IP=IP+1 C2200224+ INCR. INDEX TO PPTEMP C2200225 MORPAR=1 C2200226+ SET INDICATOR FOR MORE PARAMETERS NEEDED C2200227 GO TO 120 C2200228C C2200229C END OF PARAMETER LIST, ISSUE FM-REQUEST C2200230C C2200231 100 MORPAR=0 C2200232 GO TO 320 C2200233C C2200234C PROMPTING LEVEL = -1, NO PROMPTING DONE C2200235C C2200236 110 IF(MORLIN)115,130,130 C2200237+ DO WE NEED TO READ MORE LINES C2200238 115 MORLIN=0 C2200239C C2200240C READ NEXT LINE C2200241C C2200242 120 CALL WTREAD (LUNIT,NOCUR,DUMMY,ZRO,NOCUR,INBUF,BUFLEN,TC) C2200243C C2200244ÐÐC RESET SWORD AND SBYTE C2200245C C2200246 SBYTE=0 C2200247 SWORD=0 C2200248C C2200249 130 CALL GETFLD (INBUF,CODE,SWORD,SBYTE,STAT) C2200250C C2200251 140 IF (STAT-2)150,160,200 C2200252 150 IF (STAT-1)260,250,250 C2200253C C2200254C EOL DETECTED,COUNT NO OF REQUIRED AND NOT FOUND PARAMETERS (STATUS=1)C2200255C C2200256 160 IF(PIND)161,162,162 C2200257 161 MORPAR=0 C2200258C C2200259C CHECK IF FULL NAME DESIRED C2200260C C2200261 162 IF (CODE(1)-QUEST)164,163,164 C2200262C C2200263C YES,FULL NAME FOR THIS PARAMETER ONLY C2200264C C2200265 163 IF (PIND .NE. -1) IP=IP-1 C2200266 GO TO 40 C2200267C C2200268C CHECK IF PARAMETER ENTERED C2200269ÐÐC C2200270 164 IF(CODE(1)-BLANK)270,165,270 C2200271 165 IFND(IP-1)=0 C2200272 IF (PIND .EQ. -1) GO TO 320 C2200273 GO TO 35 C2200274C C2200275C PARAMETER-ID FOUND (STATUS=3) C2200276C C2200277 200 I=1 C2200278 210 K=IPNAM(I) C2200279 K=(K-1)*3+1 C2200280C C2200281 IF (CODE(1)-PARNAM(K))230,220,230 C2200282C C2200283C PARAMETER-ID CORRESPONDS WITH PARAM.MNEMONIC TABLE C2200284C C2200285 220 PARID=I C2200286 IFND(I)=1 C2200287 GO TO 130 C2200288C C2200289 230 I=I+1 C2200290+ NO MATCH,CONTINUE C2200291 IF(IPNAM(I))210,240,210 C2200292C C2200293 240 INDEX=39 C2200294ÐÐ+ 39 PARAMETER ILLEGAL OR MISSING C2200295 GO TO 9999 C2200296C C2200297C FIELD TERMINATED ON A SEMI-COLON (STATUS=1) C2200298C C2200299 250 MORLIN=-1 C2200300+ SET INDICATOR TO READ MORE LINES C2200301C C2200302C FIELD TERMINATED ON A COMMA (STATUS=0) C2200303C C2200304 260 MORPAR=1 C2200305+ SET INDICATOR FOR MORE PARAMETERS C2200306 IF(CODE(1) .NE. BLANK)GO TO 270 C2200307 IFND(IP)=0 C2200308 IP=IP+1 C2200309 GO TO 35 C2200310C C2200311C STORE PARAMETER VALUES INTO REQUIRED LOCATIONS C2200312C C2200313 270 IF (PARID)290,290,280 C2200314+ PARAMETER-ID FOUND C2200315 280 I=PARID C2200316+ YES C2200317 GO TO 300 C2200318C C2200319ÐÐ 290 I=IP C2200320 IF (CODE(1) .NE. BLANK) IFND(I)=1 C2200321 IP=IP+1 C2200322C C2200323 300 I=(IPNAM(I)-1)*3+1 C2200324C C2200325 LNGO=PARNAM(I+1) C2200326 OUTP=PARNAM(I+2) C2200327C C2200328C STORE INTO DESIGNATED OUTPUT FIELD C2200329C C2200330 CALL MOVEL (CODE,OUTP,LNGO) C2200331C C2200332 PARID=0 C2200333 IF(MORPAR)310,320,310 C2200334+ ARE THERE MORE PARAM TO BE PROCESSED C2200335 310 IF(PIND)110,70,40 C2200336+ YES C2200337C C2200338C C2200339C ARE ALL REQUIRED PARAMETERS FOUND ? C2200340C C2200341 320 I=0 C2200342 330 I=I+1 C2200343 IF(PPTEMP(I))330,360,340 C2200344ÐÐC C2200345C PARAMETER NOT FOUND,IS IT REQUIRED ? C2200346C C2200347 340 IF(IREQ(I))330,350,330 C2200348C C2200349C YES IT IS REQUIRED C2200350C C2200351 350 PARNUM=PARNUM+1 C2200352 GO TO 330 C2200353C C2200354C END OF PPTAB C2200355C C2200356 360 IF(PARNUM)240,400,240 C2200357+ ARE ALL REQUIRED PARAMETERS FOUND C2200358C C2200359C C2200360C C2200361C C2200362C C2200363C SUPERFLUOUS CODE REMOVED C2200364C C2200365 400 CONTINUE C2200366C C2200367 IF (IDATA(9) .NE. BLANK) GO TO 500 C2200368C C2200369ÐÐC VOLUME IS NOT SPECIFIED C2200370C C2200371C C2200372C GET THE NEXT MOUNTED AND READY VOLUME AND STORE VOLNAM INTO IDATA(9) C2200373C C2200374 410 MMUNIT=MMUNIT+1 C2200375C C2200376 CALL NXTVOL(MMUNIT) C2200377C C2200378C CHECK IF MMLUTB COMPLETELY DONE C2200379C C2200380 IF (MMUNIT) 9998,9998,420 C2200381C C2200382 420 MORVOL=-1 C2200383+ SET INDICATOR TO MORE VOLUMES C2200384C C2200385C VOLUME IS SPECIFIED C2200386C C2200387 500 INDFCB=INDFCB+1 C2200388+ INCREMENT FCB INDEX C2200389C C2200390C GET THE NEXT FCB C2200391C C2200392 CALL GETFCB (REQBUF,IDATA(9),INDFCB,FCBBUF,ISTAT) C2200393C C2200394ÐÐC INDEX OUT OF RANGE ? C2200395C C2200396 IF (IOUT-1) 510,700,700 C2200397 510 IF (ISTAT) 8000,520,520 C2200398C C2200399C CHECK IF THIS FCB IS IN USE C2200400C C2200401 520 IF (FCBBUF(1)) 530,500,530 C2200402C C2200403C CHECK IF THE OWNER IS SPECIFIED C2200404C C2200405 530 IF (IDATA(5) .EQ. BLANK) GO TO 600 C2200406 IOW=-1 C2200407C C2200408C OWNER IS SPECIFIED C2200409C C2200410 DO 540 I=1,4 C2200411 IF (IDATA(I+4) .NE. OWNR12(I)) GO TO 500 C2200412 540 CONTINUE C2200413C C2200414C CHECK IF THE EXPIRATION DATE IS EXPIRED ? C2200415C C2200416 600 CALL TODAY (ITEMP) C2200417C C2200418 IF (EXPDAT(3) .LT. ITEMP(3)) GO TO 610 C2200419ÐÐ IF (EXPDAT(2) .LT. ITEMP(2)) GO TO 610 C2200420 IF (EXPDAT(1) .GT. ITEMP(1)) GO TO 500 C2200421C C2200422C EXPIRATION DATE IS EXPIRED C2200423C C2200424 610 DO 620 I=1,4 C2200425 DISBUF(I+1)=NAME12(I) C2200426 DISBUF(I+6)=OWNR12(I) C2200427 620 CONTINUE C2200428C C2200429 CALL WTREAD(LUNIT,NOCUR,DISBUF,LENDSP,NOCUR,INBUF,BUFLEN,TC) C2200430C C2200431 IF (INBUF(1) .EQ. 2HNO) GO TO 500 C2200432C C2200433C PURGE OF THIS FILE IS CONFIRMED C2200434 DO 625 I=1,4 C2200435 IDATA(I)=NAME12(I) C2200436 625 CONTINUE C2200437C C2200438 DO 630 I=1,4 C2200439 IDATA(I+4)=OWNR12(I) C2200440 630 CONTINUE C2200441C C2200442 CALL DELETE (REQBUF,IDATA,ISTAT) C2200443C C2200444ÐÐC C2200445 DO 640 I=1,4 C2200446 IDATA(I)=BLANK C2200447 IF (IOW .NE. -1) GO TO 640 C2200448 IDATA(I+4)=BLANK C2200449 640 CONTINUE C2200450C C2200451 IF (ISTAT) 8000,500,500 C2200452 700 IF (MORVOL .NE. -1) GO TO 9998 C2200453 GO TO 410 C2200454C C2200455C FM-REQUEST TERMINATED WITH AN ERROR C2200456C C2200457 8000 CALL ERCHK(ISTAT,REQBUF(4)) C2200458 GO TO 9994 C2200459C C2200460C C2200461C ERROR ROUTINE C2200462C C2200463 9999 CALL SYSMSG (INDEX,ERBUF) C2200464C C2200465 9994 IF (PIND) 9995,9995,11 C2200466 9995 IF(MODE) 9996,9998,9996 C2200467 9996 ASSEM $E400,+MODE C2200468 ASSEM $D622 C2200469ÐÐC C2200470C C2200471C SUPERFLUOUS CODE REMOVED C2200472C C2200473 9998 CONTINUE C2200474C C2200475 9997 RETURN C2200476 END C2200477 SUBROUTINE BATC C2300001 1 /C23 F ITOS CCS 3.0 SL-149C2300002C COMMAND PROCESSOR FOR BATCH C2300003C CREDIT COLLECTION SYSTEM VERSION 3.0 C2300004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C2300005C COPYRIGHT CONTROL DATA CORPORATION 1979 C2300006C C2300007CE C2300008C** C2300009C COMMAND PROCESSOR FOR BATCH C2300010C CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.1 C2300011C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C2300012C COPYRIGHT CONTROL DATA CORPORATION 1977 C2300013C C2300014C C2300015C GENERAL DESCRIPTION C2300016C C2300017ÐÐC THIS PROCESSOR ACCEPTS INPUT FROM EITHER AN INTERACTIVE C2300018C DEVICE OR THE DEVICE IT WAS INITIATED ON. THE PROCESSOR C2300019C RUNS UNDER THE FILE MANAGER UTILITY EXECUTIVE PROGRAM. C2300020C C2300021C FUNCTION C2300022C C2300023C THIS PROCESSOR CREATES ENTRIES IN THE BATCH FILE FOR C2300024C PROCESSING BY THE BATCH INPUT DRIVER THROUGH THE JOB C2300025C PROCESSOR, IF LOCAL BATCH, OR THROUGH A SPECIFIED HOST. C2300026C THE COMMAND FORMAT IS C2300027C BATCH,FN=AAAAAAAA,OW=AAAAAAAA,VL=AAAAAAAA,HO=AAAA,TY=A,PN= C2300028C AAAAAA,M=A C2300029C FN=INPUT FILE C2300030C OW=OWNER NAME C2300031C VL=VOLUME NAME C2300032C HO=HOST NAME C2300033C TY=TYPE OF BATCH JOB C2300034C PN=PROGRAM NAME (ASSEM/FTN ONLY) C2300035C M=MODE (ABS/RELO) C2300036C C2300037C FLOW C2300038C C2300039C THE PROCESSOR DETERMINES THE LEVEL OF PROMPTING REQUIRED, C2300040C DISPLAYS THE PARAMETERS AND STORES THE PARAMETER VALUES C2300041C INTO THE REQUIRED LOCATIONS. C2300042ÐÐC C2300043C C2300044C THIS PROCESSOR SEARCHES THE HOST FILE FOR A HOST NAME C2300045C MATCH. IF A MATCH IS FOUND, THE PROCESSOR SEARCHES THE C2300046C HOST RECORD FOR AN INACTIVE JOB NUMBER. A JOB FILE IS C2300047C CREATED NAMED JMNN, WHERE M IS THE HOST RECORD NUMBER, C2300048C AND NN IS THE FIRST INACTIVE JOB NUMBER. IT THEN READS C2300049C THE INPUT FILE AND SEARCHES FOR AN *JOB RECORD, AT THE SAME C2300050C TIME MOVING THE RECORDS TO THE NEW JOB FILE. THE VOLUME NAME, C2300051C OWNER NAME, NEW JOB FILE NAME, AND CURRENT DATE AND TIME ARE C2300052C ENTERED IN THE BATCH FILE RECORD AND THE HOST STATUS IS C2300053C SET TO 1 (NOT SENT). THE JOB NUMBER IS THEN OUTPUT ON C2300054C THE CRT. C2300055C C2300056C DEPENDING UPON TYPE OF JOB (TY-PARM), JCL WILL BE APPENDED C2300057C TO THE JOB OR NO JCL WILL BE ADDED TO THE JOB FILE. C2300058C C2300059C C2300060C ERROR MESSAGES C2300061C C2300062C THE NEW JOB FILE IS DELETED UPON ANY ERRORS ENCOUNTERED C2300063C C2300064C 901 HOST NAME NOT FOUND C2300065C 913 NO ROOM IN BATCH FILE C2300066C 914 NO *JOB RECORD IN INPUT FILE C2300067ÐÐC *************************************************************127*5125C2300068C CAN NOT OPEN INPUT FILE (SECTOR ALIGN ILLEGAL) C2300069C *************************************************************127*5125C2300070C C2300071C C2300072C C2300073C C2300074M FMUCOM C2300075. C2300076C C2300077 INTEGER OWNR12,OWNR34,OWNR56,OWNR78,RECLEN,TDATRM,TDATRL C2300078 INTEGER DATBAM,DATBAL,FCBIND,TNKEYM,TNKEYL,POSKY1,POSKY2 C2300079 INTEGER POSKY3,POSKY4,TSFILM,TSFILL,EXPDAT,CRTDAT,FILTYP C2300080 INTEGER NOCUR,ZRO,ERBUF,PARNUM,PARID,PPTEMP(17),PPTAB(6) C2300081 INTEGER BUFLEN,TC,OUTP,BLANK,QUEST,STAT,OPN,WVL,FTYPE C2300082 INTEGER OPN,WVL C2300083 INTEGER RECBUF C2300084 INTEGER CPDAT(24),CPREQ(24),CPVOL,CPHDR(5),CPFCB(96),CPWIND C2300085 INTEGER CPRECL,CPFIND,CPLEN1,CPPOS1 C2300086 INTEGER STAT1(18),STAT2(18),STAT3(18),STAT4(18) C2300087 INTEGER INPBUF(6000),BATREQ(24),BATDAT(24),BATBUF(32) C2300088 INTEGER NAME(42), EOF ,RELHLD, NUMREC C2300089 INTEGER JOB(5), JOBNO(4) C2300090 INTEGER BINASC C2300091 INTEGER JOBDAT(24), JOBREQ(24), OUTDAT(24), OUTREQ(24) C2300092ÐÐ INTEGER RECNUM, IRECNO(2) C2300093C C2300094 DIMENSION IPNAM(17) C2300095 DIMENSION IREQ(17) C2300096 DIMENSION IFND(17) C2300097 DIMENSION NAME12(4) C2300098 DIMENSION OWNR12(4) C2300099 DIMENSION KEYVAL(15) C2300100 DIMENSION RECBUF(322) C2300101 DIMENSION IPRG(12) C2300102 DIMENSION ILOCL(4) C2300103C C2300104 EQUIVALENCE (PPBATC,PPTAB) C2300105 EQUIVALENCE (CPRECL,CPFCB(1)) C2300106 EQUIVALENCE (CPFIND,CPFCB(6)) C2300107 EQUIVALENCE (CPLEN1,CPFCB(15)) C2300108 EQUIVALENCE (CPPOS1,CPFCB(16)) C2300109 BYTE (IDEL,ISTAT(4=4)) C2300110 BYTE(EOF,ISTAT(8=8)) C2300111. C2300112C C2300113C FILE CONTROL BLOCK C2300114C C2300115 EQUIVALENCE (RECLEN,FCBBUF(1)) C2300116 EQUIVALENCE (TDATRM,FCBBUF(2)) C2300117ÐÐ EQUIVALENCE (TDATRL,FCBBUF(3)) C2300118 EQUIVALENCE (DATBAM,FCBBUF(4)) C2300119 EQUIVALENCE (DATBAL,FCBBUF(5)) C2300120 EQUIVALENCE (FCBIND,FCBBUF(6)) C2300121 EQUIVALENCE (NEDATM,FCBBUF(7)) C2300122 EQUIVALENCE (NEDATL,FCBBUF(8)) C2300123 EQUIVALENCE (NEXTBM,FCBBUF(9)) C2300124 EQUIVALENCE (NEXTBL,FCBBUF(10)) C2300125 EQUIVALENCE (TNKEYM,FCBBUF(11)) C2300126 EQUIVALENCE (TNKEYL,FCBBUF(12)) C2300127 EQUIVALENCE (KEYBAM,FCBBUF(13)) C2300128 EQUIVALENCE (KEYBAL,FCBBUF(14)) C2300129 EQUIVALENCE (LENKY1,FCBBUF(15)) C2300130 EQUIVALENCE (POSKY1,FCBBUF(16)) C2300131 EQUIVALENCE (LENKY2,FCBBUF(17)) C2300132 EQUIVALENCE (LENKY3,FCBBUF(19)) C2300133 EQUIVALENCE (LENKY4,FCBBUF(21)) C2300134 EQUIVALENCE (TSFILM,FCBBUF(23)) C2300135 EQUIVALENCE (TSFILL,FCBBUF(24)) C2300136 EQUIVALENCE (NAME12,FCBBUF(25)) C2300137 EQUIVALENCE (OWNR12,FCBBUF(29)) C2300138 EQUIVALENCE (EXPDAT,FCBBUF(89)) C2300139 EQUIVALENCE (CRTDAT,FCBBUF(92)) C2300140 EQUIVALENCE (FTYPE,FCBBUF(95)) C2300141C C2300142ÐÐC EXTERNALS C2300143C C2300144 EXTERNAL MMLUTB C2300145 EXTERNAL WTREAD C2300146 EXTERNAL GETFLD C2300147 EXTERNAL SYSMSG C2300148 EXTERNAL MOVEL C2300149 EXTERNAL OPENFL C2300150 EXTERNAL GETFCB C2300151 EXTERNAL AYERTO C2300152 EXTERNAL AMONTO C2300153 EXTERNAL ADAYTO C2300154 EXTERNAL HORTO C2300155 EXTERNAL MINTO C2300156 EXTERNAL SECON C2300157 EXTERNAL BINASC C2300158 EXTERNAL WKSPLU C2300159 EXTERNAL MMLUTB C2300160 EXTERNAL FMEOFC C2300161C C2300162C C2300163 BYTE (IFND,PPTEMP(15=15)) C2300164 BYTE (IREQ,PPTEMP(12=12)) C2300165 BYTE (IPNAM,PPTEMP(7=0)) C2300166C C2300167ÐÐ BYTE (OPN,ISTAT(0=0)) C2300168 BYTE (NFD,ISTAT(1=1)) C2300169 BYTE (INUNK,ISTAT(4=4)) C2300170 BYTE (MME,ISTAT(5=5)) C2300171 BYTE(ILESS,ISTAT(8=8)) C2300172 BYTE(IDUPE,ISTAT(10=10)) C2300173 BYTE (MFOS,ISTAT(11=11)) C2300174 BYTE (MFO,ISTAT(12=12)) C2300175 BYTE (IOUT,ISTAT(12=12)) C2300176 BYTE (WVL,ISTAT(13=13)) C2300177 BYTE (ILR,ISTAT(14=14)) C2300178 BYTE(STAT1,RECBUF(15=12)) C2300179 BYTE(STAT2,RECBUF(11=8)) C2300180 BYTE(STAT3,RECBUF(7=4)) C2300181 BYTE(STAT4,RECBUF(3=0)) C2300182C C2300183 DATA NOCUR/-1/,ZRO/0/ C2300184 DATA BUFLEN/40/ C2300185 DATA BLANK/$2020/ C2300186 DATA QUEST/'? '/ C2300187 DATA NAME/'INPUT FILE= OWNER NAME= VOLUME = HOST = TYPE= C2300188 * PROG. NAME= MODE A/R = '/ C2300189 DATA ILOCL/'NO - ID.'/ C2300190 DATA JOB/$0D0A,$4A4F,$4220,$4E4F,$2E3D/ C2300191 DATA IPRG/'*RPGII*ASSEM*FTN *COBOL'/ C2300192ÐÐ INTEGER BUFSIZ C2300193 DATA BUFSIZ/6000/ C2300194 DATA JOBNO/$4A30,$3020,$2020,$2020/ C2300195 DATA IK/0/ C2300196 DATA JK/0/ C2300197 DATA IJOB/0/ C2300198C C2300199C HOST FILE NUMBER OF RECORDS AND RECORD LENGTH C2300200C C2300201 DATA NUMREC/8/ C2300202 DATA LENREC/18/ C2300203C C2300204 DATA KERBAS/ 400/ C2300205. C2300206C C2300207C INITIALIZATION C2300208C C2300209 11 INDEX=0 C2300210+ ERROR MSG NO. C2300211 ERBUF=0 C2300212+ ERROR MSG BUF C2300213 ISTAT=0 C2300214+ STATUS OF FM-REQUEST C2300215 LNGO=0 C2300216+ LENGTH OF FIELD TO MOVE C2300217ÐÐ MORPAR=0 C2300218+ INDICATOR IF MORE PARAMETERS NEEDED C2300219 MORLIN=0 C2300220+ INDICATOR IF MORE LINES NEED TO BE READ C2300221 PARNUM=0 C2300222+ COUNT OF REQ.AND NOT FOUND PARAMETERS C2300223 PARID=0 C2300224 IFLAG=0 C2300225 IP=1 C2300226 IND=0 C2300227 ICHK=0 C2300228 IFINEF = 0 C2300229 IEFXX = 0 C2300230C PICK UP PSEUDO END-OF -FILE C2300231C C2300232 ASSEM $C000,+FMEOFC,$6400,+IEOF C2300233C C2300234 ASSIGN 9000 TO INTLOC C2300235 CALL PGMINT(INTLOC,IFLAG) C2300236C C2300237C COPY THE PARAMETER PROCESSING TABLE C2300238C C2300239 I=0 C2300240 10 I=I+1 C2300241 PPTEMP(I)=PPTAB(I) C2300242ÐÐ IF(PPTEMP(I))10,20,10 C2300243C C2300244C C2300245C C2300246 20 DO 30 I=1,24 C2300247 REQBUF(I)=0 C2300248 BATREQ(I)=0 C2300249 CPREQ(I)=0 C2300250 OUTREQ(I)=0 C2300251 CPDAT(I)=PARDEF(I) C2300252 BATDAT(I)=PARDEF(I) C2300253 IDATA(I)=PARDEF(I) C2300254 OUTDAT(I)=PARDEF(I) C2300255 JOBDAT(I)=PARDEF(I) C2300256 30 CONTINUE C2300257 DUMMY (5) = 2HLO C2300258 DUMMY (6) = 2HCL C2300259 ITYPE = 2HR C2300260C C2300261 35 IF(PIND)110,70,40 C2300262C C2300263C PROMPTING LEVEL = 1 FULL PARAMETERS WILL BE DISPLAYED C2300264C C2300265 40 KI=IP C2300266 I=(IP-1)*6+1 C2300267ÐÐ IF(IPNAM(IP))50,100,50 C2300268C C2300269 50 J=I+5 C2300270 K=1 C2300271 CODE(K)=$0A0D C2300272+ SET CR/LF C2300273 DO 60 I=I,J C2300274 K=K+1 C2300275 CODE(K)=NAME(I) C2300276 60 CONTINUE C2300277C C2300278 I=KI C2300279 LNGO=7 C2300280 GO TO 90 C2300281. C2300282C C2300283C PROMPTING LEVEL = 0 PARAMETER ABBREVIATIONS WILL BE DISPLAYED C2300284C C2300285 70 I=IP C2300286 K=IPNAM(IP) C2300287+ INDEX TO PARAM.MNEM.TABLE C2300288 IF(K)80,100,80 C2300289 80 K=(K-1)*3+1 C2300290C C2300291 CODE(1)=$0A0D C2300292ÐÐ CODE(2)=PARNAM(K) C2300293 CODE(3)=$3D20 C2300294 LNGO=3 C2300295C C2300296C DISPLAY NEXT PARAMETER-IDENT C2300297C C2300298 90 CALL WTREAD (LUNIT,NOCUR,CODE,LNGO,NOCUR,DUMMY,ZRO,TC) C2300299C C2300300 PARID=IP C2300301+ INDEX IN PARNAM-TABLE C2300302 IFND(I)=1 C2300303+ SET FOUND FLAG C2300304 IP=IP+1 C2300305+ INCR. INDEX TO PPTEMP C2300306 MORPAR=1 C2300307+ SET INDICATOR FOR MORE PARAMETERS NEEDED C2300308 GO TO 120 C2300309C C2300310C END OF PARAMETER LIST, ISSUE FM-REQUEST C2300311C C2300312 100 MORPAR=0 C2300313 GO TO 320 C2300314C C2300315C PROMPTING LEVEL = -1, NO PROMPTING DONE C2300316C C2300317ÐÐ 110 IF(MORLIN)115,130,130 C2300318+ DO WE NEED TO READ MORE LINES C2300319 115 MORLIN=0 C2300320C C2300321C READ NEXT LINE C2300322C C2300323 120 CALL WTREAD (LUNIT,NOCUR,DUMMY,ZRO,NOCUR,INBUF,BUFLEN,TC) C2300324C C2300325C RESET SWORD AND SBYTE C2300326C C2300327 SBYTE=0 C2300328 SWORD=0 C2300329. C2300330 130 CALL GETFLD (INBUF,CODE,SWORD,SBYTE,STAT) C2300331C C2300332C C2300333 140 IF (STAT-2)150,160,200 C2300334 150 IF (STAT-1)260,250,250 C2300335C C2300336C EOL DETECTED,COUNT NO OF REQUIRED AND NOT FOUND PARAMETERS (STATUS=1)C2300337C C2300338 160 IF(PIND)161,162,162 C2300339 161 MORPAR=0 C2300340C C2300341C CHECK IF FULL NAME DESIRED C2300342ÐÐC C2300343 162 IF (CODE(1)-QUEST)164,163,164 C2300344C C2300345C YES,FULL NAME FOR THIS PARAMETER ONLY C2300346C C2300347 163 IF (PIND .NE. -1) IP=IP-1 C2300348 GO TO 40 C2300349C C2300350C CHECK IF PARAMETER ENTERED C2300351C C2300352 164 IF(CODE(1)-BLANK)270,165,270 C2300353 165 IFND(IP-1)=0 C2300354 IF (PIND .EQ. -1) GO TO 320 C2300355 GO TO 35 C2300356C C2300357C PARAMETER-ID FOUND (STATUS=3) C2300358C C2300359 200 I=1 C2300360 210 K=IPNAM(I) C2300361 K=(K-1)*3+1 C2300362C C2300363 IF (CODE(1)-PARNAM(K))230,220,230 C2300364C C2300365C PARAMETER-ID CORRESPONDS WITH PARAM.MNEMONIC TABLE C2300366C C2300367ÐÐ 220 PARID=I C2300368 IFND(I)=1 C2300369 GO TO 130 C2300370C C2300371 230 I=I+1 C2300372+ NO MATCH,CONTINUE C2300373 IF(IPNAM(I))210,240,210 C2300374C C2300375 240 INDEX=39 C2300376+ PARAMETER ILLEGAL C2300377 GO TO 8100 C2300378C FIELD TERMINATED ON A SEMI-COLON (STATUS=1) C2300379C C2300380 250 MORLIN=-1 C2300381+ SET INDICATOR TO READ MORE LINES C2300382C C2300383C FIELD TERMINATED ON A COMMA (STATUS=0) C2300384C C2300385 260 MORPAR=1 C2300386+ SET INDICATOR FOR MORE PARAMETERS C2300387 IF(CODE(1) .NE. BLANK)GO TO 270 C2300388 IFND(IP)=0 C2300389 IP=IP+1 C2300390 GO TO 35 C2300391C C2300392ÐÐC STORE PARAMETER VALUES INTO REQUIRED LOCATIONS C2300393C C2300394 270 IF (PARID)290,290,280 C2300395+ PARAMETER-ID FOUND C2300396 280 I=PARID C2300397+ YES C2300398 GO TO 300 C2300399C C2300400 290 I=IP C2300401 IF (CODE(1) .NE. BLANK) IFND(I)=1 C2300402 IP=IP+1 C2300403C C2300404 300 I=(IPNAM(I)-1)*3+1 C2300405C C2300406 LNGO=PARNAM(I+1) C2300407 OUTP=PARNAM(I+2) C2300408C C2300409C STORE INTO DESIGNATED OUTPUT FIELD C2300410C C2300411 CALL MOVEL (CODE,OUTP,LNGO) C2300412C C2300413 PARID=0 C2300414 IF(MORPAR)310,320,310 C2300415+ ARE THERE MORE PARAM TO BE PROCESSED C2300416310 IF(IP.NE.5) GO TO 318 C2300417ÐÐ IREMOT = 1 C2300418 IF(DUMMY(5).NE.2HLO .AND. DUMMY(6).NE.2HCL ) IREMOT = 2 C2300419 GO TO (319,320),IREMOT C2300420C C2300421318 IF(IP.NE.6) GO TO 319 C2300422 IF(IDATA(16).EQ.2HR .OR.IDATA(16).EQ.2HC .OR.IDATA(16).EQ.0 C2300423 *.OR.IDATA(16).EQ.2HN ) GO TO 320 C2300424319 IF(PIND) 110,70,40 C2300425C C2300426+ YES C2300427C C2300428C C2300429C ARE ALL REQUIRED PARAMETERS FOUND ? C2300430C C2300431 320 I=0 C2300432 330 I=I+1 C2300433 IF(PPTEMP(I))330,360,340 C2300434C C2300435C PARAMETER NOT FOUND,IS IT REQUIRED ? C2300436C C2300437 340 IF(IREQ(I))330,350,330 C2300438C C2300439C YES IT IS REQUIRED C2300440C C2300441 350 PARNUM=PARNUM+1 C2300442ÐÐ GO TO 330 C2300443C C2300444C END OF PPTAB C2300445C C2300446 360 IF(PARNUM) 240,400,240 C2300447+ ARE ALL REQUIRED PARAMETERS FOUND C2300448C C2300449C ALL REQUIRED PARAMETERS HAVE BEEN FOUND C2300450C C2300451C SET UP PRESETS C2300452C C2300453400 IF(IDATA(16).NE.0) ITYPE = IDATA(16) C2300454 IF(DUMMY(5).NE.0) GOTO 405 C2300455 DUMMY(5)= 2HLO C2300456 DUMMY(6)= 2HCL C2300457C *************************************************************127*5125C2300458405 IMODE = 2HA C2300459 IF(IDATA(18).NE.0) IMODE = IDATA(18) C2300460C *************************************************************127*5125C2300461 IF(IREMOT.EQ.2) ITYPE = 2HN C2300462C C2300463C C2300464C SET UP FOR HOST FILE MANAGER CALLS C2300465C C2300466 CPDAT(1)=$2424 C2300467ÐÐ CPDAT(2)=$484F C2300468 CPDAT(3)=$5354 C2300469 CPDAT(5)=$2424 C2300470 CPDAT(9)=$5359 C2300471 CPDAT(10)=$5356 C2300472 CPDAT(11)=$4F4C C2300473 CPDAT(13)=0 C2300474 CPDAT(14)=NUMREC C2300475 CPDAT(15)=0 C2300476C C2300477C OPEN HOST FILE C2300478C C2300479 CALL OPENFL(CPREQ,CPDAT,ISTAT) C2300480 IF(ISTAT)8000,410,410 C2300481C C2300482C READ IN HOST FILE C2300483C C2300484 410 CALL GETS(CPREQ,RECBUF,KEYVAL,ISTAT) C2300485 IF(ISTAT)8000,420,420 C2300486C C2300487C CLOSE HOST FILE C2300488C C2300489 420 CALL CLOSFL(CPREQ,ISTAT) C2300490 IF(ISTAT)8000,425,425 C2300491C C2300492ÐÐC LOOP THRU HOST FILE, LOOKING FOR HOST NAME MATCH C2300493C C2300494 425 K=LENREC*NUMREC C2300495 M=0 C2300496 DO 430 I=1,K,LENREC C2300497 IF(RECBUF(I).EQ.DUMMY(5).AND.RECBUF(I+1).EQ.DUMMY(6)) GO TO 435 C2300498 M=M+1 C2300499 430 CONTINUE C2300500C C2300501C HOST NAME NOT FOUND. GO TO ERROR C2300502C C2300503 GO TO 8030 C2300504C C2300505C HOST NAME FOUND. SET WORD 1 OF JOBNO = TO I C2300506C C2300507 435 JOBNO(1)=AND(JOBNO(1),$FFF0)+M C2300508C C2300509C LOOP OVER THIS HOST RECORD FOR INACTIVE JOB NO. C2300510C C2300511 N=0 C2300512 LL=M*LENREC+4 C2300513 KK=(M+1)*LENREC C2300514 DO 440 J=LL,KK C2300515 N=N+1 C2300516 IF(STAT1(J).EQ.0) GO TO 450 C2300517ÐÐ N=N+1 C2300518 IF(STAT2(J).EQ.0) GO TO 460 C2300519 N=N+1 C2300520 IF(STAT3(J).EQ.0) GO TO 470 C2300521 N=N+1 C2300522 IF(STAT4(J).EQ.0) GO TO 480 C2300523 440 CONTINUE C2300524C C2300525C NO EMPTY JOB NOS. FOR THIS HOST. GO TO ERROR. C2300526C C2300527 GO TO 8040 C2300528C C2300529C EMPTY JOB NO. FOUND. SET IND = STATUS BYTE. C2300530C SET WORD 2 OF JOBNO TO HOST WORD BYTE NO. C2300531C C2300532 450 IND=1 C2300533 GO TO 490 C2300534 460 IND=2 C2300535 GO TO 490 C2300536 470 IND=3 C2300537 GO TO 490 C2300538 480 IND=4 C2300539C C2300540C CONVERT JOB NO. TO ASCII C2300541C C2300542ÐÐ 490 CALL BINASC(N,JOBNO(2)) C2300543 IF(AND(JOBNO(4),$FF00).EQ.$2000)JOBNO(4)=$3000+AND(JOBNO(4),$FF) C2300544 JOBNO(2)=JOBNO(4) C2300545C C2300546C GET FCB HEADER FOR INPUT FILE C2300547C LDA =XFCBHDR C2300548C STA+ REQBUF+9 C2300549C C2300550 ASSEM $C000,+FCBHDR C2300551 ASSEM $6400,+REQBUF(10) C2300552C C2300553C SET UP TO ACCESS INPUT FILE C2300554C C2300555 IDATA(13)=0 C2300556 IDATA(14)=1 C2300557 IDATA(15)=1 C2300558 REQBUF(13)=0 C2300559C C2300560C OPEN INPUT FILE C2300561C C2300562 CALL OPENFL(REQBUF,IDATA,ISTAT) C2300563 IF(ISTAT)8010,491,491 C2300564491 IVLNM = IDATA(9) C2300565 IDATA(9) = 0 C2300566 INDEX = 0 C2300567ÐÐ CALL GETFCB (REQBUF,IDATA(9),INDEX,FCBBUF,ISTAT) C2300568 IF (ISTAT) 8010,4900,4900 C23005694900 IDATA(9) = IVLNM C2300570C **** 138*A025C2300571C C2300572C CHECK FOR INPUT FILE RECORD LENGTH = 80 CHARACTERS C2300573C C2300574 IF (RECLEN.NE.40) GO TO 8053 C2300575C **** 138*A025C2300576C C2300577C SEE IF SECTOR ALIGNED, IF SO ERROR C2300578C C2300579C *************************************************************127*5125C2300580 IF(AND(FCBIND,$8000).NE.0) GO TO 8055 C2300581C *************************************************************127*5125C2300582 NUMREC = BUFSIZ/RECLEN C2300583 RELHLD=RECLEN C2300584 REQBUF(13) = NUMREC C2300585C C2300586C CREATE NEW JOB FILE C2300587C C23005884911 DO 492 I=1,24 C2300589 JOBREQ(I)=0 C2300590 492 CONTINUE C2300591 IRECLN = RELHLD*2 C2300592ÐÐ JOBDAT(1)=JOBNO(1) C2300593 JOBDAT(2)=JOBNO(2) C2300594 JOBDAT(5)=$2424 C2300595 JOBDAT(13)=IRECLN C2300596 JOBDAT(14)=0 C2300597 JOBDAT(15) = TDATRL+20 C2300598 JOBDAT(16)=0 C2300599C C2300600C C2300601C THE FOLLOWING CODE PICKS UP OUT OF SYSDAT A TABLE THAT CONTAINS C2300602C THE VOLUME NAME TO CREATE A SCRATCH FILE. C2300603C C2300604C C2300605C LDQ+ WKSPLU C2300606C LDQ+ MMLUTB,Q C2300607C INQ 1 C2300608C LDA- (ZERO),Q C2300609C STA+ JOBDAT(9) C2300610C STA+ OUTDAT(9) C2300611C LDA- 1,Q C2300612C STA+ JOBDAT(10) C2300613C STA+ OUTDAT(10) C2300614C LDA- 2,Q C2300615C STA+ JOBDAT(11) C2300616C STA+ OUTDAT(11) C2300617ÐÐC LDA- 3,Q C2300618C STA+ JOBDAT(12) C2300619C STA+ OUTDAT12) C2300620C C2300621C C2300622 ASSEM $E400,+WKSPLU,$E600,+MMLUTB,$D01 C2300623 ASSEM $C622,$6400,+JOBDAT(9),$6400,+OUTDAT(9) C2300624 ASSEM $C201,$6400,+JOBDAT(10),$6400,+OUTDAT(10) C2300625 ASSEM $C202,$6400,+JOBDAT(11),$6400,+OUTDAT(11) C2300626 ASSEM $C203,$6400,+JOBDAT(12),$6400,+OUTDAT(12) C2300627 CALL CREATE(JOBREQ,JOBDAT,ISTAT) C2300628 IF(ISTAT)493,496,496 C2300629C C2300630C CHECK IF THIS FILE (JMNN) ALREADY EXISTS C2300631C C2300632 493 IF(IDUPE.EQ.0) GO TO 8025 C2300633C C2300634C FILE ALREADY EXISTS. SET UP TO DELETE OLD JOB FILE C2300635C C2300636 OUTDAT(1)=JOBNO(1) C2300637 OUTDAT(2)=JOBNO(2) C2300638 OUTDAT(5)=$2424 C2300639 OUTDAT(13)=0 C2300640 OUTDAT(14)=1 C2300641 OUTDAT(15)=0 C2300642ÐÐ CALL OPENFL(OUTREQ,OUTDAT,ISTAT) C2300643 IF(ISTAT)8060,495,495 C2300644 495 CALL CLOSFL(OUTREQ,ISTAT) C2300645 CALL DELETE(OUTREQ,OUTDAT,ISTAT) C2300646 IF(ISTAT)8060,4911,4911 C2300647 496 IK=1 C2300648 JOBDAT(13)=0 C2300649 JOBDAT(14)=1 C2300650 JOBDAT(15)=0 C2300651 CALL OPENFL(JOBREQ,JOBDAT,ISTAT) C2300652 IF(ISTAT)8025,500,500 C2300653C C2300654C READ RECORD OF INPUT FILE, AND LOOK FOR *JOB RECORD C2300655C C2300656500 IJCL = 1 C2300657 IF(ITYPE.EQ.2HN )GO TO 508 C2300658C C2300659501 IF(IJCL.EQ.0) GO TO 508 C2300660 DO 502 I=1,40 C2300661 INPBUF(I) = $2020 C2300662502 CONTINUE C2300663 GO TO (503,504,505),IJCL C2300664C C2300665C JOB CARD C2300666C C2300667ÐÐ503 INPBUF(1) =$2A4A C2300668 INPBUF(2) =$4F42 C2300669 IJCL = IJCL+1 C2300670 IJBB = 1 C2300671 GOTO 520 C2300672C C2300673C *K,P2 C2300674C C2300675504 INPBUF(1) = $2A4B C2300676 INPBUF(2) = $2C50 C2300677 INPBUF(3) = $3220 C2300678 IJCL = IJCL + 1 C2300679 GO TO 507 C2300680C C2300681C * RPGII *ASSEM *FTN *COBOL C2300682C C2300683505 JX=1 C2300684 IF(ITYPE.EQ.2HR ) JX=1 C2300685 IF(ITYPE.EQ.2HA )JX=4 C2300686 IF(ITYPE.EQ.2HF )JX=7 C2300687 IF(ITYPE.EQ.2HC )JX=10 C2300688 DO 506 K=1,3 C2300689 KJ = K + JX -1 C2300690506 INPBUF(K) = IPRG(KJ) C2300691 IJCL=0 C2300692ÐÐC C2300693C C2300694507 RECNUM = 1 C2300695 CALL PUTS(JOBREQ,INPBUF,RECNUM,ISTAT) C2300696 IF(ISTAT)8025,501,501 C2300697C C2300698C C2300699508 IF(IFINEF.EQ.1) GO TO 535 C2300700 CALL GETS(REQBUF,INPBUF,KEYVAL,ISTAT) C2300701 IJCL = 0 C2300702 IF(ISTAT) 8010,509,509 C2300703C C2300704C SEARCH FOR *JOB CARD FOR REMOTE HOST C2300705C C2300706509 DO 1510 IJBB = 1,BUFSIZ,RELHLD C2300707 IF(INPBUF(IJBB).EQ.$2A4A.AND.INPBUF(IJBB+1).EQ.$4F42) GO TO 520 C23007081510 CONTINUE C2300709C C2300710C C2300711C SEARCH BUFFER FOR PSEUDO END OF FILE C2300712C C2300713510 DO 1509 IEF=1,BUFSIZ,RELHLD C2300714 IF(INPBUF(IEF).EQ.IEOF) GO TO 517 C2300715 IEFXX = IEFXX + 1 C23007161509 CONTINUE C2300717ÐÐC *************************************************************127*5183C2300718 IEFXX = 0 C2300719C *************************************************************127*5183C2300720 IF(ILESS.EQ.1) GO TO 516 C2300721C C2300722C C2300723C MOVE RECORD TO NEW JOB FILE C2300724C C2300725511 RECNUM = NUMREC C2300726512 CALL PUTS(JOBREQ,INPBUF,RECNUM,ISTAT) C2300727 IF(ISTAT)8025,508,508 C2300728C C2300729516 RECNUM = REQBUF(15) C2300730 GOTO 512 C2300731C C2300732517 RECNUM = IEFXX C2300733 IFINEF = 1 C2300734 IF(RECNUM.EQ.0) GO TO 535 C2300735 GO TO 512 C2300736C C2300737C MOVE JOBNO, INPUT FILE NAME, AND OWNER C2300738C NAME TO THIS RECORD. C2300739C C2300740520 INPBUF(IJBB+2) = $2C*$100 C2300741 INPBUF(IJBB+2)=AND(INPBUF(IJBB+2),$FF00)+(AND(JOBNO(1),$FF00)/$100C2300742ÐÐ *) C2300743 INPBUF(IJBB+3)=AND(JOBNO(1),$FF)*$100+(AND(JOBNO(2),$FF00)/$100) C2300744 INPBUF(IJBB+4)=AND(JOBNO(2),$FF)*$100+$2C C2300745 DO 530 I=1,4 C2300746 IXIX =IJBB+I+4 C2300747 IF (IDATA(5) .EQ. BLANK) GO TO 525 C2300748C C2300749 INPBUF(IXIX) = IDATA(I+4) C2300750 GO TO 530 C2300751525 INPBUF(IXIX) = ILOCL(I) C2300752C C2300753 530 CONTINUE C2300754 IJOB=1 C2300755 IF(IJCL.NE.0) GOTO 507 C2300756C C2300757C WRITE BACK RECORD TO NEW JOB FILE C2300758C C2300759 GO TO 510 C2300760C C2300761C SET UP FOR BATCH FILE ACCESS C2300762C C2300763535 IF(ITYPE.EQ.2HN )GO TO 536 C2300764 CALL JCLE(JOBREQ,ISTAT,ITYPE,IMODE) C2300765C *************************************************************127*5183C2300766 IF(ISTAT)8057,536,536 C2300767ÐÐC *************************************************************127*5183C2300768536 BATDAT(1)=$2424 C2300769 BATDAT(2)=$4241 C2300770 BATDAT(3)=$5443 C2300771 BATDAT(4)=$4820 C2300772 BATDAT(5)=$2424 C2300773 BATDAT(9)=$5359 C2300774 BATDAT(10)=$5356 C2300775 BATDAT(11)=$4F4C C2300776 BATDAT(13)=1 C2300777 BATDAT(14)=1 C2300778 BATDAT(15)=1 C2300779 CALL OPENFL(BATREQ,BATDAT,ISTAT) C2300780 IF(ISTAT)8020,540,540 C2300781C C2300782C READ RECORD(JOBNO) OF BATCH FILE C2300783C C2300784 540 CALL READR(BATREQ,BATBUF,JOBNO,ISTAT) C2300785 IF(ISTAT)8020,550,550 C2300786C C2300787C MOVE VOLUME NAME, OWNER NAME, AND JOB NO. TO C2300788C BATCH FILE BUFFER C2300789C C2300790 550 DO 560 I=1,4 C2300791 BATBUF(I+2)=IDATA(I+8) C2300792ÐÐ 560 CONTINUE C2300793 DO 570 I=1,4 C2300794 BATBUF(I+6)=IDATA(I+4) C2300795 570 CONTINUE C2300796 DO 580 I=1,2 C2300797 BATBUF(I+10)=JOBNO(I) C2300798 580 CONTINUE C2300799C C2300800C PUT CURRENT DATE AND TIME IN BATCH BUFFER C2300801C C2300802 ASSEM $C400,+ADAYTO,$6800,BATBUF(15) C2300803 ASSEM $C400,+AMONTO,$6800,BATBUF(16) C2300804 ASSEM $C400,+AYERTO,$6800,BATBUF(17) C2300805 ASSEM $C400,+HORTO,$6800,IHOUR C2300806 ASSEM $C400,+MINTO,$6800,IMIN C2300807 ASSEM $C400,+SECON,$6800,ISEC C2300808C C2300809C CONVERT HOURS, MINUTES AND SECONDS TO ASCII C2300810C C2300811 CALL BINASC(IHOUR,BATBUF(18)) C2300812 BATBUF(18)=BATBUF(20) C2300813 CALL BINASC(IMIN,BATBUF(19)) C2300814 BATBUF(19)=BATBUF(21) C2300815 CALL BINASC(ISEC,BATBUF(20)) C2300816 BATBUF(20)=BATBUF(22) C2300817ÐÐ BATBUF(21)=$2020 C2300818 BATBUF(22)=$2020 C2300819C C2300820C WRITE BACK UPDATED BATCH FILE RECORD C2300821C C2300822 CALL UPDREC(BATREQ,BATBUF,ISTAT) C2300823 IF(ISTAT)8020,581,581 C2300824C C2300825C OPEN AND LOCK HOST FILE RECORD C2300826C C2300827 581 DO 591 I=1,24 C2300828 CPREQ(I)=0 C2300829 591 CONTINUE C2300830 IRECNO(1)=0 C2300831 IRECNO(2)=1 C2300832 CPDAT(15)=1 C2300833 CALL OPENFL(CPREQ,CPDAT,ISTAT) C2300834 IF(ISTAT)8000,595,595 C2300835 595 CALL READR(CPREQ,RECBUF,IRECNO,ISTAT) C2300836 IF(ISTAT)8000,596,596 C2300837C C2300838C SET STATUS BYTE IN HOST = 1 (NOT SENT) C2300839C C2300840 596 GO TO (582,583,584,585),IND C2300841 582 STAT1(J)=1 C2300842ÐÐ GO TO 590 C2300843 583 STAT2(J)=1 C2300844 GO TO 590 C2300845 584 STAT3(J)=1 C2300846 GO TO 590 C2300847 585 STAT4(J)=1 C2300848C C2300849C WRITE BACK UPDATED HOST FILE RECORD C2300850C C2300851 590 CALL UPDREC(CPREQ,RECBUF,ISTAT) C2300852 IF(ISTAT)8000,600,600 C2300853C C2300854C OUTPUT JOBNO TO CRT C2300855C C2300856 600 LNGO=7 C2300857 CALL WTREAD(LUNIT,NOCUR,JOB,LNGO,NOCUR,DUMMY,ZRO,TC) C2300858 GO TO 9000 C2300859C C2300860C ERROR MESSAGE SECTION C2300861C C2300862C HOST FILE MANAGER ERROR C2300863C C2300864 8000 CALL ERCHK(ISTAT,CPREQ(4)) C2300865 JK=1 C2300866 IF(IK.EQ.1) GO TO 8400 C2300867ÐÐ GO TO 8500 C2300868C C2300869C INPUT FILE MANAGER ERROR C2300870C C2300871 8010 CALL ERCHK(ISTAT,REQBUF(4)) C2300872 IF(EOF.NE.0) GO TO 8050 C2300873 JK=1 C2300874 IF(IK.EQ.1) GO TO 8400 C2300875 GO TO 8500 C2300876C C2300877C BATCH FILE MANAGER ERROR C2300878C C2300879 8020 CALL ERCHK(ISTAT,BATREQ(4)) C2300880 JK=1 C2300881 IF(IK.EQ.1) GO TO 8400 C2300882 GO TO 8500 C2300883C C2300884C JOB FILE MANAGER ERROR C2300885C C2300886 8025 CALL ERCHK(ISTAT,JOBREQ(4)) C2300887 JK=1 C2300888 IF(IK.EQ.1) GO TO 8400 C2300889 GO TO 8500 C2300890C C2300891C SET INDEX HOST NAME NOT FOUND C2300892ÐÐC C2300893 8030 CONTINUE C2300894 INDEX = KERBAS + 1 C2300895 IF(IK.EQ.1) GO TO 8400 C2300896 GO TO 8100 C2300897C C2300898C SET INDEX NO ROOM IN BATCH FILE C2300899C C2300900 8040 CONTINUE C2300901 INDEX = KERBAS + 13 C2300902 IF(IK.EQ.1) GO TO 8400 C2300903 GO TO 8100 C2300904C C2300905C SET INDEX NO *JOB IN INPUT FILE C2300906C C2300907 8050 IF(IJOB.EQ.1) GO TO 535 C2300908 INDEX = KERBAS + 14 C2300909 IF(IK.EQ.1) GO TO 8400 C2300910 GO TO 8100 C2300911C **** 138*A025C2300912C C2300913 8053 INDEX = 87 C2300914+ INPUT FILE SIZE NOT 80 CHARACTERS C2300915 GO TO 8100 C2300916C **** 138*A025C2300917ÐÐC *************************************************************127*5183C2300918C C2300919C SECTOR ALIGN ERROR - CAN NOT OPEN INPUT FILE C2300920C C2300921C ***** 138*A015C2300922C THE EARLIER PSR HAS BEEN SUPERCEDED BY THIS LATER PSR C2300923 8055 INDEX = 90 C2300924 CALL SYSMSG (INDEX,FCBBUF(25)) C2300925 GO TO 8600 C2300926C ***** 138*A015C2300927C C2300928C JXXX FILE OUTPUT ERROR C2300929C C23009308057 CALL ERCHK(ISTAT,JOBREQ(4)) C2300931 GO TO 8500 C2300932C *************************************************************127*5183C2300933C C2300934C OUTPUT FILE FM ERROR C2300935C C2300936 8060 CALL ERCHK(ISTAT,OUTREQ(4)) C2300937 GO TO 8500 C2300938C C2300939C NO *JOB RECORD FOUND OR FILE MANAGER ERROR SINCE C2300940C CREATING JOB FILE. DELETE SAME. C2300941C C2300942ÐÐ 8400 CALL CLOSFL(JOBREQ,ISTAT) C2300943 CALL DELETE(JOBREQ,JOBDAT,ISTAT) C2300944 IF(JK.EQ.1) GO TO 8500 C2300945C C2300946C OUTPUT ERROR MESSAGE C2300947C C2300948 8100 CALL SYSMSG(INDEX,ERBUF) C2300949 8500 IF(PIND)8600,8600,11 C2300950 8600 IF(MODE)8700,9000,8700 C2300951 8700 ASSEM $E400,+MODE C2300952 ASSEM $D622 C2300953 9000 CALL CLOSFL(CPREQ,ISTAT) C2300954 CALL CLOSFL(REQBUF,ISTAT) C2300955 CALL CLOSFL(BATREQ,ISTAT) C2300956 CALL CLOSFL(JOBREQ,ISTAT) C2300957 RETURN C2300958 END C2300959 SUBROUTINE BATS C2400001 1 /C24 F ITOS CCS 3.0 SL-149C2400002C COMMAND PROCESSOR FOR BATCH STATUS C2400003C CREDIT COLLECTION SYSTEM VERSION 3.0 C2400004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C2400005C COPYRIGHT CONTROL DATA CORPORATION 1979 C2400006C C2400007C** C2400008ÐÐC COMMAND PROCESSOR FOR BATCH C2400009C CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.0 C2400010C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C2400011C COPYRIGHT CONTROL DATA CORPORATION 1977 C2400012C C2400013C C2400014C FUNCTION C2400015C C2400016C THIS IS THE BATCH STATUS PROCESSOR C2400017C C2400018C THIS COMMAND LISTS OR DISPLAYS THE STATUS OF AN INDIVIDUAL C2400019C ACTIVE JOB, STATUS OF ALL ACTIVE JOBS BY HOST, OR STATUS C2400020C OF ALL ACTIVE JOBS FOR ALL HOSTS. IN ADDITION, A SUMMARY C2400021C MAY BE REQUESTED TO DISPLAY OR PRINT A TABULAR SUMMARY C2400022C OF ALL JOBS BY HOST OR FOR ALL HOSTS. C2400023C C2400024C GENERAL DESCRIPTION C2400025C C2400026C THIS PROCESSOR ACCEPTS INPUT FROM EITHER AN INTERACTIVE C2400027C DEVICE OR THE DEVICE IT WAS INITIATED ON. THE PROCESSOR C2400028C RUNS UNDER THE FILE MANAGER UTILITY EXECUTIVE PROGRAM. C2400029C THE COMMAND FORMAT IS C2400030C BATS,JN=NNNN,HO=AAAA,LU=AAAAAAA C2400031C JN=JOB NO. C2400032C HO=HOST NAME C2400033ÐÐC LU=LOGICAL UNIT C2400034C C2400035C C2400036C FLOW C2400037C C2400038C THE PROCESSOR DETERMINES THE LEVEL OF PROMPTING REQUIRED, C2400039C DISPLAYS THE PARAMETERS AND STORES THE PARAMETER VALUES C2400040C INTO THE REQUIRED LOCATIONS. C2400041C C2400042C C2400043C IF THE JOB NUMBER IS NOT EQUAL TO 'SUMM', THE PROCESSOR C2400044C PICKS UP THE ACTIVE JOB NUMBER, ALL JOB NUMBERS BY HOST, C2400045C OR ALL JOB NUMBERS FOR ALL HOSTS AND DISPLAYS OR PRINTS THE C2400046C APPROPRIATE STATUS (USER TERMINALS MAY ONLY GET STATUS C2400047C OF THOSE JOBS ASSOCIATED WITH THAT USER ID). FOR JOB C2400048C NUMBER EQUAL TO 'SUMM', ALL STATUS TYPES ARE TOTALED, C2400049C EITHER BY HOST OR FOR ALL HOSTS AND A TABULATED SUMMARY C2400050C IS DISPLAYED OR PRINTED. THE SUMMARY OPTION IS AVAILABLE C2400051C FROM THE MASTER TERMINAL ONLY. C2400052C C2400053C C2400054C ERROR MESSAGES C2400055C C2400056C 901 HOST NAME NOT FOUND C2400057C 916 INVALID OWNER C2400058ÐÐC 917 STATUS ERROR (=6, NOT USED) C2400059C 918 FM ERROR FROM BATCHK SUBROUTINE C2400060C 919 JOB NUMBER NOT FOUND C2400061C 920 JOB INACTIVE C2400062C C2400063C C2400064M FMUCOM C2400065. C2400066C C2400067 INTEGER OWNR12,OWNR34,OWNR56,OWNR78,RECLEN,TDATRM,TDATRL C2400068 INTEGER DATBAM,DATBAL,FCBIND,TNKEYM,TNKEYL,POSKY1,POSKY2 C2400069 INTEGER POSKY3,POSKY4,TSFILM,TSFILL,EXPDAT,CRTDAT,FILTYP C2400070 INTEGER NOCUR,ZRO,ERBUF,PARNUM,PARID,PPTEMP(17),PPTAB(6) C2400071 INTEGER BUFLEN,TC,OUTP,BLANK,QUEST,STAT,OPN,WVL,FTYPE C2400072 INTEGER OPN,WVL C2400073 INTEGER RECBUF C2400074 INTEGER CPDAT(24),CPREQ(24),CPVOL,CPHDR(5),CPFCB(96),CPWIND C2400075 INTEGER CPRECL,CPFIND,CPLEN1,CPPOS1 C2400076 INTEGER STAT1(18),STAT2(18),STAT3(18),STAT4(18) C2400077 INTEGER STATBF(61),STATHD(14),SUMHD(30) C2400078 INTEGER SUMBUF(31),INAM(2),ILU,ITYPE(3),INACT,CUED C2400079 INTEGER SENT,RECD,IPRNT,ABORT,FLAG,FIRST,STATUS,STOUT(40) C2400080 INTEGER JOBNO(4),HOST(2),REC C2400081 INTEGER BINASC, IREC(2),TEMP(8) C2400082 INTEGER LINCNT,LPAUSE,MSGPAU(3),PRINT C2400083ÐÐC C2400084 DIMENSION IPNAM(17) C2400085 DIMENSION IREQ(17) C2400086 DIMENSION IFND(17) C2400087 DIMENSION NAME(18) C2400088 DIMENSION NAME12(4) C2400089 DIMENSION OWNR12(4) C2400090 DIMENSION KEYVAL(15) C2400091 DIMENSION RECBUF(322) C2400092 DIMENSION KO(42) C2400093C C2400094 DATA KO/ $0A0D, 41*$2020/ C2400095C C2400096 EQUIVALENCE(PPBATS,PPTAB) C2400097 EQUIVALENCE (CPRECL,CPFCB(1)) C2400098 EQUIVALENCE (CPFIND,CPFCB(6)) C2400099 EQUIVALENCE (CPLEN1,CPFCB(15)) C2400100 EQUIVALENCE (CPPOS1,CPFCB(16)) C2400101 BYTE (IDEL,ISTAT(4=4)) C2400102. C2400103C C2400104C FILE CONTROL BLOCK C2400105C C2400106 EQUIVALENCE (RECLEN,FCBBUF(1)) C2400107 EQUIVALENCE (TDATRM,FCBBUF(2)) C2400108ÐÐ EQUIVALENCE (TDATRL,FCBBUF(3)) C2400109 EQUIVALENCE (DATBAM,FCBBUF(4)) C2400110 EQUIVALENCE (DATBAL,FCBBUF(5)) C2400111 EQUIVALENCE (FCBIND,FCBBUF(6)) C2400112 EQUIVALENCE (NEDATM,FCBBUF(7)) C2400113 EQUIVALENCE (NEDATL,FCBBUF(8)) C2400114 EQUIVALENCE (NEXTBM,FCBBUF(9)) C2400115 EQUIVALENCE (NEXTBL,FCBBUF(10)) C2400116 EQUIVALENCE (TNKEYM,FCBBUF(11)) C2400117 EQUIVALENCE (TNKEYL,FCBBUF(12)) C2400118 EQUIVALENCE (KEYBAM,FCBBUF(13)) C2400119 EQUIVALENCE (KEYBAL,FCBBUF(14)) C2400120 EQUIVALENCE (LENKY1,FCBBUF(15)) C2400121 EQUIVALENCE (POSKY1,FCBBUF(16)) C2400122 EQUIVALENCE (LENKY2,FCBBUF(17)) C2400123 EQUIVALENCE (LENKY3,FCBBUF(19)) C2400124 EQUIVALENCE (LENKY4,FCBBUF(21)) C2400125 EQUIVALENCE (TSFILM,FCBBUF(23)) C2400126 EQUIVALENCE (TSFILL,FCBBUF(24)) C2400127 EQUIVALENCE (NAME12,FCBBUF(25)) C2400128 EQUIVALENCE (OWNR12,FCBBUF(29)) C2400129 EQUIVALENCE (EXPDAT,FCBBUF(89)) C2400130 EQUIVALENCE (CRTDAT,FCBBUF(92)) C2400131 EQUIVALENCE (FTYPE,FCBBUF(95)) C2400132C C2400133ÐÐC EXTERNALS C2400134C C2400135 EXTERNAL MMLUTB C2400136 EXTERNAL WTREAD C2400137 EXTERNAL GETFLD C2400138 EXTERNAL SYSMSG C2400139 EXTERNAL MOVEL C2400140 EXTERNAL OPENFL C2400141 EXTERNAL GETFCB C2400142 EXTERNAL BINASC C2400143 EXTERNAL LUNEQ C2400144 EXTERNAL BATCHK C2400145C C2400146C C2400147 BYTE (IEOF,ISTAT(8=8)) C2400148 BYTE (NUM1,IDATA(24)(3=0)) C2400149 BYTE (NUM2,IDATA(24)(11=8)) C2400150 C2400151 BYTE (IFND,PPTEMP(15=15)) C2400152 BYTE (IREQ,PPTEMP(12=12)) C2400153 BYTE (IPNAM,PPTEMP(7=0)) C2400154C C2400155 BYTE (OPN,ISTAT(0=0)) C2400156 BYTE (IRLOK,ISTAT(3=3)) C2400157 BYTE (INUNK,ISTAT(4=4)) C2400158ÐÐ BYTE (MME,ISTAT(5=5)) C2400159 BYTE (MFOS,ISTAT(11=11)) C2400160 BYTE (MFO,ISTAT(12=12)) C2400161 BYTE (IOUT,ISTAT(12=12)) C2400162 BYTE (WVL,ISTAT(13=13)) C2400163 BYTE (ILR,ISTAT(14=14)) C2400164 BYTE(STAT1,RECBUF(15=12)) C2400165 BYTE(STAT2,RECBUF(11=8)) C2400166 BYTE(STAT3,RECBUF(7=4)) C2400167 BYTE(STAT4,RECBUF(3=0)) C2400168C C2400169 DATA NOCUR/-1/,ZRO/0/ C2400170 DATA BUFLEN/40/ C2400171 DATA BLANK/$2020/ C2400172 DATA QUEST/'? '/ C2400173 DATA NAME/'JOB NO. = HOST NAME = LOGCAL UNIT='/ C2400174 DATA STATHD/ ' JOB NO. HOST STATUS' , $0D0A/ C2400175 DATA SUMHD/' NAME LU TYPE INACT QUEUED SENT RECD PRINT AC2400176 1BORT '/ C2400177 DATA STATBF/'NOT SENTBEING SENTSENTOUTPUT RECEIVED PRINT REQUEST JC2400178 1OB ABORTED DISCARD PENDING, JOB BEING SENT DISCARD PENDING, JOB SEC2400179 2NT'/ C2400180 DATA JOBNO/$4A30,$3030,$2020,$2020/ C2400181 DATA STATHD(1)/$0D0A/ C2400182 DATA SUMHD(1)/$0D0A/ C2400183ÐÐ DATA SUMBUF/ $0D0A, 30*$2020/ C2400184 DATA STOUT(1)/$0D0A/ C2400185 DATA FLAG/0/ C2400186 DATA LPAUSE/3/ C2400187 DATA MSGPAU/'PAUSE '/ C2400188C *************************************************************127*5178C2400189 DATA PRINT/$1009/ C2400190C *************************************************************127*5178C2400191C C2400192 DATA KERBAS/ 400/ C2400193. C2400194C C2400195C INITIALIZATION C2400196C C2400197 11 INDEX=0 C2400198+ ERROR MSG NO. C2400199 ERBUF=0 C2400200+ ERROR MSG BUF C2400201 ISTAT=0 C2400202+ STATUS OF FM-REQUEST C2400203 LNGO=0 C2400204+ LENGTH OF FIELD TO MOVE C2400205 MORPAR=0 C2400206+ INDICATOR IF MORE PARAMETERS NEEDED C2400207 MORLIN=0 C2400208ÐÐ+ INDICATOR IF MORE LINES NEED TO BE READ C2400209 PARNUM=0 C2400210+ COUNT OF REQ.AND NOT FOUND PARAMETERS C2400211 PARID=0 C2400212 IFLAG=0 C2400213 IP=1 C2400214 IND=0 C2400215 LINCNT=0 C2400216 JIND=0 C2400217C C2400218 ASSIGN 9000 TO INTLOC C2400219 CALL PGMINT(INTLOC,IFLAG) C2400220C C2400221C COPY THE PARAMETER PROCESSING TABLE C2400222C C2400223 I=0 C2400224 10 I=I+1 C2400225 PPTEMP(I)=PPTAB(I) C2400226 IF(PPTEMP(I))10,20,10 C2400227C C2400228C C2400229C C2400230 20 DO 30 I=1,24 C2400231 REQBUF(I)=0 C2400232 IDATA(I)=PARDEF(I) C2400233ÐÐ 30 CONTINUE C2400234 DO 31 I=1,6 C2400235 DUMMY(I)=BLANK C2400236 31 CONTINUE C2400237C C2400238 35 IF(PIND)110,70,40 C2400239C C2400240C PROMPTING LEVEL = 1 FULL PARAMETERS WILL BE DISPLAYED C2400241C C2400242 40 KI=IP C2400243 I=(IP-1)*6+1 C2400244 IF(IPNAM(IP))50,100,50 C2400245C C2400246 50 J=I+5 C2400247 K=1 C2400248 CODE(K)=$0A0D C2400249+ SET CR/LF C2400250 DO 60 I=I,J C2400251 K=K+1 C2400252 CODE(K)=NAME(I) C2400253 60 CONTINUE C2400254C C2400255 I=KI C2400256 LNGO=7 C2400257 GO TO 90 C2400258ÐÐ. C2400259C C2400260C PROMPTING LEVEL = 0 PARAMETER ABBREVIATIONS WILL BE DISPLAYED C2400261C C2400262 70 I=IP C2400263 K=IPNAM(IP) C2400264+ INDEX TO PARAM.MNEM.TABLE C2400265 IF(K)80,100,80 C2400266 80 K=(K-1)*3+1 C2400267C C2400268 CODE(1)=$0A0D C2400269 CODE(2)=PARNAM(K) C2400270 CODE(3)=$3D20 C2400271 LNGO=3 C2400272C C2400273C DISPLAY NEXT PARAMETER-IDENT C2400274C C2400275 90 CALL WTREAD (LUNIT,NOCUR,CODE,LNGO,NOCUR,DUMMY,ZRO,TC) C2400276C C2400277 PARID=IP C2400278+ INDEX IN PARNAM-TABLE C2400279 IFND(I)=1 C2400280+ SET FOUND FLAG C2400281 IP=IP+1 C2400282+ INCR. INDEX TO PPTEMP C2400283ÐÐ MORPAR=1 C2400284+ SET INDICATOR FOR MORE PARAMETERS NEEDED C2400285 GO TO 120 C2400286C C2400287C END OF PARAMETER LIST, ISSUE FM-REQUEST C2400288C C2400289 100 MORPAR=0 C2400290 GO TO 320 C2400291C C2400292C PROMPTING LEVEL = -1, NO PROMPTING DONE C2400293C C2400294 110 IF(MORLIN)115,130,130 C2400295+ DO WE NEED TO READ MORE LINES C2400296 115 MORLIN=0 C2400297C C2400298C READ NEXT LINE C2400299C C2400300 120 CALL WTREAD (LUNIT,NOCUR,DUMMY,ZRO,NOCUR,INBUF,BUFLEN,TC) C2400301C C2400302C RESET SWORD AND SBYTE C2400303C C2400304 SBYTE=0 C2400305 SWORD=0 C2400306. C2400307 130 CALL GETFLD (INBUF,CODE,SWORD,SBYTE,STAT) C2400308ÐÐC C2400309C C2400310 140 IF (STAT-2)150,160,200 C2400311 150 IF (STAT-1)260,250,250 C2400312C C2400313C EOL DETECTED,COUNT NO OF REQUIRED AND NOT FOUND PARAMETERS (STATUS=1)C2400314C C2400315 160 IF(PIND)161,162,162 C2400316 161 MORPAR=0 C2400317C C2400318C CHECK IF FULL NAME DESIRED C2400319C C2400320 162 IF (CODE(1)-QUEST)164,163,164 C2400321C C2400322C YES,FULL NAME FOR THIS PARAMETER ONLY C2400323C C2400324 163 IF (PIND .NE. -1) IP=IP-1 C2400325 GO TO 40 C2400326C C2400327C CHECK IF PARAMETER ENTERED C2400328C C2400329 164 IF(CODE(1)-BLANK)270,165,270 C2400330 165 IFND(IP-1)=0 C2400331 IF (PIND .EQ. -1) GO TO 320 C2400332 GO TO 35 C2400333ÐÐC C2400334C PARAMETER-ID FOUND (STATUS=3) C2400335C C2400336 200 I=1 C2400337 210 K=IPNAM(I) C2400338 K=(K-1)*3+1 C2400339C C2400340 IF (CODE(1)-PARNAM(K))230,220,230 C2400341C C2400342C PARAMETER-ID CORRESPONDS WITH PARAM.MNEMONIC TABLE C2400343C C2400344 220 PARID=I C2400345 IFND(I)=1 C2400346 GO TO 130 C2400347C C2400348 230 I=I+1 C2400349+ NO MATCH,CONTINUE C2400350 IF(IPNAM(I))210,240,210 C2400351C C2400352 240 INDEX=39 C2400353+ PARAMETER ILLEGAL C2400354 GO TO 8040 C2400355C C2400356C FIELD TERMINATED ON A SEMI-COLON (STATUS=1) C2400357C C2400358ÐÐ 250 MORLIN=-1 C2400359+ SET INDICATOR TO READ MORE LINES C2400360C C2400361C FIELD TERMINATED ON A COMMA (STATUS=0) C2400362C C2400363 260 MORPAR=1 C2400364+ SET INDICATOR FOR MORE PARAMETERS C2400365 IF(CODE(1) .NE. BLANK)GO TO 270 C2400366 IFND(IP)=0 C2400367 IP=IP+1 C2400368 GO TO 35 C2400369C C2400370C STORE PARAMETER VALUES INTO REQUIRED LOCATIONS C2400371C C2400372 270 IF (PARID)290,290,280 C2400373+ PARAMETER-ID FOUND C2400374 280 I=PARID C2400375+ YES C2400376 GO TO 300 C2400377C C2400378 290 I=IP C2400379 IF (CODE(1) .NE. BLANK) IFND(I)=1 C2400380 IP=IP+1 C2400381C C2400382 300 I=(IPNAM(I)-1)*3+1 C2400383ÐÐC C2400384 LNGO=PARNAM(I+1) C2400385 OUTP=PARNAM(I+2) C2400386C C2400387C STORE INTO DESIGNATED OUTPUT FIELD C2400388C C2400389 CALL MOVEL (CODE,OUTP,LNGO) C2400390C C2400391 PARID=0 C2400392 IF(MORPAR)310,320,310 C2400393+ ARE THERE MORE PARAM TO BE PROCESSED C2400394 310 IF(PIND) 110,70,40 C2400395+ YES C2400396C C2400397C C2400398C ARE ALL REQUIRED PARAMETERS FOUND ? C2400399C C2400400 320 I=0 C2400401 330 I=I+1 C2400402 IF(PPTEMP(I))330,360,340 C2400403C C2400404C PARAMETER NOT FOUND,IS IT REQUIRED ? C2400405C C2400406 340 IF(IREQ(I))330,350,330 C2400407C C2400408ÐÐC YES IT IS REQUIRED C2400409C C2400410 350 PARNUM=PARNUM+1 C2400411 GO TO 330 C2400412C C2400413C END OF PPTAB C2400414C C2400415 360 IF(PARNUM) 240,400,240 C2400416+ ARE ALL REQUIRED PARAMETERS FOUND C2400417C C2400418C ALL REQUIRED PARAMETERS HAVE BEEN FOUND C2400419C C2400420 400 IF(MORPAR .NE. 0) GO TO 310 C2400421C C2400422C SET UP FOR HOST FILE MANAGER CALLS C2400423C C2400424 IDATA(1)=$2424 C2400425 IDATA(2)=$484F C2400426 IDATA(3)=$5354 C2400427 IDATA(5)=$2424 C2400428 IDATA(9)=$5359 C2400429 IDATA(10)=$5356 C2400430 IDATA(11)=$4F4C C2400431 IDATA(13)=0 C2400432 IDATA(14)=1 C2400433ÐÐ IDATA(15)=0 C2400434 REQBUF(13)=0 C2400435C C2400436C GET FCB HEADER FOR HOST C2400437C LDA =XFCBHDR C2400438C STA+ REQBUF+9 C2400439C C2400440 ASSEM $C000,+FCBHDR C2400441 ASSEM $6400,+REQBUF(10) C2400442C C2400443C OPEN HOST FILE C2400444C C2400445 CALL OPENFL(REQBUF,IDATA,ISTAT) C2400446 IF(ISTAT)8000,420,420 C2400447C C2400448C CHECK IF JOB NO. = SUMMARY C2400449C C2400450 420 IF(IDATA(23).EQ.$5355.AND.IDATA(24).EQ.$4D4D) GO TO 1030 C2400451C C2400452C CHECK IF JOB NO ENTERED C2400453C C2400454 IF(IDATA(23).EQ.ZRO.AND.IDATA(24).EQ.ZRO) GO TO 490 C2400455 JOBNO(1)=IDATA(23) C2400456 JOBNO(2)=IDATA(24) C2400457C C2400458ÐÐC JOB NO. ENTERED. READ IN HOST FILE C2400459C C2400460 IREC(1)=0 C2400461 IREC(2)=AND(IDATA(23),$F) C2400462 IREC(2)=IREC(2)+1 C2400463 CALL READR(REQBUF,RECBUF,IREC,ISTAT) C2400464 IF(ISTAT)8000,430,430 C2400465C C2400466C LOOP THRU HOST FILE FOR JOB NO. C2400467C C2400468 430 HOST(1)=RECBUF(1) C2400469 HOST(2)=RECBUF(2) C2400470 ASSIGN 9000 TO ICOMP C2400471 FIRST=1 C2400472 JIND=1 C2400473 INUM=NUM1+NUM2*10 C2400474 N=0 C2400475 DO 440 I=4,RECLEN C2400476 N=N+1 C2400477 IF(INUM.EQ.N) GO TO 450 C2400478 N=N+1 C2400479 IF(INUM.EQ.N) GO TO 460 C2400480 N=N+1 C2400481 IF(INUM.EQ.N) GO TO 470 C2400482 N=N+1 C2400483ÐÐ IF(INUM.EQ.N) GO TO 480 C2400484 440 CONTINUE C2400485C C2400486C JOB NO NOT FOUND. GO TO ERROR C2400487C C2400488 GO TO 8035 C2400489C C2400490C PICK UP STATUS BYTE FOR JOB NO. C2400491C C2400492 450 STATUS=STAT1(I) C2400493 GO TO 3000 C2400494 460 STATUS=STAT2(I) C2400495 GO TO 3000 C2400496 470 STATUS=STAT3(I) C2400497 GO TO 3000 C2400498 480 STATUS=STAT4(I) C2400499 GO TO 3000 C2400500C C2400501C NO JOB NO. ENTERED. CHECK IF HOST NAME ENTERED C2400502C C2400503 490 IF(DUMMY(5).NE.BLANK.AND.DUMMY(6).NE.BLANK) GO TO 570 C2400504C C2400505C NO HOST ENTERED. STATUS REQUIRED FOR ENTIRE HOST FILE C2400506C C2400507 FIRST=1 C2400508ÐÐ REC=0 C2400509 495 REC=REC+1 C2400510 CALL GETS(REQBUF,RECBUF,KEYVAL,ISTAT) C2400511 IF(ISTAT)496,500,500 C2400512 496 IF(IEOF.EQ.0) GO TO 8000 C2400513 GO TO 9000 C2400514C C2400515C FIND ACTIVE STATUS BYTES C2400516C C2400517 500 HOST(1)=RECBUF(1) C2400518 HOST(2)=RECBUF(2) C2400519 N=0 C2400520 I=4 C2400521 JOBNO(1)=AND(JOBNO(1),$FFF0)+REC-1 C2400522 510 IF(I.GT.RECLEN) GO TO 495 C2400523 520 N=N+1 C2400524 IF(STAT1(I).EQ.0) GO TO 530 C2400525 ASSIGN 530 TO ICOMP C2400526 STATUS=STAT1(I) C2400527 GO TO 2090 C2400528 530 N=N+1 C2400529 IF(STAT2(I).EQ.0) GO TO 540 C2400530 ASSIGN 540 TO ICOMP C2400531 STATUS=STAT2(I) C2400532 GO TO 2090 C2400533ÐÐ 540 N=N+1 C2400534 IF(STAT3(I).EQ.0) GO TO 550 C2400535 ASSIGN 550 TO ICOMP C2400536 STATUS=STAT3(I) C2400537 GO TO 2090 C2400538 550 N=N+1 C2400539 IF(STAT4(I).EQ.0) GO TO 560 C2400540 ASSIGN 560 TO ICOMP C2400541 STATUS=STAT4(I) C2400542 GO TO 2090 C2400543 560 I=I+1 C2400544 GO TO 510 C2400545C C2400546C HOST NAME ENTERED. READ IN ENTIRE HOST FILE C2400547C C2400548 570 REQBUF(13)=TDATRL C2400549 CALL GETS(REQBUF,RECBUF,KEYVAL,ISTAT) C2400550 IF(ISTAT)8000,580,580 C2400551C C2400552C LOOP THRU HOST FILE FOR HOST NAME C2400553C C2400554 580 K=RECLEN*TDATRL C2400555 M=0 C2400556 DO 590 I=1,K,RECLEN C2400557 IF(RECBUF(I).EQ.DUMMY(5).AND.RECBUF(I+1).EQ.DUMMY(6)) GO TO 600 C2400558ÐÐ M=M+1 C2400559 590 CONTINUE C2400560C C2400561C HOST NOT FOUND. GO TO ERROR C2400562C C2400563 GO TO 8031 C2400564C C2400565C FIND ACTIVE STATUS BYTES FOR THIS HOST C2400566C C2400567 600 HOST(1)=RECBUF(I) C2400568 HOST(2)=RECBUF(I+1) C2400569 N=0 C2400570 JOBNO(1)=AND(JOBNO(1),$FFF0)+M C2400571 FIRST=1 C2400572 RECLEN=RECLEN+I-1 C2400573 I=I+3 C2400574 610 IF(I.GT.RECLEN) GO TO 9000 C2400575 620 N=N+1 C2400576 IF(STAT1(I).EQ.0) GO TO 630 C2400577 ASSIGN 630 TO ICOMP C2400578 STATUS=STAT1(I) C2400579 GO TO 2090 C2400580 630 N=N+1 C2400581 IF(STAT2(I).EQ.0) GO TO 640 C2400582 ASSIGN 640 TO ICOMP C2400583ÐÐ STATUS=STAT2(I) C2400584 GO TO 2090 C2400585 640 N=N+1 C2400586 IF(STAT3(I).EQ.0) GO TO 650 C2400587 ASSIGN 650 TO ICOMP C2400588 STATUS=STAT3(I) C2400589 GO TO 2090 C2400590 650 N=N+1 C2400591 IF(STAT4(I).EQ.0) GO TO 660 C2400592 ASSIGN 660 TO ICOMP C2400593 STATUS=STAT4(I) C2400594 GO TO 2090 C2400595 660 I=I+1 C2400596 GO TO 610 C2400597C*********** M A S T E R T E R M I N A L S E C T I O N *********** C2400598C*********** F O R S U M M A R Y *********** C2400599C C2400600C CHECK IF THIS IS THE MASTER TERMINAL C2400601C C2400602 1030 IF(NOPORT.NE.0) GO TO 8020 C2400603C C2400604C CHECK IF HOST NAME ENTERED C2400605C C2400606 IF(DUMMY(5).NE.BLANK.AND.DUMMY(6).NE.BLANK) GO TO 2040 C2400607C C2400608ÐÐC NO HOST ENTERED. STATUS SUMMARY REQUIRED FOR ENTIRE C2400609C HOST FILE C2400610C C2400611 1040 ASSIGN 1050 TO ICOMP C2400612C C2400613C INITIALIZE SUMMARY COUNTS C2400614C C2400615 FIRST=1 C2400616 1050 INACT=0 C2400617 CUED=0 C2400618 SENT=0 C2400619 RECD=0 C2400620 IPRNT=0 C2400621 ABORT=0 C2400622 1060 CALL GETS(REQBUF,RECBUF,KEYVAL,ISTAT) C2400623 IF(ISTAT)1070,1080,1080 C2400624 1070 IF(IEOF.EQ.0) GO TO 8000 C2400625 GO TO 9000 C2400626C C2400627C GET HOST NAME, LOGICAL UNIT AND TYPE C2400628C C2400629 1080 SUMBUF(2)=RECBUF(1) C2400630 SUMBUF(3)=RECBUF(2) C2400631 ILU=AND(RECBUF(3),$FF) C2400632 ITYPE=(AND(RECBUF(3),$300))/$100 C2400633ÐÐ 1085 CALL BINASC(ILU,SUMBUF(5)) C2400634 SUMBUF(5)=SUMBUF(7) C2400635 SUMBUF(6)=$2020 C2400636 SUMBUF(7)=$2020 C2400637 IF(ITYPE.EQ.0) GO TO 1090 C2400638 IF(ITYPE.EQ.1) GO TO 2000 C2400639 SUMBUF(7)=$4841 C2400640 SUMBUF(8)=$5350 C2400641 SUMBUF(9)=$2020 C2400642 GO TO 2010 C2400643 1090 IF(RECBUF(1).EQ.BLANK.AND.RECBUF(2).EQ.BLANK) GO TO 2005 C2400644 SUMBUF(7)=$4C4F C2400645 SUMBUF(8)=$434C C2400646 SUMBUF(9)=$2020 C2400647 GO TO 2010 C2400648 2000 SUMBUF(7)=$3230 C2400649 SUMBUF(8)=$3055 C2400650 SUMBUF(9)=$5420 C2400651 GO TO 2010 C2400652 2005 SUMBUF(7)=$2020 C2400653 SUMBUF(8)=$2020 C2400654 SUMBUF(9)=$2020 C2400655C C2400656C PICK UP STATUS BYTES C2400657C C2400658ÐÐ 2010 IF(IND.EQ.1) GO TO 2020 C2400659 I=4 C2400660 2020 IF(I.GT.RECLEN) GO TO 2070 C2400661 2030 IF(STAT1(I).EQ.0)INACT=INACT+1 C2400662 IF(STAT1(I).EQ.1)CUED=CUED+1 C2400663 IF(STAT1(I).EQ.2)SENT=SENT+1 C2400664 IF(STAT1(I).EQ.3)SENT=SENT+1 C2400665 IF(STAT1(I).EQ.4)RECD=RECD+1 C2400666 IF(STAT1(I).EQ.5)IPRNT=IPRNT+1 C2400667 IF(STAT1(I).EQ.7)ABORT=ABORT+1 C2400668 IF(STAT2(I).EQ.0)INACT=INACT+1 C2400669 IF(STAT2(I).EQ.1)CUED=CUED+1 C2400670 IF(STAT2(I).EQ.2)SENT=SENT+1 C2400671 IF(STAT2(I).EQ.3)SENT=SENT+1 C2400672 IF(STAT2(I).EQ.4)RECD=RECD+1 C2400673 IF(STAT2(I).EQ.5)IPRNT=IPRNT+1 C2400674 IF(STAT2(I).EQ.7)ABORT=ABORT+1 C2400675 IF(STAT3(I).EQ.0)INACT=INACT+1 C2400676 IF(STAT3(I).EQ.1)CUED=CUED+1 C2400677 IF(STAT3(I).EQ.2)SENT=SENT+1 C2400678 IF(STAT3(I).EQ.3)SENT=SENT+1 C2400679 IF(STAT3(I).EQ.4)RECD=RECD+1 C2400680 IF(STAT3(I).EQ.5)IPRNT=IPRNT+1 C2400681 IF(STAT3(I).EQ.7)ABORT=ABORT+1 C2400682 IF(STAT4(I).EQ.0)INACT=INACT+1 C2400683ÐÐ IF(STAT4(I).EQ.1)CUED=CUED+1 C2400684 IF(STAT4(I).EQ.2)SENT=SENT+1 C2400685 IF(STAT4(I).EQ.3)SENT=SENT+1 C2400686 IF(STAT4(I).EQ.4)RECD=RECD+1 C2400687 IF(STAT4(I).EQ.5)IPRNT=IPRNT+1 C2400688 IF(STAT4(I).EQ.7)ABORT=ABORT+1 C2400689 I=I+1 C2400690 GO TO 2020 C2400691C C2400692C HOST NAME ENTERED. READ IN ENTIRE HOST FILE C2400693C C2400694 2040 ASSIGN 9000 TO ICOMP C2400695 REQBUF(13)=TDATRL C2400696 CALL GETS(REQBUF,RECBUF,KEYVAL,ISTAT) C2400697 IF(ISTAT)8000,2050,2050 C2400698C C2400699C LOOP THRU HOST FILE FOR HOST NAME C2400700C C2400701 2050 K=RECLEN*TDATRL C2400702 DO 2060 I=1,K,RECLEN C2400703 IF(RECBUF(I).EQ.DUMMY(5).AND.RECBUF(I+1).EQ.DUMMY(6)) GO TO 2065 C2400704 2060 CONTINUE C2400705C C2400706C HOST NAME NOT FOUND. GO TO ERROR C2400707C C2400708ÐÐ GO TO 8031 C2400709 2065 SUMBUF(2)=RECBUF(I) C2400710 SUMBUF(3)=RECBUF(I+1) C2400711 ITYPE=AND((RECBUF(I+2),$300))/$100 C2400712 ILU=AND(RECBUF(I+2),$FF) C2400713 FIRST=1 C2400714 INACT=0 C2400715 CUED=0 C2400716 SENT=0 C2400717 RECD=0 C2400718 IPRNT=0 C2400719 ABORT=0 C2400720 RECLEN=RECLEN+I-1 C2400721 I=I+3 C2400722 IND=1 C2400723 GO TO 1085 C2400724C C2400725C MOVE STATUS COUNTS TO OUTPUT BUFFER C2400726C C2400727 2070 CALL BINASC(INACT,SUMBUF(11)) C2400728 IF(AND(SUMBUF(12),$FF).NE.$20) GO TO 2071 C2400729 SUMBUF(11)=SUMBUF(13) C2400730 GO TO 2072 C2400731 2071 SUMBUF(11)=SUMBUF(12) C2400732 SUMBUF(12)=SUMBUF(13) C2400733ÐÐ 2072 SUMBUF(13)=$2020 C2400734 CALL BINASC(CUED,SUMBUF(15)) C2400735 IF(AND(SUMBUF(16),$FF).NE.$20) GO TO 2073 C2400736 SUMBUF(15)=SUMBUF(17) C2400737 GO TO 2074 C2400738 2073 SUMBUF(15)=SUMBUF(16) C2400739 SUMBUF(16)=SUMBUF(17) C2400740 2074 SUMBUF(17)=$2020 C2400741 CALL BINASC(SENT,SUMBUF(18)) C2400742 IF(AND(SUMBUF(19),$FF).NE.$20) GO TO 2075 C2400743 SUMBUF(18)=SUMBUF(20) C2400744 GO TO 2076 C2400745 2075 SUMBUF(18)=SUMBUF(19) C2400746 SUMBUF(19)=SUMBUF(20) C2400747 2076 SUMBUF(20)=$2020 C2400748 CALL BINASC(RECD,SUMBUF(21)) C2400749 IF(AND(SUMBUF(22),$FF).NE.$20) GO TO 2077 C2400750 SUMBUF(21)=SUMBUF(23) C2400751 GO TO 2078 C2400752 2077 SUMBUF(21)=SUMBUF(22) C2400753 SUMBUF(22)=SUMBUF(23) C2400754 2078 SUMBUF(23)=$2020 C2400755 CALL BINASC(IPRNT,SUMBUF(24)) C2400756 IF(AND(SUMBUF(25),$FF).NE.$20) GO TO 2079 C2400757 SUMBUF(24)=SUMBUF(26) C2400758ÐÐ GO TO 2080 C2400759 2079 SUMBUF(24)=SUMBUF(25) C2400760 SUMBUF(25)=SUMBUF(26) C2400761 2080 SUMBUF(26)=$2020 C2400762 CALL BINASC(ABORT,SUMBUF(28)) C2400763 IF(AND(SUMBUF(29),$FF).NE.$20) GO TO 2081 C2400764 SUMBUF(28)=SUMBUF(30) C2400765 GO TO 2082 C2400766 2081 SUMBUF(28)=SUMBUF(29) C2400767 SUMBUF(29)=SUMBUF(30) C2400768 2082 SUMBUF(30)=$2020 C2400769C C2400770C CHECK IF LU ENTERED C2400771C C2400772 DO 2083 K=1,4 C2400773 IF(DUMMY(K).NE.BLANK.AND.NOPORT.EQ.0) GO TO 2084 C2400774 2083 CONTINUE C2400775 GO TO 2086 C2400776 2084 LNGO=29 C2400777C *************************************************************127*5178C2400778 CALL LUNEQ(DUMMY,PRINT) C2400779 IF(AND($8000,PRINT).EQ.$8000) GO TO 8025 C2400780 PRINT = OR(PRINT,$1000) C2400781C *************************************************************127*5178C2400782 IF(FIRST.NE.1) GO TO 2085 C2400783ÐÐC C2400784C OUTPUT HEADER C2400785C C2400786 FIRST=0 C2400787 SUMHD(LNGO+1) = $0D0A C2400788 CALL TOWT(PRINT, SUMHD, LNGO+1) C2400789C C2400790C OUTPUT STATUS SUMMARY LINE C2400791C C2400792 2085 CONTINUE C2400793 SUMBUF(LNGO+1) = $0D0A C2400794 CALL TOWT(PRINT, SUMBUF, LNGO+1) C2400795 GO TO ICOMP C2400796 2086 IF(FIRST.NE.1) GO TO 2087 C2400797C C2400798C OUTPUT HEADER C2400799C C2400800 FIRST=0 C2400801 LNGO=29 C2400802 CALL WTREAD(LUNIT,NOCUR,SUMHD,LNGO,NOCUR,DUMMY,ZRO,TC) C2400803 LINCNT=LINCNT+1 C2400804C C2400805C OUTPUT STATUS SUMMARY LINE FOR HOST C2400806C C2400807 2087 LNGO=29 C2400808ÐÐ CALL WTREAD(LUNIT,NOCUR,SUMBUF,LNGO,NOCUR,DUMMY,ZRO,TC) C2400809 LINCNT=LINCNT+1 C2400810 IF(LINCNT.GT.18) GO TO 5000 C2400811 GO TO ICOMP C2400812C C2400813C************* O U T P U T S E C T I O N F O R J O B S *********** C2400814C C2400815C C2400816C CONVERT JOB NO. TO ASCII C2400817C C2400818 2090 CALL BINASC(N,JOBNO(2)) C2400819 IF(AND(JOBNO(4),$FF00).EQ.$2000)JOBNO(4)=$3000+AND(JOBNO(4),$FF) C2400820 JOBNO(2)=JOBNO(4) C2400821C C2400822C CHECK IF THIS IS A USER TERMINAL C2400823C C2400824 3000 IF(NOPORT.EQ.0) GO TO 3002 C2400825C C2400826C USER TERMINAL. CHECK IF VALID USER ID C2400827C C2400828 IDATA(23)=JOBNO(1) C2400829 IDATA(24)=JOBNO(2) C2400830 CALL BATCHK C2400831 IF(SWORD)3001,3002,3003 C2400832 3001 ISTAT=SWORD C2400833ÐÐ GO TO 8010 C2400834 3003 IF(JIND.EQ.1) GO TO 8020 C2400835 GO TO ICOMP C2400836 3002 IF(STATUS.EQ.0) GO TO 8032 C2400837C C2400838C CHECK IF LU ENTERED C2400839C C2400840 DO 3004 K=1,4 C2400841 IF(DUMMY(K).NE.BLANK.AND.NOPORT.EQ.0) GO TO 3005 C2400842 3004 CONTINUE C2400843 GO TO 3006 C2400844C C2400845C OUTPUT HEADER C2400846C C2400847 3005 IF(FIRST.NE.1) GO TO 3007 C2400848 FIRST=0 C2400849 LNGO = 14 C2400850C *************************************************************127*5178C2400851 CALL LUNEQ(DUMMY,PRINT) C2400852 IF(AND($8000,PRINT).EQ.$8000) GO TO 8025 C2400853 PRINT = OR(PRINT,$1000) C2400854C *************************************************************127*5178C2400855 CALL TOWT(PRINT, STATHD, LNGO) C2400856 GO TO 3007 C2400857 3006 IF(FIRST.EQ.0) GO TO 3007 C2400858ÐÐC C2400859C OUTPUT HEADER C2400860C C2400861 FIRST=0 C2400862 LNGO=13 C2400863 CALL WTREAD(LUNIT,NOCUR,STATHD,LNGO,NOCUR,DUMMY,ZRO,TC) C2400864 LINCNT=LINCNT+1 C2400865C C2400866C CLEAR OUTPUT BUFFER C2400867C C2400868 3007 DO 3010 J=2,40 C2400869 STOUT(J)=$2020 C2400870 3010 CONTINUE C2400871C C2400872C MOVE JOB NO AND HOST TO OUTPUT BUFFER C2400873C C2400874 STOUT(2)=JOBNO(1) C2400875 STOUT(3)=JOBNO(2) C2400876 STOUT(7)=HOST(1) C2400877 STOUT(8)=HOST(2) C2400878C C2400879C MOVE APPROPRIATE STATUS TO OUTPUT BUFFER C2400880C C2400881 GO TO (3020,3030,3040,3050,3060,3070,3080,3090,4000),STATUS C2400882C C2400883ÐÐC STATUS = 1, NOT SENT C2400884C C2400885 3020 DO 3025 K=1,4 C2400886 STOUT(K+10)=STATBF(K) C2400887 3025 CONTINUE C2400888 LNGO=15 C2400889 GO TO 4500 C2400890C C2400891C STATUS = 2, BEING SENT C2400892C C2400893 3030 DO 3035 K=1,5 C2400894 STOUT(K+10)=STATBF(K+4) C2400895 3035 CONTINUE C2400896 LNGO=16 C2400897 GO TO 4500 C2400898C C2400899C STATUS = 3, SENT C2400900C C2400901 3040 DO 3045 K=1,2 C2400902 STOUT(K+10)=STATBF(K+9) C2400903 3045 CONTINUE C2400904 LNGO=13 C2400905 GO TO 4500 C2400906C C2400907C STATUS = 4, OUTPUT RECEIVED C2400908ÐÐC C2400909 3050 DO 3055 K=1,8 C2400910 STOUT(K+10)=STATBF(K+11) C2400911 3055 CONTINUE C2400912 LNGO=19 C2400913 GO TO 4500 C2400914C C2400915C STATUS = 5, PRINT REQUEST C2400916C C2400917 3060 DO 3065 K=1,7 C2400918 STOUT(K+10)=STATBF(K+19) C2400919 3065 CONTINUE C2400920 LNGO=18 C2400921 GO TO 4500 C2400922C C2400923C STATUS =6, NOT USED C2400924C C2400925 3070 CONTINUE C2400926 INDEX = KERBAS + 17 C2400927 GO TO 8030 C2400928C C2400929C STATUS = 7, JOB ABORTED C2400930C C2400931 3080 DO 3085 K=1,6 C2400932 STOUT(K+10)=STATBF(K+26) C2400933ÐÐ 3085 CONTINUE C2400934 LNGO=17 C2400935 GO TO 4500 C2400936C C2400937C STATUS = 8, DISCARD PENDING, JOB BEING SENT C2400938C C2400939 3090 DO 3095 K=1,16 C2400940 STOUT(K+10)=STATBF(K+32) C2400941 3095 CONTINUE C2400942 LNGO=27 C2400943 GO TO 4500 C2400944C C2400945C STATUS = 9, DISCARD PENDING, JOB SENT C2400946C C2400947 4000 DO 4010 K=1,13 C2400948 STOUT(K+10)=STATBF(K+48) C2400949 4010 CONTINUE C2400950 LNGO=24 C2400951C C2400952C CHECK IF LU ENTERED C2400953C C2400954 4500 DO 4510 K=1,4 C2400955 IF(DUMMY(K).NE.BLANK.AND.NOPORT.EQ.0) GO TO 4520 C2400956 4510 CONTINUE C2400957 GO TO 4530 C2400958ÐÐC C2400959C OUTPUT STATUS LINE TO PRINTER C2400960C C2400961 4520 CONTINUE C2400962 DO 4522 LOOP = 1 , LNGO C2400963 KO(LOOP) = STOUT(LOOP) C2400964 4522 CONTINUE C2400965 KO(LNGO+1) = $0D0A C2400966 CALL TOWT(PRINT, KO, LNGO+1) C2400967 GO TO ICOMP C2400968C C2400969C OUTPUT STATUS LINE C2400970C C2400971 4530 CALL WTREAD(LUNIT,NOCUR,STOUT,LNGO,NOCUR,DUMMY,ZRO,TC) C2400972 LINCNT=LINCNT+1 C2400973 IF(LINCNT.GT.18) GO TO 5000 C2400974 GO TO ICOMP C2400975 5000 CALL WTREAD(LUNIT,NOCUR,MSGPAU,LPAUSE,NOCUR,INBUF,BUFLEN,TC) C2400976 CALL CLRSCR(LUNIT) C2400977 LINCNT=0 C2400978 FIRST=1 C2400979 GO TO ICOMP C2400980C C2400981C ERROR MESSAGE SECTION C2400982C C2400983ÐÐ 8000 CALL ERCHK(ISTAT,REQBUF(4)) C2400984 GO TO 8050 C2400985C C2400986C SET INDEX = BATCHK SUBR FM ERROR C2400987C C2400988 8010 CONTINUE C2400989 INDEX = KERBAS + 18 C2400990 GO TO 8040 C2400991C C2400992C SET INDEX = INVALID OWNER C2400993C C2400994 8020 CONTINUE C2400995 INDEX = KERBAS + 16 C2400996 GO TO 8040 C2400997C *************************************************************127*5178C2400998C C2400999C INVALID LOGICAL UNIT C2401000C C24010018025 INDEX = 63 C2401002 GO TO 8040 C2401003C *************************************************************127*5178C2401004C C2401005C SET INDEX = STATUS ERROR C2401006C C2401007 8030 CONTINUE C2401008ÐÐ INDEX = KERBAS + 17 C2401009 GO TO 8040 C2401010C C2401011C SET INDEX = HOST NAME NOT FOUND C2401012C C2401013 8031 CONTINUE C2401014 INDEX = KERBAS + 1 C2401015 GO TO 8040 C2401016C C2401017C SET INDEX = JOB INACTIVE C2401018C C2401019 8032 CONTINUE C2401020 INDEX = KERBAS + 20 C2401021 GO TO 8040 C2401022C C2401023C SET INDEX = JOB NO. NOT FOUND C2401024C C2401025 8035 CONTINUE C2401026 INDEX = KERBAS + 19 C2401027 8040 CALL SYSMSG(INDEX,ERBUF) C2401028 8050 IF(PIND)8060,8060,11 C2401029 8060 IF(MODE)8070,9000,8070 C2401030 8070 ASSEM $E400,+MODE C2401031 ASSEM $D622 C2401032 9000 CALL CLOSFL(REQBUF,ISTAT) C2401033ÐÐ RETURN C2401034 END C2401035 SUBROUTINE JCLE(JOBREQ,ISTAT,ITYPE,IMODE) C2500001 1 /C25 F ITOS CCS 3.0 SL-149C2500002C PROVIDE END JCL FOR BATCH COMMAND OUTPUT C2500003C ************************************************************* 122*4871C2500004C CREDIT COLLECTION SYSTEM VERSION 3.0 C2500005C ************************************************************* 122*4871C2500006C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C2500007C COPYRIGHT CONTROL DATA CORPORATION 1979 C2500008C C2500009C C2500010C THE PURPOSE OF THIS SUBROUTINE IS TO PROVIDE C2500011C THE BATCH OUTPUT ON PSEUDO TAPE WITH JCL AT THE END C2500012C C2500013M FMUCOM C2500014C C2500015 EXTERNAL BATINP C2500016 EXTERNAL BINASC C2500017 INTEGER RECBUF(42),BLANK,CIO(6),PRG(12),IFIL(66) C2500018C ************************************************************* 122*4871C2500019 INTEGER REL , RECNUM C2500020C ************************************************************* 122*4871C2500021 DIMENSION NAR(2) C2500022C ************************************************************* 122*4871C2500023ÐÐ DIMENSION REL(5) C2500024C ************************************************************* 122*4871C2500025 DIMENSION IBATH(3) C2500026C C2500027 DATA BLANK/$2020/ C2500028 DATA CIO/'*K,P7 MON '/ C2500029 DATA PRG/'*CATLOG *LIBEDT *COBCAT'/ C2500030 DATA IFIL/'*K,I8,P8 *P,F,2 *K,I8 C2500031 * *N, *Z *Z C2500032 * '/ C2500033 DATA NAR/',,,B'/ C2500034C ************************************************************* 122*4871C2500035 DATA REL/'*L, '/ C2500036C ************************************************************* 122*4871C2500037C C2500038 DO 200 K=1,9 C2500039 DO 10 I=1,40 C2500040 RECBUF(I)=BLANK C2500041 10 CONTINUE C2500042 IF(K .GT. 1) GO TO 50 C2500043 DO 40 I=1,3 C2500044 J=I+3 C2500045 IF(ITYPE.EQ.2HR .OR.ITYPE.EQ.2HC ) J = I C2500046 IRPG=0 C2500047 RECBUF(I)=CIO(J) C2500048ÐÐ 40 CONTINUE C2500049 GO TO 90 C2500050 50 IF(K .GT. 2) GO TO 100 C2500051 DO 60 I=1,4 C2500052 J=I C2500053 IF(ITYPE .NE. 2HR ) J=I+4 C2500054 IF(ITYPE.EQ.2HC )J=J+4 C2500055 RECBUF(I)=PRG(J) C2500056 60 CONTINUE C2500057 GO TO 90 C2500058100 IF(ITYPE .EQ. 2HR .OR. ITYPE .EQ. 2HC )GO TO 350 C2500059 CALL CNTCHR(DUMMY,ICHAR) C2500060 CALL MVCHAR(DUMMY,1,ICHAR,IFIL(34),4) C2500061 IDEST=ICHAR+4 C2500062 CALL MVCHAR(NAR,1,4,IFIL(34),IDEST) C2500063C C2500064C ************************************************************* 122*4871C2500065 IF(K .GT. 3) GO TO 300 C2500066 105 DO 110 I=1,11 C2500067C ************************************************************* 122*4871C2500068 I2=I+((K-3)*11) C2500069 RECBUF(I)=IFIL(I2) C2500070 110 CONTINUE C2500071C ************************************************************* 122*4871C2500072 GO TO 90 C2500073ÐÐC C2500074300 IF(IMODE. NE. 2HR .AND. K.LE.6) GO TO 105 C2500075 IF(K .NE. 4) GO TO 320 C2500076C C2500077 CALL MVCHAR(DUMMY,1,ICHAR,REL(1),4) C2500078 DO 310 I=1,5 C2500079 RECBUF(I)=REL(I) C2500080 310 CONTINUE C2500081 GO TO 90 C2500082C C2500083320 IF(K .EQ. 7) GO TO 105 C2500084 IF(K .LT. 8) GO TO 200 C2500085 IF(IMODE .EQ. 2HA ) GO TO 340 C2500086C C2500087C CTO NO LONGER NEEDED C2500088C C2500089340 GO TO 200 C2500090C C2500091C WRITE *Z TO TERMINATE JOB C2500092C C2500093350 IF(IRPG.EQ.3) GO TO 210 C2500094 IRPG = IRPG+1 C2500095C C2500096 GO TO (352,354,355),IRPG C2500097C C2500098ÐÐC *V,7 C2500099352 RECBUF(1) = 2H*V C2500100 RECBUF(2) = 2H,7 C2500101 GO TO 90 C2500102C C2500103C *V,BATCH INPUT LU C2500104C C2500105354 RECBUF(1) = 2H*V C2500106 RECBUF(2) = 2H , C2500107 ASSEM $C000,+BATINP,$6400,+ILU C2500108 CALL BINASC(ILU,IBATH) C2500109 ASSEM $E400,+RECBUF(2),$C400,+IBATH(3),$FE8,$4400,+RECBUF(2) C2500110 ASSEM $6400,+RECBUF(3) C2500111 GO TO 90 C2500112C C2500113C *Z C2500114C C2500115355 RECBUF(1) = $2A5A C2500116 GO TO 90 C2500117C C2500118 360 IF(K .EQ. 6) GO TO 200 C2500119 GO TO 105 C2500120C ************************************************************* 122*4871C250012190 RECNUM = 1 C2500122 CALL PUTS(JOBREQ,RECBUF,RECNUM,ISTAT) C2500123ÐÐ IF(ISTAT)210,200,200 C2500124 200 CONTINUE C2500125 210 RETURN C2500126 END C2500127 SUBROUTINE COMPRE C2600001 1 /C26 F ITOS CCS 3.0 SL-149C2600002C COMMAND PROCESSOR FOR COMPRESS C2600003C ************************************************************* 122*4873C2600004C CREDIT COLLECTION SYSTEM VERSION 3.0 C2600005C ************************************************************* 122*4873C2600006C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C2600007C COPYRIGHT CONTROL DATA CORPORATION 1979 C2600008C C2600009C C2600010C ************************************************************* 122*4873C2600011C*** C2600012C C2600013C FUNCTION C2600014C C2600015C TO COPY AN EXCISTING FILE ON MASS-MEMORY INTO ITS OWN C2600016C LOCATION BUT WITH DELETEING RECORDS MARKED AS DELETE C2600017C AND REBUILDING THE KEYS C2600018C ************************************************************* 122*4873C2600019C C2600020C C2600021ÐÐC GENERAL DESCRIPTION C2600022C C2600023C UPON ENTRY THE PARAMETER PROCESSING TABLE (PPCOMP) IS COPIED C2600024C INTO A TEMPORARILY TABLE(PPTEMP) C2600025C REQBUF IS INITIALIZED TO ALL ZEROES C2600026C IDATA IS COPIED FROM THE DEFAULT TABLE (PARDEF) C2600027C NEXT A CHECK IS DONE WHICH PROMPTING LEVEL (PIND) IS REQUIRED C2600028C C2600029C COMMAND FORMAT C2600030C C2600031C COMPRES,FN=AAAAAAAA,VL=AAAAAAAA C2600032C C2600033C C2600034C C2600035C C2600036M FMUCOM C2600037C C2600038 INTEGER BUFLEN,TC,ZRO,OUTP C2600039 INTEGER BLANK,ERBUF C2600040 INTEGER PARNUM,STATUS,PARID C2600041 INTEGER OPN,WVL C2600042 INTEGER PPTAB(4) C2600043 INTEGER STAT C2600044C C2600045 INTEGER PPTEMP(17) C2600046ÐÐ INTEGER IPNAM(17) C2600047 INTEGER IJUST(17) C2600048 INTEGER ICONV(17) C2600049 INTEGER IREQ(17) C2600050 INTEGER IFND(17) C2600051 INTEGER RECBUF(258) C2600052 INTEGER QUEST C2600053C C2600054 BYTE (IPNAM,PPTEMP(7=0)) C2600055 BYTE (IJUST,PPTEMP(8=8)) C2600056 BYTE (ICONV,PPTEMP(10=9)) C2600057 BYTE (IREQ,PPTEMP(12=12)) C2600058 BYTE (IFND,PPTEMP(15=15)) C2600059C C2600060 DIMENSION NAME(12) C2600061C C2600062 BYTE(OPN,ISTAT(0=0)) C2600063 BYTE(NFD,ISTAT(1=1)) C2600064 BYTE(MME,ISTAT(5=5)) C2600065 BYTE(WVL,ISTAT(13=13)) C2600066 BYTE(ILR,ISTAT(14=14)) C2600067 BYTE (IFL,ISTAT(2=2)) C2600068 BYTE (IEOF,ISTAT(8=8)) C2600069 BYTE (IFME,ISTAT(10=10)) C2600070 BYTE (MFOS,ISTAT(11=11)) C2600071ÐÐ BYTE (MFO,ISTAT(12=12)) C2600072* C2600073 EQUIVALENCE (PPDELE,PPTAB) C2600074* C2600075C C2600076 DATA NAME/'FILE-NAME =VOLUME-NAME='/ C2600077 DATA BUFLEN/40/ C2600078 DATA BLANK/$2020/ C2600079 DATA QUEST/'? '/ C2600080 DATA ZRO/0/,NOCUR/-1/ C2600081C C2600082C EXTERNALS C2600083C C2600084 EXTERNAL WTREAD C2600085 EXTERNAL GETFLD C2600086 EXTERNAL SYSMSG C2600087 EXTERNAL MOVEL C2600088 EXTERNAL MOVER C2600089C ************************************************************* 122*4873C2600090C*** C2600091C ************************************************************* 122*4873C2600092 EXTERNAL DELETE C2600093C C2600094C INITIALISATION C2600095C C2600096ÐÐ 11 INDEX=0 C2600097+ ERROR MSG NO. C2600098 ERBUF=0 C2600099+ ERROR MSG BUF C2600100 ISTAT=0 C2600101+ STATUS OF FM-REQUEST C2600102 LNGO=0 C2600103+ LENGTH OF FIELD TO MOVE C2600104 MORPAR=0 C2600105+ INDICATOR IF MORE PARAMETERS NEEDED C2600106 MORLIN=0 C2600107+ INDICATOR IF MORE LINES NEED TO BE READ C2600108 PARNUM=0 C2600109+ COUNT OF REQ.AND NOT FOUND PARAMETERS C2600110 PARID=0 C2600111 IFLAG=0 C2600112 IP=1 C2600113C C2600114 ASSIGN 9998 TO INTLOC C2600115 CALL PGMINT(INTLOC,IFLAG) C2600116C C2600117C COPY THE PARAMETER PROCESSING TABLE C2600118C C2600119 I=0 C2600120 10 I=I+1 C2600121ÐÐ PPTEMP(I)=PPTAB(I) C2600122 IF(PPTEMP(I))10,20,10 C2600123C C2600124C C2600125C C2600126 20 DO 30 I=1,24 C2600127 REQBUF(I)=0 C2600128 IDATA(I)=PARDEF(I) C2600129 30 CONTINUE C2600130C C2600131 35 IF(PIND)110,70,40 C2600132C C2600133C PROMPTING LEVEL = 1 FULL PARAMETERS WILL BE DISPLAYED C2600134C C2600135 40 KI=IP C2600136 I=(IP-1)*6+1 C2600137 IF(IPNAM(IP))50,100,50 C2600138C C2600139 50 J=I+5 C2600140 K=1 C2600141 CODE(K)=$0A0D C2600142+ SET CR/LF C2600143 DO 60 I=I,J C2600144 K=K+1 C2600145 CODE(K)=NAME(I) C2600146ÐÐ 60 CONTINUE C2600147C C2600148 I=KI C2600149 LNGO=7 C2600150 GO TO 90 C2600151C C2600152C PROMPTING LEVEL = 0 PARAMETER ABBREVIATIONS WILL BE DISPLAYED C2600153C C2600154 70 I=IP C2600155 K=IPNAM(IP) C2600156+ INDEX TO PARAM.MNEM.TABLE C2600157 IF(K)80,100,80 C2600158 80 K=(K-1)*3+1 C2600159C C2600160 CODE(1)=$0A0D C2600161 CODE(2)=PARNAM(K) C2600162 CODE(3)=$3D20 C2600163 LNGO=3 C2600164C C2600165C DISPLAY NEXT PARAMETER-IDENT C2600166C C2600167 90 CALL WTREAD (LUNIT,NOCUR,CODE,LNGO,NOCUR,DUMMY,ZRO,TC) C2600168C C2600169 PARID=IP C2600170+ INDEX IN PARNAM-TABLE C2600171ÐÐ IFND(I)=1 C2600172+ SET FOUND FLAG C2600173 IP=IP+1 C2600174+ INCR. INDEX TO PPTEMP C2600175 MORPAR=1 C2600176+ SET INDICATOR FOR MORE PARAMETERS C2600177 GO TO 120 C2600178C C2600179C END OF PARAMETER LIST, ISSUE FM-REQUEST C2600180C C2600181 100 MORPAR=0 C2600182 GO TO 320 C2600183C C2600184C PROMPTING LEVEL = -1, NO PROMPTING DONE C2600185C C2600186 110 IF(MORLIN)115,130,130 C2600187+ DO WE NEED TO READ MORE LINES C2600188 115 MORLIN=0 C2600189C C2600190C READ NEXT LINE C2600191C C2600192 120 CALL WTREAD (LUNIT,NOCUR,DUMMY,ZRO,NOCUR,INBUF,BUFLEN,TC) C2600193C C2600194C RESET SWORD AND SBYTE C2600195C C2600196ÐÐ SBYTE=0 C2600197 SWORD=0 C2600198C C2600199 130 CALL GETFLD (INBUF,CODE,SWORD,SBYTE,STAT) C2600200C C2600201 140 IF (STAT-2)150,160,200 C2600202 150 IF (STAT-1)260,250,250 C2600203C C2600204C EOL DETECTED,COUNT NO OF REQUIRED AND NOT FOUND PARAMETERS (STATUS=1)C2600205C C2600206 160 IF(PIND)161,162,162 C2600207 161 MORPAR=0 C2600208C C2600209C CHECK IF FULL NAME DESIRED C2600210C C2600211 162 IF (CODE(1)-QUEST)164,163,164 C2600212C C2600213C YES,FULL NAME FOR THIS PARAMETER ONLY C2600214C C2600215 163 IF (PIND .NE. -1) IP=IP-1 C2600216 GO TO 40 C2600217C C2600218C CHECK IF PARAMETER ENTERED C2600219C C2600220 164 IF(CODE(1)-BLANK)270,165,270 C2600221ÐÐ 165 IFND(IP-1)=0 C2600222 IF (PIND .EQ. -1) GO TO 320 C2600223 GO TO 35 C2600224C C2600225C PARAMETER-ID FOUND (STATUS=3) C2600226C C2600227 200 I=1 C2600228 210 K=IPNAM(I) C2600229 K=(K-1)*3+1 C2600230C C2600231 IF (CODE(1)-PARNAM(K))230,220,230 C2600232C C2600233C PARAMETER-ID CORRESPONDS WITH PARAM.MNEMONIC TABLE C2600234C C2600235 220 PARID=I C2600236 IFND(I)=1 C2600237 GO TO 130 C2600238C C2600239 230 I=I+1 C2600240+ NO MATCH,CONTINUE C2600241 IF(IPNAM(I))210,240,210 C2600242C C2600243 240 INDEX=39 C2600244+ PARAMETER ILLEGAL C2600245 GO TO 9999 C2600246ÐÐC C2600247C FIELD TERMINATED ON A SEMI-COLON (STATUS=1) C2600248C C2600249 250 MORLIN=-1 C2600250+ SET INDICATOR TO READ MORE LINES C2600251C C2600252C FIELD TERMINATED ON A COMMA (STATUS=0) C2600253C C2600254 260 MORPAR=1 C2600255+ SET INDICATOR FOR MORE PARAMETERS C2600256 IF(CODE(1) .NE. BLANK)GO TO 270 C2600257 IFND(IP)=0 C2600258 IP=IP+1 C2600259 GO TO 35 C2600260C C2600261C STORE PARAMETER VALUES INTO REQUIRED LOCATIONS C2600262C C2600263 270 IF (PARID)290,290,280 C2600264+ PARAMETER-ID FOUND C2600265 280 I=PARID C2600266+ YES C2600267 GO TO 300 C2600268C C2600269 290 I=IP C2600270 IF (CODE(1) .NE. BLANK) IFND(I)=1 C2600271ÐÐ IP=IP+1 C2600272C C2600273 300 I=(IPNAM(I)-1)*3+1 C2600274C C2600275 LNGO=PARNAM(I+1) C2600276 OUTP=PARNAM(I+2) C2600277C C2600278C STORE INTO DESIGNATED OUTPUT FIELD C2600279C C2600280 CALL MOVEL (CODE,OUTP,LNGO) C2600281C C2600282 PARID=0 C2600283 IF(MORPAR)310,320,310 C2600284+ ARE THERE MORE PARAM TO BE PROCESSED C2600285 310 IF(PIND)110,70,40 C2600286+ YES C2600287C C2600288C ARE ALL REQUIRED PARAMETERS FOUND ? C2600289C C2600290 320 I=0 C2600291 330 I=I+1 C2600292 IF(PPTEMP(I))330,360,340 C2600293C C2600294C PARAMETER NOT FOUND,IS IT REQUIRED ? C2600295C C2600296ÐÐ 340 IF(IREQ(I))330,350,330 C2600297C C2600298C YES IT IS REQUIRED C2600299C C2600300 350 PARNUM=PARNUM+1 C2600301 GO TO 330 C2600302C C2600303C END OF PPTAB C2600304C C2600305 360 IF(PARNUM)240,400,240 C2600306+ ARE ALL REQUIRED PARAMETERS FOUND C2600307C C2600308C C2600309C C2600310 400 ASSEM $C000,+FCBHDR C2600311 ASSEM $6400,+REQBUF(10) C2600312C C2600313 REQBUF(13)=96 C2600314+ SET FOR FULL LENGTH FC B C2600315 IDATA(13)=-1 C2600316+ OPEN FOR COMPRESSION C2600317 IDATA(14)=1 C2600318 IDATA(15)=0 C2600319C C2600320 CALL OPENFL (REQBUF,IDATA,ISTAT) C2600321ÐÐ IF (ISTAT) 8000,410,410 C2600322C C2600323 410 CALL COMFIL (REQBUF,RECBUF,ISTAT) C2600324 IF (IEOF) 9998,410,9998 C2600325+ CHECK IF EOF REACHED C2600326C C2600327C FILE REQUEST REJECTED C2600328C C2600329 8000 CALL ERCHK(ISTAT,REQBUF(4)) C2600330 GO TO 9995 C2600331C C2600332C C2600333 9000 GO TO 9998 C2600334C C2600335C ERROR ROUTINE C2600336C C2600337 9999 CALL SYSMSG(INDEX,ERBUF) C2600338 9995 IF (PIND) 9990,9990,11 C2600339C C2600340 9990 IF (MODE) 9991,9998,9991 C2600341C C2600342 9991 ASSEM $E400,+MODE C2600343 ASSEM $D622 C2600344C C2600345 9998 CALL CLOSFL (REQBUF,ISTAT) C2600346ÐÐ 9997 RETURN C2600347 END C2600348 SUBROUTINE RELOAD C2700001 1 /C27 F ITOS CCS 3.0 . SL-149C2700002C CREDIT COLLECTION SYSTEM VERSION 3.0 C2700003C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C2700004C COPYRIGHT CONTROL DATA CORPORTION 1979 C2700005C CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.1 C2700006C ************************************************************* 122*4777C2700007C *****************************************************'******* 122*4870C2700008C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C2700009C COPYRIGHT CONTROL DATA CORPORATION 1977 C2700010C C2700011C C2700012C FUNCTION C2700013C C2700014C THIS IS THE REQUEST PROCESSOR FOR THE FILE-MANAGER UTILITY C2700015C ITS PURPOSE IS TO RELOAD A MASS-STORAGE FILE FROM A SEQUENTIAL C2700016C DEVICE WHEREON IT WAS EARLIER WRITTEN BY THE 'DUMP' UTILITY. C2700017C C2700018C GENERAL DESCRIPTION C2700019C C2700020C UPON ENTRY THE PARAMETER PROCESSING TABLE(PPRELO) IS COPIED C2700021C INTO A TEMPORARY TABLE(PPTEMP) C2700022C REQBUF IS INITIALIZED TO ALL ZEROES C2700023ÐÐC IDATA IS COPIED FROM THE DEFAULT TABLE (PARDEF) C2700024C NEXT A CHECK IS DONE WHICH PROMPTING LEVEL (PIND) IS REQUIRED C2700025C C2700026C COMMAND FORMAT C2700027C C2700028C RELOAD,FN=AAAAAAAA,VL=VVVVVVVV,I=IIIIIIII C2700029C C2700030C RELOAD,AAAAAAAA,VVVVVVVV,IIIIIIII C2700031C C2700032C RELOAD,AAAAAAAA C2700033C C2700034C C2700035M FMUCOM C2700036C C2700037 INTEGER BUFLEN,TC,ZRO,OUTP C2700038 INTEGER BLANK,ERBUF C2700039 INTEGER PARNUM,STATUS,PARID C2700040 INTEGER OPN,WVL C2700041 INTEGER PPTAB(5) C2700042 INTEGER STAT,VOLNAM(4) C2700043 INTEGER POSKY1 C2700044C C2700045 INTEGER PPTEMP(17) C2700046 INTEGER IPNAM(17) C2700047 INTEGER IJUST(17) C2700048ÐÐ INTEGER ICONV(17) C2700049 INTEGER IREQ(17) C2700050 INTEGER IFND(17) C2700051 INTEGER QUEST,PPRENA,EXPFLG,EXPDAT,RENFLG,CRTDAT C2700052 INTEGER FCBTEM( 3),RECBUF(4002),RECLEN C2700053 INTEGER FNFLAG,FNFND C2700054 INTEGER EOFREC C2700055 INTEGER VOLDEF C2700056C C2700057 BYTE (IPNAM,PPTEMP(7=0)) C2700058 BYTE (IJUST,PPTEMP(8=8)) C2700059 BYTE (ICONV,PPTEMP(10=9)) C2700060 BYTE (IREQ,PPTEMP(12=12)) C2700061 BYTE (IFND,PPTEMP(15=15)) C2700062C C2700063C ************************************************************* 122*4870C2700064 DIMENSION NAME(24) C2700065C ************************************************************* 122*4870C2700066 DIMENSION NR(4),EXPDAT(3),CRTDAT(3) C2700067 DIMENSION KEYVAL(15) C2700068 DIMENSION MSGLOD(20),MSGNLD(30) C2700069 DIMENSION EOFREC(2) C2700070 DIMENSION VOLDEF(4) C2700071C C2700072 BYTE(OPN,ISTAT(0=0)) C2700073ÐÐ BYTE(NFD,ISTAT(1=1)) C2700074 BYTE(MME,ISTAT(5=5)) C2700075 BYTE(WVL,ISTAT(13=13)) C2700076 BYTE(ILR,ISTAT(14=14)) C2700077 BYTE (ICHAR,CODE(1)(15=8)) C2700078* C2700079 EQUIVALENCE (PPRELO,PPTAB) C2700080 EQUIVALENCE (POSKY1,FCBBUF(16)) C2700081 EQUIVALENCE (LENKY1,FCBBUF(15)) C2700082* C2700083C FILE CONTROL BLOCK . . . . C2700084C C2700085 EQUIVALENCE(RECLEN,FCBBUF(1)) C2700086 EQUIVALENCE (EXPDAT(1),FCBBUF(89)) C2700087 EQUIVALENCE (CRTDAT(1),FCBBUF(92)) C2700088C C2700089C ************************************************************* 122*4870C2700090 DATA NAME/'FILE-NAME =OWNER-NAME =VOLUME-NAME=INPUT UNIT ='/ C2700091C *****************************************************'******* 122*4870C2700092 DATA BUFLEN/40/ C2700093 DATA BLANK/$2020/ C2700094 DATA QUEST/'? '/ C2700095 DATA ZRO/0/,NOCUR/-1/ C2700096 DATA MSGNLD/' NOT LOADED,ALREADY PRESEC2700097 *NT '/ C2700098ÐÐ DATA MSGLOD/' LOADING '/ C2700099 DATA EOFREC/'EOF '/ C2700100 DATA NOISE/ 2/ C2700101C *************************************************************127*5174C2700102C C2700103 DIMENSION KSYSTF( 2) C2700104 DIMENSION KBUCKR( 2) C2700105C C2700106 EQUIVALENCE (KEOFMK,KSYSTF( 1)),(KDELMK,KSYSTF( 2)) C2700107C C2700108 INTEGER OBL000 C2700109 INTEGER OBFIMK,UTEFCK C2700110C C2700111 DATA KREWIN/ 3/, KBUFSZ/ 4000/, KFCBHR/ 100/ C2700112C C2700113C EXTERNALS C2700114C C2700115 EXTERNAL WTREAD C2700116 EXTERNAL GETFLD C2700117 EXTERNAL ITSERR C2700118 EXTERNAL MOVEL C2700119 EXTERNAL MOVER C2700120 EXTERNAL GETFCB C2700121 EXTERNAL TODAY C2700122 EXTERNAL ERPROC C2700123ÐÐ EXTERNAL LOG1A C2700124C C2700125C INITIALISATION C2700126C C2700127 11 INDEX=0 C2700128+ ERROR MSG NO. C2700129 ERBUF=0 C2700130+ ERROR MSG BUF C2700131 ISTAT=0 C2700132+ STATUS OF FM-REQUEST C2700133 LNGO=0 C2700134+ LENGTH OF FIELD TO MOVE C2700135 MORPAR=0 C2700136+ INDICATOR IF MORE PARAMETERS NEEDED C2700137 MORLIN=0 C2700138+ INDICATOR IF MORE LINES NEED TO BE READ C2700139 PARNUM=0 C2700140+ COUNT OF REQ.AND NOT FOUND PARAMETERS C2700141 IP=1 C2700142 PARID=0 C2700143 NAMFLG=0 C2700144+ NAME FLAG (0=CURRENT, 1=NEW) C2700145 EXPFLG=0 C2700146 NEWFLG=0 C2700147+ EXP.DATE FLAG (0=USE OLD, 1=NEW) C2700148ÐÐ IINTRP=0 C2700149 DUMMY(1)=0 C2700150 FNFLAG=1 C2700151+ FN FLAG (1=SEARCH FOR FN, 0=LOAD ALL FN'S) C2700152 FNFND=0 C2700153+ FN FOUND FLAG (0=FN NOT FOUND, 1=FN FOUND) C2700154 VOLDEF(1)=2HSY C2700155 VOLDEF(2)=2HSV C2700156 VOLDEF(3)=2HOL C2700157 VOLDEF(4)=2H C2700158 MSGLOD(1)=$0A0D C2700159 MSGNLD(1)=$0A0D C2700160+ PRESET LFCR IN MESSAGES C2700161 ASSIGN 9998 TO INTLOC C2700162 CALL PGMINT(INTLOC,IINTRP) C2700163C C2700164C COPY THE PARAMETER PROCESSING TABLE C2700165C C2700166 I=0 C2700167 10 I=I+1 C2700168 PPTEMP(I)=PPTAB(I) C2700169 IF(PPTEMP(I))10,20,10 C2700170C C2700171C C2700172C C2700173ÐÐ 20 DO 30 I=1,24 C2700174 REQBUF(I)=0 C2700175 IDATA(I)=PARDEF(I) C2700176 30 CONTINUE C2700177C C2700178 35 IF(PIND)110,70,40 C2700179C C2700180C PROMPTING LEVEL = 1 FULL PARAMETERS WILL BE DISPLAYED C2700181C C2700182 40 KI=IP C2700183 I=(IP-1)*6+1 C2700184 IF(IPNAM(IP))50,100,50 C2700185C C2700186 50 J=I+5 C2700187 K=1 C2700188 CODE(K)=$0A0D C2700189+ SET CR/LF C2700190 DO 60 I=I,J C2700191 K=K+1 C2700192 CODE(K)=NAME(I) C2700193 60 CONTINUE C2700194C C2700195 I=KI C2700196 LNGO=7 C2700197 GO TO 90 C2700198ÐÐC C2700199C PROMPTING LEVEL = 0 PARAMETER ABBREVIATIONS WILL BE DISPLAYED C2700200C C2700201 70 I=IP C2700202 K=IPNAM(IP) C2700203+ INDEX TO PARAM.MNEM.TABLE C2700204 IF(K)80,100,80 C2700205 80 K=(K-1)*3+1 C2700206C C2700207 CODE(1)=$0A0D C2700208 CODE(2)=PARNAM(K) C2700209 CODE(3)=$3D20 C2700210 LNGO=3 C2700211C C2700212C DISPLAY NEXT PARAMETER-IDENT C2700213C C2700214 90 CALL WTREAD (LUNIT,NOCUR,CODE,LNGO,NOCUR,DUMMY,ZRO,TC) C2700215C C2700216 PARID=IP C2700217+ INDEX IN PARNAM-TABLE C2700218 IFND(I)=1 C2700219+ SET FOUND FLAG C2700220 IP=IP+1 C2700221+ INCR. INDEX TO PPTEMP C2700222 MORPAR=1 C2700223ÐÐ+ SET INDICATOR FOR MORE PARAMETERS NEEDED C2700224 GO TO 120 C2700225C C2700226C END OF PARAMETER LIST, ISSUE FM-REQUEST C2700227C C2700228 100 MORPAR=0 C2700229 GO TO 320 C2700230C C2700231C PROMPTING LEVEL = -1, NO PROMPTING DONE C2700232C C2700233 110 IF(MORLIN)115,130,130 C2700234+ DO WE NEED TO READ MORE LINES C2700235 115 MORLIN=0 C2700236C C2700237C READ NEXT LINE C2700238C C2700239 120 CALL WTREAD (LUNIT,NOCUR,DUMMY,ZRO,NOCUR,INBUF,BUFLEN,TC) C2700240C C2700241C RESET SWORD AND SBYTE C2700242C C2700243 SBYTE=0 C2700244 SWORD=0 C2700245C C2700246 130 CALL GETFLD (INBUF,CODE,SWORD,SBYTE,STAT) C2700247C C2700248ÐÐ 140 IF (STAT-2)150,160,200 C2700249 150 IF (STAT-1)260,250,250 C2700250C C2700251C EOL DETECTED,COUNT NO OF REQUIRED AND NOT FOUND PARAMETERS (STATUS=1)C2700252C C2700253 160 IF(PIND)161,162,162 C2700254 161 MORPAR=0 C2700255C C2700256C CHECK IF FULL NAME DESIRED C2700257C C2700258 162 IF (CODE(1)-QUEST)164,163,164 C2700259C C2700260C YES,FULL NAME FOR THIS PARAMETER ONLY C2700261C C2700262 163 IF (PIND .NE. -1) IP=IP-1 C2700263 GO TO 40 C2700264C C2700265C CHECK IF PARAMETER ENTERED C2700266C C2700267 164 IF(CODE(1)-BLANK)270,165,270 C2700268 165 IFND(IP-1)=0 C2700269 IF (PIND .EQ. -1) GO TO 320 C2700270 GO TO 35 C2700271C C2700272C PARAMETER-ID FOUND (STATUS=3) C2700273ÐÐC C2700274 200 I=1 C2700275 210 K=IPNAM(I) C2700276 K=(K-1)*3+1 C2700277C C2700278 IF (CODE(1)-PARNAM(K))230,220,230 C2700279C C2700280C PARAMETER-ID CORRESPONDS WITH PARAM.MNEMONIC TABLE C2700281C C2700282 220 PARID=I C2700283 IFND(I)=1 C2700284 GO TO 130 C2700285C C2700286 230 I=I+1 C2700287+ NO MATCH,CONTINUE C2700288 IF(IPNAM(I))210,240,210 C2700289C C2700290 240 INDEX=39 C2700291 CALL SYSMSG(INDEX,ERBUF) C2700292+ PARAMETER ILLEGAL C2700293 GO TO 9999 C2700294C C2700295C FIELD TERMINATED ON A SEMI-COLON (STATUS=1) C2700296C C2700297 250 MORLIN=-1 C2700298ÐÐ+ SET INDICATOR TO READ MORE LINES C2700299C C2700300C FIELD TERMINATED ON A COMMA (STATUS=0) C2700301C C2700302 260 MORPAR=1 C2700303+ SET INDICATOR FOR MORE PARAMETERS C2700304 IF(CODE(1) .NE. BLANK)GO TO 270 C2700305 IFND(IP)=0 C2700306 IP=IP+1 C2700307 GO TO 35 C2700308C C2700309C STORE PARAMETER VALUES INTO REQUIRED LOCATIONS C2700310C C2700311 270 IF (PARID)290,290,280 C2700312+ PARAMETER-ID FOUND C2700313 280 I=PARID C2700314+ YES C2700315 GO TO 300 C2700316C C2700317 290 I=IP C2700318 IF (CODE(1) .NE. BLANK) IFND(I)=1 C2700319 IP=IP+1 C2700320C C2700321 300 IPNAMI=IPNAM(I) C2700322+ SAVE PARAMETER ORDINAL C2700323ÐÐ I=(IPNAM(I)-1)*3+1 C2700324+ CALCULATE SUBSCRIPT INTO MNEMONIC TABLE C2700325C C2700326 LNGO=PARNAM(I+1) C2700327 OUTP=PARNAM(I+2) C2700328C C2700329C C2700330C C2700331C STORE INTO DESIGNATED OUTPUT FIELD C2700332C C2700333 308 CALL MOVEL(CODE,OUTP,LNGO) C2700334 316 PARID=0 C2700335C C2700336 IF(MORPAR)318,320,318 C2700337+ ARE THERE MORE PARAM TO BE PROCESSED C2700338 318 IF(PIND)110,70,40 C2700339+ YES C2700340C C2700341C ARE ALL REQUIRED PARAMETERS FOUND ? C2700342C C2700343 320 I=0 C2700344 330 I=I+1 C2700345 IF(PPTEMP(I))330,360,340 C2700346C C2700347C PARAMETER NOT FOUND,IS IT REQUIRED ? C2700348ÐÐC C2700349 340 IF(IREQ(I))330,350,330 C2700350C C2700351C YES IT IS REQUIRED C2700352C C2700353 350 PARNUM=PARNUM+1 C2700354 GO TO 330 C2700355C C2700356C END OF PPTAB C2700357C C2700358 360 IF(PARNUM)240,400,240 C2700359+ ARE ALL REQUIRED PARAMETERS FOUND C2700360C C2700361. C2700362C C2700363C C2700364 400 CONTINUE C2700365 KVOLNA = IDATA(9) C2700366C *************************************************************138*0023C2700367 CALL OBFIMK(KSYSTF(1)) C2700368 MAGBUF = OBL000( 0) C2700369 IF (DUMMY(1) .NE. 0) GO TO 402 C2700370 401 DUMMY(1)=$5441 C2700371+ SET LU TO DEFAULT TAPE0 C2700372 DUMMY(2)=$5045 C2700373ÐÐ DUMMY(3)=$3020 C2700374 DUMMY(4)=$2020 C2700375 402 CALL LUNEQ(DUMMY,LUNIN) C2700376+ DETERMINE LOGICAL UNIT NMBR C2700377 IF(LUNIN)403,403,404 C2700378 403 INDEX=52 C2700379+ 52 INVALID LOGICAL UNIT NMBR(PARAM ENTRY ERR) C2700380 GO TO 498 C2700381C C2700382C DETERMINE LOGICAL UNIT FOR READS C2700383C C2700384 404 CONTINUE C2700385 LUNIN = LUNIN + $1000 C2700386C C2700387C REWIND INPUT C2700388C C2700389 CALL RWBUWM(LUNIN, KREWIN) C2700390 IF(IDATA(1).EQ.BLANK)FNFLAG=0 C2700391+ HAS FN BEEN SPECIFIED ? C2700392C C2700393C C2700394C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - C2700395C C2700396C C2700397C STARTING OF THE WHOLE THING ---- S T A R T C2700398ÐÐC STARTING OF THE WHOLE THING ---- S T A R T C2700399C C2700400C C2700401C YES - SEARCH LU FOR EOF C2700402C C2700403C DEFAULT DATA SIZE C2700404C C2700405 405 CONTINUE C2700406 KSIZE = KBUFSZ C2700407 IF (KBUFSZ .GT. MAGBUF) KSIZE = MAGBUF C2700408 IRDSTA = MPREDX(LUNIN, RECBUF(1), KSIZE) C2700409 IF (AND($C000,IRDSTA) .EQ. $C000) GO TO 410 C2700410 GO TO 405 C2700411C C2700412C READ FCB OR ANOTHER EOF C2700413C C2700414 410 CONTINUE C2700415 IRDSTA = MPREDX(LUNIN, RECBUF(1), KFCBHR) C2700416 IF (IRDSTA .GT. 0) GO TO 411 C2700417 IF (AND($C000,IRDSTA) .EQ. $C000) GO TO 430 C2700418 GO TO 411 C2700419C C2700420C C2700421C EOF ENCOUNTERED FROM READ C2700422C DETERMINE WHAT TO DO NEXT C2700423ÐÐC C2700424C C2700425C C2700426C ************************************************************* 127*5122C2700427 430 CONTINUE C2700428C IS FILE NAME SPECIFIED C2700429 IF(FNFLAG)490,9998,490 C2700430C ************************************************************* 127*5122C2700431 490 IF(FNFND)9998,499,9998 C2700432+ IF FN FOUND, ALL DONE; IF NOT, ERROR. C2700433C C2700434C C2700435 499 INDEX =34 C2700436+ REPORT FILE NOT FOUND C2700437 498 CONTINUE C2700438 CALL SYSMSG(INDEX,ERBUF) C2700439 GO TO 9999 C2700440C C2700441C C2700442C- - - - - - - -- - - FCB BLOCK IS READ C2700443C C2700444C C2700445C** CHECK IF SHORT READ. SHORT READ MEANS ITOS 1.1 DUMP FORMAT C2700446C (FCB BLOCK IS 96 WORDS) C2700447C C2700448ÐÐ 411 CONTINUE C2700449 ISHORT = 0 C2700450 IF ( AND($4000 , IRDSTA) .NE. 0) ISHORT = 1 C2700451C C2700452C* MOVE FCB AND OTHER BLOCKING DATA C2700453C C2700454 DO 412 LOOP = 1 , 96 C2700455 FCBBUF(LOOP) = RECBUF(LOOP) C2700456 412 CONTINUE C2700457 NUMREC = RECBUF( 97) C2700458 ISECLN = RECBUF( 98) C2700459 IBLKSZ = RECBUF( 99) C2700460 IRESVE = RECBUF(100) C2700461C C2700462C CHECK IF SHORT READ ---1.1 DUMP C2700463C C2700464 IF (ISHORT .EQ. 0) GO TO 413 C2700465 NUMREC = 1 C2700466 IBLKSZ = RECBUF( 1) C2700467 ISECLN = RECBUF( 1) C2700468 IRESVE = 0 C2700469 413 CONTINUE C2700470C C2700471C CHECK IF FILE NAME ENTERED (FNFLAG = 1) OR NOT ENTERED (FNFLAG = 0) C2700472C C2700473ÐÐ IF (FNFLAG .EQ. 0) GO TO 500 C2700474C C2700475C C2700476C------------------------------- ------------------------------ C2700477C C2700478C C2700479C TO HERE, FILE NAME ENTERED BY OPERATOR C2700480C C2700481C C2700482C C2700483C ************************************************************* 122*4870C2700484C SET THE SEARCH MAXIMUM FOR FILE NAME OR FILE AND OWNER NAME C2700485C DEPENDING ON WHETHER OR NOT AN OWNER NAME WAS ENTERED C2700486 419 ISMAX=4 C2700487 IF (PPTEMP(2).LT.0) ISMAX=8 C2700488 DO 420 I=1,ISMAX C2700489C ************************************************************* 122*4870C2700490+ COMPARE TO FN; IF =, CREATE.C2700491 IF(FCBBUF(I+24).NE.IDATA(I))GO TO 405 C2700492 420 CONTINUE C2700493 421 FNFND=1 C2700494C ************************************************************* 122*4870C2700495 GO TO 5009 C2700496C C2700497C SET UP IDATA FOR CREATE - BLANK OWNER, VOLUME C2700498ÐÐC C2700499C ************************************************************* 122*4870C2700500C IF THERE IS AN OWNER NAME ENTERED, MAKE SURE THIS FILE C2700501C BELONGS TO THAT OWNER C2700502 500 IF (PPTEMP(2).GT.0) GO TO 5009 C2700503 DO 5005 I=1,4 C2700504 IF (FCBBUF(I+28).NE.IDATA(I+4)) GO TO 405 C2700505 5005 CONTINUE C2700506C C2700507C C2700508C------------------------------- ------------------------------ C2700509C C2700510C FILE NAME MATCHED OR FILE TO BE SAVED C2700511C C2700512C C2700513C SAVE FILE NAME, IF ANY, OWER NAME AND VOLUME IF ANY C2700514C C2700515 5009 CONTINUE C2700516C C2700517C* CHECK IF BLOCKING SIZE IS LARGER THAN SYSTEM BUFFER C2700518C C2700519 IF (IBLKSZ .LE. KSIZE) GO TO 414 C2700520 INDEX = 81 C2700521 GO TO 498 C2700522C C2700523ÐÐ 414 CONTINUE C2700524 DO 501 I = 1,4 C2700525C ************************************************************* 122*4870C2700526 IDATA(I)=FCBBUF(I+24) C2700527 IDATA(I+4)=FCBBUF(I+28) C2700528 IF (KVOLNA .EQ. BLANK) IDATA(I+8) = VOLDEF(I) C2700529C ************************************************************ 138*0023C2700530 501 CONTINUE C2700531C ************************************************************* 122*4870C2700532C IF NO USER WAS ENTERED, SET UP FOR COMMON USER C2700533 IF (PPTEMP(2).GE.0.AND.FCBBUF(29).EQ.$2020) IDATA(5)=0 C2700534C *****************************************************'******* 122*4870C2700535C C2700536C RECORD LENGTH, NUMBER OF RECORDS C2700537C C2700538 IDATA(14) = FCBBUF(2) C2700539 IDATA(15) = FCBBUF(3) C2700540 IDATA(13) = FCBBUF(33) C2700541C C2700542C SET RECORD LENGTH INTO TAPE READ C2700543C C2700544C C2700545C SET UP READ TAPE SIZE ACCORDING TO ITOS 1.1 FORMAT OR 1.2 FORMAT C2700546C C2700547 KREDSZ = IBLKSZ C2700548ÐÐ IF (ISHORT .EQ. 0) GO TO 5150 C2700549 KREDSZ = RECLEN C2700550C *************************************************************127*5174C2700551C C2700552C FOR ITOS 1.1 FORMAT, CHECK IF RECORD SIZE IS 1 WORD (OR 2 BYTES) C2700553C IF SO, BUMP SIZE TO LARGER THAN NOISE RECORD C2700554C C2700555 IF (KREDSZ .LE. NOISE) KREDSZ = NOISE + 1 C2700556C *************************************************************127*5174C2700557 ISECLN = RECLEN C2700558 NUMREC = 1 C2700559 5150 CONTINUE C2700560C SA, KEY ARRANGEMENT, FILE TYPE C2700561C C2700562C* SET UP FILE TYPE FOR LOADING C2700563C C2700564 IDATA(16)=AND(FCBBUF(6),$C001) C2700565 IFLTYP = AND( IDATA(16) , $0001) C2700566C C2700567C KEY LENGTHS % POSITIONS C2700568C C2700569 DO 503 I=17,24 C2700570 503 IDATA(I)=FCBBUF(I-2) C2700571 IFYLTP=FCBBUF(95) C2700572C C2700573ÐÐC CREATE FILE BASED ON TAPED FCB INFO . . . C2700574C C2700575 CALL CREATE(REQBUF,IDATA,ISTAT) C2700576 IF(ISTAT)505,520,520 C2700577 505 IF(AND(ISTAT,$400))506,510,506 C2700578+ FILE ALREADY PRESENT ? C2700579C C2700580C WRITE INFORMATIVE MESSAGE FOR FILE IS NOT BEING LOADED C2700581C C2700582 506 DO 507 I=1,8 C2700583+ YES C2700584 N=I+5 C2700585 507 MSGNLD(N)=IDATA(I) C2700586 CALL WTREAD(LUNIT,NOCUR,MSGNLD,30,NOCUR,DUMMY,ZRO,TC) C2700587 508 CONTINUE C2700588 IRDSTA = MPREDX(LUNIN, RECBUF(1), KSIZE) C2700589 IF (AND($C000,IRDSTA) .EQ. $C000) GO TO 410 C2700590 GO TO 508 C2700591C C2700592C ---------- TO PRINT ERROR MESSAGE ------------ C2700593C C2700594C C2700595 510 CALL ERCHK(ISTAT,REQBUF(4)) C2700596+ GO FIND WHICH ISTAT BIT IS ON C2700597 CALL CLOSFL( REQBUF(1), ISTAT) C2700598ÐÐ GO TO 9999 C2700599C C2700600C ------ WRITE FILE LOADING MESSAGE ------- C2700601C C2700602C C2700603 520 DO 521 I=1,8 C2700604 N=I+5 C2700605 521 MSGLOD(N)=IDATA(I) C2700606 CALL WTREAD(LUNIT,NOCUR,MSGLOD,20,NOCUR,DUMMY,ZRO,TC) C2700607 IDATA(13)=0 C2700608 IDATA(14)=1 C2700609 IDATA(15)=-1 C2700610C ************************************************************* 122*4870C2700611 IF (PPTEMP(2).GE.0.AND.FCBBUF(29).EQ.$2020) IDATA(5)=0 C2700612C ************************************************************* 122*4870C2700613. C2700614C C2700615C CLEAR REQBUF AND SET UP FOR FCB IN USER SPACE C2700616C C2700617 DO 530 I=1,24 C2700618 530 REQBUF(I) = 0 C2700619 ASSEM $C000,+FCBHDR C2700620+ LDA =XFCBHDR C2700621 ASSEM $6400,+REQBUF(10) C2700622+ STA+ REQBUF+9 C2700623ÐÐ REQBUF(13) = 96 C2700624 CALL OPENFL(REQBUF,IDATA,ISTAT) C2700625 IF (ISTAT .LT. 0) GO TO 510 C2700626C C2700627 1200 VOLNAM(1)=0 C2700628C C2700629C UPDATE FCB C2700630C C2700631 CALL TODAY(FCBTEM) C2700632 CRTDAT(1) =FCBTEM(1) C2700633+ INSERT CREATE DATE C2700634 CRTDAT(2) =FCBTEM(2) C2700635 CRTDAT(3) =FCBTEM(3) C2700636 FCBBUF(95)=IFYLTP C2700637C C2700638 CALL UPDFCB(REQBUF,VOLNAM,INDEX,FCBBUF,ISTAT) C2700639 IF (ISTAT .LT. 0) GO TO 510 C2700640C C2700641C ('IFLTYP' = 0 FOR SEQUENTIAL OR 1 FOR INDEX FILE) C2700642C C2700643 540 CONTINUE C2700644 IF (IFLTYP .EQ. 1) GO TO 610 C2700645C C2700646C C2700647C -------- ------------ ------------- ---------- C2700648ÐÐC C2700649C C2700650C SEQUENTIAL FILE C2700651C SEQUENTIAL FILE C2700652C SEQUENTIAL FILE C2700653C C2700654C C2700655C SEQUENTIAL FILE IS 'PUT' IN BLOCK MODE IF APPLIED C2700656C C2700657C C2700658C SEQUENTIAL C2700659C C2700660 550 CONTINUE C2700661 IRDSTA = MPREDX(LUNIN, RECBUF(1), KREDSZ) C2700662 IF (AND($C000,IRDSTA) .EQ. $C000) GO TO 551 C2700663 GO TO 556 C2700664C C2700665C END OF FILE AND CLOSE FILE STUFF C2700666C AFTER FILE CLOSED, PROCESSING IS DETERMINED BY FILE ENTERED C2700667C OR NOT C2700668C C2700669 551 CONTINUE C2700670 CALL CLOSFL(REQBUF,ISTAT) C2700671 IF(FNFLAG)9998,410,9998 C2700672+ IF FN SPECIFIED, ALL DONE. C2700673ÐÐC C2700674C PUT SEQUENTIAL FILE C2700675C C2700676C C2700677C BEFORE 'PUT' TO FIND OUT IF EOF MARK IN BLOCKED RECORDS C2700678C C2700679 556 CONTINUE C2700680 GO TO 3000 C2700681 557 CONTINUE C2700682 CALL PUTS(REQBUF,RECBUF,ITOLRC,ISTAT) C2700683 IF (ISTAT .LT. 0) GO TO 510 C2700684 GO TO 550 C2700685C C2700686C C2700687C -------- ------------ ------------- ---------- C2700688C INDEX FILE C2700689C INDEX FILE C2700690C INDEX FILE C2700691C C2700692C C2700693C SPECIAL SPECIAL SPECIAL C2700694C SPECIAL SPECIAL SPECIAL C2700695C C2700696C INDEX FILE REQUIRES 'KIB' STUFF TO BE BUILT, THEREFORE SAVE IS C2700697C DONE ON 1 RECORD BASE C2700698ÐÐC IT IS VERY SLOW........SO SORRY C2700699C C2700700C C2700701C INDEXED C2700702C C2700703C SET UP KEYVAL FOR INDEXED WRITE C2700704C C2700705C C2700706 610 CONTINUE C2700707 IRDSTA = MPREDX(LUNIN, RECBUF(1), KREDSZ) C2700708 IF (AND($C000,IRDSTA) .EQ.$C000) GO TO 551 C2700709C C2700710C GO TO CHECK IF EOF IN BLOCKED RECORDS C2700711C C2700712 617 CONTINUE C2700713 GO TO 3000 C2700714C C2700715C SAVE 1 RECORD AT A TIME SO THAT 'KIB' CAN BE BUILT BY FILE MANAGER C2700716C C2700717 630 CONTINUE C2700718 ICURNT = 1 C2700719 DO 640 LOOP = 1 , ITOLRC C2700720 KTEMPR = ICURNT + ISECLN C2700721 KBUCKR(1) = RECBUF(KTEMPR ) C2700722 KBUCKR(2) = RECBUF(KTEMPR+1) C2700723ÐÐ CALL MVCHAR(RECBUF(ICURNT), POSKY1, LENKY1, KEYVAL, 1) C2700724 CALL WRITER(REQBUF(1), RECBUF(ICURNT), KEYVAL, ISTAT) C2700725 RECBUF(KTEMPR ) = KBUCKR(1) C2700726 RECBUF(KTEMPR+1) = KBUCKR(2) C2700727 IF (ISTAT .LT. 0) GO TO 510 C2700728 ICURNT = ICURNT + ISECLN C2700729 640 CONTINUE C2700730 GO TO 610 C2700731C C2700732C C2700733C------ ------- -------- -------- -------- ------- C2700734C C2700735C C2700736C COMMON CODE SEQUENCE FOR SEARCH FOR EOF MARK IF ANY C2700737C FOR BLOCKING TYPE DATA. C2700738C IT ALSO SET UP NUMBER OF RECORDS IN BUFFER C2700739C C2700740C C2700741 3000 CONTINUE C2700742 ICURNT = 1 C2700743 ITOLRC = NUMREC C2700744C C2700745 DO 3100 LOOP = 1 , NUMREC C2700746 IF ( (RECBUF(ICURNT) .EQ. KEOFMK) .AND. (RECBUF(ICURNT+1) .EQ. C2700747 1 KEOFMK) ) GO TO 3200 C2700748ÐÐ ICURNT = ICURNT + ISECLN C2700749 3100 CONTINUE C2700750 3150 CONTINUE C2700751 IF (IFLTYP .EQ. 0) GO TO 557 C2700752 GO TO 630 C2700753C C2700754C EOF ENCOUNTERED, CHECK IF ONLY 1 RECORD C2700755C C2700756 3200 CONTINUE C2700757C C2700758C ADJUST NUMBER OF RECORDS C2700759C C2700760 ITOLRC = LOOP - 1 C2700761 IF (ITOLRC .NE. 0) GO TO 3150 C2700762C GO TO READ NEXT RECORD(SHOULD BE EOF) C2700763 IF (IFLTYP .EQ. 0) GO TO 550 C2700764 GO TO 610 C2700765C C2700766C---------- - - - - - - - - - - - - - - - - - - - - - - - - - -- C2700767C C2700768C C2700769C RECOVERY ROUTINE C2700770C C2700771 9999 IF(PIND)9995,9995,11 C2700772 9995 IF(MODE)9996,9998,9996 C2700773ÐÐ 9996 ASSEM $E400,+MODE C2700774 ASSEM $D622 C2700775C C2700776 9998 RETURN C2700777 END C2700778 SUBROUTINE DISC C2800001 1 /C28 F ITOS CCS 3.0 SL-149C2800002C COMMAND PROCESSOR FOR DELETING ENTRIES IN THE HOST FILE C2800003C CREDIT COLLECTION SYSTEM VERSION 3.0 C2800004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C2800005C COPYRIGHT CONTROL DATA CORPORATION 1979 C2800006C** C2800007C COMMAND PROCESSOR FOR DISCARD C2800008C CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.0 C2800009C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C2800010C COPYRIGHT CONTROL DATA CORPORATION 1977 C2800011C C2800012C C2800013C FUNCTION C2800014C C2800015C THIS PROCESSOR DISCARDS ENTRIES IN HOST FILE. C2800016C C2800017C GENERAL DESCRIPTION C2800018C C2800019C THIS PROCESSOR ACCEPTS INPUT FROM EITHER AN INTERACTIVE C2800020ÐÐC DEVICE OR THE DEVICE IT WAS INITIATED ON. THE PROCESSOR C2800021C RUNS UNDER THE FILE MANAGER UTILITY EXECUTIVE PROGRAM. C2800022C THE COMMAND FORMAT IS C2800023C DISC,JN=AAAA C2800024C JN=JOB NUMBER C2800025C C2800026C C2800027C FLOW C2800028C C2800029C THE PROCESSOR DETERMINES THE LEVEL OF PROMPTING REQUIRED, C2800030 EXTERNAL WKSPLU C2800031 EXTERNAL MMLUTB C2800032C DISPLAYS THE PARAMETERS AND STORES THE PARAMETER VALUES C2800033C INTO THE REQUIRED LOCATIONS. C2800034C C2800035C THIS PROCESSOR SEARCHES THE HOST FILE FOR A JOB NUMBER C2800036C MATCH. IF THE PROCESSOR WAS INITIATED FROM A USER C2800037C TERMINAL, IT CHECKS THE BATCH FILE TO INSURE THE USER C2800038C ID IS VALID FOR THIS JOB NUMBER. IT THEN SETS THE JOB C2800039C STATUS CODE IN THE HOST FILE AS FOLLOWS - C2800040C C2800041C IF STATUS = 1 (NOT SENT), STATUS = 0 (INACTIVE) C2800042C IF STATUS = 2 (BEING SENT), STATUS = 8 (DISCARD PENDING, C2800043C JOB BEING SENT) C2800044C IF STATUS = 3 (SENT), STATUS = 9 (DISCARD PENDING, C2800045ÐÐC JOB SENT) C2800046C IF STATUS = 4 (OUTPUT RECEIVED) OR C2800047C STATUS = 5 (PRINT REQUEST), STATUS = 0 (INACTIVE) C2800048C AND THE OUTPUT C2800049C FILE IS DELETED. C2800050C IF STATUS = 7 (JOB ABORTED), STATUS = 0 (INACTIVE) C2800051C C2800052C ERROR MESSAGES C2800053C C2800054C 915 INVALID JOB NUMBER C2800055C 916 INVALID OWNER C2800056C 917 JOB ALREADY DISCARDED C2800057C C2800058C C2800059C C2800060M FMUCOM C2800061. C2800062C C2800063 INTEGER OWNR12,OWNR34,OWNR56,OWNR78,RECLEN,TDATRM,TDATRL C2800064 INTEGER DATBAM,DATBAL,FCBIND,TNKEYM,TNKEYL,POSKY1,POSKY2 C2800065 INTEGER POSKY3,POSKY4,TSFILM,TSFILL,EXPDAT,CRTDAT,FILTYP C2800066 INTEGER NOCUR,ZRO,ERBUF,PARNUM,PARID,PPTEMP(17),PPTAB(6) C2800067 INTEGER BUFLEN,TC,OUTP,BLANK,QUEST,STAT,OPN,WVL,FTYPE C2800068 INTEGER OPN,WVL C2800069 INTEGER RECBUF C2800070ÐÐ INTEGER CPDAT(24),CPREQ(24),CPVOL,CPHDR(5),CPFCB(96),CPWIND C2800071 INTEGER CPRECL,CPFIND,CPLEN1,CPPOS1 C2800072 INTEGER STAT1(18),STAT2(18),STAT3(18),STAT4(18) C2800073 INTEGER NAME(6) C2800074 INTEGER BATREQ(24), BATDAT(24), BATBUF(32) C2800075 INTEGER STATUS C2800076 INTEGER IREC(2) C2800077C C2800078 DIMENSION IPNAM(17) C2800079 DIMENSION IREQ(17) C2800080 DIMENSION IFND(17) C2800081 DIMENSION NAME12(4) C2800082 DIMENSION OWNR12(4) C2800083 DIMENSION KEYVAL(15) C2800084 DIMENSION RECBUF(322) C2800085C C2800086 EQUIVALENCE (PPDISC,PPTAB) C2800087 EQUIVALENCE (CPRECL,CPFCB(1)) C2800088 EQUIVALENCE (CPFIND,CPFCB(6)) C2800089 EQUIVALENCE (CPLEN1,CPFCB(15)) C2800090 EQUIVALENCE (CPPOS1,CPFCB(16)) C2800091 BYTE (IDEL,ISTAT(4=4)) C2800092. C2800093C C2800094C FILE CONTROL BLOCK C2800095ÐÐC C2800096 EQUIVALENCE (RECLEN,FCBBUF(1)) C2800097 EQUIVALENCE (TDATRM,FCBBUF(2)) C2800098 EQUIVALENCE (TDATRL,FCBBUF(3)) C2800099 EQUIVALENCE (DATBAM,FCBBUF(4)) C2800100 EQUIVALENCE (DATBAL,FCBBUF(5)) C2800101 EQUIVALENCE (FCBIND,FCBBUF(6)) C2800102 EQUIVALENCE (NEDATM,FCBBUF(7)) C2800103 EQUIVALENCE (NEDATL,FCBBUF(8)) C2800104 EQUIVALENCE (NEXTBM,FCBBUF(9)) C2800105 EQUIVALENCE (NEXTBL,FCBBUF(10)) C2800106 EQUIVALENCE (TNKEYM,FCBBUF(11)) C2800107 EQUIVALENCE (TNKEYL,FCBBUF(12)) C2800108 EQUIVALENCE (KEYBAM,FCBBUF(13)) C2800109 EQUIVALENCE (KEYBAL,FCBBUF(14)) C2800110 EQUIVALENCE (LENKY1,FCBBUF(15)) C2800111 EQUIVALENCE (POSKY1,FCBBUF(16)) C2800112 EQUIVALENCE (LENKY2,FCBBUF(17)) C2800113 EQUIVALENCE (LENKY3,FCBBUF(19)) C2800114 EQUIVALENCE (LENKY4,FCBBUF(21)) C2800115 EQUIVALENCE (TSFILM,FCBBUF(23)) C2800116 EQUIVALENCE (TSFILL,FCBBUF(24)) C2800117 EQUIVALENCE (NAME12,FCBBUF(25)) C2800118 EQUIVALENCE (OWNR12,FCBBUF(29)) C2800119 EQUIVALENCE (EXPDAT,FCBBUF(89)) C2800120ÐÐ EQUIVALENCE (CRTDAT,FCBBUF(92)) C2800121 EQUIVALENCE (FTYPE,FCBBUF(95)) C2800122C C2800123C EXTERNALS C2800124C C2800125 EXTERNAL MMLUTB C2800126 EXTERNAL WTREAD C2800127 EXTERNAL GETFLD C2800128 EXTERNAL SYSMSG C2800129 EXTERNAL MOVEL C2800130 EXTERNAL OPENFL C2800131 EXTERNAL GETFCB C2800132C C2800133C C2800134 BYTE (IFND,PPTEMP(15=15)) C2800135 BYTE (IREQ,PPTEMP(12=12)) C2800136 BYTE (IPNAM,PPTEMP(7=0)) C2800137C C2800138 BYTE (OPN,ISTAT(0=0)) C2800139 BYTE (IRLOK,ISTAT(3=3)) C2800140 BYTE (INUNK,ISTAT(4=4)) C2800141 BYTE (MME,ISTAT(5=5)) C2800142 BYTE (MFOS,ISTAT(11=11)) C2800143 BYTE (MFO,ISTAT(12=12)) C2800144 BYTE (IOUT,ISTAT(12=12)) C2800145ÐÐ BYTE (WVL,ISTAT(13=13)) C2800146 BYTE (ILR,ISTAT(14=14)) C2800147 BYTE(STAT1,RECBUF(15=12)) C2800148 BYTE(STAT2,RECBUF(11=8)) C2800149 BYTE(STAT3,RECBUF(7=4)) C2800150 BYTE(STAT4,RECBUF(3=0)) C2800151 BYTE(NUM1,IDATA(24)(3=0)) C2800152 BYTE (NUM2,IDATA(24)(11=8)) C2800153C C2800154 DATA NOCUR/-1/,ZRO/0/ C2800155 DATA BUFLEN/40/ C2800156 DATA BLANK/$2020/ C2800157 DATA QUEST/'? '/ C2800158 DATA NAME/'JOB NO. = '/ C2800159C C2800160 DATA KERBAS/ 400/ C2800161. C2800162C C2800163C INITIALIZATION C2800164C C2800165 11 INDEX=0 C2800166+ ERROR MSG NO. C2800167 ERBUF=0 C2800168+ ERROR MSG BUF C2800169 ISTAT=0 C2800170ÐÐ+ STATUS OF FM-REQUEST C2800171 LNGO=0 C2800172+ LENGTH OF FIELD TO MOVE C2800173 MORPAR=0 C2800174+ INDICATOR IF MORE PARAMETERS NEEDED C2800175 MORLIN=0 C2800176+ INDICATOR IF MORE LINES NEED TO BE READ C2800177 PARNUM=0 C2800178+ COUNT OF REQ.AND NOT FOUND PARAMETERS C2800179 PARID=0 C2800180 IFLAG=0 C2800181 IP=1 C2800182C C2800183 ASSIGN 9000 TO INTLOC C2800184 CALL PGMINT(INTLOC,IFLAG) C2800185C C2800186C COPY THE PARAMETER PROCESSING TABLE C2800187C C2800188 I=0 C2800189 10 I=I+1 C2800190 PPTEMP(I)=PPTAB(I) C2800191 IF(PPTEMP(I))10,20,10 C2800192C C2800193C C2800194C C2800195ÐÐ 20 DO 30 I=1,24 C2800196 REQBUF(I)=0 C2800197 CPREQ(I)=0 C2800198 BATREQ(I)=0 C2800199 CPDAT(I)=PARDEF(I) C2800200 BATDAT(I)=PARDEF(I) C2800201 IDATA(I)=PARDEF(I) C2800202 30 CONTINUE C2800203C C2800204 35 IF(PIND)110,70,40 C2800205C C2800206C PROMPTING LEVEL = 1 FULL PARAMETERS WILL BE DISPLAYED C2800207C C2800208 40 KI=IP C2800209 I=(IP-1)*6+1 C2800210 IF(IPNAM(IP))50,100,50 C2800211C C2800212 50 J=I+5 C2800213 K=1 C2800214 CODE(K)=$0A0D C2800215+ SET CR/LF C2800216 DO 60 I=I,J C2800217 K=K+1 C2800218 CODE(K)=NAME(I) C2800219 60 CONTINUE C2800220ÐÐC C2800221 I=KI C2800222 LNGO=7 C2800223 GO TO 90 C2800224. C2800225C C2800226C PROMPTING LEVEL = 0 PARAMETER ABBREVIATIONS WILL BE DISPLAYED C2800227C C2800228 70 I=IP C2800229 K=IPNAM(IP) C2800230+ INDEX TO PARAM.MNEM.TABLE C2800231 IF(K)80,100,80 C2800232 80 K=(K-1)*3+1 C2800233C C2800234 CODE(1)=$0A0D C2800235 CODE(2)=PARNAM(K) C2800236 CODE(3)=$3D20 C2800237 LNGO=3 C2800238C C2800239C DISPLAY NEXT PARAMETER-IDENT C2800240C C2800241 90 CALL WTREAD (LUNIT,NOCUR,CODE,LNGO,NOCUR,DUMMY,ZRO,TC) C2800242C C2800243 PARID=IP C2800244+ INDEX IN PARNAM-TABLE C2800245ÐÐ IFND(I)=1 C2800246+ SET FOUND FLAG C2800247 IP=IP+1 C2800248+ INCR. INDEX TO PPTEMP C2800249 MORPAR=1 C2800250+ SET INDICATOR FOR MORE PARAMETERS NEEDED C2800251 GO TO 120 C2800252C C2800253C END OF PARAMETER LIST, ISSUE FM-REQUEST C2800254C C2800255 100 MORPAR=0 C2800256 GO TO 320 C2800257C C2800258C PROMPTING LEVEL = -1, NO PROMPTING DONE C2800259C C2800260 110 IF(MORLIN)115,130,130 C2800261+ DO WE NEED TO READ MORE LINES C2800262 115 MORLIN=0 C2800263C C2800264C READ NEXT LINE C2800265C C2800266 120 CALL WTREAD (LUNIT,NOCUR,DUMMY,ZRO,NOCUR,INBUF,BUFLEN,TC) C2800267C C2800268C RESET SWORD AND SBYTE C2800269C C2800270ÐÐ SBYTE=0 C2800271 SWORD=0 C2800272. C2800273 130 CALL GETFLD (INBUF,CODE,SWORD,SBYTE,STAT) C2800274C C2800275C C2800276 140 IF (STAT-2)150,160,200 C2800277 150 IF (STAT-1)260,250,250 C2800278C C2800279C EOL DETECTED,COUNT NO OF REQUIRED AND NOT FOUND PARAMETERS (STATUS=1)C2800280C C2800281 160 IF(PIND)161,162,162 C2800282 161 MORPAR=0 C2800283C C2800284C CHECK IF FULL NAME DESIRED C2800285C C2800286 162 IF (CODE(1)-QUEST)164,163,164 C2800287C C2800288C YES,FULL NAME FOR THIS PARAMETER ONLY C2800289C C2800290 163 IF (PIND .NE. -1) IP=IP-1 C2800291 GO TO 40 C2800292C C2800293C CHECK IF PARAMETER ENTERED C2800294C C2800295ÐÐ 164 IF(CODE(1)-BLANK)270,165,270 C2800296 165 IFND(IP-1)=0 C2800297 IF (PIND .EQ. -1) GO TO 320 C2800298 GO TO 35 C2800299C C2800300C PARAMETER-ID FOUND (STATUS=3) C2800301C C2800302 200 I=1 C2800303 210 K=IPNAM(I) C2800304 K=(K-1)*3+1 C2800305C C2800306 IF (CODE(1)-PARNAM(K))230,220,230 C2800307C C2800308C PARAMETER-ID CORRESPONDS WITH PARAM.MNEMONIC TABLE C2800309C C2800310 220 PARID=I C2800311 IFND(I)=1 C2800312 GO TO 130 C2800313C C2800314 230 I=I+1 C2800315+ NO MATCH,CONTINUE C2800316 IF(IPNAM(I))210,240,210 C2800317C C2800318 240 INDEX=39 C2800319+ PARAMETER ILLEGAL C2800320ÐÐ GO TO 8050 C2800321C C2800322C FIELD TERMINATED ON A SEMI-COLON (STATUS=1) C2800323C C2800324 250 MORLIN=-1 C2800325+ SET INDICATOR TO READ MORE LINES C2800326C C2800327C FIELD TERMINATED ON A COMMA (STATUS=0) C2800328C C2800329 260 MORPAR=1 C2800330+ SET INDICATOR FOR MORE PARAMETERS C2800331 IF(CODE(1) .NE. BLANK)GO TO 270 C2800332 IFND(IP)=0 C2800333 IP=IP+1 C2800334 GO TO 35 C2800335C C2800336C STORE PARAMETER VALUES INTO REQUIRED LOCATIONS C2800337C C2800338 270 IF (PARID)290,290,280 C2800339+ PARAMETER-ID FOUND C2800340 280 I=PARID C2800341+ YES C2800342 GO TO 300 C2800343C C2800344 290 I=IP C2800345ÐÐ IF (CODE(1) .NE. BLANK) IFND(I)=1 C2800346 IP=IP+1 C2800347C C2800348 300 I=(IPNAM(I)-1)*3+1 C2800349C C2800350 LNGO=PARNAM(I+1) C2800351 OUTP=PARNAM(I+2) C2800352C C2800353C STORE INTO DESIGNATED OUTPUT FIELD C2800354C C2800355 CALL MOVEL (CODE,OUTP,LNGO) C2800356C C2800357 PARID=0 C2800358 IF(MORPAR)310,320,310 C2800359+ ARE THERE MORE PARAM TO BE PROCESSED C2800360 310 IF(PIND) 110,70,40 C2800361+ YES C2800362C C2800363C C2800364C ARE ALL REQUIRED PARAMETERS FOUND ? C2800365C C2800366 320 I=0 C2800367 330 I=I+1 C2800368 IF(PPTEMP(I))330,360,340 C2800369C C2800370ÐÐC PARAMETER NOT FOUND,IS IT REQUIRED ? C2800371C C2800372 340 IF(IREQ(I))330,350,330 C2800373C C2800374C YES IT IS REQUIRED C2800375C C2800376 350 PARNUM=PARNUM+1 C2800377 GO TO 330 C2800378C C2800379C END OF PPTAB C2800380C C2800381 360 IF(PARNUM) 240,400,240 C2800382+ ARE ALL REQUIRED PARAMETERS FOUND C2800383C C2800384C ALL REQUIRED PARAMETERS HAVE BEEN FOUND C2800385C C2800386 400 IF(MORPAR .NE. 0) GO TO 310 C2800387C C2800388C SET UP TO ACCESS HOST FILE C2800389C C2800390 CPDAT(1)=$2424 C2800391 CPDAT(2)=$484F C2800392 CPDAT(3)=$5354 C2800393 CPDAT(5)=$2424 C2800394 CPDAT(9)=$5359 C2800395ÐÐ CPDAT(10)=$5356 C2800396 CPDAT(11)=$4F4C C2800397 CPDAT(13)=0 C2800398 CPDAT(14)=1 C2800399 CPDAT(15)=1 C2800400 CPREQ(13)=0 C2800401C C2800402C GET FCB HEADER C2800403C LDA =XFCBHDR C2800404C STA+ CPREQ+9 C2800405C C2800406 ASSEM $C000,+FCBHDR C2800407 ASSEM $6400,+CPREQ(10) C2800408C C2800409C OPEN AND LOCK HOST FILE. ALSO GET FCB C2800410C C2800411 CALL OPENFL(CPREQ,CPDAT,ISTAT) C2800412 IF(ISTAT)8000,410,410 C2800413C C2800414C READ IN HOST RECORD AS SPECIFIED BY JOB NO. REC IN IDATA C2800415C C2800416 410 IREC(1)=0 C2800417 IREC(2)=AND(IDATA(23),$F) C2800418 IREC(2)=IREC(2)+1 C2800419 CALL READR(CPREQ,RECBUF,IREC,ISTAT) C2800420ÐÐ IF(ISTAT) 8000,420,420 C2800421C C2800422C LOOP THRU STATUS WORDS UNTIL INDEX MATCHES WORD 2 C2800423C OF JOB NUMBER (IDATA(24)) C2800424C C2800425 420 N=0 C2800426 INUM=NUM1+NUM2*10 C2800427 DO 430 I= 4,RECLEN C2800428 N=N+1 C2800429 IF(INUM.EQ.N) GO TO 435 C2800430 N=N+1 C2800431 IF(INUM.EQ.N) GO TO 440 C2800432 N=N+1 C2800433 IF(INUM.EQ.N) GO TO 450 C2800434 N=N+1 C2800435 IF(INUM.EQ.N) GO TO 460 C2800436 430 CONTINUE C2800437C C2800438C NO JOB NO MATCH. GO TO ERROR C2800439C C2800440 GO TO 8020 C2800441 435 STATUS=STAT1(I) C2800442 IND=1 C2800443 GO TO 470 C2800444 440 STATUS=STAT2(I) C2800445ÐÐ IND=2 C2800446 GO TO 470 C2800447 450 STATUS=STAT3(I) C2800448 IND=3 C2800449 GO TO 470 C2800450 460 STATUS=STAT4(I) C2800451 IND=4 C2800452C C2800453C GET BATCH FILE C2800454C C2800455 470 BATDAT(1)=$2424 C2800456 BATDAT(2)=$4241 C2800457 BATDAT(3)=$5443 C2800458 BATDAT(4)=$4820 C2800459 BATDAT(5)=$2424 C2800460 BATDAT(9)=$5359 C2800461 BATDAT(10)=$5356 C2800462 BATDAT(11)=$4F4C C2800463 BATDAT(13)=1 C2800464 BATDAT(14)=1 C2800465 BATDAT(15)=0 C2800466 CALL OPENFL(BATREQ,BATDAT,ISTAT) C2800467 IF(ISTAT)8010,480,480 C2800468 480 CALL READR(BATREQ,BATBUF,IDATA(23),ISTAT) C2800469 IF(ISTAT)8010,490,490 C2800470ÐÐC C2800471C CHECK IF PORT=0 (MASTER TERMINAL) C2800472C C2800473 490 IF(NOPORT.EQ.0) GO TO 505 C2800474 DO 500 J=1,4 C2800475 IF(BATBUF(J+6).NE.IDUSER(J)) GO TO 510 C2800476 500 CONTINUE C2800477C C2800478C CLOSE BATCH FILE C2800479C C2800480 505 CALL CLOSFL(BATREQ,ISTAT) C2800481 IF(ISTAT)8010,520,520 C2800482 510 CALL CLOSFL(BATREQ,ISTAT) C2800483 IF(ISTAT)8010,8030,8030 C2800484C C2800485C CHECK JOB STATUS CODES C2800486C C2800487C C2800488C IF STATUS = JOB ABORTED, SET STATUS TO INACTIVE C2800489C C2800490 520 IF(STATUS.NE.7) GO TO 521 C2800491 STATUS=0 C2800492 GO TO 540 C2800493 521 IF(STATUS.NE.1) GO TO 525 C2800494 STATUS=0 C2800495ÐÐ GO TO 540 C2800496 525 IF(STATUS.EQ.2) STATUS=8 C2800497 IF(STATUS.EQ.3) STATUS=9 C2800498 IF(STATUS.EQ.4) GO TO 530 C2800499 IF(STATUS.EQ.5) GO TO 530 C2800500 IF(STATUS.NE.0) GO TO 540 C2800501C C2800502C STATUS=0. JOB ALREADY DISCARDED. GO TO ERROR. C2800503C C2800504 GO TO 8040 C2800505C C2800506C STATUS=OUTPUT RECEIVED. DELETE OUTPUT FILE. C2800507C C2800508 530 STATUS=0 C2800509 IDATA(1)=IDATA(23) C2800510 IDATA(2)=IDATA(24) C2800511 IDATA(5)=$2424 C2800512 IDATA(9)=BATBUF(3) C2800513C C2800514C C2800515C THE FOLLOWING CODE PICKS UP OUT OF SYSDAT A TABLE THAT CONTAINS C2800516C THE VOLUME NAME TO CREATE A SCRATCH FILE. C2800517C C2800518C C2800519C LDQ+ WKSPLU C2800520ÐÐC LDQ+ MMLUTB,Q C2800521C INQ 1 C2800522C LDA- (ZERO),Q C2800523C STA+ IDATA(9) C2800524C LDA- 1,Q C2800525C STA+ IDATA(10) C2800526C LDA- 2,Q C2800527C STA+ IDATA(11) C2800528C LDA- 3,Q C2800529C STA+ IDATA(12) C2800530C C2800531C C2800532 ASSEM $E400,+WKSPLU,$E600,+MMLUTB,$D01 C2800533 ASSEM $C622,$6400,+IDATA(9) C2800534 ASSEM $C201,$6400,+IDATA(10) C2800535 ASSEM $C202,$6400,+IDATA(11) C2800536 ASSEM $C203,$6400,+IDATA(12) C2800537 CALL CLOSFL(REQBUF,ISTAT) C2800538 CALL DELETE(REQBUF,IDATA,ISTAT) C2800539 IF(ISTAT)8015,540,540 C2800540C C2800541C SET APPROPRIATE STATUS BYTE IN HOST = TO STATUS C2800542C C2800543 540 GO TO (550,560,570,580),IND C2800544 550 STAT1(I)=STATUS C2800545ÐÐ GO TO 590 C2800546 560 STAT2(I)=STATUS C2800547 GO TO 590 C2800548 570 STAT3(I)=STATUS C2800549 GO TO 590 C2800550 580 STAT4(I)=STATUS C2800551C C2800552C WRITE BACK UPDATED RECORD IN HOST FILE C2800553C C2800554 590 CALL UPDREC(CPREQ,RECBUF,ISTAT) C2800555 IF(ISTAT)8000,9000,9000 C2800556C C2800557C ERROR MESSAGE SECTION C2800558C C2800559C HOST FILE MANAGER ERROR C2800560C C2800561 8000 CALL ERCHK(ISTAT,CPREQ(4)) C2800562 GO TO 8060 C2800563C C2800564C BATCH FILE MANAGER ERROR C2800565C C2800566 8010 CALL ERCHK(ISTAT,BATREQ(4)) C2800567 GO TO 8060 C2800568C C2800569C OUTPUT FILE MANAGER ERROR C2800570ÐÐC C2800571 8015 CALL ERCHK(ISTAT,REQBUF(4)) C2800572 GO TO 8060 C2800573C C2800574C SET INDEX = INVALID JOB NO. C2800575C C2800576 8020 CONTINUE C2800577 INDEX = KERBAS + 15 C2800578 GO TO 8050 C2800579C C2800580C SET INDEX = INVALID OWNER C2800581C C2800582 8030 CONTINUE C2800583 INDEX = KERBAS + 16 C2800584 GO TO 8050 C2800585C C2800586C SET INDEX = JOB ALREADY DISCARDED C2800587C C2800588 8040 CONTINUE C2800589 INDEX = KERBAS + 17 C2800590 8050 CALL SYSMSG(INDEX,ERBUF) C2800591 8060 IF(PIND)8070,8070,11 C2800592 8070 IF(MODE)8080,9000,8080 C2800593 8080 ASSEM $E400,+MODE C2800594 ASSEM $D622 C2800595ÐÐC C2800596C CLOSE HOST FILE C2800597C C2800598 9000 CALL CLOSFL(CPREQ,ISTAT) C2800599 RETURN C2800600 END C2800601 SUBROUTINE DISPOS C2900001 1 /C29 F ITOS CCS 3.0 SL-149C2900002C COMMAND PROCESSOR FOR DISPOSING OF A JOB FILE C2900003C CREDIT COLLECTION SYSTEM VERSION 3.0 C2900004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C2900005C COPYRIGHT CONTROL DATA CORPORATION 1979 C2900006C C2900007C** C2900008C THIS IS THE DISPOSE PROCESSOR C2900009C CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.0 C2900010C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C2900011C COPYRIGHT CONTROL DATA CORPORATION 1977 C2900012C C2900013C C2900014C FUNCTION C2900015C C2900016C THIS PROCESSOR ALLOWS THE TERMINAL USER TO DISPOSE C2900017C OF A JOB THAT IS IN THE 'OUTPUT RECEIVED' STATUS. THE C2900018C USER MAY SELECT THE PRINT OPTION TO PRODUCE A HARDCOPY C2900019ÐÐC PRINTOUT OF THE JOB, OR THE MOVE OPTION TO MOVE THE OUTPUT C2900020C JOB TO ANOTHER FILE, OR THE MOVEPR OPTION TO BOTH MOVE C2900021C AND PRINT. C2900022C C2900023C C2900024C GENERAL DESCRIPTION C2900025C C2900026C THIS PROCESSOR ACCEPTS INPUT FROM EITHER AN INTERACTIVE C2900027C DEVICE OR THE DEVICE IT WAS INITIATED ON. THE PROCESSOR C2900028C RUNS UNDER THE FILE MANAGER UTILITY EXECUTIVE PROGRAM. C2900029C THE COMMAND FORMAT IS C2900030C C2900031C DISPOS,JN=NNNN,OP=AAAAA,NC=NNN,SC=NNN,V2=AAAAAAAA,FN=AAAAAAAA C2900032C JN=JOB NO. C2900033C OP=OPTION C2900034C NC=NO CHARS C2900035C SC=START CHAR C2900036C V2=OUTPUT VOL. C2900037C FN=OUTPUT FILE C2900038C C2900039C C2900040C FLOW C2900041C C2900042C THE PROCESSOR DETERMINES THE LEVEL OF PROMPTING REQUIRED, C2900043C DISPLAYS THE PARAMETERS AND STORES THE PARAMETER VALUES C2900044ÐÐC INTO THE REQUIRED LOCATIONS. C2900045C C2900046C THIS PROCESSOR SEARCHES THE HOST FILE FOR THE JOB C2900047C NUMBER. IF FOUND, IT CHECKS THE STATUS FOR 'OUTPUT C2900048C RECEIVED' (STATUS=4). IF THE OUTPUT IS RECEIVED, IT C2900049C READS IN THE BATCH FILE TO CHECK FOR OWNER VALIDITY. IF C2900050C THE OPTION WAS 'PRINT', IT SETS THE HOST FILE STATUS = 5 C2900051C (PRINT REQUEST). IF THE OPTION WAS MOVE, IT READS IN C2900052C THE JOB OUTPUT FILE, PICKS UP THE NUMBER OF CHARACTERS C2900053C TO MOVE AND THE STARTING CHARACTER. THE PROCESSOR THEN C2900054C CREATES A NEW OUTPUT FILE AND MOVES THE RECORDS TO THE C2900055C NEW FILE, DELETING ALL CONTROL CHARACTERS. AFTER THE C2900056C MOVE IS COMPLETE, THE JOB OUTPUT FILE IS DELETED, AND C2900057C THE HOST STATUS FOR THIS JOB IS SET TO INACTIVE. C2900058C C2900059C C2900060C ERROR MESSAGES C2900061C C2900062C 52 PARAMETER ENTRY ERROR C2900063C 916 INVALID OWNER C2900064C 919 JOB NOT FOUND C2900065C 924 OUTPUT NOT RECEIVED C2900066C C2900067M FMUCOM C2900068. C2900069ÐÐC C2900070 INTEGER OWNR12,OWNR34,OWNR56,OWNR78,RECLEN,TDATRM,TDATRL C2900071 INTEGER DATBAM,DATBAL,FCBIND,TNKEYM,TNKEYL,POSKY1,POSKY2 C2900072 INTEGER POSKY3,POSKY4,TSFILM,TSFILL,EXPDAT,CRTDAT,FILTYP C2900073 INTEGER NOCUR,ZRO,ERBUF,PARNUM,PARID,PPTEMP(17),PPTAB(6) C2900074 INTEGER BUFLEN,TC,OUTP,BLANK,QUEST,STAT,OPN,WVL,FTYPE C2900075 INTEGER OPN,WVL C2900076 INTEGER RECBUF C2900077 INTEGER CPDAT(24),CPREQ(24),CPVOL,CPHDR(5),CPFCB(96),CPWIND C2900078 INTEGER CPRECL,CPFIND,CPLEN1,CPPOS1 C2900079 INTEGER STAT1(18),STAT2(18),STAT3(18),STAT4(18) C2900080 INTEGER BATREQ(24),BATBUF(32),BATDAT(24) C2900081 INTEGER JOBBUF(80),OUTREQ(24),OUTBUF(80),OUTDAT(24) C2900082 INTEGER JREC(2),ISTRT(2),ITOT(2),ITEMP(4) C2900083 INTEGER IREC(2) C2900084 INTEGER HODAT(24) C2900085C C2900086 INTEGER CNVRT C2900087C C2900088 DIMENSION IPNAM(17) C2900089 DIMENSION IREQ(17) C2900090 DIMENSION IFND(17) C2900091 DIMENSION NAME(36) C2900092 DIMENSION NAME12(4) C2900093 DIMENSION OWNR12(4) C2900094ÐÐ DIMENSION KEYVAL(15) C2900095 DIMENSION RECBUF(322) C2900096C C2900097 EQUIVALENCE(PPDISP,PPTAB) C2900098 EQUIVALENCE (CPRECL,CPFCB(1)) C2900099 EQUIVALENCE (CPFIND,CPFCB(6)) C2900100 EQUIVALENCE (CPLEN1,CPFCB(15)) C2900101 EQUIVALENCE (CPPOS1,CPFCB(16)) C2900102 BYTE (IDEL,ISTAT(4=4)) C2900103. C2900104C C2900105C FILE CONTROL BLOCK C2900106C C2900107 EQUIVALENCE (RECLEN,FCBBUF(1)) C2900108 EQUIVALENCE (TDATRM,FCBBUF(2)) C2900109 EQUIVALENCE (TDATRL,FCBBUF(3)) C2900110 EQUIVALENCE (DATBAM,FCBBUF(4)) C2900111 EQUIVALENCE (DATBAL,FCBBUF(5)) C2900112 EQUIVALENCE (FCBIND,FCBBUF(6)) C2900113 EQUIVALENCE (NEDATM,FCBBUF(7)) C2900114 EQUIVALENCE (NEDATL,FCBBUF(8)) C2900115 EQUIVALENCE (NEXTBM,FCBBUF(9)) C2900116 EQUIVALENCE (NEXTBL,FCBBUF(10)) C2900117 EQUIVALENCE (TNKEYM,FCBBUF(11)) C2900118 EQUIVALENCE (TNKEYL,FCBBUF(12)) C2900119ÐÐ EQUIVALENCE (KEYBAM,FCBBUF(13)) C2900120 EQUIVALENCE (KEYBAL,FCBBUF(14)) C2900121 EQUIVALENCE (LENKY1,FCBBUF(15)) C2900122 EQUIVALENCE (POSKY1,FCBBUF(16)) C2900123 EQUIVALENCE (LENKY2,FCBBUF(17)) C2900124 EQUIVALENCE (LENKY3,FCBBUF(19)) C2900125 EQUIVALENCE (LENKY4,FCBBUF(21)) C2900126 EQUIVALENCE (TSFILM,FCBBUF(23)) C2900127 EQUIVALENCE (TSFILL,FCBBUF(24)) C2900128 EQUIVALENCE (NAME12,FCBBUF(25)) C2900129 EQUIVALENCE (OWNR12,FCBBUF(29)) C2900130 EQUIVALENCE (EXPDAT,FCBBUF(89)) C2900131C C2900132C EXTERNALS C2900133C C2900134 EXTERNAL MMLUTB C2900135 EXTERNAL WTREAD C2900136 EXTERNAL GETFLD C2900137 EXTERNAL SYSMSG C2900138 EXTERNAL MOVEL C2900139 EXTERNAL OPENFL C2900140 EXTERNAL GETFCB C2900141 EXTERNAL CHARMV C2900142 EXTERNAL MOVER C2900143 EXTERNAL WKSPLU C2900144ÐÐ EXTERNAL MMLUTB C2900145C C2900146C C2900147 BYTE (IEOF,ISTAT(8=8)) C2900148 BYTE (NUM1,IDATA(24)(3=0)) C2900149 BYTE (NUM2,IDATA(24)(11=8)) C2900150 BYTE (IFND,PPTEMP(15=15)) C2900151 BYTE (IREQ,PPTEMP(12=12)) C2900152 BYTE (IPNAM,PPTEMP(7=0)) C2900153C C2900154 BYTE (OPN,ISTAT(0=0)) C2900155 BYTE (INUNK,ISTAT(4=4)) C2900156 BYTE (WVL,ISTAT(13=13)) C2900157 BYTE(STAT1,RECBUF(15=12)) C2900158 BYTE(STAT2,RECBUF(11=8)) C2900159 BYTE(STAT3,RECBUF(7=4)) C2900160 BYTE(STAT4,RECBUF(3=0)) C2900161C C2900162 DATA NOCUR/-1/,ZRO/0/ C2900163 DATA BUFLEN/40/ C2900164 DATA BLANK/$2020/ C2900165 DATA QUEST/'? '/ C2900166 DATA NAME/'JOB NO. = OPTION = NO. CHARS = START CHAR =OUTPUT C2900167 1VOL.=OUTPUT FILE='/ C2900168C C2900169ÐÐ DATA KERBAS/ 400/ C2900170. C2900171C C2900172C INITIALIZATION C2900173C C2900174 11 INDEX=0 C2900175+ ERROR MSG NO. C2900176 ERBUF=0 C2900177+ ERROR MSG BUF C2900178 ISTAT=0 C2900179+ STATUS OF FM-REQUEST C2900180 LNGO=0 C2900181+ LENGTH OF FIELD TO MOVE C2900182 MORPAR=0 C2900183+ INDICATOR IF MORE PARAMETERS NEEDED C2900184 MORLIN=0 C2900185+ INDICATOR IF MORE LINES NEED TO BE READ C2900186 PARNUM=0 C2900187+ COUNT OF REQ.AND NOT FOUND PARAMETERS C2900188 PARID=0 C2900189 IFLAG=0 C2900190 IP=1 C2900191 IND=0 C2900192C C2900193 ASSIGN 9000 TO INTLOC C2900194ÐÐ CALL PGMINT(INTLOC,IFLAG) C2900195C C2900196C COPY THE PARAMETER PROCESSING TABLE C2900197C C2900198 I=0 C2900199 10 I=I+1 C2900200 PPTEMP(I)=PPTAB(I) C2900201 IF(PPTEMP(I))10,20,10 C2900202C C2900203C C2900204C C2900205 20 DO 30 I=1,24 C2900206 REQBUF(I)=0 C2900207 BATREQ(I)=0 C2900208 CPREQ(I)=0 C2900209 OUTREQ(I)=0 C2900210 BATDAT(I)=PARDEF(I) C2900211 CPDAT(I)=PARDEF(I) C2900212 OUTDAT(I)=PARDEF(I) C2900213 IDATA(I)=PARDEF(I) C2900214 HODAT(I)=PARDEF(I) C2900215 30 CONTINUE C2900216 DO 31 I=1,6 C2900217 DUMMY(I)=BLANK C2900218 31 CONTINUE C2900219ÐÐC C2900220 35 IF(PIND)110,70,40 C2900221C C2900222C PROMPTING LEVEL = 1 FULL PARAMETERS WILL BE DISPLAYED C2900223C C2900224 40 KI=IP C2900225 I=(IP-1)*6+1 C2900226 IF(IPNAM(IP))50,100,50 C2900227C C2900228 50 J=I+5 C2900229 K=1 C2900230 CODE(K)=$0A0D C2900231+ SET CR/LF C2900232 DO 60 I=I,J C2900233 K=K+1 C2900234 CODE(K)=NAME(I) C2900235 60 CONTINUE C2900236C C2900237 I=KI C2900238 LNGO=7 C2900239 GO TO 90 C2900240. C2900241C C2900242C PROMPTING LEVEL = 0 PARAMETER ABBREVIATIONS WILL BE DISPLAYED C2900243C C2900244ÐÐ 70 I=IP C2900245 K=IPNAM(IP) C2900246+ INDEX TO PARAM.MNEM.TABLE C2900247 IF(K)80,100,80 C2900248 80 K=(K-1)*3+1 C2900249C C2900250 CODE(1)=$0A0D C2900251 CODE(2)=PARNAM(K) C2900252 CODE(3)=$3D20 C2900253 LNGO=3 C2900254C C2900255C DISPLAY NEXT PARAMETER-IDENT C2900256C C2900257 90 CALL WTREAD (LUNIT,NOCUR,CODE,LNGO,NOCUR,DUMMY,ZRO,TC) C2900258C C2900259 PARID=IP C2900260+ INDEX IN PARNAM-TABLE C2900261 IFND(I)=1 C2900262+ SET FOUND FLAG C2900263 IP=IP+1 C2900264+ INCR. INDEX TO PPTEMP C2900265 MORPAR=1 C2900266+ SET INDICATOR FOR MORE PARAMETERS NEEDED C2900267 GO TO 120 C2900268C C2900269ÐÐC END OF PARAMETER LIST, ISSUE FM-REQUEST C2900270C C2900271 100 MORPAR=0 C2900272 GO TO 320 C2900273C C2900274C PROMPTING LEVEL = -1, NO PROMPTING DONE C2900275C C2900276 110 IF(MORLIN)115,130,130 C2900277+ DO WE NEED TO READ MORE LINES C2900278 115 MORLIN=0 C2900279C C2900280C READ NEXT LINE C2900281C C2900282 120 CALL WTREAD (LUNIT,NOCUR,DUMMY,ZRO,NOCUR,INBUF,BUFLEN,TC) C2900283C C2900284C RESET SWORD AND SBYTE C2900285C C2900286 SBYTE=0 C2900287 SWORD=0 C2900288. C2900289 130 CALL GETFLD (INBUF,CODE,SWORD,SBYTE,STAT) C2900290C C2900291C C2900292 140 IF (STAT-2)150,160,200 C2900293 150 IF (STAT-1)260,250,250 C2900294ÐÐC C2900295C EOL DETECTED,COUNT NO OF REQUIRED AND NOT FOUND PARAMETERS (STATUS=1)C2900296C C2900297 160 IF(PIND)161,162,162 C2900298 161 MORPAR=0 C2900299C C2900300C CHECK IF FULL NAME DESIRED C2900301C C2900302 162 IF (CODE(1)-QUEST)164,163,164 C2900303C C2900304C YES,FULL NAME FOR THIS PARAMETER ONLY C2900305C C2900306 163 IF (PIND .NE. -1) IP=IP-1 C2900307 GO TO 40 C2900308C C2900309C CHECK IF PARAMETER ENTERED C2900310C C2900311 164 IF(CODE(1)-BLANK)270,165,270 C2900312 165 IFND(IP-1)=0 C2900313 IF (PIND .EQ. -1) GO TO 320 C2900314 GO TO 35 C2900315C C2900316C PARAMETER-ID FOUND (STATUS=3) C2900317C C2900318 200 I=1 C2900319ÐÐ 210 K=IPNAM(I) C2900320 K=(K-1)*3+1 C2900321C C2900322 IF (CODE(1)-PARNAM(K))230,220,230 C2900323C C2900324C PARAMETER-ID CORRESPONDS WITH PARAM.MNEMONIC TABLE C2900325C C2900326 220 PARID=I C2900327 IFND(I)=1 C2900328 GO TO 130 C2900329C C2900330 230 I=I+1 C2900331+ NO MATCH,CONTINUE C2900332 IF(IPNAM(I))210,240,210 C2900333C C2900334 240 INDEX=39 C2900335+ PARAMETER ILLEGAL C2900336 GO TO 8060 C2900337C C2900338C FIELD TERMINATED ON A SEMI-COLON (STATUS=1) C2900339C C2900340 250 MORLIN=-1 C2900341+ SET INDICATOR TO READ MORE LINES C2900342C C2900343C FIELD TERMINATED ON A COMMA (STATUS=0) C2900344ÐÐC C2900345 260 MORPAR=1 C2900346+ SET INDICATOR FOR MORE PARAMETERS C2900347 IF(CODE(1) .NE. BLANK)GO TO 270 C2900348 IFND(IP)=0 C2900349 IP=IP+1 C2900350 GO TO 35 C2900351C C2900352C STORE PARAMETER VALUES INTO REQUIRED LOCATIONS C2900353C C2900354 270 IF (PARID)290,290,280 C2900355+ PARAMETER-ID FOUND C2900356 280 I=PARID C2900357+ YES C2900358 GO TO 300 C2900359C C2900360 290 I=IP C2900361 IF (CODE(1) .NE. BLANK) IFND(I)=1 C2900362 IP=IP+1 C2900363C C2900364 300 I=(IPNAM(I)-1)*3+1 C2900365C C2900366 LNGO=PARNAM(I+1) C2900367 OUTP=PARNAM(I+2) C2900368C C2900369ÐÐC STORE INTO DESIGNATED OUTPUT FIELD C2900370C C2900371 CALL MOVEL (CODE,OUTP,LNGO) C2900372C C2900373C IF OPTION WAS PRINT, NO MORE PARAMETERS ARE REQUIRED. C2900374C GO DIRECTLY TO PROCESS C2900375C C2900376 IF(IDATA(20).EQ.$5052.AND.IDATA(21).EQ.$494E) GO TO 410 C2900377 PARID=0 C2900378 IF(MORPAR)310,320,310 C2900379+ ARE THERE MORE PARAM TO BE PROCESSED C2900380 310 IF(PIND) 110,70,40 C2900381+ YES C2900382C C2900383C C2900384C ARE ALL REQUIRED PARAMETERS FOUND ? C2900385C C2900386 320 I=0 C2900387 330 I=I+1 C2900388 IF(PPTEMP(I))330,360,340 C2900389C C2900390C PARAMETER NOT FOUND,IS IT REQUIRED ? C2900391C C2900392 340 IF(IREQ(I))330,350,330 C2900393C C2900394ÐÐC YES IT IS REQUIRED C2900395C C2900396 350 PARNUM=PARNUM+1 C2900397 GO TO 330 C2900398C C2900399C END OF PPTAB C2900400C C2900401 360 IF(PARNUM) 240,400,240 C2900402+ ARE ALL REQUIRED PARAMETERS FOUND C2900403C C2900404C ALL REQUIRED PARAMETERS HAVE BEEN FOUND C2900405C C2900406 400 IF(MORPAR .NE. 0) GO TO 310 C2900407C C2900408C SET UP FOR HOST FILE MANAGER CALLS C2900409C C2900410 410 HODAT(1)=$2424 C2900411 HODAT(2)=$484F C2900412 HODAT(3)=$5354 C2900413 HODAT(5)=$2424 C2900414 HODAT(9)=$5359 C2900415 HODAT(10)=$5356 C2900416 HODAT(11)=$4F4C C2900417 HODAT(13)=0 C2900418 HODAT(14)=1 C2900419ÐÐ HODAT(15)=0 C2900420C C2900421C OPEN HOST FILE C2900422C C2900423 CALL OPENFL(REQBUF,HODAT,ISTAT) C2900424 IF(ISTAT)8000,420,420 C2900425C C2900426C OPEN BATCH FILE C2900427C C2900428 420 BATDAT(1)=$2424 C2900429 BATDAT(2)=$4241 C2900430 BATDAT(3)=$5443 C2900431 BATDAT(4)=$4820 C2900432 BATDAT(5)=$2424 C2900433C C2900434C C2900435C THE FOLLOWING CODE PICKS UP OUT OF SYSDAT A TABLE THAT CONTAINS C2900436C THE VOLUME NAME TO CREATE A SCRATCH FILE. C2900437C C2900438C C2900439C LDQ+ WKSPLU C2900440C LDQ+ MMLUTB,Q C2900441C INQ 1 C2900442C LDA- (ZERO),Q C2900443C *************************************************************127*5182C2900444ÐÐC STA+ CPDAT(9) C2900445C LDA- 1,Q C2900446C STA+ CPDAT(10) C2900447C LDA- 2,Q C2900448C STA+ CPDAT(11) C2900449C LDA- 3,Q C2900450C STA+ CPDAT(12) C2900451C *************************************************************127*5182C2900452C C2900453C C2900454 ASSEM $E400,+WKSPLU,$E600,+MMLUTB,$D01 C2900455C *************************************************************127*5182C2900456 ASSEM $C622,$6400,+CPDAT(9) C2900457 ASSEM $C201,$6400,+CPDAT(10) C2900458 ASSEM $C202,$6400,+CPDAT(11) C2900459 ASSEM $C203,$6400,+CPDAT(12) C2900460 BATDAT(9) = HODAT(9) C2900461 BATDAT(10) = HODAT(10) C2900462 BATDAT(11) = HODAT(11) C2900463 BATDAT(12) = HODAT(12) C2900464C *************************************************************127*5182C2900465 BATDAT(13)=1 C2900466 BATDAT(14)=1 C2900467 BATDAT(15)=1 C2900468 CALL OPENFL(BATREQ,BATDAT,ISTAT) C2900469ÐÐ IF(ISTAT)8010,430,430 C2900470C C2900471C READ IN RECORD JX OF HOST C2900472C C2900473 430 IREC(1)=0 C2900474 IREC(2)=AND(IDATA(23),$F) C2900475 IREC(2)=IREC(2)+1 C2900476 CALL READR(REQBUF,RECBUF,IREC,ISTAT) C2900477 IF(ISTAT)8000,440,440 C2900478C C2900479C LOOP THRU HOST FILE FOR JOB NO. C2900480C C2900481 440 INUM=NUM1+NUM2*10 C2900482 N=0 C2900483 DO 450 I=4,18 C2900484 N=N+1 C2900485 IF(INUM.EQ.N) GO TO 460 C2900486 N=N+1 C2900487 IF(INUM.EQ.N) GO TO 470 C2900488 N=N+1 C2900489 IF(INUM.EQ.N) GO TO 480 C2900490 N=N+1 C2900491 IF(INUM.EQ.N) GO TO 490 C2900492 450 CONTINUE C2900493C C2900494ÐÐC JOB NO. NOT FOUND. GO TO ERROR C2900495C C2900496 GO TO 8035 C2900497C C2900498C CHECK IF STATUS = OUTPUT RECEIVED C2900499C C2900500 460 IF(STAT1(I).NE.4) GO TO 8040 C2900501 IND=1 C2900502 GO TO 500 C2900503 470 IF(STAT2(I).NE.4) GO TO 8040 C2900504 IND=2 C2900505 GO TO 500 C2900506 480 IF(STAT3(I).NE.4) GO TO 8040 C2900507 IND=3 C2900508 GO TO 500 C2900509 490 IF(STAT4(I).NE.4) GO TO 8040 C2900510 IND=4 C2900511C C2900512C STATUS = OUTPUT RECEIVED. READ IN BATCH FILE RECORD OF JOB NO. C2900513C C2900514 500 CALL READR(BATREQ,BATBUF,IDATA(23),ISTAT) C2900515 IF(ISTAT)8010,510,510 C2900516C C2900517C CHECK FOR VALID OWNER C2900518C C2900519ÐÐ 510 DO 520 J=1,4 C2900520 IF(BATBUF(J+6).NE.IDUSER(J)) GO TO 8050 C2900521 520 CONTINUE C2900522C C2900523C VALID OWNER. CHECK OPTION FOR PRINT C2900524C C2900525 IF(IDATA(20).NE.$5052.AND.IDATA(21).NE.$494E) GO TO 530 C2900526C C2900527C PRINT OPTION. SET STATUS = PRINT REQUEST C2900528C C2900529 521 IF(IND.EQ.1)STAT1(I)=5 C2900530 IF(IND.EQ.2)STAT2(I)=5 C2900531 IF(IND.EQ.3)STAT3(I)=5 C2900532 IF(IND.EQ.4)STAT4(I)=5 C2900533C C2900534C WRITE BACK HOST RECORD C2900535C C2900536 CALL UPDREC(REQBUF,RECBUF,ISTAT) C2900537 IF(ISTAT)8000,525,525 C2900538C C2900539C CHECK IF THIS A MOVE AND PRINT OPTION C2900540C C2900541 525 IF(IDATA(22).EQ.$5052) GO TO 535 C2900542C C2900543C PRINT ONLY OPTION. RETURN C2900544ÐÐC C2900545 GO TO 9000 C2900546C C2900547C CHECK FOR VALID MOVE PARAMETER, OR MOVEPR PARAMETER C2900548C C2900549 530 IF(IDATA(20).NE.$4D4F.AND.IDATA(21).NE.$5645) GO TO 8045 C2900550C C2900551C CHECK IF THIS A MOVE AND PRINT OPTION C2900552C C2900553 IF(IDATA(22).EQ.$5052) GO TO 521 C2900554C C2900555C MOVE OPTION. SET UP TO OPEN JOB FILE C2900556C C2900557 535 CPDAT(1)=IDATA(23) C2900558 CPDAT(2)=IDATA(24) C2900559 CPDAT(5)=$2424 C2900560C *************************************************************127*5182C2900561C 3 CARDS DELETED C2900562C *************************************************************127*5182C2900563 CPDAT(13)=0 C2900564 CPDAT(14)=1 C2900565 CPDAT(15)=-1 C2900566C C2900567C GET FCB HEADER FOR JOB FILE C2900568C C2900569ÐÐ ASSEM $C000,+FCBHDR C2900570 ASSEM $6400,+CPREQ(10) C2900571 CALL OPENFL(CPREQ,CPDAT,ISTAT) C2900572 IF(ISTAT)8020,540,540 C2900573C C2900574C CHECK IF STARTING CHAR AND NO. OF CHARS ENTERED C2900575C C2900576 540 DO 550 J=1,2 C2900577 IF(DUMMY(J).EQ.BLANK.AND.DUMMY(J+3).EQ.BLANK) GO TO 555 C2900578 550 CONTINUE C2900579C C2900580C STARTING CHAR AND NO. OF CHARS ENTERED. CONVERT TO INTEGER C2900581C C2900582 N=3 C2900583 L=8 C2900584C C2900585C GET ADDRESS OF ITEMP ARRAY C2900586C C2900587 ASSEM $C000,+ITEMP C2900588 ASSEM $6800,IADR C2900589C C2900590C MOVE INPUT DATA TO RIGHT AND CONVERT TO BINARY C2900591C C2900592 CALL MOVER(DUMMY(5),N,IADR,L) C2900593 IF (CNVRT( ITEMP(1), ISTRT) .LT. 0) GO TO 8070 C2900594ÐÐC C2900595C FIRST CHAR IN EACH RECORD = NO. WORDS IN RECORD. C2900596C PICK UP STARTING AT NEXT CHARACTER C2900597C C2900598 ISTRT(2)=ISTRT(2)+1 C2900599 N=3 C2900600 L=8 C2900601 CALL MOVER(DUMMY,N,IADR,L) C2900602 IF ( CNVRT( ITEMP(1), ITOT) .LT. 0) GO TO 8070 C2900603 GO TO 560 C2900604C C2900605C FIRST CHAR = NO. WORDS IN RECORD. DEFAULT TO NEXT CHARACTER C2900606C NO STARTING CHAR OR NO. CHARS ENTERED. SET TO DEFAULT C2900607C VALUE (2 AND 80) C2900608C C2900609 555 ISTRT(2)=2 C2900610 ITOT(2)=80 C2900611C C2900612C CREATE NEW OUTPUT FILE C2900613C C2900614 560 OUTDAT(1)=IDATA(1) C2900615 OUTDAT(2)=IDATA(2) C2900616 OUTDAT(3)=IDATA(3) C2900617 OUTDAT(4)=IDATA(4) C2900618 OUTDAT(5)=BATBUF(7) C2900619ÐÐ OUTDAT(6)=BATBUF(8) C2900620 OUTDAT(7)=BATBUF(9) C2900621 OUTDAT(8)=BATBUF(10) C2900622 OUTDAT(9)=IDATA(9) C2900623 OUTDAT(10)=IDATA(10) C2900624 OUTDAT(11)=IDATA(11) C2900625 OUTDAT(12)=IDATA(12) C2900626C *************************************************************127*5182C2900627 IF(IDATA(9).NE.BLANK) GO TO 570 C2900628 OUTDAT(9) = CPDAT(9) C2900629 OUTDAT(10) = CPDAT(10) C2900630 OUTDAT(11) = CPDAT(11) C2900631 OUTDAT(12) = CPDAT(12) C2900632570 OUTDAT(13) = ITOT(2) C2900633C *************************************************************127*5182C2900634 OUTDAT(14)=0 C2900635 OUTDAT(15)=TDATRL C2900636 OUTDAT(16)=0 C2900637 CALL CREATE(OUTREQ,OUTDAT,ISTAT) C2900638 IF(ISTAT)8030,600,600 C2900639C C2900640C OPEN OUTPUT FILE C2900641C C2900642 600 DO 605 J=1,24 C2900643 OUTREQ(J)=0 C2900644ÐÐ 605 CONTINUE C2900645 OUTDAT(13)=0 C2900646 OUTDAT(14)=1 C2900647 OUTDAT(15)=-1 C2900648 CALL OPENFL(OUTREQ,OUTDAT,ISTAT) C2900649 IF(ISTAT)8030,610,610 C2900650C C2900651C GET NEXT RECORD FROM JOB FILE C2900652C C2900653 610 IF(TDATRL.EQ.0) GO TO 640 C2900654 620 CALL GETS(CPREQ,JOBBUF,KEYVAL,ISTAT) C2900655 IF(IEOF.EQ.1) GO TO 640 C2900656 IF(ISTAT)8020,630,630 C2900657 630 TDATRL=TDATRL-1 C2900658C C2900659C CALL SUBROUTINE TO MOVE CHARS C2900660C C2900661 ITOX=0 C2900662 CALL CHARMV(JOBBUF,ISTRT(2),OUTBUF,ITOX,ITOT(2)) C2900663C C2900664C WRITE RECORD TO OUTPUT FILE C2900665C C2900666 NUMREC=1 C2900667 CALL PUTS(OUTREQ,OUTBUF,NUMREC,ISTAT) C2900668 IF(ISTAT)8030,610,610 C2900669ÐÐC C2900670C IF OPTION WAS A MOVE/PRINT REQUEST, DO NOT UPDATE HOST C2900671C STATUS, OR DELETE JOB FILE C2900672C C2900673 640 IF(IDATA(22).EQ.$5052) GO TO 9000 C2900674C C2900675C ALL RECORDS MOVED. DELETE JOB FILE C2900676C C2900677 CALL CLOSFL(CPREQ,ISTAT) C2900678 CALL DELETE(CPREQ,CPDAT,ISTAT) C2900679 IF(ISTAT)8020,660,660 C2900680C C2900681C SET STATUS IN HOST INACTIVE C2900682C C2900683 660 IF(IND.EQ.1)STAT1(I)=0 C2900684 IF(IND.EQ.2)STAT2(I)=0 C2900685 IF(IND.EQ.3)STAT3(I)=0 C2900686 IF(IND.EQ.4)STAT4(I)=0 C2900687C C2900688C WRITE BACK UPDATED HOST RECORD C2900689C C2900690 CALL UPDREC(REQBUF,RECBUF,ISTAT) C2900691 IF(ISTAT)8000,9000,9000 C2900692C C2900693C ERROR MSG SECTION C2900694ÐÐC C2900695 8000 CALL ERCHK(ISTAT,REQBUF(4)) C2900696 GO TO 8070 C2900697 8010 CALL ERCHK(ISTAT,BATREQ(4)) C2900698 GO TO 8070 C2900699 8020 CALL ERCHK(ISTAT,CPREQ(4)) C2900700 GO TO 8070 C2900701 8030 CALL ERCHK(ISTAT,OUTREQ(4)) C2900702 GO TO 8070 C2900703C C2900704C SET INDEX = JOB NOT FOUND C2900705C C2900706 8035 CONTINUE C2900707 INDEX = KERBAS + 19 C2900708 GO TO 8060 C2900709C C2900710C SET INDEX = OUTPUT NOT RECEIVED C2900711C C2900712 8040 CONTINUE C2900713 INDEX = KERBAS + 24 C2900714 GO TO 8060 C2900715C C2900716C SET INDEX = PARAMETER ENTRY ERROR C2900717C C2900718 8045 INDEX=052 C2900719ÐÐ GO TO 8060 C2900720C C2900721C SET INDEX = INVALID OWNER C2900722C C2900723 8050 CONTINUE C2900724 INDEX = KERBAS + 16 C2900725 8060 CALL SYSMSG(INDEX,ERBUF) C2900726 8070 IF(PIND)8080,8080,11 C2900727 8080 IF(MODE)8090,9000,8090 C2900728 8090 ASSEM $E400,+MODE C2900729 ASSEM $D622 C2900730 9000 CALL CLOSFL(REQBUF,ISTAT) C2900731 CALL CLOSFL(BATREQ,ISTAT) C2900732 CALL CLOSFL(OUTREQ,ISTAT) C2900733 CALL CLOSFL(CPREQ,ISTAT) C2900734 RETURN C2900735 END C2900736 SUBROUTINE FLUSH C3000001 1 /C30 F ITOS CCS 3.0 SL-149C3000002C COMMAND PROCESSOR FOR PURGING ALL JOBS IN THE HOST FILE C3000003C CREDIT COLLECTION SYSTEM VERSION 3.0 C3000004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C3000005C COPYRIGHT CONTROL DATA CORPORATION 1979 C3000006C** C3000007C COMMAND PROCESSOR FOR FLUSH. C3000008ÐÐC CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.0 C3000009C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C3000010C COPYRIGHT CONTROL DATA CORPORATION 1977 C3000011C C3000012C C3000013C FUNCTION C3000014C THIS PROCESSOR PURGES ALL JOBS IN THE HOST FILE THAT ARE IN C3000015C A SENT STATUS AND THAT ARE N DAYS OLD. IF N IS NEGATIVE, ALL C3000016C JOBS WILL BE PURGED FOR THAT HOST. C3000017C C3000018C GENERAL DESCRIPTION C3000019C C3000020C THIS PROCESSOR ACCEPTS INPUT FROM EITHER AN INTERACTIVE C3000021C DEVICE OR THE DEVICE IT WAS INITIATED ON. THE PROCESSOR C3000022C RUNS UNDER THE FILE MANAGER UTILITY EXECUTIVE PROGRAM. C3000023C THE COMMAND FORMAT IS C3000024C FLUSH,HO=AAAA,DO=NNN C3000025C HO=HOST NAME C3000026C DO=DAYS OLD C3000027C C3000028C C3000029C FLOW C3000030C C3000031C THE PROCESSOR DETERMINES THE LEVEL OF PROMPTING REQUIRED, C3000032C DISPLAYS THE PARAMETERS AND STORES THE PARAMETER VALUES C3000033ÐÐC INTO THE REQUIRED LOCATIONS. C3000034C C3000035C THIS PROCESSOR PICKS UP THE 'DAYS OLD' VALUE AND CONVERTS C3000036C IT TO ASCII. IT THEN GETS THE CURRENT DATE AND CONVERTS C3000037C IT TO JULIAN. THE HOST FILE IS THEN READ AND A SEARCH C3000038C MADE FOR ALL JOBS IN A SENT STATUS. FOR ALL SENT C3000039C JOBS, A COMPARISON IS MADE BETWEEN THE CURRENT JULIAN DATE C3000040C AND THE DATE ENTERED. IF THE ENTRY IS GREATER THAN OR C3000041C EQUAL TO THE REQUIRED AGE, IT WILL BE PURGED BY SETTING C3000042C THE JOB STATUS IN THE HOST FILE INACTIVE. IF THE C3000043C DAYS OLD ENTRY IS NEGATIVE (-) AND THE HOST IS INACTIVE, C3000044C ALL THE JOB STATUS WORDS IN THE HOST FILE ARE SET TO INACTIVE. C3000045C C3000046C ERROR MESSAGES C3000047C C3000048C 905 BATCH DRIVER BUSY C3000049C 901 HOST NAME NOT FOUND. C3000050C C3000051C C3000052C C3000053C C3000054C C3000055M FMUCOM C3000056. C3000057C C3000058ÐÐ INTEGER OWNR12,OWNR34,OWNR56,OWNR78,RECLEN,TDATRM,TDATRL C3000059 INTEGER DATBAM,DATBAL,FCBIND,TNKEYM,TNKEYL,POSKY1,POSKY2 C3000060 INTEGER POSKY3,POSKY4,TSFILM,TSFILL,EXPDAT,CRTDAT,FILTYP C3000061 INTEGER NOCUR,ZRO,ERBUF,PARNUM,PARID,PPTEMP(17),PPTAB(6) C3000062 INTEGER BUFLEN,TC,OUTP,BLANK,QUEST,STAT,OPN,WVL,FTYPE C3000063 INTEGER OPN,WVL C3000064 INTEGER RECBUF C3000065 INTEGER CPDAT(24),CPREQ(24),CPVOL,CPHDR(5),CPFCB(96),CPWIND C3000066 INTEGER CPRECL,CPFIND,CPLEN1,CPPOS1 C3000067 INTEGER STAT1(15),STAT2(15),STAT3(15),STAT4(15) C3000068 INTEGER BINASC C3000069C C3000070 INTEGER CNVRT C3000071C C3000072 DIMENSION IPNAM(17) C3000073 DIMENSION IREQ(17) C3000074 DIMENSION IFND(17) C3000075 DIMENSION NAME(12) C3000076 DIMENSION NAME12(4) C3000077 DIMENSION OWNR12(4) C3000078 DIMENSION KEYVAL(15) C3000079 DIMENSION RECBUF(322) C3000080 DIMENSION IHOBUF(24) C3000081 DIMENSION IHODAT(15) C3000082 DIMENSION IMONTH(12) C3000083ÐÐ DIMENSION IKEYS(4) C3000084 DIMENSION IRECBF(32) C3000085 DIMENSION I100(2),I10(2) C3000086 DIMENSION ITEMP(4) C3000087 DIMENSION IOUT(2) C3000088 DIMENSION ILOW(22) C3000089 DIMENSION IUPPR(22) C3000090 DIMENSION IBABUF(24) C3000091 DIMENSION IBADAT(15) C3000092C C3000093 EQUIVALENCE (PPFLUS,PPTAB) C3000094 EQUIVALENCE (CPRECL,CPFCB(1)) C3000095 EQUIVALENCE (CPFIND,CPFCB(6)) C3000096 EQUIVALENCE (CPLEN1,CPFCB(15)) C3000097 EQUIVALENCE (CPPOS1,CPFCB(16)) C3000098 BYTE (IDEL,ISTAT(4=4)) C3000099. C3000100C C3000101C FILE CONTROL BLOCK C3000102C C3000103 EQUIVALENCE (RECLEN,FCBBUF(1)) C3000104 EQUIVALENCE (TDATRM,FCBBUF(2)) C3000105 EQUIVALENCE (TDATRL,FCBBUF(3)) C3000106C C3000107C EXTERNALS C3000108ÐÐC C3000109 EXTERNAL MMLUTB C3000110 EXTERNAL WTREAD C3000111 EXTERNAL GETFLD C3000112 EXTERNAL SYSMSG C3000113 EXTERNAL MOVEL C3000114 EXTERNAL OPENFL C3000115 EXTERNAL GETFCB C3000116 EXTERNAL MONTO C3000117 EXTERNAL DAYTO C3000118 EXTERNAL BINASC C3000119C C3000120C C3000121 BYTE (IFND,PPTEMP(15=15)) C3000122 BYTE (IREQ,PPTEMP(12=12)) C3000123 BYTE (IPNAM,PPTEMP(7=0)) C3000124C C3000125 BYTE (OPN,ISTAT(0=0)) C3000126 BYTE (NFD,ISTAT(1=1)) C3000127 BYTE (LOK,ISTAT(2=2)) C3000128 BYTE (IRLOK,ISTAT(3=3)) C3000129 BYTE (INUNK,ISTAT(4=4)) C3000130 BYTE (MME,ISTAT(5=5)) C3000131 BYTE (MFOS,ISTAT(11=11)) C3000132 BYTE (MFO,ISTAT(12=12)) C3000133ÐÐ BYTE (IOUT,ISTAT(12=12)) C3000134 BYTE (WVL,ISTAT(13=13)) C3000135 BYTE (ILR,ISTAT(14=14)) C3000136 BYTE(STAT1,RECBUF(15=12)) C3000137 BYTE(STAT2,RECBUF(11=8)) C3000138 BYTE(STAT3,RECBUF(7=4)) C3000139 BYTE(STAT4,RECBUF(3=0)) C3000140 BYTE(IUPPR,IRECBF(11=8)) C3000141 BYTE(ILOW,IRECBF(3=0)) C3000142 BYTE(I100,DUMMY(3=0)) C3000143 BYTE(I10,DUMMY(11=8)) C3000144C C3000145 DATA NOCUR/-1/,ZRO/0/ C3000146 DATA BUFLEN/40/ C3000147 DATA BLANK/$2020/ C3000148 DATA QUEST/'? '/ C3000149 DATA IMONTH/31,28,31,30,31,30,31,31,30,31,30,31/ C3000150 DATA IJULAN/0/ C3000151 DATA IBABUF/24*0/ C3000152 DATA IBADAT/'$$BATCH $$ SYSVOL ',1,1,0/ C3000153 DATA NAME/'HOST NAME = DAYS OLD = '/ C3000154C C3000155 DATA KERBAS/ 400/ C3000156. C3000157C C3000158ÐÐC INITIALIZATION C3000159C C3000160 11 INDEX=0 C3000161+ ERROR MSG NO. C3000162 ERBUF=0 C3000163+ ERROR MSG BUF C3000164 ISTAT=0 C3000165+ STATUS OF FM-REQUEST C3000166 LNGO=0 C3000167+ LENGTH OF FIELD TO MOVE C3000168 MORPAR=0 C3000169+ INDICATOR IF MORE PARAMETERS NEEDED C3000170 MORLIN=0 C3000171+ INDICATOR IF MORE LINES NEED TO BE READ C3000172 PARNUM=0 C3000173+ COUNT OF REQ.AND NOT FOUND PARAMETERS C3000174 PARID=0 C3000175 IFLAG=0 C3000176 IP=1 C3000177C C3000178 ASSIGN 9998 TO INTLOC C3000179 CALL PGMINT(INTLOC,IFLAG) C3000180C C3000181C COPY THE PARAMETER PROCESSING TABLE C3000182C C3000183ÐÐ I=0 C3000184 10 I=I+1 C3000185 PPTEMP(I)=PPTAB(I) C3000186 IF(PPTEMP(I))10,20,10 C3000187C C3000188C C3000189C C3000190 20 DO 30 I=1,24 C3000191 REQBUF(I)=0 C3000192 IDATA(I)=PARDEF(I) C3000193 30 CONTINUE C3000194C C3000195 35 IF(PIND)110,70,40 C3000196C C3000197C PROMPTING LEVEL = 1 FULL PARAMETERS WILL BE DISPLAYED C3000198C C3000199 40 KI=IP C3000200 I=(IP-1)*6+1 C3000201 IF(IPNAM(IP))50,100,50 C3000202C C3000203 50 J=I+5 C3000204 K=1 C3000205 CODE(K)=$0A0D C3000206+ SET CR/LF C3000207 DO 60 I=I,J C3000208ÐÐ K=K+1 C3000209 CODE(K)=NAME(I) C3000210 60 CONTINUE C3000211C C3000212 I=KI C3000213 LNGO=7 C3000214 GO TO 90 C3000215. C3000216C C3000217C PROMPTING LEVEL = 0 PARAMETER ABBREVIATIONS WILL BE DISPLAYED C3000218C C3000219 70 I=IP C3000220 K=IPNAM(IP) C3000221+ INDEX TO PARAM.MNEM.TABLE C3000222 IF(K)80,100,80 C3000223 80 K=(K-1)*3+1 C3000224C C3000225 CODE(1)=$0A0D C3000226 CODE(2)=PARNAM(K) C3000227 CODE(3)=$3D20 C3000228 LNGO=3 C3000229C C3000230C DISPLAY NEXT PARAMETER-IDENT C3000231C C3000232 90 CALL WTREAD (LUNIT,NOCUR,CODE,LNGO,NOCUR,DUMMY,ZRO,TC) C3000233ÐÐC C3000234 PARID=IP C3000235+ INDEX IN PARNAM-TABLE C3000236 IFND(I)=1 C3000237+ SET FOUND FLAG C3000238 IP=IP+1 C3000239+ INCR. INDEX TO PPTEMP C3000240 MORPAR=1 C3000241+ SET INDICATOR FOR MORE PARAMETERS NEEDED C3000242 GO TO 120 C3000243C C3000244C END OF PARAMETER LIST, ISSUE FM-REQUEST C3000245C C3000246 100 MORPAR=0 C3000247 GO TO 320 C3000248C C3000249C PROMPTING LEVEL = -1, NO PROMPTING DONE C3000250C C3000251 110 IF(MORLIN)115,130,130 C3000252+ DO WE NEED TO READ MORE LINES C3000253 115 MORLIN=0 C3000254C C3000255C READ NEXT LINE C3000256C C3000257 120 CALL WTREAD (LUNIT,NOCUR,DUMMY,ZRO,NOCUR,INBUF,BUFLEN,TC) C3000258ÐÐC C3000259C RESET SWORD AND SBYTE C3000260C C3000261 SBYTE=0 C3000262 SWORD=0 C3000263. C3000264 130 CALL GETFLD (INBUF,CODE,SWORD,SBYTE,STAT) C3000265C C3000266C C3000267 140 IF (STAT-2)150,160,200 C3000268 150 IF (STAT-1)260,250,250 C3000269C C3000270C EOL DETECTED,COUNT NO OF REQUIRED AND NOT FOUND PARAMETERS (STATUS=1)C3000271C C3000272 160 IF(PIND)161,162,162 C3000273 161 MORPAR=0 C3000274C C3000275C CHECK IF FULL NAME DESIRED C3000276C C3000277 162 IF (CODE(1)-QUEST)164,163,164 C3000278C C3000279C YES,FULL NAME FOR THIS PARAMETER ONLY C3000280C C3000281 163 IF (PIND .NE. -1) IP=IP-1 C3000282 GO TO 40 C3000283ÐÐC C3000284C CHECK IF PARAMETER ENTERED C3000285C C3000286 164 IF(CODE(1)-BLANK)270,165,270 C3000287 165 IFND(IP-1)=0 C3000288 IF (PIND .EQ. -1) GO TO 320 C3000289 GO TO 35 C3000290C C3000291C PARAMETER-ID FOUND (STATUS=3) C3000292C C3000293 200 I=1 C3000294 210 K=IPNAM(I) C3000295 K=(K-1)*3+1 C3000296C C3000297 IF (CODE(1)-PARNAM(K))230,220,230 C3000298C C3000299C PARAMETER-ID CORRESPONDS WITH PARAM.MNEMONIC TABLE C3000300C C3000301 220 PARID=I C3000302 IFND(I)=1 C3000303 GO TO 130 C3000304C C3000305 230 I=I+1 C3000306+ NO MATCH,CONTINUE C3000307 IF(IPNAM(I))210,240,210 C3000308ÐÐC C3000309 240 INDEX=39 C3000310+ PARAMETER ILLEGAL C3000311 GO TO 9999 C3000312C C3000313C FIELD TERMINATED ON A SEMI-COLON (STATUS=1) C3000314C C3000315 250 MORLIN=-1 C3000316+ SET INDICATOR TO READ MORE LINES C3000317C C3000318C FIELD TERMINATED ON A COMMA (STATUS=0) C3000319C C3000320 260 MORPAR=1 C3000321+ SET INDICATOR FOR MORE PARAMETERS C3000322 IF(CODE(1) .NE. BLANK)GO TO 270 C3000323 IFND(IP)=0 C3000324 IP=IP+1 C3000325 GO TO 35 C3000326C C3000327C STORE PARAMETER VALUES INTO REQUIRED LOCATIONS C3000328C C3000329 270 IF (PARID)290,290,280 C3000330+ PARAMETER-ID FOUND C3000331 280 I=PARID C3000332+ YES C3000333ÐÐ GO TO 300 C3000334C C3000335 290 I=IP C3000336 IF (CODE(1) .NE. BLANK) IFND(I)=1 C3000337 IP=IP+1 C3000338C C3000339 300 I=(IPNAM(I)-1)*3+1 C3000340C C3000341 LNGO=PARNAM(I+1) C3000342 OUTP=PARNAM(I+2) C3000343C C3000344C STORE INTO DESIGNATED OUTPUT FIELD C3000345C C3000346 CALL MOVEL (CODE,OUTP,LNGO) C3000347C C3000348 PARID=0 C3000349 IF(MORPAR)310,320,310 C3000350+ ARE THERE MORE PARAM TO BE PROCESSED C3000351 310 IF(PIND) 110,70,40 C3000352+ YES C3000353C C3000354C C3000355C ARE ALL REQUIRED PARAMETERS FOUND ? C3000356C C3000357 320 I=0 C3000358ÐÐ 330 I=I+1 C3000359 IF(PPTEMP(I))330,360,340 C3000360C C3000361C PARAMETER NOT FOUND,IS IT REQUIRED ? C3000362C C3000363 340 IF(IREQ(I))330,350,330 C3000364C C3000365C YES IT IS REQUIRED C3000366C C3000367 350 PARNUM=PARNUM+1 C3000368 GO TO 330 C3000369C C3000370C END OF PPTAB C3000371C C3000372 360 IF(PARNUM) 240,400,240 C3000373+ ARE ALL REQUIRED PARAMETERS FOUND C3000374C C3000375C ALL REQUIRED PARAMETERS HAVE BEEN FOUND C3000376C C3000377 400 IF(MORPAR .NE. 0) GO TO 310 C3000378C CONVERT DAYS OLD TO INTEGER. C3000379C C3000380 N=3 C3000381 L=8 C3000382C GET ADDRESS OF ITEMP ARRAY. C3000383ÐÐ ASSEM $C000,+ITEMP C3000384 ASSEM $6800,IADR C3000385C C3000386C CHECK IF NEGATIVE SIGN C3000387C C3000388 IF ( DUMMY .EQ. $2D20) GO TO 410 C3000389C FIRST MOVE THE INPUT DATA FOUND IN DUMMY C3000390C TO THE RIGHT WITH 'MOVER',THEN CONVERT IT TO C3000391C BINARY WITH 'CNVRT'. C3000392 CALL MOVER(DUMMY,N,IADR,L) C3000393 IF (CNVRT( ITEMP(1), IOUT) .LT. 0) GO TO 8500 C3000394C C3000395C STORE BINARY NUMBER IN KAGE. THIS IS THE DAYS OLD C3000396C VALUE TO USE. C3000397C C3000398 410 CONTINUE C3000399 ASSEM $E000,+KAGE C3000400 ASSEM $C400,+IOUT(2) C3000401 ASSEM $6622 C3000402C C3000403C GET CURRENT DAY AND MONTH AND CONVERT TO JULIAN C3000404C DATE. C3000405C C3000406 ASSEM $C400,+DAYTO,$6800,ITODAY C3000407 ASSEM $C400,+MONTO,$6800,ITOMON C3000408ÐÐ IF(ITOMON.EQ.1)GO TO 430 C3000409 ITOMON=ITOMON-1 C3000410 DO 420 INDX=1,ITOMON C3000411 IJULAN=IJULAN+IMONTH(INDX) C3000412 420 CONTINUE C3000413 430 IJULAN=IJULAN+ITODAY C3000414C SET UP FOR $$HOST FILE ON SYSVOL. C3000415 IDATA(1)=$2424 C3000416 IDATA(2)=$484F C3000417 IDATA(3)=$5354 C3000418 IDATA(5)=$2424 C3000419 IDATA(9)=$5359 C3000420 IDATA(10)=$5356 C3000421 IDATA(11)=$4F4C C3000422 IDATA(13)=0 C3000423 IDATA(14)=1 C3000424 IDATA(15)=-1 C3000425C C3000426C GET FCB HEADER WITH OPEN REQUEST C3000427C LDA =XFCBHDR C3000428C STA+ REQBUF+9 C3000429C C3000430 ASSEM $C000,+FCBHDR C3000431 ASSEM $6400,+REQBUF(10) C3000432C C3000433ÐÐC OPEN AND LOCK HOST FILE. C3000434C C3000435 CALL OPENFL(REQBUF,IDATA,ISTAT) C3000436 IF(ISTAT)8000,450,450 C3000437 450 REQBUF(13)=TDATRL C3000438C C3000439C READ IN HOST FILE USING TDATRL NUMBER OF RECORDS C3000440C IN THE READ REQUEST. C3000441C C3000442 CALL GETS(REQBUF,RECBUF,KEYVAL,ISTAT) C3000443 IF(ISTAT)8000,480,480 C3000444C C3000445C ENTIRE HOST FILE NOW RESIDES IN RECBUF C3000446C C3000447C C3000448C FIND SELECTED HOST IN $$HOST FILE C3000449C C3000450 480 K=RECLEN*TDATRL C3000451 M=$4A30 C3000452 DO 500 I=1,K,RECLEN C3000453 IF(RECBUF(I).EQ.DUMMY(5).AND.RECBUF(I+1).EQ.DUMMY(6)) GO TO 550 C3000454 M=M+1 C3000455 500 CONTINUE C3000456C C3000457C SET INDEX = HOST NAME NOT FOUND C3000458ÐÐC C3000459 INDEX = KERBAS + 1 C3000460 GO TO 9999 C3000461C OPEN BATCH FILE C3000462C C3000463 550 CALL OPENFL(IBABUF,IBADAT,ISTAT) C3000464 IF(ISTAT.LT.0)GO TO 7900 C3000465 IF(DUMMY.EQ.$2D20)GO TO 800 C3000466C C3000467C DAYS OLD WAS NOT NEGATIVE. GET POSITIVE NUMBER OF C3000468C DAYS FOR FLUSH CRITERIA. DAYS FOUND IN DUMMY +0,+1 C3000469C C3000470C CHECK ALL STATUS BYTES FOR THIS HOST. THOSE WITH C3000471C A SENT STATUS WILL BE PROCESSED FURTHER. C3000472C C3000473 N=0 C3000474 IRECLN=RECLEN+I-1 C3000475 I=I+3 C3000476 560 IF(I.GE.IRECLN) GO TO 635 C3000477 N=N+1 C3000478 IBIAS=1 C3000479 ASSIGN 600 TO ICOMPL C3000480 IF(STAT1(I).EQ.3) GO TO 650 C3000481 600 N=N+1 C3000482 IBIAS=2 C3000483ÐÐ ASSIGN 610 TO ICOMPL C3000484 IF(STAT2(I).EQ.3) GO TO 650 C3000485 610 N=N+1 C3000486 IBIAS=3 C3000487 ASSIGN 620 TO ICOMPL C3000488 IF(STAT3(I).EQ.3) GO TO 650 C3000489 620 N=N+1 C3000490 IBIAS=4 C3000491 ASSIGN 630 TO ICOMPL C3000492 IF(STAT4(I).EQ.3) GO TO 650 C3000493 630 I=I+1 C3000494 GO TO 560 C3000495C C3000496C UPDATE $$HOST FILE WITH THE NEW JOB STATUS WORDS. C3000497C C3000498 635 CALL UPDREC(REQBUF,RECBUF,ISTAT) C3000499 IF(ISTAT.LT.0)GO TO 8000 C3000500 GO TO 9000 C3000501C C3000502C PROCESS TASK WITH A SENT STATUS. C3000503C READ BATCH FILE ENTRY FOR THIS JOB. THE JOB KEY C3000504C WILL BE JMNN WHERE M=INDEX OF HOST POSITION AND C3000505C NN= INDEX OF (J-3)*4-BIAS. C3000506C C3000507C SINCE FEW ENTRIES ARE ANTICIPATED TO BE CANDIDATES C3000508ÐÐC FOR FLUSH, BATCH FILE ENTRIES WILL BE READ ONE AT C3000509C A TIME AS REQUIRED. C3000510C C3000511C GET TENS AND UNITS DIGITS. C3000512C THE DIGITS ARE THEN COMBINED IN THEIR ASCII C3000513C EQUIVALENTS. C3000514C C3000515C A JOB WITH A SENT STATUS WAS FOUND,PROCESS IT. C3000516C C3000517C C3000518C CREATE THE REQUIRED KEY TO THE $$BATCH FILE. C3000519 650 IKEYS(1)=M C3000520 CALL BINASC(N,IKEYS(2)) C3000521 IF(AND(IKEYS(4),$FF00).EQ.$2000) C3000522 1 IKEYS(4)=$3000+AND(IKEYS(4),$FF) C3000523 IKEYS(2)=IKEYS(4) C3000524 CALL READR(IBABUF,IRECBF,IKEYS,ISTAT) C3000525 IF(ISTAT.LT.0)GO TO 7900 C3000526 670 IDAY=IUPPR(21)*10+ILOW(21) C3000527 IMON=IUPPR(22)*10+ILOW(22) C3000528 ITOTL=0 C3000529 IF(IMON.EQ.1)GO TO 690 C3000530 IMON=IMON-1 C3000531 DO 680 INDX=1,IMON C3000532 ITOTL=ITOTL+IMONTH(INDX) C3000533ÐÐ 680 CONTINUE C3000534C COMBINE DAYS IN ALL PREVIOUS MONTHS AND DAY TO C3000535C GET THE JULIAN EQUIVALENT. C3000536C C3000537 690 ITOTL=ITOTL+IDAY C3000538C C3000539C COMPARE THE CURRENT JULIAN DATE IN IJULAN WITH C3000540C THE DATE TRANSMITTED IN ITOTL. IF THE ENTRY IS C3000541C GREATER THAN OR EQUAL TO THE REQUIRED AGE, IT C3000542C WILL BE FLUSHED BY SETTING THE JOB STATUS IN THE C3000543C HOST FILE TO INACTIVE. C3000544 IAGE=IJULAN-ITOTL C3000545 IF(IAGE.GE.0)GO TO 700 C3000546 IAGE=365-ITOTL+IJULAN C3000547 700 IF(IAGE.LT.KAGE)GO TO ICOMPL C3000548C C3000549C DELETE THIS JOB. C3000550C C3000551 GO TO (701,702,703,704),IBIAS C3000552 701 STAT1(I)=0 C3000553 GO TO ICOMPL C3000554 702 STAT2(I)=0 C3000555 GO TO ICOMPL C3000556 703 STAT3(I)=0 C3000557 GO TO ICOMPL C3000558ÐÐ 704 STAT4(I)=0 C3000559 GO TO ICOMPL C3000560C C3000561C THE DAYS OLD ENTRY CONTAINED A -. IF THE HOST IS C3000562C INACTIVE, SET ALL OF THE JOB STATUS WORDS TO C3000563C INACTIVE. THE HOST IS INACTIVE IF JA=0 IN WORD 3 C3000564C BIT 10 OF THE $$HOST FILE ENTRY. C3000565C C3000566 800 IF(AND(RECBUF(I+2),$400).NE.0)GO TO 8050 C3000567 ILAST=I+RECLEN-1 C3000568 I=I+3 C3000569 DO 820 J=I,ILAST C3000570 RECBUF(J)=0 C3000571 820 CONTINUE C3000572 GO TO 635 C3000573 7900 CALL ERCHK(ISTAT,IBABUF(4)) C3000574 GO TO 8500 C3000575 8000 CALL ERCHK(ISTAT,REQBUF(4)) C3000576 GO TO 8500 C3000577C C3000578C SET INDEX = BATCH DRIVER BUSY ON THIS HOST C3000579C C3000580 8050 CONTINUE C3000581 INDEX = KERBAS + 5 C3000582 9999 CONTINUE C3000583ÐÐ 8100 CALL SYSMSG(INDEX,ERBUF) C3000584 8500 IF(PIND)8600,8600,11 C3000585 8600 IF(MODE)8700,9000,8700 C3000586 8700 ASSEM $E400,+MODE C3000587 ASSEM $D622 C3000588C C3000589C CLOSE ALL FILES BEFORE EXITING. C3000590C C3000591 9998 CONTINUE C3000592 9000 CALL CLOSFL(REQBUF,ISTAT) C3000593 CALL CLOSFL(IBABUF,ISTAT) C3000594 RETURN C3000595 END C3000596 SUBROUTINE PRINT C3100001 1 /C31 F ITOS CCS 3.0 SL-149C3100002C COMMAND PROCESSOR FOR PRINTING THE OUTPUT FILES FROM BATCHING C3100003C CREDIT COLLECTION SYSTEM VERSION 3.0 C3100004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C3100005C COPYRIGHT CONTROL DATA CORPORATION 1979 C3100006C C3100007C** C3100008C COMMAND PROCESSOR FOR PRINT C3100009C CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.0 C3100010C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C3100011C COPYRIGHT CONTROL DATA CORPORATION 1977 C3100012ÐÐC C3100013C C3100014C FUNCTION C3100015C C3100016C THIS PROCESSOR PRINTS THE OUTPUT FILES FROM BATCH C3100017C PROCESSING. C3100018C C3100019C GENERAL DESCRIPTION C3100020C C3100021C THIS PROCESSOR ACCEPTS INPUT FROM EITHER AN INTERACTIVE C3100022C DEVICE OR THE DEVICE IT WAS INITIATED ON. THE PROCESSOR C3100023C RUNS UNDER THE FILE MANAGER UTILITY EXECUTIVE PROGRAM. C3100024C THE COMMAND FORMAT IS C3100025C PRINT,OP=AAAA,P=AAAAAAAA C3100026C OP=OPTION (JOB NUMBER OR HOST NAME) C3100027C P=LIST DEVICE NAME C3100028C C3100029C C3100030C FLOW C3100031C C3100032C THE PROCESSOR DETERMINES THE LEVEL OF PROMPTING REQUIRED, C3100033C DISPLAYS THE PARAMETERS AND STORES THE PARAMETER VALUES C3100034C INTO THE REQUIRED LOCATIONS. C3100035C C3100036C GET PRINT LOGICAL UNIT NUMBER. IF ILLEGAL, PRINT C3100037ÐÐC 'ILLEGAN SYSTEM PERIPHERAL NAME' AND RETURN. C3100038C IF THE OPTION IS PR00, THEN PRINT ALL PRXX FILES THAT C3100039C EXIST. IF NO PRXX FILES EXIST, THE MESSAGE 'NO JOBS TO C3100040C PRINT' IS OUTPUT AND CONTROL IS RETURNED TO THE REQUESTOR. C3100041C IF THE OPTION IS A SPECIFIC PRXX FILE (I.E., PR01), C3100042C THEN THAT FILE IS PRINTED. IF THE OPTION SPECIFIES A C3100043C SPECIFIC JOB FILE JYXX (I.E. J102), THEN THAT SPECIFIC C3100044C JOB FILE IS PRINTED. IF THE OPTION SPECIFIES A HOST C3100045C NAME, THEN ALL JOB FILES READY TO PRINT FOR THAT HOST ARE C3100046C PRINTED. AS EACH JOB FILE IS PRINTED, ITS STATUS IN THE C3100047C $$HOST FILE IS SET TO INACTIVE. C3100048C C3100049C TWO SUBROUTINES INTERNAL TO THE PRINT MODULE ARE USED C3100050C TO PRINT THE PRXX AND JOB FILES. THE SUBROUTINE, PRINZ, C3100051C EXTERNAL TO PRINT IS USED BY BOTH SUBROUTINES TO PRINT A C3100052C LINE. EACH SUBROUTINE HAS LOGIC TO UPDATE THE STATUS OF THE C3100053C FILE THAT IT PRINTED. C3100054C C3100055C C3100056C ERROR MESSAGES C3100057C C3100058C 69 ILLEGAL SYSTEM PERIPHERAL NAME C3100059C 921 NO JOBS TO PRINT C3100060C 922 NO SUCH HOST, @ @ @ @ @ @ C3100061C 923 NO MORE JOBS TO PRINT FOR HOST @ @ @ @ @ @ C3100062ÐÐC C3100063C C3100064C C3100065M FMUCOM C3100066. C3100067C C3100068 INTEGER OWNR12,OWNR34,OWNR56,OWNR78,RECLEN,TDATRM,TDATRL C3100069 INTEGER DATBAM,DATBAL,FCBIND,TNKEYM,TNKEYL,POSKY1,POSKY2 C3100070 INTEGER POSKY3,POSKY4,TSFILM,TSFILL,EXPDAT,CRTDAT,FILTYP C3100071 INTEGER NOCUR,ZRO,ERBUF,PARNUM,PARID,PPTEMP(17),PPTAB(6) C3100072 INTEGER BUFLEN,TC,OUTP,BLANK,QUEST,STAT,OPN,WVL,FTYPE C3100073 INTEGER OPN,WVL C3100074 INTEGER RECBUF C3100075 INTEGER CPDAT(24),CPREQ(24),CPVOL,CPHDR(5),CPFCB(96),CPWIND C3100076 INTEGER CPRECL,CPFIND,CPLEN1,CPPOS1 C3100077 INTEGER STAT1(18),STAT2(18),STAT3(18),STAT4(18) C3100078C C3100079 DIMENSION IPNAM(17) C3100080 DIMENSION IREQ(17) C3100081 DIMENSION IFND(17) C3100082 DIMENSION NAME(18) C3100083 DIMENSION NAME12(4) C3100084 DIMENSION OWNR12(4) C3100085 DIMENSION KEYVAL(15) C3100086 DIMENSION RECBUF(322) C3100087ÐÐC C3100088 EQUIVALENCE (PPPRIN,PPTAB) C3100089 EQUIVALENCE (CPRECL,CPFCB(1)) C3100090 EQUIVALENCE (CPFIND,CPFCB(6)) C3100091 EQUIVALENCE (CPLEN1,CPFCB(15)) C3100092 EQUIVALENCE (CPPOS1,CPFCB(16)) C3100093 BYTE (IDEL,ISTAT(4=4)) C3100094. C3100095C C3100096C FILE CONTROL BLOCK C3100097C C3100098 EQUIVALENCE (RECLEN,FCBBUF(1)) C3100099 EQUIVALENCE (TDATRM,FCBBUF(2)) C3100100 EQUIVALENCE (TDATRL,FCBBUF(3)) C3100101C C3100102C EXTERNALS C3100103C C3100104 EXTERNAL MMLUTB C3100105 EXTERNAL WKSPLU C3100106 EXTERNAL WTREAD C3100107 EXTERNAL GETFLD C3100108 EXTERNAL SYSMSG C3100109 EXTERNAL MOVEL C3100110 EXTERNAL OPENFL C3100111 EXTERNAL GETFCB C3100112ÐÐC C3100113C C3100114 BYTE (IFND,PPTEMP(15=15)) C3100115 BYTE (IREQ,PPTEMP(12=12)) C3100116 BYTE (IPNAM,PPTEMP(7=0)) C3100117C C3100118 BYTE (OPN,ISTAT(0=0)) C3100119 BYTE (NFD,ISTAT(1=1)) C3100120 BYTE (LOK,ISTAT(2=2)) C3100121 BYTE (IRLOK,ISTAT(3=3)) C3100122 BYTE (INUNK,ISTAT(4=4)) C3100123 BYTE (MME,ISTAT(5=5)) C3100124 BYTE (MFOS,ISTAT(11=11)) C3100125 BYTE (MFO,ISTAT(12=12)) C3100126 BYTE (IOUT,ISTAT(12=12)) C3100127 BYTE (WVL,ISTAT(13=13)) C3100128 BYTE (ILR,ISTAT(14=14)) C3100129 BYTE(STAT1,RECBUF(15=12)) C3100130 BYTE(STAT2,RECBUF(11=8)) C3100131 BYTE(STAT3,RECBUF(7=4)) C3100132 BYTE(STAT4,RECBUF(3=0)) C3100133C C3100134 DATA NOCUR/-1/,ZRO/0/ C3100135 DATA BUFLEN/40/ C3100136 DATA BLANK/$2020/ C3100137ÐÐ DATA QUEST/'? '/ C3100138 DATA (NAME(I),I=1,18)/'OPTION = LIST NAME = ',6*$2020/ C3100139C C3100140 DATA KERBAS/ 400/ C3100141. C3100142C C3100143C C3100144 EXTERNAL LUNEQ C3100145 EXTERNAL PRINZ C3100146C C3100147C OPEN PARAMETERS FOR $$PRINT FILE C3100148 INTEGER IPRINT(15) C3100149 DATA (IPRINT(I),I=1,5)/'$$PRINT $$'/ C3100150 DATA (IPRINT(I),I=6,12)/7*$2020/ C3100151 DATA IPRINT(13)/0/ C3100152 DATA IPRINT(14)/1/ C3100153 DATA IPRINT(15)/0/ C3100154C C3100155C OPEN PARAMETRERS FOR $$HOST FILE C3100156 INTEGER IHOST(15) C3100157 DATA (IHOST(I),I=1,5)/'$$HOST $$'/ C3100158 DATA (IHOST(I),I=6,12)/7*$2020/ C3100159 DATA IHOST(13)/0/ C3100160 DATA IHOST(14)/8/ C3100161 DATA IHOST(15)/0/ C3100162ÐÐC C3100163C OPEN PARAMETERS FOR JYXX FILE C3100164 INTEGER IJYXX(15) C3100165 DATA (IJYXX(I),I=1,4)/4*$2020/ C3100166 DATA (IJYXX(I),I=5,5)/'$$'/ C3100167 DATA (IJYXX(I),I=6,12)/7*$2020/ C3100168 DATA IJYXX(13)/0/ C3100169 DATA IJYXX(14)/10/ C3100170 DATA IJYXX(15)/0/ C3100171C C3100172C OPEN PARAMETER FOR PRXX FILE C3100173 INTEGER IPRXX(15) C3100174 DATA (IPRXX(I),I=1,4)/4*$2020/ C3100175 DATA (IPRXX(I),I=5,5)/'$$'/ C3100176 DATA (IPRXX(I),I=6,12)/7*$2020/ C3100177 DATA IPRXX(13)/0/ C3100178 DATA IPRXX(14)/10/ C3100179 DATA IPRXX(15)/0/ C3100180C C3100181 INTEGER BYTFLD(4) C3100182 DATA (BYTFLD(I),I=1,4)/$F000,$0F00,$00F0,$000F/ C3100183 INTEGER BYTMSK(4) C3100184 DATA (BYTMSK(I),I=1,4)/$0FFF,$F0FF,$FF0F,$FFF0/ C3100185 INTEGER BYTVAL(4) C3100186 DATA (BYTVAL(I),I=1,4)/$5000,$0500,$0050,$0005/ C3100187ÐÐ INTEGER FILNAM(4) C3100188C HOST RECORD SIZE C3100189 INTEGER HOSTRZ C3100190 DATA HOSTRZ/18/ C3100191 INTEGER IBYTE C3100192 INTEGER IHOSTB(144) C3100193 INTEGER INOERR C3100194 DATA INOERR/0/ C3100195 INTEGER IPRII C3100196 INTEGER IQ,IR C3100197 INTEGER JN C3100198 BYTE (JNMSB,JN(15=8)) C3100199 BYTE (JNLSB,JN(7=0)) C3100200 INTEGER JPRTED C3100201 INTEGER JYXX(2) C3100202 EQUIVALENCE (JYXX,IJYXX) C3100203C BUFFER FOR LINES TO PRINT(10 LINES,73 WDS/LINE) C3100204 INTEGER LINBUF(730) C3100205 INTEGER LOGUNT C3100206 INTEGER MAXREC C3100207 INTEGER RECSPC(2) C3100208 DATA (RECSPC(I),I=1,2)/2*0/ C3100209 INTEGER XX C3100210C C3100211C C3100212ÐÐC INITIALIZATION C3100213C C3100214 11 INDEX=0 C3100215+ ERROR MSG NO. C3100216 ERBUF=0 C3100217+ ERROR MSG BUF C3100218 ISTAT=0 C3100219+ STATUS OF FM-REQUEST C3100220 LNGO=0 C3100221+ LENGTH OF FIELD TO MOVE C3100222 MORPAR=0 C3100223+ INDICATOR IF MORE PARAMETERS NEEDED C3100224 MORLIN=0 C3100225+ INDICATOR IF MORE LINES NEED TO BE READ C3100226 PARNUM=0 C3100227+ COUNT OF REQ.AND NOT FOUND PARAMETERS C3100228 PARID=0 C3100229 IFLAG=0 C3100230 IP=1 C3100231C C3100232C C3100233C THE FOLLOWING CODE PICKS UP OUT OF SYSDAT A TABLE THAT CONTAINS C3100234C THE VOLUME NAME TO CREATE A SCRATCH FILE. C3100235C C3100236C C3100237ÐÐC LDQ+ WKSPLU C3100238C LDQ+ MMLUTB,Q C3100239C INQ 1 C3100240C LDA- (ZERO),Q C3100241C STA+ IJYXX(9) C3100242C STA+ IPRXX(9) C3100243C LDA- 1,Q C3100244C STA+ IJYXX(10) C3100245C STA+ IPRXX(10) C3100246C LDA- 2,Q C3100247C STA+ IJYXX(11) C3100248C STA+ IPRXX(11) C3100249C LDA- 3,Q C3100250C STA+ IJYXX(12) C3100251C STA+ IPRXX(12) C3100252C C3100253C C3100254 ASSEM $E400,+WKSPLU,$E600,+MMLUTB,$D01 C3100255 ASSEM $C622,$6400,+IJYXX(9),$6400,+IPRXX(9) C3100256 ASSEM $C201,$6400,+IJYXX(10),$6400,+IPRXX(10) C3100257 ASSEM $C202,$6400,+IJYXX(11),$6400,+IPRXX(11) C3100258 ASSEM $C203,$6400,+IJYXX(12),$6400,+IPRXX(12) C3100259C C3100260 ASSIGN 9998 TO INTLOC C3100261 CALL PGMINT(INTLOC,IFLAG) C3100262ÐÐC C3100263C COPY THE PARAMETER PROCESSING TABLE C3100264C C3100265 I=0 C3100266 10 I=I+1 C3100267 PPTEMP(I)=PPTAB(I) C3100268 IF(PPTEMP(I))10,20,10 C3100269C C3100270C C3100271C C3100272 20 DO 30 I=1,24 C3100273 REQBUF(I)=0 C3100274 IDATA(I)=PARDEF(I) C3100275 30 CONTINUE C3100276C C3100277 35 IF(PIND)110,70,40 C3100278C C3100279C PROMPTING LEVEL = 1 FULL PARAMETERS WILL BE DISPLAYED C3100280C C3100281 40 KI=IP C3100282 I=(IP-1)*6+1 C3100283 IF(IPNAM(IP))50,100,50 C3100284C C3100285 50 J=I+5 C3100286 K=1 C3100287ÐÐ CODE(K)=$0A0D C3100288+ SET CR/LF C3100289 DO 60 I=I,J C3100290 K=K+1 C3100291 CODE(K)=NAME(I) C3100292 60 CONTINUE C3100293C C3100294 I=KI C3100295 LNGO=7 C3100296 GO TO 90 C3100297. C3100298C C3100299C PROMPTING LEVEL = 0 PARAMETER ABBREVIATIONS WILL BE DISPLAYED C3100300C C3100301 70 I=IP C3100302 K=IPNAM(IP) C3100303+ INDEX TO PARAM.MNEM.TABLE C3100304 IF(K)80,100,80 C3100305 80 K=(K-1)*3+1 C3100306C C3100307 CODE(1)=$0A0D C3100308 CODE(2)=PARNAM(K) C3100309 CODE(3)=$3D20 C3100310 LNGO=3 C3100311C C3100312ÐÐC DISPLAY NEXT PARAMETER-IDENT C3100313C C3100314 90 CALL WTREAD (LUNIT,NOCUR,CODE,LNGO,NOCUR,DUMMY,ZRO,TC) C3100315C C3100316 PARID=IP C3100317+ INDEX IN PARNAM-TABLE C3100318 IFND(I)=1 C3100319+ SET FOUND FLAG C3100320 IP=IP+1 C3100321+ INCR. INDEX TO PPTEMP C3100322 MORPAR=1 C3100323+ SET INDICATOR FOR MORE PARAMETERS NEEDED C3100324 GO TO 120 C3100325C C3100326C END OF PARAMETER LIST, ISSUE FM-REQUEST C3100327C C3100328 100 MORPAR=0 C3100329 GO TO 320 C3100330C C3100331C PROMPTING LEVEL = -1, NO PROMPTING DONE C3100332C C3100333 110 IF(MORLIN)115,130,130 C3100334+ DO WE NEED TO READ MORE LINES C3100335 115 MORLIN=0 C3100336C C3100337ÐÐC READ NEXT LINE C3100338C C3100339 120 CALL WTREAD (LUNIT,NOCUR,DUMMY,ZRO,NOCUR,INBUF,BUFLEN,TC) C3100340C C3100341C RESET SWORD AND SBYTE C3100342C C3100343 SBYTE=0 C3100344 SWORD=0 C3100345. C3100346 130 CALL GETFLD (INBUF,CODE,SWORD,SBYTE,STAT) C3100347C C3100348C C3100349 140 IF (STAT-2)150,160,200 C3100350 150 IF (STAT-1)260,250,250 C3100351C C3100352C EOL DETECTED,COUNT NO OF REQUIRED AND NOT FOUND PARAMETERS (STATUS=1)C3100353C C3100354 160 IF(PIND)161,162,162 C3100355 161 MORPAR=0 C3100356C C3100357C CHECK IF FULL NAME DESIRED C3100358C C3100359 162 IF (CODE(1)-QUEST)164,163,164 C3100360C C3100361C YES,FULL NAME FOR THIS PARAMETER ONLY C3100362ÐÐC C3100363 163 IF (PIND .NE. -1) IP=IP-1 C3100364 GO TO 40 C3100365C C3100366C CHECK IF PARAMETER ENTERED C3100367C C3100368 164 IF(CODE(1)-BLANK)270,165,270 C3100369 165 IFND(IP-1)=0 C3100370 IF (PIND .EQ. -1) GO TO 320 C3100371 GO TO 35 C3100372C C3100373C PARAMETER-ID FOUND (STATUS=3) C3100374C C3100375 200 I=1 C3100376 210 K=IPNAM(I) C3100377 K=(K-1)*3+1 C3100378C C3100379 IF (CODE(1)-PARNAM(K))230,220,230 C3100380C C3100381C PARAMETER-ID CORRESPONDS WITH PARAM.MNEMONIC TABLE C3100382C C3100383 220 PARID=I C3100384 IFND(I)=1 C3100385 GO TO 130 C3100386C C3100387ÐÐ 230 I=I+1 C3100388+ NO MATCH,CONTINUE C3100389 IF(IPNAM(I))210,240,210 C3100390C C3100391 240 INDEX=39 C3100392+ PARAMETER ILLEGAL C3100393 GO TO 9999 C3100394C C3100395C FIELD TERMINATED ON A SEMI-COLON (STATUS=1) C3100396C C3100397 250 MORLIN=-1 C3100398+ SET INDICATOR TO READ MORE LINES C3100399C C3100400C FIELD TERMINATED ON A COMMA (STATUS=0) C3100401C C3100402 260 MORPAR=1 C3100403+ SET INDICATOR FOR MORE PARAMETERS C3100404 IF(CODE(1) .NE. BLANK)GO TO 270 C3100405 IFND(IP)=0 C3100406 IP=IP+1 C3100407 GO TO 35 C3100408C C3100409C STORE PARAMETER VALUES INTO REQUIRED LOCATIONS C3100410C C3100411 270 IF (PARID)290,290,280 C3100412ÐÐ+ PARAMETER-ID FOUND C3100413 280 I=PARID C3100414+ YES C3100415 GO TO 300 C3100416C C3100417 290 I=IP C3100418 IF (CODE(1) .NE. BLANK) IFND(I)=1 C3100419 IP=IP+1 C3100420C C3100421 300 I=(IPNAM(I)-1)*3+1 C3100422C C3100423 LNGO=PARNAM(I+1) C3100424 OUTP=PARNAM(I+2) C3100425C C3100426C STORE INTO DESIGNATED OUTPUT FIELD C3100427C C3100428 CALL MOVEL (CODE,OUTP,LNGO) C3100429C C3100430 PARID=0 C3100431 IF(MORPAR)310,320,310 C3100432+ ARE THERE MORE PARAM TO BE PROCESSED C3100433 310 IF(PIND) 110,70,40 C3100434+ YES C3100435C C3100436C C3100437ÐÐC ARE ALL REQUIRED PARAMETERS FOUND ? C3100438C C3100439 320 I=0 C3100440 330 I=I+1 C3100441 IF(PPTEMP(I))330,360,340 C3100442C C3100443C PARAMETER NOT FOUND,IS IT REQUIRED ? C3100444C C3100445 340 IF(IREQ(I))330,350,330 C3100446C C3100447C YES IT IS REQUIRED C3100448C C3100449 350 PARNUM=PARNUM+1 C3100450 GO TO 330 C3100451C C3100452C END OF PPTAB C3100453C C3100454 360 IF(PARNUM) 240,400,240 C3100455+ ARE ALL REQUIRED PARAMETERS FOUND C3100456C C3100457C ALL REQUIRED PARAMETERS HAVE BEEN FOUND C3100458C C3100459 400 IF(MORPAR .NE. 0) GO TO 310 C3100460C C3100461C BEGIN PRINT LOGIC C3100462ÐÐC C3100463C OPTION PASSED IN IDATA(20,21,22) IN ASCII C3100464C C3100465C P = LOGICAL UNIT PASSED IN DUMMY(1,2,3,4) IN ASCII C3100466C .BEGIN C3100467C -GET PRINT LOGICAL UNIT C3100468 CALL LUNEQ(DUMMY,LOGUNT) C3100469 IF (LOGUNT .LE. 0) GO TO 8000 C3100470C .IF OPTION = 'PRXX' C3100471 IF (IDATA(20) .NE. $5052) GO TO 1220 C3100472C -PROCESS PRXX FILES C3100473C .THEN C3100474C .IF OPTION = PR00 C3100475 IF (IDATA(21) .NE. $3030) GO TO 1151 C3100476C .THEN C3100477C -PRINT ALL PRXX FILES C3100478C -CLEAR REQUEST BUFFER C3100479 DO 1001 I=1,24 C3100480 1001 REQBUF(I) = 0 C3100481C -SETUP FOR FCB WITHIN USERS AREA C3100482C (LDA =XFCBHDR/STA+ RECBUF+9) C3100483 ASSEM $C000,+FCBHDR,$6400,+REQBUF(10) C3100484C -SAVE FILE NAME FOR ERROR MSG. C3100485 DO 1051 I=1,4 C3100486 1051 FILNAM(I) = IPRINT(I) C3100487ÐÐC -OPEN $$PRINT FILE(W/0 LOCK) C3100488 CALL OPENFL (REQBUF,IPRINT,ISTAT) C3100489 IF (ISTAT .LT. 0) GO TO 8100 C3100490C -GET NO. OF RECORDS IN FILE FROM FCB C3100491 MAXREC = FCBBUF(3) C3100492C -CLOSE $$PRINT FILE C3100493 CALL CLOSFL (REQBUF,ISTAT) C3100494 IF (ISTAT .LT. 0) GO TO 8100 C3100495C -SET FOR NO ERROR MSG. ON OPEN(SEE PDUPR SUBROUTINE) C3100496 INOERR = 1 C3100497C -INITIALIZE JOB PRINTED FLAG C3100498 JPRTED = 0 C3100499 II = 0 C3100500C .WHILE PRXX FILES TO PRINT C3100501 1101 IF (II .EQ. MAXREC) GO TO 1131 C3100502C .BEGIN C3100503 IPRXX(1) = $5052 C3100504 II = II + 1 C3100505C -CONVERT II TO ASCII C3100506 IQ = II/10 C3100507 IR = II - IQ*10 C3100508 IPRXX(2) = (IQ+$30)*$100+IR+$30 C3100509C -PRINT PRII FILE C3100510 ASSIGN 1101 TO IRETRN C3100511 GO TO 5001 C3100512ÐÐC .END WHILE C3100513C -IF NO JOBS PRINTED TELL USER C31005141131 IF (JPRTED .EQ. 0) GO TO 8010 C3100515 GO TO 9000 C3100516C .ELSE C3100517C -PRINT ONLY PRXX FILE SPECIFIED C3100518 1151 IPRXX(1) = IDATA(20) C3100519 IPRXX(2) = IDATA(21) C3100520 ASSIGN 1201 TO IRETRN C3100521 GO TO 5001 C3100522C -RETURN C3100523 1201 GO TO 9000 C3100524C .ELSE C3100525C .IF OPTION = JYXX (Y = 0-7) C3100526 1220 JN = IDATA(20) C3100527 IF (JNMSB .NE. $4A) GO TO 1301 C3100528 IF (JNLSB .LT. $30 .OR. JNLSB .GT. $37) GO TO 1301 C3100529C .THEN C3100530C -PRINT JYXX FILE C3100531 JYXX(1) = IDATA(20) C3100532 JYXX(2) = IDATA(21) C3100533 ASSIGN 1251 TO IRETRN C3100534 GO TO 4001 C3100535C -RETURN C3100536 1251 GO TO 9000 C3100537ÐÐC .ELSE C3100538C -ASSUME OPTION = HOST NAME C3100539C -CLEAR REQUEST BUFFER C3100540 1301 DO 1321 I=1,24 C3100541 1321 REQBUF(I) = 0 C3100542C -SETUP FOR FCB WITHIN USERS AREA C3100543 ASSEM $C000,+FCBHDR,$6400,+REQBUF(10) C3100544C -SAVE FILE NAME FOR ERROR MSG. C3100545 DO 1351 I=1,4 C3100546 1351 FILNAM(I) = IHOST(I) C3100547C -ADJUST IHOST ARRAY FOR 8 RECORD READ W/O LOCK C3100548 IHOST(14) = 8 C3100549 IHOST(15) = 0 C3100550C -OPEN $$HOST FILE C3100551 CALL OPENFL (REQBUF,IHOST,ISTAT) C3100552 IF (ISTAT .LT. 0) GO TO 8100 C3100553C -GET ALL RECORD OF $$HOST FILE C3100554 CALL GETS (REQBUF,IHOSTB,0,ISTAT) C3100555 IF (ISTAT .LT. 0) GO TO 8100 C3100556C -CLOSE $$HOST FILE C3100557 CALL CLOSFL (REQBUF,ISTAT) C3100558 IF (ISTAT .LT. 0) GO TO 8100 C3100559C -SEARCH FOR HOST SPECIFIED C3100560 DO 1401 I=1,8 C3100561 J = 1 + (I-1)*HOSTRZ C3100562ÐÐ IF (IHOSTB(J ) .EQ. IDATA(20) .AND. C3100563 . IHOSTB(J+1) .EQ. IDATA(21)) GO TO 1431 C3100564 1401 CONTINUE C3100565C -PRINT 'NO SUCH HOST' MSG. C3100566 GO TO 8050 C3100567C -SEARCH STATUS WORDS FOR NEXT JOB TO PRINT. C31005681431 DO 1451 K=1,15 C3100569C -(M=INDEX TO STATUS WORDS) C3100570 M = J + K + 2 C3100571C -SEARCH STATUS WORD WITH BYTE = 5 (OUTPUT READY TO PRINT) C3100572 DO 1451 L=1,4 C3100573 IF (AND(IHOSTB(M),BYTFLD(L)).EQ. BYTVAL(L)) GO TO 1501 C3100574 1451 CONTINUE C3100575C ALL DONE - EXIT C3100576 GO TO 9000 C3100577C -CALC. JYXX FILE NAME IN ASCII C3100578C - Y = I-1 C3100579C - XX = 1 + (K-1)*4 + (L-1) C3100580C -GENERATE JY C3100581 1501 JYXX(1) = $4A00 + $30 + I - 1 C3100582C -GENERATE XX C3100583 I = 1 + (K-1)*4 + (L-1) C3100584 IQ = I/10 C3100585 IR = I - IQ*10 C3100586 JYXX(2) = ($30+IQ)*$100 + $30 + IR C3100587ÐÐC -PRINT JYXX FILE C3100588 ASSIGN 1551 TO IRETRN C3100589 GO TO 4001 C3100590C -RETURN,GO CHECK FOR MORE JOBS C31005911551 GO TO 1301 C3100592C C3100593C PRINT,DELETE,UPDATE JYXX FILE AND STATUS C3100594C C3100595C -CLEAR REQUEST BUFFER C3100596 4001 DO 4101 I=1,24 C3100597 4101 REQBUF(I) = 0 C3100598C -SETUP FOR FCB WITHIN USER AREA C3100599 ASSEM $C000,+FCBHDR,$6400,+REQBUF(10) C3100600C -SAVE FILE NAME FOR ERROR MSG. C3100601 DO 4151 I=1,4 C3100602 4151 FILNAM(I) = IJYXX(I) C3100603C -OPEN JYXX FILE C3100604 CALL OPENFL (REQBUF,IJYXX,ISTAT) C3100605 IF (ISTAT .LT. 0) GO TO 9001 C3100606C -GET N RECORDS FROM JYXX FILE C3100607 4171 CALL GETS (REQBUF,LINBUF,0,ISTAT) C3100608 IF (ISTAT .GE. 0) GO TO 4201 C3100609C .IF EOF,GO CLOSE FILE,ETC. C3100610 IF (AND(ISTAT,$0100) .NE. 0) GO TO 4271 C3100611C .ELSE C3100612ÐÐC -REPORT FM ERROR,THEN CLOSE FILE,ETC. C3100613 CALL ERCHK (ISTAT,REQBUF(4)) C3100614 GO TO 4271 C3100615C -PRINT RETRIEVED RECORDS C3100616C - N = NO. OF RECORDS RETRIEVED C3100617 4201 N = REQBUF(15) C3100618 DO 4251 I=1,N C3100619C -(ASSUME 73 WORD RECORDS) C3100620C -CALC. INDEX TO LINE TEXT C3100621 J = 1 + (I-1)*73 C3100622C -PRINT THE LINE C3100623 CALL PRINZ (J,LINBUF,LOGUNT) C3100624 4251 CONTINUE C3100625C .IF NO EOF,GO TO GET MORE RECORDS C3100626 IF (AND(ISTAT,$0100) .EQ. 0) GO TO 4171 C3100627C -ALL RECORDS PRINTED(OR ERROR) C3100628C -CLOSE JYXX FILE C3100629 4271 CALL CLOSFL (REQBUF,ISTAT) C3100630 IF (ISTAT .LT. 0) GO TO 9001 C3100631C -DELETE JYXX FILE C3100632 CALL DELETE (REQBUF,IJYXX,ISTAT) C3100633 IF (ISTAT .LT. 0) GO TO 9001 C3100634C -CLEAR REQUEST BUFFER C3100635 DO 4301 I=1,24 C3100636 4301 REQBUF(I) = 0 C3100637ÐÐC -AJUST IHOST ARRAY FOR 1 RECORD AND LOCK C3100638 IHOST(14) = 1 C3100639 IHOST(15) = 1 C3100640C -SAVE FILE NAME FOR ERROR C3100641 DO 4351 I=1,4 C3100642 4351 FILNAM(I) = IHOST(I) C3100643C -OPEN $$HOST FILE W/REC. LOCK C3100644 CALL OPENFL (REQBUF,IHOST,ISTAT) C3100645 IF (ISTAT .LT. 0) GO TO 8100 C3100646C -CALC. REL. RECORD NO.(= Y+1 OF JYXX) C3100647 RECSPC(2) = AND(IJYXX(1),$00FF) - $30 + 1 C3100648C -READ RECORD Y FROM $$HOST FILE C3100649 CALL READR (REQBUF,RECBUF,RECSPC,ISTAT) C3100650 IF (ISTAT .LT. 0) GO TO 8100 C3100651C -SET STATUS FOR JYXX = 0(INACTIVE) C3100652C -CALC. REQUIRED INDEX FROM XX OF JYXX C3100653 I = IJYXX(2) - $3030 C3100654 IQ = I/$100 C3100655 IR = I - IQ*$100 C3100656 XX = IQ*10 + IR C3100657 I = (XX-1)/4 C3100658 IBYTE = XX - (I*4) C3100659 I = I + 4 C3100660 RECBUF(I) = AND(RECBUF(I),BYTMSK(IBYTE)) C3100661C -UPDATE RECORD Y OF $$HOST FILE C3100662ÐÐ CALL UPDREC (REQBUF,RECBUF,ISTAT) C3100663 IF (ISTAT .LT. 0) GO TO 8100 C3100664C -CLOSE $$HOST FILE C3100665 CALL CLOSFL (REQBUF,ISTAT) C3100666 IF (ISTAT .LT. 0) GO TO 8100 C3100667C -RETURN TO CALLER C3100668 GO TO IRETRN C3100669C C3100670C PRINT,DELETE,UPDATE PRXX FILE AND STATUS C3100671C C3100672C -CLEAR REQUEST BUFFER C3100673 5001 DO 5101 I=1,24 C3100674 5101 REQBUF(I) = 0 C3100675C -SETUP FOR FCB WITHIN USER AREA C3100676 ASSEM $C000,+FCBHDR,$6400,+REQBUF(10) C3100677C -SAVE FILE NAME FOR ERROR MSG. C3100678 DO 5151 I=1,4 C3100679 5151 FILNAM(I) = IPRXX(I) C3100680C -OPEN PRXX FILE C3100681 CALL OPENFL (REQBUF,IPRXX,ISTAT) C3100682 IF (ISTAT .GE. 0) GO TO 5171 C3100683C .IF NO ERROR MSG. ON ERROR,GO RETURN C3100684 IF (INOERR .NE.0) GO TO IRETRN C3100685 GO TO 9001 C3100686C -GET N RECORDS FROM PRXX FILE C3100687ÐÐ 5171 CALL GETS (REQBUF,LINBUF,0,ISTAT) C3100688 IF (ISTAT .GE. 0) GO TO 5201 C3100689C .IF EOF,GO CLOSE FILE,ETC. C3100690 IF (AND(ISTAT,$0100) .NE. 0) GO TO 5271 C3100691C .ELSE C3100692C -REPORT FM ERROR,THEN CLOSE FILE,ETC. C3100693 CALL ERCHK (ISTAT,REQBUF(4)) C3100694 GO TO 5271 C3100695C -PRINT RETRIEVED RECORDS C3100696C - N = NO. OF RECORDS RETRIEVED C3100697 5201 N = REQBUF(15) C3100698 DO 5251 I=1,N C3100699C -(ASSUME 73 WORD RECORDS) C3100700C -CALC. INDEX TO LINE TEXT C3100701 J = 1 + (I-1)*73 C3100702C -PRINT THE LINE C3100703 CALL PRINZ (J,LINBUF,LOGUNT) C3100704 5251 CONTINUE C3100705C -SET JPRTED FOR JOB PRINTED C3100706 JPRTED = 1 C3100707C .IF NO EOF,GO TO GET MORE RECORDS C3100708 IF (AND(ISTAT,$0100) .EQ. 0) GO TO 5171 C3100709C -ALL RECORDS PRINTED(OR ERROR) C3100710C -CLOSE PRXX FILE C3100711 5271 CALL CLOSFL (REQBUF,ISTAT) C3100712ÐÐ IF (ISTAT .LT. 0) GO TO 9001 C3100713C -DELETE PRXX FILE C3100714 CALL DELETE (REQBUF,IPRXX,ISTAT) C3100715 IF (ISTAT .LT. 0) GO TO 8100 C3100716C -CLEAR REQUEST BUFFER C3100717 DO 5301 I=1,24 C3100718 5301 REQBUF(I) = 0 C3100719C -CHANGE IPRINT ARRAY FOR LOCK C3100720 IPRINT(15) = 1 C3100721C -SAVE FILE NAME FOR ERROR C3100722 DO 5351 I=1,4 C3100723 5351 FILNAM(I) = IHOST(I) C3100724C -OPEN $$PRINT FILE W/REC. LOCK C3100725 CALL OPENFL (REQBUF,IPRINT,ISTAT) C3100726 IF (ISTAT .LT. 0) GO TO 8100 C3100727C -CALC. REL. RECORD NO. (=XX OF PRXX) C3100728 I = IPRXX(2) - $3030 C3100729 IQ = I/$100 C3100730 IR = I - IQ*$100 C3100731 RECSPC(2) = IQ*10 + IR C3100732C -READ RECORD FROM $$PRINT FILE C3100733 CALL READR (REQBUF,RECBUF,RECSPC,ISTAT) C3100734 IF (ISTAT .LT. 0) GO TO 8100 C3100735C -SET NO. OF RECORDS TO BLANKS(NOTHING TO PRINT) C3100736 RECBUF(16) = $2020 C3100737ÐÐ RECBUF(17) = $2020 C3100738C -UPDATE RECORD OF $$PRINT FILE C3100739 CALL UPDREC (REQBUF,RECBUF,ISTAT) C3100740 IF (ISTAT .LT. 0) GO TO 8100 C3100741C -CLOSE $$PRINT FILE C3100742 CALL CLOSFL (REQBUF,ISTAT) C3100743 IF (ISTAT .LT. 0) GO TO 8100 C3100744C -RETURN TO CALLER C3100745 GO TO IRETRN C3100746C C3100747C -LOCAL FM ERROR HANDLING,DOES NOT EXIT UTILITY C3100748C C3100749 9001 CALL ERCHK (ISTAT,REQBUF(4)) C3100750C -RETURN TO CALLER C3100751 GO TO IRETRN C3100752C C3100753C C3100754C C3100755C MESSAGES C3100756C C3100757C ILLEGAL SYSTEM PERIPHERAL NAME C3100758 8000 INDEX = 63 C3100759 GO TO 8045 C3100760C NO JOBS TO PRINT C3100761 8010 CONTINUE C3100762ÐÐ INDEX = KERBAS + 21 C3100763 GO TO 8045 C3100764C NO SUCH HOST,@@@@@@ C3100765 8050 CONTINUE C3100766 INDEX = KERBAS + 22 C3100767 GO TO 8090 C3100768C NO MORE JOBS TO PRINT FOR HOST,@@@@@@ C3100769 8060 CONTINUE C3100770 INDEX = KERBAS + 23 C3100771C SYSTEM MESSAGE WITH FILE NAME TEXT C3100772 8090 CALL SYSMSG (INDEX,FILNAM) C3100773 GO TO 9000 C3100774C SYSTEM MESSAGE WITHOUT TEXT C3100775 8045 CALL SYSMSG (INDEX,0) C3100776 GO TO 9000 C3100777C C3100778C FM ERROR LOGIC C3100779C C3100780 8100 CALL ERCHK (ISTAT,REQBUF+4) C3100781 GO TO 9000 C3100782C EXIT LOGIC C3100783 9000 RETURN C3100784C C3100785C ERROR LOGIC FOR INITIALIZATION LOGIC C3100786C C3100787ÐÐ 9999 CALL SYSMSG (INDEX,ERBUF) C3100788 9998 CALL CLOSFL (REQBUF,ISTAT) C3100789 9997 RETURN C3100790 END C3100791 SUBROUTINE SET C3200001 1 /C32 F ITOS CCS 3.0 SL-149C3200002C PROCESSOR FOR ASSIGNING LU. NUM. TO ENTRIES IN THE HOST FILE C3200003C CREDIT COLLECTION SYSTEM VERSION 3.0 C3200004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C3200005C COPYRIGHT CONTROL DATA CORPORATION 1979 C3200006C C3200007C** C3200008C COMMAND PROCESSOR FOR SET C3200009C CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.0 C3200010C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C3200011C COPYRIGHT CONTROL DATA CORPORATION 1977 C3200012C C3200013C C3200014C FUNCTION C3200015C C3200016C THIS PROCESSOR SETS THE LOGICAL UNIT NUMBER IN THE HOST FILE. C3200017C A LOGICAL UNIT OF ZERO SETS THE ABORT BIT IN THE HOST C3200018C FILE AND CAUSES THE INPUT BATCH DRIVER TO TERMINATE C3200019C PROCESSING FOR THIS HOST. C3200020C C3200021ÐÐC C3200022C C3200023C GENERAL DESCRIPTION C3200024C C3200025C THIS PROCESSOR ACCEPTS INPUT FROM EITHER AN INTERACTIVE C3200026C DEVICE OR THE DEVICE IT WAS INITIATED ON. THE PROCESSOR C3200027C RUNS UNDER THE FILE MANAGER UTILITY EXECUTIVE PROGRAM. C3200028C THE COMMAND FORMAT IS C3200029C SET,HO=AAAA,LU=NN C3200030C HO=HOST NAME C3200031C LU=LOGICAL UNIT NUMBER C3200032C C3200033C C3200034C FLOW C3200035C C3200036C THE PROCESSOR DETERMINES THE LEVEL OF PROMPTING REQUIRED, C3200037C DISPLAYS THE PARAMETERS AND STORES THE PARAMETER VALUES C3200038C INTO THE REQUIRED LOCATIONS. C3200039C C3200040C THIS PROCESSOR VERIFIES THE LU ENTERED IS VALID AND C3200041C THAT THE HOST NAME IS IN THE HOST FILE. IT INSURES C3200042C THAT THE BATCH DRIVER IS NOT BUSY AND THE LU IS C3200043C NOT SET FOR THIS OR ANY OTHER HOST. IF LU IS EQUAL C3200044C TO ZERO, THIS PROCESSOR SETS THE JA BIT (BIT 10 OF WORD 3) C3200045C TO ZERO TO FLAG THE BATCH DRIVER TO STOP PROCESSING C3200046ÐÐC ON THIS HOST. C3200047C C3200048C C3200049C ERROR MESSAGES C3200050C C3200051C 901 HOST NAME NOT FOUND C3200052C 908 INVALID LU C3200053C 905 BATVH DRIVER BUSY C3200054C 910 LU FOR THIS HOST ALREADY SET C3200055C 911 DUPLICATE LU C3200056C C3200057C C3200058C C3200059M FMUCOM C3200060. C3200061C C3200062 INTEGER OWNR12,OWNR34,OWNR56,OWNR78,RECLEN,TDATRM,TDATRL C3200063 INTEGER DATBAM,DATBAL,FCBIND,TNKEYM,TNKEYL,POSKY1,POSKY2 C3200064 INTEGER POSKY3,POSKY4,TSFILM,TSFILL,EXPDAT,CRTDAT,FILTYP C3200065 INTEGER NOCUR,ZRO,ERBUF,PARNUM,PARID,PPTEMP(17),PPTAB(6) C3200066 INTEGER BUFLEN,TC,OUTP,BLANK,QUEST,STAT,OPN,WVL,FTYPE C3200067 INTEGER OPN,WVL C3200068 INTEGER RECBUF C3200069 INTEGER CPDAT(24),CPREQ(24),CPVOL,CPHDR(5),CPFCB(96),CPWIND C3200070 INTEGER CPRECL,CPFIND,CPLEN1,CPPOS1 C3200071ÐÐC ************************************************************127*5173C3200072 INTEGER NAME(14) C3200073C ************************************************************127*5173C3200074C C3200075 DIMENSION IPNAM(17) C3200076 DIMENSION IREQ(17) C3200077 DIMENSION IFND(17) C3200078 DIMENSION NAME12(4) C3200079 DIMENSION OWNR12(4) C3200080 DIMENSION KEYVAL(15) C3200081 DIMENSION RECBUF(322) C3200082C C3200083 EQUIVALENCE (PPSET,PPTAB) C3200084 EQUIVALENCE (CPRECL,CPFCB(1)) C3200085 EQUIVALENCE (CPFIND,CPFCB(6)) C3200086 EQUIVALENCE (CPLEN1,CPFCB(15)) C3200087 EQUIVALENCE (CPPOS1,CPFCB(16)) C3200088 BYTE (IDEL,ISTAT(4=4)) C3200089. C3200090C C3200091C FILE CONTROL BLOCK C3200092C C3200093 EQUIVALENCE (RECLEN,FCBBUF(1)) C3200094 EQUIVALENCE (TDATRM,FCBBUF(2)) C3200095 EQUIVALENCE (TDATRL,FCBBUF(3)) C3200096ÐÐ EQUIVALENCE (DATBAM,FCBBUF(4)) C3200097 EQUIVALENCE (DATBAL,FCBBUF(5)) C3200098 EQUIVALENCE (FCBIND,FCBBUF(6)) C3200099 EQUIVALENCE (NEDATM,FCBBUF(7)) C3200100 EQUIVALENCE (NEDATL,FCBBUF(8)) C3200101 EQUIVALENCE (NEXTBM,FCBBUF(9)) C3200102 EQUIVALENCE (NEXTBL,FCBBUF(10)) C3200103 EQUIVALENCE (TNKEYM,FCBBUF(11)) C3200104 EQUIVALENCE (TNKEYL,FCBBUF(12)) C3200105 EQUIVALENCE (KEYBAM,FCBBUF(13)) C3200106 EQUIVALENCE (KEYBAL,FCBBUF(14)) C3200107 EQUIVALENCE (LENKY1,FCBBUF(15)) C3200108 EQUIVALENCE (POSKY1,FCBBUF(16)) C3200109 EQUIVALENCE (LENKY2,FCBBUF(17)) C3200110 EQUIVALENCE (LENKY3,FCBBUF(19)) C3200111 EQUIVALENCE (LENKY4,FCBBUF(21)) C3200112 EQUIVALENCE (TSFILM,FCBBUF(23)) C3200113 EQUIVALENCE (TSFILL,FCBBUF(24)) C3200114 EQUIVALENCE (NAME12,FCBBUF(25)) C3200115 EQUIVALENCE (OWNR12,FCBBUF(29)) C3200116 EQUIVALENCE (EXPDAT,FCBBUF(89)) C3200117 EQUIVALENCE (CRTDAT,FCBBUF(92)) C3200118 EQUIVALENCE (FTYPE,FCBBUF(95)) C3200119C C3200120C EXTERNALS C3200121ÐÐC C3200122 EXTERNAL MMLUTB C3200123 EXTERNAL WTREAD C3200124 EXTERNAL GETFLD C3200125 EXTERNAL SYSMSG C3200126 EXTERNAL MOVEL C3200127 EXTERNAL OPENFL C3200128 EXTERNAL GETFCB C3200129 EXTERNAL LOG1A C3200130C C3200131C C3200132 BYTE (IFND,PPTEMP(15=15)) C3200133 BYTE (IREQ,PPTEMP(12=12)) C3200134 BYTE (IPNAM,PPTEMP(7=0)) C3200135C C3200136 BYTE (OPN,ISTAT(0=0)) C3200137 BYTE (NFD,ISTAT(1=1)) C3200138 BYTE (LOK,ISTAT(2=2)) C3200139 BYTE (IRLOK,ISTAT(3=3)) C3200140 BYTE (INUNK,ISTAT(4=4)) C3200141 BYTE (MME,ISTAT(5=5)) C3200142 BYTE (MFOS,ISTAT(11=11)) C3200143 BYTE (MFO,ISTAT(12=12)) C3200144 BYTE (IOUT,ISTAT(12=12)) C3200145 BYTE (WVL,ISTAT(13=13)) C3200146ÐÐ BYTE (ILR,ISTAT(14=14)) C3200147 BYTE (LUNO,DUMMY(3=0)) C3200148 BYTE (LUNP,DUMMY(11=8)) C3200149C C3200150 DATA NOCUR/-1/,ZRO/0/ C3200151 DATA BUFLEN/40/ C3200152 DATA BLANK/$2020/ C3200153 DATA QUEST/'? '/ C3200154C ************************************************************127*5173C3200155 DATA NAME/ 'HOST NAME =LOGICAL UNIT ='/ C3200156C ************************************************************127*5173C3200157C C3200158 DATA KERBAS/ 400/ C3200159. C3200160C C3200161C INITIALIZATION C3200162C C3200163 11 INDEX=0 C3200164+ ERROR MSG NO. C3200165 ERBUF=0 C3200166+ ERROR MSG BUF C3200167 ISTAT=0 C3200168+ STATUS OF FM-REQUEST C3200169 LNGO=0 C3200170+ LENGTH OF FIELD TO MOVE C3200171ÐÐ MORPAR=0 C3200172+ INDICATOR IF MORE PARAMETERS NEEDED C3200173 MORLIN=0 C3200174+ INDICATOR IF MORE LINES NEED TO BE READ C3200175 PARNUM=0 C3200176+ COUNT OF REQ.AND NOT FOUND PARAMETERS C3200177 PARID=0 C3200178 IFLAG=0 C3200179 IP=1 C3200180C C3200181 ASSIGN 9998 TO INTLOC C3200182 CALL PGMINT(INTLOC,IFLAG) C3200183C C3200184C COPY THE PARAMETER PROCESSING TABLE C3200185C C3200186 I=0 C3200187 10 I=I+1 C3200188 PPTEMP(I)=PPTAB(I) C3200189 IF(PPTEMP(I))10,20,10 C3200190C C3200191C C3200192C C3200193 20 DO 30 I=1,24 C3200194 REQBUF(I)=0 C3200195 IDATA(I)=PARDEF(I) C3200196ÐÐ 30 CONTINUE C3200197C C3200198 35 IF(PIND)110,70,40 C3200199C C3200200C PROMPTING LEVEL = 1 FULL PARAMETERS WILL BE DISPLAYED C3200201C C3200202 40 KI=IP C3200203C ************************************************************127*5173C3200204 I = (IP - 1) * 7 + 1 C3200205C ************************************************************127*5173C3200206 IF(IPNAM(IP))50,100,50 C3200207C C3200208C ************************************************************127*5173C3200209 50 CONTINUE C3200210 J = I + 6 C3200211C ************************************************************127*5173C3200212 K=1 C3200213 CODE(K)=$0A0D C3200214+ SET CR/LF C3200215 DO 60 I=I,J C3200216 K=K+1 C3200217 CODE(K)=NAME(I) C3200218 60 CONTINUE C3200219C C3200220 I=KI C3200221ÐÐC ************************************************************127*5173C3200222 LNGO = 8 C3200223C ************************************************************127*5173C3200224 GO TO 90 C3200225. C3200226C C3200227C PROMPTING LEVEL = 0 PARAMETER ABBREVIATIONS WILL BE DISPLAYED C3200228C C3200229 70 I=IP C3200230 K=IPNAM(IP) C3200231+ INDEX TO PARAM.MNEM.TABLE C3200232 IF(K)80,100,80 C3200233 80 K=(K-1)*3+1 C3200234C C3200235 CODE(1)=$0A0D C3200236 CODE(2)=PARNAM(K) C3200237 CODE(3)=$3D20 C3200238 LNGO=3 C3200239C C3200240C DISPLAY NEXT PARAMETER-IDENT C3200241C C3200242 90 CALL WTREAD (LUNIT,NOCUR,CODE,LNGO,NOCUR,DUMMY,ZRO,TC) C3200243C C3200244 PARID=IP C3200245+ INDEX IN PARNAM-TABLE C3200246ÐÐ IFND(I)=1 C3200247+ SET FOUND FLAG C3200248 IP=IP+1 C3200249+ INCR. INDEX TO PPTEMP C3200250 MORPAR=1 C3200251+ SET INDICATOR FOR MORE PARAMETERS NEEDED C3200252 GO TO 120 C3200253C C3200254C END OF PARAMETER LIST, ISSUE FM-REQUEST C3200255C C3200256 100 MORPAR=0 C3200257 GO TO 320 C3200258C C3200259C PROMPTING LEVEL = -1, NO PROMPTING DONE C3200260C C3200261 110 IF(MORLIN)115,130,130 C3200262+ DO WE NEED TO READ MORE LINES C3200263 115 MORLIN=0 C3200264C C3200265C READ NEXT LINE C3200266C C3200267 120 CALL WTREAD (LUNIT,NOCUR,DUMMY,ZRO,NOCUR,INBUF,BUFLEN,TC) C3200268C C3200269C RESET SWORD AND SBYTE C3200270C C3200271ÐÐ SBYTE=0 C3200272 SWORD=0 C3200273. C3200274 130 CALL GETFLD (INBUF,CODE,SWORD,SBYTE,STAT) C3200275C C3200276C C3200277 140 IF (STAT-2)150,160,200 C3200278 150 IF (STAT-1)260,250,250 C3200279C C3200280C EOL DETECTED,COUNT NO OF REQUIRED AND NOT FOUND PARAMETERS (STATUS=1)C3200281C C3200282 160 IF(PIND)161,162,162 C3200283 161 MORPAR=0 C3200284C C3200285C CHECK IF FULL NAME DESIRED C3200286C C3200287 162 IF (CODE(1)-QUEST)164,163,164 C3200288C C3200289C YES,FULL NAME FOR THIS PARAMETER ONLY C3200290C C3200291 163 IF (PIND .NE. -1) IP=IP-1 C3200292 GO TO 40 C3200293C C3200294C CHECK IF PARAMETER ENTERED C3200295C C3200296ÐÐ 164 IF(CODE(1)-BLANK)270,165,270 C3200297 165 IFND(IP-1)=0 C3200298 IF (PIND .EQ. -1) GO TO 320 C3200299 GO TO 35 C3200300C C3200301C PARAMETER-ID FOUND (STATUS=3) C3200302C C3200303 200 I=1 C3200304 210 K=IPNAM(I) C3200305 K=(K-1)*3+1 C3200306C C3200307 IF (CODE(1)-PARNAM(K))230,220,230 C3200308C C3200309C PARAMETER-ID CORRESPONDS WITH PARAM.MNEMONIC TABLE C3200310C C3200311 220 PARID=I C3200312 IFND(I)=1 C3200313 GO TO 130 C3200314C C3200315 230 I=I+1 C3200316+ NO MATCH,CONTINUE C3200317 IF(IPNAM(I))210,240,210 C3200318C C3200319 240 INDEX=39 C3200320+ PARAMETER ILLEGAL C3200321ÐÐ GO TO 9999 C3200322C C3200323C FIELD TERMINATED ON A SEMI-COLON (STATUS=1) C3200324C C3200325 250 MORLIN=-1 C3200326+ SET INDICATOR TO READ MORE LINES C3200327C C3200328C FIELD TERMINATED ON A COMMA (STATUS=0) C3200329C C3200330 260 MORPAR=1 C3200331+ SET INDICATOR FOR MORE PARAMETERS C3200332 IF(CODE(1) .NE. BLANK)GO TO 270 C3200333 IFND(IP)=0 C3200334 IP=IP+1 C3200335 GO TO 35 C3200336C C3200337C STORE PARAMETER VALUES INTO REQUIRED LOCATIONS C3200338C C3200339 270 IF (PARID)290,290,280 C3200340+ PARAMETER-ID FOUND C3200341 280 I=PARID C3200342+ YES C3200343 GO TO 300 C3200344C C3200345 290 I=IP C3200346ÐÐ IF (CODE(1) .NE. BLANK) IFND(I)=1 C3200347 IP=IP+1 C3200348C C3200349 300 I=(IPNAM(I)-1)*3+1 C3200350C C3200351 LNGO=PARNAM(I+1) C3200352 OUTP=PARNAM(I+2) C3200353C C3200354C STORE INTO DESIGNATED OUTPUT FIELD C3200355C C3200356 CALL MOVEL (CODE,OUTP,LNGO) C3200357C C3200358 PARID=0 C3200359 IF(MORPAR)310,320,310 C3200360+ ARE THERE MORE PARAM TO BE PROCESSED C3200361 310 IF(PIND) 110,70,40 C3200362+ YES C3200363C C3200364C C3200365C ARE ALL REQUIRED PARAMETERS FOUND ? C3200366C C3200367 320 I=0 C3200368 330 I=I+1 C3200369 IF(PPTEMP(I))330,360,340 C3200370C C3200371ÐÐC PARAMETER NOT FOUND,IS IT REQUIRED ? C3200372C C3200373 340 IF(IREQ(I))330,350,330 C3200374C C3200375C YES IT IS REQUIRED C3200376C C3200377 350 PARNUM=PARNUM+1 C3200378 GO TO 330 C3200379C C3200380C END OF PPTAB C3200381C C3200382 360 IF(PARNUM) 240,400,240 C3200383+ ARE ALL REQUIRED PARAMETERS FOUND C3200384C C3200385C ALL REQUIRED PARAMETERS HAVE BEEN FOUND C3200386C C3200387 400 IF(MORPAR .NE. 0) GO TO 310 C3200388C C3200389C SET UP FOR HOST FILE MANAGER CALLS C3200390C C3200391 IDATA(1)=$2424 C3200392 IDATA(2)=$484F C3200393 IDATA(3)=$5354 C3200394 IDATA(5)=$2424 C3200395 IDATA(9)=$5359 C3200396ÐÐ IDATA(10)=$5356 C3200397 IDATA(11)=$4F4C C3200398 IDATA(13)=0 C3200399 IDATA(14)=1 C3200400 IDATA(15)=-1 C3200401 REQBUF(13)=0 C3200402C C3200403C GET FCB HEADER C3200404C LDA =XFCBHDR C3200405C STA+ REQBUF+9 C3200406C C3200407 ASSEM $C000,+FCBHDR C3200408 ASSEM $6400,+REQBUF(10) C3200409C C3200410C OPEN AND LOCK HOST FILE C3200411C RETRIEVE 13 WORDS OF FCB INFO TOO. C3200412C C3200413 CALL OPENFL(REQBUF,IDATA,ISTAT) C3200414 IF(ISTAT)8000,447,447 C3200415 447 REQBUF(13)=TDATRL C3200416C C3200417C READ IN HOST FILE C3200418C C3200419 CALL GETS(REQBUF,RECBUF,KEYVAL,ISTAT) C3200420 IF(ISTAT)8000,450,450 C3200421ÐÐC C3200422C CHECK FOR VALID LU C3200423C C3200424C LDQ LU C3200425C LDQ+ LOG1A,Q C3200426C LDA* 8,Q C3200427C LDA+ LOG1A,Q C3200428C STA* LUCHK C3200429C C3200430C CONVERT THE LOGICAL UNIT FROM ASCII TO HEX. C3200431 450 LU=LUNO+LUNP*10 C3200432 IF(LU.EQ.0) GO TO 455 C3200433 ASSEM $E800,LU,$E600,+LOG1A,$C208,$6800,LUCHK C3200434 IF(AND(LUCHK,$1FFF).NE.$08A2) GO TO 8010 C3200435C C3200436C CHECK FOR HOST NAME C3200437C C3200438 455 K=RECLEN*TDATRL C3200439 DO 460 I=1,K,RECLEN C3200440 IF(RECBUF(I).EQ.DUMMY(5).AND.RECBUF(I+1).EQ.DUMMY(6)) C3200441 1 GO TO 470 C3200442 460 CONTINUE C3200443C C3200444C NAME NOT FOUND, GO TO ERROR C3200445C C3200446ÐÐ INDEX = KERBAS + 7 C3200447 GO TO 9999 C3200448C C3200449C CHECK IF BATCH DRIVER BUSY C3200450C C3200451 470 IF(LU.EQ.0) GO TO 490 C3200452 IF(AND(RECBUF(I+2),$400).NE.0) GO TO 8020 C3200453 IF(AND(RECBUF(I+2),$FF).NE.0 ) GO TO 8030 C3200454C C3200455C IS LU ALREADY SET FOR ANY OTHER HOST C3200456C C3200457 DO 480 J=1,K,RECLEN C3200458 IF(AND(RECBUF(J+2),$FF).EQ.LU) GO TO 8040 C3200459 480 CONTINUE C3200460 RECBUF(I+2)=AND(RECBUF(I+2),$F300)+LU C3200461 GO TO 500 C3200462 490 RECBUF(I+2)=AND(RECBUF(I+2),$F700)+$800 C3200463 500 CALL UPDREC(REQBUF,RECBUF,ISTAT) C3200464 IF(ISTAT)8000,9998,9998 C3200465C C3200466C ERROR MSG SECTION C3200467C C3200468 8000 CALL ERCHK(ISTAT,REQBUF(4)) C3200469 GO TO 9993 C3200470C C3200471ÐÐC SET INDEX TO INVALUD LU C3200472C C3200473 8010 CONTINUE C3200474 INDEX = KERBAS + 8 C3200475 GO TO 9999 C3200476C C3200477C SET INDEX TO BATCH DRIVER BUSY C3200478C C3200479 8020 CONTINUE C3200480 INDEX = KERBAS + 5 C3200481 GO TO 9999 C3200482C C3200483C SET INDEX TO LU FOR THIS HOST ALREADY SET C3200484C C3200485 8030 CONTINUE C3200486 INDEX = KERBAS + 10 C3200487 GO TO 9999 C3200488C C3200489C SET INDEX TO DUPLICATE LU NO. C3200490C C3200491 8040 CONTINUE C3200492 INDEX = KERBAS + 11 C3200493C ERROR ROUTINE C3200494C C3200495 9999 CALL SYSMSG (INDEX,ERBUF) C3200496ÐÐC C3200497 9993 IF (PIND) 9994,9994,11 C3200498 9994 IF (MODE) 9995,9998,9995 C3200499 9995 ASSEM $E400,+MODE C3200500 ASSEM $D622 C3200501C C3200502 9998 CALL CLOSFL(REQBUF,ISTAT) C3200503 9997 RETURN C3200504 END C3200505 SUBROUTINE UPDIDX C3300001 1 /C33 F ITOS CCS 3.0 SL-149C3300002C UPDATE INDEX TO REFLECT ADDITION OF NEW RECORD IN FILE. C3300003C CREDIT COLLECTION SYSTEM VERSION 3.0 C3300004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C3300005C COPYRIGHT CONTROL DATA CORPORATION 1979 C3300006C C3300007C*** C3300008C C3300009C THIS IS A VARIENT OF FILE MANAGER ROUTINE ADDKIS C3300010C UPDIDX ADDS A KIS TO A KEY INFO STRUCTURE. C3300011C C3300012C AFTER A NEW RECORD HAS BEEN ADDED TO AN INDEXED FILE, ALL C3300013C THE KEY INFO STRUCTURE(S) DEFINED FOR THE FILE MUST BE C3300014C UPDATED TO REFLECT THIS ADDITION. THE UPDATE IS DONE BY C3300015C ADDING A NEW KIS TO THE KEY INFO STRUCTURE. A KIS CONTAINS C3300016ÐÐC A KEY VALUE AND A RELATIVE RECORD NUMBER FOR THE NEW RECORD. C3300017C C3300018C THE UPDATE IS DONE SO THAT THE RECORD CAN BE RETRIEVED VIA C3300019C KEY VALUE LATER C3300020C C3300021C INPUT: C3300022C BLDIDR CALLS UPDIDX C3300023C INPUT PARAMETER : C3300024C KEY TYPE FOR THIS ADD (KEYTYP) C3300025C KEY VALUE (KEYVAL) C3300026C RELATIVE RECORD NUMBER OF THE NEW RECORD (RRDATA) C3300027C KEY LENGTH IN BYTES (KEYLNG) C3300028C KIB LENGTH IN WORDS (KIBLEN) C3300029C KIB HEADER LENGTH (KIBHRL) C3300030C ALL PARAMETERS ARE IN COMMON C33000312 C3300032C PROCESS: C3300033C LOOKS FOR THE RIGHT PLACE TO INSERT THE NEW KIS C3300034C IF THE KEY INFO STRUCTURE IS EMPTY, THEN BUILD THE ROOT C3300035C (WHOSE NUMBER MUST BE THE KEY TYPE) AND THE FIRST S.S. C3300036C C3300037C SEE IF THE KIB HAS ENOUGH SPACE TO CONTAIN THIS KIS. C3300038C IF SO, INSERT KIS IN ITS PLACE. UPDATE FATHER KIB, IF C3300039C NECESSARY. C3300040C IF THE KIB DOES NOT HAVE ENOUGH SPACE TO INCLUDE THE KIS, C3300041ÐÐC THEN NEED TO DO A BLOCK SPLIT. C3300042C C3300043C IN BLOCK SPLIT, A NEW KIB IS CREATED. SOME OF THE KISES C3300044C IN THE ORGINIAL KIB IS MOVED TO THE NEW KIB. THE FATHER C3300045C KIS IS UPDATED BY DELETING THE KIS POINTING TO THE C3300046C ORGINIAL KIB AND ADDING TWO NEW KISES POINTING TO C3300047C THESE TWO NEW KIBES. IF THE FATHER KIB IS FULL, A BLOCK C3300048C SPLIT ON THE FATHER KIB WILL BE DONE. C3300049. C3300050C IN CASE THE ROOT IS TO BE SPLIT. TWO TOTAL NEW KIBES WILL C3300051C BE CREATED AND A NEW ROOT CREATED. THE NUMBER FOR THE C3300052C ROOT IS THE KEY TYPE. BY KEEPING THE NUMBER OF THE ROOT C3300053C EQUAL TO THE KEY TYPE MAKES ANY RETRIEVAL OF THE KEY C3300054C EASIER. C3300055C C3300056C WHEN A NEW KIB IS CREATED, "THE POINTER TO FATHER KIB" OF C3300057C ITS SON KIB MUST BE CHANGED TO POINTING TO THIS NEW KIB. C3300058C THE UPDATE IS DONE FOR NON-SEQUENCE SET KIBES ONLY. C3300059C EXIT: C3300060C RETURNS TO CALLING PROGRAM C3300061C C3300062C THE FOLLOWING SUBROUTINES ARE USED BY ADDKIS C3300063C CMPSTG - COMPARES TWO STRINGS OF CHARACTER C3300064C NXTKIB - RELATIVE KIB NO. FOR NEXT AVAILABLE KIB C3300065C FWAKIS - FIRST WORD OF A KIS IN A KIB C3300066ÐÐC POSKID - POSITION INTO A KEY INFORMATION DIRECTORY C3300067C GETKIB - GET A KIB INTO THE KIB BUFFER C3300068C UDSKIB - UPDATE HEADER OF ALL KIBS ONE LEVEL DOWN C3300069C MRKKIB - MARK KIB IN KIB BUFFER AS CHANGED C3300070C FREEUP - FREE KIB BUFFER FOR USE AS SPECIFIED KIB C3300071C C3300072. C3300073C FOR A DEFINITION OF FMCOM, SEE MACRO FMCOM C3300074M FMCOM C3300075. C3300076C FOR A DEFINITION OF FMCOM2, SEE MACRO FMCOM2 C3300077M FMCOM2 C3300078 INTEGER OLDNUM (2) C3300079 INTEGER ROOTSP C3300080 INTEGER TOTKIS C3300081 INTEGER SEQSET C3300082 INTEGER SPCRKB(2) C3300083 INTEGER SAVBUF(288) C33000841 C3300085C SEQSET - SEQUENCE SET FLAG C3300086C SPCRKB - RELATIVE KIB # FOR SPECIAL CASE C3300087. C3300088C --INITIALIZE VARIABLE C3300089 FTHRUD = 0 C33000901 C3300091ÐÐC -PRESET NEW KIB FLAG TO FALSE C3300092 NEWBUF = 0 C33000932 C3300094C --BUILD THE KIS TO BE ADDED IN BUFFER C3300095 DO 5 I = 1,KEYLWD C3300096 KISA1 (I) = KEYVAL(I) C3300097 5 CONTINUE C3300098 KISA1 (KEYLWD+1) = RRDATA (1) C3300099 KISA1 (KEYLWD+2) = RRDATA (2) C33001002 C3300101C IS THIS A SEQUENCE SET KIB C3300102 IDX = KIBTYP + BUFIDX C3300103 IF (KIBBUF(IDX) .NE. SSET) GO TO 7 C33001041 C3300105C -- SPECIAL CASE: SCAN SEQ SET FOR PLACE TO INSERT THIS KEY C33001061 C3300107 I3 = -1 C3300108 IDX = NUMKIS + BUFIDX C3300109 TOTKIS = KIBBUF(IDX) C3300110 DO 10 KISIDX = 1, TOTKIS C3300111 I = FWAKIS (KISIDX) + BUFIDX C3300112 I2 = CMPSTG (KEYVAL, KIBBUF(I), KEYLWD) C3300113 IF (I2 .LT. 0 .AND. I3 .GE. 0) GO TO 15 C3300114 IF (I2 .EQ. 0 .AND. KEYTYP .EQ. 1) GO TO 20 C3300115 10 I3 = I2 C3300116ÐÐ GO TO 7 C33001171 C3300118 15 SEQSET = 1 C3300119 GO TO 100 C33001201 C3300121C -- EXISTING KEY VALUE IN PRIMARY KEY INDEX C3300122 20 J = I + KEYLWD C3300123 IF (KIBBUF(J) .GE. 0) GO TO 850 C3300124+ 127*5123C3300125C OK - ALL 0'S OR 1'S KEY C3300126 KIBBUF(J) = RRDATA(1) C3300127 KIBBUF(J+1) = RRDATA(2) C3300128 GO TO 40 C33001292 C3300130C--------------------------------------------------------- C3300131C -NOT- SPECIAL CASE: C3300132C --POSITION IN CORRECT PLACE IN KEY INFO STRUCTURE C3300133C--------------------------------------------------------- C3300134 7 CALL POSKID C3300135 SEQSET = 1 C3300136 IDX = NUMKIS + BUFIDX C3300137 TOTKIS = KIBBUF(IDX) C3300138 IF (REQSTA .LT. 0) GO TO 999 C3300139C --PRIMARY KEY ALREADY EXISTS, FLAG ERROR C3300140 IF (KEYFND .EQ. KEYTYP) GO TO 850 C3300141ÐÐ IF (EOF. EQ. 0) GO TO 100 C3300142C EOF = YES C3300143 IF (TOTKIS .NE. 0) GO TO 50 C3300144C --THE ROOT IS EMPTY C3300145C --BUILD ROOT C3300146C --KIB TYPE IS ALREADY ROOT C3300147C --SET THE RELATIVE KIB NO. = KEY TYPE C3300148 RKIBNO(1) = 0 C3300149 RKIBNO(2) = KEYTYP C3300150C CLEAR KIB AREA C3300151 DO 8 I = 1, KIBLEN C3300152 IDX = I + BUFIDX C3300153 8 KIBBUF(IDX) = 0 C33001541 C3300155 IDX = NUMKIS + BUFIDX C3300156 KIBBUF(IDX) = 1 C3300157C --GET NEXT KIB NUMBER C3300158 CALL NXTKIB C3300159 IF (REQSTA .LT. 0) GO TO 999 C3300160C --POINTERS TO FATHER + BROTHER KIB ARE ALREADY ZERO C3300161C --KIB TYPE IS ALREADY ROOT C3300162C --KEEP THE RELATIVE KIB NO. = KEY TYPE C3300163 RKIBNO(1) = 0 C3300164 RKIBNO(2) = KEYTYP C3300165C --BUILD THE ONLY KIS C3300166ÐÐ J = KIBHRL + BUFIDX C3300167 DO 81 I = 1, KEYLWD C3300168 J = J+1 C3300169 KIBBUF(J) = $FFFF C3300170 81 CONTINUE C3300171C --POINTER TO NEXT LEVEL KIB IS THE NEW KIB NO. JUST OBTAINED C3300172 KIBBUF (J+1) = NEWKIB (1) C3300173 KIBBUF (J+2) = NEWKIB (2) C3300174C --MARK KIB AS CHANGED C3300175 CALL MRKKIB C33001762 C3300177C --BUILD THE FIRST S.S. C33001781 C3300179C --ITS NUMBER IS THE NEW NUMBER JUST OBTAINED C3300180 RKIBNO(1) = NEWKIB(1) C3300181 RKIBNO(2) = NEWKIB(2) C3300182C --GET THE KIB C3300183 CALL GETKIB C3300184 IF (REQSTA .LT. 0) GO TO 999 C3300185C CLEAR KIB BUFFER C3300186 DO 32 I = 1, KIBLEN C3300187 IDX = I + BUFIDX C3300188 32 KIBBUF(IDX) = 0 C33001891 C3300190 NEWBUF = 1 C3300191ÐÐC --POINTER TO FATHER KIB IS THE KEY TYPE C3300192 IDX = PKIBNL+BUFIDX C3300193 KIBBUF(IDX) = KEYTYP C3300194C --THE KEY VALUE IS SAME ONE AS ROOT C3300195C --POINTER ISTHE RELATIVE RECORD NUMBER C3300196C -- LOAD 1ST SEQ SET W/ SMALLES/LARGEST POSSIBLE KEYS C33001971 C3300198C 1ST KIS = ALL 0,S KEY / RRN = -1,0 127*5123C3300199C 2ND KIS = KEYVAL / RRN = RRDATA C3300200C 3RD KIS = ALL F,S KEY/ RRN = -2,0 127*5123C33002011 C3300202C KEY = ALL 0,S 127*5123C3300203 J = KIBHRL + KEYLWD + BUFIDX + 1 C3300204+ 127*5123C3300205C RRN = -1,0 127*5123C3300206 KIBBUF(J) = -1 C3300207+ 127*5123C33002081 C3300209 J = J + 2 C3300210+ 127*5123C3300211C 2ND KIS (REAL 1ST KIS) 127*5123C3300212 K = KEYLWD + 2 C3300213 DO 34 I = 1, K C3300214 KIBBUF(J) = KISA1(I) C3300215 34 J = J + 1 C3300216ÐÐ1 C3300217C KEY = ALL F,S 127*5123C3300218 DO 36 I = 1, KEYLWD C3300219 KIBBUF(J) = $FFFF C3300220 36 J = J + 1 C3300221C RRN = -2,0 127*5123C3300222C ***** THIS PSR SUPERCEDES THE CHANGE MADE BY THE EARLIER PSR 138*A033C3300223 KIBBUF(J) = -2 C3300224C ***** 138*A033C33002251 C3300226C NUMBER OF KIS'S = 3 C3300227 IDX = BUFIDX + NUMKIS C3300228 KIBBUF(IDX) = 3 C33002291 C3300230C --KIB TYPE IS S.S. C3300231 IDX = KIBTYP + BUFIDX C3300232 KIBBUF(IDX) = SSET C3300233 40 CONTINUE C3300234C --MARK KIB AS CHANGED C3300235 CALL MRKKIB C3300236C --A L L D O N E C3300237 GO TO 1000 C3300238. C3300239 50 CONTINUE C3300240C --EOF THE KEY IS THE LARGEST ONE IN THE SET C3300241ÐÐC --KIBBUF CONTAINS THE ROOT C3300242C --GO DOWN TO THE LARGEST S.S. CHANGE THE LAST KEY IN EACH C3300243C --KIB ON THE WAY DOWN SO AS TO SAVE UPDATING AFTER INSERTION C3300244C --BUT NOTE THIS, IN CASE THERE IS A SPLIT AT THE S.S. C3300245 FTHRUD = 1 C3300246C --WHILE KIB IS NOT S.S. DO C3300247 55 CONTINUE C3300248 IDX = NUMKIS + BUFIDX C3300249 TOTKIS = KIBBUF(IDX) C3300250 IDX = KIBTYP + BUFIDX C3300251 IF (KIBBUF(IDX) .EQ. SSET) GO TO 70 C3300252C --CHANGE KEY OF THE LAST KIS C3300253 I1= FWAKIS (TOTKIS) + BUFIDX C3300254 DO 60 I = 1, KEYLWD C3300255 KIBBUF(I1) = KEYVAL(I) C3300256 I1 = I1 + 1 C3300257 60 CONTINUE C3300258C --MARK KIB AS CHANGED C3300259 CALL MRKKIB C3300260 IF (REQSTA .LT. 0) GO TO 999 C3300261C --POINTER TO NEXT LEVEL KIB C3300262 RKIBNO(1) = KIBBUF (I1) C3300263 RKIBNO(2) = KIBBUF (I1 + 1) C3300264 CALL GETKIB C3300265 IF (REQSTA .LT. 0) GO TO 999 C3300266ÐÐ GO TO 55 C3300267 70 CONTINUE C3300268C --ENDWHILE C3300269C --ARRIVE AT S.S. C3300270C --THE NEW KIS IS TO BE ADDED IS THE VERY LAST ONE IN THIS KIB C3300271 KISIDX = TOTKIS + 1 C3300272. C3300273C -- I N S E R T R O U T I N E -- C3300274C A D D N E W K I S TO K I B C33002752 C3300276 100 CONTINUE C3300277 110 CONTINUE C3300278 IF (TOTKIS .EQ. MAXKIS) GO TO 200 C3300279C --NO NEED TO SPLIT C3300280C --JUST INSERT NEW KIS IN ITS PLACE IN THIS KIB C3300281C --UPDATE IS ALREADY DONE ON THE WAY DOWN IF THE KEY IS THE C3300282C --LARGEST ONE C33002832 C3300284C --MOVE ALL KISES AFTER THE NEW KIS ONE POSITION TO THE RIGHT C3300285 J = (TOTKIS-KISIDX + 1) *KISLNG C3300286 I1 = FWAKIS (TOTKIS+1) -1 + BUFIDX C3300287 I2 = I1 + KISLNG C3300288C --NO NEED TO MOVE KISES IF NEW KIS IS THE LAST ONE C3300289 IF (J .EQ.0) GO TO 125 C3300290 DO 120 I = 1,J C3300291ÐÐ KIBBUF(I2) = KIBBUF (I1) C3300292 I2 = I2-1 C3300293 I1 = I1 - 1 C3300294 120 CONTINUE C3300295 125 CONTINUE C33002962 C3300297C -- ADD THE NEW KIS IN ITS PROPER PLACE C3300298 J=FWAKIS (KISIDX) + BUFIDX C3300299 DO 130 I = 1, KISLNG C3300300 KIBBUF(J) = KISA1 (I) C3300301 J = J+1 C3300302 130 CONTINUE C3300303C --INCREMENT NUMBER OF KISES COUNT BY ONE C3300304 IDX = NUMKIS + BUFIDX C3300305 KIBBUF(IDX) = KIBBUF(IDX) + 1 C3300306 TOTKIS = KIBBUF(IDX) C3300307C --MARK KIB AS CHANGED C3300308 CALL MRKKIB C3300309C --ALL DONE C3300310 GO TO 1000 C3300311. C3300312 200 CONTINUE C33003132 C3300314C B L O C K S P L I T C33003152 C3300316ÐÐC --THE KIB CANNOT HOLD ANOTHER KIS C3300317C --HAVE TO CREATE A NEW KIB AND MOVE SOME OF THE KISES IN THIS C3300318C --KIB TO THE NEW KIB C3300319 SPCRKB(1) = RKIBNO(1) C3300320 SPCRKB(2) = RKIBNO(2) C3300321 SEQSET = 0 C33003221 C33003232 C3300324C --SAVE THE LAST KEY IN THIS KIB, IT WILL BE DELETED FROM THE C3300325C --FATHER KIB C3300326 IF (FTHRUD .EQ. 0) GO TO 215 C3300327C C3300328C --FATHER WAS UPDATED ON THE WAY DOWN C3300329C --THE KEY TO LOOK FOR IS THE NEW KEY C3300330 DO 210 I = 1,KEYLWD C3300331 KISD (I) = KEYVAL(I) C3300332 210 CONTINUE C3300333 GO TO 230 C33003341 C3300335 215 CONTINUE C3300336C THIS IS THE KIS POINTING TO THIS KIB IN THE FATHER KIB. C3300337C NEEDS TO CHANGE POINTER AFTER SPLIT. C3300338 J = FWAKIS (MAXKIS) + BUFIDX C3300339 DO 220 I = 1, KEYLWD C3300340 KISD (I) = KIBBUF (J) C3300341ÐÐ J = J+1 C3300342 220 CONTINUE C3300343 230 CONTINUE C3300344 KISD (KEYLWD+1) = RKIBNO(1) C3300345 KISD (KEYLWD+2) = RKIBNO(2) C33003462 C3300347C --CLEAR SPLIT ROOT FLAG C3300348 ROOTSP = 0 C3300349 IDX = KIBTYP + BUFIDX C3300350 IF (KIBBUF(IDX) .NE. ROOT) GO TO 240 C3300351C --THE KIB BEING SPLIT IS THE ROOT C3300352C --WANT TO KEEP RELATIVE KIB NUMBER = KEY TYPE FOR THE ROOT C3300353C --GET NEW KIB NUMBER FOR THIS KIB C3300354 CALL NXTKIB C3300355 IF (REQSTA .LT. 0) GO TO 999 C3300356 RKIBNO (1) = NEWKIB (1) C3300357 RKIBNO (2) = NEWKIB (2) C3300358C C3300359C --SAVE CURRENT KIB IN SAVBUF C3300360 DO 232 I = 1,KIBLEN C3300361 IDX = I + BUFIDX C3300362 232 SAVBUF(I) = KIBBUF(IDX) C3300363C C3300364C --CALL FREEUP TO ASSIGN KIB BUFFER AS PROPER KIB C3300365 CALL FREEUP C3300366ÐÐC C3300367C --RESTORE SAVED KIB TO NEW KIBBUF C3300368 DO 234 I = 1,KIBLEN C3300369 IDX = I + BUFIDX C3300370 234 KIBBUF(IDX) = SAVBUF(I) C3300371 NEWBUF = 1 C3300372 IDX = BUFIDX + KIBTYP C3300373 KIBBUF(IDX) = NOROOT C3300374C --POINTER TO FATHER IS THE KEY TYPE C3300375 IDX = PKIBNL + BUFIDX C3300376 KIBBUF(IDX) = KEYTYP C3300377C --FLAG THAT THE ROOT IS BEING SPLIT C3300378 ROOTSP = 1 C33003792 C3300380 240 CONTINUE C3300381C ARRANGE THE FIRST KIB C33003822 C3300383C --MOVE THE LARGEST KIS TO A TEMP STORAGE C3300384 IF (KISIDX .GT. MAXKIS) GO TO 290 C3300385C --THE LARGEST KIS IS THE SAME C3300386 J = FWAKIS (MAXKIS) + BUFIDX C3300387 DO 250 I = 1, KISLNG C3300388 KISBUF(I) = KIBBUF (J) C3300389 J = J+1 C3300390 250 CONTINUE C3300391ÐÐ1 C3300392C --MOVE ALL KISES BIGGER THAN THE NEW ONE, ONE KIS POSITION TO C3300393C --THE RIGHT C3300394 J = (MAXKIS-KISIDX) * KISLNG C3300395 I1 = FWAKIS(MAXKIS) - 1 + BUFIDX C3300396 I2 = I1 + KISLNG C3300397 DO 270 I = 1,J C3300398 KIBBUF (I2) = KIBBUF (I1) C3300399 I1 = I1-1 C3300400 I2 = I2-1 C3300401 270 CONTINUE C33004022 C3300403C --INSERT THE NEW KIS C3300404 I1 = FWAKIS (KISIDX) + BUFIDX C3300405 DO 280 I = 1,KISLNG C3300406 KIBBUF (I1) = KISA1 (I) C3300407 I1 = I1+1 C3300408 280 CONTINUE C3300409 GO TO 300 C33004103 C3300411 290 CONTINUE C3300412C --THE NEW KIS IS THE LARGEST ONE C3300413 DO 295 I = 1,KISLNG C3300414 KISBUF (I) = KISA1 (I) C3300415 295 CONTINUE C3300416ÐÐ. C3300417 300 CONTINUE C3300418C USE A 50-50 SPLIT 132*5318C3300419C --COMPUTE NUMBER OF KISES FOR THIS KIB C3300420 TOTKIS = (MAXKIS+2)/2 C3300421C * 18 CARDS DELETED 132*5318C3300422 IDX = NUMKIS + BUFIDX C3300423 KIBBUF(IDX) = TOTKIS C3300424C * 1 CARD DELETED 132*5318C33004255 C3300426C --GET NEW KIB NUMBER FOR BROTHER KIB C3300427 CALL NXTKIB C3300428 IF (REQSTA .LT. 0) GO TO 999 C3300429C --SAVE POINTER TO PRESENT BROTHER, FOR THE NEW KIB C3300430 IDX = NKIBNM + BUFIDX C3300431 OLDNUM(1) = KIBBUF(IDX) C3300432 OLDNUM(2) = KIBBUF(IDX+1) C3300433 KIBBUF(IDX) = NEWKIB(1) C3300434 KIBBUF(IDX+1) = NEWKIB(2) C3300435C --MARK KIB AS CHANGED C3300436 CALL MRKKIB C3300437 IF (REQSTA .LT. 0) GO TO 999 C33004382 C3300439C --SAVE THE LARGEST KIS IN THIS KIB, TO BE ADDED TO FATHER KIB C3300440 J = FWAKIS (TOTKIS) + BUFIDX C3300441ÐÐ DO 510 I = 1,KEYLWD C3300442 KISA1(I) = KIBBUF (J) C3300443 J = J + 1 C3300444 510 CONTINUE C3300445 KISA1(KEYLWD+1) = RKIBNO (1) C3300446 KISA1(KEYLWD+2) = RKIBNO (2) C3300447C --UPDATE ALL SONS OF THIS KIB, IF IT WAS A ROOT C3300448 IF (ROOTSP .EQ. 0) GO TO 515 C3300449 CALL UDSKIB (SAVBUF) C3300450 IF (REQSTA .LT. 0) GO TO 999 C3300451 515 CONTINUE C33004523 C3300453C B U I L D N E W K I B (2ND KIB IN SPLIT) C33004542 C3300455 RKIBNO(1) = NEWKIB (1) C3300456 RKIBNO(2) = NEWKIB (2) C33004572 C3300458C --SAVE CURRENT KIB IN SAVBUF C3300459 DO 517 I = 1,KIBLEN C3300460 IDX = I + BUFIDX C3300461 517 SAVBUF(I) = KIBBUF(IDX) C3300462C --CALL FREEUP TO ASSIGN KIB BUFFER AS PROPER KIB C3300463 CALL FREEUP C3300464 IF (REQSTA .LT. 0) GO TO 999 C33004652 C3300466ÐÐC --RESTORE SAVED KIB TO NEW KIBBUF C3300467 DO 519 I = 1,KIBLEN C3300468 IDX = I + BUFIDX C3300469 519 KIBBUF(IDX) = SAVBUF(I) C3300470 NEWBUF = 1 C3300471C --POINTER TO FATHER IS THE SAME AS THE PREVIOUS ONE C3300472C --KIB TYPE IS SAME AS PREVIOUS ONE C3300473C --POINTER TO BROTHER KIB IS THE ONE RESERVED BY PREVIOUS KIB C3300474 IDX = NKIBNM + BUFIDX C3300475 KIBBUF(IDX) = OLDNUM(1) C3300476 KIBBUF(IDX+1) = OLDNUM(2) C33004772 C3300478C --MOVE ALL KISES NOT INCLUDED IN THE PREVIOUS KIB TO THE BEGINNING C3300479C --OF THIS KIB C3300480 J = (MAXKIS-TOTKIS) * KISLNG C3300481 I1 = FWAKIS (TOTKIS+1) + BUFIDX C3300482 I2 = KIBHRL +1 + BUFIDX C3300483 DO 520 I = 1,J C3300484 KIBBUF (I2) = KIBBUF (I1) C3300485 I1 = I1+1 C3300486 I2 = I2+1 C3300487 520 CONTINUE C3300488C --SIZE OF THIS KIB C3300489 TOTKIS = MAXKIS+1-TOTKIS C3300490C C3300491ÐÐC --INCLUDE THE EXTRA KIS IN TEMP STORAGE C3300492 I1 = FWAKIS (TOTKIS) + BUFIDX C3300493 DO 530 I = 1,KISLNG C3300494 KIBBUF (I1) = KISBUF (I) C3300495 I1 = I1+1 C3300496 530 CONTINUE C3300497 IDX = NUMKIS + BUFIDX C3300498 KIBBUF(IDX) = TOTKIS C33004991 C3300500C --MARK KIB AS CHANGED C3300501 CALL MRKKIB C3300502C C3300503C --THE KEY OF THE LARGEST KIS IN THIS KIB IS ALREADY IN THE C3300504C FATHER KIB. C3300505C SAVE THE RELATIVE KIB NO. OF THIS KIB SO THAT IT CAN BE CHANGED C3300506C IN THE FATHER KIB. C3300507 OLDNUM(1) = RKIBNO(1) C3300508 OLDNUM(2) = RKIBNO(2) C33005092 C3300510C --UPDATE ALL SONS C3300511 CALL UDSKIB (SAVBUF) C3300512C --FINISH BUILDING NEW KIB C33005133 C3300514C --SET UP FATHER KIB TO REFLECT THE SPLIT C3300515 IF (ROOTSP .EQ. 0) GO TO 570 C3300516ÐÐ3 C3300517C --THE KIB THAT WAS SPLIT WAS THE ROOT C3300518C --CREATE NEW ROOT TO POINT TO THE TWO KIBS C3300519C --ITS NUMBER IS THE KEY TYPE C3300520C --BUILD POINTER TO BIGGER KIB INTO KIS. C3300521 KISBUF(KEYLWD+1) = OLDNUM(1) C3300522 KISBUF(KEYLWD+2) = OLDNUM(2) C3300523 RKIBNO(1) = 0 C3300524 RKIBNO(2) = KEYTYP C3300525C --GET THE KIB C3300526 CALL GETKIB C3300527 IF (REQSTA .LT. 0) GO TO 999 C3300528C --CLEAR POINTER TO FATHER, BROTHER C3300529C --KEY TYPE IS ROOT (=0) C3300530 DO 550 I=1,KIBHRL C3300531 IDX = I + BUFIDX C3300532 KIBBUF(IDX) = 0 C3300533 550 CONTINUE C3300534 IDX = NUMKIS + BUFIDX C3300535 KIBBUF(IDX) = 2 C3300536C --FILL IN THE TWO KISES C3300537 I1= KIBHRL + 1 + BUFIDX C3300538 I2= I1+ KISLNG C3300539 DO 560 I = 1,KISLNG C3300540 KIBBUF(I1) = KISA1(I) C3300541ÐÐ KIBBUF (I2)= KISBUF(I) C3300542 I1 = I1 + 1 C3300543 I2 = I2 + 1 C3300544 560 CONTINUE C3300545C C3300546C --MARK KIB AS CHANGED C3300547 CALL MRKKIB C33005482 C3300549C --ALL DONE C3300550 GO TO 1000 C3300551. C3300552 570 CONTINUE C3300553C --THE KIB JUST SPLIT WAS NOT A ROOT C3300554C --DELETE THE OLD KIS POINTING TO OLD SON C3300555C --ADD THE TWO NEW KISES C3300556C --UPDATE FATHER C3300557C --READ IN FATHER KIB C3300558 IDX = PKIBNM + BUFIDX C3300559 RKIBNO(1) = KIBBUF(IDX) C3300560 RKIBNO(2) = KIBBUF(IDX+1) C3300561 CALL GETKIB C3300562 IF (REQSTA .LT. 0) GO TO 999 C3300563C --LOOK FOR THE KIS TO BE DELETED C3300564 IDX = NUMKIS + BUFIDX C3300565 TOTKIS = KIBBUF(IDX) C3300566ÐÐ KISIDX = 1 C3300567 580 CONTINUE C3300568 IF (KISIDX .GT. TOTKIS) GO TO 800 C3300569 J = FWAKIS (KISIDX) + BUFIDX C3300570C ** 137*A019C3300571 IF (CMPSTG(KIBBUF(J), KISD, KISLNG)) 590,600,590 C3300572C ** 137*A019C3300573 590 KISIDX = KISIDX + 1 C3300574C --GO ON TO NEXT KIS IN KIB C3300575 GO TO 580 C33005762 C3300577 600 CONTINUE C3300578C --FOUND PLACE POINTING TO THE OLD KIS C3300579C --CHANGE POINTER TO THE NEW KIB NO. THE KEY IS THE SAME C3300580 J = J+KEYLWD C3300581 KIBBUF(J) = OLDNUM(1) C3300582 KIBBUF(J+1) = OLDNUM(2) C3300583C C3300584C --INSERT THE LARGEST KIS OF THE SMALLER KIB (KISA1) IN C3300585C --THIS POSITION WITHIN THE FATHER KIB C3300586C C3300587 GO TO 110 C3300588. C3300589C------------ C3300590C --ERROR C3300591ÐÐC------------ C3300592 800 CONTINUE C3300593 KIDFUL = 1 C3300594 ERRIDC = 1 C3300595 GO TO 3000 C33005961 C3300597 850 CONTINUE C3300598C DUPLICATE PRIMARY KEY, SET ERROR C3300599 RECDUP = 1 C3300600 ERRIDC = 1 C33006011 C3300602 990 KEYFND = 1 C33006031 C3300604 1000 CONTINUE C33006051 C3300606 999 CONTINUE C33006071 C3300608 3000 CONTINUE C3300609 RETURN C3300610 END C3300611 SUBROUTINE POSKID C3400001 1 /C34 F ITOS CCS 3.0 SL-149C3400002C POSITION INTO THE KEY INFO DIRECTORY C3400003C CREDIT COLLECTION SYSTEM VERSION 3.0 C3400004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C3400005ÐÐC COPYRIGHT CONTROL DATA CORPORATION 1979 C3400006C C3400007C C3400008C*** 127*5187C3400009C THIS IS A VARIENT OF FILE MANAGER ROUTINE POSKID (G22). 127*5187C3400010C TO SIMPLIFY CONVERSION TO THE UTILITIES ENVIROMMENT, 127*5187C3400011+ 127*5187C3400012C CHANGES WERE KEPT TO A MINIMUM. THUS, SOME SUPERFLUOUS 127*5187C3400013C CODE WAS LEFT IN. 127*5187C3400014C 127*5187C3400015C POSKID POSITIONS INTO A KEY INFORMATION DIRECTORY FOR C3400016C A SPECIFIED KEY. SEE ITOS FM 2.0 REF MANUAL, APPENDIX C3400017C FOR DETAILED DESCRIPTION OF THE STRUCTURE OF A KEY INFO C3400018C DIRECTORY. C3400019C C3400020C POSITIONING MEANS THE RELATIVE KIB NUMBER, AND THE KIS C3400021C NUMBER WITHIN THE KIB. C3400022C C3400023C THE RELATIVE KIB NUMBER OF THE ROOT FOR THE KEY INFO C3400024C DIRECTORY IS THE KEY TYPE. WHICH IS BETWEEN 1 TO 4. C34000252 C3400026C INPUT -.KEY VALUE LOOKING FOR C3400027C C3400028C .KEY TYPE C3400029C C3400030ÐÐC .RELATIVE RECORD NUMBER C3400031C 5 CARDS REMOVED 127*5187C3400032C THE CALLING PROGRAM IS LOOKING FOR THE POSITION 127*5187C3400033C TO LOGICALLY INSERT A KIS FOR THE CURRENT RECORD. 127*5187C3400034C C3400035C C3400036C C3400037C PROCESS: C3400038C STARTING FROM THE ROOT OF THE KID FOR THE KEY TYPE, C3400039C LOOK FOR THE KIS WHOSE KEY VALUE IS EQUAL OR GREATER C3400040C THAN THE ONE BEING LOOK FOR. WHEN FOUND, GET THE C3400041C POINTER OF THE KIS. THE POINTER POINTS TO THE NEXT C3400042C LEVEL KIB IN THE KID. C3400043C C3400044C THE KIB IS SEARCHED IN THE SAME WAY AS THE ROOT. C3400045C C3400046C WHEN KIB REACHED IS THE SEQUENCE SET, THEN THE POINTERS C3400047C IN THE KIS IS THE RELATIVE RECORD NUMBER OF THE C3400048C RECORD CONTAINING THE KEY IN THE KIS. C3400049C C3400050C IF THERE IS NO KIS WITH THE EXACT KEY VALUE, THEN C3400051C POSKID WILL POSITION AT THE KIS ONE BIGGER THAN THE C3400052C ONE BEING SEARCH FOR. C3400053C C3400054C C3400055ÐÐC THE FOLLOWING SUBROUTINES ARE USED BY POSKID C3400056C CMPSTG - COMPARES TWO STRINGS OF CHARACTER C3400057C FWAKIS - FIRST WORD OF A KIS IN A KIB C3400058C NEXTSS - READ NEXT SEQUENCE SET FROM MASS MEMORY C3400059C GETKIB - GET SPECIFIED KIB INTO KIB BUFFER C34000602 C3400061C OUTPUT -.POSITIONING = REALTIVE KIB NUMBER (RKIBNO) C3400062C RELATIVE KIS NUMBER WITHIN THE KIB C3400063C (KISIDX) C3400064C C3400065C .THE CURRENT KEY INFO BLOCK IN KIBBUF C3400066C C3400067C .WHETHER THE KEY IS PRESENT OR NOT C3400068C IF KEY DOES NOT EXIST, THEN POSITIONING C3400069C IS AT THE NEXT HIGHER KEY. C3400070C KEYFND = 1 MEANS FOUND KEY C3400071C KEYFND = 0 MEANS KEY NOT FOUND C3400072C C3400073C C3400074C C3400075C .WHETHER THE EXACT KIS (KEY + RELATIVE RECORD NO.) C3400076C IS FOUND, KISFND = 1 MEANS YES C3400077C KISFND = 0 MEANS NO C3400078C C3400079C .WHETHER EOF IS ENCOUNTERED (EOF) C3400080ÐÐC C3400081C .THE RELATIVE RECORD NUMBER WITHIN THE FILE OF THAT C3400082C RECORD (RRDATA) C3400083C C3400084C ALL PARAMETERS ARE IN THE COMMON BLOCK C3400085C C3400086C FOR A DEFINITION OF FMCOM, SEE MACRO FMCOM C3400087M FMCOM C3400088 INTEGER BGKIS C3400089 INTEGER DONE C3400090 INTEGER GTNXT C3400091 INTEGER KEYLWD C3400092 INTEGER KISTYP C3400093 INTEGER OLDNUM(2) C3400094 INTEGER TOTKIS C3400095C FOR DESCRIPTION OF VARIABLES, SEE MACRO FMCOM3C3400096C*** C3400097. C3400098C --LENGTH OF KIS C3400099 KEYLWD = (KEYLNG+1)/2 C3400100 KISLNG = KEYLWD + 2 C3400101C --ASSUME EOF ENCOUNTERED C3400102 EOF = 1 C3400103 KEYFND = 0 C3400104 KISFND = 0 C3400105ÐÐC --START FROM KIB WHOSE RELATIVE KIB NUMBER IS THE KEY TYPE C3400106 RKIBNO (1) = 0 C3400107 RKIBNO (2) = KEYTYP C3400108 DONE = 0 C34001095 C3400110C --REPEAT C3400111C -(WORK ON A NEW KIB) C3400112 100 CONTINUE C3400113C --READ KIB WHOSE RELATIVE BLOCK NO. IS RKIBNO C3400114 CALL GETKIB C3400115 IF (REQSTA .LT. 0) GO TO 999 C3400116 KISIDX = 1 C3400117 GTNXT = 0 C3400118 IDX = NUMKIS + BUFIDX C3400119 TOTKIS = KIBBUF(IDX) C34001203 C3400121C --WHILE MORE KIS IN KIB C3400122C AND NOT DONE YET C3400123C AND DO NOT GET NEXT LEVEL KIB DO C34001242 C3400125 200 IF (KISIDX .GT. TOTKIS) GO TO 700 C3400126 IF (GTNXT .EQ. 1) GO TO 700 C3400127 IF (DONE .EQ. 1) GO TO 700 C34001282 C3400129C --COMPARE KEY IN QUESTION WITH KEY IN KIS C3400130ÐÐ BGKIS = FWAKIS (KISIDX) + BUFIDX C3400131 IF (CMPSTG (KEYVAL,KIBBUF(BGKIS), KEYLWD)) 500,400,600 C34001322 C3400133 400 CONTINUE C3400134 C3400135C -- THE TWO KEYS ARE EQUAL C3400136 KEYFND = 1 C3400137C 127*5187C3400138C --CHECK IF MORE KISES HAVE SAME KEY. IF SO, POSITION 127*5187C3400139C TO THE LAST KIS WITH THE SAME KEY. 127*5187C3400140 450 IS1 = KISIDX C3400141+ 127*5187C3400142 IS2 = BGKIS C3400143+ 127*5187C3400144 KISIDX = KISIDX + 1 C3400145+ 127*5187C3400146 IF (KISIDX .GT. TOTKIS) GO TO 475 C3400147+ 127*5187C3400148C --COMPARE KEY IN QUESTION WITH KEY IN KIS 127*5187C3400149 BGKIS = FWAKIS(KISIDX) + BUFIDX C3400150+ 127*5187C3400151 IF (CMPSTG(KEYVAL,KIBBUF(BGKIS),KEYLWD))475,450,450 C3400152+ 127*5187C3400153C 127*5187C3400154C --PREVIOUS KIS WAS THE ONE TO USE FOR SUBSEQUENT PRO- 127*5187C3400155ÐÐC CESSING. 127*5187C3400156 475 KISIDX = IS1 C3400157+ 127*5187C3400158 BGKIS = IS2 C3400159+ 127*5187C34001602 C3400161 500 CONTINUE C3400162C -- KEY VALUE LESS THAN KEY IN KIS C3400163C -- PICK OUT POINTERS C3400164 I1 = BGKIS + KEYLWD C3400165 I = KIBBUF (I1) C3400166 J = KIBBUF (I1+1) C3400167C C3400168C --IF KIS IS SEQUENCE SET THEN POINTERS ARE RELATIVE C3400169C --RECORD NUMBERS C3400170 IDX = KIBTYP + BUFIDX C3400171 IF (KIBBUF(IDX) .NE. SSET ) GO TO 550 C3400172 EOF = 0 C3400173 DONE = 1 C34001741 C3400175 510 CONTINUE C3400176C --RELATIVE RECORD NUMBER IS NON-ZERO C3400177C --NEED TO POSITION TO KIS POINTING TO THE RECORD. C3400178C --SKIP OVER DUPLICATE KEY, IN CASE THERE ARE SOME C34001792 C3400180ÐÐC -------------------- C3400181C 1X A B B B C 1 C3400182C 1------------------1 C3400183C X C34001841 C3400185C --MAKE MASTER KIS C3400186 DO 515 I = 1, KEYLWD C3400187 KISBUF(I) = KEYVAL(I) C3400188 515 CONTINUE C3400189 KISBUF (KEYLWD+1) = RRDATA(1) C3400190 KISBUF (KEYLWD+2) = RRDATA(2) C3400191 OLDNUM(1) = RKIBNO(1) C3400192 OLDNUM(2) = RKIBNO(2) C34001932 C3400194C --COMPARE EACH KIS WITH THE MASTER KIS C3400195 520 CONTINUE C3400196 IDX = NUMKIS + BUFIDX C3400197 TOTKIS = KIBBUF(IDX) C3400198 521 CONTINUE C3400199 IF (KISIDX .GT. TOTKIS) GO TO 525 C3400200C --WHILE THERE ARE MORE KISES IN THIS KIB DO C3400201 BGKIS = FWAKIS (KISIDX) + BUFIDX C3400202 IF (CMPSTG (KISBUF, KIBBUF(BGKIS), KISLNG)) 535,540,523 C34002031 C3400204C --IF NOT YET AT RIGHT PLACE, THERE IS DUPLICATE KEY C3400205ÐÐC --MOVE TO NEXT KIS C3400206 523 KISIDX = KISIDX + 1 C3400207 GO TO 521 C34002081 C3400209 525 CONTINUE C3400210C --EXHAUST ALL KISES IN THIS KIB C3400211C --READ IN BROTHER KIB C3400212C --REMEMBER NUMBER FOR THIS KIB, IN CASE NEED TO BACK UP C3400213 OLDNUM(1) = RKIBNO(1) C3400214 OLDNUM(2) = RKIBNO(2) C3400215 CALL NEXTSS C3400216 IF (LASTSS .NE. 1) GO TO 530 C3400217C -- LAST S.S. FOUND, READ BACK LAST KIB IN MEMORY C3400218 RKIBNO (1) = OLDNUM (1) C3400219 RKIBNO (2) = OLDNUM (2) C3400220 CALL GETKIB C3400221 IF (REQSTA .LT. 0) GO TO 999 C3400222 IDX = NUMKIS + BUFIDX C3400223 KISIDX = KIBBUF(IDX) + 1 C3400224 GO TO 545 C34002252 C3400226 530 CONTINUE C3400227 KISIDX = 1 C3400228 GO TO 520 C34002293 C3400230ÐÐ 535 CONTINUE C3400231C --FOUND PLACE WHERE KIS LOGICALLY SHOULD BE C3400232C --THE EXACT KIS IS NOT FOUND C3400233C --BACK UP TO THE PREVIOUS KIB, IN CASE C3400234C --WE ARE INSERTING "B" IN THIS SITUATION C34002351 C3400236C ------------------- 1- - - - - - - - - 1 C3400237C 1X A B B 1 1X C D 1 C3400238C 1-----------------1 1- - - - - - - - - 1 C3400239C X C3400240C C3400241C --WE WILL BE POINTING TO "C" IN THE SECOND KIB C3400242C --WANT TO POINT TO THE LAST 'B' C34002432 C3400244 IF (KISIDX.NE.1) GO TO 545 C3400245 IF (CMPSTG(OLDNUM,RKIBNO,2) .EQ. 0) GO TO 545 C3400246C -BACK UP ONE KIB C3400247 RKIBNO(1) = OLDNUM(1) C3400248 RKIBNO(2) = OLDNUM(2) C3400249 CALL GETKIB C3400250 IF (REQSTA .LT. 0) GO TO 999 C3400251 IDX = NUMKIS + BUFIDX C3400252 KISIDX = KIBBUF(IDX) + 1 C3400253 GO TO 545 C34002542 C3400255ÐÐC --EXACT KIS FOUND C3400256 540 CONTINUE C3400257 KISFND = 1 C34002581 C3400259 545 CONTINUE C3400260 GO TO 670 C34002612 C3400262 550 CONTINUE C3400263C KIS IS NOT SEQUENCE SET, POINTERS ARE FOR NEXT LEVEL KIB C3400264 RKIBNO (1) = I C3400265 RKIBNO (2) = J C3400266 GTNXT = 1 C3400267 GO TO 670 C34002682 C3400269 600 CONTINUE C3400270C -- KEY VALUE BIGGER THAN KEY IN KIS C3400271C -- MOVE TO NEXT KIS IN THIS KIB C3400272 KISIDX = KISIDX + 1 C34002732 C3400274 670 CONTINUE C3400275C --ENDWHILE C3400276C --(MOVE ON TO NEXT KIS IN THIS KIB) C3400277 GO TO 200 C34002785 C3400279 700 CONTINUE C3400280ÐÐ IF (GTNXT .EQ. 1) GO TO 100 C3400281C --UNTIL NO MORE KIB TO READ C3400282C --ENDREPEAT C34002832 C3400284C --RETURN (ERROR OR NOT) C3400285 999 CONTINUE C3400286 RETURN C3400287C C3400288 END C3400289 SUBROUTINE NEXTSS C3500001 1 /C35 F ITOS CCS 3.0 SL-149C3500002C READ IN THE NEXT SEQUENCE SET C3500003C CREDIT COLLECTION SYSTEM VERSION 3.0 C3500004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C3500005C COPYRIGHT CONTROL DATA CORPORATION 1979 C3500006C C3500007C C3500008C*** C3500009C NEXTSS READS THE NEXT SEQUENCE SET IN A KEY INFORMATION C3500010C STRUCTURE. A SEQUENCE SET IS THE LOWEST LEVEL KIS IN A C3500011C KEY INFO STRUCTURE. A KIS IN A SEQUENCE SET (S.S.) CONTAINS C3500012C A KEY AND THE RELATIVE RECORD NUMBER OF THE RECORD CONTAIN- C3500013C ING THE KEY. C3500014C C3500015C ALL THE S.S. ARE LINKED IN ASCENDING ORDER W.R.T. THE KEY C3500016ÐÐC VALUE. THE HEADER OF A S.S. CONTAINS THE POINTER TO THE C3500017C NEXT S.S. (KIBBUF(NKIBNM, NKIBNL)). C3500018C C3500019C C3500020C INPUT: C3500021C THE CURRENT S.S. (KIBBUF) C3500022C BEGINNING SECTOR OF KIB (KEYBSC) C3500023C LENGTH OF KIB IN WORDS (KIBLEN) C3500024C C3500025C C3500026C PROCESS: C3500027C GET THE RELATIVE KIB NUMBER FOR THE NEXT S.S. FROM C3500028C THE HEADER OF THE CURRENT KIB C3500029C C3500030C IF THERE IS NO MORE S.S., THEN SET FLAG (LASTSS) AND C3500031C LEAVE. C3500032C OTHERWISE, READ IN THE NEW S.S. C3500033C C3500034C C3500035C EXIT: C3500036C NON-EMPTY S.S.(IN KIBBUF) C3500037C END OF S.S. FLAG (LASTSS) 1= YES IGNORE KIBBUF C3500038C 0= NO KIBBUF CONTAINS S.S. C3500039C C3500040C C3500041ÐÐC THE FOLLOWING SUBROUTINES ARE USED BY NEXTSS C3500042C CMPSTG - COMPARES TWO STRINGS OF CHARACTER C3500043C GETKIB - GET SPECIFIED KIB INTO KIB BUFFER C3500044C C3500045C FOR A DEFINITION OF FMCOM, SEE MACRO FMCOM C3500046M FMCOM C3500047C FOR DESCRIPTION OF VARIABLES, SEE MACRO FMCOM3C3500048C*** C35000495 C3500050 LASTSS = 0 C35000513 C3500052C --NUMBER TO BROTHER C3500053 10 IDX = NKIBNM + BUFIDX C3500054 RKIBNO(1) = KIBBUF(IDX) C3500055 RKIBNO(2) = KIBBUF(IDX+1) C35000562 C3500057C --SEE IF LAST S.S. IS HERE C3500058 20 CONTINUE C3500059 IF (CMPSTG(RKIBNO,ZERO2,2) .NE. 0) GO TO 30 C3500060C --LAST S.S. C3500061 LASTSS = 1 C3500062 GO TO 90 C3500063C --READ NEXT KIB C3500064 30 CONTINUE C3500065 CALL GETKIB C3500066ÐÐ 90 CONTINUE C3500067 RETURN C3500068 END C3500069 SUBROUTINE XTKEY (FCB, RECORD) C3600001 1 /C36 F ITOS CCS 3.0 SL-149C3600002C EXTRACT KEY FROM RECORD C3600003C CREDIT COLLECTION SYSTEM VERSION 3.0 C3600004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C3600005C COPYRIGHT CONTROL DATA CORPORATION 1979 C3600006C C3600007C C3600008C*** C3600009C ALL KEYS OF A RECORD FOR AN INDEXED FILE ARE CONTAINED C3600010C WITHIN THE RECORD. THE KEYS ARE CONTIGUOUS WITHIN C3600011C THE RECORD. C3600012C C3600013C THE KEY CAN START WITH AN EVEN OR ODD BYTE OF THE C3600014C RECORD. C3600015C C3600016C THE LENGTH OF THE KEY CAN BE EVEN OR ODD. C3600017C C3600018C C3600019C INPUT: C3600020C THE RECORD (PARAMETER) C3600021C FCB CONTAINING INFO ABOUT KEY POSITION AND LENGTH C3600022ÐÐC (PARAMETER) C3600023C KEY TYPE (KEYTYP) C3600024C C3600025C C3600026C PROCESS: C3600027C GET THE START BYTE OF KEY IN RECORD AND LENGTH OF C3600028C KEY IN BYTES FROM THE FCB FOR THE KEY TYPE. C3600029C C3600030C EXTRACT BYTE BY BYTE FROM THE RECORD. C3600031C PUT RESULT IN BUFFER KEYVAL, LEFT-JUSTIFIED. C3600032C C3600033C IF THE NUMBER OF BYTES IN THE KEY IS ODD, THE EXTRA C3600034C BYTE IN KEYVAL IS ZERO FILLED. C3600035C C3600036C C3600037C OUTPUT: C3600038C KEY VALUE LEFT-JUSTIFIED AND ZERO FILLED (KEYVAL) C3600039C C3600040C C3600041C FOR A DEFINITION OF FMCOM, SEE MACRO FMCOM C3600042M FMCOM C3600043C FOR DESCRIPTION OF VARIABLES, SEE MACRO FMCOM3C3600044C*** C3600045 INTEGER FCB(1) C3600046 INTEGER FRSTBY C3600047ÐÐ INTEGER FRSTWD C3600048 INTEGER KPIDX (4) C3600049 INTEGER LASTBY C3600050 INTEGER RECORD(1) C36000515 C3600052 DATA KPIDX /21,23,25,27/ C3600053. C3600054C --PICK UP DATA FROM FCB C3600055 I = KPIDX (KEYTYP) C3600056 FRSTBY = FCB (I) C36000572 C3600058C --LAST BYTE POSITION IN RECORD C3600059 LASTBY = FRSTBY+KEYLNG-1 C3600060C --I IS THE BYTE POSITION IN A RECORD C3600061C --J IS THE WORD POSITION IN A RECORD C3600062C --I1 IS THE BYTE POSITION IN KEYVAL BUFFER C3600063C --J1 IS THE WORD POSITION IN KEYVAL BUFFER C3600064 I1 = 0 C3600065 DO 300 I = FRSTBY, LASTBY C3600066 J = (I+1)/2 C3600067 I1= I1+1 C3600068 J1=(I1+1)/2 C3600069 IF (AND(I,1) .EQ. 0) GO TO 100 C3600070C --EXTRACT LEFT-HAND BYTES, SHIFT TO RIGHT-HAND BYTES C3600071 IBYTE = AND (RECORD(J)/$100, $00FF) C3600072ÐÐ GO TO 150 C3600073 100 CONTINUE C3600074C --EXTRACT RIGHT-HAND BYTES C3600075 IBYTE = AND (RECORD(J), $00FF) C3600076 150 CONTINUE C36000772 C3600078 IF (AND(I1,1) .EQ. 0) GO TO 200 C3600079C --PUT BYTE IN LEFT-HAND OF WORD IN KEY VALUE BUFFER C3600080 KEYVAL(J1) = IBYTE*$100 C3600081 GO TO 250 C36000821 C3600083 200 CONTINUE C3600084C --ADD BYTE TO RIGHT-HAND OF WORD IN KEY VALUE BUFFER C3600085 KEYVAL(J1) = KEYVAL(J1) + IBYTE C3600086 250 CONTINUE C3600087 300 CONTINUE C36000882 C3600089 END C3600090 INTEGER FUNCTION FWAKIS (IDUM) C3700001 1 /C37 F ITOS CCS 3.0 SL-149C3700002C COMPUTE THE FWA OF A KIS WITHIN A KIB C3700003C CREDIT COLLECTION SYSTEM VERSION 3.0 C3700004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C3700005C COPYRIGHT CONTROL DATA CORPORATION 1979 C3700006C C3700007ÐÐC*** C3700008C C3700009C A KEY INFO BLOCK (KIB) CONTAINS A HEADER FOLLOWED BY A NUMBER OF C3700010C KEY INFO SEGMENTS (KIS). THIS INTEGER FUNCTION RETURNS THE FIEST C3700011C WORD ADDRESS OF THE NTH KIS WITHIN THE KIB. N STARTS FROM ONE. C3700012C C3700013C C3700014C INPUT: C3700015C THE KIS NUMBER (FROM CALL PARAMETER) C3700016C LENGTH OF KIB HEADER (KIBHRL-FROM COMMON) C3700017C LENGTH OF A KIS (KISLNG-FROM COMMON C3700018C C3700019C C3700020C PROCESS: C3700021C INDEX IS HEADER LENGTH + (KIS LENGTH* (I-1)) C3700022C OUTPUT: C3700023C INDEX AS INTEGER C3700024C*** C3700025C C3700026M FMCOM C3700027C C3700028C C3700029 FWAKIS = (IDUM-1) * KISLNG + KIBHRL + 1 C3700030 RETURN C3700031 END C3700032ÐÐ SUBROUTINE UDSKIB (LOCBUF) C3800001 1 /C38 F ITOS CCS 3.0 SL-149C3800002C UPDATE HEADER OF ALL KIB'S ONE LEVEL DOWN C3800003C CREDIT COLLECTION SYSTEM VERSION 3.0 C3800004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C3800005C COPYRIGHT CONTROL DATA CORPORATION 1979 C3800006C C3800007C*** WHEN A NEW KIB HAS BEEN CREATED (BECAUSE OF A BLOCK SPLIT), C3800008C THE HEADER WORD OF ALL THE KIB'S IT POINTS TO (THE SON KIB'S) C3800009C HAS TO BE CHANGED SUCH THAT THEY WILL BE POINTING TO THE NEW C3800010C FATHER KIB. UDSKIB CHANGES ALL THE HEADER WORDS. C3800011C C3800012C INPUT: C3800013C THE NEW KIB (KIBBUF) (KIBBUF) C3800014C ITS RELATIVE KIB NUMBER (RKIBNO) C3800015C BEGINNING SECTOR ADDR OF KIB (KEYBSC) C3800016C LENGTH OF A KIB (KIBLEN) C3800017C LENGTH OF A KEY IN WORDS (KEYLWD) C3800018C C3800019C PROCESS: C3800020C EACH KIS IN THE KIB POINTS TO THE SON KIB. C3800021C FROM EACH KIS, GET THE RELATIVE KIB NUMBER OF THE SON KIB. C3800022C C3800023C IN THE HEADER OF EACH SON KIB, THERE IS AN ENTRY POINTING TO C3800024C THE FATHER KIB (WORDS 4,5 - PKIBNM). C3800025ÐÐC C3800026C RETRIEVE AND UPDATE ALL SON KIB'S TO POINT TO THE NEW FATHER C3800027C KIB. AT COMPLETION, READ BACK FATHER KIB TO KIB BUFFER. C3800028C C3800029C C3800030C OUTPUT: C3800031C ALL HEADERS OF SON KIBS UPDATED. C3800032C C3800033C THE FOLLOW SUBROUTINES ARE USED BY UPDKIB: C3800034C GETKIB GET SPECIFIED INTO THE KIB BUFFER. C3800035C MRKKIB MARK KIB AS CHANGED C3800036C*** C3800037C FOR A DEFINITION OF FMCOM, SEE MACRO FMCOM C3800038M FMCOM C3800039C C38000402 C3800041C C3800042C ****NOTE THAT THIS IS SIZED FOR A 3 SECTOR KIB USING A 96 **** C3800043C ****WORD SECTOR. **** C3800044C C3800045 INTEGER LOCBUF(288) C3800046 INTEGER TOTKIS C38000472 C3800048C --ONLY UPDATE SONS OF NON-SEQUENCE SET KIB C3800049 IDX = KIBTYP + BUFIDX C3800050ÐÐ IF (KIBBUF(IDX) .EQ. SSET) GO TO 300 C38000512 C3800052 IDX = NUMKIS + BUFIDX C3800053 TOTKIS = KIBBUF(IDX) C3800054C C3800055C --MARK RESIDENT KIB AS CHANGED C3800056 CALL MRKKIB C3800057C C3800058C --SAVE KIB LOCALLY AND SAVE KIB NO. C3800059 DO 100 I =1,KIBLEN C3800060 IDX = I + BUFIDX C3800061 100 LOCBUF(I) = KIBBUF(IDX) C3800062 MSB = RKIBNO(1) C3800063 LSB = RKIBNO(2) C3800064C C3800065C --RETRIEVE AND UPDATE EACH OF THE TOTKIS KIBS C3800066 DO 200 I = 1, TOTKIS C3800067 J = FWAKIS(I) + KEYLWD C3800068 RKIBNO(1) = LOCBUF(J) C3800069 RKIBNO(2) = LOCBUF(J+1) C3800070 CALL GETKIB C3800071 IF (REQSTA .LT. 0) RETURN C3800072 IDX = PKIBNM + BUFIDX C3800073 KIBBUF(IDX) = MSB C3800074 KIBBUF(IDX+1) = LSB C3800075ÐÐC --MARK THE KIB AS CHANGED C3800076 CALL MRKKIB C3800077 200 CONTINUE C3800078C C3800079C --RESET RKIBNO TO FATHER KIB AND GET KIB BACK INTO BUFFER C3800080 RKIBNO(1) = MSB C3800081 RKIBNO(2) = LSB C3800082 CALL GETKIB C3800083 300 RETURN C3800084 END C3800085 INTEGER FUNCTION BLDIDR (IDUM) C3900001 1 /C39 F ITOS CCS 3.0 SL-149C3900002C BUILD INDEX FOR RANDOMLY ORDERED RECORDS C3900003C CREDIT COLLECTION SYSTEM VERSION 3.0 C3900004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C3900005C COPYRIGHT CONTROL DATA CORPORATION 1979 C3900006C*** C3900007C C3900008C THIS PROCESSOR IS USED TO BUILD ONE OR MORE INDEXES FOR A FILE IN C3900009C WATCH IT IS ASSUMED THAT THE RECORDS ARE RAMDOMLY ORDERED WITH C3900010C RESPECT TO COLATING SEQUENCE OF THE KEYS. WHEN BLDIDR IS CALLED, C3900011C IT IS NOTIFIED WHICH KEY IS THE FIRST ONE FOR WHICH IT IS TO C3900012C BUILD AN INDEX. IF THE PRIMARY KEY IS THE FIRST, BLDIDR WILL READC3900013C IN THE RECORDS FROM THE INPUT DEVICE AND STORE THEM INTO THE DATA C3900014C FILE. FOR EACH KEY OTHER THAN THE PRIMARY, BLDIDR WILL READ IN C3900015ÐÐC THE RECORDS FROM THE FILE. BLDIDR WILL BUILD INDEXES FOR ALL C3900016C NEEDED KEYS PRIOR TO RETURNING TO THE CALLER. C3900017C C3900018C BLDIDR IS EXECUTED AS AN INTEGER FUNCTION. THE SINGLE PARAMETER C3900019C IDUM IS A DUMMY. BLDIDR SHOULD BE SET TO 0 (ZERO) UPON THE C3900020C RETURN. C3900021C C3900022C WHEN BLDIDR IS CALLED, THE FILE FOR WHICH THE INDEX IS TO BE BUILTC3900023C MUST BE DEFINED VIA THE FIRST 12 WORDS OF IDATA (USING IDATA FROM C3900024C THE LABELLED COMMON OF THE CALLING PROGRAM). IDATA(13) MUST C3900025C SPECIFY THE FIRST KEY (INTEGER 1 THRU 4) FOR WHICH BLDIDR IS TO C3900026C BUILD AN INDEX. IDATA(14) MUST SPECIFY THE LOGICAL UNIT TO BE C3900027C USED TO READ THE INPUT RECORDS. IDATA(15) MUST CONTAIN AN ENTRY C3900028C MODE SWITCH INDICATING WHETHER OR NOT THE INPUT RECORDS ARE TO C3900029C BE CONVERTED FROM EBCDIC TO ASCII WHERE 1 SIGNIFIES YES AND C3900030C 0 SIGNIFIES NO. THE FILE MUST BE CLOSED. C3900031C C3900032C C3900033C*** C3900034C C3900035M FMUCOM C3900036 INTEGER ICOMON(700) C3900037 EQUIVALENCE (COMCOD,ICOMON) C3900038C C3900039C THIS IS THE LOCAL BUFFER USED TO SAVE THE PORTION OF C3900040ÐÐC LABELED COMMON USED BY ALL NON-INDEX LOAD RELATED UTILITIES. C3900041C C3900042 INTEGER BUFFER(528) C3900043C LENGTH OF COMMON C3900044 DATA LENCOM/528/ C3900045C C3900046C C3900047C THESE WORDS ARE DEFINED BY UPDIDX COMMON (MACRO FMCOM) SO THEY C3900048C MUST BE EQUATED INTO ORIGINAL COMMON. C3900049C C3900050 INTEGER RQBADR, FCBADR, KEYLNG, KEYLWD, KEYTYP, KIBHRL, KIBLEN, C3900051 1 KIBTYP, KLIDX(4) , MAXKIS, NOROOT, NKIBNL, NKIBNM, C3900052 2 NUMKIS, PKIBNL, PKIBNM, RECLNG, REQSTA, ROOT , SSET , C3900053 3 WPS , ZERO2(2),RRDATA(2),KISLNG C3900054 EQUIVALENCE (ICOMON( 1),RQBADR),(ICOMON( 2),FCBADR), C3900055 1 (ICOMON( 8),KEYLNG),(ICOMON( 9),KEYLWD),(ICOMON( 10),KEYTYP), C3900056 2 (ICOMON(598),KIBHRL),(ICOMON(599),KIBLEN),(ICOMON(600),KIBTYP), C3900057 3 (ICOMON(672),KLIDX ),(ICOMON(679),MAXKIS),(ICOMON(683),NOROOT), C3900058 4 (ICOMON(684),NKIBNL),(ICOMON(685),NKIBNM),(ICOMON(686),NUMKIS), C3900059 5 (ICOMON(687),PKIBNL),(ICOMON(688),PKIBNM),(ICOMON(689),RECLNG), C3900060 EQUIVALENCE C3900061 1 (ICOMON(690),REQSTA),(ICOMON(693),ROOT ),(ICOMON(696),SSET ), C3900062 2 (ICOMON(697),WPS ),(ICOMON(698),ZERO2 ),(ICOMON(694),RRDATA), C3900063 3 (ICOMON(671),KISLNG) C3900064 EQUIVALENCE (REQSTA,ISTAT) C3900065ÐÐC C3900066 INTEGER REQBFF(24),JDATA(24),FCBHDD(5),FCBBFF(96) C3900067C C3900068C RECBUF IS USED AS THE INPUT RECORD BUFFER. RBLEN IS THE LENGTH C3900069C OF THE BUFFER. NO2RED IS THE NUMBER OF RECORDS TO READ PER GETS C3900070C CALL (DEPENDENT UPON RECORD SIZE AND RBLEN). C3900071C C3900072 INTEGER RECBUF(1802),RBLEN C3900073C ALL RECORDS READ FLAG C3900074 DATA RBLEN/1800/,NO2RED/0/ , IDONE/0/ C3900075C DEFERRED ERROR FLAG MAXIMUN READ FLAG C3900076 DATA IDEFER/0/ , MAXRED/0/ C3900077C C3900078C C3900079 INTEGER NUMPRO(2),NUMRED(2),IDUMMY(2),WRTCOD C3900080C ***** 138*A031C3900081 INTEGER ISAVE(2),LSAVE(2) C3900082 DATA ISAVE /0,1/ C3900083C ***** 138*A031C3900084C C3900085C NUMBER OF RECORDS READ WRITE INDEXED RECORD CODE C3900086 DATA NUMRED/0,0/, WRTCOD/$C/ C3900087C C3900088 EXTERNAL MMLUTB C3900089+ FILE MANAGER LOGICAL UNIT TABLE C3900090ÐÐ EXTERNAL WRTKIB C3900091+ WRITE ALL CHANGED KIBS TO MASS MEMORY C3900092 INTEGER WRTKIB C3900093+ INTEGER FUNCTION C3900094C C3900095C ******************************************************************C3900096C C3900097C SAVE IDATA CONTENTS LOCALLY C3900098C C3900099 DO 5 I = 1,24 C3900100 5 JDATA(I) = IDATA(I) C3900101C C3900102C SAVE CURRENT COMMON CONTENTS THEN ZERO IT OUT C3900103 DO 10 I = 1, LENCOM C3900104 BUFFER(I) = ICOMON(I) C3900105 10 ICOMON(I) = 0 C3900106C C3900107C PROGRAM ABORT REQUEST SETUP C3900108 JJJ = 0 C3900109 ASSIGN 120 TO INTLOC C3900110+ 127*5166C3900111 CALL PGMINT (INTLOC,JJJ) C3900112C C3900113C SET UP FIRST 2 WORDS OF UPDIDX COMMON C3900114C C3900115ÐÐ ASSEM $C000,+FCBHDD C3900116+ LDA =XFCBHDR C3900117 ASSEM $6400,+FCBADR C3900118+ STA FCBADR C3900119 ASSEM $C000,+REQBFF C3900120+ LDA =XREQBUF C3900121 ASSEM $6400,+RQBADR C3900122+ STA RQBADR C3900123C C3900124C SAVE 1ST KEY NEEDING AN INDEX. (DECREMENTED BY 1) C3900125 KEYTYP = JDATA(13) - 1 C3900126C C3900127C SAVE LOGICAL UNIT TO BE USED FOR RECORD INPUT C3900128 LOGUNT = JDATA(14) C3900129C C3900130C SAVE ENTRY MODE SWITCH C3900131 MODESW = JDATA(15) C3900132C ***** 138*A031C3900133 IS1 = 0 C3900134+ CLEAR INITIAL SET FLAG C3900135C C3900136C SAVE INPUT LENGTH FOR RECORD READS C3900137 INPLEN = JDATA(16) C3900138 NOLOAD = 0 C3900139+ SET NO RECORDS LOADED FLAG C3900140ÐÐC ***** 138*A031C3900141C C3900142 JDATA(13) = -2 C3900143+ SPECIAL PROCESSING CODE C3900144 JDATA(14) = 1 C3900145+ NO. OF RECORDS - TO BE CHANGED C3900146C C3900147C SET UP REQBFF TO CAUSE FCB TO BE IN USER SPACE. C3900148C C3900149 ASSEM $C000,+FCBHDD C3900150+ LDA =XFCBHDD C3900151 ASSEM $6400,+REQBFF(10) C3900152+ STA REQBFF+9 C3900153 ASSEM $0A60 C3900154+ ENA 96 C3900155 ASSEM $6400,+REQBFF(13) C3900156+ STA REQBFF+12 C3900157C C3900158C ************************************************** C3900159C C3900160C OPEN THE FILE C3900161C C3900162 CALL OPENFL (REQBFF,JDATA,ISTAT) C3900163 IF (ISTAT.LT.0) GO TO 900 C3900164C C3900165ÐÐC SAVE FCB WORD 6 C3900166 IWORD6 = FCBBFF(6) C3900167C C3900168C CHANGE FILE TYPE TO SEQUENTIAL C3900169 FCBBFF(6) = AND(FCBBFF(6),$FFFE) C3900170C C3900171C --SET UP WORDS PER SECTOR AND KIB LENGTH C3900172C C3900173 ASSEM $C400,+FCBHDD C3900174+ LDA FCBHDD EXTRACT MM C3900175 ASSEM $0F4B C3900176+ ARS 11 LU PORTION C3900177 ASSEM $A007 C3900178+ AND- ONEMSK+4 OF FILEID. C3900179 ASSEM $0822 C3900180+ TRA Q C3900181 ASSEM $E600,+MMLUTB C3900182+ LDQ MMLUTB,Q C3900183 ASSEM $C20D C3900184+ LDA- VIWPS,Q GET WPS FOR C3900185 ASSEM $6400,+WPS C3900186+ STA WPS VOLUME. C3900187 ASSEM $6400,+IWPS C3900188+ STA+ IWPS (SECTOR LENGTH) C3900189C C3900190ÐÐC GET KIB LENGTH IN WORDS C3900191C C3900192 CALL UTCKLN (WPS,KIBLEN) C39001932 C3900194 RECLNG = FCBBUF(1) C39001952 C3900196 KLIDX(1) = 20 C3900197 KLIDX(2) = 22 C3900198 KLIDX(3) =24 C3900199 KLIDX(4) = 26 C39002001 C3900201 KIBHRL = 6 C3900202 NUMKIS = 1 C3900203 NKIBNM = 2 C3900204 NKIBNL = 3 C3900205 PKIBNM = 4 C3900206 PKIBNL = 5 C3900207 KIBTYP = 6 C39002081 C3900209 ROOT = 0 C3900210 NOROOT = 1 C3900211 SSET = 2 C39002121 C3900213 ZERO2(1) = 0 C3900214 ZERO2(2) = 0 C3900215ÐÐC ***** 138*A031C3900216C SAVE CURRENT NUMBER OF RECORDS IN THE FILE C3900217C C3900218 LSAVE(1) = FCBBFF(7) C3900219 LSAVE(2) = FCBBFF(8) C3900220C ***** 138*A031C3900221C C3900222C SET RECORD LENGTH FOR I/O AND INDEXING C3900223 IRLEN = FCBBFF(1) C3900224C C3900225C IF RECORDS ARE SECTOR ALIGNED, RECOMPUTE RECORD LENGTH TO BE AN C3900226C INTEGRAL NUMBER OF WORDS PER SECTOR C3900227C C3900228 IF (FCBBFF(6) .GT. 0) GO TO 20 C3900229C C3900230C COMPUTE NEW RECORD LENGTH C3900231C C3900232 II = IRLEN/IWPS C3900233 III = II * IWPS C3900234 IF (IRLEN.NE.III) II = II + 1 C3900235 IRLEN = II * IWPS C3900236C C3900237C COMPUTE NUMBER OF RECORDS THAT WILL FIT IN RECORD BUFFER. C3900238C C3900239 20 NO2RED = RBLEN / IRLEN C3900240ÐÐ REQBFF(13) = NO2RED C3900241C C3900242C INITIALIZE THE KIB BUFFER TABLES C3900243C C3900244 40 CALL INIKIB C3900245C ***** 138*A031C3900246 IF (ISAVE(1).EQ.0 .AND. ISAVE(2).EQ.1) GO TO 45 C3900247C C3900248C INITIALIZE NO. OF RECORDS PROCESSED TO SAVE INIT. NO. C3900249C C3900250 NUMPRO(1) = LSAVE(1) C3900251 NUMPRO(2) = LSAVE(2) C3900252 GO TO 48 C3900253C C3900254C DO THIS IF FIRST LOAD WAS FROM THE ORDERED LOAD MODULE C3900255C C3900256 45 NUMPRO(1) = 0 C3900257 NUMPRO(2) = 0 C3900258 48 CONTINUE C3900259C ***** 138*A031C3900260C C3900261C CLEAR WORDS 18-20 OF REQUEST BUFFER C3900262C C3900263 REQBFF(18) = 0 C3900264 REQBFF(19) = 0 C3900265ÐÐ REQBFF(20) = 0 C3900266C ***** 138*A031C3900267C IF KEYTYP=0, RESET NUMRED TO NO. OF EXIST. RCRDS IN FILE C3900268C C3900269 IF (KEYTYP.NE.0) GO TO 50 C3900270C C3900271 NUMRED(1) = FCBBFF(7) C3900272 NUMRED(2) = FCBBFF(8) C3900273C ***** 138*A031C3900274C C3900275C CLEAR DONE FLAG C3900276C C3900277 50 IDONE = 0 C3900278C ***** 138*A031C3900279 ISTART = 0 C3900280+ CLEAR START FLAG C3900281C ***** 138*A031C3900282C C3900283C ************************************************** C3900284C C3900285C BUMP KEYTYP AND CHECK IF KEY EXISTS FOR THAT KEY TYPE C3900286C C3900287 KEYTYP = KEYTYP + 1 C3900288 IF (KEYTYP.EQ.5) GO TO 200 C3900289 IND = (KEYTYP*2) + 13 C3900290ÐÐ IF (FCBBFF(IND).EQ.0) GO TO 200 C3900291C C3900292C SET KEY LENGTH IN CHARACTERS AND WORDS C3900293C C3900294 I = KLIDX(KEYTYP) C3900295 KEYLNG = FCBHDD(I) C3900296 KEYLWD = (KEYLNG+1)/2 C3900297 KISLNG = KEYLWD + 2 C3900298 MAXKIS = (KIBLEN-KIBHRL) / KISLNG C3900299C C3900300C CHECK IF KEYTYP = 1. IF SO, READ FILE RECORDS FROM INPUT LOGICAL C3900301C UNIT AND STORE IN FILE VIA PUTS REQUEST. C3900302C C3900303 75 IF (KEYTYP.NE.1) GO TO 130 C3900304C C3900305C** FILL INPUT BUFFER WITH SPACE CODE C3900306C C3900307 DO 85 LFL = 1 , RBLEN C3900308 RECBUF(LFL) = $2020 C3900309 85 CONTINUE C3900310 100 NRREAD = 0 C3900311 DO 110 I = 1,NO2RED C3900312C C3900313C COMPUTE BUFFER INDEX FOR CURRENT RECORD C3900314C C3900315ÐÐ IDX = NRREAD* IRLEN + 1 C3900316C ***** 138*A031C3900317C C3900318C RESET NO. OF CHAR REC. IN RECBUF(RECLEN+1) (SET BY THE C3900319C ITOS EXEC) TO BLANKS. THIS IS NOT MEANINGFUL THE 1ST TIME C3900320 RECBUF(IDX) = $2020 C3900321C ***** 138*A031C3900322C C3900323C READ IN THE RECORD AND CHECK STATUS C3900324C C3900325C ***** 138*A031C3900326 CALL REDREC (LOGUNT, INPLEN, RECBUF(IDX), ISTAT) C3900327C C3900328C REBLANK THE 1ST WORD AFTER THE LAST RECORD INPUT (MAY HAVE BEEN C3900329C RESET BY THE EXEC) C3900330C C3900331 IDD = IDX + INPLEN C3900332 RECBUF(IDD) = $2020 C3900333C C3900334C CHECK IF 1ST RECORD READ IS AN EOF C3900335C C3900336 IF (ISTAT.GE.0) GO TO 101 C3900337 IF (NRREAD.EQ.0 .AND. IS1.EQ.0) GO TO 200 C3900338 GO TO 120 C3900339 101 CONTINUE C3900340ÐÐC C3900341C SET NOLOAD FLAG TO INDICATE RECORD READ C3900342C C3900343 NOLOAD = 1 C3900344C ***** 138*A031C3900345C C3900346C CHECK IF THIS RECORD IS ONE TOO MANY, IF YES GO TO 103 C3900347C C3900348 IF (MAXRED.EQ.1) GO TO 103 C3900349C C3900350C BUMP NUMBER OF RECORDS PROCESSED BY 1 AND CHECK IF TOTAL NUMBER C3900351C PERMITTED HAS BEEN REACHED. C3900352C C3900353 CALL BMPRRN (NUMRED) C3900354 IF (FCBBFF(2).EQ.NUMRED(1) .AND. FCBBFF(3).EQ.NUMRED(2)) MAXRED =1C3900355 GO TO 105 C3900356C C3900357C TOO MANY RECORDS, SET DEFERRED ERROR FLAG. C3900358 103 IDEFER = 1 C3900359 GO TO 120 C3900360C C3900361C CONVERT FROM EBCDIC TO ASCII IF REQUIRED C3900362C C3900363 105 IF (MODESW.EQ.1) CALL ASCEBC (RECBUF(IDX),MODESW,FCBBFF(1)) C3900364C 127*5166C3900365ÐÐC EXTRACT KEY FOR USE BY UPDIDX 127*5166C3900366C 127*5166C3900367 CALL XTKEY (FCBHDD,RECBUF(IDX)) C3900368+ 127*5166C3900369C 127*5166C3900370C STORE RRN FOR UPDIDX 127*5166C3900371C 127*5166C3900372 RRDATA(1) = NUMRED(1) C3900373+ 127*5166C3900374 RRDATA(2) = NUMRED(2) C3900375+ 127*5166C3900376C 127*5166C3900377C UPDATE INDEX TO REFLECT ADDITION OF CURRENT RECORD 127*5166C3900378C 127*5166C3900379 CALL UPDIDX C3900380+ 127*5166C3900381 IF (ISTAT .LT. 0) GO TO 108 C3900382+ 127*5166C3900383C C3900384C BUMP COUNT OF RECORDS C3900385C C3900386 NRREAD = NRREAD + 1 C3900387 GO TO 110 C3900388+ 127*5166C3900389 108 IDEFER = 2 C3900390ÐÐ+ 127*5166C3900391 ISAVST = ISTAT C3900392+ 127*5166C3900393 GO TO 120 C3900394+ 127*5166C3900395 110 CONTINUE C3900396 GO TO 125 C3900397C C3900398C SET DONE FLAG C3900399C C3900400 120 IDONE = 1 C3900401 125 IF (NRREAD .EQ. 0) GO TO 170 C3900402+ 127*5166C3900403C C3900404C STORE THE NRREAD RECORDS INTO THE FILE. C3900405C C3900406 CALL PUTS (REQBFF,RECBUF,NRREAD,ISTAT) C3900407 IF (ISTAT.LT.0) GO TO 905 C3900408C ***** 138*A031C3900409C C3900410C IF INIT SET FLAG=0, SET IT AND SET ISAVE TO REL REC NO OF C3900411C 1ST RECORD STORED. C3900412C C3900413 IF (IS1.NE.0) GO TO 128 C3900414 IS1 = 1 C3900415ÐÐ ISAVE(1) = REQBFF(16) C3900416 ISAVE(2) = REQBFF(17) C3900417 128 CONTINUE C3900418C ***** 138*A031C3900419C 127*5166C3900420C CHECK IF WE ARE DONE 127*5166C3900421C 127*5166C3900422 IF (IDONE .EQ. 1) GO TO 170 C3900423+ 127*5166C3900424 GO TO 75 C3900425+ 127*5166C3900426C C3900427C READ IN A BLOCK OF NO2RED RECORDS FROM THE FILE. SET NRREAD TO C3900428C NUMBER OF RECORDS ACTUALLY READ. C3900429C C3900430C C3900431C ***** 138*A031C3900432C C3900433C DO INITIAL READ VIA READR RATHER THAN GETS C3900434C C3900435 130 IF (ISTART.NE.0) GO TO 134 C3900436 ISTART = 1 C3900437 CALL READR (REQBFF,RECBUF,ISAVE,ISTAT) C3900438 GO TO 136 C3900439C C3900440ÐÐ 134 CALL GETS (REQBFF,RECBUF,IDUMMY,ISTAT) C3900441 136 NRREAD = REQBFF(15) C3900442C ***** 138*A031C3900443 IF (ISTAT.LT.0) GO TO 910 C3900444C C3900445C PROCESS EACH RECORD FROM THE INPUT BUFFER C3900446C C3900447 140 IRECD = 1 C3900448C 6 CARDS REMOVED 127*5166C3900449C C3900450C COMPUTE INDEX TO REFERENCE CURRENT RECORD C3900451C C3900452 160 IDX = (IRECD-1) * IRLEN + 1 C3900453C C3900454C EXTRACT KEY FOR USE BY UPDIDX C3900455C C3900456 CALL XTKEY (FCBHDD,RECBUF(IDX)) C3900457C C3900458C C3900459C BUMP NUMBER OF RECORDS PROCESSED BY 1 TO GET REL. REC. NO. C3900460C C3900461 CALL BMPRRN (NUMPRO) C3900462C C3900463C STORE RRN FOR UPDIDX C3900464C C3900465ÐÐ RRDATA(1) = NUMPRO(1) C3900466 RRDATA(2) = NUMPRO(2) C3900467C C3900468C UPDATE INDEX TO REFLECT ADDITION OF CURRENT RECORD C3900469C C3900470 CALL UPDIDX C3900471 IF (ISTAT .LT. 0) GO TO 920 C3900472 IRECD = IRECD + 1 C3900473C 3 CARDS REMOVED 127*5166C3900474 IF (IRECD .LE. NRREAD) GO TO 160 C3900475C C3900476C CHECK IF ALL RECORDS HAVE BEEN PROCESSED C3900477C C3900478 IF (NUMPRO(1).EQ.FCBBFF(7) .AND. NUMPRO(2).EQ.FCBBFF(8)) GO TO 170C3900479 GO TO 130 C3900480C C3900481C C3900482C ************************************************** C3900483C C3900484C C3900485C WRITE ALL CHANGED KIBS TO MASS MEMORY C3900486C C3900487 170 CALL WRTKIB C3900488 IF (REQSTA.LT.0) GO TO 930 C3900489C C3900490ÐÐC GO BACK TO 40 AND PREPARE TO PROCESS NEXT KEY IF IT EXISTS. C3900491C C3900492 GO TO 40 C3900493C C3900494C C3900495C C3900496C RESTORE FCB WORD 6 C3900497 200 FCBBFF(6) = IWORD6 C3900498C C3900499C CLOSE FILE C3900500C C3900501 CALL CLOSFL (REQBFF,ISTAT) C3900502C C3900503C RESTORE SAVED COMMON C3900504C C3900505 DO 210 I = 1, LENCOM C3900506 210 ICOMON(I) = BUFFER(I) C3900507C C3900508C IF DEFERRED ERROR FLAG SET, GENERATE ERROR MESSAGE C3900509 IF (IDEFER.EQ.0) GO TO 220 C3900510 IF (IDEFER .EQ. 1) GO TO 215 C3900511+ 127*5166C3900512 CALL ERCHK (ISAVST,WRTCOD) C3900513+ 127*5166C3900514 GO TO 220 C3900515ÐÐ+ 127*5166C3900516 215 CONTINUE C3900517+ 127*5166C3900518C C3900519C SIMULATE WRITER CALL WITH APPROPRIATE ERROR STATUS C3900520 CALL ERCHK ($9000,WRTCOD) C3900521C C3900522C SET BLDIDR TO SIGNAL ALL DONE C3900523 220 BLDIDR = 0 C3900524C C3900525 RETURN C3900526C ************************************************** C3900527C ERROR PROCESSING C3900528 900 CONTINUE C3900529 905 CONTINUE C3900530 910 CONTINUE C3900531 920 CONTINUE C3900532 930 CONTINUE C3900533 CALL ERCHK (REQSTA, REQBFF(4)) C3900534 GO TO 200 C3900535C ***** 138*A031C3900536C C3900537C ABORT ENTRY C3900538C C3900539C CHECK IF ANY RECORDS PROCESSED YET. IF YES, GO TO 120 C3900540ÐÐ 1000 IF (NOLOAD.EQ.1) GO TO 120 C3900541 GO TO 200 C3900542C ***** 138*A031C3900543 END C3900544 INTEGER FUNCTION LDIXOD(IDUMMY) C4000001 1 /C40 F ITOS CCS 3.0 SL-149C4000002C BUILD KEY INDEX ROUTINE C4000003C CREDIT COLLECTION SYSTEM VERSION 3.0 C4000004C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CLAIFORNIA C4000005C COPYRIGHT CONTROL DATA CORPORATION 1979 C4000006C C4000007C LDIXOD LOADS AN ORDERED INDEXED FILE AND BUILDS ITS INDEX. C4000008C C4000009C LDIXOD READS THE SOURCE RECORDS FROM THE APPROPRIATE INPUT C4000010C LOGICAL UNIT. IT STORES THE RECORDS INTO A RECORD RECEIVING C4000011C BUFFER UNTIL THE BUFFER BECOMES FULL. AFTER THE BUFFER IS C4000012C FULL, THE RECORDS ARE STORED INTO THE FILE USING A PUTS C4000013C REQUEST. C4000014C C4000015C AS EACH RECORD IS INPUT, A KIS IN INSERTED INTO A SEQUENCE SETC4000016C KIB FOR THE RECORD. KIBS (OTHER THAN ROOT KIBS) ARE ONLY C4000017C FILLED 3/4 FULL SO AS TO PERMIT ADDITIONS TO THE FILE WITHOUT C4000018C INCURRING EXCESSIVE PENALTY. AFTER A KIB BECOMES 3/4 FULL ANDC4000019C DOES NOT HAVE ROOM FOR A KIS FOR THE LAST RECORD LOADED, THE C4000020C NEXT SEQUENCE SET KIB IS ALLOCATED (KIB RKN-WISE), THE CURRENTC4000021ÐÐC KIB IS LINKED TO THE NEW (NEXT) SEQUENCE SET KIB AND THE C4000022C CURRENT KIB IS WRITTEN TO THE FILE USING AN UPDATE RECORD RE- C4000023C QUEST. AN ENTRY FOR EACH SEQUENCE KIB IS INSERTED INTO AN C4000024C APPROPRIATE FATHER KIB. KIBS HIGHER THAT LOWEST LEVEL WILL C4000025C BE WRITTEN TO MM AS APPROPRIATE AND NEW LEVELS CREATED AS C4000026C NEEDED. AFTER THE ORIGINAL SET OF RECORDS HAVE BEEN READ AND C4000027C THE FIRST TWO KIBS HAVE BEEN CREATED, THE HIGHEST LEVEL KIB C4000028C (THE ROOT) WILL ALWAYS BE IN CORE. THE ROOT WILL NOT BE C4000029C WRITTEN OUT TILL ALL DATA RECORDS HAVE BEEN INPUT. C4000030C C4000031C NON-OREDERED KEY INDEXES AND SECONDARY KEY INDEXES ARE BUILT C4000032C BY THE BLDIDR MODULE. C4000033C C4000034C THE CURRENT SIZE OF KIBBUF WILL SUFFICE FOR A 12 LEVEL C4000035C KEY INDEX GIVEN A SECTOR SIZE OF 96 WORDS. IF C4000036C OTHER THAN 96 WORD SECTORS ARE USED, 'LDIXOD' COMPUTES THE C4000037C NUMBER OF LEVELS POSSIBLE. C4000038C C4000039C C4000040M FMUCOM C4000041C C4000042C C4000043 EQUIVALENCE (LENKY1,FCBBUF( 15)) C4000044 EQUIVALENCE (FTYPE ,FCBBUF( 95)) C4000045 EQUIVALENCE (RECLEN,FCBBUF( 1)) C4000046ÐÐ EQUIVALENCE (FCBIND,FCBBUF( 6)) C4000047C C4000048 INTEGER FTYPE C4000049 INTEGER RECLEN,FCBIND,SECLEN C4000050C C4000051 INTEGER RECBUF(3502),KIBBUF(3458),FRSTBY,NXTKIB(2),KISBUF(17), C4000052 1 KISSAV(17),TOTREC(2),ITEMP1(2),KIBM(12),KIBL(12), C4000053 1 IRRN(2),ISAVE(6) C4000054 DIMENSION KSHIFT( 2),KMSKBT( 2) C4000055 DIMENSION LRELRD( 2) C4000056C C4000057C C4000058C RECORD BFR LENGTH KIB BFR LENGTH ALL RECORDS READ FLAG C4000059 DATA IRBLEN/3500/, IKBLEN/3256/, IDONE/0/ C4000060C NEXT AVAILABLE KIB NUMBER NUMBER OF PYRAMID LEVELS C4000061 DATA NXTKIB/0,3/, NUMLEV/1/ C4000062C TOTAL RECORDS PROCESSED KIB ADDRESSES C4000063 DATA TOTREC/0,0/, KIBM/12*0/, KIBL/2,11*0/ C4000064C MAX. NO. OF LEVELS C4000065 DATA MAXLEV/ 12/ C4000066C MAXIMUM SIZE OF KIBS IF NOT 96 WDS. PER SECTOR C4000067 DATA MAXSIZ/ 572/ C4000068 INTEGER SAVBUF(8) C4000069 DATA LDIXOD/ 0/ C4000070 DATA KSHIFT/ 1, $100/, KMSKBT/ $FF00, 0/ C4000071ÐÐC WRITE INDEXED CODE C4000072 INTEGER WRTCOD C4000073 DATA WRTCOD/$C/ C4000074 DATA MAXRED/0/ C4000075 DATA K3SRWD/ 288/ C4000076 DATA SECLEN/ 96/ C4000077 DATA KISSAV/ 17*0/ C4000078C PRE-SET REL. RECORD NO. TO 1 C4000079 DATA IRRN/ 0, 1/ C4000080 DATA IEXIT/0/ C4000081+ 127*5124C4000082C ***** 138*A030C4000083 DATA IDEFER/0/ C4000084C ***** 138*A030C4000085C C4000086C C4000087C FIRST, CLEAR OUT RECBUF AND KIBBUF C4000088C C4000089 DO 100 I = 1, IRBLEN C4000090 100 RECBUF(I) = 0 C4000091 DO 110 I = 1, IKBLEN C4000092 110 KIBBUF(I) = 0 C4000093C C4000094C*** PROGRAM ABORT REQUEST SET-UP C4000095C C4000096ÐÐ LDIXOD = 0 C4000097 IDONE = 0 C4000098 IRECD = 0 C4000099 I = 0 C4000100 ASSIGN 3000 TO INTLOC C4000101 CALL PGMINT( INTLOC, I) C4000102C C4000103C**** SAVE LOGICAL UNIT AND DATA TYPE C4000104C C4000105 LOGUNT = IDATA( 14) C4000106 IDATYP = IDATA( 15) C4000107C ***** 138*A030C4000108C C4000109C SAVE INPUT LENGTH FOR RECORD READS C4000110C C4000111 INPLEN = IDATA(16) C4000112C ***** 138*A030C4000113C C4000114C C4000115C OPEN FILE C4000116C C4000117 IDATA(13) = -2 C4000118 IDATA(15) = 0 C4000119 IDATA(14) = 1 C4000120 REQBUF(13) = 96 C4000121ÐÐ ASSEM $C000,+FCBHDR C4000122+ LDA =XFCBHDR C4000123 ASSEM $6400,+REQBUF(10) C4000124+ STA* REQBUF+9 C4000125 CALL OPENFL(REQBUF(1), IDATA( 1), ISTAT) C4000126 IF (ISTAT .LT. 0) GO TO 8000 C4000127C C4000128C SET UP WORDS PER SECTOR AND LENGTH C4000129C C4000130 CALL GETSSZ (FCBHDR, SECLEN) C4000131C C4000132C C4000133 IF (SECLEN .EQ. 96) GO TO 111 C4000134C C4000135C SECTOR LENGTH NOT 96 SO COMPUTE KIB C4000136C LENGTH AND NUMBER OF LEVELS POSSIBLE. C4000137C C4000138 KIBSEC = MAXSIZ / SECLEN C4000139 K3SRWD = KIBSEC * SECLEN C4000140 MAXLEV = IKBLEN / K3SRWD C4000141C C4000142 111 CONTINUE C4000143 ISPECL = FCBBUF(6) C4000144 FCBBUF(6) = AND($7FFE, FCBBUF(6)) C4000145C C4000146ÐÐC ** SET NUMBER OF 'KIB' LEVEL STUFF C4000147C C4000148 KIBL = 2 C4000149 DO 112 I = 17, 22 , 2 C4000150 IF ( FCBBUF(I) .EQ. 0) GO TO 113 C4000151 KIBL = KIBL + 1 C4000152 112 CONTINUE C4000153 113 CONTINUE C4000154 NXTKIB( 2) = KIBL + 1 C4000155C C4000156C COMPUTE NUMBER OF RECORDS PER READ OF DATA FILE AND RESET C4000157C NUMBER IN REQBUF C4000158C C4000159 ISECLN = RECLEN C4000160 NRECS = IRBLEN / RECLEN C4000161 IF ( AND( ISPECL , $8000) .EQ. 0) GO TO 115 C4000162 NUMSEC = RECLEN / SECLEN C4000163 IF ( (NUMSEC * SECLEN) .LT. RECLEN) NUMSEC = NUMSEC + 1 C4000164 NRECS = IRBLEN / (SECLEN * NUMSEC) C4000165 ISECLN = SECLEN * NUMSEC C4000166 115 CONTINUE C4000167 IDATA(14) = NRECS C4000168 REQBUF(13) = NRECS C4000169 IDASAV = 1 C4000170C C4000171ÐÐC COMPUTE NUMBER OF KISES PER KIB C4000172C C4000173 KISLEN = (LENKY1 + 1) / 2 + 2 C4000174 MAXKIS = (K3SRWD - 6) / KISLEN C4000175C PACK 3/4 FULL SO READJUST NUMBER OF KIBS C4000176C C4000177 NUMKIS = (MAXKIS*3)/4 C4000178C C4000179C ************************************************** C4000180C C4000181C SAVE FIRST 8 FCB WORDS FOR RESTORE AND ONGOING USE C4000182C C4000183 DO 140 I = 1 , 6 C4000184 140 SAVBUF(I) = FCBBUF(I) C4000185C C4000186C SET UP KIB TYPE FOR FIRST KIB C4000187C C4000188 KIBBUF(6) = 2 C4000189C C4000190C SET UP KIB TYPE FOR INTERMIDIATE LEVEL KIBS. HIGHEST LEVEL C4000191C KIB TYPE WORD WILL BE RESET LATER. C4000192C C4000193 DO 150 I = 2, MAXLEV C4000194 IDX = (I-1) * K3SRWD + 6 C4000195 150 KIBBUF(IDX) = 1 C4000196ÐÐ LRELRD( 1) = 0 C4000197 LRELRD( 2) = 0 C4000198C INSERT FIRST KIS IN KIB AND SET NO. OF KIBS TO 1 127*5124C4000199C ALL 0,S KEY / RRN = -1,0 127*5124C4000200 KIBBUF(KISLEN+5) = -1 C4000201+ 127*5124C4000202 KIBBUF(1) = 1 C4000203+ 127*5124C4000204C C4000205C** FILL INPUT BUFFER WITH SPACE CODES C4000206C C4000207 180 CONTINUE C4000208 DO 185 LFL = 1 , IRBLEN C4000209 RECBUF(LFL) = $2020 C4000210 185 CONTINUE C4000211C C4000212C ************************************************** C4000213C C4000214C C4000215C C4000216C READ UNIT RECORD AND DO BLOCKING OF DATA C4000217C C4000218C C4000219 200 CONTINUE C4000220C ***** 138*A030C4000221ÐÐC RESET NO. OF CHARACTERS RECEIVED IN RECBUF(RECLEN+1) (SET BY C4000222C THE ITOS EXEC) TO BLANKS. THIS IS NOT MEANINGFUL THE FIRST C4000223C TIME THRU. 136*A037C4000224 RECBUF(IDASAV) = $2020 C4000225 CALL REDREC (LOGUNT,INPLEN, RECBUF(IDASAV), ISTAT) C4000226C C4000227C REBLANK 1ST WORD BEYOND LAST RECORD INPUT (MAY HAVE BEEN RESETC4000228C BY THE EXEC) C4000229C C4000230 IDD = IDASAV + INPLEN C4000231 RECBUF(IDD) = $2020 C4000232C ***** 138*A030C4000233 IF (ISTAT .GE. 0) GO TO 210 C4000234C ***** 138*A030C4000235C IF NO RECORDS READ, GO TO 9150 136*A056C4000236C 136*A056C4000237 IF (IRRN(1).EQ.0 .AND. IRRN(2).EQ.1) GO TO 9150 C4000238C ***** 138*A030C4000239 205 CONTINUE C4000240 IDONE = 1 C4000241 IF (IRECD .NE. 0) GO TO 304 C4000242 GO TO 307 C4000243+ 127*5124C4000244C C4000245C CHECK IF EBCDIC CONVERSION REQUIRED C4000246ÐÐC C4000247 210 CONTINUE C4000248 IF (MAXRED.EQ.0) GO TO 220 C4000249 MAXRED = 2 C4000250 GO TO 205 C4000251 220 IF (IDATYP .EQ. 1) CALL ASCEBC(RECBUF(IDASAV), IDATYP, RECLEN) C4000252C C4000253C PROCESS EACH RECORD FROM THE INPUT BUFFER C4000254C C4000255C C4000256 230 CONTINUE C4000257 ISTART = IDASAV C4000258C C4000259C EXTRACT KEY FROM RECORD AND STORE IN KISBUF C4000260C (CODE FROM XTKEY PGM OF FM) C4000261C C4000262 FRSTBY = FCBBUF(16) C4000263 LASTBY = FRSTBY + FCBBUF(15) - 1 C4000264 I1 = 0 C4000265 DO 280 I = FRSTBY, LASTBY C4000266 J = (I+1)/2 C4000267 IDX = J + ISTART - 1 C4000268 I1 = I1 + 1 C4000269 J1 = (I1+1) / 2 C4000270 LSHIFT = 1 + AND(I , 1) C4000271ÐÐ IBYTE = AND( (RECBUF(IDX) / KSHIFT(LSHIFT)) , $FF) C4000272 LSHIFT = 1 + AND(I1 , 1) C4000273 KISBUF(J1) = AND (KISBUF(J1) , KMSKBT(LSHIFT) ) + IBYTE * C4000274 1 KSHIFT(LSHIFT) C4000275 280 CONTINUE C4000276C C4000277C CHECK TO ASSURE CURRENT KIS HAS GREATER KEY THAN PREVIOUS C4000278C C4000279 IEND = KISLEN - 2 C4000280 DO 285 I = 1, IEND C4000281C ***** 138*A030C4000282 IF (KISBUF(I)-KISSAV(I)) 287,285,290 C4000283 285 CONTINUE C4000284C C4000285C DUPLICATE OR SMALLER KEY NOTED. SET DEFERED ERROR FLAG. C4000286C C4000287 287 IDEFER = 1 C4000288 GO TO 205 C4000289C ***** 138*A030C4000290C C4000291C SET KIB LEVEL TO 1 C4000292C C4000293 290 ILEV = 1 C4000294C C4000295C CHECK IF SEQ SET KIB HAS ROOM FOR KIS. IF NO, GO TO 400 C4000296ÐÐC C4000297 IF (KIBBUF(1).EQ.NUMKIS) GO TO 400 C4000298C C4000299C INSERT RRN CURRENT RECORD INTO KISBUF C4000300C C4000301 295 KISBUF(KISLEN-1) = IRRN(1) C4000302 KISBUF(KISLEN) = IRRN(2) C4000303C C4000304C INSERT KIS INTO LOWEST LEVEL KIB AND BUMP NO. OF KISES IN KIB C4000305C C4000306 IDX = KIBBUF(1) * KISLEN + 6 C4000307 DO 300 I = 1, KISLEN C4000308 IWORD = I + IDX C4000309 KIBBUF(IWORD) = KISBUF(I) C4000310C C4000311C ALSO SAVE THIS KIS C4000312C C4000313 KISSAV(I) = KISBUF(I) C4000314 300 CONTINUE C4000315 KIBBUF(1) = KIBBUF(1) + 1 C4000316C C4000317C BUMP RRN BY 1 C4000318C C4000319 CALL BMPRRN (IRRN) C4000320C C4000321ÐÐC CHECK IF ALL DONE. IF NOT, GO PROCESS NEXT RECORD. C4000322C C4000323 IF (IDONE .NE. 0) GO TO 307 C4000324+ 127*5124C4000325C C4000326C***** UPDATE STORAGE, RECORD COUNT C4000327C C4000328 CALL BMPRRN (TOTREC) C4000329 IDASAV = IDASAV + ISECLN C4000330 IRECD = IRECD + 1 C4000331C C4000332C CHECK IF ALL RECORDS BEEN READ C4000333C C4000334 IF(TOTREC(1).EQ.FCBBUF(2).AND.TOTREC(2).EQ.FCBBUF(3)) MAXRED=1 C4000335C C4000336C CHECK IF BUFFER IS FULL C4000337C C4000338 IF (IRECD .LT. NRECS) GO TO 200 C4000339 304 CONTINUE C4000340 FCBBUF(6) = AND($FFFE , ISPECL) C4000341 CALL PUTS( REQBUF( 1), RECBUF( 1), IRECD, ISTAT) C4000342 FCBBUF(6) = AND($7FFE , ISPECL) C4000343 IRECD = 0 C4000344 IDASAV = 1 C4000345 IF (ISTAT .GE. 0) GO TO 306 C4000346ÐÐ CALL ERCHK( ISTAT, REQBUF( 4) ) C4000347 GO TO 3000 C4000348 306 CONTINUE C4000349 IF (IDONE .EQ. 0) GO TO 180 C4000350 307 CONTINUE C4000351+ 127*5124C4000352C 127*5124C4000353C NEW LAST KIS MUST BE ADDED (TO BE CONSISTANT WITH FM 127*5124C4000354C BUILD INDEX) - ALL F,S KEY / RRN = -2,0 127*5124C4000355C 127*5124C4000356C CHECK IF SUFFICIENT ROOM IN SEQ SET KIB 127*5124C4000357C 127*5124C4000358 IF (KIBBUF(1) .LT. NUMKIS) GO TO 308 C4000359+ 127*5124C4000360 IEXIT = 1 C4000361+ 127*5124C4000362 GO TO 400 C4000363+ 127*5124C4000364C 127*5124C4000365C INSERT THE KIS AND BUMP NUMBER OF KISES 127*5124C4000366C 127*5124C4000367 308 IDX = KIBBUF(1) *KISLEN + 6 C4000368+ 127*5124C4000369 DO 309 I = 1, KISLEN C4000370+ 127*5124C4000371ÐÐ IWORD = I + IDX C4000372+ 127*5124C4000373 309 KIBBUF(IWORD) = $FFFF C4000374C ***** 138*A030C4000375 KIBBUF(IWORD) = 0 C4000376 KIBBUF(IWORD-1) = -2 C4000377C ***** 138*A030C4000378 KIBBUF(1) = KIBBUF(1) + 1 C4000379+ 127*5124C4000380C C4000381C SET NEXT SEQ SET POINTER TO 0,0 C4000382C C4000383 KIBBUF(2) = 0 C4000384 KIBBUF(3) = 0 C4000385C C4000386C DETERMINE HIGHEST LEVEL USED C4000387C C4000388 DO 310 I = 2,6 C4000389 NUMLEV = I C4000390 IDX = (I-1) * K3SRWD C4000391 IF (KIBBUF(IDX+1).NE.0) GO TO 310 C4000392 NUMLEV = NUMLEV-1 C4000393 GO TO 320 C4000394 310 CONTINUE C4000395C C4000396ÐÐC IF ONLY ONE LEVEL OF KIBS, GO TO 500 FOR SPECIAL PROCESSING C4000397 320 CONTINUE C4000398 IF (NUMLEV.EQ.1) GO TO 500 C4000399C C4000400C SET KIB TYPE OF TOP KIB TO 0 (FOR ROOT) C4000401C C4000402 IDX = (NUMLEV-1) * K3SRWD C4000403 KIBBUF(IDX+6) = 0 C4000404C C4000405C UPDATE EACH KIB FROM LEVEL 2 THRU NUMLEV TO POINT TO LOWER C4000406C LEVEL KIB C4000407C C4000408 DO 340 I = 2, NUMLEV C4000409C C4000410C UPDATE KISBUF TO POINT TO LOWER LEVEL KIB C4000411C C4000412 KISBUF(KISLEN-1) = KIBM(I-1) C4000413 KISBUF(KISLEN) = KIBL(I-1) C4000414C C4000415C STORE KIS IN KIB AND BUMP NO. OF KISES IN KIB C4000416C C4000417 IDX = (I-1) * K3SRWD C4000418 IDXX = (KIBBUF(IDX+1)*KISLEN) + 6 + IDX C4000419 DO 330 J = 1, KISLEN C4000420 K = IDXX + J C4000421ÐÐ 330 KIBBUF(K) = KISBUF(J) C4000422 KIBBUF(IDX+1) = KIBBUF(IDX+1) + 1 C4000423 340 CONTINUE C4000424C C4000425C SET KIB ADDRESS FOR ROOT KIB C4000426C C4000427 KIBM(NUMLEV) = 0 C4000428 KIBL(NUMLEV) = 1 C4000429C C4000430C ASSURE SUPERIOR KIB POINTER FOR ROOT IS CLEAR C4000431 IDX = (NUMLEV-1) * K3SRWD C4000432 KIBBUF(IDX+4) = 0 C4000433 KIBBUF(IDX+5) = 0 C4000434C C4000435C WRITE OUT EACH OF THE NUMLEV KIBS C4000436C C4000437 ASSIGN 350 TO IRETRN C4000438 DO 350 I = 1, NUMLEV C4000439 ILEV = I C4000440 GO TO 1000 C4000441 350 CONTINUE C4000442C C4000443C ALL SECOND LEVEL (DOWN FROM TOP) KIBS MUST BE UPDATED TO C4000444C POINT TO ROOT IN FIRST KIB POSITION. C4000445C C4000446ÐÐ IDX = (NUMLEV-1) * K3SRWD C4000447 IEND = KIBBUF(IDX+1) C4000448 DO 370 I = 1, IEND C4000449C C4000450C SET KIB RKN THEN READ IN THE KIB (INTO KIB 1 POSITION) C4000451C C4000452 IOFSET = IDX + 5 + (I-1) * KISLEN + KISLEN C4000453 KIBM(1) = KIBBUF(IOFSET) C4000454 KIBL(1) = KIBBUF(IOFSET+1) C4000455 ILEV = 1 C4000456 ASSIGN 360 TO IRETRN C4000457 GO TO 1500 C4000458C C4000459C UPDATE THE SUPERIOR KIB POINTER TO POINT TO ROOT - THEN C4000460C WRITE KIB BACK TO FILE C4000461C C4000462 360 KIBBUF(4) = 0 C4000463 KIBBUF(5) = 1 C4000464 ASSIGN 370 TO IRETRN C4000465 GO TO 1000 C4000466 370 CONTINUE C4000467C C4000468C RESTORE 1ST 8 WORDS OF FCB FROM SAVBUF AND SET NEXT KIB C4000469C POINTER TO NXTKIB C4000470C C4000471ÐÐ 375 DO 380 I = 1,8 C4000472 380 FCBBUF(I) = SAVBUF(I) C4000473 FCBBUF(9) = NXTKIB(1) C4000474 FCBBUF(10) = NXTKIB(2) C4000475 FCBBUF(6) = ISPECL C4000476C C4000477C IF MAXED=2, OUTPUT ERROR MESSAGE C4000478 IF (MAXRED.EQ.2) CALL ERCHK ($9000,WRTCOD) C4000479 CALL CLOSFL( REQBUF(1), ISTAT) C4000480 IF (ISTAT .LT. 0) GO TO 8000 C4000481C ***** 138*A030C4000482C C4000483C CHECK IF DEFERED ERROR FLAG SET C4000484C C4000485 IF (IDEFER.EQ.1) CALL SYSMSG (83,0) C4000486C ***** 138*A030C4000487C C4000488C******* CALL RANDOM INDEXED FILE PROCESSOR TO FINISH THE JOB C4000489C IF THERE ARE 2 KEYS C4000490C C4000491 LDIXOD = 2 C4000492 IDATA(13) = 2 C4000493 IDATA(14) = LOGUNT C4000494 IDATA(15) = IDATYP C4000495 IF (FCBBUF(17) .EQ. 0) LDIXOD = 0 C4000496ÐÐ RETURN C4000497C C4000498C ****************************************************** C4000499C C4000500C C4000501C KIB WAS FULL (AS MUCH AS PERMITTED). C4000502C BUMP TO NEXT LEVEL AND MAKE ENTRY FOR LOWER LEVEL C4000503C C4000504 400 ILEV = ILEV + 1 C4000505C C4000506C ASSURE LEVEL NOT TOO HIGH C4000507C C4000508 IF (ILEV .LE. MAXLEV) GO TO 405 C4000509 INDEX = 82 C4000510 GO TO 9100 C4000511C C4000512C COMPUTE INDEX TO THIS LEVELS KIB C4000513C C4000514 405 IOFSET = (ILEV-1) * K3SRWD C4000515C C4000516C CHECK IF KIB SPACE HAS BEEN ASSIGNED YET C4000517C C4000518 IF (KIBBUF(IOFSET+1) .NE. 0) GO TO 408 C4000519C C4000520C ASSIGN SPACE AND BUMP NXTKIB C4000521ÐÐC C4000522 KIBM(ILEV) = NXTKIB(1) C4000523 KIBL(ILEV) = NXTKIB(2) C4000524 CALL BMPRRN (NXTKIB) C4000525C C4000526C CHECK IF ROOM EXISTS IN KIB FOR ANOTHER KIS C4000527C C4000528 408 IF (KIBBUF(IOFSET+1).LT.NUMKIS) GO TO 410 C4000529C C4000530C CHECK IF THIS IS THE HIGHEST LEVEL KIB C4000531C C4000532 IF (ILEV .NE. MAXLEV) GO TO 400 C4000533C C4000534C IS THERE ROOM IN ROOT KIB - IF SO, USE IT. C4000535C C4000536C C4000537 IF (KIBBUF(IOFSET+1).LE.MAXKIS) GO TO 410 C4000538C C4000539C INDEX TOO BIG FOR UTILITY (ORDERED LOAD) C4000540C C4000541 INDEX = 82 C4000542 GO TO 9100 C4000543C C4000544C COMPUTE NEW OFFSET FOR STORE OF KIS C4000545C C4000546ÐÐ 410 NEWOST = IOFSET + 6 + KIBBUF(IOFSET+1) * KISLEN C4000547C C4000548C USE KIS KEY FROM LAST KIS IN NEXT LOWER LEVEL KIB C4000549C C4000550 IDX = (ILEV-2) * K3SRWD C4000551 IDXX = IDX + 6 + (KIBBUF(IDX+1)-1) * KISLEN C4000552 DO 420 I = 1,KISLEN C4000553 ISTOR = NEWOST + I C4000554 ILOAD = IDXX + I C4000555 KIBBUF(ISTOR) = KIBBUF(ILOAD) C4000556 420 CONTINUE C4000557C C4000558C BUMP NO. OF KISES IN KIB C4000559C C4000560 KIBBUF(IOFSET+1) = KIBBUF(IOFSET+1) + 1 C4000561C C4000562C STORE LOWER LEVEL KIB POINTER INTO KIS C4000563C C4000564 KIBBUF(ISTOR-1) = KIBM(ILEV-1) C4000565 KIBBUF(ISTOR) = KIBL(ILEV-1) C4000566C C4000567C THIS LEVEL IS FINISHED FOR NOW. DROP LEVELS. C4000568C C4000569 ILEV = ILEV - 1 C4000570C C4000571ÐÐC STORE SUPERIOR KIB POINTER INTO KIB C4000572C C4000573 NEWOST = (ILEV-1) * K3SRWD C4000574 KIBBUF(NEWOST+4) = KIBM(ILEV+1) C4000575 KIBBUF(NEWOST+5) = KIBL(ILEV+1) C4000576C C4000577C IF THIS IS SEQ SET KIB, SET BROTHER KIB POINTER C4000578C C4000579 IF (ILEV.NE.1) GO TO 430 C4000580 KIBBUF(2) = NXTKIB(1) C4000581 KIBBUF(3) = NXTKIB(2) C4000582C C4000583C GO STORE THIS LEVELS KIB C4000584C C4000585 430 ASSIGN 440 TO IRETRN C4000586 GO TO 1000 C4000587C C4000588CC IF THIS IS SEQ SET KIB, BUMP NXTKIB AND SET KIB ADDRESS TO C4000589C LAST BROTHER POINTER C4000590C C4000591 440 IF (ILEV.NE.1) GO TO 445 C4000592 CALL BMPRRN (NXTKIB) C4000593 KIBM(1) = KIBBUF(2) C4000594 KIBL(1) = KIBBUF(3) C4000595C C4000596ÐÐC CLEAR NO. OF KISES AND KIS PART OF KIB C4000597C C4000598 445 KIBBUF(NEWOST+1) = 0 C4000599 DO 450 I = 1, 282 C4000600 IDX = NEWOST + 6 + I C4000601 450 KIBBUF(IDX) = 0 C4000602C C4000603C IF WE ARE NOW AT SEQ SET LEVEL, GO TO 295, ELSE GO TO 405 C4000604C C4000605C IF WE ARE NOT AT SEQ SET LEVEL, GO TO 405. ELSE 127*5124C4000606C GO TO 295 OR 308 (308 IF IEXIT .NE. 0) 127*5124C4000607C 127*5124C4000608 IF (ILEV.NE.1) GO TO 405 C4000609+ 127*5124C4000610 IF (IEXIT.EQ.0) GO TO 295 C4000611+ 127*5124C4000612 GO TO 308 C4000613+ 127*5124C4000614C C4000615C ************************************************** C4000616C C4000617C ONLY ONE KIB HAS BEEN GENERATED. MAKE THE APPROPRIATE ROOT C4000618C KIB AND UPDATE THE SEQUENCE SET KIB APPROPRIATELY. C4000619C C4000620C FIRST, SET UP THE HEADER FOR THE ROOT KIB. WORDS 2-6 ALL 0. C4000621ÐÐC C4000622 500 KIBBUF(K3SRWD + 1) = 1 C4000623C ***** 1 CARD DELETED 138*A030C4000624C C4000625C SET UP THE HEADER OF THE SEQUENCE SET KIB. C4000626C C4000627 KIBBUF(5) = 1 C4000628C C4000629C PUT ONE KIS INTO THE SEQUENCE SET KIB C4000630C C4000631 IDX = 6 + (KIBBUF(1)-1) * KISLEN C4000632 DO 510 I = 1, KISLEN C4000633 ILOAD = IDX + I C4000634 ISTORE = K3SRWD + 6 + I C4000635 510 KIBBUF(ISTORE) = KIBBUF(ILOAD) C4000636 KIBBUF(ISTORE-1) = KIBM(1) C4000637 KIBBUF(ISTORE) = KIBL(1) C4000638C C4000639C SET KIBM/KIBL TO DEFINE THE ROOT KIB C4000640C C4000641 KIBL(2) = 1 C4000642C C4000643C WRITE OUT THE TWO KIBS C4000644C C4000645 ASSIGN 520 TO IRETRN C4000646ÐÐ DO 520 ILEV = 1,2 C4000647 GO TO 1000 C4000648 520 CONTINUE C4000649 GO TO 375 C4000650C C4000651C C4000652C-------------------------------------------------------------------- C4000653C C4000654C PROGRAM ABORT PROGRAM ABORT C4000655C PROGRAM ABORT PROGRAM ABORT C4000656C C4000657C C4000658 3000 CONTINUE C4000659C ***** 1 RECORD DELETED 138*A030C4000660C C4000661C** CHECK IF ANY RECORD EVER READ C4000662C C4000663 IF ( (TOTREC( 1) .EQ. 0) .AND. (TOTREC( 2) .EQ. 0)) GO TO 9150 C4000664C ***** 138*A030C4000665 GO TO 205 C4000666C ***** 138*A030C4000667C C4000668C ************************************************** C4000669C C4000670C ERROR MESSAGES C4000671ÐÐC C4000672C C4000673C F-M REQUEST ERROR C4000674C C4000675 8000 CONTINUE C4000676 CALL ERCHK( ISTAT, REQBUF( 4) ) C4000677 GO TO 9150 C4000678C ***** 4 RECORDS DELETED 138*A030C4000679 9100 CONTINUE C4000680 CALL SYSMSG( INDEX, 0) C4000681C ***** 138*A030C4000682 GO TO 9160 C4000683C C4000684C ALSO USED FOR EXIT IF NO RECORDS READ 136*A056C4000685C C4000686C ***** 138*A030C4000687 9150 CONTINUE C4000688 FCBBUF(6) = ISPECL C4000689 CALL CLOSFL( REQBUF, ISTAT) C4000690 9160 LDIXOD = 0 C4000691 RETURN C4000692C C4000693C ************************************************** C4000694C C4000695C INTERNAL SUBROUTINE C4000696ÐÐC C4000697C THIS ROUTINE CHANGES THE FCB SO THAT A KIB CAN BE STORED C4000698C INTO THE KIB SPACE FOR THE FILE, STORES THE KIB AND THEN C4000699C RESETS THE FCB BACK TO THE ORIGINAL STATE. C4000700C THE KIB TO BE WRITTEN OUT IS IN POSITION ILEV IN KIBBUF. C4000701C C4000702 1000 CONTINUE C4000703 SAVBUF(7) = FCBBUF(7) C4000704 SAVBUF(8) = FCBBUF(8) C4000705 FCBBUF(1) = K3SRWD C4000706 FCBBUF(2) = FCBBUF(11) C4000707 FCBBUF(3) = FCBBUF(12) C4000708 FCBBUF(4) = FCBBUF(13) C4000709 FCBBUF(5) = FCBBUF(14) C4000710 FCBBUF(7) = FCBBUF(11) C4000711 FCBBUF(8) = FCBBUF(12) C4000712C C4000713C SAVE REQBUF WORDS 15-20 C4000714C C4000715 DO 1005 N = 1,6 C4000716 1005 ISAVE(N) = REQBUF(N+14) C4000717C C4000718C CHANGE THE REQBUF TO REFLECT RETRIEVAL OF THE KIB AS A RECORD.C4000719C C4000720 REQBUF(15) = 1 C4000721ÐÐ REQBUF(16) = KIBM(ILEV) C4000722 REQBUF(17) = KIBL(ILEV) C4000723C C4000724C STORE THE KIB VIA AN UPDATE RECORD REQUEST C4000725C C4000726 IDDX = 1 + (ILEV-1) * K3SRWD C4000727 CALL UPDREC (REQBUF,KIBBUF(IDDX),ISTAT) C4000728C C4000729C RESTORE REQBUF WORDS 15-20 C4000730C C4000731 DO 1015 N = 1,6 C4000732 1015 REQBUF(N+14) = ISAVE(N) C4000733C C4000734C RESTORE THE FCB AND RETURN C4000735C C4000736 DO 1010 N = 1 , 8 C4000737 1010 FCBBUF(N) = SAVBUF(N) C4000738 IF (ISTAT.LT.0) GO TO 8000 C4000739 GO TO IRETRN C4000740C C4000741C ************************************************** C4000742C C4000743C INTERNAL SUBROUTINE C4000744C C4000745C C4000746ÐÐC THIS ROUTINE CHANGES THE FCB SO THAT A KIB CAN BE READ VIA C4000747C A READR REQUEST, READS THE KIB AND THEN RESETS THE FCB BACK C4000748C TO THE ORIGINAL STATE. C4000749C THE KIB TO BE READ WILL BE IN POSITION ILEV IN KIBBUF. C4000750C C4000751 1500 CONTINUE C4000752 SAVBUF(7) = FCBBUF(7) C4000753 SAVBUF(8) = FCBBUF(8) C4000754 FCBBUF(1) = K3SRWD C4000755 FCBBUF(2) = FCBBUF(11) C4000756 FCBBUF(3) = FCBBUF(12) C4000757 FCBBUF(4) = FCBBUF(13) C4000758 FCBBUF(5) = FCBBUF(14) C4000759 FCBBUF(7) = FCBBUF(11) C4000760 FCBBUF(8) = FCBBUF(12) C4000761C C4000762C SAVE CURRENT WORDS 15-20 OF REQBUF, THEN RESET REQBUF(13) TO 1C4000763C C4000764C C4000765 DO 1505 N = 1,6 C4000766 1505 ISAVE(N) = REQBUF(N+14) C4000767 REQBUF(13) =1 C4000768C C4000769C STORE KIB NUMBER FOR THE READ C4000770C C4000771ÐÐ ITEMP1(1) = KIBM(ILEV) C4000772 ITEMP1(2) = KIBL(ILEV) C4000773C C4000774C READ THE RECORD C4000775C C4000776 IDXX = 1 + (ILEV-1) * K3SRWD C4000777 CALL READR (REQBUF,KIBBUF(IDXX),ITEMP1,ISTAT) C4000778C C4000779C RESTORE THE FCB AND REQBUF C4000780C C4000781 DO 1510 N = 1 , 8 C4000782 1510 FCBBUF(N) = SAVBUF(N) C4000783 DO 1515 N = 1,6 C4000784 1515 REQBUF(N+14) = ISAVE(N) C4000785 REQBUF(13) = NRECS C4000786 IF (ISTAT.LT.0) GO TO 8000 C4000787 GO TO IRETRN C4000788 END C4000789 SUBROUTINE FLHXLR(LBUF,LDAT,LSIZ) C4100001 1 /C41 F ITOS CCS 3.0 SL-149C4100002C DATA ASSEMBLY ROUTINE C4100003C CREDIT COLLECTION SYSTEM VERSION 3.0 C4100004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C4100005C COPYRIGHT CONTROL DATA CORPORATION 1979 C4100006C C4100007ÐÐC ************************************************ C4100008C * * C4100009C * ROUTINE TO ASSEMBLE DATA INTO BUFFER * C4100010C * --FORMAT (/, 1X, 20($4, 1X))-- * C4100011C * * C4100012C ************************************************ C4100013C C4100014C C4100015CCCCC CALLING PARAMETERS : C4100016C C4100017C LBUF = OUTPUT DATA BUFFER C4100018C LDAT = DATA TO BE CONVERTED C4100019C LSIZ = DATA SIZE C4100020C C4100021C C4100022CCCC ROUTINE FUNCTION : C4100023C C4100024C BACKGROUND OUTPUT BUFFER WITH SPACE CODE AND INSERT C4100025C CR/LF. THEN CONVERT DATA ACCORDING TO THIS FORMAT C4100026C ( 20($4, 1X) ) C4100027C C4100028C C4100029C C4100030C---- --- DESCRIPTION OF VARIABLES ---- C4100031C C4100032ÐÐC K2SPA = 2 SPACE CODES C4100033C KCRLF = CARRIAGE RETURN AND LINE FEED C4100034C C4100035C LVAL = WORKING BUFFER C4100036C LFETH = FETCH DATA INDEX C4100037C LOTPT = OUTPUT BUFFER INDEX C4100038C NOCHAR = NO. OF CHARACTERS TO BE INSERT (4 OR 5 ,LEFT/RIGHT) C4100039C C4100040C C4100041C C4100042C**** * CALLING PARAMETER ARRAYS : C4100043C C4100044 DIMENSION LBUF(52),LDAT(20),LMESB(50) C4100045C C4100046 EQUIVALENCE (LMESB,LBUF( 1)) C4100047C C4100048C**** * LOCAL ARRAY : C4100049C C4100050 DIMENSION LVAL( 5) C4100051C C4100052C**** * PRE-SET VARIABLES C4100053C C4100054 DATA K2SPA/ $2020/, KCRLF/ $0D0A/ C4100055C C4100056C C4100057ÐÐC**** ***** P R O G R A M S T A R T ***** C4100058C C4100059C C4100060C FILL BUFFER WITH SPACE CODE C4100061C C4100062 DO 50 LFETH = 1, 51 C4100063 LBUF(LFETH) = K2SPA C4100064 50 CONTINUE C4100065 LBUF(51) = KCRLF C4100066C C4100067C INITIALIZE POINTERS C4100068C C4100069 LFETH = 1 C4100070 LOTPT = 1 C4100071C C4100072C*** GET VALUE AND CONVERT TO HEX-DECIMAL. THEN STORE INTO OUTPUT C4100073C BUFFER C4100074C C4100075 100 CONTINUE C4100076 LVAL( 1) = LDAT(LFETH) C4100077 CALL FRHX(LVAL( 1)) C4100078 LVAL( 1) = $20 C4100079 LPOS = 2 - AND(1, LFETH) C4100080 NOCHAR = 6 - LPOS C4100081 CALL BLD2(LVAL(LPOS), LMESB(LOTPT), NOCHAR) C4100082ÐÐC C4100083C UPDATE POINTER AND CHECK IF DONE C4100084C C4100085 LOTPT = LOTPT + 2 + AND(1, LFETH) C4100086 IF (LFETH .GE. LSIZ) RETURN C4100087 LFETH = LFETH + 1 C4100088 GO TO 100 C4100089 END C4100090 SUBROUTINE FL2SP(MES2,MSIZ) C4200001 1 /C42 F ITOS CCS 3.0 SL-149C4200002C ROUTINE USED TO FILL AN ARRAY C4200003C CREDIT COLLECTION SYSTEM VERSION 3.0 C4200004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C4200005C COPYRIGHT CONTROL DATA CORPORATION 1979 C4200006C C4200007C ******************************************************* C4200008C * * C4200009C * ROUTINE TO FILL ARRAY (42 WORDS) WITH SPACE * C4200010C * * C4200011C ******************************************************* C4200012C C4200013C C4200014CCCCC CALLING PARAMETER : C4200015C C4200016C MSIZ = SIZE OF ARRAY MES2 C4200017ÐÐC MES2 = ARRAY TO WHICH SPACE CODES ARE FILLED C4200018C C4200019C C4200020CCCCC ROUTINE FUNCTION : C4200021C C4200022C 2 SPACE CODES/WORD IS STORED INTO ARRAY 'MES2' C4200023C C4200024C C4200025CCCCC SUBROUTINE USED : C4200026C C4200027C NONE C4200028C C4200029C C4200030C---- --- DESCRIPTION OF VARIABLE C4200031C C4200032C K2SPAC = 2 SPACE CODES C4200033C C4200034C C4200035C**** * CALLING PARAMETER ARRAY : C4200036C C4200037C C4200038 DIMENSION MES2(42) C4200039C C4200040C**** * PRE-SET VARIABLE C4200041C C4200042ÐÐ DATA K2SPAC/ $2020/ C4200043C C4200044C C4200045C**** ***** P R O G R A M S T A R T ***** C4200046C C4200047C C4200048 DO 50 LOOP = 1, MSIZ C4200049 MES2(LOOP) = K2SPAC C4200050 50 CONTINUE C4200051 MES2(MSIZ) = $0D0A C4200052 RETURN C4200053 END C4200054 SUBROUTINE RDNP(IRCNT,LOGUNT,LINFD) C4300001 1 /C43 F ITOS CCS 3.0 SL-149C4300002C RECORD NUMBER ASSEMBLY ROUTINE C4300003C CREDIT COLLECTION SYSTEM VERSION 3.0 C4300004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C4300005C COPYRIGHT CONTROL DATA CORPORATION 1979 C4300006C C4300007C ************************************************* C4300008C * * C4300009C * ROUTINE TO ASSEMBLE RECORD NUMBER AND * C4300010C * PRINT * C4300011C * * C4300012C *****************************************'******* C4300013ÐÐC C4300014C C4300015CCCCC CALLING PARAMETERS : C4300016C C4300017C IRCNT = RECORD NUMBER C4300018C LOGUNT = PRINT LOGICAL UNIT C4300019C LINFD = LINE FEED FLAG (0 FOR NO LINE FEED, 1 FOR C4300020C LINE FEED AND 1 SPACE, 2 FOR NO LF/SP) C4300021C C4300022CCCCC ROUTINE FUNCTION : C4300023C C4300024C THIS ROUTINE ASSEMBLE THE RECORD NUMBER INTO 'I4' C4300025C FORMAT AND PRINT VIA THE REQUEST PRINT DEVICE. C4300026C C4300027C C4300028CCCCC MESSAGE FORMAT : C4300029C C4300030C ( /, 1X, 7HRECORD , I4 ) C4300031C C4300032C C4300033CCCCC SUBROUTINES USED : C4300034C C4300035C VLTOI = CONVERT VALUE TO I4 FORMAT C4300036C BLD2 = ASSEMBLE INTO 2 CHARACTERS/WORD C4300037C TOWT = TO PRINT MESSAGE C4300038ÐÐC C4300039C C4300040C---- --- DESCRIPTION OF VARIABLES --- C4300041C C4300042C MESS = MESSAGE BUFFER AND 'MES1' FOR RECORD NO. C4300043C KTEMP = WORKING ARRAY C4300044C MSIZ = SIZE OF 'MESS' ARRAY C4300045C C4300046C C4300047C C4300048C**** * LOCAL ARRAYS : C4300049C C4300050 DIMENSION KTEMP( 6),MESS(10),MES1( 2) C4300051C C4300052 EQUIVALENCE (MES1,MESS( 7)) C4300053C C4300054C**** * PRE-SET VARIABLES C4300055C C4300056 DATA MESS/ $0D0A, ' RECORD ', $0D0A/ C4300057C C4300058C C4300059C**** ***** P R O G R A M S T A R T ***** C4300060C C4300061C C4300062C CONVERT VALUE INTO A INTEGER DIGITS C4300063ÐÐC C4300064 MESS( 3) = $2052 C4300065 KTEMP( 1) = IRCNT C4300066 CALL VLTOI(KTEMP( 1)) C4300067 CALL BLD2(KTEMP( 3), MES1( 1) , 4) C4300068 I = 1 C4300069 IF (AND(1,LINFD) .EQ. 0) I = 3 C4300070 IF (LINFD .EQ. 2) MESS( 3) = $0052 C4300071 CALL TOWT(LOGUNT, MESS( I), 11-I) C4300072 RETURN C4300073 END C4300074 SUBROUTINE RIGJST(MSOUR,MTARG,NOCHA) C4400001 1 /C44 F ITOS CCS 3.0 SL-149C4400002C CHARACTER MOVE ROUTINE C4400003C CREDIT COLLECTION SYSTEM VERSION 3.0 C4400004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C4400005C COPYRIGHT CONTROL DATA CORPORATION 1979 C4400006C C4400007C *********************************************** C4400008C * * C4400009C * ROUTINE TO MOVE CHARACTER FROM LEFT * C4400010C * JUSTIFIED TO RIGHT JUSTIFIED WORD * C4400011C * * C4400012C *********************************************** C4400013C C4400014ÐÐC C4400015CCCCC CALLING PARAMETERS : C4400016C C4400017C MSOUR = SOURCE ARRAY (DATA TO BE MOVED FROM) C4400018C MTARG = TARGET ARRAY (DATA TO BE SAVED TO) C4400019C NOCHA = NO. OF CHARACTERS TO BE MOVED C4400020C C4400021C C4400022CCCCC ROUTINE FUNCTION : C4400023C C4400024C MOVE 2 CHARACTERS/WORD FROM SOURCE ARRAY TO TARGET C4400025C ARRAY. ALSO CHANGE THE SOURCE DATA FROM LEFT C4400026C JUSTIFIED TO RIGHT JUSTIFIED IN THE TARGET ARRAY. C4400027C C4400028C C4400029CCCCC LOCAL VARIABLES : C4400030C C4400031C MSKSHF = SOURCE AND TARGET SHIFT COUNTS C4400032C MSKBYT = TARGET CHARACTER SAVE MASK C4400033C LSOUR = SOURCE CHARACTER BYTE (0 = UPPER BYTE) C4400034C LTARG = TARGET CHARACTER BYTE (0 = UPPER BYTE) C4400035C LFETH = SOURCE ARRAY INDEX (WORD TO BE PROCESSED) C4400036C LSTOR = TARGET ARRAY INDEX C4400037C LCUNT = CURRENT CHARACTER COUNT C4400038C C4400039ÐÐC C4400040C C4400041C C4400042C***** ** CALLING PARAMETER ARRAYS : C4400043C C4400044 DIMENSION MSOUR(10),MTARG(10) C4400045C C4400046C***** ** LOCAL ARRAYS : C4400047C C4400048 DIMENSION MSKSHF(4),MSKBYT(2) C4400049C C4400050C--- PRE-SET VARIABLES C4400051C C4400052 DATA MSKSHF/ 256,1,1,256/, MSKBYT/ $00FF,$FF00/ C4400053C C4400054C C4400055C C4400056C**** ***** P R O G R A M S T A R T ***** C4400057C C4400058C C4400059C C4400060C INITIALIZE POINTERS C4400061C C4400062 LSOUR = 0 C4400063 LCUNT = 0 C4400064ÐÐ LTARG = 1 C4400065 LFETH = 1 C4400066 LSTOR = 1 C4400067C C4400068C EXTRACT SOURCE ARRAY CHARACTER AND INSERT INTO TARGET ARRAY C4400069C C4400070 50 CONTINUE C4400071 L1 = 2 * LSOUR + 1 C4400072 L2 = 2 * LTARG + 1 C4400073 LSCHA = AND( (MSOUR(LFETH) / MSKSHF(L1)) , $FF) C4400074 MTARG(LSTOR) = AND( MTARG(LSTOR) , MSKBYT(LTARG+1) ) + C4400075 1 LSCHA * MSKSHF(L2) C4400076C C4400077C UPDATE NO. OF CHARACTER COUNT AND CHECK IF DONE C4400078C C4400079 LCUNT = LCUNT + 1 C4400080 IF (LCUNT .GE. NOCHA) RETURN C4400081C C4400082C ADJUST ALL OTHER POINTERS (STORAG, BYTE, ETC.) C4400083C C4400084 LSOUR = AND(1, (LSOUR+1)) C4400085 IF (LSOUR .EQ. 0) LFETH = LFETH + 1 C4400086 LTARG = AND(1, (LTARG+1) ) C4400087 IF (LTARG .EQ. 0) LSTOR = LSTOR + 1 C4400088 GO TO 50 C4400089ÐÐ END C4400090 SUBROUTINE BATCHK C4500001 1 /C45 F ITOS CCS 3.0 SL-149C4500002C CHECK BATCH FILE FOR LEGAL FILE OWNER C4500003C CREDIT COLLECTION SYSTEM VERSION 3.0 C4500004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C4500005C COPYRIGHT CONTROL DATA CORPORATION 1979 C4500006C C4500007M FMUCOM C4500008C C4500009 INTEGER BATBUF(32), CPDAT(24) C4500010 INTEGER CPREQ(24) C4500011C C4500012C SET UP TO ACCESS BATCH FILE C4500013C C4500014 DO 10 I=1,24 C4500015 CPREQ(I)=0 C4500016 CPDAT(I)=PARDEF(I) C4500017 10 CONTINUE C4500018 CPDAT(1)=$2424 C4500019 CPDAT(2)=$4241 C4500020 CPDAT(3)=$5443 C4500021 CPDAT(4)=$4820 C4500022 CPDAT(5)=$2424 C4500023 CPDAT(9)=$5359 C4500024ÐÐ CPDAT(10)=$5356 C4500025 CPDAT(11)=$4F4C C4500026 CPDAT(13)=1 C4500027 CPDAT(14)=1 C4500028 CPDAT(15)=0 C4500029 CPREQ(13)=0 C4500030 CALL OPENFL(CPREQ,CPDAT,ISTAT) C4500031 IF(ISTAT)500,100,100 C4500032 100 CALL READR(CPREQ,BATBUF,IDATA(23),ISTAT) C4500033 IF(ISTAT)500,200,200 C4500034 200 DO 300 K=1,4 C4500035 IF(BATBUF(K+6).NE.IDUSER(K)) GO TO 400 C4500036 300 CONTINUE C4500037C C4500038C MATCH FOUND C4500039C C4500040 SWORD=0 C4500041 GO TO 600 C4500042C C4500043C NO MATCH C4500044C C4500045 400 SWORD=1 C4500046 GO TO 600 C4500047C C4500048C FILE MANAGER ERROR C4500049ÐÐC C4500050 500 SWORD=ISTAT C4500051 600 CALL CLOSFL(CPREQ,ISTAT) C4500052 RETURN C4500053 END C4500054 MON 00001 NAM GOEDIT D01 A ITOS CCS 3.0 SL-149D0100001* ITOS SOURCE LANGUAGE EDITOR SUBR. INITIAL PROGRAM IN ROOT D0100002* CREDIT COLLECTION SYSTEM VERSION 3.0 D0100003* DATA SYSTEM-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA D0100004* COPYRIGHT CONTROL DATA CORPORATION 1978 D0100005* D0100006 SPC 3 D0100007**** D0100008* FUNCTION D0100009* -------- D0100010*S3 THIS ROUTINE DETERMINES IF THIS IS THE INITIAL ENTRY D0100011* INTO THIS COPY OF THE SOURCE LANGUAGE EDITOR ROOT. D0100012*S5 GENERAL DESCRIPTION D0100013* ------- ----------- D0100014*S3 IF THIS IS THE FIRST ENTRY INTO THIS COPY OF THE D0100015* EDITOR, A CALL IS MADE TO 'LOCAL' TO BRING IN THE D0100016* EDITOR OVERLAY. IF IT IS NOT THE FIRST ENTRY INTO D0100017* THIS COPY OF THE EDITOR, CONTROL TRANSFERS TO 'RELOAD' D0100018* TO RELOAD THE OVERLAY IF NECESSARY. D0100019ÐÐ*S5 **NOTE** D0100020* -------- D0100021*S2 THIS VERSION OF THE EDITOR IS SET UP AS A SINGLE USER D0100022* FUNCTION. THE CALL TO 'LOCAL' HAS BEEN REPLACED BY D0100023* A CALL TO 'INITLE'. NO CALL WILL EVER BE MADE TO D0100024* 'RELOAD' WHEN THE EDITOR IS USED AS A SINGLE USER D0100025* FUNCTION. D0100026*S5 ENTRY/EXIT D0100027* ---------- D0100028*S3 THIS ROUTINE IS ENTERED FROM THE EXECUTIVE AS THE D0100029* FIRST ROUTINE LOADED IN THE EDITOR ROOT. D0100030* THIS ROUTINE EXITS TO EITHER 'LOCAL' OR 'RELOAD'. D0100031*S5 ENTRIES D0100032* ------- D0100033*S3 ENTRY POINT REFERENCED BY D0100034* ----- ----- ---------- -- D0100035* GOEDIT (NONE) D0100036*S3 EXTERNAL REFERENCES D0100037* EXTERNAL EXTERNAL D0100038* -------- -------- D0100039* RELOAD LOCAL D0100040* EDITX PGMOUT D0100041* INITLE D0100042*S5 **NOTE** D0100043* -------- D0100044ÐÐ*S2 THIS MUST BE THE FIRST PROGRAM OF THE EDITOR ROOT. D0100045**** D0100046 EJT D0100047 ENT GOEDIT D0100048 EXT RELOAD D0100049* EXT EDITX D0100050 EXT PGMOUT D0100051 EXT INITLE D0100052* IF THIS IS THE FIRST TIME THROUGH, INITIALIZE THE EDITOR. D0100053* OTHERWISE, GO TO RELOAD. D0100054 SPC 2 D0100055GOEDIT LDA* FIRSTT D0100056 SAZ NOTREL D0100057 JMP RELOAD D0100058NOTREL RAO* FIRSTT SET THE FIRST TIME FLAG. D0100059************************************************************************D0100060* NOTE *D0100061************************************************************************D0100062* WHEN THE ITOS SOURCE LANGUAGE EDITOR IS MODIFIED TO RUN A D0100063* A MULTI-USER ROUTINE, THIS RETURN JUMP TO 'INITLE' MUST BE D0100064* CHANGED TO A RETURN JUMP TO 'LOCAL'. D0100065 RTJ INITLE D0100066* ADC EDITX THIS COMMENT SHOULD BE AN ACTUAL 'ADC' D0100067* IF THE ITOS EDITOR IS SET UP AS A D0100068* MULTI-USER ROUTINE. D0100069ÐÐ ADC TVINDX EDITOR'S INDEX INTO MULTI-USER TABLES D0100070 RTJ PGMOUT CALL PGMOUT : EXIT TO EXECUTIVE D0100071TVINDX ADC $0000 D0100072FIRSTT NUM 0 D0100073 END D0100074 NAM EDITZR D02 A ITOS CCS 3.0 SL-149D0200001* ITOS SOURCE LANGUAGE EDITOR SUBR. TO CLEAR ALL LABELED COMMON D0200002* CREDIT COLLECTION SYSTEM VERSION 3.0 D0200003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA D0200004* COPYRIGHT CONTROL DATA CORPORATION 1978 D0200005* D0200006 SPC 3 D0200007**** D0200008* FUNCTION D0200009* -------- D0200010*S3 THIS ROUTINE INITIALLY CLEARS ALL OF LABELLED COMMON. D0200011*S5 GENERAL DESCRIPTION D0200012* ------- ----------- D0200013*S3 THIS ROUTINE CONSISTS ENTIRELY OF A BZS BLOCK WHICH D0200014* IS EQUAL IN SIZE TO THE SIZE OF LABELLED COMMON AND D0200015* IS ORIGINED AT THE START OF LABELLED COMMON. D0200016*S5 ENTRY/EXIT D0200017* ---------- D0200018*S3 AS THIS ROUTINE CONTAINS NO EXECUTABLE CODE, THERE D0200019* ARE NO ENTRY OR EXIT CONDITIONS. D0200020ÐÐ*S5 ENTRIES D0200021* ------- D0200022*S3 ENTRY POINT REFERENCED BY D0200023* ----- ----- ---------- -- D0200024* (NONE) (NONE) D0200025*S5 EXTERNAL REFERENCES D0200026* -------- ---------- D0200027*S3 EXTERNAL D0200028* (NONE) D0200029*S5 **NOTE** D0200030* -------- D0200031* THIS ROUTINE SHOULD BE LOADED IMMEDIATELY FOLLOWING 'EDITCM'. D0200032**** D0200033 DAT LCOMMON LABELED COMMON D0200034 ORG LCOMMON D0200035 BZS ZEROS(5274) LABELED COMMON SIZE AS OF 04/08/77 D0200036 ORG* D0200037 END D0200038 NAM IO D03 A ITOS CCS 3.0 SL-149D0300001* ITOS SOURCE LANGUAGE EDITOR SUBR. TO PERFORM INPUT/OUTPUT D0300002* CREDIT COLLECTION SYSTEM VERSION 3.0 D0300003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA D0300004* COPYRIGHT CONTROL DATA CORPORATION 1978 D0300005* D0300006*** D0300007ÐÐ* FUNCTION D0300008* -------- D0300009*S3 THIS ROUTINE PERFORMS READ AND WRITE OPERATIONS. D0300010*S5 GENERAL DESCRIPTION D0300011* ------- ----------- D0300012*S3 IO CONTAINS FIVE FUNCTIONAL SUBROUTINES: INPUT D0300013* FOR FORMATTED READ, OUTPUT FOR FORMATTED WRITE, D0300014* RREAD FOR UNFORMATTED READ, AND RWRITE FOR D0300015* UNFORMATTED WRITE AND AWRITE TO CIRCUMVENT D0300016* THE FORTRAN I/O ROUTINES. EACH OF THE SUBSECTIONS CALLS D0300017* THE INTERNAL SUBROUTINE IO TO SET UP PARAMETERS D0300018* AND MAKE THE MONITOR CALL TO PERFORM THE READ D0300019* OR WRITE. D0300020*S5 ENTRY/EXIT D0300021* ---------- D0300022*S3 THE CALLING SEQUENCE IS: CALL INPUT(LU,BUFFER,N) D0300023* OR: CALL OUTPUT(LU,BUFFER,N) D0300024* OR: CALL AWRITE(LU,OBUFR,N) D0300025* OR: CALL RWRITE(LU,BUFFER,N) D0300026* OR: CALL RREAD(LU,BUFFER,N) D0300027* D0300028* WHERE LU = THE LOGICAL UNIT D0300029* BUFFER = THE BUFFER TO BE USED D0300030* OBUFR = THE ASSIGNED FORTRAN FORMAT D0300031* STATEMENT VARIABLE D0300032ÐÐ* N = THE LENGTH OF THE BUFFER. D0300033* THE ROUTINE RETURNS TO THE CALLING PROGRAM D0300034* UPON COMPLETION D0300035*S5 SUBROUTINES D0300036* ----------- D0300037*S1 IO D0300038* -- D0300039*S3 THIS SUBROUTINE SAVES THE MONITOR REQUEST CODE D0300040* PASSED TO THE SUBROUTINE, AND PICKS UP THE D0300041* PARAMETERS FROM THE PARAMETER LIST OF THE D0300042* CALLING ROUTINE. THESE PARAMETERS ARE PLACED D0300043* IN THE MONITOR CALL AND AN INDIRECT MONITOR D0300044* CALL IS MADE. UPON COMPLETION OF THE REQUEST, D0300045* THE REGISTERS ARE RESTORED AN THE ROUTINE D0300046* RETURNS TO THE USER. D0300047*S3 PKUP D0300048* ---- D0300049*S3 THIS SUBROUTINE IS CALLED BY SUBROUTINE IO D0300050* TO PICK UP PARAMETERS FROM THE PARAMETER D0300051* LIST OF THE USER. THE SUBROUTINE RETURNS D0300052* WITH THE ADDRESS OF THE PARAMETER IN THE D0300053* Q-REGISTER AND THE VALUE OF THE PARAMETER D0300054* IN THE A-REGISTER. D0300055*S5 ENTRIES D0300056* ------- D0300057ÐÐ*S3 ENTRY POINT REFERENCED BY D0300058* ----- ----- ---------- -- D0300059* INPUT (NONE) D0300060* OUTPUT AUTPRO D0300061* EDITOS D0300062* INITLE D0300063* LSTPRO D0300064* LINPRO D0300065* SEAPRO D0300066* CHAPRO D0300067* AWRITE (NONE) D0300068* RREAD (NONE) D0300069* RWRITE (NONE) D0300070*S5 EXTERNAL REFERENCES D0300071* -------- ---------- D0300072*S3 EXTERNAL D0300073* -------- D0300074* ATTCHK D0300075**** D0300076 SPC 2 D0300077* D0300078* CALL INPUT(LU,BUFFER,N) D0300079* CALL OUTPUT(LU,BUFFER,N) D0300080 ENT INPUT,OUTPUT D0300081* CALL RWRITE(LU,BUFFER,N) D0300082ÐÐ* CALL RREAD(LU,BUFFER,N) D0300083 ENT RWRITE D0300084 ENT RREAD D0300085 ENT AWRITE ASSIGN 100 TO OBFR; 100 FORMAT(*TEXT*) D0300086* CALL AWRITE(LU, OBFR, N) D0300087 EJT D0300088 EJT D0300089 EQU ZERO($22) D0300090 EQU D($4000) D BIT IN MONITOR REQUESTS. D0300091INPUT 0 0 D0300092 RTJ* IO D0300093 ADC $800+D,INPUT FORMAT READ CODE D0300094 JMP* (INPUT) D0300095OUTPUT 0 0 D0300096 RTJ* IO D0300097FWCODE ADC $C00+D,OUTPUT FORMAT WRITE CODE D0300098 JMP* (OUTPUT) D0300099 SPC 2 D0300100* UNFORMATTED WRITE D0300101RWRITE 0 0 D0300102 RTJ* IO D0300103 ADC $400+D,RWRITE D0300104 JMP* (RWRITE) D0300105* UNFORMATTED READ D0300106RREAD 0 0 D0300107ÐÐ RTJ* IO D0300108 ADC $200+D,RREAD D0300109 JMP* (RREAD) D0300110 SPC 1 D0300111 SPC 2 D0300112IO 0 0 D0300113 LDA* (IO) D0300114 STA* RC REQUEST D0300115 RAO* IO D0300116 STQ* QSAV D0300117 LDA- I D0300118 STA* ISAV D0300119 LDQ* (IO) D0300120 LDQ- (ZERO),Q D0300121 STQ* PCTR POINTER TO PARAMETERS D0300122 RTJ* PKUP D0300123 INA -4 D0300124 SAP USEIT D0300125 ADD =N$18F8 REFER TO CONSTANTS IN LOCORE D0300126USEIT INA 4 D0300127 STA* LU VALUE IN A D0300128 RTJ* PKUP D0300129 STQ* BFR ADDRESS IN Q D0300130 RTJ* PKUP D0300131 STA* N D0300132ÐÐ LDA- 1,Q D0300133 STA* LSB D0300134 ENA 0 D0300135 STA* MSB D0300136* ALL IO CALLS ARE ISSUED FROM HERE. D0300137ALLIO EQU ALLIO(*) D0300138 RTJ- ($F4) D0300139 ADC $2000+D,RC INDIRECT REQUEST FOR EITHER PART 1 OR 0 (ABS) D0300140 JMP- ($EA) CALL THE DISPATCHER D0300141RC ADC $000+D,COMP,0 MONITOR CALL D0300142LU ADC 0 LOGICAL UNIT D0300143N ADC 0 LENGTH D0300144BFR ADC 0 BUFFER ADDRESS D0300145MSB ADC 0 D0300146LSB ADC 0 D0300147 SPC 4 D0300148* ALL IO COMPLETES HERE. D0300149COMP EQU COMP(*) D0300150 EXT ATTCHK ATTACH REQUEST CHECK D0300151 RTJ ATTCHK CHECK FOR PROPER MULTI-USER ATTACHMENT D0300152 LDA* ISAV D0300153 STA- I RESTORE REGISTERS D0300154* D0300155 LDQ* QSAV D0300156 JMP* (PCTR) RETURN TO USER D0300157ÐÐPCTR ADC 0 D0300158QSAV ADC 0 D0300159ISAV ADC 0 D0300160* D0300161 SPC 4 D0300162* ONLY NON-RUN-ANYWHERE CALLS ACCEPTED. D0300163PKUP 0 0 PICK UP PARAM ADDRESS IN Q, VALUE IN A. D0300164 LDQ* (PCTR) D0300165 LDA- (ZERO),Q CONTENTS OF Q IN A D0300166 RAO* PCTR INCREMENT POINTER TO PARAMETERS D0300167 JMP* (PKUP) D0300168 EJT D0300169* TIMESHARE D0300170* AWRITE IS A SPECIAL WRITE ROUTINE TO AVOID D0300171* HAVING THE FORTRAN READ/WRITE PACKAGE PRESENT.D0300172* CALLING SEQUENCE: D0300173* ASSIGN 100 TO OBFR D0300174* CALL AWRITE( LU, OBFR, N) D0300175* 100 FORMAT(*ANYTEXT*) D0300176AWRITE 0 0 D0300177 STQ* QSAV D0300178 LDA- I D0300179 STA* ISAV D0300180 LDQ* AWRITE D0300181 STQ* PCTR PCTR=RETURN ADDRESS. D0300182ÐÐ RTJ* PKUP D0300183 STA* LU LOGICAL UNIT. D0300184 RTJ* PKUP D0300185 INA 2 CORRECT FOR FORTRAN'S (XH.....AT BEGINNING. D0300186 STA* BFR D0300187 RTJ* PKUP D0300188 STA* N VALUE IN A IS ACTUAL LENGTH. D0300189 LDA FWCODE D0300190 STA* RC D0300191 JMP* ALLIO GO TO COMMON IO CALL LOGIC. D0300192 END D0300193 NAM LOCAL D04 A ITOS CCS 3.0 SL-149D0400001* ITOS SOURCE LANGUAGE EDITOR SUBR. MULTI-USER SUPPORT ROUTINES D0400002* CREDIT COLLECTION SYSTEM VERSION 3.0 D0400003* DATA SYSTEM-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA D0400004* COPYRIGHT CONTROL DATA CORPORATION 1978 D0400005* D0400006 SPC 2 D0400007**** D0400008* FUNCTION D0400009* -------- D0400010* THE MAIN FUNCTION OF THIS ROUTINE IS TO LOAD A MULTI-USER D0400011* ROUTINE SPECIFIED IN THE CALLING SEQUENCE AND TO PASS D0400012* CONTROL TO THE MULTI-USER ROUTINE AT THE ENTRY POINT D0400013* SPECIFIED BY THE INDEX IN THE CALL TO LOCAL D0400014ÐÐ* IN ADDITION, VARIOUS SUPPORT ROUTINES ARE INCLUDED TO D0400015* SUPPLY SERVICES REQUIRED IN THE ROOT OF A MULTI-USER JOB. D0400016* THESE INCLUDE Q8STP,Q8STPN FOR RETURNING CONTROL. D0400017* Q8PREP AND Q8PKUP ARE INCLUDED FOR PARAMETER PASSING. D0400018* SAVE AND RETURN ARE INCLUDED FOR REENTRANT FORTRAN D0400019* ROUTINES. D0400020* SAVADD AND STOADD ARE INCLUDED TO ALLOW FORTRAN SUBROUTINES D0400021* TO RETURN VALUES VIA THE PARAMETER LIST. D0400022* BREAK ALLOWS THE USER TO GIVE UP CONTROL IF THE TIME D0400023* SLICE IS UP. D0400024*S5 ENTRY/EXIT D0400025* ---------- D0400026*S3 D0400027* CALLING SEQUENCE IS: D0400028* RTJ LOCAL D0400029* ADC YY,XX WHERE YY IS THE ACTUAL MULTI-USER NUMBER D0400030* AND XX IS THE LOCATION CONTAINING THE TRANSFERD0400031* INDEX. D0400032* RETURNLOC EQU (*) D0400033* D0400034* THE CALLED OVERLAY RETURNS TO THE CALLING OVERLAY BY EXECUTING D0400035* A STOP 7777 OR BY A RETURN. D0400036**** D0400037 EJT D0400038 ENT Q8PREP,Q8PKUP D0400039ÐÐ ENT Q8STP D0400040 ENT Q8STPN D0400041 SPC 2 D0400042 EXT BEGIN D0400043 EXT ATTACH D0400044 SPC 2 D0400045 EXT PGMOUT D0400046 EXT SYSMSG D0400047 SPC 2 D0400048 EQU ADISP($EA) DISPATCHER ADDRESS D0400049 EQU HFFF($E) D0400050 EQU ENTAD($DC) D0400051 EQU PAD($DD) D0400052 EQU HFF($A) D0400053 EQU ZERO($22) D0400054 EJT D0400055* LABELLED COMMON D0400056* D0400057* EDITCM---------------APRIL 08, 1977---------------------------D0400058 DAT CMNDBF(41),FBUFFR(800),TBUFFR(41),FMOPEN(15) D0400059 DAT REQBUF(24),FCBBUX(101),IDATA(10),NUMFLD(3),NUMBER(3) D0400060 DAT LINBUF(54),IS(3600),IRECPT(2),ALFFLD(3) D0400061 DAT NAMFIL(8),SLRQBF(24),SLFCBX(101),NW(2),TABBUF(20) D0400062 DAT RECBUF(41),SCRQBF(24),ISCRPT(2),SCFCBX(101) D0400063 DAT TEMHOL(7),SAVRTN(42),STRBF1(20),STRBF2(20) D0400064ÐÐ DAT ICRBUF(24),ISSAVE(2),IPGMID(3) D0400065 DAT COMMAF,ICHARC,IDXWRD,IWRDIX,J,NUMHEX,BEGLIN,FCBADR D0400066 DAT ENDLIN,IERRFG,IFLAGX,LINENO,STNMBR,TERMLU,IA,ISTAT D0400067 DAT CHARNO,FRSTIM,GOTCHR,IMODE,IDELFG,ICHAR,IENPLN,IENX D0400068 DAT IMADR,IRRP,LINIDX,ITCHAR,ID,I1,HIREF,ILEAST,IX D0400069 DAT IB,IC,IRCIDX,SLFADR,ISREF,NOREF,IMAX,CB,TABIDX D0400070 DAT IMOD,NOPORT,ISSIZE,IPGSIZ,FBSIZE,NOPAGS D0400071 DAT ILOCAT,IMADRL,IREF,IT,IY,IZ,IDUMB,RSQINC,RSQNUM D0400072 DAT AUTOFG,FORMTP,ICORDS,ISCRLN,IEOFFM,TC,TEPMID,SCRADR D0400073 DAT NUMFLG,EXPCOM,Y,XWORD,COUNT,SAVEQ,MATCHX,IDELIM D0400074 DAT IRADD,ISRMCH,ISTRST,ICHSTO,ICHANG,ISEAFG,ISRLNG D0400075 DAT IWTCRD,IHIRRP,ISTATX,IBLKSZ,NRECST,IENREC D0400076 DAT ISPACE(50) D0400077 EQU USERID(NAMFIL+4) D0400078 EQU FCBBUF(FCBBUX+5) D0400079 EQU SLFCBF(SLFCBX+5) D0400080 EQU SCFCBF(SCFCBX+5) D0400081* EDITCM END D0400082 EJT D0400083* SAVE/RETURN STACK D0400084* SAVRTN(0)= NEXT AVAILABLE LOC D0400085* SAVRTN(1)= LAST AVAILABLE LOC D0400086 ORG SAVRTN D0400087 EQU SAVSIZ(3) SAVRTN ENTRY SIZE (P,Q, AND I) D0400088 ADC SAVSIZ,42,SAVSIZ FIRST,LAST,INCREMENT D0400089ÐÐ ORG* D0400090* D0400091 EJT D0400092* D0400093* D0400094* D0400095 ENT LOCAL D0400096LOCAL 0 0 OUT OF CORE SUBROUTINE CALLED. D0400097* D0400098 SPC 2 D0400099*STEP1. D0400100 RTJ Q8PREP D0400101 ADC (LOCAL-*) D0400102* D0400103*STEP2. D0400104 LDA* IOVNUM CURRENT MULTI-USER NUMBER D0400105 STA* IOVRNT SAVE IN TABLE(0). D0400106*STEP3. D0400107 RTJ Q8PKUP D0400108* FIRST PARAM IS THE ACTUAL OVERLAY # D0400109* D0400110 STA* IOVNUM D0400111 RTJ Q8PKUP D0400112 TRA Q PICK UP TRANSFER VECTOR INDEX D0400113 LDA- (ZERO),Q D0400114ÐÐ AND- HFF D0400115 STA* INDEX D0400116*STEP4. D0400117 LDA* LOCAL SAVE RETURN ADDRESS IN PSAV D0400118 STA* PSAV D0400119* D0400120 RTJ ATTACR CALL ATTACH(IOVNUM,RELP) D0400121*STEP5. D0400122 RTJ ATTCHK CHECK FOR CORRECT ATTACHMENT D0400123*STEP6. D0400124 LDQ* INDEX D0400125 INQ 3 SKIP OVER THE HEADER WORDS D0400126 LDA* (S),Q LOC OF THE TV WITHIN THE OVERLAY. D0400127 STA* CALL D0400128 LDA =XEXIT D0400129 STA* (AIRADD) D0400130 RTJ* (CALL) D0400131* EITHER A RETURN OR A 'GO TO IRADD' COMES D0400132* HERE. (CAN BE USED FOR SUBROUTINES OR RULES. )D0400133EXIT RTJ* Q8STPN STOP 7777 D0400134 NUM $FFF D0400135CALL ADC 0 D0400136AIRADD ADC IRADD RETURN TO USER (LOCATED IN COMMON) D0400137 SPC 2 D0400138P1 ADC 0 D0400139ÐÐPSAV ADC 0 D0400140IOVRNT ADC 0 D0400141INDEX ADC 0 INDEX INTO OVERLAY'S TRANSFER VECTOR D0400142 ENT IOVNUM D0400143S ADC BEGIN D0400144 EJT D0400145*** D0400146*S3 SUBROUTINE Q8STP D0400147C D0400148* CASE 1: STOP OR STOP 7777. D0400149* RESTORE THE OVERLAY NUMBER. D0400150* RESTORE THE RETURN ADDRESS. D0400151* ATTACH TO THE OVERLAY USING THE ATTACH SUBROUTINE. D0400152* RETURN TO THE SAVED RETURN ADDRESS. D0400153* D0400154* D0400155Q8STP 0 0 ENTRY FOR STOP D0400156 JMP* EXITAL D0400157Q8STPN 0 0 ENTRY FOR STOP N D0400158 LDA* (Q8STPN) PICK UP N FROM STOP N D0400159 SUB- HFFF OCTAL 7777 D0400160 SAN CASE2 D0400161* CASE 1: STOP 7777 D0400162 JMP* S6 RETURN TO CALLER OF LOCAL. D0400163*** D0400164ÐÐ* CASE 2: STOP 7776 : RESTART. D0400165* IF RESTART HAS BEEN CALLED, THEN D0400166* RESTORE THE RETURN ADDRESS FOR THE RESTART PROGRAM D0400167* AT THE LEVEL WHICH CALLED RESTART. D0400168* RESTORE THE SAVRTN STACK POINTERS. D0400169* RESTORE THE OVERLAY AND GO TO THE RESTART LOCATION. D0400170* D0400171CASE2 INA 1 STOP 7776: RESTART D0400172 SAZ S4 D0400173 JMP* CASE3 D0400174S4 EQU S4(*) D0400175* IF RESTART HAS NOT BEEN CALLED, TREAT AS STOP D0400176 LDA* RESTRT D0400177 SAN S5 D0400178 JMP* CASE3 D0400179* D0400180S5 EQU S5(*) D0400181 STA* PSAV D0400182 LDA* RSAVRT RESTORE STACK POINTER D0400183 STA SAVRTN D0400184S6 EQU S6(*) D0400185* RETURN TO CALLER OF LOCAL D0400186 LDA* PSAV GET THE RETURN ADDRESS TO CALLER FROM PSAV D0400187 STA* P1 D0400188 LDA* IOVRNT RESTORE THE OVERLAY NUMBER D0400189ÐÐ STA* IOVNUM D0400190 SAM S33 IF NOT ATTACHED TO AN OVERLAY, SKIP ATTACHES D0400191* IF ROOT IS CURRENTLY ATTACHED TO THIS MULTI- D0400192* USER, THEN DON'T CALL ATTACH D0400193 ENQ 2 POINTER TO MULTI-USER CODE IN BEGINX D0400194 LDA* (S),Q D0400195 SUB* IOVNUM D0400196 SAZ S32 D0400197 RTJ* ATTACR ATTACH TO MULTI-USER ROUTINE D0400198S32 EQU S32(*) D0400199 RTJ* ATTCHK CHECK FOR CORRECT ATTACHMENT D0400200S33 EQU S33(*) D0400201 JMP* (P1) D0400202 SPC 2 D0400203* D0400204* CASE 3: STOP N WHERE N IS NOT 7777 OR 7776 FOR RETURN OR RESTARTD0400205* TREAT AS CALL PGMOUT. D0400206CASE3 EQU CASE3(*) STOP OTHER THAN 7777 OR 7776 D0400207 JMP* EXITAL D0400208 SPC 2 D0400209EXITAL EQU EXITAL(*) D0400210 RTJ PGMOUT CALL PGMOUT D0400211* --- CONTROL NEVER RETURNS D0400212 SPC 2 D0400213ATTACR 0 0 CALL ATTACH(IOVNUM,RELP) D0400214ÐÐ RTJ ATTACH D0400215 ADC IOVNUM OVERLAY (MULTI-USER NUMBER) D0400216 ADC RELP RELOAD'S P-REGISTER D0400217 JMP* (ATTACR) RETURN TO CALLLER D0400218IOVNUM NUM -1 INITIAL VALUE OF THE MULTI-USER ROUTINE D0400219 EJT D0400220*** D0400221*S3 SUBROUTINE RESTRT D0400222* SAVE LEVEL AND CALL PGMINT TO DO PROGRAM INTERRUPT D0400223* SETUP, THEN RETURN. D0400224 ENT RESTRT RESTART COMPILER FROM CONTENTS OF RESTRT D0400225RESTRT 0 0 D0400226 LDA SAVRTN SAVE STACK POINTER D0400227 STA* RSAVRT D0400228 EXT PGMINT PROGRAM INTERRUPT SET UP D0400229 RTJ PGMINT SET IFLAGX NON-ZERO ON INTERRUPT D0400230 ADC AZRO (NO ADDRESS) D0400231 ADC IFLAGX D0400232 JMP* (RESTRT) D0400233SLEVEL ADC 0 OVERLAY LEVEL FOR RESTART D0400234RSAVRT ADC 0 SAVRTN STACK POINTER FOR RESTART. D0400235AZRO ADC 0 D0400236 EJT D0400237*** D0400238*S3 SUBROUTINE ATTCHK D0400239ÐÐ* CHECK FOR PROPER ATTACHMENT TO MULTI-USER CODE D0400240* IF NOT CORRECTLY ATTACHED, THEN D0400241* HANG. D0400242* D0400243 ENT ATTCHK D0400244ATTCHK 0 0 D0400245 LDA* IOVNUM IF CURRENT OVERLAY IS NEGATIVE, ROOT IS D0400246 SAP ATT00 NOT ATTACHED TO A MULTI-USER ROUTINE D0400247 JMP* (ATTCHK) EXIT D0400248ATT00 EQU ATT00(*) D0400249 LDQ S Q POINTS TO BEGIN D0400250 LDA- 2,Q PICK UP ACTUAL MULTI-USER CODE FROM OVERLAY D0400251 SUB IOVNUM COMPARE TO DESIRED CODE FROM ROOT. D0400252 SAZ ATT01 D0400253 LDA* M1 ATTACHED TO WRONG USER D0400254 LDQ- 2,Q WRONG USER IN Q D0400255 JMP* ATTERR D0400256ATT01 EQU ATT01(*) D0400257 LDA- (ZERO),Q BEGIN LOC D0400258 SUB S D0400259 SAZ ATT02 D0400260 LDA* M2 WORD 0 ISN'T BEGIN D0400261 JMP* ATTERR D0400262ATT02 EQU ATT02(*) D0400263 LDQ- 1,Q D0400264ÐÐ LDA- (ZERO),Q BEGIN:(ENDLOC) D0400265 SUB S D0400266 SAZ ATT03 D0400267 LDA* M3 SHOULD HAVE BEEN BEGIN D0400268 JMP* ATTERR D0400269ATT03 EQU ATT03(*) D0400270 TRQ A (ENDLOC+1):ENDLOC D0400271 SUB- 1,Q D0400272 SAZ ATT04 D0400273 LDA* M4 SHOULD HAVE BEEN ENDLOC D0400274 JMP* ATTERR D0400275ATT04 EQU ATT04(*) D0400276 JMP* (ATTCHK) D0400277ATTERR EQU ATTERR(*) D0400278HANG NOP 0 D0400279 JMP* HANG D0400280 SPC 2 D0400281M1 ADC 1 WRONG USER ATTACHED D0400282M2 ADC 2 BEGIN DOESN'T CONTAIN BEGIN D0400283M3 ADC 3 ENDLOC DOESN'T CONTAIN BEGIN D0400284M4 ADC 4 ENDLOC+1 SOESN'T CONTAIN ENDLOC D0400285 EJT D0400286*** D0400287*S3 SUBROUTINES Q8PREP AND Q8PKUP D0400288* PARAMETER PASSING ROUTINES D0400289ÐÐ* THIS IS A LOCAL COPY OF THE Q8PRMS SUBROUTINE D0400290* WHICH IS FOUND IN THE FORTRAN LIBRARY ROUTINES D0400291* IT IS INCLUDED HERE TO INSURE THAT IT IS CORE RESIDENT D0400292* WITH RESPECT TO THE OVERLAY HANDLING IN THE META MACHINE D0400293* Q8PREP MOVES THE ADDRESS OF THE SUBROUTINE'S ENTRY TO ENTAD D0400294Q8PREP 0 0 D0400295 STQ* QSAV D0400296 LDA* (Q8PREP) D0400297 ADD* Q8PREP D0400298* 64K MODE(NOT RUN ANYWHERE CODE) D0400299 STA- ENTAD D0400300 RAO* Q8PREP D0400301 JMP* (Q8PREP) D0400302*** D0400303* Q8PKUP MOVES THE NEXT PARAMETER'S ADDRESS TO A AND BUMPS D0400304* THE POINTER IN THE SUBROUTINE'S ENTRY LOCATION D0400305* D0400306Q8PKUP 0 0 D0400307 LDA- (ENTAD) D0400308 STA- PAD D0400309 LDA- (PAD) D0400310* 64K MODE(NOT RUN ANYWHERE CODE) D0400311 RAO- (ENTAD) D0400312 LDQ* QSAV MAINTAIN ORIGINAL Q REGISTER FOR SAVE/RETURN D0400313 JMP* (Q8PKUP) D0400314ÐÐ EJT D0400315**** D0400316* D0400317* FOR IMPLEMENTING SERIALLY REENTRANT CODE IN D0400318* FORTRAN ROUTINES. D0400319* D0400320* SAVRTN STACK(0) CONTAINS CURRENT AVAILABLE LOCD0400321* SAVRTN(1) CONTAINS LAST AVAILABLE LOC D0400322 ENT SAVE D0400323* SAVE OBTAINS THE P REGISTER OF THE CALLER AND PUSHES IT D0400324* AND THE Q REGISTER ONTO THE SAVRTN STACK. D0400325* D0400326* CALLING SEQUENCE IS: D0400327* CALL SAVE(SUBROUTINE ENTRY POINT NAME) D0400328* D0400329**** D0400330ASAVRTN ADC SAVRTN ADDRESS OF SAVRTN IN COMMON D0400331ASAVR1 ADC SAVRTN+1 ADDRESS OF SAVRTN+1 IN COMMON D0400332ASAVR2 ADC SAVRTN+2 ADDRESS OF SAVRTN+2 IN COMMON D0400333* D0400334ASAV ADC 0 A REGISTER SAVED D0400335QSAV ADC 0 Q REGISTER SAVED D0400336ISAV ADC 0 I REGISTER SAVED D0400337SAVE 0 0 D0400338 STQ* QSAV (Q HAS BEEN PRESERVED THRU Q8PREP CALLS) D0400339ÐÐ LDQ* (SAVE) POINTER TO CALLER OF CALLER OF SAVE. D0400340 LDA- (ZERO),Q ENTRY POINT OF ORIGINAL CALLER D0400341 LDQ* (ASAVRTN) POINTER TO SAVRTN STACK D0400342 STA* (ASAVRTN),Q SAVE P AT STACK +0 D0400343 LDA* QSAV D0400344 STA* (ASAVR1),Q SAVE Q AT STACK+1 D0400345 LDA- I SAVE I AT STACK+2 D0400346 STA* (ASAVR2),Q D0400347 INQ SAVSIZ INCREMENT POINTER BY STACK SIZE D0400348 STQ* (ASAVRTN) D0400349* IF STACK HAS OVERFLOWED, GO TO SAVERR D0400350 TRQ A D0400351 SUB* (ASAVR1) LAST AVAILABLE INDEX D0400352 SAP SAVERR D0400353 RAO* SAVE BUMP RETURN ADDRESS D0400354 LDQ* QSAV RESTORE Q D0400355 JMP* (SAVE) RETURN TO CALLER. D0400356* D0400357* STACK OVERFLOW D0400358SAVERR EQU SAVERR(*) D0400359 RTJ SYSMSG D0400360 ADC MSAVNO ERROR-IN SYSTEM. SAVRTN STACK OVERFLOW D0400361 ADC ZERO (NO EXTRA PARAMTEER) D0400362 JMP* EXITAL FINAL EXIT D0400363MSAVNO NUM 320 D0400364ÐÐ EJT D0400365**** D0400366* D0400367* THE CALLING SEQUENCE IS: D0400368* CALL RETURN D0400369* D0400370* RETURN OBTAINS P AND Q FROM THE SAVRTN STACK AND POPS IT D0400371* CONTROL RETURNS TO LOCATION P WITH Q SET TO ORIGINAL VALUE D0400372* THE RETURN STATEMENT IN FORTRAN IS EQUIVALENT TO THE D0400373* CALL RETURN EXCEPT THAT THE TEMPORARY LOCATIONS FOR P AND Q D0400374* ARE NOW ON THE SAVRTN STACK. D0400375**** D0400376 ENT RETURN D0400377RETURN 0 0 D0400378 STA* ASAV SAVE A FOR FUNCTION RETURNS D0400379 JMP* R1 D0400380**** D0400381* D0400382 ENT RETRNQ D0400383* D0400384* D0400385* THE CALLING SEQUENCE IS: D0400386* CALL RETRNQ D0400387* D0400388* RETRNQ OPERATES THE SAME AS RETURN WITH THE EXCEPTION D0400389ÐÐ* THAT THE CURRENT VALUE OF THE Q AND I REGISTERS ARE RTN'D. D0400390* NOTE THAT IN RETURN THE ORIGINAL VALUE OF Q IS RETURNED. D0400391* D0400392* IN BOTH RETURN AND RETRNQ THE CURRENT VALUES OF A AND I D0400393* ARE RETURNED D0400394**** D0400395RETRNQ 0 0 D0400396 STA* ASAV SAVE A D0400397 STQ* QSAV SAVE Q D0400398 LDQ* (ASAVRTN) POINTER TO NEXT POSITION ON STACK D0400399 INQ -SAVSIZ MOVE TO CURRENT POSITION ON STACK D0400400 LDA* QSAV D0400401 STA* (ASAVR1),Q SAVE Q ON STACK D0400402 LDA- I SAVE THE CURRENT I-REGISTER ON THE STACK D0400403 STA* (ASAVR2),Q D0400404R1 EQU R1(*) D0400405* POP THE STACK D0400406 LDQ* (ASAVRTN) D0400407 INQ -SAVSIZ D0400408 TRQ A IF STACK IS BELOW 1ST ENTRY, CALL ERROR D0400409 INA -SAVSIZ D0400410 SAP R2 D0400411 JMP* RETERR D0400412R2 EQU R2(*) D0400413 STQ* (ASAVRTN) D0400414ÐÐ* OBTAIN THE RETURN ADDRESS D0400415 LDA* (ASAVRTN),Q D0400416 STA* RETRNP D0400417 LDA* (ASAVR2),Q OBTAIN THE I REGISTER D0400418 STA- I D0400419* OBTAIN THE Q REGISTER D0400420 LDQ* (ASAVR1),Q D0400421 STQ* QSAV D0400422 LDA* ASAV D0400423 JMP* (RETRNP) RETURN TO USER VIA P SAVED ON STACK D0400424RETRNP ADC 0 RETURN P REGISTER D0400425RETERR EQU RETERR(*) D0400426 RTJ SYSMSG D0400427 ADC RETERN D0400428 ADC ZERO D0400429 JMP EXITAL D0400430RETERN NUM 321 D0400431* D0400432 EJT D0400433**** D0400434 ENT RELOAD CONTROL COMES HERE IF ROOT BECOMES D0400435* DETACHED FROM THE OVERLAY BY THE EXECUTIVE D0400436* D0400437* RELP CONTAINS THE LAST EXIT POINT FROM THE D0400438* MULTI-USER ROUTINE. THE ROOT MAY BE DETACHED BY THE EXEC D0400439ÐÐ* ON ONE OF THE FOLLOWING CALLS: D0400440* MSOS I/O CALLS: FREAD,FWRITE,RREAD,RWRITE D0400441* FILE MANAGER CALLS: DEFFIL, STOSEQ,RTVSEQ,ETC. D0400442* EXEC LEVEL I/O CALLS: WTREAD D0400443* USER LEVEL I/O CALLS: TSREAD,INPUT,OUTPUT,ETC. D0400444* TIMESLICE EXPIRE: SLICUP D0400445* D0400446* NOTE: THE REGISTERS Q,A, AND I ARE PRESERVED ACROSS D0400447* I/O CALLS EVEN IF DETACHED BY THE EXEC D0400448**** D0400449RELOAD EQU RELOAD(*) D0400450 STQ* QSAV SAVE Q D0400451 LDA IOVNUM IF NOT CURRENTLY ATTACHED, SKIP ATTACH CALL D0400452 SAM RELD1 D0400453 LDA* RELP MOVE P TO RELP2 D0400454 SAN RELD2 RELP MUST BE NON-ZERO AT THIS POINT D0400455* TEMPORARY DEBUGGING CK ONLY D0400456 ADC $18FF HANG D0400457RELD2 EQU RELD2(*) D0400458 STA* RELP2 D0400459* ATTACH TO PREVIOUS OVERLAY D0400460 RTJ ATTACH CALL ATTACH('IOVNUM',RELP) D0400461 ADC IOVNUM D0400462 ADC RELP D0400463 RTJ ATTCHK CHECK THE MULTI-USER ATTACHMENT. D0400464ÐÐRELD1 EQU RELD1(*) D0400465 ENA 0 CLEAR RELP FOR NEXT USAGE BY EXEC D0400466 STA* RELP D0400467 LDQ* QSAV D0400468 JMP* (RELP2) RETURN TO THE LAST EXIT POINT D0400469RELP ADC 0 LOCAL P SAVE D0400470RELP2 ADC 0 LAST RETURN POINT TO USER D0400471 EJT D0400472**** D0400473 ENT SAVADD,STOADD SAVE ADDRESS AND STORE VALUE INDIRECT D0400474* D0400475* FOR REENTRANT ROUTINES WHICH RETURN VALUES IN LOCATIONS D0400476* ACROSS I/O CALLS: THIS ACCOMPLISHES X=I WHERE X IS A D0400477* SUBROUTINE CALL PARAMETER AND I IS THE RETURNED VALUE. D0400478* THE CALLING SEQUENCES ARE: D0400479* CALL SAVADD(X) 'WHERE X IS THE RESULT ADDRESS D0400480* CALL STOADD(I) 'WHERE I IS THE RESULT VALUE D0400481**** D0400482SAVADD 0 0 D0400483 RTJ* (AQ8PREP) D0400484 ADC (SAVADD-*) D0400485 RTJ* (AQ8PKUP) D0400486 STA* ADDRX SAVE THE ADDRESS OF X D0400487 JMP* (SAVADD) D0400488* D0400489ÐÐSTOADD 0 0 D0400490 RTJ* (AQ8PREP) D0400491 ADC (STOADD-*) D0400492 RTJ* (AQ8PKUP) D0400493 STA* AVALUX D0400494 LDA* (AVALUX) MOVE VALUE OF I TO LOCATION X D0400495 STA* (ADDRX) D0400496 RAO* ADDRX INCREMENT SOURCE ADDRESS D0400497 JMP* (STOADD) D0400498ADDRX ADC 0 ADDRESS OF VARIABLE X D0400499AVALUX ADC 0 D0400500AQ8PREP ADC Q8PREP D0400501AQ8PKUP ADC Q8PKUP D0400502* D0400503 END D0400504 NAM EBEGIN D05 A ITOS CCS 3.0 SL-149D0500001* ITOS SOURCE LANGUAGE EDITOR SUBR. INITIAL PROGRAM IN OVERLAY D0500002* CREDIT COLLECTION SYSTEM VERSION 3.0 D0500003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA D0500004* COPYRIGHT CONTROL DATA CORPORATION 1978 D0500005* D0500006 SPC 3 D0500007**** D0500008* FUNCTION D0500009* -------- D0500010ÐÐ*S3 THIS ROUTINE PROVIDES LINKAGE BETWEEN THE D0500011* ROOT AND THE OVERLAY. D0500012*S5 GENERAL DESCRIPTION D0500013* ------- ----------- D0500014*S3 THE FIRST AND LAST LOCATION ADDRESSES OF THE D0500015* OVERLAY AND THE TRANSFER VECTOR TABLE ARE PART D0500016* OF THIS ROUTINE. THE EDITOR INITIALIZATION D0500017* SUBROUTINE IS CALLED BY THIS ROUTINE. D0500018*S5 ENTRY/EXIT D0500019* ---------- D0500020*S3 ENTRY TO THIS ROUTINE IS AT 'TXEDIT'. ENTRY D0500021* COMES FROM 'LOCAL' THROUGH THE TRANSFER VECTOR D0500022* TABLE. D0500023* D0500024* NO RETURN IS MADE TO THIS ROUTINE. D0500025*S5 ENTRIES D0500026* ------- D0500027* ENTRY POINT REFERENCED BY D0500028* ----- ----- ---------- -- D0500029* BEGIN ENDLOC D0500030* LOCAL D0500031*S5 EXTERNAL REFERENCES D0500032* -------- ---------- D0500033* EXTERNAL EXTERNAL D0500034* -------- -------- D0500035ÐÐ* ENDLOC INITLE D0500036* RETURN SAVE D0500037*S5 **NOTE** D0500038* -------- D0500039*S3 THIS MUST BE THE FIRST PROGRAM OF THE EDITOR OVERLAY 'EDITOS' D0500040**** D0500041 SPC 5 D0500042 ENT EBEGIN D0500043 EXT SAVE D0500044 EXT RETURN D0500045 EXT ENDLOC D0500046 EXT INITLE D0500047 SPC 5 D0500048 ENT BEGIN D0500049 EQU BEGIN(*) D0500050EBEGIN ADC *,ENDLOC FIRST AND LAST LOCATIONS OF THE OVERLAY. D0500051 ADC 0 MULTI-USER CODE FOR EDITOR D0500052TV ADC TXEDIT ENTRY 0 IN THE TRANSFER VECTOR TABLE. D0500053TXEDIT NOP 0 D0500054 RTJ SAVE CALL SAVE(TXEDIT): SAVE RETURN ON STACK D0500055 ADC TXEDIT D0500056 RTJ INITLE CALL SOURCE LANGUAGE EDITOR INITIALIZATION SUBD0500057 RTJ RETURN RETURN TO CALLER D0500058* CONTROL NEVER RETURNS HERE. D0500059 END D0500060ÐÐ NAM EDITOS D06 A ITOS CCS 3.0 SL-149D0600001* ITOS SOURCE LANGUAGE EDITOR CONTROL PROGRAM D0600002* CREDIT COLLECTION SYSTEM VERSION 3.0 D0600003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA D0600004* COPYRIGHT CONTROL DATA CORPORATION 1978 D0600005* D0600006 SPC 3 D0600007**** D0600008* FUNCTION D0600009* -------- D0600010*S3 THIS PROGRAM IS THE CONTROL PROGRAM FOR THE ITOS D0600011* SOURCE LANGUAGE EDITOR. D0600012*S5 GENERAL FLOW D0600013* ------- ---- D0600014*S3 THE MAIN PURPOSE OF THE CONTROL MODULE IS TO CALL D0600015* THE APPROPRIATE PROCESSOR AS REQUESTED BY THE USER. D0600016* THE OPERATIONS PERFORMED BY THIS PROGRAM INCLUDE: D0600017* 1. OUTPUT THE MESSAGE 'READY' AND REQUEST D0600018* INPUT FROM THE USER D0600019* 2. THE INPUT TERMINATION CODE IS THE CHECKED. D0600020* IF IT IS A RUB OUT, THE REQUEST IS REPEATED. D0600021* IF IT IS A LINE FEED OR CARRIAGE RETURN AND D0600022* NO DATA WAS ENTERED, THE SINGLE LINE ENTRY D0600023* PROCESSOR IS ENTERED. IF IT IS A LINE FEED D0600024* OR CARRIAGE RETURN AND SOME DATA CHARACTERS D0600025ÐÐ* WERE ENTERED, THE INPUT COMMAND PROCESSOR IS D0600026* ENTERED. D0600027* ANY OTHER TERMINATION CODE WILL CAUSE THE D0600028* ERROR 'INVALID COMMAND' TO BE OUTPUT. D0600029* 3. THE INPUT COMMAND PROCESSOR CHECKS THE VALIDITY D0600030* COMMAND INPUT BY THE USER. THE FIRST CHECK D0600031* IS FOR 6 OR LESS CHARACTERS IN THE COMMAND. D0600032* IF MORE THAN 6 CHARACTERS ARE ENCOUNTERED BEFORE D0600033* A DATA DELIMITER (A COMMA OR END OF DATA) D0600034* THE ERROR 'INVALID COMMAND' IS OUTPUT. D0600035* THE NEXT CHECK IS FOR A UNIQUE COMMAND NAME. D0600036* IF MORE THAN ONE COMMAND EXISTS WITH SAME NAME D0600037* (OR ABBREVIATED NAME) THE ERROR 'COMMAND NAME D0600038* NOT UNIQUE' IS OUTPUT. D0600039* THE FINAL CHECK IS MADE FOR THE COMMAND NAME D0600040* EXISTING AT ALL. IF IT DOES NOT EXIST, THE D0600041* ERROR 'INVALID COMMAND' IS OUTPUT. D0600042* PASSING ALL OF THE ABOVE CHECKS, THE ADDRESS D0600043* OF THE PROCESSOR IS CALCULATED AND THE PROCESSOR D0600044* IS CALLED. D0600045* AFTER RETURNING FROM THE PROCESSOR THE D0600046* ERROR FLAG IS CHECKED. IF A FATAL EDITOR D0600047* ERROR OCCURS THE EDITOR IS TERMINATED. D0600048* IF NO FATAL ERRORS OCCUR, THE INPUT COMMAND D0600049* BUFFER IS INITIALIZED AND THE 'READY' MESSAGE D0600050ÐÐ* IS OUTPUT. D0600051* 4. THE PROGRAM ALSO CONTAINS THE ASCII COMMAND D0600052* LIST WHICH CONTAINS ALL OF THE VALID COMMANDS D0600053* FOR THE EDITOR. IT ALSO CONTAINS THE PROCESSOR D0600054* VECTOR TABLE WHICH CONTAINS THE ADDRESSES D0600055* OF ALL VALID EDITOR PROCESSORS. D0600056* 5. THIS PROGRAM INCLUDES THE EXIT PROCESSOR. D0600057* THIS PROCESSOR IS USED TO LEAVE THE EDITOR D0600058* FROM EITHER A NORMAL (EXIT COMMAND) OR ABNORMAL D0600059* (FATAL EDITOR ERROR) CONDITION. D0600060* A CALL IS MADE TO THE CLEAR PROCESSOR TO UPDATE D0600061* THE FCB FOR THE FILE CURRENTLY BEING USED D0600062* AND TO RESEQUENCE IT IF NECESSARY. D0600063* UPON RETURN FROM THE CLEAR PROCESSOR A RETURN D0600064* IS MADE TO THE CALLING PROGRAM D0600065* 6. THE COMMAN PROCESSOR, WHICH IS PART OF THIS D0600066* PROGRAM, PRINTS A LIST OF ALL AVAILABLE D0600067* EDITOR COMMANDS INCLUDING AN ABBREVIATED D0600068* PARAMETER STRING FOR EACH COMMAND. D0600069* UPON COMPLETION OF THE PROCESSOR, RETURN D0600070* IS MADE TO THE MAIN CONTROL SECTION. D0600071*S5 ENTRY/EXIT D0600072* ---------- D0600073*S3 ENTRY TO THIS PROCESSOR IS FROM THE EDITOR INITIALIZATION D0600074* PROGRAM 'INITLE'. D0600075ÐÐ* D0600076* EXIT TO 'INITLE' OCCURS THRU THE EXIT PROCESSOR D0600077* FROM EITHER A NORMAL OR ABNORMAL EXIT CONDITION. D0600078*S5 ERROR MESSAGES D0600079* ----- -------- D0600080*S3 TWO ERROR MESSAGES ARE OUTPUT BY THIS PROGRAM. D0600081* 1. EDITOR ERROR 308 D0600082* 'COMMAND NAME NOT UNIQUE' D0600083* 2. EDITOR ERROR 309 D0600084* 'INVALID COMMAND' D0600085*S5 ENTRIES D0600086* ------- D0600087*S3 ENTRY POINT REFERENCED BY D0600088* ----- ----- ---------- -- D0600089* EDITOS INITLE D0600090*S5 EXTERNAL REFERENCES D0600091* -------- ---------- D0600092*S3 EXTERNAL EXTERNAL D0600093* -------- -------- D0600094* WTREAD SYSMSG D0600095* ELNSCN AUTPRO D0600096* CHAPRO CLEPRO D0600097* CTAPRO DELPRO D0600098* GETPRO LSTPRO D0600099* RSQPRO SEAPRO D0600100ÐÐ* SEQPRO STAPRO D0600101* SAVE RETURN D0600102* SET LINPRO D0600103* OUTPUT D0600104**** D0600105 EJT D0600106* EDITCM---------------APRIL 08, 1977---------------------------D0600107 DAT CMNDBF(41),FBUFFR(800),TBUFFR(41),FMOPEN(15) D0600108 DAT REQBUF(24),FCBBUX(101),IDATA(10),NUMFLD(3),NUMBER(3) D0600109 DAT LINBUF(54),IS(3600),IRECPT(2),ALFFLD(3) D0600110 DAT NAMFIL(8),SLRQBF(24),SLFCBX(101),NW(2),TABBUF(20) D0600111 DAT RECBUF(41),SCRQBF(24),ISCRPT(2),SCFCBX(101) D0600112 DAT TEMHOL(7),SAVRTN(42),STRBF1(20),STRBF2(20) D0600113 DAT ICRBUF(24),ISSAVE(2),IPGMID(3) D0600114 DAT COMMAF,ICHARC,IDXWRD,IWRDIX,J,NUMHEX,BEGLIN,FCBADR D0600115 DAT ENDLIN,IERRFG,IFLAGX,LINENO,STNMBR,TERMLU,IA,ISTAT D0600116 DAT CHARNO,FRSTIM,GOTCHR,IMODE,IDELFG,ICHAR,IENPLN,IENX D0600117 DAT IMADR,IRRP,LINIDX,ITCHAR,ID,I1,HIREF,ILEAST,IX D0600118 DAT IB,IC,IRCIDX,SLFADR,ISREF,NOREF,IMAX,CB,TABIDX D0600119 DAT IMOD,NOPORT,ISSIZE,IPGSIZ,FBSIZE,NOPAGS D0600120 DAT ILOCAT,IMADRL,IREF,IT,IY,IZ,IDUMB,RSQINC,RSQNUM D0600121 DAT AUTOFG,FORMTP,ICORDS,ISCRLN,IEOFFM,TC,TEPMID,SCRADR D0600122 DAT NUMFLG,EXPCOM,Y,XWORD,COUNT,SAVEQ,MATCHX,IDELIM D0600123 DAT IRADD,ISRMCH,ISTRST,ICHSTO,ICHANG,ISEAFG,ISRLNG D0600124 DAT IWTCRD,IHIRRP,ISTATX,IBLKSZ,NRECST,IENREC D0600125ÐÐ DAT ISPACE(50) D0600126 EQU USERID(NAMFIL+4) D0600127 EQU FCBBUF(FCBBUX+5) D0600128 EQU SLFCBF(SLFCBX+5) D0600129 EQU SCFCBF(SCFCBX+5) D0600130* EDITCM END D0600131 EJT D0600132* ENTRY POINT D0600133* EXTERNAL REFERENCES D0600134 ENT EDITOS D0600135 EXT WTREAD WRITE READ PROCESSOR D0600136 EXT SYSMSG SYSTEM MESSAGE PROCESSOR D0600137 EXT ELNSCN NEXT CHARACTER SUBROUTINE D0600138 EXT AUTPRO AUTO PROCESSOR D0600139 EXT CHAPRO CHANGE PROCESSOR D0600140 EXT CLEPRO CLEAR PROCESSOR D0600141 EXT CTAPRO CLEAR TAB STOP PROCESSOR D0600142 EXT DELPRO DELETE PROCESSOR D0600143 EXT GETPRO GET PROCESSOR D0600144 EXT LSTPRO LIST PROCESSOR D0600145 EXT RSQPRO RESEQUENCE PROCESSOR D0600146 EXT SEAPRO SEARCH PROCESSOR D0600147 EXT SEQPRO D0600148 EXT STAPRO STATUS PROCESSOR D0600149 EXT SAVE SAVE ENTRY ADDRESS SUBROUTINE D0600150ÐÐ EXT RETURN RETURN TO CALLER SUBROUTINE D0600151 EXT SET SET A BUFFER TO A SPECIFIC DATA PATTERN D0600152 EXT LINPRO SINGLE LINE ENTRY PROCESSOR D0600153 EXT RWRITE WRITE PROCESSOR 123*4922D0600154 EJT D0600155* EQUIVALENCES D0600156 EQU LPMSK(2) D0600157 EQU ONEBIT($23) D0600158 EQU M1($33) D0600159 EQU N3(4) D0600160 EQU ZERO($22) D0600161 SPC 5 D0600162* MESSAGES D0600163MESG2 NUM $0A0D D0600164 NUM $1600 LINE CLEAR D0600165 ALF *,READY* D0600166LMESG2 ADC *-MESG2 D0600167 SPC 3 D0600168MESG1A NUM $1800 D0600169 ALF *,AUTO,TYPE,BASE,INCR,IDENT :R:L* D0600170 ALF *,CHANGE,OSTR,NSTR,STRT,END,SCOL,ECOL,VETO:R:L* D0600171 ALF *,CLEAR :R:L* D0600172 ALF *,COMMAN:R:L* D0600173 ALF *,CTAB:R:L* D0600174 ALF *,DELETE,STRT,END :R:L* 123*4922D0600175ÐÐLMSG1A ADC *-MESG1A D0600176MESG1B ALF *,EXIT:R:L* D0600177 ALF *,GET,FN,R:R:L* D0600178 ALF *,LINE,NMBR,TYPE:R:L* D0600179 ALF *,LIST,STRT,END :R:L* D0600180 ALF *,RESEQ,BASE,INCR :R:L* D0600181 ALF *,SEARCH,STR,STRT,END,SCOL,ECOL :R:L* D0600182 ALF *,SEQUEN,FN,R,N :R:L* D0600183LMSG1B ADC *-MESG1B D0600184MESG1C ALF *,STAB,TYPE/N1,N2,...,N20 :R:L D0600185LMSG1C ADC *-MESG1C D0600186EDER08 NUM 308 D0600187EDER09 NUM 309 D0600188N40 NUM 40 D0600189 EJT D0600190EDITOS NOP 0 D0600191 RTJ SAVE SAVE ENTRY FOR RETURN D0600192 ADC EDITOS D0600193EREADY RTJ SET SET THE COMMAND BUFFER TO $FFFF D0600194 ADC CMNDBF D0600195 ADC N40 D0600196 ADC LPMSK+16 D0600197 SPC 1 D0600198 RTJ WTREAD OUTPUT READY AND INPUT COMMAND D0600199 ADC TERMLU D0600200ÐÐ ADC M1 D0600201 ADC MESG2 D0600202 ADC LMESG2 D0600203 ADC M1 D0600204 ADC CMNDBF D0600205 ADC N40 D0600206 ADC TC D0600207 LDA TC IS THE TERMINATION CODE A RUBOUT D0600208 INA -4 D0600209 SAN CHKTC NO, IS IT A LINE FEED D0600210 JMP* EREADY YES, REPEAT THE REQUEST D0600211CHKTC INA 1 IS IT A LINE FEED D0600212 SAZ LINENT YES D0600213 INA 1 NO, IS IT A CARRIAGE RETURN D0600214 SAZ LINENT YES D0600215 JMP INVCMD NO, ANYTHING ELSE IS INVALID D0600216LINENT LDA CMNDBF+40 WAS ANY DATA INPUT D0600217 SAN TSTCMD YES, THIS MUST BE A COMMAND INPUT D0600218 JMP INVCMD ZERO LENGTH REQUEST IS ILLEGAL D0600219 EJT D0600220* CHECK FOR A VALID COMMAND D0600221 SPC 2 D0600222TSTCMD ENA LISTLN GET THE LENGTH OF THE COMMAND LIST D0600223 CLR Q D0600224 DVI- N3 DETERMINE THE NUMBER OF ENTRIES IN THE LIST D0600225ÐÐ TRA Q D0600226 CLR A D0600227CLRCEL STA MATCH-1,Q CLEAR THE MATCH TABLE D0600228 INQ -1 D0600229 SQZ CLDUN D0600230 JMP* CLRCEL D0600231CLDUN STA EXPCOM CLEAR THE EXPECT A COMMA FLAG D0600232 STA COMMAF CLEAR THE COMMA ENCOUNTERED FLAG D0600233 STA Y CLEAR THE LIST BYTE FLAG D0600234 STA XWORD CLEAR THE LIST WORD FLAG D0600235 STA COUNT CLEAR THE MATCH COUNT FLAG D0600236 STA- I CLEAR THE MATCH ENTRY FLAG D0600237 STA IERRFG CLEAR THE ERROR FLAG D0600238 STA ICHARC CLEAR THE OUT OF DATA FLAG D0600239 ENA 1 SET UP TO GET THE FIRST CHARACTER D0600240 STA CHARNO D0600241XYZ RTJ ELNSCN D0600242 LDA ICHARC GET THE CHARACTER D0600243 SAP CHARGT IS THERE A CHARACTER D0600244 JMP* COMEND NO, THIS IS THE END OF THE INPUT D0600245CHARGT INA -$20 IS THIS CHARACTER A BLANK D0600246 SAN XYZTST NO D0600247 JMP* COMEND YES, THIS IS THE END OF THE INPUT D0600248XYZTST INA $20-$2C IS THIS A COMMA D0600249 SAN XGET0 NO D0600250ÐÐ RAO COMMAF YES, SET THE COMMA ENCOUNTERED FLAG D0600251 JMP* COMEND THIS IS THE END OF THE INPUT D0600252XGET0 CLR A D0600253 STA COUNT CLEAR THE MATCH COUNT FLAG D0600254 STA- I CLEAR THE MATCH ENTRY FLAG D0600255 LDA EXPCOM SHOULD THIS CHARACTER BE A DATA TERMINATOR D0600256 SAZ XGET NO D0600257 JMP INVCMD YES, THIS IS AN INVALID COMMAND D0600258XGET LDQ XWORD GET THE LIST WORD FLAG D0600259XGET1 LDA MATCH,I SEE IF THIS ENTRY HAS MATCHED SO FAR D0600260 SAZ GT1 D0600261 JMP* NOTFD1 NO D0600262GT1 STQ SAVEQ YES, CHECK THE NEXT CHARACTER D0600263 LDQ* COMNDS,Q GET THE WORD FROM THE LIST D0600264 LDA Y DETERMINE WHICH BYTE THE CHARACTER IS IN D0600265 SAZ GT2 D0600266 QLS 8 POSITION THE CHARACTER FOR CHECKING D0600267GT2 LLS 8 D0600268 LDQ SAVEQ D0600269 EOR ICHARC DOES THE CHARACTER MATCH D0600270 SAZ FND YES D0600271 STA MATCH,I NO, SET THE NO MATCH FLAG FOR THIS ENTRY D0600272 JMP* NOTFD1 D0600273FND LDA I SAVE THE MATCH INDEX D0600274 STA MATCHX D0600275ÐÐ RAO COUNT INCREMENT THE MATCH COUNTER D0600276NOTFD1 INQ 3 POINT TO THE NEXT LIST ENTRY, SAME COLUMN D0600277 TRQ A D0600278 INA -LISTLN IS THIS COLUMN DONE D0600279 SAP XEND YES D0600280 RAO- I NO, CHECK THE NEXT LIST ENTRY D0600281 JMP* XGET1 D0600282XEND LDA COUNT ARE THERE ANY MATCHES D0600283 SAN CONSRH YES D0600284 JMP INVCMD NO, THIS IS AN INVALID COMMAND D0600285CONSRH LDA CHARNO HAVE SIX CHARACTERS BEEN SCANNED D0600286 INA -7 D0600287 SAN XEND2 NO D0600288 RAO EXPCOM YES, SET THE EXPECT A COMMA FALG D0600289XEND2 LDA Y SET UP TO GET THE OTHER BYTE OF THE WORD D0600290 EOR- ONEBIT+15 D0600291 STA Y D0600292 SAM X1 D0600293 RAO XWORD GO TO THE NEXT WORD D0600294X1 JMP* XYZ GET THE NEXT CHARACTER FORM THE COMMAND D0600295COMEND LDA COUNT ARE THERE ANY MATCHES D0600296 SAN AMATCH YES D0600297 JMP INVCMD NO, THIS IS AN INVALID COMMAND D0600298AMATCH INA -1 IS THERE JUST ONE MATCH D0600299 SAZ XEND5 YES D0600300ÐÐ RTJ SYSMSG NO, OUTPUT THE ERROR 'NAME NOT UNIQUE' D0600301 ADC EDER08 D0600302 ADC IDATA D0600303 JMP* RUNING D0600304XEND5 LDQ TEPMID GET THE EDITOR INDEX D0600305 LDQ DISTAB,Q GET THE TABLE ADDRESS OF THE COMMAND TABLE D0600306 SQN XEND5A D0600307 JMP INVCMD THE INDEX IS INVALID. SOMETHING IS WRONG D0600308XEND5A ADQ MATCHX ADD IN THE INDEX INTO THE COMMAND TABLE D0600309 LDQ- (ZERO),Q GET THE PROCESSOR ADDRESS D0600310 RTJ- (ZERO),Q EXECUTE THE PROCESSOR D0600311XEND6 LDA IERRFG HAS AN EDITOR FATAL ERROR OCCURRED D0600312 SAP RUNING NO D0600313 JMP EXIT YES, TERMINATE THE EDITOR D0600314RUNING CLR A,Q D0600315 STA IFLAGX CLEAR MANUAL INTERRUPT FLAG D0600316 STA IERRFG CLEAR THE ERROR FLAG D0600317 JMP EREADY OUTPUT READY AND INPUT NEXT STATEMENT D0600318 EJT D0600319* COMMAND LIST D0600320COMNDS ALF 3,AUTO D0600321 ALF 3,CHANGE D0600322 ALF 3,CLEAR D0600323 ALF 3,COMMAN D0600324 ALF 3,CTAB D0600325ÐÐ ALF 3,DELETE D0600326 ALF 3,EXIT D0600327 ALF 3,GET D0600328 ALF 3,LINE D0600329 ALF 3,LIST D0600330 ALF 3,RESEQ D0600331 ALF 3,SEARCH D0600332 ALF 3,SEQUEN D0600333 ALF 3,STAB D0600334 EQU LISTLN(*-COMNDS) D0600335MATCH BZS MATCH(LISTLN/3) D0600336* ADDRESS OF VECTOR TABLES D0600337* INDEX IS PROGRAM ID D0600338DISTAB ADC EVETAB EDITOR VECTOR TABLE D0600339ZZ BZS ZZ(14) D0600340* EDITOR VECTOR TABLE D0600341* INDEX IS MATCH INDEX D0600342EVETAB ADC AUTPRO D0600343 ADC CHAPRO D0600344 ADC CLEPRO D0600345 ADC COMPRO D0600346 ADC CTAPRO D0600347 ADC DELPRO D0600348 ADC EXIT D0600349 ADC GETPRO D0600350ÐÐ ADC LINPRO D0600351 ADC LSTPRO D0600352 ADC RSQPRO D0600353 ADC SEAPRO D0600354 ADC SEQPRO D0600355 ADC STAPRO D0600356EXIT NOP 0 D0600357 RTJ CLEPRO FINISH OFF THE FCB AND RESEQUENCE THE FILE D0600358 RTJ RETURN RETURN TO CALLING PROGRAM D0600359 EJT D0600360* INVALID COMMAND D0600361INVCMD RTJ SYSMSG OUTPUT THE ERROR 'INVALID COMMAND' D0600362 ADC EDER09 D0600363 ADC IDATA D0600364 JMP* RUNING D0600365* D0600366* HELP PROCESSOR D0600367* D0600368 SPC 5 D0600369COMPRO NOP 0 COMMAND LIST PROCESSOR ENTRY D0600370 RTJ SAVE D0600371 ADC COMPRO D0600372 RTJ RWRITE OUTPUT FIRST PART OF MESSAGE 123*4922D0600373 ADC TERMLU D0600374 ADC MESG1A D0600375ÐÐ ADC LMSG1A D0600376 RTJ RWRITE OUTPUT SECORD PART OF MESSAGE 123*4922D0600377 ADC TERMLU D0600378 ADC MESG1B D0600379 ADC LMSG1B D0600380 RTJ RWRITE OUTPUT THIRD PART OF MESSAGE 123*4922D0600381 ADC TERMLU D0600382 ADC MESG1C D0600383 ADC LMSG1C D0600384 RTJ RETURN D0600385 END D0600386 NAM DECHEX D08 A ITOS CCS 3.0 SL-149D0800001* ITOS SOURCE LANGUAGE EDITOR SUBR. CONVERT DECIMAL ASCII TO BINARYD0800002* CREDIT COLLECTION SYSTEM VERSION 3.0 D0800003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA D0800004* COPYRIGHT CONTROL DATA CORPORATION 1978 D0800005* D0800006 SPC 4 D0800007**** D0800008* FUNCTION D0800009* -------- D0800010*S3 THE FUNCTION OF THIS PROGRAM IS TO CONVERT DECIMAL D0800011* ASCII TO BINARY. D0800012*S5 GENERAL FLOW D0800013* ------- ---- D0800014ÐÐ*S3 THIS PROGRAM CONVERTS A 3-WORD INPUT BUFFER CONTAINING D0800015* DECIMAL CODED ASCII CHARACTERS INTO A 1-WORD BINARY D0800016* NUMBER. AS EACH CHARACTER IS PICKED UP IT IS CHECKED D0800017* TO MAKE SURE IT IS BETWEEN 0 AND 9. IF IT IS NOT, THE D0800018* ERROR 'ILLEGAL LINE NUMBER @@@@@@' IS OUTPUT, THEN THE D0800019* ERROR FLAG IS SET AND THE PROGRAM IS EXITED. D0800020* THE PROGRAM USES AN INTERMEDIATE BUFFER FOR CONVERSION D0800021* SO THE INPUT AND OUTPUT BUFFERS MAY BE THE SAME AREA. D0800022*S5 ENTRY/EXIT D0800023* ---------- D0800024*S3 CALL DECHEX(IBUF,IVAL) D0800025* WHERE IVAL MAY BE THE SAME AS IBUF. D0800026* IBUF IS A 3-WORD CHARACTER BUFFER. D0800027* IVAL IS A 1-WORD OUTPUT VALUE. D0800028* D0800029* EXIT RETURNS WITH A BINARY VALUE IN IVAL. D0800030*S5 ERROR MESSAGES D0800031* ----- -------- D0800032*S3 THE ERROR MESSAGE EDITOR ERROR 301 D0800033* 'ILLEGAL LINE NUMBER @@@@@@' D0800034* IS OUTPUT BY THIS PROGRAM. D0800035*S5 ENTRIES D0800036* ------- D0800037*S3 ENTRY POINT REFERENCED BY D0800038* ----- ----- ---------- -- D0800039ÐÐ* DECHEX LINPRO D0800040* RSQPRO D0800041* GETNUM D0800042* SLIBLD D0800043* EXTERNAL REFERENCES D0800044* -------- ---------- D0800045* EXTERNAL EXTERNAL D0800046* -------- -------- D0800047* Q8PKUP Q8PREP D0800048* SYSMSG D0800049**** D0800050 EJT D0800051* EDITCM---------------APRIL 08, 1977---------------------------D0800052 DAT CMNDBF(41),FBUFFR(800),TBUFFR(41),FMOPEN(15) D0800053 DAT REQBUF(24),FCBBUX(101),IDATA(10),NUMFLD(3),NUMBER(3) D0800054 DAT LINBUF(54),IS(3600),IRECPT(2),ALFFLD(3) D0800055 DAT NAMFIL(8),SLRQBF(24),SLFCBX(101),NW(2),TABBUF(20) D0800056 DAT RECBUF(41),SCRQBF(24),ISCRPT(2),SCFCBX(101) D0800057 DAT TEMHOL(7),SAVRTN(42),STRBF1(20),STRBF2(20) D0800058 DAT ICRBUF(24),ISSAVE(2),IPGMID(3) D0800059 DAT COMMAF,ICHARC,IDXWRD,IWRDIX,J,NUMHEX,BEGLIN,FCBADR D0800060 DAT ENDLIN,IERRFG,IFLAGX,LINENO,STNMBR,TERMLU,IA,ISTAT D0800061 DAT CHARNO,FRSTIM,GOTCHR,IMODE,IDELFG,ICHAR,IENPLN,IENX D0800062 DAT IMADR,IRRP,LINIDX,ITCHAR,ID,I1,HIREF,ILEAST,IX D0800063 DAT IB,IC,IRCIDX,SLFADR,ISREF,NOREF,IMAX,CB,TABIDX D0800064ÐÐ DAT IMOD,NOPORT,ISSIZE,IPGSIZ,FBSIZE,NOPAGS D0800065 DAT ILOCAT,IMADRL,IREF,IT,IY,IZ,IDUMB,RSQINC,RSQNUM D0800066 DAT AUTOFG,FORMTP,ICORDS,ISCRLN,IEOFFM,TC,TEPMID,SCRADR D0800067 DAT NUMFLG,EXPCOM,Y,XWORD,COUNT,SAVEQ,MATCHX,IDELIM D0800068 DAT IRADD,ISRMCH,ISTRST,ICHSTO,ICHANG,ISEAFG,ISRLNG D0800069 DAT IWTCRD,IHIRRP,ISTATX,IBLKSZ,NRECST,IENREC D0800070 DAT ISPACE(50) D0800071 EQU USERID(NAMFIL+4) D0800072 EQU FCBBUF(FCBBUX+5) D0800073 EQU SLFCBF(SLFCBX+5) D0800074 EQU SCFCBF(SCFCBX+5) D0800075* EDITCM END D0800076 ENT DECHEX D0800077 EXT* Q8PKUP D0800078 EXT* Q8PREP D0800079 EXT SYSMSG D0800080 EQU ONEMSK(3) D0800081 EQU ONEBIT($23) D0800082DECHEX NUM 0 D0800083 LDA- I SAVE I,Q D0800084 STA* ISAVE D0800085 STQ* QSAVE D0800086 RTJ Q8PREP PICK UP PARAMETER LOCATIONS D0800087 ADC* DECHEX D0800088 RTJ Q8PKUP D0800089ÐÐ STA* IBUF D0800090 RTJ Q8PKUP D0800091 STA* IVAL D0800092 ENA 0 INITIALIZE D0800093 STA* IDX CHAR IDX D0800094 STA* TEMP VALUE D0800095 STA- I INPUT BUFFER WORD POINTER D0800096DEC4 ENQ 0 CONVERT LOOP D0800097 LDA* TEMP D0800098 MUI =N10 D0800099 STA* TEMP D0800100 LDA* (IBUF),I GET NEXT WORD D0800101 LDQ* IDX IS LS CHAR D0800102 SQN DEC8 YES D0800103 ARS 8 NO, RIGHT JUSTIFY D0800104DEC8 AND- ONEMSK+7 MASK D0800105 SUB =N$3A IS THIS A VALID DECIMAL NUMBER D0800106 SAM DEC09 IS IT .LT. $3A D0800107 JMP* DECERR NO, OUTPUT THE ERROR D0800108DEC09 INA $A IS IT .GE. $30 D0800109 SAP DEC10 YES D0800110 JMP* DECERR NO, OUTPUT THE ERROR D0800111DEC10 ADD* TEMP ADD TO THE ACCUMULATOR D0800112 STA* TEMP D0800113 TRQ A CHAR IDX D0800114ÐÐ EOR- ONEBIT SWITCH CHAR IDX D0800115 STA* IDX D0800116 SAN DEC12 LS NEXT, SAME WORD D0800117 LDA- I CHECK END OF BUFFER D0800118 INA -2 D0800119 SAZ DEC16 DONE D0800120 RAO- I BUMP WORD INDEX D0800121DEC12 JMP* DEC4 DO NEXT CHARACTER D0800122DEC16 LDA* ISAVE RESTORE I,Q D0800123 STA- I D0800124 LDQ* QSAVE D0800125 LDA* TEMP D0800126 STA* (IVAL) D0800127 JMP* (DECHEX) D0800128DECERR ENA 0 CLEAR THE ERROR WORDS IN IDATA D0800129 STA IDATA D0800130 STA IDATA+1 D0800131 RTJ SYSMSG OUTPUT THE ERROR - ILLEGAL LINE NUMBER D0800132 ADC EDER01 D0800133 ADC IDATA D0800134 ENA 1 SET THE ERROR FLAG D0800135 STA IERRFG D0800136 JMP* DEC16 D0800137EDER01 NUM 301 D0800138IDX NUM 0 D0800139ÐÐIBUF NUM 0 D0800140IVAL NUM 0 D0800141TEMP NUM 0 D0800142QSAVE NUM 0 D0800143ISAVE NUM 0 D0800144 END D0800145 NAM ENDLOC D09 A ITOS CCS 3.0 SL-149D0900001* ITOS SOURCE LANGUAGE EDITOR SUBR. TO MARK THE END OF THE OVERLAY D0900002* CREDIT COLLECTION SYSTEM VERSION 3.0 D0900003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA D0900004* COPYRIGHT CONTROL DATA CORPORATION 1978 D0900005* D0900006*** D0900007* FUNCTION D0900008* -------- D0900009*S3 THIS IS A DUMMY ROUTINE TO MARK THE END OF THE D0900010* OVERLAY AND TO PROVIDE SPACE FOR VIRTUAL MEMORY. D0900011*S5 GENERAL DESCRIPTION D0900012* ------- ----------- D0900013*S3 ENDLOC CONSISTS OF AN ENTRY POINT AND A BLOCK AREA. D0900014* THE ROUTINE CONTAINS NO EXECUTABLE CODE. D0900015*S5 ENTRIES D0900016* ------- D0900017*S3 ENTRY POINT REFERENCED BY D0900018* ----- ----- ---------- -- D0900019ÐÐ* ENDLOC EBEGIN D0900020*** D0900021 SPC 2 D0900022 ENT ENDLOC D0900023 EXT BEGIN D0900024ENDLOC ADC BEGIN,ENDLOC D0900025 END D0900026 MON 00001 MACRO EDITCM E0100001C E01 F ITOS CCS 3.0 SL-149E0100002C COMMON MACRO FOR EDITOR FORTRAN PROGRAMS E0100003C CREDIT COLLECTION SYSTEM VERSION 3.0 VERSION 2.0 E0100004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E0100005C COPYRIGHT CONTROL DATA CORPORATION 1978 E0100006C E0100007 COMMON/EDITCM/CMNDBF(41),FBUFFR(800),TBUFFR(41),FMOPEN(15) E0100008 COMMON/EDITCM/REQBUF(24),FCBBUX(101),IDATA(10),NUMFLD(3),NUMBER(3)E0100009 COMMON/EDITCM/LINBUF(54), IS(3600),IRECPT(2),ALFFLD(3) E0100010 COMMON/EDITCM/NAMFIL(8),SLRQBF(24),SLFCBX(101),NW(2),TABBUF(20) E0100011 COMMON/EDITCM/RECBUF(41),SCRQBF(24),ISCRPT(2),SCFCBX(101) E0100012 COMMON/EDITCM/TEMHOL(7),SAVRTN(42),STRBF1(20),STRBF2(20) E0100013 COMMON/EDITCM/ICRBUF(24),ISSAVE(2),IPGMID(3) E0100014 COMMON/EDITCM/COMMAF, ICHARC,IDXWRD,IWRDIX,J,NUMHEX,BEGLIN,FCBADRE0100015 COMMON/EDITCM/ENDLIN,IERRFG,IFLAGX,LINENO,STNMBR,TERMLU,IA,ISTAT E0100016 COMMON/EDITCM/CHARNO,FRSTIM,GOTCHR,IMODE,IDELFG,ICHAR,IENPLN,IENX E0100017ÐÐ COMMON/EDITCM/IMADR,IRRP,LINIDX,ITCHAR,ID, I1,HIREF,ILEAST,IX E0100018 COMMON/EDITCM/IB,IC,IRCIDX, SLFADR,ISREF,NOREF,IMAX,CB,TABIDXE0100019 COMMON/EDITCM/IMOD,NOPORT, ISSIZE,IPGSIZ,FBSIZE,NOPAGS E0100020 COMMON/EDITCM/ILOCAT,IMADRL,IREF, IT,IY,IZ,IDUMB,RSQINC,RSQNUME0100021 COMMON/EDITCM/AUTOFG,FORMTP,ICORDS,ISCRLN,IEOFFM,TC,TEPMID,SCRADR E0100022 COMMON/EDITCM/NUMFLG,EXPCOM,Y,XWORD,COUNT,SAVEQ,MATCHX,IDELIM E0100023 COMMON/EDITCM/IRADD,ISRMCH,ISTRST,ICHSTO,ICHANG,ISEAFG,ISRLNG E0100024 COMMON/EDITCM/IWTCRD,IHIRRP,ISTATX,IBLKSZ,NRECST,IENREC E0100025 COMMON/EDITCM/ISPACE(50) E0100026 INTEGER ALFFLD E0100027 INTEGER AUTOFG E0100028 INTEGER BEGLIN E0100029 INTEGER CB E0100030 INTEGER CHARNO E0100031 INTEGER CMNDBF E0100032 INTEGER COMMAF E0100033 INTEGER COUNT E0100034 INTEGER ENDLIN E0100035 INTEGER EXPCOM E0100036 INTEGER FBSIZE E0100037 INTEGER FBUFFR E0100038 INTEGER FCBADR E0100039 INTEGER FCBBUF E0100040 INTEGER FCBBUX E0100041 INTEGER FMOPEN E0100042ÐÐ INTEGER FORMTP E0100043 INTEGER FRSTIM E0100044 INTEGER GOTCHR E0100045 INTEGER HIREF E0100046 INTEGER RECBUF E0100047 INTEGER REQBUF E0100048 INTEGER RSQINC E0100049 INTEGER RSQNUM E0100050 INTEGER SAVEQ E0100051 INTEGER SAVRTN E0100052 INTEGER SCFCBF E0100053 INTEGER SCFCBX E0100054 INTEGER SCRADR E0100055 INTEGER SCRQBF E0100056 INTEGER SLFADR E0100057 INTEGER SLFCBF E0100058 INTEGER SLFCBX E0100059 INTEGER SLRQBF E0100060 INTEGER STNMBR E0100061 INTEGER STRBF1 E0100062 INTEGER STRBF2 E0100063 INTEGER TABBUF E0100064 INTEGER TABIDX E0100065 INTEGER TBUFFR E0100066 INTEGER TC E0100067ÐÐ INTEGER TEMHOL E0100068 INTEGER TEPMID E0100069 INTEGER TERMLU E0100070 INTEGER USERID E0100071 INTEGER XWORD E0100072 INTEGER Y E0100073 DIMENSION USERID(4) E0100074 DIMENSION FCBBUF(96) E0100075 DIMENSION SLFCBF(16) E0100076 DIMENSION SCFCBF(96) E0100077 EQUIVALENCE (USERID(1),NAMFIL(5)) E0100078 EQUIVALENCE (FCBBUF(1),FCBBUX(6)) E0100079 EQUIVALENCE (SLFCBF(1),SLFCBX(6)) E0100080 EQUIVALENCE (SCFCBF(1),SCFCBX(6)) E0100081 EQUIVALENCE (IRESFG,ISPACE(1)) E0100082 EQUIVALENCE (ICURCH,ISPACE(2)) E0100083 EQUIVALENCE (IRELRC,ISPACE(3)) E0100084 END E0100085 PROGRAM EDCOMM E0200001 1 /E02 F ITOS CCS 3.0 SL-149E0200002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO DECLARE LABELLED COMMON AREA E0200003C CREDIT COLLECTION SYSTEM VERSION 3.0 VERSION 2.0 E0200004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E0200005C COPYRIGHT CONTROL DATA CORPORATION 1978 E0200006C E0200007ÐÐC*** E0200008C FUNCTION E0200009C -------- E0200010CS3 THIS ROUTINE DEFINES LABELLED COMMON FOR THE EDITOR. E0200011CS5 GENERAL DESCRIPTION E0200012C ------- ----------- E0200013CS3 THIS LABELLED COMMON BLOCK RESIDES IN THE EDITOR E0200014C ROOT. IT CONTAINS ALL INFORMATION WHICH MUST BE E0200015C PRESERVED IF THE EDITOR ROOT AND OVERLAY BECOME E0200016C DETACHED. E0200017CS5 ENTRY/EXIT E0200018C ---------- E0200019CS3 AS THIS ROUTINE CONTAINS NO EXECUTABLE CODE, THERE E0200020C ARE NO ENTRY OR EXIT CONDITIONS. E0200021CS5 ENTRIES E0200022C ------- E0200023CS3 ENTRY POINT REFERENCED BY E0200024C ----- ----- ---------- -- E0200025C EDITCM (NONE) E0200026CS3 EXTERNAL REFERENCES E0200027C -------- ---------- E0200028CS3 EXTERNAL E0200029C -------- E0200030C Q8STP E0200031CS5 **NOTE** E0200032ÐÐC -------- E0200033C THIS ROUTINE SHOULD BE LOADED IMMEDIATELY FOLLOWING 'GOEDIT'. E0200034C*** E0200035M EDITCM E0200036 END E0200037 SUBROUTINE SET(ITABLE,N,IVAL) E0300001 1 /E03 F ITOS CCS 3.0 SL-149E0300002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO SET ITABLE(N-WORDS) TO IVAL E0300003C CREDIT COLLECTION SYSTEM VERSION 3.0 VERSION 2.0 E0300004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E0300005C COPYRIGHT CONTROL DATA CORPORATION 1978 E0300006C E0300007C E0300008C** FUNCTION E0300009C -------- E0300010CS3 SET SETS ITABLE(N) TO IVAL. E0300011CS5 GENERAL DESCRIPTION E0300012C ------- ----------- E0300013CS3 SET EQUATES ITABLE(1) THRU ITABLE(N) TO IVAL. E0300014CS5 ENTRY/EXIT E0300015C ---------- E0300016CS3 SET IS ENTERED WITH THE TABLE TO BE SET IN ITABLE, E0300017C WITH THE VALUE THE TABLE IS TO BE SET TO IN IVAL, E0300018C AND WITH THE NUMBER OF LOCATIONS TO BE SET IN N. E0300019C WHEN SET EXITS, THE TABLE IS SET TO IVAL. E0300020ÐÐCS5 ENTRIES E0300021C ------- E0300022CS3 ENTRY POINT REFERENCED BY E0300023C ----- ----- ---------- -- E0300024C SET INITLE E0300025C EDITOS E0300026C AUTPRO E0300027C CLEPRO E0300028C CTAPRO E0300029C GETPRO E0300030C LINPRO E0300031C RSQPRO E0300032C SEQPRO E0300033C CLRMEM E0300034C CLRMSVM E0300035C GETAFD E0300036C GETNAM E0300037C GETNUM E0300038C GETSTR E0300039C HEXDEC E0300040C LOCATE E0300041C SLIBLD E0300042CS5 EXTERNAL REFERENCES E0300043C -------- ---------- E0300044C EXTERNAL EXTERNAL E0300045ÐÐC -------- -------- E0300046C Q8PKUP Q8PREP E0300047C E0300048 DIMENSION ITABLE(2) E0300049C SET ITABLE(1) TO ITABLE(N) TO IVAL E0300050 DO 1 I=1,N E03000511 ITABLE(I) = IVAL E0300052 RETURN E0300053 END E0300054 SUBROUTINE INITLE E0400001 1 /E04 F ITOS CCS 3.0 SL-149E0400002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO INITIALIZE THE EDITOR COMMON E0400003C CREDIT COLLECTION SYSTEM VERSION 3.0 E0400004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E0400005C COPYRIGHT CONTROL DATA CORPORATION 1979 E0400006C E0400007C*** E0400008C FUNCTION E0400009C -------- E0400010CS3 THIS ROUTINE DOES ALL OF THE INITIAL SET UP OF E0400011C PARAMETERS REQUIRED TO PUT THE EDITOR INTO EXECUTION. E0400012CS5 GENERAL DESCRIPTION E0400013C ------- ----------- E0400014CS3 THE OPERATIONS PERFORMED BY THIS ROUTINE INCLUDE: E0400015C 1. CALL 'PGMIN' TO SET UP THE PROGRAMS OPERATING E0400016ÐÐC ENVIRONMENT. E0400017C 2. INITIALIZE BACKGROUNDING IN VARIOUS BUFFERS E0400018C 3. PRESET INFORMATION REQUIRED TO BUILD THE E0400019C STATEMENT LABEL INDEX FILE. E0400020C 4. OBTAIN ABSOLUTE BUFFER ADDRESSES AND SYSTEM E0400021C PARAMETERS. E0400022C 5. SET UP, DEFINE AND/OR OPEN THE STATEMENT E0400023C LABEL INDEX FILE. THE FCB FOR THIS FILE IS E0400024C UPDATED WITH THE CURRENT DATE AS THE CREATE E0400025C AND EXPIRATION DATES. E0400026C 6. INITIALIZE VARIOUS COMMON PARAMETERS E0400027C 7. THE PROGRAM INTERRUPT FLAG IS SET UP. E0400028C 8. THE MESSAGE 'EDITOR IN' IS OUTPUT. E0400029C 9. CALL THE EDITOR CONTROL PROGRAM. E0400030C 10. UPON COMPLETION OF THE EDITOR (USER TYPES E0400031C 'EXIT'), THE MESSAGE 'EDITOR OUT' IS OUTPUT. E0400032C THE STATEMENT LABEL INDEX FILE IS CLOSED AS E0400033C IS THE USERS' FILE IF NECESSARY. E0400034C 11. RETURN TO THE EXECUTIVE THROUGH A CALL E0400035C TO 'PGMOUT'. E0400036CS5 ENTRY/EXIT E0400037C --------- E0400038CS3 THIS ROUTINE IS ENTERED FROM 'EBEGIN' WHEN THE EDITOR E0400039C IS INITIALLY CALLED BY THE USER. E0400040C E0400041ÐÐC UPON COMPLETION OF THE EDITOR, CONTROL IS RETURNED E0400042C TO THE EXECUTIVE VIA A CALL TO 'PGMOUT'. E0400043CS5 ERROR MESSAGES E0400044C -------------- E0400045CS3 IF A FILE MANAGER ERROR OCCURS WHILE DEFINING DR E0400046C OPENING THE STATEMENT LABEL INDEX FILE, THE MESSAGE E0400047C 'FILE MANAGER ERROR OCCURRED WHEN INITIALIZING THE E0400048C EDITOR ISTAT = $' E0400049C IS OUTPUT. THIS IS A FATAL ERROR TO THE EDITOR AND E0400050C THE EDITOR RUN IS ABORTED. E0400051CS5 ENTRIES E0400052C ------- E0400053CS3 ENTRY POINT REFERENCED BY E0400054C ----- ----- ---------- -- E0400055C INITLE EBEGIN E0400056CS5 EXTERNAL REFERENCES E0400057C -------- ---------- E0400058CS3 EXTERNAL EXTERNAL E0400059C ------- -------- E0400060C FMRDEL FMEOFC E0400061C SAVE PGMIN E0400062C SET HEXDEC E0400063C OPENFL SYSMSG E0400064C CREATE PGMINT E0400065C OUTPUT EDITOS E0400066ÐÐC PGMOUT RETURN E0400067C AMONTO ADAYTO E0400068C AYERTO E0400069C*** E0400070M EDITCM E0400071 INTEGER FMER06 E0400072 DATA FMER06/336/ E0400073 DIMENSION ICREAT(24) E0400074 DATA (ICREAT(I),I=1,12)/' SLITF $$ SYSVOL '/ E0400075 DATA ICREAT(13)/768/ E0400076 DATA ICREAT(14)/0/ E0400077 DATA ICREAT(15)/86/ E0400078 DATA (ICREAT(I),I=16,24)/9*0/ E0400079 DIMENSION IEDIN(6) E0400080 DIMENSION IEDOUT(5) E0400081 DATA (IEDIN(I),I=2,6)/'EDITOR IN '/ E0400082 DATA (IEDOUT(I),I=1,5)/'EDITOR OUT'/ E0400083 EXTERNAL FMRDEL E0400084 EXTERNAL FMEOFC E0400085 EXTERNAL AMONTO E0400086 EXTERNAL ADAYTO E0400087 EXTERNAL AYERTO E0400088 EXTERNAL WKSPLU E0400089 EXTERNAL MMLUTB E0400090C SAVE ENTRY FOR RETURN E0400091ÐÐ CALL SAVE(INITLE) E0400092C INITIALIZE THE INPUT PARAMETERS E0400093 CALL PGMIN(USERID,TERMLU,IMOD,NOPORT) E0400094C SET UP THE TERMINAL LOGICAL UNIT FOR WORD TRANSFERS E0400095 TERMLU=AND(TERMLU,$00FF)+$1000 E0400096C CLEAR THE COMMAND BUFFER E0400097 CALL SET(CMNDBF,40,-0) E0400098C BLANK OUT THE FILE NAME E0400099 CALL SET(NAMFIL,4,$2020) E0400100C SET THE RECORD BUFFER TO RIGHT ARROWS ($15) E0400101 CALL SET(RECBUF,40,$1515) E0400102C INITIALIZE THE TEXT INPUT BUFFER E0400103 CALL SET(TBUFFR,40,$1515) E0400104C ISSIZE IS THE LENGTH IN WORDS OF THE IS ARRAY E0400105 ISSIZE=3600 E0400106C IPGSIZ IS THE LENGTH IN WORDS OF ONE PAGE OF VIRTUAL MEMORY E0400107C ONE PAGE OF VIRTUAL MEMORY IS FOUR SECTORS E0400108 IPGSIZ=384 E0400109C FBSIZE IS THE LENGTH IN WORDS OF ONE RECORD BLOCK OF THE TEXT FILEE0400110 FBSIZE=800 E0400111C NOPAGS IS THE SIZE OF THE HEADER AREA WITHIN THE IS ARRAY E0400112 NOPAGS=(ISSIZE/(IPGSIZ+4))*4 E0400113C IENPLN IS THE NUMBER OF ENTRIES REQUIRED IN THE IS ARRAY E0400114C TO REPRESENT ONE LINE IN THE USER FILE E0400115 IENPLN=1 E0400116ÐÐC GET THE ADDRESS OF THE STATEMENT LABEL INDEX FILE FCB BUFFER E0400117C LDA =XSLFCBX E0400118C STA SLFADR E0400119C E0400120 ASSEM $C000,+SLFCBX,$6400,+SLFADR E0400121C GET THE ADDRESS OF THE USER'S FILE FCB BUFFER E0400122C LDA =XFCBBUX E0400123C STA FCBADR E0400124C E0400125 ASSEM $C000,+FCBBUX,$6400,+FCBADR E0400126C GET THE ADDRESS OF THE SCRATCH FILE FCB BUFFER E0400127C LDA =XSCFCBX E0400128C STA SCRADR E0400129C E0400130 ASSEM $C000,+SCFCBX,$6400,+SCRADR E0400131C GET THE SYSTEMS FILE MANAGER DELETE CODE E0400132C LDA FMRDEL E0400133C STA IDELFG E0400134C E0400135 ASSEM $C000,+FMRDEL,$6400,+IDELFG E0400136C GET THE SYSTEMS FILE MANAGER END OF FILE CODE E0400137C LDA FMEOFC E0400138C STA IEOFFM E0400139C E0400140 ASSEM $C000,+FMEOFC,$6400,+IEOFFM E0400141ÐÐC E0400142C GET THE VOLUME NAME OF THE WORKSPACE VOLUME E0400143C LDQ WKSPLU GET THE INDEX INTO THE LU TABLE E0400144C LDQ MMLUTB,Q GET THE VIT ADDRESS FOR THIS LU E0400145C LDA 1,Q GET THE 4-WORD VOLUME NAME E0400146C STA ICREAT+8 E0400147C LDA 2,Q E0400148C STA ICREAT+9 E0400149C LDA 3,Q E0400150C STA ICREAT+10 E0400151C LDA 4,Q E0400152C STA ICREAT+11 E0400153C E0400154 ASSEM $E400,+WKSPLU,$E600,+MMLUTB E0400155 ASSEM $C201,$6400,+ICREAT(9),$C202,$6400,+ICREAT(10) E0400156 ASSEM $C203,$6400,+ICREAT(11),$C204,$6400,+ICREAT(12) E0400157C E0400158C SET HIGHEST STATEMENT NUMBER TO ZERO E0400159 STNMBR=0 E0400160C CONVERT PORT NUMBER TO ASCII FOR USE IN OPEN REQUEST E0400161 CALL HEXDEC(NOPORT,NUMBER(1)) E0400162C PUT PORT NUMBER (TWO DIGITS ONLY) INTO STATEMENT LABEL FILE NAME E0400163 ICREAT(4)=NUMBER(3) E0400164C MOVE DATA TO OPEN BUFFER E0400165 50 DO 100 IX=1,12 E0400166ÐÐ FMOPEN(IX)=ICREAT(IX) E0400167 100 CONTINUE E0400168C SET UP TO OPEN THE FILE E0400169C SET TO OPEN BY RELATIVE RECORD NUMBER E0400170 FMOPEN(13)=0 E0400171C SET UP TO RETRIEVE 1 RECORD BLOCKS E0400172 FMOPEN(14)=1 E0400173C SET THE LOCK FILE FLAG E0400174 FMOPEN(15)=$8000 E0400175C CLEAR THE REQUEST BUFFER FOR THIS FILE E0400176 CALL SET(SLRQBF,24,0) E0400177C PUT THE FCB BUFFER ADDRESS IN THE REQUEST BUFFER E0400178 SLRQBF(10)=SLFADR E0400179C SET THE NUMBER OF WORDS FOR THE FCB E0400180 SLRQBF(13)=96 E0400181C TRY TO OPEN THE STATEMENT LABEL INDEX FILE E0400182 CALL OPENFL(SLRQBF,FMOPEN,ISTAT) E0400183C VERIFY THE STATUS OF THE FILE MANAGER E0400184 IF (ISTAT.GE.0) GO TO 400 E0400185C HAS THE FILE NOT BEEN CREATED YET E0400186 IF (ISTAT.EQ.$8002) GO TO 300 E0400187C PUT STATUS IN ERROR E0400188 IDATA(1)=ISTAT E0400189C SOMETHING IS DRASTICALLY WRONG. E0400190C OUTPUT THE ERROR - FILE MANAGER ERROR WHEN INITIALIZING EDITOR E0400191ÐÐ 225 CALL SYSMSG(FMER06,IDATA) E0400192 250 IERRFG=$8001 E0400193 GO TO 9000 E0400194C THIS FILE NEEDS TO BE CREATED FOR THIS PORT E0400195C CLEAR THE REQUEST BUFFER E0400196 300 CALL SET(SLRQBF,24,0) E0400197C PUT THE FCB BUFFER ADDRESS IN THE REQUEST BUFFER E0400198 SLRQBF(10)=SLFADR E0400199C SET THE NUMBER OF WORDS FOR THE FCB E0400200 SLRQBF(13)=96 E0400201C MOVE THE CREATE BUFFER TO COMMON E0400202 DO 350 IX=1,24 E0400203 ICRBUF(IX)=ICREAT(IX) E0400204 350 CONTINUE E0400205C CREATE THIS FILE E0400206 CALL CREATE(SLRQBF,ICRBUF,ISTAT) E0400207C VERIFY THE STATUS OF THE FILE MANAGER E0400208 IF (ISTAT.LT.0) GO TO 225 E0400209 GO TO 50 E0400210C SET THE OPEN BUFFER TO BLANKS E0400211 400 CALL SET(FMOPEN,12,$2020) E0400212C PUT THE USER'S ID INTO THE OPEN COMMAND BUFFER E0400213 DO 500 IX=1,4 E0400214 FMOPEN(IX+4)=USERID(IX) E0400215 500 CONTINUE E0400216ÐÐC E0400217C PUT THE DATE INTO THE FCB FOR THE DIRECTORY FILE E0400218C LDA AMONTO E0400219C STA SLFCBF+89 E0400220C STA SLFCBF+92 E0400221C LDA ADAYTO E0400222C STA SLFCBF+90 E0400223C STA SLFCBF+93 E0400224C LDA AYERTO E0400225C STA SLFCBF+91 E0400226C STA SLFCBF+94 E0400227C E0400228 ASSEM $C400,+AMONTO,$6400,+SLFCBF(89),$6400,+SLFCBF(92) E0400229 ASSEM $C400,+ADAYTO,$6400,+SLFCBF(90),$6400,+SLFCBF(93) E0400230 ASSEM $C400,+AYERTO,$6400,+SLFCBF(91),$6400,+SLFCBF(94) E0400231C UPDATE THE FCB E0400232 CALL UPDFCB(SLRQBF,0,0,SLFCBF,ISTAT) E0400233C VERIFY THE STATUS OF THE FILE MANAGER E0400234 IF (ISTAT.LT.0) GO TO 225 E0400235C SET UP TO USE THE EDITOR'S COMMAND LIST E0400236 TEPMID=0 E0400237C SET INITIAL NON-RPG TABS E0400238 CALL CTAPRO E0400239C SET UP THE INTERRUPT ADDRESS E0400240 CALL PGMINT(0,IFLAGX) E0400241ÐÐC SET CLEAR SCREEN INTO REQUEST E0400242 IEDIN(1)=$1800 E0400243C OUTPUT THE EDITOR IN MESSAGE E0400244 CALL OUTPUT(TERMLU,IEDIN,6) E0400245C EXECUTE THE EDITOR E0400246 CALL EDITOS E0400247C THE EDITOR HAS COMPLETED E0400248C CLOSE THE STATEMENT LABEL INDEX FILE E0400249 CALL CLOSFL(SLRQBF,ISTAT) E0400250C IF A USER FILE IS OPEN, CLOSE IT E0400251 IF (NAMFIL(1).NE.$2020) CALL CLOSFL(REQBUF,ISTAT) E0400252C OUTPUT THE EDITOR OUT MESSAGE E0400253 9000 CALL OUTPUT(TERMLU,IEDOUT,5) E0400254C RETURN TO THE ITOS EXECUTIVE E0400255 CALL PGMOUT E0400256C ****NOTE**** E0400257C CONTROL NEVER RETURNS TO HERE E0400258 CALL RETURN E0400259 RETURN E0400260 END E0400261 SUBROUTINE AUTPRO E0500001 1 /E05 F ITOS CCS 3.0 SL-149E0500002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO PROCESS 'AUTO' COMMAND E0500003C CREDIT COLLECTION SYSTEM VERSION 3.0 E0500004* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E0500005ÐÐC COPYRIGHT CONTROL DATA CORPORATION 1978 E0500006C E0500007C*** E0500008C FUNCTION E0500009C -------- E0500010CS3 THE FUNCTION OF THIS PROGRAM IS TO PROCESS THE 'AUTO' E0500011C COMMAND. E0500012CS5 GENERAL FLOW E0500013C ------- ---- E0500014CS3 THIS PROGRAM PERFORMS THE FOLLOWING OPERATIONS WHILE E0500015C PROCESSING THE 'AUTO' COMMAND. E0500016C 1. CHECK TO MAKE SURE A 'GET' COMMAND HAS BEEN E0500017C PERFORMED. IF NOT, OUTPUT THE ERROR MESSAGE E0500018C 'NO FILE OPEN FOR EDITOR USE' AND RETURN TO E0500019C THE CONTROL PROCESSOR. E0500020C 2. CLEAR THE SCREEN LINE COUNT AND GET THE NEXT E0500021C FIELD. IF AN ERROR OCCURS WHILE GETTING THIS E0500022C FIELD, RETURN TO THE CONTROL PROCESSOR. E0500023C IF NOT, SET THE FORMAT TYPE TO THIS FIELD E0500024C VALUE. E0500025C 3. GET THE NEXT FIELD. IF AN ERROR OCCURS E0500026C WHILE GETTING THIS FIELD, RETURN TO THE E0500027C CONTROL PROCESSOR E0500028C 4. BASE LINE NUMBER DETERMINATION E0500029C A. IF THERE IS NO BASE LINE NUMBER ENTERED E0500030ÐÐC AND NO PREVIOUS HIGH STATEMENT NUMBER E0500031C EXISTS, SET THE BASE TO 10. E0500032C B. IF THERE IS NO BASE LINE NUMBER ENTERED E0500033C AND A HIGH STATEMENT NUMBER EXISTS, SET E0500034C THE BASE TO THE HIGH STATEMENT NUMBER. E0500035C C. IF A BASE LINE NUMBER IS ENTERED AND NO E0500036C PREVIOUS HIGH STATEMENT NUMBER EXISTS, E0500037C SET THE BASE TO THE ENTERED BASE. E0500038C D. IF A BASE LINE NUMBER EXISTS AND A HIGH E0500039C STATEMENT NUMBER EXISTS, CHECK TO SEE IF E0500040C THE NEW BASE IS BELOW THE EXISTING HIGH E0500041C STATEMENT NUMBER. IF IT IS BELOW THE E0500042C EXISTING HIGH STATEMENT NUMBER, OUTPUT E0500043C THE ERROR 'ILLEGAL LINE NUMBER ###### E0500044C SPECIFIED', THEN RETURN TO THE CONTROL E0500045C PROCESSOR. IF NOT, SET THE BASE TO THE E0500046C NUMBER ENTERED. E0500047C 5. GET THE NEXT FIELD. IF AN ERROR OCCURS E0500048C WHILE GETTING THIS FIELD, RETURN TO THE E0500049C CONTROL PROCESSOR. E0500050C IF NOT, IF NO INCREMENT IS ENTERED, SET THE E0500051C INCREMENT TO 10. IF AN INCREMENT VALUE IS E0500052C ENTERED USE IT AS THE INCREMENT. E0500053C 6. IF THE BASE LINE NUMBER IS THE SAME AS THE E0500054C HIGHEST STATEMENT NUMBER ADD THE INCREMENT E0500055ÐÐC TO GET TO THE NEXT LINE NUMBER. E0500056C 7. GET THE NEXT FIELD. IF AN ERROR OCCURS E0500057C WHILE GETTING THIS FIELD, RETURN TO THE E0500058C CONTROL PROCESSOR. E0500059C IF NOT, IF THERE IS ALREADY A PROGRAM IDENT- E0500060C IFICATION FIELD SPECIFIED, IGNORE THIS FIELD. E0500061C OTHERWISE USE THIS FIELD AS THE PROGRAM E0500062C IDENTIFICATION FIELD. E0500063C 8. SET THE TAB POSITIONS FOR THE SPECIFIED FORMAT E0500064C TYPE. IF AN ERROR OCCURS, RETURN TO THE E0500065C CONTROL PROCESSOR. E0500066C 9. CLEAR THE CHARACTER AND VALIDATE THE LINE E0500067C NUMBER. IF IT IS OUT OF RANGE, OUTPUT THE E0500068C ERROR 'LINE NUMBER OVERFLOW', AND RETURN E0500069C TO THE CONTROL PROCESSOR. E0500070C IF THE SCREEN POINTER IS AT THE TOP OF THE SCREEN E0500071C THEN OUTPUT THE SCREEN COLUMN HEADER. BUMP THE E0500072C SCREEN LINE COUNTER, AND IF THE COUNTER VALUE IS E0500073C GREATER OR EQUAL TO 21, RESET THE LINE COUNT. E0500074C E0500075C CALL FNDSLI TO SEE IF THERE IS ALREADY AN EXISTING E0500076C RECORD. IF THERE WAS AN ERROR, THEN RETURN TO E0500077C CALLER. INITIALIZE TAB COUNTER AND PREPARE TO E0500078C RETRIEVE EXISTING RECORD. IF THERE IS NO E0500079C EXISTING RECORD AND THERE IS NO MORE ROOM IN E0500080ÐÐC THE EDIT FILE, THEN OUTPUT THE MESSAGE 'END OF EDIT E0500081C FILE--RESEQUENCE OR ENLARGE FILE' E0500082C E0500083C RETRIEVE EITHER THE EXISTING RECORD OR THE NEXT E0500084C EMPTY RECORD FROM THE EDIT FILE. IF THERE IS AN E0500085C FM ERROR, OUTPUT 'FILE MANAGER ERROR WHEN READING' E0500086C 10. IF THE FORMAT TYPE IS NON RPG OR RPG ARRAY E0500087C DATA, POSITION THE LINE NUMBER IN POSITIONS E0500088C 76-80 OF THE DATA RECORD AND THE PRINT RECORD. E0500089C IF THE FORMAT TYPE IS NON RPG, PLACE THE E0500090C PROGRAM IDENTIFICATION IN POSITIONS 73-75 E0500091C OF THESE RECORDS. CLEAR POSITIONS 1-6 OF E0500092C THESE RECORDS. E0500093C IF THIS IS AN RPG 'H' FORMAT SPECIFICATION E0500094C CHECK TO MAKE SURE THERE IS A PROGRAM IDENT- E0500095C IFICATION SPECIFIED. IF NOT, OUTPUT THE E0500096C ERROR 'NO PROGRAM ID ON H FORMAT SPECIFICATION' E0500097C AND RETURN TO THE CONTROL PROCESSOR. E0500098C FOR ANY OTHER RPG FORMAT SPECIFICATIONS PUT E0500099C THE PROGRAM IDENTIFICATION INTO POSITIONS E0500100C 75-80 OF THE DATA RECORD AND THE PRINT RECORD. E0500101C PUT THE LOWER 5 DIGITS OF THE LINE NUMBER E0500102C INTO POSITIONS 1-5 OF THE RECORDS AND FORMAT E0500103C TYPE INTO POSITION 6. CLEAR POSITIONS 73-74 E0500104C OF THESE RECORDS. E0500105ÐÐC 11. IF THIS IS THE FIRST TIME THRU, OUTPUT CHARACTER E0500106C POSITIONS AT THE TOP OF THE SCREEN. INCREMENT E0500107C TO THE NEXT SCREEN LINE. E0500108C IF THIS IS THE LAST SCREEN LINE, RESET TO THE E0500109C SECOND LINE ON THE SCREEN. E0500110C SET THE INTERNAL CURSOR POSITION FOR POSITION E0500111C 73 ON THIS SCREEN LINE. E0500112C 12. INITIALIZE THE NEW EDIT RECORD AS ALL BLANKS AND E0500113C INDICATE RESEQUENCING IS NEEDED. E0500114C SET UP A LOOP TO POSITION THE CURSOR AND E0500115C INPUT AS MANY TIMES AS THERE ARE POSSIBLE E0500116C TAB POSITIONS. E0500117C CALCULATE THE CURSOR POSITIONING COORDINATES E0500118C FOR THIS NEW LINE. E0500119C IF THIS IS THE FIRST REQUEST FOR THIS RECORD E0500120C OUTPUT THE PRESET DATA FOR THIS LINE AND THE E0500121C CHARACTER POSITION LINE BELOW THIS LINE AND E0500122C INPUT THE RECORD E0500123C 13. IF NO DATA WAS ENTERED, SKIP THIS SECTION E0500124C DETERMINE THE NUMBER OF CHARACTERS INPUT E0500125C AND THE CHARACTER POSITION TO PLACE IT IN E0500126C THE INTERMEDIATE RECORD BUFFER. E0500127C MOVE THE PORTION OF THE RECORD JUST INPUT. E0500128C 14. GO TO THE APPROPRIATE TERMINATION CODE E0500129C PROCESSOR. E0500130ÐÐC A. BUFFER FULL TERMINATION CODE E0500131C 1. GO TO THE RECORD TERMINATION SECTION E0500132C B. TAB TERMINATION CODE E0500133C 1. INCREMENT TO THE NEXT STEP OF THE E0500134C TAB STOP DO LOOP. E0500135C 2. IF THE RANGE OF THE DO LOOP IS EXCEEDED E0500136C SOMETHING IS WRONG, RETURN TO THE E0500137C CONTROL PROCESSOR. E0500138C C. CARRIAGE RETURN TERMINATION E0500139C CODES. E0500140C 1. IF SOME DATA HAS BEEN ENTERED WITH THIS E0500141C REQUEST OR IF SOME DATA HAS BEEN ENTERED E0500142C ON PREVIOUS REQUESTS ON THIS LINE, GO E0500143C TO THE RECORD TERMINATION SECTION. E0500144C 2. IF NO DATA WAS ENTERED ON THIS REQUEST E0500145C AND IT IS THE FIRST REQUEST ON THIS E0500146C LINE, GO TO THE PROCESSOR TERMINATION E0500147C SECTION. E0500148C D. RUB-OUT TERMINATION CODE E0500149C 1. IF THIS IS THE FIRST REQUEST ISSUED ON E0500150C THIS LINE, REPEAT THIS INITIAL REQUEST. E0500151C 2. IF NO DATA WAS ENTERED ON THIS REQUEST E0500152C FOR THIS LINE, BACK UP TO THE PREVIOUS E0500153C TAB POSITION AND REPEAT THE REQUEST. E0500154C 3. IF SOME DATA WAS ENTERED FOR THIS REQUEST E0500155ÐÐC REPEAT THE REQUEST. E0500156C E. LINE FEED TERMINATION CODE. E0500157C 1. ENTER CURRENT RECORD INTO EDIT FILE BY E0500158C GOING TO STEP 12. E0500159C 15. RECORD TERMINATION PROCESSOR E0500160C THE CHARACTERS CONTAINED IN THE INTERMEDIATE E0500161C RECORD BUFFER ARE PLACED IN THE CORRESPONDING E0500162C POSITIONS IN THE FILE RECORD BUFFER EXCEPT E0500163C FOR CHARACTER $15 WHICH IS A CURSOR POSITION E0500164C CHARACTER TO INDICATE THAT THE EXISTING E0500165C CHARACTER IN THE FILE RECORD BUFFER IS NOT E0500166C MODIFIED. E0500167C IF THIS IS A NEW RECORD, INSERT THE RELATIVE E0500168C RECORD NUMBER INTO IS ARRAY AND BUMP THE E0500169C RELATIVE RECORD NUMBER COUNTER BY 1. E0500170C THE UPDATED RECORD IS WRITTEN BACK TO THE E0500171C PROPER POSITION IN THE USERS FILE. IF AN ERROR E0500172C OCCURS THE ERROR MESSAGE 'FILE MANAGER ERROR E0500173C WHEN UPDATING FILE @@@@@@@@ ISTAT = $$$$' AND E0500174C CONTROL IS RETURNED TO THE CONTROL PROCESSOR. E0500175C IF NO ERRORS OCCUR, THE RELATIVE RECORD POINTER E0500176C IS UPDATED, THE INTERMEDIATE RECORD BUFFER E0500177C AND THE FILE TEXT BUFFER ARE BACKGROUNDED, E0500178C AND THE NEXT LINE NUMBER IS CALCULATED. E0500179C THE RECORD ENTRY SECTION STARTING AT ITEM 9 E0500180ÐÐC ABOVE IS REPEATED UNTIL THE PROCESSOR TERMIN- E0500181C ATION SECTION IS CALLED. E0500182C 16. AUTO PROCESSOR TERMINATION SECTION. E0500183C THE NEXT RECORD IS OBTAINED FROM THE FILE. E0500184C IF AN END OF FILE IS NOT INDICATED IN THE E0500185C FILE STATUS, AN END OF FILE IS WRITTEN INTO E0500186C THIS RECORD TO MARK THE CURRENT HIGHEST E0500187C RELATIVE RECORD USED IN THE FILE. E0500188C THE FCB FOR THE USERS FILE IS UPDATED. IF E0500189C AN ERROR OCCURS THE MESSAGE 'FILE MANAGER E0500190C ERROR WHEN UPDATING FCB FOR FILE @@@@@@@@ E0500191C ISTAT =$$$$'. E0500192C THE HIGHEST STATEMENT NUMBER USED IS SAVED E0500193C IN THE FCB. E0500194C IF NO ERROR OCCURS THE PROCESSOR IS EXITED E0500195C AND CONTROL IS RETURNED TO THE CONTROL E0500196C PROCESSOR. E0500197CS5 ENTRY/EXIT E0500198C ----------- E0500199CS3 THIS ROUTINE IS ENTERED FROM THE CONTROL PROCESSOR E0500200C 'EDITOS'. A FILE MUST BE OPENED FOR THE EDITOR TO E0500201C USE AND THE COMMAND BUFFER MUST CONTAIN THE PARAMETER E0500202C STRING FOR THE AUTO COMMAND. E0500203C E0500204C EXIT TO THE CONTROL PROCESSOR IS E0500205ÐÐC 1. IERRFG = 0 NO ERRORS E0500206C = + NON FATAL EDITOR ERROR. ANOTHER E0500207C PROCESSOR MAY BE ENTERED. E0500208C = - A FATAL EDITOR ERROR HAS OCCURRED. E0500209C THE EDITOR IS TERMINATED. E0500210CS5 ERROR MESSAGES E0500211C ----- -------- E0500212CS3 THE FOLLOWING ERROR MESSAGES ARE OUTPUT BY THE AUTO E0500213C PROCESSOR. E0500214C EDITOR ERROR 301 E0500215C 'ILLEGAL LINE NUMBER @@@@@@ SPECIFIED' E0500216C EDITOR ERROR 302 E0500217C 'NO PROGRAM ID ON H FORMAT SPECIFICATION' E0500218C EDITOR ERROR 312 E0500219C 'LINE NUMBER OVERFLOW' E0500220C EDITOR ERROR 319 E0500221C 'NO FILE OPEN FOR EDITOR USE' E0500222C EDITOR ERROR 322 E0500223C 'END OF EDIT FILE--RESEQUENCE OR ENLARGE FILE' E0500224C EDITOR FILE MANAGER ERROR 334 E0500225C 'FILE MANAGER ERROR WHEN READING FILE @@@@@@@@ E0500226C ISTAT = $$$$' E0500227C EDITOR FILE MANAGER ERROR 341 E0500228C 'FILE MANAGER ERROR WHEN UPDATING FILE @@@@@@@@ E0500229C ISTAT = $$$$' E0500230ÐÐC EDITOR FILE MANAGER ERROR 342 E0500231C 'FILE MANAGER ERROR WHEN UPDATING FCB FOR FILE E0500232C @@@@@@@@ ISTAT = $$$$ E0500233CS5 ENTRIES E0500234C ------- E0500235CS3 ENTRY POINT REFERENCED BY E0500236C ----- ----- E0500237C AUTPRO EDITOS E0500238CS5 EXTERNAL REFERENCES E0500239C -------- ---------- E0500240CS3 EXTERNAL EXTERNAL E0500241C -------- -------- E0500242C SAVE SYSMSG E0500243C GETNUM GETONE E0500244C GETAFD SETAUT E0500245C HEXDEC SET E0500246C OUTPUT WTREAD E0500247C FNDSLI READR E0500248C UPDREC UPDFCB E0500249C RETURN E0500250C*** E0500251M EDITCM E0500252 INTEGER TDATRM,TDATRL E0500253 EQUIVALENCE (TDATRM,FCBBUF(2)),(TDATRL,FCBBUF(3)) E0500254 DIMENSION TOFHED(41) E0500255ÐÐ INTEGER TOFHED E0500256 DATA TOFHED(1)/$1800/ E0500257 DATA(TOFHED(I),I=2,41)/'123456789012345678901234567890123456789012E0500258 134567890123456789012345678901234567890'/ E0500259 DATA LTOFHD/41/ E0500260 DIMENSION LINBFR(54) E0500261 DATA LINBFR(1)/$0000/,LINBFR(2)/$1600/,LINBFR(3)/'00'/,LINBFR(4)/ E0500262 1'00'/,LINBFR(5)/'0 '/,LINBFR(6)/$1B31/,LINBFR(7)/0/,(LINBFR(I),I=8E0500263 2,11)/' '/ E0500264 DATA(LINBFR(I),I=12,51)/'12345678901234567890123456789012345678901E0500265 1234567890123456789012345678901234567890'/,LINBFR(52)/$1600/ E0500266 DATA LLINBF/52/ E0500267 INTEGER EDER01 E0500268 INTEGER EDER02 E0500269 INTEGER EDER12 E0500270 INTEGER EDER19 E0500271 INTEGER EDER22 E0500272 DATA EDER01/301/ E0500273 DATA EDER02/302/ E0500274 DATA EDER12/312/ E0500275 DATA EDER19/319/ E0500276 DATA EDER22/322/ E0500277 INTEGER FMER04 E0500278 INTEGER FMER11 E0500279 INTEGER FMER12 E0500280ÐÐ DATA FMER04/334/ E0500281 DATA FMER11/341/ E0500282 DATA FMER12/342/ E0500283C SAVE ENTRY FOR RETURN E0500284 CALL SAVE(AUTPRO) E0500285C HAS THE USER DONE A GET YET E0500286 IF (NAMFIL(1).NE.$2020) GO TO 10 E0500287C OUTPUT THE ERROR - NO FILE OPEN FOR EDITOR USE E0500288 CALL SYSMSG(EDER19,IDATA) E0500289 GOTO 9000 E0500290C CLEAR SCREEN LINE COUNT E0500291 10 ISCRLN=0 E0500292C INITIALIZE THE RECORD BUFFER AND THE TEXT BUFFER E0500293 CALL SET(RECBUF,40,$1515) E0500294 CALL SET(TBUFFR,40,$1515) E0500295C E0500296C RETRIEVE AUTO PARAMETERS E0500297C ------------------------ E0500298C GET NEXT FIELD - FORMAT TYPE E0500299 CALL GETONE E0500300C DID AN ERROR OCCUR E0500301 IF (IERRFG.NE.0) GO TO 9000 E0500302C SET UP FORMAT TYPE E0500303 FORMTP=GOTCHR E0500304C GET NEXT FIELD - BASE LINE NUMBER E0500305ÐÐ CALL GETNUM E0500306C DID AN ERROR OCCUR E0500307 IF (IERRFG.NE.0) GO TO 9000 E0500308C IF THIS BASE NUMBER AND THE CURRENT HIGHEST LINE NUMBER ARE ZERO E0500309C SET BASE LINE NUMBER TO 10 E0500310 IF (NUMHEX.EQ.0.AND.STNMBR.EQ.0) NUMHEX=10 E0500311C IF THE CURRENT BASE IS ZERO, BUT THERE HAS BEEN A HIGHEST E0500312C LINE ENTERED, USE THE HIGHEST LINE ENTERED AS THE BASE AND E0500313C SET THE FLAG TO ADD THE INCREMENT TO FORM THE NEW LINE NUMBER E0500314 IF (NUMHEX.EQ.0.AND.STNMBR.NE.0) NUMHEX=-STNMBR E0500315C SET THE CURRENT LINE NUMBER E0500316 LINENO=NUMHEX E0500317C GET NEXT FIELD - INCREMENT BETWEEN LINES E0500318 CALL GETNUM E0500319C DID AN ERROR OCCUR E0500320 IF (IERRFG.NE.0) GO TO 9000 E0500321C SET DEFAULT VALUE FOR INCREMENT E0500322 AUTOFG=10 E0500323C IF THERE IS AN INCREMENT SPECIFIED, USE IT E0500324 IF (NUMHEX.NE.0) AUTOFG=NUMHEX E0500325C IF THE FLAG IS SET TO ADD THE INCREMENT TO GET THE NEXT LINE E0500326C NUMBER, DO IT E0500327 IF (LINENO.LT.0) LINENO=STNMBR+AUTOFG E0500328C GET NEXT FIELD - PROGRAM IDENTIFICATION E0500329 CALL GETAFD E0500330ÐÐC DID AN ERROR OCCUR E0500331 IF (IERRFG.NE.0) GO TO 9000 E0500332C SAVE PROGRAM ID E0500333 IPGMID(1)=ALFFLD(1) E0500334 IPGMID(2)=ALFFLD(2) E0500335 IPGMID(3)=ALFFLD(3) E0500336C SET UP TABS FOR THIS FORMAT TYPE E0500337C IF NON RPG FORMAT TYPE, USE WHATEVER TABS EXIST E0500338 220 IF (FORMTP.NE.$20) CALL SETAUT E0500339C HAS AN ERROR OCCURRED E0500340 IF (IERRFG.NE.0) GO TO 9000 E0500341C E0500342C BEGIN AUTO PROCESSING E0500343C --------------------- E0500344C CLEAR THE CHARACTER COUNTER E0500345 225 IDUMB=0 E0500346C CLEAR THE CHARACTER COUNT E0500347 ICURCH=0 E0500348C VERIFY THE LINE NUMBER WITHIN RANGE E0500349 IF (LINENO.LE.32767) GO TO 240 E0500350C OUTPUT THE ERROR - LINE NUMBER OVERFLOW E0500351 CALL SYSMSG(EDER12,IDATA) E0500352 GOTO 9000 E0500353C E0500354C OUTPUT SCREEN HEADER AND PERFORM CURSOR CONTROL E0500355ÐÐC ----------------------------------------------- E0500356C IF THIS IS THE FIRST TIME THRU, OUTPUT THE SCREEN HEADER E0500357 240 IF (ISCRLN.EQ.0) CALL OUTPUT(TERMLU,TOFHED,LTOFHD) E0500358 ISCRLN=ISCRLN+1 E0500359C IF THIS IS LINE 22 ON THE SCREEN, RESET TO LINE 2 E0500360 IF (ISCRLN.EQ.21) ISCRLN=1 E0500361C SET CURSOR POSITION TO 73 ON THIS LINE E0500362 LINBFR(7) = $4800 + ISCRLN E0500363C E0500364 E0500365C SCAN EDIT FILE FOR POSSIBLE RECORD MATCH E0500366C ---------------------------------------- E0500367C INDICATE TO FNDSLI TO PREPARE FOR A WRITE E0500368 IMODE=1 E0500369C CALCULATE LOCATION IN IS ARRAY FOR THIS SEQUENCE NUMBER E0500370 CALL FNDSLI E0500371C DID AN ERROR OCCUR E0500372 IF (IERRFG.NE.0) GOTO 9000 E0500373C INITIALIZE TAB TABLE POINTER E0500374 IT=1 E0500375C E0500376C PREPARE TO RETRIEVE EXISTING RECORD E0500377 NW(1)=0 E0500378 NW(2)=IS(LINIDX) E0500379C CONTINUE IF THERE IS AN EXISTING USER EDIT FILE RECORD E0500380ÐÐ IF (IS(LINIDX).NE.0) GOTO 245 E0500381C E0500382C IS THERE ANY MORE EDIT FILE ROOM E0500383 IF (IRECPT(2).LE.TDATRL) GOTO 242 E0500384C OUTPUT END OF EDIT FILE--RESEQUENCE OR ENLARGE FILE E0500385 CALL SYSMSG(EDER22,0) E0500386 GOTO 8000 E0500387C E0500388C PREPARE TO RETRIEVE NEXT USER EDIT RECORD E0500389 242 NW(2)=IRECPT(2) E0500390 245 CALL READR(REQBUF,FBUFFR,NW,ISTAT) E0500391C VERIFY THE STATUS OF THE FILE MANAGER E0500392 IF (ISTAT.GE.0) GOTO 260 E0500393C PUT THE FILE NAME INTO THE ERROR MESSAGE E0500394 250 DO 255 IX=1,4 E0500395 255 IDATA(IX)=NAMFIL(IX) E0500396C PUT THE STATUS INTO THE ERROR E0500397 IDATA(5)=ISTAT E0500398C OUTPUT THE ERROR - FILE MANAGER ERROR WHEN READING @@@@@@@@ E0500399C ISTAT = $$$$ E0500400 CALL SYSMSG(FMER04,IDATA) E0500401 GOTO 8200 E0500402C E0500403C SEE IF THERE IS AN EXISTING TEXT RECORD E0500404 260 IF (IS(LINIDX).EQ.0) GOTO 300 E0500405ÐÐC E0500406C INSERT PROGRAM ID, IF ANY, INTO EXISTING RECORD E0500407C IF THERE IS NO ID, LEAVE WHAT IS THERE ALREADY E0500408 IF (IPGMID(1).EQ.$2020) GOTO 275 E0500409C IF THERE IS A PROGRAM ID, PUT IT IN THE RPG FIELD POSITION E0500410 FBUFFR(37)=IPGMID(1) E0500411 FBUFFR(38)=(AND(FBUFFR(38),$FF)+AND(IPGMID(2),$FF00)) E0500412C POSITION THE CURSOR E0500413 275 ICORDS=(TABBUF(IT)-1)*$100+ISCRLN E0500414C OUTPUT THE CURSOR POSITION AND INPUT THE RECORD E0500415 CALL WTREAD(TERMLU,ISCRLN,FBUFFR,40,ICORDS,TBUFFR,40,TC) E0500416 GOTO 1160 E0500417C E0500418C INSERT SEQUENCE NUMBER IN CORRECT FORMAT POSITION E0500419C ------------------------------------------------- E0500420C IS THIS AN RPG ARRAY DATA RECORD ENTRY E0500421 300 IF (FORMTP.EQ.$2A) GOTO 325 E0500422C IS THIS NON-RPG TYPE FORMAT E0500423 IF (FORMTP.NE.$20) GOTO 375 E0500424C YES, PUT LINE NUMBER INTO NON-RPG POSITION E0500425 325 CALL HEXDEC(LINENO,LINBFR(9)) E0500426 CALL HEXDEC(LINENO,RECBUF(38)) E0500427C IF THIS IS RPG ARRAY DATA, DON'T STORE INTO POSITION 73 - 75 E0500428 IF (FORMTP.EQ.$2A) GOTO 350 E0500429C PUT PROGRAM ID INTO BUFFER E0500430ÐÐ LINBFR(8)=IPGMID(1) E0500431 RECBUF(37)=IPGMID(1) E0500432C THIS IS A NON RPG FILE, SET UP THE REST OF THE POSSIBLE PROGRAM IDE0500433 LINBFR(9)=AND(IPGMID(2),$FF00)+AND(LINBFR(9),$00FF) E0500434 RECBUF(38)=AND(IPGMID(2),$FF00)+AND(RECBUF(38),$00FF) E0500435C CLEAR RPG TYPE LINE NUMBER E0500436 350 CALL SET(LINBFR(3),3,$2020) E0500437C CLEAR THE LINE NUMBER FROM THE RECORD BUFFER E0500438 CALL SET(RECBUF,3,$2020) E0500439 GO TO 600 E0500440C IF FORMAT TYPE IS H, THERE MUST BE A PROGRAM ID FIELD E0500441 375 IF (FORMTP.NE.$48) GOTO 400 E0500442C NO ID FIELD. THIS IS AN ERROR. E0500443 IF (IPGMID(1).NE.$2020) GO TO 400 E0500444C NO PROGRAM ID ON H FORMAT SPECIFICATION E0500445C OUTPUT THE ERROR MESSAGE E0500446 CALL SYSMSG(EDER02,IDATA) E0500447 GO TO 9000 E0500448C CLEAR NON-RPG FORMAT TYPE ID FIELD E0500449 400 LINBFR(8)=$2020 E0500450 RECBUF(37)=$2020 E0500451C E0500452C INSERT PROGRAM ID, IF ANY, INTO BLANK RECORD E0500453C -------------------------------------------- E0500454C IF THERE IS NO ID INPUT LEAVE WHAT MAY BE THERE E0500455ÐÐ IF (IPGMID(1).EQ.$2020) GO TO 500 E0500456C IF THERE IS AN ID INPUT PUT IT IN THE RPG FIELD POSITION E0500457 DO 450 IX=1,3 E0500458 LINBFR(IX+8)=IPGMID(IX) E0500459 RECBUF(IX+37)=IPGMID(IX) E0500460 450 CONTINUE E0500461C PUT LINE NUMBER INTO RPG FIELD POSITION E0500462 500 CALL HEXDEC(LINENO,NUMBER(1)) E0500463 LINBFR(3)=AND(NUMBER(1),$00FF)*$100+AND(NUMBER(2),$FF00)/$100 E0500464 RECBUF(1)=AND(NUMBER(1),$00FF)*$100+AND(NUMBER(2),$FF00)/$100 E0500465 LINBFR(4)=AND(NUMBER(2),$00FF)*$100+AND(NUMBER(3),$FF00)/$100 E0500466 RECBUF(2)=AND(NUMBER(2),$00FF)*$100+AND(NUMBER(3),$FF00)/$100 E0500467 LINBFR(5)=AND(NUMBER(3),$00FF)*$100+FORMTP E0500468 RECBUF(3)=AND(NUMBER(3),$00FF)*$100+FORMTP E0500469C E0500470C BEGIN INPUTTING TEXT E0500471C -------------------- E0500472C INITIALIZE NEXT EDIT RECORD AS BLANKS E0500473 600 CALL SET(FBUFFR,40,$2020) E0500474C SET CURSOR POSITION BEFORE READ TO FIRST TAB ON THIS LINE E0500475 700 ICORDS=(TABBUF(IT)-1)*$100+ISCRLN E0500476C IF THIS IS NOT THE FIRST TAB POSITION, DON'T OUTPUT THE HEADER E0500477 IF (IT.NE.1) GO TO 3100 E0500478C MOVE LINBFR TO LINBUF IN COMMON E0500479 DO 1100 IX=1,53 E0500480ÐÐ LINBUF(IX)=LINBFR(IX) E0500481 1100 CONTINUE E0500482C OUTPUT THE STATEMENT LINE AND TRAILER AND INPUT RECORD E0500483C OUTPUT BLANK STATEMENT LINE ( NO INPUT) E0500484 1150 CALL WTREAD (TERMLU,ISCRLN,LINBUF,11,-0,TBUFFR,0,TC) E0500485C OUTPUT CHARACTER POSITION GUIDE LINE (WITH INPUT) E0500486 ISCRLN = ISCRLN + 1 E0500487 CALL WTREAD (TERMLU,ISCRLN,LINBUF(12),41,ICORDS,TBUFFR,40,TC) E0500488 ISCRLN = ISCRLN - 1 E0500489C E0500490C IF NO DATA HAS BEEN ENTERED, SKIP THE DATA MOVE E0500491 1160 IF (TBUFFR(41).EQ.0) GOTO 1200 E0500492C E0500493C BEGIN MOVING DATA INTO RECBUF E0500494C ----------------------------- E0500495C IF THE TERMINATION CODE IS A RUBOUT DONT MOVE THE DATA E0500496 IF (TC.EQ.4) GOTO 5000 E0500497C SAVE THE CURRENT CHARACTER POSITION E0500498 ICURCH=TABBUF(IT)+TBUFFR(41) E0500499C MOVE THE DATA FROM THE DATA BUFFER TO THE RECORD BUFFER E0500500 IY=TBUFFR(41)/2 E0500501C IS THERE AN ODD NUMBER OF CHARACTERS E0500502 IF (AND(TBUFFR(41),1).NE.0) IY=IY+1 E0500503 IX=TABBUF(IT)/2+1 E0500504C DOES THE INPUT START ON THE EVEN (LOWER) CHARACTER E0500505ÐÐ IF (AND(TABBUF(IT),1).EQ.0) GO TO 1175 E0500506 DO 1165 IZ=1,IY E0500507 IDUMB=IX+IZ-1 E0500508C THE CHARACTER GOING INTO RECBUF SHOULD START IN THE UPPER BYTE E0500509 RECBUF(IDUMB)=TBUFFR(IZ) E0500510 1165 CONTINUE E0500511 GO TO 1200 E0500512C THE CHARACTER GOING INTO RECBUF SHOULD START IN THE LOWER BYTE E0500513 1175 IX=TABBUF(IT)/2 E0500514 DO 1185 IZ=1,IY E0500515 IDUMB=IX+IZ-1 E0500516 RECBUF(IDUMB)=AND(RECBUF(IDUMB),$FF00)+AND(TBUFFR(IZ),$FF00)/$100 E0500517 RECBUF(IDUMB+1)=AND(RECBUF(IDUMB+1),$00FF)+ E0500518 1AND(TBUFFR(IZ),$00FF)*$100 E0500519 1185 CONTINUE E0500520C GO TO THE APPROPRIATE TERMINATION CODE PROCESSOR E0500521C 0 = BUFFER FULL E0500522C 1 = TAB E0500523C 2 = CARRIAGE RETURN E0500524C 3 = LINE FEED E0500525C 4 = RUB OUT E0500526C LESS THAN 0 OR GREATER THAN 4 ARE UNDEFINED AND HANDLED E0500527C THE SAME AS CARRIAGE RETURN E0500528 IF (TC.LE.0) GOTO 2000 E0500529 1200 GOTO (3000,4000,2000,5000,2000),TC E0500530ÐÐC E0500531C RECORD TERMNATION PROCESSOR E0500532C --------------------------- E0500533 2000 DO 2100 IX=1,80 E0500534 IY=(IX+1)/2 E0500535C IS THIS THE ODD (UPPER) CHARACTER E0500536 IF (AND(IX,1).NE.0) GO TO 2075 E0500537C E0500538C NO, THIS IS THE EVEN (LOWER) CHARACTER E0500539C IS IT A RIGHT ARROW ($15) E0500540 IF (AND(RECBUF(IY),$00FF).EQ.$15) GO TO 2100 E0500541C NO, MOVE THE CHARACTER TO THE FILE BUFFER E0500542 FBUFFR(IY)=AND(FBUFFR(IY),$FF00)+AND(RECBUF(IY),$00FF) E0500543 GO TO 2100 E0500544C E0500545C IS THIS A RIGHT ARROW ($15) E0500546 2075 IF (AND(RECBUF(IY),$FF00).EQ.$1500) GO TO 2100 E0500547C NO, MOVE THE CHARACTER TO THE FILE BUFFER E0500548 FBUFFR(IY)=AND(FBUFFR(IY),$00FF)+AND(RECBUF(IY),$FF00) E0500549 2100 CONTINUE E0500550C E0500551C IS THIS AN EXISTING RECORD E0500552 IF (IS(LINIDX).NE.0) GOTO 2105 E0500553C ENTER A RELATIVE RECORD NUMBER FOR NEW EDIT RECORD E0500554 IS(LINIDX)=IRECPT(2) E0500555ÐÐC IF NEW RECORD IS NOT AT END OF FILE, TURN ON RESEQUENCE FLAG E0500556 IF (LINENO.LT.STNMBR) IRESFG=1 E0500557C BUMP RELATIVE RECORD NUMBER E0500558 IRECPT(2)=IRECPT(2)+1 E0500559C E0500560C WRITE THIS RECORD BACK OUT E0500561C -------------------------- E0500562 2105 CALL UPDREC(REQBUF,FBUFFR,ISTAT) E0500563C VERIFY THE STATUS OF THE FILE MANAGER E0500564 IF (ISTAT.GE.0) GO TO 2150 E0500565C PUT THE FILE NAME INTO THE ERROR E0500566 2110 DO 2125 IX=1,4 E0500567 IDATA(IX)=NAMFIL(IX) E0500568 2125 CONTINUE E0500569C PUT THE STATUS INTO THE ERROR E0500570 IDATA(5)=ISTAT E0500571C OUTPUT THE ERROR - FILE MANAGER ERROR WHEN UPDATING FILE @@@@@@@@ E0500572C ISTAT = $ E0500573 CALL SYSMSG(FMER11,IDATA) E0500574 GOTO 8200 E0500575C E0500576C SET UP FOR NEXT RECORD E0500577C ---------------------- E0500578C CLEAR THE RECORD BUFFER E0500579 2150 CALL SET(RECBUF,40,$1515) E0500580ÐÐC INITIALIZE THE TEXT INPUT BUFFER E0500581 CALL SET(TBUFFR,40,$1515) E0500582C CHECK FOR NEW HIGHEST STATEMENT NUMBER E0500583 IF (LINENO.GT.STNMBR) STNMBR=LINENO E0500584C THIS IS TO SET UP FOR THE NEXT LINE E0500585 LINENO=LINENO+AUTOFG E0500586C DO THE NEXT LINE E0500587 GO TO 225 E0500588C E0500589C PREPARE TO GET NEXT TAB POSITION E0500590C -------------------------------- E0500591 3000 IT=IT+1 E0500592 IF (IT.LT.21) GOTO 700 E0500593 GOTO 2000 E0500594C E0500595C SET UP FOR THE NEXT TAB POSITION E0500596C -------------------------------- E0500597C THIS CONTINUES THE TAB DO LOOP E0500598C IF THERE ARE NO MORE TABS, DO THE NEXT LINE E0500599 3100 IF (TABBUF(IT).EQ.0) GO TO 2000 E0500600C E0500601C HAVE WE ALREADY PASSED THIS TAB POSITION E0500602 IF (TABBUF(IT).LE.ICURCH) GOTO 3000 E0500603C NO, CLEAR THE LAST RECORD LENGTH E0500604 TBUFFR(41)=0 E0500605ÐÐC CLEAR THE TEXT INPUT BUFFER E0500606 3200 CALL SET(TBUFFR,40,$1515) E0500607C SET THE CURSOR TO THE NEXT TAB AND READ E0500608 CALL WTREAD(TERMLU,-1,TBUFFR,0,ICORDS,TBUFFR,40,TC) E0500609 GO TO 1160 E0500610C E0500611C THIS IS A CARRIAGE RETURN E0500612C ------------------------- E0500613C HAVE ANY CHARACTERS BEEN ENTERED FOR THIS READ E0500614 4000 IF (TBUFFR(41).NE.0) GO TO 2000 E0500615C NO DATA, IS THIS THE FIRST READ FOR THIS RECORD E0500616 IF (IT.EQ.1) GO TO 8000 E0500617 GOTO 2000 E0500618C E0500619C THIS IS A RUB OUT E0500620C ----------------- E0500621C CLEAR ANY DATA ENTERED E0500622 5000 CALL SET(TBUFFR,40,$1515) E0500623C IF NO DATA WAS ENTERED, BACK UP TO THE PREVIOUS TAB POSITION E0500624 IF (TBUFFR(41).EQ.0) IT=IT-1 E0500625C IF THE TAB PTR IS OUT OF BOUNDS, RESET TO 1 E0500626 IF (IT.LT.1) IT=1 E0500627C IF RUBOUT IS BACKED UP TO 1ST TAB, OUTPUT THE LINE E0500628 IF (IT.EQ.1) GOTO 245 E0500629C CALCULATE CURSOR POSITION FOR PREVIOUS TAB POSITION E0500630ÐÐ ICORDS=(TABBUF(IT)-1)*$100+ISCRLN E0500631 GOTO 3200 E0500632C E0500633C PERFORM HOUSEKEEPING FUNCTIONS E0500634C ------------------------------ E0500635C CHECK TO SEE IF AN EOF IS NEEDED TO BE INSERTED E0500636 8000 IF (IRECPT(2).GE.TDATRL) GOTO 8075 E0500637C GET THE NEXT AVAILABLE RECORD E0500638 CALL READR(REQBUF,FBUFFR,IRECPT,ISTAT) E0500639C VERIFY THE STATUS OF THE FILE MANAGER E0500640 IF (ISTAT.LT.0) GOTO 250 E0500641C STORE AN EOF INDICATOR INTO THIS RECORD E0500642 8050 FBUFFR(1)=IEOFFM E0500643C UPDATE THIS LAST RECORD E0500644 CALL UPDREC(REQBUF,FBUFFR,ISTAT) E0500645C VERIFY THE STATUS OF THE FILE MANAGER E0500646 IF (ISTAT.LT.0) GO TO 2110 E0500647C CLEAR THE EOF E0500648 FBUFFR(1)=$2020 E0500649C PUT THE HIGHEST STATEMENT NUMBER INTO THE FCB E0500650 8075 FCBBUF(88)=STNMBR E0500651C OUTPUT THE UPDATED FCB E0500652 8090 CALL UPDFCB(REQBUF,0,0,FCBBUF,ISTAT) E0500653C VERIFY THE STATUS OF THE FILE MANAGER E0500654 IF (ISTAT.GE.0) GO TO 9000 E0500655ÐÐC MOVE THE FILE NAME TO ERROR E0500656 DO 8100 IX=1,4 E0500657 IDATA(IX)=NAMFIL(IX) E0500658 8100 CONTINUE E0500659C PUT THE STATUS IN ERROR E0500660 IDATA(5)=ISTAT E0500661C OUTPUT THE ERROR - FILE MANAGER ERROR WHEN UPDATING FCB FOR FILE E0500662C @@@@@@@@ ISTAT = $ E0500663 CALL SYSMSG(FMER12,IDATA) E0500664 8200 IERRFG=-1 E0500665 9000 CALL RETURN E0500666 RETURN E0500667 END E0500668 SUBROUTINE CHAPRO E0600001 1 /E06 F ITOS CCS 3.0 SL-149E0600002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO PROCESS 'CHANGE' COMMAND E0600003C CREDIT COLLECTION SYSTEM VERSION 3.0 E0600004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E0600005C COPYRIGHT CONTROL DATA CORPORATION 1978 E0600006C E0600007C*** E0600008C FUNCTION E0600009C -------- E0600010CS3 THE FUNCTION OF THIS PROGRAM IS TO PROCESS THE 'CHANGE' E0600011C COMMAND. E0600012ÐÐCS5 GENERAL FLOW E0600013C ------- ---- E0600014CS3 THE OPERATIONS PERFORMED BY THIS ROUTINE INCLUDE: E0600015C 1. INITIALIZE THE STARTING AND ENDING LINE E0600016C NUMBER, THE CHANGE OCCURRED FLAG AND THE E0600017C SCREEN LINE COUNT. E0600018C 2. GET THE CHARACTER STRING TO CHANGE. IF AN E0600019C ERROR OCCURS WHILE GETTING THE CHARACTER E0600020C STRING, RETURN TO THE CONTROL PROCESSOR. E0600021C IF NO ERROR OCCURS CHECK TO SEE IF END OF E0600022C DATA IN THE COMMAND BUFFER WAS ENCOUNTERED. E0600023C IF SO, OUTPUT THE ERROR 'INVALID COMMAND'. E0600024C IF NOT, MOVE THE CHARACTER STRING TO CHANGE E0600025C TO THE COMPARISON BUFFER. E0600026C 3. GET THE REPLACEMENT CHARACTER STRING. IF E0600027C AN ERROR OCCURS WHILE GETTING THE REPLACEMENT E0600028C CHARACTER STRING, RETURN TO THE CONTROL E0600029C PROCESSOR. E0600030C 4. GET THE STARTING LINE NUMBER. IF AN ERROR E0600031C OCCURS WHEN GETTING THIS NUMBER, RETURN TO CALLER. E0600032C IF A STARTING LINE WAS ENTERED SAVE IT. E0600033C E0600034C GET THE ENDING LINE NUMBER. IF AN ERROR OCCURS E0600035C WHEN GETTING THIS NUMBER, RETURN TO CALLER. E0600036C IF THERE IS AN ENDING LINE NUMBER ENTERED, SAVE E0600037ÐÐC IT FOR LATER USE. IF NONE WAS ENTERED, BUT THERE IS E0600038C A STARTING LINE NUMBER, THEN DO ONLY 1 LINE. IF E0600039C NEITHER A STARTING OR ENDING LINE NUMBER WAS E0600040C ENTERED, DO THE WHOLE FILE. E0600041C E0600042C 5. GET THE STARTING CHARACTER NUMBER. IF AN ERROR E0600043C OCCURS WHEN GETTING THIS NUMBER, RETURN TO CALLER. E0600044C IF THERE IS A STARTING CHARACTER NUMBER, SAVE E0600045C IT FOR LATER USE. E0600046C E0600047C GET THE ENDING CHARACTER NUMBER. IF AN ERROR OCCURS E0600048C WHEN GETTING THIS NUMBER, RETURN TO CALLER. IF E0600049C THERE IS AN ENDING CHARACTER NUMBER, SAVE IT FOR E0600050C LATER USE. IF NONE WAS ENTERED, BUT THERE IS A E0600051C STARTING LINE NUMBER, THEN LIMIT THE CHANGES TO E0600052C 1 CHARACTER. IF NEITHER A STARTING OR ENDING E0600053C CHARACTER NUMBER WAS ENTERED, DO THE WHOLE RECORD E0600054C E0600055C GET THE VETO FIELD. IF AN ERROR OCCURS WHEN GETTING E0600056C THIS FIELD, RETURN TO CALLER. IF FIELD IS NOT BLANK, E0600057C THEN INDICATE VETO OPTION IS IN EFFECT. E0600058C 6. IF THE BEGINNING LINE IS GREATER THAN THE E0600059C ENDING LINE, OUTPUT THE ERROR 'INVALID COMMAND' E0600060C AND RETURN TO THE CONTROL PROCESSOR. E0600061C IF THE STARTING CHARACTER POSITION IS LESS THAN E0600062ÐÐC THE ENDING CHARACTER POSITION, THEN OUTPUT THE E0600063C ERROR 'INVALID COMMNAD' AND RETURN TO THE CALLER. E0600064C 7. FIND THE NEXT RECORD BETWEEN THE STARTING AND E0600065C ENDING LINE. IF AN ERROR OCCURS WHILE GETTING E0600066C THIS LINE, RETURN CONTROL TO THE CONTROL E0600067C PROCESSOR. E0600068C 8. IF THE ENDING LINE HAS NOT BEEN PROCESSED, MOVE E0600069C THE RECORD FROM THE FILE BUFFER TO THE COMMAND E0600070C INPUT BUFFER SO IT CAN BE SCANNED WITH PROGRAM E0600071C 'ELNSCN' E0600072C A. MAKE SURE THE END OF DATA FLAG IS NOT SET. E0600073C INITIALIZE THE STARTING POSITION FOR THE E0600074C EXISTING RECORD AND THE NEW ONE, IF ONE IS E0600075C NEEDED. E0600076C B. SET THE FIRST AND LAST CHARACTER POSITION E0600077C TO BE SCANNED DEPENDING ON THE FILE AND E0600078C RECORD TYPE. E0600079C C. LOOK FOR A MATCH IN THIS RECORD. E0600080C 1. IF A MATCH WAS FOUND, CONTINUE AT THE E0600081C MATCH PROCESSOR SECTION. E0600082C 2. IF A MATCH WAS NOT FOUND, CHECK TO SEE E0600083C IF A MATCH WAS FOUND ANYWHERE IN THIS E0600084C RECORD. IF NOT, GET THE NEXT RECORD E0600085C TO BE PROCESSED. E0600086C IF A MATCH HAS BEEN FOUND BEFORE IN THIS E0600087ÐÐC RECORD, MOVE THE REST OF THE RECORD INTO E0600088C THE INTERMEDIATE RECORD BUFFER. E0600089C MOVE THE CHARACTERS IN POSITIONS 75 - 80 E0600090C INTO THE INTERMEDIATE RECORD BUFFER, AND E0600091C CONTINUE PROCESSING AT THE NEW RECORD E0600092C PROCESSOR SECTION. E0600093C D. MATCH PROCESSOR SECTION E0600094C 1. SET THE CHANGE OCCURRED FLAG. E0600095C 2. IF THE CHARACTER POSITION IN THE EXISTING E0600096C RECORD IS NOT THE SAME AS THE LAST E0600097C CHARACTER POSITION PROCESSED FROM THE E0600098C EXISTING RECORD, MOVE ALL CHARACTERS E0600099C FROM THE LAST POSITION PROCESSED TO THE E0600100C CURRENT START OF THE STRING MATCHED. E0600101C 3. MOVE THE NEW STRING TO THE NEW RECORD. E0600102C 4. IF THE NEW RECORD IS FULL, GO TO THE E0600103C NEW RECORD PROCESSOR SECTION E0600104C 5 IF THE WHOLE EXISTING RECORD HAS BEEN E0600105C CHECKED, GO TO THE NEW RECORD PROCESSOR E0600106C SECTION. E0600107C E. MESSAGE OUTPUT SECTION E0600108C 1. OUTPUT THE CHANGED LINE ON THE SCREEN. E0600109C BUMP THE SCREEN LINE COUNTER. E0600110C 2. IF THIS IS THE BOTTOM OF THE SCREEN E0600111C OUTPUT THE MESSAGE 'PAUSE' AND WAIT E0600112ÐÐC FOR A REPLY FROM THE USER. WHEN THE E0600113C USER REPLIES, CONTINUE SEARCHING THIS E0600114C LINE FOR MORE MATCHES. E0600115C 9. NEW RECORD SECTION E0600116C A. MOVE THE COMPLETE CHANGED RECORD FROM THE E0600117C INTERMEDIATE RECORD BUFFER BACK TO THE E0600118C FILE BUFFER. E0600119C B. UPDATE THE RECORD IN THE FILE. IF AN ERROR E0600120C OCCURS OUTPUT THE MESSAGE 'FILE MANAGER E0600121C ERROR WHEN UPDATING FILE @@@@@@@@ ISTAT = E0600122C $$$$' AND RETURN TO THE CONTROL PROCESSOR. E0600123C C. IF NO ERRORS OCCUR, GO BACK TO PROCESS THE E0600124C NEXT LINE. E0600125C 10. IF ALL RECORDS HAVE BEEN PROCESSED AND NO E0600126C CHANGES HAVE OCCURRED, OUTPUT THE MESSAGE E0600127C 'OPERATION FINISHED STRING NOT FOUND'. E0600128C 11. RETURN CONTROL TO THE CONTROL PROCESSOR. E0600129CS5 ENTRY/EXIT E0600130C ---------- E0600131CS3 THIS ROUTINE IS ENTERED FROM THE CONTROL PROCESSOR E0600132C 'EDITOS'. THE COMMAND INPUT BUFFER MUST CONTAIN THE E0600133C PARAMETER STRING FOR THE CHANGE COMMAND E0600134C E0600135C EXIT TO THE CONTROL PROCESSOR IS E0600136C 1. IERRFG = 0 NO ERRORS E0600137ÐÐC = + NON FATAL EDITOR ERROR. ANOTHER E0600138C PROCESSOR MAY BE ENTERED. E0600139C = - A FATAL EDITOR ERROR OCCURRED. E0600140C THE EDITOR IS TERMINATED. E0600141CS5 ERROR MESSAGES E0600142C ----- -------- E0600143CS3 THE FOLLOWING ERROR MESSAGES ARE OUTPUT BY THE CHANGE E0600144C PROCESSOR E0600145C EDITOR ERROR 309 E0600146C 'INVALID COMMAND' E0600147C EDITOR FILE MANAGER ERROR 341 E0600148C 'FILE MANAGER ERROR WHEN UPDATING FILE @@@@@@@@ E0600149C ISTAT = $$$$' E0600150CS5 ENTRIES E0600151C ------- E0600152CS3 ENTRY POINT REFERENCED BY E0600153C ----- ----- ---------- -- E0600154C CHAPRO EDITOS E0600155CS5 EXTERNAL REFERENCES E0600156C -------- ---------- E0600157CS3 EXTERNAL EXTERNAL E0600158C -------- -------- E0600159C SAVE GETSTR E0600160C SYSMSG GETNUM E0600161C FNDNXT STRMCH E0600162ÐÐC UPOREC UPNREC E0600163C OUTPUT WTREAD E0600164C GETAFD SET E0600165C RETURN UPDREC E0600166C*** E0600167M EDITCM E0600168 INTEGER ICOLST,ICOLEN E0600169 INTEGER IREPLN,IBEGLN E0600170 INTEGER IMATCH E0600171 INTEGER PAUSE E0600172 DIMENSION PAUSE(4) E0600173 DATA PAUSE(1)/$0D0A/ E0600174 DATA PAUSE(2)/'PA'/ E0600175 DATA PAUSE(3)/'US'/ E0600176 DATA PAUSE(4)/'E '/ E0600177 INTEGER CONFRM(18) E0600178 DATA (CONFRM(I),I=1,18)/'TYPE CARRIAGE RETURN IF CHANGE IS OK'/ E0600179 INTEGER IVETO E0600180 INTEGER CLRSCN E0600181 DATA CLRSCN/$1800/ E0600182 DIMENSION IOPFIN(19) E0600183 DATA (IOPFIN(I),I=1,19)/'OPERATION FINISHED...STRING NOT FOUND '/ E0600184 INTEGER EDER09 E0600185 INTEGER EDER19 E0600186 INTEGER FMER11 E0600187ÐÐ DATA EDER09/309/ E0600188 DATA EDER19/319/ E0600189 DATA FMER11/341/ E0600190C SAVE ENTRY FOR RETURN E0600191 CALL SAVE(CHAPRO) E0600192C HAS THE USER DONE A GET YET E0600193 IF (NAMFIL(1).NE.$2020) GO TO 10 E0600194C OUTPUT THE ERROR - NO FILE OPEN FOR EDITOR USE E0600195 CALL SYSMSG(EDER19,IDATA) E0600196 GOTO 9000 E0600197C E0600198C RETRIEVE CHANGE PARAMETERS E0600199C -------------------------- E0600200C SET INITIAL VALUES FOR START AND ENDING LINE NUMBERS E0600201 10 BEGLIN=1 E0600202 ENDLIN=STNMBR E0600203C SET UP INITIAL VALUES FOR STARTING, ENDING CHARACTER POS E0600204 ICOLST=1 E0600205 ICOLEN=80 E0600206C ASSUME NO CHANGE VETO OPTION IN EFFECT E0600207 IVETO=0 E0600208C CLEAR THE CHANGE HAS OCCURRED FLAG E0600209 ICHANG=0 E0600210C SET UP THE INITIAL LINE COUNT E0600211 ISCRLN=1 E0600212ÐÐC E0600213C GET THE ORIGINAL TEXT RECORD STRING TO BE REPLACED E0600214 CALL GETSTR E0600215C DID AN ERROR OCCUR E0600216 IF (IERRFG.NE.0) GOTO 25 E0600217C SAVE LENGTH OF STRING WHICH WILL BE REPLACED E0600218 IBEGLN=IX-1 E0600219C IS THE END OF DATA FLAG SET E0600220 IF (ICHARC.GE.0) GO TO 100 E0600221C OUTPUT THE ERROR - INVALID COMMAND E0600222 25 CALL SYSMSG(EDER09,IDATA) E0600223 GO TO 9000 E0600224C MOVE THE CHARACTER STRING TO THE COMPARISON BUFFER E0600225 100 DO 200 IX=1,20 E0600226 STRBF2(IX)=STRBF1(IX) E0600227 200 CONTINUE E0600228C E0600229C GET THE REPLACEMENT STRING E0600230 CALL GETSTR E0600231C DID AN ERROR OCCUR E0600232 IF (IERRFG.NE.0) GOTO 25 E0600233C SAVE LENGTH OF REPLACEMENT STRING E0600234 IREPLN=IX-1 E0600235C E0600236C GET THE STARTING LINE NUMBER E0600237ÐÐ CALL GETNUM E0600238C DID AN ERROR OCCUR E0600239 IF (IERRFG.NE.0) GOTO 25 E0600240C IF STARTING LINE NUMBER IS ENTERED, USE IT E0600241 IF (NUMHEX.GT.0) BEGLIN=NUMHEX E0600242 IDUMB=NUMHEX E0600243C E0600244C GET THE ENDING LINE NUMBER E0600245 CALL GETNUM E0600246C DID AN ERROR OCCUR E0600247 IF (IERRFG.NE.0) GOTO 25 E0600248C IF ENDING LINE NUMBER IS ENTERED, USE IT E0600249 IF (NUMHEX.GT.0) ENDLIN=NUMHEX E0600250C IF THERE IS NO NUMBER ENTERED, DO ONLY ONE LINE E0600251 IF (NUMHEX.EQ.0.AND.IDUMB.NE.0) ENDLIN=BEGLIN E0600252C E0600253C SEE IF THERE IS A STARTING CHARACTER NUMBER E0600254 CALL GETNUM E0600255C DID AN ERROR OCCUR E0600256 IF (IERRFG.NE.0) GOTO 25 E0600257C IF STARTING CHARACTER POSITION IS GIVEN, USE IT E0600258 IF (NUMHEX.GT.0) ICOLST=NUMHEX E0600259 IDUMB=NUMHEX E0600260C E0600261C SEE IF THERE IS AN ENDING CHARACTER NUMBER E0600262ÐÐ CALL GETNUM E0600263C DID AN ERROR OCCUR E0600264 IF (IERRFG.NE.0) GOTO 25 E0600265C IF ENDING CHARACTER POSITION IS GIVEN, USE IT E0600266 IF (NUMHEX.GT.0) ICOLEN=NUMHEX E0600267C IF THERE IS NO ENDING COLUMN NUMBER, DO ONLY 1 CHARACTER E0600268 IF (NUMHEX.EQ.0.AND.IDUMB.NE.0) ICOLEN=ICOLST E0600269C IF TARGET STRING=EMPTY STRING, ASSUME ENDING CHARACTER NUMBER= E0600270C STARTING CHARACTER NUMBER E0600271 IF (IBEGLN.EQ.0.AND.NUMHEX.EQ.0) ICOLEN=ICOLST E0600272C IF TARGET STRING=EMPTY STRING AND STARTING CHARACTER NUMBER E0600273C IS NOT EQUAL TO ENDING CHARACTER NUMBER, OUTPUT ERROR E0600274 IF (IBEGLN.EQ.0.AND.ICOLEN.NE.ICOLST) GOTO 25 E0600275C E0600276C SEE IF THE VETO OPTION IS TO BE EXERCISED E0600277 CALL GETAFD E0600278C IF THERE IS A CHARACTER(NON-BLANK) INDICATE VETO IS IN EFFECT E0600279 IF (ALFFLD(1).NE.$2020) IVETO=1 E0600280C E0600281C IS THE STARTING LINE BELOW THE ENDING LINE E0600282 400 IF (BEGLIN.GT.ENDLIN) GO TO 25 E0600283C IF STARTING COLUMN IS GREATER THAN ENDING COLUMN, GO OUTPUT ERROR E0600284 IF (ICOLST.GT.ICOLEN) GOTO 25 E0600285C IF ENDING COLUMN NUMBER IS GREATER THAN 80, THEN OUTPUT ERROR E0600286 IF (ICOLEN.GT.80) GOTO 25 E0600287ÐÐC IF THE TARGET,REPLACEMENT STRINGS ARE BOTH EMPTY STRINGS, E0600288C OUTPUT ERROR E0600289 IF (IBEGLN.EQ.0.AND.IREPLN.EQ.0) GOTO 25 E0600290C SET THE INITIAL LINE NUMBER TO THE STARTING LINE NUMBER E0600291 LINENO=BEGLIN E0600292C E0600293C BEGIN CHANGE STRING PROCESSING E0600294C ------------------------------ E0600295C GET THE NEXT RECORD E0600296 500 CALL FNDNXT E0600297C DID AN ERROR OCCUR E0600298 IF (IERRFG.NE.0) GO TO 9000 E0600299C HAS THE ENDING LINE BEEN EXCEEDED E0600300 IF (LINENO.GT.ENDLIN) GO TO 1300 E0600301C MOVE THE RECORD TO CMNDBF SO IT CAN BE PROCESSED BY 'ELNSCN' E0600302 DO 600 IX=1,40 E0600303 CMNDBF(IX)=FBUFFR(IX) E0600304 600 CONTINUE E0600305C SET THE LAST LOCATION TO $FFFF E0600306 CMNDBF(41)=$FFFF E0600307C CLEAR POSSIBLE EOF FROM RECORD BEING CHECKED E0600308 IF (CMNDBF(1).EQ.IEOFFM) CMNDBF(1)=$2020 E0600309C MAKE SURE THE END OF DATA FLAG IS NOT SET E0600310 ICHARC=0 E0600311C SET THE INITIAL CHARACTER FOR 'ELNSCN',THE E0600312ÐÐC START POSITION FOR THE EXISTING RECORD AND THE NEW RECORD E0600313 NRECST=1 E0600314 ICHSTO=1 E0600315C IS THIS AN RPG FILE E0600316 IF (FCBBUF(87).LE.1) GO TO 625 E0600317C YES, IS THIS LINE RPG ARRAY DATA E0600318 IF (FCBBUF(86).EQ.0) GO TO 610 E0600319 IF (FCBBUF(86).LE.LINENO) GO TO 625 E0600320C SET UP RECORD LIMITS FOR RPG RECORDS E0600321 610 CHARNO=6 E0600322 IF (ICOLST.GT.6) CHARNO=ICOLST E0600323C SAVE START,END OF RECORD LIMITS E0600324 ICOLST=CHARNO E0600325 IENREC=80 E0600326 GO TO 650 E0600327C SET UP RECORD LIMITS FOR NON-RPG RECORDS E0600328 625 CHARNO=ICOLST E0600329 IENREC=75 E0600330C PUT THE SMALLER TERMINATION NUMBER OF ICOLEN,IENREC IN ICOLEN E0600331 650 IF (ICOLEN.GT.IENREC) ICOLEN=IENREC E0600332C INITILIZE THE NEW RECORD BUFFER TO BLANKS E0600333 CALL SET(RECBUF,38,$2020) E0600334C ASSUME THERE IS NO MATCH FOR THE CURRENT RECORD E0600335 IMATCH=0 E0600336C E0600337ÐÐC STRING MATCHING LOOP E0600338C -------------------- E0600339C GET THE LENGTH OF STRING TO BE REPLACED E0600340 675 ISRLNG=IBEGLN E0600341C PASS ENDING CHARACTER POSITION TO TRY FOR A MATCH E0600342 IY=ICOLEN E0600343C LOOK FOR A STRING MATCH E0600344 CALL STRMCH E0600345C IF THERE IS A MATCH, CONTINUE ON E0600346 IF (ISRMCH.GE.0) GOTO 700 E0600347C IF THERE ARE NO CHANGES, CONTINUE ON E0600348 IF (IMATCH.EQ.0) GOTO 1150 E0600349C SET ENDING CHARACTER POSITION TO MOVE REMAINDER OF RECORD E0600350 ISTRST=IENREC+1 E0600351C GO MOVE THE REST OF THE RECORD IN E0600352 GOTO 900 E0600353C E0600354C STRING MATCH FOUND--MOVE IN REPLACEMENT STRING E0600355C ---------------------------------------------- E0600356C INDICATE THAT A CHANGE HAS BEEN MADE E0600357 700 ICHANG=1 E0600358C INDICATE A MATCH HAS OCCURRED INTHIS RECORD E0600359 IMATCH=1 E0600360C ARE WE AT THIS POSITION IN THE EXISTING RECORD E0600361 IF (ISTRST.EQ.ICHSTO) GOTO 800 E0600362ÐÐC MOVE CHARACTERS FROM THE CURRENT CHARACTER POSITION E0600363C TO THE PROPER CHARACTER POSITION IN THE NEW RECORD E0600364 CALL UPOREC E0600365C IF THE NEW RECORD IS FULL, THEN CONTINUE ON E0600366 IF (NRECST.GT.IENREC) GOTO 915 E0600367C UPDATE THE MATCHED STRING WITH THE NEW STRING E0600368 800 ISRLNG=IREPLN E0600369 CALL UPNREC E0600370C IF THE OLD RECORD IS NOT FULLY CHECKED, CONTINUE ON E0600371 IF (ISTRST.LE.IENREC) GOTO 675 E0600372C E0600373C RECORD CHANGE IS COMPLETED E0600374C -------------------------- E0600375C MOVE THE REST OF THE CURRENT RECORD TO THE NEW RECORD E0600376C GO UPDATE REMAINING PORTION OF RECORD E0600377 900 CALL UPOREC E0600378C IF SEQUENCE NUMBER IS NOT TO BE COPY, THEN CONTINUE E0600379 915 IF (IENREC.EQ.80) GOTO 925 E0600380C MOVE PROGRAM ID OR SEQUENCE NUMBER IN COLUMNS 75-80 E0600381 RECBUF(38)=AND(RECBUF(38),$FF00)+AND(CMNDBF(38),$FF) E0600382 RECBUF(39)=CMNDBF(39) E0600383 RECBUF(40)=CMNDBF(40) E0600384C CLEAR SCREEN IF AT TOP OF SCREEN E0600385 925 IF (ISCRLN.EQ.1) CALL OUTPUT(TERMLU,CLRSCN,1) E0600386C WRITE OUT CHANGED RECORD E0600387ÐÐ CALL WTREAD(TERMLU,ISCRLN,RECBUF,40,-1,0,0,TC) E0600388C BUMP SCREEN LINE COUNT E0600389 ISCRLN=ISCRLN+1 E0600390C IF VETO OPTION IS NOT IN EFFECT, CONTINUE ON E0600391 IF (IVETO.EQ.0) GOTO 940 E0600392C CALCULATE CURSOR POSITION FOR REPLY E0600393 IDUMB=$2800+ISCRLN E0600394C ASK FOR CARRIGE RETURN CONFIRMATION E0600395 CALL WTREAD(TERMLU,ISCRLN,CONFRM,18,IDUMB,ISCRPT,1,TC) E0600396C IF A CHARACTER WAS ENTERED, THEN IGNORE CHANGE E0600397 IF (ISCRPT(2).EQ.0) GOTO 940 E0600398C BUMP SCREEN LINE COUNT TO INDICATE RECORD REJECTION E0600399 ISCRLN=ISCRLN+1 E0600400 GOTO 1100 E0600401C MOVE THIS NEW RECORD BACK TO THE FILE BUFFER E0600402 940 DO 950 IX=1,40 E0600403 FBUFFR(IX)=RECBUF(IX) E0600404 950 CONTINUE E0600405C UPDATE THE RECORD E0600406 960 CALL UPDREC(REQBUF,FBUFFR,ISTAT) E0600407C VERIFY THE STATUS OF THE FILE MANAGER E0600408 IF (ISTAT.GE.0) GOTO 1100 E0600409C MOVE THE FILE NAME TO ERROR E0600410 DO 980 IX=1,4 E0600411 IDATA(IX)=NAMFIL(IX) E0600412ÐÐ 980 CONTINUE E0600413C PUT THE STATUS IN ERROR E0600414 IDATA(5)=ISTAT E0600415C OUTPUT THE ERROR - FILE MANAGER WHEN UPDATING FILE @@@@@@@@ E0600416C ISTAT=$$$$ E0600417 CALL SYSMSG(FMER11,IDATA) E0600418C SET THE ERROR FLAG E0600419 IERRFG=-1 E0600420 GOTO 9000 E0600421C E0600422C HAVE WE REACHED THE BOTTOM OF THE SCREEN YET E0600423 1100 IF (ISCRLN.LT.22-IVETO) GOTO 1150 E0600424C IF VETO OPTION IS IN EFFECT, DON'T OUTPUT 'PAUSE' E0600425 IF (IVETO.EQ.1) GOTO 1125 E0600426C OUTPUT 'PAUSE' AND WAIT FOR CARRIAGE RETURN E0600427 CALL WTREAD(TERMLU,-1,PAUSE,4,-1,ISCRPT,1,TC) E0600428C RESET SCREEN LINE COUNT TO 1 E0600429 1125 ISCRLN=1 E0600430C E0600431C PREPARE TO GET NEXT RECORD E0600432C -------------------------- E0600433C BUMP RECORD POINTER TO GET NEXT RECORD E0600434 1150 LINENO=LINENO+1 E0600435C IF MANUAL INTERRUPT HASN'T OCCURRED, CONTINUE ON E0600436 IF (IFLAGX.EQ.0) GOTO 500 E0600437ÐÐC E0600438C HAVE ANY CHANGES OCCURRED E0600439 1300 IF (ICHANG.NE.0) GO TO 9000 E0600440C OUTPUT THE MESSAGE - OPERATION FINISHED...STRING NOT FOUND E0600441 CALL OUTPUT(TERMLU,IOPFIN,19) E0600442 9000 CALL RETURN E0600443 RETURN E0600444 END E0600445 SUBROUTINE CLEPRO E0700001 1 /E07 F ITOS CCS 3.0 SL-149E0700002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO PROCESS 'CLEAR' COMMAND E0700003C CREDIT COLLECTION SYSTEM VERSION 3.0 E0700004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E0700005C COPYRIGHT CONTROL DATA CORPORATION 1978 E0700006C E0700007C*** E0700008C FUNCTION E0700009C -------- E0700010CS3 THE FUNCTION OF THIS PROGRAM IS TO PROCESS THE 'CLEAR' E0700011C COMMAND. E0700012CS5 GENERAL FLOW E0700013C ------- ---- E0700014CS3 THE OPERATIONS PERFORMED BY THIS ROUTINE INCLUDE: E0700015C 1. CLEAR THE INTERMEDIATE RECORD BUFFER E0700016C 2. IF THERE IS NO OPEN FILE, SKIP THE FCB UPDATE E0700017ÐÐC AND THE CLOSE FILE OPERATIONS. E0700018C 3. UPDATE THE FCB FOR THE USERS' FILE. IF ANY E0700019C ERRORS OCCUR OUTPUT THE ERROR 'FILE MANAGER E0700020C ERROR WHEN UPDATING FCB ISTAT = $$$$'. THEN E0700021C 4. CHECK TO SEE IF A RESEQUENCE OF THE FILE IS E0700022C NEEDED. IF NOT, GO TO THE CLOSE FILE OPERATION. E0700023C 5. SET THE END OF DATA FLAG SO THE RESEQUENCE E0700024C PROCESSOR WILL NOT CHECK FOR ANY PARAMETERS E0700025C 6. CALL THE RESEQUENCE PROCESSOR. ON RETURN E0700026C CLEAR THE RESEQUENCE NEEDED FLAG, SET THE E0700027C CURRENT CHARACTER TO A COMMA AND SKIP OVER E0700028C THE CLOSE FILE OPERATION. E0700029C 7. CLOSE THE USERS' FILE. IF ANY ERRORS OCCUR E0700030C OUTPUT THE ERROR 'FILE MANAGER ERROR WHEN E0700031C CLOSING FILE @@@@@@@@ ISTAT = $$$$'. E0700032C 8. CLEAR THE PROGRAM NAME AND PROGRAM IDENTIFI- E0700033C CATION BUFFERS. E0700034C 9. CLEAR THE STATEMENT LABEL INDEX FILE E0700035C 10. SET TAB STOPS TO NON RPG FORMAT. E0700036C 11. RETURN TO THE CONTROL PROCESSOR. E0700037CS5 ENTRY/EXIT E0700038C ---------- E0700039CS3 THIS ROUTINE IS ENTERED FROM THE CONTROL PROCESSOR E0700040C 'EDITOS', FROM THE EXIT PROCESSOR 'EXIT', FROM THE E0700041C GET PROCESSOR 'GETPRO' AND FROM THE SEQUENCE PROCESSOR E0700042ÐÐC 'SEQPRO'. E0700043C E0700044C EXIT TO ANY OF THE CALLING ROUTINES IS E0700045C 1. IERRFG = 0 NO ERRORS E0700046C = + NON FATAL EDITOR ERROR. ANOTHER E0700047C PROCESSOR MAY BE ENTERED. E0700048C = - A FATAL EDITOR ERROR OCCURRED. E0700049C THE EDITOR IS TERMINATED. E0700050CS5 ERROR MESSAGES E0700051C ----- -------- E0700052CS3 EDITOR FILE MANAGER 338 E0700053C 'FILE MANAGER ERROR UPDATING FCB ISTAT = $$$$' E0700054C EDITOR FILE MANAGER 339 E0700055C 'FILE MANAGER ERROR WHEN CLOSING FILE @@@@@@@@ E0700056C ISTAT =$$$$' E0700057CS5 ENTRIES E0700058C ------- E0700059CS3 ENTRY POINT REFERENCED BY E0700060C ----- ----- ---------- -- E0700061C CLEPRO EDITOS E0700062C GETPRO E0700063C SEQPRO E0700064CS5 EXTERNAL REFERENCES E0700065C -------- ---------- E0700066CS3 EXTERNAL EXTERNAL E0700067ÐÐC -------- -------- E0700068C SAVE SET E0700069C UPDFCB SYSMSG E0700070C RSQPRO CLOSFL E0700071C CLRSVM CTAPRO E0700072C RETURN E0700073C*** E0700074M EDITCM E0700075 INTEGER FMER08 E0700076 INTEGER FMER09 E0700077 DATA FMER08/338/ E0700078 DATA FMER09/339/ E0700079C SAVE ENTRY FOR RETURN E0700080 CALL SAVE(CLEPRO) E0700081C SET THE RECORD BUFFER TO RIGHT ARROWS($15) E0700082 CALL SET(RECBUF,40,$1515) E0700083C IF THERE IS NO OPENED FILE, DON'T UPDATE THE FCB OR CLOSE THE FILEE0700084 IF (AND(NAMFIL(1),$FF00).EQ.$2000) GO TO 300 E0700085C YES, UPDATE THE FCB FOR THIS FILE E0700086 CALL UPDFCB(REQBUF,0,0,FCBBUF,ISTAT) E0700087C VERIFY THE STATUS OF THE FILE MANAGER E0700088 IF (ISTAT.GE.0) GO TO 100 E0700089C PUT STATUS INTO ERROR E0700090 IDATA(1)=ISTAT E0700091C OUTPUT THE ERROR - FILE MANAGER ERROR UPDATING FCB ISTAT = $ E0700092ÐÐ CALL SYSMSG(FMER08,IDATA) E0700093 IERRFG=1 E0700094C IS THE RESEQUENCE FLAG SET E0700095 100 IF (IRESFG.EQ.0) GO TO 150 E0700096C SET THE END OF DATA FLAG E0700097 ICHARC=$8000 E0700098C RESEQUENCE THE FILE E0700099 CALL RSQPRO E0700100C CLEAR RESEQUENCE NEEDED FLAG E0700101 IRESFG=0 E0700102C RESET THE CHARACTER WORD TO A COMMA E0700103 ICHARC=$2C E0700104 GO TO 300 E0700105C CLOSE THIS USER FILE E0700106 150 CALL CLOSFL(REQBUF,ISTAT) E0700107C VERIFY THE STATUS OF THE FILE MANAGER E0700108 IF (ISTAT.GE.0) GO TO 300 E0700109C PUT FILE NAME INTO ERROR E0700110 DO 200 IX=1,4 E0700111 IDATA(IX)=NAMFIL(IX) E0700112 200 CONTINUE E0700113C PUT STATUS INTO ERROR E0700114 IDATA(5)=ISTAT E0700115C OUTPUT THE ERROR - FILE MANAGER ERROR WHEN CLOSING FILE @@@@@@@@ E0700116C ISTAT = $ E0700117ÐÐ CALL SYSMSG(FMER09,IDATA) E0700118 IERRFG=1 E0700119C CLEAR CURRENT FILE NAME E0700120 300 CALL SET(NAMFIL,4,$2020) E0700121C CLEAR ANY PROGRAM ID THAT EXISTS E0700122 CALL SET(IPGMID,3,$2020) E0700123C CLEAR THE STATEMENT LABEL INDEX FILE E0700124 CALL CLRSVM E0700125C DID ANY ERRORS OCCUR E0700126 IF (IERRFG.NE.0) GO TO 9000 E0700127C CLEAR ALL TAB STOPS E0700128 9000 CALL RETURN E0700129 RETURN E0700130 END E0700131 SUBROUTINE CTAPRO E0800001 1 /E08 F ITOS CCS 3.0 SL-149E0800002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO PROCESS THE 'CTAB' COMMAND E0800003C CREDIT COLLECTION SYSTEM VERSION 3.0 E0800004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E0800005C COPYRIGHT CONTROL DATA CORPORATION 1978 E0800006C E0800007C*** E0800008C FUNCTION E0800009C -------- E0800010CS3 THE FUNCTION OF THIS PROGRAM IS TO INITIALIZE ALL E0800011ÐÐC TAB STOP POSITIONS TO A NON-RPG FORMAT. E0800012CS5 GENERAL FLOW E0800013C ------- ---- E0800014CS3 THIS ROUTINE PERFORMS THE FOLLOWING OPERATIONS: E0800015C 1. CLEAR THE ENTIRE TAB STOP BUFFER TO ZEROS. E0800016C 2. SETS TAB STOPS FOR POSITIONS 1 AND 73. E0800017CS5 ENTRY/EXIT E0800018C ---------- E0800019CS3 ENTRY TO THIS ROUTINE IS FROM THE CONTROL PROCESSOR E0800020C 'EDITOS', OR INDIRECTLY THROUGH CALLS FROM THE CLEAR E0800021C PROCESSOR 'CLEPRO' OR THE SET TAB PROCESSOR 'STAPRO'. E0800022C IT IS ALSO CALLED DURING INITIALIZATION FROM 'INITLE'. E0800023C EXIT TO ALL CALLING PROGRAMS IS WITH NO ERROR E0800024C INDICATOR SET. E0800025CS5 ENTRIES E0800026C ------- E0800027CS3 ENTRY POINT REFERENCED BY E0800028C ----- ----- ---------- -- E0800029C CTAPRO EDITOS E0800030C CLEPRO E0800031C SETAUT E0800032C INITLE E0800033CS5 EXTERNAL REFERENCES E0800034C -------- ---------- E0800035CS3 EXTERNAL EXTERNAL E0800036ÐÐC ------------ -------- E0800037C RETURN SAVE E0800038C SET E0800039C*** E0800040M EDITCM E0800041C SAVE ENTRY FOR RETURN E0800042 CALL SAVE(CTAPRO) E0800043C CLEAR THE TAB STOP BUFFER E0800044 CALL SET(TABBUF,20,0) E0800045C SET A TAB FOR POSITION 1 E0800046 TABBUF(1)=1 E0800047C SET A TAB FOR POSITION 73 E0800048 TABBUF(2)=73 E0800049C CLEAR THE TAB INDEX E0800050 TABIDX=0 E0800051 CALL RETURN E0800052 RETURN E0800053 END E0800054 SUBROUTINE DELPRO E0900001 1 /E09 F ITOS CCS 3.0 SL-149E0900002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO PROCESS THE 'DELETE' COMMAND E0900003C CREDIT COLLECTION SYSTEM VERSION 3.0 E0900004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E0900005C COPYRIGHT CONTROL DATA CORPORATION 1978 E0900006C E0900007ÐÐC*** E0900008C FUNCTION E0900009C -------- E0900010CS3 THE FUNCTION OF THIS PROGRAM IS TO PROCESS THE 'DELETE' E0900011C COMMAND. E0900012CS5 GENERAL FLOW E0900013C ------- ---- E0900014CS3 THE FOLLOWING OPERATIONS ARE PERFORMED BY THIS PROGRAM: E0900015C 1. A CHECK IS MADE TO SEE IF THE IS A FILE OPEN. E0900016C IF NOT, THE ERROR 'NO FILE OPEN FOR EDITOR USE' E0900017C IS OUTPUT AND CONTROL IS RETURNED TO THE CALLING E0900018C PROGRAM. E0900019C 2. THE STARTING LINE NUMBER IS OBTAINED. IF ANY E0900020C ERRORS OCCUR, CONTROL RETURNS TO THE CALLING E0900021C PROGRAM. IF NOT, THE LINE NUMBER IS VALIDATED. E0900022C IF IT IS IN ERROR, THE ERROR 'INVALID FIELD' IS E0900023C IS OUTPUT. IF NOT, THE NUMBER IS SAVED AS THE E0900024C BEGINING LINE NUMBER. E0900025C 3. THE ENDING LINE NUMBER IS OBTAINED. IF ANY E0900026C ERRORS OCCUR, CONTROL RETURNS TO THE CALLING E0900027C PROGRAM. IF NOT, THE LINE NUMBER IS VALIDATED. E0900028C IF IT IS IN ERROR, THE ERROR 'INVALID FIELD' IS E0900029C OUTPUT. IF NOT, THE NUMBER IS SAVED AS THE E0900030C ENDING LINE NUMBER. IF NO NUMBER IS ENTERED E0900031C THE BEGINNING LINE NUMBER IS SAVED AS THE E0900032ÐÐC ENDING LINE NUMBER. E0900033C 4. THE LINE NUMBERS ARE VALIDATED TO BE SURE E0900034C THAT THE STARTING LINE IS NOT GREATER THAN E0900035C THE ENDING LINE. IF IT IS, THE ERROR 'INVALID E0900036C FIELD' IS OUTPUT AND CONTROL RETURNS TO THE E0900037C CALLING PROGRAM. E0900038C 5. THE NEXT RECORD WITHIN THESE LINE LIMITS IS E0900039C OBTAINED FROM THE DIRECTORY INDEX FILE. E0900040C 6. THE BLOCK SIZE FROM THE REQUEST BUFFER IS E0900041C SAVED AND CHANGED TO ONE FOR THE RECORD DELETE. E0900042C THE RECORD IS DELETED AND THE ORIGINAL BLOCK E0900043C SIZE IS PUT BACK INTO THE REQUEST BUFFER. IF E0900044C ANY ERRORS OCCURRED DURING THE DELETE REQUEST E0900045C THE ERROR 'FILE MANAGER ERROR WHEN DELETING E0900046C FROM FILE @@@@@@@@ ISTAT = $$$$' IS OUTPUT E0900047C AND CONTROL IS RETURNED TO THE USER. E0900048C 7. THE DIRECTORY INDEX FILE ENTRY FOR THIS LINE E0900049C IS CLEARED. THE RESEQUENCE NEEDED FLAG IS SET. E0900050C IF THE LAST LINE HAS NOT BEEN PROCESSED, THE E0900051C PROGRAM GOES BACK TO GET THE NEXT LINE. E0900052C 8. THERE IS A TEST TO SEE IF THE LAST RECORD OF E0900053C THE FILE HAS BEEN DELETED. IF SO, THE PROGRAM E0900054C 'FNDEND' IS CALLED TO FIND THE NEW HIGHEST E0900055C LINE NUMBER. THE HIGHEST STATEMENT NUMBER IS E0900056C SAVED IN THE FCB. E0900057ÐÐC 9. CONTROL IS RETURNED TO THE CONTROL PROCESSOR. E0900058CS5 ENTRY/EXIT E0900059C ---------- E0900060CS3 THIS ROUTINE IS ENTERED FROM THE CONTROL PROCESSOR E0900061C 'EDITOS'. THE COMMAND INPUT BUFFER MUST CONTAIN THE E0900062C PARAMETER STRING FOR THE DELETE COMMAND. E0900063C E0900064C EXIT TO THE CONTROL PROCESSOR IS E0900065C 1. IERRFG = 0 NO ERROR E0900066C = + NON FATAL EDITOR ERROR. ANOTHER E0900067C PROCESSOR MAY BE ENTERED. E0900068C = - A FATAL EDITOR ERROR OCCURRED. E0900069C THE EDITOR IS TERMINATED. E0900070CS5 ERROR MESSAGES E0900071C ----- -------- E0900072CS3 THE FOLLOWING ERROR MESSAGES ARE OUTPUT BY THE DELETE E0900073C COMMAND. E0900074C EDITOR ERROR 306 E0900075C 'INVALID FIELD' E0900076C EDITOR ERROR 319 E0900077C 'NO FILE OPEN FOR EDITOR USE' E0900078C EDITOR FILE MANAGER ERROR 335 E0900079C 'FILE MANAGER ERROR WHEN DELETING FROM FILE @@@@@@@@ E0900080C ISTAT = $$$$' E0900081CS5 ENTRIES E0900082ÐÐC ------- E0900083CS3 ENTRY POINT REFERENCED BY E0900084C ----- ----- ---------- -- E0900085C DELPRO EDITOS E0900086CS5 EXTERNAL REFERENCES E0900087C -------- ---------- E0900088CS3 EXTERNAL EXTERNAL E0900089C -------- -------- E0900090C DELREC FNDEND E0900091C FNDNXT GETNUM E0900092C RETURN SAVE E0900093C SYSMSG E0900094C*** E0900095M EDITCM E0900096 INTEGER EDER06 E0900097 INTEGER EDER19 E0900098 INTEGER FMER05 E0900099 DATA EDER06/306/ E0900100 DATA EDER19/319/ E0900101 DATA FMER05/335/ E0900102C SAVE ENTRY FOR RETURN E0900103 CALL SAVE(DELPRO) E0900104C HAS THE USER DONE A GET YET E0900105 IF (NAMFIL(1).NE.$2020) GO TO 10 E0900106C OUTPUT THE ERROR - NO FILE OPEN FOR EDITOR USE E0900107ÐÐ CALL SYSMSG(EDER19,IDATA) E0900108 GO TO 450 E0900109C GET NEXT FIELD - START LINE NUMBER E0900110 10 CALL GETNUM E0900111C DID AN ERROR OCCUR E0900112 IF (IERRFG.NE.0) GO TO 9000 E0900113C IF NO NUMBER WAS ENTERED IT IS AN ERROR E0900114 IF (NUMHEX.LE.0) GO TO 400 E0900115C SAVE THE STARTING LINE NUMBER E0900116 BEGLIN=NUMHEX E0900117 LINENO=NUMHEX E0900118C GET NEXT FIELD - END LINE NUMBER E0900119 CALL GETNUM E0900120C DID AN ERROR OCCUR E0900121 IF (IERRFG.NE.0) GO TO 9000 E0900122C IF NO NUMBER IS ENTERED, DELETE ONLY ONE LINE E0900123 IF (NUMHEX.LE.0) NUMHEX=BEGLIN E0900124C SAVE THE END LINE NUMBER E0900125 ENDLIN=NUMHEX E0900126C IF THE START LINE IS GREATER THAN THE END LINE E0900127C THIS IS AN ERROR E0900128 IF (BEGLIN.GT.ENDLIN) GO TO 400 E0900129C SET THE MODE FOR LOCATE TO WRITE E0900130 IMODE=1 E0900131C FIND THIS LINE NUMBER ENTRY E0900132ÐÐ 100 CALL FNDNXT E0900133C CHECK FOR AN ERROR HAVING OCCURRED E0900134 IF (IERRFG.NE.0) GO TO 9000 E0900135C SAVE BLOCK SIZE AND SET TO 1 RECORD FOR DELETE E0900136 IBLKSZ=REQBUF(15) E0900137 REQBUF(15)=1 E0900138C DELETE THE RECORD E0900139 CALL DELREC(REQBUF,FBUFFR,ISTAT) E0900140C RESET BLOCK SIZE E0900141 REQBUF(15)=IBLKSZ E0900142C VERIFY THE STATUS OF THE FILE MANAGER CALL E0900143 IF (ISTAT.GE.0) GO TO 300 E0900144C MOVE FILE NAME TO ERROR E0900145 DO 200 IX=1,4 E0900146 IDATA(IX)=NAMFIL(IX) E0900147 200 CONTINUE E0900148C MOVE STATUS TO ERROR E0900149 IDATA(5)=ISTAT E0900150C OUTPUT THE ERROR - FILE MANAGER ERROR WHEN DELETING FROM E0900151C FILE @@@@@@@@ ISTAT = $ E0900152 CALL SYSMSG(FMER05,IDATA) E0900153 GO TO 450 E0900154C CLEAR RECORD POINTER IN IS-ARRAY E0900155 300 IS(LINIDX)=0 E0900156C SET THE RESEQUENCE NEEDED FLAG E0900157ÐÐ IRESFG=1 E0900158C WAS THE LAST LINE DELETED E0900159 IF (LINENO.GE.ENDLIN) GO TO 500 E0900160C SET UP FOR NEXT LINE E0900161 LINENO=LINENO+1 E0900162 GO TO 100 E0900163C OUTPUT THE ERROR - INVALID FIELD E0900164 400 CALL SYSMSG(EDER06,IDATA) E0900165 450 IERRFG=1 E0900166 GO TO 9000 E0900167C HAS THE HIGHEST LINE OF THE FILE DELETED. IF SO, FIND THE NEW E0900168C HIGHEST LINE NUMBER E0900169 500 IF (LINENO.GE.STNMBR) CALL FNDEND E0900170C SET THE NEW HIGHEST STATEMENT NUMBER E0900171 FCBBUF(88)=STNMBR E0900172 9000 CALL RETURN E0900173 RETURN E0900174 END E0900175 SUBROUTINE GETPRO E1000001 1 /E10 F ITOS CCS 3.0 SL-149E1000002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO PROCESS THE 'GET' COMMAND E1000003C CREDIT COLLECTION SYSTEM VERSION 3.0 E1000004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E1000005C COPYRIGHT CONTROL DATA CORPORATION 1978 E1000006C E1000007ÐÐC*** E1000008C FUNCTION E1000009C -------- E1000010CS3 THE FUNCTION OF THIS PROGRAM IS TO PROCESS THE 'GET' E1000011C COMMAND. E1000012CS5 GENERAL FLOW E1000013C ------- ---- E1000014CS3 THIS PROGRAM OPENS THE USER'S FILE AND SETS IT UP E1000015C FOR THE EDITOR TO USE. E1000016C IT PERFORMS SEVERAL FUNCTIONS INCLUDING: E1000017C 1. THE CLEAR PROCESSOR IS CALLED TO INITIALIZE E1000018C ALL EDITOR TABLES. IF ANY ERRORS OCCUR, CONTROL E1000019C IS RETURNED TO THE CALLER. E1000020C 2. THE RELATIVE RECORD POINTER IS INITIALIZED E1000021C 3. THE FILE NAME IS OBTAINED FROM THE PARAMETER E1000022C LIST. IF ANY ERRORS OCCUR, CONTROL IS RETURNED E1000023C TO THE CALLING PROGRAM. E1000024C 4. THE FILE NAME IS MOVED TO THE ERROR BUFFER. E1000025C 5. THE RPG FILE TYPE INDICATOR IS OBTAINED FROM E1000026C THE PARAMETER LIST. E1000027C 6. THE USER'S REQUEST BUFFER IS INITIALIZED TO E1000028C ZEROS AND THE ADDRESS OF THE FILE'S FCB IS E1000029C STORED IN THE REQUEST BUFFER. E1000030C 7. THE PARAMETER LIST FOR THE OPEN REQUEST IS E1000031C SET UP. E1000032ÐÐC A. FILE NAME AND USER ID E1000033C B. RELATIVE RECORD RETREIVE E1000034C C. 20 RECORDS PER BLOCK E1000035C D. LOCK THE FILE E1000036C 8. THE OPEN REQUEST IS PERFORMED WITHIN A DO E1000037C LOOP FOR MAXTRY (10) ATTEMPTS TO OPEN THE E1000038C FILE IF IT IS LOCKED. IF THE FILE CANNOT E1000039C BE OPENED WITHIN MAXTRY ATTEMPTS, THE ERROR E1000040C 'FILE @@@@@@@@ IS LOCKED. TRY AGAIN LATER' IS E1000041C PRINTED AND CONTROL IS RETURNED TO THE CALLING E1000042C PROGRAM. IF THE FILE CANNOT BE LOCATED, THE E1000043C ERROR 'COULD NOT LOCATE FILE @@@@@@@@ USER E1000044C @@@@@@@@' IS OUTPUT AND CONTROL IS RETURNED E1000045C TO THE CALLING PROGRAM. IF SOME OTHER ERROR E1000046C OCCURS, THE ERROR 'FILE MANAGER ERROR WHEN E1000047C OPENING FILE @@@@@@@@ ISTAT = $$$$' IS PRINTED E1000048C AND CONTROL IS RETURNED TO THE CALLING PROGRAM. E1000049C 9. IF NO ERRORS HAVE OCCURRED, THE VALIDITY OF E1000050C THE FILE IS CHECKED. TESTS ARE MADE FOR: E1000051C A. DIRECT OR SEQUENTIAL FILE TYPE E1000052C B. 80 CHARACTER RECORDS E1000053C C. NON-SECTOR ALIGNED FILE E1000054C IF ANY OF THESE TESTS ARE FAILED, THE ERROR E1000055C 'FILE @@@@@@@@ IS NOT AN EDITOR FILE' IS OUTPUT E1000056C THE FILE IS CLOSED AND CONTROL IS RETURNED TO E1000057ÐÐC THE CALLING PROGRAM. E1000058C 10. THE FILE TYPE IS DETERMINED FROM THE PARAMETER E1000059C STRING AND THE FCB IS SET ACCORDINGLY. E1000060C FCB(87)=1 - NON RPG FILE E1000061C =2 - RPG FILE E1000062C 11. THE PROGRAM 'SLIBLD' IS CALLED TO SET E1000063C UP THE STATEMENT LABEL INDEX FILE. IF E1000064C NO ERRORS OCCUR, CONTROL IS RETURNED TO THE E1000065C CALLING PROGRAM. IF ERRORS HAVE OCCURRED E1000066C THE FILE IS CLOSED AND CONTROL IS RETURNED E1000067C TO THE CALLING PROGRAM E1000068CS5 ENTRY/EXIT E1000069C ---------- E1000070CS3 THIS ROUTINE IS ENTERED DIRECTLY FROM THE CONTROL E1000071C PROCESSOR 'EDITOS' WITH THE PARAMETER STRING FOR THE E1000072C GET COMMAND IN THE COMMAND INPUT BUFFER. IT IS ALSO E1000073C ENTERED INDIRECTLY FROM 'RSQPRO' TO REBUILD THE STATE- E1000074C MENT LABEL INDEX FILE AFTER THE USER'S FILE HAS BEEN E1000075C RESEQUENCED. THE RESEQUENCE PROCESSOR STORES ALL OF E1000076C THE PARAMETERS REQUIRED FOR THE GET COMMAND INTO THE E1000077C COMMAND INPUT BUFFER. E1000078C E1000079C EXIT TO THE CALLING PROGRAM IS E1000080C IERRFG = 0 NO ERRORS E1000081C = + NON FATAL EDITOR ERROR. ANOTHER E1000082ÐÐC PROCESSOR MAY BE ENTERED. E1000083C = - FATAL EDITOR ERROR OCCURRED. THE E1000084C EDITOR IS TERMINATED. E1000085CS5 ERROR MESSAGES E1000086C ----- -------- E1000087CS3 THE FOLLOWING ERROR MESSAGES ARE OUTPUT BY THE GET E1000088C PROCESSOR. E1000089C EDITOR ERROR 303 E1000090C 'FILE @@@@@@@@ IS NOT AN EDITOR FILE' E1000091C EDITOR FILE MANAGER ERROR 331 E1000092C 'FILE MANAGER ERROR WHEN OPENING FILE @@@@@@@@ ISTAT = $$$$' E1000093C EDITOR FILE MANAGER ERROR 332 E1000094C 'COULD NOT LOCATE FILE @@@@@@@@ USER @@@@@@@@' E1000095C EDITOR FILE MANAGER ERROR 333 E1000096C 'FILE @@@@@@@@ IS LOCKED. TRY AGAIN LATER' E1000097CS5 ENTRIES E1000098C ------- E1000099CS3 ENTRY POINT REFERENCED BY E1000100C ----- ----- ---------- -- E1000101C GETPRO EDITOS E1000102C RSQPRO E1000103CS5 EXTERNAL REFERENCES E1000104C -------- ---------- E1000105CS3 EXTERNAL EXTERNAL E1000106C -------- -------- E1000107ÐÐC CLEPRO CLOSFL E1000108C GETNAM GETONE E1000109C OPENFL RETURN E1000110C SAVE SET E1000111C SLIBLD SYSMSG E1000112C*** E1000113M EDITCM E1000114 INTEGER FMER01 E1000115 INTEGER FMER02 E1000116 INTEGER FMER03 E1000117 INTEGER EDER03 E1000118 DATA FMER01/331/ E1000119 DATA FMER02/332/ E1000120 DATA FMER03/333/ E1000121 DATA EDER03/303/ E1000122 DATA MAXTRY/10/ E1000123C SAVE ENTRY FOR RETURN E1000124 CALL SAVE(GETPRO) E1000125C CLEAR ALL PREVIOUS FILE DATA E1000126 CALL CLEPRO E1000127C DID ANY ERRORS OCCUR E1000128 IF (IERRFG.NE.0) GO TO 9000 E1000129C SET THE RECORD POINTER FOR THE FIRST RECORD E1000130 IRECPT(1)=0 E1000131 IRECPT(2)=1 E1000132ÐÐC GET FILE NAME FROM NEXT FIELD E1000133 CALL GETNAM E1000134C HAS AN ERROR OCCURRED E1000135 IF (IERRFG.NE.0) GO TO 9000 E1000136C MOVE FILE NAME TO ERROR BUFFER FOR POSSIBLE USE LATER E1000137 DO 100 IX=1,4 E1000138 IDATA(IX)=NAMFIL(IX) E1000139 100 CONTINUE E1000140C GET THE RPG TYPE INDICATOR E1000141 CALL GETONE E1000142C CLEAR THE FILE MANAGER'S REQUEST BUFFER E1000143 CALL SET(REQBUF,24,0) E1000144C SET UP THE FCB ADDRESS IN THE REQUEST BUFFER E1000145 REQBUF(10)=FCBADR E1000146C PUT FILE NAME AND USER ID INTO THE OPEN COMMAND E1000147 DO 150 IX=1,8 E1000148 FMOPEN(IX)=NAMFIL(IX) E1000149 150 CONTINUE E1000150C INDICATE TO SEARCH ALL MOUNTED VOLUMES E1000151 FMOPEN(9)=0 E1000152C SET UP TO OPEN BY RELATIVE RECORD NUMBER E1000153 FMOPEN(13)=0 E1000154C SET UP THE NUMBER OF RECORDS PER RETRIEVE E1000155 FMOPEN(14)=20 E1000156C SET UP FILE LOCK E1000157ÐÐ FMOPEN(15)=$8000 E1000158C PERFORM OPEN WITHIN A DO SO IT CAN BE E1000159C REPEATED IF THE FILE IS LOCKED E1000160 DO 300 IX=1,MAXTRY E1000161C SET UP THE LENGTH OF THE FCB E1000162 REQBUF(13)=96 E1000163 CALL OPENFL(REQBUF,FMOPEN,ISTAT) E1000164C CHECK FOR ERRORS E1000165 IF (ISTAT.GE.0) GO TO 250 E1000166C IS THE FILE UNLOCATABLE E1000167 IF (AND(ISTAT,2) .NE.0) GO TO 220 E1000168C IF THE FILE IS LOCKED OR THE USER IS LOCKED OUT, RETRY E1000169 IF (AND(ISTAT,$1804).NE.0) GO TO 300 E1000170C OTHER FILE MANAGER ERRORS HAVE OCCURRED E1000171C SET FILE MANAGER STATUS INTO ERROR E1000172 IDATA(5)=ISTAT E1000173C OUTPUT THE ERROR - FILE MANAGER ERROR WHEN OPENING FILE @@@@@@@@ E1000174C ISTAT = $ E1000175 CALL SYSMSG(FMER01,IDATA) E1000176 GO TO 600 E1000177C REPORT UNABLE TO LOCATE FILE ERROR E1000178C PUT USER ID INTO ERROR E1000179 220 DO 230 IA=5,8 E1000180 IDATA(IA)=FMOPEN(IA) E1000181 230 CONTINUE E1000182ÐÐC OUTPUT THE ERROR - COULD NOT LOCATE FILE @@@@@@@@ USER @@@@@@@@ E1000183 CALL SYSMSG(FMER02,IDATA) E1000184 GO TO 600 E1000185C IS THE FILE CURRENTLY LOCKED E1000186 250 IF (AND(ISTAT,4).EQ.0) GO TO 350 E1000187C FILE IS LOCKED OR USER IS LOCKED OUT - RETRY OPEN CALL E1000188 300 CONTINUE E1000189C FILE LOCKED OR USER LOCKED OUT FOR MAXIMUM RETRIES E1000190C OUTPUT THE ERROR - FILE @@@@@@@@ IS LOCKED. TRY AGAIN LATER E1000191 CALL SYSMSG(FMER03,IDATA) E1000192 GO TO 600 E1000193C IS THIS FILE A SEQUENTIAL FILE OR A DIRECT FILE E1000194 350 IF (FCBBUF(95).EQ.0.OR.FCBBUF(95).EQ.3) GO TO 375 E1000195 GO TO 400 E1000196C ARE THESE 40 WORD RECORDS E1000197 375 IF (FCBBUF(1).NE.40) GO TO 400 E1000198C IS THIS A SECTOR ALIGNED FILE E1000199 IF (FCBBUF(6).LT.0) GO TO 400 E1000200C THE FILE IS OPENED AND LOCKED. NOW SET UP STATEMENT LABEL INDEX E1000201C IS THIS A USER CREATED RPG FILE E1000202 FCBBUF(87)=1 E1000203 IF (GOTCHR.EQ.$52) FCBBUF(87)=2 E1000204C BUILD THE STATEMENT LABEL INDEX FILE E1000205 CALL SLIBLD E1000206C INDICATE THAT RESEQUENCE IS NOT NEEDED E1000207ÐÐ IRESFG=0 E1000208C WAS THERE AN ERROR IN BUILDING THE INDEX E1000209 IF (IERRFG.NE.0) GO TO 500 E1000210 GO TO 9000 E1000211C OUTPUT THE ERROR - FILE @@@@@@@@ IS NOT AN EDITOR FILE E1000212 400 CALL SYSMSG(EDER03,IDATA) E1000213C AN ERROR OCCURRED IN BUILDING THE STATEMENT LABEL INDEX E1000214C CLOSE THE FILE E1000215 500 CALL CLOSFL(REQBUF,ISTAT) E1000216C INDICATE TO CLEPRO THAT THERE IS NO EXISTING RECORD E1000217 600 CALL SET(NAMFIL,3,$2020) E1000218 9000 CALL RETURN E1000219 RETURN E1000220 END E1000221 SUBROUTINE LINPRO E1100001 1 /E11 F ITOS CCS 3.0 SL-149E1100002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO PROCESS SINGLE LINE ENTRY E1100003C CREDIT COLLECTION SYSTEM VERSION 3.0 E1100004C DATA SYSTEM-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E1100005C COPYRIGHT CONTROL DATA CORPORATION 1978 E1100006C E1100007C*** E1100008C FUNCTION E1100009C -------- E1100010CS3 THE FUNCTION OF THIS PROGRAM IS TO PROCESS THE 'LINE' E1100011ÐÐC COMMAND. E1100012CS5 GENERAL FLOW E1100013C ------- ---- E1100014CS3 THE FOLLOWING OPERATIONS ARE PERFORMED BY THIS ROUTINE E1100015C 1. IF THERE IS NO FILE OPEN OUTPUT THE ERROR E1100016C MESSAGE 'NO FILE OPEN FOR EDITOR USE', SET E1100017C THE ERROR FLAG AND RETURN TO THE CALLING E1100018C PROGRAM. E1100019C 2. INITIALIZE THE INTERMEDIATE RECORD BUFFER AND E1100020C THE FINAL RECORD BUFFER. E1100021C 3. GET THE NEXT FIELD (LINE NUMBER). IF ANY E1100022C ERRORS OCCUR, RETURN TO THE CALLING PROGRAM. E1100023C 4. VALIDATE THE RANGE OF THE LINE NUMBER. IF IT E1100024C IS OUT OF RANGE OUTPUT THE ERROR MESSAGE E1100025C 'ILLEGAL LINE NUMBER ##### SPECIFIED', SET E1100026C THE ERROR FLAG AND RETURN TO THE CALLING E1100027C PROGRAM. E1100028C 5. SAVE THIS VALID LINE NUMBER. E1100029C 6. GET THE NEXT FIELD (FORMAT SPECIFICATION). IF E1100030C ANY ERRORS OCCUR, RETURN TO THE CALLING PROGRAM. E1100031C 7. SAVE THIS FIELD AS THE FORMAT TYPE. E1100032C 8. IF THERE IS AN RPG FORMAT TYPE SPECIFIED, CALL E1100033C 'SETAUT' TO SET UP TAB POSITIONS. IF ANY E1100034C ERRORS OCCUR RETURN TO THE CALLING PROGRAM. E1100035C 9. OUTPUT THE CHARACTER POSITION LINE AT THE TOP E1100036ÐÐC OF THE SCREEN. E1100037C 10. CLEAR THE CHARACTER POSITION COUNT. E1100038C 12. SET THE MODE FOR 'LOCATE' TO READ ONLY AND E1100039C CALL 'FNDSLI' TO FIND THIS LINE IN THE STATE- E1100040C MENT LABEL INDEX FILE. E1100041C IF THE LINE NUMBER HAS AN ASSOCIATED RECORD. E1100042C PERFORM THE FOLLOWING OPERATIONS: E1100043C A. SET THE RELATIVE RECORD POINTER TO THIS E1100044C RECORD. E1100045C B. GET THIS RECORD. IF AN ERROR OCCURS, E1100046C OUTPUT THE ERROR MESSAGE 'FILE MANAGER E1100047C ERROR WHEN READING FILE @@@@@@@@ ISTAT E1100048C = $$$$', SET THE ERROR FLAG AND RETURN E1100049C TO THE CALLING PROGRAM. E1100050C C. IF THE RECORD CONTAINS AN END OF FILE E1100051C MARK, CLEAR IT FROM THE RECORD. E1100052C D. OUTPUT THE LINE AND A CHARACTER POSITION E1100053C LINE BELOW IT. E1100054C E. POSITION THE CURSOR AT THE FIRST TAB E1100055C POSITION IN THE RECORD AND CONTINUE IN E1100056C THE LOGIC FOR LINES WITH NO EXISTING E1100057C RECORDS AT STEP G. E1100058C IF THE LINE HAS NO EXISTING RECORD, PERFORM E1100059C THE FOLLOWING OPERATIONS: E1100060C A. SEE IF THERE IS STILL ROOM IN THE FILE E1100061ÐÐC FOR A NEW RECORD. IF NOT OUTPUT THE SYSTEM E1100062C MESSAGE FILE MESSAGE 'NO ROOM IN EDIT FILE-- E1100063C ENLARGE FILE OR OR RESEQUENCE' AND THEN RETURN. E1100064C OTHERWISE, SET THE RESEQUENCE NEEDED FLAG. E1100065C B. IF THIS IS A NON RPG FILE OR AN RPG FILE E1100066C BUT A LINE BEYOND THE START OF RPG ARRAY E1100067C DATA POSITION THE LINE NUMBER IN POSITIONS E1100068C 76 - 80 OF THE LINE RECORD. IF THE FILE E1100069C IS NON RPG, PUT THE PROGRAM ID IN POSITIONS E1100070C 73 - 75 OF THE LINE RECORD. IN BOTH CASES E1100071C CLEAR POSITIONS 1 - 6 TO CLEAR THE RPG E1100072C LINE NUMBER AREA. E1100073C IF THE FILE IS AN RPG FILE AND IS BELOW E1100074C THE START OF RPG ARRAY DATA, CLEAR THE E1100075C NON RPG PROGRAM ID AREA, PUT IN THE RPG E1100076C PROGRAM ID IN POSITIONS 75 - 80. PUT E1100077C THE LINE NUMBER AND RPG FORMAT SPECIFICATION E1100078C TYPE IN POSITIONS 1 - 6. E1100079C C. SET UP THE CURSOR POSITIONING IN THE LINE E1100080C RECORD FOR POSITION 73. E1100081C D. SET UP A DO LOOP TO POSITION THE CURSOR E1100082C AND INPUT AS MANY TIMES AS THERE ARE E1100083C POSSIBLE TAB POSITIONS. E1100084C E. CALCULATE THE CURSOR POSITIONING COORDIN- E1100085C ATES FOR THIS NEW LINE. E1100086ÐÐC F. IF THIS IS THE FIRST REQUEST FOR THIS E1100087C RECORD OUTPUT THE PRESET DATA FOR THIS E1100088C LINE AND THE CHARACTER POSITION LINE E1100089C BELOW THIS LINE AND INPUT THE RECORD. E1100090C IF THIS IS NOT THE FIRST REQUEST FOR THIS E1100091C RECORD, CHECK TO SEE IF THERE IS A DEFINED E1100092C TAB POSITION. IF THERE ARE NO MORE TABS E1100093C TERMINATE THIS RECORD. E1100094C IF THE LAST TERMINATION CODE WAS A RUBOUT E1100095C DO NOT PERFORM THE NEXT CHECK. E1100096C CHECK TO SEE IF WE HAVE ALREADY PASSED E1100097C THIS TAB POSITION. IF SO, GET THE NEXT E1100098C TAB POSITION. IF NOT, CLEAR THE INPUT E1100099C BUFFER, SET THE CURSOR TO THE NEXT TAB E1100100C POSITION AND INPUT THE NEXT PART OF THE E1100101C RECORD. E1100102C G. IF NO DATA WAS ENTERED, SKIP THIS SECTION. E1100103C DETERMINE THE NUMBER OF CHARACTERS INPUT E1100104C AND THE CHARACTER POSITION TO PLACE IT IN E1100105C IN THE INTERMEDIATE RECORD BUFFER. E1100106C MOVE THE PORTION OF THE RECORD JUST INPUT. E1100107C H. GO TO THE APPROPRIATE TERMINATION CODE E1100108C PROCESSOR. E1100109C 1. BUFFER FULL TERMINATION CODE E1100110C A. GO TO THE RECORD TERMINATION SECTION. E1100111ÐÐC 2. TAB TERMINATION CODE E1100112C A. INCREMENT TO THE NEXT STEP OF THE E1100113C TAB STOP DO LOOP. E1100114C B. IF THE RANGE OF THE DO LOOP IS E1100115C EXCEEDED, ASSUME COMPLETION AND E1100116C RETURN TO THE CALLER. E1100117C 3. CARRIAGE RETURN TERMINATION E1100118C CODES. E1100119C 1. IF SOME DATA HAS BEEN ENTERED WITH E1100120C THIS REQUEST OR IF SOME DATA HAS E1100121C BEEN ENTERED ON PREVIOUS REQUESTS E1100122C ON THIS LINE, GO TO THE RECORD E1100123C TERMINATION SECTION. E1100124C 2. IF NO DATA WAS ENTERED ON THIS E1100125C REQUEST AND IT IS THE FIRST REQUEST E1100126C ON THIS LINE, GO TO THE PROCESSOR E1100127C TERMINATION SECTION. E1100128C 4. RUB-OUT TERMINATION CODE E1100129C 1. IF THIS IS THE FIRST REQUEST ISSUED E1100130C ON THIS LINE, REPEAT THE INITIAL E1100131C REQUEST. E1100132C 2. IF NO DATA WAS ENTERED ON THIS E1100133C REQUEST FOR THIS LINE, BACK UP TO E1100134C THE PREVIOUS TAB POSITION AND REPEAT E1100135C THE REQUEST. E1100136ÐÐC 3. IF SOME DATA WAS ENTERED FOR THIS E1100137C REQUEST REPEAT THE REQUEST. E1100138C 5. LINE FEED TERMINATION CODE E1100139C 1. INSERT PRESENT RECORD BACK INTO E1100140C EDIT FILE AND GOTO RECORD TERMNATION E1100141C SECTION. E1100142C I. RECORD TERMINATION SECTION E1100143C IF THE WAS NO ASSOCIATED RECORD FOR THIS E1100144C LINE NUMBER, GET THE NEXT RELATIVE RECORD E1100145C POINTER AND SAVE IT AS THE RECORD INDEX E1100146C IN THE STATEMENT LABEL INDEX FILE ENTRY E1100147C FOR THIS LINE. SET UP FOR THE NEXT E1100148C RELATIVE RECORD. READ THIS RECORD FROM E1100149C THE USERS FILE. IF A FILE MANAGER ERROR E1100150C AND IT WAS NOT AN END OF FILE INDICATOR E1100151C MOVE THE FILE NAME TO THE ERROR BUFFER, E1100152C OUTPUT THE ERROR MESSAGE 'FILE MANAGER E1100153C ERROR WHEN READING FILE @@@@@@@@ ISTAT = E1100154C $$$$', SET THE ERROR FLAG AND RETURN TO E1100155C THE CALLING PROGRAM. E1100156C IF THE RECORD ALREADY EXISTED AND WAS E1100157C READ IN OR AFTER THE RECORD WITH NO DATA E1100158C IN IT HAS BEEN RETRIEVED CONTINUE THE E1100159C PROCESSING HERE. E1100160C IF THE FIRST WORD OF THE RECORD CONTAINS E1100161ÐÐC AN END OF FILE CODE, IT IS REPLACED WITH E1100162C BLANKS. THE CHARACTERS CONTAINED IN THE E1100163C INTERMEDIATE RECORD BUFFER ARE PLACED IN E1100164C THE CORRESPONDING POSITIONS IN THE FILE E1100165C RECORD BUFFER EXCEPT FOR THE CHARACTER E1100166C $15 WHICH IS A CURSOR POSITION CHARACTER E1100167C TO INDICATE THAT THE EXISTING CHARACTER E1100168C IN THE FILE RECORD BUFFER IS NOT TO BE E1100169C MODIFIED. E1100170C THE UPDATED RECORD IS WRITTEN BACK TO THE E1100171C PROPER POSITION IN THE USERS FILE. IF AN E1100172C ERROR OCCURS, THE ERROR MESSAGE 'FILE E1100173C MANAGER ERROR WHEN UPDATING FILE @@@@@@@@ E1100174C ISTAT = $$$$' IS OUTPUT, THE ERROR FLAG IS E1100175C SET AND CONTROL IS RETURNED TO THE CALLING E1100176C PROGRAM. E1100177C THE RECORD INPUT BUFFER AND THE INTERMEDIATE E1100178C RECORD BUFFER ARE INITIALIZED, THE HIGHEST E1100179C STATEMENT NUMBER USED IS UPDATED AND THE E1100180C PROCESSOR COMPLETION ROUTINE IS EXECUTED. E1100181C J. PROCESSOR COMPLETION ROUTINE E1100182C THE HIGHEST STATEMENT NUMBER USED IN THIS E1100183C FILE IS SAVED IN THE FILES FCB. THE NEXT E1100184C RECORD IS OBTAINED FROM THE FILE. IF AN E1100185C END OF FILE IS NOT INDICATED IN THE FILE E1100186ÐÐC STATUS, AN END OF FILE IS WRITTEN INTO E1100187C THIS RECORD TO MARK THE CURRENT HIGHEST E1100188C RELATIVE RECORD USED IN THE FILE. E1100189C THE FCB FOR THE USERS FILE IS UPDATED. E1100190C IF AN ERROR OCCURS THE ERROR MESSAGE E1100191C 'FILE MANAGER ERROR WHEN UPDATING FCB FOR E1100192C FILE @@@@@@@@ ISTAT = $$$$' IS OUTPUT, THE E1100193C ERROR FLAG IS SET AND CONTROL IS RETURNED E1100194C TO THE CALLING PROGRAM. E1100195C IF NO ERRORS OCCUR, THE PROCESSOR IS E1100196C EXITED AND CONTROL IS RETURNED TO THE E1100197C CONTROL PROCESSOR. E1100198CS5 ENTRY/EXIT E1100199C ---------- E1100200CS3 THIS ROUTINE IS ENTERED FROM THE CONTROL PROCESSOR E1100201C 'EDITOS'. A FILE MUST BE OPENED FOR THE EDITOR TO E1100202C USE AND THE COMMAND INPUT BUFFER MUST CONTAIN THE E1100203C PARAMETER STRING FOR THE LINE COMMAND. E1100204C E1100205C EXIT TO THE CONTROL PROCESSOR IS E1100206C IERRFG = 0 NO ERRORS E1100207C = + NON FATAL EDITOR ERROR. ANOTHER E1100208C PROCESSOR MAY BE ENTERED. E1100209C = - A FATAL EDITOR ERROR HAS OCCURRED. E1100210C THE EDITOR IS TERMINATED. E1100211ÐÐCS5 ERROR MESSAGES E1100212C ----- -------- E1100213CS3 THE FOLLOWING ERROR MESSAGES ARE OUTPUT BY THE LINE E1100214C PROCESSOR. E1100215C EDITOR ERROR 301 E1100216C 'ILLEGAL LINE NUMBER @@@@@ SPECIFIED' E1100217C EDITOR ERROR 319 E1100218C 'NO FILE OPEN FOR EDITOR USE' E1100219C EDITOR ERROR 322 E1100220C 'END OF EDIT FILE--RESEQUENCE OR ENLARGE FILE' E1100221C EDITOR FILE MANAGER ERROR 334 E1100222C 'FILE MANAGER ERROR WHEN READING FILE @@@@@@@@ E1100223C ISTAT = $$$$' E1100224C EDITOR FILE MANAGER ERROR 341 E1100225C 'FILE MANAGER ERROR WHEN UPDATING FILE @@@@@@@@ E1100226C ISTAT = $$$$' E1100227C EDITOR FILE MANAGER ERROR 342 E1100228C 'FILE MANAGER ERROR WHEN UPDATING FCB FOR FILE E1100229C @@@@@@@@ ISTAT = $$$$' E1100230CS5 ENTRIES E1100231C ------- E1100232CS3 ENTRY POINT REFERENCED BY E1100233C ----- ----- ---------- -- E1100234C LINPRO EDITOS E1100235CS5 EXTERNAL REFERENCES E1100236ÐÐC -------- ---------- E1100237CS3 EXTERNAL EXTERNAL E1100238C -------- -------- E1100239C FNDSLI GETNUM E1100240C GETONE HEXDEC E1100241C OUTPUT READR E1100242C RETURN RWRITE E1100243C SAVE SET E1100244C SETAUT SYSMSG E1100245C UPDFCB UPDREC E1100246C WTREAD E1100247C*** E1100248M EDITCM E1100249 INTEGER TDATRM,TDATRL E1100250 EQUIVALENCE (TDATRM,FCBBUF(2)),(TDATRL,FCBBUF(3)) E1100251 DIMENSION TOFHED(41) E1100252 INTEGER TOFHED E1100253 DATA TOFHED(1)/$1800/ E1100254 DATA (TOFHED(I),I=2,41)/'12345678901234567890123456789012345678901E1100255 1234567890123456789012345678901234567890'/ E1100256 DIMENSION LINBFR(54) E1100257 DATA LINBFR(1)/$0000/,LINBFR(2)/$1600/,LINBFR(3)/'00'/,LINBFR(4)/ E1100258 1'00'/,LINBFR(5)/'0 '/,LINBFR(6)/$1B31/,LINBFR(7)/0/,(LINBFR(I),I=8E1100259 2,11)/' '/ E1100260 DATA (LINBFR(I),I=12,51)/'1234567890123456789012345678901234567890E1100261ÐÐ 11234567890123456789012345678901234567890'/,LINBFR(52)/$1600/ E1100262 INTEGER EDER01 E1100263 INTEGER EDER02 E1100264 INTEGER EDER12 E1100265 INTEGER EDER19 E1100266 INTEGER EDER22 E1100267 DATA EDER01/301/ E1100268 DATA EDER02/302/ E1100269 DATA EDER12/312/ E1100270 DATA EDER19/319/ E1100271 DATA EDER22/322/ E1100272 INTEGER FMER04 E1100273 INTEGER FMER11 E1100274 INTEGER FMER12 E1100275 DATA FMER04/334/ E1100276 DATA FMER11/341/ E1100277 DATA FMER12/342/ E1100278C SAVE ENTRY FOR RETURN E1100279 CALL SAVE(LINPRO) E1100280C HAS THE USER DONE A GET YET E1100281 IF (NAMFIL(1).NE.$2020) GO TO 10 E1100282C OUTPUT THE ERROR - NO FILE OPEN FOR EDITOR USE E1100283 CALL SYSMSG(EDER19,IDATA) E1100284 GOTO 9000 E1100285C INITIALIZE THE RECORD BUFFER AND THE TEXT BUFFER E1100286ÐÐ 10 CALL SET(RECBUF,40,$1515) E1100287 CALL SET(TBUFFR,40,$1515) E1100288C E1100289C RETRIEVE LINE PARAMETERS E1100290C ------------------------ E1100291C GET THE LINE NUMBER TO ENTER OR CORRECT E1100292 CALL GETNUM E1100293C DID ANY ERRORS OCCUR E1100294 IF (IERRFG.NE.0) GO TO 9000 E1100295C VALIDATE THE LINE NUMBER E1100296 IF (NUMHEX.GT.0.AND.NUMHEX.LE.32767) GO TO 100 E1100297C PUT LINE NUMBER INTO ERROR E1100298 IDATA(1)=0 E1100299 IDATA(2)=NUMHEX E1100300C OUTPUT THE ERROR - ILLEGAL LINE NUMBER ###### SPECIFIED E1100301 CALL SYSMSG(EDER01,IDATA) E1100302 GO TO 9000 E1100303C SAVE THIS LINE NUMBER E1100304 100 LINENO=NUMHEX E1100305C GET THE NEXT FIELD - FORMAT TYPE E1100306 CALL GETONE E1100307C DID AN ERROR OCCUR E1100308 IF (IERRFG.NE.0) GO TO 9000 E1100309C SET FORMAT TYPE E1100310 FORMTP=GOTCHR E1100311ÐÐC IF FORMAT TYPE IS NON-RPG USE WHATEVER WAS LAST TAB SETUP E1100312 IF (FORMTP.NE.$20) CALL SETAUT E1100313C DID ANY ERRORS OCCUR E1100314 IF (IERRFG.NE.0) GO TO 9000 E1100315C E1100316C DETERMINE IF EDIT RECORD EXISTS E1100317C -------------------------------- E1100318C CLEAR THE CHARACTER COUNT E1100319 ICURCH=0 E1100320C SET MODE FOR LOCATE TO WRITE E1100321 IMODE=1 E1100322C SEE IF THIS LINE EXISTS E1100323 CALL FNDSLI E1100324C DOES THIS LINE EXIST E1100325 150 IF (IS(LINIDX).NE.0) GOTO 6000 E1100326C IS THERE ANY MORE EDIT FILE ROOM E1100327 IF (IRECPT(2).LE.TDATRL) GOTO 175 E1100328C NO MORE ROOM IN THE EDIT FILE E1100329 CALL SYSMSG(EDER22,0) E1100330 GOTO 9000 E1100331C E1100332C PREPARE TO INPUT A NEW RECORD E1100333C ----------------------------- E1100334C OUTPUT THE COLUMN HEADING E1100335175 CALL OUTPUT(TERMLU,TOFHED,41) E1100336ÐÐC SET UP TO BUILD THE RECORD E1100337C IS THIS AN RPG FILE E1100338 IF(FCBBUF(87).LE.1) GO TO 350 E1100339 IF(FCBBUF(86).NE.0) GO TO 300 E1100340C CLEAR THE NON-RPG FORMAT TYPE ID FIELD E1100341 200 LINBFR(8)=$2020 E1100342 RECBUF(37)=$2020 E1100343C MOVE IN ANY PROGRAM ID THAT MAY BE THERE E1100344 DO 250 IX=1,3 E1100345 LINBFR(IX+8)=IPGMID(IX) E1100346 RECBUF(IX+37)=IPGMID(IX) E1100347 250 CONTINUE E1100348C PUT LINE NUMBER INTO RPG FIELD POSITION E1100349 CALL HEXDEC(LINENO,NUMBER) E1100350 LINBFR(3)=AND(NUMBER(1),$00FF)*$100+AND(NUMBER(2),$FF00)/$100 E1100351 RECBUF(1)=AND(NUMBER(1),$00FF)*$100+AND(NUMBER(2),$FF00)/$100 E1100352 LINBFR(4)=AND(NUMBER(2),$00FF)*$100+AND(NUMBER(3),$FF00)/$100 E1100353 RECBUF(2)=AND(NUMBER(2),$00FF)*$100+AND(NUMBER(3),$FF00)/$100 E1100354 LINBFR(5)=AND(NUMBER(3),$00FF)*$100+FORMTP E1100355 RECBUF(3)=AND(NUMBER(3),$00FF)*$100+FORMTP E1100356 GO TO 500 E1100357C IS THIS SUPPOSED TO BE AN RPG ARRAY DATA LINE E1100358 300 IF (FCBBUF(86).GT.LINENO) GO TO 200 E1100359C THIS IS NON RPG FORMAT OR RPG ARRAY DATA E1100360C PUT THE LINE NUMBER INTO THE BUFFER E1100361ÐÐ 350 CALL HEXDEC(LINENO,LINBFR(9)) E1100362 CALL HEXDEC(LINENO,RECBUF(38)) E1100363C IF THIS IS RPG ARRAY DATA, DON'T SAVE THE PROGRAM ID E1100364 IF (FORMTP.EQ.$2A) GO TO 400 E1100365C THIS IS NON RPG FORMAT, SAVE THE PROGRAM ID E1100366 LINBFR(8)=IPGMID(1) E1100367 RECBUF(37)=IPGMID(1) E1100368 LINBFR(9)=AND(IPGMID(2),$FF00)+AND(LINBFR(9),$00FF) E1100369 RECBUF(38)=AND(IPGMID(2),$FF00)+AND(RECBUF(38),$00FF) E1100370C CLEAR THE RPG TYPE LINE NUMBER E1100371 400 CALL SET(LINBFR(3),3,$2020) E1100372 CALL SET(RECBUF(1),3,$2020) E1100373C SET THE CURSOR POSITION FOR THE 73 POSITION E1100374 500 LINBFR(7) = $4801 E1100375C E1100376C BEGIN INPUTTING DATA E1100377C -------------------- E1100378C SET UP THE DO LOOP FOR THE TAB BUFFER INDEX E1100379C THIS LOOP WILL TERMINATE ON THE 20TH TAB E1100380 DO 3000 IT=1,20 E1100381C SET THE CURSOR POSITION BEFORE READ TO FIRST TAB ON THIS LINE E1100382 ICORDS=(TABBUF(IT)-1)*$100+1 E1100383C IF THIS IS NOT THE FIRST TAB POSITION, DON'T OUTPUT THE TRAILER E1100384 IF (IT.NE.1) GO TO 3100 E1100385C MOVE LINBFR TO LINBUF IN COMMON E1100386ÐÐ DO 600 IX=1,53 E1100387 LINBUF(IX)=LINBFR(IX) E1100388 600 CONTINUE E1100389C OUTPUT THE STATEMENT LINE AND TRAILER AND INPUT THE RECORD E1100390C OUTPUT BLANK STATEMENT LINE (NO INPUT) E1100391 650 CALL WTREAD (TERMLU, 1, LINBUF, 11, -0, TBUFFR, 0, TC) E1100392C OUTPUT CHARACTER POSITION QUIDE LINE (WITH INPUT) E1100393 CALL WTREAD (TERMLU, 2, LINBUF(12), 41, ICORDS, TBUFFR, 40, TC) E1100394C E1100395C DATA HAS BEEN ENTERED, MOVE TO RECBUF E1100396C ------------------------------------- E1100397C IF NO DATA HAS BEEN ENTERED, SKIP THE DATA MOVE E1100398 700 IF (TBUFFR(41).EQ.0) GOTO 1500 E1100399C IF TERMINATION CODE IS A RUBOUT, DON'T MOVE THE DATA E1100400 IF (TC.EQ.4) GOTO 5000 E1100401C SAVE THE CURRENT CHARACTER POSITION E1100402 ICURCH=TABBUF(IT)+TBUFFR(41) E1100403C MOVE DATA FROM THE INPUT BUFFER TO THE RECORD BUFFER E1100404 IY=TBUFFR(41)/2 E1100405C IS THERE AN ODD NUMBER OF CHARACTERS INPUT E1100406 IF (AND(TBUFFR(41),1).NE.0) IY=IY+1 E1100407C CALCULATE THE STARTING WORD POSITION E1100408 IX=TABBUF(IT)/2+1 E1100409C DOES THE INPUT START ON THE EVEN (LOWER) CHARACTER E1100410 IF (AND(TABBUF(IT),1).EQ.0) GO TO 900 E1100411ÐÐ DO 800 IZ=1,IY E1100412 IDUMB=IX+IZ-1 E1100413C THE CHARACTER GOING INTO RECBUF SHOULD START IN THE UPPER BYTE E1100414 RECBUF(IDUMB)=TBUFFR(IZ) E1100415 800 CONTINUE E1100416 GO TO 1500 E1100417C THE CHARACTER GOING INTO RECBUF SHOULD GO INTO THE LOWER BYTE E1100418 900 IX=TABBUF(IT)/2 E1100419 DO 950 IZ=1,IY E1100420 IDUMB=IX+IZ-1 E1100421 RECBUF(IDUMB)=AND(RECBUF(IDUMB),$FF00)+AND(TBUFFR(IZ),$FF00)/$100 E1100422 RECBUF(IDUMB+1)=AND(RECBUF(IDUMB+1),$00FF)+ E1100423 1AND(TBUFFR(IZ),$00FF)*$100 E1100424 950 CONTINUE E1100425C GO TO THE APPROPRIATE TERMINATION CODE PROCESSOR E1100426C 0 = BUFFER FULL E1100427C 1 = TAB E1100428C 2 = CARRIAGE RETURN E1100429C 3 = LINE FEED E1100430C 4 = RUB OUT E1100431C LESS THAN 0 OR GREATER THAN 4 ARE UNDEFINED AND HANDLED E1100432C THE SAME AS CARRIAGE RETURN E1100433 1500 IF (TC.LE.0) GO TO 2000 E1100434 GO TO (3000,4000,2000,5000,2000),TC E1100435C IF THIS RECORD EXISTS, WE HAVE ALREADY GOT IT. IF NOT, E1100436ÐÐC GET THE NEXT AVAILABLE RECORD E1100437 2000 IF (IS(LINIDX).NE.0) GO TO 2300 E1100438C SET UP THE NEXT RELATIVE RECORD E1100439 NW(1)=0 E1100440 NW(2)=IRECPT(2) E1100441C SET RESEQUENCE FLAG ONLY IF NEW LINE IS NOT AT END OF FILE E1100442 IF (LINENO.LT.STNMBR) IRESFG=1 E1100443C SET THIS RECORD NUMBER INTO THE INDEX E1100444 IS(LINIDX)=IRECPT(2) E1100445C SET UP FOR THE NEXT RECORD E1100446 IRECPT(2)=IRECPT(2)+1 E1100447C GET THIS RECORD FROM THE FILE E1100448 CALL READR(REQBUF,FBUFFR,NW,ISTAT) E1100449C VERIFY THE STATUS OF THE FILE MANAGER E1100450 IF (ISTAT.GE.0) GO TO 2300 E1100451C PUT THE FILE NAME INTO THE ERROR E1100452 2100 DO 2200 IX=1,4 E1100453 IDATA(IX)=NAMFIL(IX) E1100454 2200 CONTINUE E1100455C PUT THE STATUS INTO THE ERROR E1100456 IDATA(5)=ISTAT E1100457C OUTPUT THE ERROR - FILE MANAGER ERROR WHEN READING FILE @@@@@@@@ E1100458C ISTAT = $$$$ E1100459 CALL SYSMSG(FMER04,IDATA) E1100460 GOTO 8900 E1100461ÐÐC IF THE FIRST WORD OF THE FILE IS AN EOF, REMOVE IT E1100462 2300 IF (FBUFFR(1).EQ.IEOFFM) FBUFFR(1)=$2020 E1100463C MOVE THE RECORD INTO THE FILE BUFFER E1100464C MOVE ALL CHARACTERS FROM RECBUF TO FBUFFR EXCEPT FOR THE E1100465C RIGHT ARROW ($15). THESE ARE CURSOR POSITION CHARACTERS E1100466 DO 2400 IX=1,80 E1100467 IY=(IX+1)/2 E1100468C IS THIS THE ODD (UPPER) CHARACTER E1100469 IF (AND(IX,1).NE.0) GO TO 2350 E1100470C NO, THIS IS THE EVEN (LOWER) CHARACTER E1100471C IS IT A RIGHT ARROW ($15) E1100472 IF (AND(RECBUF(IY),$00FF).EQ.$15) GO TO 2400 E1100473C NO, MOVE THE CHARACTER TO THE FILE BUFFER E1100474 FBUFFR(IY)=AND(FBUFFR(IY),$FF00)+AND(RECBUF(IY),$00FF) E1100475 GO TO 2400 E1100476C IS THIS A RIGHT ARROW ($15) E1100477 2350 IF (AND(RECBUF(IY),$FF00).EQ.$1500) GO TO 2400 E1100478C NO, MOVE THE CHARACTER TO THE FILE BUFFER E1100479 FBUFFR(IY)=AND(FBUFFR(IY),$00FF)+AND(RECBUF(IY),$FF00) E1100480 2400 CONTINUE E1100481C WRITE THIS RECORD BACK OUT E1100482 CALL UPDREC(REQBUF,FBUFFR,ISTAT) E1100483C VERIFY THE STATUS OF THE FILE MANAGER E1100484 IF (ISTAT.GE.0) GO TO 2700 E1100485C PUT THE FILE NAME INTO THE ERROR E1100486ÐÐ 2500 DO 2600 IX=1,4 E1100487 IDATA(IX)=NAMFIL(IX) E1100488 2600 CONTINUE E1100489C PUT THE STATUS INTO THE ERROR E1100490 IDATA(5)=ISTAT E1100491C OUTPUT THE ERROR - FILE MANAGER ERROR WHEN UPDATING FILE @@@@@@@@ E1100492C ISTAT = $$$$ E1100493 CALL SYSMSG(FMER11,IDATA) E1100494 GOTO 8900 E1100495C CLEAR THE RECORD BUFFER E1100496 2700 CALL SET(RECBUF,40,$1515) E1100497C INITIALIZE THE TEXT INPUT BUFFER E1100498 CALL SET(TBUFFR,40,$1515) E1100499C CHECK FOR A NEW HIGHEST STATEMENT NUMBER E1100500 IF (LINENO.GT.STNMBR) STNMBR=LINENO E1100501C COMPLETE THE PROCESSOR E1100502 GO TO 7000 E1100503C SET UP FOR THE NEXT TAB POSITION E1100504 3000 CONTINUE E1100505C IF THIS IS THE LAST (20TH) TAB, THEN CONTINUE E1100506 GOTO 2000 E1100507C THIS CONTINUES THE TAB LOOP E1100508C IF THERE ARE NO MORE TABS, DO THE NEXT LINE E1100509 3100 IF (TABBUF(IT).EQ.0) GO TO 2000 E1100510C IF WE ARE COMMING HERE FROM A RUBOUT E1100511ÐÐC SKIP THE PASSED POSITION TEST E1100512 IF (TC.EQ.4) GO TO 3200 E1100513C HAVE WE ALREADY PASSED THIS TAB POSITION E1100514 IF (TABBUF(IT).LE.ICURCH) GO TO 3000 E1100515C CLEAR THE LENGTH OF THE REQUEST E1100516 TBUFFR(41)=0 E1100517C CLEAR THE TEXT BUFFER E1100518 3200 CALL SET(TBUFFR,40,$1515) E1100519C SET THE CURSOR TO THE NEXT TAB AND READ E1100520 CALL WTREAD(TERMLU,-1,TBUFFR,0,ICORDS,TBUFFR,40,TC) E1100521 GO TO 700 E1100522C THIS IS A LINE FEED OR A CARRIAGE RETURN E1100523C HAVE ANY CHARACTERS BEEN ENTERED FOR THIS READ E1100524 4000 IF (TBUFFR(41).NE.0) GO TO 2000 E1100525C NO DATA, IS THIS THE FIRST READ FOR THIS RECORD E1100526 IF (IT.EQ.1) GO TO 7000 E1100527C NO, THERE IS SOME DATA FOR THIS LINE E1100528 GO TO 2000 E1100529C THIS IS A RUBOUT E1100530C CLEAR ANY DATA ENTERED E1100531 5000 CALL SET(TBUFFR,40,$1515) E1100532C IF NO DATA WAS ENTERED, BACK UP TO THE PREVIOUS TAB POSITION E1100533 IF (TBUFFR(41).EQ.0) IT=IT-1 E1100534C IF TAB PTR IS OUT OF BOUNDS, RESET TO 1 E1100535 IF (IT.LT.1) IT=1 E1100536ÐÐC IF RUBOUT IS BACKED UP TO 1ST TAB, OUTPUT THE LINE E1100537 IF (IT.EQ.1) GOTO 150 E1100538C CALCULATE CURSOR POSITION FOR PREVIOUS TAB POSITION E1100539 ICORDS=(TABBUF(IT)-1)*$100+1 E1100540 GOTO 3200 E1100541C GET THIS RECORD E1100542 6000 NW(1)=0 E1100543 NW(2)=IS(LINIDX) E1100544 CALL READR(REQBUF,FBUFFR,NW,ISTAT) E1100545C VERIFY THE STATUS OF THE FILE MANAGER E1100546 IF (ISTAT.GE.0) GO TO 6200 E1100547C PUT THE FILE NAME INTO THE ERROR E1100548 DO 6100 IX=1,4 E1100549 IDATA(IX)=NAMFIL(IX) E1100550 6100 CONTINUE E1100551C PUT THE STATUS INTO THE ERROR E1100552 IDATA(5)=ISTAT E1100553C OUTPUT THE ERROR - FILE MANAGER ERROR WHEN READING FILE @@@@@@@@ E1100554C ISTAT = $$$$ E1100555 CALL SYSMSG(FMER04,IDATA) E1100556 GOTO 8900 E1100557C OUTPUT THE COLUMN HEADING E11005586200 CALL OUTPUT(TERMLU,TOFHED,41) E1100559C OUTPUT THE LINE E1100560 CALL RWRITE(TERMLU,FBUFFR,40) E1100561ÐÐC OUTPUT THE TRAILER E1100562 CALL RWRITE(TERMLU,TOFHED(2),40) E1100563C INITIALIZE THE DO LOOP FOR THE TAB BUFFER E1100564 IT=1 E1100565C POSITION THE CURSOR E1100566 ICORDS=(TABBUF(IT)-1)*$100+1 E1100567C OUTPUT THE CURSOR POSITION AND INPUT THE RECORD E1100568 CALL WTREAD(TERMLU,-1,0,0,ICORDS,TBUFFR,40,TC) E1100569C GET INTO THE DO LOOP AND CONTINUE FROM THERE. E1100570 GO TO 700 E1100571C PUT THE HIGHEST STATEMENT NUMBER INTO THE FCB E1100572 7000 FCBBUF(88)=STNMBR E1100573C GET THE NEXT AVAILABLE RECORD E1100574 CALL READR(REQBUF,FBUFFR,IRECPT,ISTAT) E1100575C VERIFY THE STATUS OF THE FILE MANAGER E1100576 IF (ISTAT.GE.0) GO TO 8100 E1100577C IS THIS AN END OF FILE E1100578 IF (AND(ISTAT,$0100).EQ.0) GO TO 2100 E1100579C YES, THERE IS NO NEED TO WRITE THE END OF FILE E1100580 GO TO 8200 E1100581C STORE AN EOF INDICATOR INTO THIS RECORD E1100582 8100 FBUFFR(1)=IEOFFM E1100583C UPDATE THIS LAST RECORD E1100584 CALL UPDREC(REQBUF,FBUFFR,ISTAT) E1100585C VERIFY THE STATUS OF THE FILE MANAGER E1100586ÐÐ IF (ISTAT.LT.0) GO TO 2500 E1100587C CLEAR THE EOF E1100588 FBUFFR(1)=$2020 E1100589C OUTPUT THE UPDATED FCB E1100590 8200 CALL UPDFCB(REQBUF,0,0,FCBBUF,ISTAT) E1100591C VERIFY THE STATUS OF THE FILE MANAGER E1100592 IF (ISTAT.GE.0) GO TO 9000 E1100593C MOVE THE FILE NAME TO THE ERROR E1100594 DO 8300 IX=1,4 E1100595 IDATA(IX)=NAMFIL(IX) E1100596 8300 CONTINUE E1100597C PUT THE STATUS INTO THE ERROR E1100598 IDATA(5)=ISTAT E1100599C OUTPUT THE ERROR - FILE MANAGER ERROR WHEN UPDATING FCB FOR FILE E1100600C @@@@@@@@ ISTAT = $$$$ E1100601 CALL SYSMSG(FMER12,IDATA) E1100602 8900 IERRFG=1 E1100603 9000 CALL RETURN E1100604 RETURN E1100605 END E1100606 SUBROUTINE LSTPRO E1200001 1 /E12 F ITOS CCS 3.0 SL-149E1200002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO PROCESS 'LIST' COMMAND E1200003C CREDIT COLLECTION SYSTEM VERSION 3.0 E1200004C DATA SYSTEM-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E1200005ÐÐC COPYRIGHT CONTROL DATA CORPORATION 1978 E1200006C E1200007C*** E1200008C FUNCTION E1200009C -------- E1200010CS3 THE FUNCTION OF THIS PROGRAM IS TO PROCESS THE 'LIST' E1200011C COMMAND. E1200012CS5 GENERAL FLOW E1200013C ------- ---- E1200014CS3 THE OPERATIONS PERFORMED BY THIS ROUTINE INCLUDE: E1200015C 1. IF THE IS NO FILE OPEN, THE ERROR MESSAGE E1200016C 'NO FILE OPEN FOR EDITOR USE' IS OUTPUT, THE E1200017C ERROR FLAG IS SET, AND CONTROL IS RETURNED TO E1200018C THE CALLING PROGRAM. E1200019C 2. THE CLEAR SCREEN BUFFER, THE SCREEN LINE COUNT, E1200020C AND THE BEGINNING AND ENDING LINE NUMBERS ARE E1200021C INITIALIZED. E1200022C 3. THE NEXT FIELD IS OBTAINED. IF AN ERROR OCCURS E1200023C CONTROL IS RETURNED TO THE CALLING PROGRAM. E1200024C IF THE INPUT VALUE WAS ZERO, LIST FROM THE E1200025C BEGINNING OF THE FILE. IF THE END OF DATA E1200026C FLAG WAS SET, LIST THE WHOLE FILE. E1200027C 4. GET THE NEXT FIELD. IF AN ERROR OCCURS, E1200028C CONTROL IS RETURNED TO THE CALLING PROGRAM. E1200029C IF THE INPUT VALUE WAS ZERO, LIST ONLY THE E1200030ÐÐC STARTING LINE. E1200031C 5. IF THE ENDING LINE PRECEEDS THE STARTING LINE E1200032C OUTPUT THE ERROR MESSAGE 'INVALID FIELD', SET E1200033C THE ERROR FLAG AND RETURN TO THE CALLING E1200034C PROGRAM. E1200035C 6. IF THE STARTING LINE IS GREATER THAN THE E1200036C HIGHEST LINE IN THE FILE, SET UP TO LIST ONLY E1200037C THE HIGHEST LINE IN THE FILE. E1200038C 7. INITIALIZE THE BEGINNING LINE. E1200039C 8. SET THE MODE FOR 'LOCATE' TO READ ONLY. E1200040C 9. IF A MANUAL INTERRUPT HAS OCCURRED, RETURN E1200041C TO THE CALLING PROGRAM. E1200042C 10. IF THIS IS THE FIRST LINE ON THE SCREEN, E1200043C OUTPUT A CLEAR SCREEN REQUEST. E1200044C 11. GET THE NEXT LINE FROM THE FILE. IF AN ERROR E1200045C OCCURS, RETURN TO THE CALLING PROGRAM. E1200046C 12. IF THE ENDING LINE HAS BEEN EXCEEDED, RETURN E1200047C TO THE CALLING PROGRAM. E1200048C 13. INCREMENT FOR THE NEXT LINE. E1200049C 14. OUTPUT THE CURRENT LINE. E1200050C 15. POSITION THE CURSOR AT THE NEXT SCREEN LINE. E1200051C IF THIS IS NOT THE BOTTOM OF THE SCREEN, E1200052C INCREMENT THE SCREEN LINE COUNT AND GO BACK E1200053C FOR THE NEXT LINE. E1200054C IF IT IS THE BOTTOM OF THE SCREEN, RESET THE E1200055ÐÐC SCREEN LINE COUNT TO THE TOP OF THE SCREEN, E1200056C OUTPUT 'PAUSE' AND WAIT FOR THE USER TO REPLY. E1200057C WHEN THE USER REPLIES, GO BACK TO GET THE E1200058C NEXT LINE. E1200059CS5 ENTRY/EXIT E1200060C ---------- E1200061CS3 THIS ROUTINE IS ENTERED FROM THE CONTROL PROCESSOR E1200062C 'EDITOS'. THE COMMAND INPUT BUFFER MUST CONTAIN THE E1200063C PARAMETER STRING FOR THE LIST COMMAND. E1200064C E1200065C EXIT TO THE CONTROL PROCESSOR IS WITH E1200066C IERRFG = 0 NO ERRORS E1200067C = + NON FATAL EDITOR ERROR. ANOTHER E1200068C PROCESSOR MAY BE ENTERED. E1200069C = - FATAL EDITOR ERROR HAS OCCURRED. E1200070C THE EDITOR IS TERMINATED. E1200071CS5 ERROR MESSAGES E1200072C ----- -------- E1200073CS3 THE FOLLOWING ERROR MESSAGES ARE OUTPUT BY THE LIST E1200074C PROCESSOR. E1200075C EDITOR ERROR 306 E1200076C 'INVALID FIELD' E1200077C EDITOR ERROR 319 E1200078C 'NO FILE OPEN FOR EDITOR USE' E1200079CS5 ENTRIES E1200080ÐÐC ------- E1200081CS3 ENTRY POINT REFERENCED BY E1200082C ----- ----- ---------- -- E1200083C LSTPRO EDITOS E1200084CS5 EXTERNAL REFERENCES E1200085C -------- ---------- E1200086CS3 EXTERNAL EXTERNAL E1200087C -------- -------- E1200088C FNDNXT GETNUM E1200089C OUTPUT RETURN E1200090C SAVE SYSMSG E1200091C WTREAD E1200092C*** E1200093M EDITCM E1200094 INTEGER EDER06 E1200095 INTEGER EDER19 E1200096 DATA EDER06/306/ E1200097 DATA EDER19/319/ E1200098 DIMENSION PAUSE(4) E1200099 INTEGER PAUSE E1200100 DATA PAUSE(1)/$0D0A/ E1200101 DATA PAUSE(2)/'PA'/ E1200102 DATA PAUSE(3)/'US'/ E1200103 DATA PAUSE(4)/'E '/ E1200104C SAVE ENTRY FOR RETURN E1200105ÐÐ CALL SAVE(LSTPRO) E1200106C HAS THE USER DONE A GET YET E1200107 IF (NAMFIL(1).NE.$2020) GO TO 10 E1200108C OUTPUT THE ERROR - NO FILE OPEN FOR EDITOR USE E1200109 CALL SYSMSG(EDER19,IDATA) E1200110 GOTO 9000 E1200111C E1200112C SET UP THE CLEAR SCREEN BUFFER E1200113 10 CB=$1800 E1200114C INITIALIZE THE LINE COUNTER E1200115 ISCRLN=1 E1200116C SET UP FOR FIRST AND LAST LINE E1200117 BEGLIN=1 E1200118 ENDLIN=STNMBR E1200119C GET NEXT FIELD - START LINE NUMBER E1200120 CALL GETNUM E1200121C DID AN ERROR OCCUR E1200122 IF (IERRFG.NE.0) GO TO 9000 E1200123C IF NO NUMBER IS ENTERED, LIST THE FILE FROM THE FIRST RECORD E1200124 IF (NUMHEX.NE.0) GO TO 100 E1200125C IF END OF TEXT WAS ENCOUNTERED, LIST THE WHOLE FILE E1200126 IF (ICHARC.LT.0) GO TO 300 E1200127 GO TO 150 E1200128C SET THE BEGINNING LINE NUMBER E1200129 100 BEGLIN=NUMHEX E1200130ÐÐC GET NEXT FIELD - END LINE NUMBER E1200131 150 CALL GETNUM E1200132C DID AN ERROR OCCUR E1200133 IF (IERRFG.NE.0) GO TO 9000 E1200134C IF END OF TEXT WAS ENCOUNTERED, LIST ONLY ONE LINE E1200135 IF (NUMHEX.EQ.0) NUMHEX=BEGLIN E1200136C SET THE END LINE NUMBER E1200137 ENDLIN=NUMHEX E1200138C IF THE START LINE IS GREATER THAN THE END LINE, IT IS AN ERROR E1200139 200 IF (BEGLIN.GT.ENDLIN) GO TO 500 E1200140C IF THE START LINE IS GREATER THAN THE HIGHEST LINE IN THE E1200141C FILE, LIST ONLY THE LAST LINE. E1200142 IF (BEGLIN.LE.STNMBR) GO TO 300 E1200143C SET START AND END LINE TO LAST LINE. E1200144 BEGLIN=STNMBR E1200145 ENDLIN=STNMBR E1200146C SET THE FIRST LINE FOR THE SEARCH OF THE STATEMENT LABEL INDEX E1200147 300 LINENO=BEGLIN E1200148C SET THE MODE FOR LOCATE TO READ ONLY E1200149 IMODE=0 E1200150C IS THE MANUAL INTERRUPT FLAG SET E1200151 400 IF (IFLAGX.NE.0) GO TO 9000 E1200152C IS IT TIME TO OUTPUT A CLEAR SCREEN E1200153 IF (ISCRLN.EQ.1) CALL OUTPUT(TERMLU,CB,1) E1200154C GET THE NEXT RECORD FROM THE FILE E1200155ÐÐ CALL FNDNXT E1200156C CHECK FOR AN ERROR HAVING OCCURRED E1200157 IF (IERRFG.NE.0) GO TO 9000 E1200158C IS THIS LINE BEYOND THE LAST LINE REQUESTED E1200159 IF (LINENO.GT.ENDLIN) GO TO 9000 E1200160C NO, SET UP FOR NEXT LINE E1200161 LINENO=LINENO+1 E1200162C OUTPUT THE LINE E1200163 CALL OUTPUT(TERMLU,FBUFFR,40) E1200164C BACK UP ONE LINE E1200165 ISCRPT(1)=$1B31 E1200166 ISCRPT(2)=ISCRLN+$2020 E1200167 CALL OUTPUT(TERMLU,ISCRPT,2) E1200168C BOTTOM OF SCREEN YET E1200169 IF (ISCRLN.GE.22) GO TO 450 E1200170C INCREMENT LINE COUNTER E1200171 ISCRLN=ISCRLN+1 E1200172C GET THE NEXT LINE E1200173 GO TO 400 E1200174C RESET LINE COUNT E1200175 450 ISCRLN=1 E1200176C OUTPUT THE PAUSE AND WAIT FOR INPUT E1200177 CALL WTREAD(TERMLU,-1,PAUSE,4,-1,CMNDBF,1,TC) E1200178 GO TO 400 E1200179C OUTPUT THE ERROR - INVALID FIELD E1200180ÐÐ 500 CALL SYSMSG(EDER06,IDATA) E1200181 9000 CALL RETURN E1200182 RETURN E1200183 END E1200184 SUBROUTINE RSQPRO E1300001 1 /E13 F ITOS CCS 3.0 SL-149E1300002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO PROCESS THE 'RESEQ' COMMAND E1300003C CREDIT COLLECTION SYSTEM VERSION 3.0 E1300004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E1300005C COPYRIGHT CONTROL DATA CORPORATION 1978 E1300006C E1300007C*** E1300008C FUNCTION E1300009C -------- E1300010CS3 THE FUNCTION OF THE PROGRAM IS TO PROCESS THE 'RESEQ' E1300011C COMMAND. E1300012CS5 GENERAL FLOW E1300013C ------- ---- E1300014CS3 THE FOLLOWING OPERATIONS ARE PERFORMED BY THIS ROUTINE. E1300015C 1. A CHECK IS MADE TO BE SURE A FILE HAS BEEN E1300016C OPENED FOR THE EDITOR TO USE. IF ONE HAS NOT E1300017C BEEN OPENED, THE ERROR MESSAGE 'NO FILE OPEN E1300018C FOR EDITOR USE' IS OUTPUT, THE ERROR FLAG IS E1300019C SET AND CONTROL IS RETURNED TO THE CALLING E1300020C PROGRAM. E1300021ÐÐC 2. IF THIS IS A RESEQUENCE COMMAND THE RESEQUENCE E1300022C NEEDED FLAG IS CLEARED. E1300023C 3. THE BASE AND INCREMENT VALUES FOR RESEQUENCING E1300024C ARE CLEARED. E1300025C 4. IF THIS IS NOT A RESEQUENCE COMMAND THE PICKUP E1300026C OF THE BASE AND INCREMENT VALUES IS SKIPPED. E1300027C GET THE BASE LINE NUMBER FOR RESEQUENCING. IF E1300028C AN ERROR OCCURS, RETURN CONTROL TO THE CALLING E1300029C PROGRAM. IF NO NUMBER WAS ENTERED SET THE E1300030C BASE LINE NUMBER TO 10. E1300031C GET THE LINE INCREMENT NUMBER. IF AN ERROR E1300032C OCCURS, RETURN CONTROL TO THE CALLING PROGRAM. E1300033C IF NO NUMBER WAS ENTERED SET THE INCREMENT E1300034C VALUE TO 10. E1300035C 5. INITIALIZE THE STARTING AND ENDING LINE NUMBERS E1300036C FOR THE USERS FILE. E1300037C 6. MOVE THE VOLUME NAME FROM THE USERS FILE INFOR- E1300038C MATION AREA TO THE SCRATCH FILE INFORMATION E1300039C AREA. CONVERT THE TERMINAL PORT NUMBER TO E1300040C ASCII TO CREATE A UNIQUE SCRATCH FILE NAME. E1300041C SET UP THE IDATA ARRAY FOR A CREATE REQUEST E1300042C FOR A SCRATCH FILE. E1300043C SET UP PARAMETERS TO OPEN THE FILE FOR RELATIVE E1300044C RECORD RETREIVAL, ONE RECORD PER REQUEST AND E1300045C LOCK THE FILE. E1300046ÐÐC CLEAR THE REQUEST BUFFER FOR THIS FILE. SET E1300047C THE NUMBER OF RECORDS FOR THE SCRATCH FILE TO E1300048C BE THE SAME AS THE USERS FILE. E1300049C TRY TO CREATE THIS SCRATCH FILE. IF THE FILE E1300050C ALREADY EXISTS, TRY TO DELETE IT. IF ANY E1300051C ERROR OCCURS OUTPUT THE ERROR MESSAGE 'FILE E1300052C MANAGER ERROR WHEN DELETING SCRATCH FILE E1300053C ISTAT = $$$$', SET THE ERROR FLAG AND RETURN E1300054C TO THE CALLING PROGRAM. IF NO ERROR OCCUR E1300055C WHEN DELETING THE FILE, GO BACK AND CREATE E1300056C IT AGAIN. E1300057C IF SOME OTHER ERROR OCCURS WHEN CREATING THE E1300058C SCRATCH FILE OUTPUT THE ERROR MESSAGE 'FILE E1300059C MANAGER ERROR WHEN CREATING SCRATCH FILE E1300060C ISTAT = $$$$', THE ERROR FLAG IS SET AND E1300061C CONTROL IS RETURNED TO THE CALLING PROGRAM. E1300062C 7. IF THE FILE IS CREATED CORRECTLY, CLEAR THE E1300063C REQUEST BUFFER FOR THE SCRATCH FILE, SET THE E1300064C FCB LENGTH AND ADDRESS INTO THE REQUEST BUFFER E1300065C AND OPEN THE SCRATCH FILE. IF AN ERROR OCCURS E1300066C OUTPUT THE ERROR MESSAGE 'FILE MANAGER ERROR E1300067C WHEN OPENING SCRATCH FILE ISTAT = $$$$', THE E1300068C ERROR FLAG IS SET AND CONTROL IS RETURNED TO E1300069C THE CALLING PROGRAM. E1300070C 8. IF NO ERROR OCCURS, THE RELATIVE RECORD NUMBER E1300071ÐÐC FOR THE SCRATCH FILE IS INITIALIZED. E1300072C 9. THE RPG ARRAY DATA FLAG IN THE USER FILE FCB E1300073C IS CLEARED. THE USERS FILE RELATIVE RECORD E1300074C IS SAVED IN CASE AN ERROR OCCURS. E1300075C 10. THE NEXT RECORD IS RETREIVED FROM THE FILE. E1300076C IF AN ERROR OCCURED, CONTROL IS RETURNED TO E1300077C THE CALLING PROGRAM. E1300078C 11. IF THE HIGHEST LINE NUMBER HAS BEEN PASSED E1300079C THE RESEQUENCE PORTION IS COMPLETE. E1300080C 12. IF NOT, CHECK TO SEE IF THE LINE NUMBER NEEDS E1300081C TO BE CHANGED. IF THIS IS A RESEQUENCE CALL E1300082C FROM THE CLEAR PROCESSOR CHANGING THE LINE E1300083C NUMBER IS NOT REQUIRED. SKIP TO THE STORE E1300084C RECORD SECTION. E1300085C 13. CONVERT THE NEW LINE NUMBER TO ASCII. IF THE E1300086C FILE TYPE IS NON RPG OR THE RECORD IS RPG ARRAY E1300087C DATA, POSITION THE LINE NUMBER IN POSITIONS E1300088C 76 - 80 OF THE RECORD. IF THE FILE IS RPG AND E1300089C NOT AN RPG ARRAY DATA RECORD, POSITION THE E1300090C LINE NUMBER IN POSITIONS 1 - 5 OF THE RECORD. E1300091C 14. STORE THE UPDATED RECORD INTO THE NEXT RELATIVE E1300092C RECORD OF THE SCRATCH FILE. IF AN ERROR OCCURS E1300093C OUTPUT THE ERROR MESSAGE 'FILE MANAGER ERROR E1300094C WHEN WRITING SCRATCH FILE ISTAT = $$$$', SET E1300095C THE ERROR FLAG AND RETURN TO THE CALLING E1300096ÐÐC PROGRAM. E1300097C 15. INCREMENT THE RELATIVE RECORD POINTERS FOR E1300098C BOTH FILES E1300099C 16. INCREMENT TO THE NEXT NEW LINE NUMBER. INCRE- E1300100C MENT THE OLD LINE NUMBER. E1300101C IF THE NEW LINE NUMBER IS GREATER THAN 32,767 E1300102C OUTPUT THE ERROR MESSAGE 'LINE NUMBER OVERFLOW' E1300103C AND THE ERROR MESSAGE 'RESEQUENCE WITH A LOWER E1300104C BASE AND/OR INCREMENT', CLOSE THE SCRATCH FILE E1300105C RESET THE RELATIVE RECORD POINTER FOR THE USERS E1300106C FILE, SET THE ERROR FLAG AND RETURN TO THE E1300107C CALLING PROGRAM. OTHERWISE, GO BACK FOR THE E1300108C NEXT RECORD. E1300109C 17. WHEN ALL RECORDS HAVE BE RESEQUENCED THE FILE E1300110C RECORD BUFFER IS CLEARED. E1300111C IF THE FILE IS NOT COMPLETELY FULL IT IS FILLED E1300112C WITH BLANK RECORDS. AN END OF FILE MARK IS E1300113C WRITTEN IN THE FIRST RECORD FOLLOWING THE E1300114C LAST DATA RECORD IF THE FILE IS NOT FULL. E1300115C 18. THE FCB FOR THE SCRATCH FILE IS UPDATED WITH E1300116C THE EXTENDED PORTION OF THE USERS FILE FCB. E1300117C IF ANY ERROR OCCURS THE ERROR MESSAGE 'FILE E1300118C MANAGER ERROR WHEN UPDATING FCB FOR SCRATCH E1300119C FILE ISTAT = $$$$' THE ERROR FLAG IS SET AND E1300120C CONTROL IS RETURNED TO THE CALLING PROGRAM. E1300121ÐÐC 19. CLOSE THE SCRATCH FILE. IF AN ERROR OCCURS E1300122C OUTPUT THE ERROR MESSAGE 'FILE MANAGER ERROR E1300123C WHEN CLOSING SCRATCH FILE ISTAT = $$$$' THE E1300124C ERROR FLAG IS SET AND CONTROL IS RETURNED TO E1300125C THE CALLING PROGRAM. E1300126C 20. THE USERS FILE IS CLOSED. IF AN ERROR OCCURS E1300127C OUTPUT THE ERROR MESSAGE 'FILE MANAGER ERROR E1300128C WHEN CLOSING FILE @@@@@@@@ ISTAT = $$$$' THE E1300129C ERROR FLAG IS SET AND CONTROL IS RETURNED TO E1300130C THE CALLING PROGRAM. E1300131C 21. THE USER'S FILE IS DELETED. IF AN ERROR OCCURS E1300132C THE ERROR MESSAGE 'FILE MANAGER ERROR WHEN E1300133C DELETING FILE @@@@@@@@ ISTAT = $$$$' IS OUTPUT, E1300134C THE ERROR FLAG IS SET AND CONTROL RETURNS TO E1300135C THE CALLING PROGRAM. E1300136C 22. THE SCRATCH FILE IS RENAMED USING THE ORIGINAL E1300137C NAME OF THE USERS NOW DELETED FILE. IF AN E1300138C ERROR OCCURS THE ERROR MESSAGE 'FILE MANAGER E1300139C ERROR WHEN RENAMING SCRATCH FILE ISTAT = $$$$', E1300140C IS OUTPUT, THE ERROR FLAG IS SET AND CONTROL E1300141C IS RETURNED TO THE CALLING PROGRAM. E1300142C 23. IF RESEQUENCE WAS CALLED BY THE CLEAR PROCESSOR E1300143C RETURN TO THE CALLING PROGRAM. IF IT WAS E1300144C CALLED BECAUSE OF A RESEQUENCE COMMAND, CLEAR E1300145C THE COMMAND INPUT BUFFER. PUT THE ASCII E1300146ÐÐC CHARACTERS FOR 'GET,' AND THE USERS FILE NAME E1300147C IN THE COMMAND INPUT BUFFER. IF THE FILE IS E1300148C IS AN RPG FILE, PUT A ',R' IN THE COMMAND E1300149C INPUT BUFFER. CLEAR THE FILE NAME BUFFER. E1300150C INITIALIZE THE CHARACTER COUNT FOR 'ELNSCN' E1300151C TO START AT CHARACTER 5. SET THE COMMA E1300152C ENCOUNTERED FLAG. SET THE LAST CHARACTER E1300153C READ TO A COMMA. E1300154C 24. EXECUTE A GET COMMAND. E1300155C 25. RETURN TO THE CALLING PROGRAM. E1300156CS5 ENTRY/EXIT E1300157C ---------- E1300158CS3 THIS ROUTINE IS ENTERED FROM BOTH THE CONTROL PROCESSOR E1300159C 'EDITOS' AND THE CLEAR PROCESSOR 'CLEPRO'. FOR BOTH E1300160C PROCESSORS A FILE MUST BE OPEN FOR THE EDITOR TO USE. E1300161C FOR ENTRY FROM 'EDITOS' THE COMMAND INPUT BUFFER MUST E1300162C CONTAIN THE PARAMETER STRING FOR A RESEQUENCE COMMAND. E1300163C FOR ENTRY FROM 'CLEPRO' THE RESEQUENCE NEEDED FLAG E1300164C MUST BE SET (IRESFG = 1) E1300165C E1300166C EXIT TO EITHER PROCESSOR IS WITH E1300167C IERRFG = 0 NO ERROR E1300168C = 1 NON FATAL EDITOR ERROR. ANOTHER E1300169C PROCESSOR MAY BE ENTERED. E1300170C = + FATAL EDITOR ERROR HAS OCCURRED. E1300171ÐÐC THE EDITOR IS TERMINATED. E1300172CS5 ERROR MESSAGES E1300173C ----- -------- E1300174CS3 THE FOLLOWING ERROR MESSAGES ARE OUTPUT BY THE RESEQ- E1300175C UENCE COMMAND. E1300176C EDITOR ERROR 312 E1300177C 'LINE NUMBER OVERFLOW' E1300178C EDITOR ERROR 318 E1300179C 'RESEQUENCE WITH A LOWER BASE AND/OR INCREMENT' E1300180C EDITOR ERROR 319 E1300181C 'NO FILE OPEN FOR EDITOR USE' E1300182C EDITOR FILE MANAGER ERROR 339 E1300183C 'FILE MANAGER ERROR WHEN CLOSING FILE @@@@@@@@ E1300184C ISTAT = $$$$' E1300185C EDITOR FILE MANAGER ERROR 343 E1300186C 'FILE MANAGER ERROR WHEN CREATING SCRATCH FILE E1300187C ISTAT = $$$$' E1300188C EDITOR FILE MANAGER ERROR 344 E1300189C 'FILE MANAGER ERROR WHEN OPENING SCRATCH FILE E1300190C ISTAT = $$$$' E1300191C EDITOR FILE MANAGER ERROR 345 E1300192C 'FILE MANAGER ERROR WHEN WRITING SCRATCH FILE E1300193C ISTAT = $$$$' E1300194C EDITOR FILE MANAGER ERROR 346 E1300195C 'FILE MANAGER ERROR WHEN UPDATING FCB FOR SCRATCH E1300196ÐÐC FILE ISTAT = $$$$' E1300197C EDITOR FILE MANAGER ERROR 347 E1300198C 'FILE MANAGER ERROR WHEN RENAMING SCRATCH FILE E1300199C ISTAT = $$$$' E1300200C EDITOR FILE MANAGER ERROR 348 E1300201C 'FILE MANAGER ERROR WHEN DELETING FILE @@@@@@@@ E1300202C ISTAT = $$$$' E1300203C EDITOR FILE MANAGER 349 E1300204C 'FILE MANAGER ERROR WHEN DELETING SCRATCH FILE ISTAT = $$$$' E1300205CS5 ENTRIES E1300206C ------- E1300207CS3 ENTRY POINT REFERENCED BY E1300208C ----- ----- ---------- -- E1300209C RSQPRO EDITOS E1300210C CLEPRO E1300211CS5 EXTERNAL REFERENCES E1300212C -------- --------- E1300213CS3 EXTERNAL EXTERNAL E1300214C -------- -------- E1300215C CLOSFL CREATE E1300216C DECHEX DELETE E1300217C FNDNXT GETNUM E1300218C GETPRO HEXDEC E1300219C OPENFL PUTS E1300220C RENAME RETURN E1300221ÐÐC SAVE SET E1300222C SYSMSG UPDFCB E1300223C*** E1300224M EDITCM E1300225 DIMENSION ICRSCR(24) E1300226 DATA (ICRSCR(I),I=1,12)/'SCRATCXX$$ SYSVOL '/ E1300227 DATA ICRSCR(13)/80/ E1300228 DATA ICRSCR(14)/0/ E1300229 DATA ICRSCR(15)/0/ E1300230 DATA ICRSCR(16)/0/ E1300231 DATA (ICRSCR(I),I=17,24)/8*0/ E1300232 INTEGER EDER12 E1300233 INTEGER EDER18 E1300234 INTEGER EDER19 E1300235 DATA EDER12/312/ E1300236 DATA EDER18/318/ E1300237 DATA EDER19/319/ E1300238 INTEGER FMER09 E1300239 INTEGER FMER13 E1300240 INTEGER FMER14 E1300241 INTEGER FMER15 E1300242 INTEGER FMER16 E1300243 INTEGER FMER17 E1300244 INTEGER FMER18 E1300245 INTEGER FMER19 E1300246ÐÐ DATA FMER09/339/ E1300247 DATA FMER13/343/ E1300248 DATA FMER14/344/ E1300249 DATA FMER15/345/ E1300250 DATA FMER16/346/ E1300251 DATA FMER17/347/ E1300252 DATA FMER18/348/ E1300253 DATA FMER19/349/ E1300254C SAVE ENTRY FOR RETURN E1300255 CALL SAVE(RSQPRO) E1300256C HAS THE USER DONE A GET YET E1300257 IF (NAMFIL(1).NE.$2020) GO TO 10 E1300258C OUTPUT THE ERROR - NO FILE OPEN FOR EDITOR USE E1300259 CALL SYSMSG(EDER19,IDATA) E1300260 GO TO 150 E1300261C IF TH IS A RESEQUENCE COMMAND, CLEAR THE RESEQUENCE FLAG E1300262 10 IF (AND(CMNDBF(1),$FF00).EQ.$5200) IRESFG=0 E1300263C CLEAR THE RESEQUENCE BASE AND INCREMENT E1300264 RSQNUM=0 E1300265 RSQINC=0 E1300266C IF THIS IS NOT A RESEQ COMMAND, E1300267C IGNORE THE PICKUP OF THE BASE AND INCREMENT E1300268 IF (AND(CMNDBF(1),$FF00).NE.$5200) GO TO 50 E1300269C GET THE BASE LINE NUMBER PARAMETER E1300270 CALL GETNUM E1300271ÐÐC DID ANY ERRORS OCCUR E1300272 IF (IERRFG.NE.0) GO TO 9000 E1300273C IF THERE IS NO BASE USE 10 E1300274 IF (NUMHEX.EQ.0) NUMHEX=10 E1300275C SET THE BASE LINE TO THIS VALUE E1300276 RSQNUM=NUMHEX E1300277C GET THE INCREMENT VALUE PARAMETER E1300278 CALL GETNUM E1300279C DID ANY ERRORS OCCUR E1300280 IF (IERRFG.NE.0) GO TO 9000 E1300281C IF THERE IS NO INCREMENT USE 10 E1300282 IF (NUMHEX.EQ.0) NUMHEX=10 E1300283C SET THE INCREMENT VALUE TO THIS NUMBER E1300284 RSQINC=NUMHEX E1300285C SET THE START AND END LINE PARAMETERS TO ONE AND THE HIGHEST LINE E1300286 50 BEGLIN=1 E1300287 LINENO=BEGLIN E1300288 ENDLIN=STNMBR E1300289C CREATE THE SCRATCH FILE ON THE USERS VOLUME E1300290 DO 75 IX=9,12 E1300291 ICRSCR(IX)=FMOPEN(IX) E1300292 75 CONTINUE E1300293C CREATE AND OPEN ONE SCRATCH FILE FOR RESEQUENCING INTO E1300294C CONVERT THE PORT NUMBER FOR USE IN THE DEFINE/OPEN E1300295 CALL HEXDEC(NOPORT,NUMBER(1)) E1300296ÐÐC PUT THE PORT NUMBER (TWO DIGITS ONLY) INTO SCRATCH FILE NAME E1300297 ICRSCR(4)=NUMBER(3) E1300298C MOVE DATA TO OPEN BUFFER E1300299 DO 100 IX=1,12 E1300300 FMOPEN(IX)=ICRSCR(IX) E1300301 100 CONTINUE E1300302C SET TO OPEN BY RELATIVE RECORD NUMBER E1300303 FMOPEN(13)=0 E1300304C SET TO RETREIVE 20 RECORDS PER REQUEST E1300305 FMOPEN(14)=1 E1300306C SET THE FILE LOCKED E1300307 FMOPEN(15)=$8000 E1300308C CLEAR THE REQUEST BUFFER FOR THIS FILE E1300309 110 CALL SET(SCRQBF,24,0) E1300310C SET NUMBER OF RECORDS IN FILE TO BE THE SAME AS THE USERS FILE E1300311 ICRSCR(14)=FCBBUF(2) E1300312 ICRSCR(15)=FCBBUF(3) E1300313C MOVE THE CREATE BUFFER TO COMMON E1300314 DO 125 IX=1,24 E1300315 ICRBUF(IX)=ICRSCR(IX) E1300316 125 CONTINUE E1300317C CREATE THIS FILE E1300318 CALL CREATE(SCRQBF,ICRBUF,ISTAT) E1300319C VERIFY THE STATUS OF THE FILE MANAGER E1300320 IF (ISTAT.GE.0) GO TO 200 E1300321ÐÐC DOES THIS FILE ALREADY EXIST E1300322 IF (AND(ISTAT,$0400).NE.0) GO TO 160 E1300323C PUT STATUS INTO ERROR E1300324 IDATA(1)=ISTAT E1300325C OUTPUT THE ERROR - FILE MANAGER ERROR CREATING SCRATCH FILE E1300326C ISTAT = $ E1300327 CALL SYSMSG(FMER13,IDATA) E1300328C SET THE ERROR FLAG E1300329 150 IERRFG=1 E1300330 GO TO 9000 E1300331C DELETE THE FILE IF IT ALREADY EXISTS E1300332 160 CALL DELETE(SCRQBF,ICRBUF,ISTAT) E1300333C VERIFY THE STATUS OF THE FILE MANAGER E1300334 IF (ISTAT.GE.0) GO TO 110 E1300335C PUT THE STATUS INTO ERROR E1300336 IDATA(1)=ISTAT E1300337C OUTPUT THE ERROR - FILE MANAGER ERROR WHEN DELETING SCRATCH FILE E1300338C ISTAT = $$$$ E1300339 CALL SYSMSG(FMER19,IDATA) E1300340 GO TO 150 E1300341C FILE IS CREATED OK, NOW OPEN IT. E1300342C CLEAR THE REQUEST BUFFER E1300343 200 CALL SET(SCRQBF,24,0) E1300344C PUT FCB ADDRESS AND LENGTH INTO REQUEST BUFFER E1300345 SCRQBF(10)=SCRADR E1300346ÐÐ SCRQBF(13)=96 E1300347C OPEN THE SCRATCH FILE E1300348 CALL OPENFL(SCRQBF,FMOPEN,ISTAT) E1300349C VERIFY THE STATUS OF THE FILE MANAGER E1300350 IF (ISTAT.GE.0) GO TO 225 E1300351C PUT STATUS INTO ERROR E1300352 IDATA(1)=ISTAT E1300353C OUTPUT THE ERROR - FILE MANAGER ERROR WHEN OPENING SCRATCH FILE E1300354C ISTAT = $ E1300355 CALL SYSMSG(FMER14,IDATA) E1300356 GO TO 150 E1300357C SET THE INITIAL VALUE INTO THE RECORD POINTER FOR SCRATCH FILE E1300358 225 ISCRPT(1)=0 E1300359 ISCRPT(2)=1 E1300360C SAVE THE ORIGINAL VALUE OF THE RELATIVE RECORD POINTER E1300361C IN CASE AN ERROR ABORTS THE RESEQUENCE E1300362 IRELRC=IRECPT(2) E1300363C SET THE INITIAL VALUE INTO THE RECORD POINTER FOR USER FILE E1300364 IRECPT(1)=0 E1300365 IRECPT(2)=1 E1300366C CLEAR THE RPG ARRAY DATA FLAG E1300367 FCBBUF(86)=0 E1300368C GET THE NEXT RECORD FROM THE FILE E1300369 250 CALL FNDNXT E1300370C DID AN ERROR OCCUR E1300371ÐÐ IF (IERRFG.NE.0) GO TO 9000 E1300372C ARE WE DONE WITH THE FILE E1300373 IF (LINENO.GT.ENDLIN) GO TO 800 E1300374C IF THIS IS AN AUTOMATIC RESEQUENCE, DO NOT CHANGE THE LINE NUMBERSE1300375 IF (RSQINC.EQ.0) GO TO 600 E1300376C CONVERT THE LINE NUMBER FOR THE NEW FILE TO ASCII E1300377 CALL HEXDEC(RSQNUM,NUMBER) E1300378C IF THIS IS A NON RPG FILE PUT THE NUMBER INTO 76-80 E1300379 IF (FCBBUF(87).NE.1) GO TO 400 E1300380C STORE THE NUMBER E1300381 300 FBUFFR(38)=AND(FBUFFR(38),$FF00)+AND(NUMBER(1),$00FF) E1300382 FBUFFR(39)=NUMBER(2) E1300383 FBUFFR(40)=NUMBER(3) E1300384C IF THE RPG ARRAY DATA FLAG IS SET, SAVE THE LINE NUMBER E1300385 IF (FCBBUF(86).EQ.-1) FCBBUF(86)=LINENO E1300386 GO TO 600 E1300387C IS THIS RPG ARRAY DATA E1300388 400 IF (FCBBUF(86).NE.0) GO TO 300 E1300389C IS THIS AN RPG END OF PROGRAM FLAG E1300390 IF (FBUFFR(1).EQ.$2F2A) GO TO 300 E1300391C IS THIS NOT THE RPG ARRAY DATA INDICATOR E1300392 IF (FBUFFR(1).NE.$2A2A) GO TO 425 E1300393C SET THE RPG ARRAY DATA FLAG E1300394 IF (FCBBUF(86).EQ.0) FCBBUF(86)=-1 E1300395 GO TO 300 E1300396ÐÐC IF THE RPG ARRAY DATA FLAG IS SET, PUT THE LINE NUMBER IN 75 - 80 E1300397 425 IF (FCBBUF(86).NE.0) GO TO 300 E1300398C PUT NUMBER IN POSITION 1-5 E1300399 450 FBUFFR(1)=AND(NUMBER(1),$00FF)*$100+AND(NUMBER(2),$FF00)/$100 E1300400 FBUFFR(2)=AND(NUMBER(2),$00FF)*$100+AND(NUMBER(3),$FF00)/$100 E1300401 FBUFFR(3)=AND(NUMBER(3),$00FF)*$100+AND(FBUFFR(3),$00FF) E1300402 GO TO 600 E1300403C IS THIS AN RPG ARRAY DATA LINE E1300404 500 IF (AND(FBUFFR(38),$FF00).NE.$3000) GO TO 450 E1300405C IT IS PROBABLE. IS IT WITHIN THE ARRAY DATA RANGE E1300406 CALL DECHEX(FBUFFR(38),NUMHEX) E1300407C IT IS BELOW RPG ARRAY DATA. PUT THE NUMBER INTO 1-5 E1300408 IF (NUMHEX.LT.FCBBUF(86)) GO TO 450 E1300409C IT IS RPG ARRAY DATA. PUT THE NUMBER IN 75-80 E1300410 GO TO 300 E1300411C THE RECORD IS CHANGED, NOW WRITE IT BACK TO THE SCRATCH FILE E1300412 600 CALL PUTS(SCRQBF,FBUFFR,1,ISTAT) E1300413C VERIFY THE STATUS OF THE FILE MANAGER E1300414 IF (ISTAT.GE.0) GO TO 700 E1300415C PUT STATUS INTO ERROR E1300416 650 IDATA(1)=ISTAT E1300417C OUTPUT THE ERROR - FILE MANAGER ERROR WHEN WRITING SCRATCH FILE E1300418C ISTAT = $ E1300419 CALL SYSMSG(FMER15,IDATA) E1300420 GO TO 150 E1300421ÐÐC SET UP FOR NEXT RECORD E1300422 700 IRECPT(2)=IRECPT(2)+1 E1300423 ISCRPT(2)=ISCRPT(2)+1 E1300424C SET NEXT NEW LINE E1300425 RSQNUM=RSQNUM+RSQINC E1300426C SET UP FOR NEXT OLD LINE E1300427 LINENO=LINENO+1 E1300428C GET THE NEXT LINE. E1300429C HAS THE NEW LINE NUMBER EXCEEDED 32767 E1300430 IF (RSQNUM.LE.32767) GO TO 250 E1300431C OUTPUT THE ERROR - LINE NUMBER OVERFLOW E1300432 CALL SYSMSG(EDER12,IDATA) E1300433C OUTPUT THE ERROR - RESEQUENCE WITH A LOWER BASE AND/OR INCREMENT E1300434 CALL SYSMSG(EDER18,IDATA) E1300435C CLOSE THE SCRATCH FILE E1300436 CALL CLOSFL(SCRQBF,ISTAT) E1300437C RESET THE ORIGINAL RELATIVE RECORD POINTER E1300438 IRECPT(2)=IRELRC E1300439 GO TO 150 E1300440C CLEAR THE FIRST RECORD IN THE FILE BUFFER E1300441 800 CALL SET(FBUFFR,40,$2020) E1300442C DOES THE FILE NEED BLANK RECORDS TO FILL IT UP E1300443 IF (SCFCBF(8).GE.FCBBUF(3)) GO TO 875 E1300444C SET THE FIRST WORD OF THE FIRST EMPTY RECORD TO THE FILE MARK CODEE1300445 FBUFFR(1)=IEOFFM E1300446ÐÐC YES, FILL IN WHAT IS NEEDED E1300447 IY=ISCRPT(2) E1300448 IZ=FCBBUF(3) E1300449 DO 850 IX=IY,IZ E1300450 CALL PUTS(SCRQBF,FBUFFR,1,ISTAT) E1300451C VERIFY THE STATUS OF THE FILE MANAGER E1300452 IF (ISTAT.LT.0) GO TO 650 E1300453C CLEAR THE FILE MARK E1300454 FBUFFR(1)=$2020 E1300455 850 CONTINUE E1300456C UPDATE EXTENDED FCB FOR SCRATCH FILE WITH E1300457C EXTENDED FCB FOR USERS FILE E1300458 875 CALL UPDFCB(SCRQBF,0,0,FCBBUF,ISTAT) E1300459C VERIFY THE STATUS OF THE FILE MANAGER E1300460 IF (ISTAT.GE.0) GO TO 900 E1300461C PUT STATUS INTO ERROR E1300462 IDATA(1)=ISTAT E1300463C OUTPUT THE ERROR - FILE MANAGER ERROR UPDATING FCB FOR SCRATCH E1300464C FILE ISTAT = $ E1300465 CALL SYSMSG(FMER16,IDATA) E1300466 GO TO 150 E1300467C CLOSE THESE FILES E1300468 900 CALL CLOSFL(SCRQBF,ISTAT) E1300469C VERIFY THE STATUS OF THE FILE MANAGER E1300470 IF (ISTAT.GE.0) GO TO 1000 E1300471ÐÐC PUT STATUS INTO ERROR E1300472 IDATA(1)=ISTAT E1300473C OUTPUT THE ERROR - FILE MANAGER ERROR WHEN CLOSING SCRATCH FILE E1300474C ISTAT = $ E1300475 CALL SYSMSG(FMER16,IDATA) E1300476 GO TO 150 E1300477C CLOSE THE USERS FILE E1300478 1000 CALL CLOSFL(REQBUF,ISTAT) E1300479C VERIFY THE STATUS OF THE FILE MANAGER E1300480 IF (ISTAT.GE.0) GO TO 1100 E1300481C PUT FILE NAME INTO ERROR E1300482 DO 1050 IX=1,4 E1300483 IDATA(IX)=NAMFIL(IX) E1300484 1050 CONTINUE E1300485C PUT STATUS INTO ERROR E1300486 IDATA(5)=ISTAT E1300487C OUTPUT THE ERROR - FILE MANAGER ERROR WHEN CLOSING FILE @@@@@@@@ E1300488C ISTAT = $ E1300489 CALL SYSMSG(FMER09,IDATA) E1300490 GO TO 150 E1300491C RENAME THE SCRATCH FILE AS THE USERS FILE E1300492C DELETE THE USER FILE FOR RENAMIMG E1300493 1100 CALL DELETE(REQBUF,NAMFIL,ISTAT) E1300494C VERIFY THE STATUS OF THE FILE MANAGER E1300495 IF (ISTAT.GE.0) GO TO 1150 E1300496ÐÐC PUT THE FILE NAME INTO THE ERROR E1300497 DO 1125 IX=1,4 E1300498 IDATA(IX)=NAMFIL(IX) E1300499 1125 CONTINUE E1300500C PUT STATUS INTO THE ERROR E1300501 IDATA(5)=ISTAT E1300502C OUTPUT THE ERROR - FILE MANAGER ERROR WHEN DELETING FILE @@@@@@@@ E1300503C ISTAT = $$$$ E1300504 CALL SYSMSG(FMER18,IDATA) E1300505 GO TO 150 E1300506 1150 CALL RENAME(SCRQBF,FMOPEN,NAMFIL,ISTAT) E1300507C VERIFY THE STATUS OF THE FILE MANAGER E1300508 IF (ISTAT.GE.0) GO TO 1200 E1300509C PUT STATUS INTO ERROR E1300510 IDATA(1)=ISTAT E1300511C OUTPUT THE ERROR - FILE MANAGER ERROR WHEN RENAMING SCRATCH FILE E1300512C ISTAT = $ E1300513 CALL SYSMSG(FMER17,IDATA) E1300514 GO TO 150 E1300515C IF THIS RESEQUENCE OCCURRED BECAUSE OF A DELETE OR E1300516C A LINE ENTRY COMMAND, DO NOT GET THIS FILE AGAIN E1300517 1200 IF (IRESFG.NE.0) GO TO 9000 E1300518C CLEAR THE COMMAND INPUT BUFFER E1300519 CALL SET(CMNDBF,40,-0) E1300520C SET UP PSEUDO GET COMMAND E1300521ÐÐ CMNDBF(1)=2HGE E1300522 CMNDBF(2)=2HT, E1300523 DO 1300 IX=1,4 E1300524 CMNDBF(IX+2)=NAMFIL(IX) E1300525 1300 CONTINUE E1300526C SET THE RPG INDICATOR IF THIS IS AN RPG FILE E1300527 CMNDBF(7)=$2C52 E1300528 IF (FCBBUF(87).NE.2) CMNDBF(7)=$FFFF E1300529C CLEAR THE FILE NAME E1300530 CALL SET(NAMFIL,4,$2020) E1300531C SET CHARACTER POSITION FOR ELNSCN E1300532 CHARNO=5 E1300533C SET THE COMMA FLAG E1300534 COMMAF=1 E1300535C SET THE LAST CHARACTER READ TO A COMMA ($ZC) E1300536 ICHARC=$2C E1300537C EXECUTE A GET COMMAND E1300538 CALL GETPRO E1300539C COMPLETE THIS PROCESSOR E1300540 9000 CALL RETURN E1300541 RETURN E1300542 END E1300543 SUBROUTINE SEAPRO E1400001 1 /E14 F ITOS CCS 3.0 SL-149E1400002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO PROCESS THE 'SEARCH' COMMAND E1400003ÐÐC CREDIT COLLECTION SYSTEM VERSION 3.0 E1400004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E1400005C COPYRIGHT CONTROL DATA CORPORATION 1978 E1400006C E1400007C*** E1400008C FUNCTION E1400009C -------- E1400010CS3 THE FUNCTION OF THIS PROGRAM IS TO PROCESS THE 'SEARCH' E1400011C COMMAND. E1400012CS5 GENERAL FLOW E1400013C ------- ---- E1400014CS3 THE OPERATIONS PERFORMED BY THIS ROUTINE INCLUDE: E1400015C 1. IF NO FILE IS OPEN, OUTPUT THE ERROR 'NO FILE E1400016C OPEN FOR EDITOR USE', SET THE ERROR FLAG AND E1400017C RETURN TO THE CALLING PROGRAM. E1400018C 2. SET UP THE INITIAL BEGINNING AND ENDING LINE E1400019C NUMBERS. E1400020C 3. SET UP STARTING, ENDING CHARACTER POSITIONS E1400021C FOR A SEARCH, SET UP THE SCREEN LINE COUNT. E1400022C 4. GET THE CHARACTER STRING TO SEARCH FOR. IF AN E1400023C ERROR OCCURS, RETURN TO THE CALLING PROGRAM. E1400024C IF THE STRING LENGTH IS 0, THEN OUTPUT AN ERROR E1400025C ELSE SAVE THE LENGTH. E1400026C 3. GET THE STARTING LINE NUMBER. IF AN ERROR E1400027C OCCURS, RETURN TO THE CALLING PROGRAM. E1400028ÐÐC IF THE STARTING SEQUENCE NUMBER IS GIVEN, SAVE IT E1400029C TO DEFINE THE START OF THE SEARCH. E1400030C 4. GET THE ENDING LINE NUMBER. IF AN ERROR OCCURS, E1400031C RETURN TO THE CALLING PROGRAM. SAVE THIS E1400032C NUMBER AS THE ENDING LINE NUMBER. IF THE E1400033C ENDING LINE NUMBER IS ZERO, THEN DO ONE LINE E1400034C BY SETTING THE ENDING LINE NUMBER EQUAL TO E1400035C THE BEGINNING NUMBER E1400036C 5. IF THE ENDING LINE NUMBER COMES BEFORE THE E1400037C STARTING LINE NUMBER, OUTPUT THE ERROR MESSAGE E1400038C 'INVALID COMMAND' AND RETURN TO THE CALLER. E1400039C E1400040C GET THE STARTING CHARACTER POSITION TO START THE E1400041C SCAN. IF AN ERROR OCCURS, RETURN TO THE CALLING E1400042C PROGRAM. IF THIS IS GIVEN, SAVE THIS STARTING E1400043C CHARACTER POSITION FOR LATER USE. E1400044C E1400045C GET THE ENDING CHARACTER POSITION TO LOOK FOR E1400046C A MATCH. IF AN ERROR OCCURS, RETURN TO THE E1400047C CALLING PROGRAM. IF THIS IS GIVEN, SAVE E1400048C THIS ENDING CHARACTER POSITION FOR LATER USE. E1400049C IF THERE IS NO ENDING CHARACTER POSITION, E1400050C THEN SCAN ONLY 1 CHARACTER. IF THE ENDING E1400051C CHARACTER POSITION, OUTPUT THE ERROR MESSAGE E1400052C 'INVALID COMMAND' AND RETURN TO THE CALLER. E1400053ÐÐC 6. MOVE THE STRING TO SEARCH FOR TO THE COMPARISON E1400054C BUFFER. E1400055C 7. SET UP THE INITIAL LINE NUMBER FOR THE SEARCH E1400056C AND CLEAR THE MATCH ENCOUNTERED FLAG. E1400057C 8. IF A MANUAL INTERRUPT HAS OCCURRED, RETURN E1400058C TO THE CALLING PROGRAM. IF NOT, GET THE E1400059C NEXT LINE TO CHECK. IF THE LAST LINE HAS E1400060C BEEN CHECKED AND NO MATCHES HAVE BEEN FOUND E1400061C OUTPUT THE MESSAGE 'OPERATION FINISHED -- E1400062C STRING NOT FOUND' AND RETURN TO THE CALLING E1400063C PROGRAM. IF SOME MATCHES HAVE BEEN FOUND E1400064C RETURN TO THE CALLING PROGRAM. E1400065C 9. IF IT IS NOT THE LAST LINE, MOVE THE RECORD E1400066C INTO 'CMNDBF' SO IT MAY BE SCANNED BY 'ELNSCN'. E1400067C SET THE END OF RECORD FLAG AT THE END OF E1400068C 'CMNDBF'. E1400069C 10. INITIALIZE THE CHARACTER COUNTER. E1400070C 11. SET UP THE BOUNDS FOR THE SEARCH DEPENDING E1400071C ON THE FILE TYPE. E1400072C RPG TYPE FILE - SEARCH POSITIONS 6 - 80. E1400073C NON RPG TYPE FILE AND E1400074C ARRAY DATA RECORDS IN E1400075C RPG TYPE FILE - SEARCH POSITIONS 1 - 75 E1400076C 12. IF A MANUAL INTERRUPT HAS OCCURRED, RETURN E1400077C TO THE CALLING PROGRAM. E1400078ÐÐC 13. CALL 'STRMCH' TO SEE IF A MATCH EXISTS. IF NO E1400079C MATCH EXISTS IN THE RECORD, GO BACK FOR THE E1400080C IF A MATCH OCCURS, SET STRING MATCHED FOUND E1400081C FLAG AND THEN OUTPUT THE RECORD ON THE SCREEN. E1400082C 14. IF THIS IS NOT THE BOTTOM OF THE SCREEN, E1400083C INCREMENT TO THE NEXT LINE ON THE SCREEN AND E1400084C CONTINUE LOOKING FOR MORE MATCHES IN THIS E1400085C RECORD. E1400086C IF THIS IS THE BOTTOM OF THE SCREEN, OUTPUT E1400087C THE MESSAGE 'PAUSE' AND WAIT FOR INPUT. WHEN E1400088C THE USER REPLIES CONTINUE LOOKING FOR MATCHES E1400089C ON THIS RECORD. E1400090CS5 ENTRY/EXIT E1400091C ---------- E1400092CS3 THIS ROUTINE IS ENTERED FROM THE CONTROL PROCESSOR E1400093C 'EDITOS'. THE COMMAND INPUT BUFFER MUST CONTAIN THE E1400094C PARAMETER STRING FOR THE SEARCH COMMAND. E1400095C E1400096C EXIT TO THE CONTROL PROCESSOR IS E1400097C IERRFG = 0 NO ERRORS E1400098C = + NON FATAL EDITOR ERROR. ANOTHER E1400099C PROCESSOR MAY BE ENTERED. E1400100C = - FATAL EDITOR ERROR OCCURRED. THE E1400101C EDITOR IS TERMINATED. E1400102CS5 ERROR MESSAGES E1400103ÐÐC ----- -------- E1400104CS3 THE FOLLOWING ERROR MESSAGES ARE OUTPUT BY THE SEARCH E1400105C PROCESSOR. E1400106C EDITOR ERROR 306 E1400107C 'INVALID FIELD' E1400108C EDITOR ERROR 309 E1400109C 'INVALID COMMAND' E1400110C EDITOR ERROR 319 E1400111C 'NO FILE OPEN FOR EDITOR USE' E1400112CS5 ENTRIES E1400113C ------- E1400114CS3 ENTRY POINT REFERENCED BY E1400115C ----- ----- ---------- -- E1400116C SEAPRO EDITOS E1400117CS5 EXTERNAL REFERENCES E1400118C -------- ---------- E1400119CS3 EXTERNAL EXTERNAL E1400120C -------- -------- E1400121C FNDNXT GETNUM E1400122C OUTPUT RETURN E1400123C SAVE STRMCH E1400124C SYSMSG WTREAD E1400125C GETSTR E1400126C*** E1400127M EDITCM E1400128ÐÐ INTEGER ICOLST,ICOLEN E1400129 INTEGER PAUSE E1400130 DIMENSION PAUSE(4) E1400131 DATA PAUSE(1)/$0D0A/ E1400132 DATA PAUSE(2)/'PA'/ E1400133 DATA PAUSE(3)/'US'/ E1400134 DATA PAUSE(4)/'E '/ E1400135 INTEGER SCNCLR E1400136 DATA SCNCLR/$1800/ E1400137 DIMENSION IOPFIN(19) E1400138 DATA (IOPFIN(I),I=1,19)/'OPERATION FINISHED...STRING NOT FOUND '/ E1400139 INTEGER EDER06 E1400140 INTEGER EDER09 E1400141 INTEGER EDER19 E1400142 DATA EDER06/306/ E1400143 DATA EDER09/309/ E1400144 DATA EDER19/319/ E1400145C SAVE ENTRY FOR RETURN E1400146 CALL SAVE(SEAPRO) E1400147C HAS THE USER DONE A GET YET E1400148 IF (NAMFIL(1).NE.$2020) GO TO 10 E1400149C OUTPUT THE ERROR - NO FILE OPEN FOR EDITOR USE E1400150 CALL SYSMSG(EDER19,IDATA) E1400151C E1400152C GET SEARCH PARAMETERS E1400153ÐÐC --------------------- E1400154C SET UP START AND END LINE NUMBERS E1400155 10 BEGLIN=1 E1400156 ENDLIN=STNMBR E1400157C E1400158C INITIALIZE STARTING, ENDING CHARACTER POSITIONS E1400159 ICOLST=1 E1400160 ICOLEN=80 E1400161C SET UP INITIAL LINE COUNT E1400162 ISCRLN=1 E1400163C E1400164C GET THE CHARACTER STRING TO SEARCH FOR E1400165 CALL GETSTR E1400166C DID AN ERROR OCCUR E1400167 IF (IERRFG.NE.0) GO TO 9000 E1400168C SAVE LENGTH OF STRING THAT IS TO BE LOOKED FOR E1400169 ISRLNG=IX-1 E1400170C IF THIS IS AN EMPTY STRING(NO CHARS BETWEEN DELIMITER)THEN ERROR E1400171 IF (ISRLNG.LE.0) GOTO 250 E1400172C E1400173C GET THE STARTING LINE NUMBER, IF ANY E1400174 CALL GETNUM E1400175C DID AN ERROR OCCUR E1400176 IF (IERRFG.NE.0) GO TO 9000 E1400177C IF A STARTING SEQUENCE IS GIVEN, USE PARAM E1400178ÐÐ IF (NUMHEX.NE.0) BEGLIN=NUMHEX E1400179 IDUMB=NUMHEX E1400180C GET THE ENDING LINE NUMBER E1400181 CALL GETNUM E1400182C DID AN ERROR OCCUR E1400183 IF (IERRFG.NE.0) GO TO 9000 E1400184C IF ENDING STATEMENT NUMBER IS GIVEN, USE IT E1400185 IF (NUMHEX.GT.0) ENDLIN=NUMHEX E1400186C IF NO NUMBER WAS ENTERED, DO ONLY ONE LINE E1400187 IF (NUMHEX.EQ.0.AND.IDUMB.NE.0) ENDLIN=BEGLIN E1400188C IS ENDING LINE BEFORE STARTING LINE E1400189 IF (ENDLIN.LT.BEGLIN) GOTO 250 E1400190C E1400191C SEE IF THERE IS A STARTING CHARACTER POSITION E1400192 CALL GETNUM E1400193C DID AN ERROR OCCUR E1400194 IF (IERRFG.NE.0) GOTO 9000 E1400195C SAVE STARTING CHARACTER POSITION PARAMETER, IF GIVEN E1400196 IF (NUMHEX.NE.0) ICOLST=NUMHEX E1400197 IDUMB=NUMHEX E1400198C E1400199C SEE IF THERE IS AN ENDING CHARACTER POSITION PARAMETER E1400200 CALL GETNUM E1400201C DID AN ERROR OCCUR E1400202 IF (IERRFG.NE.0) GOTO 9000 E1400203ÐÐC IF ENDING CHARACTER NUMBER IS GIVEN, USE IT E1400204 IF (NUMHEX.GT.0) ICOLEN=NUMHEX E1400205C IF THERE IS NO ENDING CHARACTER NUMBER, DO ONLY 1 CHARACTER E1400206 IF (NUMHEX.EQ.0.AND.IDUMB.NE.0) ICOLEN=ICOLST E1400207C IS ENDING CHARACTER POSITION BEFORE THE STARTING CHAR POSITION E1400208 200 IF (ICOLEN.GE.ICOLST) GOTO 300 E1400209C OUTPUT ERROR MESSAGE - INVALID COMMAND E1400210 250 CALL SYSMSG(EDER09,IDATA) E1400211 GOTO 9000 E1400212C MOVE STRING TO COMPARISON BUFFER E1400213 300 DO 400 IX=1,20 E1400214 STRBF2(IX)=STRBF1(IX) E1400215 400 CONTINUE E1400216C SET INITIAL LINE NUMBER E1400217 LINENO=BEGLIN E1400218C ASSUME STRING WAS NOT FOUND E1400219 ISEAFG=0 E1400220C E1400221C BEGIN SEARCH PROCESSING E1400222C ----------------------- E1400223C HAS A MANUAL INTERRUPT OCCURRED E1400224 500 IF (IFLAGX.NE.0) GO TO 1000 E1400225C GET THE NEXT LINE E1400226 CALL FNDNXT E1400227C HAS THE ENDING LINE BEEN PASSED E1400228ÐÐ IF (LINENO.GT.ENDLIN) GO TO 1000 E1400229C MOVE THE RECORD INTO THE COMMAND BUFFER E1400230C SO ELNSCN CAN BE USED FOR CHARACTER PICKUP E1400231 DO 600 IX=1,40 E1400232 CMNDBF(IX)=FBUFFR(IX) E1400233 600 CONTINUE E1400234C SET LAST WORD TO ALL ONES E1400235 CMNDBF(41)=$FFFF E1400236C MAKE SURE THE END OF DATA FLAG IS NOT SET E1400237 ICHARC=0 E1400238C IS THIS AN RPG FILE E1400239 IF (FCBBUF(87).LE.1) GO TO 650 E1400240C YES, IS THIS AN RPG ARRAY DATA LINE E1400241 IF (FCBBUF(86).EQ.0) GO TO 625 E1400242 IF (FCBBUF(86).LE.LINENO) GO TO 650 E1400243C ASSUME SCAN WILL START AT CHAR POSITION 6 E1400244 625 CHARNO=6 E1400245C IF DATA TYPE=RPG, SEE IF STARTING COLUMN.GE.6 E1400246 IF (ICOLST.LT.6) GOTO 635 E1400247C SET UP THE SEARCH LIMITS FOR RPG RECORDS E1400248 CHARNO=ICOLST E1400249 635 IENREC=80 E1400250 GO TO 700 E1400251C SET THE SEARCH LIMITS FOR NON-RPG OR RPG ARRAY DATA RECORDS E1400252 650 CHARNO=ICOLST E1400253ÐÐ IENREC=75 E1400254C HAS A MANUAL INTERRUPT OCCURRED E1400255 700 IF (IFLAGX.NE.0) GO TO 1000 E1400256C PAST TO STRMCH, THE ENDING CHARACTER POSITION OF SEARCH E1400257 IY=IENREC E1400258C USE THE LOWER OF RECORD LIMIT E1400259 IF (ICOLEN.LT.IENREC) IY=ICOLEN E1400260 CALL STRMCH E1400261C DID A MATCH OCCUR E1400262 IF (ISRMCH.GE.0) GOTO 800 E1400263C NO, GET THE NEXT RECORD E1400264 750 LINENO=LINENO+1 E1400265 GO TO 500 E1400266C INDICATE A STRING HAS BEEN FOUND E1400267 800 ISEAFG=1 E1400268C IF AT TOP OF SCREEN, CLEAR SCREEN E1400269 IF (ISCRLN.EQ.1) CALL OUTPUT(TERMLU,SCNCLR,1) E1400270C OUTPUT RECORD WITH A MATCH E1400271 CALL WTREAD(TERMLU,ISCRLN,CMNDBF,40,-1,0,0,TC) E1400272C HAVE WE REACHED THE BOTTOM OF THE SCREEN YET E1400273 IF (ISCRLN.GT.21) GO TO 950 E1400274C NO, INCREMENT TO THE NEXT LINE ON THE SCREEN E1400275 ISCRLN=ISCRLN+1 E1400276C CONTINUE SEARCHING THIS LINE E1400277 GOTO 750 E1400278ÐÐC OUTPUT THE PAUSE AND WAIT FOR INPUT E1400279 950 CALL WTREAD(TERMLU,ISCRLN,PAUSE,4,-1,ISCRPT,1,TC) E1400280C CONTINUE SEARCHING THIS LINE E1400281C RESET THE LINE COUNT TO THE TOP OF THE SCREEN E1400282 ISCRLN=1 E1400283 GO TO 700 E1400284C HAVE ANY MATCHES OCCURRED E1400285 1000 IF (ISEAFG.NE.0) GO TO 9000 E1400286C OUTPUT THE MESSAGE - OPERATION FINISHED...STRING NOT FOUND E1400287 CALL OUTPUT(TERMLU,IOPFIN,19) E1400288 9000 CALL RETURN E1400289 RETURN E1400290 END E1400291 SUBROUTINE STAPRO E1500001 1 /E15 F ITOS CCS 3.0 SL-149E1500002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO PROCESS THE 'STAB' COMMAND E1500003C CREDIT COLLECTION SYSTEM VERSION 3.0 E1500004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E1500005C COPYRIGHT CONTROL DATA CORPORATION 1978 E1500006C E1500007C*** E1500008C FUNCTION E1500009C -------- E1500010CS3 THE FUNCTION OF THIS PROGRAM IS TO PROCESS THE 'STAB' E1500011C OR SET TAB COMMAND. E1500012ÐÐCS5 GENERAL FLOW E1500013C ------- ---- E1500014CS3 THE OPERATIONS PERFORMED BY THIS ROUTINE INCLUDE: E1500015C 1. THE CURRENT CHARACTER POSITION IN THE COMMAND E1500016C INPUT BUFFER IS SAVED. E1500017C 2. THE FIELD 'ALFFLD' IS INITIALIZED TO BLANKS. E1500018C 3. THE NEXT FIELD IS OBTAINED. IF AN ERROR E1500019C OCCURS, CONTROL IS RETURNED TO THE CALLING E1500020C PROGRAM. E1500021C 4. IF THE FIELD CONTAINS ANY ALPHA CHARACTER E1500022C A - Z OR A BLANK OR ASTARISK, THE CHARACTER E1500023C IS SAVED AS THE FORMAT TYPE, 'SETAUT' IS E1500024C CALLED TO SET UP THE TAB POSITIONS FOR THAT E1500025C FORMAT TYPE AND CONTROL IS RETURNED TO THE E1500026C CALLING PROGRAM. E1500027C 5. IF THE CHARACTER IS NOT ALPHA OR BLANK OR AN *, E1500028C THE CHARACTER POSITION FOR THE START OF THE E1500029C FIELD IS RESET AND THE FIELD IS OBTAINED AS E1500030C A NUMERIC FIELD. IF ANY ERROR OCCURS, CONTROL E1500031C IS RETURNED TO THE CALLING PROGRAM. E1500032C 6. UP TO 20 NUMERIC FIELDS ARE OBTAINED AND SAVED E1500033C AS TAB POSITIONS IN 'TABBUF'. E1500034C 7. EACH TAB POSITION IS CHECKED TO MAKE SURE IT E1500035C IS ASCENDING SEQUENCE. THE FIRST POSITION E1500036C WHICH CONTAINS A ZERO TERMINATES THE TEST. E1500037ÐÐC IF ANY POSITION IS OUT OF ORDER, THE ERROR E1500038C 'TAB STOPS INCORRECTLY SET UP' IS OUTPUT E1500039C THE ERROR FLAG IS SET AND CONTROL RETURNS TO E1500040C THE CALLING PROGRAM. E1500041C IF NO TAB POSITION ERRORS OCCUR, CONTROL IS E1500042C RETURNED TO THE CALLING PROGRAM. E1500043CS5 ENTRY/EXIT E1500044C ---------- E1500045CS3 THIS ROUTINE IS ENTERED FROM THE CONTROL PROCESSOR E1500046C 'EDITOS'. THE COMMAND INPUT BUFFER MUST CONTAIN THE E1500047C PARAMETER STRING FOR THE SET TAB COMMAND. E1500048C E1500049C EXIT TO THE CONTROL PROCESSOR IS WITH THE APPROPRIATE E1500050C TAB STOP POSITIONS SET IN 'TABBUF', AND IERRFG = 0 E1500051C INDICATING NO ERRORS. OR, E1500052C IERRFG = + NON FATAL EDITOR ERROR. ANOTHER E1500053C PROCESSOR MAY BE ENTERED. E1500054C = - A FATAL EDITOR ERROR OCCURRED. E1500055C THE EDITOR IS TERMINATED. E1500056CS5 ERROR MESSAGES E1500057C ----- -------- E1500058CS3 THE FOLLOWING ERROR MESSAGE IS OUTPUT BY THE STAB E1500059C PROCESSOR. E1500060C EDITOR ERROR 313 E1500061C 'TAB STOPS INCORRECTLY SET UP' E1500062ÐÐCS5 ENTRIES E1500063C ------- E1500064CS3 ENTRY POINT REFERENCED BY E1500065C ----- ----- ---------- -- E1500066C STAPRO EDITOS E1500067CS5 EXTERNAL REFERENCES E1500068C -------- ---------- E1500069CS3 EXTERNAL EXTERNAL E1500070C -------- -------- E1500071C GETAFD GETNUM E1500072C RETURN SAVE E1500073C SETAUT SYSMSG E1500074C*** E1500075M EDITCM E1500076 INTEGER EDER13 E1500077 DATA EDER13/313/ E1500078C SAVE ENTRY FOR RETURN E1500079 CALL SAVE(STAPRO) E1500080C SAVE THE POSITION COUNT FROM ELNSCN E1500081 ITCHAR=CHARNO E1500082C INITIALIZE ALFFLD TO BLANK E1500083 ALFFLD(1)=$2020 E1500084C WAS THE OUT OF DATA FLAG SET E1500085 IF (ICHARC.LT.0) GO TO 300 E1500086C GET A FIELD FROM THE COMMAND E1500087ÐÐ CALL GETAFD E1500088C DID AN ERROR OCCUR E1500089 IF (IERRFG.NE.0) GO TO 9000 E1500090C IS THIS AN ALPHA CHARACTER E1500091 IF (AND(ALFFLD(1),$FF00)/$100.GE.$41.AND.AND(ALFFLD(1),$FF00)/$100E1500092 1.LE.$5A) GO TO 300 E1500093C IS THIS CHARACTER A BLANK OR AN * E1500094 IF (AND(ALFFLD(1),$FF00).EQ.$2000.OR. E1500095 1 AND(ALFFLD(1),$FF00).EQ.$2A00) GO TO 300 E1500096C THIS IS A NUMERIC FIELD. BACK UP AND GET IT AS A NUMBER E1500097 CHARNO=ITCHAR E1500098C RESET THE END OF DATA FLAG BACK TO A COMMA E1500099 ICHARC=$2C E1500100C SET THE COMMA ENCOUNTERED FLAG E1500101 COMMAF=1 E1500102C GET UP TO 20 NUMERIC FIELDS AS TAB POSITIONS E1500103 DO 100 IZ=1,20 E1500104C GET A NUMBER E1500105 CALL GETNUM E1500106C DID AN ERROR OCCUR E1500107 IF (IERRFG.NE.0) GO TO 9000 E1500108C STORE IT IN THE TAB STOP BUFFER E1500109 TABBUF(IZ)=NUMHEX E1500110 100 CONTINUE E1500111C MAKE SURE THEY ARE IN ASCENDING ORDER E1500112ÐÐ DO 200 IZ=1,19 E1500113C IF THE NUMBER IS ZERO, THE CHECK IS DONE E1500114 IF (TABBUF(IZ+1).EQ.0) GO TO 9000 E1500115C CHECK ORDER E1500116 IF (TABBUF(IZ+1).LE.TABBUF(IZ)) GO TO 250 E1500117 200 CONTINUE E1500118 GO TO 9000 E1500119C OUTPUT THE ERROR - TAB STOPS INCORRECTLY SET UP E1500120 250 CALL SYSMSG(EDER13,IDATA) E1500121 GO TO 9000 E1500122C SET UP THE FORMAT TYPE E1500123 300 FORMTP=AND(ALFFLD(1),$FF00)/$100 E1500124C VALIDATE THE FILE TYPE AND SET THE TABS E1500125 CALL SETAUT E1500126 9000 CALL RETURN E1500127 RETURN E1500128 END E1500129 SUBROUTINE CLRMEM E1600001 1 /E16 F ITOS CCS 3.0 SL-149E1600002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO CLEAR THE IS'ARRAY E1600003C CREDIT COLLECTION SYSTEM VERSION 3.0 E1600004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E1600005C COPYRIGHT CONTROL DATA CORPORATION 1978 E1600006C E1600007C*** E1600008ÐÐC FUNCTION E1600009C -------- E1600010CS3 THE FUNCTION OF THIS PROGRAM IS TO CLEAR THE 'IS' AND E1600011C 'FBUFFR' ARRAYS. E1600012CS5 GENERAL FLOW E1600013C ------- ---- E1600014CS3 THIS PROGRAM CONTAINS TWO CALLS TO 'SET'. THE FIRST E1600015C SETS THE 'IS' ARRAY TO ZERO AND THE SECOND SETS THE E1600016C 'FBUFFR' ARRAY TO ZERO. E1600017CS5 ENTRY/EXIT E1600018C ---------- E1600019CS3 THIS ROUTINE IS ENTERED FROM 'CLRSVM'. THERE ARE NO E1600020C SPECIAL ENTRY CONDITIONS. E1600021C E1600022C EXIT IS TO THE CALLING PROGRAM, WITH NO SPECIAL EXIT E1600023C CONDITIONS. E1600024CS5 ENTRIES E1600025C ------- E1600026CS3 ENTRY POINT REFERENCED BY E1600027C ----- ----- ---------- -- E1600028C CLRMEM CLRSVM E1600029CS5 EXTERNAL REFERENCES E1600030C -------- ---------- E1600031CS3 EXTERNAL EXTERNAL E1600032C -------- -------- E1600033ÐÐC RETURN SAVE E1600034C SET E1600035C*** E1600036M EDITCM E1600037C SAVE ENTRY FOR RETURN E1600038 CALL SAVE(CLRMEM) E1600039C CLEAR THE IS-ARRAY E1600040 CALL SET(IS,ISSIZE,0) E1600041C CLEAR THE FILE BUFFER E1600042 CALL SET(FBUFFR,FBSIZE,0) E1600043 CALL RETURN E1600044 RETURN E1600045 END E1600046 SUBROUTINE CLRSVM E1700001 1 /E17 F ITOS CCS 3.0 SL-149E1700002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO CLEAR THE DIRECTORY FILE E1700003C CREDIT COLLECTION SYSTEM VERSION 3.0 E1700004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E1700005C COPYRIGHT CONTROL DATA CORPORATION 1978 E1700006C E1700007C*** E1700008C FUNCTION E1700009C -------- E1700010CS3 THE FUNCTION OF THIS PROGRAM IS TO CLEAR THE STATEMENT E1700011C LABEL VIRTUAL MEMORY SPACE. E1700012ÐÐCS5 GENERAL FLOW E1700013C ------- ---- E1700014CS3 THE FOLLOWING OPERATIONS ARE PERFORMED BY THIS ROUTINE: E1700015C 1. 'CLRMEM' IS CALLED TO CLEAR THE STATEMENT E1700016C LABEL VIRTUAL MEMORY. E1700017C 2. THE NUMBER OF RECORD BLOCKS OF THE STATEMENT E1700018C LABEL INDEX FILE USED IS CALCULATED. THESE E1700019C RECORD BLOCKS ARE CLEARED. IF A FILE MANAGER E1700020C ERROR OCCURS, THE ERROR 'FILE MANAGER ERROR E1700021C IN STATEMENT LABEL INDEX FILE ISTAT = $$$$' E1700022C IS PRINTED, THE EDITOR ABORT FLAG IS SET AND E1700023C THE RETURN IS MADE TO THE CALLER. E1700024C 3. THE STATEMENT LABEL INDEX HEADER AREA IS E1700025C INITIALIZED. E1700026C 4. THE LAST REFERENCED RECORD IN THE STATEMENT E1700027C LABEL INDEX, THE HIGHEST REFERENCED RECORD IN E1700028C THE STATEMENT LABEL INDEX, AND THE HIGHEST E1700029C STATEMENT NUMBER ARE INITIALIZED. E1700030C 5. RETURN IS MADE TO THE CALLER. E1700031CS5 ENTRY/EXIT E1700032C ---------- E1700033CS3 ENTRY TO THIS ROUTINE IS FROM 'CLEPRO'. E1700034C E1700035C EXIT TO 'CLPRO' IS WITH E1700036C IERRFG = 0 NO ERRORS E1700037ÐÐC = + NON FATAL EDITOR ERROR. ANOTHER E1700038C PROCESSOR MAY BE ENTERED. E1700039C = - A FATAL EDITOR ERROR OCCURRED. E1700040C THE EDITOR IS TERMINATED. E1700041CS5 ERROR MESSAGES E1700042C ----- -------- E1700043CS3 THE FOLLOWING ERROR MESSAGE IS OUTPUT BY THIS ROUTINE. E1700044C EDITOR FILE MANAGER ERROR 337 E1700045C 'FILE MANAGER ERROR IN STATEMENT LABEL INDEX FILE ISTAT = $$$$E1700046CS5 ENTRIES E1700047C ------- E1700048CS3 ENTRY POINT REFERENCED BY E1700049C ----- ----- ---------- -- E1700050C CLRMEM CLEPRO E1700051CS5 EXTERNAL REFERENCES E1700052C -------- ---------- E1700053CS3 EXTERNAL EXTERNAL E1700054C -------- -------- E1700055C CLRMEM RETURN E1700056C SAVE SET E1700057C SYSMSG UPDREC E1700058C*** E1700059M EDITCM E1700060 INTEGER FMER07 E1700061 DATA FMER07/337/ E1700062ÐÐC SAVE ENTRY FOR RETURN E1700063 CALL SAVE(CLRSVM) E1700064C CLEAR WORK SPACES E1700065 CALL CLRMEM E1700066C STNMBR IS THE HIGHEST STATEMENT NUMBER USED E1700067C IPGSIZ IS THE NUMBER OF ENTRIES PER RECORD BLOCK E1700068C IMAX IS THE HIGHEST RECORD BLOCK USED E1700069 IMAX=(STNMBR+IPGSIZ-1)/IPGSIZ E1700070C CLEAR ALL USED RECORD BLOCKS IN STATEMENT LABEL INDEX FILE E1700071 DO 100 IX=1,IMAX E1700072C SET THE RELATIVE RECORD POINTER E1700073 SLRQBF(16)=0 E1700074 SLRQBF(17)=IX E1700075C CLEAR THIS RECORD E1700076 CALL UPDREC(SLRQBF,IS,ISTAT) E1700077C VERIFY THE STATUS OF THE FILE MANAGER E1700078 IF (ISTAT.GE.0) GO TO 100 E1700079C WAS THIS AN END OF FILE E1700080 IF (AND(ISTAT,$0020).NE.0) GO TO 100 E1700081C PUT THE STATUS INTO THE ERROR E1700082 IDATA(1)=ISTAT E1700083C OUTPUT THE ERROR - FILE MANAGER ERROR IN STATEMENT LABEL INDEX E1700084C FILE ISTAT = $ E1700085 CALL SYSMSG(FMER07,ISTAT) E1700086C SET THE ERROR FLAG TO ABORT THE EDITOR E1700087ÐÐ IERRFG=$8000 E1700088 GO TO 9000 E1700089 100 CONTINUE E1700090C INITIALIZE THE STATEMENT LABEL INDEX FILE HEADER AREA E1700091 CALL SET(IS,NOPAGS,-1) E1700092C CLEAR THE LAST REFERENCED RECORD E1700093 IMADRL=-1 E1700094C SET THE HIGHEST REFERENCED RELATIVE RECORD POINTER E1700095 IHIRRP=0 E1700096C CLEAR THE HIGHEST STATEMENT NUMBER E1700097 STNMBR=0 E1700098 9000 CALL RETURN E1700099 RETURN E1700100 END E1700101 SUBROUTINE ELNSCN E1800001 1 /E18 F ITOS CCS 3.0 SL-149E1800002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO PICK UP CHARACTERS E1800003C CREDIT COLLECTION SYSTEM VERSION 3.0 E1800004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E1800005C COPYRIGHT CONTROL DATA CORPORATION 1978 E1800006C E1800007C*** E1800008C FUNCTION E1800009C -------- E1800010CS3 THE FUNCTION OF THIS PROGRAM IS TO EXTRACT THE NEXT E1800011ÐÐC CHARACTER FROM 'CMNDBF'. E1800012CS5 GENERAL FLOW E1800013C ------- ---- E1800014CS3 THE OPERATIONS PERFORMED BY THIS ROUTINE INCLUDE. E1800015C 1. A TEST IS MADE FOR THE END OF TEXT FLAG BEING E1800016C SET. IF IT IS SET, CONTROL IS RETURNED TO E1800017C THE CALLING PROGRAM. E1800018C 2. THE PROPER WORD AND BYTE ARE CALCULATED FROM E1800019C 'CHARNO'. E1800020C 3. THE CHARACTER IS EXTRACTED INTO 'ICHARC'. E1800021C 4. IF THE CHARACTER IS A BACKGROUND CHARACTER E1800022C (EITHER ZERO OR $7F) THE END OF TEXT FLAG IS E1800023C SET. E1800024C 5. CONTROL IS RETURNED TO THE CALLING PROGRAM. E1800025CS5 ENTRY/EXIT E1800026C ---------- E1800027CS3 THIS ROUTINE IS ENTERED FROM VARIOUS PROCESSORS AND E1800028C SUBPROCESSORS. THE COMMAND INPUT BUFFER 'CMNDBF' MUST E1800029C CONTAIN THE CHARACTER STRING TO BE PROCESSED AND THE E1800030C NEXT CHARACTER NUMBER MUST BE IN 'CHARNO'. E1800031C E1800032C EXIT TO THE CALLING ROUTINE IS WITH E1800033C ICHARC = ASCII CHARACTER E1800034C OR $8000 END OF TEXT FLAG E1800035CS5 ENTRIES E1800036ÐÐC ------- E1800037C ENTRY POINT REFERENCED BY E1800038C ----- ----- ---------- -- E1800039C ELNSCN EDITOS E1800040C GETAFD E1800041C GETNAM E1800042C GETNUM E1800043C GETONE E1800044C GETSTR E1800045C STRMCH E1800046CS5 EXTERNAL REFERENCES E1800047C -------- ---------- E1800048CS3 EXTERNAL EXTERNAL E1800049C -------- -------- E1800050C RETURN SAVE E1800051C*** E1800052M EDITCM E1800053C SAVE ENTRY FOR RETURN E1800054 CALL SAVE(ELNSCN) E1800055C IS THE END OF TEXT FLAG SET E1800056 IF (ICHARC.LT.0) GO TO 300 E1800057C COMPUTE WORD INDEX INTO COMMAND BUFFER E1800058 IWRDIX=(CHARNO+1)/2 E1800059C IS THIS THE ODD (UPPER) CHARACTER E1800060 IF (AND(CHARNO,1).NE.0) GO TO 100 E1800061ÐÐC GET THE CHARACTER FROM THE LOWER BYTE E1800062 ICHARC=AND(CMNDBF(IWRDIX),$007F) E1800063 GO TO 200 E1800064C GET THE CHARACTER FROM THE UPPER BYTE AND PUT IT IN THE LOWER E1800065 100 ICHARC=AND(CMNDBF(IWRDIX),$7F00)/$100 E1800066C GET SET FOR NEXT CHARACTER E1800067 200 CHARNO=CHARNO+1 E1800068C IF THE CHARACTER IS BACKGROUND, SET END OF DATA FLAG E1800069 IF (ICHARC.EQ.0.OR.ICHARC.EQ.$7F) ICHARC=$8000 E1800070 300 CALL RETURN E1800071 RETURN E1800072 END E1800073 SUBROUTINE FNDEND E1900001 1 /E19 F ITOS CCS 3.0 SL-149E1900002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO FIND THE HIGHEST LINE NUMBER E1900003C CREDIT COLLECTION SYSTEM VERSION 3.0 E1900004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E1900005C COPYRIGHT CONTROL DATA CORPORATION 1978 E1900006C E1900007C*** E1900008C FUNCTION E1900009C -------- E1900010CS3 THE FUNCTION OF THIS PROGRAM IS TO FIND THE HIGHEST E1900011C STATEMENT NUMBER IN THE CURRENT FILE E1900012CS5 GENERAL FLOW E1900013ÐÐC ------- ---- E1900014CS3 THIS PROGRAM PERFORMS THE FOLLOWING OPERATIONS E1900015C 1. SET THE MODE FOR 'LOCATE' TO READ ONLY. E1900016C 2. WORKING BACKWARDS FROM THE CURRENT LINE NUMBER E1900017C (WHICH IS THE HIGHEST LINE NUMBER AT THIS E1900018C POINT), FIND THE NEXT HIGHEST LINE NUMBER E1900019C INDICATED IN THE STATEMENT LABEL INDEX FILE. E1900020C 3. PUT THIS LINE NUMBER INTO THE HIGHEST STATEMENT E1900021C NUMBER. IF THERE ARE NO OTHER ENTRIES, MAKE E1900022C THE HIGHEST STATEMENT NUMBER ZERO. E1900023C 4. RETURN TO THE CALLER. E1900024CS5 ENTRY/EXIT E1900025C ---------- E1900026CS3 THIS ROUTINE IS ENTERED FROM THE DELETE PROCESSOR. E1900027C 'LINENO' MUST CONTAIN THE CURRENT HIGHEST LINE NUMBER. E1900028C THIS LINE HAS JUST BEEN DELETED. E1900029C E1900030C EXIT RETURN TO THE DELETE PROCESSOR WITH E1900031C LINENO = NEW HIGHEST LINE NUMBER E1900032C OR 0 IF THE FILE IS NOW EMPTY E1900033CS5 ENTRIES E1900034C ------- E1900035CS3 ENTRY POINT REFERENCED BY E1900036C ----- ----- ---------- -- E1900037C FNDEND DELPRO E1900038ÐÐCS5 EXTERNAL REFERENCES E1900039C -------- ---------- E1900040CS3 EXTERNAL EXTERNAL E1900041C -------- -------- E1900042C FNDSLI RETURN E1900043C SAVE E1900044C*** E1900045M EDITCM E1900046C SAVE ENTRY FOR RETURN E1900047 CALL SAVE(FNDEND) E1900048C SET THE MODE FOR LOCATE TO READ E1900049 IMODE=0 E1900050C WORKING BACKWARDS FROM HERE, FIND THE NEXT HIGHEST LINE NUMBER E1900051 DO 100 IENX=LINENO,1,-1 E1900052 LINENO=IENX E1900053C FIND THIS LINE IN THE STATEMENT LABEL INDEX FILE E1900054 CALL FNDSLI E1900055C DID AN ERROR OCCUR E1900056 IF (IERRFG.NE.0) GO TO 9000 E1900057C IS THIS LINE NUMBER USED E1900058 IF (IS(LINIDX).NE.0) GO TO 200 E1900059C NO, GO BACK FOR NEXT LOWER E1900060 100 CONTINUE E1900061C THE FILE IS EMPTY E1900062 IENX=0 E1900063ÐÐC SAVE THE NEW HIGHEST LINE NUMBER E1900064 200 STNMBR=IENX E1900065 9000 CALL RETURN E1900066 RETURN E1900067 END E1900068 SUBROUTINE FNDNXT E2000001 1 /E20 F ITOS CCS 3.0 SL-149E2000002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO FIND THE NEXT STATEMENT REC. E2000003C CREDIT COLLECTION SYSTEM VERSION 3.0 E2000004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E2000005C COPYRIGHT CONTROL DATA CORPORATION 1978 E2000006C E2000007C*** E2000008C FUNCTION E2000009C -------- E2000010CS3 THE FUNCTION OF THIS PROGRAM IS TO GET THE USER TEXT E2000011C RECORD SPECIFIED BY LINEO AND PUT IT INTO FBUFFR E2000012CS5 GENERAL FLOW E2000013C ------- ---- E2000014CS3 THE FOLLOWING OPERATIONS ARE PERFORMED BY THIS ROUTINE E2000015C 1. 'FNDSLI' IS CALLED TO FIND THE ENTRY IN THE E2000016C STATEMENT LABEL INDEX FILE CORRESPONDING TO E2000017C THIS LINE NUMBER. E2000018C 2. IF THE ENTRY FOR THIS LINE NUMBER IS ZERO, THERE E2000019C IS NO CORRESPONDING RECORD. INCREMENT THE E2000020ÐÐC LINE NUMBER TO THE NEXT LINE. IF THIS LINE E2000021C NUMBER IS BEYOND THE LAST LINE NUMBER REQUESTED E2000022C RETURN TO THE CALLER, OTHERWISE PROCEED WITH E2000023C STEP ONE ABOVE. E2000024C 3. IF THERE IS A RECORD POINTER RETURNED FROM E2000025C 'FNDSLI', SAVE IT AS THE RELATIVE RECORD E2000026C POINTER. E2000027C 4. READ THIS RECORD FROM THE USER FILE. IF ANY E2000028C ERRORS OCCUR, THE ERROR 'FILE MANAGER ERROR E2000029C WHEN ACCESSING FILE @@@@@@@@ ISTAT = $$$$' IS E2000030C OUTPUT AND CONTROL IS RETURNED TO THE CALLING E2000031C PROGRAM. E2000032C 5. IF THE RECORD HAS BEEN DELETED PROCESSING E2000033C CONTINUES IN STEP TWO ABOVE WHERE THE LINE E2000034C NUMBER IS INCREMENTED. E2000035C 6. CONTROL RETURNS TO THE CALLER. E2000036CS5 ENTRY/EXIT E2000037C ---------- E2000038CS3 THIS ROUTINE IS ENTERED FROM VARIOUS PROCESSORS. THE E2000039C NEXT LINE NUMBER MUST BE IN 'LINENO' AND 'ENDLIN' MUST E2000040C CONTAIN THE LAST LINE NUMBER DESIRED. E2000041C E2000042C EXIT CONDITIONS ARE: E2000043C 1. IF THE RECORD IS FOUND, THE RECORD WILL BE IN E2000044C 'FBUFFR'. THE LINE NUMBER WILL BE IN 'LINENO'. E2000045ÐÐC 2. IF NO RECORDS ARE FOUND OR IF 'ENDLIN' IS E2000046C EXCEEDED, THE LINE NUMBER WILL BE 'ENDLIN'+1. E2000047CS5 ERROR MESSAGES E2000048C ----- -------- E2000049CS3 THE FOLLOWING ERROR MESSAGE IS OUTPUT BY THIS ROUTINE. E2000050C EDITOR FILE MANAGER ERROR 334 E2000051C 'FILE MANAGER ERROR WHEN ACCESSING FILE @@@@@@@@ E2000052C ISTAT = $$$$' E2000053CS5 ENTRIES E2000054C ------- E2000055CS3 ENTRY POINT REFERENCED BY E2000056C ----- ----- ---------- -- E2000057C FNDNXT CHAPRO E2000058C DELPRO E2000059C LSTPRO E2000060C RSQPRO E2000061C SEAPRO E2000062CS5 EXTERNAL REFERENCES E2000063C -------- ---------- E2000064CS3 EXTERNAL EXTERNAL E2000065C FNDSLI READR E2000066C RETURN SAVE E2000067C SYSMSG E2000068C*** E2000069M EDITCM E2000070ÐÐ INTEGER FMER04 E2000071 DATA FMER04/334/ E2000072C SAVE ENTRY FOR RETURN E2000073 CALL SAVE(FNDNXT) E2000074C GET THE INDEX RECORD FOR THIS LINE E2000075 100 CALL FNDSLI E2000076C DID AN ERROR OCCUR E2000077 IF (IERRFG.NE.0) GO TO 9000 E2000078C IF THIS INDEX ENTRY IS ZERO, NO RECORD EXISTS E2000079C WITH THIS LINE NUMBER. GET THE NEXT LINE E2000080 IF (IS(LINIDX).NE.0) GO TO 300 E2000081C SET UP FOR THE NEXT LINE E2000082 200 LINENO=LINENO+1 E2000083C IF THE NEXT LINE IS GREATER THAN THE LAST LINE TO BE E2000084C PROCESSED, RETURN E2000085 IF (LINENO.LE.ENDLIN) GO TO 100 E2000086 GO TO 9000 E2000087C STORE THE RELATIVE RECORD POINTER IN THE CALL E2000088 300 NW(1)=0 E2000089 NW(2)=IS(LINIDX) E2000090C GET THIS RECORD. E2000091 CALL READR(REQBUF,FBUFFR,NW,ISTAT) E2000092C VERIFY THE STATUS OF THE FILE MANAGER CALL E2000093 IF (ISTAT.GE.0) GO TO 500 E2000094C PUT THE FILE NAME INTO ERROR E2000095ÐÐ 350 DO 400 IX=1,4 E2000096 IDATA(IX)=NAMFIL(IX) E2000097 400 CONTINUE E2000098C PUT THE STATUS INTO ERROR E2000099 IDATA(5)=ISTAT E2000100C OUTPUT THE ERROR - FILE MANAGER ERROR WHEN ACCESSING FILE @@@@@@@@E2000101C ISTAT = $ E2000102 CALL SYSMSG(FMER04,IDATA) E2000103C SET THE ERROR FLAG E2000104 IERRFG=1 E2000105 GO TO 9000 E2000106C HAS THE FIRST RECORD GOT THE FILE MANAGER DELETE CODE SET E2000107 500 IF (FBUFFR(1).EQ.IDELFG) GO TO 200 E2000108C FOUND THE RECORD E2000109 9000 CALL RETURN E2000110 RETURN E2000111 END E2000112 SUBROUTINE FNDSLI E2100001 1 /E21 F ITOS CCS 3.0 SL-149E2100002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO CALCULATE THE INDEX POSITION E2100003C CREDIT COLLECTION SYSTEM VERSION 3.0 E2100004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E2100005C COPYRIGHT CONTROL DATA CORPORATION 1978 E2100006C E2100007C*** E2100008ÐÐC FUNCTION E2100009C -------- E2100010C THE FUNCTION OF THIS PROGRAM IS TO CALCULATE THE E2100011C RECORD BLOCK AND WORD IN THE STATEMENT LABEL INDEX E2100012C FILE FOR THE SPECIFIED LINE NUMBER. E2100013CS5 GENERAL FLOW E2100014C ------- ---- E2100015CS3 THE FOLLOWING OPERATIONS ARE PERFORMED BY THIS ROUTINE. E2100016C 1. THE CORRECT BLOCK OF THE STATEMENT LABEL E2100017C INDEX FILE IS CALUCLATED BY DIVIDING THE LINE E2100018C NUMBER BY THE NUMBER OF ENTRIES IN A BLOCK E2100019C AND ADDING ONE E2100020C 2. THE WORD WITHIN THE BLOCK IS CALCULATED BY E2100021C MULTIPLYING THE BLOCK BY THE NUMBER OF ENTRIES E2100022C PER BLOCK, SUBTRACTING THE RESULT FROM THE E2100023C LINE NUMBER AND MULTIPLYING THAT RESULT BY E2100024C THE NUMBER OF WORDS FOR EACH ENTRY. E2100025C 3. CALL THE ROUTINE 'LOCATE' TO OBTAIN THE E2100026C APPROPRIATE ENTRY. E2100027C 4. RETURN TO THE CALLER. E2100028CS5 ENTRY/EXIT E2100029C ---------- E2100030CS3 THIS ROUTINE IS ENTERED FROM VARIOUS PROCESSORS AND E2100031C SUBPROCESSORS. THE LINE NUMBER IS IN 'LINENO'. THE E2100032C VALUES DEFINE DURING EDITOR INITIALIZATION ARE: E2100033ÐÐC IPGSIZ - THE NUMBER OF WORDS IN EACH FILE RECORD. E2100034C IENPLN - THE NUMBER OF WORDS IN EACH ENTRY. E2100035C E2100036C EXIT TO THE CALLING PROGRAM IS WITH INDEX TO THIS E2100037C ENTRY IN THE 'IS' ARRAY IN THE VARIABLE 'LINIDX'. E2100038CS5 ENTRIES E2100039C ------- E2100040CS3 ENTRY POINT REFERENCED BY E2100041C ----------- ---------- -- E2100042C FNDSLI AUTPRO E2100043C LINPRO E2100044C FNDEND E2100045C FNDNXT E2100046C SLIBLD E2100047CS5 EXTERNAL REFERENCES E2100048C -------- ---------- E2100049CS3 EXTERNAL EXTERNAL E2100050C -------- -------- E2100051C LOCATE RETURN E2100052C SAVE E2100053C*** E2100054M EDITCM E2100055C SAVE ENTRY FOR RETURN E2100056 CALL SAVE(FNDSLI) E2100057C GET CORRECT RELATIVE RECORD POINTER FOR THIS LINE NUMBER E2100058ÐÐ J=LINENO/IPGSIZ E2100059 IRRP=J+1 E2100060C GET CORRECT POSITION WITHIN THE BLOCK E2100061 IMADR=(LINENO-J*IPGSIZ)*IENPLN E2100062C CALL LOCATE TO FIND THE CORRECT ENTRY IN THE IS ARRAY E2100063C WHICH CORRESPONDS TO THIS LINE NUMBER ENTRY IN SLI FILE E2100064 CALL LOCATE E2100065 CALL RETURN E2100066 RETURN E2100067 END E2100068 SUBROUTINE GETAFD E2200001 1 /E22 F ITOS CCS 3.0 SL-149E2200002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO GET AN ASCII FIELD E2200003C CREDIT COLLECTION SYSTEM VERSION 3.0 E2200004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E2200005C COPYRIGHT CONTROL DATA CORPORATION 1978 E2200006C E2200007C*** E2200008C FUNCTION E2200009C -------- E2200010CS3 THE FUNCTION OF THIS PROGRAM IS TO EXTRACT AN ALPHA- E2200011C NUMERIC FIELD FROM THE COMMAND INPUT BUFFER. E2200012CS5 GENERAL FLOW E2200013C ------- ---- E2200014CS3 THE FOLLOWING OPERATIONS ARE PERFORMED BY THIS ROUTINE. E2200015ÐÐC 1. THE ALPHANUMERIC FIELD 'ALFFLD' IS INITIALIZED. E2200016C 2. IF THE END OF TEXT FLAG IS SET, CONTROL IS E2200017C RETURNED TO THE CALLING PROGRAM. E2200018C 3. IF THE LAST CHARACTER PROCESSED WAS NOT A E2200019C COMMA, THE ERROR MESSAGE 'INVALID FIELD' IS E2200020C OUTPUT AND CONTROL IS RETURNED TO THE CALLING E2200021C PROGRAM E2200022C 4. THE COMMA FLAG IS CLEARED. E2200023C 5. A DO LOOP IS SET UP TO EXTRACT UP TO SIX E2200024C CHARACTERS AND A FIELD TERMINATOR. E2200025C A. 'ELNSCN' IS CALLED TO EXTRACT THE NEXT E2200026C CHARACTER FROM THE FIELD. E2200027C B. IF THE CHARACTER IS THE END OF TEXT FLAG E2200028C CONTROL IS RETURNED TO THE CALLING PROGRAM. E2200029C C. IF THE CHARACTER IS A COMMA, THE COMMA E2200030C FLAG IS SET AND CONTROL IS RETURNED TO E2200031C THE CALLING PROGRAM. E2200032C D. IF THE BUFFER SIZE HAS BEEN EXCEEDED AND E2200033C NO FIELD TERMINATOR HAS BEEN FOUND, THE E2200034C ERROR MESSAGE 'INVALID FIELD' IS OUTPUT E2200035C AND CONTROL IS RETURNED TO THE CALLING E2200036C PROGRAM. E2200037C E. THE CORRECT WORD AND BYTE ARE CALCULATED. E2200038C THE CHARACTER IS STORED IN THE BUFFER E2200039C AND THE DO LOOP IS CONTINUED. E2200040ÐÐC 6. UPON COMPLETION OF THE DO LOOP, CONTROL IS E2200041C RETURNED TO THE CALLING PROGRAM. E2200042CS5 ENTRY/EXIT E2200043C ---------- E2200044CS3 THIS ROUTINE IS ENTERED FROM VARIOUS PROCESSORS. THE E2200045C FIELD TO BE PROCESSED IS IN THE COMMAND INPUT BUFFER E2200046C AND THE COMMA ENCOUNTERED FLAG MUST BE SET. E2200047C E2200048C EXIT FROM THIS ROUTINE IS WITH THE PROCESSED FIELD E2200049C IN 'ALFFLD'. IF NO FIELD IS ENCOUNTERED, 'ALFFLD' E2200050C WILL CONTAIN BLANKS. E2200051C IERRFG = 0 NO ERROR E2200052C + NON FATAL EDITOR ERROR. ANOTHER PROCESSOR E2200053C MAY BE ENTERED. E2200054C - FATAL EDITOR ERROR. THE EDITOR IS TERMIN- E2200055C ATED. E2200056CS5 ERROR MESSAGES E2200057C ----- -------- E2200058CS3 THE FOLLOWING ERROR MESSAGE IS OUTPUT BY THIS ROUTINE. E2200059C EDITOR ERROR 306 E2200060C 'INVALID FIELD' E2200061CS5 ENTRIES E2200062C ------- E2200063CS3 ENTRY POINT REFERENCED BY E2200064C ----- ----- ---------- -- E2200065ÐÐC GETAFD AUTPRO E2200066C STAPRO E2200067CS5 EXTERNAL REFERENCES E2200068C -------- ---------- E2200069CS3 EXTERNAL EXTERNAL E2200070C -------- -------- E2200071C ELNSCN RETURN E2200072C SAVE SET E2200073C SYSMSG E2200074C*** E2200075M EDITCM E2200076 INTEGER EDER06 E2200077 DATA EDER06/306/ E2200078C SAVE ENTRY FOR RETURN E2200079 CALL SAVE(GETAFD) E2200080C INITIALIZE THE FIELD BUFFER E2200081 CALL SET(ALFFLD,3,$2020) E2200082C IF END OF DATA FLAG IS SET, DON'T TRY TO GET ANY MORE E2200083 IF (ICHARC.LT.0) GO TO 9000 E2200084C WAS THE LAST CHARACTER A COMMA E2200085 IF (COMMAF.NE.0) GO TO 100 E2200086C THE FIELD IS INVALID E2200087C OUTPUT THE ERROR - INVALID FIELD E2200088 50 CALL SYSMSG(EDER06,IDATA) E2200089 IERRFG=1 E2200090ÐÐ GO TO 9000 E2200091C CLEAR THE COMMA FLAG E2200092 100 COMMAF=0 E2200093C GET THE NEXT 6 CHARACTERS AND A FIELD TERMINATOR E2200094 DO 200 IX=1,7 E2200095C GET THE NEXT CHARACTER E2200096 CALL ELNSCN E2200097C IS IT END OF DATA E2200098 IF (ICHARC.LT.0) GO TO 9000 E2200099C IS IT A COMMA E2200100 IF (ICHARC.NE.$2C) GO TO 125 E2200101C YES, SET THE COMMA FLAG E2200102 COMMAF=1 E2200103 GO TO 9000 E2200104C HAS THE BUFFER SIZE BEEN EXCEEDED AND NO TERMINATOR FOUND E2200105 125 IF (IX.EQ.7) GO TO 50 E2200106C DETERMINE WHICH HALF OF THE WORD IT GOES IN E2200107 IF (AND(IX,1).NE.0) GO TO 150 E2200108C THIS IS THE EVEN(LOWER) POSITION E2200109 IA=IX/2 E2200110C MASK FOR THE PROPER CHARACTER E2200111 ALFFLD(IA)=AND(ALFFLD(IA),$FF00) E2200112 GO TO 175 E2200113C THIS IS THE ODD(UPPER) POSITION E2200114 150 IA=IX/2+1 E2200115ÐÐC MASK FOR THE PROPER CHARACTER E2200116 ALFFLD(IA)=AND(ALFFLD(IA),$00FF) E2200117C SHIFT THE CHARACTER TO THE UPPER BYTE E2200118 ICHARC=ICHARC*$100 E2200119C STORE THE CHARACTER IN THE FIELD E2200120 175 ALFFLD(IA)=ALFFLD(IA)+ICHARC E2200121 200 CONTINUE E2200122 9000 CALL RETURN E2200123 RETURN E2200124 END E2200125 SUBROUTINE GETNAM E2300001 1 /E23 F ITOS CCS 3.0 SL-149E2300002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO GET A FILE NAME E2300003C CREDIT COLLECTION SYSTEM VERSION 3.0 E2300004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E2300005C COPYRIGHT CONTROL DATA CORPORATION 1978 E2300006C E2300007C*** E2300008C FUNCTION E2300009CS3 -------- E2300010C THE FUNCTION OF THIS PROGRAM IS TO EXTRACT THE FILE E2300011C NAME FROM THE COMMAND INPUT BUFFER. E2300012CS5 GENERAL FLOW E2300013C ------- ---- E2300014CS3 THE OPERATIONS PERFORMED BY THIS ROUTINE INCLUDE: E2300015ÐÐC 1. THE FILE NAME BUFFER 'NAMFIL' IS INITIALIZED. E2300016C 2. IF THE END OF TEXT FLAG IS SET, CONTROL IS E2300017C RETURNED TO THE CALLING PROGRAM. E2300018C 3. IF THE LAST CHARACTER PROCESSED WAS NOT A E2300019C COMMA, OUTPUT THE ERROR 'ILLEGAL FILE NAME' E2300020C AND RETURN CONTROL TO THE CALLING PROGRAM. E2300021C 4. THE COMMA FLAG IS CLEARED. E2300022C 5. A DO LOOP IS SET UP TO EXTRACT UP TO EIGHT E2300023C CHARACTERS AND A FIELD TERMINATOR. E2300024C A. 'ELNSCN' IS CALLED TO EXTRACT THE NEXT E2300025C CHARACTER FROM THE FIELD. E2300026C B. IF THE CHARACTER IS THE END OF TEXT FLAG E2300027C CONTROL IS RETURNED TO THE CALLING PROGRAM. E2300028C C. IF THE BUFFER SIZE HAS BEEN EXCEEDED AND E2300029C NO FIELD TERMINATOR HAS BEEN FOUND, THE E2300030C ERROR 'ILLEGAL FILE NAME' IS OUTPUT AND E2300031C CONTROL IS RETURNED TO THE CALLING PROGRAM. E2300032C D. IF NO FIELD IS ENTERED, OUTPUT THE ERROR E2300033C MESSAGE 'ILLEGAL FILE NAME' AND RETURN E2300034C CONTROL TO THE CALLING PROGRAM. E2300035C E. IF THE FIRST CHARACTER OF THE FILE NAME E2300036C IS A BLANK, OUTPUT THE ERROR MESSAGE E2300037C 'ILLEGAL FILE NAME' AND RETURN CONTROL E2300038C TO THE CALLING PROGRAM. E2300039C F. IF THE CHARACTER BEING PROCESSED IS E2300040ÐÐC BELOW $20 OR ABOVE $7E, THE ERROR MESSAGE E2300041C 'ILLEGAL FILE NAME' IS OUTPUT AND CONTROL E2300042C IS RETURNED TO THE CALLING PROGRAM. E2300043C G. IF THE CHARACTER BEING PROCESSED IS A E2300044C COMMA, THE COMMA ENCOUNTERED FLAG IS SET E2300045C AND CONTROL IS RETURNED TO THE CALLING E2300046C PROGRAM. E2300047C H. IF THIS IS A VALID CHARACTER, THE CORRECT E2300048C WORD AND BYTE ARE CALCULATED. THE CHAR- E2300049C ACTER IS STORED IN THE BUFFER AND THE E2300050C DO LOOP IS CONTINUED. E2300051C 6. UPON COMPLETION OF THE DO LOOP, CONTROL IS E2300052C RETURNED TO THE CALLING PROGRAM. E2300053CS5 ENTRY/EXIT E2300054C ---------- E2300055CS3 THIS ROUTINE IS ENTERED FROM VARIOUS PROCESSORS. THE E2300056C FIELD TO BE PROCESSED IS IN THE COMMAND INPUT BUFFER E2300057C AND THE COMMA ENCOUNTERED FLAG MUST BE SET. E2300058C E2300059C EXIT FROM THIS ROUTINE IS WITH THE PROCESSED FIELD E2300060C IN 'NAMFIL'. E2300061C IERRFG = 0 NO ERROR E2300062C + NON FATAL EDITOR ERROR. ANOTHER PROCESSOR E2300063C MAY BE ENTERED. E2300064C - FATAL EDITOR ERROR. THE EDITOR IS TERMIN- E2300065ÐÐC ATED. E2300066CS5 ERROR MESSAGES E2300067C ----- -------- E2300068CS3 THE FOLLOWING ERROR MESSAGE IS OUTPUT BY THIS ROUTINE. E2300069C EDITOR ERROR MESSAGE 305 E2300070C 'ILLEGAL FILE NAME' E2300071CS5 ENTRIES E2300072C ------- E2300073CS3 ENTRY POINT REFERENCED BY E2300074C ----- ----- ---------- -- E2300075C GETNAM GETPRO E2300076C SEQPRO E2300077CS5 EXTERNAL REFERENCES E2300078C -------- ---------- E2300079CS3 EXTERNAL EXTERNAL E2300080C -------- -------- E2300081C ELNSCN RETURN E2300082C SAVE SET E2300083C SYSMSG E2300084C*** E2300085M EDITCM E2300086 INTEGER EDER05 E2300087 DATA EDER05/305/ E2300088C SAVE ENTRY FOR RETURN E2300089 CALL SAVE(GETNAM) E2300090ÐÐC CLEAR FILE NAME E2300091 CALL SET(NAMFIL,4,$2020) E2300092C IF THE END OF TEXT FLAG IS SET, DON'T TRY TO GET ANY MORE E2300093 IF (ICHARC.LT.0) GO TO 9000 E2300094C WAS THE LAST CHARACTER CHECKED A COMMA. NO, ILLEGAL INPUT E2300095 IF (COMMAF.EQ.0) GO TO 300 E2300096C CLEAR COMMA FLAG E2300097 COMMAF=0 E2300098C INPUT UP TO 8 CHARACTERS FOR THE FILE NAME AND A TERMINATOR E2300099 DO 200 IX=1,9 E2300100C GET THE NEXT CHARACTER E2300101 CALL ELNSCN E2300102C IS THIS A DATA TERMINATOR E2300103 IF (ICHARC.LT.0) GO TO 9000 E2300104C ARE THERE TOO MANY CHARACTERS E2300105 IF (IX.EQ.9.AND.ICHARC.NE.$2C) GO TO 300 E2300106C IS THE FIRST CHARACTER A BLANK OR A COMMA E2300107 IF (IX.EQ.1.AND.ICHARC.EQ.$20.OR.IX.EQ.1.AND.ICHARC.EQ.$2C) E2300108 1GO TO 300 E2300109C IS THE CHARACTER VALID E2300110 IF (ICHARC.LT.$20.OR.ICHARC.GT.$7E) GO TO 300 E2300111C IS THE CHARACTER A COMMA E2300112 IF (ICHARC.EQ.$2C) GO TO 125 E2300113C IS THIS THE ODD OR EVEN CHARACTER POSITION E2300114 IF (AND(IX,1).NE.0) GO TO 150 E2300115ÐÐC THIS IS THE EVEN (LOWER) POSITION E2300116 IA=IX/2 E2300117C MASK OUT THE CHARACTER TO BE REPLACED E2300118 NAMFIL(IA)=AND(NAMFIL(IA),$FF00) E2300119 GO TO 175 E2300120C SET COMMA FLAG E2300121 125 COMMAF=1 E2300122C TERMINATE THE DO LOOP E2300123 GO TO 9000 E2300124C THIS IS THE ODD (UPPER) POSITION E2300125 150 IA=IX/2+1 E2300126C MASK OUT THE CHARACTER TO BE REPLACED E2300127 NAMFIL(IA)=AND(NAMFIL(IA),$00FF) E2300128C SHIFT THE CHARACTER TO THE UPPER BYTE E2300129 ICHARC=ICHARC*$100 E2300130C STORE THE CHARACTER IN THE FILE NAME ARRAY E2300131 175 NAMFIL(IA)=NAMFIL(IA)+ICHARC E2300132 200 CONTINUE E2300133 GO TO 9000 E2300134C OUTPUT THE ERROR - ILLEGAL FILE NAME E2300135 300 CALL SYSMSG(EDER05,IDATA) E2300136C SET THE ERROR FLAG E2300137 IERRFG=1 E2300138 9000 CALL RETURN E2300139 RETURN E2300140ÐÐ END E2300141 SUBROUTINE GETNUM E2400001 1 /E24 F ITOS CCS 3.0 SL-149E2400002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO GET A NUMERIC FIELD E2400003C CREDIT COLLECTION SYSTEM VERSION 3.0 E2400004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E2400005C COPYRIGHT CONTROL DATA CORPORATION 1978 E2400006C E2400007C*** E2400008C FUNCTION E2400009C -------- E2400010CS3 THE FUNCTION OF THIS PROGRAM IS TO EXTRACT AN ASCII E2400011C NUMERIC FIELD AND CONVERT IT TO HEXADECIMAL. E2400012CS5 GENERAL FLOW E2400013C ------- ---- E2400014CS3 THE OPERATIONS PERFORMED BY THIS ROUTINE INCLUDE: E2400015C 1. INITIALIZE THE FIELDS FOR RAW ASCII NUMBER, E2400016C RIGHT JUSTIFIED ASCII NUMBER AND CONVERTED E2400017C HEXADECIMAL NUMBER. E2400018C 2. IF THE END OF TEXT FLAG IS SET, RETURN CONTROL E2400019C TO THE CALLING PROGRAM. E2400020C 3. IF THE COMMA ENCOUNTERED FLAG IS NOT SET, OUT- E2400021C PUT THE ERROR MESSAGE 'INVALID FIELD' AND E2400022C RETURN TO THE CALLING PROGRAM E2400023C 4. CLEAR THE COMMA ENCOUNTERED FLAG. E2400024ÐÐC 5. SET UP A DO LOOP TO GET UP TO 6 CHARACTERS E2400025C AND A FIELD TERMINATOR. E2400026C A. CALL 'ELNSCN' TO GET THE NEXT CHARACTER. E2400027C B. IF THE CHARACTER IS THE END OF TEXT FLAG, E2400028C TERMINATE THE DO LOOP. E2400029C C. IF THE CHARACTER IS A COMMA, SET THE E2400030C COMMA ENCOUNTERED FLAG AND TERMINATE THE E2400031C DO LOOP. E2400032C D. IF THE CHARACTER IS NOT NUMERIC (0-9), E2400033C OUTPUT THE ERROR MESSAGE 'INVALID NUMERIC E2400034C FIELD' AND RETURN TO THE CALLING PROGRAM. E2400035C E. IF THIS IS THE 7TH CHARACTER AND IT IS E2400036C NOT A FIELD TERMINATOR (COMMA OR END OF E2400037C TEXT), OUTPUT THE ERROR MESSAGE 'INVALID E2400038C NUMERIC FIELD' AND RETURN TO THE CALLING E2400039C PROGRAM. E2400040C F. CALCULATE THE WORD AND BYTE IN THE RAW E2400041C ASCII NUMBER BUFFER (NUMFLD) AND STORE E2400042C THIS CHARACTER. CONTINUE THE DO LOOP E2400043C FOR THE NEXT CHARACTER. E2400044C 6. SET UP A DO LOOP TO MOVE THE RAW ASCII NUMBER E2400045C TO THE RIGHT-JUSTIFIED ASCII NUMBER BUFFER E2400046C (NUMBER). E2400047C A. CALCULATE THE CORRECT WORD AND BYTE E2400048C TO EXTRACT A CHARACTER FROM THE E2400049ÐÐC RAW ASCII NUMBER BUFFER STARTING FROM E2400050C THE RIGHT-MOST CHARACTER POSITION WORKING E2400051C TO THE LEFT. E2400052C B. IF THE CHARACTER IS THE BACKGROUND CHAR- E2400053C ACTER ($FF) CONTINUE THE DO LOOP FOR THE E2400054C NEXT CHARACTER E2400055C C. IF THERE IS A CHARACTER, CALCULATE THE E2400056C CORRECT WORD AND BYTE IN THE RIGHT-JUSTI- E2400057C FIED ASCII NUMBER BUFFER TO STORE THIS E2400058C CHARACTER. E2400059C D. CONTINUE THE DO LOOP FOR THE NEXT CHAR- E2400060C ACTER. E2400061C 7. CONVERT THE RIGHT-JUSTIFIED ASCII NUMBER TO E2400062C HEXADECIMAL. E2400063C 8. RETURN TO THE CALLING PROGRAM. E2400064CS5 ENTRY/EXIT E2400065C ---------- E2400066CS3 THIS ROUTINE IS ENTERED FROM VARIOUS PROCESSORS. THE E2400067C FIELD TO BE PROCESSED IS IN THE COMMAND INPUT BUFFER E2400068C AND THE COMMA ENCOUNTERED FLAG MUST BE SET. E2400069C E2400070C EXIT FROM THIS ROUTINE IS WITH THE PROCESSED FIELD E2400071C CONVERTED TO HEXADECIMAL IN 'NUMHEX'. E2400072C IERRFG = 0 NO ERROR E2400073C + NON-FATAL EDITOR ERROR. ANOTHER PROCESSOR E2400074ÐÐC MAY BE ENTERED. E2400075C - FATAL EDITOR ERROR. THE EDITOR IS TERMIN- E2400076C ATED. E2400077CS5 ERROR MESSAGES E2400078C ----- -------- E2400079CS3 THE FOLLOWING ERROR MESSAGES ARE OUTPUT BY THIS ROUTINE. E2400080C EDITOR ERROR MESSAGE 306 E2400081C 'INVALID FIELD' E2400082C EDITOR ERROR MESSAGE 307 E2400083C 'INVALID NUMERIC FIELD' E2400084CS5 ENTRIES E2400085C ------- E2400086CS3 ENTRY POINT REFERENCED BY E2400087C ----- ----- ---------- -- E2400088C GETNUM AUTPRO E2400089C CHAPRO E2400090C DELPRO E2400091C LSTPRO E2400092C RSQPRO E2400093C SEAPRO E2400094C SEQPRO E2400095C STAPRO E2400096CS5 EXTERNAL REFERENCES E2400097C -------- ---------- E2400098CS3 EXTERNAL EXTERNAL E2400099ÐÐC -------- -------- E2400100C DECHEX ELNSCN E2400101C RETURN SAVE E2400102C SET SYSMSG E2400103C*** E2400104M EDITCM E2400105 INTEGER EDER06 E2400106 INTEGER EDER07 E2400107 DATA EDER06/306/ E2400108 DATA EDER07/307/ E2400109C SAVE ENTRY FOR RETURN E2400110 CALL SAVE(GETNUM) E2400111C INITIALIZE STORAGE AREAS E2400112 CALL SET(NUMFLD,3,$FFFF) E2400113 CALL SET(NUMBER,3,$3030) E2400114 NUMHEX=0 E2400115C IF THE TEXT BUFFER IS ALREADY AT THE END DON'T TRY TO GET MORE E2400116 IF (ICHARC.LT.0) GO TO 9000 E2400117C IF THE LAST CHARACTER PROCESSED WASN'T A COMMA E2400118C THIS IS AN INVALID FIELD E2400119 IF (COMMAF.EQ.0) GO TO 600 E2400120C CLEAR COMMA FLAG E2400121 COMMAF=0 E2400122C GET UP TO 6 CHARACTERS AND A COMMA OR END OF TEXT E2400123 DO 200 IX=1,7 E2400124ÐÐ CALL ELNSCN E2400125C VALIDATE THE CHARACTER E2400126C IS THIS END OF TEXT E2400127 IF (ICHARC.LT.0) GO TO 300 E2400128C IS THIS A COMMA E2400129 IF (ICHARC.EQ.$2C) GO TO 250 E2400130C IS THIS A VALID CHARACTER E2400131 IF (ICHARC.LT.$30.OR.ICHARC.GT.$39) GO TO 700 E2400132C IF THE CHARACTER IS VALID, IS THE INDEX VALID E2400133 IF (IX.EQ.7) GO TO 700 E2400134C PUT THE CHARACTER INTO THE BUFFER E2400135C CALCULATE THE STORAGE INDEX E2400136 IWRDIX=(IX+1)/2 E2400137C IS THIS THE ODD (UPPER BYTE) CHARACTER E2400138 IF (AND(IX,1).NE.0) GO TO 150 E2400139C THIS IS THE EVEN (LOWER BYTE) CHARACTER E2400140C STORE IT IN THE BUFFER E2400141 NUMFLD(IWRDIX)=AND(NUMFLD(IWRDIX),$FF00)+ICHARC E2400142 GO TO 200 E2400143C THIS IS THE ODD (UPPER BYTE) CHARACTER E2400144 150 NUMFLD(IWRDIX)=AND(NUMFLD(IWRDIX),$00FF)+ICHARC*$100 E2400145 200 CONTINUE E2400146C TOO MANY CHARACTERS IN THE FIELD E2400147 GO TO 700 E2400148C SET THE COMMA FLAG E2400149ÐÐ 250 COMMAF=1 E2400150C RIGHT-JUSTIFY THE NUMERIC FIELD FOR CONVERSION E2400151 300 J=6 E2400152 DO 500 IX=6,1,-1 E2400153C CALCULATE THE INDEX FOR THE FIELD TO BE MOVED E2400154 IWRDIX=(IX+1)/2 E2400155C IS THIS THE ODD (UPPER BYTE) CHARACTER E2400156 IF (AND(IX,1).NE.0) GO TO 350 E2400157C THIS IS THE EVEN (LOWER BYTE) CHARACTER E2400158C IS THE CHARACTER BACKGROUND ($FF) E2400159 IF (AND(NUMFLD(IWRDIX),$00FF).EQ.$FF) GO TO 500 E2400160 ICHAR=AND(NUMFLD(IWRDIX),$007F) E2400161 GO TO 425 E2400162C THIS IS THE ODD (UPPER BYTE) CHARACTER E2400163C IS THE CHARACTER BACKGROUND ($FF) E2400164 350 IF (AND(NUMFLD(IWRDIX),$FF00).EQ.$FF00) GO TO 500 E2400165 ICHAR=AND(NUMFLD(IWRDIX),$7F00)/$100 E2400166C THIS IS A VALID CHARACTER TO MAKE UP THE VALUE TO BE CONVERTED E2400167C STORE RIGHT-JUSTIFIED IN THE CONVERSION FIELD E2400168C CALCULATE THE INDEX FOR THE CONVERSION FIELD E2400169 425 IDXWRD=(J+1)/2 E2400170C DOES THIS CHARACTER GO INTO THE UPPER OR LOWER BYTE E2400171 IF (AND(J,1).NE.0) GO TO 450 E2400172C THIS IS THE EVEN (LOWER BYTE) CHARACTER E2400173 NUMBER(IDXWRD)=AND(NUMBER(IDXWRD),$FF00)+ICHAR E2400174ÐÐ GO TO 475 E2400175C THIS IS THE ODD (UPPER BYTE) CHARACTER E2400176 450 NUMBER(IDXWRD)=AND(NUMBER(IDXWRD),$00FF)+ICHAR*$100 E2400177C DECREMENT THE INDEX FOR THE CONVERSION FIELD E2400178 475 J=J-1 E2400179 500 CONTINUE E2400180C CONVERT THE NUMBER TO HEX E2400181 CALL DECHEX(NUMBER,NUMHEX) E2400182 GO TO 9000 E2400183C OUTPUT THE ERROR - INVALID FIELD E2400184 600 CALL SYSMSG(EDER06,IDATA) E2400185 GO TO 900 E2400186C OUTPUT THE ERROR - INVALID NUMERIC FIELD E2400187 700 CALL SYSMSG(EDER07,IDATA) E2400188C SET THE ERROR FLAG E2400189 900 IERRFG=1 E2400190 9000 CALL RETURN E2400191 RETURN E2400192 END E2400193 SUBROUTINE GETONE E2500001 1 /E25 F ITOS CCS 3.0 SL-149E2500002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO GET A ONE CHARACTER FIELD E2500003C CREDIT COLLECTION SYSTEM VERSION 3.0 E2500004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E2500005C COPYRIGHT CONTROL DATA CORPORATION 1978 E2500006ÐÐC E2500007C*** E2500008C FUNCTION E2500009C -------- E2500010CS3 THE FUNCTION OF THIS ROUTINE IS TO EXTRACT A ONE E2500011C CHARACTER FIELD. E2500012CS5 GENERAL FLOW E2500013C ------- ---- E2500014CS3 THE FOLLOWING OPERATIONS ARE PERFORMED BY THIS ROUTINE E2500015C 1. THE FIRST CHARACTER FLAG AND THE CHARACTER E2500016C STORAGE LOCATION ARE INITIALIZED. E2500017C 2. IF THE END OF TEXT FLAG IS SET, SET THE CHARACTER E2500018C TO SPACE AND RETURN TO THE CALLING PROGRAM E2500019C 3. IF THE COMMA ENCOUNTERED FLAG IS NOT SET, E2500020C OUTPUT THE ERROR MESSAGE 'INVALID FIELD' AND E2500021C RETURN TO THE CALLING PROGRAM. E2500022C 4. CLEAR THE COMMA ENCOUNTERED FLAG. E2500023C 5. GET THE NEXT CHARACTER. E2500024C A. IF THIS IS THE FIRST CHARACTER, SET THE E2500025C FIRST CHARACTER FLAG. IF THE CHARACTER E2500026C IS A COMMA, PERFORM THE SAME LOGIC FOR E2500027C THE COMMA AS THE SECOND CHARACTER. IF E2500028C IT IS NOT A COMMA, IS THE END OF TEXT E2500029C FLAG SET. IF IT IS SET, PERFORM THE E2500030C SAME LOGIC FOR END OF TEXT AS IS DONE E2500031ÐÐC IF END OF TEXT IS SET AT THE ENTRY TO E2500032C THE PROGRAM. IF END OF TEXT IS NOT SET E2500033C SAVE THE CHARACTER AND GET THE NEXT E2500034C CHARACTER E2500035C B. IF IT IS THE SECOND CHARACTER AND IT IS E2500036C A COMMA, SET THE COMMA ENCOUNTERED FLAG. E2500037C C. IF THE END OF TEXT FLAG IS SET, IS THE E2500038C CHARACTER SET TO A SPACE. IF IT IS NOT E2500039C SET IT TO A SPACE. RETURN TO THE CALLING E2500040C PROGRAM. E2500041C D. IF THE COMMA ENCOUNTERED FLAG IS NOT SET E2500042C OUTPUT THE ERROR MESSAGE 'INVALID FIELD', E2500043C SET THE ERROR FLAG AND RETURN TO THE E2500044C CALLING PROGRAM. E2500045C 6. RETURN TO THE CALLING PROGRAM. E2500046CS5 ENTRY/EXIT E2500047C ---------- E2500048CS3 ENTRY TO THIS ROUTINE IS FROM VARIOUS PROCESSORS. THE E2500049C FIELD TO BE PROCESSED IS IN THE COMMAND INPUT BUFFER E2500050C AND THE COMMA ENCOUNTERED FLAG MUST BE SET. E2500051C E2500052C EXIT FROM THIS ROUTINE IS WITH THE PROCESSED FIELD E2500053C IN ASCII IN 'GOTCHR'. E2500054C IERRFG = 0 NO ERROR E2500055C + NON FATAL EDITOR ERROR. ANOTHER PROCESSOR E2500056ÐÐC MAY BE ENTERED. E2500057C - FATAL EDITOR ERROR. THE EDITOR IS TERMIN- E2500058C ATED. E2500059CS5 ERROR MESSAGES E2500060C ----- -------- E2500061CS3 THE FOLLOWING ERROR MESSAGE IS OUTPUT BY THIS ROUTINE. E2500062C EDITOR ERROR MESSAGE 306 E2500063C 'INVALID FIELD' E2500064CS5 ENTRIES E2500065C ------- E2500066CS3 ENTRY POINT REFERENCED BY E2500067C ----- ----- ---------- -- E2500068C GETONE AUTPRO E2500069C GETPRO E2500070C LINPRO E2500071C SEQPRO E2500072CS5 EXTERNAL REFERENCES E2500073C -------- ---------- E2500074CS3 EXTERNAL EXTERNAL E2500075C -------- -------- E2500076C ELNSCN RETURN E2500077C SAVE SYSMSG E2500078C*** E2500079M EDITCM E2500080 INTEGER EDER06 E2500081ÐÐ DATA EDER06/306/ E2500082C SAVE ENTRY FOR RETURN E2500083 CALL SAVE(GETONE) E2500084C INITIALIZE FIRST CHARACTER FLAG E2500085 FRSTIM=0 E2500086C CLEAR CHARACTER STORAGE E2500087 GOTCHR=0 E2500088C IF THE END OF TEXT FLAG IS SET, DON'T TRY TO GET ANY MORE E2500089 IF (ICHARC.GE.0) GO TO 50 E2500090 25 GOTCHR=$20 E2500091 GO TO 9000 E2500092C WAS THE LAST CHARACTER CHECKED A COMMA E2500093 50 IF (COMMAF.EQ.0) GO TO 300 E2500094C CLEAR COMMA FLAG E2500095 COMMAF=0 E2500096C GET THE NEXT CHARACTER E2500097 100 CALL ELNSCN E2500098C IS THIS THE FIRST CHARACTER E2500099 IF (FRSTIM.NE.0) GO TO 200 E2500100C SET FIRST CHARACTER PROCESSED FLAG E2500101 FRSTIM=1 E2500102C IS THIS CHARACTER A COMMA E2500103 IF (ICHARC.EQ.$2C) GO TO 200 E2500104C HAS A DATA TERMINATOR BEEN ENCOUNTERED E2500105 IF (ICHARC.LT.0) GO TO 25 E2500106ÐÐC PUT CHARACTER INTO CHARACTER STORAGE E2500107 GOTCHR=ICHARC E2500108 GO TO 100 E2500109C IF THIS CHARACTER IS A COMMA, SET THE COMMA FLAG E2500110 200 IF (ICHARC.EQ.$2C) COMMAF=1 E2500111C WAS THIS THE END OF THE DATA E2500112 IF (ICHARC.LT.0) GO TO 250 E2500113C IF THERE HASN'T BEEN A COMMA, THIS IS A BAD COMMAND E2500114 IF (COMMAF.NE.1) GO TO 300 E2500115C IF CHARACTER IS ZERO, MAKE IT A SPACE E2500116 250 IF (GOTCHR.EQ.0) GOTCHR=$20 E2500117 GO TO 9000 E2500118C OUTPUT THE ERROR - INVALID FIELD E2500119 300 CALL SYSMSG (EDER06,IDATA) E2500120C SET THE ERROR FLAG E2500121 IERRFG=1 E2500122 9000 CALL RETURN E2500123 RETURN E2500124 END E2500125 SUBROUTINE GETSTR E2600001 1 /E26 F ITOS CCS 3.0 SL-149E2600002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO GET A CHARACTER STRING E2600003C CREDIT COLLECTION SYSTEM VERSION 3.0 E2600004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E2600005C COPYRIGHT CONTROL DATA CORPORATION 1978 E2600006ÐÐC E2600007C*** E2600008C FUNCTION E2600009C --------- E2600010CS3 THE FUNCTION OF THIS PROGRAM IS TO EXTRACT THE DEFINED E2600011C CHARACTER STRING FROM THE INPUT BUFFER. E2600012CS5 GENERAL FLOW E2600013C ------- ---- E2600014CS3 THE FOLLOWING OPERATIONS ARE PERFORMED BY THIS ROUTINE: E2600015C 1. THE CHARACTER STRING BUFFER 'STRBF1' IS CLEARED. E2600016C 2. IF THE END OF TEXT FLAG IS SET, THE ERROR E2600017C MESSAGE 'INVALID COMMAND' IS OUTPUT, THE ERROR E2600018C FLAG IS SET AND CONTROL IS RETURNED TO THE E2600019C CALLING PROGRAM. E2600020C 3. IF THE COMMA FLAG IS NOT SET, THE ERROR MESSAGE E2600021C 'INVALID COMMAND' IS OUTPUT, THE ERROR FLAG IS E2600022C SET AND CONTROL RETURNS TO THE CALLING PROGRAM. E2600023C 4. CLEAR THE COMMA ENCOUNTERED FLAG. E2600024C 5. GET THE NEXT CHARACTER AS THE DELIMITER E2600025C CHARACTER. IF IT IS THE END OF TEXT FLAG, E2600026C OUTPUT THE ERROR MESSAGE 'INVALID COMMAND', E2600027C SET THE ERROR FLAG AND RETURN TO THE CALLING E2600028C PROGRAM E2600029C IF IT IS A COMMA, OUTPUT THE ERROR MESSAGE E2600030C 'INVALID DELIMITER', SET THE ERROR FLAG AND E2600031ÐÐC RETURN TO THE CALLING PROGRAM. E2600032C IF IT IS A VALID ASCII CHARACTER BETWEEN $20 E2600033C AND $5F, SAVE THE CHARACTER AS THE DELIMITER. E2600034C OTHERWISE OUTPUT THE ERROR MESSAGE 'INVALID E2600035C DELIMITER, SET THE ERROR FLAG AND RETURN TO E2600036C THE CALLING PROGRAM. E2600037C 6. SET UP A DO LOOP TO GET THE NEXT 20 CHARACTERS E2600038C AND A DELIMITER. E2600039C A. CALL 'ELNSCN' TO GET THE NEXT CHARACTER. E2600040C B. IF THE CHARACTER IS THE END OF TEXT FLAG E2600041C OR A COMMA AND NO TERMINATING DELIMITER E2600042C HAS BEEN ENCOUNTERED. OUTPUT THE ERROR E2600043C MESSAGE 'DELIMITER MISSING', SET THE E2600044C ERROR FLAG AND RETURN TO THE CALLING E2600045C PROGRAM. E2600046C C. IF THE CHARACTER IS A DELIMITER CHARACTER E2600047C THE DO LOOP IS EXITED. E2600048C D. IF IT IS NOT A DELIMITER A CHECK IS MADE E2600049C TO SEE IF THIS IS THE 21ST CHARACTER. E2600050C IF IT IS, THE ERROR MESSAGE 'CHARACTER E2600051C STRING TOO LONG' IS OUTPUT, THE ERROR E2600052C FLAG IS SET AND CONTROL RETURNS TO THE E2600053C CALLING PROGRAM. OTHERWISE THE CHARACTER E2600054C IS STORED IN THE STRING BUFFER. THE E2600055C PROGRAM THEN LOOPS BACK FOR THE NEXT E2600056ÐÐC CHARACTER. E2600057C 7. WHEN THE DO LOOP IS TERMINATED UPON ENCOUNTER- E2600058C ING THE TERMINATING DELIMITER, THE NEXT CHAR- E2600059C ACTER IS OBTAINED. IF IT IS AN END OF TEXT E2600060C CHARACTER, CONTROL IS RETURNED TO THE CALLING E2600061C PROGRAM. IF THE CHARACTER IS A COMMA, THE E2600062C COMMA ENCOUNTERED FLAG IS SET AND CONTROL E2600063C RETURNS TO THE CALLING PROGRAM. IF THE E2600064C CHARACTER IS ANYTHING ELSE, THE ERROR MESSAGE E2600065C 'INVALID FIELD' IS OUTPUT, THE ERROR FLAG IS E2600066C SET AND CONTROL RETURNS TO THE CALLING PROGRAM. E2600067CS5 ENTRY/EXIT E2600068C ---------- E2600069CS3 THIS ROUTINE IS ENTERED FROM THE ROUTINES 'CHAPRO' AND E2600070C 'SEAPRO'. THE CHARACTER STRING, PRECEEDED AND FOLLOWED E2600071C BY DELIMITER CHARACTERS, MUST BE IN THE COMMAND INPUT E2600072C BUFFER AND THE COMMA ENCOUNTERED FLAG MUST BE SET. E2600073C E2600074C EXIT IS WITH THE CHARACTER STRING CHARACTERS STORED E2600075C IN 'STRBF1', ONE CHARACTER PER WORD. E2600076C IERRFG = 0 NO ERRORS E2600077C + NON FATAL EDITOR ERROR. ANOTHER PROCESSOR E2600078C MAY BE ENTERED. E2600079C - FATAL EDITOR ERROR. THE EDITOR IS TERMIN- E2600080C ATED. E2600081ÐÐC IS=LENGTH OF THIS STRING E2600082C E2600083CS5 ERROR MESSAGES E2600084C ----- -------- E2600085CS3 THE FOLLOWING ERROR MESSAGES ARE OUTPUT BY THIS ROUTINE: E2600086C EDITOR ERROR 306 E2600087C 'INVALID FIELD' E2600088C EDITOR ERROR 309 E2600089C 'INVALID COMMAND' E2600090C EDITOR ERROR 315 E2600091C 'INVALID DELIMITER' E2600092C EDITOR ERROR 316 E2600093C 'DELIMITER MISSING' E2600094C EDITOR ERROR 317 E2600095C 'CHARACTER STRING TOO LONG' E2600096CS5 ENTRIES E2600097C ------- E2600098CS3 ENTRY POINT REFERENCED BY E2600099C ----- ----- ---------- -- E2600100C GETSTR CHAPRO E2600101C SEAPRO E2600102CS5 EXTERNAL REFERENCES E2600103C -------- ---------- E2600104CS3 EXTERNAL EXTERNAL E2600105C -------- -------- E2600106ÐÐC ELNSCN RETURN E2600107C SAVE SET E2600108C SYSMSG E2600109C*** E2600110M EDITCM E2600111 INTEGER EDER06 E2600112 INTEGER EDER09 E2600113 INTEGER EDER15 E2600114 INTEGER EDER16 E2600115 INTEGER EDER17 E2600116 DATA EDER06/306/ E2600117 DATA EDER09/309/ E2600118 DATA EDER15/315/ E2600119 DATA EDER16/316/ E2600120 DATA EDER17/317/ E2600121C SAVE ENTRY FOR RETURN E2600122 CALL SAVE(GETSTR) E2600123C CLEAR THE CHARACTER STRING BUFFER E2600124 CALL SET(STRBF1,20,0) E2600125C CHECK THE OUT OF DATA FLAG E2600126 IF (ICHARC.GE.0) GO TO 100 E2600127C OUTPUT THE ERROR - INVALID COMMAND E2600128 25 CALL SYSMSG(EDER09,IDATA) E2600129C SET THE ERROR FLAG E2600130 50 IERRFG=1 E2600131ÐÐ GO TO 9000 E2600132C WAS THE LAST CHARACTER A COMMA E2600133 100 IF (COMMAF.EQ.0) GO TO 25 E2600134C CLEAR THE COMMA FLAG AND EXPECT A COMMA FLAG E2600135 COMMAF=0 E2600136C GET THE DELIMITER CHARACTER E2600137 CALL ELNSCN E2600138C IS THE OUT OF DATA FLAG SET E2600139 IF (ICHARC.LT.0) GO TO 25 E2600140C A COMMA IS AN INVALID DELIMETER E2600141 IF (ICHARC.EQ.$2C) GO TO 200 E2600142C MAKE SURE IT IS A VALID CHARACTER E2600143 IF (ICHARC.GE.$21.AND.ICHARC.LE.$5F) GO TO 300 E2600144C OUTPUT THE ERROR - INVALID DELIMIER E2600145 200 CALL SYSMSG(EDER15,IDATA) E2600146 GO TO 50 E2600147C SAVE THIS CHARACTER AS THE DELIMITER E2600148 300 IDELIM=ICHARC E2600149C GET UP TO 20 CHARACTERS AS A STRING AND A DELIMITER E2600150 DO 600 IX=1,21 E2600151C GET THE NEXT CHARACTER E2600152 CALL ELNSCN E2600153C IF THE OUT OF DATA FLAG IS SET, THERE WAS NO DELIMITER E2600154C OR IF THE CHARACTER WAS A COMMA E2600155 IF (ICHARC.GE.0.OR.ICHARC.NE.$2C) GO TO 400 E2600156ÐÐC OUTPUT THE ERROR - DELIMITER MISSING E2600157 CALL SYSMSG(EDER16,IDATA) E2600158 GO TO 50 E2600159C IS THE CHARACTER THE TERMINATING DELIMITER E2600160 400 IF (ICHARC.EQ.IDELIM) GO TO 700 E2600161C IF THIS IS THE 21ST CHARACTER AND NOT THE DELIMITER E2600162C THE CHARACTER STRING IS TOO LONG E2600163 IF (IX.LT.21) GO TO 500 E2600164C OUTPUT THE ERROR - CHARACTER STRING TOO LONG E2600165 450 CALL SYSMSG(EDER17,IDATA) E2600166 GO TO 50 E2600167C THIS IS A CHARACTER TO SAVE AS PART OF THE STRING E2600168 500 STRBF1(IX)=ICHARC E2600169 600 CONTINUE E2600170 GO TO 450 E2600171C GET THE NEXT CHARACTER, EITHER A COMMA OR OUT OF DATA E2600172 700 CALL ELNSCN E2600173 IF (ICHARC.LT.0) GO TO 9000 E2600174C IF IT IS A COMMA, SET THE COMMA FLAG E2600175 IF (ICHARC.NE.$2C) GO TO 750 E2600176 COMMAF=1 E2600177 GO TO 9000 E2600178C OUTPUT THE ERROR - INVALID FIELD E2600179 750 CALL SYSMSG(EDER06,IDATA) E2600180 GO TO 50 E2600181ÐÐ 9000 CALL RETURN E2600182 RETURN E2600183 END E2600184 SUBROUTINE HEXDEC(NUM,IOUT) E2700001 1 /E27 F ITOS CCS 3.0 SL-149E2700002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO CONVERT HEX TO DECIMAL ASCII E2700003C CREDIT COLLECTION SYSTEM VERSION 3.0 E2700004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E2700005C COPYRIGHT CONTROL DATA CORPORATION 1978 E2700006C E2700007C E2700008C** FUNCTION E2700009C -------- E2700010CS3 HEXDEC CONVERTS A HEXADECIMAL NUMBER INTO AN ASCII E2700011C DECIMAL NUMBER. E2700012CS5 GENERAL DESCRIPTION E2700013C ------------------- E2700014CS3 HEXDEC BLANKS OUT THE OUTPUT BUFFER, IOUT. THE E2700015C SUBROUTINE THEN TESTS THE HEX NUMBER FOR ZERO. IF E2700016C THE NUMBER IS ZERO, AN ASCII ZERO IS MOVED TO THE E2700017C RIGHT BYTE OF THE THIRD WORD OF IOUT. IF THE E2700018C NUMBER IS NOT ZERO AND IS NEGATIVE AN ASCII MINUS E2700019C SIGN IS PLACED IN THE LEFT BYTE OF THE FIRST WORD E2700020C OF IOUT AND THE HEX NUMBER IS COMPLIMENTED. AT E2700021C THIS POINT ANOTHER TEST FOR ZERO IS MADE. IF THE E2700022ÐÐC NUMBER IS ZERO, NO CONVERSION TAKES PLACE, E2700023C OTHERWISE THE HEX NUMBER IS CONVERTED TO AN ASCII E2700024C DECIMAL NUMBER. E2700025CE ENTRY/EXIT E2700026C ---------- E2700027CS3 HEXDEC IS ENTERED WITH THE HEX NUMBER IN NUM AND E2700028C EXITS WITH THE CONVERTED NUMBER IN IOUT. E2700029CS5 ENTRIES E2700030C ------- E2700031CS3 ENTRY POINT REFERENCED BY E2700032C ----- ----- ---------- -- E2700033C HEXDEC EXEC2 E2700034C QHSLOG E2700035C ITSERR E2700036C TSTART E2700037C NEWS E2700038C EDITOR E2700039C TSUTIL E2700040C TSUT07 E2700041C OPCLOS E2700042C START E2700043CS5 EXTERNAL REFERENCES E2700044C -------- ---------- E2700045CS3 EXTERNAL EXTERNAL E2700046C -------- -------- E2700047ÐÐC Q8PKUP Q8PREP E2700048C SET E2700049C E2700050 BYTE (ILEFT,IOUT(15=8)),(IRIGHT,IOUT(7=0)) E2700051 DIMENSION ILEFT(1),IRIGHT(1),IOUT(1) E2700052C SAVE NUMBER IN N BEFORE CONVERTING TO ALLOW CONVERSION IN PLACE. E2700053 N=NUM E2700054 CALL SET(IOUT,3,$3030) E2700055 IF(N.EQ.0) IRIGHT(3)=$30 E2700056 IF(N.GE.0) GO TO 50 E2700057C MINUS NUMBER E2700058 N=-N E2700059 ILEFT(1)=$2D E270006050 CONTINUE E2700061 I=5 E270006255 CONTINUE E2700063 IF(N.EQ.0) GO TO 200 E2700064 N1=(N/10)*10 E2700065 N2=N-N1+$30 E2700066 I1=I/2+1 E2700067 IF(AND(I,1).EQ.0) GO TO 100 E2700068 IRIGHT(I1)=N2 E2700069 GO TO 110 E2700070100 ILEFT(I1)=N2 E2700071110 CONTINUE E2700072ÐÐ N=N/10 E2700073 I=I-1 E2700074 IF(I.GT.0) GO TO 55 E2700075200 CONTINUE E2700076 RETURN E2700077 END E2700078 SUBROUTINE LOCATE E2800001 1 /E28 F ITOS CCS 3.0 SL-149E2800002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO LOCATE A LINE ENTRY IN IS ARYE2800003C CREDIT COLLECTION SYSTEM VERSION 3.0 E2800004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E2800005C COPYRIGHT CONTROL DATA CORPORATION 1978 E2800006C E2800007C LOCATE RETURNS THE POINTER TO THE VIRTUAL PAGE IN REAL STORAGE E2800008C NOTE: THIS IS A SERIALLY REENTRANT FUNCTION. E2800009C E2800010C E2800011C** FUNCTION E2800012C -------- E2800013CS3 LOCATE RETURNS THE POINTER TO THE VIRTUAL PAGE IN E2800014C REAL STORAGE. E2800015CS5 GENERAL DESCRIPTION E2800016C ------- ----------- E2800017CS3 LOCATE RETURNS THE INDEX I1 WHICH POINTS TO THE E2800018C DESIRED LOCATION IN THE 'IS' ARRAY. THE 'IS' ARRAY E2800019ÐÐC IS SEARCHED FOR THE PAGE CONTAINING THE DESIRED E2800020C INFORMATION. IF THE PAGE IS NOT FOUND IN MEMORY E2800021C THE LEAST RECENTLY USED PAGE IS WRITTEN OUT AND THE E2800022C DESIRED PAGE IS READ IN. THE INDEX I1 IS THEN E2800023C CALCULATED AND PLACED IN I1 AND ILOCAT, AND THE E2800024C REFERENCE COUNTER IS UPDATED. E2800025CE ENTRY/EXIT E2800026C ---------- E2800027CS3 LOCATE IS ENTERED WITH THE BASE RECORD BLOCK IN THE E2800028C STATEMENT LABEL INDEX FILE (IRRP) AND A VALUE FOR READ- E2800029C WRITE FLAG (IMODE) WHERE WRITE = 1. THE RECORD POSITION E2800030C WITHIN THE BLOCK IS IN IMADR. EXIT IS WITH THE DESIRED E2800031C RECORD BLOCK IN CORE AND WITH THE INDEX TO THE E2800032C LOCATION IN I1,ILOCAT,AND LINIDX. E2800033CS5 ENTRIES E2800034C ------- E2800035CS3 ENTRY POINT E2800036C ----- ----- E2800037C LOCATE E2800038CS5 EXTERNAL REFERENCES E2800039C -------- ---------- E2800040CS3 EXTERNAL EXTERNAL E2800041C -------- -------- E2800042C Q8STPN Q8PKUP E2800043C Q8PREP LOKFIL E2800044ÐÐC STODIR STOIDX E2800045C RTVIDX SET E2800046C E2800047M EDITCM E2800048 INTEGER FMER07 E2800049 DATA FMER07/7/ E2800050C SAVE ENTRY FOR RETURN E2800051 CALL SAVE(LOCATE) E2800052C IS ARRAY REQUIRES 384 WORDS PER PAGE PLUS 4 MORE FOR THE HEADER. E2800053C IS ARRAY CONTAINS: E2800054C HEADER AREA, SIZE IS NOPAGS. EACH ENTRY IS 4 WORDS. E2800055C +0:RELATIVE RECORD POINTER IN SLITFXX FILE E2800056C +1:FREQUENCY COUNTER E2800057C +2:WRITTEN INTO FLAG E2800058C +3:RELATIVE SECTOR NUMBER E2800059C E2800060C DATA AREA: 384 WORDS FOR EACH ENTRY (4 SECTORS FROM MASS MEMORY) E2800061C 2. DATA AREA - E2800062C +0: WORD 0 OF PAGE E2800063C : E2800064C : E2800065C : E2800066C : E2800067C +383: WORD 383 OF PAGE E2800068C CHECK IF THIS REQUEST IS IN THE E2800069ÐÐC SAME SECTOR AS LAST REQUEST. E2800070C IF SO, SKIP SEARCH LOGIC E2800071C ASSUMES THAT IREF IS SET FROM E2800072C LAST SEARCH. E2800073 IF (IRRP.EQ.IMADRL) GO TO 400 E2800074C RETRIEVE DESIRED RECORD FROM VIRTUAL MEMORY FILE. E2800075C THIS PORTION OF THE CODE SEARCHES THE 'IS' ARRAY FOR THE SECTOR E2800076C CONTAINING THE DESIRED INFORMATION. IF NOT IN MEMORY. IT WRITES E2800077C OUT THE LEAST USED SECTOR AND READS IN THE DESIRED SECTOR. E2800078C E2800079C STEP 1. LOOK THRU THE IS ARRAY FOR SECTOR ISEC E2800080C E2800081 DO 101 IREF=1,NOPAGS,4 E2800082C SEE IF ISEC SECTOR IS IN CORE. E2800083 IF (IS(IREF).EQ.IRRP) GO TO 400 E2800084101 CONTINUE E2800085C NOT FOUND IN MEMORY LOOK FOR A PAGE TO REPLACE. E2800086 NOREF = 32767 E2800087 ILEAST = 1 E2800088C E2800089C STEP 2. LOOK FOR A PAGE TO REPLACE E2800090C E2800091C E2800092C PUNISH ALL PAGES CURRENTLY IN CORE BY ONE REFERENCE TO CAUSE E2800093C THE LEAST ACTIVE PAGES TO BECOME CANDIDATES FOR A NEW PAGE E2800094ÐÐC LOOK FOR THE LEAST REFERENCED PAGE E2800095 HIREF=255 E2800096 DO 104 J=1,NOPAGS,4 E2800097C DECAY THE VALUES OF THE NUMBER OF REFERENCES . E2800098 IS(J+1)=IS(J+1)-5 E2800099C PREVENT FREQUENCY COUNTER FROM GOING NEGATIVE E2800100 IF(IS(J+1).LT.0) IS(J+1)=0 E2800101 ISREF=IS(J+1) E2800102C E2800103C SAVE LEAST REFERENCED PAGE IN ILEAST. E2800104C SAVE IT'S FREQUENCY IN NOREF. E2800105 IF(ISREF.GE.NOREF) GO TO 103 E2800106 NOREF=ISREF E2800107 ILEAST = J E2800108C FIND THE MOST FREQUENTLY REFERENCED PAGE . PUT IN HIREF E2800109C RETAIN THE MOST FREQUENTLY REFERENCED PAGE'S COUNTER TO BE E2800110C USED TO INITIALIZE THE NEW PAGE'S FREQUENCY COUNTER E2800111103 IF(ISREF.GE.HIREF)HIREF=ISREF E2800112104 CONTINUE E2800113C E2800114C STEP 3. E2800115C E2800116 IREF = ILEAST E2800117 ID=IPGSIZ*(IREF/4)+NOPAGS+1 E2800118C IF THE SECTOR THAT IS BEING REPLACED WAS NOT MODIFIED E2800119ÐÐC OMIT WRITING IT ONTO MASS STORAGE BY SETTING ITS ADDRESS NEGATIVE.E2800120C THE ILLEGAL ADDRESS CHECK BELOW WILL CAUSE THE WRITE TO BE SKIPPEDE2800121C E2800122 IF(IS(IREF+2).EQ.0) IS(IREF) =-1 E2800123C E2800124C E2800125C PUT RELATIVE RECORD POINTER INTO REQUEST BUFFER E2800126 SLRQBF(16)=0 E2800127 SLRQBF(17)=IS(IREF) E2800128C NEW SECTOR ADDRESS INTO HEADER WORD 0 E2800129 IS(IREF)=IRRP E2800130C SET FREQUENCY COUNTER E2800131 IS(IREF+1)=HIREF E2800132C CLEAR WRITTEN INTO FLAG E2800133 IS(IREF+2) = 0 E2800134C DO NOT WRITE IF ILLEGAL ADDRESS. E2800135C NOTE: THIS CHECK IS ALSO USED TO AVOID WRITING AN UNMODIFIED PAGE E2800136 IF (SLRQBF(17).LE.0) GO TO 200 E2800137C WRITE OUT THIS LEAST REFERENCED PAGE E2800138 CALL UPDREC(SLRQBF,IS(ID),ISTAT) E2800139C VERIFY THE STATUS OF THE FILE MANAGER E2800140 IF (ISTAT.GE.0) GO TO 200 E2800141C AN ERROR OCCURRED IN THE STATEMENT LABEL INDEX FILE E2800142C ABORT THIS RUN OF THE EDITOR E2800143 150 IDATA(1)=ISTAT E2800144ÐÐ CALL SYSMSG(FMER07,IDATA) E2800145 IERRFG=$8000 E2800146 GO TO 9000 E2800147200 CONTINUE E2800148C HAS THE HIGHEST RECORD BLOCK USED SO FAR BEEN EXCEEDED E2800149 IF (IRRP.LT.IHIRRP) GO TO 300 E2800150C SAVE THE TWO WORDS THAT FOLLOW THIS BLOCK OF THE IS-ARRAY E2800151 IDUMB=ID+IPGSIZ E2800152 ISSAVE(1)=IS(IDUMB) E2800153 ISSAVE(2)=IS(IDUMB+1) E2800154C CLEAR THIS AREA OF THE IS-ARRAY E2800155 CALL SET(IS(ID),IPGSIZ,0) E2800156C CLEAR ALL RECORD BLOCKS IN THE FILE UP TO AND INCLUDING THIS ONE E2800157 DO 305 IZ=IHIRRP,IRRP E2800158C SET THE RELATIVE RECORD POINTER FOR THIS RECORD E2800159 SLRQBF(17)=IZ E2800160C WRITE ZEROS TO THIS RECORD E2800161 CALL PUTS(SLRQBF,IS(ID),1,ISTAT) E2800162C VERIFY THE STATUS OF THE FILE MANAGER E2800163 IF (ISTAT.GE.0) GO TO 305 E2800164C HAVE ALL RECORDS BEEN WRITTEN INTO YET E2800165 IF (AND(ISTAT,$1000).NE.0) GO TO 305 E2800166C SOMETHING IS WRONG E2800167 GO TO 150 E2800168 305 CONTINUE E2800169ÐÐC SET THE NEW HIGHEST RELATIVE RECORD POINTER E2800170 IHIRRP=IRRP E2800171C RESTORE THE 2 WORDS FOLLOWING THIS BLOCK OF THE IS-ARRAY E2800172 IS(IDUMB)=ISSAVE(1) E2800173 IS(IDUMB+1)=ISSAVE(2) E2800174C E2800175C STEP 4. READ IN DESIRED SECTOR INTO IS E2800176C E2800177 300 NW(1)=0 E2800178 NW(2)=IRRP E2800179 CALL READR(SLRQBF,IS(ID),NW,ISTAT) E2800180C VERIFY THE STATUS OF THE FILE MANAGER E2800181 IF (ISTAT.GE.0) GO TO 400 E2800182C IS THE END OF FILE BIT SET E2800183 IF (AND(ISTAT,$0100).NE.0) GO TO 400 E2800184 GO TO 150 E2800185C E2800186C ALLOW OTHER USERS TO BREAK IN IF TIMESLICE IS UP. E2800187O CALL BREAK E2800188C E2800189 400 CONTINUE E2800190C CALCULATE THE OFF SET WITHIN THE PAGE E2800191 ID = IPGSIZ*(IREF/4)+NOPAGS+1 E2800192 I1=IMADR+ID E2800193C UPDATE REFERENCE COUNTER. E2800194ÐÐC REWARD WRITE OPERATIONS MORE THAN READS. E2800195 IS(IREF+1) =IS(IREF+1)+1+10*IMODE E2800196C IF WRITE OPERATION, SET THE WRITTEN INTO FLAG E2800197 IF (IMODE.EQ.1) IS(IREF+2)=1 E2800198 IMADRL=IRRP E2800199 ILOCAT=I1 E2800200 LINIDX=I1 E2800201 9000 CALL RETURN E2800202 RETURN E2800203 END E2800204 SUBROUTINE SETAUT E2900001 1 /E29 F ITOS CCS 3.0 SL-149E2900002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO SET UP FOR AUTOMATIC TABBING E2900003C CREDIT COLLECTION SYSTEM VERSION 3.0 E2900004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E2900005C COPYRIGHT CONTROL DATA CORPORATION 1978 E2900006C E2900007C*** E2900008C FUNCTION E2900009C -------- E2900010CS3 THE FUNCTION OF THIS PROGRAM IS TO SET UP FOR THE E2900011C AUTOMATIC TAB FUNCTION. E2900012CS5 GENERAL FLOW E2900013C ------- ---- E2900014CS3 THE FOLLOWING OPERATIONS ARE PERFORMED BY THIS ROUTINE. E2900015ÐÐC 1. THE TAB FUNCTION INDEX IS CLEARED. E2900016C 2. FORMAT SPECIFICATION TYPE VALIDATION. E2900017C A. IF THE FORMAT TYPE IS RPG ARRAY DATA E2900018C ($2A - *) MAKE SURE THIS IS AN RPG TYPE E2900019C FILE OR AN UNDEFINED FILE TYPE. IF IT E2900020C IS NOT, OUTPUT THE ERROR MESSAGE 'WRONG E2900021C FORMAT TYPE FOR THIS FILE', SET THE E2900022C ERROR FLAG AND RETURN TO THE CALLING E2900023C PROGRAM. IF IT IS AN RPG FILE OR AN E2900024C UNDEFINED FILE SET THE FILE TYPE INDICATOR E2900025C (FCBBUF(87)) TO RPG TYPE (2). MAKE SURE E2900026C THE NEXT LINE IS WITHIN THE DEFINED RPG E2900027C ARRAY DATA AREA. IF IT IS NOT, OUTPUT E2900028C THE ERROR 'ILLEGAL LINE NUMBER ##### E2900029C SPECIFIED', SET THE ERROR FLAG AND RETURN E2900030C TO THE CALLING PROGRAM. IF NO RPG ARRAY E2900031C DATA AREA EXISTS, SET THIS LINE AS THAT E2900032C AREA STARTING LINE. PROCEED TO THE NON- E2900033C RPG TAB SET UP. E2900034C B. IF THE FORMAT TYPE IS NON-RPG ($20 - BLANK) E2900035C MAKE SURE THIS IS A NON-RPG TYPE FILE OR E2900036C AN UNDEFINED FILE TYPE. IF IT IS NOT, E2900037C OUTPUT THE ERROR MESSAGE 'WRONG FORMAT E2900038C TYPE FOR THIS FILE', SET THE ERROR FLAG E2900039C AND RETURN TO THE CALLING PROGRAM. IF E2900040ÐÐC IT IS A NON RPG FILE OR AN UNDEFINED E2900041C FILE, SET THE FILE TYPE INDICATOR E2900042C (FCBBUF(87)) TO NON RPG TYPE (1). E2900043C PROCEED AT THE NON RPG TAB SET UP. E2900044C C. IF THE FORMAT TYPE IS NOT NON RPG, SEE E2900045C IF THE FILE IS A RPG TYPE OR AN UNDEFINED E2900046C FILE TYPE. IF IT IS NOT AN RPG FILE E2900047C TYPE OUTPUT THE ERROR MESSAGE 'WRONG E2900048C FORMAT TYPE FOR THIS FILE', SET THE E2900049C ERROR FLAG AND RETURN TO THE CALLING E2900050C PROGRAM. IF IT IS AN RPG TYPE FILE E2900051C OR AN UNDEFINED FILE TYPE, SET THE E2900052C FILE TYPE INDICATOR (FCBBUF(87)) TO E2900053C RPG FILE TYPE (2). PROCEED AT THE RPG E2900054C TAB SET UP. E2900055C 3. TAB SET UP VALIDATION E2900056C A. NON RPG TAB SET UP. E2900057C 1. CALL 'CTAPRO' TO SET UP TAB POSITIONS E2900058C FOR NON RPG FORMAT. E2900059C 2. SET THE TAB FUNCTION INDEX TO ZERO. E2900060C 3. RETURN TO THE CALLING PROGRAM. E2900061C B. RPG TAB SET UP. E2900062C 1. SET TAB FUNCTION INDEX FOR APPROPR- E2900063C IATE TAB SETTING. E2900064C FORMAT TYPE H = 1 E2900065ÐÐC FORMAT TYPE F = 2 E2900066C FORMAT TYPE E = 3 E2900067C FORMAT TYPE L = 4 E2900068C FORMAT TYPE I = 5 E2900069C FORMAT TYPE C = 6 E2900070C FORMAT TYPE O = 7 E2900071C FORMAT TYPE X = 8 E2900072C 2. IF THE TAB FUNCTION INDEX IS STILL E2900073C ZERO, AN UNDEFINED FORMAT TYPE HAS E2900074C BEEN ENTERED. OUTPUT THE ERROR E2900075C 'INVALID FORMAT SPECIFICATION ENTERED' E2900076C SET THE ERROR FLAG AND RETURN TO E2900077C THE CALLING PROGRAM E2900078C 3. CALL 'SETTAB' TO SET UP THE CORRECT E2900079C TAB STOPS FOR THIS FORMAT SPECIFICA- E2900080C TION. E2900081C 4. RETURN TO THE CALLING PROGRAM. E2900082CS5 ENTRY/EXIT E2900083C ---------- E2900084CS3 ENTRY TO THIS ROUTINE IS FROM VARIOUS PROCESSORS. E2900085C 'FORMTP' MUST CONTAIN THE FORMAT TYPE CHARACTER AND E2900086C THE FCB FOR THE FILE REQUESTED MUST BE IN CORE. E2900087C E2900088C EXIT IS WITH 'TABBUF' SET TO THE CORRECT TAB STOP E2900089C POSITIONS, 'TABIDX' SET TO THE INDEX FOR THIS TAB E2900090ÐÐC FUNCTION TYPE AND 'FCBBUF(87)' SET TO THE CORRECT E2900091C FILE TYPE. E2900092C IERRFG = 0 NO ERRORS E2900093C + NON FATAL EDITOR ERROR. ANOTHER PROCESSOR E2900094C MAY BE ENTERED. E2900095C - FATAL EDITOR ERROR. THE EDITOR IS TERMIN E2900096C ATED. E2900097CS5 ERROR MESSAGES E2900098C ----- -------- E2900099CS3 THE FOLLOWING ERROR MESSAGES ARE OUTPUT BY THIS ROUTINE E2900100C EDITOR ERROR 301 E2900101C 'INVALID LINE NUMBER ##### SPECIFIED' E2900102C EDITOR ERROR 310 E2900103C 'WRONG FORMAT TYPE FOR THIS FILE' E2900104C EDITOR ERROR 311 E2900105C 'INVALID FORMAT SPECIFICATION ENTERED' E2900106CS5 ENTRIES E2900107C ------- E2900108CS3 ENTRY POINT REFERENCED BY E2900109C ----- ----- ---------- -- E2900110C SETAUT AUTPRO E2900111C LINPRO E2900112C STAPRO E2900113CS5 EXTERNAL REFERENCES E2900114C -------- ---------- E2900115ÐÐCS3 EXTERNAL EXTERNAL E2900116C -------- -------- E2900117C CTAPRO RETURN E2900118C SAVE SETTAB E2900119C SYSMSG E2900120C*** E2900121M EDITCM E2900122 INTEGER EDER01 E2900123 INTEGER EDER10 E2900124 INTEGER EDER11 E2900125 DATA EDER01/301/ E2900126 DATA EDER10/310/ E2900127 DATA EDER11/311/ E2900128C SAVE ENTRY FOR RETURN E2900129 CALL SAVE(SETAUT) E2900130C CLEAR THE TAB INDEX E2900131 TABIDX=0 E2900132C IS THIS RPG ARRAY DATA ENTRY ENTRY E2900133 IF (FORMTP.EQ.$2A) GO TO 200 E2900134C IS THIS AN RPG FILE E2900135 IF (FORMTP.NE.$20) GO TO 400 E2900136C THIS IS A NON-RPG FILE IS IT ALREADY DEFINED AS AN RPG FILE E2900137 IF (FCBBUF(87).EQ.1.OR.FCBBUF(87).EQ.0) GO TO 100 E2900138C FILE TYPE IS INCORRECT E2900139C OUTPUT THE ERROR - WRONG FORMAT TYPE FOR THIS FILE E2900140ÐÐ 50 CALL SYSMSG(EDER10,IDATA) E2900141 75 IERRFG=1 E2900142 GO TO 9000 E2900143C THIS IS TO BE A NON-RPG TYPE FILE, SET THE INDICATOR E2900144 100 FCBBUF(87)=1 E2900145C CLEAR ANY PREVIOUS TAB STOPS E2900146C SET A TAB IN POSITION 1 ONLY E2900147 150 CALL CTAPRO E2900148 TABIDX=0 E2900149 GO TO 9000 E2900150C THIS IS AN RPG FILE WITH AN RPG ARRAY DATA FORMAT SPEC E2900151C MAKE SURE THIS IS AN RPG FILE E2900152 200 IF (FCBBUF(87).EQ.2.OR.FCBBUF(87).EQ.0) GO TO 300 E2900153 GO TO 50 E2900154C THIS IS TO BE AN RPG FILE, SET THE INDICATOR E2900155 300 FCBBUF(87)=2 E2900156C IS THIS BASE LINE ABOVE THE BASE LINE OF RPG ARRAY DATA E2900157 IF (FCBBUF(86).EQ.0.OR.LINENO.GE.FCBBUF(86)) GO TO 350 E2900158C THIS LINE NUMBER IS IN VALID E2900159 IDATA(1)=0 E2900160 IDATA(2)=LINENO E2900161C OUTPUT THE ERROR - INVALID LINE NUMBER ##### E2900162 CALL SYSMSG(EDER01,IDATA) E2900163 GO TO 75 E2900164C SET THE BASE FOR RPG ARRAY DATA IF THERE ISN'T ONE ALREADY E2900165ÐÐ 350 IF (FCBBUF(86).EQ.0) FCBBUF(86)=LINENO E2900166C GO SET THE TABS FOR NON-RPG TYPE FORMAT E2900167 GO TO 150 E2900168C THIS IS AN RPG FILE, IS IT ALREADY DEFINED AS A NON-RPG FILE E2900169 400 IF (FCBBUF(87).EQ.2.OR.FCBBUF(87).EQ.0) GO TO 450 E2900170 GO TO 50 E2900171C SET FILE TYPE TO RPG E2900172 450 FCBBUF(87)=2 E2900173C SET THE TAB INDEX TO THE APPROPRIATE ENTRY FOR THIS FORMAT TYPE E2900174 IF (FORMTP.EQ.$48) TABIDX=1 E2900175 IF (FORMTP.EQ.$46) TABIDX=2 E2900176 IF (FORMTP.EQ.$45) TABIDX=3 E2900177 IF (FORMTP.EQ.$4C) TABIDX=4 E2900178 IF (FORMTP.EQ.$49) TABIDX=5 E2900179 IF (FORMTP.EQ.$43) TABIDX=6 E2900180 IF (FORMTP.EQ.$4F) TABIDX=7 E2900181 IF (FORMTP.EQ.$58) TABIDX=8 E2900182C IF THE FORMAT SPEC IS UNDEFINED, OUTPUT AN ERROR E2900183 IF (TABIDX.NE.0) GO TO 500 E2900184C OUTPUT THE ERROR -INVALID FORMAT SPECIFICATION ENTERED E2900185 CALL SYSMSG(EDER11,IDATA) E2900186 GO TO 75 E2900187C SET THE TAB STOPS BASED ON THIS INDEX E2900188 500 CALL SETTAB E2900189 9000 CALL RETURN E2900190ÐÐ RETURN E2900191 END E2900192 SUBROUTINE SETTAB E3000001 1 /E30 F ITOS CCS 3.0 SL-149E3000002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO INITIALIZE TAB POSITIONS E3000003C CREDIT COLLECTION SYSTEM VERSION 3.0 E3000004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E3000005C COPYRIGHT CONTROL DATA CORPORATION 1978 E3000006C E3000007C*** E3000008C FUNCTION E3000009C -------- E3000010CS3 THE FUNCTION OF THIS PROGRAM IS TO STORE TAB STOP E3000011C POSITIONS IN THE TAB STOP BUFFER. E3000012CS5 GENERAL FLOW E3000013C ------- ---- E3000014CS3 DEPENDING ON THE VALUE OF 'TABIDX' THE FOLLOWING TAB E3000015C STOP POSITIONS ARE STORED IN 'TABBUF'. E3000016CS1 'TABIDX'=1 H FORMAT SPECIFICATION E3000017C 'TABBUF'=7,15,21,26,41,43,48,75 E3000018CS1 'TABIDX'=2 F FORMAT SPECIFICATION E3000019C 'TABBUF'=7,15,24,39,53,60,66,75 E3000020CS1 'TABIDX'=3 E FORMAT SPECIFICATION E3000021C 'TABBUF'=7,11,19,27,40,43,46,52,55,58,75 E3000022CS1 'TABIDX'=4 L FORMAT SPECIFICATION E3000023ÐÐC 'TABBUF'=7,15,8,20,23,25,28,30,33,35,38,40,43,45,48 E3000024C 50,53,75 E3000025CS1 'TABIDX'=5 I FORMAT SPECIFICATION E3000026C 'TABBUF'=7,15,21,28,35,42,52,59,75 E3000027CS1 'TABIDX'=6 C FORMAT SPECIFICATION E3000028C 'TABBUF'=7,18,28,33,43,49,54,60,75 E3000029CS1 'TABIDX'=7 O FORMAT SPECIFICATION E3000030C 'TABBUF'=7,15,23,32,38,45,75 E3000031CS1 'TABIDX'=8 X FORMAT SPECIFICATION E3000032C 'TABBUF'=8,10,20,27,75 E3000033CS5 ENTRY/EXIT E3000034C ---------- E3000035CS3 ENTRY TO THIS ROUTINE IS FORM 'SETAUT'. TABIDX MUST E3000036C CONTAIN THE CORRECT TAB FUNCTION INDEX SETTING. E3000037C E3000038C EXIT IS WITH 'TABBUF' SET TO THE CORRECT TAB SETTINGS E3000039C FOR THE SPECIFIED FORMAT TYPE. E3000040C IERRFG = 0 NO ERRORS E3000041C + NON FATAL EDITOR ERROR. ANOTHER PROCESSOR E3000042C MAY BE ENTERED. E3000043C - FATAL EDITOR ERROR. THE EDITOR IS TERMIN- E3000044C ATED. E3000045CS5 ENTRIES E3000046C ------- E3000047CS3 ENTRY POINT REFERENCED BY E3000048ÐÐC ----- ----- ---------- -- E3000049C SETTAB SETAUT E3000050CS5 EXTERNAL REFERENCES E3000051C -------- ---------- E3000052CS3 EXTERNAL EXTERNAL E3000053C -------- -------- E3000054C RETURN SAVE E3000055C*** E3000056M EDITCM E3000057 DIMENSION ITABS(160) E3000058 DIMENSION IHFORM(20) E3000059 DIMENSION IFFORM(20) E3000060 DIMENSION IEFORM(20) E3000061 DIMENSION ILFORM(20) E3000062 DIMENSION IIFORM(20) E3000063 DIMENSION ICFORM(20) E3000064 DIMENSION IOFORM(20) E3000065 DIMENSION IXFORM(20) E3000066 EQUIVALENCE(IHFORM(1),ITABS(1)) E3000067 EQUIVALENCE(IFFORM(1),ITABS(21)) E3000068 EQUIVALENCE(IEFORM(1),ITABS(41)) E3000069 EQUIVALENCE(ILFORM(1),ITABS(61)) E3000070 EQUIVALENCE(IIFORM(1),ITABS(81)) E3000071 EQUIVALENCE(ICFORM(1),ITABS(101)) E3000072 EQUIVALENCE(IOFORM(1),ITABS(121)) E3000073ÐÐ EQUIVALENCE (IXFORM(1),ITABS(141)) E3000074 DATA (IHFORM(I),I=1,20)/7,15,21,26,41,43,48,75,0,0,0,0,0,0,0,0,0,0E3000075 1,0,0/ E3000076 DATA (IFFORM(I),I=1,20)/7,15,19,24,39,53,60,66,75,0,0,0,0,0,0,0,0,E3000077 10,0,0/ E3000078 DATA (IEFORM(I),I=1,20)/7,11,19,27,40,43,46,52,55,58,75,0,0,0,0,0,E3000079 10,0,0,0/ E3000080 DATA (ILFORM(I),I=1,20)/7,15,18,20,23,25,28,30,33,35,38,40,43,45,4E3000081 18,50,53,75,0,0/ E3000082 DATA (IIFORM(I),I=1,20)/7,15,21,28,35,42,52,59,75,0,0,0,0,0,0,0,0,E3000083 10,0,0/ E3000084 DATA (ICFORM(I),I=1,20)/7,18,28,33,43,49,54,60,75,0,0,0,0,0,0,0,0,E3000085 10,0,0/ E3000086 DATA (IOFORM(I),I=1,20)/7,15,23,32,38,45,75,0,0,0,0,0,0,0,0,0,0,0,E3000087 10,0/ E3000088 DATA (IXFORM(I),I=1,20)/8,10,20,27,75,0,0,0,0,0,0,0,0,0,0,0,0,0,0,E3000089 10/ E3000090C SAVE ENTRY FOR RETURN E3000091 CALL SAVE(SETTAB) E3000092C CALCULATE THE APPROPRIATE POSITION IN ITABS FOR E3000093C THIS FORMAT TYPE E3000094 IZ=(TABIDX-1)*20 E3000095C MOVE THIS TAB STOP SETUP INTO THE TAB STOP BUFFER E3000096 DO 100 IX=1,20 E3000097 IDUMB=IX+IZ E3000098ÐÐ TABBUF(IX)=ITABS(IDUMB) E3000099 100 CONTINUE E3000100 CALL RETURN E3000101 RETURN E3000102 END E3000103 SUBROUTINE SLIBLD E3100001 1 /E31 F ITOS CCS 3.0 SL-149E3100002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO BUILD THE INDEX DIRECTORY E3100003C CREDIT COLLECTION SYSTEM VERSION 3.0 E3100004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E3100005C COPYRIGHT CONTROL DATA CORPORATION 1978 E3100006C E3100007C*** E3100008C FUNCTION E3100009C -------- E3100010CS3 THE FUNCTION OF THIS PROGRAM IS TO BUILD THE STATEMENT E3100011C LABEL INDEX FILE FOR THE OPEN USER FILE. E3100012CS5 GENERAL FLOW E3100013C ------- ---- E3100014CS3 THE FOLLOWING OPERATIONS ARE PERFORMED BY THIS ROUTINE. E3100015C 1. THE RPG ARRAY DATA FLAG (FCBBUF(86)) IS CLEARED. E3100016C 2. SET THE FLAG FOR 'LOCATE' TO WRITE. E3100017C 3. INITIALIZE THE RELATIVE RECORD POINTER. E3100018C 4. READ THE NEXT BLOCK OF RECORDS FROM THE USER E3100019C FILE. E3100020ÐÐC 5. VERIFY THE STATUS OF THE FILE MANAGER. IF AN E3100021C ERROR OCCURS, IS IT AN END OF FILE AND NO DATA E3100022C READ. IF IT IS GO TO THE SECTION TO BLANK FILL E3100023C ANY UNUSED RECORDS. IF NOT, PUT THE FILE NAME E3100024C IN THE ERROR BUFFER, OUTPUT THE ERROR MESSAGE E3100025C 'FILE MANAGER ERROR WHEN READING FILE @@@@@@@@ E3100026C ISTAT = $$$$', SET THE ERROR FLAG AND RETURN E3100027C TO THE CALLING PROGRAM. E3100028C 6. GET THE ACTUAL NUMBER OF RECORDS READ FROM THE E3100029C FCB (FCBBUF(15)). E3100030C 7. IF THE FIRST RECORD IS ALL BLANK THE FILE MUST E3100031C BE EMPTY. BECAUSE THESE ARE SEQUENTIALLY E3100032C STORED FILES, THE FIRST DATA RECORD WILL BE E3100033C THE FIRST RECORD. IF THE FIRST RECORD IS A E3100034C RECORD WITH 80 BLANKS, IT MUST BE A DIRECT E3100035C FILE WITH NO ACTUAL DATA IN IT. IN THIS CASE E3100036C THE BUILDING OF THE DIRECTORY FILE CAN BE E3100037C SKIPPED. RETURN TO THE CALLING PROGRAM. E3100038C 8. IF THERE IS DATA IN THE FIRST RECORD, SET UP E3100039C A DO LOOP TO FIND THE LINE NUMBER IN EACH E3100040C RECORD. E3100041C A. CALCULATE THE INDEX TO THE FIRST WORD OF E3100042C THE NEXT RECORD. E3100043C B. IF THIS RECORD HAS BEEN DELETED, INCRE- E3100044C MENT THE RELATIVE RECORD POINTER AND E3100045ÐÐC CONTINUE THE DO LOOP. E3100046C C. IF THIS RECORD IS AN END OF FILE INDICATOR E3100047C RETURN TO THE CALLING PROGRAM. E3100048C D. LINE NUMBER LOCATION E3100049C 1. IF THIS IS A NON-RPG FILE, EXTRACT E3100050C THE LINE NUMBER FROM POSITIONS 75 - E3100051C 80 OF THE RECORD. E3100052C 2. IF THE FIRST WORD OF THE RECORD IS E3100053C THE RPG ARRAY DATA INDICATOR ($2A2A), E3100054C SET THE RPG ARRAY DATA INDICATOR IF E3100055C IT IS NOT ALREADY SET E3100056C LINE NUMBER FROM POSITIONS 75 - 80 E3100057C OF THE RECORD. E3100058C OR AN RPG END OF FILE INDICATOR ($2F2A) E3100059C 3. IF THIS IS AN RPG FILE AND THE RPG E3100060C ARRAY DATA FLAG IS SET, EXTRACT THE E3100061C LINE NUMBER FROM POSITIONS 75 - 80 E3100062C OF THE RECORD. OTHERWISE, EXTRACT E3100063C THE LINE NUMBER FROM POSITIONS 1 - 5 E3100064C OF THE RECORD. E3100065C E. CONVERT THE EXTRACTED LINE NUMBER TO E3100066C HEXADECIMAL. IF AN ERROR OCCURRED DURING E3100067C CONVERSION, RETURN TO THE CALLING PROGRAM. E3100068C F. IF THIS IS THE FIRST RPG ARRAY DATA RECORD E3100069C SAVE THIS LINE NUMBER AS THE FIRST RECORD E3100070ÐÐC OF ARRAY DATA (FCBBUF(86)). E3100071C G. IF THE LINE NUMBER IS GREATER THAN 32767 E3100072C OUTPUT THE ERROR MESSAGE 'ILLEGAL LINE E3100073C NUMBER ##### SPECIFIED, SET THE ERROR E3100074C FLAG AND RETURN TO THE CALLING PROGRAM. E3100075C H. IF THIS IS THE HIGHEST LINE NUMBER ENTERED E3100076C SO FAR, SAVE IT. E3100077C I. CALL 'FNDSLI' TO LOCATE THE POSITION FOR E3100078C THIS ENTRY IN THE STATEMENT LABEL INDEX E3100079C FILE. E3100080C J. SAVE THE RELATIVE RECORD POINTER FOR THIS E3100081C RECORD IN THE USERS FILE AS THE RECORD E3100082C FOR THIS ENTRY IN THE STATEMENT LABEL E3100083C INDEX FILE. E3100084C K. INCREMENT THE RELATIVE RECORD POINTER E3100085C FOR THE USERS FILE. E3100086C L. CONTINUE THE DO LOOP FOR THE RECORD BLOCK E3100087C FROM THE USERS FILE. E3100088C 9. IF THIS IS NOT THE LAST BLOCK OF THE USERS E3100089C FILE, GO BACK AND GET THE NEXT RECORD BLOCK. E3100090C 10. CLEAR THE FIRST RECORD IN THE FILE BUFFER. E3100091C 11. IF THE FILE IS COMPLETELY FULL OF RECORDS, E3100092C RETURN TO THE CALLING PROGRAM. E3100093C 12. PUT AN END OF FILE MARK IN THE FILE BUFFER. E3100094C 13. SET UP A DO LOOP TO OUTPUT AS MANY BLANK E3100095ÐÐC RECORDS AS IS NECESSARY TO FILL THE FILE. E3100096C A. WRITE A BLANK RECORD INTO THE FILE. THE E3100097C FIRST RECORD ONLY WILL HAVE A FILE MARK. E3100098C B. IF AN ERROR OCCURS, OUTPUT THE ERROR E3100099C MESSAGE 'FILE MANAGER ERROR WHEN WRITING E3100100C FILE @@@@@@@@ ISTAT = $$$$', SET THE E3100101C ERROR FLAG AND RETURN TO THE CALLING E3100102C PROGRAM. E3100103C C. IF NO ERRORS OCCUR, CLEAR THE FILE MARK E3100104C AND CONTINUE THE DO LOOP E3100105C 14. CHANGE THE FILE TYPE TO A DIRECT FILE. E3100106C 15. RETURN TO THE CALLING PROGRAM. E3100107CS5 ENTRY/EXIT E3100108C ---------- E3100109CS3 ENTRY TO THIS ROUTINE IS FROM THE GET PROCESSOR. IT E3100110C REQUIRES THAT THE USERS FILE AND THE STATEMENT LABEL E3100111C INDEX FILE BE OPEN. THE FCB FOR THE USERS FILE MUST E3100112C BE IN CORE. E3100113C E3100114C EXIT FROM THIS ROUTINE IS WITH THE STATEMENT LABEL E3100115C INDEX FILE CONTAINING A POINTER TO EACH RECORD IN E3100116C THE USERS FILE. E3100117C IERRFG = 0 NO ERRORS E3100118C + NON FATAL EDITOR ERROR. ANOTHER PROCESSOR E3100119C MAY BE ENTERED. E3100120ÐÐC - FATAL EDITOR ERROR. THE EDITOR IS TERMIN- E3100121C ATED. E3100122CS5 ERROR MESSAGES E3100123C ----- -------- E3100124CS3 THE FOLLOWING ERROR MESSAGES ARE OUTPUT BY THIS ROUTINE E3100125C EDITOR ERROR 301 E3100126C 'ILLEGAL LINE NUMBER ##### SPECIFIED' E3100127C EDITOR FILE MANAGER ERROR 334 E3100128C 'FILE MANAGER ERROR WHEN READING FILE @@@@@@@@ ISTAT = $$$$' E3100129C EDITOR FILE MANAGER ERROR 345 E3100130C 'FILE MANAGER ERROR WHEN WRITING FILE @@@@@@@@ ISTAT = $$$$' E3100131CS5 ENTRIES E3100132C ------- E3100133CS3 ENTRY POINT REFERENCED BY E3100134C ----- ----- ---------- -- E3100135C SLIBLD GETPRO E3100136CS5 EXTERNAL REFERENCES E3100137C -------- ---------- E3100138CS3 EXTERNAL EXTERNAL E3100139C -------- -------- E3100140C DECHEX FNDSLI E3100141C PUTS READR E3100142C RETURN SAVE E3100143C SET SYSMSG E3100144C*** E3100145ÐÐM EDITCM E3100146 INTEGER EDER01 E3100147 INTEGER FMER04 E3100148 INTEGER FMER15 E3100149 DATA EDER01/301/ E3100150 DATA FMER04/334/ E3100151 DATA FMER15/345/ E3100152C SAVE ENTRY FOR RETURN E3100153 CALL SAVE(SLIBLD) E3100154C CLEAR THE RPG ARRAY DATA FLAG E3100155 FCBBUF(86)=0 E3100156C SET THE FLAG FOR LOCATE TO WRITE E3100157 IMODE=1 E3100158C SET THE INITIAL RELATIVE RECORD COUNT TO ONE E3100159 IRECPT(1)=0 E3100160 IRECPT(2)=1 E3100161C READ A RECORD BLOCK E3100162 100 CALL READR(REQBUF,FBUFFR,IRECPT,ISTATX) E3100163C VERIFY THE STATUS OF THE FILE MANAGER E3100164 IF (ISTATX.GE.0) GO TO 300 E3100165C WAS THE AN EOF AND NO RECORDS READ E3100166 IF (AND(ISTATX,$0100).NE.0) GO TO 500 E3100167C AN ERROR HAS OCCURRED E3100168C MOVE THE FILE NAME TO THE ERROR BUFFER E3100169 DO 200 IX=1,4 E3100170ÐÐ IDATA(IX)=NAMFIL(IX) E3100171 200 CONTINUE E3100172C MOVE STATUS TO ERROR E3100173 IDATA(5)=ISTATX E3100174C OUTPUT THE ERROR - FILE MANAGER ERROR WHEN READING FILE @@@@@@@@ E3100175C ISTAT = $ E3100176 CALL SYSMSG(FMER04,IDATA) E3100177C SET ERROR FLAG E3100178 250 IERRFG=1 E3100179 GO TO 9000 E3100180C GET NUMBER OF RECORDS ACTUALLY READ AND USE IF FOR THE DO LOOP E3100181 300 IC=REQBUF(15) E3100182C IF THIS IS THE FIRST RECORD SEE IF IT HAS DATA IN IT E3100183 IF (IRECPT(2).NE.1) GO TO 345 E3100184 DO 325 IX=1,40 E3100185 IF (FBUFFR(IX).NE.$2020) GO TO 345 E3100186 325 CONTINUE E3100187C THIS FIRST RECORD IS ALL BLANKS. THIS MUST BE A BLANK FILE E3100188C DO NOT BUILD AN INDEX E3100189 GO TO 9000 E3100190 345 DO 400 IB=1,IC E3100191C CALCULATE THE INDEX TO THE FIRST WORD OF EACH RECORD E3100192 IRCIDX=(IB-1)*40+1 E3100193C IS THIS RECORD DELETED E3100194 IF (FBUFFR(IRCIDX).EQ.IDELFG) GO TO 390 E3100195ÐÐC IS THIS THE END OF THE TEXT RECORDS E3100196 IF (FBUFFR(IRCIDX).EQ.IEOFFM) GO TO 9000 E3100197C DETERMINE WHERE LINE NUMBER IS LOCATED FOR CONVERSION (BY FILE ID)E3100198 IF (FCBBUF(87).LE.1) GO TO 350 E3100199C IS THIS AN RPG END OF PROGRAM INDICATOR E3100200 IF (FBUFFR(IRCIDX).EQ.$2F2A) GO TO 346 E3100201C IS THIS AN RPG ARRAY DATA INDICATOR E3100202 IF (FBUFFR(IRCIDX).NE.$2A2A) GO TO 347 E3100203C IF THE RPG ARRAY DATA FLAG IS NOT SET, SET IT E3100204 346 IF (FCBBUF(86).EQ.0) FCBBUF(86)=-1 E3100205 GO TO 350 E3100206C NUMBER IS IN POSITIONS 1-5 OF THE RECORD. E3100207C CHECK FOR RPG ARRAY DATA INDICATOR E3100208 347 IF (FCBBUF(86).NE.0) GO TO 350 E3100209C REPOSITION IT FOR CONVERSION E3100210 NUMBER(1)=$3000+AND(FBUFFR(IRCIDX),$FF00)/$0100 E3100211 NUMBER(2)=AND(FBUFFR(IRCIDX),$00FF)*$0100+ E3100212 1AND(FBUFFR(IRCIDX+1),$FF00)/$0100 E3100213 NUMBER(3)=AND(FBUFFR(IRCIDX+1),$00FF)*$0100+ E3100214 1AND(FBUFFR(IRCIDX+2),$FF00)/$0100 E3100215 GO TO 375 E3100216C NUMBER IS IN POSITIONS 75-80 OF THE RECORD E3100217 350 NUMBER(1)=$3000+AND(FBUFFR(IRCIDX+37),$00FF) E3100218 NUMBER(2)=FBUFFR(IRCIDX+38) E3100219 NUMBER(3)=FBUFFR(IRCIDX+39) E3100220ÐÐC CONVERT THE NUMBER TO HEXIDECIMAL E3100221 375 CALL DECHEX(NUMBER,LINENO) E3100222C DID AN ERROR OCCUR E3100223 IF (IERRFG.NE.0) GO TO 9000 E3100224C IF THE RPG ARRAY DATA FLAG IS SET, SAVE THIS LINE NUMBER E3100225 IF (FCBBUF(86).EQ.-1) FCBBUF(86)=LINENO E3100226C MAKE SURE THE LINE NUMBER ISN'T OUT OF RANGE E3100227 IF (LINENO.LE.32767) GO TO 380 E3100228C SET ILLEGAL LINE NUMBER INTO ERROR E3100229 IDATA(1)=NUMBER(1) E3100230 IDATA(2)=NUMBER(2) E3100231 IDATA(3)=NUMBER(3) E3100232C OUTPUT THE ERROR - ILLEGAL LINE NUMBER @@@@@@ E3100233 CALL SYSMSG(EDER01,IDATA) E3100234 GO TO 250 E3100235C IS THIS LINE NUMBER HIGHER THAN THE HIGHEST SO FAR E3100236 380 IF (STNMBR.LT.LINENO) STNMBR=LINENO E3100237C FIND THE INDEX INTO THE STATEMENT LABEL INDEX FILE FOR THIS LINE E3100238C WRITE OUT SOME PREVIOUS ENTRIES IF NECESSARY E3100239 CALL FNDSLI E3100240C LINIDX CONTAINS THE CORRECT INDEX FOR THIS LINE E3100241C STORE THE RELATIVE RECORD POINTER FOR THIS LINE E3100242 IS(LINIDX)=IRECPT(2) E3100243C INCREMENT TO NEXT RELATIVE RECORD NUMBER E3100244 390 IRECPT(2)=IRECPT(2)+1 E3100245ÐÐC GET NEXT RECORD FROM THE BLOCK E3100246 400 CONTINUE E3100247C WAS THIS THE LAST BLOCK E3100248 500 IF (AND(ISTATX,$0100).EQ.0) GO TO 100 E3100249C CLEAR THE FIRST RECORD IN THE FILE BUFFER E3100250 CALL SET(FBUFFR,40,$2020) E3100251C DOES THE FILE NEED BLANK RECORDS TO FILL IT UP E3100252 IF (FCBBUF(8).GE.FCBBUF(3)) GO TO 9000 E3100253C SET THE FIRST WORD OF THE FIRST EMPTY RECORD TO THE FILE MARK CODEE3100254 FBUFFR(1)=IEOFFM E3100255C FILL UP WHAT IS LEFT E3100256 IY=FCBBUF(8)+1 E3100257 IZ=FCBBUF(3) E3100258 DO 800 IX=IY,IZ E3100259C OUTPUT THIS BLANK RECORD E3100260 CALL PUTS(REQBUF,FBUFFR,1,ISTAT) E3100261C VERIFY THE STATUS OF THE FILE MANAGER E3100262 IF (ISTAT.GE.0) GO TO 700 E3100263C PUT THE FILE NAME INTO ERROR E3100264 DO 600 IA=1,4 E3100265 IDATA(IA)=NAMFIL(IA) E3100266 600 CONTINUE E3100267C PUT THE STATUS INTO ERROR E3100268 IDATA(5)=ISTAT E3100269C OUTPUT THE ERROR - FILE MANAGER WHEN WRITING FILE @@@@@@@@ E3100270ÐÐC ISTAT = $$$$ E3100271 CALL SYSMSG(FMER15,IDATA) E3100272 GO TO 250 E3100273C CLEAR THE FIEL MARK E3100274 700 FBUFFR(1)=$2020 E3100275 800 CONTINUE E3100276C CHANGE THIS FILE TO A DIRECT FILE E3100277 FCBBUF(95)=3 E3100278 9000 CALL RETURN E3100279 RETURN E3100280 END E3100281 SUBROUTINE STRMCH E3200001 1 /E32 F ITOS CCS 3.0 SL-149E3200002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO SEARCH FOR A MATCHING STRING E3200003C CREDIT COLLECTION SYSTEM VERSION 3.0 E3200004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E3200005C COPYRIGHT CONTROL DATA CORPORATION 1978 E3200006C E3200007C*** E3200008C FUNCTION E3200009C -------- E3200010CS3 THE FUNCTION OF THIS PROGRAM IS TO SEARCH FOR A MATCH E3200011C OF THE DESIRED STRING IN THE USER RECORD. E3200012CS5 GENERAL FLOW E3200013C ------- ---- E3200014ÐÐCS3 THE OPERATIONS PERFORMED BY THIS ROUTINE INCLUDE: E3200015C 1. THE STRING MATCH FLAG IS CLEARED AND THE STARTING, E3200016C ENDING CHARACTER LIMIT IS SAVED. IF THE TARGET E3200017C STRING IS THE EMPTY STRING, BUMP THE CHARACTER E3200018C POINTER OF THE OLD RECORD AND GO TO 6. E3200019C 2. IF THE NEXT CHARACTER POSITION IS BEYOND THE E3200020C BOUNDS OF THIS SEARCH LIMIT, RETURN TO THE E3200021C CALLING PROGRAM. E3200022C 3. SAVE THIS CHARACTER AS THE POSSIBLE START E3200023C OF THE STRING. E3200024C 5. SET UP A DO LOOP TO COMPARE THE STRING TO E3200025C THE RECORD E3200026C A. GET A CHARACTER THRU 'ELNSCN' E3200027C B. IF THERE IS NO MORE CHARACTERS, THEN THERE E3200028C IS NO MATCH. RETURN TO CALLER E3200029C C. IF THE MATCHING GOES BEYOND THE ENDING E3200030C CHARACTER LIMIT, THEN THERE IS NO MATCH. E3200031C RETURN TO CALLER. E3200032C D. IF THE CHARACTER FROM THE RECORD DOES NOT E3200033C MATCH THE CHARACTER FROM THE STRING, GO E3200034C BACK TO 2. E3200035C E. GET THE NEXT CHARACTER FROM THE USER E3200036C RECORD AND CONTINUE THE DO LOOP. E3200037C 6. IF THE DO LOOP COMPLETES NORMALLY, THEN E3200038C INDICATE THAT A FULL MATCH WAS FOUND BY SETTING E3200039ÐÐC ISRMCH EQUAL TO THE LENGTH OF THE TARGET STRING E3200040CS5 ENTRY/EXIT E3200041C ---------- E3200042CS3 ENTRY TO THIS ROUTINE IS FROM THE SEARCH AND CHANGE E3200043C PROCESSORS. THE STRING TO COMPARE WITH IS IN 'STRBF2', E3200044C THE RECORD TO COMPARE AGAINST IS IN 'CMNDBF'. E3200045C THE LENGTH OF 'STRBF2' IS IN VARIABLE ISRLNG E3200046C CHARNO=CHAR POSITION IN THE OLD USER EDIT RECORD(CMNDBF) E3200047C TO START THE MATCHING E3200048C IENREC=LAST LEGAL CHARACTER POSITION IN RECORD(IN CMNDBF) E3200049C IY=ENDING CHARACTER POSITION TO TRY FOR A MATCH E3200050C E3200051C ISRMCH=NUMBER OF CONSECUTIVE MATCHED CHARACTERS E3200052C =-1 IF THERE IS NO FULL MATCH E3200053C ISTRST=CHAR POSITION IN OLD RECORD(CMNDBF) OF A MATCH E3200054C CHARNO=LAST CHAR SCANNED IN OLD RECORD(CMNDBF) E3200055C IERRFG = 0 NO ERRORS E3200056C + NON FATAL EDITOR ERROR. ANOTHER PROCESSOR E3200057C MAY BE ENTERED. E3200058C - FATAL EDITOR ERROR. THE EDITOR IS TERMIN- E3200059C ATED. E3200060CS5 ENTRIES E3200061C ------- E3200062CS3 ENTRY POINT REFERENCED BY E3200063C ----- ----- ---------- -- E3200064ÐÐC STRMCH CHAPRO E3200065C SEAPRO E3200066CS5 EXTERNAL REFERENCES E3200067C -------- ---------- E3200068CS3 EXTERNAL EXTERNAL E3200069C -------- -------- E3200070C ELNSCN RETURN E3200071C SAVE E3200072C*** E3200073M EDITCM E3200074 INTEGER ICOLEN E3200075C SAVE ENTRY FOR RETURN E3200076 CALL SAVE(STRMCH) E3200077C CLEAR THE STRING MATCH FLAG E3200078 ISRMCH=-1 E3200079C GET ENDING CHARACTER MATCHING LIMIT E3200080 ICOLEN=IY E3200081C SAVE START OF SCAN E3200082 ISTRST=CHARNO E3200083C IF STRBF2 IS NOT AN EMPTY STRING (NO CHARACTER BETWEEN DELIMITERS)E3200084C THEN CONTINUE E3200085 IF (ISRLNG.NE.0) GOTO 150 E3200086C IF EMPTY STRING IS NOT IN PROPER CHARACTER LIMITS, RETURN E3200087 IF (CHARNO.NE.ICOLEN) GOTO 9000 E3200088C BUMP OLD RECORD CHARACTER PTR TO NEXT CHARACTER E3200089ÐÐ CHARNO=CHARNO+1 E3200090 GOTO 300 E3200091C E3200092C SET STARTING CHAR NUMBER FOR SCAN TO THE NEXT CHARACTER E3200093 100 CHARNO=ISTRST+1 E3200094C SAVE THIS CHARACTER NUMBER AS THE POSSIBLE START OF THE STRING E3200095 ISTRST=CHARNO E3200096C CHECK FOR THIS CHARACTER IN THE STRING BUFFER E3200097 150 DO 200 IX=1,ISRLNG E3200098C GET A CHARACTER TO COMPARE E3200099 CALL ELNSCN E3200100C IS THERE ANY MORE CHARACTERS IN OLD RECORD E3200101 IF (ICHARC.LT.0) GOTO 9000 E3200102C IF ENDING CHARACTER LIMIT IS REACHED, THEN RETURN E3200103 IF (CHARNO-1.GT.ICOLEN) GOTO 9000 E3200104C DOES THIS CHARACTER MATCH E3200105 IF (ICHARC.NE.STRBF2(IX)) GO TO 100 E3200106 200 CONTINUE E3200107C INDICATE THAT A FULL MATCH WAS FOUND E3200108 300 ISRMCH=ISRLNG E3200109 9000 CALL RETURN E3200110 RETURN E3200111 END E3200112 SUBROUTINE UPNREC E3300001 1 /E33 F ITOS CCS 3.0 SL-149E3300002ÐÐC ITOS SOURCE LANGUAGE EDITOR SUBR. TO PLACE THE NEW STRING IN REC. E3300003C CREDIT COLLECTION SYSTEM VERSION 3.0 E3300004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E3300005C COPYRIGHT CONTROL DATA CORPORATION 1978 E3300006C E3300007C*** E3300008C FUNCTION E3300009C -------- E3300010CS3 THE FUNCTION OF THIS PROGRAM IS TO PUT THE REPLACEMENT E3300011C STRING INTO THE NEW RECORD. E3300012CS5 GENERAL FLOW E3300013C ------- ---- E3300014CS3 THE FOLLOWING OPERATIONS ARE PERFORMED BY THIS ROUTINE E3300015C 0. IF THE REPLACEMENT STRING IS THE EMPTY STRING, E3300016C GO TO STEP 2. E3300017C 1. A DO LOOP IS SET UP TO MOVE THE NUMBER OF E3300018C CHARACTERS IN THE REPLACEMENT STRING INTO THE E3300019C NEW RECORD. E3300020C A. CALCULATE THE POSITION OF THE WORD TO E3300021C STORE THE NEXT CHARACTER INTO. E3300022C B. STORE THE CHARACTER IN THE APPROPRIATE E3300023C WORD AND BYTE OF 'RECBUF'. E3300024C C. SET UP FOR THE NEXT CHARACTER POSITION. E3300025C D. CONTINUE THE DO LOOP E3300026C 2. SET THE CHARACTER POINTER IN THE OLD RECORD E3300027ÐÐC TO THE CHARACTER AFTER THE STRING BEING E3300028C REPLACED, AND RETURN TO THE CALLING PROGRAM. E3300029CS5 ENTRY/EXIT E3300030C ---------- E3300031CS3 ENTRY TO THIS ROUTINE IS FROM THE CHANGE PROCESSOR. E3300032C ISRLNG = LENGTH OF THE NEW STRING. E3300033C NRECST = CURRENT CHARACTER POSITION IN THE NEW RECORD. E3300034C STRBF1 = CHARACTER STRING TO REPLACE OLD STRING. E3300035C ICHSTO = CURRENT CHARACTER POSITION IN THE OLD RECORD. E3300036C ISRMCH = LENGTH OF THE OLD STRING. E3300037C RECBUF = CHANGED RECORD BUFFER E3300038C E3300039C EXIT IS WITH THE NEW STRING POSITIONED IN THE NEW E3300040C RECORD. THE CHARACTER POINTER IN THE OLD RECORD E3300041C POINTS TO THE NEXT CHARACTER IN THE OLD RECORD. E3300042C IERRFG = 0 NO ERRORS E3300043C + NON FATAL EDITOR ERROR. ANOTHER PROCESSOR E3300044C MAY BE ENTERED. E3300045C - FATAL EDITOR ERROR. THE EDITOR IS TERMIN- E3300046C ATED. E3300047CS5 ENTRIES E3300048C ------- E3300049CS3 ENTRY POINT REFERENCED BY E3300050C ----- ----- ---------- -- E3300051C UPNREC CHAPRO E3300052ÐÐCS5 EXTERNAL REFERENCES E3300053C -------- ---------- E3300054CS3 EXTERNAL EXTERNAL E3300055C -------- -------- E3300056C RETURN SAVE E3300057C*** E3300058M EDITCM E3300059C SAVE ENTRY FOR RETURN E3300060 CALL SAVE(UPNREC) E3300061C IF REPLACEMENT STRING SIZE EQUAL TO 0 THEN RETURN E3300062 IF (ISRLNG.EQ.0) GOTO 400 E3300063C MOVE THE CHARACTER STRING TO THE NEW RECORD E3300064 DO 300 IX=1,ISRLNG E3300065 IDUMB=(NRECST+1)/2 E3300066C IS THIS THE ODD (UPPER) CHARACTER E3300067 IF (AND(NRECST,1).NE.0) GO TO 100 E3300068C THIS IS THE EVEN(LOWER) CHARACTER E3300069 RECBUF(IDUMB)=AND(RECBUF(IDUMB),$FF00)+STRBF1(IX) E3300070 GO TO 200 E3300071C THIS IS THE ODD (UPPER CHARACTER E3300072 100 RECBUF(IDUMB)=AND(RECBUF(IDUMB),$00FF)+STRBF1(IX)*$100 E3300073C SET FOR NEXT CHARACTER E3300074 200 NRECST=NRECST+1 E3300075 300 CONTINUE E3300076C SET NEXT CHARACTER POSITION IN OLD RECORD E3300077ÐÐ 400 ICHSTO=ICHSTO+ISRMCH E3300078 9000 CALL RETURN E3300079 RETURN E3300080 END E3300081 SUBROUTINE UPOREC E3400001 1 /E34 F ITOS CCS 3.0 SL-149E3400002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO MOVE CHARACTERS FROM OLD REC.E3400003C CREDIT COLLECTION SYSTEM VERSION 3.0 E3400004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E3400005C COPYRIGHT CONTROL DATA CORPORATION 1978 E3400006C E3400007C*** E3400008C FUNCTION E3400009C -------- E3400010CS3 THE FUNCTION OF THIS PROGRAM IS TO MOVE THE UNCHANGED E3400011C CHARACTERS FROM THE OLD RECORD TO THE NEW ONE. E3400012CS5 GENERAL FLOW E3400013C ------- ---- E3400014CS3 THE FOLLOWING OPERATIONS ARE PERFORMED BY THIS ROUTINE E3400015C 1. THE LAST CHARACTER TO MOVE IS CALCULATED. IF E3400016C THERE IS NO CHARACTER TO MOVE(REPLACEMENT STRING E3400017C IS THE EMPTY STRING) THEN RETURN. E3400018C 2. A DO LOOP IS SET UP TO MOVE THE CHARACTERS E3400019C FROM THE OLD RECORD TO THE NEW ONE. E3400020C A. CALCULATE THE CORRECT WORD AND BYTE FROM E3400021ÐÐC WHICH TO EXTRACT THE NEXT CHARACTER FROM E3400022C THE OLD RECORD. E3400023C B. CALCULATE THE CORRECT WORD AND BYTE INTO E3400024C WHICH TO STORE THE NEXT CHARACTER INTO E3400025C THE NEW RECORD. E3400026C C. EXTRACT THE APPROPRIATE CHARACTER AND E3400027C STORE IT IN THE APPROPRIATE WORD IN THE E3400028C NEW RECORD. E3400029C D. UPDATE THE CURRENT CHARACTER POINTERS IN E3400030C BOTH THE OLD AND NEW RECORDS AND CONTINUE E3400031C THE DO LOOP. E3400032C 3. RETURN TO THE CALLING PROGRAM. E3400033CS5 ENTRY/EXIT E3400034C ---------- E3400035CS3 ENTRY TO THIS ROUTINE IS FROM THE CHANGE PROCESSOR. E3400036C ISTRST = ENDING CHARACTER POSITION NUMBER OF RECORD MOVE E3400037C ICHSTO = CURRENT CHARACTER POSITION IN THE OLD RECORD. E3400038C NRECST = CURRENT CHARACTER POSITION IN THE NEW RECORD. E3400039C CMNDBF = OLD RECORD BUFFER E3400040C RECBUF = NEW RECORD BUFFER E3400041C E3400042C UPON EXIT FROM THIS ROUTINE THE CHARACTER POINTERS FOR E3400043C THE OLD AND NEW RECORDS WILL BE POSITIONED AT THE E3400044C START OF THE REPLACED STRING AND THE START OF THE E3400045C NEW STRING RESPECTIVELY. E3400046ÐÐC IERRFG = 0 NO ERRORS E3400047C + NON FATAL EDITOR ERROR. ANOTHER PROCESSOR E3400048C MAY BE ENTERED. E3400049C - FATAL EDITOR ERROR. THE EDITOR IS TERMIN- E3400050C ATED. E3400051CS5 ENTRIES E3400052C ------- E3400053CS3 ENTRY POINT REFERENCED BY E3400054C ----- ----- ---------- -- E3400055C UPOREC CHAPRO E3400056CS5 EXTERNAL REFERENCES E3400057C -------- ---------- E3400058CS3 EXTERNAL EXTERNAL E3400059C -------- -------- E3400060C RETURN SAVE E3400061C*** E3400062M EDITCM E3400063C SAVE ENTRY FOR RETURN E3400064 CALL SAVE(UPOREC) E3400065C CALCULATE NUMBER OF CHARACTERS TO INSERT E3400066 IZ=ISTRST-1 E3400067C RETURN IF THERE IS NO MOVE NECESSARY INTO THE OLD RECORD E3400068 IF (IZ.LT.ICHSTO) GOTO 9000 E3400069C E3400070C BEGIN MOVE OLD RECORD DATA INTO RECBUF E3400071ÐÐC -------------------------------------- E3400072 DO 500 IX=ICHSTO,IZ E3400073 IY=(IX+1)/2 E3400074 IDUMB=(NRECST+1)/2 E3400075C IS THIS THE UPPER OR LOWER CHARACTER IN THE OLD RECORD E3400076 IF (AND(IX,1).NE.0) GO TO 100 E3400077C THIS IS THE EVEN (LOWER) CHARACTER E3400078 ICHARC=AND(CMNDBF(IY),$00FF) E3400079 GO TO 200 E3400080C THIS IS THE ODD (UPPER) CHARACTER E3400081 100 ICHARC=AND(CMNDBF(IY),$FF00)/$100 E3400082C DOES TT GO INTO THE UPPER OR LOWER CHARACTER OF THE NEW RECORD E3400083 200 IF (AND(NRECST,1).NE.0) GO TO 300 E3400084C THIS IS THE EVEN (LOWER) CHARACTER E3400085 RECBUF(IDUMB)=AND(RECBUF(IDUMB),$FF00)+ICHARC E3400086 GO TO 400 E3400087C THIS IS THE ODD (UPPER) CHARACTER E3400088 300 RECBUF(IDUMB)=AND(RECBUF(IDUMB),$00FF)+ICHARC*$100 E3400089C SET FOR THE NEXT CHARACTER E3400090 400 ICHSTO=ICHSTO+1 E3400091 NRECST=NRECST+1 E3400092 500 CONTINUE E3400093 9000 CALL RETURN E3400094 RETURN E3400095 END E3400096ÐÐ SUBROUTINE SEQPRO E3500001 1 /E35 F ITOS CCS 3.0 SL-149E3500002C ITOS SOURCE LANGUAGE EDITOR SUBR. TO ADD LINE NUMBERS TO A FILE E3500003C CREDIT COLLECTION SYSTEM VERSION 3.0 E3500004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA E3500005C COPYRIGHT CONTROL DATA CORPORATION 1978 E3500006C E3500007C*** E3500008C FUNCTION E3500009C -------- E3500010CS3 THE FUNCTION OF THIS PROGRAM IS TO PROCESS THE 'SEQUEN' E3500011C COMMAND. E3500012CS5 GENERAL FLOW E3500013C ------- ---- E3500014CS3 THE FOLLOWING OPERATIONS ARE PERFORMED BY THIS ROUTINE E3500015C 1. THE 'CLEAR' PROCESSOR IS CALLED TO COMPLETE E3500016C ANY ACTIVITY ON A CURRENTLY OPEN FILE. IF ANY E3500017C ERRORS OCCURRED, THE ROUTINE RETURNS TO THE E3500018C CALLING PROGRAM. E3500019C 2. THE RELATIVE RECORD POINTER IS INITIALIZED. E3500020C 3. THE NEXT FIELD (FILE NAME) IS OBTAINED FROM E3500021C THE CALLING STRING. IF ANY ERRORS OCCUR, THE E3500022C ROUTINE RETURNS TO THE CALLING PROGRAM. THE E3500023C FILE NAME IS SAVED IN THE ERROR BUFFER FOR E3500024C POSSIBLE USE LATER. E3500025ÐÐC 4. THE NEXT FIELD (RPG INDICATOR) IS OBTAINED E3500026C FROM THE CALLING STRING. IF ANY ERRORS OCCUR E3500027C CONTROL IS RETURNED TO THE CALLING PROGRAM. E3500028C 5. THE NEXT FIELD (BASE LINE AND INCREMENT) IS E3500029C OBTAINED FROM THE CALLING STRING. IF ANY E3500030C ERRORS OCCUR CONTROL IS RETURNED TO THE CALLING E3500031C PROGRAM. THE NUMBER OBTAINED IS SAVED FOR E3500032C LATER USE. E3500033C 6. THE FILE MANAGER REQUEST BUFFER FOR THIS FILE E3500034C IS INITIALIZED. E3500035C 7. THE PARAMETER LIST FOR THE OPEN REQUEST IS E3500036C SET UP. E3500037C A. FILE NAME AND USER ID E3500038C B. RELATIVE RECORD RETREIVE E3500039C C. 1 RECORD PER BLOCK E3500040C D. LOCK THE FILE E3500041C 8. THE OPEN REQUEST IS PERFORMED WITHIN A DO E3500042C LOOP FOR MAXTRY (10) ATTEMPTS TO OPEN THE E3500043C FILE IF IT IS LOCKED. IF THE FILE CANNOT E3500044C BE OPENED WITHIN MAXTRY ATTEMPTS, THE ERROR E3500045C 'FILE @@@@@@@@ IS LOCKED. TRY AGAIN LATER' IS E3500046C PRINTED AND CONTROL IS RETURNED TO THE CALLING E3500047C PROGRAM. IF THE FILE CANNOT BE LOCATED, THE E3500048C ERROR 'COULD NOT LOCATE FILE @@@@@@@@ USER E3500049C @@@@@@@@' IS OUTPUT AND CONTROL IS RETURNED E3500050ÐÐC TO THE CALLING PROGRAM. IF SOME OTHER ERROR E3500051C OCCURS, THE ERROR 'FILE MANAGER ERROR WHEN E3500052C OPENING FILE @@@@@@@@ ISTAT = $$$$' IS PRINTED E3500053C AND CONTROL IS RETURNED TO THE CALLING PROGRAM. E3500054C 9. IF NO ERRORS HAVE OCCURRED, THE VALIDITY OF E3500055C THE FILE IS CHECKED. THESTS ARE MADE FOR: E3500056C A. DIRECT OR SEQUENTIAL FILE TYPE E3500057C B. 80 CHARACTER RECORDS E3500058C C. NON-SECTOR ALIGNED FILE E3500059C IF ANY OF THESE TESTS ARE FAILED, THE ERROR E3500060C 'FILE @@@@@@@@ IS NOT AN EDITOR FILE' IS OUTPUT E3500061C THE FILE IS CLOSED, THE ERROR FLAG IS SET, THE E3500062C FILE NAME BUFFER IS CLEARED AND CONTROL IS E3500063C RETURNED TO THE CALLING PROGRAM. E3500064C 10. THE FILE TYPE INDICATED IN THE CALLING STRING E3500065C IS STORED IN THE FCB FOR THIS FILE (FCBBUF(87)). E3500066C 11. THE BASE LINE IS SET UP AS INDICATED IN THE E3500067C CALLING STRING. IF THE BASE LINE IS NOT IN E3500068C THE CALLING STRING, 10 IS USED AS THE BASE E3500069C AND INCREMENT. IF THE LINE NUMBER EXCEEDS E3500070C 32767, THE ERROR 'ILLEGAL LINE NUMBER ##### E3500071C SPECIFIED' IS OUTPUT, THE FILE IS CLOSED, THE E3500072C ERROR FLAG IS SET, THE FILE NAME BUFFER IS E3500073C CLEARED AND CONTROL RETURNS TO THE CALLING E3500074C PROGRAM. E3500075ÐÐC 12. THE NEXT RECORD IS READ FROM THE FILE. IF AN E3500076C ERROR OCCURS AND IT IS NOT AN END OF FILE, E3500077C THE ERROR 'FILE MANAGER ERROR WHEN READING E3500078C FILE @@@@@@@@ ISTAT = $$$$' IS OUTPUT AND THE E3500079C SAME ERROR LOGIC USED FOR AN ILLEGAL LINE E3500080C NUMBER IS EXECUTED. IF IT IS THE END OF THE E3500081C FILE, THE HIGHEST STATEMENT NUMBER ENCOUNTERED E3500082C IS SAVED IN THE FCB (FCBBUF(88)), THE 'CLEAR' E3500083C PROCESSOR IS CALLED TO COMPLETE ACTIVITY ON E3500084C THIS FILE AND CONTROL IS RETURNED TO THE E3500085C CALLING PROGRAM. E3500086C 13. IF NO ERRORS HAVE OCCURRED, THE LINE NUMBER E3500087C IS CONVERTED TO DECIMAL-ASCII. E3500088C 14. IF THE RECORD HAS BEEN DELETED, INCREMENT THE E3500089C RELATIVE RECORD POINTER AND GO BACK TO GET E3500090C THE NEXT RELATIVE RECORD. E3500091C 15. IF THE RECORD IS AN END OF FILE RECORD, PROCESS E3500092C THE SAME AS THE END OF FILE STATUS FROM THE E3500093C FILE MANAGER READ. E3500094C 16. IF THE FILE TYPE INDICATOR IS NON-RPG, POSITION E3500095C THE LINE NUMBER IN POSITIONS 76 - 80 OF THE E3500096C RECORD. E3500097C IF THE FILE IS AN RPG FILE, IS THE RECORD AN E3500098C END OF RPG FILE INDICATOR ($2F2A). IF IT IS E3500099C AND THE RPG ARRAY DATA FLAG IS NOT SET, SET E3500100ÐÐC IT. POSITION THE LINE NUMBER IN POSITIONS 76 - E3500101C 80 OF THE RECORD. IF IT IS NOT THE END OF RPG E3500102C FILE INDICATOR, IS IT AN RPG ARRAY DATA INDICATOR E3500103C ($2A2A). IF IT IS, SET THE RPG ARRAY DATA FLAG E3500104C IF IT IS NOT SET. POSITION THE LINE NUMBER IN E3500105C POSITIONS 76 - 80 OF THE RECORD. IF IT IS E3500106C NEITHER OF THE ABOVE RECORDS AND THE RPG ARRAY E3500107C DATA INDICATOR IS NON-ZERO, POSITION THE LINE E3500108C NUMBER IN POSITIONS 76 - 80 OTHERWISE, POS- E3500109C ITION THE LINE NUMBER IN POSITIONS 1 - 5 OF E3500110C THE RECORD. E3500111C 17. IF THE RPG ARRAY DATA FLAG IS SET SAVE THIS E3500112C LINE NUMBER AS THE BASE RPG ARRAY DATA INDICATOR. E3500113C 18. IF THIS IS THE HIGHEST LINE NUMBER ENTERED E3500114C SAVE IT IN THE FCB (FCBBUF(86)). E3500115C 19. WRITE THE RECORD WITH THE LINE NUMBER POSITIONED E3500116C IN THE APPROPRIATE POSITION. IF AN ERROR OCCURS E3500117C OUTPUT THE ERROR MESSAGE 'FILE MANAGER ERROR E3500118C WHEN UPDATING FILE @@@@@@@@ ISTAT = $$$$' AND E3500119C THE SAME LOGIC USED FOR AN ILLEGAL LINE NUMBER E3500120C IS EXECUTED. IF NO ERRORS OCCUR INCREMENT THE E3500121C RELATIVE RECORD POINTER AND GO BACK TO GET THE E3500122C NEXT LINE NUMBER E3500123CS5 ENTRY/EXIT E3500124C ---------- E3500125ÐÐCS3 THIS ROUTINE IS ENTERED FROM THE CONTROL PROCESSOR E3500126C 'EDITOS' WITH THE PARAMETER STRING FOR THE SEQUENCE E3500127C COMMAND IN THE COMMAND INPUT BUFFER. E3500128C E3500129C EXIT TO THE CALLING PROGRAM IS WITH E3500130C IERRFG = 0 NO ERRORS E3500131C + NON FATAL EDITOR ERROR. ANOTHER E3500132C PROCESSOR MAY BE ENTERED. E3500133C - FATAL EDITOR ERROR OCCURRED. THE E3500134C EDITOR IS TERMINATED. E3500135CS5 ERROR MESSAGES E3500136C ----- -------- E3500137CS3 THE FOLLOWING ERROR MESSAGES ARE OUTPUT BY THIS ROUTINE E3500138C EDITOR ERROR 301 E3500139C 'ILLEGAL LINE NUMBER ##### SPECIFIED' E3500140C EDITOR ERROR 303 E3500141C 'FILE @@@@@@@@ IS NOT AN EDITOR FILE' E3500142C EDITOR FILE MANAGER ERROR 331 E3500143C 'FILE MANAGEC PROCESSOR MAY BE ENTEREDE3500144C - FATAL EDITOR ERROR OCCURRED. THE E3500145C EDITOR IS TERMINATED. E3500146CS5 ERROR MESSAGES E3500147C ----- -------- E3500148CS3 THE FOLLOWING ERROR MESSAGES ARE OUTPUT BY THIS ROUTINE E3500149C EDITOR ERROR 301 E3500150ÐÐC 'ILLEGAL LINE NUMBER ##### SPECIFIED' E3500151C EDITOR ERROR 303 E3500152C 'FILE @@@@@@@@ IS NOT AN EDITOR FILE' E3500153C EDITOR FILE MANAGER ERROR 331 E3500154C 'FILE MANAGER ERROR WHEN OPENING FILE @@@@@@@@ ISTAT = $$$$' E3500155C EDITOR FILE MANAGER ERROR 332 E3500156C 'COULD NOT LOCATE FILE @@@@@@@@ USER @@@@@@@@' E3500157C EDITOR FILE MANAGER ERROR 333 E3500158C 'FILE @@@@@@@@ IS LOCKED. TRY AGAIN LATER E3500159C EDITOR FILE MANAGER ERROR 334 E3500160C 'FILE MANAGER ERROR WHEN READING FILE @@@@@@@@ ISTAT = $$$$' E3500161C EDITOR FILE MANAGER ERROR 341 E3500162C 'FILE MANAGER ERROR WHEN UPDATING FILE @@@@@@@@ ISTAT = $$$$' E3500163CS5 ENTRIES E3500164C ------- E3500165CS3 ENTRY POINT REFERENCED BY E3500166C ----- ----- ---------- -- E3500167C SEQPRO EDITOS E3500168CS5 EXTERNAL REFERENCES E3500169C -------- ---------- E3500170CS3 EXTERNAL EXTERNAL E3500171C -------- -------- E3500172C CLEPRO CLOSFL E3500173C GETNAM GETNUM E3500174C GETONE HEXDEC E3500175ÐÐC OPENFL READR E3500176C RETURN SAVE E3500177C SET SYSMSG E3500178C UPDREC E3500179C*** E3500180M EDITCM E3500181 INTEGER FMER01 E3500182 INTEGER FMER02 E3500183 INTEGER FMER03 E3500184 INTEGER FMER04 E3500185 INTEGER FMER11 E3500186 INTEGER EDER01 E3500187 INTEGER EDER03 E3500188 DATA FMER01/331/ E3500189 DATA FMER02/332/ E3500190 DATA FMER03/333/ E3500191 DATA FMER04/334/ E3500192 DATA FMER11/341/ E3500193 DATA EDER01/301/ E3500194 DATA EDER03/303/ E3500195 DATA MAXTRY/10/ E3500196C SAVE ENTRY FOR RETURN E3500197 CALL SAVE(SEQPRO) E3500198C CLEAR ALL PREVIOUS FILE DATA E3500199 CALL CLEPRO E3500200ÐÐC DID ANY ERRORS OCCUR E3500201 IF (IERRFG.NE.0) GO TO 9000 E3500202C SET THE RECORD POINTER FOR THE FIRST RECORD E3500203 IRECPT(1)=0 E3500204 IRECPT(2)=1 E3500205C GET THE FILE NAME FROM THE NEXT FIELD E3500206 CALL GETNAM E3500207C DID ANY ERRORS OCCUR E3500208 IF (IERRFG.NE.0) GO TO 9000 E3500209C MOVE THE FILE NAME TO ERROR BUFFER FOR POSSIBLE USE LATER E3500210 DO 100 IX=1,4 E3500211 IDATA(IX)=NAMFIL(IX) E3500212 100 CONTINUE E3500213C GET THE RPG FILE TYPE INDICATOR E3500214 CALL GETONE E3500215C DID ANY ERRORS OCCUR E3500216 IF (IERRFG.NE.0) GO TO 9000 E3500217C GET THE LINE BASE AND INCREMENT E3500218 CALL GETNUM E3500219C DID ANY ERRORS OCCUR E3500220 IF (IERRFG.NE.0) GO TO 9000 E3500221C SAVE AS THE BASE/INCREMENT E3500222 AUTOFG=NUMHEX E3500223C CLEAR THE FILE MANAGER'S REQUEST BUFFER E3500224 CALL SET(REQBUF,24,0) E3500225ÐÐC SET UP THE FCB ADDRESS IN THE REQUEST BUFFER E3500226 REQBUF(10)=FCBADR E3500227C PUT THE FILE NAME AND USER ID INTO THE OPEN COMMAND E3500228 DO 200 IX=1,8 E3500229 FMOPEN(IX)=NAMFIL(IX) E3500230 200 CONTINUE E3500231C SET UP TO RETRIEVE BY RELATIVE RECORD NUMBER E3500232 FMOPEN(13)=0 E3500233C SET UP THE NUMBER OF RECORDS PER RETRIEVE E3500234 FMOPEN(14)=1 E3500235C LOCK THE FILE E3500236 FMOPEN(15)=$8000 E3500237C PERFORM THE OPEN WITHIN A DO SO IT CAN E3500238C BE REPEATED IF THE FILE IS LOCKED. E3500239 DO 600 IX=1,MAXTRY E3500240C SET UP THE LENGTH OF THE FCB E3500241 REQBUF(13)=96 E3500242 CALL OPENFL(REQBUF,FMOPEN,ISTAT) E3500243C VERIFY THE STATUS OF THE FILE MANAGER E3500244 IF (ISTAT.GE.0) GO TO 500 E3500245C IS THE FILE UNLOCATABLE E3500246 IF (AND(ISTAT,2).NE.0) GO TO 300 E3500247C IF THE FILE IS LOCKED OR THE USER IS LOCKED OUT, RETRY THE OPEN E3500248 IF (AND(ISTAT,$1804).NE.0) GO TO 600 E3500249C OTHER FILE MANAGER ERRORS HAVE OCCURRED E3500250ÐÐC SET THE FILE MANAGER STATUS INTO ERROR E3500251 IDATA(5)=ISTAT E3500252C OUTPUT THE ERROR - FILE MANAGER ERROR WHEN OPENING FILE @@@@@@@@ E3500253C ISTAT = $$$$ E3500254 CALL SYSMSG(FMER01,IDATA) E3500255C SET THE ERROR FLAG E3500256 250 IERRFG=1 E3500257C CLEAR THE FILE NAME ON ANY FILE MANAGER ERROR DURING OPEN SEQUENCEE3500258 CALL SET(NAMFIL,3,$2020) E3500259 GO TO 9000 E3500260C REPORT UNABLE TO LOCATE FILE ERROR E3500261C PUT THE USER ID INTO THE ERROR E3500262 300 DO 400 IA=5,8 E3500263 IDATA(IA)=NAMFIL(IA) E3500264 400 CONTINUE E3500265C OUTPUT THE ERROR - COULD NOT LOCATE FILE @@@@@@@@ USER @@@@@@@@ E3500266 CALL SYSMSG(FMER02,IDATA) E3500267 GO TO 250 E3500268C IS THE FILE CURRENTLY LOCKED E3500269 500 IF (AND(ISTAT,4).EQ.0) GO TO 700 E3500270C FILE IS LOCKED OR USER IS LOCKED OUT - RETRY OPEN CALL E3500271 600 CONTINUE E3500272C FILE IS LOCKED OR USER IS LOCKED OUT - FOR MAXIMUM RETRIES E3500273C OUTPUT THE ERROR - FILE @@@@@@@@ IS LOCKED. TRY AGAIN LATER E3500274 CALL SYSMSG(FMER03,IDATA) E3500275ÐÐ GO TO 250 E3500276C IS THIS A SEQUENTIAL FILE OR A DIRECT FILE E3500277 700 IF (FCBBUF(95).EQ.0.OR.FCBBUF(95).EQ.3) GO TO 800 E3500278C NO, REPORT NON-EDITOR FILE TYPE E3500279 GO TO 900 E3500280C ARE THERE 40 WORD RECORDS E3500281 800 IF (FCBBUF(1).EQ.40) GO TO 1000 E3500282C OUTPUT THE ERROR - FILE @@@@@@@@ IS NOT AN EDITOR FILE E3500283 900 CALL SYSMSG(EDER03,IDATA) E3500284 GO TO 250 E3500285C THE FILE IS OPENED AND LOCKED. NOW SEQUENCE IT. E3500286C IS THIS A SECTOR ALIGNED FILE E3500287 1000 IF (FCBBUF(6).LT.0) GO TO 900 E3500288C SET THE CORRECT FILE TYPE E3500289 FCBBUF(87)=1 E3500290 IF (GOTCHR.EQ.$52) FCBBUF(87)=2 E3500291C CLEAR THE RPG ARRAY DATA FLAG E3500292 FCBBUF(86)=0 E3500293C SET UP LINE NUMBER PARAMETERS E3500294 LINENO=0 E3500295 IF (AUTOFG.EQ.0) AUTOFG=10 E3500296C SET UP THE NEXT LINE E3500297 1100 LINENO=LINENO+AUTOFG E3500298C MAKE SURE THE LINE NUMBER ISN'T OUT OF RANGE E3500299 IF (LINENO.LE.32767) GO TO 1150 E3500300ÐÐC SET ILLEGAL LINE NUMBER INTO ERROR E3500301 IDATA(1)=NUMBER(1) E3500302 IDATA(2)=NUMBER(2) E3500303 IDATA(3)=NUMBER(3) E3500304C OUTPUT THE ERROR - ILLEGAL LINE NUMBER @@@@@@@@ E3500305 CALL SYSMSG(EDER01,IDATA) E3500306C SET THE ERROR FLAG E3500307 1125 IERRFG=1 E3500308C CLOSE THE FILE E3500309 CALL CLOSFL(REQBUF,ISTAT) E3500310 GO TO 250 E3500311C READ THE NEXT RECORD FROM THE FILE E3500312 1150 CALL READR(REQBUF,FBUFFR,IRECPT,ISTATX) E3500313C VERIFY THE STATUS OF THE FILE MANAGER E3500314 IF (ISTATX.GE.0) GO TO 1200 E3500315C WAS THIS AN END OF FILE AND NO RECORDS READ E3500316 IF (AND(ISTATX,$0100).NE.0) GO TO 2000 E3500317C ANOTHER KIND OF ERROR HAS OCCURRED E3500318C MOVE THE STATUS TO ERROR E3500319 IDATA(5)=ISTATX E3500320C OUTPUT THE ERROR - FILE MANAGER ERROR WHEN READING FILE @@@@@@@@ E3500321C ISTAT = $$$$ E3500322 CALL SYSMSG(FMER04,IDATA) E3500323 GO TO 1125 E3500324C CONVERT THE LINE NUMBER TO ASCII E3500325ÐÐ 1200 CALL HEXDEC(LINENO,NUMBER) E3500326C HAS THIS RECORD BEEN DELETED E3500327 IF (FBUFFR(1).EQ.IDELFG) GO TO 1800 E3500328C IS THIS THE END OF THE TEXT RECORDS E3500329 IF (FBUFFR(1).EQ.IEOFFM) GO TO 2000 E3500330C IS THIS A NON RPG FILE E3500331 IF (FCBBUF(87).LE.1) GO TO 1500 E3500332C IS THIS AN RPG END OF PROGRAM INDICATOR E3500333 IF (FBUFFR(1).EQ.$2F2A) GO TO 1300 E3500334C IS THIS AN RPG ARRAY DATA INDICATOR E3500335 IF (FBUFFR(1).NE.$2A2A) GO TO 1400 E3500336C IF THE RPG ARRAY DATA FLAG IS NOT SET, SET IT E3500337 1300 IF (FCBBUF(86).EQ.0) FCBBUF(86)=-1 E3500338 GO TO 1500 E3500339C THE RECORD IS RPG CODE. POSITION THE NUMBER IN 1 - 5 E3500340C IF THE RPG ARRAY DATA INDICATOR IS SET, PUT ALL LINE E3500341C NUMBERS ON THE RIGHT SIDE OF THE RECORD E3500342 1400 IF (FCBBUF(86).NE.0) GO TO 1500 E3500343 FBUFFR(1)=AND(NUMBER(1),$00FF)*$100+AND(NUMBER(2),$FF00)/$100 E3500344 FBUFFR(2)=AND(NUMBER(2),$00FF)*$100+AND(NUMBER(3),$FF00)/$100 E3500345 FBUFFR(3)=AND(NUMBER(3),$00FF)*$100+AND(FBUFFR(3),$00FF) E3500346 GO TO 1600 E3500347C THE RECORD IS NON-RPG OR RPG ARRAY DATA E3500348C POSITION THE LINE NUMBER IN 76 - 80 E3500349 1500 FBUFFR(38)=AND(FBUFFR(38),$FF00)+AND(NUMBER(1),$00FF) E3500350ÐÐ FBUFFR(39)=NUMBER(2) E3500351 FBUFFR(40)=NUMBER(3) E3500352C IF THE RPG ARRAY DATA FLAG IS SET, SAVE THIS LINE NUMBER E3500353 1600 IF (FCBBUF(86).EQ.-1) FCBBUF(86)=LINENO E3500354C IS THIS LINE NUMBER HIGHER THAN THE HIGHEST SO FAR E3500355 IF (STNMBR.LT.LINENO) STNMBR=LINENO E3500356C WRITE THIS RECORD BACK TO THE FILE E3500357 CALL UPDREC(REQBUF,FBUFFR,ISTATX) E3500358C VERIFY THE STATUS OF THE FILE MANAGER E3500359 IF (ISTATX.GE.0) GO TO 1700 E3500360C SET STATUS INTO ERROR E3500361 IDATA(5)=ISTATX E3500362C OUTPUT THE ERROR - FILE MANAGER ERROR WHEN UPDATING FILE @@@@@@@@ E3500363C ISTAT = $$$$ E3500364 CALL SYSMSG(FMER11,IDATA) E3500365 GO TO 1125 E3500366C INCREMENT TO THE NEXT RELATIVE RECORD NUMBER E3500367 1700 IRECPT(2)=IRECPT(2)+1 E3500368 GO TO 1100 E3500369C GET THE NEXT RECORD. THE LINE NUMBER IS CORRECT AS IS E3500370 1800 IRECPT(2)=IRECPT(2)+1 E3500371 GO TO 1150 E3500372C SAVE THE NEW HIGHEST STATEMENT NUMBER E3500373 2000 FCBBUF(88)=STNMBR E3500374C CLEAR THE HIGHEST STATEMENT NUMBER E3500375ÐÐ STNMBR=0 E3500376C CLEAR ALL FILE REFENCES AND UPDATE THE FCB E3500377 CALL CLEPRO E3500378 9000 CALL RETURN E3500379 RETURN E3500380 END E3500381 MON 00001 NAM FMEXEC F01 A ITOS CCS 3.0 SL-149F0100001* FILE MANAGER EXECUTIVE F0100002* CREDIT COLLECTION SYSTEM VERSION 3.0 F0100003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F0100004* COPYRIGHT CONTROL DATA CORPORATION 1979 F0100005* F0100006* F0100007**** F0100008* I T O S F I L E M A N A G E R V E R S I O N 2 . 0 F0100009* F0100010* R E Q U E S T E X E C U T I V E F0100011* F0100012* THE REQUEST EXECUTIVE CONTROLS THE PROCESSING OF ALL FILE F0100013* MANAGER REQUESTS. FILE REQUESTS ARE INITIALLY INTERCEPTED F0100014* BY EITHER THE NON-REENTRANT INTERCEPTOR FMENTP OR BY THE F0100015* REENTRANT INTERCEPTOR FMCEPT. THE INTERCEPTORS PERFORM THE F0100016* FOLLOWING INITIALIZATION OF THE CALLER'S REQUEST BUFFER: F0100017* 1. Q-REG AND I-REG CONTENTS ARE SAVED IN REQBUF WORDS 5-6.F0100018ÐÐ* 2. REQBUF(1) IS CLEARED. F0100019* 3. THE CURRENT CONTROL POINT VALUE IS SAVED IN REQBUF(3). F0100020* 4. THE REQUEST INDEX IS COMPUTED AND STORED IN REQBUF(4). F0100021* 5. THE ABSOLUTE ADDRESS OF REQBUF(5) IS STORED IN F0100022* REQBUF(2). F0100023* 6. IF THE REQUEST IS FOR OPEN FILE, REQBUF(8) IS SET TO F0100024* ZERO (UCT ENTRY ADDRESS WORD). F0100025* F0100026* AFTER REQBUF HAS BEEN INITIALIZED, THE INTERCEPTOR EXECUTES F0100027* A RETURN JUMP TO THE REQUEST EXECUTIVE WITH I-REG CONTAININGF0100028* THE ADDRESS OF REQBUF. IF THE REQUEST CAME FROM AN ITOS F0100029* (TIMESHARE) USER AREA, THE ITOS EXECUTIVE PROTECT PROCESSOR F0100030* INTERCEPTS THE RETURN JUMP TO FMEXEC. THE ITOS EXEC VALI- F0100031* DATES THE REQUEST, ASSIGNS AND STORES USER ID INTO REQBUF(9)F0100032* IF THE REQUEST IS FOR OPEN FILE, MOVES THE CONTENTS OF THE F0100033* FIRST 4 WORDS OF REQBUF TO AN ITOS EXEC TABLE, RESETS I-REG F0100034* TO POINT TO THE 4 WORD REQBUF SUBSET AND EXECUTES A RETURN F0100035* JUMP TO FMEXEC. F0100036*E F0100037 EJT F0100038* AFTER BEING ENTERED FROM THE LAST INTERCEPTOR, FMEXEC COM- F0100039* MENCES PROCESSING THE REQUEST. IF THE CURRENT PRIORITY F0100040* LEVEL IS THAT FOR AN UNPROTECTED (NON-ITOS USER AREA) USER, F0100041* UNPIO IS SET TO PREVENT A CORE SWAP WHILE THE REQUEST IS F0100042* BEING PROCESSED. SYSTEM PROGRAM CPSET IS EXECUTED TO SET F0100043ÐÐ* THE CONTROL POINT TO THAT OF THE REQUESTOR AS THE CONTROL F0100044* POINT WILL NOT BE SET IF THE REQUEST HAD BEEN INTERCEPTED F0100045* BY THE ITOS EXEC. IF THE CURRENT PRIORITY LEVEL IS NOT THE F0100046* SAME AS THE INTERNAL PROCESSING LEVEL OF FMEXEC, FMEXEC F0100047* CHANGES TO THE INTERNAL LEVEL VIA A SCHEDULE REQUEST. AS F0100048* MOST PORTIONS OF FILE MANAGER CODE ARE EXECUTED AT THE SAME F0100049* PRIORITY LEVEL, MOST OF THE CODE DOES NOT NEED TO BE FORMAL-F0100050* LY REENTRANT. F0100051* F0100052* FMEXEC VALIDATES A REQUEST AS MUCH AS POSSIBLE BEFORE F0100053* CHECKING IF IT CAN NOW BE EXECUTED. THESE CHECKS INCLUDE F0100054* THE FOLLOWING: F0100055* 1. ASSURE ADDRESS OF LAST WORD OF REQBUF AND ADDRESS OF F0100056* ISTAT ARE NOT ILLEGAL UNPROTECTED ADDRESSES. F0100057* 2. ASSURE ISTAT DOES NOT OVERLAP REQBUF. F0100058* 3. IF THE REQUEST REQUIRES AN OPEN FILE, THE UCT ENTRY F0100059* FOR THE REQUEST IS CHECKED FOR CONSISTANCY WITH RELATEDF0100060* INFORMATION IN REQBUF. F0100061* F0100062* FMEXEC NEXT DETERMINES WHETHER A REENTRANT OR A NON-REEN- F0100063* TRANT PROCESSOR IS NEEDED FOR THE REQUEST AND GETS THE F0100064* ADDRESS OF THE PROCESSOR CONTROL TABLE TO BE USED IN EXECU- F0100065* TING THE REQUEST. IF THE SELECTED CONTROL TABLE INDICATES F0100066* THAT A REQUEST IS ALREADY BEING EXECUTED OUT OF THAT TABLE F0100067* THE (NEW) REQUEST IS THREADED ONTO THE WAITING REQUEST F0100068ÐÐ* QUEUE FOR THAT TABLE. WAITING REQUESTS ARE THREADED FIFO F0100069* WITHIN PRIORITY LEVEL. IF THE TABLE INDICATED THAT NO F0100070* REQUEST WAS BEING EXECUTED OUT OF THE TABLE, THE ACTIVE F0100071* REQUEST FLAG FOR THE TABLE IS SET TO THE REQUESTOR'S REQBUF F0100072* ADDRESS AND FMEXEC PREPARES TO EXECUTE THE REQUEST. F0100073*E F0100074 EJT F0100075* THE FOLLOWING STEPS ARE USED TO EXECUTE A REQUEST: F0100076* 1. THE REQUESTOR'S PRIORITY LEVEL AND CONTROL POINT ARE F0100077* STORED INTO THE PCT (PROCESSOR CONTROL TABLE). F0100078* 2. FCB ADDRESS IS STORED INTO THE PROCESSOR CALL SEQUENCE F0100079* (ADDRESS MAY OR MAY NOT EXIST). F0100080* 3. REQUEST CALL PARAMETER ADDRESSES ARE ABSOLUTIZED AND F0100081* STORED INTO THE PROCESSOR CALL SEQUENCE. ISTAT F0100082* ADDRESS WILL ALWAYS GO TO A FIXED LOCATION. F0100083* 4. IF REQUEST REQUIRES AN OPEN FILE, A CHECK IS MADE TO F0100084* ASSURE REQBUF INFO STILL AGREES WITH THE RELATED UCT F0100085* ENTRY. F0100086* 5. FM LU NO. FOR THE FILE IS STORED INTO THE PCT. F0100087* 6. IF THE REQUEST IS A STORE UPDATE OR A DELETE RECORD F0100088* REQUEST, A CHECK IS MADE TO ASSURE THAT THE RECORDS F0100089* SPECIFIED BY REQBUF ARE LOCKED OR THAT THE FILE IS F0100090* LOCKED. REQUEST ABORTED IF NOT. IF A RECORD LOCK WASF0100091* FOUND, THE RECORD LOCK ENTRY ADDRESS IS STORED INTO F0100092* THE PCT FOR THE PROCESSOR. F0100093ÐÐ* 7. IF THE REQUEST IS A READ RANDOM, GET NEXT, PUT RECORD F0100094* OR WRITE RECORD REQUEST AND A RECORD LOCK EXISTS FOR F0100095* THE FILE FOR THIS USER, THE RECORD LOCK IS DELETED. F0100096* 8. IF THE REQUEST IS A READ OR GET NEXT REQUEST AND RECORDF0100097* LOCKING IS BEING DONE, A CHECK IS MADE TO DETERMINE F0100098* IF ROOM EXISTS IN THE RECORD LOCK TABLE. IF YES, AN F0100099* ENTRY SPACE IS RESERVED (BY BUMPING A COUNTER). IF F0100100* NO, THE REQUEST IS REJECTED. F0100101* 9. IF A REENTRANT PROCESSOR IS TO BE USED, THE PROCESSOR F0100102* IS EXECUTED. A REENTRANT PROCESSOR IS EXECUTED BY F0100103* JUMPING TO THE SECOND WORD OF THE PROCESSOR. F0100104* 10. IF A SERIALLY EXECUTED PROCESSOR IS TO BE USED, A CHECKF0100105* IS MADE TO DETERMINE IF THE PROCESSOR IS IN MAIN ME- F0100106* MORY. IF SO, THE PROCESSOR IS EXECUTED. IF NOT, THE F0100107* REQUIRED PROCESSOR IS READ FROM MASS MEMORY AND THEN F0100108* EXECUTED. PRIOR TO EXECUTING THE PROCESSOR, THE F0100109* ADDRESS OF THE PCT AND THE ADDRESS OF THE ASSOCIATED F0100110* FILE'S FCB (MAY OR MAY NOT EXIST) ARE STORED INTO THE F0100111* FIRST AND SECOND WORDS OF COMMON. THE THIRD WORD OF F0100112* THE PROCESSOR (LOADED FROM MASS MEMORY) DEFINES THE F0100113* ENTRY POINT FOR THE PROCESSOR. A FORTRAN SUBROUTINE F0100114* COMPATIBLE CALL SEQUENCE IS USED TO EXECUTE THE PRO- F0100115* CESSOR. F0100116*E F0100117 EJT F0100118ÐÐ* SERIAL REQUEST PROCESSORS COMPLETE A REQUEST BY EXECUTING F0100119* A RTJ (OR FORTRAN CALL) TO FMSCOM. THEY MAY ALSO ALTERNA- F0100120* TIVELY JUMP TO FMCOMP IF THEY FIRST SET THE I-REG TO THE F0100121* ADDRESS OF THE SERIAL PCT. F0100122* F0100123* A PRIMARY SERIAL REQUEST PROCESSOR (ONE THAT IS EXECUTED F0100124* BY FMEXEC IN RESPONSE TO A USER'S REQUEST) MAY UTILIZE A F0100125* SECONDARY SERIAL PROCESSOR. IN GENERAL, SECONDARY PROCES- F0100126* SORS SHOULD BE USED WHENEVER IT IS REQUIRED TO SPLIT AN F0100127* OVERLY LARGE PROCESSOR INTO SMALLER PARTS. WHEN A SECOND- F0100128* ARY PROCESSOR IS REQUIRED TO BE LOADED AND EXECUTED OR WHEN F0100129* A SECONDARY PROCESSOR HAS COMPLETED ITS FUNCTION AND IS F0100130* READY TO RETURN CONTROL TO THE PRIMARY PROCESSOR, THE PRO- F0100131* CESSOR SWAP IS EFFECTED BY SETTING THE Q AND A REGISTERS F0100132* AS INDICATED BELOW AND EXECUTING A RTJ (OR FORTRAN CALL) TO F0100133* FMSWAP. A AND Q MEANINGS ARE AS FOLLOWS: F0100134* Q POSITIVE, Q HAS INDEX OF NEXT REQUEST PROCESSOR TO BE F0100135* READ AND EXECUTED. F0100136* Q NEGATIVE, READ BACK IN AND RESUME EXECUTION OF SAVED F0100137* PRIMARY PROCESSOR. F0100138* A SPECIFIES WHETHER CURRENT PROCESSOR MUST BE SAVED ON F0100139* MASS MEMORY FOR REUSE (ONLY IF Q.GE.0): F0100140* A.EQ.0, DO NOT SAVE PROCESSOR F0100141* A.NE.0, DO SAVE PROCESSOR F0100142* F0100143ÐÐ* CURRENTLY ONLY ONE PROCESSOR SAVE AREA IS USED, THUS, THE F0100144* FOLLOWING TYPE OF SEQUENCE WILL NOT WORK: F0100145* PRIMARY PROC A REQUESTS SECONDARY PROC B TO BE EXECUTED F0100146* WITH PROC A SAVED F0100147* SECONDARY PROC B REQUESTS SECONDARY PROC C TO BE EXECUTED F0100148* WITH SECONDARY PROC B SAVED F0100149* SECONDARY PROC C REQUESTS PREVIOUS PROC (PROC B) TO BE F0100150* RELOADED AND ITS EXECUTION RESUMED F0100151* SECONDARY PROC B REQUESTS PREVIOUS PROC (PROC A) TO BE F0100152* RELOADED AND ITS EXECUTION RESUMED - WILL FAIL AS THE F0100153* SAVED COPY OF PROC A WAS OVERWRITTEN BY PROC B F0100154*E F0100155 EJT F0100156* WHEN A PROCESSOR IS SAVED ON MASS MEMORY, THE I-REG CONTENTSF0100157* ARE SAVED AND RESTORED PRIOR TO RESUMING ITS EXECUTION UPON F0100158* RELOADING. F0100159* F0100160* A SECONDARY MAY COMPLETE A REQUEST RATHER THAN RETURNING TO F0100161* THE CALLING PRIMARY PROCESSOR. F0100162* F0100163* THE SAME CALL SEQUENCE THAT IS USED FOR PRIMARY PROCESSORS F0100164* IS USED FOR SECONDARY PROCESSORS. F0100165* F0100166* REENTRANT PROCESSORS COMPLETE A REQUEST BY JUMPING TO F0100167* FMCOMP. F0100168ÐÐ* F0100169* ENTRY POINT FMCOME (COMPLETE REQUEST WITH ERROR) IS USED F0100170* ONLY BY THE CHECK FOR ILLEGAL UNPROTECTED ADDRESS SUBROUTINEF0100171* IN FMSUBS. IF THE CALL TO THE SUBROUTINE CAME FROM FMEXEC, F0100172* A JP02 ERROR IS GENERATED. IF THE CALL TO THE SUBROUTINE F0100173* CAME FROM A REQUEST PROCESSOR, A JUMP IS MADE TO FMCOME. F0100174* F0100175* AFTER THE COMPLETE REQUEST LOGIC OF FMEXEC IS ENTERED, A F0100176* CHECK IS MADE TO DETERMINE WHETHER OR NOT THERE IS A WAITINGF0100177* REQUEST FOR THAT PCT. IF SO, THE FIRST WAITING REQUEST IS F0100178* DEFINED TO BE THE NEXT (CURRENT) ACTIVE REQUEST AND THE NEXTF0100179* WAITING REQUEST (MAY OR MAY NOT EXIST) IS DEFINED TO BE THE F0100180* FIRST WAITING REQUEST. NEXT, FMEXEC SCHEDULES BACK TO THE F0100181* REQUESTORS LEVEL FOR FINAL COMPLETION PROCESSING. F0100182*E F0100183 EJT F0100184* IN THE FINAL COMPLETION PROCESSING, THE FOLLOWING IS ACCOM- F0100185* LISHED: F0100186* 1. I-REG IS SET TO THE REQUESTORS REQBUF ADDRESS (4 WORD F0100187* SUBSET). F0100188* 2. CONTROL POINT IS SET TO THE REQUESTORS IF NEEDED. F0100189* 3. A CHECK IS MADE OF THE RQINFO WORD OF REQBUF TO DETER- F0100190* IF THE REQUEST WAS ABORTED BECAUSE OF A PARAMETER F0100191* OVERLAP ERROR. IF YES: F0100192* A. IF REQUESTOR'S LEVEL IS .LE. 2, A JP02 ERROR F0100193ÐÐ* IS GENERATED. F0100194* B. IF REQUESTOR'S LEVEL IS .GE. 3 AND THE REQUESTOR F0100195* HAD BEEN INTERCEPTED BY THE ITOS EXEC, FMEXEC F0100196* SETS Q NEGATIVE AND RETURNS TO THE ITOS INTER- F0100197* CEPTOR. F0100198* C. IF REQUESTOR'S LEVEL IS .GE. 3 AND THE REQUESTOR F0100199* HAD NOT BEEN INTERCEPTED, AN RTJ IS MADE TO F0100200* SYFAIL. F0100201* 4. IF NO ABORTING DUE TO OVERLAPPED PARAMETERS, THE RETURNF0100202* ADDRESS TO THE REQUESTOR IS COMPUTED AND STORED. F0100203* 5. IF THE REQUESTOR'S PRIORITY LEVEL IS .LE. 2 AND THE F0100204* JOB CANCEL FLAG IS SET, FMEXEC JUMPS TO THE DISPATCHERF0100205* AFTER EXECUTING SYSTEM ROUTINE SWAPCK. F0100206* 6. A RETURN IS MADE TO THE LAST INTERCEPTOR WITH Q=0 AND F0100207* I-REG POINTING TO REQBUF. IF THE REQUESTOR'S LEVEL F0100208* WAS .LE. 2, SWAPCK IS EXECUTED PRIOR TO THE RETURN. F0100209*E F0100210 EJT F0100211 SPC 4 F0100212 EQU FMLEVL(9) PRIORITY LEVEL OF FILE MANAGER F0100213 EQU COMLEN(707) LENGTH OF PARTITION COMMON. F0100214* F0100215* ENTRY POINTS F0100216* F0100217 ENT FMEXEC FILE MANAGER EXECUTIVE ENTRY POINT F0100218ÐÐ ENT FMSWAP SWAP PROCESSORS ENTRY FOR SERIAL PROCESSORS F0100219 ENT FMSCOM COMPLETE REQUEST ENTRY FOR SERIAL PROCESSORS F0100220 ENT FMCOMP COMPLETE REQUEST ENTRY FOR REENTRANT PROC,S F0100221 ENT FMCOME COMPLETE REQUEST ENTRY WITH ERROR (REENTRANT) F0100222 ENT FMPPRO PREVIOUS PROCESSOR INDEX (PREV. SER. PROC.) F0100223*E F0100224 EJT F0100225* EXTERNALS F0100226 SPC 2 F0100227* FILE MANAGER COMMON SUBROUTINES F0100228 EXT ABSPAR ABSOLUTIZE PARAMETER ADDRESS F0100229 EXT CKUADR CHECK UNPROTECTED ADDRESS F0100230 EXT LOKCHK CHECK FOR LOCKED RECORD F0100231 EXT REMLOK REMOVE RECORD LOCK TABLE ENTRY F0100232 EXT FMCHKO CHECK UCT ENTRY AND REQBUF FOR OPEN F0100233 SPC 1 F0100234* FM TABLE PARAMETERS F0100235 EXT PCTABL PROCESSOR CONTROL TABLE F0100236 EXT NRERLE NUMBER OF RESERVED RECORD LOCK ENTRY SPACES F0100237 EXT MAXLOC MAX. NO. OF CONCURRENT RECORD LOCKS F0100238 SPC 1 F0100239* FILE MANAGER SYSTEM ADDRESSES F0100240 EXT FMSAVA ADDRESS OF PROCESSOR SAVE AREA ON MASS MEMORY F0100241 SPC 1 F0100242* DISMOUNT VOLUME SYSTEM ORDINAL F0100243ÐÐ EXT DISMNT F0100244 SPC 1 F0100245* SYSDAT PARAMETERS F0100246 EXT PARTBL PARTITION CORE ADDRESS TABLE F0100247 SPC 1 F0100248* MONITOR SYSTEM INTERFACES F0100249 SPC 1 F0100250* PARAMETERS TO PREVENT SWAPS ON UNPROTECTED FILE RECS.F0100251 EXT UNPIO UNPROTECTED I/O IN PROGRESS FLAG (IN TRVEC) F0100252 EXT SWAPCK DECREMENT UNPIO, IF =0, CHECK SWAP (IN DRCORE)F0100253 SPC 1 F0100254 SPC 1 F0100255* J02 PARAMETERS LOCATIONS FOR PROT. IN TRVEC F0100256 EXT LOCF LOCATION OF F (J02 ENTRY) F0100257 EXT LPTRS LOCATION OF PTRS (PARAMETER ADDRESS) F0100258* JOB CANCEL FLAG F0100259 EXT JBCNFG (IN TRVEC) F0100260 SPC 1 F0100261* TIMESHARE EXECUTIVE INTERFACES F0100262 EXT CCP CURRENT CONTROL POINT LOCATION F0100263 EXT CPSET SET CP ADDRESS F0100264 EXT SYFAIL SYSTEM FAILURE ROUTINE F0100265 EXT TSPORT START ADDRESS OF ITOS/TIMESHARE USER TABLE F0100266 EXT TSPEND END ADDRESS OF ITOS/TIMESHARE USER TABLE F0100267*E F0100268ÐÐ EJT F0100269* REENTRANT REQUEST PROCESSOR ADDRESSES F0100270 EXT PUTREC PUT NEW RECORD INTO FILE F0100271 EXT READRC READ RECORDS VIA REL. REC. NUMBER F0100272 EXT GETNXT GET NEXT SEQUENTIAL RECORD F0100273 EXT WRTBAK WRITE BACK UPDATED RECORD F0100274 EXT MRECAD MARK RECORD AS DELETED F0100275 EXT LOCKFL LOCK FILE F0100276 EXT UNLOCK UNLOCK FILE F0100277 EXT COMSEQ COMPRESS SEQUENTIAL FILE F0100278 SPC 2 F0100279* NONREENTRANT REQUEST PROCESSOR EXTERNALS F0100280* REQUEST PROCESSOR SECTOR ADDRESSES F0100281 EXT FMPA01 EXEC FUNCTION (FORCED FILE CLOSE) F0100282 EXT FMPA02 CREATE FILE F0100283 EXT FMPA03 CLEAR FILE F0100284 EXT FMPA04 DELETE FILE F0100285 EXT FMPA05 OPEN FILE F0100286 EXT FMPA06 CLOSE FILE F0100287 EXT FMPA07 GET FILE CONTROL BLOCK F0100288 EXT FMPA08 UPDATE FILE CONTROL BLOCK F0100289 EXT FMPA09 RENAME FILE F0100290 EXT FMPA10 WRITE INDEXED RECORD F0100291 EXT FMPA11 GET NEXT RECORD BY KEY F0100292 EXT FMPA12 GET NEXT RECORD BY KEY F0100293ÐÐ EXT FMPA13 DELETE INDEXED RECORD F0100294 EXT FMPA14 COMPRESS INDEXED FILE F0100295 EXT FMPA15 ALLOCATE MASS MEMORY (SECONDARY PROCESSOR) F0100296 EXT FMPA16 RETURN MASS MEMORY SPACE (SECONDARY PROCESSOR)F0100297 EXT FMPA17 ENABLE/DISABLE VOLUME USE F0100298 EXT FMPA18 SPARE F0100299 EXT FMPA19 SPARE F0100300 SPC 1 F0100301* REQUEST PROCESSOR LAST WORD ADDRESSES F0100302 EXT FMPL01 F0100303 EXT FMPL02 F0100304 EXT FMPL03 F0100305 EXT FMPL04 F0100306 EXT FMPL05 F0100307 EXT FMPL06 F0100308 EXT FMPL07 F0100309 EXT FMPL08 F0100310 EXT FMPL09 F0100311 EXT FMPL10 F0100312 EXT FMPL11 F0100313 EXT FMPL12 F0100314 EXT FMPL13 F0100315 EXT FMPL14 F0100316 EXT FMPL15 F0100317 EXT FMPL16 F0100318ÐÐ EXT FMPL17 F0100319 EXT FMPL18 F0100320 EXT FMPL19 F0100321*E F0100322 EJT F0100323* MISCELLANEOUS TABLE DESCRIPTIONS F0100324 SPC 2 F0100325* USER CONTROL TABLE F0100326* F0100327* THE USER CONTROL TABLE (UCT) KEEPS AN UP-TO-DATE RECORD OF F0100328* WHICH FILES ARE OPEN BY WHICH USERS. THE UCT CONTAINS F0100329* MAXCOP 6-WORD USER/OPEN FILE ENTRIES. A 6-WORD ENTRY CON- F0100330* TAINS THE FOLLOWING INFORMATION. F0100331* F0100332* WORD 1 USER IDENTIFIER F0100333* WORD 2 PSEUDO FILE IDENTIFIER F0100334* BIT 15 PSEUDO LOCK FLAG F0100335* =1, FILE USERS LOCKED OUT. MAIN F0100336* MEMORY IS SWAPPED. SWAPPED F0100337* AREA INCLUDES FCB INFORMATION F0100338* FOR THIS FILE, AND THERE IS F0100339* INSUFFICIENT SPACE TO DUPLICATE F0100340* THIS INFORMATION IN UNSWAPPED F0100341* AREA. F0100342* =0, NO REASON TO LOCK OUT USERS DUE F0100343ÐÐ* TO MAIN MEMORY SWAP. F0100344* BITS 14-11 FILE MANAGER LOGICAL UNIT NUMBER F0100345* BITS 10-00 INDEX OF FCB IN FCB TABLE F0100346* WORD 3 FCB CORE ADDRESS F0100347* WORD 4 FILE SPACE LIMITS TABLE ENTRY ADDRESS, 0 IF NONE F0100348* WORD 5 FCB SUBSET ADDRESS F0100349* WORD 6 CONTROL POINT OF USER (CAN BE CHANGED) F0100350* F0100351* MAXCOP IS A SYSTEM DEPENDENT EQUATED VALUE. F0100352 SPC 4 F0100353* RECORD LOCK TABLE F0100354* F0100355* THIS TABLE MAINTAINS A RECORD OF THE RECORD LOCKS IN EFFECT.F0100356* THIS TABLE HAS MAXLOC 5-WORD ENTRY SPACES, THUS MAXLOC LOCKSF0100357* MAY BE IN EFFECT CONCURRENTLY. EACH ENTRY SPACE CONTAINS F0100358* THE FOLLOWING FIVE WORDS. F0100359* F0100360* WORD 1 PSEUDO FILE IDENTIFIER F0100361* WORD 2 1ST WORD OF RECORD,S RELATIVE RECORD NUMBER F0100362* WORD 3 2ND WORD OF RECORD,S RELATIVE RECORD NUMBER F0100363* WORD 4 NUMBER OF LOCKED RECORDS IN SET F0100364* WORD 5 USER IDENTIFIER (OF LOCKING USER) F0100365* F0100366* A NON-ZERO 1ST WORD INDICATES THAT AN ENTRY SPACE IS IN USE.F0100367* F0100368ÐÐ* MAXLOC IS A SYSTEM DEPENDENT EQUATED VALUE. F0100369*E F0100370 SPC 4 F0100371 EJT F0100372* SEQUENTIAL FILE CONTROL BLOCK TABLE F0100373* F0100374* THIS TABLE IS USED FOR STORAGE OF THE FCB,S OF OPENED F0100375* SEQUENTIAL FILES FOR WHICH A USER SPACE FCB BUFFER WAS F0100376* NOT PROVIDED BY THE USER WHEN THE FILE WAS OPENED. F0100377* F0100378* THIS TABLE CONTAINS ROOM FOR FMMOSF SEQUENTIAL FILE FCBS. F0100379* EACH FCB (WITH ITS HEADER) IS 23 WORDS LONG. A FCB SPACE F0100380* IN THE TABLE IS FREE FOR USE IF ITS FIRST WORD IS ZERO. F0100381* F0100382* FMMOSF IS A SYSTEM DEPENDENT EQUATED VALUE. F0100383 SPC 3 F0100384* INDEXED FILE CONTROL BLOCK TABLE F0100385* F0100386* THIS TABLE IS USED FOR STORAGE OF THE FCB,S OF OPENED F0100387* INDEXED FILES FOR WHICH A USER SPACE FCB BUFFER WAS NOT F0100388* PROVIDED BY THE USER WHEN THE FILE WAS OPENED. F0100389* F0100390* THIS TABLE CONTAINS ROOM FOR FMMOIF INDEXED FILE FCBS. F0100391* EACH FCB (WITH ITS HEADER) IS 38 WORDS LONG. A FCB SPACE F0100392* IN THE TABLE IS FREE FOR USE IF ITS FIRST WORD IS ZERO. F0100393ÐÐ* F0100394* FMMOIF IS A SYSTEM DEPENDENT EQUATED VALUE. F0100395 SPC 3 F0100396* FCB SUBSET CONTROL TABLE F0100397* F0100398* EACH ENTRY IN THE FCB SUBSET CONTROL TABLE (FSCT) F0100399* CORRESPONDS TO AN OPEN FILE. THE ENTRY FOR A GIVEN FILE F0100400* CONTAINS THAT SUBSET OF THE FILE'S FCB WHICH IS SUBJECT F0100401* TO CHANGE WHILE A FILE IS OPEN. AN OPEN FILE WILL HAVE F0100402* AN ENTRY IN THE FSCT IF AND ONLY IF THERE IS NO ENTRY IN F0100403* THE FILE MANAGER MAIN MEMORY FCB TABLES FOR THAT FILE AND F0100404* ONE OR BOTH OF THE FOLLOWING CONDITIONS HOLDS- F0100405* (A) THE NECESSARY FCB WORDS FOR THIS FILE ARE CURRENTLY F0100406* STORED IN TWO OR MORE USER SPACES, F0100407* (B) THE NECESSARY FCB WORDS ARE STORED IN USER SPACE F0100408* FOR A SWAPPED OUT USER. F0100409*E F0100410 EJT F0100411* FILE SPACE LIMITS TABLE F0100412* F0100413* THIS TABLE MAINTAINS A RECORD OF THE BEGINNING WORD ADDRESS F0100414* AND ENDING WORD ADDRESS + 1 FOR EACH OPEN FILE THAT HAS ITS F0100415* FCB IN USER SPACE. THIS TABLE HAS MAXFSL*4 WORD ENTRY F0100416* SPACES. EACH FOUR WORD ENTRY SPACE HAS THE FOLLOWING INFOR-F0100417* MATION WHEN IN USE: F0100418ÐÐ* F0100419* WORD 1 START WORD ADDRESS, MSB F0100420* WORD 2 START WORD ADDRESS, LSB F0100421* WORD 3 ENDING WORD ADDRESS + 1, MSB F0100422* WORD 4 ENDING WORD ADDRESS + 1, LSB F0100423* F0100424* MAXFSL IS A SYSTEM DEPENDENT EQUATED VALUE. F0100425 SPC 3 F0100426* MASS MEMORY LOGICAL UNIT TABLE F0100427* F0100428* THE MASS MEMORY LOGICAL UNIT TABLE IS USED TO DEFINE THE F0100429* ADDRESSES OF THE VOLUME INFORMATION TABLES. THE FIRST WORD F0100430* OF THIS TABLE DEFINES THE NUMBER OF VOLUME INFORMATION F0100431* TABLES IN THE SYSTEM. EACH VOLUME DEFINED VIA THE VOLUME F0100432* INFORMATION TABLE MAY BE USED BY THE FILE MANAGER FOR FILES.F0100433 SPC 4 F0100434* PROCESSOR CONTROL TABLE F0100435* F0100436* THE PROCESSOR CONTROL TABLE IS USED TO DEFINE THE ADDRESSES F0100437* OF THE REQUEST PROCESSOR CONTROL TABLES. THE FIRST WORD OF F0100438* THE TABLE CONTAINS THE ADDRESS OF THE TABLE TO BE USED FOR F0100439* PROCESSING SERIALLY EXECUTED REQUESTS. THE REMAINING WORDS F0100440* CONTAIN THE ADDRESSES OF TABLES TO BE FOR PROCESSING REEN- F0100441* TRANTLY EXECUTABLE REQUESTS, IN FM LOGICAL UNIT NUMBER ORDERF0100442*E F0100443ÐÐ EJT F0100444* EQUIVALENCES F0100445 SPC 2 F0100446* COMMUNICATION REGION CONSTANTS F0100447 EQU ZERO(2) ZERO CONSTANT F0100448 EQU ONEMSK(3) ONE MASK TABLE F0100449 EQU ZROMSK($13) ZERO MASK TABLE F0100450 EQU ONEBIT($23) ONE BIT TABLE F0100451 EQU ZROBIT($33) ZERO BIT TABLE F0100452 EQU AVOLR($BA) ADDRESS OF VOLATILE RELEASE F0100453 EQU AVOLA($BB) ADDRESS OF VOLATILE ASSIGN F0100454 EQU ADISP($EA) ADDRESS OF DISPATCHER F0100455 EQU PL($EF) PRIORITY LEVEL F0100456 EQU AMONI($F4) ADDRESS OF MONITOR REQUEST ENTRY F0100457 EQU HUPLVL(2) HIGHEST UNPROTECTED LEVEL F0100458* F0100459* MISCELLANEOUS F0100460 EQU PUTS(11) PUTS REQUEST INDEX F0100461 EQU WRITER(12) WRITER REQUEST INDEX F0100462 EQU REDRAN(13) READ RANDOM REQUEST INDEX F0100463 EQU STOUPD(15) UPDATE RECORD REQUEST INDEX F0100464 EQU DELREC(16) DELETE RECORD REQUEST INDEX F0100465* F0100466 EQU DMTLEV(4) DISMOUNT VOLUME ORDINAL PRIORITY LEVEL F0100467* F0100468ÐÐ* F0100469* VOLATILE CORE INDEXES FOR FMEXEC F0100470 EQU VQ(0) Q-REGISTER F0100471 EQU VRCDT(1) SAVED REQUEST CALL DEFINITION TABLE WORD F0100472 EQU VI(2) I-REGISTER F0100473 EQU VRAINT(3) RETURN ADDRESS TO INTERCEPTOR F0100474 EQU VRLEV(4) PRIORITY LEVEL OF USER (THIS WORD IS REFERENC-F0100475* ED BY CKUADR AS RPRLEV) F0100476 EQU VASTAT(5) ADDRESS OF STATUS WORD F0100477 EQU VIND(6) REQUEST INDEX F0100478 EQU VARBMP(7) ADDRESS OF REQBUF (MAIN PART - 20 WORDS) F0100479 EQU NVWRDS(8) NUMBER OF WORDS USED BY FMEXEC F0100480 SPC 1 F0100481* UCT ENTRY EQUIVALENCES F0100482 EQU UIDENT(ZERO) USER IDENTIFICATION F0100483 EQU FIDENT(1) PSEUDO FILE IDENTIFIER F0100484 EQU FCBCAD(2) FCB CORE ADDRESS F0100485 EQU FSLADR(3) FILE SPACE LIMITS TABLE ENTRY ADDRESS F0100486 EQU FCBSAD(4) FCB SUBSET ADDRESS F0100487 EQU USRCPT(5) USERS CONTROL POINT F0100488*E F0100489 EJT F0100490* REQUEST BUFFER INDEXES - FIRST 4 WORDS F0100491 EQU RBATHR(0) REQUEST BUFFER ADDRESS THREAD F0100492 EQU BUFAMP(1) BUFFER ADDRESS MAIN PART F0100493ÐÐ EQU CNTLPT(2) CONTROL POINT (OR SPARE) F0100494 EQU RQINFO(3) REQUEST INFORMATION (MULTI-FIELD) F0100495* BITS USE F0100496* 15-12 SPARE F0100497* 11-04 REQUEST INDEX F0100498* 03-00 LEVEL OF REQUESTOR F0100499* F0100500* REQUEST BUFFER INDEXES - MAIN PART F0100501 EQU QREG(0) Q REGISTER F0100502 EQU IREG(1) I REGISTER F0100503 EQU PARLST(2) ADDRESS OF PARAMETER LIST F0100504 EQU RTNADR(2) RETURN ADDRESS TO USER (UPON RETURN FROM EXEC)F0100505 EQU UCTADR(3) UCT ENTRY ABSOLUTE ADDRESS F0100506 EQU USERID(4) USER IDENTIFIER F0100507 EQU FCBADR(5) FCB ADDRESS (MAY BE SET BY CALLER OR INTCPTR.)F0100508 EQU RADINT(6) RETURN ADDRESS TO INTERCEPTOR F0100509 EQU RPIDX(7) REQUEST PROCESSOR INDEX AND I/O FLAG 123*4935F0100510* BITS 13-00 REQUEST PROCESSOR INDEX 123*4935F0100511* BIT 14 I/O FLAG 123*4935F0100512* =0, NO I/O DONE FOR REQT 123*4935F0100513* =1, I/O DONE FOR REQUEST 123*4935F0100514* BIT 15 TYPE OF PROCESSOR F0100515* =0, SERIAL PROCESSOR F0100516* =1, REENTRANT PROCESSOR F0100517 EQU LOKREC(8) NUMBER OF RECORDS TO BE READ/WRITTEN PER I/O F0100518ÐÐ* CALL AND LOCK RECORDS ON RETRIEVE FLAG F0100519* BITS 14-00 NUMBER OF RECORDS PER CALL F0100520* BIT 15 =0, DO NOT LOCK ON RETRIEVE F0100521* =1, LOCK RECORDS ON RETRIEVE F0100522 EQU USEFLG(9) TYPE OF FILE USE FLAG F0100523* -1, OPEN FOR COMPRESSION F0100524* -2, OPEN FOR SPECIAL PROCESSING F0100525* 0, OPEN FOR ACESS VIA REL REC NO F0100526* 1, OPEN FOR RETRIEVAL VIA KEY 1 F0100527* 2, OPEN FOR RETRIEVAL VIA KEY 2 F0100528* 3, OPEN FOR RETRIEVAL VIA KEY 3 F0100529* 4, OPEN FOR RETRIEVAL VIA KEY 4 F0100530 EQU NUMREC(10) NUMBER OF RECORDS ACTUALLY STORED/RETRIEVED F0100531 EQU RRNMSB(11) REL REC NUMBER OF STORED/RETRIEVED REC, MSB F0100532 EQU RRNLSB(12) REL REC NUMBER OF STORED/RETRIEVED REC, LSB F0100533 EQU RMPLEN(20) LENGTH OF REQBUF MAIN PART F0100534*E F0100535 EJT F0100536* FILE CONTROL BLOCK EQUIVALENCES F0100537 EQU FH(4) LENGTH -1 OF FCB HEADER F0100538 EQU FILEID(ZERO) FILE IDENTIFIER F0100539* ACCESS FILEID INDIRECTLY F0100540* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBERF0100541* BITS 10-00 INDEX OF FCB IN FCB TABLE F0100542 EQU FCBFLG(1) FCB FLAGS F0100543ÐÐ* BITS 15-8, SPARE F0100544* BITS 7-00, NUMBER OF USERS USING FILE F0100545 EQU FILOCK(2) FILE LOCK FLAG (IF NON-0, CONTAINS USER ID) F0100546 EQU NUMSET(3) NUMBER OF SETS OF LOCKED RECORDS IN FILE F0100547 EQU NUMNEW(4) NUMBER OF NEW RECORDS SINCE FCB UPDATED ON MM F0100548 SPC 1 F0100549 EQU RECLEN(FH+1) RECORD LENGTH IN WORDS F0100550 EQU TDATRM(FH+2) TOTAL NUMBER OF DATA RECORDS, MSB F0100551 EQU TDATRL(FH+3) TOTAL NUMBER OF DATA RECORDS, LSB F0100552 EQU DATBAM(FH+4) DATA RECORDS BEGINNING SECTOR ADDRESS, MSB F0100553 EQU DATBAL(FH+5) DATA RECORDS BEGINNING SECTOR ADDRESS,LMSB F0100554 EQU FCBIND(FH+6) FCB INDICATORS F0100555* BIT 15 , SECTOR ALLIGNED RECORDS IF =1 F0100556* BIT 14 , STORAGE MODE FOR INDEXED FILE F0100557* =0, RECORDS STORED RANDOMLY WITHF0100558* RESPECT TO PRIMARY KEY F0100559* =1, RECORDS STORED IN ORDER WIT F0100560* RESPECT TO PRIMARY KEY F0100561* BIT 13 , =1, FILE IS CURRENTLY OPEN F0100562* =0, FILE IS CURRENTLY CLOSED F0100563* BIT 12 , =1, FILE IS BEING COMPRESSED F0100564* =0, FILE IS NOT BEING COMPRESSEDF0100565* BIT 11 , =1, FILE IS OPEN FOR SPECIAL F0100566* PROCESSING F0100567* =0, FILE IS NOT OPEN FOR SPECIALF0100568ÐÐ* PROCESSING F0100569* BIT 8 , =1, RECORDS CONTAIN BINARY DATA F0100570* =0, RECORDS DO NOT CONTAIN F0100571* BINARY DATA F0100572* BIT 0 , FILE TYPE F0100573* =0, SEQUENTIAL FILE F0100574* =1, INDEXED FILE F0100575 EQU NEDATM(FH+7) NUMBER OF EXISTING DATA RECORDS, MSB F0100576 EQU NEDATL(FH+8) NUMBER OF EXISTING DATA RECORDS, LSB F0100577 EQU SEQLTH(NEDATL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F0100578* OF FCB FOR A SEQUENTIAL FILE F0100579 SPC 1 F0100580 EQU NEXTBM(FH+9) NEXT FREE KEY INDEX BLOCK, MSB F0100581 EQU NEXTBL(FH+10) NEXT FREE KEY INDEX BLOCK, LSB F0100582 EQU TNKEYM(FH+11) TOTAL NUMBER OF KEY INDEX BLOCKS, MSB F0100583 EQU TNKEYL(FH+12) TOTAL NUMBER OF KEY INDEX BLOCKS, LSB F0100584 EQU KEYBAM(FH+13) KEY INDEX BEGINNING SECTOR ADDRESS, MSB F0100585 EQU KEYBAL(FH+14) KEY INDEX BEGINNING SECTOR ADDRESS, LSB F0100586 EQU LENKY1(FH+15) LENGTH OF KEY NO. 1 F0100587 EQU POSKY1(FH+16) BYTE POSITION OF KEY NO. 1 F0100588 EQU LENKY2(FH+17) LENGTH OF KEY NO. 2 F0100589 EQU POSKY2(FH+18) BYTE POSITION OF KEY NO. 2 F0100590 EQU LENKY3(FH+19) LENGTH OF KEY NO. 3 F0100591 EQU POSKY3(FH+20) BYTE POSITION OF KEY NO. 3 F0100592 EQU LENKY4(FH+21) LENGTH OF KEY NO. 4 F0100593ÐÐ EQU POSKY4(FH+22) BYTE POSITION OF KEY NO. 4 F0100594 EQU INDLEN(POSKY4-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F0100595* OF FCB FOR AN INDEXED FILE F0100596 EJT F0100597* THE FOLLOWING PORTION OF THE FCB EXISTS ONLY F0100598* ON MASS MEMORY. THESE 10 WORDS ARE NOT LOADEDF0100599* INTO EITHER OF THE FILE MANAGER CONTROLLED FCBF0100600* TABLES. F0100601 EQU TSFILM(FH+23) TOTAL NUMBER OF SECTORS IN FILE, MSB F0100602 EQU TSFILL(FH+24) TOTAL NUMBER OF SECTORS IN FILE, LSB F0100603 EQU NAME12(FH+25) FILE NAME, CHARACTERS 1 AND 2 F0100604 EQU NAME34(FH+26) FILE NAME, CHARACTERS 3 AND 4 F0100605 EQU NAME56(FH+27) FILE NAME, CHARACTERS 5 AND 6 F0100606 EQU NAME78(FH+28) FILE NAME, CHARACTERS 7 AND 8 F0100607 EQU OWNR12(FH+29) OWNER NAME, CHARACTERS 1 AND 2 F0100608 EQU OWNR34(FH+30) OWNER NAME, CHARACTERS 3 AND 4 F0100609 EQU OWNR56(FH+31) OWNER NAME, CHARACTERS 5 AND 6 F0100610 EQU OWNR78(FH+32) OWNER NAME, CHARACTERS 7 AND 8 F0100611 EQU BYTLEN(FH+33) BYTE LENGTH OF RECORD F0100612* F0100613* FOR COMPRESS ONLY F0100614* F0100615 EQU PRSRNM(FH+34) RRN OF LAST PROCESSED RECORD - MSB F0100616 EQU PRSRNL(FH+35) RRN OF LAST PROCESSED RECORD - LSB F0100617 EQU NEWRNM(FH+36) RRN OF THE LATEST 'NEW' RECORD - MSB F0100618ÐÐ EQU NEWRNL(FH+37) RRN OF THE LATEST 'NEW' RECORD - LSB F0100619 SPC 4 F0100620* WORDS 0 THRU 4 OF THE FCB HEADER AND WORDS F0100621* 6 THRU 10 OF THE FCB ARE REFERRED TO AS THE F0100622* SHARED SUBSET OF THE FCB. THEY INCLUDE THE F0100623* ONLY FCB WORDS THAT CAN BE MODIFIED AFTER FILEF0100624* CREATION. IF TWO OR MORE USERS HAVE THE SAME F0100625* FILE OPEN, THERE HAS TO BE A SINGLE MASTER F0100626* COPY OF THE SUBSET THAT RECEIVES (AND RECORDS)F0100627* ALL OF THE UPDATES. THE CONTROLLED SUBSET F0100628* WILL ALWAYS BE PART OF A MAIN MEMORY RESIDENT F0100629* FCB IF THE FCB IS IN A FM CONTROLLED TABLE. F0100630* IF THE FCB IS IN USER SPACE, THE SUBSET MAY ATF0100631* TIMES RESIDE IN THE SUBSET CONTROL TABLE. F0100632 SPC 2 F0100633* ALTERNATE NAMES FOR SUBSET WORDS F0100634 EQU SAFCBI(FH+1) SUBSET ALTERNATE NAME FOR FCBIND F0100635 EQU SADATM(FH+2) SUBSET ALTERNATE NAME FOR NEDATM F0100636 EQU SADATL(FH+3) SUBSET ALTERNATE NAME FOR NEDATL F0100637 EQU SANXTM(FH+4) SUBSET ALTERNATE NAME FOR NEXTBM F0100638 EQU SANXTL(FH+5) SUBSET ALTERNATE NAME FOR NEXTBL F0100639*E F0100640 EJT F0100641* REQUEST PROCESSOR CONTROL TABLE F0100642* F0100643ÐÐ EQU RP(10) INDEX TO START OF REQUEST PARAMETERS F0100644 EQU MR(RP+5) INDEX TO START OF MONITOR REQUEST PARAM LIST F0100645 EQU SS(MR+10) INDEX TO START OF SCRATCH PORTION OF PAR LIST F0100646* F0100647 EQU RPLOGU(1) LU NUMBER OF MM DEVICE F0100648 EQU RPAREQ(2) ACTIVE REQUEST FLAG (IF 0, NONE FOR TABLE) F0100649 EQU RPWAIT(3) START OF WAITING REQUEST QUEUE (IF 0, NO WAITGF0100650 EQU RPRLEV(4) REQUEST PRIORITY LEVEL - ACTIVE REQUEST F0100651 EQU RPRBF4(5) REQBUF ADDRESS - FIRST FOUR WORDS F0100652 EQU RPLTEA(6) LOCK TABLE ENTRY (ABSOLUTE) ADDRESS F0100653 EQU RPRTNJ(7) RETURN JUMP TO REQUEST PROCESSOR F0100654 EQU RPPADR(8) PROCESSOR ADDRESS F0100655 SPC 1 F0100656* PARAMETER LIST FOR REQUEST PROCESSOR F0100657 EQU RPFCBA(9) FCB ADDRESS FOR FILE F0100658 EQU RPRBMP(RP+0) REQBUF ADDRESS - MAIN PART F0100659 EQU RPPFP1(RP+1) REQUEST PARAMETER ADDRESS - FIRST + 1 F0100660 EQU RPPFP2(RP+2) REQUEST PARAMETER ADDRESS - FIRST + 2 F0100661 EQU RPPFP3(RP+3) REQUEST PARAMETER ADDRESS - FIRST + 3 F0100662 EQU RPPFP4(RP+4) REQUEST PARAMETER ADDRESS - FIRST + 4 F0100663 SPC 1 F0100664* MAIN MONITOR REQUEST F0100665 EQU RPMREQ(MR+0) MONITOR REQUEST CODE WORD F0100666 EQU RPMRP1(MR+1) COMPLETION ADDRESS F0100667 EQU RPMRP2(MR+2) THREAD WORD F0100668ÐÐ EQU RPMRP3(MR+3) LOGICAL UNIT FOR I/O F0100669 EQU RPMRP4(MR+4) NUMBER OF WORDS F0100670 EQU RPMRP5(MR+5) START CORE ADDRESS F0100671 EQU RPMRP6(MR+6) MASS MEMORY ADDRESS, MSB F0100672 EQU RPMRP7(MR+7) MASS MEMORY ADDRESS, LSB F0100673 EQU RPRCPT(MR+8) CONTROL POINT (FOR I/O REQUESTS) F0100674 EQU RPRETN(MR+9) SAVED RETURN ADDRESS F0100675* ALTERNATE COMMON NAMES F0100676 EQU REQBUF(RP+0) USERS FIRST CALL PARAMETER ADDRESS F0100677 EQU ISTAT(RP+4) USERS COMPLETION STATUS PARAMETER ADDRESS F0100678*E F0100679 EJT F0100680* VOLUME INFORMATION TABLE F0100681* F0100682 EQU VISLUN(2) SYSTEM LOGICAL UNIT NUMBER (BIT 15=1,NOT READYF0100683* ACCESS VISLUN INDIRECTLY F0100684 EQU VINAME(1) VOLUME NAME - ASCII CHARACTERS 1 AND 2 F0100685* VOLUME NAME - ASCII CHARACTERS 3 AND 4 F0100686* VOLUME NAME - ASCII CHARACTERS 5 AND 6 F0100687* VOLUME NAME - ASCII CHARACTERS 7 AND 8 F0100688 EQU VINMBR(5) VOLUME NUMBER - (2 ASCII CHARACTERS) F0100689 EQU VIBMSM(6) BEGINNING OF MANAGEABLE SPACE - MSB F0100690 EQU VIBMSL(7) BEGINNING OF MANAGEABLE SPACE - LSB F0100691 EQU VIASDM(8) AVAILABLE SPACE DIRECTORY ADDRESS - MSB F0100692 EQU VIASDL(9) AVAILABLE SPACE DIRECTORY ADDRESS - LSB F0100693ÐÐ EQU VIASDS(10) # SECTORS IN AVAILABLE SPACE DIRECTORY F0100694 EQU VILBAM(11) LARGEST BLOCK OF SPACE AVAILABLE - MSB F0100695 EQU VILBAL(12) LARGEST BLOCK OF SPACE AVAILABLE - LSB F0100696 EQU VIWPS(13) WORDS/SECTOR FOR VOLUME F0100697 EQU VIFDDM(14) FILE DEFINITION DIRECTORY ADDRESS - MSB F0100698 EQU VIFDDL(15) FILE DEFINITION DIRECTORY ADDRESS - LSB F0100699 EQU VIMAXF(16) MAX. NUMBER OF FILES PERMITTED ON VOLUME F0100700 EQU VICURF(17) CURRENT NUMBER OF FILES EXISTING ON VOLUME F0100701 EQU VINFDB(18) NUMBER OF BLOCKS IN FILE DEFINITION DIRECTORY F0100702 EQU VINXTB(19) NEXT AVAILABLE BLOCK IN FILE DEF. DIRECTORY F0100703 EQU VINOOF(20) NUMBER OF OPEN FILES ON VOLUME 121*4618F0100704 EQU VILBLM(21) VOLUME LABEL SECTOR - MSB 121*4618F0100705 EQU VILBLL(22) VOLUME LABEL SECTOR - LSB 121*4618F0100706*E F0100707 EJT F0100708* REQUEST CALL DEFINITION TABLE F0100709* F0100710* THIS TABLE DEFINES CERTAIN INFORMATION FOR EACH REQUEST F0100711* (CALL) MADE TO THE FILE MANAGER. EACH FILE MANAGER REQUEST F0100712* HAS A 1-WORD ENTRY IN THE TABLE. THE TABLE IS INDEXED USINGF0100713* A REQUEST PROCESSOR INDEX THAT MUST HAVE BEEN STORED IN THE F0100714* CALLERS REQBUF PRIOR TO ENTRY INTO THIS FM REQUEST EXECUTIVEF0100715* F0100716* EACH DEFINITION WORD HAS THE FOLLOWING INFORMATION FIELDS F0100717* BITS INFORMATION F0100718ÐÐ* A 15-14 TYPE OF PROCESSOR REQUIRED F0100719* =0, SERIAL PROCESSOR F0100720* =1, REENTRANT PROCESSOR F0100721* =2, REENTRANT/SERIAL (DEPENDS ON ACCESS MODE) F0100722* =3, NOT DEFINED F0100723* F0100724* B 13 OPEN FILE REQUIREMENT F0100725* =0, OPEN FILE NOT REQUIRED F0100726* =1, OPEN FILE REQUIRED F0100727* F0100728* C 12-08 PRIMARY REQUEST PROCESSOR INDEX INTO 122*4855F0100729* TABLE FMSPDT OR FMCRPA (DEPENDING ON TYPE).122*4855F0100730* F0100731* D 07-04 ALTERNATE REQUEST PROCESSOR INDEX INTO 122*4855F0100732* TABLE FMSPDT OR FMCRPA (DEPENDING ON TYPE).122*4855F0100733* THE ALTERNATE INDEX IS USED IF THE PROCESSOR TYPE F0100734* CODE IS 2 AND THE FILE IS OPENED FOR RETRIEVAL BY F0100735* RELATIVE RECORD NUMBER. F0100736* F0100737* E 03-00 NUMBER OF PARAMETERS IN REQUEST CALL F0100738* A B C D E F0100739FMRCDT NUM $0002 0. EXEC FUNCTION 0 0 0 0 2 F0100740 NUM $0103 1. CREATE FILE 0 0 1 0 3 F0100741 NUM $0203 2. CLEAR FILE 0 0 2 0 3 F0100742 NUM $0303 3. DELETE FILE 0 0 3 0 3 F0100743ÐÐ NUM $0403 4. OPEN FILE 0 0 4 0 3 F0100744 NUM $2502 5. CLOSE FILE 0 1 5 0 2 F0100745 NUM $6502 6. LOCK FILE 1 1 5 0 2 F0100746 NUM $6602 7. UNLOCK FILE 1 1 6 0 2 F0100747 NUM $0605 8. GET FCB 0 0(1) 6 0 5 F0100748 NUM $0705 9. UPDATE FCB 0 0(1) 7 0 5 F0100749 NUM $0804 10. RENAME FILE 0 0 8 0 4 F0100750 NUM $6004 11. PUT SEQUENTIAL RECORD 1 1 0 0 4 F0100751 NUM $2904 12. WRITE RECORD 0 1 9 0 4 F0100752 NUM $AA14 13. READ RECORD RANDOMLY 2 1 10 1 4 F0100753 NUM $AB24 14. GET NEXT SEQUENTIAL RECD 2 1 11 2 4 F0100754 NUM $6303 15. UPDATE RECORD 1 1 3 0 3 F0100755 NUM $AC43 16. DELETE RECORD 2 1 12 4 3 F0100756 NUM $AD73 17. COMPRESS FILE 2 1 13 7 3 F0100757 NUM $1004 18. ENABLE/DISABLE VOL USE 0 0 16 0 4 F0100758 NUM $1203 19. REDUCE FILE SPACE 0 0 18 0 3 F0100759 NUM 0 20. SPARE F0100760**** F0100761 EJT F0100762* SERIAL PROCESSOR ADDRESS/END ADDRESS TABLE F0100763* F0100764* THIS TABLE DEFINES THE SECTOR ADDRESS AND ENDING MAIN MEMORYF0100765* ADDRESS OF EACH MASS RESIDENT SERIALLY-EXECUTED REQUEST F0100766* PROCESSOR. EACH PROCESSOR HAS A TWO WORD ENTRY. WORD 1 OF F0100767* EACH ENTRY IS THE SECTOR ADDRESS. WORD 2 IS THE ENDING MAINF0100768ÐÐ* MEMORY ADDRESS. F0100769* F0100770* THIS TABLE IS ACCESSED USING A REQUEST PROCESSOR INDEX FROM F0100771* THE REQUEST CALL DEFINITION TABLE. F0100772* (TABLE INDEX = R.P. INDEX * 2) F0100773* F0100774* EXEC FUNCTION (FORCED FILE CLOSE) F0100775FMSPDT ADC FMPA01 PROCESSOR SECTOR ADDRESS F0100776 ADC FMPL01 ENDING MAIN MEMORY ADDRESS F0100777* F0100778* CREATE FILE F0100779 ADC FMPA02 PROCESSOR SECTOR ADDRESS F0100780 ADC FMPL02 ENDING MAIN MEMORY ADDRESS F0100781* F0100782* CLEAR FILE F0100783 ADC FMPA03 PROCESSOR SECTOR ADDRESS F0100784 ADC FMPL03 ENDING MAIN MEMORY ADDRESS F0100785* F0100786* DELETE FILE F0100787 ADC FMPA04 PROCESSOR SECTOR ADDRESS F0100788 ADC FMPL04 ENDING MAIN MEMORY ADDRESS F0100789* F0100790* OPEN FILE F0100791 ADC FMPA05 PROCESSOR SECTOR ADDRESS F0100792 ADC FMPL05 ENDING MAIN MEMORY ADDRESS F0100793ÐÐ* F0100794* CLOSE FILE F0100795 ADC FMPA06 PROCESSOR SECTOR ADDRESS F0100796 ADC FMPL06 ENDING MAIN MEMORY ADDRESS F0100797* F0100798* GET FILE CONTROL BLOCK F0100799 ADC FMPA07 PROCESSOR SECTOR ADDRESS F0100800 ADC FMPL07 ENDING MAIN MEMORY ADDRESS F0100801* F0100802* UPDATE FILE CONTROL BLOCK F0100803 ADC FMPA08 PROCESSOR SECTOR ADDRESS F0100804 ADC FMPL08 ENDING MAIN MEMORY ADDRESS F0100805* F0100806* RENAME FILE F0100807 ADC FMPA09 PROCESSOR SECTOR ADDRESS F0100808 ADC FMPL09 ENDING MAIN MEMORY ADDRESS F0100809 EJT F0100810* WRITE INDEXED RECORD F0100811 ADC FMPA10 PROCESSOR SECTOR ADDRESS F0100812 ADC FMPL10 ENDING MAIN MEMORY ADDRESS F0100813* F0100814* READ RECORD BY KEY F0100815 ADC FMPA11 PROCESSOR SECTOR ADDRESS F0100816 ADC FMPL11 ENDING MAIN MEMORY ADDRESS F0100817* F0100818ÐÐ* GET NEXT RECORD BY KEY F0100819 ADC FMPA12 PROCESSOR SECTOR ADDRESS F0100820 ADC FMPL12 ENDING MAIN MEMORY ADDRESS F0100821* F0100822* DELETE INDEXED RECORD F0100823 ADC FMPA13 PROCESSOR SECTOR ADDRESS F0100824 ADC FMPL13 ENDING MAIN MEMORY ADDRESS F0100825* F0100826* COMPRESS INDEXED FILE F0100827 ADC FMPA14 PROCESSOR SECTOR ADDRESS F0100828 ADC FMPL14 ENDING MAIN MEMORY ADDRESS F0100829* F0100830* ALLOCATE MASS MEMORY SPACE (SECONDARY PROCESSOR) F0100831 ADC FMPA15 PROCESSOR SECTOR ADDRESS F0100832 ADC FMPL15 ENDING MAIN MEMORY ADDRESS F0100833* F0100834* RETURN MASS MEMORY SPACE (SECONDARY PROCESSOR) F0100835 ADC FMPA16 PROCESSOR SECTOR ADDRESS F0100836 ADC FMPL16 ENDING MAIN MEMORY ADDRESS F0100837* F0100838* ENABLE/DISABLE VOLUME USE F0100839 ADC FMPA17 PROCESSOR SECTOR ADDRESS F0100840 ADC FMPL17 ENDING MAIN MEMORY ADDRESS F0100841* F0100842* CORRECT FCB FOR OPEN (SECONDARY PROC.) 122*4855F0100843ÐÐ ADC FMPA18 PROCESSOR SECTOR ADDRESS F0100844 ADC FMPL18 ENDING MAIN MEMORY ADDRESS F0100845* F0100846* REDUCE FILE SPACE 122*4855F0100847 ADC FMPA19 PROCESSOR SECTOR ADDRESS F0100848 ADC FMPL19 ENDING MAIN MEMORY ADDRESS F0100849 EJT F0100850* CORE RESIDENT PROCESSOR ADDRESS TABLE F0100851* F0100852* THIS TABLE DEFINES THE ENTRY POINT ADDRESSES OF THE CORE F0100853* RESIDENT REQUEST PROCESSORS. F0100854* F0100855* THIS TABLE IS ACCESSED USING A REQUEST PROCESSOR INDEX FROM F0100856* THE REQUEST CALL DEFINITION TABLE. F0100857* F0100858FMCRPA ADC PUTREC PUT NEW RECORD INTO FILE F0100859 ADC READRC READ RECORDS VIA REL. REC. NUMBER F0100860 ADC GETNXT GET NEXT SEQUENTIAL RECORD F0100861 ADC WRTBAK WRITE BACK UPDATED RECORD F0100862 ADC MRECAD MARK RECORD AS DELETED F0100863 ADC LOCKFL LOCK FILE F0100864 ADC UNLOCK UNLOCK FILE F0100865 ADC COMSEQ COMPRESS SEQUENTIAL FILE F0100866 EJT F0100867* FILE MANAGER EXECUTIVE F0100868ÐÐ* F0100869FMEXEC NUM 0 F0100870 IIN 0 F0100871 RTJ- (AVOLA) SAVE REGISTERS IN VOLATILE F0100872 ADC NVWRDS F0100873* F0100874 LDQ- PL CHECK IF CALLER UNPROTECTED F0100875 INQ -HUPLVL-1 F0100876 SQP FM10 F0100877 RAO UNPIO YES, SET I/O IN PROGRESS FLAG TO PREVENT SWAP F0100878FM10 EIN 0 F0100879 LDA* FMEXEC PICKUP AND SAVE RETURN ADDRESS TO INTERCEPTOR F0100880 STA- VRAINT,I F0100881 LDA- PL F0100882 STA- VRLEV,I STORE PRIORITY LEVEL FOR CKUADR F0100883 LDQ- VI,I F0100884 LDQ- CNTLPT,Q F0100885 RTJ CPSET SET CONTROL POINT F0100886* F0100887 LDQ- VI,I F0100888 LDA- RQINFO,Q ADD PRIORITY LEVEL TO RQINFO WORD F0100889 ALS 4 F0100890 ADD- PL F0100891 STA- RQINFO,Q F0100892 LDQ- BUFAMP,Q F0100893ÐÐ TRQ A F0100894 INA RMPLEN-1 CHECK IF LAST WORD OF REQBUF (MAIN PART) IS ANF0100895 RTJ (ACUADR) ILLEGAL UNPROTECTED ADDRESS F0100896 LDA- VRAINT,I F0100897 STA- RADINT,Q SAVE RETURN ADDRESS TO INTERCEPTOR IN REQBUF F0100898* F0100899 ENA FMLEVL F0100900 SUB- PL CHECK IF USER AT FM PRIORITY LEVEL F0100901 SAN FM20 SKIP IF NO F0100902 JMP* FM40 GO SET UP FOR REQUEST XQT F0100903* F0100904FM20 IIN 0 F0100905 RTJ- (AVOLR) RELEASE VOLATILE CORE. I NOW HAS ADDRESS OF F0100906 EIN 0 REQBUF F0100907* F0100908 LDQ- I F0100909 RTJ- (AMONI) SCHEDULE FM20 AT FM,S LEVEL. PASS REQBUF F0100910 ADC $5200+FMLEVL ADDRESS VIA Q-REG F0100911 ADC FM30 F0100912 JMP- (ADISP) JUMP TO DISPATCHER F0100913 EJT F0100914FM30 STQ- I STORE REQBUF ADDRESS INTO I F0100915 IIN 0 F0100916 RTJ- (AVOLA) GET VOLATILE F0100917 ADC NVWRDS F0100918ÐÐ EIN 0 F0100919* F0100920 LDQ- VI,I RESET Q TO REQBUF ADDRESS F0100921* F0100922 LDA- CNTLPT,Q CHECK IF REQUESTORS CONTROL POINT IS SAME F0100923 TRA Q AS CURRENT C.P. F0100924 SUB CCP F0100925 SAZ FM40 SKIP IF YES F0100926 RTJ CPSET SET THE REQUESTOR,S CONTROL POINT F0100927* F0100928FM40 LDQ- VI,I RESET Q TO REQBUF ADDRESS F0100929 STQ- (I) SAVE FOR USE LATER 122*4812F0100930 LDA- RQINFO,Q STORE USER LEVEL FOR USE BY CKUADR F0100931 AND- ONEMSK+3 F0100932 STA- VRLEV,I F0100933 LDA- BUFAMP,Q GET ADDRESS OF MAIN PART OF REQBUF F0100934 STA- VARBMP,I SAVE IT IN VOLATILE F0100935 LDA- RQINFO,Q EXTRACT REQUEST INDEX AND SAVE IN VOLATILE F0100936 ARS 4 F0100937 AND- ONEMSK+4 F0100938 STA- VIND,I F0100939 TRA Q F0100940 LDA FMRCDT,Q PICKUP RCDEFT WORD FOR REQUEST, SAVE IN VOLATLF0100941 STA- VRCDT,I F0100942 ARS 8 F0100943ÐÐ AND- ONEMSK+4 SAVE PRIMARY REQ PROC INDEX F0100944 STA* RPINDX F0100945* F0100946 LDA- VRCDT,I COMPUTE RETURN ADDRESS F0100947 AND- ONEMSK+3 GET NUMBER OF PARAMETERS IN CALL F0100948 LDQ- VARBMP,I F0100949 ADD- PARLST,Q F0100950 TRA Q F0100951 RTJ* (ACUADR) CHECK IF ILLEGAL RETURN ADDRESS F0100952 INQ -1 Q = ADDRESS OF COMPLETION STATUS INDICATOR ADRF0100953 RTJ* (AABSPR) ABSOLUTIZE THE INDICATOR ADDRESS F0100954 STA- VASTAT,I SAVE IT F0100955 RTJ* (ACUADR) CHECK IF ILLEGAL UNPROTECTED ADDRESS F0100956 EJT F0100957 LDQ- VI,I RESET Q TO REQBUF ADDRESS F0100958 TRQ A F0100959 SUB- VASTAT,I CHECK IF REQBUF OVERLAPS ISTAT F0100960 SAZ FM50 SKIP IF YES (1ST WORD OF 1ST 4 WORDS) F0100961 SAP FM45 SKIP IF ABSOLUTELY NO F0100962 TRQ A F0100963 INA 3 F0100964 SUB- VASTAT,I CHECK LAST OF FIRST 4 WORDS F0100965 SAP FM50 SKIP IF OVERLAP F0100966* F0100967FM45 LDA- VARBMP,I CHECK 1ST WORD OF MAIN PART (20 WORDS) F0100968ÐÐ SUB- VASTAT,I F0100969 SAZ FM50 SKIP IF ADDRESSES ARE THE SAME F0100970 SAP FM55 SKIP IF ABSOLUTELY NO OVERLAP F0100971 LDA- VARBMP,I F0100972 INA 19 CHECK LAST OF MAIN PART F0100973 SUB- VASTAT,I F0100974 SAM FM55 SKIP IF NO OVERLAP F0100975* F0100976FM50 LDA- RQINFO,Q SET BIT 15 OF RQINFO TO SIGNAL ABORTED REQUESTF0100977 EOR- ONEBIT+15 F0100978 STA- RQINFO,Q F0100979 JMP* FM65 GO RELEASE VOLATILE F0100980* F0100981FM55 LDA- VRCDT,I CHECK IF REQUEST REQUIRES AN OPEN FILE F0100982 AND- ONEBIT+13 F0100983 SAN FM60 SKIP IF YES F0100984 JMP* FM76 F0100985* F0100986FM60 LDQ- VARBMP,I GET ADDRESS OF MAIN PART OF REQBUF F0100987 RTJ* (AFMCHK) CHECK IF UCT ENTRY AGREES WITH REQBUF INFO F0100988 SAZ FM70 SKIP IF YES F0100989* F0100990 LDA* CNA000 SET USER'S ISTAT TO $A000 F0100991FM62 LDQ- VASTAT,I F0100992 STA- (ZERO),Q F0100993ÐÐ* REQUEST IS REJECTED AS REQBUF IS IMPROPERLY F0100994* INITIALIZED F0100995* F0100996FM65 IIN 0 F0100997 RTJ- (AVOLR) RELEASE VOLATILE CORE F0100998 EIN 0 F0100999 JMP FM355 GO COMPLETE REQUEST 122*4843F0101000TEMP NUM 0 F0101001* F0101002FM70 LDA- UCTADR,Q SET ADDRESS OF 2ND UCT WORD F0101003 INA 1 F0101004 STA* TEMP F0101005 LDA* (TEMP) PICKUP 2ND WORD OF UCT ENTRY F0101006 ARS 11 F0101007 AND- ONEMSK+4 EXTRACT FM LU NO. AND SAVE LOCALLY F0101008 STA TEMP2 F0101009 EJT F0101010 LDQ- FCBADR,Q EXTRACT FILE TYPE FROM FCB INDICATOR WORD F0101011 ENA 1 F0101012 AND- FCBIND,Q F0101013 SAZ FM72 SKIP IF FILE IS SEQUENTIAL F0101014 LDA- VIND,I FILE IS INDEXED F0101015 INA -PUTS CHECK IF THIS A PUTS REQUEST F0101016 SAZ FM74 SKIP TO ABORT IF YES F0101017 LDA- VIND,I CHECK IF THIS IS A DELETE RECORD REQUEST F0101018ÐÐ INA -DELREC F0101019 SAN FM76 SKIP IF NO F0101020 LDQ- VARBMP,I GET REQBUF MAIN PART ADDRESS F0101021 LDA- USEFLG,Q CHECK IF OPEN FOR RRN ACCESS F0101022 SAZ FM74 SKIP TO ABORT IF YES F0101023 JMP* FM76 CONTINUE F0101024* F0101025FM72 LDA- VIND,I FILE IS SEQUENTIAL F0101026 INA -WRITER CHECK IF THIS IS A WRITER REQUEST F0101027 SAN FM76 SKIP TO CONTINUE IF NO F0101028FM74 LDA- ZROMSK+13 SET USER'S ISTAT TO $C000 (ILLEGAL REQUEST) F0101029 JMP* FM62 GO STORE IT AND COMPLETE REQUEST F0101030* F0101031FM76 LDQ- VARBMP,I F0101032 LDA- VRCDT,I EXTRACT PROCESSOR TYPE CODE FROM RCDT WORD F0101033 ARS 14 F0101034 AND- ONEMSK+1 F0101035 SAZ FM80 SKIP IF TYPE CODE = 0. (SERIAL PROCESSOR) F0101036 INA -1 CHECK FOR CODE = 1. F0101037 SAZ FM100 SKIP IF CODE = 1. (REENTRANT PROCESSOR) F0101038* F0101039* ASSUME CODE = 2 (AS 3 IS UNDEFINED) F0101040 LDA- USEFLG,Q CHECK IF FILE OPEN FOR KEY RELATED RETRIEVAL F0101041 SAZ FM90 SKIP IF NO- OPEN FOR RRN RETRIEVAL F0101042 SAM FM85 SKIP IF NO- OPEN FOR COMP. OR SPEC PROCESSING F0101043ÐÐ* F0101044FM80 ENQ 0 SET Q TO 0 FOR USE AS INDEX TO RPCTBL F0101045 JMP* FM110 GO SET REQUEST PROCESSOR CONTROL TABLE ADDRESSF0101046* F0101047FM85 LDQ- FCBADR,Q CHECK IF FILE IS SEQUENTIAL F0101048 ENA 1 F0101049 AND- FCBIND,Q F0101050 SAZ FM90 SKIP IF YES F0101051 JMP* FM80 GO USE SERIAL PROCESSOR FOR INDEXED FILE F0101052* F0101053FM90 LDA- VRCDT,I ALTERNATE PROCESSOR IS TO BE USED. GET INDEX.F0101054 ARS 4 F0101055 AND- ONEMSK+3 F0101056 STA* RPINDX SAVE IT F0101057* F0101058FM100 LDQ* TEMP2 SET Q TO SAVED FM LU NO. F0101059 LDA* RPINDX SET BIT 15 OF RPINDX TO SIGNAL REENTRANT PROC.F0101060 ADD- ONEBIT+15 F0101061 STA* RPINDX F0101062* F0101063FM110 LDA PCTABL,Q PICKUP ADDRESS OF RPC TABLE TO BE USED F0101064 STA- VI,I SAVE IN VOLATILE F0101065 LDQ- VARBMP,I SAVE REQUEST PROCESSOR INDEX IN REQBUF F0101066 LDA* RPINDX F0101067 STA- RPIDX,Q F0101068ÐÐ EJT F0101069 LDQ- (I) RESET Q TO ADDRESS OF 1ST PART OF REQBUF F0101070 LDA- RQINFO,Q EXTRACT REQUESTORS PRI. LEV. AND STORE F0101071 AND- ONEMSK+3 LOCALLY. F0101072 STA* TEMP1 F0101073* F0101074 LDQ- VI,I RESET Q TO RPC TABLE ADDRESS F0101075 LDA- RPAREQ,Q CHECK IF THERE IS AN ACTIVE REQUEST F0101076 SAN FM120 SKIP IF YES F0101077 JMP* FM140 GO SET UP TO EXECUTE REQUEST F0101078 SPC 2 F0101079CNA000 NUM $A000 F0101080AFMCHK ADC FMCHKO ADDRESS OF CHECK UCT AND REQBUF FOR OPEN F0101081AABSPR ADC ABSPAR ADDRESS OF ABSOLUTIZE PARAMETER F0101082ACUADR ADC CKUADR ADDRESS OF CHECK IF ILLEGAL UNPROTECTED ADDRESF0101083RPINDX NUM 0 TEMPORARY STORAGE F0101084* F0101085* THREAD THIS REQUEST TO WAITING REQUEST QUEUE F0101086 SPC 4 F0101087FM120 INQ RPWAIT BUMP Q TO ADDRESS OF START OF QUEUE F0101088 STQ* TEMP3 SAVE Q TEMPORARILY 122*4812F0101089 ENQ 0 SET ADDRESSING TO ABSOLUTE MODE FOR 122*4812F0101090 RTJ CPSET SEARCHING QUEUE 122*4812F0101091 LDQ* TEMP3 RELOAD Q-R 122*4812F0101092FM125 STQ* TEMP3 SAVE LAST POINTER ADDRESS F0101093ÐÐ LDQ- (ZERO),Q GET NEXT THREADED REQUEST F0101094 SQZ FM130 SKIP IF NO NEXT F0101095* F0101096 ENA $F IS REQUEST,S PRIORITY GREATER THAN THE PRI- F0101097 AND- RQINFO,Q ORITY OF THE NEXT WAITING REQUEST. F0101098 SUB* TEMP1 F0101099 SAM FM130 YES, THREAD IT F0101100 JMP* FM125 CONTINUE SEARCH F0101101* F0101102FM130 STQ* TEMP1 SAVE LAST POINTER TO NEXT REQUEST F0101103 LDQ* TEMP3 RESET Q TO LAST POINTER F0101104 LDA- (I) F0101105 STA- (ZERO),Q STORE POINTER TO REQUEST BUFFER INTO (LSTPTR) F0101106 LDA* TEMP1 F0101107 LDQ- (I) STORE SAVED REQBUF(0) WORD INTO REQBUF(0) F0101108 STA- (ZERO),Q (REQUEST NOW COMPLETELY THREADED) F0101109 IIN 0 F0101110 RTJ- (AVOLR) RELEASE VOLATILE AND JUMP TO THE DISPATCHER F0101111 EIN 0 F0101112 JMP- (ADISP) F0101113 EJT F0101114* NO REQUEST WAS ALREADY BEING EXECUTED OUT OF F0101115* THIS RPC TABLE SO THE CURRENT REQUEST CAN BE F0101116* EXECUTED NOW. F0101117FM140 LDA- (I) SET THE ACTIVE REQUEST FLAG TO REQBUF ADDRESS F0101118ÐÐ STA- RPAREQ,Q F0101119 IIN 0 F0101120 RTJ- (AVOLR) RELEASE VOLATILE - UPON RETURN I POINTS TO RPCF0101121 EIN 0 TABLE F0101122* F0101123FM150 LDQ- RPAREQ,I SET UP TO EXECUTE THE CURRENTLY 'ACTIVE' REQSTF0101124 STQ- RPRBF4,I SET RPRBF4 TO REQBUF ADDRESS FOR COMPLETION F0101125 LDA- CNTLPT,Q STORE CONTROL POINT FOR REQUEST INTO RP TABLE F0101126 STA- RPRCPT,I F0101127 LDA- RQINFO,Q F0101128 AND- ONEMSK+3 EXTRACT REQUEST LEVEL FROM RQINFO WORD OF F0101129 STA- RPRLEV,I REQBUF AND STORE IN RPC TABLE F0101130 LDA- RQINFO,Q EXTRACT REQUEST INDEX FROM RQINFO F0101131 ARS 4 F0101132 AND- ONEMSK+7 F0101133 TRA Q F0101134 LDA FMRCDT,Q PICK UP REQUEST,S WORD FROM REQ DEF TABLE F0101135 AND- ONEMSK+3 EXTRACT NO. OF PARAMETERS IN CALL F0101136 STA* TEMP1 STORE LOCALLY F0101137 LDQ- RPAREQ,I RESET Q TO REQBUF ADDRESS F0101138 LDQ- BUFAMP,Q F0101139 STQ- RPRBMP,I STORE REQBUF MAIN PART ADDRESS IN TABLE F0101140 LDA- FCBADR,Q STORE FILE'S FCB ADDRESS IN A RPC TABLE IF F0101141 STA- RPFCBA,I IT EXISTS F0101142* F0101143ÐÐ* PREPARE TO ABSOLUTIZE ADDRESSES OF ALL CALL F0101144* PARAMETERS F0101145 ENA 1 SET TEMP2 TO 1 FOR NUMBER OF ADDRESSES ABSOLU-F0101146 STA* TEMP2 TIZED F0101147 LDA- I SET TEMP3 TO ADDRESS OF 2ND PARAM ADDRESS -1 F0101148 INA RPPFP1-1 FOR STORE F0101149 STA* TEMP3 F0101150* F0101151FM160 LDQ- REQBUF,I PICKUP PARAM LIST F0101152 LDQ- PARLST,Q F0101153 ADQ* TEMP2 F0101154 RTJ ABSPAR ABSOLUTIZE THIS ADDRESS F0101155 RAO* TEMP3 BUMP STORE ADDRESS BY 1 F0101156 STA* (TEMP3) STORE INTO RPC TABLE F0101157 RAO* TEMP2 BUMP NO. OF PARAM ADDRESSES ABSOLUTIZED BY 1 F0101158 LDA* TEMP2 F0101159 SUB* TEMP1 CHECK IF ALL PARAMS HAVE BEEN ABSOLUTIZED F0101160 SAZ FM165 SKIP IF YES F0101161 JMP* FM160 GO ABSOLUTIZE NEXT PARAM ADDRESS F0101162 EJT F0101163TEMP1 NUM 0 TEMPORARY STORAGE F0101164TEMP2 NUM 0 TEMPORARY STORAGE F0101165TEMP3 NUM 0 TEMPORARY STORAGE F0101166* PARAMETERS FOR LOKCHK CALL F0101167MSBRRN NUM 0 RELATIVE RECORD NUMBER, MSB F0101168ÐÐLSBRRN NUM 0 RELATIVE RECORD NUMBER, LSB F0101169NRECS NUM 0 NUMBER OF RECORDS LOCKED F0101170ADPLST ADC MSBRRN ABSOLUTE ADDRESS OF PARAMETER LIST F0101171 SPC 2 F0101172FM165 LDA* (TEMP3) ASSURE ISTAT WORD OF RPC TABLE HAS ISTAT ADDR.F0101173 STA- ISTAT,I F0101174 LDQ- RPAREQ,I RESET Q TO ADDRESS OF 4 WORD HEADER F0101175 LDA- RQINFO,Q CHECK IF THIS REQUEST REQUIRES AN OPEN FILE F0101176 ARS 4 F0101177 AND- ONEMSK+7 F0101178 TRA Q F0101179 LDA FMRCDT,Q CHECK OPEN FILE BIT IN FMRCDT WORD F0101180 AND- ONEBIT+13 F0101181 SAZ FM175 SKIP IF NOT REQUIRED F0101182* F0101183 LDQ- RPAREQ,I F0101184 LDQ- BUFAMP,Q SET Q TO ADDRESS OF MAIN PART OF REQBUF F0101185 RTJ* (AFMCHK) CHECK IF UCT ENTRY AND REQBUF INFO STILL AGREEF0101186* (FILE MAY HAVE BEEN CLOSED BY FFCLOS) F0101187 SAZ FM170 SKIP IF BOTH AGREE F0101188 LDA* CNA000 SET USER'S ISTAT TO $A000 F0101189 JMP* FM240 GO STORE ISTAT F0101190* F0101191FM170 LDQ- REQBUF,I EXTRACT FM LU NUMBER FROM THE FILE ID WORD F0101192 LDQ- UCTADR,Q AND STORE IN THE PROCESSOR CONTROL TABLE F0101193ÐÐ LDQ- FCBSAD,Q F0101194 LDA- (FILEID),Q F0101195 ARS 11 F0101196 AND- ONEMSK+3 F0101197 STA- RPLOGU,I F0101198FM175 LDQ- RPRBMP,I CHECK IF RECORD LOCKING IN EFFECT F0101199 LDA- LOKREC,Q F0101200 SAM FM180 SKIP IF YES F0101201 JMP* FM260 CONTINUE AT FM260 F0101202* F0101203FM180 LDQ- RPRBF4,I CHECK IF THIS IS A STORE UPDATED RECORD OR F0101204 LDA- RQINFO,Q DELETE RECORD REQUEST F0101205 ARS 4 F0101206 AND- ONEMSK+7 EXTRACT REQUEST INDEX AND SAVE IT IN Q F0101207 TRA Q F0101208 INA -STOUPD FIRST, CHECK IF A STORE UPDATED RECORD REQUESTF0101209 SAZ FM190 SKIP IF YES F0101210 TRQ A NEXT, CHECK IF A DELETE RECORD REQUEST F0101211 INA -DELREC F0101212 SAZ FM190 SKIP IF YES F0101213 JMP* FM210 CONTINUE AT FM210 F0101214 EJT F0101215FM190 LDQ- REQBUF,I SET UP TO CHECK IF THE RECORDS SPECIFIED BY F0101216 LDA- RRNMSB,Q REQBUF ARE CURRENTLY LOCKED BY THIS USER. F0101217 STA* MSBRRN F0101218ÐÐ LDA- RRNLSB,Q F0101219 STA* LSBRRN F0101220 LDA- NUMREC,Q F0101221 STA* NRECS SET NUMBER OF RECORDS F0101222 LDQ* ADPLST SET Q TO LIST ADDRESS TO SIGNAL TYPE OF CHECK F0101223 RTJ* (ALOKCK) CHECK IF A RECORD LOCK EXISTS F0101224 SAN FM200 SKIP IF YES F0101225* F0101226 LDQ- REQBUF,I CHECK IF FILE IS LOCKED BY THE CALLER F0101227 LDQ- UCTADR,Q F0101228 LDQ- FCBSAD,Q F0101229 LDA- FILOCK,Q SKIP IF FILE NOT LOCKED AT ALL F0101230 SAZ FM195 F0101231 LDQ- REQBUF,I CHECK IF LOCKED BY THIS CALLER F0101232 EOR- USERID,Q F0101233 SAZ FM205 SKIP IF YES F0101234* F0101235FM195 LDA =N$8080 REJECT REQUEST. SET ISTAT TO REFLECT NEITHER F0101236* RECORD NOR FILE IS LOCKED F0101237 JMP* FM240 GO STORE ISTAT F0101238* F0101239FM200 SQZ FM205 SKIP IF LOCK FOUND WAS THE REQUIRED LOCK F0101240 LDA- ZROMSK+12 REJECT REQUEST. SET ISTAT TO REFLECT REQBUF F0101241* IS IMPROPERLY INITIALIZED AND ILLEGAL REQUESTF0101242 JMP* FM240 GO STORE ISTAT F0101243ÐÐ* F0101244FM205 STA- RPLTEA,I STORE LOCK TABLE ENTRY ADDRESS FOR PROCESSOR F0101245 JMP* FM260 GO CHECK FOR TYPE OF PROCESSOR USED F0101246* F0101247FM210 TRQ A CHECK IF A READ RANDOM REQUEST F0101248 INA -REDRAN F0101249 SAZ FM220 SKIP IF YES F0101250 INA -1 NEXT, CHECK IF A GET NEXT SEQUENTIAL REQUEST F0101251 SAZ FM220 SKIP IF YES F0101252 TRQ A F0101253 INA -PUTS CHECK IF A PUT NEW RECORD REQUEST F0101254 SAZ FM220 SKIP IF YES F0101255 INA -1 CHECK IF A WRITE RECORD REQUEST F0101256 SAZ FM220 SKIP IF YES F0101257 JMP* FM260 ELSE GO TO FM260 F0101258 EJT F0101259FM220 STQ* SAVERI SAVE REQUEST INDEX F0101260 ENQ 0 SET Q=0 TO FLAG CHECK FOR ANY LOCK FOR FILE F0101261 RTJ* (ALOKCK) CHECK IF ANY RECORD IN THE FILE IS LOCKED BY F0101262* THIS USER F0101263 SAZ FM230 SKIP IF NONE FOUND F0101264 TRA Q SET Q-REG TO ABS ADDRESS OF ENTRY F0101265 RTJ REMLOK REMOVE THE RECORD LOCK ENTRY FROM THE TABLE F0101266* F0101267FM230 LDQ- REQBUF,I CHECK IF RECORD LOCKS ARE REQUIRED F0101268ÐÐ LDA- LOKREC,Q F0101269 SAM FM235 SKIP IF YES F0101270 JMP* FM260 F0101271* F0101272 F0101273FM235 LDA* SAVERI SKIP TO FM260 IF PUTS OR WRITER REQUEST F0101274 INA -PUTS F0101275 SAZ FM260 F0101276 INA -1 F0101277 SAZ FM260 F0101278 LDA =XMAXLOC CHECK IF TABLE HAS ROOM FOR NEW ENTRY F0101279 SUB* (ANRELR) F0101280 SAN FM250 SKIP IF YES F0101281 LDA =N$8040 REJECT REQUEST F0101282FM240 LDQ- ISTAT,I SET ISTAT TO REFLECT NO ROOM IN TABLE F0101283 STA- (ZERO),Q F0101284 JMP FMCOMP GO COMPLETE REQUEST F0101285* F0101286FM250 RAO* (ANRELR) RESERVE ENTRY SPACE IN LOCK TABLE F0101287* F0101288FM260 LDQ- REQBUF,I CHECK IF REENTRANT PROCESSOR IS USED F0101289 LDA- RPIDX,Q F0101290 SAP FM270 SKIP IF SERIAL PROCESSOR IS USED F0101291 AND- ONEMSK+13 EXTRACT REQUEST PROCESSOR INDEX 123*4935F0101292 TRA Q F0101293ÐÐ LDQ FMCRPA,Q PICKUP ADDRESS OF REENTRANT PROCESSOR F0101294 INQ 1 BUMP BY 1 F0101295 JMP- (ZERO),Q EXECUTE REENTRANT PROCESSOR F0101296 EJT F0101297* A SERIAL PROCESSOR IS TO BE EXECUTED F0101298FM270 TRA Q CHECK IF REQUIRED PROCESSOR IS NOW IN CORE F0101299 SUB* RESPRC F0101300 SAN FM280 SKIP TO READ IN REQUIRED PROCESSOR F0101301 JMP* FM290 GO EXECUTE THE PROCESSOR F0101302* F0101303FM280 LDA* RESPRC SET PREVIOUS PROCESSOR INDEX TO LAST LOADED F0101304 STA* FMPPRO PROCESSOR F0101305 STQ* RESPRC SET NEW RESIDENT PROCESSOR INDEX F0101306 QLS 1 SHIFT PROCESSOR INDEX TO MULTIPLY BY 2 F0101307 LDA* (ASPDT),Q PICK UP SECTOR ADDRESS AND STORE FOR READ F0101308 STA- RPMRP7,I F0101309 INQ 1 F0101310 LDA* (ASPDT),Q COMPUTE LENGTH AND STORE F0101311 SUB* (ADPART) F0101312 INA 1 F0101313 STA- RPMRP4,I F0101314 STA* CURLEN SAVE LENGTH FOR POSSIBLE SAVE F0101315 LDA* READCD STORE READ REQUEST CODE IN REQUEST F0101316 STA- RPMREQ,I F0101317 RTJ REDWRT READ IN REQUEST PROCESSOR F0101318ÐÐFM290 ENQ 1 COMPUTE ADDRESS OF START OF COMMON FOR FM'S F0101319 LDA* (ADPART),Q PARTITION F0101320 SUB =XCOMLEN F0101321 TRA Q F0101322 LDA- I STORE ADDRESS OF PROCESSOR CONTROL TABLE IN F0101323 STA- (ZERO),Q FIRST WORD F0101324 LDA- RPFCBA,I STORE FCB ADDRESS IN WORD 2 F0101325 STA- 1,Q F0101326* F0101327 LDQ* (ADPART) PICKUP ENTRY POINT ADDRESS OF JUST LOADED PROCF0101328 INQ 2 BUMP BY 2 TO SKIP OF 1ST TWO WORDS F0101329 LDA- (ZERO),Q F0101330 STA- RPPADR,I STORE FOR PROCESSOR XQT F0101331 LDQ- I F0101332 INQ RPRTNJ F0101333 JMP- (ZERO),Q JUMP TO RPC TABLE TO EXECUTE PROCESSOR F0101334 EJT F0101335SAVERI NUM 0 SAVED REQUEST INDEX F0101336RESPRC NUM $FF INDEX OF CURRENTLY RESIDENT PROCESSOR F0101337FMPPRO NUM 0 PREVIOUS PROCESSOR INDEX F0101338READCD ADC $4800+FMLEVL*$10+FMLEVL READ REQUEST CODE F0101339SAVLEN NUM 0 LENGTH OF SAVED PROCESSOR F0101340CURLEN NUM 0 LENGTH OF CURRENT RESIDENT PROCESSOR F0101341SAVPRC NUM 0 INDEX OF SAVED PROCESSOR F0101342SAVEDI NUM 0 SAVED I-REG FOR SWAPPED PROCESSOR F0101343ÐÐSAVRTN NUM 0 SAVED RETURN ADDRESS FOR SWAPPED PROCESSOR F0101344SAVADR ADC FMSAVA ADDRESS OF MM REQ PROC SAVE AREA F0101345ASPDT ADC FMSPDT SERIAL PROCESSOR ADDRESS/LENGTH TABLE F0101346WRITCD ADC $4C00+FMLEVL*$10+FMLEVL F0101347ANRELR ADC NRERLE ADDRESS OF NUMBER OF RESERVED RECORD LOCK ENTSF0101348ALOKCK ADC LOKCHK CHECK FOR LOCKED RECORD ROUTINE F0101349 EJT F0101350* SERIALLY EXECUTED REQUEST PROCESSORS EXECUTE F0101351* A RTJ TO FMSWAP TO EFFECT A MODULE SWAP. F0101352* SWAP REQUIREMENTS ARE GIVEN BY A AND Q F0101353* Q POSITIVE, Q HAS INDEX OF NEXT REQUEST F0101354* PROCESSOR TO BE READ AND EXECUTED F0101355* Q NEGATIVE, READ BACK IN SAVED PRI. PROC. F0101356* A SPECIFIES WHETHER CURRENT PROC MUST BE F0101357* SAVED ON MM FOR REUSE (ONLY IF Q.GE.0) F0101358* A = 0, DO NOT SAVE PROC. F0101359* A NOT 0, DO SAVE PROC. F0101360* F0101361FMSWAP 000 000 F0101362 STQ* TEMPA SAVE Q TEMPORARILY F0101363 LDQ- I SAVE I-REG TEMPORARILY F0101364 STQ* TEMPB F0101365 LDQ* (ADPCTB) RESET I-REG TO SERIAL RPC TABLE ADDRESS F0101366 STQ- I F0101367* F0101368ÐÐ LDQ* TEMPA CHECK IF SAVED PROCESSOR MUST BE REREAD F0101369 SQM FM300 SKIP IF YES F0101370 JMP* FM320 F0101371* F0101372* SET UP TO READ AND EXECUTE SAVED PROCESSOR F0101373FM300 LDA* READCD STORE READ REQUEST CODE IN REQUEST F0101374 STA- RPMREQ,I F0101375 LDA* SAVADR SET MM ADDRESS FOR READ F0101376 STA- RPMRP7,I F0101377 LDA* SAVLEN SET NO. OF WORDS FOR READ F0101378 STA* CURLEN RESET CURRENT LENGTH F0101379 STA- RPMRP4,I F0101380 RTJ REDWRT READ BACK IN REQUEST PROCESSOR F0101381 LDA* SAVPRC F0101382 STA* RESPRC RESET INDEX OF RESIDENT PROCESSOR F0101383 LDQ* (ADPART) RESET ENTRY ADDRESS IN PCT F0101384 INQ 2 F0101385 LDA- (ZERO),Q F0101386 STA- RPPADR,I F0101387 LDQ* SAVEDI RESET SAVED I-REG CONTENTS F0101388 STQ- I F0101389 LDQ* SAVRTN RETURN TO SAVED RETURN ADDRESS F0101390 JMP- (ZERO),Q F0101391 EJT 122*4843F0101392* CHECK IF CURRENT PROCESSOR MUST BE SAVED F0101393ÐÐFM320 SAN FM325 SKIP IF YES 122*4843F0101394 JMP* FM330 122*4843F0101395* 122*4843F0101396FM325 LDQ* TEMPB SAVE I-REG CONTENTS FOR PRIMARY 122*4843F0101397* PROCESSOR 122*4843F0101398 STQ* SAVEDI RELOAD F0101399 LDQ* FMSWAP SAVE RETURN ADDRESS TO SAVED PRIMARY PROC F0101400 STQ* SAVRTN F0101401 EJT F0101402* SET UP TO WRITE TO SAVE AREA THE RESIDENT PROCF0101403 LDA* WRITCD F0101404 STA- RPMREQ,I STORE WRITE REQUEST CODE IN REQUEST F0101405 LDA* CURLEN SET LENGTH FOR WRITE F0101406 STA- RPMRP4,I F0101407 STA* SAVLEN SAVE ALSO FOR READ BACK F0101408 LDA* SAVADR SET MM ADDRESS FOR WRITE F0101409 STA- RPMRP7,I F0101410 RTJ REDWRT WRITE OUT PROCESSOR 122*4843F0101411 LDA* RESPRC F0101412 STA* SAVPRC SAVE PROCESSOR INDEX F0101413 LDQ* TEMPA RESET Q TO SAVED INDEX OF NEXT PROCESSOR F0101414FM330 JMP* FM280 GO READ IN THE PROCESSOR F0101415 SPC 2 F0101416TEMPA NUM 0 TEMPORARY STORAGE F0101417TEMPB NUM 0 TEMPORARY STORAGE F0101418ÐÐADPCTB ADC PCTABL PROCESSOR CONTROL TABLE F0101419ADPART ADC PARTBL ADDRESS OF PARTITION CORE TABLE F0101420 EJT F0101421* SERIALLY EXECUTED REQUEST PROCESSORS EXECUTE F0101422* A RTJ TO FMSCOM TO COMPLETE A REQUEST. F0101423FMSCOM 000 000 F0101424 LDQ* (ADPCTB) RESET I-REG TO SERIAL RPC TABLE ADDRESS F0101425 STQ- I F0101426 JMP* FMCOMP GO TO REGULAR COMPLETE REQUEST F0101427 SPC 1 F0101428* COMPLETE SERIAL REQUEST WITH ERROR F0101429* (MAY BE USED BY EXEC) F0101430* F0101431* CHECK IF NO. OF RESERVED RECORD LOCK ENTRIES F0101432* NEEDS TO BE DECREMENTED F0101433FMCOME LDQ- RPRBF4,I FIRST, DETERMINE IF THIS IS A READR OR GETS F0101434 LDA- RQINFO,Q REQUEST F0101435 ARS 4 F0101436 AND- ONEMSK+7 F0101437 INA -REDRAN F0101438 SAZ FM335 SKIP IF READR F0101439 INA -1 F0101440 SAN FMCOMP SKIP IF NOT A GETS REQUEST F0101441FM335 LDQ- REQBUF,I CHECK IF RECORD LOCKING IN EFFECT F0101442 LDA- LOKREC,Q F0101443ÐÐ SAP FMCOMP SKIP IF NO F0101444 LDA* (ADNREL) DECREMENT NUMBER OF RESERVED RECORD LOCK ENTS F0101445 INA -1 F0101446 STA* (ADNREL) F0101447 SPC 1 F0101448* REQUESTS THAT WERE 'ATTACHED' TO A RPC TABLE F0101449* ARE COMPLETED BY LOGIC STARTING HERE. F0101450FMCOMP ENQ 0 SET ADDRESSING TO ABSOLUTE MODE AS 122*4812F0101451 RTJ* (ADCPST) REQUEST MAY BE BACKGROUND REQUEST 122*4812F0101452 LDQ- RPWAIT,I SET ACTIVE REQUEST FLAG FOR NXT RQST 122*4812F0101453 STQ- RPAREQ,I (REQUEST MAY NOT EXIST) F0101454 SQZ FM340 SKIP IF NO NEW REQUEST F0101455 LDA- (ZERO),Q F0101456 STA- RPWAIT,I SET NEW START OF WAITING THREAD F0101457FM340 LDA- RPRLEV,I F0101458 EOR* SCHCOD SET UP SCHEDULE REQUEST TO SCHEDULE BACK TO F0101459 STA* CODWRD USERS LEVEL F0101460 LDQ- RPRBF4,I PASS REQBUF ADDRESS OF COMPLETED REQUEST IN Q F0101461 RTJ- (AMONI) SCHEDULE DOWN F0101462CODWRD NUM 0 F0101463 ADC FM360 F0101464* F0101465 LDQ- RPAREQ,I CHECK IF THERE IS A NEW ACTIVE REQUEST F0101466 SQZ FM350 SKIP IF NO F0101467 LDQ- CNTLPT,Q F0101468ÐÐ TRQ A F0101469 SUB* (ADCCP) CHECK IF CURRENT CONTROL POINT IS SAME AS F0101470 SAZ FM345 NEEDED ONE - SKIP IF YES F0101471 RTJ* (ADCPST) SET CONTROL POINT TO THAT OF NEW USER F0101472FM345 JMP FM150 GO EXECUTE NEW REQUEST F0101473FM350 JMP- (ADISP) NO NEW REQUEST - JUMP TO DISPATCHER F0101474 SPC 2 122*4843F0101475FM355 LDA- RQINFO,I SET UP SCHEDULE REQUEST TO SCHEDULE 122*4843F0101476 AND- ONEMSK+3 BACK TO USER'S LEVEL 122*4843F0101477 EOR* SCHCOD 122*4843F0101478 STA* CODE 122*4843F0101479 LDQ- I PASS REQBUF ADDRESS IN Q 122*4843F0101480 RTJ- (AMONI) SCHEDULE DOWN 122*4843F0101481CODE NUM 0 122*4843F0101482 ADC FM360 122*4843F0101483 JMP- (ADISP) JUMP TO DISPATCHER 122*4843F0101484 SPC 1 F0101485 EJT F0101486* FINAL COMPLETE REQUEST PROCESSING F0101487FM360 STQ- I SET I TO REQBUF ADDRESS F0101488 LDA- CNTLPT,I 122*4843F0101489 TRA Q SET Q AND A TO USERS CONTROL POINT F0101490 SUB* (ADCCP) CHECK IF USERS IS SAME AS CURRENT F0101491 SAZ FM370 SKIP IF YES F0101492 RTJ* (ADCPST) SET THE USERS CONTROL POINT F0101493ÐÐ* F0101494FM370 LDA- RQINFO,I CHECK IF REQUEST WAS ABORTED DUE TO PARAMETER F0101495 SAP FM375 OVERLAP - SKIP IF NO F0101496 JMP* FM400 GO ABORT F0101497* F0101498FM375 LDQ- BUFAMP,I CHECK IF I/O PERFORMED FOR THIS REQT 123*4935F0101499 LDA- RPIDX,Q 123*4935F0101500 AND- ONEBIT+14 123*4935F0101501 SAZ FM376 SKIP IF NO 123*4935F0101502 JMP* FM379 123*4935F0101503* 123*4935F0101504FM376 LDA* SCHCOD AS NO I/O HAS BEEN PERFORMED, SCHEDULE123*4935F0101505 ADD- PL TO LEVEL 4 AND THEN BACK TO USER'S 123*4935F0101506 STA* CODEWD LEVEL 123*4935F0101507 LDQ- I PASS REQBUF ADDRESS IN Q-REG 123*4935F0101508 RTJ- (AMONI) 123*4935F0101509 NUM $5204 SCHEDULE TO LEVEL 4 123*4935F0101510 ADC FM377 123*4935F0101511 JMP- (ADISP) 123*4935F0101512* 123*4935F0101513FM377 RTJ- (AMONI) SCHEDULE BACK TO USER'S LEVEL 123*4935F0101514CODEWD NUM 0 123*4935F0101515 ADC FM378 123*4935F0101516 JMP- (ADISP) 123*4935F0101517* 123*4935F0101518ÐÐFM378 STQ- I RESET I TO REQBUF ADDRESS 123*4935F0101519 LDQ- CNTLPT,I 123*4935F0101520 RTJ* (ADCPST) RESET THE CONTROL POINT 123*4935F0101521 EJT 123*4935F0101522FM379 LDA- RQINFO,I SET UP THE RETURN ADDRESS 123*4935F0101523 ARS 4 123*4935F0101524 AND- ONEMSK+7 F0101525 TRA Q SET Q TO REQUEST INDEX F0101526 LDA FMRCDT,Q F0101527 AND- ONEMSK+3 GET NUMBER OF PARAMETERS IN REQUEST CALL F0101528 LDQ- BUFAMP,I F0101529 ADD- PARLST,Q ADD TO ADDRESS OF PARAMETER LIST F0101530 STA- RTNADR,Q SAVE COMPUTED RETURN ADDRESS (TO CALLER) F0101531* F0101532 LDA- RQINFO,I CHECK IF CALLER WAS UNPROTECTED F0101533 AND- ONEMSK+3 F0101534 INA -HUPLVL-1 F0101535 SAP FM390 SKIP IF NO F0101536 LDA JBCNFG CHECK IF JOB WAS CANCELLED F0101537 SAZ FM380 SKIP IF NO F0101538 RTJ* (ASWAPC) RESET UNPIO, CHECK FOR SWAP F0101539 JMP- (ADISP) JUMP TO DISPATCHER AS USER HAS ABORTED F0101540* F0101541FM380 RTJ* (ASWAPC) RESET UNPIO, CHECK FOR SWAP F0101542FM390 IIN 0 SET UP RETURN TO INTERCEPTOR F0101543ÐÐ LDA- RADINT,Q F0101544 STA* RETADR SET RETURN ADDRESS TO INTERCEPTOR F0101545 ENQ 0 SET Q POSITIVE FOR RETURN F0101546 EIN 0 F0101547 JMP* (RETADR) RETURN F0101548* F0101549RETADR NUM 0 RETURN ADDRESS F0101550ASWAPC ADC SWAPCK F0101551SCHCOD NUM $5200 SCHEDULE REQUEST CODE F0101552ADNREL ADC NRERLE NUMBER OF RESERVED RECORD LOCK ENTRIES F0101553ADCCP ADC CCP ADDRESS OF CURRENT CONTROL POINT F0101554ADCPST ADC CPSET ADDRESS OF SET CONTORL POINT F0101555 EJT F0101556* ABORT REQUEST AS THERE IS AN OVERLAP OF F0101557* PARAMETERS. F0101558* IF REQUEST IS UNPROTECTED, HANDLE AS A JP02 F0101559* ERROR. F0101560* IF REQUEST IS PROTECTED AND THE CALLER IS NOT F0101561* CONTROLLED BY A TIMESHARE/ITOS EXEC, CRASH F0101562* THE SYSTEM VIA A RTJ TO SYFAIL. F0101563* IF REQUEST IS PROTECTED AND THE CALLER IS F0101564* CONTROLLED BY A TIMESHARE/ITOS EXEC, RETURN F0101565* TO THE LAST INTERCEPTOR WITH Q-REG NEGATIVE. F0101566* F0101567FM400 AND- ONEMSK+3 FIRST, CHECK IF UNPROTECTED F0101568ÐÐ TCA A F0101569 INA HUPLVL F0101570 SAM FM410 SKIP IF NO F0101571* F0101572 LDQ- BUFAMP,I SET Q TO ADDRESS OF PARAM LIST F0101573 LDA- PARLST,Q F0101574 LDQ LPTRS F0101575 STA- (ZERO),Q SET ADDRESS OF BAD REQUEST F0101576 RTJ SWAPCK RESET UNPIO AND CHECK IF SWAP DESIRED F0101577 LDQ LOCF F0101578 JMP- (ZERO),Q FORCE THE JP02,XXXX ERROR F0101579 SPC 2 F0101580* REQUEST IS PROTECTED F0101581FM410 LDA =XTSPORT CHECK IF THIS USER IS CONTROLLED BY ITOS/TIME-F0101582 SUB- I SHARE F0101583 SAZ FM420 SKIP IF YES F0101584 SAP FM430 SKIP IF NO F0101585 LDA =XTSPEND F0101586 SUB- I F0101587 SAM FM430 SKIP IF NO F0101588* F0101589FM420 IIN 0 RETURN TO ITOS/TIMESHARE INTERCEPTOR F0101590 LDQ- BUFAMP,I F0101591 LDA- RADINT,Q F0101592 STA* RETADR F0101593ÐÐ ENQ -1 SET Q NEGATIVE AS ABORTED REQUEST FLAG F0101594 EIN 0 F0101595 JMP* (RETADR) RETURN TO INTERCEPTING EXECUTIVE CONTROLLER F0101596* F0101597FM430 RTJ SYFAIL CRASH THE SYSTEM - ERROR IN FOREGROUND PROGRAMF0101598 EJT F0101599* READ OR WRITE REQUEST PROCESSOR F0101600REDWRT 000 000 F0101601 LDA* CADDRS SET UP COMPLETION ADDRESS F0101602 STA- RPMRP1,I F0101603 LDA- I F0101604 INA RPMREQ SET UP ADDRESS OF MONITOR REQUEST F0101605 STA* MRADDR F0101606 LDA (ADPART) SET UP STARTING CORE ADDRESS 122*4843F0101607 STA- RPMRP5,I F0101608 CLR A F0101609 STA- RPMRP6,I CLEAR MSB ADDRESS WORD F0101610 LDA- $C2 SET LOGICAL UNIT FOR I/O F0101611 STA- RPMRP3,I (USE LIBRARY LOG UNIT) F0101612 RTJ- (AMONI) EXECUTE INDIRECT MONITOR REQUEST F0101613 NUM $2000 F0101614MRADDR NUM 0 F0101615 JMP- (ADISP) ADDRESS OF REQUEST IN RPC TABLE F0101616 SPC 2 F0101617CADDRS ADC REDW10 COMPLETION ADDRESS F0101618ÐÐ SPC 2 F0101619REDW10 STQ* MRADDR SAVE COMPLETION STATUS TEMPORARILY F0101620 LDA (ADPCTB) RESET I TO RPC TABLE ADDRESS F0101621 STA- I F0101622 LDA- RPRCPT,I PICKUP REQUESTOR,S CONTROL POINT F0101623 TRA Q HAVE IN A AND Q F0101624 SUB CCP CHECK IF SAME AS CURRENT F0101625 SAZ REDW20 SKIP IF YES F0101626 RTJ CPSET SET CONTROL POINT AS REQUIRED F0101627* F0101628REDW20 LDA* MRADDR PICKUP SAVED I/O STATUS F0101629 SAP REDW30 SKIP IF NO ERROR F0101630* F0101631 LDA =N$8020 SET USERS ISTAT TO $8020 F0101632 LDQ- ISTAT,I REQUEST IS REJECTED AS I/O ERROR OCCURED F0101633 STA- (ZERO),Q F0101634 JMP FMCOMP GO COMPLETE REQUEST F0101635* F0101636REDW30 JMP* (REDWRT) RETURN F0101637 SPC 4 F0101638 END F0101639 NAM FMSUBS F02 A ITOS CCS 3.0 SL-149F0200001* FILE MANAGER SUPPORT SUBROUTINES F0200002* CREDIT COLLECTION SYSTEM VERSION 3.0 F0200003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F0200004ÐÐ* COPYRIGHT CONTROL DATA CORPORATION 1979 F0200005* F0200006* F0200007**** F0200008* I T O S F I L E M A N A G E R V E R S I O N 2 . 0 F0200009* F0200010* C O M M O N S U B R O U T I N E S F0200011* F0200012 ENT ABSPAR ABSOLUTIZE PARAMETER ADDRESS F0200013 ENT CKUADR CHECK UNPROTECTED ADDRESS F0200014 ENT MMREAD MASS MEMORY READ ROUTINE F0200015 ENT MMWRIT MASS MEMORY WRITE ROUTINE F0200016 ENT LOKCHK CHECK FOR LOCKED RECORD F0200017 ENT REMLOK REMOVE RECORD LOCK TABLE ENTRY F0200018 ENT INSLOK INSERT RECORD LOCK INTO LOCK TABLE. F0200019 ENT CLFRIO COMPUTE LENGTH FOR RECORD I/O F0200020 ENT FMUFCB UPDATE FCB ON MASS MEMORY F0200021 ENT FMCHKO CHECK REQBUF AND UCT FOR OPEN F0200022 ENT FMCOVL CHECK FOR OVERLAPPING PARAMETERS F0200023 ENT FMBRRN BUMP RELATIVE RECORD NUMBER BY ONE 121*4675F0200024 ENT FMFSRC CHECK IF SUBSET IS IN SUBSET TABLE 132*5367F0200025 SPC 4 F0200026 EQU FMLEVL(9) PRIORITY LEVEL OF FILE MANAGER F0200027*E F0200028 EJT F0200029ÐÐ* EXTERNALS F0200030 SPC 2 F0200031* FM EXEC ENTRY POINTS F0200032 SPC 1 F0200033* (ERROR RETURN) F0200034 EXT FMCOME COMPLETE REQUEST ENTRY FOR REENTRANT PROC,S F0200035 SPC 1 F0200036* FM TABLE PARAMETERS F0200037 SPC 1 F0200038 EXT MMLUTB MASS MEMORY LOGICAL UNIT TABLE F0200039* F0200040 EXT LRTABL LOCKED RECORDS TABLE F0200041 EXT NRERLE NUMBER OF RESERVED RECORD LOCK ENTRY SPACES F0200042 EXT MAXLOC MAX. NO. OF CONCURRENT RECORD LOCKS F0200043 EXT FSLIMT FILE SPACE LIMITS TABLE 132*5367F0200044 EXT FCBSCT FCB SUBSET CONTROL TABLE 132*5367F0200045 SPC 1 F0200046* MONITOR SYSTEM INTERFACES F0200047 SPC 1 F0200048* J02 PARAMETERS LOCATIONS FOR PROTECT PROT. IN TRVEC F0200049 EXT LOCF LOCATION OF F (J02 ENTRY) F0200050 EXT LPTRS LOCATION OF PTRS (PARAMETER ADDRESS) F0200051 SPC 1 F0200052* PARAMETERS TO PREVENT SWAPS ON UNPROTECTED FILE RECS.F0200053 EXT SWAPCK DECREMENT UNPIO, IF =0, CHECK SWAP (IN DRCORE)F0200054ÐÐ SPC 1 F0200055* PARAMETERS USED TO DETERMINE ABSOLUTIZATION MODE F0200056 EXT END0V4 END ADDRESS OF PART 0. F0200057 SPC 1 F0200058* TIMESHARE EXECUTIVE INTERFACES F0200059 EXT CPSET SET CP ADDRESS F0200060 EXT SYFAIL SYSTEM FAILURE ROUTINE F0200061 SPC 1 F0200062* DISMOUNT VOLUME SYSTEM ORDINAL F0200063 EXT DISMNT F0200064 SPC 1 F0200065* DOUBLE WORD MATH ROUTINES F0200066 EXT DWADD DOUBLE WORD ADD F0200067 EXT DWSUB DOUBLE WORD SUBTRACT F0200068 EXT DWMUL DOUBLE WORD MULTIPLY F0200069*E F0200070 EJT F0200071* MISCELLANEOUS TABLE DESCRIPTIONS F0200072 SPC 2 F0200073* USER CONTROL TABLE F0200074* F0200075* THE USER CONTROL TABLE (UCT) KEEPS AN UP-TO-DATE RECORD OF F0200076* WHICH FILES ARE OPEN BY WHICH USERS. THE UCT CONTAINS F0200077* MAXCOP 6-WORD USER/OPEN FILE ENTRIES. A 6-WORD ENTRY CON- F0200078* TAINS THE FOLLOWING INFORMATION. F0200079ÐÐ* F0200080* WORD 1 USER IDENTIFIER F0200081* WORD 2 PSEUDO FILE IDENTIFIER F0200082* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBER F0200083* BITS 10-00 INDEX OF FCB IN FCB TABLE F0200084* WORD 3 FCB CORE ADDRESS F0200085* WORD 4 FILE SPACE LIMITS TABLE ENTRY ADDRESS, 0 IF NONE F0200086* WORD 5 FCB SUBSET ADDRESS F0200087* WORD 6 CONTROL POINT OF USER (CAN BE CHANGED) F0200088* F0200089* MAXCOP IS A SYSTEM DEPENDENT EQUATED VALUE. F0200090 SPC 4 F0200091* RECORD LOCK TABLE F0200092* F0200093* THIS TABLE MAINTAINS A RECORD OF THE RECORD LOCKS IN EFFECT.F0200094* THIS TABLE HAS MAXLOC 5-WORD ENTRY SPACES, THUS MAXLOC LOCKSF0200095* MAY BE IN EFFECT CONCURRENTLY. EACH ENTRY SPACE CONTAINS F0200096* THE FOLLOWING FIVE WORDS. F0200097* F0200098* WORD 1 PSEUDO FILE IDENTIFIER F0200099* WORD 2 1ST WORD OF RECORD,S RELATIVE RECORD NUMBER F0200100* WORD 3 2ND WORD OF RECORD,S RELATIVE RECORD NUMBER F0200101* WORD 4 NUMBER OF LOCKED RECORDS IN SET F0200102* WORD 5 USER IDENTIFIER (OF LOCKING USER) F0200103* F0200104ÐÐ* A NON-ZERO 1ST WORD INDICATES THAT AN ENTRY SPACE IS IN USE.F0200105* MAXLOC IS A SYSTEM DEPENDENT EQUATED VALUE. F0200106*E F0200107 SPC 4 F0200108 EJT F0200109* SEQUENTIAL FILE CONTROL BLOCK TABLE F0200110* F0200111* THIS TABLE IS USED FOR STORAGE OF THE FCB,S OF OPENED F0200112* SEQUENTIAL FILES FOR WHICH A USER SPACE FCB BUFFER WAS F0200113* NOT PROVIDED BY THE USER WHEN THE FILE WAS OPENED. F0200114* F0200115* THIS TABLE CONTAINS ROOM FOR FMMOSF SEQUENTIAL FILE FCBS. F0200116* EACH FCB (WITH ITS HEADER) IS 23 WORDS LONG. A FCB SPACE F0200117* IN THE TABLE IS FREE FOR USE IF ITS FIRST WORD IS ZERO. F0200118* F0200119* FMMOSF IS A SYSTEM DEPENDENT EQUATED VALUE. F0200120 SPC 3 F0200121* INDEXED FILE CONTROL BLOCK TABLE F0200122* F0200123* THIS TABLE IS USED FOR STORAGE OF THE FCB,S OF OPENED F0200124* INDEXED FILES FOR WHICH A USER SPACE FCB BUFFER WAS NOT F0200125* PROVIDED BY THE USER WHEN THE FILE WAS OPENED. F0200126* F0200127* THIS TABLE CONTAINS ROOM FOR FMMOIF INDEXED FILE FCBS. F0200128* EACH FCB (WITH ITS HEADER) IS 38 WORDS LONG. A FCB SPACE F0200129ÐÐ* IN THE TABLE IS FREE FOR USE IF ITS FIRST WORD IS ZERO. F0200130* F0200131* FMMOIF IS A SYSTEM DEPENDENT EQUATED VALUE. F0200132 SPC 3 F0200133* FCB SUBSET CONTROL TABLE F0200134* F0200135* EACH ENTRY IN THE FCB SUBSET CONTROL TABLE (FSCT) F0200136* CORRESPONDS TO AN OPEN FILE. THE ENTRY FOR A GIVEN FILE F0200137* CONTAINS THAT SUBSET OF THE FILE'S FCB WHICH IS SUBJECT F0200138* TO CHANGE WHILE A FILE IS OPEN. AN OPEN FILE WILL HAVE F0200139* AN ENTRY IN THE FSCT IF AND ONLY IF THERE IS NO ENTRY IN F0200140* THE FILE MANAGER MAIN MEMORY FCB TABLES FOR THAT FILE AND F0200141* ONE OR BOTH OF THE FOLLOWING CONDITIONS HOLDS: F0200142* (A) THE NECESSARY FCB WORDS FOR THIS FILE ARE CURRENTLY F0200143* STORED IN TWO OR MORE USERS SPACES, F0200144* (B) THE NECESSARY FCB WORDS ARE STORED IN USER SPACE F0200145* FOR A SWAPPED OUT USER. F0200146*E F0200147 EJT F0200148 SPC 3 F0200149* FILE SPACE LIMITS TABLE F0200150* F0200151* THIS TABLE MAINTAINS A RECORD OF THE BEGINNING WORD ADDRESS F0200152* AND ENDING WORD ADDRESS + 1 FOR EACH OPEN FILE THAT HAS ITS F0200153* FCB IN USER SPACE. THIS TABLE HAS MAXFSL*4 WORD ENTRY F0200154ÐÐ* SPACES. EACH FOUR WORD ENTRY SPACE HAS THE FOLLOWING INFOR-F0200155* MATION WHEN IN USE: F0200156* F0200157* WORD 1 START WORD ADDRESS, MSB F0200158* WORD 2 START WORD ADDRESS, LSB F0200159* WORD 3 ENDING WORD ADDRESS + 1, MSB F0200160* WORD 4 ENDING WORD ADDRESS + 1, LSB F0200161* F0200162* MAXFSL IS A SYSTEM DEPENDENT EQUATED VALUE. F0200163 SPC 3 F0200164 EJT F0200165* MASS MEMORY LOGICAL UNIT TABLE F0200166* F0200167* THE MASS MEMORY LOGICAL UNIT TABLE IS USED TO DEFINE THE F0200168* ADDRESSES OF THE VOLUME INFORMATION TABLES. THE FIRST WORD F0200169* OF THIS TABLE DEFINES THE NUMBER OF VOLUME INFORMATION F0200170* TABLES IN THE SYSTEM. EACH VOLUME DEFINED VIA THE VOLUME F0200171* INFORMATION TABLE MAY BE USED BY THE FILE MANAGER FOR FILES.F0200172 SPC 4 F0200173* PROCESSOR CONTROL TABLE F0200174* F0200175* THE PROCESSOR CONTROL TABLE IS USED TO DEFINE THE ADDRESSES F0200176* OF THE REQUEST PROCESSOR CONTROL TABLES. THE FIRST WORD OF F0200177* THE TABLE CONTAINS THE ADDRESS OF THE TABLE TO BE USED FOR F0200178* PROCESSING SERIALLY EXECUTED REQUESTS. THE REMAINING WORDS F0200179ÐÐ* CONTAIN THE ADDRESSES OF TABLES TO BE FOR PROCESSING REEN- F0200180* TRANTLY EXECUTABLE REQUESTS, IN FM LOGICAL UNIT NUMBER ORDERF0200181*E F0200182**** F0200183 EJT F0200184* EQUIVALENCES F0200185 SPC 2 F0200186* COMMUNICATION REGION CONSTANTS F0200187 EQU ZERO(2) ZERO CONSTANT F0200188 EQU ONEMSK(3) ONE MASK TABLE F0200189 EQU ZROMSK($13) ZERO MASK TABLE F0200190 EQU ONEBIT($23) ONE BIT TABLE F0200191 EQU ZROBIT($33) ZERO BIT TABLE F0200192 EQU AVOLR($BA) ADDRESS OF VOLATILE RELEASE F0200193 EQU ADISP($EA) ADDRESS OF DISPATCHER F0200194 EQU PL($EF) PRIORITY LEVEL F0200195 EQU AMONI($F4) ADDRESS OF MONITOR REQUEST ENTRY F0200196 EQU HUPLVL(2) HIGHEST UNPROTECTED LEVEL F0200197* F0200198* MISCELLANEOUS F0200199 EQU DMTLEV(4) DISMOUNT VOLUME ORDINAL PRIORITY LEVEL F0200200 EQU LTELEN(5) LOCK TABLE ENTRY LENGTH F0200201 SPC 1 F0200202**** F0200203* UCT ENTRY EQUIVALENCES F0200204ÐÐ EQU UIDENT(ZERO) USER IDENTIFICATION F0200205 EQU FIDENT(1) PSEUDO FILE IDENTIFIER F0200206 EQU FCBCAD(2) FCB CORE ADDRESS F0200207 EQU FSLADR(3) FILE SPACE LIMITS TABLE ENTRY ADDRESS F0200208 EQU FCBSAD(4) FCB SUBSET ADDRESS F0200209 EQU USRCPT(5) USERS CONTROL POINT F0200210*E F0200211 EJT F0200212* REQUEST BUFFER INDEXES - FIRST 4 WORDS F0200213 EQU RBATHR(0) REQUEST BUFFER ADDRESS THREAD F0200214 EQU BUFAMP(1) BUFFER ADDRESS MAIN PART F0200215 EQU CNTLPT(2) CONTROL POINT (OR SPARE) F0200216 EQU RQINFO(3) REQUEST INFORMATION (MULTI-FIELD) F0200217* BITS USE F0200218* 15-12 SPARE F0200219* 11-04 REQUEST INDEX F0200220* 03-00 LEVEL OF REQUESTOR F0200221* F0200222* REQUEST BUFFER INDEXES - MAIN PART F0200223 EQU QREG(0) Q REGISTER F0200224 EQU IREG(1) I REGISTER F0200225 EQU PARLST(2) ADDRESS OF PARAMETER LIST F0200226 EQU RTNADR(2) RETURN ADDRESS TO USER (UPON RETURN FROM EXEC)F0200227 EQU UCTADR(3) UCT ENTRY ABSOLUTE ADDRESS F0200228 EQU USERID(4) USER IDENTIFIER F0200229ÐÐ EQU FCBADR(5) FCB ADDRESS (MAY BE SET BY CALLER OR INTCPTR.)F0200230 EQU RADINT(6) RETURN ADDRESS TO INTERCEPTOR F0200231 EQU RPIDX(7) REQUEST PROCESSOR INDEX AND I/O FLAG F0200232* BITS 13-00 REQUEST PROCESSOR INDEX F0200233* BIT 14 I/O FLAG F0200234* =0, NO I/O DONE FOR REQUEST F0200235* =1, I/O DONE FOR REQUEST F0200236* BIT 15 TYPE OF PROCESSOR F0200237* =0, SERIAL PROCESSOR F0200238* =1, REENTRANT PROCESSOR F0200239 EQU LOKREC(8) NUMBER OF RECORDS TO BE READ/WRITTEN PER I/O F0200240* CALL AND LOCK RECORDS ON RETRIEVE FLAG F0200241* BITS 14-00 NUMBER OF RECORDS PER CALL F0200242* BIT 15 =0, DO NOT LOCK ON RETRIEVE F0200243* =1, LOCK RECORDS ON RETRIEVE F0200244 EQU USEFLG(9) TYPE OF FILE USE FLAG F0200245* -1, OPEN FOR COMPRESSION F0200246* -2, OPEN FOR SPECIAL PROCESSING F0200247* 0, OPEN FOR ACESS VIA REL REC NO F0200248* 1, OPEN FOR RETRIEVAL VIA KEY 1 F0200249* 2, OPEN FOR RETRIEVAL VIA KEY 2 F0200250* 3, OPEN FOR RETRIEVAL VIA KEY 3 F0200251* 4, OPEN FOR RETRIEVAL VIA KEY 4 F0200252 EQU NUMREC(10) NUMBER OF RECORDS ACTUALLY STORED/RETRIEVED F0200253 EQU RRNMSB(11) REL REC NUMBER OF STORED/RETRIEVED REC, MSB F0200254ÐÐ EQU RRNLSB(12) REL REC NUMBER OF STORED/RETRIEVED REC, LSB F0200255 EQU RMPLEN(20) LENGTH OF REQBUF MAIN PART F0200256*E F0200257 EJT F0200258* FILE CONTROL BLOCK EQUIVALENCES F0200259 EQU FH(4) LENGTH -1 OF FCB HEADER F0200260 EQU FILEID(ZERO) FILE IDENTIFIER F0200261* ACCESS FILEID INDIRECTLY F0200262* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBERF0200263* BITS 10-00 INDEX OF FCB IN FCB TABLE F0200264 EQU FCBFLG(1) FCB FLAGS F0200265* BITS 15-8, SPARE F0200266* BITS 7-00, NUMBER OF USERS USING FILE F0200267 EQU FILOCK(2) FILE LOCK FLAG (IF NON-0, CONTAINS USER ID) F0200268 EQU NUMSET(3) NUMBER OF SETS OF LOCKED RECORDS IN FILE F0200269 EQU NUMNEW(4) NUMBER OF NEW RECORDS SINCE FCB UPDATED ON MM F0200270 SPC 1 F0200271 EQU RECLEN(FH+1) RECORD LENGTH IN WORDS F0200272 EQU TDATRM(FH+2) TOTAL NUMBER OF DATA RECORDS, MSB F0200273 EQU TDATRL(FH+3) TOTAL NUMBER OF DATA RECORDS, LSB F0200274 EQU DATBAM(FH+4) DATA RECORDS BEGINNING SECTOR ADDRESS, MSB F0200275 EQU DATBAL(FH+5) DATA RECORDS BEGINNING SECTOR ADDRESS,LMSB F0200276 EQU FCBIND(FH+6) FCB INDICATORS F0200277* BIT 15 , SECTOR ALLIGNED RECORDS IF =1 F0200278* BIT 14 , STORAGE MODE FOR INDEXED FILE F0200279ÐÐ* =0, RECORDS STORED RANDOMLY WITHF0200280* RESPECT TO PRIMARY KEY F0200281* =1, RECORDS STORED IN ORDER WIT F0200282* RESPECT TO PRIMARY KEY F0200283* BIT 13 , =1, FILE IS CURRENTLY OPEN F0200284* =0, FILE IS CURRENTLY CLOSED F0200285* BIT 12 , =1, FILE IS BEING COMPRESSED F0200286* =0, FILE IS NOT BEING COMPRESSEDF0200287* BIT 11 , =1, FILE IS OPEN FOR SPECIAL F0200288* PROCESSING F0200289* =0, FILE IS NOT OPEN FOR SPECIALF0200290* PROCESSING F0200291* BIT 8 , =1, RECORDS CONTAIN BINARY DATA F0200292* =0, RECORDS DO NOT CONTAIN F0200293* BINARY DATA F0200294* BIT 0 , FILE TYPE F0200295* =0, SEQUENTIAL FILE F0200296* =1, INDEXED FILE F0200297 EQU NEDATM(FH+7) NUMBER OF EXISTING DATA RECORDS, MSB F0200298 EQU NEDATL(FH+8) NUMBER OF EXISTING DATA RECORDS, LSB F0200299 EQU SEQLTH(NEDATL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F0200300* OF FCB FOR A SEQUENTIAL FILE F0200301 SPC 1 F0200302 EQU NEXTBM(FH+9) NEXT FREE KEY INDEX BLOCK, MSB F0200303 EQU NEXTBL(FH+10) NEXT FREE KEY INDEX BLOCK, LSB F0200304ÐÐ EQU TNKEYM(FH+11) TOTAL NUMBER OF KEY INDEX BLOCKS, MSB F0200305 EQU TNKEYL(FH+12) TOTAL NUMBER OF KEY INDEX BLOCKS, LSB F0200306 EQU KEYBAM(FH+13) KEY INDEX BEGINNING SECTOR ADDRESS, MSB F0200307 EQU KEYBAL(FH+14) KEY INDEX BEGINNING SECTOR ADDRESS, LSB F0200308 EQU LENKY1(FH+15) LENGTH OF KEY NO. 1 F0200309 EQU POSKY1(FH+16) BYTE POSITION OF KEY NO. 1 F0200310 EQU LENKY2(FH+17) LENGTH OF KEY NO. 2 F0200311 EQU POSKY2(FH+18) BYTE POSITION OF KEY NO. 2 F0200312 EQU LENKY3(FH+19) LENGTH OF KEY NO. 3 F0200313 EQU POSKY3(FH+20) BYTE POSITION OF KEY NO. 3 F0200314 EQU LENKY4(FH+21) LENGTH OF KEY NO. 4 F0200315 EQU POSKY4(FH+22) BYTE POSITION OF KEY NO. 4 F0200316 EQU INDLEN(POSKY4-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F0200317* OF FCB FOR AN INDEXED FILE F0200318 EJT F0200319* THE FOLLOWING PORTION OF THE FCB EXISTS ONLY F0200320* ON MASS MEMORY. THESE 10 WORDS ARE NOT LOADEDF0200321* INTO EITHER OF THE FILE MANAGER CONTROLLED FCBF0200322* TABLES. F0200323 EQU TSFILM(FH+23) TOTAL NUMBER OF SECTORS IN FILE, MSB F0200324 EQU TSFILL(FH+24) TOTAL NUMBER OF SECTORS IN FILE, LSB F0200325 EQU NAME12(FH+25) FILE NAME, CHARACTERS 1 AND 2 F0200326 EQU NAME34(FH+26) FILE NAME, CHARACTERS 3 AND 4 F0200327 EQU NAME56(FH+27) FILE NAME, CHARACTERS 5 AND 6 F0200328 EQU NAME78(FH+28) FILE NAME, CHARACTERS 7 AND 8 F0200329ÐÐ EQU OWNR12(FH+29) OWNER NAME, CHARACTERS 1 AND 2 F0200330 EQU OWNR34(FH+30) OWNER NAME, CHARACTERS 3 AND 4 F0200331 EQU OWNR56(FH+31) OWNER NAME, CHARACTERS 5 AND 6 F0200332 EQU OWNR78(FH+32) OWNER NAME, CHARACTERS 7 AND 8 F0200333 EQU BYTLEN(FH+33) BYTE LENGTH OF RECORD F0200334* F0200335* FOR COMPRESS ONLY F0200336* F0200337 EQU PRSRNM(FH+34) RRN OF LAST PROCESSED RECORD - MSB F0200338 EQU PRSRNL(FH+35) RRN OF LAST PROCESSED RECORD - LSB F0200339 EQU NEWRNM(FH+36) RRN OF THE LATEST 'NEW' RECORD - MSB F0200340 EQU NEWRNL(FH+37) RRN OF THE LATEST 'NEW' RECORD - LSB F0200341 SPC 4 F0200342* WORDS 0 THRU 4 OF THE FCB HEADER AND WORDS F0200343* 6 THRU 10 OF THE FCB ARE REFERRED TO AS THE F0200344* SHARED SUBSET OF THE FCB. THEY INCLUDE THE F0200345* ONLY FCB WORDS THAT CAN BE MODIFIED AFTER FILEF0200346* CREATION. IF TWO OR MORE USERS HAVE THE SAME F0200347* FILE OPEN, THERE HAS TO BE A SINGLE MASTER F0200348* COPY OF THE SUBSET THAT RECEIVES (AND RECORDS)F0200349* ALL OF THE UPDATES. THE CONTROLLED SUBSET F0200350* WILL ALWAYS BE PART OF A MAIN MEMORY RESIDENT F0200351* FCB IF THE FCB IS IN A FM CONTROLLED TABLE. F0200352* IF THE FCB IS IN USER SPACE, THE SUBSET MAY ATF0200353* TIMES RESIDE IN THE SUBSET CONTROL TABLE. F0200354ÐÐ SPC 2 F0200355* ALTERNATE NAMES FOR SUBSET WORDS F0200356 EQU SAFCBI(FH+1) SUBSET ALTERNATE NAME FOR FCBIND F0200357 EQU SADATM(FH+2) SUBSET ALTERNATE NAME FOR NEDATM F0200358 EQU SADATL(FH+3) SUBSET ALTERNATE NAME FOR NEDATL F0200359 EQU SANXTM(FH+4) SUBSET ALTERNATE NAME FOR NEXTBM F0200360 EQU SANXTL(FH+5) SUBSET ALTERNATE NAME FOR NEXTBL F0200361*E F0200362 EJT F0200363* VOLUME INFORMATION TABLE F0200364* F0200365 EQU VISLUN(2) SYSTEM LOGICAL UNIT NUMBER (BIT 15=1,NOT READYF0200366* ACCESS VISLUN INDIRECTLY F0200367 EQU VINAME(1) VOLUME NAME - ASCII CHARACTERS 1 AND 2 F0200368* VOLUME NAME - ASCII CHARACTERS 3 AND 4 F0200369* VOLUME NAME - ASCII CHARACTERS 5 AND 6 F0200370* VOLUME NAME - ASCII CHARACTERS 7 AND 8 F0200371 EQU VINMBR(5) VOLUME NUMBER - (2 ASCII CHARACTERS) F0200372 EQU VIBMSM(6) BEGINNING OF MANAGEABLE SPACE - MSB F0200373 EQU VIBMSL(7) BEGINNING OF MANAGEABLE SPACE - LSB F0200374 EQU VIASDM(8) AVAILABLE SPACE DIRECTORY ADDRESS - MSB F0200375 EQU VIASDL(9) AVAILABLE SPACE DIRECTORY ADDRESS - LSB F0200376 EQU VIASDS(10) # SECTORS IN AVAILABLE SPACE DIRECTORY F0200377 EQU VILBAM(11) LARGEST BLOCK OF SPACE AVAILABLE - MSB F0200378 EQU VILBAL(12) LARGEST BLOCK OF SPACE AVAILABLE - LSB F0200379ÐÐ EQU VIWPS(13) WORDS/SECTOR FOR VOLUME F0200380 EQU VIFDDM(14) FILE DEFINITION DIRECTORY ADDRESS - MSB F0200381 EQU VIFDDL(15) FILE DEFINITION DIRECTORY ADDRESS - LSB F0200382 EQU VIMAXF(16) MAX. NUMBER OF FILES PERMITTED ON VOLUME F0200383 EQU VICURF(17) CURRENT NUMBER OF FILES EXISTING ON VOLUME F0200384 EQU VINFDB(18) NUMBER OF BLOCKS IN FILE DEFINITION DIRECTORY F0200385 EQU VINXTB(19) NEXT AVAILABLE BLOCK IF FILE DEF. DIRECTORY F0200386 EQU VINOOF(20) NUMBER OF OPEN FILES ON VOLUME F0200387 EQU VILBLM(21) VOLUME LABEL SECTOR - MSB 121*4619F0200388 EQU VILBLL(22) VOLUME LABEL SECTOR - LSB 121*4619F0200389*E F0200390 EJT F0200391* REQUEST PROCESSOR CONTROL TABLE F0200392* F0200393 EQU RP(10) INDEX TO START OF REQUEST PARAMETERS F0200394 EQU MR(RP+5) INDEX TO START OF MONITOR REQUEST PARAM LIST F0200395 EQU SS(MR+10) INDEX TO START OF SCRATCH PORTION OF PAR LIST F0200396* F0200397 EQU RPLOGU(1) LU NUMBER OF MM DEVICE F0200398 EQU RPAREQ(2) ACTIVE REQUEST FLAG (IF 0, NONE FOR TABLE) F0200399 EQU RPWAIT(3) START OF WAITING REQUEST QUEUE (IF 0, NO WAITGF0200400 EQU RPRLEV(4) REQUEST PRIORITY LEVEL - ACTIVE REQUEST F0200401 EQU RPRBF4(5) REQBUF ADDRESS - FIRST FOUR WORDS F0200402 EQU RPLTEA(6) LOCK TABLE ENTRY (ABSOLUTE) ADDRESS F0200403 EQU RPRTNJ(7) RETURN JUMP TO REQUEST PROCESSOR F0200404ÐÐ EQU RPPADR(8) PROCESSOR ADDRESS F0200405 SPC 1 F0200406* PARAMETER LIST FOR REQUEST PROCESSOR F0200407 EQU RPFCBA(9) FCB ADDRESS FOR FILE F0200408 EQU RPRBMP(RP+0) REQBUF ADDRESS - MAIN PART F0200409 EQU RPPFP1(RP+1) REQUEST PARAMETER ADDRESS - FIRST + 1 F0200410 EQU RPPFP2(RP+2) REQUEST PARAMETER ADDRESS - FIRST + 2 F0200411 EQU RPPFP3(RP+3) REQUEST PARAMETER ADDRESS - FIRST + 3 F0200412 EQU RPPFP4(RP+4) REQUEST PARAMETER ADDRESS - FIRST + 4 F0200413 SPC 1 F0200414* MAIN MONITOR REQUEST F0200415 EQU RPMREQ(MR+0) MONITOR REQUEST CODE WORD F0200416 EQU RPMRP1(MR+1) COMPLETION ADDRESS F0200417 EQU RPMRP2(MR+2) THREAD WORD F0200418 EQU RPMRP3(MR+3) LOGICAL UNIT FOR I/O F0200419 EQU RPMRP4(MR+4) NUMBER OF WORDS F0200420 EQU RPMRP5(MR+5) START CORE ADDRESS F0200421 EQU RPMRP6(MR+6) MASS MEMORY ADDRESS, MSB F0200422 EQU RPMRP7(MR+7) MASS MEMORY ADDRESS, LSB F0200423 EQU RPRCPT(MR+8) CONTROL POINT (FOR I/O REQUESTS) F0200424 EQU RPRETN(MR+9) SAVED RETURN ADDRESS F0200425* ALTERNATE COMMON NAMES F0200426 EQU REQBUF(RP+0) USERS FIRST CALL PARAMETER ADDRESS F0200427 EQU ISTAT(RP+4) USERS COMPLETION STATUS PARAMETER ADDRESS F0200428 SPC 1 F0200429ÐÐ* FMUFCB'S TABLE INDEXES F0200430 EQU MSBBSA(SS+0) MSB OF BASE SECTOR ADDRESS F0200431 EQU LSBBSA(SS+1) LSB OF BASE SECTOR ADDRESS F0200432 EQU RRNHIW(SS+2) MSB OF RELATIVE RECORD NUMBER F0200433 EQU RRNLOW(SS+3) LSB OF RELATIVE RECORD NUMBER F0200434 EQU FCBLEN(SS+4) FCB RECORD LENGTH F0200435 EQU WRTLEN(SS+5) NUMBER OR WORDS TO WRITE F0200436 EQU OFFSET(SS+6) WORD OFFSET - 0 F0200437 EQU ADRFSS(SS+7) ADDRESS OF FCB SUBSET (MM PART) F0200438 EQU IOTYPE(SS+8) I/O TYPE - 0 F0200439 SPC 1 F0200440* MISCELLANEOUS PARAMETERS F0200441 EQU FMURTN(SS+9) SAVED RETURN ADDRESS F0200442*E F0200443**** F0200444 EJT F0200445*** F0200446* A B S O L U T I Z E P A R A M E T E R F0200447* F0200448* ABSPAR GENERATES AN ABSOLUTE PARAMETER ADDRESS. THE Q-REG F0200449* SHOULD CONTAIN THE ADDRESS OF THE ADDRESS TO BE ABSOLUTIZED F0200450* ON ENTRY. UPON EXIT, THE REQUIRED ADDRESS IS IN THE A-REG. F0200451* Q AND I ARE NOT CHANGED. F0200452*E F0200453 SPC 2 F0200454ÐÐABSPAR 000 000 Q = POINTER TO PARAMETER ADDRESS F0200455 IIN 0 F0200456* F0200457 TRQ A SET A TO ADDRESS OF ADDRESS TO BE CHECKED F0200458 SAM AP05 SKIP IF FROM PART 1 F0200459 SUB =XEND0V4 CHECK IF PART 1 EXTENDS INTO BANK 0 F0200460 SAM AP10 SKIP IF NO F0200461* F0200462AP05 LDA- (ZERO),Q REQUEST FROM PART 1, ABSOLUTE ADDRESSING ONLY F0200463 JMP* APEXIT F0200464* F0200465AP10 LDA- (ZERO),Q REQUEST FROM PART 0, A = ABS/REL PARAMETER ADRF0200466 SAP APEXIT F0200467 AAQ A ABSOLUTIZE RELATIVE PARAMETER ADDRESS F0200468 AND- ONEMSK+14 F0200469APEXIT EIN 0 F0200470 JMP* (ABSPAR) A = ABSOLUTE PARAMETER ADDRESS F0200471 EJT F0200472*** F0200473* C H E C K U N P R O T E C T E D A D D R E S S F0200474* F0200475* CKUADR CHECKS WHETHER OR NOT A PARTICULAR ADDRESS IS UNPRO- F0200476* TECTED. UPON ENTRY, THE ADDRESS TO BE CHECKED SHOULD BE IN F0200477* THE A-REGISTER. IF THE CALL IS FROM A REQUEST PROCESSOR THEF0200478* I REGISTER SHOULD CONTAIN THE ADDRESS OF THE RELATED REQUESTF0200479ÐÐ* PROCESSOR CONTROL TABLE. IF THE CALL IS FROM THE EXECUTIVE,F0200480* THE I REGISTER SHOULD POINT TO VOLATILE AND VRLEV MUST HAVE F0200481* BEEN SET. F0200482* F0200483* Q-REG MUST CONTAIN 0 IF CALL IS FROM A REQUEST PROCESSOR. F0200484*E F0200485 SPC 2 F0200486CKUADR 000 000 A = ADDRESS TO BE CHECKED F0200487 IIN 0 Q = ZERO OR POINTER TO ADDRESS F0200488 STA* ADRESS F0200489* F0200490 ENA HUPLVL CHECK IF CALLER UNPROTECTED F0200491 SUB- RPRLEV,I F0200492 SAM CKU10 A = NEGATIVE, IF REQUEST PROTECTED F0200493* F0200494 LDA- $F7 CHECK BOTTOM END F0200495 RTJ* CMPR16 F0200496 SAP CKU20 F0200497* F0200498 LDA- $F6 CHECK TOP END F0200499 INA -1 F0200500 RTJ* CMPR16 F0200501 SAM CKU20 F0200502* F0200503CKU10 LDA* ADRESS ADD F0200504ÐÐ EIN 0 F0200505 JMP* (CKUADR) F0200506 SPC 2 F0200507* PROCESS UNPROTECTED ADDRESS ERROR F0200508* F0200509CKU20 SQZ CKU30 UNPROTECTED ADDRESS ERROR F0200510 TRQ A F0200511 LDQ LPTRS ILLEGAL REQUEST BUFFER AND / OR INDICATOR F0200512 STA- (ZERO),Q F0200513 RTJ- (AVOLR) RELEASE VOLATILE F0200514 EIN 0 F0200515 RTJ SWAPCK RESET UNPIO AND CHECK IF SWAP DESIRED F0200516 LDQ LOCF HANDLE AS A (J02,XXXX) ERROR F0200517 JMP- (ZERO),Q F0200518 EJT F0200519CKU30 EIN 0 REQUEST ERROR, ILLEGAL PARAMETER, SET BIT 14 F0200520 LDA- ZROMSK+13 AND 15 OF REQIND F0200521 LDQ- ISTAT,I F0200522 STA- (ZERO),Q F0200523 JMP FMCOME COMPLETE REQUEST - USE ERROR RETURN F0200524 SPC 4 F0200525CMPR16 000 000 COMPARE UNP. BOUND WITH A 16 BIT ADDRESS F0200526 EOR* ADRESS CHECK IF SIGNS ARE THE SAME F0200527 SAP CMP010 (YES) F0200528 LDA* ADRESS F0200529ÐÐ JMP* (CMPR16) A .GE. 0 IF UNP. BOUND HIGHER F0200530* F0200531CMP010 EOR* ADRESS SUBTRACT ADDRESS FROM UNP. BOUND F0200532 SUB* ADRESS F0200533 JMP* (CMPR16) A .GE. 0 IF UNP. BOUND HIGHER F0200534ADRESS NUM 0 ADDRESS TO BE CHECKED F0200535 EJT F0200536*** F0200537* M A S S M E M O R Y I / O R O U T I N E F0200538* F0200539* THIS ROUTINE PERFORMS I/O FOR FILE MANAGER CORE RESIDENT F0200540* AND MASS RESIDENT PROCESSORS. THIS ROUTINE GENERATES A WORDF0200541* ADDRESSED REQUEST EVEN IF SECTOR ADDRESSING COULD BE USED. F0200542* THE MASS MEMORY DRIVER IS EXPECTED TO CONVERT TO STRAIGHT F0200543* SECTOR ADDRESSING IF POSSIBLE. SEPARATE ENTRY POINTS ARE F0200544* PROVIDED FOR INPUT (MMREAD) AND OUTPUT (MMWRIT). A NINE F0200545* WORD PARAMETER LIST IS USED TO DEFINE WHAT INFORMATION IS F0200546* TO BE READ/WRITTEN. THE LIST CONTAINS THE FOLLOWING: F0200547* F0200548* WORD USE F0200549* 1 MSB OF BASE SECTOR ADDRESS F0200550* 2 LSB OF BASE SECTOR ADDRESS F0200551* 3 MSB OF RELATIVE RECORD NUMBER (REL REC NUM FORMAT) F0200552* 4 LSB OF RELATIVE RECORD NUMBER F0200553* 5 RECORD LENGTH IN WORDS - BIT 15 SET IF SECTOR ALGNDF0200554ÐÐ* 6 NUMBER OF WORDS TO READ OR WRITE F0200555* 7 WORD OFFSET FROM START OF RECORD F0200556* 8 ADDRESS OF BUFFER FOR I/O F0200557* 9 NON-ZERO IF FILE I/O, ELSE ZERO F0200558* F0200559* TO EXECUTE THIS ROUTINE, (1) SET UP THE PARAMETER LIST, F0200560* (2) SET Q TO THE ABSOLUTE ADDRESS OF THE PARAMETER LIST, F0200561* (3) SET I TO THE ADDRESS OF THE RELATED REQUEST PROCESSOR F0200562* CONTROL TABLE AND (4) EXECUTE A RTJ TO THE APPROPRIATE F0200563* ENTRY POINT. THE I REGISTER WILL HAVE THE SAME TABLE F0200564* ADDRESS UPON RETURN TO THE CALLER. THE Q-REG WILL HAVE F0200565* COMPLETION STATUS UPON RETURN TO THE CALLER; THUS IF NEGA- F0200566* TIVE, AN I/O ERROR OCCURRED. IF Q=-0 ON RETURN, THE COMPU- F0200567* TATIONS USED TO COMPUTE THE WORD ADDRESS RESULTED IN AN F0200568* ERROR. F0200569*E F0200570 SPC 3 F0200571* M A S S M E M O R Y R E A D S U B R O U T I N E F0200572* F0200573MMREAD 000 000 F0200574 LDA* MMREAD PICKUP RETURN ADDRESS F0200575 RAO- RPMRP2,I BUMP THREAD WORD TO SIGNAL FOR READ F0200576 JMP* MM10 JUMP TO COMMON READ/WRITE ENTRY F0200577* F0200578* M A S S M E M O R Y W R I T E S U B R O U T I N E F0200579ÐÐ* F0200580MMWRIT 000 000 F0200581 LDA* MMWRIT PICKUP RETURN ADDRESS F0200582 EJT F0200583* COMMON READ/WRITE ENTRY F0200584MM10 STA- RPRETN,I PUT RETURN ADDRESS IN REQ PROC TABLE F0200585 LDA- RPMRP2,I PICKUP THREAD WORD TO CHECK IF READ F0200586 SAZ MM20 SKIP FOR WRITE F0200587 LDA* RECODE LOAD READ REQUEST CODE WORD F0200588 JMP* MM30 F0200589MM20 LDA* WRCODE LOAD WRITE REQUEST CODE F0200590* F0200591MM30 STA- RPMREQ,I STORE REQUEST CODE INTO MONITOR REQUEST F0200592 STQ- RPMRP2,I SAVE CALLERS ARRAY ADDRESS IN THREAD WORD F0200593 LDA- (ZERO),Q MOVE BASE SECTOR ADDRESS TO LOCAL TABLE FOR F0200594 STA* DWWRD1 USE IN DWMUL CALL F0200595 LDA- 1,Q F0200596 STA* DWWRD2 F0200597* F0200598 LDA- 5,Q F0200599 STA- RPMRP4,I SET UP NUMBER OF WORDS F0200600 LDA- 7,Q F0200601 STA- RPMRP5,I SET UP BUFFER ADDRESS F0200602 LDA- 6,Q F0200603 STA- RPMRP7,I SAVE INDEX OFFSET IN I/O REQUEST F0200604ÐÐ LDA- 8,Q SAVE LIMITS CHECK FLAG F0200605 STA* LIMCHK F0200606* F0200607 LDQ- RPLOGU,I F0200608 LDQ* (MMLTAB),Q PICKUP ADDRESS OF VOLUME INF TBL FOR UNIT F0200609 LDA- (VISLUN),Q PICKUP LOGICAL UNIT NUMBER F0200610 SAP MM32 GO STORE IF POSITIVE F0200611 TRA Q SET Q NEGATIVE (NOT -0) F0200612 JMP* MM80+1 GO TO RETURN LOGIC F0200613* F0200614MM32 STA- RPMRP3,I SET UP LOGICAL UNIT WORD F0200615 LDA- VIWPS,Q PICKUP WORDS PER SECTOR FOR UNIT F0200616 STA* DWWRD3 STORE IN TABLE FOR CALL TO DWMUL F0200617 LDQ* ARAYAD SET Q TO ABS ADDRESS OF DWWRD1 WORD F0200618 RTJ* (MULTIP) MULTIPLY BASE ADDRESS BY NO. OF WORDS F0200619 LDA* DWWRD6 CHECK COMPLETION STATUS F0200620 SAZ MM35 OK IF 0 F0200621 JMP* MM80 GO SET Q TO -0 F0200622* F0200623MM35 LDA* DWWRD4 SAVE DOUBLE WORD RESULT F0200624 STA* TEMPY1 F0200625 LDA* DWWRD5 F0200626 STA* TEMPY2 F0200627 LDQ- RPMRP2,I RESET Q TO CALLERS ARRAY ADDRESS F0200628 LDA- 3,Q F0200629ÐÐ LDQ- 2,Q SET Q-A TO MSB-LSB OF REL REC NUMBER F0200630 LLS 1 F0200631 ALS 15 CONVERT TO 15 BIT FORMAT F0200632 SAN MM40 SKIP IF LSB NOT 0 F0200633 LDA- ONEMSK+14 SET LSB TO $7FFF AND DECREMENT MSB BY 1 F0200634 INQ -1 F0200635 JMP* MM50 F0200636 EJT F0200637MM40 INA -1 DECREMENT LSB BY 1 F0200638MM50 STQ* DWWRD1 STORE MSB AND LSB FOR DWMUL CALL F0200639 STA* DWWRD2 F0200640* F0200641 LDQ- RPMRP2,I RESET Q TO CALLERS ARRAY ADDRESS F0200642 LDA- 4,Q PICKUP RECORD (BLOCK) LENGTH F0200643 SAP MM70 SKIP IF NOT FLAGGED AS SECTOR ALIGNED F0200644 AND- ONEMSK+14 AND OFF BIT 15 F0200645 CLR Q F0200646 DVI* DWWRD3 DIVIDE RECORD LENGTH BY WORDS/SECTOR F0200647 SQZ MM60 SKIP IF NO REMAINDER F0200648 INA 1 F0200649MM60 MUI* DWWRD3 MULTIPLY NO. OF SECTORS BY WORDS/SECTOR F0200650MM70 STA* DWWRD3 STORE NO. OF MM WORDS USED PER RECORD F0200651 LDQ* ARAYAD SET Q TO ABS ADDRESS OF DWWRD1 WORD F0200652 RTJ* (MULTIP) MULTIPLY TO GET OFFSET FROM BASE WORD ADDRESS F0200653 LDA* DWWRD6 CHECK COMPLETION STATUS F0200654ÐÐ SAN MM80 BAD IF NON ZERO F0200655* F0200656 LDA* DWWRD4 MOVE RESULT TO 1ST VALUE SLOT FOR ADD F0200657 STA* DWWRD1 F0200658 LDA* DWWRD5 F0200659 STA* DWWRD2 F0200660* F0200661 LDA* TEMPY1 MOVE BASE WORD ADDRESS TO 2ND VALUE SLOT F0200662 STA* DWWRD3 F0200663 LDA* TEMPY2 F0200664 STA* DWWRD4 F0200665 LDQ* ARAYAD SET Q TO ABS ADDRESS OF DWWRD1 WORD F0200666 RTJ DWADD ADD TO GET NEW WORD ADDRESS FOR I/O F0200667 LDA* DWWRD7 CHECK COMPLETION STATUS F0200668 SAZ MM90 OK IF 0 F0200669* F0200670MM80 SET Q SET Q TO -0 AND RETURN F0200671 JMP* MMRETN F0200672MM90 LDQ* DWWRD5 F0200673 LDA* DWWRD6 F0200674 ADD- RPMRP7,I ADD OFFSET USING DOUBLE PRECISION F0200675 SAP MM100 F0200676 INQ 1 F0200677 AND- ONEMSK+14 F0200678MM100 STA- RPMRP7,I STORE LSB F0200679ÐÐ STQ- RPMRP6,I SAVE MSB IN CURRENT FORM F0200680 STQ* DWWRD1 SAVE MSB/LSB IN PARAMETER ARRAY IN CASE LIMITSF0200681 STA* DWWRD2 CHECK IS NEEDED F0200682 LDA* LIMCHK CHECK IF LIMIT CHECK IS NEEDED F0200683 SAN MM110 SKIP IF YES F0200684 JMP* MM150 GO SET CONTROL POINT FLAG FOR REQUEST F0200685 EJT F0200686MM110 LDQ- REQBUF,I PICKUP UCT ENTRY ADDRESS FROM REQBUF F0200687 LDQ- UCTADR,Q F0200688 LDQ- FSLADR,Q PICKUP FILE SPACE LIMITS TABLE ENTRY ADDRESS F0200689 SQN MM120 SKIP IF ADDFESS EXISTS F0200690 JMP* MM150 ELSE GO TO MM150 F0200691* F0200692MM120 STQ* LIMCHK SAVE ADDRESS IN FLAG WORD F0200693 LDA- (ZERO),Q PICKUP START WORD ADDRESS FROM LIMITS TABLE F0200694 STA* DWWRD3 ENTRY - STORE IN DW PARAM ARRAY F0200695 LDA- 1,Q F0200696 STA* DWWRD4 F0200697 LDQ* ARAYAD SET Q TO ABS ADDRESS OF DWWRD1 WORD F0200698 RTJ* (ADSUBT) DO DOUBLE WORD SUBTRACT F0200699 LDA* DWWRD7 CHECK COMPLETION STATUS F0200700 SAZ MM125 SKIP IF GOOD F0200701 JMP* MM80 SET Q = -0 FOR RETURN F0200702MM125 JMP* MM130 F0200703 SPC 4 F0200704ÐÐMULTIP ADC DWMUL DW MULTIPLY ROUTINE F0200705ARAYAD ADC DWWRD1 ADDRESS OF 7 WORD ARRAY FOR DW MATH ROUTINES F0200706TEMPY1 NUM 0 TEMPORARY STORAGE F0200707TEMPY2 NUM 0 TEMPORARY STORAGE F0200708MMLTAB ADC MMLUTB F0200709 SPC 2 F0200710DWWRD1 NUM 0 PARAMETER ARRAY FOR DW MATH ROUTINES F0200711DWWRD2 NUM 0 F0200712DWWRD3 NUM 0 F0200713DWWRD4 NUM 0 F0200714DWWRD5 NUM 0 F0200715DWWRD6 NUM 0 F0200716DWWRD7 NUM 0 F0200717 SPC 2 F0200718RECODE ADC $4200+FMLEVL*$10+FMLEVL F0200719WRCODE ADC $4400+FMLEVL*$10+FMLEVL F0200720LIMCHK NUM 0 SAVED LIMIT CHECK F0200721 EJT F0200722MM130 LDQ- RPMRP6,I DO DOUBLE PRECISION ADD OF START WORD ADDRESS F0200723 LDA- RPMRP7,I WITH NUMBER OF WORDS F0200724 INA -1 F0200725 ADD- RPMRP4,I F0200726 SAP MM140 F0200727 INQ 1 F0200728 AND- ONEMSK+14 F0200729ÐÐMM140 STA* DWWRD2 STORE FOR SUBTRACT F0200730 STQ* DWWRD1 F0200731 LDQ* LIMCHK RELOAD LIMITS TABLE ENTRY ADDRESS F0200732 LDA- 2,Q MOVE ENDING WORD ADDRESS + 1 TO PARAMETER F0200733 STA* DWWRD3 ARRAY F0200734 LDA- 3,Q F0200735 STA* DWWRD4 F0200736 LDQ* ARAYAD SET Q FOR DWSUB CALL F0200737 RTJ* (ADSUBT) DO DOUBLE WORD SUBTRACT F0200738 LDA* DWWRD7 CHECK COMPLETION STATUS. IF BAD, I/O IS OK. F0200739 SAN MM150 SKIP IF I/O OK F0200740 JMP* MM80 GO SET Q=-0 FOR RETURN F0200741* F0200742MM150 LDA- RPMRP6,I F0200743 EOR- ONEBIT+15 SET BIT 15 OF MSB TO FLAG CONTROL POINT F0200744 STA- RPMRP6,I F0200745* F0200746 CLR A CLEAR THREAD WORD F0200747 STA- RPMRP2,I F0200748 LDA =XMMCOMP SET COMPLETION ADDRESS F0200749 STA- RPMRP1,I F0200750 LDQ- RPRBMP,I SET I/O PERFORMED FLAG 123*4934F0200751 LDA- RPIDX,Q 123*4934F0200752 AND- ZROBIT+14 123*4934F0200753 EOR- ONEBIT+14 123*4934F0200754ÐÐ STA- RPIDX,Q 123*4934F0200755 LDA- I F0200756 INA RPMREQ F0200757 STA* RADDRS STORE ADDRESS OF REQUEST LIST FOR MONITOR CALLF0200758 RTJ- (AMONI) EXECUTE INDIRECT MONITOR REQUEST (PART 1 REQ) F0200759 NUM $2000 F0200760RADDRS NUM 0 F0200761 JMP- (ADISP) F0200762 EJT F0200763* COMPLETION LOGIC OF I/O REQUESTS F0200764MMCOMP INA -RPMREQ F0200765 STA- I RESTORE I-REG F0200766 SQP MMRETN SKIP IF NO I/O ERROR F0200767 LDQ- RPLOGU,I F0200768 LDQ* (MMLTAB),Q F0200769 LDA- (VISLUN),Q F0200770 AND- ONEMSK+14 SET BIT 15 OF LU WORD TO FLAG DISMOUNTING F0200771 EOR- ONEBIT+15 F0200772 STA- (VISLUN),Q F0200773 LDA* ORDNAM CHECK IF DISMOUNT ORDINAL EXISTS F0200774 EOR- ONEMSK+14 F0200775 SAZ MM160 SKIP IF NO F0200776 LDQ- RPLOGU,I VOLUME UNIT NUMBER F0200777 RTJ- (AMONI) SCHEDULE THE DISMOUNT ORDINAL, PASS VOLUME F0200778 ADC $2400+DMTLEV NUMBER VIA THE Q REGISTER F0200779ÐÐORDNAM ADC DISMNT F0200780* F0200781MM160 LDQ- RPMRP3,I RESET Q TO COMPLETION STATUS F0200782MMRETN CLR A ASSURE RPMRP2 IS CLEAR IN CASE MATH ERROR NOTDF0200783 STQ* TEMPY2 SAVE COMPLETION STATUS F0200784 STA- RPMRP2,I F0200785 LDQ- RPRCPT,I F0200786 RTJ CPSET RESET CONTROL POINT F0200787MMEXIT LDA- RPRETN,I F0200788 STA* TEMPY1 F0200789 LDQ* TEMPY2 RELOAD COMPLETION STATUS F0200790 JMP* (TEMPY1) RETURN TO USER WITH STATUS IN Q F0200791 SPC 2 F0200792ADSUBT ADC DWSUB DW SUBTRACT ROUTINE F0200793 EJT F0200794*** F0200795* C H E C K L O C K E D R E C O R D T A B L E F0200796* F O R L O C K E D R E C O R D F0200797* F0200798* LOKCHK CHECKS THE LOCKED RECORD TABLE TO DETERMINE EITHER F0200799* (1) WHETHER OR NOT ANY RECORD IS LOCKED FOR THE CURRENT FILEF0200800* BY THE CURRENT USER OR (2) WHETHER OR NOT A SPECIFIC RECORD F0200801* OR SET OF RECORDS FOR A SPECIFIC FILE IS CURRENTLY LOCKED. F0200802* F0200803* TO CHECK FOR A LOCKED RECORD, THE CALLER MUST HAVE THE I-REGF0200804ÐÐ* SET TO THE ADDRESS OF THE RELATED PROCESSOR CONTROL TABLE, F0200805* SET Q-REG TO 0 TO SIGNAL FOR A CHECK OF ANY RECORD LOCKED F0200806* BY THIS USER FOR HIS FILE OR SET Q-REG NOT 0 TO SIGNAL FOR F0200807* A CHECK FOR A SPECIFIC RECORD, AND EXECUTE A RTJ TO LOKCHK. F0200808* IF A CHECK IS TO BE MADE FOR A SPECIFIC RECORD, THE Q-REG F0200809* SHOULD CONTAIN THE ABSOLUTE ADDRESS OF A THREE WORD BUFFER F0200810* THAT CONTAINS THE RELATIVE RECORD NUMBER (MSB AND LSB) OF F0200811* THE FIRST RECORD OF THE SET AND THE NUMBER OF RECORDS IN F0200812* THE SET (WORD 3). F0200813* F0200814* ON RETURN TO THE CALLER, THE A-REG HAS THE ABS ADDRESS OF A F0200815* LOCK TABLE ENTRY IF ONE WAS FOUND; ELSE, A-REG=0. IF A F0200816* SEARCH WAS MADE FOR A SPECIFIC ENTRY, Q-REG INDICATES F0200817* WHETHER OR NOT THE ENTRY SPECIFIED BY THE CALLER MATCHED THEF0200818* TABLE ENTRY WHERE Q=0 SIGNIFIES YES, NOT 0 SIGNIFIES NO. F0200819*E F0200820 SPC 2 F0200821LOKCHK 000 000 SUBROUTINE ENTRY POINT F0200822 STQ* TYPECK SAVE Q-REG - SPECIFIES TYPE OF CHECK NEEDED F0200823 LDQ- RPRBMP,I F0200824 LDA- USERID,Q PICKUP USER ID AND STORE FOR COMPARES F0200825 STA* UDENT (UDENT MAY OR MAY BE USED) F0200826* F0200827LOK10 LDQ- UCTADR,Q PICKUP FILE ID AND STORE FOR COMPARES F0200828 LDA- FIDENT,Q F0200829ÐÐ AND- ONEMSK+14 F0200830 STA* FDENT F0200831 LDA- I SAVE I-REG F0200832 STA* TEMPY1 F0200833 LDA* TYPECK USE I FOR ADDRESSING CALLER'S 3 WORD BUFFER F0200834 STA- I F0200835 ENA -1 INITIALIZE LOOP COUNTER TO -1 F0200836 STA* LCCNTR F0200837* F0200838LOK20 RAO* LCCNTR BUMP LOOP COUNTER AND CHECK IF ALL ENTRIES F0200839 LDA* LCCNTR CHECKED. F0200840 TRA Q SAVE COUNTER IN Q F0200841 SUB* NLOCKS F0200842 SAN LOK30 SKIP IF NOT ALL CHECKED F0200843LOK25 LDQ* TEMPY1 RESTORE I TO ENTRY VALUE F0200844 STQ- I F0200845 JMP* (LOKCHK) RETURN WITH A=0, ENTRY NOT FOUND F0200846 EJT F0200847LOK30 TRQ A SET Q TO ABSOLUTE ADDRESS OF CURRENT TABLE F0200848 MUI =XLTELEN ENTRY F0200849 TRA Q F0200850 ADQ* LKTABL F0200851 LDA- (ZERO),Q CHECK IF CURRENT ENTRY FOR REQUIRED FILE F0200852 SUB* FDENT F0200853 SAZ LOK40 SKIP IF YES F0200854ÐÐ JMP* LOK20 GO CHECK FOR ANOTHER ENTRY F0200855* F0200856LOK40 LDA* TYPECK CHECK FOR TYPE OF CHECK REQUIRED F0200857 SAN LOK60 SKIP TO CHECK FOR SPECIFIC RECORD F0200858* F0200859 LDA- 4,Q CHECK FOR LOCK BY CURRENT USER F0200860 SUB* UDENT F0200861 SAZ LOK50 SKIP IF ENTRY FOUND F0200862 JMP* LOK20 GO CHECK FOR ANOTHER ENTRY F0200863* F0200864LOK50 TRQ A SET A TO ABS ADDRESS OF ENTRY F0200865 JMP* LOK25 GO SET UP RETURN F0200866* F0200867* CHECK FOR SPECIFIC RECORD OR SET OF RECORDS F0200868LOK60 LDA- (ZERO),I FIRST CHECK IF ENTRIES ARE IDENTICAL F0200869 EOR- 1,Q CHECK MSB F0200870 SAN LOK70 SKIP IF NOT THE SAME F0200871 LDA- 1,I CHECK LSB F0200872 EOR- 2,Q F0200873 SAN LOK70 SKIP IF NOT THE SAME F0200874 LDA- 2,I CHECK NO. OF RECORDS F0200875 EOR- 3,Q F0200876 LLS 16 SWAP A AND Q. A NOW HAS ADDRESS OF LOCK TABLEF0200877* ENTRY AND Q=O IF ENTRIES MATCH, ELSE Q NOT O. F0200878 JMP* LOK110 GO RESTORE I FOR EXIT F0200879ÐÐ* F0200880LOK70 STQ* TEMPYA SET UP TO SUBTRACT START OF TABLE ENTRY SET F0200881 LDA- (ZERO),I FROM START OF CALLER'S ENTRY SET F0200882 LDQ- 1,I F0200883 LLS 1 CONVERT CALLERS ENTRY TO NEEDED MSB/LSB FORMATF0200884 ALS 15 F0200885 STA* DWORD2 STORE FOR DWSUB F0200886 STQ* DWORD1 F0200887 LDQ* TEMPYA CONVERT TABLE ENTRY TO MSB/LSB FORMAT F0200888 LDA- 2,Q F0200889 LDQ- 1,Q F0200890 LLS 1 F0200891 ALS 15 F0200892 STA* DWORD4 STORE IT F0200893 STQ* DWORD3 F0200894 LDQ* ABSADR SET Q TO ADDRESS OF PARAMETER ARRAY F0200895 RTJ* (ADSUBT) DO THE DOUBLE WORD SUBTRACT F0200896 LDA* DWORD7 CHECK IF RESULT NEGATIVE F0200897 SAN LOK80 SKIP IF YES F0200898 EJT F0200899* F0200900* FIRST RECORD FOR CALLER'S SET HAD A REL. REC. F0200901 LDA* DWORD1 NO. GE. FIRST RECORD OF TABLE ENTRY. F0200902 LDQ* DWORD3 F0200903 STA* DWORD3 SWAP MINUEND WITH SUBTRAHEND F0200904ÐÐ STQ* DWORD1 F0200905 LDQ* DWORD4 F0200906 STA* DWORD4 F0200907 STQ* DWORD2 F0200908 LDQ* TEMPYA PICKUP NO. OF RECORDS FOR TABLE ENTRY F0200909 LDA- 3,Q F0200910 JMP* LOK85 GO TO ADD IT TO CURRENT MINUEND F0200911* F0200912* FIRST RECORD FOR CALLER'S SET HAD A R.R.N. F0200913* THAT WAS LESS THAN R.R.N. OF THE TABLE ENTRY F0200914LOK80 LDA- 2,I PICKUP NO. OF RECORDS FOR CALLER'S ENTRY F0200915LOK85 INA -1 DECREMENT BY 1 F0200916 ADD* DWORD2 DOUBLE PRECISION ADD IT TO R.R.N. F0200917 LDQ* DWORD1 F0200918 SAP LOK90 F0200919 INQ 1 F0200920 AND- ONEMSK+14 F0200921LOK90 STA* DWORD2 STORE IT FOR DOUBLE WORD SUBTRACT F0200922 STQ* DWORD1 F0200923 LDQ* ABSADR SET Q TO ADDRESS OF PARAMETER ARRAY F0200924 RTJ* (ADSUBT) DO THE SUBTRACT F0200925 LDA* DWORD7 CHECK THE RESULT F0200926 SAZ LOK100 SKIP IF RESULT POSITIVE F0200927 JMP* LOK20 NO OVERLAP FOUND. CHECK FOR NEXT ENTRY. F0200928* F0200929ÐÐLOK100 LDA* TEMPYA OVEPLAD FOUND. SET A TO ADDRESS OF ENTRY F0200930 TRA Q ASSURE Q NOT O - INDICATES ENTRIES NOT ALIKE F0200931LOK110 STA* TEMPYA SAVE A-REG (EXIT STATUS) F0200932 LDA TEMPY1 F0200933 STA- I RESTORE ENTRY VALUE OF I-REG F0200934 LDA* TEMPYA RESTORE A F0200935 JMP* (LOKCHK) RETURN TO CALLER F0200936 EJT F0200937 SPC 2 F0200938* F0200939ABSADR ADC DWORD1 ABSOLUTE ADDRESS OF 7 WORD ARRAY F0200940* 7-WORD ARRAY FOR DOUBLE WORD MATH ROUTINES F0200941DWORD1 NUM 0 F0200942DWORD2 NUM 0 F0200943DWORD3 NUM 0 F0200944DWORD4 NUM 0 F0200945DWORD5 NUM 0 F0200946DWORD6 NUM 0 F0200947DWORD7 NUM 0 F0200948 SPC 2 F0200949LCCNTR NUM 0 LOOP COUNTER F0200950TYPECK NUM 0 TYPE OF CHECK WANTED F0200951NLOCKS ADC MAXLOC MAXIMUM NUMBER OF LOCKS F0200952LKTABL ADC LRTABL LOCKED RECORD TABLE F0200953UDENT NUM 0 USER IDENT F0200954ÐÐ EQU BUFADR(*) BUFFER ADDRESS F0200955FDENT NUM 0 FILE IDENT F0200956TEMPYA NUM 0 TEMPORARY STORAGE F0200957 EJT F0200958*** F0200959* R E M O V E R E C O R D L O C K E N T R Y F R O M F0200960* R E C O R D L O C K T A B L E F0200961* F0200962* REMLOK REMOVES A LOCKED RECORD ENTRY FROM THE F0200963* RECORD LOCK TABLE AND DECREMENTS THE NUMBER OFF0200964* RESERVED ENTRIES BY 1. TO USE REMLOK, SET F0200965* Q-REG TO THE ABSOLUTE ADDRESS OF THE ENTRY TO F0200966* BE DELETED AND EXECUTE A RTJ TO REMLOK. THE F0200967* I-REG WILL BE UNAFFECTED BY REMLOK. F0200968* F0200969*E F0200970REMLOK 000 000 REMLOK ENTRY POINT F0200971 CLR A F0200972 STA- (ZERO),Q CLEAR ALL 5 WORDS OF TABLE ENTRY F0200973 STA- 1,Q F0200974 STA- 2,Q F0200975 STA- 3,Q F0200976 STA- 4,Q F0200977 LDA* (ANRELE) DECREMENT NUMBER OF RESERVED LOCK ENTRIES F0200978 INA -1 F0200979ÐÐ STA* (ANRELE) F0200980 JMP* (REMLOK) RETURN TO USER F0200981 SPC 2 F0200982ANRELE ADC NRERLE NUMBER OF RESERVED RECORD LOCK ENTRIES F0200983 EJT F0200984*** F0200985* I N S E R T R E C O R D L O C K I N T O R E C O R D F0200986* L O C K T A B L E F0200987* F0200988* INSLOK INSERTS A NEW RECORD LOCK ENTRY INTO F0200989* THE RECORD LOCK TABLE. TO USE INSLOK, SET F0200990* I-REG TO THE ADDRESS OF THE PROCESSOR CONTROL F0200991* TABLE, SET Q-REG TO THE ABSOLUTE ADDRESS OF F0200992* A 3-WORD BUFFER CONTAINING THE RELATIVE RECORDF0200993* NUMBER OF THE FIRST RECORD OF THE SET TO BE F0200994* LOCKED (MSB AND LSB) AND THE NUMBER OF RECORDSF0200995* IN THE SET (WORD 3). UPON RETURN TO THE F0200996* CALLER, THE I-REG WILL STILL POINT TO THE F0200997* PROCESSOR CONTROL TABLE, HOWEVER Q AND A WILL F0200998* HAVE CHANGED. F0200999* INSLOK REQUIRES A RECORD ENTRY TO HAVE BEEN F0201000* RESERVED FOR ITS USE. F0201001*E F0201002INSLOK 000 000 INSLOK ENTRY POINT F0201003 STQ* BUFADR SAVE 3-WORD BUFFER ADDRESS F0201004ÐÐ ENA -1 INITIALIZE LOOP COUNTER TO -1 F0201005 STA* LCCNTR F0201006* F0201007INS10 RAO* LCCNTR BUMP LOOP COUNTER AND CHECK IF ALL ENTRIES F0201008 LDA* LCCNTR CHECKED F0201009 TRA Q PUT COUNTER IN Q F0201010 SUB* NLOCKS F0201011 SAN INS20 SKIP IF NOT ALL CHECKED F0201012 RTJ SYFAIL SYSTEM FAILURE - ABORT F0201013* F0201014INS20 TRQ A SET Q TO ABSOLUTE ADDRESS OF NEXT ENTRY F0201015 MUI =XLTELEN F0201016 TRA Q F0201017 ADQ* LKTABL F0201018 LDA- (ZERO),Q CHECK IF ENTRY IS FREE F0201019 SAZ INS30 SKIP IF YES F0201020 JMP* INS10 GO BUMP COUNTER F0201021* F0201022INS30 LDA* (BUFADR) INSERT MSB AND LSB OF RELATIVE RCD NUMBER F0201023 STA- 1,Q F0201024 RAO* BUFADR F0201025 LDA* (BUFADR) F0201026 STA- 2,Q F0201027 RAO* BUFADR F0201028 LDA* (BUFADR) F0201029ÐÐ STA- 3,Q INSERT NO. OF RECORDS TO BE LOCKED F0201030 STQ* LCCNTR SAVE ENTRY ADDRESS F0201031 LDQ- RPFCBA,I F0201032 LDA- (FILEID),Q PICKUP FILE ID FROM FCB AND STORE INTO ENTRY F0201033 STA* (LCCNTR) F0201034 LDQ- RPRBMP,I F0201035 LDA- USERID,Q PICKUP USER ID FROM REQUEST BUFFER AND STORE F0201036 LDQ* LCCNTR INTO ENTRY. F0201037 STA- 4,Q F0201038 JMP* (INSLOK) ALL DONE - RETURN TO CALLER F0201039 EJT F0201040*** F0201041* C O M P U T E L E N G T H F O R R E C O R D I / O F0201042* F0201043* THIS ROUTINE COMPUTES THE NUMBER OF WORDS REQUIRED FOR F0201044* INPUT/OUTPUT OF A SET OF ONE OR MORE RECORDS. TO COMPUTE F0201045* THE NUMBER OF WORDS, SET A-REG TO THE REQUIRED NUMBER OF F0201046* RECORDS, SET I-REG TO THE PROCESSOR CONTROL TABLE ADDRESS F0201047* AND EXECUTE AN RTJ TO CLFRIO. UPON THE RETURN TO THE CALLERF0201048* THE A-REG WILL CONTAIN THE REQUIRED NUMBER OF WORDS. WHEN F0201049* CLFRIO IS CALLED, WORD RPFCBA OF THE PC TABLE MUST CONTAIN F0201050* THE FCB ADDRESS. F0201051* F0201052*E F0201053CLFRIO 000 000 ENTRY POINT F0201054ÐÐ STA* NORECS SAVE NO. OF RECORDS F0201055 LDQ- RPFCBA,I F0201056 LDA- RECLEN,Q PICKUP RECORD LENGTH FROM FCB F0201057 STA* RCDLEN SAVE RECORD LENGTH TEMPORARILY F0201058 LDA- FCBIND,Q CHECK WHETHER FILE IS SECTOR ALLIGNED OR NOT F0201059 SAP CLF20 SKIP IF NO F0201060* F0201061 LDA- (FILEID),Q SET Q TO FILE'S MM LOGICAL UNIT F0201062 ARS 11 F0201063 AND- ONEMSK+4 F0201064 TRA Q F0201065 LDQ MMLUTB,Q GET VIT ADDRESS FROM MMLUTB F0201066 LDA- VIWPS,Q GET WORDS/SECTOR F0201067 STA* WDSSTR SAVE IT F0201068 LDA* RCDLEN SET Q=0, A=RECORD LENGTH F0201069 ENQ 0 F0201070 DVI* WDSSTR DIVIDE BY WORDS/SECTOR F0201071 SQZ CLF10 SKIP IF NO REMAINDER F0201072 INA 1 BUMP BY 1 F0201073CLF10 MUI* WDSSTR A-REG NOW HAS SECTORS/RECORD. COMPUTE NUMBER F0201074* OF WORDS/RECORD F0201075 JMP* CLF30 GO TO COMPUTE NUMBER OF WORDS F0201076* F0201077CLF20 LDA* RCDLEN SET A TO RECORD LENGTH F0201078CLF30 MUI* NORECS MULTIPLY BY NO. OF RECORDS. F0201079ÐÐ JMP* (CLFRIO) RETURN WITH NO. OF WORDS FOR I/O IN A F0201080 SPC 2 F0201081 EQU ADPARM(*) USED BY FMCOVL F0201082RCDLEN NUM 0 RECORD LENGTH F0201083 EQU LNPARM(*) USED BY FMCOVL F0201084WDSSTR NUM 0 WORDS PER SECTOR F0201085 EQU STRTAD(*) USED BY FMCOVL F0201086NORECS NUM 0 NUMBER OF RECORDS F0201087 EJT F0201088*** F0201089* U P D A T E F C B O N M A S S M E M O R Y F0201090* F0201091* FMUFCB UPDATES A FCB ON MASS MEMORY. AFTER THE FCB HAS BEENF0201092* WRITTEN ON MASS EMMORY, THE FCB CHANGED FLAG AND THE NUMBER F0201093* OF NEW RECORDS SINCE FCB UPDATED ON MASS MEORY ARE BOTH F0201094* CLEARED. TO USE FMUFCB, SET I-REG TO THE PROCESSOR CONTROL F0201095* TABLE AND EXECUTE A RTJ TO FMUFCB. PC TABLE WORD RPFCBA F0201096* MUST CONTAIN THE ADDRESS OF THE FCB. NOTE THAT FMUFCB USES F0201097* WORDS 1 THRU 10 OF THE PROCESSOR SCRATCH AREA. UPON THE F0201098* RETURN, Q-REG CONTAINS THE STATUS FROM MMWRIT. F0201099* F0201100*E F0201101FMUFCB 000 000 ENTRY POINT F0201102 LDA* FMUFCB F0201103 STA- FMURTN,I SAVE RETURN ADDRESS F0201104ÐÐ LDQ- RPFCBA,I GET FCB ADDERSS F0201105 LDA- (FILEID),Q EXTRACT AND SAVE FCB TABLE INDEX FROM FILEID F0201106 AND- ONEMSK+10 IT WILL BE USED AS RELATIVE RECORD NUMBER F0201107 INA 1 BUMP IT BY 1 F0201108 STA- RRNLOW,I F0201109 LDA- (FILEID),Q SET Q TO FILE'S MM LOGICAL UNIT F0201110 ARS 11 F0201111 AND- ONEMSK+4 F0201112 STA- RPLOGU,I SET MM UNIT NUMBER FOR MMWRITE F0201113 TRA Q F0201114 LDQ MMLUTB,Q GET VIT ADDRESS FOR FILE'S UNIT F0201115* F0201116 ENA 96 SET RECORD LENGTH TO 96(FIXED SIZE) F0201117 STA- FCBLEN,I F0201118* F0201119 LDA- VIFDDL,Q SET A TO LSB OF FDD ADDRESS F0201120 ADD- VINFDB,Q ADD NO. OF BLOCKS IN FDD (DOUBLE PRECISION ADDF0201121 LDQ- VIFDDM,Q SET Q TO MSB OF FDD ADDRESS F0201122 SAP FMU10 SKIP IF A STILL POSITIVE F0201123 AND- ONEMSK+14 CLEAR BIT 15 OF MSB F0201124 INQ 1 BUMP MSB BY 1 F0201125FMU10 STQ- MSBBSA,I STORE BASE SECTOR ADDRESS F0201126 STA- LSBBSA,I F0201127 CLR A F0201128 STA- IOTYPE,I CLEAR IOTYPE AND MSB OF RRN WORDS F0201129ÐÐ STA- RRNHIW,I F0201130 ENA FCBIND-FH-1 SET OFFSET FOR FCB WRITE F0201131 STA- OFFSET,I F0201132 ENA 5 SET WRITE LENGTH TO 5 (ONLY THE CHANGE WDS) F0201133 STA- WRTLEN,I F0201134 LDQ- REQBUF,I GET UCT ENTRY ADDRESS FROM REQBUF F0201135 LDQ- UCTADR,Q F0201136 LDA- FCBSAD,Q GET SUBSET ADDRESS F0201137 EOR- FCBCAD,Q CHECK IF SUBSET IN THIS FCB F0201138 SAN FMU20 SKIP IF NO F0201139 LDQ- FCBCAD,Q SET ABS ADDRESS OF FCBIND WORD IN FCB F0201140 JMP* FMU25 132*5367F0201141* 132*5367F0201142FMU20 LDQ- FCBSAD,Q GET SUBSET ADDRESS AND CHECK IF IN 132*5367F0201143 TRQ A SUBSET TABLE OR NOT 132*5367F0201144 RTJ* FMFSRC CHECK IF SUBSET IS IN SUBSET TABLE 132*5367F0201145 SAZ FMU25 SKIP IF NO 132*5367F0201146 TRQ A SAVE SUBSET ADDRESS 132*5367F0201147 INQ SAFCBI SET ABSOLUTE ADDRESS OF SAFCBI WORD 132*5367F0201148 JMP* FMU30 132*5367F0201149* 132*5367F0201150FMU25 TRQ A SAVE SUBSET ADDRESS 132*5367F0201151 INQ FCBIND SET ABS ADDRESS OF FCBIND WORD IN FCB 132*5367F0201152* F0201153FMU30 STQ- ADRFSS,I SET ADDRESS OF WRITE BACK PART OF SUBSET F0201154ÐÐ TRA Q RESTORE SUBSET OR FCB ADDRESS TO Q F0201155 CLR A CLEAR NUMBER OF NEW RECORDS F0201156 STA- NUMNEW,Q F0201157* F0201158 LDQ- I SET Q TO ABS ADDRESS OF PARAM LIST F0201159 INQ MSBBSA F0201160 RTJ MMWRIT WRITE FCB TO MM F0201161* F0201162 LDA- FMURTN,I RETURN TO CALLER F0201163 STA* READDR F0201164 JMP* (READDR) F0201165 SPC 2 F0201166 EQU ENDAD(*) USED BY FMCOVL F0201167 EQU ADUCTE(*) SAVED UCT ENTRY ADDRESS F0201168READDR NUM 0 RETURN ADDRESS F0201169 EJT F0201170*** F0201171* C H E C K I F R E Q B U F A N D U C T E N T R Y F0201172* A G R E E F O R O P E N F0201173* F0201174* THIS ROUTINE CHECKS WHETHER OR NOT REQBUF AND AN INDICATED F0201175* UCT ENTRY AGREE WITH EACH OTHER FOR AN OPEN FILE. THEY F0201176* SHOULD AGREE UNLESS THE FILE HAS BEEN CLOSED OR THE USER HASF0201177* ALTERED REQBUF. TO USE THIS ROUTINE, SET Q-REG TO THE F0201178* ADDRESS OF REQBUF AND EXECUTE AN RTJ TO FMCHKO. UPON THE F0201179ÐÐ* RETURN, A-REG = 0 IF THE UCT AND REQBUF ARE IN AGREEMENT. F0201180* ELSE, A-REG NOT 0. NEITHER THE Q NOR THE I REGISTER WILL BEF0201181* ALTERED. F0201182*E F0201183FMCHKO 000 000 ENTRY POINT F0201184 LDA- UCTADR,Q GET ADDRESS OF UCT ENTRY AND SAVE LOCALLY F0201185 STA* ADUCTE F0201186 SAN FMC10 SKIP IF ADDRESS IS DEFINED F0201187 ENA 1 SET A=1 AS RETURN STATUS F0201188 JMP* (FMCHKO) RETURN TO CALLER F0201189* F0201190FMC10 LDA* (ADUCTE) PICKUP 1ST WORD AND CHECK IF IT AGREES WITH F0201191 EOR- USERID,Q REQBUF INFO F0201192 SAN FMC20 SKIP IF NO F0201193 RAO* ADUCTE F0201194 RAO* ADUCTE F0201195 LDA* (ADUCTE) PICKUP 3RD WORD OF UCT ENTRY AND CHECK IF IT F0201196 EOR- FCBADR,Q AGREES WITH REQBUF INFO F0201197FMC20 JMP* (FMCHKO) RETURN, A=0 IF AGREEMENT EXISTS, ELSE NOT 0. F0201198 EJT F0201199*** F0201200* C H E C K F O R O V E R L A P P I N G P A R A M S F0201201* F0201202* FMCOVL CHECKS WHETHER OR NOT A GIVEN PARAMETERF0201203* OVERLAPS REQBUF OR ISTAT. THIS ROUTINE IS F0201204ÐÐ* CALLED ONLY BY REQUEST PROCESSORS. WHEN A F0201205* PARAMETER IS TO BE CHECKED, I-REG SHOULD CON- F0201206* TAIN THE RELATED PCT ADDRESS, A-REG SHOULD F0201207* CONTAIN THE ADDRESS OF THE PARAMETER TO BE F0201208* CHECKED AND Q-REG SHOULD CONTAIN THE LENGTH F0201209* OF THE BUFFER DEFINED BY A-REG. UPON THE F0201210* RETURN, A = 0 IF NO OVERLAP WAS NOTED, ELSE F0201211* A NOT 0. Q WILL NOT HAVE BEEN ALTERED. I-REGF0201212* WILL NOT BE CHANGED. F0201213* F0201214* IF AN OVERLAP IS NOTED, BIT 15 OF THE RQINFO F0201215* WORD OF REQBUF WILL BE SET AS A FLAG FOR THE F0201216* EXEC. F0201217* F0201218* F0201219*E F0201220FMCOVL 000 00 ENTRY POINT F0201221 STA* ADPARM SAVE ADDRESS AND LENGTH OF PARAMETER TO BE F0201222 STQ* LNPARM CHECKED F0201223 LDA- REQBUF,I FIRST, CHECK MAIN PART OF REQBUF F0201224 STA* STRTAD STORE START ADDRESS F0201225 INA 19 BUMP A TO END ADDRESS F0201226 RTJ* CHKADR CHECK FOR OVERLAP F0201227* F0201228 LDA- RPRBF4,I NEXT, CHECK 1ST 4 WORDS OF REQBUF F0201229ÐÐ STA* STRTAD STORE START ADDRESS F0201230 INA 3 BUMP A TO END ADDRESS F0201231 RTJ* CHKADR CHECK FOR OVERLAP F0201232* F0201233 LDA- ISTAT,I NEXT, CHECK ISTAT F0201234 STA* STRTAD STORE ADDERSS F0201235 RTJ* CHKADR CHECK FOR OVERLAP F0201236 CLR A CLEAR A FOR STATUS - NO OVERLAP F0201237 JMP* (FMCOVL) RETURN TO CALLER F0201238 EJT F0201239* CHECK PASSED BUFFER FOR OVERLAP F0201240CHKADR 000 000 ENTRY F0201241 STA* ENDAD STORE END ADDRESS F0201242* F0201243 LDA* STRTAD FIRST, CHECK START ADDRESS WITH PASSED PARAM F0201244 SUB* ADPARM START F0201245 SAP CHK10 SKIP IF START ADR .GE. PASSED ADR F0201246* F0201247 LDA* ENDAD CHECK IF END ADR .GE. PASSED ADR F0201248 SUB* ADPARM F0201249 SAP CHK20 SKIP IF YES - ERROR NOTED F0201250 JMP* (CHKADR) RETURN TO FMCOVL F0201251* F0201252CHK10 LDA* ADPARM CHECK IF END OF PASSED PAR BFR .GE. START ADR F0201253 ADD* LNPARM F0201254ÐÐ INA -1 F0201255 SUB* STRTAD F0201256 SAP CHK20 SKIP IF YES - ERROR NOTED F0201257 JMP* (CHKADR) RETURN TO FMCOVL F0201258* F0201259CHK20 LDQ- RPRBF4,I SET BIT 15 OF RQINFO WORD OF 1ST 4 WORDS OF F0201260 LDA- RQINFO,Q REQBUF TO SIGNAL OVERLAP PROBLEM F0201261 AND- ONEMSK+14 F0201262 EOR- ONEBIT+15 F0201263 STA- RQINFO,Q (RETURN WITH A NOT 0 - OVERLAP EXISTS) F0201264 LDQ- REQBUF,I F0201265 JMP* (FMCOVL) RETURN TO FMCOVL'S CALLER F0201266 EJT F0201267*** F0201268* B U M P R R N BY O N E 121*4675F0201269* 121*4675F0201270* FMBRRN BUMPS A RELATIVE RECORD NUMBER BY 1. WHEN 121*4675F0201271* FMBRRN IS CALLED Q-REG AND A-REG SHOULD CONTAIN 121*4675F0201272* MSB AND LSB, RESPECTIVELY, OF THE RRN TO BE 121*4675F0201273* INCREMENTED. UPON RETURN, THE INCREMENTED RRN 121*4675F0201274* IS IN Q-A. 121*4675F0201275* 121*4675F0201276*E 121*4675F0201277FMBRRN 000 000 ENTRY POINT 121*4675F0201278 SAP FMB10 SKIP IF LSB IS 0-$7FFF 121*4675F0201279ÐÐ INA 0 CHECK FOR $FFFF 121*4675F0201280 SAN FMB10 SKIP IF OLD LSB .NE. $FFFF 121*4675F0201281 INQ 1 BUMP MSB 121*4675F0201282 JMP* FMB20 121*4675F0201283* 121*4675F0201284FMB10 INA 1 BUMP LSB WORD 121*4675F0201285 SAN FMB20 SKIP IF OLD LSB .NE. $FFFE 121*4675F0201286 SET A WAS $FFFE SO SET IT TO $FFFF 121*4675F0201287FMB20 JMP* (FMBRRN) 121*4675F0201288 EJT F0201289* F C B S U B S E T R E S I D E N C Y C H E C K F0201290* F0201291* FMFSRC CHECKS WHETHER OR NOT A FCB SUBSET RESIDES 132*5367F0201292* IN THE FCB SUBSET TABLE. WHEN FMFSRC IS CALLED, THE132*5367F0201293* A-REGISTER CONTAINS THE ADDRESS TO BE CHECKED. 132*5367F0201294* UPON THE RETURN A=0 IF THE SUBSET IS NOT IN THE 132*5367F0201295* SUBSET TABLE OR A NOT 0 IF THE SUBSET IS IN THE 132*5367F0201296* SUBSET TABLE. 132*5367F0201297*E 132*5367F0201298 SPC 2 F0201299FMFSRC 000 000 ENTRY POINT 132*5367F0201300 STA* FCBSAV SAVE SUBSET ADDRESS 132*5367F0201301 SUB =XFCBSCT CHECK IF < START ADDR. OF SUBSET TBL 132*5367F0201302 SAM FMFS05 SKIP IF YES 132*5367F0201303 LDA =XFSLIMT CHECK IF LESS THAN START OF FSLIMT TBL132*5367F0201304ÐÐ SUB* FCBSAV 132*5367F0201305 SAP FMFS10 SKIP IF YES 132*5367F0201306FMFS05 CLR A SET A=0 AS SUBSET NOT IN TABLE 132*5367F0201307 JMP* (FMFSRC) 132*5367F0201308* 132*5367F0201309FMFS10 ENA 1 RETURN WITH A NOT 0 132*5367F0201310 JMP* (FMFSRC) 132*5367F0201311 SPC 2 132*5367F0201312FCBSAV NUM 0 SAVED FCB ADDRESS TO BE CHECKED 132*5367F0201313 SPC 4 F0201314 END F0201315 NAM PUTREC F03 A ITOS CCS 3.0 SL-149F0300001* PUT NEW RECORD(S) INTO FILE F0300002* CREDIT COLLECTION SYSTEM VERSION 3.0 F0300003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F0300004* COPYRIGHT CONTROL DATA CORPORATION 1979 F0300005* F0300006* F0300007**** F0300008* PUTREC IS THE REQUEST PROCESSOR FOR THE PUT RECORD REQUEST. F0300009* IT IS ALSO USED AS A SUBROUTINE BY THE WRITE RECORD PRO- F0300010* CESSOR. THE PUT RECORD REQUEST HAS THE FOLLOWING CALL F0300011* SEQUENCE: F0300012* F0300013* CALL PUTS (REQBUF,RECBUF,NUMREC,ISTAT) F0300014ÐÐ* F0300015* WHERE REQBUF IS THE FILE REQUEST BUFFER, F0300016* NUMREC IS THE NUMBER OF RECORDS TO BE STORED, F0300017* RECBUF IS THE RECORD BUFFER CONTAINING THE NUMREC F0300018* RECORDS AND F0300019* ISTAT IS THE FILE REQUEST STATUS WORD. F0300020* F0300021* THE WRITER RECORD REQUEST HAS THE FOLLOWING CALL SEQUENCE: F0300022* F0300023* CALL WRITER (REQBUF,RECBUF,KEYVAL,ISTAT) F0300024* F0300025* WHERE REQBUF IS THE FILE REQUEST BUFFER, F0300026* RECBUF IS THE RECORD BUFFER CONTAINING THE SINGLE F0300027* RECORD, F0300028* KEYVAL IS THE PRIMARY KEY VALUE ARRAY AND F0300029* ISTAT IS THE FILE REQUEST STATUS WORD. F0300030* F0300031* WHEN PUTREC IS EXECUTED BY THE EXEC TO PROCESS A PUTS FILE F0300032* REQUEST, A JUMP IS MADE TO PUTREC+1. WHEN PUTREC IS EXECUT-F0300033* ED BY THE WRITE RECORD PROCESSOR, A RETURN JUMP IS MADE TO F0300034* PUTREC. PUTREC COMPLETES EXECUTION BY JUMPING TO FMCOMP IF F0300035* EXECUTED BY THE EXEC OR BY RETURNING TO THE CALLER IF EXE- F0300036* CUTED BY THE WRITE RECORD PROCESSOR F0300037* F0300038* WHENEVER PUTREC IS USED AS A SUBROUTINE BY WRITER, THE NUM- F0300039ÐÐ* BER OF RECORDS TO BE STORED IS ONE. F0300040*E F0300041* AFTER SOME PRELIMINARY PROCESSING, PUTREC CHECKS WHETHER OR F0300042* NOT THE FILE HAS ROOM FOR ALL OF THE SET OF ONE OR MORE NEW F0300043* RECORDS TO BE WRITTEN INTO THE FILE. IF THERE IS ROOM FOR F0300044* NO MORE NEW RECORDS, THE REQUEST WILL BE REJECTED WITH F0300045* APPROPRIATE ERROR STATUS. IF THERE IS ROOM FOR SOME BUT NOTF0300046* ALL OF THE RECORDS, ISTAT AND REQBUF WILL BE SET TO REFLECT F0300047* THIS CONDITION (AND THE NUMBER ACUTALLY STORED). F0300048* F0300049* TWO EOF CODE WORDS ARE STORED INTO THE FIRST TWO WORDS OF F0300050* THE CORE SPACE THAT WOULD BE USED BY THE NEXT RECORD FOLLOW-F0300051* ING THE LAST OF THE SET OF RECORDS TO BE STORED FOR THE F0300052* CURRENT. THESE EOF WORDS WILL BE WRITTEN TO THE FILE'S F0300053* RECORD SPACE (ON MM) AS LONG AS THERE IS ROOM FOR ANOTHER F0300054* CURRENT REQUEST. THESE EOF WORDS WILL BE WRITTEN TO THE F0300055* FILE'S RECORD SPACE (ON MM) AS LONG AS THERE IS ROOM FOR F0300056* ANOTHER RECORD TO BE STORED INTO THE FILE F0300057* PUTREC CHECKS FOR A POSSIBLE UNPROTECTED ADDRESS ERROR AND F0300058* A POSSIBLE OVERLAP OF RECBUF WITH REQBUF OR ISTAT PRIOR TO F0300059* STORING THE EOF CODES INTO THE USER'S RECORD SPACE. F0300060* F0300061* AFTER PUTREC STORES THE NEW RECORD(S) INTO THE FILE, THE FCBF0300062* IS UPDATED TO REFLECT THE NEW CURRENT NUMBER OF RECORDS IN F0300063* THE FILE. THE FCB WILL BE UPDATED ON MASS MEMORY IF PUTREC F0300064ÐÐ* HAD BEEN EXECUTED BY THE EXEC AND IF THE CURRENT NO. OF NEW F0300065* RECORDS SINCE THE FCB WAS UPDATED IS .GE. THE MAX. NO. OF F0300066* NEW RECORDS BEFORE AUTO UPDATE. F0300067* F0300068* F0300069 ENT PUTREC ENTRY POINT F0300070* F0300071 EXT FMCOMP EXEC'S COMPLETE REQUEST ENTRY FOR REENT. PROCSF0300072 EXT MMWRIT MASS MEMORY WRITE ROUTINE F0300073 EXT CLFRIO COMPUTE LENGTH FOR RECORD I/O F0300074 EXT FMEOFC END-OF-FILE CODE F0300075 EXT FMNRCD NO. OF NEW RECORDS BEFORE UPDATE OF FCB F0300076 EXT DWSUB DOUBLE WORD SUBTRACT F0300077* ONE CARD REMOVED F0300078 EXT MMLUTB MASS MEMORY LOGICAL UNIT TABLE F0300079 EXT FMUFCB UPDATE FCB ON MASS MEMORY F0300080 EXT CKUADR CHECK FOR UNPROTECTED ADDRESS ERROR F0300081 EXT FMBRRN BUMP RELATIVE RECORD NUMBER BY ONE 121*4627F0300082 EXT FMCOVL CHECK IF PARAMETERS OVERLAP F0300083 EXT FMFSRC CHECK FCB SUBSET RESIDENCY 132*5371F0300084**** F0300085 EJT F0300086* EQUIVALENCES F0300087 SPC 2 F0300088* COMMUNICATION REGION CONSTANTS F0300089ÐÐ EQU ZERO(2) ZERO CONSTANT F0300090 EQU ONEMSK(3) ONE MASK TABLE F0300091 EQU ZROMSK($13) ZERO MASK TABLE F0300092 EQU ONEBIT($23) ONE BIT TABLE F0300093 SPC 1 F0300094* UCT ENTRY EQUIVALENCES F0300095 EQU UIDENT(ZERO) USER IDENTIFICATION F0300096 EQU FIDENT(1) PSEUDO FILE IDENTIFIER F0300097 EQU FCBCAD(2) FCB CORE ADDRESS F0300098 EQU FSLADR(3) FILE SPACE LIMITS TABLE ENTRY ADDRESS F0300099 EQU FCBSAD(4) FCB SUBSET ADDRESS F0300100 EQU USRCPT(5) USERS CONTROL POINT F0300101 EJT F0300102* REQUEST BUFFER INDEXES - FIRST 4 WORDS F0300103 EQU RBATHR(0) REQUEST BUFFER ADDRESS THREAD F0300104 EQU BUFAMP(1) BUFFER ADDRESS MAIN PART F0300105 EQU CNTLPT(2) CONTROL POINT (OR SPARE) F0300106 EQU RQINFO(3) REQUEST INFORMATION (MULTI-FIELD) F0300107* BITS USE F0300108* 15-12 SPARE F0300109* 11-04 REQUEST INDEX F0300110* 03-00 LEVEL OF REQUESTOR F0300111* F0300112* REQUEST BUFFER INDEXES - MAIN PART F0300113 EQU QREG(0) Q REGISTER F0300114ÐÐ EQU IREG(1) I REGISTER F0300115 EQU PARLST(2) ADDRESS OF PARAMETER LIST F0300116 EQU RTNADR(2) RETURN ADDRESS TO USER (UPON RETURN FROM EXEC)F0300117 EQU UCTADR(3) UCT ENTRY ABSOLUTE ADDRESS F0300118 EQU USERID(4) USER IDENTIFIER F0300119 EQU FCBADR(5) FCB ADDRESS (MAY BE SET BY CALLER OR INTCPTR.)F0300120 EQU RADINT(6) RETURN ADDRESS TO INTERCEPTOR F0300121 EQU RPIDX(7) REQUEST PROCESSOR INDEX F0300122* BITS 14-00 REQUEST PROCESSOR INDEX F0300123* BIT 15 TYPE OF PROCESSOR F0300124* =0, SERIAL PROCESSOR F0300125* =1, REENTRANT PROCESSOR F0300126 EQU LOKREC(8) NUMBER OF RECORDS TO BE READ/WRITTEN PER I/O F0300127* CALL AND LOCK RECORDS ON RETRIEVE FLAG F0300128* BITS 14-00 NUMBER OF RECORDS PER CALL F0300129* BIT 15 =0, DO NOT LOCK ON RETRIEVE F0300130* =1, LOCK RECORDS ON RETRIEVE F0300131 EQU USEFLG(9) TYPE OF FILE USE FLAG F0300132* -1, OPEN FOR COMPRESSION F0300133* -2, OPEN FOR SPECIAL PROCESSING F0300134* 0, OPEN FOR ACESS VIA REL REC NO F0300135* 1, OPEN FOR RETRIEVAL VIA KEY 1 F0300136* 2, OPEN FOR RETRIEVAL VIA KEY 2 F0300137* 3, OPEN FOR RETRIEVAL VIA KEY 3 F0300138* 4, OPEN FOR RETRIEVAL VIA KEY 4 F0300139ÐÐ EQU NUMREC(10) NUMBER OF RECORDS ACTUALLY STORED/RETRIEVED F0300140 EQU RRNMSB(11) REL REC NUMBER OF STORED/RETRIEVED REC, MSB F0300141 EQU RRNLSB(12) REL REC NUMBER OF STORED/RETRIEVED REC, LSB F0300142 EQU RMPLEN(20) LENGTH OF REQBUF MAIN PART F0300143 EJT F0300144* FILE CONTROL BLOCK EQUIVALENCES F0300145 EQU FH(4) LENGTH -1 OF FCB HEADER F0300146 EQU FILEID(ZERO) FILE IDENTIFIER F0300147* ACCESS FILEID INDIRECTLY F0300148* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBERF0300149* BITS 10-00 INDEX OF FCB IN FCB TABLE F0300150 EQU FCBFLG(1) FCB FLAGS F0300151* BITS 15-8, SPARE F0300152* BITS 7-00, NUMBER OF USERS USING FILE F0300153 EQU FILOCK(2) FILE LOCK FLAG (IF NON-0, CONTAINS USER ID) F0300154 EQU NUMSET(3) NUMBER OF SETS OF LOCKED RECORDS IN FILE F0300155 EQU NUMNEW(4) NUMBER OF NEW RECORDS SINCE FCB UPDATED ON MM F0300156 SPC 1 F0300157 EQU RECLEN(FH+1) RECORD LENGTH IN WORDS F0300158 EQU TDATRM(FH+2) TOTAL NUMBER OF DATA RECORDS, MSB F0300159 EQU TDATRL(FH+3) TOTAL NUMBER OF DATA RECORDS, LSB F0300160 EQU DATBAM(FH+4) DATA RECORDS BEGINNING SECTOR ADDRESS, MSB F0300161 EQU DATBAL(FH+5) DATA RECORDS BEGINNING SECTOR ADDRESS,LMSB F0300162 EQU FCBIND(FH+6) FCB INDICATORS F0300163* BIT 15 , SECTOR ALLIGNED RECORDS IF =1 F0300164ÐÐ* BIT 14 , STORAGE MODE FOR INDEXED FILE F0300165* =0, RECORDS STORED RANDOMLY WITHF0300166* RESPECT TO PRIMARY KEY F0300167* =1, RECORDS STORED IN ORDER WIT F0300168* RESPECT TO PRIMARY KEY F0300169* BIT 13 , =1, FILE IS CURRENTLY OPEN F0300170* =0, FILE IS CURRENTLY CLOSED F0300171* BIT 12 , =1, FILE IS BEING COMPRESSED F0300172* =0, FILE IS NOT BEING COMPRESSEDF0300173* BIT 11 , =1, FILE IS OPEN FOR SPECIAL F0300174* PROCESSING F0300175* =0, FILE IS NOT OPEN FOR SPECIALF0300176* PROCESSING F0300177* BIT 8 , =1, RECORDS CONTAIN BINARY DATA F0300178* =0, RECORDS DO NOT CONTAIN F0300179* BINARY DATA F0300180* BIT 0 , FILE TYPE F0300181* =0, SEQUENTIAL FILE F0300182* =1, INDEXED FILE F0300183 EQU NEDATM(FH+7) NUMBER OF EXISTING DATA RECORDS, MSB F0300184 EQU NEDATL(FH+8) NUMBER OF EXISTING DATA RECORDS, LSB F0300185 EQU SEQLTH(NEDATL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F0300186* OF FCB FOR A SEQUENTIAL FILE F0300187 SPC 1 F0300188 EQU NEXTBM(FH+9) NEXT FREE KEY INDEX BLOCK, MSB F0300189ÐÐ EQU NEXTBL(FH+10) NEXT FREE KEY INDEX BLOCK, LSB F0300190 EQU TNKEYM(FH+11) TOTAL NUMBER OF KEY INDEX BLOCKS, MSB F0300191 EQU TNKEYL(FH+12) TOTAL NUMBER OF KEY INDEX BLOCKS, LSB F0300192 EQU KEYBAM(FH+13) KEY INDEX BEGINNING SECTOR ADDRESS, MSB F0300193 EQU KEYBAL(FH+14) KEY INDEX BEGINNING SECTOR ADDRESS, LSB F0300194 EQU LENKY1(FH+15) LENGTH OF KEY NO. 1 F0300195 EQU POSKY1(FH+16) BYTE POSITION OF KEY NO. 1 F0300196 EQU LENKY2(FH+17) LENGTH OF KEY NO. 2 F0300197 EQU POSKY2(FH+18) BYTE POSITION OF KEY NO. 2 F0300198 EQU LENKY3(FH+19) LENGTH OF KEY NO. 3 F0300199 EQU POSKY3(FH+20) BYTE POSITION OF KEY NO. 3 F0300200 EQU LENKY4(FH+21) LENGTH OF KEY NO. 4 F0300201 EQU POSKY4(FH+22) BYTE POSITION OF KEY NO. 4 F0300202 EQU TSFILM(FH+23) TOTAL NUMBER OF SECTORS IN FILE, MSB F0300203 EQU TSFILL(FH+24) TOTAL NUMBER OF SECTORS IN FILE, LSB F0300204 EQU INDLEN(TSFILL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F0300205* OF FCB FOR AN INDEXED FILE F0300206 EJT F0300207* THE FOLLOWING PORTION OF THE FCB EXISTS ONLY F0300208* ON MASS MEMORY. THESE 8 WORDS ARE NOT LOADED F0300209* INTO EITHER OF THE FILE MANAGER CONTROLLED FCBF0300210* TABLES. F0300211 EQU NAME12(FH+25) FILE NAME, CHARACTERS 1 AND 2 F0300212 EQU NAME34(FH+26) FILE NAME, CHARACTERS 3 AND 4 F0300213 EQU NAME56(FH+27) FILE NAME, CHARACTERS 5 AND 6 F0300214ÐÐ EQU NAME78(FH+28) FILE NAME, CHARACTERS 7 AND 8 F0300215 EQU OWNR12(FH+29) OWNER NAME, CHARACTERS 1 AND 2 F0300216 EQU OWNR34(FH+30) OWNER NAME, CHARACTERS 3 AND 4 F0300217 EQU OWNR56(FH+31) OWNER NAME, CHARACTERS 5 AND 6 F0300218 EQU OWNR78(FH+32) OWNER NAME, CHARACTERS 7 AND 8 F0300219 EQU BYTLEN(FH+33) BYTE LENGTH OF RECORD F0300220* F0300221* FOR COMPRESS ONLY F0300222* F0300223 EQU PRSRNM(FH+34) RRN OF LAST PROCESSED RECORD - MSB F0300224 EQU PRSRNL(FH+35) RRN OF LAST PROCESSED RECORD - LSB F0300225 EQU NEWRNM(FH+36) RRN OF THE LATEST 'NEW' RECORD - MSB F0300226 EQU NEWRNL(FH+37) RRN OF THE LATEST 'NEW' RECORD - LSB F0300227 SPC 4 F0300228* WORDS 0 THRU 4 OF THE FCB HEADER AND WORDS F0300229* 6 THRU 10 OF THE FCB ARE REFERRED TO AS THE F0300230* SHARED SUBSET OF THE FCB. THEY INCLUDE THE F0300231* ONLY FCB WORDS THAT CAN BE MODIFIED AFTER FILEF0300232* CREATION. IF TWO OR MORE USERS HAVE THE SAME F0300233* FILE OPEN, THERE HAS TO BE A SINGLE MASTER F0300234* COPY OF THE SUBSET THAT RECEIVES (AND RECORDS)F0300235* ALL OF THE UPDATES. THE CONTROLLED SUBSET F0300236* WILL ALWAYS BE PART OF A MAIN MEMORY RESIDENT F0300237* FCB IF THE FCB IS IN A FM CONTROLLED TABLE. F0300238* IF THE FCB IS IN USER SPACE, THE SUBSET MAY ATF0300239ÐÐ* TIMES RESIDE IN THE SUBSET CONTROL TABLE. F0300240 SPC 2 F0300241* ALTERNATE NAMES FOR SUBSET WORDS F0300242 EQU SAFCBI(FH+1) SUBSET ALTERNATE NAME FOR FCBIND F0300243 EQU SADATM(FH+2) SUBSET ALTERNATE NAME FOR NEDATM F0300244 EQU SADATL(FH+3) SUBSET ALTERNATE NAME FOR NEDATL F0300245 EQU SANXTM(FH+4) SUBSET ALTERNATE NAME FOR NEXTBM F0300246 EQU SANXTL(FH+5) SUBSET ALTERNATE NAME FOR NEXTBL F0300247 EJT F0300248* VOLUME INFORMATION TABLE F0300249* F0300250 EQU VISLUN(2) SYSTEM LOGICAL UNIT NUMBER (BIT 15=1,NOT READYF0300251* ACCESS VISLUN INDIRECTLY F0300252 EQU VINAME(1) VOLUME NAME - ASCII CHARACTERS 1 AND 2 F0300253* VOLUME NAME - ASCII CHARACTERS 3 AND 4 F0300254* VOLUME NAME - ASCII CHARACTERS 5 AND 6 F0300255* VOLUME NAME - ASCII CHARACTERS 7 AND 8 F0300256 EQU VINMBR(5) VOLUME NUMBER - (2 ASCII CHARACTERS) F0300257 EQU VIBMSM(6) BEGINNING OF MANAGEABLE SPACE - MSB F0300258 EQU VIBMSL(7) BEGINNING OF MANAGEABLE SPACE - LSB F0300259 EQU VIASDM(8) AVAILABLE SPACE DIRECTORY ADDRESS - MSB F0300260 EQU VIASDL(9) AVAILABLE SPACE DIRECTORY ADDRESS - LSB F0300261 EQU VIASDS(10) # SECTORS IN AVAILABLE SPACE DIRECTORY F0300262 EQU VILBAM(11) LARGEST BLOCK OF SPACE AVAILABLE - MSB F0300263 EQU VILBAL(12) LARGEST BLOCK OF SPACE AVAILABLE - LSB F0300264ÐÐ EQU VIWPS(13) WORDS/SECTOR FOR VOLUME F0300265 EQU VIFDDM(14) FILE DEFINITION DIRECTORY ADDRESS - MSB F0300266 EQU VIFDDL(15) FILE DEFINITION DIRECTORY ADDRESS - LSB F0300267 EQU VIMAXF(16) MAX. NUMBER OF FILES PERMITTED ON VOLUME F0300268 EQU VICURF(17) CURRENT NUMBER OF FILES EXISTING ON VOLUME F0300269 EQU VINFDB(18) NUMBER OF BLOCKS IN FILE DEFINITION DIRECTORY F0300270 EQU VINXTB(19) NEXT AVAILABLE BLOCK IF FILE DEF. DIRECTORY F0300271 EQU VINOOF(20) NUMBER OF OPEN FILES ON VOLUME F0300272 EJT F0300273* REQUEST PROCESSOR CONTROL TABLE F0300274* F0300275 EQU RP(10) INDEX TO START OF REQUEST PARAMETERS F0300276 EQU MR(RP+5) INDEX TO START OF MONITOR REQUEST PARAM LIST F0300277 EQU SS(MR+10) INDEX TO START OF SCRATCH PORTION OF PAR LIST F0300278* F0300279 EQU RPLOGU(1) LU NUMBER OF MM DEVICE F0300280 EQU RPAREQ(2) ACTIVE REQUEST FLAG (IF 0, NONE FOR TABLE) F0300281 EQU RPWAIT(3) START OF WAITING REQUEST QUEUE (IF 0, NO WAITGF0300282 EQU RPRLEV(4) REQUEST PRIORITY LEVEL - ACTIVE REQUEST F0300283 EQU RPRBF4(5) REQBUF ADDRESS - FIRST FOUR WORDS F0300284 EQU RPLTEA(6) LOCK TABLE ENTRY (ABSOLUTE) ADDRESS F0300285 EQU RPRTNJ(7) RETURN JUMP TO REQUEST PROCESSOR F0300286 EQU RPPADR(8) PROCESSOR ADDRESS F0300287 SPC 1 F0300288* PARAMETER LIST FOR REQUEST PROCESSOR F0300289ÐÐ EQU RPFCBA(9) FCB ADDRESS FOR FILE F0300290 EQU RPRBMP(RP+0) REQBUF ADDRESS - MAIN PART F0300291 EQU RPPFP1(RP+1) REQUEST PARAMETER ADDRESS - FIRST + 1 F0300292 EQU RPPFP2(RP+2) REQUEST PARAMETER ADDRESS - FIRST + 2 F0300293 EQU RPPFP3(RP+3) REQUEST PARAMETER ADDRESS - FIRST + 3 F0300294 EQU RPPFP4(RP+4) REQUEST PARAMETER ADDRESS - FIRST + 4 F0300295 SPC 1 F0300296* MAIN MONITOR REQUEST F0300297 EQU RPMREQ(MR+0) MONITOR REQUEST CODE WORD F0300298 EQU RPMRP1(MR+1) COMPLETION ADDRESS F0300299 EQU RPMRP2(MR+2) THREAD WORD F0300300 EQU RPMRP3(MR+3) LOGICAL UNIT FOR I/O F0300301 EQU RPMRP4(MR+4) NUMBER OF WORDS F0300302 EQU RPMRP5(MR+5) START CORE ADDRESS F0300303 EQU RPMRP6(MR+6) MASS MEMORY ADDRESS, MSB F0300304 EQU RPMRP7(MR+7) MASS MEMORY ADDRESS, LSB F0300305 EQU RPRCPT(MR+8) CONTROL POINT (FOR I/O REQUESTS) F0300306 EQU RPRETN(MR+9) SAVED RETURN ADDRESS F0300307* ALTERNATE COMMON NAMES F0300308 EQU REQBUF(RP+0) USERS FIRST CALL PARAMETER ADDRESS F0300309 EQU RECBUF(RP+1) RECORD BUFFER PARAMETER - FOR PUTS F0300310 EQU ISTAT(RP+4) USERS COMPLETION STATUS PARAMETER ADDRESS F0300311 EQU NORECS(RP+2) NUMBER OF RECORDS PARAMETER - FOR PUTS F0300312 EJT F0300313* SCRATCH FOR PUTREC F0300314ÐÐ* F0300315* PARAMETER LIST FOR DWSUB F0300316 EQU TOTMSB(SS+0) TOTAL NO. OF RECORDS, MSB F0300317 EQU TOTLSB(SS+1) TOTAL NO. OF RECORDS, LSB F0300318 EQU CURMSB(SS+2) CURRENT NO. OF RECORDS, MSB F0300319 EQU CURLSB(SS+3) CURRENT NO. OF RECORDS, LSB F0300320 EQU PERMSB(SS+4) NO. OF NEW RECORDS PERMITTED, MSB F0300321 EQU PERLSB(SS+5) NO. OF NEW RECORDS PERMITTED, LSB F0300322 EQU COMFLG(SS+6) COMPLETION STATUS F0300323* F0300324* PARAMETER LSIT FOR MM I/O ROUTINE F0300325 EQU MSBBSA(SS+7) MSB OF BASE SECTOR ADDRESS F0300326 EQU LSBBSA(SS+8) LSB OF BASE SECTOR ADDRESS F0300327 EQU MSBRRN(SS+9) MSB OF RELATIVE RECORD NUMBER F0300328 EQU LSBRRN(SS+10) LSB OF RELATIVE RECORD NUMBER F0300329 EQU RCDLEN(SS+11) RECORD LENGTH - BIT 15 SET IF SECTOR ALLIGNED F0300330 EQU NUMWDS(SS+12) NUMBER OF WORDS TO READ OR WRITE F0300331 EQU OFFSET(SS+13) WORD OFFSET FROM START OF RECORD F0300332 EQU RECBFR(SS+14) ADDRESS OF BUFFER FOR I/O F0300333 EQU IOTYPE(SS+15) I/O TYPE: NON-ZERO IF FILE I/O, ELSE ZERO. F0300334* MISCELLANEOUS PARAMETERS F0300335 EQU RETURN(SS+16) SAVED RETURN ADDRESS - 0 IF EXECUTED BY EXEC F0300336 EQU SAVMSB(SS+17) SAVED MSB OF NO. OF EXISTING RECORDS F0300337 EQU SAVLSB(SS+18) SAVED LSB OF NO. OF EXISTING RECORDS F0300338 EQU SAVSAD(SS+19) SAVED FCB SUBSET ADDRESS F0300339ÐÐ EJT F0300340PUTREC 000 000 ENTRY POINT - WILL BE NON-ZERO IF EXECUTED BY F0300341* WRITE RECORD PROCESSOR F0300342 LDA* PUTREC F0300343 STA- RETURN,I SAVE RETURN ADDRESS - MAY BE 0 F0300344 CLR Q F0300345 STQ* PUTREC CLEAR ENTRY POINT FOR NEXT USE F0300346 STQ* TSTFLG ALSO CLEAR TEST FLAG - USED IN LOGIC AT PUT40+F0300347* F0300348 STQ- OFFSET,I AND CLEAR OFFSET FOR RECORD WRITE F0300349 SAZ PUT10 SKIP IF EXECUTED FROM EXEC F0300350 ENA 1 SET A=1 AS NUMREC VALUE FOR WRITER F0300351 JMP* PUT30 GO STORE NUMBER OF RECORDS F0300352* F0300353PUT10 LDQ- NORECS,I F0300354 LDA- (ZERO),Q PICKUP NUMREC VALUE F0300355 SAM PUT20 CHECK IF NEGATIVE - BAD IF SO F0300356 SAN PUT30 CHECK IF NON-ZERO - GOOD IF YES F0300357PUT20 LDA =N$8200 SET REJECTED BIT AND BAD NUMREC FLAG 132*5257F0300358 JMP* PUT44 F0300359* 2 CARDS DELETED 132*5371F0300360* F0300361PUT30 STA- IOTYPE,I SAVE NUMBER OF RECORDS TO BE STORED F0300362* (ALSO SETS I/O TYPE FLAG TO SIGNAL FILE I/O) F0300363 LDA- RECBUF,I F0300364ÐÐ STA- RECBFR,I STORE RECORD BUFFER ADDRESS IN MMWRIT PAR LISTF0300365 LDQ- RPFCBA,I F0300366 LDA- TDATRL,Q PREPARE TO USE DWSUB TO COMPUTE NO. 123*4933F0300367 LDQ- TDATRM,Q OF NEW RECORDS THAT CAN BE STORED 123*4933F0300368 LLS 1 INTO THE FILE 123*4933F0300369 ALS 15 CONVERT TO 15 BIT FORMAT 123*4933F0300370 STA- TOTLSB,I 123*4933F0300371 STQ- TOTMSB,I 123*4933F0300372 LDQ- REQBUF,I GET FCB SUBSET ADDRESS AND SAVE IT F0300373 LDQ- UCTADR,Q F0300374 LDQ- FCBSAD,Q F0300375 STQ- SAVSAD,I F0300376 TRQ A 132*5371F0300377 RTJ FMFSRC CHECK IF SUBSET IS IN SUBSET TABLE 132*5371F0300378 SAN PUT35 SKIP IF YES F0300379* F0300380* 1 CARD DELETED 132*5371F0300381 LDA- NEDATL,Q PICKUP NO. OF EXISTING RECORDS 123*4933F0300382 LDQ- NEDATM,Q USING REGULAR FCB ADDRESSING 132*5371F0300383 JMP* PUT40 F0300384 SPC 2 F0300385ADSUBT ADC DWSUB DOUBLE WORD SUBTRACT F0300386ACLFRI ADC CLFRIO COMPUTE LENGTH FOR RECORD I/O 121*4576F0300387ADCKUA ADC CKUADR CHECK FOR UNPROTECTED ADDRESS ERROR 121*4576F0300388SAVADR NUM 0 SAVED ADDRESS 121*4576F0300389ÐÐTSTFLG NUM 0 TEST FLAG F0300390 EJT F0300391PUT35 LDA- SADATL,Q PICKUP NO. OF EXISTING RECORDS 123*4933F0300392 LDQ- SADATM,Q FROM FCB SUBSET 123*4933F0300393* 123*4933F0300394PUT40 LLS 1 CONVERT TO 15 BIT FORMAT 123*4933F0300395 ALS 15 123*4933F0300396 STA- CURLSB,I STORE FOR DWSUB 123*4933F0300397 STQ- CURMSB,I 123*4933F0300398 STA- SAVLSB,I SAVE MSB/LSB FOR LATER 123*4933F0300399 STQ- SAVMSB,I 123*4933F0300400 LDQ- I F0300401 INQ TOTMSB SET Q TO ABS ADDRESS OF PARAMETER LIST F0300402 RTJ* (ADSUBT) DO THE DOUBLE WORD SUBTRACT F0300403 LDA- COMFLG,I ASSURE SUBTRACT WAS OK F0300404 SAZ PUT45 F0300405 LDA =N$C020 FM STRUCTURES ERROR F0300406PUT44 JMP* PUT105 GO SET ISTAT AND COMPLETE REQUEST F0300407* F0300408PUT45 LDQ- PERMSB,I CHECK RESULT (NUMBER NEW PERMITTED) - IF 0, F0300409 LDA- PERLSB,I REJECT REQUEST F0300410 SAN PUT50 SKIP IF EITHER MSB OR LSB NOT 0 F0300411 SQN PUT50 F0300412 LDA =N$9000 SET REJECTED BIT AND NO ROOM FOR RECORD BIT F0300413 JMP* PUT105 GO SET ISTAT AND COMPLETE REQUEST F0300414ÐÐ* F0300415PUT50 STQ- TOTMSB,I CHECK IF ROOM FOR ALL RECORDS F0300416 STA- TOTLSB,I F0300417 CLR A TO MAKE THE CHECK, SUBTRACT THE REQUESTED F0300418 STA- CURMSB,I NUMBER FROM THE PERMITTED F0300419 LDA- IOTYPE,I F0300420 STA- CURLSB,I F0300421 LDQ- I F0300422 INQ TOTMSB SET Q TO ABS ADDRESS OF PARAM LIST F0300423 RTJ* (ADSUBT) DO THE SUBTRACT F0300424 LDA- COMFLG,I CHECK IF ROOM FOR ALL F0300425 SAZ PUT55 SKIP IF YES F0300426 LDA- TOTLSB,I RESET NO. TO NUMBER PERMITTED F0300427 STA- IOTYPE,I F0300428 RAO* TSTFLG BUMP TEST FLAG - SIGNALS DON'T WRITE EOF FLAG F0300429 LDA- ONEBIT+12 SET A=$1000 FOR ISTAT (NO ROOM FOR ALL RECS) F0300430PUT55 LDQ- ISTAT,I STORE A AS ISTAT (0 OR $1000) F0300431 STA- (ZERO),Q F0300432* F0300433 LDA- RECBFR,I CHECK FOR UNPROTECTED ADDRESS ERROR 121*4576F0300434 CLR Q FIRST CHECK START OF RECORD BUFFER 121*4576F0300435 RTJ* (ADCKUA) 121*4576F0300436 LDA- IOTYPE,I NEXT, CHECK END OF RECORD BUFFER 121*4576F0300437 RTJ* (ACLFRI) CONVERT TO NO. OF WORDS 121*4576F0300438 INA 1 BUMP FOR EOF CODES 121*4576F0300439ÐÐ ADD- RECBFR,I 121*4576F0300440 STA* SAVADR SAVE ADDRESS 121*4576F0300441 CLR Q 121*4576F0300442 RTJ* (ADCKUA) CHECK ADDRESS 121*4576F0300443 EJT 121*4576F0300444 LDA* SAVADR SET Q TO LENGTH OF RECORD BUFFER 121*4576F0300445 SUB- RECBFR,I 121*4576F0300446 TRA Q 121*4576F0300447 INQ 1 121*4576F0300448 LDA- RECBFR,I SET A TO RECORD BUFFER ADDRESS 121*4576F0300449 RTJ FMCOVL CHECK IF RECORD BUFFER OVERLAPS WITH 121*4576F0300450* OTHER PARAMETER 121*4576F0300451 SAZ PUT58 NO, SKIP 121*4576F0300452 LDA =N$A000 YES, SET ERROR STATUS AND LEAVE 121*4576F0300453 JMP* PUT160 121*4576F0300454* 121*4576F0300455PUT58 LDQ* SAVADR STORE TWO EOF CODE WORDS INTO NEXT 121*4576F0300456 LDA =XFMEOFC RECORDS SPACE 121*4576F0300457 STA- (ZERO),Q 121*4576F0300458 INQ -1 121*4576F0300459 STA- (ZERO),Q 121*4576F0300460* 121*4576F0300461 LDA- IOTYPE,I SET A TO NO. OF RECORDS F0300462 RTJ CLFRIO COMPUTE LENGTH FOR RECORD I/O F0300463 STA- NUMWDS,I STORE FOR MMWRIT CALL F0300464ÐÐ* F0300465* 6 CARDS DELETED 121*4576F0300466 LDA* TSTFLG CHECK IF EOF FLAG SHOULD BE ADDED TO RCD WRITEF0300467 SAZ PUT60 SKIP IF YES F0300468 JMP* PUT80 NO, NOT ROOM FOR EOF F0300469* F0300470PUT60 LDA- PERMSB,I CHECK IF NUMBER OF NEW RECORDS PERMITTED IS F0300471 LDQ- PERLSB,I SAME AS NUMBER OF RECORDS PERMITTED F0300472 SAN PUT65 SKIP IF NO F0300473 SQZ PUT80 SKIP IF YES - CANNOT WRITE EOF FLAG F0300474* F0300475PUT65 LDQ- RPFCBA,I EOF CAN BE WRITTEN - CHECK IF SECTOR ALLIGNED F0300476 LDA- FCBIND,Q F0300477 SAP PUT70 SKIP IF FILE NOT SECTOR ALLIGNED F0300478 LDA- (FILEID),Q SET Q TO FILE'S MM LOGICAL UNIT F0300479 ARS 11 F0300480 AND- ONEMSK+4 F0300481 TRA Q F0300482 LDQ MMLUTB,Q PICKUP VIT TABLE ADDRESS FOR LU F0300483 LDA- VIWPS,Q PICKUP WORDS PER SECTOR F0300484 JMP* PUT75 GO ADD IT TO LENGTH FOR WRITE F0300485* F0300486PUT70 ENA 2 SET A=2 AS RECORDS NOT SECTOR ALLIGNED F0300487PUT75 ADD- NUMWDS,I ADD A TO CURRENT NUMBER OF WORDS F0300488 STA- NUMWDS,I STORE BACK UPDATED LENGTH F0300489ÐÐ* F0300490 EJT 121*4576F0300491PUT80 LDQ- RPFCBA,I SET BASE SECTOR ADDRESS FOR WRITE 121*4576F0300492 LDA- DATBAM,Q F0300493 STA- MSBBSA,I F0300494 LDA- DATBAL,Q F0300495 STA- LSBBSA,I F0300496 LDA- RECLEN,Q SET RECORD LENGTH FOR WRITE - SET BIT 15 IF F0300497 LDQ- FCBIND,Q FILE HAS SECTOR ALLIGNED RECORDS F0300498 SQP PUT90 SKIP IF NOT SECTOR ALLIGNED F0300499 EOR- ONEBIT+15 F0300500PUT90 STA- RCDLEN,I F0300501* F0300502 LDA- SAVLSB,I PICKUP SAVED NUMBER OF EXISTING RECORDS F0300503 LDQ- SAVMSB,I F0300504 ALS 1 CONVERT TO 24-BIT INTEGER FORMAT 123*4933F0300505 LRS 1 123*4933F0300506 RTJ FMBRRN BUMP RRN BY 1 121*4627F0300507 STQ- MSBRRN,I STORE NEW RRN FOR WRITE 121*4627F0300508 STA- LSBRRN,I F0300509 LDQ- REQBUF,I STORE NEW RRN INTO REQBUF F0300510 STA- RRNLSB,Q F0300511 LDA- MSBRRN,I F0300512 STA- RRNMSB,Q F0300513 LDA- IOTYPE,I STORE NUMBER OF RECORDS STORED IN REQBUF F0300514ÐÐ STA- NUMREC,Q F0300515 LDQ- I F0300516 INQ MSBBSA SET Q TO ABS ADDRESS OF MMWRIT PARAMETER LIST F0300517 RTJ MMWRIT F0300518 SQP PUT120 SKIP IF NO I/O ERROR F0300519 INQ 0 CHECK IF Q=-0 (-0 IF COMPUTATION ERROR) F0300520 SQN PUT110 F0300521 LDA =N$C020 SET REJECTED + ILLEGAL + I/O ERROR BITS F0300522PUT105 JMP* PUT160 GO STORE ISTAT F0300523 EJT F0300524PUT110 LDA =N$8020 SET REJECTED + I/O ERROR BITS F0300525 JMP* PUT160 GO STORE ISTAT F0300526* F0300527PUT120 LDQ- SAVMSB,I NOW, COMPUTE NEW NUMBER OF EXISTING RECORDS F0300528 LDA- SAVLSB,I PICKUP SAVED CURRENT NUMBER F0300529* TWO CARDS DELETED 123*4933F0300530 ADD- IOTYPE,I ADD NUMBER OF NEW RECORDS TO LSB F0300531 SAP PUT125 SKIP IF A STILL POSITIVE F0300532 INQ 1 BUMP MSB BY 1 F0300533 AND- ONEMSK+14 CLEAR BIT 15 OF LSB F0300534PUT125 ALS 1 CONVERT BACK TO RRN FORMAT F0300535 LRS 1 F0300536 STQ- TOTMSB,I SAVE MSB AND LSB F0300537 STA- TOTLSB,I F0300538 LDQ- SAVSAD,I CHECK IF SUBSET IS IN SUBSET TABLE 132*5371F0300539ÐÐ TRQ A 132*5371F0300540 RTJ FMFSRC 132*5371F0300541 SAZ PUT130 SKIP IF NO 132*5371F0300542* 132*5371F0300543 LDA- TOTMSB,I STORE NEW SAVED NO. OF EXISTING RECORDS INTO F0300544 STA- SADATM,Q SUBSET F0300545 LDA- TOTLSB,I F0300546 STA- SADATL,Q F0300547 JMP* PUT140 F0300548* F0300549PUT130 LDA- TOTMSB,I NO SUBSET EXISTS. STORE DIRECTLY INTO FCB F0300550 STA- NEDATM,Q F0300551 LDA- TOTLSB,I F0300552 STA- NEDATL,Q F0300553 EJT F0300554PUT140 LDQ- SAVSAD,I F0300555 LDA- NUMNEW,Q NEXT, UPDATE NUMBER OF NEW RECORDS SINCE UP- F0300556 ADD- IOTYPE,I DATE OF FCB ON MM F0300557 STA- NUMNEW,Q F0300558* F0300559 LDQ- RPFCBA,I CHECK IF THIS IS A BINARY DATA FILE F0300560 LDA- FCBIND,Q F0300561 AND- ONEBIT+8 F0300562 SAN PUT145 SKIP TO UPDATE FCB IF BINARY DATA FILE F0300563 LDQ- RETURN,I CHECK IF CALLED FROM WRITER PROCESSOR F0300564ÐÐ SQN PUT142 SKIP TO AVOID UPDATE IF YES F0300565 LDQ- SAVSAD,I CHECK IF ENOUGH NEW RECORDS STORED TO REQUIRE F0300566 LDA- NUMNEW,Q F0300567 SUB =XFMNRCD FCB UPDATE F0300568 SAM PUT142 SKIP IF NO F0300569 LDQ- REQBUF,I CHECK IF FILE IS OPEN FOR SPECIAL PROCESSING F0300570 LDA- USEFLG,Q F0300571 INA 2 132*5371F0300572 SAN PUT145 SKIP IF NO - UPDATE THE FCB F0300573PUT142 JMP* PUT150 SKIP THE UPDATE F0300574* F0300575PUT145 RTJ FMUFCB UPDATE FCB ON MASS MEMORY F0300576 SQP PUT150 SKIP IF NO I/O ERROR NOTED F0300577 LDA* PUT110+1 SET REJECTED + I/O ERROR BITS F0300578 INQ 0 CHECK IF COMPUTATION ERROR F0300579 SQN PUT160 SKIP IF NO F0300580 ADD- ONEBIT+14 ADD ILLEGAL REQUEST BIT F0300581 JMP* PUT160 GO STORE ISTAT F0300582* F0300583PUT150 LDQ- RETURN,I CHECK IF CALLED BY WRITER F0300584 SQZ PUT170 SKIP IF NO F0300585 JMP- (ZERO),Q RETURN TO WRITER F0300586 SPC 3 F0300587PUT160 LDQ- ISTAT,I STORE A AS ISTAT F0300588 STA- (ZERO),Q F0300589ÐÐ JMP* PUT150 F0300590* F0300591PUT170 JMP FMCOMP RETURN TO EXEC F0300592 SPC 2 F0300593* ONE CARD DELETED 121*4576F0300594 END F0300595 NAM READRC F04 A ITOS CCS 3.0 SL-149F0400001* READ RECORD(S) FROM FILE F0400002* CREDIT COLLECTION SYSTEM VERSION 3.0 F0400003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F0400004* COPYRIGHT CONTROL DATA CORPORATION 1979 F0400005* F0400006* F0400007**** F0400008* READRC IS THE REQUEST PROCESSOR FOR THE READ RECORD RANDOMLYF0400009* REQUEST FOR FILES THAT HAVE BEEN OPENED FOR ACCESS VIA RELA-F0400010* TIVE RECORD NUMBER. IT IS ALSO USED AS A SUBROUTINE BY THE F0400011* GET NEXT SEQUENTIAL RECORD PROCESSORS (BOTH THE MAIN MEMORY F0400012* RESIDENT REENTRANT ROUTINE USED WITH FILES OPENED FOR ACCESSF0400013* VIA RELATIVE RECORD NUMBER AND THE MASS MEMORY RESIDENT ROU-F0400014* TINE USED FOR INDEXED ACCESS) AND BY THE MASS MEMORY RESI- F0400015* DENT READ RECORD RANDOMLY PROCESSOR USED FOR INDEXED ACCESS.F0400016* F0400017* THE READ RECORD RANDOMLY REQUEST HAS THE FOLLOWING CALL F0400018* SEQUENCE: F0400019ÐÐ* F0400020* CALL READR (REQBUF,RECBUF,KEYVAL,ISTAT) F0400021* F0400022* WHERE REQBUF IS THE FILE REQUEST BUFFER, F0400023* RECBUF IS THE RECORD BUFFER, F0400024* KEYVAL IS THE KEY VALUE OR RELATIVE RECORD NUMBER F0400025* AND F0400026* ISTAT IS THE FILE REQUEST STATUS WORD F0400027* F0400028* THE GET NEXT SEQUENTIAL RECORD REQUEST HAS THE FOLLOWING F0400029* CALL SEQUENCE: F0400030* F0400031* CALL GETS (REQBUF,RECBUF,KEYVAL,ISTAT) F0400032* F0400033* WHERE REQBUF IS THE REQUEST BUFFER, F0400034* RECBUF IS THE RECORD BUFFER, F0400035* KEYVAL IS KEY VALUE ARRAY AND F0400036* ISTAT IS THE FILE REQUEST STATUS WORD. F0400037* F0400038* THE KEYVAL PARAMETER FOR THE GETS REQUEST IS IGNORED IF THE F0400039* FILE IS OPEN FOR ACCESS VIA RELATIVE RECORD NUMBER. F0400040*E F0400041* F0400042* WHEN READRC IS EXECUTED BY THE EXEC TO PROCESS A READR RE- F0400043* QUEST, A JUMP IS MADE TO READRC+1. WHEN READRC IS EXECUTED F0400044ÐÐ* AS A SUBROUTINE, A RETURN JUMP IS MADE TO READRC. READRC F0400045* COMPLETES EXECUTION BY JUMPING TO FMCOMP IF EXECUTED BY THE F0400046* EXEC. READRC COMPLETES EXECUTION BY RETURNING TO THE CALLERF0400047* IF EXECUTED BY ANOTHER PROCESSOR. F0400048 EJT F0400049* WHEN READRC IS USED AS A SUBROUTINE BY ANOTHER PROCESSOR, F0400050* THE FOLLOWING FOUR WORDS OF THE PROCESSOR CONTROL TABLE F0400051* MUST BE SET UP BY THE CALLING PROCESSOR: F0400052* F0400053* REDBUF(SS+0) BUFFER FOR READ OF RECORDS F0400054* RELRNM(SS+1) RELATIVE RECORD NUMBER - MSB F0400055* RELRNL(SS+2) RELATIVE RECORD NUMBER - LSB F0400056* NORECS (SS+3) NUMBER OF RECORDS F0400057* F0400058* AFTER SOME PRELIMINARY INITIALIZATION, READRC CHECKS IF THE F0400059* REQUIRED RECORDS ARE LOCKED. IF SO, THE REQUEST IS REJECTEDF0400060* WITH APPROPRIATE ERROR STATUS. NEXT, READRC CHECKS WHETHER F0400061* OR NOT ALL THE REQUESTED RECORDS CURRENTLY EXIST IN THE F0400062* FILE. IF ALL THE RECORDS CURRENTLY EXIST, PROCESSING PRO- F0400063* CEEDS WITH ISTAT BEING SET TO ZERO. IF SOME BUT NOT ALL OF F0400064* THE RECORDS EXIST, ISTAT IS SET TO REFLECT THIS AND THE F0400065* NUMBER OF EXISTING RECORDS (FROM THE LARGER SET REQUESTED) F0400066* ARE RETRIVED. IF NONE OF THE REQUESTED RECORDS CURRENTLY F0400067* EXIST, THE REQUEST IS REJECTED WITH APPROPRIATE ERROR STA- F0400068* TUS. IF ALL CASES REQBUF WILL BE SET TO REFLECT THE ACTUAL F0400069ÐÐ* SET OF RECORDS READ. F0400070* F0400071* AFTER THE SET OF ONE OR MORE RECORDS HAVE BEEN RETRIVED, F0400072* READRC CHECKS EACH OF THE RECORDS TO DETERMINE IF ANY ARE F0400073* MARKED AS DELETED. IF ANY ARE SO MARKED, ISTAT WILL BE SET F0400074* ACCORDINGLY F0400075* F0400076* IF RECORD LOCKING IS SPECIFIED, AN ENTRY FOR THE RETRIVED F0400077* RECORDS WILL BE INSERTED INTO THE RECORD LOCK TABLE. F0400078*E F0400079 EJT F0400080 ENT READRC ENTRY POINT F0400081* F0400082 EXT CKUADR CHECK UNPROTECTED ADDRESS F0400083 EXT LOKCHK CHECK FOR LOCKED RECORDS F0400084 EXT MMREAD MASS MEMORY READ ROUTINE F0400085 EXT CLFRIO COMPUTE LENGTH FOR RECORD I/O F0400086 EXT INSLOK INSERT RECORD LOCK INTO LOCK TABLE F0400087 EXT DWSUB DOUBLE WORD SUBTRACT ROUTINE F0400088 EXT FMCOMP COMPLETION ADDRESS FOR SERIAL PROCESSORS. F0400089 EXT FMRDEL RECORD DELETED CODE F0400090 EXT NRERLE NUMBER OF RESERVED RECORD LOCK ENTRIES F0400091 EXT FMCOVL CHECK IF PARAMETERS OVERLAP F0400092 EXT FMFSRC CHECK IF SUBSET IS IN SUBSET TABLE 132*5368F0400093**** F0400094ÐÐ SPC 2 F0400095* EQUIVALENCES F0400096 SPC 2 F0400097* COMMUNICATION REGION CONSTANTS F0400098 EQU ZERO(2) ZERO CONSTANT F0400099 EQU ONEMSK(3) ONE MASK TABLE F0400100 EQU ZROMSK($13) ZERO MASK TABLE F0400101 EQU ONEBIT($23) ONE BIT TABLE F0400102 EQU ZROBIT($33) ZERO BIT TABLE F0400103 SPC 1 F0400104* UCT ENTRY EQUIVALENCES F0400105 EQU UIDENT(ZERO) USER IDENTIFICATION F0400106 EQU FIDENT(1) PSEUDO FILE IDENTIFIER F0400107 EQU FCBCAD(2) FCB CORE ADDRESS F0400108 EQU FSLADR(3) FILE SPACE LIMITS TABLE ENTRY ADDRESS F0400109 EQU FCBSAD(4) FCB SUBSET ADDRESS F0400110 EQU USRCPT(5) USERS CONTROL POINT F0400111 EJT F0400112* REQUEST BUFFER INDEXES - FIRST 4 WORDS F0400113 EQU RBATHR(0) REQUEST BUFFER ADDRESS THREAD F0400114 EQU BUFAMP(1) BUFFER ADDRESS MAIN PART F0400115 EQU CNTLPT(2) CONTROL POINT (OR SPARE) F0400116 EQU RQINFO(3) REQUEST INFORMATION (MULTI-FIELD) F0400117* BITS USE F0400118* 15-12 SPARE F0400119ÐÐ* 11-04 REQUEST INDEX F0400120* 03-00 LEVEL OF REQUESTOR F0400121* F0400122* REQUEST BUFFER INDEXES - MAIN PART F0400123 EQU QREG(0) Q REGISTER F0400124 EQU IREG(1) I REGISTER F0400125 EQU PARLST(2) ADDRESS OF PARAMETER LIST F0400126 EQU RTNADR(2) RETURN ADDRESS TO USER (UPON RETURN FROM EXEC)F0400127 EQU UCTADR(3) UCT ENTRY ABSOLUTE ADDRESS F0400128 EQU USERID(4) USER IDENTIFIER F0400129 EQU FCBADR(5) FCB ADDRESS (MAY BE SET BY CALLER OR INTCPTR.)F0400130 EQU RADINT(6) RETURN ADDRESS TO INTERCEPTOR F0400131 EQU RPIDX(7) REQUEST PROCESSOR INDEX F0400132* BITS 14-00 REQUEST PROCESSOR INDEX F0400133* BIT 15 TYPE OF PROCESSOR F0400134* =0, SERIAL PROCESSOR F0400135* =1, REENTRANT PROCESSOR F0400136 EQU LOKREC(8) NUMBER OF RECORDS TO BE READ/WRITTEN PER I/O F0400137* CALL AND LOCK RECORDS ON RETRIEVE FLAG F0400138* BITS 14-00 NUMBER OF RECORDS PER CALL F0400139* BIT 15 =0, DO NOT LOCK ON RETRIEVE F0400140* =1, LOCK RECORDS ON RETRIEVE F0400141 EQU USEFLG(9) TYPE OF FILE USE FLAG F0400142* -1, OPEN FOR COMPRESSION F0400143* -2, OPEN FOR SPECIAL PROCESSING F0400144ÐÐ* 0, OPEN FOR ACESS VIA REL REC NO F0400145* 1, OPEN FOR RETRIEVAL VIA KEY 1 F0400146* 2, OPEN FOR RETRIEVAL VIA KEY 2 F0400147* 3, OPEN FOR RETRIEVAL VIA KEY 3 F0400148* 4, OPEN FOR RETRIEVAL VIA KEY 4 F0400149 EQU NUMREC(10) NUMBER OF RECORDS ACTUALLY STORED/RETRIEVED F0400150 EQU RRNMSB(11) REL REC NUMBER OF STORED/RETRIEVED REC, MSB F0400151 EQU RRNLSB(12) REL REC NUMBER OF STORED/RETRIEVED REC, LSB F0400152 SPC 2 F0400153 EQU SAVMSB(13) SAVED RRN MSB FOR REPEATED GETS CALLS F0400154 EQU SAVLSB(14) SAVED RRN LSB FOR REPEATED GETS CALLS F0400155 EQU SAVREC(15) SAVED NUMREC FOR REPEATED GETS CALLS F0400156 EQU LOKORF(18) LOCKED RECORD OVERRIDE FLAG 132*5366F0400157* =0 IF NORMAL REJECT. ON LOCK. REC. 132*5366F0400158* NOT 0 IF LOCK. RECS. TO BE RETRIEVED132*5366F0400159 EQU RMPLEN(20) LENGTH OF REQBUF MAIN PART F0400160 EJT F0400161* FILE CONTROL BLOCK EQUIVALENCES F0400162 EQU FH(4) LENGTH -1 OF FCB HEADER F0400163 EQU FILEID(ZERO) FILE IDENTIFIER F0400164* ACCESS FILEID INDIRECTLY F0400165* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBERF0400166* BITS 10-00 INDEX OF FCB IN FCB TABLE F0400167 EQU FCBFLG(1) FCB FLAGS F0400168* BITS 15-8, SPARE F0400169ÐÐ* BITS 7-00, NUMBER OF USERS USING FILE F0400170 EQU FILOCK(2) FILE LOCK FLAG (IF NON-0, CONTAINS USER ID) F0400171 EQU NUMSET(3) NUMBER OF SETS OF LOCKED RECORDS IN FILE F0400172 EQU NUMNEW(4) NUMBER OF NEW RECORDS SINCE FCB UPDATED ON MM F0400173 SPC 1 F0400174 EQU RECLEN(FH+1) RECORD LENGTH IN WORDS F0400175 EQU TDATRM(FH+2) TOTAL NUMBER OF DATA RECORDS, MSB F0400176 EQU TDATRL(FH+3) TOTAL NUMBER OF DATA RECORDS, LSB F0400177 EQU DATBAM(FH+4) DATA RECORDS BEGINNING SECTOR ADDRESS, MSB F0400178 EQU DATBAL(FH+5) DATA RECORDS BEGINNING SECTOR ADDRESS,LMSB F0400179 EQU FCBIND(FH+6) FCB INDICATORS F0400180* BIT 15 , SECTOR ALLIGNED RECORDS IF =1 F0400181* BIT 14 , STORAGE MODE FOR INDEXED FILE F0400182* =0, RECORDS STORED RANDOMLY WITHF0400183* RESPECT TO PRIMARY KEY F0400184* =1, RECORDS STORED IN ORDER WIT F0400185* RESPECT TO PRIMARY KEY F0400186* BIT 13 , =1, FILE IS CURRENTLY OPEN F0400187* =0, FILE IS CURRENTLY CLOSED F0400188* BIT 12 , =1, FILE IS BEING COMPRESSED F0400189* =0, FILE IS NOT BEING COMPRESSEDF0400190* BIT 11 , =1, FILE IS OPEN FOR SPECIAL F0400191* PROCESSING F0400192* =0, FILE IS NOT OPEN FOR SPECIALF0400193* PROCESSING F0400194ÐÐ* BIT 8 , =1, RECORDS CONTAIN BINARY DATA F0400195* =0, RECORDS DO NOT CONTAIN F0400196* BINARY DATA F0400197* BIT 0 , FILE TYPE F0400198* =0, SEQUENTIAL FILE F0400199* =1, INDEXED FILE F0400200 EQU NEDATM(FH+7) NUMBER OF EXISTING DATA RECORDS, MSB F0400201 EQU NEDATL(FH+8) NUMBER OF EXISTING DATA RECORDS, LSB F0400202 EQU SEQLTH(NEDATL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F0400203* OF FCB FOR A SEQUENTIAL FILE F0400204 SPC 1 F0400205 EQU NEXTBM(FH+9) NEXT FREE KEY INDEX BLOCK, MSB F0400206 EQU NEXTBL(FH+10) NEXT FREE KEY INDEX BLOCK, LSB F0400207 EQU TNKEYM(FH+11) TOTAL NUMBER OF KEY INDEX BLOCKS, MSB F0400208 EQU TNKEYL(FH+12) TOTAL NUMBER OF KEY INDEX BLOCKS, LSB F0400209 EQU KEYBAM(FH+13) KEY INDEX BEGINNING SECTOR ADDRESS, MSB F0400210 EQU KEYBAL(FH+14) KEY INDEX BEGINNING SECTOR ADDRESS, LSB F0400211 EQU LENKY1(FH+15) LENGTH OF KEY NO. 1 F0400212 EQU POSKY1(FH+16) BYTE POSITION OF KEY NO. 1 F0400213 EQU LENKY2(FH+17) LENGTH OF KEY NO. 2 F0400214 EQU POSKY2(FH+18) BYTE POSITION OF KEY NO. 2 F0400215 EQU LENKY3(FH+19) LENGTH OF KEY NO. 3 F0400216 EQU POSKY3(FH+20) BYTE POSITION OF KEY NO. 3 F0400217 EQU LENKY4(FH+21) LENGTH OF KEY NO. 4 F0400218 EQU POSKY4(FH+22) BYTE POSITION OF KEY NO. 4 F0400219ÐÐ EQU INDLEN(POSKY4-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F0400220* OF FCB FOR AN INDEXED FILE F0400221 EJT F0400222* THE FOLLOWING PORTION OF THE FCB EXISTS ONLY F0400223* ON MASS MEMORY. THESE 10 WORDS ARE NOT LOADEDF0400224* INTO EITHER OF THE FILE MANAGER CONTROLLED FCBF0400225* TABLES. F0400226 EQU TSFILM(FH+23) TOTAL NUMBER OF SECTORS IN FILE, MSB F0400227 EQU TSFILL(FH+24) TOTAL NUMBER OF SECTORS IN FILE, LSB F0400228 EQU NAME12(FH+25) FILE NAME, CHARACTERS 1 AND 2 F0400229 EQU NAME34(FH+26) FILE NAME, CHARACTERS 3 AND 4 F0400230 EQU NAME56(FH+27) FILE NAME, CHARACTERS 5 AND 6 F0400231 EQU NAME78(FH+28) FILE NAME, CHARACTERS 7 AND 8 F0400232 EQU OWNR12(FH+29) OWNER NAME, CHARACTERS 1 AND 2 F0400233 EQU OWNR34(FH+30) OWNER NAME, CHARACTERS 3 AND 4 F0400234 EQU OWNR56(FH+31) OWNER NAME, CHARACTERS 5 AND 6 F0400235 EQU OWNR78(FH+32) OWNER NAME, CHARACTERS 7 AND 8 F0400236 EQU BYTLEN(FH+33) BYTE LENGTH OF RECORD F0400237* F0400238* FOR COMPRESS ONLY F0400239* F0400240 EQU PRSRNM(FH+34) RRN OF LAST PROCESSED RECORD - MSB F0400241 EQU PRSRNL(FH+35) RRN OF LAST PROCESSED RECORD - LSB F0400242 EQU NEWRNM(FH+36) RRN OF THE LATEST 'NEW' RECORD - MSB F0400243 EQU NEWRNL(FH+37) RRN OF THE LATEST 'NEW' RECORD - LSB F0400244ÐÐ SPC 4 F0400245* WORDS 0 THRU 4 OF THE FCB HEADER AND WORDS F0400246* 6 THRU 10 OF THE FCB ARE REFERRED TO AS THE F0400247* SHARED SUBSET OF THE FCB. THEY INCLUDE THE F0400248* ONLY FCB WORDS THAT CAN BE MODIFIED AFTER FILEF0400249* CREATION. IF TWO OR MORE USERS HAVE THE SAME F0400250* FILE OPEN, THERE HAS TO BE A SINGLE MASTER F0400251* COPY OF THE SUBSET THAT RECEIVES (AND RECORDS)F0400252* ALL OF THE UPDATES. THE CONTROLLED SUBSET F0400253* WILL ALWAYS BE PART OF A MAIN MEMORY RESIDENT F0400254* FCB IF THE FCB IS IN A FM CONTROLLED TABLE. F0400255* IF THE FCB IS IN USER SPACE, THE SUBSET MAY ATF0400256* TIMES RESIDE IN THE SUBSET CONTROL TABLE. F0400257 SPC 2 F0400258* ALTERNATE NAMES FOR SUBSET WORDS F0400259 EQU SAFCBI(FH+1) SUBSET ALTERNATE NAME FOR FCBIND F0400260 EQU SADATM(FH+2) SUBSET ALTERNATE NAME FOR NEDATM F0400261 EQU SADATL(FH+3) SUBSET ALTERNATE NAME FOR NEDATL F0400262 EQU SANXTM(FH+4) SUBSET ALTERNATE NAME FOR NEXTBM F0400263 EQU SANXTL(FH+5) SUBSET ALTERNATE NAME FOR NEXTBL F0400264 EJT F0400265* REQUEST PROCESSOR CONTROL TABLE F0400266* F0400267 EQU RP(10) INDEX TO START OF REQUEST PARAMETERS F0400268 EQU MR(RP+5) INDEX TO START OF MONITOR REQUEST PARAM LIST F0400269ÐÐ EQU SS(MR+10) INDEX TO START OF SCRATCH PORTION OF PAR LIST F0400270* F0400271 EQU RPLOGU(1) LU NUMBER OF MM DEVICE F0400272 EQU RPAREQ(2) ACTIVE REQUEST FLAG (IF 0, NONE FOR TABLE) F0400273 EQU RPWAIT(3) START OF WAITING REQUEST QUEUE (IF 0, NO WAITGF0400274 EQU RPRLEV(4) REQUEST PRIORITY LEVEL - ACTIVE REQUEST F0400275 EQU RPRBF4(5) REQBUF ADDRESS - FIRST FOUR WORDS F0400276 EQU RPLTEA(6) LOCK TABLE ENTRY (ABSOLUTE) ADDRESS F0400277 EQU RPRTNJ(7) RETURN JUMP TO REQUEST PROCESSOR F0400278 EQU RPPADR(8) PROCESSOR ADDRESS F0400279 SPC 1 F0400280* PARAMETER LIST FOR REQUEST PROCESSOR F0400281 EQU RPFCBA(9) FCB ADDRESS FOR FILE F0400282 EQU RPRBMP(RP+0) REQBUF ADDRESS - MAIN PART F0400283 EQU RPPFP1(RP+1) REQUEST PARAMETER ADDRESS - FIRST + 1 F0400284 EQU RPPFP2(RP+2) REQUEST PARAMETER ADDRESS - FIRST + 2 F0400285 EQU RPPFP3(RP+3) REQUEST PARAMETER ADDRESS - FIRST + 3 F0400286 EQU RPPFP4(RP+4) REQUEST PARAMETER ADDRESS - FIRST + 4 F0400287 SPC 1 F0400288* MAIN MONITOR REQUEST F0400289 EQU RPMREQ(MR+0) MONITOR REQUEST CODE WORD F0400290 EQU RPMRP1(MR+1) COMPLETION ADDRESS F0400291 EQU RPMRP2(MR+2) THREAD WORD F0400292 EQU RPMRP3(MR+3) LOGICAL UNIT FOR I/O F0400293 EQU RPMRP4(MR+4) NUMBER OF WORDS F0400294ÐÐ EQU RPMRP5(MR+5) START CORE ADDRESS F0400295 EQU RPMRP6(MR+6) MASS MEMORY ADDRESS, MSB F0400296 EQU RPMRP7(MR+7) MASS MEMORY ADDRESS, LSB F0400297 EQU RPRCPT(MR+8) CONTROL POINT (FOR I/O REQUESTS) F0400298 EQU RPRETN(MR+9) SAVED RETURN ADDRESS F0400299* ALTERNATE COMMON NAMES F0400300 EQU REQBUF(RP+0) USERS FIRST CALL PARAMETER ADDRESS F0400301 EQU RECBUF(RP+1) RECORD BUFFER ADDRESS F0400302 EQU KEYVAL(RP+2) KEY VALUE/RRN BUFFER ADDRESS F0400303 EQU ISTAT(RP+4) USERS COMPLETION STATUS PARAMETER ADDRESS F0400304 EJT F0400305* SCRATCH FOR READRC F0400306* F0400307* FIRST 4 WORDS ARE USED AS INTERFACE WITH PROCESSORS F0400308* USING READRC AS A SUBROUTINE F0400309 EQU REDBUF(SS+0) BUFFER FOR READ OF RECORDS F0400310 EQU RELRNM(SS+1) RELATIVE RECORD NUMBER - MSB F0400311 EQU RELRNL(SS+2) RELATIVE RECORD NUMBER - LSB F0400312 EQU NORECS(SS+3) NUMBER OF RECORDS TO BE READ F0400313* F0400314 EQU RETURN(SS+4) RETURN ADDRESS - 0 IF EXECUTED BY EXEC F0400315* F0400316* PARAMETER LIST FOR DWSUB F0400317 EQU TOTMSB(SS+5) TOTAL NO. OF EXISTING RECORDS, MSB F0400318 EQU TOTLSB(SS+6) TOTAL NO. OF EXISTING RECORDS, LSB F0400319ÐÐ EQU RRNFRM(SS+7) RRN OF 1ST RECORD TO BE READ, MSB F0400320 EQU RRNFRL(SS+8) RRN OF 1ST RECORD TO BE READ, LSB F0400321 EQU RESLTM(SS+9) RESULT - MSB F0400322 EQU RESLTL(SS+10) RESULT - LSB F0400323 EQU COMFLG(SS+11) COMPLETION STATUS F0400324* F0400325* PARAMETER LIST FOR MM I/O ROUTINE F0400326 EQU MSBBSA(SS+5) MSB OF BASE SECTOR ADDRESS F0400327 EQU LSBBSA(SS+6) LSB OF BASE SECTOR ADDRESS F0400328 EQU MSBRRN(SS+7) MSB OF RELATIVE RECORD NUMBER F0400329 EQU LSBRRN(SS+8) LSB OF RELATIVE RECORD NUMBER F0400330 EQU RCDLEN(SS+9) RECORD LENGTH - BIT 15 SET IF SECTOR ALLIGNED F0400331 EQU NUMWDS(SS+10) NUMBER OF WORDS TO READ F0400332 EQU OFFSET(SS+11) WORD OFFSET FROM START OF RECORD F0400333 EQU RECBFR(SS+12) ADDRESS OF BUFFER FOR I/O F0400334 EQU IOTYPE(SS+13) I/O TYPE: NON-ZERO IF FILE I/O, ELSE ZERO F0400335* F0400336 EQU SAVSAD(SS+14) SAVED FCB SUBSET ADDRESS F0400337 EJT F0400338READRC 000 000 ENTRY POINT - WILL BE NON-ZERO IF EXECUTED BY F0400339* ANOTHER PROCESSOR F0400340 LDA* READRC F0400341 STA- RETURN,I SAVE RETURN ADDRESS - MAY BE 0 F0400342 CLR Q F0400343 STQ* READRC CLEAR ENTRY POINT FOR NEXT USE F0400344ÐÐ LDQ- ISTAT,I PRESET ISTAT TO ZERO 132*5366F0400345 CLR A 132*5366F0400346 STA- (ZERO),Q 132*5366F0400347 LDA- RETURN,I 132*5366F0400348 LDQ- REQBUF,I GET FCB SUBSET ADDRESS AND SAVE IT F0400349 LDQ- UCTADR,Q F0400350 LDQ- FCBSAD,Q F0400351 STQ- SAVSAD,I F0400352* F0400353 SAZ RED05 SKIP IF ENTERED FROM FMEXEC F0400354 JMP* RED20 F0400355* F0400356RED05 LDA- RECBUF,I SET BUFFER ADDRESS FOR RECORD READ F0400357 STA- REDBUF,I F0400358 LDQ- REQBUF,I F0400359 LDA- LOKREC,Q PICKUP NUMBER OF RECORDS TO BE READ FROM F0400360 AND- ONEMSK+14 REQBUF F0400361 SAN RED10 ASSURE IT IS NON-ZERO F0400362 LDA =N$A000 SET REJECTED AND IMPROPERLY INITIALIZED REQBUFF0400363 JMP* RED80 BITS - GO STORE AS ISTAT F0400364* F0400365RED10 STA- NORECS,I STORE NO. OF RECORDS F0400366 LDQ- KEYVAL,I F0400367 LDA- (ZERO),Q PICKUP AND STORE RELATIVE RECORD NUMBER F0400368 STA- RELRNM,I IF EXECUTED FROM EXEC. F0400369ÐÐ LDA- 1,Q F0400370 STA- RELRNL,I F0400371 SAN RED20 SKIP IF LSB NON-ZERO F0400372 LDA- RELRNM,I AS LSB IS ZERO, ASSURE MSB IS NON-ZERO F0400373 SAN RED20 SKIP IF NON-ZERO F0400374 LDA =N$8200 SET A = $8200 FOR USE AS ISTAT 132*5256F0400375 JMP* RED80 GO STORE ISTAT AND ABORT REQUEST F0400376* F0400377RED20 LDQ- I SET Q TO ABS ADDRESS OF RRN AND NO. OF RECORDSF0400378 INQ RELRNM F0400379 RTJ LOKCHK CHECK IF REQUIRED RECORDS ARE LOCKED F0400380 SAZ RED30 SKIP IF NO F0400381 LDQ- REQBUF,I 132*5366F0400382 LDA- LOKREC,Q CHECK IF RECORD LOCKING REQ'D BY USER 132*5366F0400383 SAM RED25 SKIP IF YES 132*5366F0400384 LDA- LOKORF,Q CHECK IF LOCKED REC OVERRIDE FLAG SET 132*5366F0400385 SAZ RED25 SKIP IF NO 132*5366F0400386 LDA- ONEBIT+7 SET LOCKED RECORD STATUS BIT OF ISTAT 132*5366F0400387 LDQ- ISTAT,I 132*5366F0400388 STA- (ZERO),Q 132*5366F0400389 JMP* RED30 132*5366F0400390* 132*5366F0400391RED25 LDA =N$8080 SET REJECTED AND RECORD LOCKED BIT 132*5366F0400392 JMP* RED80 GO STORE F0400393 EJT F0400394ÐÐ* NEXT, CHECK WHETHER OR NOT ALL REQUESTED F0400395RED30 LDQ- SAVSAD,I RECORDS CURRENTLY EXIST IN THE FILE 132*5368F0400396 TRQ A 132*5368F0400397 RTJ FMFSRC CHECK IF SUBSET IS IN SUBSET TABLE 132*5368F0400398 SAN RED40 SKIP IF YES 132*5368F0400399* 132*5368F0400400 LDA- NEDATL,Q USE NUMBER OF RECORDS FROM MAIN FCB F0400401 LDQ- NEDATM,Q F0400402 JMP* RED50 GO STORE THE NUMBER F0400403* F0400404RED40 LDA- SADATL,Q USE NO. OF EXISTING RECORDS FROM SUBSET F0400405 LDQ- SADATM,Q F0400406RED50 LLS 1 CONVERT TO MSB/LSB (I/O) FORMAT F0400407 ALS 15 F0400408 STQ- TOTMSB,I STORE INTO DWSUB PARAM LIST F0400409 STA- TOTLSB,I F0400410* F0400411 LDQ- RELRNM,I STORE RRN OF 1ST RECORD NEEDED INTO DWSUB F0400412 LDA- RELRNL,I PARAM LIST F0400413 LLS 1 FIRST, CONVERT IT TO MSB/LSB (I/O) FORMAT F0400414 ALS 15 F0400415 STQ- RRNFRM,I F0400416 STA- RRNFRL,I F0400417* F0400418 LDQ- I SET Q TO ABS ADDRESS OF PARAM LIST F0400419ÐÐ INQ TOTMSB SUBTRACT RRN OF FIRST RECORD NEEDED FROM NO. F0400420 RTJ DWSUB OF EXISTING RECORDS F0400421 LDA- COMFLG,I CHECK COMPLETION STATUS F0400422 SAZ RED60 SKIP IF NO ERROR F0400423 LDA =N$8100 SET REJECTED AND EOF READ BITS F0400424 JMP* RED80 GO STORE ISTAT F0400425* F0400426* NO MATH ERROR NOTED ON SUBTRACT; HOWEVER, WE F0400427* MUST STILL CHECK IF ALL NEEDED RECORDS EXIST.F0400428RED60 LDA- RESLTM,I IF MSB OF RESULT IS NON-ZERO, ALL RECORDS F0400429 SAN RED70 NECESSARILY EXIST. SKIP IF MSB NOT 0. F0400430 LDA- RESLTL,I MSB=0 SO COMPARE RESULT WITH NO. OF RECORDS F0400431 SUB- NORECS,I NEEDED F0400432 INA 1 F0400433 SAP RED70 SKIP IF ALL CAN BE READ F0400434 LDA- RESLTL,I RESET NO. OF RECORDS TO BE READ F0400435 INA 1 F0400436 STA- NORECS,I F0400437 LDA- ONEBIT+8 SET A TO EOF READ BIT F0400438 JMP* RED80 GO STORE ISTAT F0400439 EJT F0400440RED70 CLR A SET A=0 FOR ISTAT AS ALL RECORDS CAN BE READ F0400441* F0400442* A-REG HAS VALUE FOR ISTAT F0400443RED80 LDQ- SAVSAD,I PRIOR TO STORING ISTAT, CHECK IF FILE IS F0400444ÐÐ LDQ- FILOCK,Q LOCKED F0400445 SQZ RED90 SKIP IF FILE NOT LOCKED F0400446 EOR- ONEBIT+2 OR IN FILE LOCKED BIT F0400447* 132*5366F0400448RED90 LDQ- ISTAT,I OR IN PREVIOUS ISTAT CONTENTS 132*5366F0400449 EOR- (ZERO),Q 132*5366F0400450 STA- (ZERO),Q F0400451 SAP RED120 SKIP IF REQUEST NOT REJECTED F0400452* F0400453 CLR A CLEAR NUMREC WORD OF RECBUF AS NO RECORDS F0400454 LDQ- REQBUF,I WERE READ F0400455 STA- NUMREC,Q F0400456 LDA- LOKREC,Q CHECK IF RECORD LOCKS WERE NEEDED F0400457 SAP RED100 SKIP IF NO F0400458 LDA* (ANRELE) DECREMENT NO. OF RESERVED LOCK ENTRIES F0400459 INA -1 F0400460 STA* (ANRELE) F0400461* F0400462RED100 LDQ- RETURN,I SET UP RETURN F0400463 SQZ RED110 IF NO RETURN ADDRESS, COMPLETE VIA FMCOMP F0400464 JMP- (ZERO),Q RETURN TO CALLING PROCESSOR F0400465RED110 JMP FMCOMP COMPLETE REQUEST - IN EXEC F0400466 SPC 1 F0400467ANRELE ADC NRERLE NUMBER OF RESERVED RECORD LOCK ENTRIES F0400468ADCKUA ADC CKUADR CHECK FOR UNPROTECTED ADDRESS ERROR F0400469ÐÐ SPC 1 F0400470RED120 LDA- NORECS,I SET A TO NO. OF RECORDS NEEDED F0400471 RTJ* (ADCLFR) COMPUTE LENGTH FOR RECORD I/O F0400472 STA- NUMWDS,I STORE IN MMREAD PARAM LIST F0400473 LDQ- RPFCBA,I F0400474 LDA- FCBIND,Q CHECK IF FILE IS SECTOR ALLIGNED F0400475 SAP RED125 SKIP IF NO F0400476 LDA- NUMWDS,I CHECK IF RECORD LENGTH IS AN INTEGRAL MULTIPLEF0400477 CLR Q OF SECTOR LENGTH F0400478 DVI- NORECS,I F0400479 LDQ- RPFCBA,I F0400480 SUB- RECLEN,Q F0400481 SAZ RED125 SKIP IF YES (IF NO REMAINDER IN A-REG) F0400482 TCA A COMPUTE NEW LENGTH FOR READ - NO NEED TO READ F0400483 ADD- NUMWDS,I ALL OF LAST SECTOR F0400484 STA- NUMWDS,I F0400485 EJT F0400486RED125 LDA- REDBUF,I F0400487 STA- RECBFR,I SET BUFFER ADDRESS FOR I/O F0400488* F0400489 CLR Q F0400490 RTJ* (ADCKUA) CHECK 1ST WORD OF BUFFER FOR UNPROTECTED F0400491 LDA- RECBFR,I ADDRESS ERROR F0400492 INA -1 F0400493 ADD- NUMWDS,I F0400494ÐÐ RTJ* (ADCKUA) CHECK LAST WORD F0400495 SPC 2 F0400496 LDA- REDBUF,I CHECK IF RECBUF OVERLAPS WITH OTHER PARAMS F0400497 LDQ- NUMWDS,I F0400498 RTJ FMCOVL F0400499 SAZ RED127 NO, SKIP F0400500 LDA =N$A000 YES, SET ERROR BIT AND LEAVE F0400501 JMP* RED80 F0400502* F0400503RED127 EQU RED127(*) F0400504* F0400505 CLR A F0400506 STA- OFFSET,I CLEAR WORD OFFSET WORD F0400507 ENA 1 F0400508 STA- IOTYPE,I SET I/O TYPE FLAG FOR FILE I/O F0400509 LDQ- RPFCBA,I F0400510 LDA- RECLEN,Q GET RECORD LENGTH F0400511 LDQ- FCBIND,Q F0400512 SQP RED130 SKIP IF NOT SECTOR ALLIGNED RECORDS F0400513 EOR- ONEBIT+15 SET BIT 15 OF RECORD LENGTH WORD - SECTOR ALLNF0400514RED130 STA- RCDLEN,I STORE FOR I/O F0400515 LDQ- RPFCBA,I STORE BASE SECTOR ADDRESS FOR I/O F0400516 LDA- DATBAM,Q F0400517 STA- MSBBSA,I F0400518 LDA- DATBAL,Q F0400519ÐÐ STA- LSBBSA,I F0400520* F0400521 LDQ- REQBUF,I SET Q TO REQBUF SO RRN AND NO. OF RECS CAN BE F0400522 LDA- RELRNM,I STORED FOR PASS BACK F0400523 STA- MSBRRN,I STORE RELATIVE RECORD NUMBER FOR I/O F0400524 STA- RRNMSB,Q F0400525 LDA- RELRNL,I F0400526 STA- LSBRRN,I F0400527 STA- RRNLSB,Q F0400528 LDA- NORECS,I F0400529 STA- NUMREC,Q F0400530 EJT F0400531 LDQ- I SET Q TO ABS ADDRESS OF PARAMETER LIST F0400532 INQ MSBBSA F0400533 RTJ MMREAD READ IN REQUIRED RECORDS F0400534 SQP RED150 SKIP IF NO I/O ERROR F0400535 INQ 0 CHECK IF Q=$FFFF F0400536 SQN RED140 SKIP IF NO F0400537 LDA =N$C020 SET REJECTED, ILLEGAL PARAM AND I/O ERROR BITSF0400538 JMP* RED90 GO STORE ISTAT, RESET NUMREC AND EXIT 132*5366F0400539* F0400540RED140 LDA =N$8020 SET REJECTED AND I/O ERROR BITS F0400541 JMP* RED90 GO STORE ISTAT, RESET NUMREC AND EXIT 132*5366F0400542 SPC 2 F0400543ADCLFR ADC CLFRIO COMPUTE LENGTH FOR RECORD I/O F0400544ÐÐ SPC 2 F0400545* CHECK SET OF RETRIEVED RECORDS FOR 127*5190F0400546* DELETED RECORD CODE. WORD 'OFFSET' WHICH NOWF0400547* CONTAINS ZERO WILL BE USED AS A LOOP COUNTER.F0400548 SPC 2 F0400549RED150 LDQ- REQBUF,I CHECK IF RRN AND NUMREC NEED SAVED IN ALTER- F0400550 LDA- USEFLG,Q NATE WORDS OF REQBUF F0400551 SAZ RED152 SKIP IF YES F0400552 INA 2 F0400553 SAN RED155 SKIP IF NO F0400554RED152 LDA- RRNMSB,Q SAVE FOR USE BY REPEATED CALLS TO GETS F0400555 STA- SAVMSB,Q F0400556 LDA- RRNLSB,Q F0400557 STA- SAVLSB,Q F0400558 LDA- NUMREC,Q F0400559 STA- SAVREC,Q F0400560* F0400561RED155 LDA- FCBIND,Q CHECK IF THIS IS A BINARY DATA FILE 127*5190F0400562 AND- ONEBIT+8 127*5190F0400563 SAZ RED157 SKIP IF NO 127*5190F0400564 JMP* RED180 SKIP CHECK FOR DELETE CODE 127*5190F0400565* 127*5190F0400566RED157 ENA 1 COMPUTE LENGTH OF 1 RECORD (FOR I/O) 127*5190F0400567 RTJ* (ADCLFR) F0400568 STA- TOTMSB,I SAVE TEMPORARILY F0400569ÐÐRED160 LDA- OFFSET,I CHECK IF ALL DONE CHECKING F0400570 LDQ- REQBUF,I F0400571 SUB- NUMREC,Q F0400572 SAZ RED180 SKIP IF YES F0400573 LDQ- REDBUF,I F0400574 LDA- (ZERO),Q F0400575 SUB =XFMRDEL CHECK IF 1ST WORD OF RECORD HAS DELETED CODE F0400576 SAN RED170 SKIP IF NO F0400577* F0400578 LDQ- ISTAT,I F0400579 ENA $10 SET RECORD MARKED AS DELETED BIT F0400580 EOR- (ZERO),Q OR WITH ORIGINAL ISTAT VALUE F0400581 STA- (ZERO),Q STORE BACK F0400582 JMP* RED180 GO CHECK FOR LOCK F0400583 EJT F0400584RED170 RAO- OFFSET,I BUMP COUNTER F0400585 LDA- REDBUF,I CHANGE RECORD ADDRESS TO NEXT RECORD F0400586 ADD- TOTMSB,I F0400587 STA- REDBUF,I F0400588 JMP* RED160 GO CHECK IF DONE F0400589* F0400590RED180 LDQ- REQBUF,I CHECK IF RECORDS TO BE LOCKED ON RETRIEVE F0400591 LDA- LOKREC,Q F0400592 SAP RED190 SKIP IF NO F0400593 LDQ- I SET Q TO ABS ADDRESS OF 3 WORDS CONTAINING RRNF0400594ÐÐ INQ RELRNM AND NO. OF RECORDS F0400595 RTJ INSLOK INSERT ENTRY INTO RECORD LOCK TABLE F0400596RED190 JMP* RED100 GO RETURN TO COMPLETE REQUEST F0400597 END F0400598 NAM GETNXT F05 A ITOS CCS 3.0 SL-149F0500001* GET NEXT SEQUENTIAL RECORD (SEQUENTIAL FILE) F0500002* CREDIT COLLECTION SYSTEM VERSION 3.0 F0500003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F0500004* COPYRIGHT CONTROL DATA CORPORATION 1979 F0500005* F0500006* F0500007**** F0500008* GETNXT IS THE REQU5ST PROCESSOR FOR THE GET NEXT SEQUENTIAL F0500009* RECORD REQUEST FOR FILES THAT HAVE BEEN OPENED FOR ACCESS F0500010* VIA RELATIVE RECORD NUMBER. THE GET NEXT SEQUENTIAL RECORD F0500011* REQUEST HAS THE FOLLOWING CALL SEQUENCE: F0500012* F0500013* CALL GETS (REQBUF,RECBUF,KEYVAL,ISTAT) F0500014* F0500015* WHERE REQBUF IS THE REQUEST BUFFER, F0500016* RECBUF IS THE RECORD BUFFER, F0500017* KEYVAL IS THE KEY VALUE (IGNORED IF FILE OPEN FOR F0500018* RELATIVE RECORD NUMBER ACCESS) AND F0500019* ISTAT IS THE FILE REQUEST STATUS WORD. F0500020* F0500021ÐÐ* GETNXT IS ONLY EXECUTED BY THE EXEC, THUS IT COMPLETES BY F0500022* JUMPING TO FMCOMP. GETNXT UTILIZES THE READRC PROCESSOR TO F0500023* CHECK WHETHER OR NOT AN EOF STATUS SHOULD BE RETURNED AND TOF0500024* READ THE REQUIRED RECORDS. F0500025 SPC 2 F0500026 ENT GETNXT GETNXT ENTRY POINT F0500027* F0500028 EXT READRC READ SET OF RECORDS VIA RRN F0500029 EXT FMCOMP COMPLETION ADDRESS FOR SERIAL PROCESSORS F0500030 EXT NRERLE NUMBER OF RESERVED RECORD LOCK ENTRIES F0500031**** F0500032 SPC 2 F0500033* EQUIVALENCES F0500034 SPC 2 F0500035* COMMUNICATION REGION CONSTANTS F0500036 EQU ZERO(2) ZERO CONSTANT F0500037 EQU ONEMSK(3) ONE MASK TABLE F0500038 EJT F0500039* REQUEST BUFFER INDEXES - FIRST 4 WORDS F0500040 EQU RBATHR(0) REQUEST BUFFER ADDRESS THREAD F0500041 EQU BUFAMP(1) BUFFER ADDRESS MAIN PART F0500042 EQU CNTLPT(2) CONTROL POINT (OR SPARE) F0500043 EQU RQINFO(3) REQUEST INFORMATION (MULTI-FIELD) F0500044* BITS USE F0500045* 15-12 SPARE F0500046ÐÐ* 11-04 REQUEST INDEX F0500047* 03-00 LEVEL OF REQUESTOR F0500048* F0500049* REQUEST BUFFER INDEXES - MAIN PART F0500050 EQU QREG(0) Q REGISTER F0500051 EQU IREG(1) I REGISTER F0500052 EQU PARLST(2) ADDRESS OF PARAMETER LIST F0500053 EQU RTNADR(2) RETURN ADDRESS TO USER (UPON RETURN FROM EXEC)F0500054 EQU UCTADR(3) UCT ENTRY ABSOLUTE ADDRESS F0500055 EQU USERID(4) USER IDENTIFIER F0500056 EQU FCBADR(5) FCB ADDRESS (MAY BE SET BY CALLER OR INTCPTR.)F0500057 EQU RADINT(6) RETURN ADDRESS TO INTERCEPTOR F0500058 EQU RPIDX(7) REQUEST PROCESSOR INDEX F0500059* BITS 14-00 REQUEST PROCESSOR INDEX F0500060* BIT 15 TYPE OF PROCESSOR F0500061* =0, SERIAL PROCESSOR F0500062* =1, REENTRANT PROCESSOR F0500063 EQU LOKREC(8) NUMBER OF RECORDS TO BE READ/WRITTEN PER I/O F0500064* CALL AND LOCK RECORDS ON RETRIEVE FLAG F0500065* BITS 14-00 NUMBER OF RECORDS PER CALL F0500066* BIT 15 =0, DO NOT LOCK ON RETRIEVE F0500067* =1, LOCK RECORDS ON RETRIEVE F0500068 EQU USEFLG(9) TYPE OF FILE USE FLAG F0500069* -1, OPEN FOR COMPRESSION F0500070* -2, OPEN FOR SPECIAL PROCESSING F0500071ÐÐ* 0, OPEN FOR ACESS VIA REL REC NO F0500072* 1, OPEN FOR RETRIEVAL VIA KEY 1 F0500073* 2, OPEN FOR RETRIEVAL VIA KEY 2 F0500074* 3, OPEN FOR RETRIEVAL VIA KEY 3 F0500075* 4, OPEN FOR RETRIEVAL VIA KEY 4 F0500076 EQU NUMREC(10) NUMBER OF RECORDS ACTUALLY STORED/RETRIEVED F0500077 EQU RRNMSB(11) REL REC NUMBER OF STORED/RETRIEVED REC, MSB F0500078 EQU RRNLSB(12) REL REC NUMBER OF STORED/RETRIEVED REC, LSB F0500079 SPC 2 F0500080 EQU SAVMSB(13) SAVED RRN MSB FOR REPEATED GETS CALLS F0500081 EQU SAVLSB(14) SAVED RRN LSB FOR REPEATED GETS CALLS F0500082 EQU SAVREC(15) SAVED NUMREC FOR REPEATED GETS CALLS F0500083 EQU RMPLEN(20) LENGTH OF REQBUF MAIN PART F0500084 EJT F0500085* REQUEST PROCESSOR CONTROL TABLE F0500086* F0500087 EQU RP(10) INDEX TO START OF REQUEST PARAMETERS F0500088 EQU MR(RP+5) INDEX TO START OF MONITOR REQUEST PARAM LIST F0500089 EQU SS(MR+10) INDEX TO START OF SCRATCH PORTION OF PAR LIST F0500090* F0500091 EQU RPLOGU(1) LU NUMBER OF MM DEVICE F0500092 EQU RPAREQ(2) ACTIVE REQUEST FLAG (IF 0, NONE FOR TABLE) F0500093 EQU RPWAIT(3) START OF WAITING REQUEST QUEUE (IF 0, NO WAITGF0500094 EQU RPRLEV(4) REQUEST PRIORITY LEVEL - ACTIVE REQUEST F0500095 EQU RPRBF4(5) REQBUF ADDRESS - FIRST FOUR WORDS F0500096ÐÐ EQU RPLTEA(6) LOCK TABLE ENTRY (ABSOLUTE) ADDRESS F0500097 EQU RPRTNJ(7) RETURN JUMP TO REQUEST PROCESSOR F0500098 EQU RPPADR(8) PROCESSOR ADDRESS F0500099 SPC 1 F0500100* PARAMETER LIST FOR REQUEST PROCESSOR F0500101 EQU RPFCBA(9) FCB ADDRESS FOR FILE F0500102 EQU RPRBMP(RP+0) REQBUF ADDRESS - MAIN PART F0500103 EQU RPPFP1(RP+1) REQUEST PARAMETER ADDRESS - FIRST + 1 F0500104 EQU RPPFP2(RP+2) REQUEST PARAMETER ADDRESS - FIRST + 2 F0500105 EQU RPPFP3(RP+3) REQUEST PARAMETER ADDRESS - FIRST + 3 F0500106 EQU RPPFP4(RP+4) REQUEST PARAMETER ADDRESS - FIRST + 4 F0500107 SPC 1 F0500108* MAIN MONITOR REQUEST F0500109 EQU RPMREQ(MR+0) MONITOR REQUEST CODE WORD F0500110 EQU RPMRP1(MR+1) COMPLETION ADDRESS F0500111 EQU RPMRP2(MR+2) THREAD WORD F0500112 EQU RPMRP3(MR+3) LOGICAL UNIT FOR I/O F0500113 EQU RPMRP4(MR+4) NUMBER OF WORDS F0500114 EQU RPMRP5(MR+5) START CORE ADDRESS F0500115 EQU RPMRP6(MR+6) MASS MEMORY ADDRESS, MSB F0500116 EQU RPMRP7(MR+7) MASS MEMORY ADDRESS, LSB F0500117 EQU RPRCPT(MR+8) CONTROL POINT (FOR I/O REQUESTS) F0500118 EQU RPRETN(MR+9) SAVED RETURN ADDRESS F0500119* ALTERNATE COMMON NAMES F0500120 EQU REQBUF(RP+0) USERS FIRST CALL PARAMETER ADDRESS F0500121ÐÐ EQU RECBUF(RP+1) RECORD BUFFER ADDRESS F0500122 EQU ISTAT(RP+4) USERS COMPLETION STATUS PARAMETER ADDRESS F0500123 SPC 2 F0500124* SCRATCH FOR GETSEQ F0500125* F0500126* THESE ARE USED AS THE INTERFACE WITH THE READRC F0500127* PROCESSOR F0500128 EQU REDBUF(SS+0) BUFFER FOR READ OF RECORDS F0500129 EQU RELRNM(SS+1) RELATIVE RECORD NUMBER - MSB F0500130 EQU RELRNL(SS+2) RELATIVE RECORD NUMBER - LSB F0500131 EQU NORECS(SS+3) NUMBER OF RECORDS TO BE READ F0500132 EJT F0500133GETNXT 000 000 ENTRY POINT IS NOT USED. EXECUTION STARTS AT F0500134* GETNXT + 1 F0500135 LDQ- REQBUF,I CHECK IF RRN SET TO ZERO - MAY BE 1ST CALL F0500136 LDA- SAVMSB,Q F0500137 SAN GET10 SKIP IF MSB NOT ZERO F0500138 LDA- SAVLSB,Q F0500139 SAN GET10 SKIP IF LSB NOT ZERO F0500140 STA- SAVREC,Q ASSURE SAVREC = 0 F0500141 RAO- SAVLSB,Q SET SAVLSB TO 1 F0500142* F0500143GET10 LDA- SAVREC,Q SAVE VALUE OF SAVREC LOCALLY F0500144 STA* GETNXT F0500145 LDA- SAVLSB,Q PICKUP RRN AND CONVERT TO MSB/LSB (I/O) FORMATF0500146ÐÐ LDQ- SAVMSB,Q F0500147 LLS 1 F0500148 ALS 15 F0500149 ADD* GETNXT ADD NUMREC - DOUBLE PRECISION ADD F0500150 SAP GET20 SKIP IF A STILL POSITIVE F0500151 AND- ONEMSK+14 CLEAR BIT IS OF LSB AND BUMP MSB BY 1 F0500152 INQ 1 F0500153GET20 ALS 1 CONVERT BACK TO RRN FORMAT F0500154 LRS 1 F0500155 STA- RELRNL,I STORE RRN FOR USE BY READRC F0500156 STQ- RELRNM,I F0500157* F0500158 LDQ- REQBUF,I GET NO. OF RECORDS TO READ F0500159 LDA- LOKREC,Q F0500160 AND- ONEMSK+14 MASK OFF LOCK BIT F0500161 STA- NORECS,I STORE FOR READRC F0500162 SAN GET40 ASSURE NOT 0 F0500163 LDA =N$A000 SET REJECTED AND REQBUF NOT IN PROPER STATE F0500164 LDQ- ISTAT,I BITS - STORE IN USER'S ISTAT F0500165 STA- (ZERO),Q F0500166 LDQ- REQBUF,I CHECK IF RECORD LOCKING TO BE DONE F0500167 LDA- LOKREC,Q F0500168 SAP GET30 SKIP IF NO F0500169 LDA* (ANRELE) DECREMENT NO. OF RESERVED LOCK ENTRIES BY 1 F0500170 INA -1 F0500171ÐÐ STA* (ANRELE) F0500172GET30 JMP* (COMPAD) GO COMPLETE REQUEST F0500173* F0500174GET40 STA- NORECS,I STORE FOR READRC F0500175 LDA- RECBUF,I STORE ADDRESS OF BUFFER FOR RECORD READ F0500176 STA- REDBUF,I F0500177 RTJ READRC EXECUTE READRC F0500178 JMP* (COMPAD) COMPLETE REQUEST F0500179 SPC 2 F0500180COMPAD ADC FMCOMP COMPLETION ADDRESS FOR SERIAL PROCESSORS F0500181ANRELE ADC NRERLE NUMBER OF RESERVED RECORD LOCK ENTRIES F0500182* F0500183 END F0500184 NAM WRTBAK F06 A ITOS CCS 3.0 SL-149F0600001* WRITE UPDATED RECORD BACK INTO FILE F0600002* CREDIT COLLECTION SYSTEM VERSION 3.0 F0600003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F0600004* COPYRIGHT CONTROL DATA CORPORATION 1979 F0600005* F0600006**** F0600007* WRTBAK IS THE REQUEST PROCESSOR FOR THE STORE UPDATED RECORDF0600008* REQUEST. IT IS ALSO USED AS A SUBROUTINE BY THE COMPRESS F0600009* FILE PROCESSOR. THE UPDATE RECORD REQUEST HAS THE FOLLOWINGF0600010* CALL SEQUENCE: F0600011* F0600012ÐÐ* CALL UPDREC (REQBUF,RECBUF,ISTAT) F0600013* F0600014* WHERE REQBUF IS THE REQUEST BUFFER, F0600015* RECBUF IS THE RECORD BUFFER AND F0600016* ISTAT IS THE FILE REQUEST STATUS WORD. F0600017* F0600018* WHEN WRTBAK IS EXECUTED BY THE EXEC TO PROCESS AN UPDATE F0600019* RECORD REQUEST, A JUMP IS MADE TO WRTBAK+1. WHEN WRTBAK IS F0600020* EXECUTED BY THE COMPRESS FILE PROCESSOR A RETURN JUMP IS F0600021* MADE TO WRTBAK. WRTBAK COMPLETES EXECUTION BY JUMPING TO F0600022* FMCOMP IF EXECUTED BY THE EXEC OR BY RETURNING TO THE CALLERF0600023* IF EXECUTED BY THE COMPRESS FILE REQUEST PROCESSOR. F0600024* F0600025* F0600026* WHEN WRTBAK IS EXECUTED BY THE EXEC, WORD RPLTEA OF THE F0600027* REQUEST PROCESSOR TABLE WILL GIVE THE ADDRESS OF THE LOCK F0600028* TABLE ENTRY DEFINING THE SET OF ONE OR MORE RECORDS TO BE F0600029* WRITTEN BACK TO MASS MEMORY. F0600030* F0600031*E F0600032 EJT F0600033 ENT WRTBAK ENTRY POINT F0600034* F0600035 EXT FMCOMP COMPLETION ADDRESS FOR SERIAL PROCESSORS F0600036 EXT MMWRIT MM WRITE ROUTINE F0600037ÐÐ EXT CLFRIO COMPUTE LENGTH FOR RECORD I/O F0600038 EXT REMLOK REMOVE LOCKED RECORDS ENTRY F0600039 EXT DWADD DOUBLE WORD ADD F0600040 EXT DWSUB DOUBLE WORD SUBTRACT F0600041 EXT FMFSRC CHECK FCB SUBSET RESIDENCY 132*5369F0600042**** F0600043 SPC 3 F0600044* EQUIVALENCES F0600045 SPC 2 F0600046* COMMUNICATION REGION CONSTANTS F0600047 EQU ZERO(2) ZERO CONSTANT F0600048 EQU ZROMSK($13) ZERO MASK TABLE F0600049 EQU ONEBIT($23) ONE BIT TABLE F0600050 SPC 1 F0600051* UCT ENTRY EQUIVALENCES F0600052 EQU UIDENT(ZERO) USER IDENTIFICATION F0600053 EQU FIDENT(1) PSEUDO FILE IDENTIFIER F0600054 EQU FCBCAD(2) FCB CORE ADDRESS F0600055 EQU FSLADR(3) FILE SPACE LIMITS TABLE ENTRY ADDRESS F0600056 EQU FCBSAD(4) FCB SUBSET ADDRESS F0600057 EQU USRCPT(5) USERS CONTROL POINT F0600058 EJT F0600059* REQUEST BUFFER INDEXES - FIRST 4 WORDS F0600060 EQU RBATHR(0) REQUEST BUFFER ADDRESS THREAD F0600061 EQU BUFAMP(1) BUFFER ADDRESS MAIN PART F0600062ÐÐ EQU CNTLPT(2) CONTROL POINT (OR SPARE) F0600063 EQU RQINFO(3) REQUEST INFORMATION (MULTI-FIELD) F0600064* BITS USE F0600065* 15-12 SPARE F0600066* 11-04 REQUEST INDEX F0600067* 03-00 LEVEL OF REQUESTOR F0600068* F0600069* REQUEST BUFFER INDEXES - MAIN PART F0600070 EQU QREG(0) Q REGISTER F0600071 EQU IREG(1) I REGISTER F0600072 EQU PARLST(2) ADDRESS OF PARAMETER LIST F0600073 EQU RTNADR(2) RETURN ADDRESS TO USER (UPON RETURN FROM EXEC)F0600074 EQU UCTADR(3) UCT ENTRY ABSOLUTE ADDRESS F0600075 EQU USERID(4) USER IDENTIFIER F0600076 EQU FCBADR(5) FCB ADDRESS (MAY BE SET BY CALLER OR INTCPTR.)F0600077 EQU RADINT(6) RETURN ADDRESS TO INTERCEPTOR F0600078 EQU RPIDX(7) REQUEST PROCESSOR INDEX F0600079* BITS 14-00 REQUEST PROCESSOR INDEX F0600080* BIT 15 TYPE OF PROCESSOR F0600081* =0, SERIAL PROCESSOR F0600082* =1, REENTRANT PROCESSOR F0600083 EQU LOKREC(8) NUMBER OF RECORDS TO BE READ/WRITTEN PER I/O F0600084* CALL AND LOCK RECORDS ON RETRIEVE FLAG F0600085* BITS 14-00 NUMBER OF RECORDS PER CALL F0600086* BIT 15 =0, DO NOT LOCK ON RETRIEVE F0600087ÐÐ* =1, LOCK RECORDS ON RETRIEVE F0600088 EQU USEFLG(9) TYPE OF FILE USE FLAG F0600089* -1, OPEN FOR COMPRESSION F0600090* -2, OPEN FOR SPECIAL PROCESSING F0600091* 0, OPEN FOR ACESS VIA REL REC NO F0600092* 1, OPEN FOR RETRIEVAL VIA KEY 1 F0600093* 2, OPEN FOR RETRIEVAL VIA KEY 2 F0600094* 3, OPEN FOR RETRIEVAL VIA KEY 3 F0600095* 4, OPEN FOR RETRIEVAL VIA KEY 4 F0600096 EQU NUMREC(10) NUMBER OF RECORDS ACTUALLY STORED/RETRIEVED F0600097 EQU RRNMSB(11) REL REC NUMBER OF STORED/RETRIEVED REC, MSB F0600098 EQU RRNLSB(12) REL REC NUMBER OF STORED/RETRIEVED REC, LSB F0600099 EQU RMPLEN(20) LENGTH OF REQBUF MAIN PART F0600100 EJT F0600101* FILE CONTROL BLOCK EQUIVALENCES F0600102 EQU FH(4) LENGTH -1 OF FCB HEADER F0600103 EQU FILEID(ZERO) FILE IDENTIFIER F0600104* ACCESS FILEID INDIRECTLY F0600105* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBERF0600106* BITS 10-00 INDEX OF FCB IN FCB TABLE F0600107 EQU FCBFLG(1) FCB FLAGS F0600108* BITS 15-8, SPARE F0600109* BITS 7-00, NUMBER OF USERS USING FILE F0600110 EQU FILOCK(2) FILE LOCK FLAG (IF NON-0, CONTAINS USER ID) F0600111 EQU NUMSET(3) NUMBER OF SETS OF LOCKED RECORDS IN FILE F0600112ÐÐ EQU NUMNEW(4) NUMBER OF NEW RECORDS SINCE FCB UPDATED ON MM F0600113 SPC 1 F0600114 EQU RECLEN(FH+1) RECORD LENGTH IN WORDS F0600115 EQU TDATRM(FH+2) TOTAL NUMBER OF DATA RECORDS, MSB F0600116 EQU TDATRL(FH+3) TOTAL NUMBER OF DATA RECORDS, LSB F0600117 EQU DATBAM(FH+4) DATA RECORDS BEGINNING SECTOR ADDRESS, MSB F0600118 EQU DATBAL(FH+5) DATA RECORDS BEGINNING SECTOR ADDRESS,LMSB F0600119 EQU FCBIND(FH+6) FCB INDICATORS F0600120* BIT 15 , SECTOR ALLIGNED RECORDS IF =1 F0600121* BIT 14 , STORAGE MODE FOR INDEXED FILE F0600122* =0, RECORDS STORED RANDOMLY WITHF0600123* RESPECT TO PRIMARY KEY F0600124* =1, RECORDS STORED IN ORDER WIT F0600125* RESPECT TO PRIMARY KEY F0600126* BIT 13 , =1, FILE IS CURRENTLY OPEN F0600127* =0, FILE IS CURRENTLY CLOSED F0600128* BIT 12 , =1, FILE IS BEING COMPRESSED F0600129* =0, FILE IS NOT BEING COMPRESSEDF0600130* BIT 11 , =1, FILE IS OPEN FOR SPECIAL F0600131* PROCESSING F0600132* =0, FILE IS NOT OPEN FOR SPECIALF0600133* PROCESSING F0600134* BIT 8 , =1, RECORDS CONTAIN BINARY DATA F0600135* =0, RECORDS DO NOT CONTAIN F0600136* BINARY DATA F0600137ÐÐ* BIT 0 , FILE TYPE F0600138* =0, SEQUENTIAL FILE F0600139* =1, INDEXED FILE F0600140 EQU NEDATM(FH+7) NUMBER OF EXISTING DATA RECORDS, MSB F0600141 EQU NEDATL(FH+8) NUMBER OF EXISTING DATA RECORDS, LSB F0600142 EQU SEQLTH(NEDATL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F0600143* OF FCB FOR A SEQUENTIAL FILE F0600144 SPC 1 F0600145 EQU NEXTBM(FH+9) NEXT FREE KEY INDEX BLOCK, MSB F0600146 EQU NEXTBL(FH+10) NEXT FREE KEY INDEX BLOCK, LSB F0600147 EQU TNKEYM(FH+11) TOTAL NUMBER OF KEY INDEX BLOCKS, MSB F0600148 EQU TNKEYL(FH+12) TOTAL NUMBER OF KEY INDEX BLOCKS, LSB F0600149 EQU KEYBAM(FH+13) KEY INDEX BEGINNING SECTOR ADDRESS, MSB F0600150 EQU KEYBAL(FH+14) KEY INDEX BEGINNING SECTOR ADDRESS, LSB F0600151 EQU LENKY1(FH+15) LENGTH OF KEY NO. 1 F0600152 EQU POSKY1(FH+16) BYTE POSITION OF KEY NO. 1 F0600153 EQU LENKY2(FH+17) LENGTH OF KEY NO. 2 F0600154 EQU POSKY2(FH+18) BYTE POSITION OF KEY NO. 2 F0600155 EQU LENKY3(FH+19) LENGTH OF KEY NO. 3 F0600156 EQU POSKY3(FH+20) BYTE POSITION OF KEY NO. 3 F0600157 EQU LENKY4(FH+21) LENGTH OF KEY NO. 4 F0600158 EQU POSKY4(FH+22) BYTE POSITION OF KEY NO. 4 F0600159 EQU INDLEN(POSKY4-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F0600160* OF FCB FOR AN INDEXED FILE F0600161 EJT F0600162ÐÐ* THE FOLLOWING PORTION OF THE FCB EXISTS ONLY F0600163* ON MASS MEMORY. THESE 10 WORDS ARE NOT LOADEDF0600164* INTO EITHER OF THE FILE MANAGER CONTROLLED FCBF0600165* TABLES. F0600166 EQU TSFILM(FH+23) TOTAL NUMBER OF SECTORS IN FILE, MSB F0600167 EQU TSFILL(FH+24) TOTAL NUMBER OF SECTORS IN FILE, LSB F0600168 EQU NAME12(FH+25) FILE NAME, CHARACTERS 1 AND 2 F0600169 EQU NAME34(FH+26) FILE NAME, CHARACTERS 3 AND 4 F0600170 EQU NAME56(FH+27) FILE NAME, CHARACTERS 5 AND 6 F0600171 EQU NAME78(FH+28) FILE NAME, CHARACTERS 7 AND 8 F0600172 EQU OWNR12(FH+29) OWNER NAME, CHARACTERS 1 AND 2 F0600173 EQU OWNR34(FH+30) OWNER NAME, CHARACTERS 3 AND 4 F0600174 EQU OWNR56(FH+31) OWNER NAME, CHARACTERS 5 AND 6 F0600175 EQU OWNR78(FH+32) OWNER NAME, CHARACTERS 7 AND 8 F0600176 EQU BYTLEN(FH+33) BYTE LENGTH OF RECORD F0600177* F0600178* FOR COMPRESS ONLY F0600179* F0600180 EQU PRSRNM(FH+34) RRN OF LAST PROCESSED RECORD - MSB F0600181 EQU PRSRNL(FH+35) RRN OF LAST PROCESSED RECORD - LSB F0600182 EQU NEWRNM(FH+36) RRN OF THE LATEST 'NEW' RECORD - MSB F0600183 EQU NEWRNL(FH+37) RRN OF THE LATEST 'NEW' RECORD - LSB F0600184 SPC 4 F0600185* WORDS 0 THRU 4 OF THE FCB HEADER AND WORDS F0600186* 6 THRU 10 OF THE FCB ARE REFERRED TO AS THE F0600187ÐÐ* SHARED SUBSET OF THE FCB. THEY INCLUDE THE F0600188* ONLY FCB WORDS THAT CAN BE MODIFIED AFTER FILEF0600189* CREATION. IF TWO OR MORE USERS HAVE THE SAME F0600190* FILE OPEN, THERE HAS TO BE A SINGLE MASTER F0600191* COPY OF THE SUBSET THAT RECEIVES (AND RECORDS)F0600192* ALL OF THE UPDATES. THE CONTROLLED SUBSET F0600193* WILL ALWAYS BE PART OF A MAIN MEMORY RESIDENT F0600194* FCB IF THE FCB IS IN A FM CONTROLLED TABLE. F0600195* IF THE FCB IS IN USER SPACE, THE SUBSET MAY ATF0600196* TIMES RESIDE IN THE SUBSET CONTROL TABLE. F0600197 SPC 2 F0600198* ALTERNATE NAMES FOR SUBSET WORDS F0600199 EQU SAFCBI(FH+1) SUBSET ALTERNATE NAME FOR FCBIND F0600200 EQU SADATM(FH+2) SUBSET ALTERNATE NAME FOR NEDATM F0600201 EQU SADATL(FH+3) SUBSET ALTERNATE NAME FOR NEDATL F0600202 EQU SANXTM(FH+4) SUBSET ALTERNATE NAME FOR NEXTBM F0600203 EQU SANXTL(FH+5) SUBSET ALTERNATE NAME FOR NEXTBL F0600204 EJT F0600205* REQUEST PROCESSOR CONTROL TABLE F0600206* F0600207 EQU RP(10) INDEX TO START OF REQUEST PARAMETERS F0600208 EQU MR(RP+5) INDEX TO START OF MONITOR REQUEST PARAM LIST F0600209 EQU SS(MR+10) INDEX TO START OF SCRATCH PORTION OF PAR LIST F0600210* F0600211 EQU RPLOGU(1) LU NUMBER OF MM DEVICE F0600212ÐÐ EQU RPAREQ(2) ACTIVE REQUEST FLAG (IF 0, NONE FOR TABLE) F0600213 EQU RPWAIT(3) START OF WAITING REQUEST QUEUE (IF 0, NO WAITGF0600214 EQU RPRLEV(4) REQUEST PRIORITY LEVEL - ACTIVE REQUEST F0600215 EQU RPRBF4(5) REQBUF ADDRESS - FIRST FOUR WORDS F0600216 EQU RPLTEA(6) LOCK TABLE ENTRY (ABSOLUTE) ADDRESS F0600217 EQU RPRTNJ(7) RETURN JUMP TO REQUEST PROCESSOR F0600218 EQU RPPADR(8) PROCESSOR ADDRESS F0600219 SPC 1 F0600220* PARAMETER LIST FOR REQUEST PROCESSOR F0600221 EQU RPFCBA(9) FCB ADDRESS FOR FILE F0600222 EQU RPRBMP(RP+0) REQBUF ADDRESS - MAIN PART F0600223 EQU RPPFP1(RP+1) REQUEST PARAMETER ADDRESS - FIRST + 1 F0600224 EQU RPPFP2(RP+2) REQUEST PARAMETER ADDRESS - FIRST + 2 F0600225 EQU RPPFP3(RP+3) REQUEST PARAMETER ADDRESS - FIRST + 3 F0600226 EQU RPPFP4(RP+4) REQUEST PARAMETER ADDRESS - FIRST + 4 F0600227 SPC 1 F0600228* MAIN MONITOR REQUEST F0600229 EQU RPMREQ(MR+0) MONITOR REQUEST CODE WORD F0600230 EQU RPMRP1(MR+1) COMPLETION ADDRESS F0600231 EQU RPMRP2(MR+2) THREAD WORD F0600232 EQU RPMRP3(MR+3) LOGICAL UNIT FOR I/O F0600233 EQU RPMRP4(MR+4) NUMBER OF WORDS F0600234 EQU RPMRP5(MR+5) START CORE ADDRESS F0600235 EQU RPMRP6(MR+6) MASS MEMORY ADDRESS, MSB F0600236 EQU RPMRP7(MR+7) MASS MEMORY ADDRESS, LSB F0600237ÐÐ EQU RPRCPT(MR+8) CONTROL POINT (FOR I/O REQUESTS) F0600238 EQU RPRETN(MR+9) SAVED RETURN ADDRESS F0600239* ALTERNATE COMMON NAMES F0600240 EQU REQBUF(RP+0) USERS FIRST CALL PARAMETER ADDRESS F0600241 EQU ISTAT(RP+4) USERS COMPLETION STATUS PARAMETER ADDRESS F0600242 EQU RECBUF(RP+1) RECORD BUFFER PARAMETER F0600243 SPC 1 F0600244* SCRATCH FOR WRTBAK F0600245* F0600246* PARAMETER LIST FOR MM I/O ROUTINE F0600247 EQU MSBBSA(SS+0) MSB OF BASE SECTOR ADDRESS F0600248 EQU LSBBSA(SS+1) LSB OF BASE SECTOR ADDRESS F0600249 EQU MSBRRN(SS+2) MSB OF RELATIVE RECORD NUMBER F0600250 EQU LSBRRN(SS+3) LSB OF RELATIVE RECORD NUMBER F0600251 EQU RCDLEN(SS+4) RECORD LENGTH - BIT 15 SET IF SECTOR ALLIGNED F0600252 EQU NUMWDS(SS+5) NUMBER OF WORDS TO READ OR WRITE F0600253 EQU OFFSET(SS+6) WORD OFFSET FROM START OF RECORD F0600254 EQU RECBFR(SS+7) ADDRESS OF BUFFER FOR I/O F0600255 EQU IOTYPE(SS+8) I/O TYPE: NON-ZERO IF FILE I/O, ELSE ZERO. F0600256 EQU RETURN(SS+9) SAVED RETURN ADDRESS (0 IF EXECUTED BY EXEC) F0600257 EJT F0600258WRTBAK 000 0 ENTRY POINT - WILL BE ZERO IF EXECUTED BY F0600259* THE EXEC F0600260 LDA* WRTBAK SAVE RETURN ADDRESS, MAY BE 0 F0600261 STA- RETURN,I F0600262ÐÐ CLR A F0600263 STA* WRTBAK CLEAR ENTRY POINT FOR NEXT USE F0600264* F0600265 LDQ- REQBUF,I PREPARE TO CHECK IF USER'S RRN AND NUMREC ARE F0600266 LDA- RRNLSB,Q VALID F0600267 LDQ- RRNMSB,Q SET UP TO ADD NUMREC -1 TO RRN F0600268 LLS 1 CONVERT RRN TO MSB/LSB FORMAT F0600269 ALS 15 F0600270 STQ- MSBBSA,I F0600271 STA- LSBBSA,I F0600272 LDQ- REQBUF,I F0600273 LDA- NUMREC,Q F0600274 INA -1 ASSURE NUMREC IS .GE. 1 F0600275 SAP WRT10 SKIP IF NUMREC IS OK F0600276WRT05 LDA =N$A000 SET ISTAT=A000 - REQBUF SET UP INCORRECTLY F0600277 JMP* WRT70 F0600278* F0600279WRT10 STA- LSBRRN,I F0600280 CLR A F0600281 STA- MSBRRN,I F0600282 LDQ- I F0600283 INQ MSBBSA SET Q TO ABS ADDRESS OF MSBBSA F0600284 RTJ DWADD ADD THE TWO DOUBLE WORD NUMBERS F0600285 LDA- RCDLEN,I MOVE RESULT UP SO THAT IT CAN BE SUBTRACTED F0600286 STA- MSBRRN,I FROM NUMBER OF RECORDS IN THE FILE F0600287ÐÐ LDA- NUMWDS,I F0600288 STA- LSBRRN,I F0600289 LDQ- REQBUF,I CHECK IF SUBSET IS IN SUBSET TABLE 132*5369F0600290 LDQ- UCTADR,Q F0600291 LDQ- FCBSAD,Q 132*5369F0600292 TRQ A 132*5369F0600293 RTJ FMFSRC CHECK SUBSET ADDDRESS 132*5369F0600294 SAZ WRT20 SKIP IF IN TABLE 132*5369F0600295 LDA- SADATL,Q GET MSB/LSB OF NUMBER OF EXISTING RECORDS F0600296 LDQ- SADATM,Q F0600297 JMP* WRT30 F0600298 EJT F0600299WRT20 LDA- NEDATL,Q GET MSB/LSB OF NUMBER OF EXISTING REC 132*5369F0600300 LDQ- NEDATM,Q F0600301WRT30 LLS 1 F0600302 ALS 15 CONVERT TO MSB/LSB FORMAT F0600303 STQ- MSBBSA,I STORE FOR SUBTRACTION F0600304 STA- LSBBSA,I F0600305 LDQ- I SET Q TO ABS ADDRESS OF MSBBSA F0600306 INQ MSBBSA F0600307 RTJ DWSUB PERFORM THE SUBTRACT F0600308 LDA- OFFSET,I IF THE RESULT IS BAD, THE REQUEST MUST BE F0600309* REJECTED F0600310 SAZ WRT40 SKIP IF RESULT IS GOOD F0600311 JMP* WRT05 GO SET ISTAT = $A000 F0600312ÐÐ* F0600313WRT40 LDQ- REQBUF,I SET UP PARAMETER LIST FOR MMWRIT F0600314 LDA- RRNMSB,Q FIRST, GET REL REC NO. FROM REQBUF (ALSO IN F0600315 STA- MSBRRN,I RECORD LOCK ENTRY) F0600316 LDA- RRNLSB,Q F0600317 STA- LSBRRN,I F0600318 LDA- NUMREC,Q ASSURE ONLY ONE RECORD IS BEING UPDATED IF F0600319 INA -1 FILE IS INDEXED F0600320 SAZ WRT50 SKIP IF ONLY RECORD F0600321 LDA- USEFLG,Q F0600322 SAZ WRT50 SKIP IF OPEN FOR RRN RETRIEVAL F0600323 SAM WRT50 SKIP IF OPEN FOR COMPRESS F0600324 LDA- ZROMSK+13 SET ISTAT TO $C000 F0600325 JMP* WRT70 CANNOT WRITE BACK MORE THAN ONE RECORD IF F0600326** RETRIEVING VIA KEY FOR INDEXED FILE F0600327 EJT F0600328WRT50 LDA- NUMREC,Q NEXT, GET NO. OF RECORDS F0600329 STA- IOTYPE,I STORE AS I/O TYPE FLAG F0600330 RTJ CLFRIO COMPUTE LENGTH FOR RECORD I/O F0600331 STA- NUMWDS,I STORE IN PARAMETER LIST F0600332 CLR A F0600333 STA- OFFSET,I CLEAR WORD OFFSET F0600334 LDQ- ISTAT,I CLEAR REQUEST STATUS WORD, TOO F0600335 STA- (ZERO),Q F0600336 LDA- RECBUF,I F0600337ÐÐ STA- RECBFR,I SET ADDRESS OF RECORD BUFFER F0600338 LDQ- RPFCBA,I SET Q TO FCB ADDRESS F0600339 LDA- DATBAM,Q SET MSB/LSB OF BASE SECTOR ADDRESS F0600340 STA- MSBBSA,I F0600341 LDA- DATBAL,Q F0600342 STA- LSBBSA,I F0600343 LDA- RECLEN,Q PICKUP RECORD LENGTH F0600344 LDQ- FCBIND,Q CHECK IF SECTOR ALLIGNED F0600345 SQP WRT60 SKIP IF NO F0600346 EOR- ONEBIT+15 SET BIT 15 AS SECTOR ALLIGNED FLAG F0600347WRT60 STA- RCDLEN,I STORE LENGTH F0600348 LDQ- I F0600349 INQ MSBBSA SET Q TO ABS ADDRESS OF PARAM LIST F0600350 RTJ MMWRIT WRITE RECORDS BACK TO FILE F0600351 SQP WRT80 SKIP IF NO I/O ERROR F0600352 LDA =N$8020 SET REJECTED + I/O ERROR BITS F0600353 INQ 0 CHECK IF Q =-0 (-0 IF COMPUTATION ERROR) F0600354 SQN WRT70 SKIP IF NOT F0600355 ADD- ONEBIT+14 ADD ILLEGAL REQUEST BIT F0600356* F0600357WRT70 LDQ- ISTAT,I STORE ISTAT F0600358 STA- (ZERO),Q F0600359* F0600360WRT80 LDQ- REQBUF,I CHECK IF RECORD LOCKING BEING DONE F0600361 LDA- LOKREC,Q F0600362ÐÐ SAP WRT90 SKIP IF NO F0600363* F0600364 LDQ- RPLTEA,I SET Q TO RECORD LOCK ENTRY F0600365 RTJ REMLOK REMOVE LOCK ENTRY FROM ENTRY F0600366* F0600367WRT90 LDQ- RETURN,I F0600368 SQZ WRT100 F0600369 JMP- (ZERO),Q RETURN TO CALLING PROGRAM F0600370WRT100 JMP FMCOMP RETURN TO EXEC F0600371 END F0600372 NAM MRECAD F07 A ITOS CCS 3.0 SL-149F0700001* MARK RECORD AS DELETED AND WRITE BACK INTO FILE F0700002* CREDIT COLLECTION SYSTEM VERSION 3.0 F0700003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F0700004* COPYRIGHT CONTROL DATA CORPORATION 1979 F0700005* F0700006**** F0700007* MRECAD IS THE REQUEST PROCESSOR FOR THE DELETE RECORD F0700008* REQUEST. IT IS ALSO USED AS A SUBROUTINE FOR DELETING F0700009* A RECORD FROM AN INDEXED FILE. THE DELREC REQUEST HAS F0700010* THE FOLLOWING CALL SEQUENCE : F0700011* F0700012* CALL DELREC (REQBUF, RECBUF, ISTAT) F0700013* F0700014* WHERE REQBUF IS THE FILE REQUEST BUFFER, F0700015ÐÐ* RECBUF IS THE RECORD BUFFER CONTAINING THE F0700016* RECORD TO BE DELETED F0700017* ISTAT IS THE FILE REQUEST STATUS WORD. F0700018* F0700019* WHEN MRECAD IS EXECUTED BY THE EXEC TO PROCESS A DELETE F0700020* RECORD FROM A SEQUENTIAL FILE, A JUMP IS MADE TO MRECAD+1. F0700021* WHEN MRECAD IS EXECUTED BY THE INDEXED FILE DELREC PROCESSORF0700022* A RETURN JUMP IS MADE TO MRECAD. MRECAD COMPLETES EXECUTIONF0700023* BY JUMPING TO FMCOMP IF EXECUTED BY THE EXEC OR BY RETURNINGF0700024* TO THE CALLER IF EXECUTED BY THE INDEXED FILE DELREC REQUESTF0700025* PROCESSOR. F0700026* F0700027* MRECAD FIRST CHECKS IF ONLY ONE RECORD WAS RETRIEVED BY THE F0700028* PREVIOUS RETRIVE RECORD REQUEST. IF MORE THAN ONE RECORD F0700029* HAD BEEN RETRIEVED, THE REQUEST IS ABORTED. NEXT, SUBROU- F0700030* TINE FMCOVL IS USED TO CHECK FOR POSSIBLE OVERLAP OF THE F0700031* RECORD BUFFER (1ST WORD) WITH REQBUF AND ISTAT. NEXT, THE F0700032* GLOBAL RECORD DELETED CODE IS STORED INTO THE FIRST WORD OF F0700033* THE RECORD BUFFER AND THE RECORD BUFFER IS WRITTEN TO MASS F0700034* MEMORY. FINALLY, IF RECORD LOCKING IS IN EFFECT THE RECORD F0700035* LOCK IS REMOVED FROM THE RECORD LOCK TABLE. F0700036* F0700037* IF THE FILE IS DEFINED AS SECTOR ALLIGNED, A FULL SECTOR IS F0700038* WRITTEN OUT. IF NOT SECTOR ALLIGNED, ONLY ONE WORD IS F0700039* WRITTEN. F0700040ÐÐ* F0700041* F0700042 ENT MRECAD ENTRY POINT F0700043* F0700044 EXT FMCOMP EXEC'S COMPLETE REQUEST ENTRY FOR REENT. PROCSF0700045 EXT MMWRIT MASS MEMORY WRITE ROUTINE F0700046 EXT MMLUTB MASS MEMORY LOGICAL UNIT TABLE F0700047 EXT FMRDEL VALUE FOR DELETED RECORD F0700048 EXT REMLOK REMOVE LOCKED RECORDS ENTRY F0700049 EXT FMCOVL CHECK IF PARAMETERS OVERLAP F0700050**** F0700051 SPC 3 F0700052* EQUIVALENCES F0700053 SPC 2 F0700054* COMMUNICATION REGION CONSTANTS F0700055 EQU ZERO(2) ZERO CONSTANT F0700056 EQU ONEMSK(3) ONE MASK TABLE F0700057 EQU ZROMSK($13) ZERO MASK TABLE F0700058 EQU ONEBIT($23) ONE BIT TABLE F0700059 EJT F0700060* REQUEST BUFFER INDEXES - FIRST 4 WORDS F0700061 EQU RBATHR(0) REQUEST BUFFER ADDRESS THREAD F0700062 EQU BUFAMP(1) BUFFER ADDRESS MAIN PART F0700063 EQU CNTLPT(2) CONTROL POINT (OR SPARE) F0700064 EQU RQINFO(3) REQUEST INFORMATION (MULTI-FIELD) F0700065ÐÐ* BITS USE F0700066* 15-12 SPARE F0700067* 11-04 REQUEST INDEX F0700068* 03-00 LEVEL OF REQUESTOR F0700069* F0700070* REQUEST BUFFER INDEXES - MAIN PART F0700071 EQU QREG(0) Q REGISTER F0700072 EQU IREG(1) I REGISTER F0700073 EQU PARLST(2) ADDRESS OF PARAMETER LIST F0700074 EQU RTNADR(2) RETURN ADDRESS TO USER (UPON RETURN FROM EXEC)F0700075 EQU UCTADR(3) UCT ENTRY ABSOLUTE ADDRESS F0700076 EQU USERID(4) USER IDENTIFIER F0700077 EQU FCBADR(5) FCB ADDRESS (MAY BE SET BY CALLER OR INTCPTR.)F0700078 EQU RADINT(6) RETURN ADDRESS TO INTERCEPTOR F0700079 EQU RPIDX(7) REQUEST PROCESSOR INDEX F0700080* BITS 14-00 REQUEST PROCESSOR INDEX F0700081* BIT 15 TYPE OF PROCESSOR F0700082* =0, SERIAL PROCESSOR F0700083* =1, REENTRANT PROCESSOR F0700084 EQU LOKREC(8) NUMBER OF RECORDS TO BE READ/WRITTEN PER I/O F0700085* CALL AND LOCK RECORDS ON RETRIEVE FLAG F0700086* BITS 14-00 NUMBER OF RECORDS PER CALL F0700087* BIT 15 =0, DO NOT LOCK ON RETRIEVE F0700088* =1, LOCK RECORDS ON RETRIEVE F0700089 EQU USEFLG(9) TYPE OF FILE USE FLAG F0700090ÐÐ* -1, OPEN FOR COMPRESSION F0700091* -2, OPEN FOR SPECIAL PROCESSING F0700092* 0, OPEN FOR ACESS VIA REL REC NO F0700093* 1, OPEN FOR RETRIEVAL VIA KEY 1 F0700094* 2, OPEN FOR RETRIEVAL VIA KEY 2 F0700095* 3, OPEN FOR RETRIEVAL VIA KEY 3 F0700096* 4, OPEN FOR RETRIEVAL VIA KEY 4 F0700097 EQU NUMREC(10) NUMBER OF RECORDS ACTUALLY STORED/RETRIEVED F0700098 EQU RRNMSB(11) REL REC NUMBER OF STORED/RETRIEVED REC, MSB F0700099 EQU RRNLSB(12) REL REC NUMBER OF STORED/RETRIEVED REC, LSB F0700100 EQU RMPLEN(20) LENGTH OF REQBUF MAIN PART F0700101 EJT F0700102* FILE CONTROL BLOCK EQUIVALENCES F0700103 EQU FH(4) LENGTH -1 OF FCB HEADER F0700104 EQU FILEID(ZERO) FILE IDENTIFIER F0700105* ACCESS FILEID INDIRECTLY F0700106* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBERF0700107* BITS 10-00 INDEX OF FCB IN FCB TABLE F0700108 EQU FCBFLG(1) FCB FLAGS F0700109* BITS 15-8, SPARE F0700110* BITS 7-00, NUMBER OF USERS USING FILE F0700111 EQU FILOCK(2) FILE LOCK FLAG (IF NON-0, CONTAINS USER ID) F0700112 EQU NUMSET(3) NUMBER OF SETS OF LOCKED RECORDS IN FILE F0700113 EQU NUMNEW(4) NUMBER OF NEW RECORDS SINCE FCB UPDATED ON MM F0700114 SPC 1 F0700115ÐÐ EQU RECLEN(FH+1) RECORD LENGTH IN WORDS F0700116 EQU TDATRM(FH+2) TOTAL NUMBER OF DATA RECORDS, MSB F0700117 EQU TDATRL(FH+3) TOTAL NUMBER OF DATA RECORDS, LSB F0700118 EQU DATBAM(FH+4) DATA RECORDS BEGINNING SECTOR ADDRESS, MSB F0700119 EQU DATBAL(FH+5) DATA RECORDS BEGINNING SECTOR ADDRESS,LMSB F0700120 EQU FCBIND(FH+6) FCB INDICATORS F0700121* BIT 15 , SECTOR ALLIGNED RECORDS IF =1 F0700122* BIT 14 , STORAGE MODE FOR INDEXED FILE F0700123* =0, RECORDS STORED RANDOMLY WITHF0700124* RESPECT TO PRIMARY KEY F0700125* =1, RECORDS STORED IN ORDER WIT F0700126* RESPECT TO PRIMARY KEY F0700127* BIT 13 , =1, FILE IS CURRENTLY OPEN F0700128* =0, FILE IS CURRENTLY CLOSED F0700129* BIT 12 , =1, FILE IS BEING COMPRESSED F0700130* =0, FILE IS NOT BEING COMPRESSEDF0700131* BIT 11 , =1, FILE IS OPEN FOR SPECIAL F0700132* PROCESSING F0700133* =0, FILE IS NOT OPEN FOR SPECIALF0700134* PROCESSING F0700135* BIT 8 , =1, RECORDS CONTAIN BINARY DATA F0700136* =0, RECORDS DO NOT CONTAIN F0700137* BINARY DATA F0700138* BIT 0 , FILE TYPE F0700139* =0, SEQUENTIAL FILE F0700140ÐÐ* =1, INDEXED FILE F0700141 EQU NEDATM(FH+7) NUMBER OF EXISTING DATA RECORDS, MSB F0700142 EQU NEDATL(FH+8) NUMBER OF EXISTING DATA RECORDS, LSB F0700143 EQU SEQLTH(NEDATL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F0700144* OF FCB FOR A SEQUENTIAL FILE F0700145 SPC 1 F0700146 EQU NEXTBM(FH+9) NEXT FREE KEY INDEX BLOCK, MSB F0700147 EQU NEXTBL(FH+10) NEXT FREE KEY INDEX BLOCK, LSB F0700148 EQU TNKEYM(FH+11) TOTAL NUMBER OF KEY INDEX BLOCKS, MSB F0700149 EQU TNKEYL(FH+12) TOTAL NUMBER OF KEY INDEX BLOCKS, LSB F0700150 EQU KEYBAM(FH+13) KEY INDEX BEGINNING SECTOR ADDRESS, MSB F0700151 EQU KEYBAL(FH+14) KEY INDEX BEGINNING SECTOR ADDRESS, LSB F0700152 EQU LENKY1(FH+15) LENGTH OF KEY NO. 1 F0700153 EQU POSKY1(FH+16) BYTE POSITION OF KEY NO. 1 F0700154 EQU LENKY2(FH+17) LENGTH OF KEY NO. 2 F0700155 EQU POSKY2(FH+18) BYTE POSITION OF KEY NO. 2 F0700156 EQU LENKY3(FH+19) LENGTH OF KEY NO. 3 F0700157 EQU POSKY3(FH+20) BYTE POSITION OF KEY NO. 3 F0700158 EQU LENKY4(FH+21) LENGTH OF KEY NO. 4 F0700159 EQU POSKY4(FH+22) BYTE POSITION OF KEY NO. 4 F0700160 EQU INDLEN(POSKY4-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F0700161* OF FCB FOR AN INDEXED FILE F0700162 EJT F0700163* THE FOLLOWING PORTION OF THE FCB EXISTS ONLY F0700164* ON MASS MEMORY. THESE 10 WORDS ARE NOT LOADEDF0700165ÐÐ* INTO EITHER OF THE FILE MANAGER CONTROLLED FCBF0700166* TABLES. F0700167 EQU TSFILM(FH+23) TOTAL NUMBER OF SECTORS IN FILE, MSB F0700168 EQU TSFILL(FH+24) TOTAL NUMBER OF SECTORS IN FILE, LSB F0700169 EQU NAME12(FH+25) FILE NAME, CHARACTERS 1 AND 2 F0700170 EQU NAME34(FH+26) FILE NAME, CHARACTERS 3 AND 4 F0700171 EQU NAME56(FH+27) FILE NAME, CHARACTERS 5 AND 6 F0700172 EQU NAME78(FH+28) FILE NAME, CHARACTERS 7 AND 8 F0700173 EQU OWNR12(FH+29) OWNER NAME, CHARACTERS 1 AND 2 F0700174 EQU OWNR34(FH+30) OWNER NAME, CHARACTERS 3 AND 4 F0700175 EQU OWNR56(FH+31) OWNER NAME, CHARACTERS 5 AND 6 F0700176 EQU OWNR78(FH+32) OWNER NAME, CHARACTERS 7 AND 8 F0700177 EQU BYTLEN(FH+33) BYTE LENGTH OF RECORD F0700178* F0700179* FOR COMPRESS ONLY F0700180* F0700181 EQU PRSRNM(FH+34) RRN OF LAST PROCESSED RECORD - MSB F0700182 EQU PRSRNL(FH+35) RRN OF LAST PROCESSED RECORD - LSB F0700183 EQU NEWRNM(FH+36) RRN OF THE LATEST 'NEW' RECORD - MSB F0700184 EQU NEWRNL(FH+37) RRN OF THE LATEST 'NEW' RECORD - LSB F0700185 SPC 4 F0700186* WORDS 0 THRU 4 OF THE FCB HEADER AND WORDS F0700187* 6 THRU 10 OF THE FCB ARE REFERRED TO AS THE F0700188* SHARED SUBSET OF THE FCB. THEY INCLUDE THE F0700189* ONLY FCB WORDS THAT CAN BE MODIFIED AFTER FILEF0700190ÐÐ* CREATION. IF TWO OR MORE USERS HAVE THE SAME F0700191* FILE OPEN, THERE HAS TO BE A SINGLE MASTER F0700192* COPY OF THE SUBSET THAT RECEIVES (AND RECORDS)F0700193* ALL OF THE UPDATES. THE CONTROLLED SUBSET F0700194* WILL ALWAYS BE PART OF A MAIN MEMORY RESIDENT F0700195* FCB IF THE FCB IS IN A FM CONTROLLED TABLE. F0700196* IF THE FCB IS IN USER SPACE, THE SUBSET MAY ATF0700197* TIMES RESIDE IN THE SUBSET CONTROL TABLE. F0700198 SPC 2 F0700199* ALTERNATE NAMES FOR SUBSET WORDS F0700200 EQU SAFCBI(FH+1) SUBSET ALTERNATE NAME FOR FCBIND F0700201 EQU SADATM(FH+2) SUBSET ALTERNATE NAME FOR NEDATM F0700202 EQU SADATL(FH+3) SUBSET ALTERNATE NAME FOR NEDATL F0700203 EQU SANXTM(FH+4) SUBSET ALTERNATE NAME FOR NEXTBM F0700204 EQU SANXTL(FH+5) SUBSET ALTERNATE NAME FOR NEXTBL F0700205 EJT F0700206* VOLUME INFORMATION TABLE F0700207* F0700208 EQU VISLUN(2) SYSTEM LOGICAL UNIT NUMBER (BIT 15=1,NOT READYF0700209* ACCESS VISLUN INDIRECTLY F0700210 EQU VINAME(1) VOLUME NAME - ASCII CHARACTERS 1 AND 2 F0700211* VOLUME NAME - ASCII CHARACTERS 3 AND 4 F0700212* VOLUME NAME - ASCII CHARACTERS 5 AND 6 F0700213* VOLUME NAME - ASCII CHARACTERS 7 AND 8 F0700214 EQU VINMBR(5) VOLUME NUMBER - (2 ASCII CHARACTERS) F0700215ÐÐ EQU VIBMSM(6) BEGINNING OF MANAGEABLE SPACE - MSB F0700216 EQU VIBMSL(7) BEGINNING OF MANAGEABLE SPACE - LSB F0700217 EQU VIASDM(8) AVAILABLE SPACE DIRECTORY ADDRESS - MSB F0700218 EQU VIASDL(9) AVAILABLE SPACE DIRECTORY ADDRESS - LSB F0700219 EQU VIASDS(10) # SECTORS IN AVAILABLE SPACE DIRECTORY F0700220 EQU VILBAM(11) LARGEST BLOCK OF SPACE AVAILABLE - MSB F0700221 EQU VILBAL(12) LARGEST BLOCK OF SPACE AVAILABLE - LSB F0700222 EQU VIWPS(13) WORDS/SECTOR FOR VOLUME F0700223 EQU VIFDDM(14) FILE DEFINITION DIRECTORY ADDRESS - MSB F0700224 EQU VIFDDL(15) FILE DEFINITION DIRECTORY ADDRESS - LSB F0700225 EQU VIMAXF(16) MAX. NUMBER OF FILES PERMITTED ON VOLUME F0700226 EQU VICURF(17) CURRENT NUMBER OF FILES EXISTING ON VOLUME F0700227 EQU VINFDB(18) NUMBER OF BLOCKS IN FILE DEFINITION DIRECTORY F0700228 EQU VINXTB(19) NEXT AVAILABLE BLOCK IN FILE DEF. DIRECTORY F0700229 EQU VINOOF(20) NUMBER OF OPEN FILES ON VOLUME F0700230 EJT F0700231* REQUEST PROCESSOR CONTROL TABLE F0700232* F0700233 EQU RP(10) INDEX TO START OF REQUEST PARAMETERS F0700234 EQU MR(RP+5) INDEX TO START OF MONITOR REQUEST PARAM LIST F0700235 EQU SS(MR+10) INDEX TO START OF SCRATCH PORTION OF PAR LIST F0700236* F0700237 EQU RPLOGU(1) LU NUMBER OF MM DEVICE F0700238 EQU RPAREQ(2) ACTIVE REQUEST FLAG (IF 0, NONE FOR TABLE) F0700239 EQU RPWAIT(3) START OF WAITING REQUEST QUEUE (IF 0, NO WAITGF0700240ÐÐ EQU RPRLEV(4) REQUEST PRIORITY LEVEL - ACTIVE REQUEST F0700241 EQU RPRBF4(5) REQBUF ADDRESS - FIRST FOUR WORDS F0700242 EQU RPLTEA(6) LOCK TABLE ENTRY (ABSOLUTE) ADDRESS F0700243 EQU RPRTNJ(7) RETURN JUMP TO REQUEST PROCESSOR F0700244 EQU RPPADR(8) PROCESSOR ADDRESS F0700245 SPC 1 F0700246* PARAMETER LIST FOR REQUEST PROCESSOR F0700247 EQU RPFCBA(9) FCB ADDRESS FOR FILE F0700248 EQU RPRBMP(RP+0) REQBUF ADDRESS - MAIN PART F0700249 EQU RPPFP1(RP+1) REQUEST PARAMETER ADDRESS - FIRST + 1 F0700250 EQU RPPFP2(RP+2) REQUEST PARAMETER ADDRESS - FIRST + 2 F0700251 EQU RPPFP3(RP+3) REQUEST PARAMETER ADDRESS - FIRST + 3 F0700252 EQU RPPFP4(RP+4) REQUEST PARAMETER ADDRESS - FIRST + 4 F0700253 SPC 1 F0700254* MAIN MONITOR REQUEST F0700255 EQU RPMREQ(MR+0) MONITOR REQUEST CODE WORD F0700256 EQU RPMRP1(MR+1) COMPLETION ADDRESS F0700257 EQU RPMRP2(MR+2) THREAD WORD F0700258 EQU RPMRP3(MR+3) LOGICAL UNIT FOR I/O F0700259 EQU RPMRP4(MR+4) NUMBER OF WORDS F0700260 EQU RPMRP5(MR+5) START CORE ADDRESS F0700261 EQU RPMRP6(MR+6) MASS MEMORY ADDRESS, MSB F0700262 EQU RPMRP7(MR+7) MASS MEMORY ADDRESS, LSB F0700263 EQU RPRCPT(MR+8) CONTROL POINT (FOR I/O REQUESTS) F0700264 EQU RPRETN(MR+9) SAVED RETURN ADDRESS F0700265ÐÐ* ALTERNATE COMMON NAMES F0700266 EQU REQBUF(RP+0) USERS FIRST CALL PARAMETER ADDRESS F0700267 EQU ISTAT(RP+4) USERS COMPLETION STATUS PARAMETER ADDRESS F0700268 SPC 1 F0700269 EQU RECBUF(RP+1) RECORD BUFFER PARAMETER F0700270 SPC 1 F0700271* SCRATCH FOR WRTDEL F0700272* PARAMETER LIST FOR MM I/O ROUTINE F0700273 EQU MSBBSA(SS+0) MSB OF BASE SECTOR ADDRESS F0700274 EQU LSBBSA(SS+1) LSB OF BASE SECTOR ADDRESS F0700275 EQU MSBRRN(SS+2) MSB OF RELATIVE RECORD NUMBER F0700276 EQU LSBRRN(SS+3) LSB OF RELATIVE RECORD NUMBER F0700277 EQU RCDLEN(SS+4) RECORD LENGTH - BIT 15 SET IF SECTOR ALLIGNED F0700278 EQU NUMWDS(SS+5) NUMBER OF WORDS TO READ OR WRITE F0700279 EQU OFFSET(SS+6) WORD OFFSET FROM START OF RECORD F0700280 EQU RECBFR(SS+7) ADDRESS OF BUFFER FOR I/O F0700281 EQU IOTYPE(SS+8) I/O TYPE: NON-ZERO IF FILE I/O, ELSE ZERO. F0700282* F0700283 EQU RETURN(SS+9) SAVED RETURN ADDRESS (0 IF EXECUTED BY EXEC) F0700284 EJT F0700285* F0700286MRECAD 000 0 ENTRY POINT - WILL BE NON-ZERO IF EXECUTED BY F0700287* DELETE RECORD FROM INDEXED FILE PROCESSOR F0700288 LDA* MRECAD F0700289 STA- RETURN,I SAVE RETURN ADDRESS - MAY BE 0 F0700290ÐÐ CLR A F0700291 STA* MRECAD CLEAR ENTRY POINT FOR NEXT USE F0700292* F0700293 LDQ- ISTAT,I F0700294 STA- (ZERO),Q CLEAR STATUS F0700295* F0700296* SET UP PARAMETER LIST FOR MMWRIT F0700297 STA- OFFSET,I CLEAR OFFSET F0700298* F0700299 LDQ- REQBUF,I CHECK IF ONLY ONE RECORD WAS RETRIEVED F0700300 LDA- NUMREC,Q F0700301 INA -1 F0700302 SAZ DEL05 SKIP IF YES F0700303 LDA- ZROMSK+13 GO SET ISTAT TO REFLECT ILLEGAL REQUEST F0700304 JMP* DEL30 F0700305* F0700306DEL05 LDA- RRNMSB,Q GET REL REC NO. FROM REQBUF F0700307 STA- MSBRRN,I MSB F0700308 LDA- RRNLSB,Q F0700309 STA- LSBRRN,I LSB F0700310* F0700311 SPC 2 F0700312 LDA- RECBUF,I F0700313 ENQ 1 CHECK IF THE DELETED CODE IS GOING TO OVERLAP F0700314 RTJ FMCOVL WITH OTHER PARAMETERS F0700315ÐÐ SAZ DEL08 NO, SKIP F0700316 LDA =N$A000 YES, SET ERROR BIT AND LEAVE F0700317 JMP* DEL30 F0700318* F0700319DEL08 EQU DEL08(*) F0700320 LDQ- RECBUF,I F0700321 STQ- RECBFR,I ADDR OF RECORD BUFFER F0700322 LDA =XFMRDEL WRITE THE GLOBAL DELETED CODE INTO FIRST WORD F0700323 STA- (ZERO),Q OF THE RECORD BUFFER F0700324* F0700325 LDQ- RPFCBA,I PICK UP BASE SECTOR ADDR FOR DATA F0700326 LDA- DATBAM,Q F0700327 STA- MSBBSA,I F0700328 LDA- DATBAL,Q F0700329 STA- LSBBSA,I F0700330 EJT F0700331 LDA- RECLEN,Q RECORD LENGTH F0700332 LDQ- FCBIND,Q CHECK IF SECTOR ALLIGNED F0700333 SQP DEL10 F0700334 EOR- ONEBIT+15 YES, SET BIT 15 AS SECTOR ALLIGNED FLAG F0700335* F0700336 LDQ- RPFCBA,I NO. OF WORDS TO STORE WILL BE ONE SECTOR F0700337 LDA- (FILEID),Q LONG F0700338 ARS 11 SET Q TO FILE'S MM LOGICAL UNIT F0700339 AND- ONEMSK+4 F0700340ÐÐ TRA Q F0700341 LDQ MMLUTB,Q F0700342 LDQ- VIWPS,Q F0700343 JMP* DEL20 F0700344* F0700345DEL10 ENQ 1 NO, RECORDS ARE NOT SECTOR ALLIGNED F0700346* WRITE ONE WORD AND LET DRIVER TAKES CARE OF F0700347* THE UPDATING ONE WORD IN A SECTOR F0700348DEL20 STA- RCDLEN,I RA = LENGTH OF A RECORD F0700349 STQ- NUMWDS,I RQ = NO. OF WORDS TO WRITE F0700350* F0700351 STQ- IOTYPE,I SET I/O TYPE FLAG NON-ZERO F0700352* F0700353 LDQ- I F0700354 INQ MSBBSA SET Q TO ABS ADDR OF PARAM LIST F0700355 RTJ MMWRIT WRITE RECORD F0700356 SQP DEL40 SKIP IF NO I/O ERROR F0700357 LDA =N$8020 SET REJECTED + I/O ERROR BITS F0700358 INQ 0 F0700359 SQN DEL30 SKIP IF NOT COMPUTATION ERROR F0700360 ADD- ONEBIT+14 ADD ILLEGAL REQUEST F0700361DEL30 LDQ- ISTAT,I F0700362 STA- (ZERO),Q STORE ISTAT F0700363 EJT F0700364DEL40 LDQ- REQBUF,I CHECK IF RECORD LOCKING IN EFFECT F0700365ÐÐ LDA- LOKREC,Q F0700366 SAP DEL50 SKIP IF NO F0700367 LDQ- RPLTEA,I NO I/O ERROR, REMOVE LOCK ENTRY FROM TABLE F0700368 RTJ REMLOK RQ = RECORD LOCK ENTRY F0700369DEL50 LDQ- RETURN,I CHECK IF CALLED BY EXEC F0700370 SQZ DEL60 F0700371 JMP- (ZERO),Q RETURN TO DELETE RECORD FROM INDEXED FILE PROCF0700372* F0700373DEL60 JMP FMCOMP RETURN TO EXEC F0700374 END F0700375 NAM COMSEQ F08 A ITOS CCS 3.0 SL-149F0800001* COMPRESS FILE TO REMOVE DELETED RECORDS F0800002* CREDIT COLLECTION SYSTEM VERSION 3.0 F0800003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F0800004* COPYRIGHT CONTROL DATA CORPORATION 1979 F0800005* F0800006* F0800007**** F0800008* COMSEQ IS THE REQUEST PROCESSOR FOR THE COMPRESS SEQUENTIAL FILE F0800009* REQUEST. IT IS ALSO USED AS A SUBROUTINE BY THE COMPRESS INDEXEDF0800010* FILE PROCESSOR. THE COMFIL REQUEST HAS THE FOLLOWING CALLING F0800011* SEQUENCE: F0800012* F0800013* CALL COMFIL (REQBUF, RECBUF, ISTAT) F0800014* F0800015ÐÐ* WHERE REQBUF IS THE FILE REQUEST BUFFER F0800016* F0800017* RECBUF IS THE RECORD BUFFER LONG ENOUGH TO HOLD N F0800018* RECORDS + 4 WORDS (N IS DEFINED IN IDATA(14) IN F0800019* OPENFL REQUEST) AND F0800020* F0800021* ISTAT IS THE FILE REQUEST STATUS WORD. F0800022 SPC 3 F0800023* WHEN A FILE IS CREATED, A FIXED AMOUNT OF MASS MEMORY F0800024* SPACE IS ALLOCATED FOR STORING THE DATA. IF THE SPACE F0800025* IS USED IN STORING A RECORD BUT THE RECORD IS DELETED F0800026* LATER, THE SPACE ON MASS MEMORY IS NOT USED AGAIN FOR F0800027* STORING ANOTHER RECORD. F0800028* F0800029* AFTER SOME HEAVY USE OF THE FILE, IT MAY CONTAIN MANY F0800030* RECORD SPACES WITH DELETED RECORDS. TO REUSE THESE SPACES F0800031* A COMPRESS FILE REQUEST CAN BE USED. F0800032* F0800033* F0800034* THE FILE HAS TO BE OPENED FOR COMPRESSION. THE COMPRESS F0800035* FILE REQUEST SHOULD BE CALLED REPEATEDLY UNTIL AN EOF F0800036* INDICATOR IS RETURNED BY THE FILE MANAGER. THE ONLY F0800037* RECORDS IN THE FILE WILL BE UNDELETED RECORDS RESIDING F0800038* AT THE BEGINNING OF THE DATA AREA. THE REST OF THE F0800039* SPACE CAN BE USED FOR STORING NEW RECORDS. F0800040ÐÐ*E F0800041* IF THE FILE TO BE COMPRESSED IS AN INDEXED FILE, THE F0800042* KEY INFO DIRECTORY SPACE ON MASS MEMORY IS INITIALIZED F0800043* AT OPEN TIME. AS RECORDS ARE COMPRESSED, THE KEY IS F0800044* BUILT. F0800045* F0800046* F0800047* THE FILE IS AUTOMATICALLY LOCKED WHEN AN OPEN FOR COMPRESS F0800048* IS REQUESTED. DURING A COMPRESS, THE USER CANNOT DO F0800049* ANY REQUEST TO THE FILE OTHER THAN COMFIL. WHEN THE F0800050* COMPRESS IS DONE (EOF INDICATOR RETURNED) THE USER MUST F0800051* CLOSE THE FILE. F0800052* F0800053* A RECOVERY SYSTEM IS BUILT IN DURING THE COMPRESS. THIS F0800054* IS IN CASE A SYSTEM FAILURE OCCURS DURING THE COMPRESS, F0800055* THE FILE MANAGER CAN RECOVER TO THE SITUATION AT THE F0800056* FAILURE - KNOW THE NO. OF NEW RECORDS AND THE LAST 'OLD' F0800057* RECORD BEING PROCESSED. THE RECOVERY IS DONE ON THE F0800058* NEXT OPEN FOR COMPRESS REQUEST. F0800059* F0800060* IN FACT, IF A SYSTEM FAILURE OCCURS DURING A COMPRESS, F0800061* A USER CANNOT OPEN THE FILE OTHER THAN FOR COMPRESS, F0800062* AND MUST FINISH THE COMPRESS BEFORE ANYTHING ELSE CAN F0800063* BE DONE. F0800064* F0800065ÐÐ* F0800066* WHEN COMSEQ IS EXECUTED BY THE EXEC TO COMPRESS A SEQUENTIAL FILEF0800067* A JUMP IS MADE TO COMSEQ+1. WHEN COMSEQ IS EXECUTED AS A SUB- F0800068* ROUTINE, A RETURN JUMP IS MADE TO COMSEQ. COMSEQ COMPLETES F0800069* EXECUTION BY JUMPING TO FMCOMP IF EXECUTED BY THE EXEC OR BY F0800070* RETURNING TO THE CALLER IF EXECUTED AS A SUBROUTINE. F0800071 SPC 5 F0800072* ENTRY POINT F0800073* F0800074* F0800075 ENT COMSEQ ENTRY POINT F0800076* F0800077* F0800078* EXTERNALS F0800079* F0800080 EXT CLFRIO COMPUTE LENGTH FOR RECORD I/O 136*A001F0800081 EXT CLFRIO COMPUTE LENGTH FOR RECORD I/O F0800082 EXT DWSUB DOUBLE WORD SUBTRACT ROUTINE F0800083 EXT FMCHKO CHECK IF FILE STILL OK F0800084 EXT FMBRRN BUMP RELATIVE RECORD NUMBER BY ONE 121*4623F0800085 EXT FMCOMP EXEC'S COMPLETE REQUEST ENTRY FOR REENT, PROCSF0800086 EXT MMWRIT WRITE ON MASS MEMORY F0800087 EXT READRC READ RECORD(S) F0800088 SPC 2 F0800089 EXT FMEOFC CODE FOR EOF F0800090ÐÐ EXT FMNRCD NO. OF NEW RECORDS BEFORE UPDATE OF FCB F0800091 EXT FMRDEL RECORD DELETED CODE F0800092 EXT MMLUTB M M LOGICAL UNIT TABLE F0800093**** F0800094 EJT F0800095* EQUIVALENCES F0800096 SPC 2 F0800097* COMMUNICATION REGION CONSTANTS F0800098 EQU ZERO(2) ZERO CONSTANT F0800099 EQU ONEMSK(3) ONE MASK TABLE F0800100 EQU ZROMSK($13) ZERO MASK TABLE F0800101 EQU ONEBIT($23) ONE BIT TABLE F0800102 EQU ZROBIT($33) ZERO BIT TABLE F0800103 SPC 1 F0800104* UCT ENTRY EQUIVALENCES F0800105 EQU UIDENT(ZERO) USER IDENTIFICATION F0800106 EQU FIDENT(1) PSEUDO FILE IDENTIFIER F0800107 EQU FCBCAD(2) FCB CORE ADDRESS F0800108 EQU FSLADR(3) FILE SPACE LIMITS TABLE ENTRY ADDRESS F0800109 EQU FCBSAD(4) FCB SUBSET ADDRESS F0800110 EQU USRCPT(5) USERS CONTROL POINT F0800111 EJT F0800112* REQUEST BUFFER INDEXES - FIRST 4 WORDS F0800113 EQU RBATHR(0) REQUEST BUFFER ADDRESS THREAD F0800114 EQU BUFAMP(1) BUFFER ADDRESS MAIN PART F0800115ÐÐ EQU CNTLPT(2) CONTROL POINT (OR SPARE) F0800116 EQU RQINFO(3) REQUEST INFORMATION (MULTI-FIELD) F0800117* BITS USE F0800118* 15-12 SPARE F0800119* 11-04 REQUEST INDEX F0800120* 03-00 LEVEL OF REQUESTOR F0800121* F0800122* REQUEST BUFFER INDEXES - MAIN PART F0800123 EQU QREG(0) Q REGISTER F0800124 EQU IREG(1) I REGISTER F0800125 EQU PARLST(2) ADDRESS OF PARAMETER LIST F0800126 EQU RTNADR(2) RETURN ADDRESS TO USER (UPON RETURN FROM EXEC)F0800127 EQU UCTADR(3) UCT ENTRY ABSOLUTE ADDRESS F0800128 EQU USERID(4) USER IDENTIFIER F0800129 EQU FCBADR(5) FCB ADDRESS (MAY BE SET BY CALLER OR INTCPTR.)F0800130 EQU RADINT(6) RETURN ADDRESS TO INTERCEPTOR F0800131 EQU RPIDX(7) REQUEST PROCESSOR INDEX F0800132* BITS 14-00 REQUEST PROCESSOR INDEX F0800133* BIT 15 TYPE OF PROCESSOR F0800134* =0, SERIAL PROCESSOR F0800135* =1, REENTRANT PROCESSOR F0800136 EQU LOKREC(8) NUMBER OF RECORDS TO BE READ/WRITTEN PER I/O F0800137* CALL AND LOCK RECORDS ON RETRIEVE FLAG F0800138* BITS 14-00 NUMBER OF RECORDS PER CALL F0800139* BIT 15 =0, DO NOT LOCK ON RETRIEVE F0800140ÐÐ* =1, LOCK RECORDS ON RETRIEVE F0800141 EQU USEFLG(9) TYPE OF FILE USE FLAG F0800142* -1, OPEN FOR COMPRESSION F0800143* -2, OPEN FOR SPECIAL PROCESSING F0800144* 0, OPEN FOR ACESS VIA REL REC NO F0800145* 1, OPEN FOR RETRIEVAL VIA KEY 1 F0800146* 2, OPEN FOR RETRIEVAL VIA KEY 2 F0800147* 3, OPEN FOR RETRIEVAL VIA KEY 3 F0800148* 4, OPEN FOR RETRIEVAL VIA KEY 4 F0800149* F0800150* INTERFACE TO WRTBCK, MRECAD F0800151* OUTPUT FROM READRC F0800152* F0800153 EQU NUMREC(10) NO. OF RECORDS ACTUALLY READ/ WRITE F0800154 EQU RRNMSB(11) RRN - MSB F0800155 EQU RRNLSB(12) RRN - LSB F0800156 EQU SAVREC(15) NO. OF RECORDS ACTUALLY READ F0800157* F0800158* SCRATCH FOR COMSEQ F0800159* F0800160 EQU PRCRNM(16) RRN OF LAST PROCESSED RECORD, MSB F0800161 EQU PRCRNL(17) RRN OF LAST PROCESSED RECORD, LSB F0800162 EQU NETRNM(18) RRN OF THE LATEST 'NEW' RECORD - MSB F0800163 EQU NETRNL(19) RRN OF THE LATEST 'NEW' RECORD - LSB F0800164 EQU RMPLEN(20) LENGTH OF REQBUF MAIN PART F0800165ÐÐ EJT F0800166* VOLUME INFORMATION TABLE F0800167* F0800168 EQU VISLUN(2) SYSTEM LOGICAL UNIT NUMBER (BIT 15=1,NOT READYF0800169* ACCESS VISLUN INDIRECTLY F0800170 EQU VINAME(1) VOLUME NAME - ASCII CHARACTERS 1 AND 2 F0800171* VOLUME NAME - ASCII CHARACTERS 3 AND 4 F0800172* VOLUME NAME - ASCII CHARACTERS 5 AND 6 F0800173* VOLUME NAME - ASCII CHARACTERS 7 AND 8 F0800174 EQU VINMBR(5) VOLUME NUMBER - (2 ASCII CHARACTERS) F0800175 EQU VIBMSM(6) BEGINNING OF MANAGEABLE SPACE - MSB F0800176 EQU VIBMSL(7) BEGINNING OF MANAGEABLE SPACE - LSB F0800177 EQU VIASDM(8) AVAILABLE SPACE DIRECTORY ADDRESS - MSB F0800178 EQU VIASDL(9) AVAILABLE SPACE DIRECTORY ADDRESS - LSB F0800179 EQU VIASDS(10) # SECTORS IN AVAILABLE SPACE DIRECTORY F0800180 EQU VILBAM(11) LARGEST BLOCK OF SPACE AVAILABLE - MSB F0800181 EQU VILBAL(12) LARGEST BLOCK OF SPACE AVAILABLE - LSB F0800182 EQU VIWPS(13) WORDS/SECTOR FOR VOLUME F0800183 EQU VIFDDM(14) FILE DEFINITION DIRECTORY ADDRESS - MSB F0800184 EQU VIFDDL(15) FILE DEFINITION DIRECTORY ADDRESS - LSB F0800185 EQU VIMAXF(16) MAX. NUMBER OF FILES PERMITTED ON VOLUME F0800186 EQU VICURF(17) CURRENT NUMBER OF FILES EXISTING ON VOLUME F0800187 EQU VINFDB(18) NUMBER OF BLOCKS IN FILE DEFINITION DIRECTORY F0800188 EQU VINXTB(19) NEXT AVAILABLE BLOCK IF FILE DEF. DIRECTORY F0800189 EQU VINOOF(20) NUMBER OF OPEN FILES ON VOLUME F0800190ÐÐ EJT F0800191* FILE CONTROL BLOCK EQUIVALENCES F0800192 EQU FH(4) LENGTH -1 OF FCB HEADER F0800193 EQU FILEID(ZERO) FILE IDENTIFIER F0800194* ACCESS FILEID INDIRECTLY F0800195* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBERF0800196* BITS 10-00 INDEX OF FCB IN FCB TABLE F0800197 EQU FCBFLG(1) FCB FLAGS F0800198* BITS 15-8, SPARE F0800199* BITS 7-00, NUMBER OF USERS USING FILE F0800200 EQU FILOCK(2) FILE LOCK FLAG (IF NON-0, CONTAINS USER ID) F0800201 EQU NUMSET(3) NUMBER OF SETS OF LOCKED RECORDS IN FILE F0800202 EQU NUMNEW(4) NUMBER OF NEW RECORDS SINCE FCB UPDATED ON MM F0800203 SPC 1 F0800204 EQU RECLEN(FH+1) RECORD LENGTH IN WORDS F0800205 EQU TDATRM(FH+2) TOTAL NUMBER OF DATA RECORDS, MSB F0800206 EQU TDATRL(FH+3) TOTAL NUMBER OF DATA RECORDS, LSB F0800207 EQU DATBAM(FH+4) DATA RECORDS BEGINNING SECTOR ADDRESS, MSB F0800208 EQU DATBAL(FH+5) DATA RECORDS BEGINNING SECTOR ADDRESS,LMSB F0800209 EQU FCBIND(FH+6) FCB INDICATORS F0800210* BIT 15 , SECTOR ALLIGNED RECORDS IF =1 F0800211* BIT 14 , STORAGE MODE FOR INDEXED FILE F0800212* =0, RECORDS STORED RANDOMLY WITHF0800213* RESPECT TO PRIMARY KEY F0800214* =1, RECORDS STORED IN ORDER WIT F0800215ÐÐ* RESPECT TO PRIMARY KEY F0800216* BIT 13 , =1, FILE IS CURRENTLY OPEN F0800217* =0, FILE IS CURRENTLY CLOSED F0800218* BIT 12 , =1, FILE IS BEING COMPRESSED F0800219* =0, FILE IS NOT BEING COMPRESSEDF0800220* BIT 11 , =1, FILE IS OPEN FOR SPECIAL F0800221* PROCESSING F0800222* =0, FILE IS NOT OPEN FOR SPECIALF0800223* PROCESSING F0800224* BIT 8 , =1, RECORDS CONTAIN BINARY DATA F0800225* =0, RECORDS DO NOT CONTAIN F0800226* BINARY DATA F0800227* BIT 0 , FILE TYPE F0800228* =0, SEQUENTIAL FILE F0800229* =1, INDEXED FILE F0800230 EQU NEDATM(FH+7) NUMBER OF EXISTING DATA RECORDS, MSB F0800231 EQU NEDATL(FH+8) NUMBER OF EXISTING DATA RECORDS, LSB F0800232 EQU SEQLTH(NEDATL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F0800233* OF FCB FOR A SEQUENTIAL FILE F0800234 SPC 1 F0800235 EQU NEXTBM(FH+9) NEXT FREE KEY INDEX BLOCK, MSB F0800236 EQU NEXTBL(FH+10) NEXT FREE KEY INDEX BLOCK, LSB F0800237 EQU TNKEYM(FH+11) TOTAL NUMBER OF KEY INDEX BLOCKS, MSB F0800238 EQU TNKEYL(FH+12) TOTAL NUMBER OF KEY INDEX BLOCKS, LSB F0800239 EQU KEYBAM(FH+13) KEY INDEX BEGINNING SECTOR ADDRESS, MSB F0800240ÐÐ EQU KEYBAL(FH+14) KEY INDEX BEGINNING SECTOR ADDRESS, LSB F0800241 EQU LENKY1(FH+15) LENGTH OF KEY NO. 1 F0800242 EQU POSKY1(FH+16) BYTE POSITION OF KEY NO. 1 F0800243 EQU LENKY2(FH+17) LENGTH OF KEY NO. 2 F0800244 EQU POSKY2(FH+18) BYTE POSITION OF KEY NO. 2 F0800245 EQU LENKY3(FH+19) LENGTH OF KEY NO. 3 F0800246 EQU POSKY3(FH+20) BYTE POSITION OF KEY NO. 3 F0800247 EQU LENKY4(FH+21) LENGTH OF KEY NO. 4 F0800248 EQU POSKY4(FH+22) BYTE POSITION OF KEY NO. 4 F0800249 EQU INDLEN(POSKY4-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F0800250* OF FCB FOR AN INDEXED FILE F0800251 EJT F0800252* THE FOLLOWING PORTION OF THE FCB EXISTS ONLY F0800253* ON MASS MEMORY. THESE 10 WORDS ARE NOT LOADEDF0800254* INTO EITHER OF THE FILE MANAGER CONTROLLED FCBF0800255* TABLES. F0800256 EQU TSFILM(FH+23) TOTAL NUMBER OF SECTORS IN FILE, MSB F0800257 EQU TSFILL(FH+24) TOTAL NUMBER OF SECTORS IN FILE, LSB F0800258 EQU NAME12(FH+25) FILE NAME, CHARACTERS 1 AND 2 F0800259 EQU NAME34(FH+26) FILE NAME, CHARACTERS 3 AND 4 F0800260 EQU NAME56(FH+27) FILE NAME, CHARACTERS 5 AND 6 F0800261 EQU NAME78(FH+28) FILE NAME, CHARACTERS 7 AND 8 F0800262 EQU OWNR12(FH+29) OWNER NAME, CHARACTERS 1 AND 2 F0800263 EQU OWNR34(FH+30) OWNER NAME, CHARACTERS 3 AND 4 F0800264 EQU OWNR56(FH+31) OWNER NAME, CHARACTERS 5 AND 6 F0800265ÐÐ EQU OWNR78(FH+32) OWNER NAME, CHARACTERS 7 AND 8 F0800266 EQU BYTLEN(FH+33) BYTE LENGTH OF RECORD F0800267* F0800268* FOR COMPRESS ONLY F0800269* F0800270 EQU PRSRNM(FH+34) RRN OF LAST PROCESSED RECORD - MSB F0800271 EQU PRSRNL(FH+35) RRN OF LAST PROCESSED RECORD - LSB F0800272 EQU NEWRNM(FH+36) RRN OF THE LATEST 'NEW' RECORD - MSB F0800273 EQU NEWRNL(FH+37) RRN OF THE LATEST 'NEW' RECORD - LSB F0800274 SPC 4 F0800275* WORDS 0 THRU 4 OF THE FCB HEADER AND WORDS F0800276* 6 THRU 10 OF THE FCB ARE REFERRED TO AS THE F0800277* SHARED SUBSET OF THE FCB. THEY INCLUDE THE F0800278* ONLY FCB WORDS THAT CAN BE MODIFIED AFTER FILEF0800279* CREATION. IF TWO OR MORE USERS HAVE THE SAME F0800280* FILE OPEN, THERE HAS TO BE A SINGLE MASTER F0800281* COPY OF THE SUBSET THAT RECEIVES (AND RECORDS)F0800282* ALL OF THE UPDATES. THE CONTROLLED SUBSET F0800283* WILL ALWAYS BE PART OF A MAIN MEMORY RESIDENT F0800284* FCB IF THE FCB IS IN A FM CONTROLLED TABLE. F0800285* IF THE FCB IS IN USER SPACE, THE SUBSET MAY ATF0800286* TIMES RESIDE IN THE SUBSET CONTROL TABLE. F0800287 SPC 2 F0800288* ALTERNATE NAMES FOR SUBSET WORDS F0800289 EQU SAFCBI(FH+1) SUBSET ALTERNATE NAME FOR FCBIND F0800290ÐÐ EQU SADATM(FH+2) SUBSET ALTERNATE NAME FOR NEDATM F0800291 EQU SADATL(FH+3) SUBSET ALTERNATE NAME FOR NEDATL F0800292 EQU SANXTM(FH+4) SUBSET ALTERNATE NAME FOR NEXTBM F0800293 EQU SANXTL(FH+5) SUBSET ALTERNATE NAME FOR NEXTBL F0800294* F0800295 EJT F0800296* REQUEST PROCESSOR CONTROL TABLE F0800297* F0800298 EQU RP(10) INDEX TO START OF REQUEST PARAMETERS F0800299 EQU MR(RP+5) INDEX TO START OF MONITOR REQUEST PARAM LIST F0800300 EQU SS(MR+10) INDEX TO START OF SCRATCH PORTION OF PAR LIST F0800301* F0800302 EQU RPLOGU(1) LU NUMBER OF MM DEVICE F0800303 EQU RPAREQ(2) ACTIVE REQUEST FLAG (IF 0, NONE FOR TABLE) F0800304 EQU RPWAIT(3) START OF WAITING REQUEST QUEUE (IF 0, NO WAITGF0800305 EQU RPRLEV(4) REQUEST PRIORITY LEVEL - ACTIVE REQUEST F0800306 EQU RPRBF4(5) REQBUF ADDRESS - FIRST FOUR WORDS F0800307 EQU RPLTEA(6) LOCK TABLE ENTRY (ABSOLUTE) ADDRESS F0800308 EQU RPRTNJ(7) RETURN JUMP TO REQUEST PROCESSOR F0800309 EQU RPPADR(8) PROCESSOR ADDRESS F0800310 SPC 1 F0800311* PARAMETER LIST FOR REQUEST PROCESSOR F0800312 EQU RPFCBA(9) FCB ADDRESS FOR FILE F0800313 EQU RPRBMP(RP+0) REQBUF ADDRESS - MAIN PART F0800314 EQU RPPFP1(RP+1) REQUEST PARAMETER ADDRESS - FIRST + 1 F0800315ÐÐ EQU RPPFP2(RP+2) REQUEST PARAMETER ADDRESS - FIRST + 2 F0800316 EQU RPPFP3(RP+3) REQUEST PARAMETER ADDRESS - FIRST + 3 F0800317 EQU RPPFP4(RP+4) REQUEST PARAMETER ADDRESS - FIRST + 4 F0800318 SPC 1 F0800319* MAIN MONITOR REQUEST F0800320 EQU RPMREQ(MR+0) MONITOR REQUEST CODE WORD F0800321 EQU RPMRP1(MR+1) COMPLETION ADDRESS F0800322 EQU RPMRP2(MR+2) THREAD WORD F0800323 EQU RPMRP3(MR+3) LOGICAL UNIT FOR I/O F0800324 EQU RPMRP4(MR+4) NUMBER OF WORDS F0800325 EQU RPMRP5(MR+5) START CORE ADDRESS F0800326 EQU RPMRP6(MR+6) MASS MEMORY ADDRESS, MSB F0800327 EQU RPMRP7(MR+7) MASS MEMORY ADDRESS, LSB F0800328 EQU RPRCPT(MR+8) CONTROL POINT (FOR I/O REQUESTS) F0800329 EQU RPRETN(MR+9) SAVED RETURN ADDRESS F0800330* ALTERNATE COMMON NAMES F0800331 EQU REQBUF(RP+0) USERS FIRST CALL PARAMETER ADDRESS F0800332 EQU RECBUF(RP+1) RECORD BUFFER PARAMETER - FOR COMSEQ F0800333 EQU ISTAT(RP+4) USERS COMPLETION STATUS PARAMETER ADDRESS F0800334* INTERFACE TO READRC F0800335* F0800336 EQU REDBFA(SS+0) BUFFER ADDR FOR RECORD F0800337 EQU RELRNM(SS+1) RRN - MSB F0800338 EQU RELRNL(SS+2) RRN - LSB F0800339 EQU NORECS(SS+3) NO. OF RECORDS TO BE READ F0800340ÐÐ SPC 3 F0800341* SCRATCH FOR COMSEQ F0800342* F0800343 EQU LASTWD(SS+2) LAST WORD FOR MOVE F0800344* F0800345* PARAMETER LIST FOR DW SUB F0800346* F0800347 EQU DWSUB1(SS+3) F0800348 EQU DWSUB2(SS+4) F0800349 EQU DWSUB3(SS+5) F0800350 EQU DWSUB4(SS+6) F0800351 EQU DWSUB5(SS+7) F0800352 EQU DWSUB6(SS+8) F0800353* F0800354 EQU COMFLG(SS+9) F0800355* F0800356* 1 CARD DELETED 136*A001F0800357* F0800358 EQU RECLNG(SS+10) NO. OF WORDS IN ONE RECORD F0800359* 1 CARD DELETED 136*A001F0800360 EQU REDBUF(SS+11) ADDR OF RECORD BEING CHECKED F0800361 EQU CURDEL(SS+12) NO. OF DELETED RECORDS FOUND F0800362 EQU STARTI(SS+13) INDEX OF RECORD BEING CHECKED F0800363 EQU GOODRC(SS+13) NO. OF GOOD RECORDS FOUND F0800364 EQU UPDATE(SS+14) UPDATE FCB BECUASE NOT ENOUGH SPACE TO WRITE F0800365ÐÐ* MARKER F0800366 EQU COMRTN(SS+15) RETURN ADDR FOR COMSEQ F0800367 SPC 3 F0800368* SCRATCH FOR UPDATING FCB ON MM F0800369* ALSO USED TO WRITE RECORDS BACK TO MM 136*A001F0800370* F0800371 EQU MSBBSA(SS+0) MSB OF BAS SECTOR ADDRESS F0800372 EQU LSBBSA(SS+1) LSB OF BAS SECTOR ADDRESS F0800373 EQU RRNHIW(SS+2) MSB OF RELATIVE RECORD NUMBER F0800374 EQU RRNLOW(SS+3) LSB OF RELATIVE RECORD NUMBER F0800375 EQU FCBLEN(SS+4) FCB RECORD LENGTH F0800376 EQU WRTLEN(SS+5) NO. OF WORDS TO WRITE F0800377 EQU OFFSET(SS+6) OFFSET IN FCB - 0 F0800378 EQU ADRFSS(SS+7) ADDR OF RRN OF PROCESSED IN REQBUF F0800379 EQU IOTYPE(SS+8) T/O TYPE - 0 F0800380 EJT 0 F0800381COMSEQ 000 0 ENTRY POINT - WILL BE NON-ZERO IF EXECUTED AS F0800382* A SUBROUTINE F0800383 LDA* COMSEQ F0800384 STA- COMRTN,I SAVE RETURN ADDRESS - MAY BE 0 F0800385 CLR A F0800386 STA* COMSEQ CLEAR ENTRY POINT FOR NEXT USE F0800387 SPC 5 F0800388 LDQ- REQBUF,I F0800389 LDA- LOKREC,Q GET NO. OF RECORDS TO READ FROM REQUEST BUFFERF0800390ÐÐ* F0800391 STA- NORECS,I = NO. OF RECORDS TO READ F0800392 LDA- PRCRNL,Q RRN FOR THE FIRST RECORD TO READ IS THE RRN F0800393 LDQ- PRCRNM,Q OF THE LAST PROCESSED + 1 F0800394 RTJ* (BUMPIT) BUMP RRN 121*4623F0800395 STA- RELRNL,I 121*4623F0800396 STQ- RELRNM,I F0800397* F0800398* F0800399 LDA- RECBUF,I ADDR OF RECORD BUFFER TO READ TO F0800400 STA- REDBFA,I F0800401* F0800402 RTJ READRC READ IN THE REQUESTED RECORD(S) F0800403 SPC 5 F0800404 LDQ- REQBUF,I F0800405 RTJ FMCHKO CHECK IF FILE IS STILL GOOD F0800406 SAZ COM33 YES F0800407* THE FILE HAS BEEN CLOSED BY EXEC F0800408 JMP COM153 SET ERROR BIT AND LEAVE F0800409 SPC 2 F0800410COM33 EQU COM33(*) FILE IS STILL GOOD F0800411 LDA- NUMREC,Q NO. OF RECORDS ACTUALLY READ IS IN NUMREC F0800412 SAN COM50 SEE IF IT IS ZERO F0800413* F0800414 LDQ- ISTAT,I IT IS ZERO, NO RECORD WAS READ F0800415ÐÐ LDA- (ZERO),Q F0800416 AND- ONEBIT+8 LOOK FOR THE EOF INDICATOR IN ISTAT F0800417 SAN COM40 F0800418COM35 JMP COM390 NO RECORD WAS READ DUE TO SOME FATAL REASON F0800419* OTHER THAN EOF , LEAVE F0800420COM40 EQU COM40(*) EOF REACHED F0800421* WRITE LAST EOF'S AFTER THE LAST RECORDS F0800422 LDA- (ZERO),Q CLEAR ERROR BIT, IF ANY F0800423 AND- ONEMSK+14 F0800424 STA- (ZERO),Q F0800425* F0800426 CLR A F0800427 STA- GOODRC,I NO GOOD RECORDS FOUND F0800428 LDQ- REQBUF,I F0800429 STA- NUMREC,Q GO TO WRITE EOF F0800430 JMP* COM150 F0800431 SPC 5 F0800432COM50 STA- CURDEL,I SOME RECORDS WERE READ, F0800433COM60 LDA- CURDEL,I ADD IT TO THE RRN OF RECORDS PROCESSED TO F0800434 SAZ COM80 GET NEW NO. OF PROCESSED F0800435 INA -1 CURDEL IS USED AS AN INDEX, WILL BE ZERO OUTF0800436 STA- CURDEL,I F0800437 LDA- PRCRNL,Q F0800438 LDQ- PRCRNM,Q 121*4623F0800439 RTJ* (BUMPIT) BUMP RRN BY 1 121*4623F0800440ÐÐ STQ* SAVEQ SAVE MSB 121*4623F0800441 LDQ- REQBUF,I RESET Q TO REQBUF ADDRESS 121*4623F0800442 STA- PRCRNL,Q STORE LSB 121*4623F0800443 LDA* SAVEQ 121*4623F0800444 STA- PRCRNM,Q STORE MSB 121*4623F0800445 JMP* COM60 F0800446 SPC 3 F0800447 EJT 0 F0800448COM80 EQU COM80(*) F0800449* LOOK AT EACH RECORD READ THIS TIME, SEE IF F0800450* ANY OF THEM ARE DELETED F0800451 SPC 2 F0800452 LDQ- ISTAT,I SEE IF ANY RECORD HAS BEEN DELETED F0800453 LDA- (ZERO),Q STATUS BIT IS SET BY READR F0800454 AND- ONEBIT+4 F0800455 SAN COM82 F0800456 LDQ- REQBUF,I F0800457 JMP* COM140 ALL RECORD(S) READ ARE GOOD F0800458* F0800459COM82 EQU COM82(*) F0800460 LDA- (ZERO),Q YES, LOOK FOR THE RECORD(S) DELETED F0800461 AND- ZROBIT+4 CLEAR THIS BIT FROM THE STATUS F0800462 STA- (ZERO),Q F0800463 SPC 2 F0800464 ENA 1 F0800465ÐÐ STA- STARTI,I INITIALIZE TO START FROM RECORD NO. 1 F0800466 RTJ* (CMPRLG) F0800467 STA- RECLNG,I NO. OF WORDS PER RECORD F0800468 LDA- RECBUF,I REDBUF IS THE ABSOLUTE ADDR OF THE RECORD F0800469 STA- REDBUF,I BEING CHECKED F0800470* WHILE THERE ARE MORE RECORDS TO LOOK AT DO F0800471COM85 EQU COM85(*) F0800472 LDQ- REQBUF,I F0800473 LDA- NUMREC,Q (STARTI POINTS TO THE CURRENT RECORD BEINGF0800474 SUB- STARTI,I LOOKED AT) F0800475 SAP COM90 F0800476 JMP* COM140 F0800477* F0800478COM90 LDQ- REDBUF,I REDBUF IS THE ABSOLUTE ADDR OF THE RECORD F0800479 LDA- (ZERO),Q TO CHECK F0800480 EOR =XFMRDEL F0800481 SAZ COM93 F0800482 JMP* COM120 F0800483 SPC 3 F0800484 EJT 0 F0800485* RECORD IS DELETED F0800486COM93 EQU COM93(*) F0800487 RAO- CURDEL,I INCREMENT COUNT OF NO. OF DELETED F0800488* F0800489 LDQ- REQBUF,I F0800490ÐÐ LDA- NUMREC,Q IF THIS IS NOT THE LAST RECORD THEN F0800491 SUB- STARTI,I MOVE ALL RECORDS FROM THE NEXT ONE TO F0800492 SAN COM95 THE LAST, ONE RECORD POSITION TO THE F0800493 JMP* COM110 LEFT. F0800494* F0800495COM95 LDA- NUMREC,Q THUS ERASING THE DELETED RECORD FROM F0800496* THE BUFFER. F0800497 RTJ* (CMPRLG) F0800498 ADD- RECBUF,I F0800499 INA 1 F0800500 STA- LASTWD,I THIS IS THE LAST WORD TO MOVE PLUS ONE F0800501 LDQ- RECLNG,I F0800502 ADQ- REDBUF,I START MOVING FROM NEXT RECORD F0800503* F0800504COM100 LDA- LASTWD,I SEE IF ALL DONE WITH MOVING F0800505 EAQ A F0800506 SAZ COM110 F0800507 LDA- (ZERO),Q MORE TO GO, Q HAS ABSOLUTE ADDR TO READ F0800508 TCQ Q F0800509 ADQ- RECLNG,I F0800510 TCQ Q F0800511 STA- (ZERO),Q WRITE IN ONE RECORD LOCATION BEFORE F0800512 ADQ- RECLNG,I F0800513 INQ 1 RQ POINTS TO THE NEXT WORD TO READ F0800514 JMP* COM100 F0800515ÐÐCOM110 EQU COM110(*) DONE WITH MOVING F0800516 JMP* COM130 DO NOT MOVE NEXT RECORD TO CHECK F0800517 SPC 5 F0800518CMPRLG ADC CLFRIO COMPUTE RECORD LENGTH ROUTINE F0800519SUB2WD ADC DWSUB DOUBLE WORD SUBTRACT F0800520BUMPIT ADC FMBRRN BUMP RRN BY ONE 121*4623F0800521* 121*4623F0800522SAVEQ NUM 0 SAVED Q-REG 121*4623F0800523 EJT 0 F0800524COM120 EQU COM120(*) THE RECORD IS NOT DELETED F0800525 LDA- REDBUF,I MOVE TO NEXT RECORD IN BUFFER F0800526 ADD- RECLNG,I F0800527 STA- REDBUF,I F0800528 SPC 5 F0800529COM130 RAO- STARTI,I INCREMENT RECORD COUNTER BY ONE F0800530 JMP* COM85 ENDWHILE (ALL RECORDS HAVE BEEN CHECKED) F0800531 EJT 0 F0800532COM140 EQU COM140(*) F0800533* RECBUF CONTAINS GOOD RECORDS TO BE WRITTEN F0800534* BACK TO THE DATA AREA F0800535 CLR A CLEAR UPDATE FCB FLAG BECUASE OF NOT F0800536 STA- UPDATE,I ENOUGH SPACE TO WRITE MARKER F0800537 LDA- NUMREC,Q NO. OF GOOD RECORDS FOUND THIS TIME F0800538 SUB- CURDEL,I = TOTAL READ - DELETED F0800539 STA- GOODRC,I F0800540ÐÐ STA- NUMREC,Q NO. OF RECORDS TO WRITE BACK F0800541 SAZ COM142 F0800542 JMP* COM150 F0800543* NO GOOD RECORDS FOUND, DROP ON FLOOR F0800544* SEE IF ALL RECORDS IN FILE ARE PROCESSED F0800545COM142 LDA- PRCRNM,Q F0800546 STA- DWSUB1,I SAVE MSB FOR RRN OF PROCESSED F0800547 LDA- PRCRNL,Q F0800548 LDQ- RPFCBA,I F0800549 EOR- NEDATL,Q COMPARE RRN PROCESSED WITH RRN OF LAST RECORD F0800550 SAZ COM145 IN FILE F0800551 JMP* COM146 NOT DONE WITH ALL RECORDS F0800552* F0800553COM145 LDA- NEDATM,Q F0800554 EOR- DWSUB1,I F0800555 SAZ COM147 F0800556COM146 JMP COM350 NOT DONE WITH ALL RECORDS F0800557COM147 EQU COM147(*) F0800558 LDQ- ISTAT,I SET EOF BIT IN STATUS WORD F0800559 LDA- (ZERO),Q F0800560 AND- ZROBIT+8 WRITE EOF'S AT EOF OF GOOD RECORDS F0800561 EOR- ONEBIT+8 F0800562 STA- (ZERO),Q F0800563* F0800564COM150 EQU COM150(*) NEED TO WRITE BACK RECORDS F0800565ÐÐ* F0800566* F0800567 LDA- GOODRC,I F0800568 RTJ* (CMPRLG) F0800569 ADD- RECBUF,I F0800570 STA- LASTWD,I THIS IS THE LOCATION WHERE THE MARKER WILL GO F0800571* SEE IF THERE IS ENOUGH SPACE TO WRITE F0800572* MARKER IN CASE THE SYSTEM WENT DOWN. F0800573* MARKER IS TWO EOF'S + RRN FOR PROCESSED F0800574 LDQ- REQBUF,I SEE IF THERE WAS ANY DELETED RECORD AT F0800575 LDA- PRCRNL,Q ALL F0800576 LDQ- PRCRNM,Q F0800577 LLS 1 F0800578 ALS 15 STORE NO. PROCESSED AS 1ST PARAMETER IN F0800579 STA- DWSUB2,I DW SUB (CONVERT TO SUB FORMAT) F0800580 STQ- DWSUB1,I F0800581 LDQ- REQBUF,I F0800582 LDA- NETRNL,Q F0800583 LDQ- NETRNM,Q F0800584 LLS 1 F0800585 ALS 15 F0800586 STA- DWSUB4,I STORE NO. OF NEW RECORDS AS 2ND PARAMETERF0800587 STQ- DWSUB3,I IN DW SUB F0800588 LDQ- I F0800589 INQ DWSUB1 F0800590ÐÐ RTJ* (SUB2WD) DO SUBTRACTION F0800591 SPC 2 F0800592 LDA- COMFLG,I ERROR DUE TO SUB F0800593 SAZ COM155 F0800594COM153 LDA =N$A000 SET ERROR FLAG IN STATUS F0800595 JMP COM375 LEAVE F0800596* F0800597COM155 EQU COM155(*) F0800598 LDA- DWSUB5,I RESULT = NO. OF DELETED RECORDS F0800599 SAZ COM160 COMPRESSED SO FAR F0800600 JMP* COM200 RESULT LONGER THAN LENGTH OF MARKER F0800601* F0800602COM160 LDA- DWSUB6,I DO MARKER, NO NEED TO MARK RECORD AS F0800603 LDQ- REQBUF,I DELETED F0800604 SUB- NUMREC,Q PLUS NO. COMPRESSED IN THIS ROUND F0800605 SAN COM170 F0800606* NO RECORD HAS EVER BEEN COMPRESSED F0800607 CLR A NO NEED TO WRITE BACK, RECORDS IN SAME PLACE F0800608 STA- NUMREC,Q F0800609 JMP* COM180 NEED TO UPDATE FCB ON MM F0800610* F0800611COM170 INA -4 F0800612 SAP COM200 F0800613 INA 4 THERE ARE RECORDS COMPRESSED F0800614* BUT LEST THAN FOUR F0800615ÐÐ MUI- RECLNG,I SEE IF THERE ARE ENOUGH SPACE TO WRITE F0800616 INA -4 MARKER F0800617 SAP COM200 F0800618 SPC 3 F0800619* NO SPACE FOR MARKER F0800620COM180 ENA 1 SET FLAG TO UPDATE FCB ON MM SO AS NOT TO F0800621 STA- UPDATE,I LOSE PLACE IN CASE THE SYSTEM FAILS 136*A001F0800622 JMP* COM210 136*A001F0800623 EJT F0800624COM200 EQU COM200(*) F0800625 LDQ- REQBUF,I F0800626 LDA- PRCRNM,Q THERE IS SPACE TO WRITE MARKER WHICH IS FOR F0800627 STA- DWSUB1,I RECOVERY IN CASE THE SYSTEM FAILS F0800628 LDA- PRCRNL,Q F0800629 STA- DWSUB2,I STORE RRN OF PROCESSED TEMP F0800630 LDQ- LASTWD,I F0800631 LDA =XFMEOFC F0800632 STA- (ZERO),Q F0800633 STA- 1,Q TWO EOF CODE F0800634 LDA- DWSUB1,I F0800635 STA- 2,Q FOLLOWED BY RRN OF PROCESSED F0800636 LDA- DWSUB2,I F0800637 STA- 3,Q F0800638* F0800639COM210 LDQ- RPFCBA,I SET UP TO WRITE THE RECORDS TO FILE 136*A001F0800640ÐÐ LDA- DATBAM,Q SET MSB,LSB OF FILE SPACE 136*A001F0800641 STA- MSBBSA,I 136*A001F0800642 LDA- DATBAL,Q 136*A001F0800643 STA- LSBBSA,I 136*A001F0800644 LDA- RECLEN,Q 136*A001F0800645 STA- FCBLEN,I SET RECORD LENGTH 136*A001F0800646 CLR A 136*A001F0800647 STA- OFFSET,I CLEAR OFFSET WORD 136*A001F0800648 INA 1 136*A001F0800649 STA- IOTYPE,I SET I/O FLAG TO INDICATE FILE I/O 136*A001F0800650 LDA- RECBUF,I 136*A001F0800651 STA- ADRFSS,I SET BUFFER ADDRESS 136*A001F0800652 LDQ- REQBUF,I 136*A001F0800653 LDA- NETRNL,Q RRN TO WRITE BACK = RRN OF EXISTING+1 136*A001F0800654 LDQ- NETRNM,Q 136*A001F0800655 RTJ* (BUMPER) BUMP RRN BY 1 136*A001F0800656 STQ- RRNHIW,I 136*A001F0800657 STA- RRNLOW,I 136*A001F0800658 LDQ- REQBUF,I 136*A001F0800659 LDA- NUMREC,Q DO NOT WRITE IF NO RECORDS 136*A001F0800660 SAN COM220 136*A001F0800661 JMP* COM310 136*A001F0800662 EJT 136*A001F0800663COM220 RTJ CLFRIO COMPUTE LENGTH FOR I/O 136*A001F0800664 LDQ- UPDATE,I CHECK IF ROOM TO WRITE MARKER 136*A001F0800665ÐÐ SQN COM230 SKIP IF NO 136*A001F0800666 INA 4 BUMP BY 4 136*A001F0800667COM230 STA- WRTLEN,I 136*A001F0800668 LDQ- I 136*A001F0800669 INQ MSBBSA SET Q TO ABS ADDRESS OF PARAM LIST 136*A001F0800670 RTJ* (MWRIT) 136*A001F0800671 SQP COM310 SKIP IF NO ERROR 136*A001F0800672 LDA =N$8020 PRESET A TO ERROR STATUS 136*A001F0800673 INQ 0 CHECK IF COMPUTATION ERROR 136*A001F0800674 SQN COM240 SKIP IF NO 136*A001F0800675 ADD- ONEBIT+14 SET COMPUTATION ERROR FLAG 136*A001F0800676COM240 LDQ- ISTAT,I 136*A001F0800677 STA- (ZERO),Q STORE STATUS 136*A001F0800678 JMP* COM390 GO RETURN TO USER 136*A001F0800679 SPC 3 F0800680BUMPER ADC FMBRRN BUMP RRN BY ONE 121*4623F0800681MWRIT ADC MMWRIT WRITE TO MM 136*A001F0800682 SPC 2 F0800683COM310 EQU COM310(*) F0800684 LDA- GOODRC,I NO. OF GOOD RECORDS FOUND THIS TIME F0800685 LDQ- REQBUF,I SAVE NO. OF GOOD RECORDS IN NUMREC F0800686 STA- NUMREC,Q F0800687 STA- DWSUB1,I F0800688 LDQ- RPFCBA,I INCREMENT NO. OF NEW RECORDS IN FILE (IN FCB) F0800689 ADD- NUMNEW,Q BY NO. OF GOOD RECORDS FOUND THIS TIME F0800690ÐÐ STA- NUMNEW,Q F0800691* F0800692 LDQ- REQBUF,I NEW RRN OF EXISTING = OLD + GOOD RECORDS F0800693COM320 LDA- DWSUB1,I DWSUB1 IS A DUMMY VARIABLE F0800694 SAZ COM340 F0800695 INA -1 F0800696 STA- DWSUB1,I F0800697 LDA- NETRNL,Q SET Q-A TO MSB-LSB 121*4623F0800698 LDQ- NETRNM,Q 121*4623F0800699 RTJ* (BUMPER) BUMP RRN BY 1 121*4623F0800700 STQ- CURDEL,I SAVE MSB 121*4623F0800701 LDQ- REQBUF,I 121*4623F0800702 STA- NETRNL,Q STORE LSB 121*4623F0800703 LDA- CURDEL,I 121*4623F0800704 STA- NETRNM,Q STORE MSB 121*4623F0800705 JMP* COM320 F0800706 EJT 0 F0800707COM340 EQU COM340(*) ALL DONE WITH COMPRESSING RECORDS F0800708* RRN OF PROCESSED + NEW EXISTING UPDATED IN F0800709* REQBUF F0800710 LDQ- ISTAT,I SEE IF EOF BIT SET IN STATUS F0800711 LDA- (ZERO),Q F0800712 AND- ONEBIT+8 F0800713 SAN COM345 F0800714 JMP* COM350 F0800715ÐÐ* F0800716COM345 EQU COM345(*) F0800717 LDA- (ZERO),Q YES F0800718 EOR- ONEBIT+15 SET ERROR BIT ALSO F0800719 STA- (ZERO),Q F0800720 SPC 3 F0800721 LDQ- RPFCBA,I F0800722 LDA- FCBIND,Q ALL DONE F0800723 AND- ZROBIT+12 F0800724 STA- FCBIND,Q CLEAR OPEN FOR COMPRESS BIT F0800725 SPC 2 F0800726 LDQ- REQBUF,I MOVE RRN OF EXISTING RECORDS FROM REQBUF TO F0800727 LDA- NETRNM,Q FCB F0800728 STA- DWSUB1,I F0800729 LDA- NETRNL,Q F0800730 LDQ- RPFCBA,I F0800731 STA- NEDATL,Q THERE WILL NOT BE A SUBSET FCB BECAUSE ONLY F0800732 LDA- DWSUB1,I ONE USER CAN BE OPENED TO A FILE FOR COMPRESS F0800733 STA- NEDATM,Q F0800734 SPC 2 F0800735 JMP* COM390 EXIT F0800736 EJT 0 F0800737COM350 EQU COM350(*) SEE IF IT IS TIME TO UPDATE FCB F0800738 LDQ- RPFCBA,I F0800739 LDA- NUMNEW,Q F0800740ÐÐ SUB =XFMNRCD F0800741 SAP COM360 F0800742* F0800743 LDA- UPDATE,I SEE IF NEED TO UPDATE FCB ON MM F0800744 SAN COM355 BECAUSE THERE IS NOT ENOUGH SPACE FOR MARKER F0800745 JMP* COM390 NO F0800746* F0800747COM355 EQU COM355(*) F0800748 LDQ- REQBUF,I SET BIT 15 FOR RRN OF PROCESSED S.T. F0800749 LDA- PRCRNM,Q RECOVERY KNOWS IT F0800750 EOR- ONEBIT+15 F0800751 STA- PRCRNM,Q F0800752 LDQ- RPFCBA,I F0800753* F0800754COM360 EQU COM360(*) YES, WRITE THE RRN OF PROCESSED + EXISTING F0800755 LDA- (FILEID),Q RECORDS FROM REQBUF TO FCB ON MM F0800756 AND- ONEMSK+10 FCB TABLE INDEX FROM FILEID F0800757 INA 1 INCREMENT BY ONE F0800758 STA- RRNLOW,I USE AS RELATIVE RECORD NUMBER F0800759* F0800760 LDA- (FILEID),Q SET Q TO FILE'S MM LOGICAL UNIT F0800761 ARS 11 F0800762 AND- ONEMSK+4 F0800763 TRA Q F0800764 LDQ MMLUTB,Q GET VIT ADDR FOR FILE'S UNIT F0800765ÐÐ ENA 96 SET RECORD LENGTH TO 96(FIXED SIZE) F0800766 STA- FCBLEN,I F0800767* F0800768 LDA- VIFDDL,Q LSB OF FDD ADDR F0800769 ADD- VINFDB,Q ADD NO OF BLOCKS IN FDD (DOUBLE PRECISION) F0800770 LDQ- VIFDDM,Q MSB OF FDD ADDR F0800771 SAP COM370 F0800772 AND- ONEMSK+14 CLEAR BIT 15 F0800773 INQ 1 ADD ONE TO MSB F0800774COM370 STQ- MSBBSA,I STORE AS BASE SECTOR ADDR F0800775 STA- LSBBSA,I F0800776* F0800777 CLR A F0800778 STA- IOTYPE,I CLEAR IO TYPE F0800779 STA- RRNHIW,I CLEAR MSB OF RRN WORDS F0800780 ENA PRSRNM-FH-1 OFFSET FOR FCB WRITE IS FOR THE EXTRA 4 F0800781 STA- OFFSET,I WORDS ONLY F0800782 ENA 4 F0800783 STA- WRTLEN,I NO. OF WORDS TO WRITE F0800784* F0800785 LDQ- REQBUF,I WORDS TO WRITE IS FROM REQBUF F0800786 INQ PRCRNM F0800787 STQ- ADRFSS,I F0800788* F0800789 LDQ- I F0800790ÐÐ INQ MSBBSA ABSOLUTE ADDR OF PARAM LIST F0800791 RTJ* (MWRIT) WRITE FCB TO MM 136*A001F0800792 SQP COM380 F0800793 LDA =N$8020 MM IO ERROR F0800794 INQ 0 F0800795 SQN COM375 F0800796 ADD- ONEBIT+14 ILLEGAL PARAMETER BIT F0800797COM375 EQU COM375(*) F0800798 LDQ- ISTAT,I F0800799 STA- (ZERO),Q SET ERROR FLAG F0800800 JMP* COM390 F0800801* F0800802COM380 EQU COM380(*) F0800803 LDQ- REQBUF,I CLEAR BIT 15 OF RRN FOR PROCESSED F0800804 LDA- PRCRNM,Q MAY BE SET BEFORE STORE F0800805 AND- ONEMSK+14 F0800806 STA- PRCRNM,Q F0800807* F0800808 LDA- COMRTN,I F0800809 SAN COM390 F0800810 CLR A CLEAR NO. OF NEW RECORDS ENTRY, IF IT IS F0800811 LDQ- RPFCBA,I USED AS A PROCESSOR (NOT A SUBROUTINE) F0800812 STA- NUMNEW,Q F0800813* INDEXED FILE COMPRESS PROCESSOR NEEDS THIS NO.F0800814* TO KNOW WHEN TO UPDATE FCB ON MM FOR NEXT F0800815ÐÐ* KIB NUMBER F0800816* F0800817COM390 LDQ- COMRTN,I EXIT F0800818 SQZ COM400 F0800819 JMP- (ZERO),Q RETURN TO CALLER F0800820* F0800821COM400 JMP FMCOMP RETURN TO FM EXEC F0800822* F0800823 END F0800824 NAM LOKUNL F09 A ITOS CCS 3.0 SL-149F0900001* LOCK/UNLOCK A FILE F0900002* CREDIT COLLECTION SYSTEM VERSION 3.0 F0900003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F0900004* COPYRIGHT CONTROL DATA CORPORATION 1979 F0900005* F0900006**** F0900007* LOCKFL IS THE REQUEST PROCESSOR FOR THE LOKFIL REQUEST. F0900008* THE CALL SEQUENCE FOR THE REQUEST IS: F0900009* F0900010* CALL LOKFIL (REQBUF,ISTAT) F0900011* F0900012* WHERE REQBUF IS THE REQUEST BUFFER AND F0900013* ISTAT IS THE FILE REQUEST STATUS WORD. F0900014 SPC 3 F0900015* UNLOCK IS THE REQUEST PROCESSOR FOR THE UNLFIL REQUEST. F0900016ÐÐ* THE CALL SEQUENCE FOR THE REQUEST IS: F0900017* F0900018* CALL UNLFIL (REQBUF,ISTAT) F0900019* F0900020* WHERE REQBUF IS THE FILE REQUEST BUFFER AND F0900021* ISTAT IS THE FILE REQUEST STATUS WORD. F0900022* F0900023* F0900024* LOKFIL WILL LOCK A FILE IF RECORD LOCKING WAS NOT SPECIFIED F0900025* FOR THE FILE AND ONLY ONE USER HAS THE FILE OPEN. A FILE ISF0900026* LOCKED BY STORING THE USER'S USER ID INTO THE FILOCK WORD OFF0900027* THE FILE'S FCB. F0900028* F0900029* UNLOCK WILL UNLOCK A FILE IF THE FILE WAS LOCKED BY THE F0900030* CURRENT USER. A FILE IS UNLOCKED BY CLEARING THE FILOCK F0900031* WORD OF THE FILE'S FCB F0900032* F0900033*E F0900034 EJT F0900035 ENT UNLOCK ENTRY POINT F0900036 ENT LOCKFL ENTRY POINT F0900037* F0900038 EXT FMCOMP COMPLETE REQUEST ENTRY IN THE EXEC F0900039**** F0900040 SPC 3 F0900041ÐÐ* EQUIVALENCES F0900042 SPC 2 F0900043* COMMUNICATION REGION CONSTANTS F0900044 EQU ZERO(2) ZERO CONSTANT F0900045 EQU ONEMSK(3) ONE MASK TABLE F0900046 EQU ONEBIT($23) ONE BIT TABLE F0900047 SPC 1 F0900048* UCT ENTRY EQUIVALENCES F0900049 EQU UIDENT(ZERO) USER IDENTIFICATION F0900050 EQU FIDENT(1) PSEUDO FILE IDENTIFIER F0900051 EQU FCBCAD(2) FCB CORE ADDRESS F0900052 EQU FSLADR(3) FILE SPACE LIMITS TABLE ENTRY ADDRESS F0900053 EQU FCBSAD(4) FCB SUBSET ADDRESS F0900054 EQU USRCPT(5) USERS CONTROL POINT F0900055 EJT F0900056* REQUEST BUFFER INDEXES - FIRST 4 WORDS F0900057 EQU RBATHR(0) REQUEST BUFFER ADDRESS THREAD F0900058 EQU BUFAMP(1) BUFFER ADDRESS MAIN PART F0900059 EQU CNTLPT(2) CONTROL POINT (OR SPARE) F0900060 EQU RQINFO(3) REQUEST INFORMATION (MULTI-FIELD) F0900061* BITS USE F0900062* 15-12 SPARE F0900063* 11-04 REQUEST INDEX F0900064* 03-00 LEVEL OF REQUESTOR F0900065* F0900066ÐÐ* REQUEST BUFFER INDEXES - MAIN PART F0900067 EQU QREG(0) Q REGISTER F0900068 EQU IREG(1) I REGISTER F0900069 EQU PARLST(2) ADDRESS OF PARAMETER LIST F0900070 EQU RTNADR(2) RETURN ADDRESS TO USER (UPON RETURN FROM EXEC)F0900071 EQU UCTADR(3) UCT ENTRY ABSOLUTE ADDRESS F0900072 EQU USERID(4) USER IDENTIFIER F0900073 EQU FCBADR(5) FCB ADDRESS (MAY BE SET BY CALLER OR INTCPTR.)F0900074 EQU RADINT(6) RETURN ADDRESS TO INTERCEPTOR F0900075 EQU RPIDX(7) REQUEST PROCESSOR INDEX F0900076* BITS 14-00 REQUEST PROCESSOR INDEX F0900077* BIT 15 TYPE OF PROCESSOR F0900078* =0, SERIAL PROCESSOR F0900079* =1, REENTRANT PROCESSOR F0900080 EQU LOKREC(8) NUMBER OF RECORDS TO BE READ/WRITTEN PER I/O F0900081* CALL AND LOCK RECORDS ON RETRIEVE FLAG F0900082* BITS 14-00 NUMBER OF RECORDS PER CALL F0900083* BIT 15 =0, DO NOT LOCK ON RETRIEVE F0900084* =1, LOCK RECORDS ON RETRIEVE F0900085 EQU USEFLG(9) TYPE OF FILE USE FLAG F0900086* -1, OPEN FOR COMPRESSION F0900087* -2, OPEN FOR SPECIAL PROCESSING F0900088* 0, OPEN FOR ACESS VIA REL REC NO F0900089* 1, OPEN FOR RETRIEVAL VIA KEY 1 F0900090* 2, OPEN FOR RETRIEVAL VIA KEY 2 F0900091ÐÐ* 3, OPEN FOR RETRIEVAL VIA KEY 3 F0900092* 4, OPEN FOR RETRIEVAL VIA KEY 4 F0900093 EQU NUMREC(10) NUMBER OF RECORDS ACTUALLY STORED/RETRIEVED F0900094 EQU RRNMSB(11) REL REC NUMBER OF STORED/RETRIEVED REC, MSB F0900095 EQU RRNLSB(12) REL REC NUMBER OF STORED/RETRIEVED REC, LSB F0900096 EQU RMPLEN(20) LENGTH OF REQBUF MAIN PART F0900097 EJT F0900098* FILE CONTROL BLOCK EQUIVALENCES F0900099 EQU FH(4) LENGTH -1 OF FCB HEADER F0900100 EQU FILEID(ZERO) FILE IDENTIFIER F0900101* ACCESS FILEID INDIRECTLY F0900102* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBERF0900103* BITS 10-00 INDEX OF FCB IN FCB TABLE F0900104 EQU FCBFLG(1) FCB FLAGS F0900105* BITS 15-8, SPARE F0900106* BITS 7-00, NUMBER OF USERS USING FILE F0900107 EQU FILOCK(2) FILE LOCK FLAG (IF NON-0, CONTAINS USER ID) F0900108 EQU NUMSET(3) NUMBER OF SETS OF LOCKED RECORDS IN FILE F0900109 EQU NUMNEW(4) NUMBER OF NEW RECORDS SINCE FCB UPDATED ON MM F0900110 SPC 1 F0900111 EQU RECLEN(FH+1) RECORD LENGTH IN WORDS F0900112 EQU TDATRM(FH+2) TOTAL NUMBER OF DATA RECORDS, MSB F0900113 EQU TDATRL(FH+3) TOTAL NUMBER OF DATA RECORDS, LSB F0900114 EQU DATBAM(FH+4) DATA RECORDS BEGINNING SECTOR ADDRESS, MSB F0900115 EQU DATBAL(FH+5) DATA RECORDS BEGINNING SECTOR ADDRESS,LMSB F0900116ÐÐ EQU FCBIND(FH+6) FCB INDICATORS F0900117* BIT 15 , SECTOR ALLIGNED RECORDS IF =1 F0900118* BIT 14 , STORAGE MODE FOR INDEXED FILE F0900119* =0, RECORDS STORED RANDOMLY WITHF0900120* RESPECT TO PRIMARY KEY F0900121* =1, RECORDS STORED IN ORDER WIT F0900122* RESPECT TO PRIMARY KEY F0900123* BIT 13 , =1, FILE IS CURRENTLY OPEN F0900124* =0, FILE IS CURRENTLY CLOSED F0900125* BIT 12 , =1, FILE IS BEING COMPRESSED F0900126* =0, FILE IS NOT BEING COMPRESSEDF0900127* BIT 11 , =1, FILE IS OPEN FOR SPECIAL F0900128* PROCESSING F0900129* =0, FILE IS NOT OPEN FOR SPECIALF0900130* PROCESSING F0900131* BIT 8 , =1, RECORDS CONTAIN BINARY DATA F0900132* =0, RECORDS DO NOT CONTAIN F0900133* BINARY DATA F0900134* BIT 0 , FILE TYPE F0900135* =0, SEQUENTIAL FILE F0900136* =1, INDEXED FILE F0900137 EQU NEDATM(FH+7) NUMBER OF EXISTING DATA RECORDS, MSB F0900138 EQU NEDATL(FH+8) NUMBER OF EXISTING DATA RECORDS, LSB F0900139 EQU SEQLTH(NEDATL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F0900140* OF FCB FOR A SEQUENTIAL FILE F0900141ÐÐ SPC 1 F0900142 EQU NEXTBM(FH+9) NEXT FREE KEY INDEX BLOCK, MSB F0900143 EQU NEXTBL(FH+10) NEXT FREE KEY INDEX BLOCK, LSB F0900144 EQU TNKEYM(FH+11) TOTAL NUMBER OF KEY INDEX BLOCKS, MSB F0900145 EQU TNKEYL(FH+12) TOTAL NUMBER OF KEY INDEX BLOCKS, LSB F0900146 EQU KEYBAM(FH+13) KEY INDEX BEGINNING SECTOR ADDRESS, MSB F0900147 EQU KEYBAL(FH+14) KEY INDEX BEGINNING SECTOR ADDRESS, LSB F0900148 EQU LENKY1(FH+15) LENGTH OF KEY NO. 1 F0900149 EQU POSKY1(FH+16) BYTE POSITION OF KEY NO. 1 F0900150 EQU LENKY2(FH+17) LENGTH OF KEY NO. 2 F0900151 EQU POSKY2(FH+18) BYTE POSITION OF KEY NO. 2 F0900152 EQU LENKY3(FH+19) LENGTH OF KEY NO. 3 F0900153 EQU POSKY3(FH+20) BYTE POSITION OF KEY NO. 3 F0900154 EQU LENKY4(FH+21) LENGTH OF KEY NO. 4 F0900155 EQU POSKY4(FH+22) BYTE POSITION OF KEY NO. 4 F0900156 EQU INDLEN(POSKY4-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F0900157* OF FCB FOR AN INDEXED FILE F0900158 EJT F0900159* THE FOLLOWING PORTION OF THE FCB EXISTS ONLY F0900160* ON MASS MEMORY. THESE 10 WORDS ARE NOT LOADEDF0900161* INTO EITHER OF THE FILE MANAGER CONTROLLED FCBF0900162* TABLES. F0900163 EQU TSFILM(FH+23) TOTAL NUMBER OF SECTORS IN FILE, MSB F0900164 EQU TSFILL(FH+24) TOTAL NUMBER OF SECTORS IN FILE, LSB F0900165 EQU NAME12(FH+25) FILE NAME, CHARACTERS 1 AND 2 F0900166ÐÐ EQU NAME34(FH+26) FILE NAME, CHARACTERS 3 AND 4 F0900167 EQU NAME56(FH+27) FILE NAME, CHARACTERS 5 AND 6 F0900168 EQU NAME78(FH+28) FILE NAME, CHARACTERS 7 AND 8 F0900169 EQU OWNR12(FH+29) OWNER NAME, CHARACTERS 1 AND 2 F0900170 EQU OWNR34(FH+30) OWNER NAME, CHARACTERS 3 AND 4 F0900171 EQU OWNR56(FH+31) OWNER NAME, CHARACTERS 5 AND 6 F0900172 EQU OWNR78(FH+32) OWNER NAME, CHARACTERS 7 AND 8 F0900173 EQU BYTLEN(FH+33) BYTE LENGTH OF RECORD F0900174* F0900175* FOR COMPRESS ONLY F0900176* F0900177 EQU PRSRNM(FH+34) RRN OF LAST PROCESSED RECORD - MSB F0900178 EQU PRSRNL(FH+35) RRN OF LAST PROCESSED RECORD - LSB F0900179 EQU NEWRNM(FH+36) RRN OF THE LATEST 'NEW' RECORD - MSB F0900180 EQU NEWRNL(FH+37) RRN OF THE LATEST 'NEW' RECORD - LSB F0900181 SPC 4 F0900182* WORDS 0 THRU 4 OF THE FCB HEADER AND WORDS F0900183* 6 THRU 10 OF THE FCB ARE REFERRED TO AS THE F0900184* SHARED SUBSET OF THE FCB. THEY INCLUDE THE F0900185* ONLY FCB WORDS THAT CAN BE MODIFIED AFTER FILEF0900186* CREATION. IF TWO OR MORE USERS HAVE THE SAME F0900187* FILE OPEN, THERE HAS TO BE A SINGLE MASTER F0900188* COPY OF THE SUBSET THAT RECEIVES (AND RECORDS)F0900189* ALL OF THE UPDATES. THE CONTROLLED SUBSET F0900190* WILL ALWAYS BE PART OF A MAIN MEMORY RESIDENT F0900191ÐÐ* FCB IF THE FCB IS IN A FM CONTROLLED TABLE. F0900192* IF THE FCB IS IN USER SPACE, THE SUBSET MAY ATF0900193* TIMES RESIDE IN THE SUBSET CONTROL TABLE. F0900194 SPC 2 F0900195* ALTERNATE NAMES FOR SUBSET WORDS F0900196 EQU SAFCBI(FH+1) SUBSET ALTERNATE NAME FOR FCBIND F0900197 EQU SADATM(FH+2) SUBSET ALTERNATE NAME FOR NEDATM F0900198 EQU SADATL(FH+3) SUBSET ALTERNATE NAME FOR NEDATL F0900199 EQU SANXTM(FH+4) SUBSET ALTERNATE NAME FOR NEXTBM F0900200 EQU SANXTL(FH+5) SUBSET ALTERNATE NAME FOR NEXTBL F0900201 EJT F0900202* REQUEST PROCESSOR CONTROL TABLE F0900203* F0900204 EQU RP(10) INDEX TO START OF REQUEST PARAMETERS F0900205 EQU MR(RP+5) INDEX TO START OF MONITOR REQUEST PARAM LIST F0900206 EQU SS(MR+10) INDEX TO START OF SCRATCH PORTION OF PAR LIST F0900207* F0900208 EQU RPLOGU(1) LU NUMBER OF MM DEVICE F0900209 EQU RPAREQ(2) ACTIVE REQUEST FLAG (IF 0, NONE FOR TABLE) F0900210 EQU RPWAIT(3) START OF WAITING REQUEST QUEUE (IF 0, NO WAITGF0900211 EQU RPRLEV(4) REQUEST PRIORITY LEVEL - ACTIVE REQUEST F0900212 EQU RPRBF4(5) REQBUF ADDRESS - FIRST FOUR WORDS F0900213 EQU RPLTEA(6) LOCK TABLE ENTRY (ABSOLUTE) ADDRESS F0900214 EQU RPRTNJ(7) RETURN JUMP TO REQUEST PROCESSOR F0900215 EQU RPPADR(8) PROCESSOR ADDRESS F0900216ÐÐ SPC 1 F0900217* PARAMETER LIST FOR REQUEST PROCESSOR F0900218 EQU RPFCBA(9) FCB ADDRESS FOR FILE F0900219 EQU RPRBMP(RP+0) REQBUF ADDRESS - MAIN PART F0900220 EQU RPPFP1(RP+1) REQUEST PARAMETER ADDRESS - FIRST + 1 F0900221 EQU RPPFP2(RP+2) REQUEST PARAMETER ADDRESS - FIRST + 2 F0900222 EQU RPPFP3(RP+3) REQUEST PARAMETER ADDRESS - FIRST + 3 F0900223 EQU RPPFP4(RP+4) REQUEST PARAMETER ADDRESS - FIRST + 4 F0900224 SPC 1 F0900225* MAIN MONITOR REQUEST F0900226 EQU RPMREQ(MR+0) MONITOR REQUEST CODE WORD F0900227 EQU RPMRP1(MR+1) COMPLETION ADDRESS F0900228 EQU RPMRP2(MR+2) THREAD WORD F0900229 EQU RPMRP3(MR+3) LOGICAL UNIT FOR I/O F0900230 EQU RPMRP4(MR+4) NUMBER OF WORDS F0900231 EQU RPMRP5(MR+5) START CORE ADDRESS F0900232 EQU RPMRP6(MR+6) MASS MEMORY ADDRESS, MSB F0900233 EQU RPMRP7(MR+7) MASS MEMORY ADDRESS, LSB F0900234 EQU RPRCPT(MR+8) CONTROL POINT (FOR I/O REQUESTS) F0900235 EQU RPRETN(MR+9) SAVED RETURN ADDRESS F0900236* ALTERNATE COMMON NAMES F0900237 EQU REQBUF(RP+0) USERS FIRST CALL PARAMETER ADDRESS F0900238 EQU ISTAT(RP+4) USERS COMPLETION STATUS PARAMETER ADDRESS F0900239 EJT F0900240LOCKFL 000 000 ENTRY POINT IS NOT USED. EXECUTION STARTS AT F0900241ÐÐ* LOCKFL + 1. F0900242 LDQ- REQBUF,I F0900243 LDA- LOKREC,Q CHECK IF RECORD LOCKING WAS SPECIFIED F0900244 SAP LOK10 SKIP IF NO F0900245 ENA 8 SET BIT 3 - FILE WAS OPENED FOR RECORD LOCKINGF0900246 JMP* LOK20 F0900247* F0900248LOK10 LDQ- UCTADR,Q CHECK NUMBER OF CURRENT USERS OF FILE F0900249 LDQ- FCBSAD,Q F0900250 IIN 0 INHIBIT INTERRUPTS WHILE MAKING CHECKS F0900251 LDA- FCBFLG,Q F0900252 AND- ONEMSK+7 F0900253 INA -1 F0900254 SAZ LOK30 SKIP IF ONLY 1 F0900255 ENA 1 SET BIT 0 - FILE OPEN TO ANOTHER USER F0900256* F0900257LOK20 EOR- ONEBIT+15 SET BIT 15 - REQUEST REJECTED F0900258 JMP* LOK40 GO STORE A INTO ISTAT F0900259* F0900260LOK30 STQ* LOCKFL SAVE ADDRESS TEMPORARILY IN LOCKFL F0900261 LDQ- REQBUF,I SET FILE LOCK FLAG TO USER ID OF CURRENT USER F0900262 LDA- USERID,Q F0900263 LDQ* LOCKFL F0900264 STA- FILOCK,Q F0900265 CLR A CLEAR A FOR ZERO ISTAT F0900266ÐÐLOK40 EIN 0 ENABLE INTS F0900267LOK50 LDQ- ISTAT,I F0900268 STA- (ZERO),Q STORE A AS FILE REQUEST STATUS F0900269 JMP FMCOMP GO COMPLETE REQUEST F0900270 EJT F0900271UNLOCK 000 000 ENTRY POINT IS NOT USED. EXECUTION STARTS AT F0900272* UNLOCK + 1. F0900273 LDQ- REQBUF,I FIRST, ASSURE FILE IS CURRENTLY LOCKED BY USERF0900274 LDA- USERID,Q F0900275 LDQ- REQBUF,I F0900276 LDQ- UCTADR,Q F0900277 LDQ- FCBSAD,Q F0900278 EOR- FILOCK,Q F0900279 SAZ UNL10 SKIP IF YES F0900280 LDA =N$8004 SET BIT 2 OF ISTAT TO REFLECT FILE NOT LOCKED F0900281* AND BIT 15 TO REFLECT REQUEST REJECTED F0900282 JMP* LOK50 GO STORE ISTAT AND COMPLETE REQUEST F0900283* F0900284UNL10 STA- FILOCK,Q CLEAR FILE LOCK FLAG - USE 0 A-REG FOR ISTAT F0900285 JMP* LOK50 GO STORE ISTAT AND COMPLETE REQUEST F0900286 END F0900287 NAM SSMGR F10 A ITOS CCS 3.0 SL-149F1000001* FCB SUBSET MANAGER: FORCED SHARE AND FORCED UNSHARE F1000002* CREDIT COLLECTION SYSTEM VERSION 3.0 F1000003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F1000004ÐÐ* COPYRIGHT CONTROL DATA CORPORATION 1979 F1000005* F1000006**** F1000007* F1000008* THIS ROUTINE BUILDS AND RELEASES FCB SUBSETS FOR THE FILES CURRENTLY F1000009* OPEN TO A GIVEN USER. IT ASSUMES THE USER RESIDES IN THE ITOS F1000010* EXECUTIVE MANAGED USER SPACE. F1000011* F1000012* CALLING SEQUENCE: F1000013* RTJ+ FSHARE TO BUILD SUBSETS F1000014* RTJ+ FUNSHR TO RELEASE SUBSETS F1000015* F1000016* PARAMETERS ON ENTRY: F1000017* A-REG = THE ID OF THE USER (USER TABLE ADDRESS) F1000018* F1000019* EXIT: F1000020* RETURN TO CALLER WITH F1000021* A-REG HAS BEEN CHANGED BUT Q-REG AND I-REG HAVE BEEN RESTORED. F1000022* F1000023* FSHARE AND FUNSHR ARE CALLED ONLY BY THE ITOS EXECUTIVE. FSHARE F1000024* SHOULD BE CALLED WHENEVER A PARTICULAR MAIN MEMORY RESIDENT USER F1000025* IS TO BE SWAPPED OUT TO MASS MEMORY. FUNSHR SHOULD BE CALLED WHEN- F1000026* EVER A USER HAS BEEN RETURNED TO MAIN MEMORY AFTER HAVING BEEN SWAP- F1000027* PED TO MASS MEMORY. F1000028* F1000029ÐÐ* WHEN FSHARE IS CALLED, SSMGR SEARCHES THE UCT TO DETERMINE IF THE F1000030* CURRENT USER HAS ANY OPEN FILES. FOR EACH OF THE CURRENT USER'S F1000031* OPEN FILES, THE UCT ENTRY IS CHECKED TO DETERMINE WHETHER OR NOT THE F1000032* FILE HAS A FCB SUBSET (OR WHOLE FCB) IN FM CONTROLLED SPACE. IF NOT,F1000033* FSHARE ATTEMPTS TO GENERATE A SUBSET RESIDING IN FM SPACE. THE SUB- F1000034* SET CONTROL TABLE IS SEARCHED FOR A FREE ENTRY SPACE. IF A SPACE F1000035* IS FOUND, THE SUBSET IS GENERATED AND THE UCT ENTRY IS RELINKED. IF F1000036* A FREE SPACE CANNOT BE FOUND, A PSEUDO FILE LOCK IS PLACED ON THE F1000037* FILE TO PREVENT OTHER USE OF THE FILE WHILE THIS USER IS SWAPPED OUT.F1000038*E F1000039* WHEN FUNSHR IS CALLED, SSMGR SEARCHES THE UCT TO DETERMINE IF THE F1000040* CURRENT USER HAS ANY OPEN FILES. FOR EACH OF THE CURRENT USER'S F1000041* OPEN FILES THAT ARE OPEN TO ONE USER ONLY, THE RELATED UCT ENTRY IS F1000042* CHECKED TO DETERMINE IF THE FILE IS PSEUDO LOCKED OR AN EXTERNAL SUB-F1000043* SET EXISTS FOR THE FILE. IF A PSEUDO LOCK EXISTS, THE LOCK IS RE- F1000044* MOVED. IF AN EXTERNAL SUBSET IS DEFINED, THE SUBSET INFORMATION IS F1000045* MOVED BACK INTO THE MAIN FCB AND THE UCT ENTRY IS RELINKED. F1000046* F1000047*E F1000048 EJT F1000049* ENTRY POINTS F1000050* F1000051 ENT FSHARE F1000052 ENT FUNSHR F1000053* F1000054ÐÐ* EXTERNALS F1000055* F1000056 EXT UCTABL UCT ADDRESS F1000057 EXT UCTLEN LENGTH OF UCT F1000058 EXT FSCTNE NO. OF ENTRIES IN THE FCB SUBSET CONTROL TABLEF1000059 EXT FMFCBS SEQUENTIAL FILE CONTROL BLOCK TABLE F1000060 EXT FCBSCT FCB SUBSET CONTROL TABLE F1000061 EXT CCP CURRENT CONTROL POINT LOCATION F1000062 EXT SYFAIL SYSTEM FAILURE ROUTINE F1000063**** F1000064* F1000065* EQUIVALENCES F1000066* F1000067 EQU ZERO(2) F1000068 EQU ONEMSK(3) F1000069 EQU ONEBIT($23) ONE BIT TABLE F1000070 EQU FSCSIZ(10) SIZE OF A FSCT ENTRY F1000071* F1000072* UCT ENTRY EQUIVALENCES F1000073* F1000074 EQU UIDENT(ZERO) USER IDENTIFICATION F1000075 EQU FIDENT(1) PSEUDO FILE IDENTIFIER F1000076 EQU FCBCAD(2) FCB CORE ADDRESS F1000077 EQU FSLADR(3) FILE SPACE LIMITS TABLE ENTRY ADDRESS F1000078 EQU FCBSAD(4) FCB SUBSET ADDRESS F1000079ÐÐ EQU USRCPT(5) USERS CONTROL POINT F1000080 EQU UCTSIZ(6) SIZE OF A UCT ENTRY F1000081 EJT F1000082* FILE CONTROL BLOCK EQUIVALENCES F1000083 EQU FH(4) LENGTH -1 OF FCB HEADER F1000084 EQU FILEID(ZERO) FILE IDENTIFIER F1000085* ACCESS FILEID INDIRECTLY F1000086* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBERF1000087* BITS 10-00 INDEX OF FCB IN FCB TABLE F1000088 EQU FCBFLG(1) FCB FLAGS F1000089* BITS 15-8, SPARE F1000090* BITS 7-00, NUMBER OF USERS USING FILE F1000091 EQU FILOCK(2) FILE LOCK FLAG (IF NON-0, CONTAINS USER ID) F1000092 EQU NUMSET(3) NUMBER OF SETS OF LOCKED RECORDS IN FILE F1000093 EQU NUMNEW(4) NUMBER OF NEW RECORDS SINCE FCB UPDATED ON MM F1000094 SPC 1 F1000095 EQU RECLEN(FH+1) RECORD LENGTH IN WORDS F1000096 EQU TDATRM(FH+2) TOTAL NUMBER OF DATA RECORDS, MSB F1000097 EQU TDATRL(FH+3) TOTAL NUMBER OF DATA RECORDS, LSB F1000098 EQU DATBAM(FH+4) DATA RECORDS BEGINNING SECTOR ADDRESS, MSB F1000099 EQU DATBAL(FH+5) DATA RECORDS BEGINNING SECTOR ADDRESS,LMSB F1000100 EQU FCBIND(FH+6) FCB INDICATORS F1000101* BIT 15 , SECTOR ALLIGNED RECORDS IF =1 F1000102* BIT 14 , STORAGE MODE FOR INDEXED FILE F1000103* =0, RECORDS STORED RANDOMLY WITHF1000104ÐÐ* RESPECT TO PRIMARY KEY F1000105* =1, RECORDS STORED IN ORDER WIT F1000106* RESPECT TO PRIMARY KEY F1000107* BIT 13 , =1, FILE IS CURRENTLY OPEN F1000108* =0, FILE IS CURRENTLY CLOSED F1000109* BIT 12 , =1, FILE IS BEING COMPRESSED F1000110* =0, FILE IS NOT BEING COMPRESSEDF1000111* BIT 11 , =1, FILE IS OPEN FOR SPECIAL F1000112* PROCESSING F1000113* =0, FILE IS NOT OPEN FOR SPECIALF1000114* PROCESSING F1000115* BIT 8 , =1, RECORDS CONTAIN BINARY DATA F1000116* =0, RECORDS DO NOT CONTAIN F1000117* BINARY DATA F1000118* BIT 0 , FILE TYPE F1000119* =0, SEQUENTIAL FILE F1000120* =1, INDEXED FILE F1000121 EQU NEDATM(FH+7) NUMBER OF EXISTING DATA RECORDS, MSB F1000122 EQU NEDATL(FH+8) NUMBER OF EXISTING DATA RECORDS, LSB F1000123 EQU SEQLTH(NEDATL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F1000124* OF FCB FOR A SEQUENTIAL FILE F1000125 SPC 1 F1000126 EQU NEXTBM(FH+9) NEXT FREE KEY INDEX BLOCK, MSB F1000127 EQU NEXTBL(FH+10) NEXT FREE KEY INDEX BLOCK, LSB F1000128 EQU TNKEYM(FH+11) TOTAL NUMBER OF KEY INDEX BLOCKS, MSB F1000129ÐÐ EQU TNKEYL(FH+12) TOTAL NUMBER OF KEY INDEX BLOCKS, LSB F1000130 EQU KEYBAM(FH+13) KEY INDEX BEGINNING SECTOR ADDRESS, MSB F1000131 EQU KEYBAL(FH+14) KEY INDEX BEGINNING SECTOR ADDRESS, LSB F1000132 EQU LENKY1(FH+15) LENGTH OF KEY NO. 1 F1000133 EQU POSKY1(FH+16) BYTE POSITION OF KEY NO. 1 F1000134 EQU LENKY2(FH+17) LENGTH OF KEY NO. 2 F1000135 EQU POSKY2(FH+18) BYTE POSITION OF KEY NO. 2 F1000136 EQU LENKY3(FH+19) LENGTH OF KEY NO. 3 F1000137 EQU POSKY3(FH+20) BYTE POSITION OF KEY NO. 3 F1000138 EQU LENKY4(FH+21) LENGTH OF KEY NO. 4 F1000139 EQU POSKY4(FH+22) BYTE POSITION OF KEY NO. 4 F1000140 EQU INDLEN(POSKY4-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F1000141* OF FCB FOR AN INDEXED FILE F1000142 EJT F1000143* THE FOLLOWING PORTION OF THE FCB EXISTS ONLY F1000144* ON MASS MEMORY. THESE 10 WORDS ARE NOT LOADEDF1000145* INTO EITHER OF THE FILE MANAGER CONTROLLED FCBF1000146* TABLES. F1000147 EQU TSFILM(FH+23) TOTAL NUMBER OF SECTORS IN FILE, MSB F1000148 EQU TSFILL(FH+24) TOTAL NUMBER OF SECTORS IN FILE, LSB F1000149 EQU NAME12(FH+25) FILE NAME, CHARACTERS 1 AND 2 F1000150 EQU NAME34(FH+26) FILE NAME, CHARACTERS 3 AND 4 F1000151 EQU NAME56(FH+27) FILE NAME, CHARACTERS 5 AND 6 F1000152 EQU NAME78(FH+28) FILE NAME, CHARACTERS 7 AND 8 F1000153 EQU OWNR12(FH+29) OWNER NAME, CHARACTERS 1 AND 2 F1000154ÐÐ EQU OWNR34(FH+30) OWNER NAME, CHARACTERS 3 AND 4 F1000155 EQU OWNR56(FH+31) OWNER NAME, CHARACTERS 5 AND 6 F1000156 EQU OWNR78(FH+32) OWNER NAME, CHARACTERS 7 AND 8 F1000157 EQU BYTLEN(FH+33) BYTE LENGTH OF RECORD F1000158* F1000159* FOR COMPRESS ONLY F1000160* F1000161 EQU PRSRNM(FH+34) RRN OF LAST PROCESSED RECORD - MSB F1000162 EQU PRSRNL(FH+35) RRN OF LAST PROCESSED RECORD - LSB F1000163 EQU NEWRNM(FH+36) RRN OF THE LATEST 'NEW' RECORD - MSB F1000164 EQU NEWRNL(FH+37) RRN OF THE LATEST 'NEW' RECORD - LSB F1000165 SPC 4 F1000166* WORDS 0 THRU 4 OF THE FCB HEADER AND WORDS F1000167* 6 THRU 10 OF THE FCB ARE REFERRED TO AS THE F1000168* SHARED SUBSET OF THE FCB. THEY INCLUDE THE F1000169* ONLY FCB WORDS THAT CAN BE MODIFIED AFTER FILEF1000170* CREATION. IF TWO OR MORE USERS HAVE THE SAME F1000171* FILE OPEN, THERE HAS TO BE A SINGLE MASTER F1000172* COPY OF THE SUBSET THAT RECEIVES (AND RECORDS)F1000173* ALL OF THE UPDATES. THE CONTROLLED SUBSET F1000174* WILL ALWAYS BE PART OF A MAIN MEMORY RESIDENT F1000175* FCB IF THE FCB IS IN A FM CONTROLLED TABLE. F1000176* IF THE FCB IS IN USER SPACE, THE SUBSET MAY ATF1000177* TIMES RESIDE IN THE SUBSET CONTROL TABLE. F1000178 SPC 2 F1000179ÐÐ* ALTERNATE NAMES FOR SUBSET WORDS F1000180 EQU SAFCBI(FH+1) SUBSET ALTERNATE NAME FOR FCBIND F1000181 EQU SADATM(FH+2) SUBSET ALTERNATE NAME FOR NEDATM F1000182 EQU SADATL(FH+3) SUBSET ALTERNATE NAME FOR NEDATL F1000183 EQU SANXTM(FH+4) SUBSET ALTERNATE NAME FOR NEXTBM F1000184 EQU SANXTL(FH+5) SUBSET ALTERNATE NAME FOR NEXTBL F1000185* * * * F1000186 EJT F1000187FSHARE ADC 0 ENTRY TO BUILD SUBSETS F1000188 STA USERID SAVE USER ID F1000189 LDA* FSHARE MOVE RETURN ADDRESS F1000190 STA* FUNSHR F1000191 JMP* P000 F1000192* F1000193FUNSHR ADC 0 ENTRY TO RELEASE SUBSETS F1000194 STA* USERID SAVE USER ID F1000195 ENA 0 F1000196* F1000197P000 STA* CODE SAVE FUNCTION CODE F1000198 STQ* QSAVE SAVE Q-REG F1000199 LDA- I F1000200 STA* ISAVE SAVE I-REG F1000201 EJT F1000202* F1000203* PREPARE TO SCAN THE UCT FOR THE GIVEN USER'S ENTRIES F1000204ÐÐ* F1000205 LDQ* UCTADR COMPUTE STARTING ADDRESS OF SCAN F1000206 ADQ =XUCTLEN F1000207 INQ -UCTSIZ F1000208* F1000209* FIND USER'S NEXT UCT ENTRY F1000210* F1000211P010 IIN 0 INHIBIT INTERRUPTS F1000212 LDA- (UIDENT),Q GET CANDIDATE USER ID F1000213 EOR* USERID COMPARE TO GIVEN USER ID F1000214 SAZ P030 SKIP IF SAME F1000215* F1000216P020 EIN 0 ENABLE INTERRUPTS F1000217 INQ -UCTSIZ COMPUTE NEXT ENTRY ADDRESS F1000218 TRQ A F1000219 SUB* UCTADR HAS ALL OF UCT BEEN SEARCHED F1000220 SAP P025 SKIP IF NOT F1000221 ENA 0 ELSE RETURN TO CALLER F1000222 JMP EXIT F1000223P025 JMP* P010 CONTINUE SEARCH F1000224* F1000225P030 STQ* ENTRY SAVE UCT ENTRY ADDRESS F1000226 LDA* (P050+1) SET UCT CONTROL POINT WORD TO CURRENT 127*5189F1000227 STA- USRCPT,Q POINT. 127*5189F1000228 LDQ- FCBSAD,Q GET SUBSET ADDRESS F1000229ÐÐ LDA- FCBFLG,Q CHECK NO. OF CURRENT FILE USERS F1000230 AND- ONEMSK+7 ($FF) F1000231 INA -1 F1000232 LDQ* ENTRY RESTORE UCT ADDRESS F1000233 SAZ P040 SKIP IF ONLY ONE FILE USER: ASSUME IT TO BE F1000234* GIVEN USER. F1000235 JMP* P020 NO PROCESSING OF THIS FILE IS REQUIRED : F1000236* CONTINUE SEARCH OF THE UCT F1000237* F1000238P040 LDA* CODE BRANCH ACCORDING TO FUNCTION CODE F1000239 SAZ P050 RELEASE ENTRIES F1000240 JMP* P100 BUILD ENTRIES F1000241 EJT F1000242* RELEASE FCB SUBSETS IF POSSIBLE F1000243* F1000244P050 LDA CCP STORE CURRENT CONTROL POINT INTO USER'S UCT F1000245 STA- USRCPT,Q ENTRY F1000246 RTJ* RESCHK CHECK IF FCB IS IN A FM TABLE F1000247 SAN P070 SKIP IF NO F1000248 LDA- FCBCAD,Q ASSURE THAT SUBSET IS INTERNAL TO FCB F1000249 EOR- FCBSAD,Q F1000250 SAZ P060 SKIP IF INTERNAL F1000251 RTJ SYFAIL SYSTEM FAILURE - CRASH SYSTEM F1000252* F1000253P060 JMP* P080 GO CONTINUE SEARCH OF UCT F1000254ÐÐ* F1000255P070 LDA- FIDENT,Q CHECK IF PSEUDO FILE LOCK FLAG SET F1000256 SAP P075 SKIP IF NO F1000257 AND- ONEMSK+14 CLEAR LOCK BIT AND RESTORE PSEUDO FILE IDENT F1000258 STA- FIDENT,Q F1000259 JMP* P020 RESUME SEARCH OF UCT F1000260* F1000261P075 LDA- FCBCAD,Q SET I-REG TO DESTINATION BUFFER ADDRESS F1000262 STA- I F1000263 EOR- FCBSAD,Q CHECK IF SUBSET DOES EXIST F1000264 SAN P077 SKIP IF YES F1000265 JMP* P020 RESUME SEARCH OF UCT F1000266* F1000267P077 LDQ- FCBSAD,Q SET Q-REG TO SOURCE BUFFER ADDRESS F1000268 STQ* SUBSET SAVE FOR CHECK AFTER MOVE F1000269 EIN 0 F1000270 RTJ* MOVSUB MOVE SUBSET BACK INTO THE FCB F1000271 IIN 0 INHIBIT INTERRUPTS F1000272 LDQ* ENTRY RESET Q TO UCT ENTRY ADDRESS F1000273 LDA- FCBSAD,Q F1000274 EOR* SUBSET CHECK IF SUBSET ADDRESS HAS CHANGED F1000275 SAN P080 SKIP IF YES - DO NOT RELINK UCT F1000276 LDQ- FCBSAD,Q F1000277 LDA- FCBFLG,Q EXTRACT NO. OF USERS FROM FCBIND WORD F1000278 AND- ONEMSK+7 F1000279ÐÐ INA -1 CHECK IF STILL ONLY 1 USER F1000280 SAN P080 SKIP IF NO - DO NOT RELINK UCT F1000281 LDQ* ENTRY RESET Q TO UCT ENTRY ADDRESS F1000282 LDA- FCBCAD,Q F1000283 STA- FCBSAD,Q RELINK UCT TO INTERNAL SUBSET F1000284 CLR A F1000285 STA* (SUBSET) ENABLE REUSE OF SUBSET TABLE ENTRY F1000286P080 EIN 0 F1000287 LDQ* ENTRY RESET Q TO UCT ENTRY ADDRESS F1000288 JMP* P020 RESUME SEARCH OF UCT F1000289 EJT F1000290* CREATE FCB SUBSETS IF NEEDED F1000291P100 RTJ* RESCHK CHECK IF FCB IS IN A FM TABLE F1000292 SAZ P110 SKIP IF YES - NO NEED TO MAKE SUBSET F1000293 LDA- FCBCAD,Q F1000294 EOR- FCBSAD,Q CHECK IF EXTERNAL SUBSET EXISTS F1000295 SAZ P120 SKIP IF NO F1000296* F1000297P110 JMP* P080 RESUME SEARCH OF UCT - EXT. SUBSET NOT NEEDED F1000298* F1000299P120 LDA =XFSCTNE SET UP TO SCAN SUBSET TABLE FOR FREE ENTRY F1000300 INA -1 F1000301 MUI =XFSCSIZ F1000302 ADD* FSCADR F1000303 TRA Q BEGIN SCAN AT END AND WORK BACKWARDS F1000304ÐÐ* F1000305P130 IIN 0 INHIBIT INTERRUPTS F1000306 LDA- (ZERO),Q CHECK FIRST WORD OF ENTRY F1000307 SAZ P150 SKIP IF SPACE IS AVAILABLE F1000308 EIN 0 ENABLE INTS F1000309 INQ -FSCSIZ COMPUTE NEXT SPACE ADDRESS F1000310 TRQ A F1000311 SUB* FSCADR HAS ALL OF FSCT BEEN SEARCHED F1000312 SAP P140 SKIP IF NOT F1000313 LDQ* ENTRY RESET Q TO UCT ENTRY ADDRESS F1000314 LDA- FIDENT,Q SET PSEUDO FILE LOCK FLAG (BIT 15) OF FILE F1000315 EOR- ONEBIT+15 IDENT WORD F1000316 STA- FIDENT,Q F1000317 JMP* P080 GO RESUME SEARCH OF UCT F1000318P140 JMP* P130 CONTINUE SEARCH FOR SUBSET ENTRY SPACE F1000319* F1000320P150 STQ* SUBSET SAVE SUBSET ADDRESS F1000321 STQ- I STORE SUBSET ADDRESS AS DESTINATION BUF ADDRESF1000322 LDQ* ENTRY RESET Q TO UCT ENTRY ADDRESS F1000323 LDA- FIDENT,Q F1000324 STA* (SUBSET) SET SUBSET ENTRY FIRST WORD TO IN-USE STATE F1000325 LDQ- FCBCAD,Q SET Q TO SOURCE BUFFER ADDRESS F1000326 RTJ* MOVSUB MOVE SUBSET FROM FCB TO SUBSET TABLE F1000327 LDQ* ENTRY RESET Q TO UCT ENTRY ADDRESS F1000328 IIN 0 INHIBIT INTERRUPTS F1000329ÐÐ LDA- FCBCAD,Q F1000330 EOR- FCBSAD,Q CHECK IF SUBSET STILL DEFINED AS INTERNAL F1000331 SAZ P160 SKIP IF YES F1000332 CLR A NEW SUBSET NOT NOW NEEDED - RELEASE IT (DO F1000333 STA* (SUBSET) NOT RELINK) F1000334 JMP* P080 GO RESUME SEARCH OF UCT F1000335* F1000336P160 LDA* SUBSET RELINK UCT TO NEW SUBSET F1000337 STA- FCBSAD,Q F1000338 JMP* P080 GO RESUME SEARCH OF UCT F1000339 EJT F1000340* F1000341* STORAGE F1000342* F1000343USERID NUM 0 USER ID F1000344CODE NUM 0 FUNCTION CODE F1000345ISAVE NUM 0 F1000346QSAVE NUM 0 F1000347ENTRY NUM 0 UCT ENTRY ADDRESS F1000348SUBSET NUM 0 SAVED SUBSET ADDRESS F1000349UCTADR ADC UCTABL ADDRESS OF UCT F1000350FSCADR ADC FCBSCT ADDRESS OF FSCT F1000351 EJT F1000352* F1000353* MOVE FCB SUBSET SUBROUTINE F1000354ÐÐ* F1000355* ON ENTRY: Q-REG HAS SOURCE BUFFER ADDRESS F1000356* I-REG HAS DESTINATION BUFFER ADDRESS F1000357* F1000358MOVSUB 000 000 ENTRY F1000359 LDA- (ZERO),Q MOVE FIRST 5 WORDS F1000360 STA- (I) F1000361 LDA- 1,Q F1000362 STA- 1,I F1000363 LDA- 2,Q F1000364 STA- 2,I F1000365 LDA- 3,Q F1000366 STA- 3,I F1000367 LDA- 4,Q F1000368 STA- 4,I F1000369* F1000370 LDA* CODE CHECK IF UNSHARE F1000371 SAN MOV10 SKIP IF NO F1000372 LDA- I CHANGE STORE ADDRESS FOR MOVE BACK INTO SUBSETF1000373 INA 5 F1000374 STA- I F1000375 JMP* MOV20 F1000376* F1000377MOV10 INQ 5 CHANGE LOAD ADDRESS TO LOAD FROM MIDDLE OF FCBF1000378* F1000379ÐÐMOV20 LDA- 5,Q MOVE NEXT 5 WORDS F1000380 STA- 5,I F1000381 LDA- 6,Q F1000382 STA- 6,I F1000383 LDA- 7,Q F1000384 STA- 7,I F1000385 LDA- 8,Q F1000386 STA- 8,I F1000387 LDA- 9,Q F1000388 STA- 9,I F1000389 JMP* (MOVSUB) ALL DONE - RETURN F1000390 EJT F1000391* F1000392* CHECK RESIDENCY OF A GIVEN FCB F1000393* F1000394* ON ENTRY: F1000395* Q-REG = UCT ENTRY ADDRESS F1000396* F1000397* ON EXIT: F1000398* A-REG = 0 IF FCB IN FM CONTROLLED TABLE F1000399* ELSE FCB IN USER SPACE F1000400* Q AND I REGS ARE NOT ALTERED F1000401* F1000402RESCHK 000 000 ENTRY POINT F1000403 LDA- FCBCAD,Q GET FCB ADDRESS F1000404ÐÐ SUB =XFMFCBS CHECK IF FCB ADDRESS.GE.FMFCBS TABLE ADDRESS F1000405 SAM RES10 SKIP IF NO - FCB IN USER SPACE F1000406 LDA- FCBCAD,Q GET FCB ADDRESS F1000407 SUB =XFCBSCT CHECK IF FCB ADDRESS.GT.FCBSCT TABLE ADDRESS F1000408 SAP RES10 SKIP IF YES - FCB IN USER SPACE F1000409 CLR A F1000410 JMP* (RESCHK) EXIT WITH A=0 F1000411* F1000412RES10 ENA 1 F1000413 JMP* (RESCHK) EXIT WITH A=1, FCB IN USER SPACE F1000414 EJT F1000415EXIT LDQ* ISAVE RESTORE I-REG F1000416 STQ- I F1000417 LDQ* QSAVE RESTORE Q-REG F1000418 JMP (FUNSHR) RETURN TO CALLER F1000419 END F1000420 NAM PROC01 F11 A ITOS CCS 3.0 SL-149F1100001* PROVIDE FMEXEC WITH ENTRY POINT ADDRESS OF FFCLOS F1100002* CREDIT COLLECTION SYSTEM VERSION 3.0 F1100003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F1100004* COPYRIGHT CONTROL DATA CORPORATION 1979 F1100005* F1100006**** F1100007* F1100008* ITOS FILE MANAGER PROCESSOR FRONT END F1100009ÐÐ* THIS ROUTINE PROVIDES FMEXEC WITH ENTRY POINT ADDRESS OF FFCLOS F1100010* F1100011 EXT FFCLOS FORCED FILE CLOSE REQUEST PROCESSOR F1100012**** F1100013 ADC FFCLOS ADDRESS OF FFCLOS F1100014 END PROC01 F1100015 NAM PROC02 F12 A ITOS CCS 3.0 SL-149F1200001* PROVIDE FMEXEC WITH ENTRY POINT ADDRESS OF CREATE F1200002* CREDIT COLLECTION SYSTEM VERSION 3.0 F1200003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F1200004* COPYRIGHT CONTROL DATA CORPORATION 1979 F1200005* F1200006**** F1200007* F1200008* ITOS FILE MANAGER PROCESSOR FRONT END F1200009* THIS ROUTINE PROVIDES FMEXEC WITH ENTRY POINT ADDRESS OF CREATE F1200010* F1200011 EXT CREATE F1200012**** F1200013PROC02 ADC CREATE F1200014 END F1200015 NAM PROC03 F13 A ITOS CCS 3.0 SL-149F1300001* PROVIDE FMEXEC WITH ENTRY POINT ADDRESS OF CLEAR F1300002* CREDIT COLLECTION SYSTEM VERSION 3.0 F1300003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F1300004ÐÐ* COPYRIGHT CONTROL DATA CORPORATION 1979 F1300005* F1300006**** F1300007* F1300008* ITOS FILE MANAGER PROCESSOR FRONT END F1300009* THIS ROUTINE PROVIDES FMEXEC WITH ENTRY POINT ADDRESS OF CLEAR F1300010* F1300011 EXT CLEAR F1300012**** F1300013PROC03 ADC CLEAR F1300014 END F1300015 NAM PROC04 F14 A ITOS CCS 3.0 SL-149F1400001* PROVIDE FMEXEC WITH ENTRY POINT ADDRESS OF DELETE F1400002* CREDIT COLLECTION SYSTEM VERSION 3.0 F1400003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F1400004* COPYRIGHT CONTROL DATA CORPORATION 1979 F1400005* F1400006**** F1400007* F1400008* ITOS FILE MANAGER PROCESSOR FRONT END F1400009* THIS ROUTINE PROVIDES FMEXEC WITH ENTRY POINT ADDRESS OF DELETE F1400010* F1400011 EXT DELETE F1400012**** F1400013PROC04 ADC DELETE F1400014ÐÐ END F1400015 NAM PROC05 F15 A ITOS CCS 3.0 SL-149F1500001* PROVIDE FMEXEC WITH ENTRY POINT ADDRESS OF OPENFL F1500002* CREDIT COLLECTION SYSTEM VERSION 3.0 F1500003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F1500004* COPYRIGHT CONTROL DATA CORPORATION 1979 F1500005* F1500006**** F1500007* F1500008* ITOS FILE MANAGER PROCESSOR FRONT END F1500009* THIS ROUTINE PROVIDES FMEXEC WITH ENTRY POINT ADDRESS OF OPENFL F1500010* F1500011 EXT OPENFL F1500012**** F1500013PROC05 ADC OPENFL F1500014 END F1500015 NAM PROC06 F16 A ITOS CCS 3.0 SL-149F1600001* PROVIDE FMEXEC WITH ENTRY POINT ADDRESS OF CLOSFL F1600002* CREDIT COLLECTION SYSTEM VERSION 3.0 F1600003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F1600004* COPYRIGHT CONTROL DATA CORPORATION 1979 F1600005* F1600006**** F1600007* F1600008* ITOS FILE MANAGER PROCESSOR FRONT END F1600009ÐÐ* THIS ROUTINE PROVIDES FMEXEC WITH ENTRY POINT ADDRESS OF CLOSFL F1600010* F1600011 EXT CLOSFL F1600012**** F1600013PROC06 ADC CLOSFL F1600014 END F1600015 NAM PROC07 F17 A ITOS CCS 3.0 SL-149F1700001* PROVIDE FMEXEC WITH ENTRY POINT ADDRESS OF GETFCB F1700002* CREDIT COLLECTION SYSTEM VERSION 3.0 F1700003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F1700004* COPYRIGHT CONTROL DATA CORPORATION 1979 F1700005* F1700006**** F1700007* F1700008* ITOS FILE MANAGER PROCESSOR FRONT END F1700009* THIS ROUTINE PROVIDES FMEXEC WITH ENTRY POINT ADDRESS OF GETFCB F1700010* F1700011 EXT GETFCB GET FILE CONTROL BLOCK F1700012**** F1700013 ADC GETFCB ADDRESS OF ENTRY POINT F1700014 END F1700015 NAM PROC08 F18 A ITOS CCS 3.0 SL-149F1800001* PROVIDE FMEXEC WITH ENTRY POINT ADDRESS OF UPDFCB F1800002* CREDIT COLLECTION SYSTEM VERSION 3.0 F1800003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F1800004ÐÐ* COPYRIGHT CONTROL DATA CORPORATION 1979 F1800005* F1800006**** F1800007* F1800008* ITOS FILE MANAGER PROCESSOR FRONT END F1800009* THIS ROUTINE PROVIDES FMEXEC WITH ENTRY POINT ADDRESS OF UPDFCB F1800010* F1800011 EXT UPDFCB UPDATE FILE CONTROL BLOCK F1800012**** F1800013 ADC UPDFCB ADDRESS OF ENTRY POINT F1800014 END F1800015 NAM PROC09 F19 A ITOS CCS 3.0 SL-149F1900001* PROVIDE FMEXEC WITH ENTRY POINT ADDRESS OF RENAME F1900002* CREDIT COLLECTION SYSTEM VERSION 3.0 F1900003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F1900004* COPYRIGHT CONTROL DATA CORPORATION 1979 F1900005* F1900006**** F1900007* F1900008* ITOS FILE MANAGER PROCESSOR FRONT END F1900009* THIS ROUTINE PROVIDES FMEXEC WITH ENTRY POINT ADDRESS OF RENAME F1900010* F1900011 EXT RENAME F1900012**** F1900013PROC09 ADC RENAME F1900014ÐÐ END F1900015 NAM PROC10 F20 A ITOS CCS 3.0 SL-149F2000001* PROVIDE FMEXEC WITH ENTRY POINT ADDRESS OF ADDIDX F2000002* CREDIT COLLECTION SYSTEM VERSION 3.0 F2000003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F2000004* COPYRIGHT CONTROL DATA CORPORATION 1979 F2000005* F2000006**** F2000007* F2000008* ITOS FILE MANAGER PROCESSOR FRONT END F2000009* THIS ROUTINE PROVIDES FMEXEC WITH ENTRY POINT ADDRESS OF ADDIDX F2000010* F2000011 EXT ADDIDX F2000012**** F2000013 ADC ADDIDX F2000014 END F2000015 NAM PROC11 F21 A ITOS CCS 3.0 SL-149F2100001* PROVIDE FMEXEC WITH ENTRY POINT ADDRESS OF RTVIDX F2100002* CREDIT COLLECTION SYSTEM VERSION 3.0 F2100003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F2100004* COPYRIGHT CONTROL DATA CORPORATION 1979 F2100005* F2100006**** F2100007* F2100008* ITOS FILE MANAGER PROCESSOR FRONT END F2100009ÐÐ* THIS ROUTINE PROVIDES FMEXEC WITH ENTRY POINT ADDRESS OF RTVIDX F2100010* F2100011 EXT RTVIDX F2100012**** F2100013 ADC RTVIDX F2100014 END F2100015 NAM PROC12 F22 A ITOS CCS 3.0 SL-149F2200001* PROVIDE FMEXEC WITH ENTRY POINT ADDRESS OF GETNDX F2200002* CREDIT COLLECTION SYSTEM VERSION 3.0 F2200003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F2200004* COPYRIGHT CONTROL DATA CORPORATION 1979 F2200005* F2200006**** F2200007* F2200008* ITOS FILE MANAGER PROCESSOR FRONT END F2200009* THIS ROUTINE PROVIDES FMEXEC WITH ENTRY POINT ADDRESS OF GETNDX F2200010* F2200011 EXT GETNDX F2200012**** F2200013 ADC GETNDX F2200014 END F2200015 NAM PROC13 F23 A ITOS CCS 3.0 SL-149F2300001* PROVIDE FMEXEC WITH ENTRY POINT ADDRESS OF DELIDX F2300002* CREDIT COLLECTION SYSTEM VERSION 3.0 F2300003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F2300004ÐÐ* COPYRIGHT CONTROL DATA CORPORATION 1979 F2300005* F2300006**** F2300007* F2300008* ITOS FILE MANAGER PROCESSOR FRONT END F2300009* THIS ROUTINE PROVIDES FMEXEC WITH ENTRY POINT ADDRESS OF DELIDX F2300010* F2300011 EXT DELIDX F2300012**** F2300013 ADC DELIDX F2300014 END F2300015 NAM PROC14 F24 A ITOS CCS 3.0 SL-149F2400001* PROVIDE FMEXEC WITH ENTRY POINT ADDRESS OF COMIDX F2400002* CREDIT COLLECTION SYSTEM VERSION 3.0 F2400003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F2400004* COPYRIGHT CONTROL DATA CORPORATION 1979 F2400005* F2400006**** F2400007* F2400008* ITOS FILE MANAGER PROCESSOR FRONT END F2400009* THIS ROUTINE PROVIDES FMEXEC WITH ENTRY POINT ADDRESS OF COMIDX F2400010* F2400011 EXT COMIDX F2400012**** F2400013 ADC COMIDX F2400014ÐÐ END F2400015 NAM PROC15 F25 A ITOS CCS 3.0 SL-149F2500001* PROVIDE FMEXEC WITH ENTRY POINT ADDRESS OF MASALC F2500002* CREDIT COLLECTION SYSTEM VERSION 3.0 F2500003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F2500004* COPYRIGHT CONTROL DATA CORPORATION 1979 F2500005* F2500006**** F2500007* F2500008* ITOS FILE MANAGER PROCESSOR FRONT END F2500009* THIS ROUTINE PROVIDES FMEXEC WITH ENTRY POINT ADDRESS OF MASALC F2500010* F2500011 EXT MASALC F2500012**** F2500013 ADC MASALC F2500014 END F2500015 NAM PROC16 F26 A ITOS CCS 3.0 SL-149F2600001* PROVIDE FMEXEC WITH ENTRY POINT ADDRESS OF MASREL F2600002* CREDIT COLLECTION SYSTEM VERSION 3.0 F2600003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F2600004* COPYRIGHT CONTROL DATA CORPORATION 1979 F2600005* F2600006**** F2600007* F2600008* ITOS FILE MANAGER PROCESSOR FRONT END F2600009ÐÐ* THIS ROUTINE PROVIDES FMEXEC WITH ENTRY POINT ADDRESS OF MASREL F2600010* F2600011 EXT MASREL F2600012**** F2600013 ADC MASREL F2600014 END F2600015 NAM PROC17 F27 A ITOS CCS 3.0 SL-149F2700001* PROVIDE FMEXEC WITH ENTRY POINT ADDRESS OF VOLUSE F2700002* CREDIT COLLECTION SYSTEM VERSION 3.0 F2700003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F2700004* COPYRIGHT CONTROL DATA CORPORATION 1979 F2700005* F2700006**** F2700007* F2700008* ITOS FILE MANAGER PROCESSOR FRONT END F2700009* THIS ROUTINE PROVIDES FMEXEC WITH ENTRY POINT ADDRESS OF VOLUSE F2700010* F2700011 EXT VOLUSE ENABLE/DISABLE VOLUME USE F2700012**** F2700013 ADC VOLUSE ADDRESS OF ENTRY POINT F2700014 END PROC17 F2700015 NAM PROC18 F28 A ITOS CCS 3.0 SL-149F2800001* PROVIDE FMEXEC WITH ENTRY POINT ADDRESS OF CORFCB F2800002* CREDIT COLLECTION SYSTEM VERSION 3.0 F2800003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F2800004ÐÐ* COPYRIGHT CONTROL DATA CORPORATION 1979 F2800005* F2800006**** F2800007* F2800008* ITOS FILE MANAGER PROCESSOR FRONT END F2800009* THIS ROUTINE PROVIDES FMEXEC WITH ENTRY POINT ADDRESS OF CORFCB F2800010* F2800011 EXT CORFCB CORRECT FCB FOR OPEN F2800012**** F2800013 ADC CORFCB ADDRESS OF ENTRY POINT F2800014 END PROC18 F2800015 NAM FMDUMY F29 A ITOS CCS 3.0 SL-149F2900001* DUMMY ROUTINE FOR ALL MM LOADS - PROVIDES TRANSFER ADDRESS F2900002* CREDIT COLLECTION SYSTEM VERSION 3.0 F2900003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F2900004* COPYRIGHT CONTROL DATA CORPORATION 1979 F2900005* F2900006**** F2900007* F2900008* DUMMY ROUTINE FOR ALL MASS RESIDENT PROCESSORS. PROVIDES F2900009* TRANSFER FOR LOADS VIA INITIALIZER. WILL EXECUTE SYFAIL IF F2900010* EXECUTED. F2900011* F2900012 ENT FMDUMY F2900013 EXT SYFAIL F2900014ÐÐFMDUMY RTJ SYFAIL F2900015**** F2900016 END FMDUMY F2900017 NAM PICKUP F30 A ITOS CCS 3.0 SL-149F3000001* Q8PREP/Q8PKUP SUBROUTINE FOR FILE MANAGER F3000002* CREDIT COLLECTION SYSTEM VERSION 3.0 F3000003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F3000004* COPYRIGHT CONTROL DATA CORPORATION 1979 F3000005* F3000006**** F3000007* F3000008* PICKUP PROVIDES A SUBSTITUTE FOR THE Q8PREP AND Q8PKUP F3000009* ROUTINES OF THE REENTRANT FORTRAN PACKAGE. F3000010* THIS ROUTINE MUST BE LOADED WITH ANY FILE MANAGER SERIALLY F3000011* EXECUTED PROCESSOR THAT IS CODED IN FORTRAN. F3000012* NOTE THAT PICKUP IS A VARIENT OF SYSTEM PROGRAM Q8PRMR F3000013* (DECK-ID B01). F3000014 SPC 2 F3000015 ENT Q8PREP PREPARE TO PICKUP PARAMS F3000016 ENT Q8PKUP PICKUP AND ABSOLUTIZE PARAMETER ADDRESS F3000017**** F3000018 EQU ZERO(2) SYSTEM ZERO F3000019 EQU LPMSK(2) MASK TABLE F3000020 SPC 2 F3000021Q8PREP NUM 0 ENTRY POINT F3000022ÐÐ STQ* QSAVE SAVE Q-REG F3000023 LDQ* Q8PREP F3000024 LDA* (Q8PREP) LOAD PARAMETER (WHICH IS THE SELF-RELATIVE F3000025* ADDRESS OF THE ENTRY POINT OF THE CALLING F3000026* ROUTINE) F3000027 ADD* Q8PREP COMPUTE ADDRESS F3000028 SQM NOMSK NEED 16 BIT ADDRESS F3000029 AND- LPMSK+15 F3000030NOMSK STA* ENTAD F3000031 LDQ* QSAVE RESTORE Q-REG F3000032 RAO* Q8PREP F3000033 JMP* (Q8PREP) EXIT F3000034 EJT F3000035Q8PKUP NUM 0 ENTRY POINT F3000036 STQ* QSAVE SAVE Q CONTENTS F3000037 LDQ* (ENTAD) PICKUP ADDRESS OF PARAMETER F3000038 LDA- (ZERO),Q GET THE ACTUAL ADDRESS (ABSOLUTE ALREADY) F3000039ABS LDQ* QSAVE RESTORE Q-REG F3000040 RAO* (ENTAD) BUMP RETURN ADDRESS F3000041 JMP* (Q8PKUP) RETURN F3000042 SPC 2 F3000043QSAVE NUM 0 SAVED Q-REG F3000044ENTAD NUM 0 F3000045 END F3000046 NAM FFCLOS F31 A ITOS CCS 3.0 SL-149F3100001ÐÐ* FILE MANAGER FORCED FILE CLOSE PROCESSOR - EXECUTIVE FUNCTION F3100002* CREDIT COLLECTION SYSTEM VERSION 3.0 F3100003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F3100004* COPYRIGHT CONTROL DATA CORPORATION 1979 F3100005* F3100006**** F3100007* F3100008* FFCLOS IS THE REQUEST PROCESSOR FOR THE FORCED FILE CLOSE F3100009* REQUEST. THIS REQUEST IS THE 'EXECUTIVE FUNCTION' REQUEST. F3100010* THAT IS USED ONLY BY AN EXECUTIVE TYPE CONTROL ROUTINE, SUCHF3100011* AS THE ITOS EXEC. THIS REQUEST IS UTILIZED WHENEVER IT IS F3100012* REQUIRED TO CLOSE ALL FILES THAT WERE OPEN TO A PARTICULAR F3100013* USER OR ALL FILES OPEN ON A PARTICULAR VOLUME. F3100014* F3100015* IF A GIVEN USER IS ABORTED BY AN EXECUTIVE CONTROLLER, F3100016* FFCLOS SHOULD BE USED TO CLOSE ALL FILES THAT MIGHT HAVE F3100017* BEEN OPEN TO THAT USER. FURTHER, EVEN IF A GIVEN USER COM- F3100018* PLETES EXECUTION NORMALLY, AN EXECUTIVE CONTROLLER MIGHT USEF3100019* FFCLOS ROUTINELY TO ENSURE THAT NO FILES WILL INADVERTANTLY F3100020* BE LEFT OPEN. F3100021* F3100022* IF A VOLUME IS LOGICALLY DISABLED FROM USE BECAUSE OF AN I/OF3100023* ERROR, ALL OPEN FILES ON THE VOLUME SHOULD BE CLOSED VIA F3100024* THIS REQUEST. NO MASS MEMORY I/O IS DONE BY FFCLOS WHEN F3100025* CLOSING ALL OPEN FILES ON A PARTICULAR VOLUME. THE FILE F3100026ÐÐ* MANAGER CONTROLLED TABLES CONTAINING DATA FOR OPEN FILES ON F3100027* THE DESIGNATED VOLUME WILL BE PURGED OF THE DATA FOR THOSE F3100028* FILES. F3100029* F3100030* SYSTEM ORDINAL DISMNT SHOULD EXECUTE THIS 'EXECUTIVE FUNC- F3100031* TION' REQUEST TO ENSURE CLEAN-UP OF APPROPRIATE FILE MANAGERF3100032* TABLES FOR A DISABLED VOLUME. F3100033* F3100034* THE INTERCEPTOR ROUTINES, FMENTP AND FMCEPT, DO NOT HAVE AN F3100035* ENTRY POINT FOR FFCLOS. FOR AN EXECUTIVE TO USE THIS RE- F3100036* QUEST, IT MUST SET UP A REQUEST BUFFER AS IF IT HAD BEEN F3100037* INITIALIZED BY AN INTERCEPTOR. F3100038*E F3100039 EJT F3100040* TO CLOSE A FILE MEANS TO: F3100041* 1) UNLOCK THE FILE (IF LOCKED) AND UNLOCK ANY RECORDS F3100042* THE USER MAY HAVE HAD LOCKED. F3100043* 2) RETURN ANY SYSTEM RESOURCES POSSESSED BY THE USER F3100044* OF THE SYSTEM, I.E.: F3100045* - MAIN MEMORY SPACE FOR THE FILE CONTROL BLOCK F3100046* - FCB SUBSET SPACE F3100047* - FILE SPACE LIMIT ENTRY F3100048* - USER CONTROL TABLE ENTRY F3100049* 3) UPDATE THE MASS MEMORY IMAGE OF THE FCB TO REFLECT F3100050* THE CLOSED STATE OF THE FILE AND THE LATEST INFORMA- F3100051ÐÐ* TION IN THE FCB'S SUBSET IF THE CURRENT USER IS THE F3100052* ONLY USER HAVING THE FILE OPEN AND MM I/O IS PERMIT- F3100053* TED (FILES ARE BEING CLOSED FOR A SPECIFIED USER F3100054* RATHER THAN ALL FILES ON A SPECIFIED VOLUME). F3100055*E F3100056 EJT F3100057* F3100058* THE REQUEST BUFFER SHOULD BE INITIALIZED AS FOLLOWS: F3100059* F3100060* WORD CONTENTS F3100061* **** ******** F3100062* 1 0 F3100063* 2 ABSOLUTE ADDRESS OF WORD 5 F3100064* 3 CONTROL POINT F3100065* 4 0 (SIGNALS FORCED FILE CLOSE REQUEST) F3100066* F3100067* **** ******** WORDS 5-24 DO NOT HAVE TO FOLLOW WORDS 1-4F3100068* 5 Q-REG VALUE - IF NEEDED F3100069* 6 I-REG VALUE - IF NEEDED F3100070* 7 ADDRESS OF PARAM LIST - SEE BELOW F3100071* 8 0 F3100072* 9 0 F3100073* 10 0 F3100074* 11 0 F3100075* 12 0 F3100076ÐÐ* 13 0 F3100077* 14 VOLUME ID OR ZERO (SEE 15) F3100078* IF WORD 14 = 0, A PARTICULAR USER ID WILL BE SPECI- F3100079* FIED VIA WORDS 15 OR 16-17. IF WORD 15 NOT 0, IT F3100080* MUST BE CONTAIN THE UNIT NUMBER OF THE DISMOUNTED F3100081* VOLUME (INDEX INTO MMLUTB). F3100082* 15 USER ID OR 0 (SEE 16-17) F3100083* 16-17 IF WORD 14 AND WORD 15 BOTH EQUAL ZERO, WORD 16 HAS F3100084* FWA AND WORD 17 HAS LWA OF MEMORY SPACE WHERE THE F3100085* USER RESIDES - SUCH AS LIMITS OF UNPROTECTED OR F3100086* LIMITS OF AREA USED BY A PARTICULAR PROGRAM IN ALLO- F3100087* CATABLE MEMORY. F3100088* 18 0 F3100089* . . F3100090* . . F3100091* 24 0 F3100092* F3100093* THE PARAMETER LIST MENTIONED FOR WORD 7 ABOVE SHOULD LOOK F3100094* LIKE THIS: F3100095* F3100096* PLIST ADC REQBUF REQUEST BUFFER F3100097* ADC ISTAT STATUS WORD F3100098*E F3100099 EJT F3100100* TO EXECUTE THIS REQUEST, USE CODE SIMILAR TO THE FOLLOWING: F3100101ÐÐ* . . F3100102* . . SET UP REQBUF (SAVE Q AND I IF NEEDED) F3100103* . . F3100104* LDA =XPLIST SET I TO REQBUF F3100105* STA- I F3100106* ENQ 30 INDEX INTO EXTENDED CORE TABLE F3100107* LDQ- ($E9),Q PICKUP ADDRESS OF EXEC F3100108* RTJ- (ZERO),Q EXECUTE REQUEST F3100109* . . RETURN FROM EXEC F3100110* . . RESTORE Q AND I IF NEEDED F3100111 SPC 4 F3100112* UPON THE RETURN, REQBUF(18) WILL SPECIFY THE NUMBER OF FILESF3100113* THAT WERE CLOSED BY THE REQUEST. F3100114* F3100115* ISTAT GIVES COMPLETION STATUS UPON RETURN TO THE CALLER. F3100116* BIT MEANING F3100117* --- ------- F3100118* 15 REQUEST REJECTED. F3100119* 14* ILLEGAL REQUEST (MAY BE SET IN CONJUNCTION WITH 5). F3100120* 13* REQBUF NOT SET UP CORRECTLY - REQBUF WORD 14 DID NOT F3100121* SPECIFY A VALID SYSTEM UNIT NUMBER OR WORDS 15-17 DIDF3100122* NOT DEFINE A USER. F3100123* 12-6 NOT USED F3100124* 5 MASS MEMORY ERROR. F3100125* 4-0 UNUSED. F3100126ÐÐ EJT F3100127*E F3100128* F3100129* ENTRY POINTS F3100130* F3100131 ENT FFCLOS FORCED FILE CLOSE F3100132* F3100133* EXTERNALS F3100134* F3100135 EXT LOKCHK CHECK FOR LOCKED RECORDS F3100136 EXT REMLOK REMOVE LOCKED RECORD ENTRY F3100137 EXT FILLS RELEASE FILE SPACE LIMIT ENTRY F3100138 EXT UCTABL USER CONTROL TABLE ADDRESS F3100139 EXT MAXCOP NUMBER OF UCT ENTRIES F3100140 EXT UCTMGR USER CONTROL TABLE MANAGER F3100141 EXT FMUFCB UPDATE MASS MEMORY FCB F3100142 EXT FMSCOM COMPLETE REQUEST TO FILE MANAGER F3100143 EXT FCBSCT ADDRESS OF FCB SUBSET CONTROL TABLE F3100144 EXT FMFCBS ADDRESS OF SEQUENTIAL FILE FCB TABLE F3100145 EXT MMLUTB MASS MEMORY LOGICAL UNIT TABLE F3100146 EXT SYFAIL SYSTEM FAILURE ROUTINE F3100147 EXT FCBSS FCB SUBSET MANAGER 136*A004F3100148 EJT F3100149* COMMON F3100150* F3100151ÐÐ COM PCTABL PCT TABLE ADDRESS F3100152 COM FCBMMA FCB MAIN MEMORY ADDRESS F3100153 COM SPARE(705) SPARE COMMON WORDS. F3100154**** F3100155 EJT F3100156* EQUIVALENCES F3100157* F3100158 EQU ZERO(2) SYSTEM ZERO F3100159 EQU ONEMSK(3) ONE MASK TABLE F3100160 EQU ONEBIT($23) ONE BIT TABLE F3100161 EQU CLRMSK($33) ZERO BIT TABLE F3100162 SPC 2 F3100163* UCT ENTRY EQUIVALENCES F3100164 EQU UIDENT(ZERO) USER IDENTIFICATION F3100165 EQU FIDENT(1) PSEUDO FILE IDENTIFIER F3100166 EQU FCBCAD(2) FCB CORE ADDRESS F3100167 EQU FSLADR(3) FILE SPACE LIMITS TABLE ENTRY ADDRESS F3100168 EQU FCBSAD(4) FCB SUBSET ADDRESS F3100169 EQU USRCPT(5) USERS CONTROL POINT F3100170 EQU UCTSIZ(6) SIZE OF A UCT ENTRY F3100171 EJT F3100172* REQUEST BUFFER INDEXES - FIRST 4 WORDS F3100173 EQU RBATHR(0) REQUEST BUFFER ADDRESS THREAD F3100174 EQU BUFAMP(1) BUFFER ADDRESS MAIN PART F3100175 EQU CNTLPT(2) CONTROL POINT (OR SPARE) F3100176ÐÐ EQU RQINFO(3) REQUEST INFORMATION (MULTI-FIELD) F3100177* BITS USE F3100178* 15-12 SPARE F3100179* 11-04 REQUEST INDEX F3100180* 03-00 LEVEL OF REQUESTOR F3100181* F3100182* REQUEST BUFFER INDEXES - MAIN PART F3100183 EQU QREG(0) Q REGISTER F3100184 EQU IREG(1) I REGISTER F3100185 EQU PARLST(2) ADDRESS OF PARAMETER LIST F3100186 EQU RTNADR(2) RETURN ADDRESS TO USER (UPON RETURN FROM EXEC)F3100187 EQU UCTADR(3) UCT ENTRY ABSOLUTE ADDRESS F3100188 EQU USERID(4) USER IDENTIFIER F3100189 EQU FCBADR(5) FCB ADDRESS (MAY BE SET BY CALLER OR INTCPTR.)F3100190 EQU RADINT(6) RETURN ADDRESS TO INTERCEPTOR F3100191 EQU RPIDX(7) REQUEST PROCESSOR INDEX F3100192* BITS 14-00 REQUEST PROCESSOR INDEX F3100193* BIT 15 TYPE OF PROCESSOR F3100194* =0, SERIAL PROCESSOR F3100195* =1, REENTRANT PROCESSOR F3100196 EQU LOKREC(8) NUMBER OF RECORDS TO BE READ/WRITTEN PER I/O F3100197* CALL AND LOCK RECORDS ON RETRIEVE FLAG F3100198* BITS 14-00 NUMBER OF RECORDS PER CALL F3100199* BIT 15 =0, DO NOT LOCK ON RETRIEVE F3100200* =1, LOCK RECORDS ON RETRIEVE F3100201ÐÐ EQU USEFLG(9) TYPE OF FILE USE FLAG F3100202* -1, OPEN FOR COMPRESSION F3100203* -2, OPEN FOR SPECIAL PROCESSING F3100204* 0, OPEN FOR ACESS VIA REL REC NO F3100205* 1, OPEN FOR RETRIEVAL VIA KEY 1 F3100206* 2, OPEN FOR RETRIEVAL VIA KEY 2 F3100207* 3, OPEN FOR RETRIEVAL VIA KEY 3 F3100208* 4, OPEN FOR RETRIEVAL VIA KEY 4 F3100209 EQU NUMREC(10) NUMBER OF RECORDS ACTUALLY STORED/RETRIEVED F3100210 EQU RRNMSB(11) REL REC NUMBER OF STORED/RETRIEVED REC, MSB F3100211 EQU RRNLSB(12) REL REC NUMBER OF STORED/RETRIEVED REC, LSB F3100212 EQU RMPLEN(20) LENGTH OF REQBUF MAIN PART F3100213* F3100214* ALTERNATE NAMES USED BY FFCLOS F3100215 EQU SYSUNT(9) SYSTEM UNIT NUMBER OR 0 F3100216 EQU UDENT(10) USER IDENT OR 0 F3100217 EQU FWASPC(11) FWA OF USER SPACE - IF UDENT = 0 F3100218 EQU LWASPC(12) LWA OF USER SPACE - IF UDENT = 0 F3100219 EQU NUMCLS(13) NUMBER OF FILES CLOSED BY FFCLOS F3100220 EJT F3100221* REQUEST PROCESSOR CONTROL TABLE F3100222* F3100223 EQU RP(10) INDEX TO START OF REQUEST PARAMETERS F3100224 EQU MR(RP+5) INDEX TO START OF MONITOR REQUEST PARAM LIST F3100225 EQU SS(MR+10) INDEX TO START OF SCRATCH PORTION OF PAR LIST F3100226ÐÐ* F3100227 EQU RPLOGU(1) LU NUMBER OF MM DEVICE F3100228 EQU RPAREQ(2) ACTIVE REQUEST FLAG (IF 0, NONE FOR TABLE) F3100229 EQU RPWAIT(3) START OF WAITING REQUEST QUEUE (IF 0, NO WAITGF3100230 EQU RPRLEV(4) REQUEST PRIORITY LEVEL - ACTIVE REQUEST F3100231 EQU RPRBF4(5) REQBUF ADDRESS - FIRST FOUR WORDS F3100232 EQU RPLTEA(6) LOCK TABLE ENTRY (ABSOLUTE) ADDRESS F3100233 EQU RPRTNJ(7) RETURN JUMP TO REQUEST PROCESSOR F3100234 EQU RPPADR(8) PROCESSOR ADDRESS F3100235 SPC 1 F3100236* PARAMETER LIST FOR REQUEST PROCESSOR F3100237 EQU RPFCBA(9) FCB ADDRESS FOR FILE F3100238 EQU RPRBMP(RP+0) REQBUF ADDRESS - MAIN PART F3100239 EQU RPPFP1(RP+1) REQUEST PARAMETER ADDRESS - FIRST + 1 F3100240 EQU RPPFP2(RP+2) REQUEST PARAMETER ADDRESS - FIRST + 2 F3100241 EQU RPPFP3(RP+3) REQUEST PARAMETER ADDRESS - FIRST + 3 F3100242 EQU RPPFP4(RP+4) REQUEST PARAMETER ADDRESS - FIRST + 4 F3100243 SPC 1 F3100244* MAIN MONITOR REQUEST F3100245 EQU RPMREQ(MR+0) MONITOR REQUEST CODE WORD F3100246 EQU RPMRP1(MR+1) COMPLETION ADDRESS F3100247 EQU RPMRP2(MR+2) THREAD WORD F3100248 EQU RPMRP3(MR+3) LOGICAL UNIT FOR I/O F3100249 EQU RPMRP4(MR+4) NUMBER OF WORDS F3100250 EQU RPMRP5(MR+5) START CORE ADDRESS F3100251ÐÐ EQU RPMRP6(MR+6) MASS MEMORY ADDRESS, MSB F3100252 EQU RPMRP7(MR+7) MASS MEMORY ADDRESS, LSB F3100253 EQU RPRCPT(MR+8) CONTROL POINT (FOR I/O REQUESTS) F3100254 EQU RPRETN(MR+9) SAVED RETURN ADDRESS F3100255* ALTERNATE COMMON NAMES F3100256 EQU REQBUF(RP+0) USERS FIRST CALL PARAMETER ADDRESS F3100257 EQU RECBUF(RP+1) RECORD BUFFER PARAMETER - FOR PUTS F3100258 EQU ISTAT(RP+4) USERS COMPLETION STATUS PARAMETER ADDRESS F3100259 EQU NORECS(RP+2) NUMBER OF RECORDS PARAMETER - FOR PUTS F3100260 EJT F3100261* FILE CONTROL BLOCK EQUIVALENCES F3100262 EQU FH(4) LENGTH -1 OF FCB HEADER F3100263 EQU FILEID(ZERO) FILE IDENTIFIER F3100264* ACCESS FILEID INDIRECTLY F3100265* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBERF3100266* BITS 10-00 INDEX OF FCB IN FCB TABLE F3100267 EQU FCBFLG(1) FCB FLAGS F3100268* BITS 15-8, SPARE F3100269* BITS 7-00, NUMBER OF USERS USING FILE F3100270 EQU FILOCK(2) FILE LOCK FLAG (IF NON-0, CONTAINS USER ID) F3100271 EQU NUMSET(3) NUMBER OF SETS OF LOCKED RECORDS IN FILE F3100272 EQU NUMNEW(4) NUMBER OF NEW RECORDS SINCE FCB UPDATED ON MM F3100273 SPC 1 F3100274 EQU RECLEN(FH+1) RECORD LENGTH IN WORDS F3100275 EQU TDATRM(FH+2) TOTAL NUMBER OF DATA RECORDS, MSB F3100276ÐÐ EQU TDATRL(FH+3) TOTAL NUMBER OF DATA RECORDS, LSB F3100277 EQU DATBAM(FH+4) DATA RECORDS BEGINNING SECTOR ADDRESS, MSB F3100278 EQU DATBAL(FH+5) DATA RECORDS BEGINNING SECTOR ADDRESS,LMSB F3100279 EQU FCBIND(FH+6) FCB INDICATORS F3100280* BIT 15 , SECTOR ALLIGNED RECORDS IF =1 F3100281* BIT 14 , STORAGE MODE FOR INDEXED FILE F3100282* =0, RECORDS STORED RANDOMLY WITHF3100283* RESPECT TO PRIMARY KEY F3100284* =1, RECORDS STORED IN ORDER WIT F3100285* RESPECT TO PRIMARY KEY F3100286* BIT 13 , =1, FILE IS CURRENTLY OPEN F3100287* =0, FILE IS CURRENTLY CLOSED F3100288* BIT 12 , =1, FILE IS BEING COMPRESSED F3100289* =0, FILE IS NOT BEING COMPRESSEDF3100290* BIT 11 , =1, FILE IS OPEN FOR SPECIAL F3100291* PROCESSING F3100292* =0, FILE IS NOT OPEN FOR SPECIALF3100293* PROCESSING F3100294* BIT 8 , =1, RECORDS CONTAIN BINARY DATA F3100295* =0, RECORDS DO NOT CONTAIN F3100296* BINARY DATA F3100297* BIT 0 , FILE TYPE F3100298* =0, SEQUENTIAL FILE F3100299* =1, INDEXED FILE F3100300 EQU NEDATM(FH+7) NUMBER OF EXISTING DATA RECORDS, MSB F3100301ÐÐ EQU NEDATL(FH+8) NUMBER OF EXISTING DATA RECORDS, LSB F3100302 EQU SEQLTH(NEDATL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F3100303* OF FCB FOR A SEQUENTIAL FILE F3100304 SPC 1 F3100305 EQU NEXTBM(FH+9) NEXT FREE KEY INDEX BLOCK, MSB F3100306 EQU NEXTBL(FH+10) NEXT FREE KEY INDEX BLOCK, LSB F3100307 EQU TNKEYM(FH+11) TOTAL NUMBER OF KEY INDEX BLOCKS, MSB F3100308 EQU TNKEYL(FH+12) TOTAL NUMBER OF KEY INDEX BLOCKS, LSB F3100309 EQU KEYBAM(FH+13) KEY INDEX BEGINNING SECTOR ADDRESS, MSB F3100310 EQU KEYBAL(FH+14) KEY INDEX BEGINNING SECTOR ADDRESS, LSB F3100311 EQU LENKY1(FH+15) LENGTH OF KEY NO. 1 F3100312 EQU POSKY1(FH+16) BYTE POSITION OF KEY NO. 1 F3100313 EQU LENKY2(FH+17) LENGTH OF KEY NO. 2 F3100314 EQU POSKY2(FH+18) BYTE POSITION OF KEY NO. 2 F3100315 EQU LENKY3(FH+19) LENGTH OF KEY NO. 3 F3100316 EQU POSKY3(FH+20) BYTE POSITION OF KEY NO. 3 F3100317 EQU LENKY4(FH+21) LENGTH OF KEY NO. 4 F3100318 EQU POSKY4(FH+22) BYTE POSITION OF KEY NO. 4 F3100319 EQU INDLEN(POSKY4-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F3100320* OF FCB FOR AN INDEXED FILE F3100321*E F3100322 EJT F3100323* THE FOLLOWING PORTION OF THE FCB EXISTS ONLY F3100324* ON MASS MEMORY. THESE 10 WORDS ARE NOT LOADEDF3100325* INTO EITHER OF THE FILE MANAGER CONTROLLED FCBF3100326ÐÐ* TABLES. F3100327 EQU TSFILM(FH+23) TOTAL NUMBER OF SECTORS IN FILE, MSB F3100328 EQU TSFILL(FH+24) TOTAL NUMBER OF SECTORS IN FILE, LSB F3100329 EQU NAME12(FH+25) FILE NAME, CHARACTERS 1 AND 2 F3100330 EQU NAME34(FH+26) FILE NAME, CHARACTERS 3 AND 4 F3100331 EQU NAME56(FH+27) FILE NAME, CHARACTERS 5 AND 6 F3100332 EQU NAME78(FH+28) FILE NAME, CHARACTERS 7 AND 8 F3100333 EQU OWNR12(FH+29) OWNER NAME, CHARACTERS 1 AND 2 F3100334 EQU OWNR34(FH+30) OWNER NAME, CHARACTERS 3 AND 4 F3100335 EQU OWNR56(FH+31) OWNER NAME, CHARACTERS 5 AND 6 F3100336 EQU OWNR78(FH+32) OWNER NAME, CHARACTERS 7 AND 8 F3100337 EQU BYTLEN(FH+33) BYTE LENGTH OF RECORD F3100338* F3100339* FOR COMPRESS ONLY F3100340* F3100341 EQU PRSRNM(FH+34) RRN OF LAST PROCESSED RECORD - MSB F3100342 EQU PRSRNL(FH+35) RRN OF LAST PROCESSED RECORD - LSB F3100343 EQU NEWRNM(FH+36) RRN OF THE LATEST 'NEW' RECORD - MSB F3100344 EQU NEWRNL(FH+37) RRN OF THE LATEST 'NEW' RECORD - LSB F3100345 SPC 4 F3100346* WORDS 0 THRU 4 OF THE FCB HEADER AND WORDS F3100347* 6 THRU 10 OF THE FCB ARE REFERRED TO AS THE F3100348* SHARED SUBSET OF THE FCB. THEY INCLUDE THE F3100349* ONLY FCB WORDS THAT CAN BE MODIFIED AFTER FILEF3100350* CREATION. IF TWO OR MORE USERS HAVE THE SAME F3100351ÐÐ* FILE OPEN, THERE HAS TO BE A SINGLE MASTER F3100352* COPY OF THE SUBSET THAT RECEIVES (AND RECORDS)F3100353* ALL OF THE UPDATES. THE CONTROLLED SUBSET F3100354* WILL ALWAYS BE PART OF A MAIN MEMORY RESIDENT F3100355* FCB IF THE FCB IS IN A FM CONTROLLED TABLE. F3100356* IF THE FCB IS IN USER SPACE, THE SUBSET MAY ATF3100357* TIMES RESIDE IN THE SUBSET CONTROL TABLE. F3100358 SPC 2 F3100359* ALTERNATE NAMES FOR SUBSET WORDS F3100360 EQU SAFCBI(FH+1) SUBSET ALTERNATE NAME FOR FCBIND F3100361 EQU SADATM(FH+2) SUBSET ALTERNATE NAME FOR NEDATM F3100362 EQU SADATL(FH+3) SUBSET ALTERNATE NAME FOR NEDATL F3100363 EQU SANXTM(FH+4) SUBSET ALTERNATE NAME FOR NEXTBM F3100364 EQU SANXTL(FH+5) SUBSET ALTERNATE NAME FOR NEXTBL F3100365* * * * F3100366 EJT F3100367FFCLOS NUM 0 ENTRY F3100368* F3100369* NO NEED TO PROCESS PARAMETER LIST AS IN A F3100370* FORTRAN CALL F3100371 LDQ- ISTAT,I STORE ISTAT ADDRESS LOCALLY F3100372 STQ AISTAT F3100373 CLR A F3100374 STA- (ZERO),Q CLEAR ISTAT F3100375 LDQ- REQBUF,I STORE REQBUF ADDRESS LOCALLY F3100376ÐÐ STQ AREQBF F3100377 STA- NUMCLS,Q ASSURE NUMCLS IS ZERO F3100378 STA UNIT CLEAR UNIT NUMBER WORD F3100379* F3100380 LDA- SYSUNT,Q CHECK IF SYSTEM UNIT NO. IF SPECIFIED F3100381 SAZ CLS05 SKIP IF NO F3100382 JMP CLS300 GO CLOSE ALL FILES ON SPECIFIED VOLUME F3100383* F3100384CLS05 LDA- UDENT,Q CHECK IF USER ID IS SPECIFIED F3100385 STA IDENT SAVE USER IDENT LOCALLY - MAY BE 0 F3100386 SAN CLS10 SKIP IF YES F3100387 JMP* CLS50 GO CHECK FOR FWA-LWA SPECIFICATION F3100388* F3100389CLS10 LDA NENTRS F3100390 INA -1 F3100391 MUI UCTLEN SET Q TO ADDRESS OF LAST UCT ENTRY TO BE F3100392 ADD ADRUCT CHECKED F3100393 TRA Q F3100394* F3100395CLS20 LDA- (UIDENT),Q GET USER ID FROM UCT ENTRY F3100396 EOR IDENT CHECK IF SAME AS SPECIFIED USER F3100397 SAZ CLS40 SKIP IF YES F3100398CLS25 INQ -UCTSIZ DECREMENT TO PRECEDING ENTRY F3100399 TRQ A F3100400 SUB ADRUCT CHECK IF DONE F3100401ÐÐ SAM CLS30 SKIP IF YES F3100402 JMP* CLS20 GO CHECK NEXT ENTRY F3100403CLS30 RTJ (ADFMSC) RETURN TO FM EXEC F3100404* F3100405CLS40 JMP* CLS130 GO CLOSE THE FILE FOR THIS UCT ENTRY F3100406 EJT F3100407CLS50 LDA- FWASPC,Q NO USER SPECIFIED - ASSURE FWA AND LWA SPECI- F3100408 SAZ CLS60 FIED - SKIP IF FWA ZERO F3100409 STA FWAADR SAVE FWA ADDRESS LOCALLY F3100410 LDA- LWASPC,Q ASSURE LWA NON-ZERO F3100411 SAN CLS80 SKIP IF NON-ZERO F3100412CLS60 LDA =N$A000 SET REJECTED AND BAD REQBUF BITS F3100413* F3100414CLS70 LDQ- ISTAT,I STORE A AS ERROR STATUS FOR REQBUF F3100415 STA- (ZERO),Q F3100416 RTJ (ADFMSC) RETURN TO EXEC F3100417* F3100418CLS80 STA LWAADR SAVE LWA ADDRESS LOCALLY F3100419 SUB FWAADR ASSURE THAT LWA.GT.FWA 123*4905F3100420 SAP CLS90 SKIP IF SO F3100421 JMP* CLS60 GO SET ERROR STATUS AND EXIT F3100422* F3100423CLS90 LDA NENTRS SET UP TO CHECK UCT FOR USER'S WITH 136*A004F3100424 INA -1 USER ID IN RIGHT RANGE 136*A004F3100425 MUI UCTLEN 136*A004F3100426ÐÐ ADD ADRUCT SET Q TO ADDRESS OF LAST UCT ENTRY TO 136*A004F3100427 TRA Q BE CHECKED 136*A004F3100428* 136*A004F3100429CLS100 LDA FWAADR CHECK IF USER ID .GT.FWA 136*A004F3100430 SUB- (UIDENT),Q F3100431 SAP CLS110 SKIP IF NO F3100432* 2 CARDS DELETED 136*A004F3100433* F3100434 LDA* LWAADR CHECK IF LWA .GT. USER ID F3100435 SUB- (UIDENT),Q F3100436 SAP CLS130 SKIP IF YES - FOUND ONE TO BE CLOSED F3100437* F3100438CLS110 INQ -UCTSIZ DECREMENT Q TO PRECEDING ENTRY F3100439 TRQ A F3100440 SUB* ADRUCT CHECK IF DONE F3100441 SAM CLS120 SKIP IF YES F3100442 JMP* CLS100 GO CHECK NEXT ENTRY F3100443* F3100444CLS120 RTJ* (ADFMSC) RETURN TO FM EXEC F3100445 EJT F3100446* FOUND PROPER USER - CLOSE THE FILE F3100447CLS130 STQ* UCTSAV FIRST, SAVE CURRENT UCT ENTRY ADDRESS FOR F3100448 STQ* UCTENT CONTINUATION OF UCT SEARCH F3100449 TRQ A STORE UCT ADDRESS IN REQBUF TO SIMULATE OPEN F3100450 LDQ- REQBUF,I FILE ATTACHED TO THIS REQBUF F3100451ÐÐ STA- UCTADR,Q F3100452 TRA Q F3100453 LDA- FCBCAD,Q 123*4905F3100454 STA* FCBADD SAVE FCB ADDRESS LOCALLY 123*4905F3100455 LDA- FCBSAD,Q F3100456 STA* FCBLOC SAVE FCB SUBSET ADDRESS LOCALLY 123*4905F3100457 STA- RPFCBA,I ALSO STORE IN RPC TABLE F3100458 LDA- (UIDENT),Q GET USER ID AND STORE IN REQBUF FOR LOKCHK F3100459 LDQ- REQBUF,I F3100460 STA- USERID,Q F3100461 RAO- NUMCLS,Q BUMP NUMBER OF FILES CLOSED BY REQUEST F3100462 SPC 3 F3100463 LDQ* UCTENT RESET Q TO UCT ENTRY ADDRESS F3100464 LDA- FCBSAD,Q GET SUBSET ADDRESS AND CHECK IF SUBSET IS IN F3100465 RTJ RESCHK FM CONTROLLED SPACE F3100466 STA* RESFLG STORE RESIDENCY STATUS. =0 IF IN FM SPACE F3100467 SPC 4 F3100468* F3100469* UNLOCK THE FILE AND/OR RECORDS F3100470* F3100471 ENQ 0 CHECK FOR ANY RECORD LOCKS F3100472 RTJ LOKCHK F3100473 SAZ CLS150 SKIP IF NONE F3100474 TRA Q REMOVE THE LOCKS F3100475 RTJ REMLOK F3100476ÐÐCLS150 LDA* RESFLG CHECK IF SUBSET IS ADDRESSABLE NOW F3100477 SAZ CLS160 SKIP IF YES F3100478 JMP* CLS170 F3100479* F3100480 EJT F3100481CLS160 LDQ* UCTENT GET USER ID FROM UCT ENTRY F3100482 LDQ- FCBSAD,Q GET FCB SUBSET ADDRESS FROM UCT ENTRY F3100483 LDA- FILOCK,Q GET FCB LOCK FLAG F3100484 SAZ CLS165 SKIP IF FILE IS UNLOCKED F3100485 ENA 0 F3100486 STA- FILOCK,Q UNLOCK THE FILE F3100487 SPC 2 F3100488CLS165 LDA- FCBFLG,Q DECREMENT NUMBER OF FILE USERS, SAVE NUMBER F3100489 INA -1 F3100490 STA- FCBFLG,Q F3100491 AND- ONEMSK+7 ($FF) F3100492 STA* NUMUSR F3100493 SPC 3 F3100494* F3100495* RELEASE THE FILE SPACE LIMIT ENTRY F3100496* F3100497CLS170 LDQ* UCTENT CHECK IF SUCH AN ENTRY EXISTS F3100498 LDA- FSLADR,Q F3100499 SAZ CLS175 SKIP IF NOT F3100500 LDQ- (UIDENT),Q SET Q TO USER ID F3100501ÐÐ STA- I PASS ENTRY ADDRESS F3100502 ENA 0 RELEASE THE ENTRY F3100503 RTJ FILLS F3100504 SPC 3 F3100505CLS175 LDA* (ADPCTB) RESET I TO PROCESSOR CONTROL TABLE ADDRESS F3100506 STA- I F3100507* F3100508* UPDATE THE MASS MEMORY FCB IF APPROPRIATE F3100509* F3100510 LDA* RESFLG CHECK IF SUBSET IS ADDRESSABLE NOW F3100511 SAZ CLS180 SKIP IF YES F3100512 JMP* CLS200 F3100513* F3100514CLS180 LDA* NUMUSR CHECK IF THE CLOSING USER IS THE FILE'S ONLY F3100515* REMAINING USER F3100516 SAZ CLS182 SKIP IF YES F3100517 LDQ* UCTENT 136*A004F3100518 LDA- (UIDENT),Q 136*A004F3100519 STA- I SET I TO USER ID 136*A004F3100520 LDQ- FCBSAD,Q SET Q TO FCB SUBSET ADDRESS 136*A004F3100521 ENA 0 136*A004F3100522 RTJ FCBSS RELEASE FCB SUBSET, IF PERMITTED 136*A004F3100523 JMP* CLS200 F3100524 EJT F3100525CLS182 LDQ* UCTENT CHECK IF SUBSET IS EXTERNAL TO FCB F3100526ÐÐ LDA- FCBSAD,Q F3100527 EOR- FCBCAD,Q F3100528 SAZ CLS183 SKIP IF NO F3100529 LDQ- FCBSAD,Q USE THE EXTERNAL SUBSET F3100530 LDA- SAFCBI,Q F3100531 AND- CLRMSK+13 MARK FILE CLOSED F3100532 STA- SAFCBI,Q F3100533 JMP* CLS184 F3100534* F3100535CLS183 LDQ- FCBCAD,Q USE THE WHOLE FCB F3100536 LDA- FCBIND,Q MARK FILE CLOSED F3100537 AND- CLRMSK+13 ($DFFF) F3100538 STA- FCBIND,Q F3100539* F3100540CLS184 AND- ONEBIT+11 CHECK IF FILE IS OPEN FOR SPECIAL PROCESSING F3100541 SAN CLS190 SKIP UPDATE IF YES (FILE DEFINITION MAY HAVE F3100542* BEEN TEMPORARILY CHANGED) F3100543 LDA* UNIT CHECK IF UNIT NUMBER SPECIFIED F3100544 SAN CLS190 SKIP IF YES (SKIP I/O) F3100545 RTJ FMUFCB UPDATE THE FCB F3100546 SQP CLS190 SKIP IF NO I/O ERROR F3100547 LDA =N$8020 SET A FOR USE AS ISTAT- REFLECT REJECT + I/O F3100548* ERROR F3100549 INQ 0 F3100550 SQN CLS185 SKIP IF NOT A COMPUTATION ERROR F3100551ÐÐ EOR- ONEBIT+14 SET ILLEGAL REQUEST BIT F3100552CLS185 JMP* CLS70 GO STORE ISTAT AND COMPLETE REQUEST F3100553* F3100554CLS190 LDQ* UCTENT CHECK IF FCB HAS AN EXTERNAL SUBSET F3100555 LDA- FCBSAD,Q F3100556 EOR- FCBCAD,Q F3100557 SAZ CLS195 SKIP IF NO F3100558 CLR A CLEAR 1ST WORD TO FREE SUBSET SPACE FOR REUSE F3100559 LDQ- FCBSAD,Q F3100560 STA- (ZERO),Q F3100561CLS195 JMP* CLS200 F3100562 EJT F3100563* F3100564* STORAGE F3100565* F3100566RESFLG NUM 0 RESIDENCY FLAG: =0 IF FCB IN FM SPACE, ELSE F3100567* NOT 0 F3100568AISTAT NUM 0 COMPLETION STATUS ADDRESS F3100569AREQBF NUM 0 REQUEST BUFFER ADDRESS F3100570FCBLOC NUM 0 FCB SUBSET ADDRESS 123*4905F3100571FCBADD NUM 0 FCB ADDRESS 123*4905F3100572UCTENT NUM 0 UCT ENTRY ADDRESS/INDEX F3100573UCT BZS UCT(UCTSIZ) UCT ENTRY BUFFER F3100574TEMP NUM 0 F3100575NUMUSR NUM 0 NO. OF FILE USERS F3100576ÐÐIDENT NUM 0 SAVED USED ID F3100577NENTRS ADC MAXCOP NO. OF ENTRIES IN UCT F3100578UCTLEN ADC UCTSIZ LENGTH OF UCT ENTRY F3100579ADRUCT ADC UCTABL UCT TABLE ADDRESS F3100580ADFMSC ADC FMSCOM ADDRESS OF SERIAL PROC COMPLETE REQUEST F3100581FWAADR NUM 0 FWA OF SPACE FOR USER'S REQBUFS F3100582LWAADR NUM 0 LWA OF SPACE FOR USER'S REQBUFS F3100583UCTSAV NUM 0 SAVED UCT ENTRY ADDRESS F3100584ADPCTB ADC PCTABL PROCESSOR CONTROL TABLE ADDRESS F3100585UNIT NUM 0 SYSTEM UNIT NUMBER F3100586AMMTAB ADC MMLUTB ADDRESS OF MM LOGICAL UNIT TABLE F3100587 EJT F3100588* F3100589* RELEASE THE UCT ENTRY F3100590* F3100591CLS200 LDQ* AREQBF COMPUTE UCT ENTRY INDEX F3100592 LDA- UCTADR,Q F3100593 SUB =XUCTABL F3100594 STA* UCTENT F3100595 RTJ UCTMGR ZERO OUT THE ENTRY F3100596 ADC UCT F3100597 ADC UCTENT F3100598 ADC ONEBIT+2 CODE = 4 F3100599 ADC TEMP F3100600 SPC 3 F3100601ÐÐ* RELEASE THE FCB SPACE F3100602* F3100603 ENA -1 SET UP TO SEARCH WHOLE UCT F3100604 STA* UCTENT F3100605 LDQ* FCBLOC GET THE FILE ID F3100606 LDA- (FILEID),Q F3100607 STA* UCT+1 F3100608CLS205 RTJ UCTMGR SEARCH FOR USERS OF THE FILE F3100609 ADC UCT F3100610 ADC UCTENT F3100611 ADC ONEBIT+1 CODE = 2 F3100612 ADC TEMP F3100613* F3100614 LDA* TEMP WAS ALL OF TABLE SEARCHED F3100615 SAN CLS220 SKIP IF YES F3100616* F3100617 LDQ* UCTENT CHECK IF THIS USER EXPECTS THE FCB IN F3100618 ADQ =XUCTABL 121*4597F3100619 LDA- FCBCAD,Q SYSTEM TABLE SPACE F3100620 SUB =XFCBSCT F3100621 SAP CLS210 SKIP IF NO F3100622 LDA- FCBCAD,Q 132*5364F3100623 SUB =XFMFCBS 132*5364F3100624 SAZ CLS230 SKIP IF FCB IN SYSTEM TABLE F3100625 SAP CLS230 SKIP IF FCB IN SYSTEM TABLE: DON'T RELEASE IT F3100626ÐÐ* F3100627CLS210 JMP* CLS205 CONTINUE SEARCH F3100628 EJT F3100629CLS220 LDQ* FCBADD GET ADDRESS OF FULL FCB 123*4905F3100630 TRQ A 123*4905F3100631 SUB =XFCBSCT CHECK IF FCB IN FM TABLE SP+CE 123*4905F3100632 SAP CLS230 SKIP IF NO 123*4905F3100633 TRQ A 123*4905F3100634 SUB =XFMFCBS 123*4905F3100635 SAM CLS230 SKIP IF NO 123*4905F3100636* F3100637 CLR A ZERO OUT FIRST WORD OF FCB TO ENABLE REUSE OF F3100638 STA- (ZERO),Q ITS SPACE F3100639* F3100640CLS230 LDQ* UCTSAV RESET Q TO SAVED UCT ENTRY ADDRESS F3100641 LDA* (ADPCTB) RESET I-REG TO PCT ADDRESS F3100642 STA- I F3100643 LDA* UNIT CHECK IF UNIT NUMBER SPECIFIED F3100644 SAZ CLS235 SKIP IF NO F3100645 JMP* CLS345 GO RESUME SEARCH OF UCT F3100646* F3100647CLS235 LDA* IDENT CHECK IF SPECIFIC USER ID SPECIFIED F3100648 SAN CLS240 SKIP IF YES F3100649 JMP CLS110 GO RESUME SEARCH OF UCT F3100650* F3100651ÐÐCLS240 JMP CLS25 GO RESUME SEARCH OF UCT F3100652 EJT F3100653* A SYSTEM UNIT NO. WAS SPECIFIED SO ALL OPEN F3100654* FILES ON THE VOLUME ARE TO BE CLOSED. F3100655CLS300 SAM CLS310 FIRST, ASSURE THAT THE UNIT NUMBER IS VALID. F3100656 TCA Q INVALID IF NEGATIVE OR GREATER THAN NUMBER F3100657 ADQ* (AMMTAB) OF UNITS. F3100658 SQP CLS320 F3100659CLS310 JMP CLS60 GO SET ISTAT = $A000 AND RETURN F3100660* F3100661CLS320 TRA Q GET VIT ADDRESS OF DESIGNATED UNIT F3100662 STQ* UNIT SAVE UNIT FOR UCT CHECK F3100663 LDQ* (AMMTAB),Q F3100664 LDA- (ZERO),Q CHECK IF VOLUME CURRENTLY DISABLED F3100665 SAM CLS330 ERROR IF NOT DISABLED F3100666 LDA =N$9000 SET ISTAT TO REFLECT REJECTED AND VOLUME NOT F3100667 JMP CLS70 DISABLED. F3100668* F3100669CLS330 LDA* NENTRS SET UP TO CHECK UCT FOR ALL FILES OPEN ON F3100670 INA -1 DESIGNATED VOLUME F3100671 MUI* UCTLEN F3100672 ADD* ADRUCT SET Q TO ADDRESS OF LAST UCT ENTRY TO BE F3100673 TRA Q CHECKED F3100674* F3100675CLS340 LDA- FIDENT,Q PICKUP FILE IDENT AND EXTRACT UNIT F3100676ÐÐ ARS 11 F3100677 AND- ONEMSK+3 F3100678 EOR* UNIT CHECK IF SAME AS DESIGNATED UNIT F3100679 SAZ CLS360 SKIP IF YES F3100680* F3100681CLS345 INQ -UCTSIZ DECREMENT Q TO PRECEDING ENTRY F3100682 TRQ A F3100683 SUB* ADRUCT CHECK IF DONE F3100684 SAM CLS350 SKIP IF YES F3100685 JMP* CLS340 GO CHECK NEXT ENTRY F3100686* F3100687CLS350 RTJ* (ADFMSC) RETURN TO FM EXEC F3100688* F3100689CLS360 JMP CLS130 GO CLOSE THE FILE FOR THE INDICATED USER F3100690 EJT F3100691* F3100692* CHECK RESIDENCY OF A GIVEN TABLE ENTRY (DEFINED BY ADDRESS) F3100693* F3100694* ON ENTRY: F3100695* A-REG = TABLE ENTRY ADDRESS F3100696* F3100697* ON EXIT: F3100698* A-REG = 0 IF ADDRESS IN FM CONTROLLED TABLE F3100699* ELSE ADDRESS IN USER SPACE F3100700* Q AND I REGS ARE NOT ALTERED F3100701ÐÐ* F3100702RESCHK 000 000 ENTRY POINT F3100703 STA* TEMPOR SAVE ADDRESS F3100704 SUB =XFMFCBS CHECK IF ENTRY ADDRESS.GE.FMFCBS TBL ADDRESS F3100705 SAM RES10 SKIP IF NO - TBL ENTRY IN USER SPACE F3100706 LDA* TEMPOR GET SAVED ADDRESS F3100707 SUB* AMMTAB CHECK IF ENTRY ADDRESS.GT.MMLUTB TBL ADDRESS F3100708 SAP RES10 SKIP IF YES - TBL ENTRY IN USER SPACE F3100709 CLR A F3100710 JMP* (RESCHK) EXIT WITH A=0 F3100711* F3100712RES10 ENA 1 F3100713 JMP* (RESCHK) EXIT WITH A=1, TBL ENTRY IN USER SPACE F3100714 SPC 2 F3100715TEMPOR NUM 0 F3100716 END F3100717 NAM UCTMGR F32 A ITOS CCS 3.0 SL-149F3200001* STANDARD INTERFACE TO USER CONTROL TABLE F3200002* CREDIT COLLECTION SYSTEM VERSION 3.0 F3200003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F3200004* COPYRIGHT CONTROL DATA CORPORATION 1979 F3200005* F3200006**** F3200007* F3200008* THIS ROUTINE PROVIDES A COMMON INTERFACE TO THE USER CONTROL TABLE. F3200009ÐÐ* F3200010* CALLING SEQUENCE: F3200011* F3200012* CALL UCTMGR (ENTRY, INDEX, CODE, STATUS) F3200013* F3200014* PARAMETERS: F3200015* F3200016* ENTRY - 6 WORD ARRAY. CONTENT RESEMBLES A UCT ENTRY BUT EXACT F3200017* DEFINITION IS A FUNCTION OF THE VALUE OF 'CODE'. F3200018* INDEX - AN ADDRESS WITHIN THE UCT. EXACT INTERPRETATION IS A F3200019* FUNCTION OF THE VALUE OF 'CODE'. F3200020* CODE - DEFINES FUNCTION TO BE PERFORMED: F3200021* F3200022* 0 - SCAN FOR AN AVAILABLE SPACE. F3200023* ON ENTRY: F3200024* ENTRY IS UNUSED. F3200025* INDEX = STARTING ADDRESS (OFFSET FROM THE START F3200026* OF THE UCT) OF THE SEARCH. = -1 TO F3200027* INDICATE START OF UCT. F3200028* ON EXIT: F3200029* ENTRY CONTENTS UNPREDICTABLE. F3200030* INDEX = THE INDEX OFFSET OF THE SELECTED ENTRY. F3200031* F3200032* 1 - SCAN THE UCT FOR ENTRIES OF A SPECIFIED USER ID. F3200033* ON ENTRY: F3200034ÐÐ* ENTRY(1) = DESIRED USER ID. F3200035* ENTRY(2) TO (6) ARE UNUSED. F3200036* INDEX IS SET AS IN CODE = 0. F3200037* ON EXIT: F3200038* ENTRY CONTAINS AN ENTRY OF THE INDICATED USER. F3200039* INDEX IS SET AS IN CODE = 0. F3200040* F3200041* 2 - SCAN THE UCT FOR ENTRIES OF A SPECIFIED FILE. F3200042* ON ENTRY: F3200043* ENTRY(1) IS UNUSED. F3200044* ENTRY(2) = PSEUDO FILE ID. F3200045* ENTRY(3) TO (6) ARE UNUSED. F3200046* INDEX IS SET AS IN CODE = 0. F3200047* ON EXIT: F3200048* ENTRY CONTAINS AN ENTRY OF THE DESIRED FILE. F3200049* INDEX IS SET AS IN CODE = 0. F3200050* F3200051* 3 - STORE AN ENTRY IN THE UCT. F3200052* ON ENTRY: F3200053* ENTRY CONTAINS THE UCT ENTRY TO BE STORED. F3200054* INDEX = THE OFFSET ADDRESS OF THE ENTRY SPACE. F3200055* ON EXIT: F3200056* ENTRY IS UNCHANGED. F3200057* INDEX IS UNCHANGED. F3200058 EJT F3200059ÐÐ* 4 - RELEASE A UCT ENTRY. F3200060* ON ENTRY: F3200061* ENTRY IS UNUSED. F3200062* INDEX = THE OFFSET ADDRESS OF THE ENTRY SPACE. F3200063* ON EXIT: F3200064* ENTRY IS UNCHANGED. F3200065* INDEX IS UNCHANGED. F3200066* F3200067* STATUS - COMPLETION STATUS SET ON RETURN TO CALLER: F3200068* = 1 : FUNCTION NOT PERFORMED. END OF UCT WAS REACHED. F3200069* = 0 : FUNCTION PERFORMED WITH NO ERROR. F3200070* F3200071* ON RETURN: F3200072* F3200073* RETURN IS AS DESCRIBED WITH THE Q-REG AND I-REG RESTORED. F3200074 EJT F3200075*E F3200076* F3200077* ENTRY POINTS F3200078* F3200079 ENT UCTMGR F3200080* F3200081* EXTERNALS F3200082* F3200083 EXT UCTABL USER CONTROL TABLE ADDRESS F3200084ÐÐ EXT SYFAIL SYSTEM FAILURE ROUTINE F3200085 EXT UCTLEN UCT LENGTH F3200086 EXT Q8PREP ABSOLUTIZE PARAMETER ADDRESS F3200087 EXT Q8PKUP PICK UP PARAMETER ADDRESS F3200088* F3200089* EQUIVALENCES F3200090* F3200091 EQU ZERO(2) SYSTEM ZERO F3200092 EQU ONEMSK(3) ONE MASK TABLE F3200093 EQU ZROMSK($13) ZERO MASK TABLE F3200094* F3200095* UCT ENTRY FORMAT F3200096* F3200097* UCT ENTRY EQUIVALENCES F3200098 EQU UIDENT(ZERO) USER IDENTIFICATION F3200099 EQU FIDENT(1) PSEUDO FILE IDENTIFIER F3200100 EQU FCBCAD(2) FCB CORE ADDRESS F3200101 EQU FSLADR(3) FILE SPACE LIMITS TABLE ENTRY ADDRESS F3200102 EQU FCBSAD(4) FCB SUBSET ADDRESS F3200103 EQU USRCPT(5) USERS CONTROL POINT F3200104 EQU SIZE(6) SIZE OF A UCT ENTRY F3200105**** F3200106 EJT F3200107UCTMGR ADC 0 ENTRY F3200108 STQ* QSAVE SAVE Q-REG F3200109ÐÐ LDA- I SAVE I-REG F3200110 STA* ISAVE F3200111 RTJ Q8PREP ABSOLUTIZE PARAMETER ADDRESS F3200112 ADC* UCTMGR F3200113ADDR RTJ Q8PKUP F3200114 STA* ENTRY SAVE ENTRY ADDR F3200115 RTJ* (ADDR+1) F3200116 STA* INDEX SAVE INDEX ADDR F3200117 RTJ* (ADDR+1) F3200118 TRA Q F3200119 LDA- (ZERO),Q F3200120 STA* CODE SAVE CODE VALUE F3200121 RTJ* (ADDR+1) F3200122 STA* STATUS SAVE STATUS ADDR F3200123 EJT F3200124 LDA* CODE VALIDATE REQUEST CODE F3200125 SAM INVALD F3200126 INA -5 F3200127 SAM START SKIP IF LEGAL F3200128INVALD RTJ SYFAIL FM ERROR...KILL SYSTEM F3200129START INA 5 BRANCH ACCORDING TO CODE F3200130 TRA Q F3200131 NUM $1A01 CODE: F3200132 JMP* U000 0 F3200133 JMP* U100 1 F3200134ÐÐ JMP* U200 2 F3200135 JMP* U300 3 F3200136 JMP* U400 4 F3200137 EJT F3200138* STORAGE F3200139* F3200140QSAVE NUM 0 F3200141ISAVE NUM 0 F3200142ENTRY NUM 0 ENTRY ADDR F3200143INDEX NUM 0 INDEX ADDR F3200144CODE NUM 0 CODE VALUE F3200145STATUS NUM 0 STATUS ADDR F3200146KEY NUM 0 COMPARE KEY F3200147OFFSET NUM 0 OFFSET INTO UCT ENTRY TO COMPARE WORD F3200148 EJT F3200149* SEARCH FOR AN AVAILABLE ENTRY SPACE F3200150* F3200151U000 ENA 0 USE A ZERO AS THE SEARCH KEY F3200152 STA* KEY F3200153 JMP* SEARCH COMPARE TO USER ID WORD F3200154* F3200155* SEARCH FOR AN ENTRY OF A SPECIFIED USER F3200156* F3200157U100 LDA* (ENTRY) USE THE USER ID AS THE SEARCH KEY F3200158 STA* KEY F3200159ÐÐ ENA 0 COMPARE TO USER ID WORD F3200160 JMP* SEARCH F3200161* F3200162* SEARCH FOR AN ENTRY OF A SPECIFIED FILE F3200163* F3200164U200 LDQ* ENTRY USE PSUEDO FILE ID AS THE SEARCH KEY F3200165 LDA- FIDENT,Q F3200166 STA* KEY F3200167 ENA FIDENT COMPARE TO FILE ID WORD F3200168 EJT F3200169SEARCH STA* OFFSET SAVE OFFSET INTO UCT ENTRY OF COMPARE WORD F3200170 LDQ* (INDEX) CHECK FOR SEARCH FROM TABLE START F3200171 INQ 1 F3200172 SQZ S030 SKIP IF YES F3200173 SQP S000 VERIFY SEARCH ADDR LIES WITHIN THE UCT F3200174 JMP* INVALD F3200175S000 INQ -1 F3200176S010 INQ SIZE COMPUTE NEXT ENTRY INDEX F3200177 TRQ A F3200178 SUB* LENUCT CHECK FOR END OF TABLE F3200179 SAM S030 SKIP IF NOT F3200180 JMP* S070 F3200181S030 STQ* (INDEX) PASS CURRENT INDEX TO CALLER F3200182 ADQ* UCTADR CHECK THIS ENTRY FOR A MATCH AGAINST KEY F3200183 LDA* OFFSET CHECK IF CHECKING FILE IDENT WORD F3200184ÐÐ SAZ S032 SKIP IF NO F3200185 LDA* (OFFSET),Q PICKUP FILE ID WORD AND CLEAR BIT 15 F3200186 AND- ONEMSK+14 F3200187 JMP* S035 F3200188* F3200189S032 LDA* (OFFSET),Q PICKUP USER ID WORD F3200190S035 EOR* KEY F3200191 SAZ S040 SKIP IF MATCH F3200192 LDQ* (INDEX) F3200193 JMP* S010 GO CHECK NEXT ENTRY F3200194S040 STQ- I RETURN THE FOUND ENTRY TO THE CALLER F3200195 ENQ SIZE-1 F3200196S050 LDA- (ZERO),B F3200197 STA* (ENTRY),Q F3200198 INQ -1 F3200199 SQM S060 F3200200 JMP* S050 F3200201S060 JMP* NOERR RETURN TO CALLER F3200202S070 ENA 1 RETURN WITH END-OF-TABLE INDICATION F3200203 STA* (STATUS) F3200204 JMP* EXIT F3200205 SPC 2 F3200206UCTADR ADC UCTABL F3200207LENUCT ADC UCTLEN F3200208 EJT F3200209ÐÐ* STORE A UCT ENTRY F3200210* F3200211U300 LDA* (INDEX) VERIFY ENTRY INDEX LIES WITHIN THE TABLE F3200212 RTJ* CKIDX F3200213 ADD* UCTADR COMPUTE TRUE ENTRY ADDR F3200214 STA- I F3200215 ENQ SIZE-1 TRANSFER DATA FROM CALLER TO UCT F3200216U320 LDA* (ENTRY),Q F3200217 STA- (ZERO),B F3200218 INQ -1 F3200219 SQM U330 F3200220 JMP* U320 F3200221U330 JMP* NOERR F3200222 EJT F3200223* RELEASE A UCT ENTRY F3200224* F3200225U400 LDA* (INDEX) VERIFY ENTRY INDEX LIES WITHIN THE TABLE F3200226 RTJ* CKIDX F3200227 ADD* UCTADR COMPUTE TRUE ENTRY ADDR F3200228 STA- I F3200229 ENQ SIZE-1 ZERO OUT THE ENTRY F3200230 ENA 0 F3200231U410 STA- (ZERO),B F3200232 INQ -1 F3200233 SQM U420 SKIP IF DONE F3200234ÐÐ JMP* U410 F3200235U420 JMP* NOERR F3200236 EJT F3200237* SUBROUTINE TO VERIFY THE CALLER'S UCT INDEX: F3200238* 1) IS AN INTEGRAL MULTIPLE OF THE UCT ENTRY LENGTH F3200239* 2) LIES WITHIN THE UCT F3200240* A-REG CONTAINS THE INDEX. F3200241* F3200242CKIDX ADC 0 ENTRY F3200243 SAM CK010 F3200244 STA- I SAVE INDEX F3200245 ENQ 0 F3200246 DVI =XSIZE CHECK FOR INTEGRALITY F3200247 SQZ CK000 OK F3200248 JMP* CK010 F3200249CK000 LDA- I VERIFY INDEX IS IN UCT F3200250 SUB* LENUCT F3200251 SAP CK010 SKIP IF NOT F3200252 ADD* LENUCT F3200253 JMP* CK020 F3200254CK010 JMP* INVALD INDEX IS INVALID F3200255CK020 JMP* (CKIDX) F3200256 EJT F3200257NOERR ENA 0 RETURN WITH NO ERROR F3200258 STA* (STATUS) F3200259ÐÐ SPC 2 F3200260EXIT LDQ* QSAVE RESTORE Q-REG F3200261 LDA* ISAVE RESTORE I-REG F3200262 STA- I F3200263 JMP (UCTMGR) F3200264 END F3200265 NAM FILLS F33 A ITOS CCS 3.0 SL-149F3300001* BUILD/RELEASE FILE SPACE LIMIT ENTRY F3300002* CREDIT COLLECTION SYSTEM VERSION 3.0 F3300003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F3300004* COPYRIGHT CONTROL DATA CORPORATION 1979 F3300005* F3300006**** F3300007* F3300008* THIS ROUTINE PROCESSES REQUESTS TO BUILD/RELEASE AN ENTRY IN THE F3300009* FILE SPACE LIMITS TABLE. F3300010* F3300011* TO BUILD AN ENTRY THE ROUTINE FIRST SEARCHES THE TABLE FOR AN F3300012* EXISITING ENTRY DESCRIBING THE GIVEN FILE. IF ONE EXISTS, THAT F3300013* ENTRY'S ADDRESS IS RETURNED TO THE CALLER- NO NEW ENTRY IS BUILT. F3300014* OTHERWISE AN ENTRY IS BUILT AND THAT ADDRESS IS RETURNED. F3300015* F3300016* TO RELEASE AN ENTRY THE ROUTINE FIRST CHECKS IF THE ENTRY IS BEING F3300017* USED BY ANY OTHER FILE USER BESIDES THE RELEASING ONE. IF SO THE F3300018* ENTRY IS NOT RELEASED, OTHERWISE IT IS ZEROED OUT - RELEASING IT. F3300019ÐÐ* F3300020* ON ENTRY: F3300021* A-REG = 1 TO INDICATE AN ENTRY IS TO BE BUILT F3300022* Q-REG = FCB MAIN MEMORY ADDRESS F3300023* I-REG = FILE ID F3300024* F3300025* OR F3300026* A-REG = 0 TO INDICATE AN ENTRY IS TO BE RELEASED F3300027* Q-REG = RELEASING USER'S ID F3300028* I-REG = ENTRY ADDRESS F3300029* F3300030* ON EXIT: F3300031* A-REG = ENTRY ADDRESS F3300032* Q-REG = COMPLETION STATUS: F3300033* 0 NO ERROR OCCURRED F3300034* $9000 NO SPACE AVAILABLE FOR A NEW ENTRY F3300035* $8400 INTENAL ERROR F3300036* I-REG IS UNCHANGED F3300037* F3300038 EJT F3300039*E F3300040* F3300041* ENTRY POINTS F3300042* F3300043 ENT FILLS F3300044ÐÐ* F3300045* EXTERNALS F3300046* F3300047 EXT FSLIMT FILE SPACE LIMIT TABLE F3300048 EXT FSLEND FILE SPACE LIMIT ENDING ADDRESS F3300049 EXT MMLUTB MASS MEMORY LOGICAL UNIT TABLE ADDRESS F3300050 EXT UCTABL USER CONTROL TABLE F3300051 EXT MAXCOP NO. OF ENTRIES IN THE UCT F3300052 EXT DWADD DOUBLE WORD ADD ROUTINE F3300053 EXT DWMUL DOUBLE WORD MULTIPLY ROUTINE F3300054**** F3300055* F3300056* EQUIVALENCES F3300057* F3300058 EQU ENTYSZ(4) SIZE OF AN FSLIMT ENTRY F3300059 EQU UCTSIZ(6) SIZE OF A UCT ENTRY F3300060 EQU ZERO(2) SYSTEM ZERO F3300061 EQU ONEMSK(3) ONE MASK TABLE F3300062* F3300063* UCT ENTRY EQUIVALENCES F3300064 EQU UIDENT(ZERO) USER IDENTIFICATION F3300065 EQU FIDENT(1) PSEUDO FILE IDENTIFIER F3300066 EQU FCBCAD(2) FCB CORE ADDRESS F3300067 EQU FSLADR(3) FILE SPACE LIMITS TABLE ENTRY ADDRESS F3300068 EQU FCBSAD(4) FCB SUBSET ADDRESS F3300069ÐÐ EQU USRCPT(5) USERS CONTROL POINT F3300070 EJT F3300071* VOLUME INFORMATION TABLE F3300072* F3300073 EQU VISLUN(2) SYSTEM LOGICAL UNIT NUMBER (BIT 15=1,NOT READYF3300074* ACCESS VISLUN INDIRECTLY F3300075 EQU VINAME(1) VOLUME NAME - ASCII CHARACTERS 1 AND 2 F3300076* VOLUME NAME - ASCII CHARACTERS 3 AND 4 F3300077* VOLUME NAME - ASCII CHARACTERS 5 AND 6 F3300078* VOLUME NAME - ASCII CHARACTERS 7 AND 8 F3300079 EQU VINMBR(5) VOLUME NUMBER - (2 ASCII CHARACTERS) F3300080 EQU VIBMSM(6) BEGINNING OF MANAGEABLE SPACE - MSB F3300081 EQU VIBMSL(7) BEGINNING OF MANAGEABLE SPACE - LSB F3300082 EQU VIASDM(8) AVAILABLE SPACE DIRECTORY ADDRESS - MSB F3300083 EQU VIASDL(9) AVAILABLE SPACE DIRECTORY ADDRESS - LSB F3300084 EQU VIASDS(10) # SECTORS IN AVAILABLE SPACE DIRECTORY F3300085 EQU VILBAM(11) LARGEST BLOCK OF SPACE AVAILABLE - MSB F3300086 EQU VILBAL(12) LARGEST BLOCK OF SPACE AVAILABLE - LSB F3300087 EQU VIWPS(13) WORDS/SECTOR FOR VOLUME F3300088 EQU VIFDDM(14) FILE DEFINITION DIRECTORY ADDRESS - MSB F3300089 EQU VIFDDL(15) FILE DEFINITION DIRECTORY ADDRESS - LSB F3300090 EQU VIMAXF(16) MAX. NUMBER OF FILES PERMITTED ON VOLUME F3300091 EQU VICURF(17) CURRENT NUMBER OF FILES EXISTING ON VOLUME F3300092 EQU VINFDB(18) NUMBER OF BLOCKS IN FILE DEFINITION DIRECTORY F3300093 EQU VINXTB(19) NEXT AVAILABLE BLOCK IF FILE DEF. DIRECTORY F3300094ÐÐ EQU VINOOF(20) NUMBER OF OPEN FILES ON VOLUME F3300095 EJT F3300096* FILE CONTROL BLOCK EQUIVALENCES F3300097 EQU FH(4) LENGTH -1 OF FCB HEADER F3300098 EQU FILEID(ZERO) FILE IDENTIFIER F3300099* ACCESS FILEID INDIRECTLY F3300100* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBERF3300101* BITS 10-00 INDEX OF FCB IN FCB TABLE F3300102 EQU FCBFLG(1) FCB FLAGS F3300103* BITS 15-8, SPARE F3300104* BITS 7-00, NUMBER OF USERS USING FILE F3300105 EQU FILOCK(2) FILE LOCK FLAG (IF NON-0, CONTAINS USER ID) F3300106 EQU NUMSET(3) NUMBER OF SETS OF LOCKED RECORDS IN FILE F3300107 EQU NUMNEW(4) NUMBER OF NEW RECORDS SINCE FCB UPDATED ON MM F3300108 SPC 1 F3300109 EQU RECLEN(FH+1) RECORD LENGTH IN WORDS F3300110 EQU TDATRM(FH+2) TOTAL NUMBER OF DATA RECORDS, MSB F3300111 EQU TDATRL(FH+3) TOTAL NUMBER OF DATA RECORDS, LSB F3300112 EQU DATBAM(FH+4) DATA RECORDS BEGINNING SECTOR ADDRESS, MSB F3300113 EQU DATBAL(FH+5) DATA RECORDS BEGINNING SECTOR ADDRESS,LMSB F3300114 EQU FCBIND(FH+6) FCB INDICATORS F3300115* BIT 15 , SECTOR ALLIGNED RECORDS IF =1 F3300116* BIT 14 , STORAGE MODE FOR INDEXED FILE F3300117* =0, RECORDS STORED RANDOMLY WITHF3300118* RESPECT TO PRIMARY KEY F3300119ÐÐ* =1, RECORDS STORED IN ORDER WIT F3300120* RESPECT TO PRIMARY KEY F3300121* BIT 13 , =1, FILE IS CURRENTLY OPEN F3300122* =0, FILE IS CURRENTLY CLOSED F3300123* BIT 12 , =1, FILE IS BEING COMPRESSED F3300124* =0, FILE IS NOT BEING COMPRESSEDF3300125* BIT 11 , =1, FILE IS OPEN FOR SPECIAL F3300126* PROCESSING F3300127* =0, FILE IS NOT OPEN FOR SPECIALF3300128* PROCESSING F3300129* BIT 8 , =1, RECORDS CONTAIN BINARY DATA F3300130* =0, RECORDS DO NOT CONTAIN F3300131* BINARY DATA F3300132* BIT 0 , FILE TYPE F3300133* =0, SEQUENTIAL FILE F3300134* =1, INDEXED FILE F3300135 EQU NEDATM(FH+7) NUMBER OF EXISTING DATA RECORDS, MSB F3300136 EQU NEDATL(FH+8) NUMBER OF EXISTING DATA RECORDS, LSB F3300137 EQU SEQLTH(NEDATL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F3300138* OF FCB FOR A SEQUENTIAL FILE F3300139 SPC 1 F3300140 EQU NEXTBM(FH+9) NEXT FREE KEY INDEX BLOCK, MSB F3300141 EQU NEXTBL(FH+10) NEXT FREE KEY INDEX BLOCK, LSB F3300142 EQU TNKEYM(FH+11) TOTAL NUMBER OF KEY INDEX BLOCKS, MSB F3300143 EQU TNKEYL(FH+12) TOTAL NUMBER OF KEY INDEX BLOCKS, LSB F3300144ÐÐ EQU KEYBAM(FH+13) KEY INDEX BEGINNING SECTOR ADDRESS, MSB F3300145 EQU KEYBAL(FH+14) KEY INDEX BEGINNING SECTOR ADDRESS, LSB F3300146 EQU LENKY1(FH+15) LENGTH OF KEY NO. 1 F3300147 EQU POSKY1(FH+16) BYTE POSITION OF KEY NO. 1 F3300148 EQU LENKY2(FH+17) LENGTH OF KEY NO. 2 F3300149 EQU POSKY2(FH+18) BYTE POSITION OF KEY NO. 2 F3300150 EQU LENKY3(FH+19) LENGTH OF KEY NO. 3 F3300151 EQU POSKY3(FH+20) BYTE POSITION OF KEY NO. 3 F3300152 EQU LENKY4(FH+21) LENGTH OF KEY NO. 4 F3300153 EQU POSKY4(FH+22) BYTE POSITION OF KEY NO. 4 F3300154 EQU INDLEN(POSKY4-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F3300155* OF FCB FOR AN INDEXED FILE F3300156 EJT F3300157* THE FOLLOWING PORTION OF THE FCB EXISTS ONLY F3300158* ON MASS MEMORY. THESE 10 WORDS ARE NOT LOADEDF3300159* INTO EITHER OF THE FILE MANAGER CONTROLLED FCBF3300160* TABLES. F3300161 EQU TSFILM(FH+23) TOTAL NUMBER OF SECTORS IN FILE, MSB F3300162 EQU TSFILL(FH+24) TOTAL NUMBER OF SECTORS IN FILE, LSB F3300163 EQU NAME12(FH+25) FILE NAME, CHARACTERS 1 AND 2 F3300164 EQU NAME34(FH+26) FILE NAME, CHARACTERS 3 AND 4 F3300165 EQU NAME56(FH+27) FILE NAME, CHARACTERS 5 AND 6 F3300166 EQU NAME78(FH+28) FILE NAME, CHARACTERS 7 AND 8 F3300167 EQU OWNR12(FH+29) OWNER NAME, CHARACTERS 1 AND 2 F3300168 EQU OWNR34(FH+30) OWNER NAME, CHARACTERS 3 AND 4 F3300169ÐÐ EQU OWNR56(FH+31) OWNER NAME, CHARACTERS 5 AND 6 F3300170 EQU OWNR78(FH+32) OWNER NAME, CHARACTERS 7 AND 8 F3300171 EQU BYTLEN(FH+33) BYTE LENGTH OF RECORD F3300172* F3300173* FOR COMPRESS ONLY F3300174* F3300175 EQU PRSRNM(FH+34) RRN OF LAST PROCESSED RECORD - MSB F3300176 EQU PRSRNL(FH+35) RRN OF LAST PROCESSED RECORD - LSB F3300177 EQU NEWRNM(FH+36) RRN OF THE LATEST 'NEW' RECORD - MSB F3300178 EQU NEWRNL(FH+37) RRN OF THE LATEST 'NEW' RECORD - LSB F3300179 SPC 4 F3300180* WORDS 0 THRU 4 OF THE FCB HEADER AND WORDS F3300181* 6 THRU 10 OF THE FCB ARE REFERRED TO AS THE F3300182* SHARED SUBSET OF THE FCB. THEY INCLUDE THE F3300183* ONLY FCB WORDS THAT CAN BE MODIFIED AFTER FILEF3300184* CREATION. IF TWO OR MORE USERS HAVE THE SAME F3300185* FILE OPEN, THERE HAS TO BE A SINGLE MASTER F3300186* COPY OF THE SUBSET THAT RECEIVES (AND RECORDS)F3300187* ALL OF THE UPDATES. THE CONTROLLED SUBSET F3300188* WILL ALWAYS BE PART OF A MAIN MEMORY RESIDENT F3300189* FCB IF THE FCB IS IN A FM CONTROLLED TABLE. F3300190* IF THE FCB IS IN USER SPACE, THE SUBSET MAY ATF3300191* TIMES RESIDE IN THE SUBSET CONTROL TABLE. F3300192 SPC 2 F3300193* ALTERNATE NAMES FOR SUBSET WORDS F3300194ÐÐ EQU SAFCBI(FH+1) SUBSET ALTERNATE NAME FOR FCBIND F3300195 EQU SADATM(FH+2) SUBSET ALTERNATE NAME FOR NEDATM F3300196 EQU SADATL(FH+3) SUBSET ALTERNATE NAME FOR NEDATL F3300197 EQU SANXTM(FH+4) SUBSET ALTERNATE NAME FOR NEXTBM F3300198 EQU SANXTL(FH+5) SUBSET ALTERNATE NAME FOR NEXTBL F3300199* * * * F3300200 EJT F3300201FILLS ADC 0 ENTRY F3300202 STQ* QSAVE SAVE THE Q-REG F3300203 LDQ- I SAVE I-REG F3300204 STQ* ISAVE F3300205 SAN FS000 SKIP TO BUILD AN ENTRY F3300206 JMP* FS500 JUMP TO RELEASE AN ENTRY F3300207 EJT F3300208* INSURE A NEW ENTRY IS REQUIRED F3300209* F3300210FS000 LDA* QSAVE GET FCB ADDRESS F3300211 STA- I F3300212 LDA =XMAXCOP SEARCH UCT FOR CURRENT USER OF THE FILE F3300213 INA -1 F3300214 MUI =XUCTSIZ F3300215 ADD* ADRUCT F3300216 TRA Q F3300217FS010 LDA- FIDENT,Q GET FILE ID FROM UCT ENTRY F3300218 EOR* ISAVE COMPARE TO CALLING USER'S FILE ID F3300219ÐÐ SAZ FS020 SKIP IF SAME F3300220FS015 INQ -UCTSIZ COMPUTE NEXT UCT ENTRY ADDRESS F3300221 TRQ A F3300222 SUB* ADRUCT IS ALL OF TABLE CHECKED F3300223 SAM FS040 SKIP IF SO F3300224 JMP* FS010 F3300225* F3300226FS020 LDA- FSLADR,Q CHECK IF FILE SPACE LIMIT ENTRY IS USED F3300227 SAN FS030 SKIP IF SO F3300228 JMP* FS015 CONTINUE SEARCH F3300229* F3300230FS030 ENQ 0 ENTRY ALREADY EXISTS: EXIT TO CALLER F3300231 JMP* EXIT F3300232 EJT F3300233* F3300234* LOCATE AN AVAILABLE ENTRY SPACE F3300235* F3300236FS040 LDQ* ENDFSL SEARCH TABLE FOR AN EMPTY ENTRY SPOT F3300237 INQ -ENTYSZ+1 F3300238FS050 LDA- (ZERO),Q CHECK WORD 1 OF ENTRY F3300239 SAN FS060 SKIP IF OCCUPIED F3300240 LDA- 1,Q CHECK WORD 2 OF ENTRY F3300241 SAZ FS080 SKIP IF ENTRY IS AVAILABLE F3300242FS060 INQ -ENTYSZ COMPUTE NEXT ENTRY ADDRESS F3300243 TRQ A F3300244ÐÐ SUB* FSLTAD CHECK IF ALL OF TABLE IS SEARCHED F3300245 SAM FS070 SKIP IF SO F3300246 JMP* FS050 CONTINUE SEARCH F3300247* F3300248FS070 LDQ =N$9000 NO SPACE AVAILABLE F3300249 JMP* EXIT F3300250 EJT F3300251* F3300252* BUILD AN ENTRY F3300253* F3300254FS080 STQ* ENTRY SAVE ENTRY ADDRESS F3300255 LDA- DATBAM,I CONVERT FILE'S STARTING ADDRESS FROM SECTORS F3300256 LDQ- DATBAL,I TO WORDS F3300257 RTJ* CONVRT F3300258 STA* STMSB SAVE THE CONVERTED ADDRESS F3300259 STQ* STLSB F3300260 LDA- TSFILM,I CONVERT TOTAL NO. OF SECTORS IN FILE TO WORDS F3300261 LDQ- TSFILL,I F3300262 RTJ* CONVRT F3300263 STA* LGHMSB SAVE WORD LENGTH F3300264 STQ* LGHLSB F3300265 LDQ =XSTMSB ADD LENGTH TO FILE STARTING ADDRESS F3300266 RTJ DWADD F3300267* F3300268 LDA* OV CHECK FOR OVERFLOW F3300269ÐÐ SAZ FS090 SKIP IF NONE F3300270 JMP* CON005 SET ERROR INDICATION F3300271* F3300272FS090 LDQ* ENTRY STORE FILE'S WORD STARTING AND ENDING ADDRESS F3300273 LDA* STMSB IN THE TABLE ENTRY F3300274 STA- (ZERO),Q F3300275 LDA* STLSB F3300276 STA- 1,Q F3300277 LDA* ENDMSB F3300278 STA- 2,Q F3300279 LDA* ENDLSB F3300280 STA- 3,Q F3300281* F3300282 TRQ A RETURN TO CALLER F3300283 ENQ 0 F3300284 JMP* EXIT F3300285 SPC 3 F3300286* PARAMETER LIST FOR DOUBLE WORD ADD F3300287STMSB NUM 0 F3300288STLSB NUM 0 F3300289LGHMSB NUM 0 F3300290LGHLSB NUM 0 F3300291ENDMSB NUM 0 F3300292ENDLSB NUM 0 F3300293OV NUM 0 F3300294ÐÐ EJT F3300295ADRUCT ADC UCTABL ADDRESS OF UCT F3300296FSLTAD ADC FSLIMT START OF FSLT F3300297ENDFSL ADC FSLEND ENDING ADDR OF FSLT F3300298QSAVE NUM 0 F3300299ISAVE NUM 0 F3300300ENTRY NUM 0 SPARE ENTRY ADDRESS F3300301 EJT F3300302* THIS SUBROUTINE CONVERTS A SECTOR ADDRESS TO A WORD ADDRESS F3300303* F3300304* ON ENTRY: F3300305* A-REG = SECTOR ADDRESS (MSB) F3300306* Q-REG = SECTOR ADDRESS (LSB) F3300307* F3300308* ON EXIT: F3300309* A-REG = WORD ADDRESS (MSB) F3300310* Q-REG = WORD ADDRESS (LSB) F3300311* I-REG UNCHANGED F3300312* F3300313CONVRT ADC 0 ENTRY F3300314 STA* PLIST SET UP CALL TO DOUBLE WORD MULTIPLY F3300315 STQ* PLIST+1 F3300316 LDA* ISAVE GET FILE ID F3300317 ARS 11 F3300318 AND- ONEMSK+4 ($001F) F3300319ÐÐ TRA Q Q-REG CONTAINS FILE MANAGER LOGICAL UNIT NO. F3300320 LDQ MMLUTB,Q GET VIT ADDRESS F3300321 LDA- VIWPS,Q GET SECTOR SIZE F3300322 STA* PLIST+2 F3300323 LDQ =XPLIST F3300324 RTJ DWMUL MULTIPLY SECTOR ADDR TIMES NO. OF WORDS/SECT F3300325* F3300326 LDA* PLIST+5 CHECK FOR OVERFLOW F3300327 SAZ CON010 SKIP IF NONE F3300328CON005 LDQ =N$8400 EXIT WITH ERROR F3300329 JMP* EXIT F3300330* F3300331CON010 LDA* PLIST+3 RETURN RESULT TO CALLER F3300332 LDQ* PLIST+4 F3300333 JMP* (CONVRT) F3300334 SPC 3 F3300335PLIST BZS PLIST(6) PARAMETERS FOR DOUBLE WORD MULTIPLY F3300336 EJT F3300337* F3300338* RELEASE AN ENTRY F3300339* F3300340FS500 LDA =XMAXCOP COMPUTE ENDING ADDRESS OF UCT - 1 ENTRY F3300341 INA -1 F3300342 MUI =XUCTSIZ F3300343 ADD* ADRUCT F3300344ÐÐ TRA Q SAVE IN Q-REG F3300345FS510 LDA- FSLADR,Q SEARCH UCT FOR AN ENTRY USING THE FILE SPACE F3300346 EOR* ISAVE LIMIT ENTRY BEING RELEASED F3300347 SAN FS520 SKIP IF NOT FOUND F3300348 LDA- (UIDENT),Q IS THIS FOUND ENTRY THE RELEASING USER F3300349 EOR* QSAVE F3300350 SAN FS540 SKIP IF NOT: DON'T RELEASE THE ENTRY F3300351* F3300352FS520 INQ -UCTSIZ COMPUTE NEXT UCT ENTRY ADDRESS F3300353 TRQ A CHECK IF ALL OF UCT HAS BEEN SEARCHED F3300354 SUB* ADRUCT F3300355 SAM FS530 SKIP IF YES F3300356 JMP* FS510 F3300357* F3300358FS530 ENA 0 RELEASE THE ENTRY F3300359 LDQ* ISAVE F3300360 STA- (ZERO),Q F3300361 STA- 1,Q F3300362* F3300363FS540 TRQ A RETURN TO CALLER F3300364 ENQ 0 F3300365 EJT F3300366EXIT STA* QSAVE F3300367 LDA* ISAVE RESTORE I-REG F3300368 STA- I F3300369ÐÐ LDA* QSAVE F3300370 JMP (FILLS) RETURN TO CALLER F3300371 END F3300372 NAM FNDVIT F34 A ITOS CCS 3.0 SL-149F3400001* SEARCH VOLUME INFORMATION TABLES FOR A GIVEN VOLUME F3400002* CREDIT COLLECTION SYSTEM VERSION 3.0 F3400003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F3400004* COPYRIGHT CONTROL DATA CORPORATION 1979 F3400005* F3400006 SPC 1 F3400007**** F3400008* THIS ROUTINE SEARCHES THE CORE-RESIDENT VOLUME INFORMATION TABLESF3400009* FOR A MATCH AGAINST A PASSED VOLUME NAME. IF A MATCH IS FOUND F3400010* THEN THE CORE ADDRESS AND THE MASS MEMORY UNIT NO. OF THE F3400011* SELECTED VIT ARE RETURNED. IF NO MATCH IS FOUND, AN ADDRESS F3400012* OF ZERO IS RETURNED. F3400013 SPC 1 F3400014* CALLING SEQUENCE: F3400015* CALL FNDVIT (NAME, VITADR, MMUNIT) F3400016* PARAMETERS: F3400017* NAME - 4 WORD BUFFER CONTAINING THE VOLUME NAME. F3400018* VITADR - SELECTED VIT ADDRESS OR ZERO. F3400019* MMUNIT - VOLUME'S MASS MEMORY UNIT NO. (INDEX INTO THE F3400020* MMLUTB) F3400021 SPC 1 F3400022ÐÐ* EXIT: F3400023* RETURN TO CALLER WITH Q-REG AND I-REG PRESERVED. F3400024* THE COMMON BUFFER 'VIT' WILL BE RETURNED CONTAINING THE FOUND F3400025* VOLUME INFORMATION TABLE. F3400026 SPC 1 F3400027*E F3400028* ENTRY POINTS F3400029 SPC 1 F3400030 ENT FNDVIT FIND VIT ENTRY POINT F3400031 SPC 1 F3400032* EXTERNALS F3400033 SPC 1 F3400034 EXT MMLUTB NO. OF VOLUME INFORMATION TABLES F3400035 EXT Q8PREP PARAMETER ADDRESS ABSOLUTIZING ROUTINE F3400036 EXT Q8PKUP PARAMTERS ADDRESS PICKUP ROUTINE F3400037 SPC 1 F3400038* COMMON DECLARATIONS F3400039 SPC 1 F3400040 COM PCTABL PROCESSOR CONTROL TABLE ADDRESS F3400041 COM FCBMMA F3400042 COM BUF(572) F3400043 COM STATUS F3400044 COM VIT(21) F3400045 COM FDB(2) F3400046 COM FDS F3400047ÐÐ COM NUMSEC(2) F3400048 COM SPARE(106) F3400049**** F3400050 SPC 1 F3400051* EQUIVALENCES F3400052 SPC 1 F3400053* VOLUME INFORMATION TABLE F3400054 EQU VISLUN(2) SYSTEM LOGICAL UNIT NO. F3400055 EQU VINAME(1) FIRST WORD OF THE VOLUME NAME F3400056 EQU VITSIZ(20) SIZE OF A VIT - 1 F3400057* COMMUNICATIONS REGION CONSTANTS F3400058 EQU ZERO(2) ZERO F3400059*E F3400060 EJT F3400061* REQUEST PROCESSOR CONTROL TABLE F3400062* F3400063 EQU RP(10) INDEX TO START OF REQUEST PARAMETERS F3400064 EQU MR(RP+5) INDEX TO START OF MONITOR REQUEST PARAM LIST F3400065 EQU SS(MR+10) INDEX TO START OF SCRATCH PORTION OF PAR LIST F3400066* F3400067 EQU RPLOGU(1) LU NUMBER OF MM DEVICE F3400068 EQU RPAREQ(2) ACTIVE REQUEST FLAG (IF 0, NONE FOR TABLE) F3400069 EQU RPWAIT(3) START OF WAITING REQUEST QUEUE (IF 0, NO WAITGF3400070 EQU RPRLEV(4) REQUEST PRIORITY LEVEL - ACTIVE REQUEST F3400071 EQU RPRBF4(5) REQBUF ADDRESS - FIRST FOUR WORDS F3400072ÐÐ EQU RPLTEA(6) LOCK TABLE ENTRY (ABSOLUTE) ADDRESS F3400073 EQU RPRTNJ(7) RETURN JUMP TO REQUEST PROCESSOR F3400074 EQU RPPADR(8) PROCESSOR ADDRESS F3400075 SPC 1 F3400076* PARAMETER LIST FOR REQUEST PROCESSOR F3400077 EQU RPFCBA(9) FCB ADDRESS FOR FILE F3400078 EQU RPRBMP(RP+0) REQBUF ADDRESS - MAIN PART F3400079 EQU RPPFP1(RP+1) REQUEST PARAMETER ADDRESS - FIRST + 1 F3400080 EQU RPPFP2(RP+2) REQUEST PARAMETER ADDRESS - FIRST + 2 F3400081 EQU RPPFP3(RP+3) REQUEST PARAMETER ADDRESS - FIRST + 3 F3400082 EQU RPPFP4(RP+4) REQUEST PARAMETER ADDRESS - FIRST + 4 F3400083 SPC 1 F3400084* MAIN MONITOR REQUEST F3400085 EQU RPMREQ(MR+0) MONITOR REQUEST CODE WORD F3400086 EQU RPMRP1(MR+1) COMPLETION ADDRESS F3400087 EQU RPMRP2(MR+2) THREAD WORD F3400088 EQU RPMRP3(MR+3) LOGICAL UNIT FOR I/O F3400089 EQU RPMRP4(MR+4) NUMBER OF WORDS F3400090 EQU RPMRP5(MR+5) START CORE ADDRESS F3400091 EQU RPMRP6(MR+6) MASS MEMORY ADDRESS, MSB F3400092 EQU RPMRP7(MR+7) MASS MEMORY ADDRESS, LSB F3400093 EQU RPRCPT(MR+8) CONTROL POINT (FOR I/O REQUESTS) F3400094 EQU RPRETN(MR+9) SAVED RETURN ADDRESS F3400095* ALTERNATE COMMON NAMES F3400096 EQU REQBUF(RP+0) USERS FIRST CALL PARAMETER ADDRESS F3400097ÐÐ EQU ISTAT(RP+4) USERS COMPLETION STATUS PARAMETER ADDRESS F3400098 SPC 1 F3400099 EJT F3400100FNDVIT ADC 0 ENTRY F3400101 STQ* QSAVE SAVE Q-REG F3400102 LDA- I SAVE I-REG F3400103 STA* ISAVE F3400104 RTJ Q8PREP ABSOLUTIZE PARAMETER ADDRESS F3400105 ADC* FNDVIT F3400106HERE RTJ Q8PKUP F3400107 STA* NAME SAVE NAME BUFFER ADDRESS F3400108 RTJ* (HERE+1) F3400109 STA* VITADR SAVE VITADR PARAMETER ADDRESS F3400110 RTJ* (HERE+1) F3400111 STA* MMUNIT SAVE MMUNIT PARAMETER ADDRESS F3400112 EJT F3400113 ENQ 1 START SEARCH OVER THE TABLES F3400114 STQ* (MMUNIT) F3400115 SPC 1 F3400116TLOOP LDQ* (MMUNIT) SET Q TO CURRENT INDEX F3400117ADDR LDA MMLUTB,Q GET ADDRESS OF TABLE F3400118 STA- I F3400119 LDA- (VISLUN),I CHECK IF VOLUME IS MOUNTED F3400120 SAM ENDCHK SKIP IF NOT F3400121 LDA- I F3400122ÐÐ INA VINAME SAVE VOLUME NAME ADDR F3400123 STA- I F3400124 ENQ 3 CHECK ALL FOUR WORDS OF THE NAME F3400125NLOOP LDA* (NAME),Q F3400126 EOR- (ZERO),B F3400127 SAN ENDCHK SKIP IF NO MATCH OF THIS WORD F3400128 INQ -1 F3400129 SQM FOUND SKIP IF ALL 4 WORDS MATCH F3400130 JMP* NLOOP F3400131ENDCHK LDA* (MMUNIT) CHECK IF ALL TABLES HAVE BEEN EXAMINED F3400132 SUB* (ADDR+1) F3400133 SAN NEXT SKIP IF NOT F3400134 JMP* FAIL F3400135NEXT RAO* (MMUNIT) SET TO CHECK NEXT TABLE F3400136 JMP* TLOOP F3400137 SPC 1 F3400138FOUND LDA* (MMUNIT) F3400139 LDQ PCTABL STORE MMUNIT IN PCT F3400140 STA- RPLOGU,Q F3400141 LDA- I MOVE VIT TO COMMON BUFFER F3400142 INA -VINAME F3400143 STA- I F3400144 ENQ VITSIZ F3400145MOVVIT LDA- (ZERO),B TRANSFER A WORD AT A TIME F3400146 STA VIT,Q F3400147ÐÐ INQ -1 CHECK IF DONE F3400148 SQM DONE SKIP IF YES F3400149 JMP* MOVVIT F3400150DONE LDA- I RETURN VIT ADDRESS TO CALLER F3400151 JMP* EXIT F3400152 SPC 1 F3400153FAIL ENA 0 RETURN 'VIT NOT FOUND' INDICATOR TO CALLER F3400154 SPC 1 F3400155EXIT STA* (VITADR) RETURN VITADR PARAMETER TO CALLER F3400156 LDQ* QSAVE RESTORE Q-REG F3400157 LDA* ISAVE RESTORE I-REG F3400158 STA- I F3400159 JMP* (FNDVIT) RETURN TO CALLER F3400160 SPC 3 F3400161QSAVE NUM 0 SAVE Q-REG F3400162ISAVE NUM 0 SAVE I-REG F3400163NAME NUM 0 ADDRESS OF PARAMETER 'NAME' F3400164VITADR NUM 0 ADDRESS OF PARAMETER 'VITADR' F3400165MMUNIT NUM 0 ADDRESS OF PARAMETER 'MMUNIT' F3400166 SPC 1 F3400167 END F3400168 NAM MMIOF F35 A ITOS CCS 3.0 SL-149F3500001* FORTRAN INTERFACE TO MASS MEMORY READ/WRITE F3500002* CREDIT COLLECTION SYSTEM VERSION 3.0 F3500003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F3500004ÐÐ* COPYRIGHT CONTROL DATA CORPORATION 1979 F3500005* F3500006**** F3500007* F3500008* THIS ROUTINE PROVIDES A FORTRAN INTERFACE TO THE FILE MANAGER F3500009* MASS MEMORY READ AND WRITE SUBROUTINES. F3500010* F3500011* CALLING SEQUENCES: F3500012* CALL MREADF (SECADR, RELREC, RECLEN, NUMWDS, IOFSET, BUF, F3500013* FILEIO, ISTAT) F3500014* CALL MWRITF (SECADR, RELREC, RECLEN, NUMWDS, IOFSET, BUF, F3500015* FILEIO, ISTAT) F3500016* F3500017* PARAMETERS: F3500018* F3500019* SECADR - BASE SECTOR ADDRESS (MSB/LSB) F3500020* RELREC - RELATIVE RECORD NO. (MSB/LSB) F3500021* RECLEN - RECORD LENGTH F3500022* NUMWDS - NO. OF WORDS TO TRANSFER F3500023* IOFSET - WORD OFFSET FROM START OF RECORD TO BEGIN TRANSFER. F3500024* BUF - I/O BUFFER F3500025* FILEIO - FILE SPACE I/O INDICATOR: F3500026* =0 IF I/O IS TO OCCUR OUTSIDE OF FILE SPACE, F3500027* NON-ZERO OTHERWISE F3500028* ISTAT - COMPLETION STATUS SET ON RETURN TO CALLER: F3500029ÐÐ* BITS MEANING IF SET F3500030* ---- -------------- F3500031* 15 ERROR OCCURRED F3500032* 14* ADDRESS COMPUTATION ERROR F3500033* 13-6 UNUSED F3500034* 5* MASS MEMORY I/O ERROR F3500035* 4-0 UNUSED F3500036* * : BIT 15 WILL ALSO BIT SET F3500037* F3500038* F3500039* NOTE THAT ISTAT WILL BE SET TO ZERO IF NO ERROR IS NOTED. F3500040* F3500041* ENTRY POINTS F3500042* F3500043 ENT MREADF MASS MEMORY READ ROUTINE - FORTRAN INTERFACE F3500044 ENT MWRITF MASS MEMORY WRITE ROUTINE - FORTRAN INTERFACE F3500045* F3500046* EXTERNALS F3500047* F3500048 EXT MMREAD READ MASS MEMORY ROUTINE F3500049 EXT MMWRIT WRITE MASS MEMORY ROUTINE F3500050 EXT Q8PREP PREPARE TO PICKUP PARAMS F3500051 EXT Q8PKUP PICKUP ABSOLUTIZED PARAMETER ADDRESS F3500052* F3500053* EQUIVALENCES F3500054ÐÐ* F3500055 EQU ZERO(2) SYSTEM ZERO F3500056 EQU CLRBIT($33) ZERO BIT TABLE F3500057 EQU ONEBIT($23) ONE BIT TABLE F3500058* F3500059* COMMON F3500060* F3500061 COM PCTABL PROCESSOR CONTROL TABLE ADDRESS F3500062 COM FCBMMA F3500063 COM BUF(572) F3500064 COM STATUS F3500065 COM VIT(21) F3500066 COM FDB(2) F3500067 COM FDS F3500068 COM NUMSEC(2) F3500069 COM SPARE(106) F3500070**** F3500071 EJT F3500072MREADF NUM 0 ENTRY FOR READ F3500073 LDA* MREADF F3500074 STA* MWRITF TRANSFER PARAMETER LIST ADDRESS F3500075 STA* IOCODE SET IOCODE FOR READ F3500076 JMP* CONTIN F3500077* F3500078MWRITF NUM 0 ENTRY FOR WRITE F3500079ÐÐ CLR A F3500080 STA* IOCODE SET IOCODE FOR WRITE F3500081CONTIN STQ* QSAVE SAVE Q-REG F3500082 LDA- I F3500083 STA* ISAVE SAVE I-REG F3500084 RTJ Q8PREP PREPARE MMREAD/MMWRIT PARAMETER LIST F3500085 ADC* MWRITF F3500086ADDR RTJ Q8PKUP F3500087 TRA Q F3500088 LDA- (ZERO),Q F3500089 STA* PLIST SECTOR ADDRESS, MSB F3500090 LDA- 1,Q F3500091 STA* PLIST+1 SECTOR ADDRESS, LSB F3500092 RTJ* (ADDR+1) F3500093 TRA Q F3500094 LDA- (ZERO),Q F3500095 STA* PLIST+2 RELATIVE RECORD NO., MSB F3500096 LDA- 1,Q F3500097 STA* PLIST+3 RELATIVE RECORD NO., LSB F3500098 RTJ* (ADDR+1) F3500099 TRA Q F3500100 LDA- (ZERO),Q F3500101 STA* PLIST+4 RECLEN F3500102 RTJ* (ADDR+1) F3500103 TRA Q F3500104ÐÐ LDA- (ZERO),Q F3500105 STA* PLIST+5 NUMWDS F3500106 RTJ* (ADDR+1) F3500107 TRA Q F3500108 LDA- (ZERO),Q F3500109 STA* PLIST+6 IOFSET F3500110 RTJ* (ADDR+1) F3500111 STA* PLIST+7 BUFFER ADDRESS F3500112 RTJ* (ADDR+1) F3500113 TRA Q F3500114 LDA- (ZERO),Q F3500115 STA* PLIST+8 FILE I/O FLAG F3500116 RTJ* (ADDR+1) F3500117 STA* STAT COMPLETION STATUS ADDRESS F3500118* F3500119 LDA PCTABL CALL APPROPRIATE ROUTINE F3500120 STA- I F3500121 LDQ =XPLIST F3500122 LDA* IOCODE F3500123 SAZ WRIT F3500124 RTJ MMREAD F3500125 JMP* CHKSTA F3500126WRIT RTJ MMWRIT F3500127* F3500128CHKSTA CLR A F3500129ÐÐ SQP EXIT SKIP IF NO ERROR F3500130 LDA* (STAT) F3500131 INQ 0 CHECK FOR I/O ERROR F3500132 SQN IOERR SKIP IF SO F3500133 AND- CLRBIT+14 ($BFFF) SET BIT 14 TO INDICATE A COMPUTATION F3500134 EOR- ONEBIT+14 ERROR F3500135IOERR AND =N$7FDF INDICATE I/O ERROR F3500136 EOR =N$8020 F3500137EXIT STA* (STAT) SET STATUS FOR THIS I/O F3500138 LDQ* QSAVE RESTORE Q AND I REGS F3500139 LDA* ISAVE F3500140 STA- I F3500141 JMP* (MWRITF) RETURN TO CALLER F3500142 SPC 3 F3500143PLIST BZS PLIST(9) MM I/O PARAMETER LIST F3500144IOCODE NUM 0 IO CODE: ZERO FOR WRITE ELSE READ F3500145QSAVE NUM 0 SAVE Q-REG F3500146ISAVE NUM 0 SAVE I-REG F3500147STAT NUM 0 COMPLETION STATUS ADDRESS F3500148 END F3500149 NAM FDWMTH F36 A ITOS CCS 3.0 SL-149F3600001* FORTRAN INTERFACE TO DOUBLE WORD ADD/SUBTRACT/MULTIPLY F3600002* CREDIT COLLECTION SYSTEM VERSION 3.0 F3600003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F3600004* COPYRIGHT CONTROL DATA CORPORATION 1979 F3600005ÐÐ* F3600006**** F3600007* F3600008* THIS ROUTINE PROVIDES A FORTRAN INTERFACE TO THE FILE MANAGER F3600009* DOUBLE WORD MATH ROUTINES. F3600010* F3600011* CALLING SEQUENCES: F3600012* CALL FDWADD (OP1, OP2, RESULT, OV) F3600013* CALL FDWSUB (OP1, OP2, RESULT, OV) F3600014* CALL FDWMUI (OP1, OP3, RESULT, OV) F3600015* F3600016* PARAMETERS: F3600017* OP1 - FIRST OPERAND (MSB/LSB) F3600018* OP2 - SECOND OPERAND (MSB/LSB) (SUBTRAHEND) F3600019* OP3 - SINGLE WORD OPERAND F3600020* RESULT - COMPUTATION RESULT (MSB/LSB) F3600021* OV - OVERFLOW INDICATOR: F3600022* =0 IF NONE OCCURRED F3600023* =1 IF ONE DID OCCUR F3600024* F3600025* ENTRY POINTS F3600026* F3600027 ENT FDWADD FORTRAN INTERFACE FOR DOUBLE WORD ADD F3600028 ENT FDWSUB FORTRAN INTERFACE FOR DOUBLE WORD SUBTRACT F3600029 ENT FDWMUI FORTRAN INTERFACE FOR DOUBLE WORD MULTIPLY F3600030ÐÐ* F3600031* EXTERNALS F3600032* F3600033 EXT Q8PREP PREPARE TO PICKUP PARAMETERS F3600034 EXT Q8PKUP PICKUP ABSOLUTIZED PARAMETER ADDRESS F3600035 EXT DWADD DOUBLE WORD ADD ROUTINE F3600036 EXT DWSUB DOUBLE WORD SUBTRACT ROUTINE F3600037 EXT DWMUL DOUBLE WORD MULTIPLY ROUTINE F3600038**** F3600039* F3600040* EQUIVALENCES F3600041* F3600042 EQU ZERO(2) SYSTEM ZERO F3600043 EJT F3600044FDWADD ADC 0 ENTRY FOR ADD F3600045 LDA* FDWADD F3600046 STA* FDWMUI TRANSFER PARAMETER ADDRESS F3600047 ENA 0 F3600048 STA* OPTYPE SET OPERATOR CODE TO ADD F3600049 JMP* CONTIN F3600050* F3600051FDWSUB ADC 0 ENTRY FOR SUBTRACT F3600052 LDA* FDWSUB F3600053 STA* FDWMUI TRANSFER PARAMETER ADDRESS F3600054 ENA 3 F3600055ÐÐ STA* OPTYPE SET OPERATOR CODE TO SUBTRACT F3600056 JMP* CONTIN F3600057* F3600058FDWMUI ADC 0 ENTRY FOR MULTIPLY F3600059 ENA 6 F3600060 STA* OPTYPE SET OPERATOR CODE TO MULTIPLY F3600061 EJT F3600062CONTIN STQ* QSAVE SAVE Q-REG F3600063 LDA- I SAVE I-REG F3600064 STA* ISAVE F3600065* F3600066 RTJ Q8PREP ABSOLUTIZE PARAMETERS FOR F.M. ROUTINES F3600067 ADC* FDWMUI F3600068ADR RTJ Q8PKUP F3600069 TRA Q F3600070 LDA- (ZERO),Q F3600071 STA* PLIST OP1 MSB F3600072 LDA- 1,Q F3600073 STA* PLIST+1 OP1 LSB F3600074 RTJ* (ADR+1) F3600075 TRA Q F3600076 LDA- (ZERO),Q F3600077 STA* PLIST+2 OP2 (MSB) OR OP3 F3600078 LDA* OPTYPE LIST FORMAT DIFFERS FOR ADD/SUB AND MUI F3600079 INA -6 F3600080ÐÐ SAM ADDSUB F3600081 RTJ* (ADR+1) F3600082 STA* RESULT ADDRESS OF RESULT F3600083 RTJ* (ADR+1) F3600084 STA* OVADR OVERFLOW STATUS ADDRESS F3600085 JMP* COMPUT F3600086* F3600087ADDSUB LDA- 1,Q F3600088 STA* PLIST+3 OP2 (LSB) F3600089 RTJ* (ADR+1) F3600090 STA* RESULT ADDRESS OF RESULT F3600091 RTJ* (ADR+1) F3600092 STA* OVADR OVERFLOW STATUS ADDRESS F3600093 EJT F3600094COMPUT LDQ =XPLIST GO CALL APPROPRIATE ROUTINE F3600095 LDA* OPTYPE F3600096 STA- I F3600097 NUM $1901 F3600098* F3600099 RTJ DWADD ADD F3600100 JMP* RET F3600101 RTJ DWSUB SUBTRACT F3600102 JMP* RET F3600103 RTJ DWMUL MULTIPLY F3600104 EJT F3600105ÐÐRET LDQ* RESULT RETURN RESULT TO CALLER F3600106 LDA* OPTYPE F3600107 INA -6 F3600108 SAM AS F3600109 LDA* PLIST+3 F3600110 STA- (ZERO),Q F3600111 LDA* PLIST+4 F3600112 STA- 1,Q F3600113 LDA* PLIST+5 F3600114 JMP* EXIT F3600115* F3600116AS LDA* PLIST+4 F3600117 STA- (ZERO),Q F3600118 LDA* PLIST+5 F3600119 STA- 1,Q F3600120 LDA* PLIST+6 F3600121 SPC 3 F3600122EXIT STA* (OVADR) RETURN OVERFLOW STATUS F3600123 LDQ* QSAVE RESTORE Q AND I REGISTERS F3600124 LDA* ISAVE F3600125 STA- I F3600126 JMP* (FDWMUI) RETURN TO CALLER F3600127 SPC 3 F3600128PLIST BZS PLIST(7) F3600129QSAVE NUM 0 F3600130ÐÐISAVE NUM 0 F3600131RESULT NUM 0 F3600132OVADR NUM 0 OVERFLOW STATUS ADDRESS F3600133OPTYPE NUM 0 F3600134 END F3600135 NAM DWDIV F37 A ITOS CCS 3.0 SL-149F3700001* DOUBLE WORD DIVIDE ROUTINE F3700002* CREDIT COLLECTION SYSTEM VERSION 3.0 F3700003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F3700004* COPYRIGHT CONTROL DATA CORPORATION 1979 F3700005* F3700006**** F3700007* F3700008* PROGRAMMING SPECIFICATIONS 39418700 AND 84983700 GIVE DETAILED F3700009* INFORMATION ON DOUBLE WORD ARITHMETIC. F3700010* F3700011* F3700012* DOUBLE WORD DIVIDE F3700013* F3700014* CALL SEQUENCE IS: F3700015* F3700016* CALL DWDIV (DWV,SWV,DWRES,ISTAT) F3700017* F3700018* WHERE DWV IS A DOUBLE WORD VALUE F3700019* SWV IS A SINGLE WORD VALUE (DIVISOR) F3700020ÐÐ* DWRES IS THE DOUBLE WORD RESULT F3700021* ISTAT IS THE COMPLETION STATUS F3700022* 0 IF GOOD, ELSE NON-ZERO F3700023* F3700024 ENT DWDIV SUBROUTINE ENTRY POINT F3700025* F3700026 EXT Q8PREP PREPARE TO PICKUP PARAMETERS F3700027 EXT Q8PKUP PICKUP ABSOLUTIZED PARAMETER ADDRESS F3700028**** F3700029* F3700030 EQU ZERO($22) SYSTEM ZERO F3700031 EQU LPMSK(2) MASK TABLE F3700032 SPC 2 F3700033DWDIV 000 000 F3700034 STQ* QSAVE SAVE Q-REG F3700035* F3700036 RTJ Q8PREP PREPARE TO PICKUP PARAMS F3700037 ADC* DWDIV F3700038DWD10 RTJ Q8PKUP PICKUP DWV AND SAVE BOTH WORDS F3700039 TRA Q F3700040 LDA- (ZERO),Q F3700041 STA* DWVMSB MSB F3700042 LDA- 1,Q F3700043 STA* DWVLSB LSB F3700044 RTJ* (DWD10+1) PICKUP SWV AND SAVE IT F3700045ÐÐ TRA Q F3700046 LDA- (ZERO),Q F3700047 STA* SWV F3700048 RTJ* (DWD10+1) PICKUP DWRES AND SAVE IT F3700049 STA* DWRES F3700050 RTJ* (DWD10+1) PICKUP ISTAT ADDRESS AND SAVE IT F3700051 STA* ISTAT F3700052 CLR A CLEAR STATUS TO 'GOOD' STATUS F3700053 STA* (ISTAT) F3700054* F3700055 LDA* LRSINS PICK-UP LRS 1 INSTRUCTION F3700056 STA* LRS1 STORE IT IN LOGIC F3700057 EJT F3700058 LDA* SWV FIRST, ASSURE THE SWV IS NON-ZERO POSITIVE F3700059 SAZ ERROR ELSE ERROR F3700060 SAM ERROR F3700061 LDQ* DWVMSB CHECK MSB - MUST BE POSITIVE F3700062 SQM ERROR ELSE ERROR F3700063 LDA* DWVLSB CHECK LSB - MUST BE POSITIVE F3700064 SAM ERROR ELSE ERROR F3700065 SQN PROCED ASSURE THAT MSB AND LSB ARE NOT BOTH ZERO F3700066 SAN PROCED ELSE ERROR F3700067ERROR RAO* (ISTAT) SET COMP STATUS TO 1 AND EXIT F3700068 JMP* EXIT F3700069* F3700070ÐÐPROCED ALS 1 MAKE DIVIDEND INTO A 30 BIT NUMBER F3700071 LRS 1 F3700072 STA* TEMP+1 SAVE IN CASE OF OVERFLOW F3700073 STQ* TEMP F3700074DVI SOV 0 CLEAR OVERFLOW INDICATOR F3700075 DVI* SWV DIVIDE BY DIVISOR F3700076 SNO OUT IF NO OVERFLOW ON DIVIDE, WE'RE OK F3700077 LDQ* TEMP F3700078 LDA* TEMP+1 IF SO, DIVIDE NO. BY FACTOR OF 2, TRY AGAIN F3700079LRS1 ADC 0 F3700080 RAO* LRS1 READY FOR NEXT PASS F3700081 JMP* DVI F3700082OUT STQ* TEMP+2 SAVE REMAINDER AND DIVIDEND F3700083 STA* TEMP+3 F3700084 LDA* LRS1 CK NO TIMES SHIFTED F3700085 SUB* LRSINS F3700086 TRA Q PUT INTO Q F3700087 INA -16 F3700088 SAM OK CK FOR LESS THAN 16 F3700089 JMP* ERROR NO, GO SET ERROR STATUS AND EXIT F3700090OK TCA A F3700091 ADD* ALS GET 15-CNT AND SET UP SHIFT INSTRUCTIONS F3700092 STA* ALS1 TO PACK ANSWER BEFORE LEAVING F3700093 STA* ALS2 F3700094 EOR* SWITCH SWITCH TO A LRS F3700095ÐÐ STA* LRS2 F3700096 STA* LRS3 F3700097 LDA* DWVLSB F3700098 SAP 1 F3700099 TCA A F3700100 AND- LPMSK,Q WORK WITH REMAINING LSB'S F3700101 LDQ* TEMP+2 GET REMAINDER FROM FIRST PART F3700102 SQP 1 F3700103 TCQ Q MAKE SIGNS BOTH POSITIVE F3700104ALS2 ADC 0 F3700105 EJT F3700106LRS3 ADC 0 F3700107 DVI* SWV DO DIVIDE F3700108 LDQ* TEMP+3 PICK MSB OF NUM FROM FIRST PART F3700109 SQM B1 F3700110 SAP ALS1 MAKE SIGN OF A AGREE WITH Q F3700111 TCA A F3700112 JMP* ALS1 F3700113B1 SAM ALS1 F3700114 TCA A F3700115ALS1 ADC 0 PACK ANSWER F3700116LRS2 ADC 0 F3700117 LLS 1 CONVERT TO SPECIAL DOUBLE PRECISION FORMAT F3700118 ALS 15 F3700119 STQ* (DWRES) STORE RESULT FOR USER F3700120ÐÐ RAO* DWRES F3700121 STA* (DWRES) F3700122EXIT LDQ* QSAVE RESTORE Q-REG AND RETURN F3700123 JMP* (DWDIV) RETURN TO CALLER F3700124 SPC 4 F3700125* PROGRAM CONSTANTS AND BUFFERS F3700126DWVLSB NUM 0 F3700127DWVMSB NUM 0 F3700128QSAVE NUM 0 F3700129ISTAT NUM 0 F3700130SWV NUM 0 F3700131DWRES NUM 0 F3700132LRSINS LRS 1 LONG RIGHT SHIFT 1 INSTRUCTION F3700133ALS ALS 0 F3700134CNT ADC 0 COUNTING CELL F3700135SWITCH NUM $00A0 SWITCH AN (ALS) TO A (LRS) F3700136ASAVE ADC 0 F3700137 BSS TEMP(4) TEMP STORAGE F3700138 END F3700139 NAM IOVCHK F38 A ITOS CCS 3.0 SL-149F3800001* FORTRAN INTERFACE TO REQBUF/ISTAT OVERLAP CHECK ROUTINE F3800002* CREDIT COLLECTION SYSTEM VERSION 3.0 F3800003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F3800004* COPYRIGHT CONTROL DATA CORPORATION 1979 F3800005* F3800006ÐÐ**** F3800007* F3800008* THIS IS THE FORTRAN INTERFACE TO THE CM SUBROUTINE WHICH VERIFIESF3800009* THAT NO OUTPUT PARAMETER OVERLAPS WITH THE REQUEST BUFFER. F3800010* F3800011* THIS IS AN INTEGER FUNCTION; IT RETURNS IN RA F3800012* 0 = GOOD F3800013* NON-ZERO-BAD F3800014* CALLING SEQUENCE F3800015* IFLAG = IOVCHK (BUFFER, LENGTH) F3800016* WHERE BUFFER IS THE ABSOLUTE ADDR OF THE BUFFER TO F3800017* BE CHECKED F3800018* F3800019* LENGTH IS THE ADDR WHICH CONTAINS THE LENGTH F3800020* OF THE BUFFER F3800021* F3800022 ENT IOVCHK SUBROUTINE ENTRY POINT F3800023 EXT Q8PREP PREPARE TO PICKUP PARAMETER ADDRESS F3800024 EXT Q8PKUP PICKUP ABSOLUTIZED PARAMETER ADDRESS F3800025 EXT FMCOVL CHECK FOR OVERLAPPING PARAMETERS ROUTINE F3800026* F3800027 EQU ZERO(2) CONSTANT ZERO F3800028* F3800029 COM PCTADR ADDR OF PCT F3800030**** F3800031ÐÐ EJT 0 F3800032IOVCHK NOP 0 ENTRY POINT F3800033 STQ* QSAVE F3800034 LDQ- I SAVE REG Q, I F3800035 STQ* ISAVE F3800036 RTJ Q8PREP F3800037 ADC* IOVCHK F3800038IOV5 RTJ Q8PKUP F3800039 STA* ADRTMP ADDR OF BUFFER TO CHECK F3800040 RTJ* (IOV5+1) F3800041 TRA Q PICK UP ADDR OF LENGTH F3800042 LDQ- (ZERO),Q GET VALUE FOR LENGTH F3800043* F3800044 LDA PCTADR F3800045 STA- I F3800046* F3800047 LDA* ADRTMP F3800048 RTJ FMCOVL GO CHECK PARAMETER F3800049 LDQ* ISAVE VALUE IN A ALREADY F3800050 STQ- I F3800051 LDQ* QSAVE RESTORE REGS F3800052 JMP* (IOVCHK) F3800053QSAVE NUM 0 F3800054ISAVE NUM 0 F3800055ADRTMP NUM 0 ADDR OF BUFFER, SAVED HERE F3800056ÐÐ END F3800057 NAM OPENFL F39 A ITOS CCS 3.0 SL-149F3900001* FILE MANAGER OPEN FILE REQUEST PROCESSOR F3900002* CREDIT COLLECTION SYSTEM VERSION 3.0 F3900003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F3900004* COPYRIGHT CONTROL DATA CORPORATION 1979 F3900005* F3900006**** F3900007* F3900008* THIS ROUTINE PROCESSES REQUESTS TO THE FILE MANAGER TO OPEN A FILE. F3900009* F3900010* TO OPEN A FILE MEANS TO: F3900011* - INITIALIZE THE REQUEST BUFFER FOR SUBSEQUENT FILE MANAGER USE. F3900012* - BRING THE FILE'S FCB INTO MAIN MEMORY. F3900013* - BUILD THE USER CONTROL TABLE ENTRY. F3900014* F3900015* RESTRICTIONS: F3900016* 1. SECTOR LENGTH (IN WORDS) MUST BE LESS THAN OR EQUAL TO 572 WORDS.F3900017* THE CORFCB AND COMPRS ROUTINES (MODULES OF THE CORFCB SECONDARY F3900018* PROCESSOR) MUST BE CHANGED IF A LARGER SECTOR SIZE IS USED. F3900019*E F3900020 EJT F3900021* CALLING SEQUENCE: F3900022* F3900023* CALL OPENFL (IFCBAD, REQBUF, IDATA, ISTAT) F3900024ÐÐ* F3900025* PARAMETERS: F3900026* F3900027* IFCBAD - FILE CONTROL BLOCK ADDRESS. UNUSED. F3900028* REQBUF - 24 WORD BUFFER. F3900029* WORD 10 WILL SPECIFY THE FCB BUFFER ADDRESS IF THE FCB IS F3900030* TO BE IN USER SPACE. F3900031* WORD 13 WILL BE USED TO SPECIFY THE LENTH THE FCB BUFFER F3900032* IN USER SPACE IF NON-ZERO. F3900033* IDATA - 15 WORD BUFFER DEFINING REQUEST PARAMETERS. F3900034* WORD CONTENTS F3900035* ---- -------- F3900036* 1-4 FILE NAME. 8 ASCII CHARACTERS. F3900037* 5-8 FILE OWNER NAME. 8 ASCII CHARACTERS. F3900038* 9-12 FILE'S VOLUME NAME. IF WORD 9 IS ZERO OR BLANK, F3900039* ($2020), THIS NAME IS FILLED ON RETURN TO CALLER.F3900040* 13 FILE COMPRESSION/RECORD RETRIEVAL MODE FLAG: F3900041* -1 FOR FILE COMPRESSION F3900042* -2 FOR 'SPECIAL PROCESSING' F3900043* 0 FOR RETRIEVAL BY RELATIVE RECORD NO. F3900044* 1 TO 4 FOR RETRIEVAL BY SPECIFIED KEY INDEX. F3900045* 14 NO. OF RECORDS TO BE RETRIEVED BY EACH READ: F3900046* 15 LOCK FLAG: F3900047* NEGATIVE IF FILE TO BE LOCKED. F3900048* 0 IF NO LOCKING REQUIRED. F3900049ÐÐ* NON-ZERO POSITIVE IF RECORD LOCKING REQUIRED. F3900050* F3900051* ISTAT - COMPLETION STATUS SET ON RETURN TO CALLER: F3900052* BIT MEANING F3900053* --- ------- F3900054* 15 FILE REQUEST REJECTED. F3900055* 14* FILE REQUEST ILLEGAL. F3900056* 13* VOLUME NOT READY. F3900057* 12* MAX. NO. OF OPEN FILES OBTAINS. DELAY AND RETRY. F3900058* 11* MAX. NO. OF OPEN FILES FOR THIS USER OBTAINS. F3900059* 10* FILE MANAGER INTERNAL ERROR. F3900060* 9 FILE LAST OPENED FOR COMPRESSION BUT NOT COM- F3900061* PLETED. MUST BE OPENED FOR COMPRESSION. F3900062* 8-6 UNUSED. F3900063* 5* MASS MEMORY I/O ERROR. F3900064* 4-3 UNUSED. F3900065* 2* FILE IS LOCKED. F3900066* 1* FILE COULD NOT BE LOCATED. F3900067* 0 FILE IS OPEN. IF BIT 15 IS SET THE REQUEST F3900068* IS REJECTED. F3900069* * : BIT 15 WILL ALSO BE SET. F3900070*E F3900071 EJT F3900072* F3900073* ENTRY POINTS F3900074ÐÐ* F3900075 ENT OPENFL F3900076* F3900077* EXTERNALS F3900078* F3900079 EXT Q8PREP ABSOLUTIZE PARAMETER ADDRESS F3900080 EXT Q8PKUP PICK UP PARAMETER ADDRESS F3900081 EXT FMCOVL CHECK FOR OVERLAPPING PARAMETERS F3900082 EXT CKRQST CHECK REQUEST FEASABILITY F3900083 EXT UCTMGR USER CONTROL TABLE INTERFACE F3900084 EXT UCTABL USER CONTROL TABLE F3900085 EXT MOVFCB MOVE FCB F3900086 EXT FCBSS BUILD/RELEASE THE FCB SHARED SUBSET F3900087 EXT FILLS BUILD/RELEASE THE FILE LIMIT ENTRY F3900088 EXT FMUFCB UPDATE FCB ON MASS MEMORY F3900089 EXT FMSCOM FILE MANAGER COMPLETION F3900090 EXT MMWRIT MASS MEMORY WRITE SUBROUTINE F3900091 EXT CCP CURRENT CONTROL POINT LOCATION F3900092 EXT SYFAIL SYSTEM FAILURE ROUTINE F3900093 EXT FMEOFC END OF FILE CODE F3900094* F3900095* COMMON F3900096* F3900097 COM PCTABL PROCESSOR CONTROL TABLE ADDRESS F3900098 COM FCBMMA FCB MAIN MEMORY ADDR (SET BY EXECUTIVE) F3900099ÐÐ COM BUF(572) SCRATCH BUFFER F3900100 COM STATUS MODULE COMPLETION STATUS F3900101 COM VIT(21) VOLUME INFORMATION TABLE F3900102 COM FDB(2) FDB OF FILE BLOCK NO. F3900103 COM FDS INDEX INTO FDB TO FILE'S FDS F3900104 COM MMUNIT FILE'S MASS MEMORY UNIT NO. F3900105 COM SIZE WORDS/SECTOR OF VOLUME F3900106 COM FILE PSUEDO FILE ID F3900107 COM INITCM INITIAL OPEN FOR COMPRESSION FLAG F3900108 COM SPARE(104) SPARE WORDS. F3900109**** F3900110* F3900111* EQUIVALENCES F3900112* F3900113* CONSTANTS F3900114 EQU ZERO(2) F3900115 EQU ZROMSK($13) F3900116 EQU ONEMSK(3) F3900117 EQU ONEBIT($23) F3900118 EQU CLRBIT($33) F3900119 EQU UCTSIZ(6) SIZE OF A UCT ENTRY F3900120 EQU MXSCLN($C0) MAXIMUM SECTOR LENGTH PERMITTED BY OPENFL F3900121 EJT F3900122 EJT F3900123* REQUEST BUFFER INDEXES - FIRST 4 WORDS F3900124ÐÐ EQU RBATHR(0) REQUEST BUFFER ADDRESS THREAD F3900125 EQU BUFAMP(1) BUFFER ADDRESS MAIN PART F3900126 EQU CNTLPT(2) CONTROL POINT (OR SPARE) F3900127 EQU RQINFO(3) REQUEST INFORMATION (MULTI-FIELD) F3900128* BITS USE F3900129* 15-12 SPARE F3900130* 11-04 REQUEST INDEX F3900131* 03-00 LEVEL OF REQUESTOR F3900132* F3900133* REQUEST BUFFER INDEXES - MAIN PART F3900134 EQU QREG(0) Q REGISTER F3900135 EQU IREG(1) I REGISTER F3900136 EQU PARLST(2) ADDRESS OF PARAMETER LIST F3900137 EQU RTNADR(2) RETURN ADDRESS TO USER (UPON RETURN FROM EXEC)F3900138 EQU UCTADR(3) UCT ENTRY ABSOLUTE ADDRESS F3900139 EQU USERID(4) USER IDENTIFIER F3900140 EQU FCBADR(5) FCB ADDRESS (MAY BE SET BY CALLER OR INTCPTR.)F3900141 EQU RADINT(6) RETURN ADDRESS TO INTERCEPTOR F3900142 EQU RPIDX(7) REQUEST PROCESSOR INDEX F3900143* BITS 14-00 REQUEST PROCESSOR INDEX F3900144* BIT 15 TYPE OF PROCESSOR F3900145* =0, SERIAL PROCESSOR F3900146* =1, REENTRANT PROCESSOR F3900147 EQU LOKREC(8) NUMBER OF RECORDS TO BE READ/WRITTEN PER I/O F3900148* CALL AND LOCK RECORDS ON RETRIEVE FLAG F3900149ÐÐ* BITS 14-00 NUMBER OF RECORDS PER CALL F3900150* BIT 15 =0, DO NOT LOCK ON RETRIEVE F3900151* =1, LOCK RECORDS ON RETRIEVE F3900152 EQU USEFLG(9) TYPE OF FILE USE FLAG F3900153* -1, OPEN FOR COMPRESSION F3900154* -2, OPEN FOR SPECIAL PROCESSING F3900155* 0, OPEN FOR ACESS VIA REL REC NO F3900156* 1, OPEN FOR RETRIEVAL VIA KEY 1 F3900157* 2, OPEN FOR RETRIEVAL VIA KEY 2 F3900158* 3, OPEN FOR RETRIEVAL VIA KEY 3 F3900159* 4, OPEN FOR RETRIEVAL VIA KEY 4 F3900160 EQU NUMREC(10) NUMBER OF RECORDS ACTUALLY STORED/RETRIEVED F3900161 EQU RRNMSB(11) REL REC NUMBER OF STORED/RETRIEVED REC, MSB F3900162 EQU RRNLSB(12) REL REC NUMBER OF STORED/RETRIEVED REC, LSB F3900163 EQU SAVMSB(13) F3900164 EQU SAVLSB(14) F3900165 EQU SAVREC(15) F3900166* SCRATCH FOR COMSEQ F3900167* F3900168 EQU PRCRNM(16) RRN OF LAST PROCESSED RECORD, MSB F3900169 EQU PRCRNL(17) RRN OF LAST PROCESSED RECORD, LSB F3900170 EQU NETRNM(18) RRN OF THE LATEST 'NEW' RECORD - MSB F3900171 EQU NETRNL(19) RRN OF THE LATEST 'NEW' RECORD - LSB F3900172 EQU RMPLEN(20) LENGTH OF REQBUF MAIN PART F3900173 EJT F3900174ÐÐ* REQUEST PROCESSOR CONTROL TABLE F3900175* F3900176 EQU RP(10) INDEX TO START OF REQUEST PARAMETERS F3900177 EQU MR(RP+5) INDEX TO START OF MONITOR REQUEST PARAM LIST F3900178 EQU SS(MR+10) INDEX TO START OF SCRATCH PORTION OF PAR LIST F3900179* F3900180 EQU RPLOGU(1) LU NUMBER OF MM DEVICE F3900181 EQU RPAREQ(2) ACTIVE REQUEST FLAG (IF 0, NONE FOR TABLE) F3900182 EQU RPWAIT(3) START OF WAITING REQUEST QUEUE (IF 0, NO WAITGF3900183 EQU RPRLEV(4) REQUEST PRIORITY LEVEL - ACTIVE REQUEST F3900184 EQU RPRBF4(5) REQBUF ADDRESS - FIRST FOUR WORDS F3900185 EQU RPLTEA(6) LOCK TABLE ENTRY (ABSOLUTE) ADDRESS F3900186 EQU RPRTNJ(7) RETURN JUMP TO REQUEST PROCESSOR F3900187 EQU RPPADR(8) PROCESSOR ADDRESS F3900188 SPC 1 F3900189* PARAMETER LIST FOR REQUEST PROCESSOR F3900190 EQU RPFCBA(9) FCB ADDRESS FOR FILE F3900191 EQU RPRBMP(RP+0) REQBUF ADDRESS - MAIN PART F3900192 EQU RPPFP1(RP+1) REQUEST PARAMETER ADDRESS - FIRST + 1 F3900193 EQU RPPFP2(RP+2) REQUEST PARAMETER ADDRESS - FIRST + 2 F3900194 EQU RPPFP3(RP+3) REQUEST PARAMETER ADDRESS - FIRST + 3 F3900195 EQU RPPFP4(RP+4) REQUEST PARAMETER ADDRESS - FIRST + 4 F3900196 SPC 1 F3900197* MAIN MONITOR REQUEST F3900198 EQU RPMREQ(MR+0) MONITOR REQUEST CODE WORD F3900199ÐÐ EQU RPMRP1(MR+1) COMPLETION ADDRESS F3900200 EQU RPMRP2(MR+2) THREAD WORD F3900201 EQU RPMRP3(MR+3) LOGICAL UNIT FOR I/O F3900202 EQU RPMRP4(MR+4) NUMBER OF WORDS F3900203 EQU RPMRP5(MR+5) START CORE ADDRESS F3900204 EQU RPMRP6(MR+6) MASS MEMORY ADDRESS, MSB F3900205 EQU RPMRP7(MR+7) MASS MEMORY ADDRESS, LSB F3900206 EQU RPRCPT(MR+8) CONTROL POINT (FOR I/O REQUESTS) F3900207 EQU RPRETN(MR+9) SAVED RETURN ADDRESS F3900208 EJT F3900209* FILE CONTROL BLOCK EQUIVALENCES F3900210 EQU FH(4) LENGTH -1 OF FCB HEADER F3900211 EQU FILEID(ZERO) FILE IDENTIFIER F3900212* ACCESS FILEID INDIRECTLY F3900213* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBERF3900214* BITS 10-00 INDEX OF FCB IN FCB TABLE F3900215 EQU FCBFLG(1) FCB FLAGS F3900216* BITS 15-8, SPARE F3900217* BITS 7-00, NUMBER OF USERS USING FILE F3900218 EQU FILOCK(2) FILE LOCK FLAG (IF NON-0, CONTAINS USER ID) F3900219 EQU NUMSET(3) NUMBER OF SETS OF LOCKED RECORDS IN FILE F3900220 EQU NUMNEW(4) NUMBER OF NEW RECORDS SINCE FCB UPDATED ON MM F3900221 SPC 1 F3900222 EQU RECLEN(FH+1) RECORD LENGTH IN WORDS F3900223 EQU TDATRM(FH+2) TOTAL NUMBER OF DATA RECORDS, MSB F3900224ÐÐ EQU TDATRL(FH+3) TOTAL NUMBER OF DATA RECORDS, LSB F3900225 EQU DATBAM(FH+4) DATA RECORDS BEGINNING SECTOR ADDRESS, MSB F3900226 EQU DATBAL(FH+5) DATA RECORDS BEGINNING SECTOR ADDRESS,LMSB F3900227 EQU FCBIND(FH+6) FCB INDICATORS F3900228* BIT 15 , SECTOR ALLIGNED RECORDS IF =1 F3900229* BIT 14 , STORAGE MODE FOR INDEXED FILE F3900230* =0, RECORDS STORED RANDOMLY WITHF3900231* RESPECT TO PRIMARY KEY F3900232* =1, RECORDS STORED IN ORDER WIT F3900233* RESPECT TO PRIMARY KEY F3900234* BIT 13 , =1, FILE IS CURRENTLY OPEN F3900235* =0, FILE IS CURRENTLY CLOSED F3900236* BIT 12 , =1, FILE IS BEING COMPRESSED F3900237* =0, FILE IS NOT BEING COMPRESSEDF3900238* BIT 11 , =1, FILE IS OPEN FOR SPECIAL F3900239* PROCESSING F3900240* =0, FILE IS NOT OPEN FOR SPECIALF3900241* PROCESSING F3900242* BIT 8 , =1, RECORDS CONTAIN BINARY DATA F3900243* =0, RECORDS DO NOT CONTAIN F3900244* BINARY DATA F3900245* BIT 0 , FILE TYPE F3900246* =0, SEQUENTIAL FILE F3900247* =1, INDEXED FILE F3900248 EQU NEDATM(FH+7) NUMBER OF EXISTING DATA RECORDS, MSB F3900249ÐÐ EQU NEDATL(FH+8) NUMBER OF EXISTING DATA RECORDS, LSB F3900250 EQU SEQLTH(NEDATL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F3900251* OF FCB FOR A SEQUENTIAL FILE F3900252 SPC 1 F3900253 EQU NEXTBM(FH+9) NEXT FREE KEY INDEX BLOCK, MSB F3900254 EQU NEXTBL(FH+10) NEXT FREE KEY INDEX BLOCK, LSB F3900255 EQU TNKEYM(FH+11) TOTAL NUMBER OF KEY INDEX BLOCKS, MSB F3900256 EQU TNKEYL(FH+12) TOTAL NUMBER OF KEY INDEX BLOCKS, LSB F3900257 EQU KEYBAM(FH+13) KEY INDEX BEGINNING SECTOR ADDRESS, MSB F3900258 EQU KEYBAL(FH+14) KEY INDEX BEGINNING SECTOR ADDRESS, LSB F3900259 EQU LENKY1(FH+15) LENGTH OF KEY NO. 1 F3900260 EQU POSKY1(FH+16) BYTE POSITION OF KEY NO. 1 F3900261 EQU LENKY2(FH+17) LENGTH OF KEY NO. 2 F3900262 EQU POSKY2(FH+18) BYTE POSITION OF KEY NO. 2 F3900263 EQU LENKY3(FH+19) LENGTH OF KEY NO. 3 F3900264 EQU POSKY3(FH+20) BYTE POSITION OF KEY NO. 3 F3900265 EQU LENKY4(FH+21) LENGTH OF KEY NO. 4 F3900266 EQU POSKY4(FH+22) BYTE POSITION OF KEY NO. 4 F3900267 EQU INDLEN(POSKY4-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F3900268* OF FCB FOR AN INDEXED FILE F3900269 EJT F3900270* THE FOLLOWING PORTION OF THE FCB EXISTS ONLY F3900271* ON MASS MEMORY. THESE 10 WORDS ARE NOT LOADEDF3900272* INTO EITHER OF THE FILE MANAGER CONTROLLED FCBF3900273* TABLES. F3900274ÐÐ EQU TSFILM(FH+23) TOTAL NUMBER OF SECTORS IN FILE, MSB F3900275 EQU TSFILL(FH+24) TOTAL NUMBER OF SECTORS IN FILE, LSB F3900276 EQU NAME12(FH+25) FILE NAME, CHARACTERS 1 AND 2 F3900277 EQU NAME34(FH+26) FILE NAME, CHARACTERS 3 AND 4 F3900278 EQU NAME56(FH+27) FILE NAME, CHARACTERS 5 AND 6 F3900279 EQU NAME78(FH+28) FILE NAME, CHARACTERS 7 AND 8 F3900280 EQU OWNR12(FH+29) OWNER NAME, CHARACTERS 1 AND 2 F3900281 EQU OWNR34(FH+30) OWNER NAME, CHARACTERS 3 AND 4 F3900282 EQU OWNR56(FH+31) OWNER NAME, CHARACTERS 5 AND 6 F3900283 EQU OWNR78(FH+32) OWNER NAME, CHARACTERS 7 AND 8 F3900284 EQU BYTLEN(FH+33) BYTE LENGTH OF RECORD F3900285* F3900286* FOR COMPRESS ONLY F3900287* F3900288 EQU PRSRNM(FH+34) RRN OF LAST PROCESSED RECORD - MSB F3900289 EQU PRSRNL(FH+35) RRN OF LAST PROCESSED RECORD - LSB F3900290 EQU NEWRNM(FH+36) RRN OF THE LATEST 'NEW' RECORD - MSB F3900291 EQU NEWRNL(FH+37) RRN OF THE LATEST 'NEW' RECORD - LSB F3900292 SPC 4 F3900293* WORDS 0 THRU 4 OF THE FCB HEADER AND WORDS F3900294* 6 THRU 10 OF THE FCB ARE REFERRED TO AS THE F3900295* SHARED SUBSET OF THE FCB. THEY INCLUDE THE F3900296* ONLY FCB WORDS THAT CAN BE MODIFIED AFTER FILEF3900297* CREATION. IF TWO OR MORE USERS HAVE THE SAME F3900298* FILE OPEN, THERE HAS TO BE A SINGLE MASTER F3900299ÐÐ* COPY OF THE SUBSET THAT RECEIVES (AND RECORDS)F3900300* ALL OF THE UPDATES. THE CONTROLLED SUBSET F3900301* WILL ALWAYS BE PART OF A MAIN MEMORY RESIDENT F3900302* FCB IF THE FCB IS IN A FM CONTROLLED TABLE. F3900303* IF THE FCB IS IN USER SPACE, THE SUBSET MAY ATF3900304* TIMES RESIDE IN THE SUBSET CONTROL TABLE. F3900305 SPC 2 F3900306* ALTERNATE NAMES FOR SUBSET WORDS F3900307 EQU SAFCBI(FH+1) SUBSET ALTERNATE NAME FOR FCBIND F3900308 EQU SADATM(FH+2) SUBSET ALTERNATE NAME FOR NEDATM F3900309 EQU SADATL(FH+3) SUBSET ALTERNATE NAME FOR NEDATL F3900310 EQU SANXTM(FH+4) SUBSET ALTERNATE NAME FOR NEXTBM F3900311 EQU SANXTL(FH+5) SUBSET ALTERNATE NAME FOR NEXTBL F3900312* * * * F3900313 EJT F3900314OPENFL ADC 0 ENTRY F3900315 RTJ Q8PREP ABSOLUTIZE PARAMETER ADDRESS F3900316 ADC* OPENFL F3900317ADDR RTJ Q8PKUP F3900318 RTJ* (ADDR+1) F3900319 STA REQBUF SAVE REQUEST BUFFER ADDR 136*A005 F3900320 RTJ* (ADDR+1) F3900321 STA IDATA SAVE IDATA ADDRESS F3900322 STA* ADIDAT F3900323 RTJ* (ADDR+1) F3900324ÐÐ STA ISTAT SAVE COMPLETION STATUS ADDRESS F3900325 ENA 0 ZERO OUT STATUS WORD F3900326 STA STATUS F3900327 STA (ISTAT) F3900328 STA INITCM CLEAR SPECIAL INITIALIZATION FLAG F3900329* F3900330 LDA* ADIDAT ASSURE IDATA DOESN'T OVERLAP REQBUF AND ISTAT F3900331 ENQ 15 SET A + Q TO ADDRESS + LENGTH OF IDATA F3900332 RTJ FMCOVL CHECK FOR OVERLAP F3900333 SAZ OP005 SKIP IF NO OVERLAP F3900334* F3900335 RTJ FMSCOM RETURN TO EXEC TO ABORT THE REQUEST F3900336 EJT F3900337* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F3900338* VALIDATE THE FEASABILITY OF THE REQUEST F3900339* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F3900340* F3900341OP005 LDQ* REQBUF DETERMINE USER ID F3900342 STQ* OP020 F3900343 LDA- USERID,Q F3900344 SAN OP010 SKIP IF ID WAS SUPPLIED F3900345 STQ- USERID,Q ELSE USE REQBUF ADDR AS ID F3900346 TRQ A F3900347OP010 STA UCT F3900348 RTJ CKRQST INSURE REQUEST IS POSSIBLE F3900349ÐÐADIDAT ADC 0 F3900350 ADC UCT F3900351 ADC UCTIDX F3900352OP020 ADC 0 F3900353 LDA STATUS CHECK FOR ERROR F3900354 SAZ OP050 SKIP IF NONE F3900355* F3900356 JMP EXIT F3900357OP050 LDQ IDATA VALIDATE REQUEST PARAMETERS F3900358 LDA* REQBUF SET I-REG TO REQBUF ADDRESS F3900359 STA- I F3900360 LDA- LOKREC,I RELOCATE FCB LENGTH TO WORD 16 F3900361 STA- 16,I (USED BY MOVFCB) F3900362 LDA- 13,Q CHECK NO. OF RECORDS/RETRIEVE F3900363 SAZ OP055 IF ZERO OR NEGATIVE GO TO ERROR EXIT F3900364 SAP OP060 F3900365OP055 JMP* OP125 F3900366* F3900367OP060 STA- LOKREC,I STORE IN REQBUF F3900368OP062 LDQ =XBUF GET FCB HEADER ADDRESS IN Q F3900369 INQ -FH-1 F3900370 LDA- FCBIND,Q CHECK IF SECTOR ALLIGNED F3900371 SAP OP070 SKIP IF NO F3900372 LDA- RECLEN,Q COMPUTE NO. OF SECTORS/RECORD F3900373 ENQ 0 F3900374ÐÐ DVI SIZE DIVIDE BY NO. OF WORDS/SECTOR F3900375 SQZ OP065 SKIP IF NO REMAINDER F3900376 INA 1 ROUND UP F3900377OP065 MUI SIZE COMPUTE NO. OF WORDS/RECORD F3900378 JMP* OP080 F3900379 EJT F3900380OP070 LDA- RECLEN,Q GET RECORD LENGTH (NOT SA) F3900381OP080 LDQ IDATA F3900382 MUI- 13,Q MULTIPLY BY NO. OF RECORDS PER RETRIEVE F3900383 SQN OP085 ERROR IF NO. OF WORDS .GT. 32767 F3900384 SAP OP090 F3900385OP085 JMP* OP125 F3900386* F3900387OP090 LDQ IDATA CHECK IF OPEN FOR COMPRESSION F3900388 LDA- 12,Q F3900389 STA* MODE SAVE MODE FLAG LOCALLY F3900390 INA 1 BUMP MODE BY 1 TO ENABLE TEST FOR -1 F3900391 SAN OP095 SKIP IF NOT OPEN FOR COMPRESSION F3900392 JMP* OP115 GO CHECK IF A BINARY FILE 132*5247F3900393* F3900394OP095 LDQ* OP062+1 SET Q TO FCB HEADER ADDRESS F3900395 INQ -FH-1 F3900396 LDA- FCBIND,Q CHECK IF FILE IS INDEXED F3900397 AND- ONEMSK F3900398 SAN OP100 SKIP IF YES F3900399ÐÐ JMP* OP135 GO STORE MODE FLAG F3900400* F3900401OP100 LDA* MODE CHECK IF OPEN FOR KEYED RETRIEVAL F3900402 SAM OP102 SKIP IF OPEN FOR SPECIAL PROCESSING F3900403 SAN OP105 SKIP IF OPEN FOR KEYED ACCESS F3900404OP102 JMP* OP135 GO STORE MODE FLAG F3900405* F3900406OP105 INA -5 F3900407 SAM OP110 SKIP IF KEY NO. IS LEGAL F3900408 JMP* OP125 F3900409* F3900410OP110 LDQ IDATA CHECK IF RECORD LOCKING OR FILE 136*5363F3900411 LDA- 14,Q LOCK SPECIFIED 132*5363F3900412 SAN OP120 SKIP IF YES 132*5247F3900413 JMP* OP130 132*5247F3900414* F3900415* COMPRESSION WAS REQUESTED F3900416OP115 LDQ* OP062+1 SET Q TO FCB HEADER ADDRESS F3900417 INQ -FH-1 F3900418 LDA- FCBIND,Q CHECK IF THIS IS A BINARY FILE 132*5247F3900419 AND- ONEBIT+8 133*5528F3900420 SAZ OP117 SKIP IF NO 132*5247F3900421 JMP* OP125 GO EXIT WITH $C000 ERROR 132*5247F3900422* 132*5247F3900423OP117 LDA- FCBIND, Q CHECK IF FILE IS INDEXED 132*5247F3900424ÐÐ AND- ONEMSK F3900425 SAN OP120 SKIP IF YES F3900426 JMP* OP135 GO SET RETRIEVAL MODE FLAG F3900427 EJT F3900428OP120 LDA- LOKREC,I CHECK IF NO. OF RECORDS = 1 F3900429 INA -1 F3900430 SAZ OP130 SKIP IF YES - OK F3900431OP125 JMP ER100 F3900432* F3900433MODE NUM 0 MODE FLAG F3900434* 1 CARD DELETED 132*5247F3900435OP130 LDA* MODE STORE MODE AS TYPE OF USE FLAG F3900436OP135 STA- USEFLG,I F3900437* F3900438 LDQ* IDATA CHECK RECORD LOCKING BIT OF LOKREC NEEDS SET F3900439 LDA- 14,Q F3900440 SAZ OP200 SKIP IF NO F3900441 SAM OP200 F3900442 LDA* MODE CHECK IF OPEN FOR SPECIAL PROCESS- 136*A005F3900443 INA 1 ING OR COMPRESSION 136*A005F3900444 SAZ OP200 COMPRESSION: SKIP RECORD LOCK FLAG 136*A005F3900445 INA 1 136*A005F3900446 SAZ OP200 SPECIAL PROCESSING 136*A005F3900447 LDA- LOKREC,I SET RECORD LOCK FLAG F3900448 EOR- ONEBIT+15 F3900449ÐÐ STA- LOKREC,I F3900450 EJT F3900451* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F3900452* ALLOCATE SYSTEM RESOURCES F3900453* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F3900454* F3900455OP200 RTJ MOVFCB MOVE THE FCB FROM THE SCRATCH BUFFER TO ITS F3900456 ADC FCBCAD PERMANENT LOCATION F3900457 ADC SUBSET F3900458REQBUF ADC 0 F3900459 LDA STATUS CHECK FOR ERROR F3900460 SAP OP205 SKIP IF NONE F3900461 JMP EXIT F3900462OP205 STA* FCBCOD SAVE REQUIREMENTS FLAG F3900463 LDQ* FCBCAD GET FCB MAIN MEMORY ADDR F3900464 AND- ONEBIT+1 IS SUBSET REQUIRED F3900465 SAZ OP215 SKIP IF NOT F3900466 LDA FILE BUILD FCB SHARED SUBSET F3900467 STA- I F3900468 ENA 1 F3900469 RTJ FCBSS F3900470 SQZ OP210 SKIP IF NO ERROR F3900471 STQ STATUS F3900472 JMP RELFCB F3900473OP210 STA* SUBSET SAVE SUBSET ADDRESS F3900474ÐÐ* F3900475OP215 LDQ* SUBSET CHECK IF FILE IS ALREADY OPEN TO ONE USER ONLYF3900476 LDA- FCBFLG,Q F3900477 AND- ONEMSK+7 F3900478 INA -1 F3900479 SAZ OP220 SKIP IF YES F3900480 JMP* OP224 F3900481* F3900482OP220 LDA FILE STORE FILE ID IN UCT ENTRY OF UCTMGR CALL F3900483 STA* UCT+1 F3900484 ENA -1 F3900485 STA* UCTIND F3900486 RTJ UCTMGR SEARCH FOR OTHER USER'S UCT ENTRY F3900487 ADC UCT F3900488 ADC UCTIND F3900489 ADC ONEBIT+1 CODE=2 F3900490ADR ADC STATUS F3900491 EJT F3900492 LDA* (ADR) CHECK STATUS TO ASSURE ENTRY FOUND F3900493 SAZ OP222 SKIP IF FOUND F3900494 RTJ SYFAIL FM BUG - CRASH SYSTEM F3900495* F3900496OP222 LDA* UCT+1 CHECK IF PSEUDO FILE LOCK FLAG SET F3900497 SAP OP224 SKIP IF NO F3900498 LDQ* SUBSET RESET Q TO SUBSET ADDRESS F3900499ÐÐ RAO- FCBFLG,Q BUMP NUMBER OF USERS SO THAT IT MAY BE DECRE- F3900500* MENTED IN ERROR PROCESSING LOGIC F3900501 JMP* OP226 GO TO ERROR PROCESSING F3900502* F3900503OP224 LDQ* SUBSET F3900504 RAO- FCBFLG,Q INCREMENT NO. OF USERS F3900505 LDA- FILOCK,Q CHECK IF FILE IS LOCKED F3900506 SAZ OP228 SKIP IF NO F3900507OP226 JMP ER110 F3900508* F3900509OP228 LDA* MODE CHECK IF OPEN FOR COMPRESSION OR SPECIAL PROC.F3900510 SAM OP230 SKIP IF YES F3900511 LDQ* IDATA F3900512 LDA- 14,Q CHECK IF FILE TO BE LOCKED F3900513 SAP OP240 SKIP IF NO F3900514* F3900515OP230 LDQ* SUBSET CHECK NO. OF CURRENT FILE USERS F3900516 LDA- FCBFLG,Q F3900517 AND- ONEMSK+7 F3900518 INA -1 F3900519 SAZ OP235 SKIP IF ONLY THE REQUESTING USER F3900520 LDA =N$8001 COMPRESSION AND SPECIAL PROCESSING ARE NOT F3900521 STA STATUS ALLOWED AT THIS TIME F3900522 JMP* OP245 F3900523 EJT F3900524ÐÐOP235 LDQ REQBUF PICK UP USERID FROM REQBUF AND STORE F3900525 LDA- USERID,Q IT IN FILOCK TO LOCK THE FILE F3900526 LDQ* SUBSET F3900527 STA- FILOCK,Q F3900528* F3900529OP240 LDA* FCBCOD IS FILE SPACE LIMIT ENTRY REQUIRED F3900530 AND- ONEBIT+2 F3900531 SAZ OP250 SKIP IF NOT F3900532 LDQ =XBUF GET COMMON FCB ADDRESS F3900533 INQ -FH-1 F3900534 LDA FILE F3900535 STA- I GET FILE ID F3900536 ENA 1 F3900537 RTJ FILLS F3900538 SQZ OP250 SKIP IF NO ERROR F3900539 STQ STATUS F3900540OP245 JMP RELSS F3900541* F3900542OP250 STA* FILSAD SAVE FILE SPACE LIMIT ENTRY ADDR F3900543 JMP* OP300 F3900544 EJT F3900545* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F3900546* STORAGE F3900547* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F3900548IDATA NUM 0 IDATA ADDR F3900549ÐÐISTAT NUM 0 ISTAT ADDR F3900550FCBCOD NUM 0 FCB REQUIREMENTS FLAG F3900551UCTIDX NUM 0 UCT INDEX F3900552UCTIND NUM 0 UCT INDEX USED FOR SEARCH ONLY F3900553FCBCAD NUM 0 FCB MAIN MEMORY ADDRESS F3900554UCT BZS UCT(UCTSIZ) USER CONTROL TABLE ENTRY F3900555FILSAD NUM 0 FILE SPACE LIMIT ADDRESS F3900556SUBSET NUM 0 FCB SUBSET ADDRESS F3900557* F3900558* PARAMETER LIST FOR MMWRIT CALL F3900559PARAMS NUM 0 MSB OF BASE SECTOR ADDRESS F3900560 NUM 0 LSB OF BASE SECTOR ADDRESS F3900561 NUM 0 MSB OF RELATIVE RECORD NUMBER F3900562 NUM 0 LSB OF RELATIVE RECORD NUMBER F3900563RLEN NUM 0 RECORD LENGTH F3900564NWDS NUM 0 NUMBER OF WORDS TO WRITE F3900565 NUM 0 WORD OFFSET FROM START OF RECORD F3900566 ADC BUF ADDRESS OF BUFFER FOR I/O. F3900567 NUM 1 I/O TYPE: NON-ZERO AS FILE I/O F3900568 SPC 2 F3900569NSECTS NUM 0 NUMBER OF SECTORS TO ZERO OUT OF KIB F3900570NKEYS NUM 0 NUMBER OF KEYS F3900571 EJT F3900572* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F3900573* CREATE THE USER CONTROL TABLE ENTRY F3900574ÐÐ* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F3900575* F3900576OP300 LDQ REQBUF GET USER ID F3900577 LDA- USERID,Q F3900578 STA* UCT F3900579 LDA FILE GET PSUEDO FILE ID F3900580 STA* UCT+1 F3900581 LDA* FCBCAD GET FCB CORE ADDRESS F3900582 STA* UCT+2 F3900583 LDA* FILSAD PICK UP FILE SPACE LIMIT ENTRY ADDR F3900584 STA* UCT+3 F3900585 LDA* SUBSET GET SHARED SUBSET ADDRESS F3900586 STA* UCT+4 F3900587 LDA CCP STORE USERS CONTROL POINT INTO UCT ENTRY F3900588 STA* UCT+5 F3900589 RTJ UCTMGR STORE ENTRY IN THE UCT F3900590 ADC UCT F3900591 ADC UCTIDX F3900592 ADC ZERO+2 CODE = 3 F3900593 ADC STATUS F3900594 EJT F3900595* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F3900596* UPDATE REQUEST BUFFER F3900597* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F3900598* F3900599ÐÐOP500 LDQ REQBUF F3900600 LDA* IDATA F3900601 STA- I F3900602 LDA* UCTIDX COMPUTE UCT ENTRY ADDRESS F3900603 ADD =XUCTABL F3900604 STA- UCTADR,Q STORE IT F3900605 LDA* FCBCAD STORE FCB CORE ADDRESS IN REQBUF F3900606 STA- FCBADR,Q F3900607 LDA- 14,I CHECK FOR RECORD OR FILE LOCK F3900608 SAZ OP510 SKIP IF NO LOCKING F3900609 SAM OP505 SKIP IF FILE LOCK F3900610 LDA- ONEBIT+15 SET BIT 15 FOR RECORD LOCKING F3900611 JMP* OP510 F3900612* F3900613OP505 CLR A F3900614OP510 EOR- 13,I MERGE IN NO. OF RECORDS/RETRIEVE F3900615 STA- LOKREC,Q F3900616 LDA- 12,I GET USE FLAG F3900617 STA- USEFLG,Q F3900618 ENA 0 ZERO OUT REMAINDER OF REQBUF F3900619 STA- NUMREC,Q F3900620 STA- RRNMSB,Q F3900621 STA- RRNLSB,Q F3900622 STA- SAVMSB,Q F3900623 STA- SAVLSB,Q F3900624ÐÐ STA- SAVREC,Q F3900625 STA- PRCRNM,Q CLEAR OUT 4 WORDS OF REQBUF (USED BY COMSEQ) F3900626 STA- PRCRNL,Q F3900627 STA- NETRNM,Q F3900628 STA- NETRNL,Q F3900629 EJT F3900630 LDA- USEFLG,Q CHECK IF FILE BEING OPENED FOR COMPRESSION F3900631 INA 1 F3900632 SAZ OP512 SKIP IF YES F3900633 JMP* OP520 F3900634* F3900635OP512 SET A SET USEFLG TO -0 TO SIGNAL SEQUENTIAL FILE F3900636 STA- USEFLG,Q F3900637 LDQ* FCBCAD CHECK IF FILE IS INDEXED F3900638 LDA- FCBIND,Q F3900639 AND- ONEMSK F3900640 SAZ OP520 SKIP IF NO F3900641 LDQ REQBUF RESET USEFLG TO -1 TO SIGNAL INDEXED FILE F3900642 ENA -1 F3900643 STA- USEFLG,Q F3900644* F3900645OP515 LDA INITCM CHECK IF REGULAR COMPRESS RELATED INIT NEEDED F3900646 SAZ OP530 SKIP IF YES F3900647OP520 JMP* OP600 SKIP FOLLOWING COMPRESS INIT LOGIC F3900648 SPC 2 F3900649ÐÐ* IF THE FILE IS INDEXED, THE NEXT FREE INDEX F3900650* BLOCK WORDS OF THE FCB NEED TO BE REINITIALIZ-F3900651* ED AND THE ROOT KIBS NEED TO BE RESET TO ZERO.F3900652OP530 LDQ SIZE SET Q TO SECTOR SIZE F3900653 TCQ A F3900654 ADD =XMXSCLN CHECK IF SECTOR LENGTH TOO BIG F3900655 SAP OP540 SKIP IF NO F3900656 RTJ SYFAIL CRASH SYSTEM - FATAL ERROR F3900657* F3900658* CLEAR FIRST 'SIZE'WORDS OF 'BUF' ARRAY. F3900659OP540 CLR A F3900660OP545 INQ -1 DECREMENT INDEX AND CHECK IF DONE F3900661 SQM OP550 SKIP IF DONE F3900662 STA BUF,Q STORE A ZERO. F3900663 JMP* OP545 REPEAT LOOP F3900664 EJT F3900665OP550 LDA SIZE SET SIZE OF RECORD FOR WRITE (SECTOR LENGTH) F3900666 STA* RLEN F3900667 STA* NWDS USE SIZE AS NUMBER OR WORDS F3900668 ENA 1 F3900669 STA* PARAMS+3 SET LSB OF RELATIVE RECORD NUMBER TO ONE F3900670 STA* NKEYS INITIALIZE NUMBER OF KEYS TO ONE F3900671 LDQ* FCBCAD F3900672 LDA- KEYBAM,Q SET MSB/LSB OF BASE SECTOR ADDRESS F3900673 STA* PARAMS F3900674ÐÐ LDA- KEYBAL,Q F3900675 STA* PARAMS+1 F3900676* F3900677 LDA- LENKY2,Q CHECK IF KEY 2 IS DEFINED F3900678 SAZ OP560 SKIP IF NO F3900679 RAO* NKEYS BUMP NUMBER OF KEYS F3900680 LDA- LENKY3,Q CHECK IF KEY 3 IS DEFINED F3900681 SAZ OP560 SKIP IF NO F3900682 RAO* NKEYS BUMP NUMBER OF KEYS F3900683 LDA- LENKY4,Q CHECK IF KEY 4 IS DEFINED F3900684 SAZ OP560 SKIP IF NO F3900685 RAO* NKEYS BUMP NUMBER OF KEYS F3900686* F3900687OP560 CLR A CLEAR MSB F3900688 STA- NEXTBM,Q F3900689 LDA* NKEYS SET LSB OF NEXT FREE KIB INDEX TO NO. OF KEYS F3900690 INA 1 PLUS 1 F3900691 STA- NEXTBL,Q F3900692 INA -1 F3900693 STA* NSECTS F3900694OP563 LDA+ SIZE CHECK SECTOR LENGTH F3900695 INA -96 F3900696 SAN OP565 SENSE NOT 96 WORDS F3900697 ENA 3 USE 3 SECTOR KIB LENGTH F3900698 JMP* OP567 F3900699ÐÐ* F3900700OP565 LDA =N572 COMPUTE LENGTH = 572/VIWPS F3900701 ENQ 0 F3900702 DVI* (OP563+1) F3900703OP567 MUI* NSECTS COMPUTE NUMBER OF SECTORS TO STORE F3900704 STA* NSECTS SAVE IN NSECTS F3900705OP570 LDQ =XPARAMS SET Q TO ABS ADDRESS OF PARAM LIST AND WRITE F3900706 LDA PCTABL RESET I TO PCT ADDRESS F3900707 STA- I F3900708 RTJ MMWRIT OUT A ZEROED OUT KIB SECTOR F3900709 SQP OP590 SKIP IF NO I/O ERROR F3900710 LDA* C8020 SET A TO REJECTED AND I/O ERROR BITS F3900711 INQ 0 CHECK IF Q=$FFFF F3900712 SQN OP580 SKIP IF NO F3900713 EOR- ONEBIT+14 OR IN BIT 14 F3900714OP580 JMP* ER120 GO STORE VALUE FOR ISTAT F3900715 EJT F3900716OP590 LDA NSECTS F3900717 SUB PARAMS+3 CHECK IF DONE F3900718 SAM OP600 SKIP IF YES F3900719 RAO PARAMS+3 BUMP LSB OF RRN FOR NEXT STORE F3900720 SAN OP595 CHECK IF DONE WITH ROOTS F3900721 LDA =XFMEOFC YES, STORE TWO EOF'S IN SECTOR AFTER ROOTS F3900722 STA BUF FOR KIB F3900723 STA BUF+1 F3900724ÐÐOP595 JMP* OP570 REPEAT LOOP F3900725 SPC 2 F3900726C8020 NUM $8020 CONSTANT F3900727 EJT F3900728* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F3900729* UPDATE FCB F3900730* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F3900731* F3900732OP600 LDA+ FCBCOD CHECK IF FCB SHOULD BE UPDATE ON MASS MEMORY F3900733 AND- ONEBIT+3 F3900734 SAN OP620 SKIP IF YES F3900735 JMP* EXIT F3900736* F3900737OP620 LDQ+ FCBCAD F3900738 LDA- FCBIND,Q MARK THE FILE OPEN F3900739 AND =N$C7FF F3900740 EOR- ONEBIT+13 F3900741 STA- FCBIND,Q F3900742 LDA MODE CHECK IF OPEN FOR COMPRESSION F3900743 INA 1 F3900744 SAN OP622 SKIP IF NO F3900745 LDA- FCBIND,Q F3900746 EOR- ONEBIT+12 SET OPEN FOR COMPRESSION FLAG F3900747 STA- FCBIND,Q F3900748 JMP* OP625 F3900749ÐÐ* F3900750OP622 INA 1 CHECK IF OPEN FOR SPECIAL PROCESSING F3900751 SAN OP625 SKIP IF NO F3900752 LDA- FCBIND,Q F3900753 EOR- ONEBIT+11 SET OPEN FOR SPECIAL PROCESSING FLAG F3900754 STA- FCBIND,Q F3900755* F3900756OP625 TRQ A SET FCB ADDRESS IN PROCESSOR CONTROL TABLE F3900757 LDQ PCTABL F3900758 STA- RPFCBA,Q F3900759 STQ- I CALL UPDATE FCB F3900760 RTJ FMUFCB F3900761 SQP OP630 SKIP IF NO ERROR F3900762 LDA* C8020 SET REJECTED AND I/O ERROR BITS F3900763 INQ 0 CHECK IF Q=$FFFF F3900764 SQN ER120 SKIP IF NO F3900765 EOR- ONEBIT+14 SET BIT 14 F3900766 JMP* ER120 GO STORE A FOR USE AS ISTAT F3900767* F3900768OP630 JMP* EXIT F3900769 EJT F3900770* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F3900771* ERROR PROCESSING F3900772* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F3900773* F3900774ÐÐER100 LDA- ZROMSK+13 ($C000) INVALID PARAMETERS F3900775ER101 STA STATUS F3900776 JMP* EXIT F3900777ER110 LDA =N$8004 FILE IS LOCKED F3900778ER120 STA STATUS F3900779* F3900780RELSS LDQ+ SUBSET DECREMENT NO. OF USERS F3900781 LDA- FCBFLG,Q F3900782 INA -1 F3900783 STA- FCBFLG,Q F3900784 LDA+ FCBCOD CHECK IF SUBSET MUST BE RELEASED F3900785 AND- ONEBIT+1 F3900786 SAZ RELFCB SKIP IF NO F3900787 LDA UCT F3900788 STA- I F3900789 ENA 0 F3900790 RTJ FCBSS RELEASE SUBSET F3900791 SPC 1 F3900792RELFCB LDQ SUBSET RELEASE FCB SPACE IF APPROPRIATE F3900793 LDA- FCBFLG,Q F3900794 AND- ONEMSK+7 ($FF) F3900795 SAN EXIT SKIP IF THERE WERE MULTIPLE FILE USERS F3900796 STA- (FILEID),Q ZERO OUT FIRST HEADER WORD: FREEING SPOT F3900797 EJT F3900798* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F3900799ÐÐ* RETURN TO FILE MANAGER F3900800* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * F3900801* F3900802EXIT LDA STATUS RETURN COMPLETION STATUS F3900803 STA (ISTAT) F3900804 RTJ FMSCOM COMPLETE TO FILE MANAGER F3900805 END F3900806 NAM CLOSFL F40 A ITOS CCS 3.0 SL-149F4000001* FILE MANAGER CLOSE FILE REQUEST PROCESSOR F4000002* CREDIT COLLECTION SYSTEM VERSION 3.0 F4000003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F4000004* COPYRIGHT CONTROL DATA CORPORATION 1979 F4000005* F4000006**** F4000007* THIS ROUTINE PROCESSES REQUEST TO THE FILE MANAGER TO CLOSE A FILE. F4000008* F4000009* TO CLOSE A FILE MEANS TO: F4000010* 1) UNLOCK THE FILE (IF LOCKED) AND UNLOCK ANY RECORDS THE USER F4000011* MAY HAVE HAD LOCKED. F4000012* 2) RETURN ANY SYSTEM RESOURCES POSSESSED BY THE USER TO THE F4000013* SYSTEM, I. E.: F4000014* - MAIN MEMORY SPACE FOR THE FILE CONTROL BLOCK F4000015* - FCB SUBSET SPACE F4000016* - FILE SPACE LIMIT ENTRY F4000017* - USER CONTROL TABLE ENTRY F4000018ÐÐ* 3) UPDATE THE MASS MEMORY IMAGE OF THE FCB. F4000019* F4000020* CALLING SEQUENCE F4000021* F4000022* CALL CLOSFL (FCBADR, REQBUF, ISTAT) F4000023* F4000024* PARAMETERS F4000025* FCBADR - MAIN MEMORY ADDRESS OF THE FCB HEADER/FCB F4000026* REQBUF - 24 WORD REQUEST BUFFER THAT WAS INITIALIZED DURING F4000027* THE OPENING OF THE FILE F4000028* ISTAT - COMPLETION STATUS SET ON RETURN TO CALLER: F4000029* BIT MEANING F4000030* --- ------- F4000031* 15 REQUEST REJECTED F4000032* 14 UNUSED F4000033* 13* REQUEST BUFFER IMPROPERLY INITIALIZED F4000034* 12-6 UNUSED F4000035* 5* MASS MEMORY I/O ERROR F4000036* 4 UNUSED F4000037* 3 A SET OF RECORDS WAS LOCKED F4000038* 2 FILE WAS LOCKED F4000039* 0-1 UNUSED F4000040 EJT F4000041*E F4000042* F4000043ÐÐ* ENTRY POINTS F4000044* F4000045 ENT CLOSFL CLOSE FILE REQUEST F4000046* F4000047* EXTERNALS F4000048* F4000049 EXT Q8PREP ABSOLUTIZE PARAMETER ADDRESS F4000050 EXT Q8PKUP PICK UP PARAMETER ADDRESS F4000051 EXT LOKCHK CHECK FOR LOCKED RECORDS F4000052 EXT REMLOK REMOVE LOCKED RECORD ENTRY F4000053 EXT FCBSS RELEASE FCB SUBSET F4000054 EXT FILLS RELEASE FILE SPACE LIMIT ENTRY F4000055 EXT UCTABL USER CONTROL TABLE ADDRESS F4000056 EXT UCTMGR USER CONTROL TABLE MANAGER F4000057 EXT FMUFCB UPDATE MASS MEMORY FCB F4000058 EXT FMSCOM COMPLETE REQUEST TO FILE MANAGER F4000059 EXT FCBSCT ADDRESS OF FCB SUBSET CONTROL TABLE F4000060 EXT FMFCBS ADDRESS OF SEQUENTIAL FILE FCB TABLE F4000061* F4000062* COMMON F4000063* F4000064 COM PCTABL PCT TABLE ADDRESS F4000065 COM FCBMMA FCB MAIN MEMORY ADDRESS F4000066 COM SPARE(705) SPARE COMMON WORDS. F4000067**** F4000068ÐÐ* F4000069* EQUIVALENCES F4000070* F4000071 EQU ZERO(2) F4000072 EQU ONEMSK(3) F4000073 EQU ONEBIT($23) F4000074 EQU CLRMSK($33) F4000075 EJT F4000076* UCT ENTRY EQUIVALENCES F4000077 EQU UIDENT(ZERO) USER IDENTIFICATION F4000078 EQU FIDENT(1) PSEUDO FILE IDENTIFIER F4000079 EQU FCBCAD(2) FCB CORE ADDRESS F4000080 EQU FSLADR(3) FILE SPACE LIMITS TABLE ENTRY ADDRESS F4000081 EQU FCBSAD(4) FCB SUBSET ADDRESS F4000082 EQU USRCPT(5) USERS CONTROL POINT F4000083 EQU UCTSIZ(6) SIZE OF A UCT ENTRY F4000084*E F4000085 EJT F4000086* REQUEST BUFFER INDEXES - FIRST 4 WORDS F4000087 EQU RBATHR(0) REQUEST BUFFER ADDRESS THREAD F4000088 EQU BUFAMP(1) BUFFER ADDRESS MAIN PART F4000089 EQU CNTLPT(2) CONTROL POINT (OR SPARE) F4000090 EQU RQINFO(3) REQUEST INFORMATION (MULTI-FIELD) F4000091* BITS USE F4000092* 15-12 SPARE F4000093ÐÐ* 11-04 REQUEST INDEX F4000094* 03-00 LEVEL OF REQUESTOR F4000095* F4000096* REQUEST BUFFER INDEXES - MAIN PART F4000097 EQU QREG(0) Q REGISTER F4000098 EQU IREG(1) I REGISTER F4000099 EQU PARLST(2) ADDRESS OF PARAMETER LIST F4000100 EQU RTNADR(2) RETURN ADDRESS TO USER (UPON RETURN FROM EXEC)F4000101 EQU UCTADR(3) UCT ENTRY ABSOLUTE ADDRESS F4000102 EQU USERID(4) USER IDENTIFIER F4000103 EQU FCBADR(5) FCB ADDRESS (MAY BE SET BY CALLER OR INTCPTR.)F4000104 EQU RADINT(6) RETURN ADDRESS TO INTERCEPTOR F4000105 EQU RPIDX(7) REQUEST PROCESSOR INDEX F4000106* BITS 14-00 REQUEST PROCESSOR INDEX F4000107* BIT 15 TYPE OF PROCESSOR F4000108* =0, SERIAL PROCESSOR F4000109* =1, REENTRANT PROCESSOR F4000110 EQU LOKREC(8) NUMBER OF RECORDS TO BE READ/WRITTEN PER I/O F4000111* CALL AND LOCK RECORDS ON RETRIEVE FLAG F4000112* BITS 14-00 NUMBER OF RECORDS PER CALL F4000113* BIT 15 =0, DO NOT LOCK ON RETRIEVE F4000114* =1, LOCK RECORDS ON RETRIEVE F4000115 EQU USEFLG(9) TYPE OF FILE USE FLAG F4000116* -1, OPEN FOR COMPRESSION F4000117* -2, OPEN FOR SPECIAL PROCESSING F4000118ÐÐ* 0, OPEN FOR ACESS VIA REL REC NO F4000119* 1, OPEN FOR RETRIEVAL VIA KEY 1 F4000120* 2, OPEN FOR RETRIEVAL VIA KEY 2 F4000121* 3, OPEN FOR RETRIEVAL VIA KEY 3 F4000122* 4, OPEN FOR RETRIEVAL VIA KEY 4 F4000123 EQU NUMREC(10) NUMBER OF RECORDS ACTUALLY STORED/RETRIEVED F4000124 EQU RRNMSB(11) REL REC NUMBER OF STORED/RETRIEVED REC, MSB F4000125 EQU RRNLSB(12) REL REC NUMBER OF STORED/RETRIEVED REC, LSB F4000126 EQU RMPLEN(20) LENGTH OF REQBUF MAIN PART F4000127*E F4000128 EJT F4000129* FILE CONTROL BLOCK EQUIVALENCES F4000130 EQU FH(4) LENGTH -1 OF FCB HEADER F4000131 EQU FILEID(ZERO) FILE IDENTIFIER F4000132* ACCESS FILEID INDIRECTLY F4000133* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBERF4000134* BITS 10-00 INDEX OF FCB IN FCB TABLE F4000135 EQU FCBFLG(1) FCB FLAGS F4000136* BITS 15-8, SPARE F4000137* BITS 7-00, NUMBER OF USERS USING FILE F4000138 EQU FILOCK(2) FILE LOCK FLAG (IF NON-0, CONTAINS USER ID) F4000139 EQU NUMSET(3) NUMBER OF SETS OF LOCKED RECORDS IN FILE F4000140 EQU NUMNEW(4) NUMBER OF NEW RECORDS SINCE FCB UPDATED ON MM F4000141 SPC 1 F4000142 EQU RECLEN(FH+1) RECORD LENGTH IN WORDS F4000143ÐÐ EQU TDATRM(FH+2) TOTAL NUMBER OF DATA RECORDS, MSB F4000144 EQU TDATRL(FH+3) TOTAL NUMBER OF DATA RECORDS, LSB F4000145 EQU DATBAM(FH+4) DATA RECORDS BEGINNING SECTOR ADDRESS, MSB F4000146 EQU DATBAL(FH+5) DATA RECORDS BEGINNING SECTOR ADDRESS,LMSB F4000147 EQU FCBIND(FH+6) FCB INDICATORS F4000148* BIT 15 , SECTOR ALLIGNED RECORDS IF =1 F4000149* BIT 14 , STORAGE MODE FOR INDEXED FILE F4000150* =0, RECORDS STORED RANDOMLY WITHF4000151* RESPECT TO PRIMARY KEY F4000152* =1, RECORDS STORED IN ORDER WIT F4000153* RESPECT TO PRIMARY KEY F4000154* BIT 13 , =1, FILE IS CURRENTLY OPEN F4000155* =0, FILE IS CURRENTLY CLOSED F4000156* BIT 12 , =1, FILE IS BEING COMPRESSED F4000157* =0, FILE IS NOT BEING COMPRESSEDF4000158* BIT 11 , =1, FILE IS OPEN FOR SPECIAL F4000159* PROCESSING F4000160* =0, FILE IS NOT OPEN FOR SPECIALF4000161* PROCESSING F4000162* BIT 8 , =1, RECORDS CONTAIN BINARY DATA F4000163* =0, RECORDS DO NOT CONTAIN F4000164* BINARY DATA F4000165* BIT 0 , FILE TYPE F4000166* =0, SEQUENTIAL FILE F4000167* =1, INDEXED FILE F4000168ÐÐ EQU NEDATM(FH+7) NUMBER OF EXISTING DATA RECORDS, MSB F4000169 EQU NEDATL(FH+8) NUMBER OF EXISTING DATA RECORDS, LSB F4000170 EQU SEQLTH(NEDATL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F4000171* OF FCB FOR A SEQUENTIAL FILE F4000172 SPC 1 F4000173 EQU NEXTBM(FH+9) NEXT FREE KEY INDEX BLOCK, MSB F4000174 EQU NEXTBL(FH+10) NEXT FREE KEY INDEX BLOCK, LSB F4000175 EQU TNKEYM(FH+11) TOTAL NUMBER OF KEY INDEX BLOCKS, MSB F4000176 EQU TNKEYL(FH+12) TOTAL NUMBER OF KEY INDEX BLOCKS, LSB F4000177 EQU KEYBAM(FH+13) KEY INDEX BEGINNING SECTOR ADDRESS, MSB F4000178 EQU KEYBAL(FH+14) KEY INDEX BEGINNING SECTOR ADDRESS, LSB F4000179 EQU LENKY1(FH+15) LENGTH OF KEY NO. 1 F4000180 EQU POSKY1(FH+16) BYTE POSITION OF KEY NO. 1 F4000181 EQU LENKY2(FH+17) LENGTH OF KEY NO. 2 F4000182 EQU POSKY2(FH+18) BYTE POSITION OF KEY NO. 2 F4000183 EQU LENKY3(FH+19) LENGTH OF KEY NO. 3 F4000184 EQU POSKY3(FH+20) BYTE POSITION OF KEY NO. 3 F4000185 EQU LENKY4(FH+21) LENGTH OF KEY NO. 4 F4000186 EQU POSKY4(FH+22) BYTE POSITION OF KEY NO. 4 F4000187 EQU INDLEN(POSKY4-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F4000188* OF FCB FOR AN INDEXED FILE F4000189 EJT F4000190* THE FOLLOWING PORTION OF THE FCB EXISTS ONLY F4000191* ON MASS MEMORY. THESE 10 WORDS ARE NOT LOADEDF4000192* INTO EITHER OF THE FILE MANAGER CONTROLLED FCBF4000193ÐÐ* TABLES. F4000194 EQU TSFILM(FH+23) TOTAL NUMBER OF SECTORS IN FILE, MSB F4000195 EQU TSFILL(FH+24) TOTAL NUMBER OF SECTORS IN FILE, LSB F4000196 EQU NAME12(FH+25) FILE NAME, CHARACTERS 1 AND 2 F4000197 EQU NAME34(FH+26) FILE NAME, CHARACTERS 3 AND 4 F4000198 EQU NAME56(FH+27) FILE NAME, CHARACTERS 5 AND 6 F4000199 EQU NAME78(FH+28) FILE NAME, CHARACTERS 7 AND 8 F4000200 EQU OWNR12(FH+29) OWNER NAME, CHARACTERS 1 AND 2 F4000201 EQU OWNR34(FH+30) OWNER NAME, CHARACTERS 3 AND 4 F4000202 EQU OWNR56(FH+31) OWNER NAME, CHARACTERS 5 AND 6 F4000203 EQU OWNR78(FH+32) OWNER NAME, CHARACTERS 7 AND 8 F4000204 EQU BYTLEN(FH+33) BYTE LENGTH OF RECORD F4000205* F4000206* FOR COMPRESS ONLY F4000207* F4000208 EQU PRSRNM(FH+34) RRN OF LAST PROCESSED RECORD - MSB F4000209 EQU PRSRNL(FH+35) RRN OF LAST PROCESSED RECORD - LSB F4000210 EQU NEWRNM(FH+36) RRN OF THE LATEST 'NEW' RECORD - MSB F4000211 EQU NEWRNL(FH+37) RRN OF THE LATEST 'NEW' RECORD - LSB F4000212 SPC 4 F4000213* WORDS 0 THRU 4 OF THE FCB HEADER AND WORDS F4000214* 6 THRU 10 OF THE FCB ARE REFERRED TO AS THE F4000215* SHARED SUBSET OF THE FCB. THEY INCLUDE THE F4000216* ONLY FCB WORDS THAT CAN BE MODIFIED AFTER FILEF4000217* CREATION. IF TWO OR MORE USERS HAVE THE SAME F4000218ÐÐ* FILE OPEN, THERE HAS TO BE A SINGLE MASTER F4000219* COPY OF THE SUBSET THAT RECEIVES (AND RECORDS)F4000220* ALL OF THE UPDATES. THE CONTROLLED SUBSET F4000221* WILL ALWAYS BE PART OF A MAIN MEMORY RESIDENT F4000222* FCB IF THE FCB IS IN A FM CONTROLLED TABLE. F4000223* IF THE FCB IS IN USER SPACE, THE SUBSET MAY ATF4000224* TIMES RESIDE IN THE SUBSET CONTROL TABLE. F4000225 SPC 2 F4000226* ALTERNATE NAMES FOR SUBSET WORDS F4000227 EQU SAFCBI(FH+1) SUBSET ALTERNATE NAME FOR FCBIND F4000228 EQU SADATM(FH+2) SUBSET ALTERNATE NAME FOR NEDATM F4000229 EQU SADATL(FH+3) SUBSET ALTERNATE NAME FOR NEDATL F4000230 EQU SANXTM(FH+4) SUBSET ALTERNATE NAME FOR NEXTBM F4000231 EQU SANXTL(FH+5) SUBSET ALTERNATE NAME FOR NEXTBL F4000232 EJT F4000233CLOSFL ADC 0 ENTRY F4000234 RTJ Q8PREP ABSOLUTIZE PARAMETER ADDRESS F4000235 ADC* CLOSFL F4000236ADDR RTJ Q8PKUP F4000237 STA* FCBLOC SAVE FCB ADDRESS F4000238 RTJ* (ADDR+1) F4000239 STA* REQBUF SAVE REQUEST BUFFER ADDRESS F4000240 RTJ* (ADDR+1) F4000241 STA* ISTAT SAVE COMPLETION STATUS ADDRESS F4000242 ENA 0 ZERO OUT COMPLETION STATUS F4000243ÐÐ STA* (ISTAT) F4000244 EJT F4000245* F4000246* UNLOCK THE FILE AND/OR RECORDS F4000247* F4000248 LDQ* REQBUF GET UCT ENTRY ADDRESS FROM REQUEST BUFFER F4000249 LDA- UCTADR,Q F4000250 STA* UCTENT SAVE IT F4000251 LDA PCTABL GET PCT ADDRESS F4000252 STA- I F4000253 ENQ 0 CHECK FOR ANY RECORD LOCKS F4000254 RTJ LOKCHK F4000255 SAZ CL030 SKIP IF NONE F4000256 TRA Q REMOVE THE LOCKS F4000257 RTJ REMLOK F4000258 ENA 8 INDICATE RECORD LOCK IN COMPLETION STATUS F4000259 STA* (ISTAT) F4000260* F4000261CL030 LDQ* UCTENT GET USER ID FROM UCT ENTRY F4000262 LDA- (UIDENT),Q F4000263 STA- I SAVE IN I-REG F4000264 LDQ- FCBSAD,Q GET FCB SUBSET ADDRESS FROM UCT ENTRY F4000265 LDA- FILOCK,Q GET FCB LOCK FLAG F4000266 SAZ CL050 SKIP IF FILE IS UNLOCKED F4000267 ENA 0 F4000268ÐÐ STA- FILOCK,Q UNLOCK THE FILE F4000269 ENA 4 INDICATE FILE LOCK IN COMPLETION STATUS F4000270 EOR* (ISTAT) F4000271 STA* (ISTAT) F4000272 EJT F4000273* F4000274* RELEASE THE FCB SUBSET (IF PERMITTED) F4000275* F4000276CL050 LDA- FCBFLG,Q DECREMENT NO. OF FILE USERS F4000277 INA -1 F4000278 STA- FCBFLG,Q F4000279 AND- ONEMSK+7 ($FF) F4000280 STA* NUMUSR SAVE IT F4000281* F4000282 ENA 0 RELEASE THE SUBSET F4000283 RTJ FCBSS F4000284 EJT F4000285* F4000286* RELEASE THE FILE SPACE LIMIT ENTRY F4000287* F4000288 LDQ* UCTENT CHECK IF SUCH AN ENTRY EXISTS F4000289 LDA- FSLADR,Q F4000290 SAZ CL060 SKIP IF NOT F4000291 LDQ- I GET USER ID F4000292 STA- I PASS ENTRY ADDRESS F4000293ÐÐ ENA 0 RELEASE THE ENTRY F4000294 RTJ FILLS F4000295 EJT F4000296* F4000297* UPDATE THE MASS MEMORY FCB F4000298* F4000299CL060 LDA* NUMUSR CHECK IF THE CLOSING USER IS THE FILE'S LAST F4000300 SAZ CL061 SKIP IF YES F4000301 JMP* CL065 F4000302CL061 LDQ* FCBLOC F4000303 LDA- FCBIND,Q MARK FILE CLOSED WITH NO FILE COMPRESSION F4000304 AND =N$C7FF ACTIVE OR SPECIAL PROCESSING ACTIVE F4000305 STA- FCBIND,Q F4000306 LDA PCTABL F4000307 STA- I F4000308 RTJ FMUFCB UPDATE THE FCB F4000309 SQP CL065 SKIP IF NO ERROR F4000310 LDA =N$8020 MASS MEMORY I/O ERROR F4000311 INQ 0 F4000312 SQN CL063 SKIP IF NOT COMPUTATION ERROR F4000313 EOR- ONEBIT+14 ($4000) F4000314CL063 STA* (ISTAT) RETURN COMPLETION STATUS F4000315CL065 JMP* CL070 F4000316 EJT F4000317* F4000318ÐÐ* STORAGE F4000319* F4000320ISTAT NUM 0 COMPLETION STATUS ADDRESS F4000321REQBUF NUM 0 REQUEST BUFFER ADDRESS F4000322FCBLOC NUM 0 FCB MAIN MEMORY ADDRESS F4000323UCTENT NUM 0 UCT ENTRY ADDRESS/INDEX F4000324UCT BZS UCT(UCTSIZ) UCT ENTRY BUFFER F4000325TEMP NUM 0 F4000326NUMUSR NUM 0 NO. OF FILE USERS F4000327 EJT F4000328* F4000329* RELEASE THE UCT ENTRY F4000330* F4000331CL070 LDQ* REQBUF COMPUTE UCT ENTRY INDEX F4000332 LDA- UCTADR,Q F4000333 SUB =XUCTABL F4000334 STA* UCTENT F4000335 RTJ UCTMGR ZERO OUT THE ENTRY F4000336 ADC UCT F4000337 ADC UCTENT F4000338 ADC ONEBIT+2 CODE = 4 F4000339 ADC TEMP F4000340 EJT F4000341* RELEASE THE FCB SPACE F4000342* F4000343ÐÐ LDQ* FCBLOC GET THE FILE ID F4000344 LDA- (FILEID),Q F4000345 STA* UCT+1 F4000346 ENA -1 F4000347 STA* UCTENT SET UP TO SEARCH WHOLE UCT F4000348CL090 RTJ UCTMGR SEARCH FOR USERS OF THE FILE F4000349 ADC UCT F4000350 ADC UCTENT F4000351 ADC ONEBIT+1 CODE = 2 F4000352 ADC TEMP F4000353* F4000354 LDA* TEMP WAS ALL OF TABLE SEARCHED F4000355 SAN CL100 SKIP IF YES F4000356* F4000357 LDQ* UCTENT CHECK IF THIS USER EXPECTS THE FCB IN F4000358 ADQ =XUCTABL 121*4598F4000359 LDA- FCBCAD,Q SYSTEM TABLE SPACE F4000360 SUB =XFCBSCT F4000361 SAP CL095 SKIP IF NO F4000362 LDA =XFMFCBS F4000363 SUB- FCBCAD,Q F4000364 SAZ CL110 SKIP IF FCB IN SYSTEM TABLE F4000365 SAM CL110 (DON'T RELEASE IT) F4000366* F4000367CL095 JMP* CL090 CONTINUE SEARCH F4000368ÐÐ* F4000369CL100 LDQ* FCBLOC ZERO OUT FIRST WORD OF FCB- F4000370 ENA 0 THIS RELEASES ITS SPACE F4000371 STA- (ZERO),Q F4000372CL110 JMP* EXIT RETURN TO CALLER F4000373 EJT F4000374* F4000375* RETURN TO FILE MANAGER EXECUTIVE F4000376* F4000377EXIT RTJ FMSCOM COMLETE TO FILE MANAGER F4000378 END F4000379 NAM FCBSS F41 A ITOS CCS 3.0 SL-149F4100001* CREATE/RELEASE FCB SUBSETS FOR OPEN AND CLOSE PROCESSORS F4100002* CREDIT COLLECTION SYSTEM VERSION 3.0 F4100003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F4100004* COPYRIGHT CONTROL DATA CORPORATION 1979 F4100005* F4100006**** F4100007* F4100008* THIS ROUTINE PROCESSES REQUESTS TO DEFINE FCB SUBSETS FOR FILES BEINGF4100009* OPENED AND TO REDEFINE OR RELEASE FCB SUBSETS FOR FILES BEING CLOSED.F4100010* F4100011* IF A FILE IS BEING OPENED, FCBSS SHOULD BE CALLED ONLY IF THE FILE F4100012* WAS PREVIOUSLY OPEN TO ONE OR MORE USERS AND THE FILE'S FCB SUBSET F4100013* IS TO BE RELOCATED. THUS IF THERE WAS ONLY ONE PREVIOUS USER AND F4100014ÐÐ* THE FILE'S FCB WAS IN HIS SPACE AND THE NEW USER HAS THE FCB IN HIS F4100015* SPACE ALSO, A SUBSET ENTRY SPACE WILL BE OBTAINED FROM THE FCB SUBSETF4100016* CONTROL TABLE AND THE SUBSET INFO FROM THE PREVIOUS USER'S SPACE WILLF4100017* BE STORED FOR USE AS THE SUBSET. IF THE NEW USER DEFINES THE FCB TO F4100018* RESIDE IN A FILE MANAGER CONTROLLED TABLE, THE INFORMATION FROM THE F4100019* PREVIOUSLY DEFINED SUBSET WILL BE MOVED TO THE NEW FCB AND, IF THE F4100020* PREVIOUS SUBSET WAS IN THE SUBSET CONTROL TABLE, THE SUBSET ENTRY F4100021* WILL BE MARKED AVAILABLE FOR RE-USE. ALL RELINKING OF PREVIOUS UCT F4100022* ENTRIES TO THE NEWLY DEFINED SUBSET WILL BE DONE AS NEEDED. F4100023* F4100024* IF A FILE IS BEING CLOSED, FCBSS SHOULD UNCONDITIONALLY BE CALLED. F4100025* IF ANY OTHER USER IS FOUND TO HAVE THE SAME FILE'S FCB IN HIS SPACE, F4100026* THE FCB SUBSET MUST REMAIN IN A FM CONTROLLED TABLE (AS THE USER MAY F4100027* HAVE BEEN SWAPPED OUT). THUS, IF THE CLOSING USER HAS THE FCB IN A F4100028* FM CONTROLLED TABLE AND ALL REMAINING USERS HAVE FCBS IN THEIR SPACE,F4100029* THE FCB SUBSET CAN BE MOVED TO THE SUBSET CONTROL TABLE. IF THE F4100030* CLOSING USER HAS THE FCB IN HIS SPACE AND ANOTHER USER ALSO HAS THE F4100031* FCB IN HIS SPACE, THE SUBSET MAY NOT BE MOVED. F4100032* F4100033*E F4100034* ON ENTRY: F4100035* A-REG = 1 TO INDICATE AN ENTRY IS TO BE BUILT F4100036* Q-REG = FCB MAIN MEMORY ADDRESS F4100037* I-REG = THE PSUEDO FILE ID F4100038* OR F4100039ÐÐ* A-REG =0 TO INDICATE AN ENTRY IS TO BE RELEASED F4100040* Q-REG = FCB SUBSET ADDRESS F4100041* I-REG = THE ID OF THE RELEASING USER F4100042* F4100043* ON EXIT: F4100044* A-REG = SUBSET ENTRY ADDRESS (ONLY IF A=1 ON ENTRY AND NO ERROR)F4100045* Q-REG = COMPLETION STATUS: F4100046* 0 IF NO ERROR OCCURED F4100047* $9000 NO SPACE AVAILABLE IN THE FCST F4100048* I-REG UNCHANGED F4100049 EJT F4100050* ENTRY POINTS F4100051* F4100052 ENT FCBSS SUBROUTINE ENTRY POINT 121*4575F4100053* F4100054* EXTERNALS F4100055* F4100056 EXT FMFSRC FCB SUBSET RESIDENCY CHECK 136*A004F4100057 EXT FMFCBS SEQUENTIAL FILE CONTROL CONTROL BLOCK TABLE F4100058 EXT FCBSCT FCB SUBSET CONTROL TABLE F4100059 EXT FSLIMT FILE SPACE LIMIT TABLE F4100060 EXT FSCTNE NO. OF ENTRIES IN THE FCB SUBSET CONTROL TABLEF4100061 EXT UCTABL UCT ADDRESS F4100062 EXT MAXCOP NO. OF UCT ENTRY SPACES F4100063 EXT CCP CURRENT CONTROL POINT LOCATION F4100064ÐÐ EXT CPSET SET CONTROL POINT ROUTINE F4100065 EXT TSUSER TIMESHARE USER TABLE STARTING ADDRESS F4100066 EXT TSUEND TIMESHARE USER TABLE ENDING ADDRESS F4100067 EXT SYFAIL SYSTEM FAILURE ROUTINE F4100068**** F4100069* F4100070* EQUIVALENCES F4100071* F4100072 EQU ZERO(2) SYSTEM ZERO 121*4575F4100073 EQU ONEMSK(3) ONE MASK TABLE 121*4575F4100074* F4100075* MISCELLANEOUS F4100076 EQU SSELGH(10) LENGTH OF A FSCT ENTRY F4100077* F4100078* UCT ENTRY EQUIVALENCES F4100079* F4100080 EQU UIDENT(ZERO) USER IDENTIFICATION F4100081 EQU FIDENT(1) PSEUDO FILE IDENTIFIER F4100082 EQU FCBCAD(2) FCB CORE ADDRESS F4100083 EQU FSLADR(3) FILE SPACE LIMITS TABLE ENTRY ADDRESS F4100084 EQU FCBSAD(4) FCB SUBSET ADDRESS F4100085 EQU USRCPT(5) USERS CONTROL POINT F4100086 EQU UCTSIZ(6) SIZE OF A UCT ENTRY F4100087 EJT F4100088* FILE CONTROL BLOCK EQUIVALENCES F4100089ÐÐ EQU FH(4) LENGTH -1 OF FCB HEADER F4100090 EQU FILEID(ZERO) FILE IDENTIFIER F4100091* ACCESS FILEID INDIRECTLY F4100092* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBERF4100093* BITS 10-00 INDEX OF FCB IN FCB TABLE F4100094 EQU FCBFLG(1) FCB FLAGS F4100095* BITS 15-8, SPARE F4100096* BITS 7-00, NUMBER OF USERS USING FILE F4100097 EQU FILOCK(2) FILE LOCK FLAG (IF NON-0, CONTAINS USER ID) F4100098 EQU NUMSET(3) NUMBER OF SETS OF LOCKED RECORDS IN FILE F4100099 EQU NUMNEW(4) NUMBER OF NEW RECORDS SINCE FCB UPDATED ON MM F4100100 SPC 1 F4100101 EQU RECLEN(FH+1) RECORD LENGTH IN WORDS F4100102 EQU TDATRM(FH+2) TOTAL NUMBER OF DATA RECORDS, MSB F4100103 EQU TDATRL(FH+3) TOTAL NUMBER OF DATA RECORDS, LSB F4100104 EQU DATBAM(FH+4) DATA RECORDS BEGINNING SECTOR ADDRESS, MSB F4100105 EQU DATBAL(FH+5) DATA RECORDS BEGINNING SECTOR ADDRESS,LMSB F4100106 EQU FCBIND(FH+6) FCB INDICATORS F4100107* BIT 15 , SECTOR ALLIGNED RECORDS IF =1 F4100108* BIT 14 , STORAGE MODE FOR INDEXED FILE F4100109* =0, RECORDS STORED RANDOMLY WITHF4100110* RESPECT TO PRIMARY KEY F4100111* =1, RECORDS STORED IN ORDER WIT F4100112* RESPECT TO PRIMARY KEY F4100113* BIT 13 , =1, FILE IS CURRENTLY OPEN F4100114ÐÐ* =0, FILE IS CURRENTLY CLOSED F4100115* BIT 12 , =1, FILE IS BEING COMPRESSED F4100116* =0, FILE IS NOT BEING COMPRESSEDF4100117* BIT 11 , =1, FILE IS OPEN FOR SPECIAL F4100118* PROCESSING F4100119* =0, FILE IS NOT OPEN FOR SPECIALF4100120* PROCESSING F4100121* BIT 8 , =1, RECORDS CONTAIN BINARY DATA F4100122* =0, RECORDS DO NOT CONTAIN F4100123* BINARY DATA F4100124* BIT 0 , FILE TYPE F4100125* =0, SEQUENTIAL FILE F4100126* =1, INDEXED FILE F4100127 EQU NEDATM(FH+7) NUMBER OF EXISTING DATA RECORDS, MSB F4100128 EQU NEDATL(FH+8) NUMBER OF EXISTING DATA RECORDS, LSB F4100129 EQU SEQLTH(NEDATL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F4100130* OF FCB FOR A SEQUENTIAL FILE F4100131 SPC 1 F4100132 EQU NEXTBM(FH+9) NEXT FREE KEY INDEX BLOCK, MSB F4100133 EQU NEXTBL(FH+10) NEXT FREE KEY INDEX BLOCK, LSB F4100134 EQU TNKEYM(FH+11) TOTAL NUMBER OF KEY INDEX BLOCKS, MSB F4100135 EQU TNKEYL(FH+12) TOTAL NUMBER OF KEY INDEX BLOCKS, LSB F4100136 EQU KEYBAM(FH+13) KEY INDEX BEGINNING SECTOR ADDRESS, MSB F4100137 EQU KEYBAL(FH+14) KEY INDEX BEGINNING SECTOR ADDRESS, LSB F4100138 EQU LENKY1(FH+15) LENGTH OF KEY NO. 1 F4100139ÐÐ EQU POSKY1(FH+16) BYTE POSITION OF KEY NO. 1 F4100140 EQU LENKY2(FH+17) LENGTH OF KEY NO. 2 F4100141 EQU POSKY2(FH+18) BYTE POSITION OF KEY NO. 2 F4100142 EQU LENKY3(FH+19) LENGTH OF KEY NO. 3 F4100143 EQU POSKY3(FH+20) BYTE POSITION OF KEY NO. 3 F4100144 EQU LENKY4(FH+21) LENGTH OF KEY NO. 4 F4100145 EQU POSKY4(FH+22) BYTE POSITION OF KEY NO. 4 F4100146 EQU INDLEN(POSKY4-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F4100147* OF FCB FOR AN INDEXED FILE F4100148 EJT F4100149* THE FOLLOWING PORTION OF THE FCB EXISTS ONLY F4100150* ON MASS MEMORY. THESE 10 WORDS ARE NOT LOADEDF4100151* INTO EITHER OF THE FILE MANAGER CONTROLLED FCBF4100152* TABLES. F4100153 EQU TSFILM(FH+23) TOTAL NUMBER OF SECTORS IN FILE, MSB F4100154 EQU TSFILL(FH+24) TOTAL NUMBER OF SECTORS IN FILE, LSB F4100155 EQU NAME12(FH+25) FILE NAME, CHARACTERS 1 AND 2 F4100156 EQU NAME34(FH+26) FILE NAME, CHARACTERS 3 AND 4 F4100157 EQU NAME56(FH+27) FILE NAME, CHARACTERS 5 AND 6 F4100158 EQU NAME78(FH+28) FILE NAME, CHARACTERS 7 AND 8 F4100159 EQU OWNR12(FH+29) OWNER NAME, CHARACTERS 1 AND 2 F4100160 EQU OWNR34(FH+30) OWNER NAME, CHARACTERS 3 AND 4 F4100161 EQU OWNR56(FH+31) OWNER NAME, CHARACTERS 5 AND 6 F4100162 EQU OWNR78(FH+32) OWNER NAME, CHARACTERS 7 AND 8 F4100163 EQU BYTLEN(FH+33) BYTE LENGTH OF RECORD F4100164ÐÐ* F4100165* FOR COMPRESS ONLY F4100166* F4100167 EQU PRSRNM(FH+34) RRN OF LAST PROCESSED RECORD - MSB F4100168 EQU PRSRNL(FH+35) RRN OF LAST PROCESSED RECORD - LSB F4100169 EQU NEWRNM(FH+36) RRN OF THE LATEST 'NEW' RECORD - MSB F4100170 EQU NEWRNL(FH+37) RRN OF THE LATEST 'NEW' RECORD - LSB F4100171 SPC 4 F4100172* WORDS 0 THRU 4 OF THE FCB HEADER AND WORDS F4100173* 6 THRU 10 OF THE FCB ARE REFERRED TO AS THE F4100174* SHARED SUBSET OF THE FCB. THEY INCLUDE THE F4100175* ONLY FCB WORDS THAT CAN BE MODIFIED AFTER FILEF4100176* CREATION. IF TWO OR MORE USERS HAVE THE SAME F4100177* FILE OPEN, THERE HAS TO BE A SINGLE MASTER F4100178* COPY OF THE SUBSET THAT RECEIVES (AND RECORDS)F4100179* ALL OF THE UPDATES. THE CONTROLLED SUBSET F4100180* WILL ALWAYS BE PART OF A MAIN MEMORY RESIDENT F4100181* FCB IF THE FCB IS IN A FM CONTROLLED TABLE. F4100182* IF THE FCB IS IN USER SPACE, THE SUBSET MAY ATF4100183* TIMES RESIDE IN THE SUBSET CONTROL TABLE. F4100184 SPC 2 F4100185* ALTERNATE NAMES FOR SUBSET WORDS F4100186 EQU SAFCBI(FH+1) SUBSET ALTERNATE NAME FOR FCBIND F4100187 EQU SADATM(FH+2) SUBSET ALTERNATE NAME FOR NEDATM F4100188 EQU SADATL(FH+3) SUBSET ALTERNATE NAME FOR NEDATL F4100189ÐÐ EQU SANXTM(FH+4) SUBSET ALTERNATE NAME FOR NEXTBM F4100190 EQU SANXTL(FH+5) SUBSET ALTERNATE NAME FOR NEXTBL F4100191 EJT F4100192FCBSS 000 000 ENTRY POINT F4100193 STQ ADSAVE SAVE FCB OR FCB SUBSET ADDRESS F4100194 LDQ- I SAVE FILE OR USER ID F4100195 STQ IDSAVE F4100196 LDQ CCP SAVE CURRENT CONTROL POINT VALUE F4100197 STQ* CCPSAV F4100198 SAN SS10 SKIP FOR FILE OPEN PROCESSING F4100199 JMP SS200 GO TO FILE CLOSE PROCESSING F4100200 EJT F4100201* F4100202* OPEN FILE PROCESSING F4100203SS10 RTJ* PREPAR PREPARE FOR SEARCH OF UCT FOR OTHER USER F4100204 INQ 1 F4100205 RTJ SEARCH SEARCH FOR SAME FILE ID F4100206 SQN SS20 SKIP IF ENTRY FOUND (SHOULD ALWAYS BE FOUND) F4100207 RTJ SYFAIL F4100208* F4100209SS20 EIN 0 ENABLE INTERRUPTS (LEFT INHIBITED BY SEARCH) F4100210 INQ -1 RESET TO START OF UCT ENTRY F4100211 LDA- FCBSAD,Q F4100212 RTJ FMFSRC SET SOURCE RESIDENCY FLAG TO 0 IF 136*A004F4100213 STA* SORRES USER'S FCB SUBSET IS PART OF FCB, ELSE NOT 0 F4100214ÐÐ SAZ SS25 SKIP IF PART OF FCB F4100215 LDA- FCBSAD,Q SET A TO SUBSET ADDRESS F4100216 JMP* SS28 F4100217* F4100218SS25 LDA- FCBCAD,Q SET A TO FCB ADDRESS F4100219* F4100220SS28 STA- I SET I-REG TO FCB OR SUBSET ADDRESS (PREV. COPYF4100221 STA SUBSET SAVE THIS ADDRESS FOR POSSIBLE SUBSET RELEASE F4100222 STQ OLDUCT SAVE UCT ENTRY ADDRESS FOR RELINK LATER F4100223* F4100224 LDA ADSAVE CHECK RESIDENCY OF USER'S FCB F4100225 RTJ RESCHK ON RETURN, A=0 IF FCB IN FM CONTROLLED SPACE F4100226 STA* DESRES ELSE A NOT 0 F4100227 SAZ SS40 SKIP IF SEPARATE SUBSET SPACE NOT NEEDED F4100228 RTJ SSSRCH SEARCH FOR FREE SUBSET ENTRY F4100229 SQN SS30 SKIP IF ENTRY OBTAINED F4100230 TRA Q TRANSFER ERROR STATUS TO Q F4100231 JMP* SS90 GO RETURN TO CALLER (ERROR AS Q NOT 0) F4100232* F4100233SS30 LDA IDSAVE STORE FILE ID IN FIRST SUBSET WORD TO FLAG IT F4100234 STA- (ZERO),Q AS BEING USED F4100235 EIN 0 ENABLE INTERRUPTS F4100236 JMP* SS45 F4100237 EJT F4100238SS40 LDQ* ADSAVE SET Q TO ADDRESS OF NEW FCB (IN FM SPACE) F4100239ÐÐSS45 STQ TEMPA SAVE FOR PASS BACK TO CALLER F4100240 LDA- I SET A TO ADDRESS OF PREVIOUS FCB F4100241 RTJ RESCHK CHECK RESIDENCY OF PREVIOUS FCB F4100242 SAN SS50 SKIP IF FCB IN USER SPACE F4100243 JMP* SS60 FCB IN FM TABLE F4100244* F4100245SS50 LDQ OLDUCT RESET Q TO PREVIOUS USER'S UCT ADDRESS F4100246 LDA =XTSUSER CHECK IF THIS IS AN ITOS (INTERCEPTED) F4100247 SUB- (UIDENT),Q USER F4100248 SAZ SS55 SKIP IF YES F4100249 SAP SS60 NO F4100250 LDA =XTSUEND F4100251 SUB- (UIDENT),Q F4100252 SAM SS60 SKIP IF NO F4100253* F4100254SS55 LDQ- USRCPT,Q SET Q TO CONTROL POINT OF USER F4100255 RTJ* (ACPSET) SET THE CONTROL POINT F4100256* F4100257SS60 LDQ* TEMPA SET Q TO ADDRESS OF NEW FCB F4100258 LDA- I SET A TO ADDRESS OF PREVIOUS FCB F4100259 RTJ MOVSUB MOVE FCB SUBSET F4100260 LDA* CCPSAV CHECK IF CONTROL POINT NEEDS TO BE RESET F4100261 TRA Q F4100262 SUB CCP F4100263 SAZ SS65 SKIP IF NO F4100264ÐÐ RTJ* (ACPSET) RESET THE CONTROL POINT F4100265* F4100266SS65 LDA* TEMPA RESET A TO SUBSET ADDRESS F4100267 LDQ* OLDUCT LINK PREVIOUS USER'S UCT ENTRY TO RELOCATED F4100268 STA- FCBSAD,Q FCB SUBSET F4100269* F4100270 RTJ* PREPAR PREPARE FOR SEARCH OF UCT FOR MORE USERS F4100271 LDQ* OLDUCT RESET Q TO LAST ENTRY FOUND F4100272 INQ UCTSIZ+1 BUMP TO FILE ID WORD OF NEXT ENTRY F4100273 RTJ* SEARCH SEARCH FOR SAME FILE ID F4100274 EIN 0 ENABLE INTERRUPTS (LEFT INHIBITED BY SEARCH) F4100275 SQZ SS70 SKIP IF NO OTHER USERS FOUND F4100276 INQ -1 RESET Q TO START OF UCT ENTRY F4100277 LDA* TEMPA RESET A TO SUBSET ADDRESS F4100278 STA- FCBSAD,Q LINK PREVIOUS USER'S UCT ENTRY TO RELOCATED F4100279* FCB SUBSET F4100280 INQ 1 BUMP Q TO FILE ID WORD AND CONTINUE SEARCH F4100281 JMP* SE005 F4100282 EJT F4100283SS70 LDA* SORRES CHECK RESIDENCY OF JUST MOVED SUBSET F4100284 SAZ SS80 SKIP IF PART OF FCB F4100285 LDQ* SUBSET SET Q TO ADDRESS OF EXTERNAL SUBSET F4100286 CLR A F4100287 STA- (ZERO),Q CLEAR FIRST WORD TO MARK FREE FOR RE-USE F4100288* F4100289ÐÐSS80 ENQ 0 SET Q=0 AS EXIT FLAG - OK F4100290SS90 LDA* IDSAVE RESTORE ENTRY CONDITIONS OF I-REG F4100291 STA- I F4100292 LDA* TEMPA RESTORE SAVED A-REG F4100293 JMP* (FCBSS) F4100294 SPC 2 F4100295ACPSET ADC CPSET SET CONTROL POINT ROUTINE F4100296CCPSAV NUM 0 SAVED CONTROL POINT VALUE F4100297 EJT F4100298* F4100299* PREPARE TO SEARCH UCT FOR USERS OF CURRENT FILE F4100300* F4100301PREPAR 000 000 ENTRY F4100302 LDQ* ADSAVE F4100303 LDA- (FILEID),Q F4100304 STA* KEY SET KEY FOR FILE ID F4100305 LDA* UCTLEN F4100306 STA* INC SET LENGTH OF ENTRY F4100307 MUI =XMAXCOP COMPUTE ADDRESS OF LWA+1 OF UCT F4100308 ADD* ADDR2 F4100309 STA* ENDAD STORE AS END ADDRESS FOR SEARCH F4100310 LDQ* ADDR2 SET Q TO START ADDRESS FOR SEARCH F4100311 STQ* SRHFLG SET SEARCH FLAG FOR 'UCT SEARCH' F4100312 JMP* (PREPAR) RETURN F4100313 EJT F4100314ÐÐ* F4100315* MOVE A FCB SUBSET FROM ONE PLACE TO ANOTHER F4100316* F4100317* SOURCE OF SUBSET MAY BE AN FCB OR THE SUBSET TABLE F4100318* DESTINATION OF SUBSET MAY BE AN FCB OR THE SUBSET TABLE F4100319* F4100320* ON ENTRY: F4100321* A-REG = ADDRESS OF SOURCE SUBSET OR FCB F4100322* Q-REG = ADDRESS OF DESTINATION SUBSET OR FCB F4100323* F4100324* AND: F4100325* SORRES INDICATES TYPE OF SOURCE BUFFER AND F4100326* DESRES INDICATES TYPE OF DESTINATION BUFFER F4100327* WHERE 0 IMPLIES FCB AND NOT 0 IMPLIES FCB SUBSET F4100328* F4100329* THE I REGISTER WILL BE USED BY MOVSUB F4100330* F4100331MOVSUB 000 000 ENTRY F4100332 STA- I PUT SOURCE BUFFER ADDRESS IN I-REG F4100333 STQ* DESTIN PUT DESTINATION BUFFER ADDRESS IN DESTIN F4100334 ENQ FH SET INDEX/COUNTER FOR HEADER MOVE F4100335* F4100336MOV10 LDA- (ZERO),B MOVE ONE WORD F4100337 STA* (DESTIN),Q F4100338 INQ -1 DECREMENT COUNTER F4100339ÐÐ SQM MOV20 SKIP IF FINISHED WITH HEADER PORTION F4100340 JMP* MOV10 LOOP F4100341* F4100342MOV20 LDA* SORRES CHECK TYPE OF SOURCE BUFFER F4100343 SAN MOV30 SKIP IF FCB SUBSET F4100344 ENA FCBIND SET INDEX TO FCBIND WORD F4100345 JMP* MOV35 F4100346* F4100347MOV30 ENA SAFCBI SET INDEX TO SAFCBI WORD F4100348MOV35 ADD- I CHANGE I FOR LOAD OF NEXT PORTION OF SUBSET F4100349 STA- I F4100350* F4100351 LDA* DESRES CHECK TYPE OF DESTINATION BUFFER F4100352 SAN MOV40 SKIP IF FCB SUBSET F4100353 ENA FCBIND SET INDEX TO FCBIND WORD F4100354 JMP* MOV45 F4100355* F4100356MOV40 ENA SAFCBI SET INDEX TO SAFCBI WORD F4100357MOV45 ADD* DESTIN CHANGE DESTINATION FOR STORE OF NEXT PART F4100358 STA* DESTIN OF SUBSET F4100359 ENQ 4 SET INDEX/COUNTER F4100360 EJT F4100361MOV50 LDA- (ZERO),B MOVE ONE WORD F4100362 STA* (DESTIN),Q F4100363 INQ -1 DECREMENT OCUNTER F4100364ÐÐ SQM MOV60 SKIP IF FINISHED WITH HEADER PORTION F4100365 JMP* MOV50 LOOP F4100366* F4100367MOV60 JMP* (MOVSUB) ALL DONE - RETURN F4100368 SPC 2 F4100369DESRES NUM 0 DESTINATION BUFFER RESIDENCY FLAG F4100370SORRES NUM 0 SOURCE BUFFER RESIDENCY FLAG F4100371DESTIN NUM 0 DESTINATION BUFFER ADDRESS F4100372 EJT F4100373* ROUTINE TO SEARCH A BLOCK OF MAIN MEMORY FOR A GIVEN VALUE (KEY) F4100374* F4100375* ON ENTRY: F4100376* KEY CONTAINS THE MATCH VALUE F4100377* INC CONTAINS THE SEARCH INCREMENT F4100378* ENDAD CONTAINS THE ENDING SEARCH ADDRESS F4100379* ON EXIT F4100380* Q-REG CONTAINS THE MATCHING VALUE'S ADDRESS OR F4100381* CONTAINS ZERO IF NO MATCH WAS FOUND. F4100382* F4100383SEARCH 000 000 ENTRY POINT F4100384 STQ* ADDR SAVE ADDRESS F4100385SE000 IIN 0 INHIBIT INTERRUPTS F4100386 LDA* SRHFLG CHECK IF THIS IS A UCT SEARCH F4100387 SAZ SE002 SKIP IF NO F4100388 LDA- (ZERO),Q GET FILE ID WORD AND MASK OFF BIT 15 F4100389ÐÐ AND- ONEMSK+14 F4100390 JMP* SE004 F4100391* F4100392SE002 LDA- (ZERO),Q PICKUP INDICATED WORD F4100393SE004 EOR* KEY COMPARE TO KEY F4100394 SAZ SE020 SKIP IF MATCHED F4100395SE005 EIN 0 ENABLE INTERRUPTS F4100396 LDA* ADDR COMPUTE NEXT ADDRESS F4100397 ADD* INC F4100398 TRA Q F4100399 SUB* ENDAD CHECK IF SEARCH IS FINISHED F4100400 SAP SE010 F4100401 STQ* ADDR NO: CONTINUE F4100402 JMP* SE000 CONTINUE F4100403SE010 ENQ 0 MATCH WAS NEVER FOUND F4100404SE020 JMP* (SEARCH) RETURN F4100405 SPC 2 F4100406SRHFLG NUM 0 SEARCH FLAG: NOT 0 IF SEARCH UCT FOR FILE ID F4100407 EJT F4100408ADSAVE NUM 0 SAVED FCB OR FCB SUBSET ADDRESS F4100409IDSAVE NUM 0 SAVED FILE OR USER ID F4100410* F4100411* SEARCH PARAMETERS F4100412KEY NUM 0 MATCH VALUE F4100413INC NUM 0 SEARCH INCREMENT F4100414ÐÐENDAD NUM 0 ENDING SEARCH ADDRESS F4100415ADDR NUM 0 SAVED ADDRESS F4100416 SPC 1 F4100417ADDR1 ADC FCBSCT FCB SUBSET CONTROL TABLE ADDRESS F4100418ADDR2 ADC UCTABL USER CONTROL TABLE ADDRESS F4100419SSTLEN ADC SSELGH LENGTH OF A FCBSCT ENTRY F4100420UCTLEN ADC UCTSIZ LENGTH OF UCT ENTRY F4100421TEMPA NUM 0 TEMPORARY STORAGE F4100422ENTRY NUM 0 ADDRESS OF SUBSET SPACE OBTAINED F4100423SUBSET NUM 0 SAVED ADDRESS OF PREVIOUS FCB OR SUBSET F4100424USERSP NUM 0 FCB IN USER SPACE FLAG - 0 IF NO F4100425OLDUCT NUM 0 ADDRESS OF OTHER USERS UCT ENTRY F4100426 EJT F4100427* F4100428* PREPARE FOR AND MAKE SEARCH FOR FREE ENTRY SPACE IN SUBSET CONTROL F4100429* TABLE. F4100430* F4100431* ON EXIT: F4100432* Q-REG = ADDRESS OF EMPTY SPACE FOUND (Q NOT 0) F4100433* ELSE Q = 0 AND A-REG = $9000 AS ERROR EXIT CODE F4100434* F4100435* IREG IS UNAFFECTED BY SEARCH F4100436* INTERRUPTS WILL BE INHIBITED UPON RETURN IF FREE SPACE FOUNDF4100437* F4100438SSSRCH 000 000 ENTRY POINT F4100439ÐÐ CLR A SET SEACH PARAMS TO SEARCH FOR FREE SPOT F4100440 STA* KEY SET KEY FOR EMPTY SUBSET F4100441 STA* SRHFLG SET SEARCH FLAG FOR 'NOT UCT SEARCH' F4100442 LDA* SSTLEN F4100443 STA* INC SET LENGTH OF SUBSET F4100444 MUI =XFSCTNE F4100445 ADD* ADDR1 COMPUTE ADDRESS OF LWA+1 OF SUBSET TABLE F4100446 STA* ENDAD STORE AS END ADDRESS FOR SEARCH F4100447 LDQ* ADDR1 SET Q TO FWA OF SUBSET TABLE F4100448 RTJ* SEARCH SEARCH FOR FREE TNTRY F4100449 SQN SSS10 F4100450 EIN 0 ENABLE INTERRUPTS F4100451 LDA =N$9000 SET ERROR CODE F4100452SSS10 JMP* (SSSRCH) RETURN TO CALLER F4100453 EJT F4100454* F4100455* CHECK RESIDENCY OF A GIVEN FCB F4100456* F4100457* ON ENTRY: F4100458* A-REG = ADDRESS OF FCB TO BE CHECKED F4100459* F4100460* ON EXIT: F4100461* A-REG = 0 IF FCB IN FM CONTROLLED TABLE F4100462* ELSE FCB IN USER SPACE F4100463* Q AND I REGS ARE NOT ALTERED F4100464ÐÐ* F4100465RESCHK 000 000 ENTRY POINT F4100466 STA* TEMP SAVE ADDRESS OF FCB F4100467 SUB =XFMFCBS CHECK IF FCB ADDRESS.GE.FMFCBS TABLE ADDRESS F4100468 SAM RES10 SKIP IF NO - FCB IN USER SPACE F4100469 LDA* TEMP RELOAD FCB ADDRESS F4100470 SUB =XFSLIMT CHECK IF FCB ADDRESS .GT. END OF FCBSCT F4100471 SAP RES10 SKIP IF YES - FCB IN USER SPACE F4100472 CLR A F4100473 JMP* (RESCHK) EXIT WITH A=0 F4100474* F4100475RES10 ENA 1 F4100476 JMP* (RESCHK) EXIT WITH A=1, FCB IN USER SPACE F4100477* F4100478TEMP NUM 0 F4100479 EJT F4100480* F4100481* CLOSE FILE PROCESSING F4100482* F4100483SS200 CLR A CLEAR FLAG THAT INDICATES WHETHER OR NOT F4100484 STA* USERSP ANOTHER FCB FOR SAME FILE IS IN USER SPACE F4100485* SET UP TO CHECK UCT FOR ANOTHER USER THAT HAS F4100486 RTJ* PREPAR THE SAME FILE OPEN WITH THE FCB IN HIS SPACE F4100487SS210 INQ 1 BUMP TO ADDRESS OF FILEID WORD F4100488 RTJ* SEARCH SEARCH FOR SAME FILE ID F4100489ÐÐ EIN 0 ENABLE INTERRUPTS F4100490 SQN SS220 SKIP IF SAME FILE ID FOUND F4100491 JMP* SS250 ALL DONE WITH SEARCH - GO CHECK WHAT TO DO F4100492* F4100493SS220 INQ -1 RESET Q TO START OF UCT ENTRY F4100494 LDA- (UIDENT),Q PICKUP USER IDENT F4100495 SUB* IDSAVE CHECK IF IDENT THAT OF CLOSING USER F4100496 SAN SS230 SKIP IF NO F4100497 STQ* TEMPA SAVE ADDRESS OF THIS UCT ENTRY F4100498 INQ 1 BUMP Q BACK TO FILE ID WORD F4100499 JMP* SE005 CONTINUE CHECK OF UCT ENTRIES F4100500* F4100501SS230 LDA- FCBCAD,Q CHECK IF THE FCB IS IN USER SPACE F4100502 RTJ* RESCHK F4100503 SAZ SS240 SKIP IF FCB NOT IN USER SPACE F4100504 RAO* USERSP BUMP FLAG TO SIGNAL FCB IN USER SPACE F4100505 INQ 1 BUMP Q BACK TO FILE ID WORD F4100506 JMP* SE005 CONTINUE SEARCH OF TABLE - TO INSURE CURRENT F4100507* USER'S ENTRY FOUND F4100508* F4100509* ANOTHER USER HAS FCB IN FM SPACE - THUS NO F4100510* MOVES OR RELINKING NEEDED F4100511SS240 JMP SS80 GO TO EXIT ROUTINE F4100512 EJT F4100513 SPC 2 F4100514ÐÐ* ALL OF UCTABL HAS BEEN SEARCHED AND NO OTHER USER HAS THE FCB IN F4100515* FM SPACE. CHECK IF ANY OTHER USER'S HAVE FCB IN THEIR SPACE. F4100516* F4100517SS250 LDA* USERSP IF NO OTHER USERS WITH FCB IN THEIR SPACE, GO F4100518 SAN SS260 CHECK IF CURRENT USER HAS EXTERNAL SUBSET F4100519 JMP* SS350 GO DO THE CHECK F4100520* F4100521SS260 LDQ* TEMPA CHECK RESIDENCY OF FCB OF CURRENT USER F4100522 LDA- FCBCAD,Q F4100523 RTJ* RESCHK F4100524 SAZ SS270 SKIP IF FCB IN FM TABLE F4100525 JMP* SS240 GO TO EXIT ROUTINE. CANNOT MOVE OR RELINK. F4100526* F4100527SS270 RTJ* SSSRCH SEARCH FOR FREE ENTRY IN SUBSET CONTROL TABLE F4100528 SQN SS280 SKIP IF ENTRY OBTAINED F4100529 TRA Q TRANSFER ERROR CODE TO Q F4100530 JMP SS90 GO RETURN TO CALLER (ERROR AS Q NOT 0) F4100531* F4100532SS280 LDA* (ADSAVE) GET FILEID AND STORE IN FIRST SUBSET WORD TO F4100533 STA- (ZERO),Q FLAG ENTRY AS IN USE F4100534 EIN 0 ENABLE INTERRUPTS F4100535 CLR A SET SOURCE RESIDENCY FLAG TO INDICATE SOURCE F4100536 STA* SORRES SUBSET IS IN FCB F4100537 ENA 1 SET DESTINATION RESIDENCY FLAG TO INDICATE F4100538 STA* DESRES DESTINATION SUBSET IS AN EXTERNAL SUBSET F4100539ÐÐ STQ* ENTRY SAVE ADDRESS OF SUBSET ENTRY F4100540 LDA* ADSAVE SET A TO ADDRESS OF SOURCE FCB F4100541 RTJ MOVSUB MOVE THE SUBSET (TO SUBSET CONTROL TABLE) F4100542* F4100543 RTJ PREPAR SET UP TO CHECK UCT FOR ALL USERS OF THIS FILEF4100544SS290 INQ 1 BUMP TO ADDRESS OF FILEID WORD F4100545 RTJ* SEARCH SEARCH FOR SAME FILE ID F4100546 EIN 0 ENABLE INTERRUPTS F4100547 SQN SS300 SKIP IF SAME FILE ID FOUND F4100548 JMP* SS240 ALL DONE - GO EXIT F4100549* F4100550SS300 INQ -1 F4100551 LDA* ENTRY LINK THIS UCT ENTRY TO NEW SUBSET F4100552 STA- FCBSAD,Q F4100553 INQ 1 BUMP Q BACK TO FILE ID WORD F4100554 JMP* SE005 GO CHECK FOR ANOTHER USER F4100555 SPC 4 F4100556 EJT F4100557* F4100558* ONLY ONE USE HAS FILE OPEN. CHECK IF AN EXTERNAL SUBSET EXISTS F4100559* F4100560SS350 LDQ* TEMPA SET Q TO SAVED UCT ENTRY ADDRESS F4100561 LDA- FCBCAD,Q F4100562 EOR- FCBSAD,Q F4100563 SAN SS360 SKIP IF SUBSET NOT PART OF FCB F4100564ÐÐ JMP* SS240 ALL DONE - GO EXIT F4100565* F4100566SS360 CLR A F4100567 STA DESRES DEFINE SUBSET DESTINATION AS FCB F4100568 LDA- FCBSAD,Q 136*A004F4100569 RTJ FMFSRC DETERMINE SUBSET RESIDENCY 136*A004F4100570 STA SORRES SET RESIDENCY FLAG FOR MOVSUB 136*A004F4100571* THE FOLLOWING LOGIC IS NEEDED SINCE 121*4575F4100572* OPEN FILE CAN CAUSE A SUBSET TO BE 121*4575F4100573* RELEASED IF ONE WAS CREATED AND THE 121*4575F4100574* OPEN REQUEST GETS ABORTED. 121*4575F4100575 LDA =XTSUSER CHECK IF AN ITOS (INTERCEPTED) USER 121*4575F4100576 SUB- (UIDENT),Q 121*4575F4100577 SAZ SS370 SKIP IF YES 121*4575F4100578 SAP SS380 SKIP IF NO 121*4575F4100579 LDA =XTSUEND 121*4575F4100580 SUB- (UIDENT),Q 121*4575F4100581 SAM SS380 SKIP IF NO 121*4575F4100582* 121*4575F4100583SS370 LDQ- USRCPT,Q SET Q TO CONTROL POINT OF USER 121*4575F4100584 RTJ* (ADCPST) SET CONTROL POINT 121*4575F4100585 LDQ* TEMPA RESET Q TO SAVED UCT ENTRY ADDRESS 121*4575F4100586* 121*4575F4100587SS380 LDA- FCBSAD,Q SET A TO SOURCE ADDRESS 121*4575F4100588 LDQ- FCBCAD,Q SET Q TO DESTINATION ADDRESS F4100589ÐÐ RTJ MOVSUB MOVE THE SUBSET F4100590 LDA CCPSAV CHECK IF CONTROL POINT NEEDS TO 121*4575F4100591 TRA Q BE RESET 121*4575F4100592 SUB CCP 121*4575F4100593 SAZ SS390 SKIP IF NO 121*4575F4100594 RTJ* (ADCPST) RESET THE CONTROL POINT 121*4575F4100595 EJT 121*4575F4100596SS390 LDQ+ TEMPA 121*4575F4100597 LDQ- FCBSAD,Q F4100598 CLR A F4100599 STA- (ZERO),Q RELEASE SUBSET FOR REUSE F4100600 LDQ* (SS390+1) 121*4575F4100601 LDA- FCBCAD,Q RELINK UCT ENTRY TO NEW SUBSET ADDRESS F4100602 STA- FCBSAD,Q F4100603 JMP* SS240 ALL DONE - GO EXIT F4100604 SPC 2 121*4575F4100605ADCPST ADC CPSET ADDRESS OF CPSET 123*4096F4100606 SPC 2 F4100607 END F4100608 NAM GETFCB F42 A ITOS CCS 3.0 SL-149F4200001* FILE MANAGER GET FCB REQUEST PROCESSOR F4200002* CREDIT COLLECTION SYSTEM VERSION 3.0 F4200003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F4200004* COPYRIGHT CONTROL DATA CORPORATION 1979 F4200005* F4200006ÐÐ**** F4200007* F4200008* GETFCB IS THE REQUEST PROCESSOR FOR THE GET FILE CONTROL F4200009* BLOCK REQUEST. THIS REQUEST HAS THE FOLLOWING CALL SEQUENCE:F4200010* F4200011* CALL GETFCB (REQBUF,VOLNAM,INDEX,FCBBFR,ISTAT) F4200012* F4200013* WHERE REQBUF IS THE REQUEST BUFFER, F4200014* VOLNAM IS THE VOLUME NAME ARRAY, F4200015* INDEX IS FILE CONTROL BLOCK TABLE INDEX, F4200016* FCBBFR IS THE BUFFER TO RECEIVE THE FCB, AND F4200017* ISTAT IS THE FILE REQUEST WORD. F4200018* F4200019* IF VOLNAM(1)=0 ON ENTRY, THE FCB TO BE RETRIEVED IS THE ONE F4200020* FOR THE OPEN FILE ASSOCIATED WITH REQBUF. IF VOLNAM(1) NOT F4200021* 0, VOLNAM MUST SPECIFY THE (4 WORD) NAME OF THE VOLUME FROM F4200022* WHICH THE FCB IS TO BE RETRIEVED. F4200023* F4200024* IF VOLNAM(1) NOT 0, INDEX SPECIFIES WHICH BLOCK IS TO BE F4200025* RETRIEVED FROM THE FCB TABLE. F4200026* F4200027* A 96 WORD FCB WILL BE RETRIEVED. F4200028* F4200029* ISTAT HAS THE FOLLOWING DEFINITION UPON RETURN F4200030* BIT MEANING F4200031ÐÐ* --- ------- F4200032* 15 FILE REQUEST REJECTED. F4200033* 14* FILE REQUEST ILLEGAL. F4200034* 13* REQBUF NOT IN PROPER INITIALIZED STATE (VOLNAM(1)=0).F4200035* VOLUME SPECIFIED BY VOLNAM IS NOT MOUNTED AND READY F4200036* (VOLNAM(1).NE.0). F4200037* 12* FCB NOT RETRIEVED AS INDEX OUT OF RANGE FOR VOLUME. F4200038* 11-6 UNUSED. F4200039* 5* MASS MEMORY I/O ERROR. F4200040* 4-0 UNUSED. F4200041 EJT F4200042* ENTRY POINT F4200043 ENT GETFCB F4200044* F4200045* EXTERNALS F4200046 EXT MMREAD MASS MEMORY READ ROUTINE F4200047 EXT CKUADR CHECK UNPROTECTED ADDRESS F4200048 EXT UCTABL USER CONTROL TABLE F4200049 EXT MMLUTB MASS MEMORY LOGICAL UNIT TABLE F4200050 EXT PCTABL PROCESSOR CONTROL TABLE F4200051 EXT FMSCOM FILE MANAGER COMPLETION ADDRESS FOR SERIAL F4200052* PROCS F4200053 EXT MAXCOP MAX. NO. USERS/OPEN FILES F4200054 EXT DWADD DOUBLE WORD ADD F4200055 EXT FCBSCT ADDRESS OF FCB SUBSET CONTROL TABLE F4200056ÐÐ EXT FMFCBS ADDRESS OF SEQUENTIAL FILE FCB TABLE F4200057 EXT FSLIMT ADDRESS OF FILE SPACE LIMITS TABLE 132*5244F4200058 EXT SYFAIL SYSTEM FAILURE ROUTINE F4200059 EXT FMCOVL CHECK FOR PARAMETER OVERLAP F4200060**** F4200061 EJT F4200062* EQUIVALENCES F4200063 SPC 2 F4200064* COMMUNICATION REGION CONSTANTS F4200065 EQU ZERO(2) ZERO CONSTANT F4200066 EQU ONEMSK(3) ONE MASK TABLE F4200067 EQU ZROMSK($13) ZERO MASK TABLE F4200068 EQU ONEBIT($23) ONE BIT TABLE F4200069 SPC 1 F4200070* UCT ENTRY EQUIVALENCES F4200071 EQU UIDENT(ZERO) USER IDENTIFICATION F4200072 EQU FIDENT(1) PSEUDO FILE IDENTIFIER F4200073 EQU FCBCAD(2) FCB CORE ADDRESS F4200074 EQU FSLADR(3) FILE SPACE LIMITS TABLE ENTRY ADDRESS F4200075 EQU FCBSAD(4) FCB SUBSET ADDRESS F4200076 EQU USRCPT(5) USERS CONTROL POINT F4200077 EQU UCTELG(6) UCT ENTRY LENGTH F4200078 EJT F4200079* REQUEST BUFFER INDEXES - FIRST 4 WORDS F4200080 EQU RBATHR(0) REQUEST BUFFER ADDRESS THREAD F4200081ÐÐ EQU BUFAMP(1) BUFFER ADDRESS MAIN PART F4200082 EQU CNTLPT(2) CONTROL POINT (OR SPARE) F4200083 EQU RQINFO(3) REQUEST INFORMATION (MULTI-FIELD) F4200084* BITS USE F4200085* 15-12 SPARE F4200086* 11-04 REQUEST INDEX F4200087* 03-00 LEVEL OF REQUESTOR F4200088* F4200089* REQUEST BUFFER INDEXES - MAIN PART F4200090 EQU QREG(0) Q REGISTER F4200091 EQU IREG(1) I REGISTER F4200092 EQU PARLST(2) ADDRESS OF PARAMETER LIST F4200093 EQU RTNADR(2) RETURN ADDRESS TO USER (UPON RETURN FROM EXEC)F4200094 EQU UCTADR(3) UCT ENTRY ABSOLUTE ADDRESS F4200095 EQU USERID(4) USER IDENTIFIER F4200096 EQU FCBADR(5) FCB ADDRESS (MAY BE SET BY CALLER OR INTCPTR.)F4200097 EQU RADINT(6) RETURN ADDRESS TO INTERCEPTOR F4200098 EQU RPIDX(7) REQUEST PROCESSOR INDEX F4200099* BITS 14-00 REQUEST PROCESSOR INDEX F4200100* BIT 15 TYPE OF PROCESSOR F4200101* =0, SERIAL PROCESSOR F4200102* =1, REENTRANT PROCESSOR F4200103 EQU LOKREC(8) NUMBER OF RECORDS TO BE READ/WRITTEN PER I/O F4200104* CALL AND LOCK RECORDS ON RETRIEVE FLAG F4200105* BITS 14-00 NUMBER OF RECORDS PER CALL F4200106ÐÐ* BIT 15 =0, DO NOT LOCK ON RETRIEVE F4200107* =1, LOCK RECORDS ON RETRIEVE F4200108 EQU USEFLG(9) TYPE OF FILE USE FLAG F4200109* -1, OPEN FOR COMPRESSION F4200110* -2, OPEN FOR SPECIAL PROCESSING F4200111* 0, OPEN FOR ACESS VIA REL REC NO F4200112* 1, OPEN FOR RETRIEVAL VIA KEY 1 F4200113* 2, OPEN FOR RETRIEVAL VIA KEY 2 F4200114* 3, OPEN FOR RETRIEVAL VIA KEY 3 F4200115* 4, OPEN FOR RETRIEVAL VIA KEY 4 F4200116 EQU NUMREC(10) NUMBER OF RECORDS ACTUALLY STORED/RETRIEVED F4200117 EQU RRNMSB(11) REL REC NUMBER OF STORED/RETRIEVED REC, MSB F4200118 EQU RRNLSB(12) REL REC NUMBER OF STORED/RETRIEVED REC, LSB F4200119 EQU RMPLEN(20) LENGTH OF REQBUF MAIN PART F4200120 EJT F4200121* FILE CONTROL BLOCK EQUIVALENCES F4200122 EQU FH(4) LENGTH -1 OF FCB HEADER F4200123 EQU FILEID(ZERO) FILE IDENTIFIER F4200124* ACCESS FILEID INDIRECTLY F4200125* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBERF4200126* BITS 10-00 INDEX OF FCB IN FCB TABLE F4200127 EQU FCBFLG(1) FCB FLAGS F4200128* BITS 15-8, SPARE F4200129* BITS 7-00, NUMBER OF USERS USING FILE F4200130 EQU FILOCK(2) FILE LOCK FLAG (IF NON-0, CONTAINS USER ID) F4200131ÐÐ EQU NUMSET(3) NUMBER OF SETS OF LOCKED RECORDS IN FILE F4200132 EQU NUMNEW(4) NUMBER OF NEW RECORDS SINCE FCB UPDATED ON MM F4200133 SPC 1 F4200134 EQU RECLEN(FH+1) RECORD LENGTH IN WORDS F4200135 EQU TDATRM(FH+2) TOTAL NUMBER OF DATA RECORDS, MSB F4200136 EQU TDATRL(FH+3) TOTAL NUMBER OF DATA RECORDS, LSB F4200137 EQU DATBAM(FH+4) DATA RECORDS BEGINNING SECTOR ADDRESS, MSB F4200138 EQU DATBAL(FH+5) DATA RECORDS BEGINNING SECTOR ADDRESS,LMSB F4200139 EQU FCBIND(FH+6) FCB INDICATORS F4200140* BIT 15 , SECTOR ALLIGNED RECORDS IF =1 F4200141* BIT 14 , STORAGE MODE FOR INDEXED FILE F4200142* =0, RECORDS STORED RANDOMLY WITHF4200143* RESPECT TO PRIMARY KEY F4200144* =1, RECORDS STORED IN ORDER WIT F4200145* RESPECT TO PRIMARY KEY F4200146* BIT 13 , =1, FILE IS CURRENTLY OPEN F4200147* =0, FILE IS CURRENTLY CLOSED F4200148* BIT 12 , =1, FILE IS BEING COMPRESSED F4200149* =0, FILE IS NOT BEING COMPRESSEDF4200150* BIT 11 , =1, FILE IS OPEN FOR SPECIAL F4200151* PROCESSING F4200152* =0, FILE IS NOT OPEN FOR SPECIALF4200153* PROCESSING F4200154* BIT 8 , =1, RECORDS CONTAIN BINARY DATA F4200155* =0, RECORDS DO NOT CONTAIN F4200156ÐÐ* BINARY DATA F4200157* BIT 0 , FILE TYPE F4200158* =0, SEQUENTIAL FILE F4200159* =1, INDEXED FILE F4200160 EQU NEDATM(FH+7) NUMBER OF EXISTING DATA RECORDS, MSB F4200161 EQU NEDATL(FH+8) NUMBER OF EXISTING DATA RECORDS, LSB F4200162 EQU SEQLTH(NEDATL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F4200163* OF FCB FOR A SEQUENTIAL FILE F4200164 SPC 1 F4200165 EQU NEXTBM(FH+9) NEXT FREE KEY INDEX BLOCK, MSB F4200166 EQU NEXTBL(FH+10) NEXT FREE KEY INDEX BLOCK, LSB F4200167 EQU TNKEYM(FH+11) TOTAL NUMBER OF KEY INDEX BLOCKS, MSB F4200168 EQU TNKEYL(FH+12) TOTAL NUMBER OF KEY INDEX BLOCKS, LSB F4200169 EQU KEYBAM(FH+13) KEY INDEX BEGINNING SECTOR ADDRESS, MSB F4200170 EQU KEYBAL(FH+14) KEY INDEX BEGINNING SECTOR ADDRESS, LSB F4200171 EQU LENKY1(FH+15) LENGTH OF KEY NO. 1 F4200172 EQU POSKY1(FH+16) BYTE POSITION OF KEY NO. 1 F4200173 EQU LENKY2(FH+17) LENGTH OF KEY NO. 2 F4200174 EQU POSKY2(FH+18) BYTE POSITION OF KEY NO. 2 F4200175 EQU LENKY3(FH+19) LENGTH OF KEY NO. 3 F4200176 EQU POSKY3(FH+20) BYTE POSITION OF KEY NO. 3 F4200177 EQU LENKY4(FH+21) LENGTH OF KEY NO. 4 F4200178 EQU POSKY4(FH+22) BYTE POSITION OF KEY NO. 4 F4200179 EQU INDLEN(POSKY4-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F4200180* OF FCB FOR AN INDEXED FILE F4200181ÐÐ EJT F4200182* THE FOLLOWING PORTION OF THE FCB EXISTS ONLY F4200183* ON MASS MEMORY. THESE 10 WORDS ARE NOT LOADEDF4200184* INTO EITHER OF THE FILE MANAGER CONTROLLED FCBF4200185* TABLES. F4200186 EQU TSFILM(FH+23) TOTAL NUMBER OF SECTORS IN FILE, MSB F4200187 EQU TSFILL(FH+24) TOTAL NUMBER OF SECTORS IN FILE, LSB F4200188 EQU NAME12(FH+25) FILE NAME, CHARACTERS 1 AND 2 F4200189 EQU NAME34(FH+26) FILE NAME, CHARACTERS 3 AND 4 F4200190 EQU NAME56(FH+27) FILE NAME, CHARACTERS 5 AND 6 F4200191 EQU NAME78(FH+28) FILE NAME, CHARACTERS 7 AND 8 F4200192 EQU OWNR12(FH+29) OWNER NAME, CHARACTERS 1 AND 2 F4200193 EQU OWNR34(FH+30) OWNER NAME, CHARACTERS 3 AND 4 F4200194 EQU OWNR56(FH+31) OWNER NAME, CHARACTERS 5 AND 6 F4200195 EQU OWNR78(FH+32) OWNER NAME, CHARACTERS 7 AND 8 F4200196 EQU BYTLEN(FH+33) BYTE LENGTH OF RECORD F4200197* F4200198* FOR COMPRESS ONLY F4200199* F4200200 EQU PRSRNM(FH+34) RRN OF LAST PROCESSED RECORD - MSB F4200201 EQU PRSRNL(FH+35) RRN OF LAST PROCESSED RECORD - LSB F4200202 EQU NEWRNM(FH+36) RRN OF THE LATEST 'NEW' RECORD - MSB F4200203 EQU NEWRNL(FH+37) RRN OF THE LATEST 'NEW' RECORD - LSB F4200204 SPC 4 F4200205* WORDS 0 THRU 4 OF THE FCB HEADER AND WORDS F4200206ÐÐ* 6 THRU 10 OF THE FCB ARE REFERRED TO AS THE F4200207* SHARED SUBSET OF THE FCB. THEY INCLUDE THE F4200208* ONLY FCB WORDS THAT CAN BE MODIFIED AFTER FILEF4200209* CREATION. IF TWO OR MORE USERS HAVE THE SAME F4200210* FILE OPEN, THERE HAS TO BE A SINGLE MASTER F4200211* COPY OF THE SUBSET THAT RECEIVES (AND RECORDS)F4200212* ALL OF THE UPDATES. THE CONTROLLED SUBSET F4200213* WILL ALWAYS BE PART OF A MAIN MEMORY RESIDENT F4200214* FCB IF THE FCB IS IN A FM CONTROLLED TABLE. F4200215* IF THE FCB IS IN USER SPACE, THE SUBSET MAY ATF4200216* TIMES RESIDE IN THE SUBSET CONTROL TABLE. F4200217 SPC 2 F4200218* ALTERNATE NAMES FOR SUBSET WORDS F4200219 EQU SAFCBI(FH+1) SUBSET ALTERNATE NAME FOR FCBIND F4200220 EQU SADATM(FH+2) SUBSET ALTERNATE NAME FOR NEDATM F4200221 EQU SADATL(FH+3) SUBSET ALTERNATE NAME FOR NEDATL F4200222 EQU SANXTM(FH+4) SUBSET ALTERNATE NAME FOR NEXTBM F4200223 EQU SANXTL(FH+5) SUBSET ALTERNATE NAME FOR NEXTBL F4200224 EJT F4200225* VOLUME INFORMATION TABLE F4200226* F4200227 EQU VISLUN(2) SYSTEM LOGICAL UNIT NUMBER (BIT 15=1,NOT READYF4200228* ACCESS VISLUN INDIRECTLY F4200229 EQU VINAME(1) VOLUME NAME - ASCII CHARACTERS 1 AND 2 F4200230* VOLUME NAME - ASCII CHARACTERS 3 AND 4 F4200231ÐÐ* VOLUME NAME - ASCII CHARACTERS 5 AND 6 F4200232* VOLUME NAME - ASCII CHARACTERS 7 AND 8 F4200233 EQU VINMBR(5) VOLUME NUMBER - (2 ASCII CHARACTERS) F4200234 EQU VIBMSM(6) BEGINNING OF MANAGEABLE SPACE - MSB F4200235 EQU VIBMSL(7) BEGINNING OF MANAGEABLE SPACE - LSB F4200236 EQU VIASDM(8) AVAILABLE SPACE DIRECTORY ADDRESS - MSB F4200237 EQU VIASDL(9) AVAILABLE SPACE DIRECTORY ADDRESS - LSB F4200238 EQU VIASDS(10) # SECTORS IN AVAILABLE SPACE DIRECTORY F4200239 EQU VILBAM(11) LARGEST BLOCK OF SPACE AVAILABLE - MSB F4200240 EQU VILBAL(12) LARGEST BLOCK OF SPACE AVAILABLE - LSB F4200241 EQU VIWPS(13) WORDS/SECTOR FOR VOLUME F4200242 EQU VIFDDM(14) FILE DEFINITION DIRECTORY ADDRESS - MSB F4200243 EQU VIFDDL(15) FILE DEFINITION DIRECTORY ADDRESS - LSB F4200244 EQU VIMAXF(16) MAX. NUMBER OF FILES PERMITTED ON VOLUME F4200245 EQU VICURF(17) CURRENT NUMBER OF FILES EXISTING ON VOLUME F4200246 EQU VINFDB(18) NUMBER OF BLOCKS IN FILE DEFINITION DIRECTORY F4200247 EQU VINXTB(19) NEXT AVAILABLE BLOCK IF FILE DEF. DIRECTORY F4200248 EQU VINOOF(20) NUMBER OF OPEN FILES ON VOLUME F4200249 EJT F4200250* REQUEST PROCESSOR CONTROL TABLE F4200251* F4200252 EQU RP(10) INDEX TO START OF REQUEST PARAMETERS F4200253 EQU MR(RP+5) INDEX TO START OF MONITOR REQUEST PARAM LIST F4200254 EQU SS(MR+10) INDEX TO START OF SCRATCH PORTION OF PAR LIST F4200255* F4200256ÐÐ EQU RPLOGU(1) LU NUMBER OF MM DEVICE F4200257 EQU RPAREQ(2) ACTIVE REQUEST FLAG (IF 0, NONE FOR TABLE) F4200258 EQU RPWAIT(3) START OF WAITING REQUEST QUEUE (IF 0, NO WAITGF4200259 EQU RPRLEV(4) REQUEST PRIORITY LEVEL - ACTIVE REQUEST F4200260 EQU RPRBF4(5) REQBUF ADDRESS - FIRST FOUR WORDS F4200261 EQU RPLTEA(6) LOCK TABLE ENTRY (ABSOLUTE) ADDRESS F4200262 EQU RPRTNJ(7) RETURN JUMP TO REQUEST PROCESSOR F4200263 EQU RPPADR(8) PROCESSOR ADDRESS F4200264 SPC 1 F4200265* PARAMETER LIST FOR REQUEST PROCESSOR F4200266 EQU RPFCBA(9) FCB ADDRESS FOR FILE F4200267 EQU RPRBMP(RP+0) REQBUF ADDRESS - MAIN PART F4200268 EQU RPPFP1(RP+1) REQUEST PARAMETER ADDRESS - FIRST + 1 F4200269 EQU RPPFP2(RP+2) REQUEST PARAMETER ADDRESS - FIRST + 2 F4200270 EQU RPPFP3(RP+3) REQUEST PARAMETER ADDRESS - FIRST + 3 F4200271 EQU RPPFP4(RP+4) REQUEST PARAMETER ADDRESS - FIRST + 4 F4200272 SPC 1 F4200273* MAIN MONITOR REQUEST F4200274 EQU RPMREQ(MR+0) MONITOR REQUEST CODE WORD F4200275 EQU RPMRP1(MR+1) COMPLETION ADDRESS F4200276 EQU RPMRP2(MR+2) THREAD WORD F4200277 EQU RPMRP3(MR+3) LOGICAL UNIT FOR I/O F4200278 EQU RPMRP4(MR+4) NUMBER OF WORDS F4200279 EQU RPMRP5(MR+5) START CORE ADDRESS F4200280 EQU RPMRP6(MR+6) MASS MEMORY ADDRESS, MSB F4200281ÐÐ EQU RPMRP7(MR+7) MASS MEMORY ADDRESS, LSB F4200282 EQU RPRCPT(MR+8) CONTROL POINT (FOR I/O REQUESTS) F4200283 EQU RPRETN(MR+9) SAVED RETURN ADDRESS F4200284* ALTERNATE COMMON NAMES F4200285 EQU REQBUF(RP+0) USERS FIRST CALL PARAMETER ADDRESS F4200286 EQU RECBUF(RP+1) RECORD BUFFER PARAMETER - FOR PUTS F4200287 EQU VOLNAM(RP+1) VOLNAM NAME BUFFER ADDRESS F4200288 EQU INDEX(RP+2) INDEX PARAMETER ADDRESS F4200289 EQU FCBBFR(RP+3) FCB BUFFER ADDRESS F4200290 EQU ISTAT(RP+4) USERS COMPLETION STATUS PARAMETER ADDRESS F4200291 EJT F4200292* SCRATCH FOR GETFCB F4200293* F4200294* PARAMETER LIST FOR MM I/O ROUTINE F4200295 EQU MSBBSA(SS+0) MSB OF BASE SECTOR ADDRESS - FCBT F4200296 EQU LSBBSA(SS+1) LSB OF BASE SECTOR ADDRESS - FCBT F4200297 EQU MSBRRN(SS+2) MSB OF RELATIVE RECORD NUMBER F4200298 EQU LSBRRN(SS+3) MSB OF RELATIVE RECORD NUMBER F4200299 EQU RCDLEN(SS+4) RECORD LENGTH F4200300 EQU NUMWDS(SS+5) NUMBER OF WORDS TO READ F4200301 EQU OFFSET(SS+6) WORD OFFSET FROM START OF RECORD F4200302 EQU RECBFR(SS+7) ADDRESS OF BUFFER FOR I/O F4200303 EQU IOTYPE(SS+8) I/O TYPE: NON-ZERO IF FILE I/O, ELSE ZERO. F4200304 EJT F4200305GETFCB 000 000 ENTRY POINT F4200306ÐÐ* F4200307* NO NEED TO PROCESS PARAMETER LIST FOR CALL F4200308* F4200309 ENA 96 SET NUMBER OF WORDS FOR READ F4200310 STA- RCDLEN,I AND RECORD LENGTH OF FCBS. F4200311 STA- NUMWDS,I F4200312 CLR A CLEAR OFFSET, IOTYPE AND MSB OF RRN F4200313 STA- OFFSET,I F4200314 STA- IOTYPE,I F4200315 STA- MSBRRN,I F4200316 LDA- FCBBFR,I SET BUFFER ADDRESS FOR I/O F4200317 STA- RECBFR,I F4200318 STA* BUFADR SAVE FOR USE AT GET220 F4200319 CLR Q CLEAR Q-REG FOR CKUADR USE F4200320GET10 RTJ CKUADR CHECK IF FIRST FCBBFR WORD LEGAL IF UNPROTECTDF4200321 LDA- RECBFR,I F4200322 INA 95 CHECK IF LAST FCBBFR WORD LEGAL IF UNPROTECTEDF4200323 RTJ* (GET10+1) (NO RETURN IF NOT) F4200324* F4200325 LDA- RECBFR,I CHECK IF RECBUF OVERLAPS F4200326 ENQ 96 WITH REQBUF F4200327 RTJ FMCOVL F4200328 SAZ GET15 NO F4200329 JMP GET160 YES, EXIT F4200330* F4200331ÐÐGET15 LDQ- VOLNAM,I CHECK IF VOLUME LABLE IS SPECIFIED F4200332 LDA- (ZERO),Q F4200333 SAZ GET20 SKIP IF NO - FILE MUST BE OPEN F4200334 JMP* GET50 GO CHECK FOR LOADED AND READY VOLUME F4200335* F4200336GET20 LDQ- REQBUF,I GET ADDRESS OF UCT ENTRY FROM REQBUF F4200337 LDA- UCTADR,Q F4200338 STA* TEMP1 SAVE LOCALLY F4200339 LDA* (TEMP1) PICKUP FIRST WORD AND CHECK IF IT AGREES WITH F4200340 EOR- USERID,Q REQBUF INFO F4200341 SAN GET30 SKIP IF NO F4200342 RAO* TEMP1 F4200343 LDA* (TEMP1) PICKUP 2ND WORD OF UCT ENTRY - FILE ID F4200344 STA* IDENT SAVE LOCALLY F4200345 AND- ONEMSK+10 EXTRACT INDEX TO FCBT F4200346 INA 1 BUMP BY 1 AND STORE AS RECORD NUMBER F4200347 STA- LSBRRN,I F4200348 EJT F4200349 LDA* IDENT F4200350 ARS 11 F4200351 AND- ONEMSK+4 EXTRACT FM LU NO. FROM FILE ID F4200352 STA- RPLOGU,I STORE IN 1ST WORD OF RPC TABLE F4200353 RAO* TEMP1 F4200354 LDA* (TEMP1) PICKUP 3RD UCT WORD AND CHECK IF IT AGREES F4200355 EOR- FCBADR,Q WITH REQBUF INFO F4200356ÐÐ SAZ GET40 SKIP IF YES F4200357* F4200358GET30 LDA =N$A000 SET USER'S ISTAT TO $A000 (REQBUF NOT PROPERLYF4200359* INITIALIZED) F4200360 JMP* GET160 GO STORE ISTAT AND RETURN TO EXEC F4200361* F4200362GET40 JMP* GET140 GO SET BASE MM ADDRESS FOR READ F4200363* F4200364* VOLUME NAME WAS SPECIFIED. CHECK IF VOLUME F4200365GET50 CLR A LOADED AND READY. F4200366 STA* TEMP1 SET COUNTER/INDEX TO ZERO F4200367* F4200368GET60 RAO* TEMP1 BUMP INDEX AND CHECK IF OUT OF RANGE F4200369 LDA* (ADMLUT) F4200370 SUB* TEMP1 F4200371 SAP GET70 SKIP IF NOT TOO BIG F4200372 LDA =N$A000 SET USER'S ISTAT TO $A000 (VOLUME SPECIFIED F4200373* NOT LOADED AND READY) F4200374 JMP* GET160 GO STORE ISTAT AND RETURN TO EXEC F4200375* F4200376GET70 LDQ* TEMP1 GET ADDRESS OF NEXT VIT TO BE CHECKED F4200377 STQ- RPLOGU,I STORE LU NUMBER OF MM DEVICE IN RPC TABLE F4200378 LDA* (ADMLUT),Q F4200379 STA* TEMP2 SAVE IT F4200380* F4200381ÐÐ LDA* (TEMP2) CHECK IF VOLUME IS LOADED AND READY F4200382 SAP GET80 SKIP IF YES F4200383 JMP* GET60 GO CHECK FOR MORE VOLUMES F4200384 EJT F4200385GET80 LDQ- VOLNAM,I F4200386 LDA- (ZERO),Q F4200387 RAO* TEMP2 BUMP VIT ADDRESS TO 1ST WORD OF NAME F4200388 EOR* (TEMP2) CHECK IF 1ST WORD OF NAMES AGREE F4200389 SAN GET90 SKIP IF NO F4200390 RAO* TEMP2 BUMP VIT ADDRESS TO 2ND WORD OF NAME F4200391 LDA- 1,Q F4200392 EOR* (TEMP2) CHECK IF 2ND WORD OF NAMES AGREE F4200393 SAN GET90 SKIP IF NO F4200394 RAO* TEMP2 BUMP VIT ADDRESS TO 3RD WROD OF NAME F4200395 LDA- 2,Q F4200396 EOR* (TEMP2) CHECK IF 3RD WORD OF NAMES AGREE F4200397 SAN GET90 SKIP IF NO F4200398 RAO* TEMP2 BUMP VIT ADDRESS TO 4TH WORD OF NAME F4200399 LDA- 3,Q F4200400 EOR* (TEMP2) CHECK IF 4TH WORD OF NAMES AGREE F4200401 SAZ GET95 SKIP IF YES F4200402GET90 JMP* GET60 GO CHECK FOR MORE VOLUMES F4200403GET95 JMP* GET100 F4200404 SPC 2 F4200405* PARAM LIST FOR DWADD F4200406ÐÐFDDMSB NUM 0 MSB OF FDD ADDRESS F4200407FDDLSB NUM 0 LSB OF FDD ADDRESS F4200408 NUM 0 F4200409NUMFDB NUM 0 NUMBER OF FDBS F4200410RESMSB NUM 0 MSB OF RESULT - START ADDRESS OF FCBT F4200411RESLSB NUM 0 LSB OF RESULT - START ADDRESS OF FCBT F4200412STATUS NUM 0 STATUS OF ADD OPERATION F4200413 SPC 2 F4200414BUFADR NUM 0 SAVED FCB BUFFER ADDRESS F4200415TEMP1 NUM 0 TEMPORARY STORAGE F4200416TEMP2 NUM 0 TEMPORARY STORAGE F4200417IDENT NUM 0 FILE ID F4200418UCTLEN ADC UCTELG UCT ENTRY LENGTH F4200419ENDAP1 NUM 0 LWA+1 OF UCT F4200420ADMLUT ADC MMLUTB MASS MEMORY LOGICAL UNIT TABLE ADDRESS F4200421 EJT F4200422GET100 LDQ* TEMP2 GET ADDRESS +4 OF VIT F4200423 INQ -4 DECREMENT BACK TO START OF VIT AND SAVE F4200424 STQ* TEMP2 F4200425* F4200426 LDQ- INDEX,I CHECK INDEX SPECIFIED BY USER F4200427 LDA- (ZERO),Q F4200428 SAZ GET110 ILLEGAL IF 0 F4200429 SAP GET120 ASSURE IT IS POSITIVE AND NON-ZERO F4200430GET110 LDA- ZROMSK+13 SET USER'S ISTAT TO $C000 - ILLEGAL REQUEST F4200431ÐÐ JMP* GET240 GO STORE ISTAT AND RETURN TO EXEC F4200432* F4200433GET120 STA- LSBRRN,I STORE IT AS RRN F4200434 TCA A COMPLEMENT IT THEN CHECK IF IT IS OUT OF F4200435 LDQ* TEMP2 RANGE FOR VOLUME F4200436 ADD- VIMAXF,Q F4200437 SAM GET125 SKIP TO ERROR EXIT IF OUT OF RANGE 121*4610F4200438 LDA- VICURF,Q CHECK IF ANY FILES CURRENTLY DEFINED 121*4610F4200439 SAN GET130 SKIP IF YES 121*4610F4200440GET125 LDA =N$9000 SET USER'S ISTAT TO $9000 - 121*4610F4200441* INDEX OUT OF RANGE 121*4610F4200442 JMP* GET240 GO STORE ISTAT AND RETURN TO EXEC F4200443* F4200444GET130 LDA* TEMP1 CONSTRUCT A FILE ID WORD FOR UCT SEARCH F4200445 ALS 11 F4200446 LDQ- INDEX,I F4200447 ADD- (ZERO),Q F4200448 INA -1 F4200449 STA* IDENT SAVE IT F4200450* F4200451GET140 LDQ- RPLOGU,I GET VIT ADDRESS FOR FILE'S VOLUME F4200452 LDQ* (ADMLUT),Q F4200453 LDA- VIFDDM,Q STORE FDD ADDRESS FOR DOUBLE WORD ADD F4200454 STA* FDDMSB F4200455 LDA- VIFDDL,Q F4200456ÐÐ STA* FDDLSB F4200457 LDA- VINFDB,Q F4200458 STA* NUMFDB STORE NO. OF FDBS F4200459 LDQ =XFDDMSB SET Q TO ADDRESS OF PARAM LIST FOR DWADD F4200460 RTJ DWADD COMPUTE ADDRESS OF FCBT F4200461 LDA* STATUS F4200462 SAZ GET150 ASSURE STATUS IS GOOD F4200463 RTJ SYFAIL CRASH SYSTEM - VIT MESSED UP F4200464 EJT F4200465GET150 LDA* RESMSB STORE FCBT ADDRESS IN MM I/O PARAM LIST F4200466 STA- MSBBSA,I F4200467 LDA* RESLSB F4200468 STA- LSBBSA,I F4200469 LDQ- I F4200470 INQ MSBBSA SET Q TO ABS ADDRESS F4200471 RTJ MMREAD READ IN THE FCB F4200472 SQP GET170 SKIP IF NO ERROR F4200473 LDA =N$8020 SET USER'S ISTAT TO REFLECT I/O ERROR + REJECTF4200474 INQ 0 F4200475 SQN GET160 SKIP IF NOT A COMPUTATION ERROR F4200476 EOR- ONEBIT+14 SET ILLEGAL REQUEST BIT F4200477GET160 JMP* GET240 GO STORE ISTAT AND RETURN TO EXEC F4200478* F4200479GET170 LDA* UCTLEN SET UP TO SEARCH UCT FOR ENTRY FOR THIS FILE F4200480 MUI =XMAXCOP F4200481ÐÐ ADD* UCTADD COMPUTE ADDRESS OF LWA+1 OF UCT F4200482 STA* ENDAP1 F4200483 LDQ* UCTADD F4200484 INQ 1 SET Q TO FWA+1 OF UCT F4200485* F4200486GET180 LDA- (ZERO),Q GET FILE ID WORD OF UCT F4200487 EOR* IDENT CHECK IF SAME AS FCB'S FILE ID F4200488 SAZ GET200 SKIP IF YES F4200489 TRQ A F4200490 ADD* UCTLEN BUMP INDEX TO NEXT UCT ENTRY F4200491 TRA Q F4200492 SUB* ENDAP1 CHECK IF ALL ENTRIES CHECKED F4200493 SAP GET190 SKIP IF YES F4200494 JMP* GET180 GO CHECK NEXT ENTRY F4200495GET190 JMP* GET230 GO SET ISTAT FOR USER F4200496* F4200497GET200 INQ -1 DECREMENT Q TO START OF UCT ENTRY F4200498 LDA- FCBSAD,Q F4200499 EOR- FCBCAD,Q CHECK IF SUBSET IS PART OF FCB F4200500 SAZ GET210 SKIP IF YES F4200501 LDQ- FCBSAD,Q SET Q TO SUBSET ADDRESS F4200502 TRQ A CHECK IF SUBSET IN SUB. CONTRL TABLE 132*5244F4200503 SUB =XFCBSCT 132*5244F4200504 SAM GET205 SKIP IF NO 132*5244F4200505 TCQ A 132*5244F4200506ÐÐ ADD =XFSLIMT 132*5244F4200507 SAM GET205 SKIP IF NO 132*5244F4200508 INQ SAFCBI BUMP SUBSET ADDRESS TO SAFCBI WORD 132*5244F4200509 JMP* GET220 132*5244F4200510* 132*5244F4200511GET205 JMP* GET217 132*5244F4200512 EJT F4200513GET210 LDQ- FCBCAD,Q SET Q TO FCB ADDRESS F4200514 TRQ A CHECK IF FCB IS IN SYSTEM TABLE SPACE F4200515 SUB =XFCBSCT F4200516 SAP GET215 SKIP IF NO F4200517 TRQ A 132*5244F4200518 SUB =XFMFCBS 132*5244F4200519 SAP GET217 SKIP IF FCB IN SYSTEM TABLE F4200520GET215 JMP* GET230 CANNOT UPDATE FCB WITH SUBSET INFO F4200521* F4200522GET217 INQ FCBIND BUMP Q TO FCBIND WORD ADDRESS F4200523* F4200524GET220 LDA* BUFADR F4200525 STA- I STORE FCB BUFFER ADDRESS IN I-REG F4200526* F4200527 LDA- (ZERO),Q MOVE FCB SUBSET INTO USER'S BUFFER F4200528 STA- FCBIND-FH-1,I F4200529 LDA- 1,Q F4200530 STA- NEDATM-FH-1,I F4200531ÐÐ LDA- 2,Q F4200532 STA- NEDATL-FH-1,I F4200533 LDA- 3,Q F4200534 STA- NEXTBM-FH-1,I F4200535 LDA- 4,Q F4200536 STA- NEXTBL-FH-1,I F4200537* F4200538GET230 CLR A CLEAR A FOR USE AS ISTAT VALUE F4200539* F4200540GET240 LDQ PCTABL RESET I-REG TO RPC TABLE ADDRESS F4200541 STQ- I F4200542 LDQ- ISTAT,I F4200543 STA- (ZERO),Q STORE ISTAT FOR USER F4200544 RTJ FMSCOM RETURN TO EXEC TO COMPLETE THE REQUEST F4200545* (NO RETURN TO GETFCB) F4200546 SPC 2 F4200547UCTADD ADC UCTABL UCT TABLE ADDRESS F4200548 END F4200549 NAM UPDFCB F43 A ITOS CCS 3.0 SL-149F4300001* FILE MANAGER UPDATE FCB REQUEST PROCESSOR F4300002* CREDIT COLLECTION SYSTEM VERSION 3.0 F4300003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F4300004* COPYRIGHT CONTROL DATA CORPORATION 1979 F4300005* F4300006**** F4300007ÐÐ* UPDFCB IS THE REQUEST PROCESSOR FOR THE UPDATE FILE CONTROL F4300008* BLOCK REQUEST. THIS REQUEST HAS THE FOLLOWING CALL SEQUENCE:F4300009* F4300010* CALL UPDFCB (REQBUF,VOLNAM,INDEX,FCBBFR,ISTAT) F4300011* F4300012* WHERE REQBUF IS THE REQUEST BUFFER, F4300013* VOLNAM IS THE VOLUME NAME ARRAY, F4300014* INDEX IS FILE CONTROL BLOCK TABLE INDEX, F4300015* FCBBFR IS THE BUFFER CONTAINING THE FCB, AND F4300016* ISTAT IS THE FILE REQUEST WORD. F4300017* F4300018* IF VOLNAM(1)=0 ON ENTRY, THE FCB TO BE UPDATED IS THE ONE F4300019* FOR THE OPEN FILE ASSOCIATED WITH REQBUF. IF VOLNAM(1) NOT F4300020* 0, VOLNAM MUST SPECIFY THE (4 WORD) NAME OF THE VOLUME FOR F4300021* WHICH THE FCB IS TO BE UPDATED. F4300022* F4300023* IF VOLNAM(1) NOT 0, INDEX SPECIFIES WHICH BLOCK IS TO BE F4300024* UPDATED IN THE FCB TABLE. F4300025* F4300026* ONLY WORDS 37 THROUGH 96 OF THE FCB BUFFER WILL BE WRITTEN F4300027* TO THE MASS RESIDENT FCB. F4300028* F4300029* ISTAT HAS THE FOLLOWING DEFINITION UPON RETURN F4300030* BIT MEANING F4300031* --- ------- F4300032ÐÐ* 15 FILE REQUEST REJECTED. F4300033* 14* FILE REQUEST ILLEGAL. F4300034* 13* REQBUF NOT IN PROPER INITIALIZED STATE (VOLNAM(1)=0).F4300035* VOLUME SPECIFIED BY VOLNAM IS NOT MOUNTED AND READY F4300036* (VOLNAM(1).NE.0). F4300037* 12* FCB NOT RETRIEVED AS INDEX OUT OF RANGE FOR VOLUME. F4300038* 11-6 UNUSED. F4300039* 5* MASS MEMORY I/O ERROR. F4300040* 4-0 UNUSED. F4300041 EJT F4300042* ENTRY POINT F4300043 ENT UPDFCB F4300044* F4300045* EXTERNALS F4300046 EXT MMWRIT MASS MEMORY WRITE ROUTINE F4300047 EXT MMLUTB MASS MEMORY LOGICAL UNIT TABLE F4300048 EXT PCTABL PROCESSOR CONTROL TABLE F4300049 EXT FMSCOM FILE MANAGER COMPLETION ADDRESS FOR SERIAL F4300050* PROCS F4300051 EXT DWADD DOUBLE WORD ADD F4300052 EXT SYFAIL SYSTEM FAILURE ROUTINE F4300053**** F4300054 EJT F4300055* EQUIVALENCES F4300056 SPC 2 F4300057ÐÐ* COMMUNICATION REGION CONSTANTS F4300058 EQU ZERO(2) ZERO CONSTANT F4300059 EQU ONEMSK(3) ONE MASK TABLE F4300060 EQU ZROMSK($13) ZERO MASK TABLE F4300061 EQU ONEBIT($23) ONE BIT TABLE F4300062 SPC 1 F4300063* UCT ENTRY EQUIVALENCES F4300064 EQU UIDENT(ZERO) USER IDENTIFICATION F4300065 EQU FIDENT(1) PSEUDO FILE IDENTIFIER F4300066 EQU FCBCAD(2) FCB CORE ADDRESS F4300067 EQU FSLADR(3) FILE SPACE LIMITS TABLE ENTRY ADDRESS F4300068 EQU FCBSAD(4) FCB SUBSET ADDRESS F4300069 EQU USRCPT(5) USERS CONTROL POINT F4300070 EJT F4300071* REQUEST BUFFER INDEXES - FIRST 4 WORDS F4300072 EQU RBATHR(0) REQUEST BUFFER ADDRESS THREAD F4300073 EQU BUFAMP(1) BUFFER ADDRESS MAIN PART F4300074 EQU CNTLPT(2) CONTROL POINT (OR SPARE) F4300075 EQU RQINFO(3) REQUEST INFORMATION (MULTI-FIELD) F4300076* BITS USE F4300077* 15-12 SPARE F4300078* 11-04 REQUEST INDEX F4300079* 03-00 LEVEL OF REQUESTOR F4300080* F4300081* REQUEST BUFFER INDEXES - MAIN PART F4300082ÐÐ EQU QREG(0) Q REGISTER F4300083 EQU IREG(1) I REGISTER F4300084 EQU PARLST(2) ADDRESS OF PARAMETER LIST F4300085 EQU RTNADR(2) RETURN ADDRESS TO USER (UPON RETURN FROM EXEC)F4300086 EQU UCTADR(3) UCT ENTRY ABSOLUTE ADDRESS F4300087 EQU USERID(4) USER IDENTIFIER F4300088 EQU FCBADR(5) FCB ADDRESS (MAY BE SET BY CALLER OR INTCPTR.)F4300089 EQU RADINT(6) RETURN ADDRESS TO INTERCEPTOR F4300090 EQU RPIDX(7) REQUEST PROCESSOR INDEX F4300091* BITS 14-00 REQUEST PROCESSOR INDEX F4300092* BIT 15 TYPE OF PROCESSOR F4300093* =0, SERIAL PROCESSOR F4300094* =1, REENTRANT PROCESSOR F4300095 EQU LOKREC(8) NUMBER OF RECORDS TO BE READ/WRITTEN PER I/O F4300096* CALL AND LOCK RECORDS ON RETRIEVE FLAG F4300097* BITS 14-00 NUMBER OF RECORDS PER CALL F4300098* BIT 15 =0, DO NOT LOCK ON RETRIEVE F4300099* =1, LOCK RECORDS ON RETRIEVE F4300100 EQU USEFLG(9) TYPE OF FILE USE FLAG F4300101* -1, OPEN FOR COMPRESSION F4300102* -2, OPEN FOR SPECIAL PROCESSING F4300103* 0, OPEN FOR ACESS VIA REL REC NO F4300104* 1, OPEN FOR RETRIEVAL VIA KEY 1 F4300105* 2, OPEN FOR RETRIEVAL VIA KEY 2 F4300106* 3, OPEN FOR RETRIEVAL VIA KEY 3 F4300107ÐÐ* 4, OPEN FOR RETRIEVAL VIA KEY 4 F4300108 EQU NUMREC(10) NUMBER OF RECORDS ACTUALLY STORED/RETRIEVED F4300109 EQU RRNMSB(11) REL REC NUMBER OF STORED/RETRIEVED REC, MSB F4300110 EQU RRNLSB(12) REL REC NUMBER OF STORED/RETRIEVED REC, LSB F4300111 EQU RMPLEN(20) LENGTH OF REQBUF MAIN PART F4300112 EJT F4300113* FILE CONTROL BLOCK EQUIVALENCES F4300114 EQU FH(4) LENGTH -1 OF FCB HEADER F4300115 EQU FILEID(ZERO) FILE IDENTIFIER F4300116* ACCESS FILEID INDIRECTLY F4300117* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBERF4300118* BITS 10-00 INDEX OF FCB IN FCB TABLE F4300119 EQU FCBFLG(1) FCB FLAGS F4300120* BITS 15-8, SPARE F4300121* BITS 7-00, NUMBER OF USERS USING FILE F4300122 EQU FILOCK(2) FILE LOCK FLAG (IF NON-0, CONTAINS USER ID) F4300123 EQU NUMSET(3) NUMBER OF SETS OF LOCKED RECORDS IN FILE F4300124 EQU NUMNEW(4) NUMBER OF NEW RECORDS SINCE FCB UPDATED ON MM F4300125 SPC 1 F4300126 EQU RECLEN(FH+1) RECORD LENGTH IN WORDS F4300127 EQU TDATRM(FH+2) TOTAL NUMBER OF DATA RECORDS, MSB F4300128 EQU TDATRL(FH+3) TOTAL NUMBER OF DATA RECORDS, LSB F4300129 EQU DATBAM(FH+4) DATA RECORDS BEGINNING SECTOR ADDRESS, MSB F4300130 EQU DATBAL(FH+5) DATA RECORDS BEGINNING SECTOR ADDRESS,LMSB F4300131 EQU FCBIND(FH+6) FCB INDICATORS F4300132ÐÐ* BIT 15 , SECTOR ALLIGNED RECORDS IF =1 F4300133* BIT 14 , STORAGE MODE FOR INDEXED FILE F4300134* =0, RECORDS STORED RANDOMLY WITHF4300135* RESPECT TO PRIMARY KEY F4300136* =1, RECORDS STORED IN ORDER WIT F4300137* RESPECT TO PRIMARY KEY F4300138* BIT 13 , =1, FILE IS CURRENTLY OPEN F4300139* =0, FILE IS CURRENTLY CLOSED F4300140* BIT 12 , =1, FILE IS BEING COMPRESSED F4300141* =0, FILE IS NOT BEING COMPRESSEDF4300142* BIT 11 , =1, FILE IS OPEN FOR SPECIAL F4300143* PROCESSING F4300144* =0, FILE IS NOT OPEN FOR SPECIALF4300145* PROCESSING F4300146* BIT 8 , =1, RECORDS CONTAIN BINARY DATA F4300147* =0, RECORDS DO NOT CONTAIN F4300148* BINARY DATA F4300149* BIT 0 , FILE TYPE F4300150* =0, SEQUENTIAL FILE F4300151* =1, INDEXED FILE F4300152 EQU NEDATM(FH+7) NUMBER OF EXISTING DATA RECORDS, MSB F4300153 EQU NEDATL(FH+8) NUMBER OF EXISTING DATA RECORDS, LSB F4300154 EQU SEQLTH(NEDATL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F4300155* OF FCB FOR A SEQUENTIAL FILE F4300156 SPC 1 F4300157ÐÐ EQU NEXTBM(FH+9) NEXT FREE KEY INDEX BLOCK, MSB F4300158 EQU NEXTBL(FH+10) NEXT FREE KEY INDEX BLOCK, LSB F4300159 EQU TNKEYM(FH+11) TOTAL NUMBER OF KEY INDEX BLOCKS, MSB F4300160 EQU TNKEYL(FH+12) TOTAL NUMBER OF KEY INDEX BLOCKS, LSB F4300161 EQU KEYBAM(FH+13) KEY INDEX BEGINNING SECTOR ADDRESS, MSB F4300162 EQU KEYBAL(FH+14) KEY INDEX BEGINNING SECTOR ADDRESS, LSB F4300163 EQU LENKY1(FH+15) LENGTH OF KEY NO. 1 F4300164 EQU POSKY1(FH+16) BYTE POSITION OF KEY NO. 1 F4300165 EQU LENKY2(FH+17) LENGTH OF KEY NO. 2 F4300166 EQU POSKY2(FH+18) BYTE POSITION OF KEY NO. 2 F4300167 EQU LENKY3(FH+19) LENGTH OF KEY NO. 3 F4300168 EQU POSKY3(FH+20) BYTE POSITION OF KEY NO. 3 F4300169 EQU LENKY4(FH+21) LENGTH OF KEY NO. 4 F4300170 EQU POSKY4(FH+22) BYTE POSITION OF KEY NO. 4 F4300171 EQU INDLEN(POSKY4-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F4300172* OF FCB FOR AN INDEXED FILE F4300173 EJT F4300174* THE FOLLOWING PORTION OF THE FCB EXISTS ONLY F4300175* ON MASS MEMORY. THESE 10 WORDS ARE NOT LOADEDF4300176* INTO EITHER OF THE FILE MANAGER CONTROLLED FCBF4300177* TABLES. F4300178 EQU TSFILM(FH+23) TOTAL NUMBER OF SECTORS IN FILE, MSB F4300179 EQU TSFILL(FH+24) TOTAL NUMBER OF SECTORS IN FILE, LSB F4300180 EQU NAME12(FH+25) FILE NAME, CHARACTERS 1 AND 2 F4300181 EQU NAME34(FH+26) FILE NAME, CHARACTERS 3 AND 4 F4300182ÐÐ EQU NAME56(FH+27) FILE NAME, CHARACTERS 5 AND 6 F4300183 EQU NAME78(FH+28) FILE NAME, CHARACTERS 7 AND 8 F4300184 EQU OWNR12(FH+29) OWNER NAME, CHARACTERS 1 AND 2 F4300185 EQU OWNR34(FH+30) OWNER NAME, CHARACTERS 3 AND 4 F4300186 EQU OWNR56(FH+31) OWNER NAME, CHARACTERS 5 AND 6 F4300187 EQU OWNR78(FH+32) OWNER NAME, CHARACTERS 7 AND 8 F4300188 EQU BYTLEN(FH+33) BYTE LENGTH OF RECORD F4300189* F4300190* FOR COMPRESS ONLY F4300191* F4300192 EQU PRSRNM(FH+34) RRN OF LAST PROCESSED RECORD - MSB F4300193 EQU PRSRNL(FH+35) RRN OF LAST PROCESSED RECORD - LSB F4300194 EQU NEWRNM(FH+36) RRN OF THE LATEST 'NEW' RECORD - MSB F4300195 EQU NEWRNL(FH+37) RRN OF THE LATEST 'NEW' RECORD - LSB F4300196 SPC 4 F4300197* WORDS 0 THRU 4 OF THE FCB HEADER AND WORDS F4300198* 6 THRU 10 OF THE FCB ARE REFERRED TO AS THE F4300199* SHARED SUBSET OF THE FCB. THEY INCLUDE THE F4300200* ONLY FCB WORDS THAT CAN BE MODIFIED AFTER FILEF4300201* CREATION. IF TWO OR MORE USERS HAVE THE SAME F4300202* FILE OPEN, THERE HAS TO BE A SINGLE MASTER F4300203* COPY OF THE SUBSET THAT RECEIVES (AND RECORDS)F4300204* ALL OF THE UPDATES. THE CONTROLLED SUBSET F4300205* WILL ALWAYS BE PART OF A MAIN MEMORY RESIDENT F4300206* FCB IF THE FCB IS IN A FM CONTROLLED TABLE. F4300207ÐÐ* IF THE FCB IS IN USER SPACE, THE SUBSET MAY ATF4300208* TIMES RESIDE IN THE SUBSET CONTROL TABLE. F4300209 SPC 2 F4300210* ALTERNATE NAMES FOR SUBSET WORDS F4300211 EQU SAFCBI(FH+1) SUBSET ALTERNATE NAME FOR FCBIND F4300212 EQU SADATM(FH+2) SUBSET ALTERNATE NAME FOR NEDATM F4300213 EQU SADATL(FH+3) SUBSET ALTERNATE NAME FOR NEDATL F4300214 EQU SANXTM(FH+4) SUBSET ALTERNATE NAME FOR NEXTBM F4300215 EQU SANXTL(FH+5) SUBSET ALTERNATE NAME FOR NEXTBL F4300216 EJT F4300217* VOLUME INFORMATION TABLE F4300218* F4300219 EQU VISLUN(2) SYSTEM LOGICAL UNIT NUMBER (BIT 15=1,NOT READYF4300220* ACCESS VISLUN INDIRECTLY F4300221 EQU VINAME(1) VOLUME NAME - ASCII CHARACTERS 1 AND 2 F4300222* VOLUME NAME - ASCII CHARACTERS 3 AND 4 F4300223* VOLUME NAME - ASCII CHARACTERS 5 AND 6 F4300224* VOLUME NAME - ASCII CHARACTERS 7 AND 8 F4300225 EQU VINMBR(5) VOLUME NUMBER - (2 ASCII CHARACTERS) F4300226 EQU VIBMSM(6) BEGINNING OF MANAGEABLE SPACE - MSB F4300227 EQU VIBMSL(7) BEGINNING OF MANAGEABLE SPACE - LSB F4300228 EQU VIASDM(8) AVAILABLE SPACE DIRECTORY ADDRESS - MSB F4300229 EQU VIASDL(9) AVAILABLE SPACE DIRECTORY ADDRESS - LSB F4300230 EQU VIASDS(10) # SECTORS IN AVAILABLE SPACE DIRECTORY F4300231 EQU VILBAM(11) LARGEST BLOCK OF SPACE AVAILABLE - MSB F4300232ÐÐ EQU VILBAL(12) LARGEST BLOCK OF SPACE AVAILABLE - LSB F4300233 EQU VIWPS(13) WORDS/SECTOR FOR VOLUME F4300234 EQU VIFDDM(14) FILE DEFINITION DIRECTORY ADDRESS - MSB F4300235 EQU VIFDDL(15) FILE DEFINITION DIRECTORY ADDRESS - LSB F4300236 EQU VIMAXF(16) MAX. NUMBER OF FILES PERMITTED ON VOLUME F4300237 EQU VICURF(17) CURRENT NUMBER OF FILES EXISTING ON VOLUME F4300238 EQU VINFDB(18) NUMBER OF BLOCKS IN FILE DEFINITION DIRECTORY F4300239 EQU VINXTB(19) NEXT AVAILABLE BLOCK IF FILE DEF. DIRECTORY F4300240 EQU VINOOF(20) NUMBER OF OPEN FILES ON VOLUME F4300241 EJT F4300242* REQUEST PROCESSOR CONTROL TABLE F4300243* F4300244 EQU RP(10) INDEX TO START OF REQUEST PARAMETERS F4300245 EQU MR(RP+5) INDEX TO START OF MONITOR REQUEST PARAM LIST F4300246 EQU SS(MR+10) INDEX TO START OF SCRATCH PORTION OF PAR LIST F4300247* F4300248 EQU RPLOGU(1) LU NUMBER OF MM DEVICE F4300249 EQU RPAREQ(2) ACTIVE REQUEST FLAG (IF 0, NONE FOR TABLE) F4300250 EQU RPWAIT(3) START OF WAITING REQUEST QUEUE (IF 0, NO WAITGF4300251 EQU RPRLEV(4) REQUEST PRIORITY LEVEL - ACTIVE REQUEST F4300252 EQU RPRBF4(5) REQBUF ADDRESS - FIRST FOUR WORDS F4300253 EQU RPLTEA(6) LOCK TABLE ENTRY (ABSOLUTE) ADDRESS F4300254 EQU RPRTNJ(7) RETURN JUMP TO REQUEST PROCESSOR F4300255 EQU RPPADR(8) PROCESSOR ADDRESS F4300256 SPC 1 F4300257ÐÐ* PARAMETER LIST FOR REQUEST PROCESSOR F4300258 EQU RPFCBA(9) FCB ADDRESS FOR FILE F4300259 EQU RPRBMP(RP+0) REQBUF ADDRESS - MAIN PART F4300260 EQU RPPFP1(RP+1) REQUEST PARAMETER ADDRESS - FIRST + 1 F4300261 EQU RPPFP2(RP+2) REQUEST PARAMETER ADDRESS - FIRST + 2 F4300262 EQU RPPFP3(RP+3) REQUEST PARAMETER ADDRESS - FIRST + 3 F4300263 EQU RPPFP4(RP+4) REQUEST PARAMETER ADDRESS - FIRST + 4 F4300264 SPC 1 F4300265* MAIN MONITOR REQUEST F4300266 EQU RPMREQ(MR+0) MONITOR REQUEST CODE WORD F4300267 EQU RPMRP1(MR+1) COMPLETION ADDRESS F4300268 EQU RPMRP2(MR+2) THREAD WORD F4300269 EQU RPMRP3(MR+3) LOGICAL UNIT FOR I/O F4300270 EQU RPMRP4(MR+4) NUMBER OF WORDS F4300271 EQU RPMRP5(MR+5) START CORE ADDRESS F4300272 EQU RPMRP6(MR+6) MASS MEMORY ADDRESS, MSB F4300273 EQU RPMRP7(MR+7) MASS MEMORY ADDRESS, LSB F4300274 EQU RPRCPT(MR+8) CONTROL POINT (FOR I/O REQUESTS) F4300275 EQU RPRETN(MR+9) SAVED RETURN ADDRESS F4300276* ALTERNATE COMMON NAMES F4300277 EQU REQBUF(RP+0) USERS FIRST CALL PARAMETER ADDRESS F4300278 EQU RECBUF(RP+1) RECORD BUFFER PARAMETER - FOR PUTS F4300279 EQU VOLNAM(RP+1) VOLNAM NAME BUFFER ADDRESS F4300280 EQU INDEX(RP+2) INDEX PARAMETER ADDRESS F4300281 EQU FCBBFR(RP+3) FCB BUFFER ADDRESS F4300282ÐÐ EQU ISTAT(RP+4) USERS COMPLETION STATUS PARAMETER ADDRESS F4300283 EJT F4300284* SCRATCH FOR UPDFCB F4300285* F4300286* PARAMETER LIST FOR MM I/O ROUTINE F4300287 EQU MSBBSA(SS+0) MSB OF BASE SECTOR ADDRESS - FCBT F4300288 EQU LSBBSA(SS+1) LSB OF BASE SECTOR ADDRESS - FCBT F4300289 EQU MSBRRN(SS+2) MSB OF RELATIVE RECORD NUMBER F4300290 EQU LSBRRN(SS+3) MSB OF RELATIVE RECORD NUMBER F4300291 EQU RCDLEN(SS+4) RECORD LENGTH F4300292 EQU NUMWDS(SS+5) NUMBER OF WORDS TO WRITE F4300293 EQU OFFSET(SS+6) WORD OFFSET FROM START OF RECORD F4300294 EQU RECBFR(SS+7) ADDRESS OF BUFFER FOR I/O F4300295 EQU IOTYPE(SS+8) I/O TYPE: NON-ZERO IF FILE I/O, ELSE ZERO. F4300296 EJT F4300297UPDFCB 000 000 ENTRY POINT F4300298* F4300299* NO NEED TO PROCESS PARAMETER LIST FOR CALL F4300300* F4300301 ENA 96-NEWRNL+FH SET NUMBER OF WORDS FOR WRITE F4300302 STA- NUMWDS,I F4300303 ENA NEWRNL-FH SET OFFSET FOR FCB WRITE F4300304 STA- OFFSET,I F4300305 CLR A CLEAR IOTYPE AND MSB OF RRN F4300306 STA- IOTYPE,I F4300307ÐÐ STA- MSBRRN,I F4300308 LDA- FCBBFR,I SET BUFFER ADDRESS FOR I/O F4300309 INA NEWRNL-FH F4300310 STA- RECBFR,I F4300311* F4300312 LDQ- VOLNAM,I CHECK IF VOLUME LABLE IS SPECIFIED F4300313 LDA- (ZERO),Q F4300314 SAZ GET20 SKIP IF NO - FILE MUST BE OPEN F4300315 JMP* GET50 GO CHECK FOR LOADED AND READY VOLUME F4300316* F4300317GET20 LDQ- REQBUF,I GET ADDRESS OF UCT ENTRY FROM REQBUF F4300318 LDA- UCTADR,Q F4300319 STA* TEMP1 SAVE LOCALLY F4300320 LDA* (TEMP1) PICKUP FIRST WORD AND CHECK IF IT AGREES WITH F4300321 EOR- USERID,Q REQBUF INFO F4300322 SAN GET30 SKIP IF NO F4300323 RAO* TEMP1 F4300324 LDA* (TEMP1) PICKUP 2ND WORD OF UCT ENTRY - FILE ID F4300325 STA* IDENT SAVE LOCALLY F4300326 AND- ONEMSK+10 EXTRACT INDEX TO FCBT F4300327 INA 1 BUMP BY 1 AND STORE AS RECORD NUMBER F4300328 STA- LSBRRN,I F4300329 LDA* IDENT F4300330 ARS 11 F4300331 AND- ONEMSK+4 EXTRACT FM LU NO. FROM FILE ID F4300332ÐÐ STA- RPLOGU,I STORE IN 1ST WORD OF RPC TABLE F4300333 RAO* TEMP1 F4300334 LDA* (TEMP1) PICKUP 3RD UCT WORD AND CHECK IF IT AGREES F4300335 EOR- FCBADR,Q WITH REQBUF INFO F4300336 SAZ GET40 SKIP IF YES F4300337* F4300338GET30 LDA =N$A000 SET USER'S ISTAT TO $A000 (REQBUF NOT PROPERLYF4300339* INITIALIZED) F4300340 JMP* GET160 GO STORE ISTAT AND RETURN TO EXEC F4300341* F4300342GET40 JMP* GET140 GO SET BASE MM ADDRESS FOR WRITE F4300343 EJT F4300344* VOLUME NAME WAS SPECIFIED. CHECK IF VOLUME F4300345GET50 CLR A LOADED AND READY. F4300346 STA* TEMP1 SET COUNTER/INDEX TO ZERO F4300347* F4300348GET60 RAO* TEMP1 BUMP INDEX AND CHECK IF OUT OF RANGE F4300349 LDA* (ADMLUT) F4300350 SUB* TEMP1 F4300351 SAP GET70 SKIP IF NOT TOO BIG F4300352 LDA =N$A000 SET USER'S ISTAT TO $A000 (VOLUME SPECIFIED F4300353* NOT LOADED AND READY) F4300354 JMP* GET160 GO STORE ISTAT AND RETURN TO EXEC F4300355* F4300356GET70 LDQ* TEMP1 GET ADDRESS OF NEXT VIT TO BE CHECKED F4300357ÐÐ STQ- RPLOGU,I STORE LU NUMBER OF MM DEVICE IN RPC TABLE F4300358 LDA* (ADMLUT),Q F4300359 STA* TEMP2 SAVE IT F4300360* F4300361 LDA* (TEMP2) CHECK IF VOLUME IS LOADED AND READY F4300362 SAP GET80 SKIP IF YES F4300363 JMP* GET60 GO CHECK FOR MORE VOLUMES F4300364* F4300365GET80 LDQ- VOLNAM,I F4300366 LDA- (ZERO),Q F4300367 RAO* TEMP2 BUMP VIT ADDRESS TO 1ST WORD OF NAME F4300368 EOR* (TEMP2) CHECK IF 1ST WORD OF NAMES AGREE F4300369 SAN GET90 SKIP IF NO F4300370 RAO* TEMP2 BUMP VIT ADDRESS TO 2ND WORD OF NAME F4300371 LDA- 1,Q F4300372 EOR* (TEMP2) CHECK IF 2ND WORD OF NAMES AGREE F4300373 SAN GET90 SKIP IF NO F4300374 RAO* TEMP2 BUMP VIT ADDRESS TO 3RD WROD OF NAME F4300375 LDA- 2,Q F4300376 EOR* (TEMP2) CHECK IF 3RD WORD OF NAMES AGREE F4300377 SAN GET90 SKIP IF NO F4300378 RAO* TEMP2 BUMP VIT ADDRESS TO 4TH WORD OF NAME F4300379 LDA- 3,Q F4300380 EOR* (TEMP2) CHECK IF 4TH WORD OF NAMES AGREE F4300381 SAZ GET95 SKIP IF YES F4300382ÐÐGET90 JMP* GET60 GO CHECK FOR MORE VOLUMES F4300383GET95 JMP* GET100 F4300384 EJT F4300385* PARAM LIST FOR DWADD F4300386FDDMSB NUM 0 MSB OF FDD ADDRESS F4300387FDDLSB NUM 0 LSB OF FDD ADDRESS F4300388 NUM 0 F4300389NUMFDB NUM 0 NUMBER OF FDBS F4300390RESMSB NUM 0 MSB OF RESULT - START ADDRESS OF FCBT F4300391RESLSB NUM 0 LSB OF RESULT - START ADDRESS OF FCBT F4300392STATUS NUM 0 STATUS OF ADD OPERATION F4300393 SPC 2 F4300394TEMP1 NUM 0 TEMPORARY STORAGE F4300395TEMP2 NUM 0 TEMPORARY STORAGE F4300396IDENT NUM 0 FILE ID F4300397ENDAP1 NUM 0 LWA+1 OF UCT F4300398ADMLUT ADC MMLUTB MASS MEMORY LOGICAL UNIT TABLE ADDRESS F4300399 EJT F4300400GET100 LDQ* TEMP2 GET ADDRESS +4 OF VIT F4300401 INQ -4 DECREMENT BACK TO START OF VIT AND SAVE F4300402 STQ* TEMP2 F4300403* F4300404 LDQ- INDEX,I CHECK INDEX SPECIFIED BY USER F4300405 LDA- (ZERO),Q F4300406 SAZ GET110 ILLEGAL IF 0 F4300407ÐÐ SAP GET120 ASSURE IT IS POSITIVE AND NON-ZERO F4300408GET110 LDA- ZROMSK+13 SET USER'S ISTAT TO $C000 - ILLEGAL REQUEST F4300409 JMP* GET160 GO STORE ISTAT AND RETURN TO EXEC F4300410* F4300411GET120 STA- LSBRRN,I STORE IT AS RRN F4300412 TCA A COMPLEMENT IT THEN CHECK IF IT IS OUT OF F4300413 LDQ* TEMP2 RANGE FOR VOLUME F4300414 ADD- VIMAXF,Q F4300415 SAP GET140 SKIP IF IN RANGE F4300416 LDA =N$9000 SET USER'S ISTAT TO $9000 - INDEX OUT OF RANGEF4300417 JMP* GET160 GO STORE ISTAT AND RETURN TO EXEC F4300418* F4300419GET140 LDQ- RPLOGU,I GET VIT ADDRESS FOR FILE'S VOLUME F4300420 LDQ* (ADMLUT),Q F4300421 ENA 96 SET RECORD LENGTH FOR I/O CALL. F4300422 STA- RCDLEN,I F4300423 LDA- VIFDDM,Q STORE FDD ADDRESS FOR DOUBLE WORD ADD F4300424 STA* FDDMSB F4300425 LDA- VIFDDL,Q F4300426 STA* FDDLSB F4300427 LDA- VINFDB,Q F4300428 STA* NUMFDB STORE NO. OF FDBS F4300429 LDQ =XFDDMSB SET Q TO ADDRESS OF PARAM LIST FOR DWADD F4300430 RTJ DWADD COMPUTE ADDRESS OF FCBT F4300431 LDA* STATUS F4300432ÐÐ SAZ GET150 ASSURE STATUS IS GOOD F4300433 RTJ SYFAIL CRASH SYSTEM - VIT MESSED UP F4300434 EJT F4300435GET150 LDA* RESMSB STORE FCBT ADDRESS IN MM I/O PARAM LIST F4300436 STA- MSBBSA,I F4300437 LDA* RESLSB F4300438 STA- LSBBSA,I F4300439 LDQ- I F4300440 INQ MSBBSA SET Q TO ABS ADDRESS F4300441 RTJ MMWRIT WRITE OUT THE NON-FM PORTION OF THE FCB F4300442 CLR A CLEAR A FOR USE AS ISTAT F4300443 SQP GET160 SKIP IF NO ERROR F4300444 LDA =N$8020 SET USER'S ISTAT TO REFLECT I/O ERROR + REJECTF4300445 INQ 0 F4300446 SQN GET160 SKIP IF NOT A COMPUTATION ERROR F4300447 EOR- ONEBIT+14 SET ILLEGAL REQUEST BIT F4300448GET160 LDQ PCTABL RESET I-REG TO RPC TABLE ADDRESS F4300449 STQ- I F4300450 LDQ- ISTAT,I F4300451 STA- (ZERO),Q STORE ISTAT FOR USER F4300452 RTJ FMSCOM RETURN TO EXEC TO COMPLETE THE REQUEST F4300453* (NO RETURN TO GETFCB) F4300454 SPC 2 F4300455 END F4300456 NAM CKUFCB F44 A ITOS CCS 3.0 SL-149F4400001ÐÐ* F4400002* CREDIT COLLECTION SYSTEM VERSION 3.0 F4400003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F4400004* COPYRIGHT CONTROL DATA CORPORATION 1979 F4400005* F4400006* FORTRAN INTERFACE TO UPDATE FCB ON MASS MEMORY F4400007**** F4400008* AS RECORDS ARE ADDED TO A FILE, DATA IN THE FCB ARE F4400009* CHANGED TO REFLECT THE ADDITION. BUT IT IS INEFFICIENT F4400010* TO UPDATE THE FCB ON MASS MEMORY EVERY TIME A NEW F4400011* RECORD IS ADDED TO THE FILE. F4400012* F4400013* A GLOBAL CONSTANT, FMNRCD, CONTAINS THE NUMBER OF F4400014* NEW RECORDS TO ADD BEFORE AN UPDATE ON THE FCB IS F4400015* DONE. IN THE FCB, AN ENTRY KEEPS TRACK OF HOW MANY F4400016* NEW RECORDS HAVE BEEN ADDED SINCE THE LAST FCB UP- F4400017* DATE ON MASS MEMORY F4400018* F4400019* CALLING SEQUNECE : F4400020* CALL CKUFCB F4400021* F4400022* F4400023* PROCESS: F4400024* SEE IF IT IS TIME TO DO UPDATE OF FCB ON MASS F4400025* MEMORY? F4400026ÐÐ* F4400027* YES, IF NO. OF NEW RECORDS ADDED SINCE THE F4400028* LAST UPDATE IS MORE THAN FMNRCD. THEN SET F4400029* REG I TO THE PCT ADDR. F4400030* GO TO THE FM SUBROUTINE, FMUFCB, TO DO FCB UPDATE F4400031* ON MASS MEMORY. CHECK FOR I/O ERROR UPON RETURN. F4400032* F4400033* RESTORE REG Q AND I. F4400034* LEAVE F4400035* F4400036* F4400037* EXIT: F4400038* STATUS IS SET IF I/O DETECTED F4400039*E F4400040* ENTRY POINT F4400041* F4400042 ENT CKUFCB F4400043* F4400044* EXTERNALS F4400045* F4400046 EXT FMUFCB FM SUBROUTINE TO UPDATE FCB ON MASS MEMORY F4400047 EXT FMNRCD NO. OF NEW RECORDS ADDED BEFORE FCB NEEDS F4400048* TO BE UPDATED F4400049* COMMON F4400050* F4400051ÐÐ COM PCTADR F4400052 COM DUN(573) F4400053 COM REQSTA F4400054 COM DUMM(132) F4400055**** F4400056 EJT 0 F4400057* COMMUNICATION REGION EQUIVALENCES F4400058 EQU ZERO(2) SYSTEM ZERO F4400059 SPC 2 F4400060* UCT ENTRY EQUIVALENCES F4400061 EQU UIDENT(ZERO) USER IDENTIFICATION F4400062 EQU FIDENT(1) PSEUDO FILE IDENTIFIER F4400063 EQU FCBCAD(2) FCB CORE ADDRESS F4400064 EQU FSLADR(3) FILE SPACE LIMITS TABLE ENTRY ADDRESS F4400065 EQU FCBSAD(4) FCB SUBSET ADDRESS F4400066 EQU USRCPT(5) USERS CONTROL POINT F4400067 EJT F4400068* REQUEST BUFFER INDEXES - FIRST 4 WORDS F4400069 EQU RBATHR(0) REQUEST BUFFER ADDRESS THREAD F4400070 EQU BUFAMP(1) BUFFER ADDRESS MAIN PART F4400071 EQU CNTLPT(2) CONTROL POINT (OR SPARE) F4400072 EQU RQINFO(3) REQUEST INFORMATION (MULTI-FIELD) F4400073* BITS USE F4400074* 15-12 SPARE F4400075* 11-04 REQUEST INDEX F4400076ÐÐ* 03-00 LEVEL OF REQUESTOR F4400077* F4400078* REQUEST BUFFER INDEXES - MAIN PART F4400079 EQU QREG(0) Q REGISTER F4400080 EQU IREG(1) I REGISTER F4400081 EQU PARLST(2) ADDRESS OF PARAMETER LIST F4400082 EQU RTNADR(2) RETURN ADDRESS TO USER (UPON RETURN FROM EXEC)F4400083 EQU UCTADR(3) UCT ENTRY ABSOLUTE ADDRESS F4400084 EQU USERID(4) USER IDENTIFIER F4400085 EQU FCBADR(5) FCB ADDRESS (MAY BE SET BY CALLER OR INTCPTR.)F4400086 EQU RADINT(6) RETURN ADDRESS TO INTERCEPTOR F4400087 EQU RPIDX(7) REQUEST PROCESSOR INDEX F4400088* BITS 14-00 REQUEST PROCESSOR INDEX F4400089* BIT 15 TYPE OF PROCESSOR F4400090* =0, SERIAL PROCESSOR F4400091* =1, REENTRANT PROCESSOR F4400092 EQU LOKREC(8) NUMBER OF RECORDS TO BE READ/WRITTEN PER I/O F4400093* CALL AND LOCK RECORDS ON RETRIEVE FLAG F4400094* BITS 14-00 NUMBER OF RECORDS PER CALL F4400095* BIT 15 =0, DO NOT LOCK ON RETRIEVE F4400096* =1, LOCK RECORDS ON RETRIEVE F4400097 EQU USEFLG(9) TYPE OF FILE USE FLAG F4400098* -1, OPEN FOR COMPRESSION F4400099* -2, OPEN FOR SPECIAL PROCESSING F4400100* 0, OPEN FOR ACESS VIA REL REC NO F4400101ÐÐ* 1, OPEN FOR RETRIEVAL VIA KEY 1 F4400102* 2, OPEN FOR RETRIEVAL VIA KEY 2 F4400103* 3, OPEN FOR RETRIEVAL VIA KEY 3 F4400104* 4, OPEN FOR RETRIEVAL VIA KEY 4 F4400105 EQU NUMREC(10) NUMBER OF RECORDS ACTUALLY STORED/RETRIEVED F4400106 EQU RRNMSB(11) REL REC NUMBER OF STORED/RETRIEVED REC, MSB F4400107 EQU RRNLSB(12) REL REC NUMBER OF STORED/RETRIEVED REC, LSB F4400108 EQU RMPLEN(20) LENGTH OF REQBUF MAIN PART F4400109 EJT F4400110* FILE CONTROL BLOCK EQUIVALENCES F4400111 EQU FH(4) LENGTH -1 OF FCB HEADER F4400112 EQU FILEID(ZERO) FILE IDENTIFIER F4400113* ACCESS FILEID INDIRECTLY F4400114* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBERF4400115* BITS 10-00 INDEX OF FCB IN FCB TABLE F4400116 EQU FCBFLG(1) FCB FLAGS F4400117* BITS 15-8, SPARE F4400118* BITS 7-00, NUMBER OF USERS USING FILE F4400119 EQU FILOCK(2) FILE LOCK FLAG (IF NON-0, CONTAINS USER ID) F4400120 EQU NUMSET(3) NUMBER OF SETS OF LOCKED RECORDS IN FILE F4400121 EQU NUMNEW(4) NUMBER OF NEW RECORDS SINCE FCB UPDATED ON MM F4400122 SPC 1 F4400123 EQU RECLEN(FH+1) RECORD LENGTH IN WORDS F4400124 EQU TDATRM(FH+2) TOTAL NUMBER OF DATA RECORDS, MSB F4400125 EQU TDATRL(FH+3) TOTAL NUMBER OF DATA RECORDS, LSB F4400126ÐÐ EQU DATBAM(FH+4) DATA RECORDS BEGINNING SECTOR ADDRESS, MSB F4400127 EQU DATBAL(FH+5) DATA RECORDS BEGINNING SECTOR ADDRESS,LMSB F4400128 EQU FCBIND(FH+6) FCB INDICATORS F4400129* BIT 15 , SECTOR ALLIGNED RECORDS IF =1 F4400130* BIT 14 , STORAGE MODE FOR INDEXED FILE F4400131* =0, RECORDS STORED RANDOMLY WITHF4400132* RESPECT TO PRIMARY KEY F4400133* =1, RECORDS STORED IN ORDER WIT F4400134* RESPECT TO PRIMARY KEY F4400135* BIT 13 , =1, FILE IS CURRENTLY OPEN F4400136* =0, FILE IS CURRENTLY CLOSED F4400137* BIT 12 , =1, FILE IS BEING COMPRESSED F4400138* =0, FILE IS NOT BEING COMPRESSEDF4400139* BIT 11 , =1, FILE IS OPEN FOR SPECIAL F4400140* PROCESSING F4400141* =0, FILE IS NOT OPEN FOR SPECIALF4400142* PROCESSING F4400143* BIT 8 , =1, RECORDS CONTAIN BINARY DATA F4400144* =0, RECORDS DO NOT CONTAIN F4400145* BINARY DATA F4400146* BIT 0 , FILE TYPE F4400147* =0, SEQUENTIAL FILE F4400148* =1, INDEXED FILE F4400149 EQU NEDATM(FH+7) NUMBER OF EXISTING DATA RECORDS, MSB F4400150 EQU NEDATL(FH+8) NUMBER OF EXISTING DATA RECORDS, LSB F4400151ÐÐ EQU SEQLTH(NEDATL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F4400152* OF FCB FOR A SEQUENTIAL FILE F4400153 SPC 1 F4400154 EQU NEXTBM(FH+9) NEXT FREE KEY INDEX BLOCK, MSB F4400155 EQU NEXTBL(FH+10) NEXT FREE KEY INDEX BLOCK, LSB F4400156 EQU TNKEYM(FH+11) TOTAL NUMBER OF KEY INDEX BLOCKS, MSB F4400157 EQU TNKEYL(FH+12) TOTAL NUMBER OF KEY INDEX BLOCKS, LSB F4400158 EQU KEYBAM(FH+13) KEY INDEX BEGINNING SECTOR ADDRESS, MSB F4400159 EQU KEYBAL(FH+14) KEY INDEX BEGINNING SECTOR ADDRESS, LSB F4400160 EQU LENKY1(FH+15) LENGTH OF KEY NO. 1 F4400161 EQU POSKY1(FH+16) BYTE POSITION OF KEY NO. 1 F4400162 EQU LENKY2(FH+17) LENGTH OF KEY NO. 2 F4400163 EQU POSKY2(FH+18) BYTE POSITION OF KEY NO. 2 F4400164 EQU LENKY3(FH+19) LENGTH OF KEY NO. 3 F4400165 EQU POSKY3(FH+20) BYTE POSITION OF KEY NO. 3 F4400166 EQU LENKY4(FH+21) LENGTH OF KEY NO. 4 F4400167 EQU POSKY4(FH+22) BYTE POSITION OF KEY NO. 4 F4400168 EQU INDLEN(POSKY4-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F4400169* OF FCB FOR AN INDEXED FILE F4400170 EJT F4400171* THE FOLLOWING PORTION OF THE FCB EXISTS ONLY F4400172* ON MASS MEMORY. THESE 10 WORDS ARE NOT LOADEDF4400173* INTO EITHER OF THE FILE MANAGER CONTROLLED FCBF4400174* TABLES. F4400175 EQU TSFILM(FH+23) TOTAL NUMBER OF SECTORS IN FILE, MSB F4400176ÐÐ EQU TSFILL(FH+24) TOTAL NUMBER OF SECTORS IN FILE, LSB F4400177 EQU NAME12(FH+25) FILE NAME, CHARACTERS 1 AND 2 F4400178 EQU NAME34(FH+26) FILE NAME, CHARACTERS 3 AND 4 F4400179 EQU NAME56(FH+27) FILE NAME, CHARACTERS 5 AND 6 F4400180 EQU NAME78(FH+28) FILE NAME, CHARACTERS 7 AND 8 F4400181 EQU OWNR12(FH+29) OWNER NAME, CHARACTERS 1 AND 2 F4400182 EQU OWNR34(FH+30) OWNER NAME, CHARACTERS 3 AND 4 F4400183 EQU OWNR56(FH+31) OWNER NAME, CHARACTERS 5 AND 6 F4400184 EQU OWNR78(FH+32) OWNER NAME, CHARACTERS 7 AND 8 F4400185 EQU BYTLEN(FH+33) BYTE LENGTH OF RECORD F4400186* F4400187* FOR COMPRESS ONLY F4400188* F4400189 EQU PRSRNM(FH+34) RRN OF LAST PROCESSED RECORD - MSB F4400190 EQU PRSRNL(FH+35) RRN OF LAST PROCESSED RECORD - LSB F4400191 EQU NEWRNM(FH+36) RRN OF THE LATEST 'NEW' RECORD - MSB F4400192 EQU NEWRNL(FH+37) RRN OF THE LATEST 'NEW' RECORD - LSB F4400193 SPC 4 F4400194* WORDS 0 THRU 4 OF THE FCB HEADER AND WORDS F4400195* 6 THRU 10 OF THE FCB ARE REFERRED TO AS THE F4400196* SHARED SUBSET OF THE FCB. THEY INCLUDE THE F4400197* ONLY FCB WORDS THAT CAN BE MODIFIED AFTER FILEF4400198* CREATION. IF TWO OR MORE USERS HAVE THE SAME F4400199* FILE OPEN, THERE HAS TO BE A SINGLE MASTER F4400200* COPY OF THE SUBSET THAT RECEIVES (AND RECORDS)F4400201ÐÐ* ALL OF THE UPDATES. THE CONTROLLED SUBSET F4400202* WILL ALWAYS BE PART OF A MAIN MEMORY RESIDENT F4400203* FCB IF THE FCB IS IN A FM CONTROLLED TABLE. F4400204* IF THE FCB IS IN USER SPACE, THE SUBSET MAY ATF4400205* TIMES RESIDE IN THE SUBSET CONTROL TABLE. F4400206 SPC 2 F4400207* ALTERNATE NAMES FOR SUBSET WORDS F4400208 EQU SAFCBI(FH+1) SUBSET ALTERNATE NAME FOR FCBIND F4400209 EQU SADATM(FH+2) SUBSET ALTERNATE NAME FOR NEDATM F4400210 EQU SADATL(FH+3) SUBSET ALTERNATE NAME FOR NEDATL F4400211 EQU SANXTM(FH+4) SUBSET ALTERNATE NAME FOR NEXTBM F4400212 EQU SANXTL(FH+5) SUBSET ALTERNATE NAME FOR NEXTBL F4400213 EJT F4400214* REQUEST PROCESSOR CONTROL TABLE F4400215* F4400216 EQU RP(10) INDEX TO START OF REQUEST PARAMETERS F4400217 EQU MR(RP+5) INDEX TO START OF MONITOR REQUEST PARAM LIST F4400218 EQU SS(MR+10) INDEX TO START OF SCRATCH PORTION OF PAR LIST F4400219* F4400220 EQU RPLOGU(1) LU NUMBER OF MM DEVICE F4400221 EQU RPAREQ(2) ACTIVE REQUEST FLAG (IF 0, NONE FOR TABLE) F4400222 EQU RPWAIT(3) START OF WAITING REQUEST QUEUE (IF 0, NO WAITGF4400223 EQU RPRLEV(4) REQUEST PRIORITY LEVEL - ACTIVE REQUEST F4400224 EQU RPRBF4(5) REQBUF ADDRESS - FIRST FOUR WORDS F4400225 EQU RPLTEA(6) LOCK TABLE ENTRY (ABSOLUTE) ADDRESS F4400226ÐÐ EQU RPRTNJ(7) RETURN JUMP TO REQUEST PROCESSOR F4400227 EQU RPPADR(8) PROCESSOR ADDRESS F4400228 SPC 1 F4400229* PARAMETER LIST FOR REQUEST PROCESSOR F4400230 EQU RPFCBA(9) FCB ADDRESS FOR FILE F4400231 EQU RPRBMP(RP+0) REQBUF ADDRESS - MAIN PART F4400232 EQU RPPFP1(RP+1) REQUEST PARAMETER ADDRESS - FIRST + 1 F4400233 EQU RPPFP2(RP+2) REQUEST PARAMETER ADDRESS - FIRST + 2 F4400234 EQU RPPFP3(RP+3) REQUEST PARAMETER ADDRESS - FIRST + 3 F4400235 EQU RPPFP4(RP+4) REQUEST PARAMETER ADDRESS - FIRST + 4 F4400236 SPC 1 F4400237* MAIN MONITOR REQUEST F4400238 EQU RPMREQ(MR+0) MONITOR REQUEST CODE WORD F4400239 EQU RPMRP1(MR+1) COMPLETION ADDRESS F4400240 EQU RPMRP2(MR+2) THREAD WORD F4400241 EQU RPMRP3(MR+3) LOGICAL UNIT FOR I/O F4400242 EQU RPMRP4(MR+4) NUMBER OF WORDS F4400243 EQU RPMRP5(MR+5) START CORE ADDRESS F4400244 EQU RPMRP6(MR+6) MASS MEMORY ADDRESS, MSB F4400245 EQU RPMRP7(MR+7) MASS MEMORY ADDRESS, LSB F4400246 EQU RPRCPT(MR+8) CONTROL POINT (FOR I/O REQUESTS) F4400247 EQU RPRETN(MR+9) SAVED RETURN ADDRESS F4400248* ALTERNATE COMMON NAMES F4400249 EQU REQBUF(RP+0) USERS FIRST CALL PARAMETER ADDRESS F4400250 EQU RECBUF(RP+1) RECORD BUFFER PARAMETER - FOR PUTS F4400251ÐÐ EQU ISTAT(RP+4) USERS COMPLETION STATUS PARAMETER ADDRESS F4400252 EQU NORECS(RP+2) NUMBER OF RECORDS PARAMETER - FOR PUTS F4400253 EJT F4400254 EJT F4400255 SPC 5 F4400256CKUFCB NOP 0 ENTRY POINT F4400257 STQ* QSAVE SAVE REGS F4400258 LDQ- I F4400259 STQ* ISAVE F4400260 LDQ PCTADR F4400261 STQ- I F4400262 LDQ- REQBUF,I GET SUBSET ADDR F4400263 LDQ- UCTADR,Q F4400264 LDQ- FCBSAD,Q F4400265 LDA- NUMNEW,Q NO. OF NEW RECORDS SINCE LAST UPDATE F4400266 SUB =XFMNRCD F4400267 SAM CKU20 F4400268 RTJ FMUFCB DO UPDATE F4400269 SQP CKU10 F4400270 LDA =N$8020 MM IO ERROR F4400271 STA REQSTA F4400272CKU10 EQU CKU10(*) F4400273CKU20 EQU CKU20(*) F4400274 LDQ* ISAVE RESTORE REGS F4400275 STQ- I F4400276ÐÐ LDQ* QSAVE F4400277 JMP* (CKUFCB) F4400278QSAVE NUM 0 F4400279ISAVE NUM 0 F4400280 END F4400281 NAM CMPSTG F45 A ITOS CCS 3.0 SL-149F4500001* COMPARE TWO STRINGS F4500002* CREDIT COLLECTION SYSTEM VERSION 3.0 F4500003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F4500004* COPYRIGHT CONTROL DATA CORPORATION 1979 F4500005* F4500006* F4500007**** F4500008* THIS SUBROUTINE COMPARES TWO STRINGS AS ABSOLUTE 16 BIT F4500009* NUMBERS. THAT IS, $8000 IS BIGGER THAN $7FFF. F4500010* THE COMPARISON STARTS FROM LEFT TO RIGHT. F4500011* F4500012* CALLING SEQUENCE F4500013* FORTRAN I = CMPSTG (STG1, STG2, LNG) F4500014* WHERE STG1 IS FIRST STRING F4500015* STG2 IS SECOND STRING F4500016* LNG IS LENGTH OF STRINGS IN WORDS F4500017* F4500018* INPUT PARAMETERS F4500019* STG1 - FIRST STRING OF CHARACTERS F4500020ÐÐ* STG2 - SECOND STRING OF CHARACTERS F4500021* LNG - LENGTH OF THE STRINGS IN WORDS F4500022* F4500023* F4500024* PROCESS F4500025* COMPARE ONE WORD OF THE STRING AT A TIME. F4500026* F4500027* IF ALL BITS ARE EQUAL, MOVE ON TO THE NEXT WORD. F4500028* IF THE WORDS ARE DIFFERENT AND THE SIGNS ARE THE F4500029* SAME, THEN STG1 IS BIGGER THAN STG2 IF THEIR F4500030* DIFFERENCE IS A POSITIVE NUMBER (BIT 15 = 0). F4500031* F4500032* STG1 IS SMALLER THAN STG2 IF THEIR DIFFERENCE F4500033* IS A NEGATIVE NUMBER (BIT 15 =1) F4500034* F4500035* IF THE WORDS HAVE DIFFERENT SIGN, THEN THE F4500036* ONE WITH BIT 15 = 1 IS BIGGER. F4500037*E F4500038* F4500039* OUTPUT F4500040* CONTENT OF REG A = +VE IF STG1 IS BIGGER THAN STG2 F4500041* +0 IF STG1 IS EQUAL TO STG2 F4500042* -VE IF STG1 IS SMALLER THAN STG2 F4500043* F4500044* ENTRY POINT F4500045ÐÐ* F4500046 SPC 3 F4500047 ENT CMPSTG F4500048* F4500049* EXTERNALS F4500050* F4500051 EXT Q8PREP PREPARE TO PICK UP PARAM F4500052 EXT Q8PKUP PICK UP ABSOLUTIZED PARAM F4500053**** F4500054* F4500055* EQUIVALENCE F4500056* F4500057 EQU ONEBIT($23) ONE BIT TABLE F4500058 EJT 0 F4500059CMPSTG NOP 0 F4500060 STQ* QSAVE F4500061 RTJ Q8PREP F4500062 ADC (CMPSTG-*) F4500063CMP5 RTJ Q8PKUP F4500064 STA* STG1 F4500065 RTJ* (CMP5+1) F4500066 STA* STG2 F4500067 RTJ* (CMP5+1) F4500068 STA* LNG F4500069 LDA* (LNG) F4500070ÐÐ SAN CMP07 F4500071 JMP* CMP90 LENGHT OF STGS ARE ZERO, LEAVE WITH RA=0 F4500072CMP07 EQU CMP07(*) F4500073 SPC 5 F4500074 CLR Q F4500075CMP10 LDA* (STG1),Q SEE IF THE TWO WORDS ARE IDENTICAL(BIT BY BIT)F4500076 EOR* (STG2),Q F4500077 SAZ CMP20 F4500078 JMP* CMP30 F4500079CMP20 EQU CMP20(*) YES, GO TO NEXT WORD F4500080 INQ 1 F4500081 TCQ Q F4500082 ADQ* (LNG) SEE IF REACH END OF STRING F4500083 SQZ CMP90 YES, ALL DONE, STRINGS ARE IDENTICAL F4500084 TCQ Q F4500085 ADQ* (LNG) Q IS POINTING TO WORD IN STRING F4500086 JMP* CMP10 F4500087 SPC 3 F4500088CMP30 EQU CMP30(*) STRINGS ARE DIFFERENT F4500089 SAM CMP40 F4500090 LDA* (STG1),Q THE SIGNS ARE THE SAME F4500091 SUB* (STG2),Q THE STRAIGHT DIFFERENCE IN SUBRACTION IS F4500092 JMP* CMP90 THE ANSWER F4500093 SPC 1 F4500094CMP40 LDA* (STG2),Q THE SIGNS ARE DIFFERENT F4500095ÐÐ AND- ONEBIT+15 F4500096 INA 1 THE ONE WITH A POSITIVE VALUE IS SMALLER F4500097 SPC 3 F4500098CMP90 LDQ* QSAVE DONE F4500099 JMP* (CMPSTG) F4500100QSAVE NUM 0 F4500101STG1 NUM 0 ADDR OF FIRST STRING F4500102STG2 NUM 0 ADDR OF SECOND STRING F4500103LNG NUM 0 ADDR OF LENGTH IN WORDS F4500104 END F4500105 NAM CPUTKL F46 A ITOS CCS 3.0 SL-149F4600001* COMPUTE LENGTH OF A KEY INFORMATION BLOCK F4600002* CREDIT COLLECTION SYSTEM VERSION 3.0 F4600003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F4600004* COPYRIGHT CONTROL DATA CORPORATION 1979 F4600005* F4600006* F4600007**** F4600008* THE NUMBER OF WORDS IN ONE SECTOR OF THE MASS MEMORY F4600009* IS IN THE VIT FOR THE UNIT. THE NUMBER OF SECTORS PER F4600010* IS A FUNCTION OF SECTOR SIZE. IF SECTOR LENGTH F4600011* IS 96, KIB LENGTH IS 3 SECTORS. IF SECTOR F4600012* LENGTH IS OTHER THAN 96 WORDS,KIB LENGTH, IN SECTORS, F4600013* IS EQUAL TO THE INTEGRAL NUMBEROF SECTORS OF DATA THAT WILL FIT F4600014* INTO THE 572 WORD I/O BUFFER USED BY THE INDEX RELATED SOFTWARE. F4600015ÐÐ* F4600016* EACH INDEXED FILE PROCESSOR COMPUTES THE LENGTH FOR F4600017* A KEY INFO BLOCK IN THE INITIALIZATION SECTION. CPUTKL F4600018* STORES THE VALUE IN THE COMMON AREA SO IT CAN BE USED F4600019* THROUGH -OUT THE PROCESSOR. F4600020* F4600021* CALLING SEQUENCE F4600022* CALL CPUTKL F4600023* F4600024* INPUT : F4600025* FCB ADDR IN COMMON (FCBAD) F4600026* F4600027* PROCESS: F4600028* GET WPS FROM VIT F4600029* MULTIPLY BY NUMBER OF SECTORS PER KEY INFO F4600030* DETERMINE KIB SIZE IN SECTORS. F4600031* BLOCK. F4600032* SAVE LENGTH OF KIB IN COMMON. F4600033* SAVE WORDS/SECTOR IN COMMON. F4600034* F4600035* OUTPUT : F4600036* WORDS PER SECTOR (WPS) F4600037* WORDS PER KIB (KIBLEN) F4600038* F4600039* F4600040ÐÐ* ENTRY POINT F4600041* F4600042 ENT CPUTKL F4600043*E F4600044* F4600045* EXTERNALS F4600046* F4600047 EXT MMLUTB MASS MEMORY LOGICAL UNIT TABLE F4600048* F4600049* COMMON F4600050* F4600051 COM PCTADR F4600052 COM FCBAD F4600053 COM DUM1(600) F4600054 COM KIBLEN F4600055 COM DUM2($65) F4600056 COM WPS F4600057**** F4600058 SPC 5 F4600059* EQUIVALENCE F4600060* F4600061 EQU ZERO(2) CONSTANT F4600062 EQU ONEMSK(3) ONE MASK TABLE F4600063 EJT F4600064* VOLUME INFORMATION TABLE F4600065ÐÐ* F4600066 EQU VISLUN(2) SYSTEM LOGICAL UNIT NUMBER (BIT 15=1,NOT READYF4600067* ACCESS VISLUN INDIRECTLY F4600068 EQU VINAME(1) VOLUME NAME - ASCII CHARACTERS 1 AND 2 F4600069* VOLUME NAME - ASCII CHARACTERS 3 AND 4 F4600070* VOLUME NAME - ASCII CHARACTERS 5 AND 6 F4600071* VOLUME NAME - ASCII CHARACTERS 7 AND 8 F4600072 EQU VINMBR(5) VOLUME NUMBER - (2 ASCII CHARACTERS) F4600073 EQU VIBMSM(6) BEGINNING OF MANAGEABLE SPACE - MSB F4600074 EQU VIBMSL(7) BEGINNING OF MANAGEABLE SPACE - LSB F4600075 EQU VIASDM(8) AVAILABLE SPACE DIRECTORY ADDRESS - MSB F4600076 EQU VIASDL(9) AVAILABLE SPACE DIRECTORY ADDRESS - LSB F4600077 EQU VIASDS(10) # SECTORS IN AVAILABLE SPACE DIRECTORY F4600078 EQU VILBAM(11) LARGEST BLOCK OF SPACE AVAILABLE - MSB F4600079 EQU VILBAL(12) LARGEST BLOCK OF SPACE AVAILABLE - LSB F4600080 EQU VIWPS(13) WORDS/SECTOR FOR VOLUME F4600081 EQU VIFDDM(14) FILE DEFINITION DIRECTORY ADDRESS - MSB F4600082 EQU VIFDDL(15) FILE DEFINITION DIRECTORY ADDRESS - LSB F4600083 EQU VIMAXF(16) MAX. NUMBER OF FILES PERMITTED ON VOLUME F4600084 EQU VICURF(17) CURRENT NUMBER OF FILES EXISTING ON VOLUME F4600085 EQU VINFDB(18) NUMBER OF BLOCKS IN FILE DEFINITION DIRECTORY F4600086 EQU VINXTB(19) NEXT AVAILABLE BLOCK IF FILE DEF. DIRECTORY F4600087 EQU VINOOF(20) NUMBER OF OPEN FILES ON VOLUME F4600088 EJT F4600089* FILE CONTROL BLOCK EQUIVALENCES F4600090ÐÐ EQU FH(4) LENGTH -1 OF FCB HEADER F4600091 EQU FILEID(ZERO) FILE IDENTIFIER F4600092* ACCESS FILEID INDIRECTLY F4600093* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBERF4600094* BITS 10-00 INDEX OF FCB IN FCB TABLE F4600095 EQU FCBFLG(1) FCB FLAGS F4600096* BITS 15-8, SPARE F4600097* BITS 7-00, NUMBER OF USERS USING FILE F4600098 EQU FILOCK(2) FILE LOCK FLAG (IF NON-0, CONTAINS USER ID) F4600099 EQU NUMSET(3) NUMBER OF SETS OF LOCKED RECORDS IN FILE F4600100 EQU NUMNEW(4) NUMBER OF NEW RECORDS SINCE FCB UPDATED ON MM F4600101 SPC 1 F4600102 EQU RECLEN(FH+1) RECORD LENGTH IN WORDS F4600103 EQU TDATRM(FH+2) TOTAL NUMBER OF DATA RECORDS, MSB F4600104 EQU TDATRL(FH+3) TOTAL NUMBER OF DATA RECORDS, LSB F4600105 EQU DATBAM(FH+4) DATA RECORDS BEGINNING SECTOR ADDRESS, MSB F4600106 EQU DATBAL(FH+5) DATA RECORDS BEGINNING SECTOR ADDRESS,LMSB F4600107 EQU FCBIND(FH+6) FCB INDICATORS F4600108* BIT 15 , SECTOR ALLIGNED RECORDS IF =1 F4600109* BIT 14 , STORAGE MODE FOR INDEXED FILE F4600110* =0, RECORDS STORED RANDOMLY WITHF4600111* RESPECT TO PRIMARY KEY F4600112* =1, RECORDS STORED IN ORDER WIT F4600113* RESPECT TO PRIMARY KEY F4600114* BIT 13 , =1, FILE IS CURRENTLY OPEN F4600115ÐÐ* =0, FILE IS CURRENTLY CLOSED F4600116* BIT 12 , =1, FILE IS BEING COMPRESSED F4600117* =0, FILE IS NOT BEING COMPRESSEDF4600118* BIT 11 , =1, FILE IS OPEN FOR SPECIAL F4600119* PROCESSING F4600120* =0, FILE IS NOT OPEN FOR SPECIALF4600121* PROCESSING F4600122* BIT 8 , =1, RECORDS CONTAIN BINARY DATA F4600123* =0, RECORDS DO NOT CONTAIN F4600124* BINARY DATA F4600125* BIT 0 , FILE TYPE F4600126* =0, SEQUENTIAL FILE F4600127* =1, INDEXED FILE F4600128 EQU NEDATM(FH+7) NUMBER OF EXISTING DATA RECORDS, MSB F4600129 EQU NEDATL(FH+8) NUMBER OF EXISTING DATA RECORDS, LSB F4600130 EQU SEQLTH(NEDATL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F4600131* OF FCB FOR A SEQUENTIAL FILE F4600132 SPC 1 F4600133 EQU NEXTBM(FH+9) NEXT FREE KEY INDEX BLOCK, MSB F4600134 EQU NEXTBL(FH+10) NEXT FREE KEY INDEX BLOCK, LSB F4600135 EQU TNKEYM(FH+11) TOTAL NUMBER OF KEY INDEX BLOCKS, MSB F4600136 EQU TNKEYL(FH+12) TOTAL NUMBER OF KEY INDEX BLOCKS, LSB F4600137 EQU KEYBAM(FH+13) KEY INDEX BEGINNING SECTOR ADDRESS, MSB F4600138 EQU KEYBAL(FH+14) KEY INDEX BEGINNING SECTOR ADDRESS, LSB F4600139 EQU LENKY1(FH+15) LENGTH OF KEY NO. 1 F4600140ÐÐ EQU POSKY1(FH+16) BYTE POSITION OF KEY NO. 1 F4600141 EQU LENKY2(FH+17) LENGTH OF KEY NO. 2 F4600142 EQU POSKY2(FH+18) BYTE POSITION OF KEY NO. 2 F4600143 EQU LENKY3(FH+19) LENGTH OF KEY NO. 3 F4600144 EQU POSKY3(FH+20) BYTE POSITION OF KEY NO. 3 F4600145 EQU LENKY4(FH+21) LENGTH OF KEY NO. 4 F4600146 EQU POSKY4(FH+22) BYTE POSITION OF KEY NO. 4 F4600147 EQU INDLEN(POSKY4-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F4600148* OF FCB FOR AN INDEXED FILE F4600149 EJT F4600150* THE FOLLOWING PORTION OF THE FCB EXISTS ONLY F4600151* ON MASS MEMORY. THESE 10 WORDS ARE NOT LOADEDF4600152* INTO EITHER OF THE FILE MANAGER CONTROLLED FCBF4600153* TABLES. F4600154 EQU TSFILM(FH+23) TOTAL NUMBER OF SECTORS IN FILE, MSB F4600155 EQU TSFILL(FH+24) TOTAL NUMBER OF SECTORS IN FILE, LSB F4600156 EQU NAME12(FH+25) FILE NAME, CHARACTERS 1 AND 2 F4600157 EQU NAME34(FH+26) FILE NAME, CHARACTERS 3 AND 4 F4600158 EQU NAME56(FH+27) FILE NAME, CHARACTERS 5 AND 6 F4600159 EQU NAME78(FH+28) FILE NAME, CHARACTERS 7 AND 8 F4600160 EQU OWNR12(FH+29) OWNER NAME, CHARACTERS 1 AND 2 F4600161 EQU OWNR34(FH+30) OWNER NAME, CHARACTERS 3 AND 4 F4600162 EQU OWNR56(FH+31) OWNER NAME, CHARACTERS 5 AND 6 F4600163 EQU OWNR78(FH+32) OWNER NAME, CHARACTERS 7 AND 8 F4600164 EQU BYTLEN(FH+33) BYTE LENGTH OF RECORD F4600165ÐÐ* F4600166* FOR COMPRESS ONLY F4600167* F4600168 EQU PRSRNM(FH+34) RRN OF LAST PROCESSED RECORD - MSB F4600169 EQU PRSRNL(FH+35) RRN OF LAST PROCESSED RECORD - LSB F4600170 EQU NEWRNM(FH+36) RRN OF THE LATEST 'NEW' RECORD - MSB F4600171 EQU NEWRNL(FH+37) RRN OF THE LATEST 'NEW' RECORD - LSB F4600172 SPC 4 F4600173* WORDS 0 THRU 4 OF THE FCB HEADER AND WORDS F4600174* 6 THRU 10 OF THE FCB ARE REFERRED TO AS THE F4600175* SHARED SUBSET OF THE FCB. THEY INCLUDE THE F4600176* ONLY FCB WORDS THAT CAN BE MODIFIED AFTER FILEF4600177* CREATION. IF TWO OR MORE USERS HAVE THE SAME F4600178* FILE OPEN, THERE HAS TO BE A SINGLE MASTER F4600179* COPY OF THE SUBSET THAT RECEIVES (AND RECORDS)F4600180* ALL OF THE UPDATES. THE CONTROLLED SUBSET F4600181* WILL ALWAYS BE PART OF A MAIN MEMORY RESIDENT F4600182* FCB IF THE FCB IS IN A FM CONTROLLED TABLE. F4600183* IF THE FCB IS IN USER SPACE, THE SUBSET MAY ATF4600184* TIMES RESIDE IN THE SUBSET CONTROL TABLE. F4600185 SPC 2 F4600186* ALTERNATE NAMES FOR SUBSET WORDS F4600187 EQU SAFCBI(FH+1) SUBSET ALTERNATE NAME FOR FCBIND F4600188 EQU SADATM(FH+2) SUBSET ALTERNATE NAME FOR NEDATM F4600189 EQU SADATL(FH+3) SUBSET ALTERNATE NAME FOR NEDATL F4600190ÐÐ EQU SANXTM(FH+4) SUBSET ALTERNATE NAME FOR NEXTBM F4600191 EQU SANXTL(FH+5) SUBSET ALTERNATE NAME FOR NEXTBL F4600192 EJT F4600193* REQUEST PROCESSOR CONTROL TABLE F4600194* F4600195 EQU RP(10) INDEX TO START OF REQUEST PARAMETERS F4600196 EQU MR(RP+5) INDEX TO START OF MONITOR REQUEST PARAM LIST F4600197 EQU SS(MR+10) INDEX TO START OF SCRATCH PORTION OF PAR LIST F4600198* F4600199 EQU RPLOGU(1) LU NUMBER OF MM DEVICE F4600200 EQU RPAREQ(2) ACTIVE REQUEST FLAG (IF 0, NONE FOR TABLE) F4600201 EQU RPWAIT(3) START OF WAITING REQUEST QUEUE (IF 0, NO WAITGF4600202 EQU RPRLEV(4) REQUEST PRIORITY LEVEL - ACTIVE REQUEST F4600203 EQU RPRBF4(5) REQBUF ADDRESS - FIRST FOUR WORDS F4600204 EQU RPLTEA(6) LOCK TABLE ENTRY (ABSOLUTE) ADDRESS F4600205 EQU RPRTNJ(7) RETURN JUMP TO REQUEST PROCESSOR F4600206 EQU RPPADR(8) PROCESSOR ADDRESS F4600207 SPC 1 F4600208* PARAMETER LIST FOR REQUEST PROCESSOR F4600209 EQU RPFCBA(9) FCB ADDRESS FOR FILE F4600210 EQU RPRBMP(RP+0) REQBUF ADDRESS - MAIN PART F4600211 EQU RPPFP1(RP+1) REQUEST PARAMETER ADDRESS - FIRST + 1 F4600212 EQU RPPFP2(RP+2) REQUEST PARAMETER ADDRESS - FIRST + 2 F4600213 EQU RPPFP3(RP+3) REQUEST PARAMETER ADDRESS - FIRST + 3 F4600214 EQU RPPFP4(RP+4) REQUEST PARAMETER ADDRESS - FIRST + 4 F4600215ÐÐ SPC 1 F4600216* MAIN MONITOR REQUEST F4600217 EQU RPMREQ(MR+0) MONITOR REQUEST CODE WORD F4600218 EQU RPMRP1(MR+1) COMPLETION ADDRESS F4600219 EQU RPMRP2(MR+2) THREAD WORD F4600220 EQU RPMRP3(MR+3) VARIABLE USE F4600221 EQU RPMRP4(MR+4) VARIABLE USE F4600222 EQU RPMRP5(MR+5) VARIABLE USE F4600223 EQU RPMRP6(MR+6) VARIABLE USE F4600224 EQU RPMRP7(MR+7) VARIABLE USE F4600225 EQU RPRCPT(MR+8) CONTROL POINT (FOR I/O REQUESTS) F4600226 EQU RPRETN(MR+9) SAVED RETURN ADDRESS F4600227* F4600228 EQU REQBUF(RP+0) USERS FIRST CALL PARAMETER ADDRESS F4600229 EQU ISTAT(RP+4) USERS COMPLETION STATUS PARAMETER ADDRESS F4600230 EJT F4600231 SPC 3 F4600232CPUTKL NOP 0 F4600233 STQ* QSAVE F4600234 LDQ FCBAD F4600235 LDA- (FILEID),Q EXTRACT MM LOGICAL UNIT PORTION OF FILEID F4600236 ARS 11 F4600237 AND- ONEMSK+4 F4600238 TRA Q Q HAS THE FILE LU F4600239 LDQ MMLUTB,Q F4600240ÐÐ LDA- VIWPS,Q WPS FOR VOLUME F4600241 STA WPS SAVE IN COMMON F4600242 INA -96 CHECK IF SECTOR LENGTH IS 96 F4600243 SAN CP10 SENSE SECTOR NOT 96 WORDS. F4600244 LDA =N288 SET KIB LENGTH = 3*96 F4600245 JMP* CP20 F4600246* F4600247CP10 INA 96 F4600248 STA* SLEN SAVE ORIGINAL SECTOR LENGTH F4600249 LDA =N572 F4600250 ENQ 0 F4600251 DVI* SLEN COMPUTE WORD LENGTH OF KIB F4600252 MUI* SLEN F4600253CP20 STA KIBLEN SAVE KIB LENGTH IN COMMON F4600254 LDQ* QSAVE F4600255 JMP* (CPUTKL) F4600256 SPC 3 F4600257QSAVE NUM 0 F4600258SLEN NUM 0 F4600259 END F4600260 NAM NXTKIB F47 A ITOS CCS 3.0 SL-149F4700001* GET RELATIVE NUMBER OF NEXT NEW KEY INFORMATION BLOCK F4700002* CREDIT COLLECTION SYSTEM VERSION 3.0 F4700003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F4700004* COPYRIGHT CONTROL DATA CORPORATION 1979 F4700005ÐÐ* F4700006* F4700007**** F4700008* WHEN THE BUILD KEY INFO DIRECTORY SUBROUTINE NEEDS A F4700009* NEW KIB, IT CALLS NXTKIB FOR THE NEXT AVAILABLE KIB'S F4700010* RELATIVE KIB NUMBER. F4700011* F4700012* NXTKIB CHECKS IF IT IS THE LAST KIB AVAILABLE FOR THE F4700013* KEY INFO DIRECTORY. IF SO, A FLAG IS SET. F4700014* F4700015* IF THERE IS NO MORE KIB AVAILABLE, THEN AN ERROR IN- F4700016* DICATION IS SET IN THE STATUS WORD. F4700017* F4700018* CALLING SEQUENCE F4700019* CALL NXTKIB F4700020* F4700021* F4700022* INPUT: F4700023* FCB ADDR IN COMMON (FCBAD) F4700024* F4700025* F4700026* PROCESS: F4700027* CLEAR LAST KIB FLAG F4700028* GET THE TOTAL NUMBER OF KIB'S FROM FCB F4700029* GET THE NEXT AVAILABLE KIB FROM FCB (MAY BE IN F4700030ÐÐ* FCB SUBSET) F4700031* F4700032* SEE IF THE NEXT KIB IS THE LAST ONE ALLOWED. F4700033* IF SO, SET THE LAST KIB FLAG. F4700034* ELSE RETURN THE NEXT AVAILABLE KIB AS THE F4700035* ANSWER AND INCREMENT THE VALUE IN THE FCB BY F4700036* ONE. F4700037* F4700038* IF THE NEXT AVAILABLE KIB IS BIGGER THAN TOTAL F4700039* NUMBER ALLOWED, THEN SET ERROR BITS IN STATUS F4700040* WORD. F4700041* F4700042* F4700043* OUTPUT: F4700044* RELATIVE KIB NUMBER NEXT AVAILABLE (NEWKBL,NEWKBM) F4700045* LAST KIB FLAG (LASTKB) F4700046* STATUS (REQSTA) BIT 15 + 11 SET IF NO MORE KIB'S F4700047* ARE AVAILABLE F4700048* F4700049* ENTRY POINT F4700050* F4700051 ENT NXTKIB F4700052 SPC 5 F4700053* F4700054* EXTERNAL F4700055ÐÐ* F4700056 EXT DWSUB DOUBLE WORD SUBTRACTION ROUTINE F4700057 EXT FMBRRN BUMP RRN BY ONE 121*4626F4700058 EXT FMFSRC CHECK IF SUBSET IS IN SUBSET TABLE 132*5370F4700059* F4700060* COMMON F4700061* F4700062 COM PCTADR PCT ADDRESS F4700063 COM FCBAD F4700064 COM DUM(677) F4700065 COM LASTKB F4700066 COM DUM1(4) F4700067 COM NEWKBM F4700068 COM NEWKBL F4700069 COM DUM2($A) F4700070 COM REQSTA F4700071**** F4700072 EJT F4700073 SPC 5 F4700074* F4700075* EQUIVALENCE F4700076* F4700077* COMMUNICATION REGION F4700078 SPC 2 F4700079 EQU ONEBIT($23) ONE BIT TABLE F4700080ÐÐ EQU ZERO(2) ZERO CONSTANT F4700081 EJT 0 F4700082 SPC 1 F4700083* UCT ENTRY EQUIVALENCES F4700084 EQU UIDENT(ZERO) USER IDENTIFICATION F4700085 EQU FIDENT(1) PSEUDO FILE IDENTIFIER F4700086 EQU FCBCAD(2) FCB CORE ADDRESS F4700087 EQU FSLADR(3) FILE SPACE LIMITS TABLE ENTRY ADDRESS F4700088 EQU FCBSAD(4) FCB SUBSET ADDRESS F4700089 EJT F4700090* REQUEST BUFFER INDEXES - FIRST 4 WORDS F4700091 EQU RBATHR(0) REQUEST BUFFER ADDRESS THREAD F4700092 EQU BUFAMP(1) BUFFER ADDRESS MAIN PART F4700093 EQU CNTLPT(2) CONTROL POINT (OR SPARE) F4700094 EQU RQINFO(3) REQUEST INFORMATION (MULTI-FIELD) F4700095* BITS USE F4700096* 15-12 SPARE F4700097* 11-04 REQUEST INDEX F4700098* 03-00 LEVEL OF REQUESTOR F4700099* F4700100* REQUEST BUFFER INDEXES - MAIN PART F4700101 EQU QREG(0) Q REGISTER F4700102 EQU IREG(1) I REGISTER F4700103 EQU PARLST(2) ADDRESS OF PARAMETER LIST F4700104 EQU RTNADR(2) RETURN ADDRESS TO USER (UPON RETURN FROM EXEC)F4700105ÐÐ EQU UCTADR(3) UCT ENTRY ABSOLUTE ADDRESS F4700106 EQU USERID(4) USER IDENTIFIER F4700107 EQU FCBADR(5) FCB ADDRESS (MAY BE SET BY CALLER OR INTCPTR.)F4700108 EQU RADINT(6) RETURN ADDRESS TO INTERCEPTOR F4700109 EQU RPIDX(7) REQUEST PROCESSOR INDEX F4700110* BITS 14-00 REQUEST PROCESSOR INDEX F4700111* BIT 15 TYPE OF PROCESSOR F4700112* =0, SERIAL PROCESSOR F4700113* =1, REENTRANT PROCESSOR F4700114 EQU LOKREC(8) NUMBER OF RECORDS TO BE READ/WRITTEN PER I/O F4700115* CALL AND LOCK RECORDS ON RETRIEVE FLAG F4700116* BITS 14-00 NUMBER OF RECORDS PER CALL F4700117* BIT 15 =0, DO NOT LOCK ON RETRIEVE F4700118* =1, LOCK RECORDS ON RETRIEVE F4700119 EQU USEFLG(9) TYPE OF FILE USE FLAG F4700120* -1, OPEN FOR COMPRESSION F4700121* -2, OPEN FOR SPECIAL PROCESSING F4700122* 0, OPEN FOR ACESS VIA REL REC NO F4700123* 1, OPEN FOR RETRIEVAL VIA KEY 1 F4700124* 2, OPEN FOR RETRIEVAL VIA KEY 2 F4700125* 3, OPEN FOR RETRIEVAL VIA KEY 3 F4700126* 4, OPEN FOR RETRIEVAL VIA KEY 4 F4700127 EQU NUMREC(10) NUMBER OF RECORDS ACTUALLY STORED/RETRIEVED F4700128 EQU RRNMSB(11) REL REC NUMBER OF STORED/RETRIEVED REC, MSB F4700129 EQU RRNLSB(12) REL REC NUMBER OF STORED/RETRIEVED REC, LSB F4700130ÐÐ EQU RMPLEN(20) LENGTH OF REQBUF MAIN PART F4700131 EJT F4700132* FILE CONTROL BLOCK EQUIVALENCES F4700133 EQU FH(4) LENGTH -1 OF FCB HEADER F4700134 EQU FILEID(ZERO) FILE IDENTIFIER F4700135* ACCESS FILEID INDIRECTLY F4700136* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBERF4700137* BITS 10-00 INDEX OF FCB IN FCB TABLE F4700138 EQU FCBFLG(1) FCB FLAGS F4700139* BITS 15-8, SPARE F4700140* BITS 7-00, NUMBER OF USERS USING FILE F4700141 EQU FILOCK(2) FILE LOCK FLAG (IF NON-0, CONTAINS USER ID) F4700142 EQU NUMSET(3) NUMBER OF SETS OF LOCKED RECORDS IN FILE F4700143 EQU NUMNEW(4) NUMBER OF NEW RECORDS SINCE FCB UPDATED ON MM F4700144 SPC 1 F4700145 EQU RECLEN(FH+1) RECORD LENGTH IN WORDS F4700146 EQU TDATRM(FH+2) TOTAL NUMBER OF DATA RECORDS, MSB F4700147 EQU TDATRL(FH+3) TOTAL NUMBER OF DATA RECORDS, LSB F4700148 EQU DATBAM(FH+4) DATA RECORDS BEGINNING SECTOR ADDRESS, MSB F4700149 EQU DATBAL(FH+5) DATA RECORDS BEGINNING SECTOR ADDRESS,LMSB F4700150 EQU FCBIND(FH+6) FCB INDICATORS F4700151* BIT 15 , SECTOR ALLIGNED RECORDS IF =1 F4700152* BIT 14 , STORAGE MODE FOR INDEXED FILE F4700153* =0, RECORDS STORED RANDOMLY WITHF4700154* RESPECT TO PRIMARY KEY F4700155ÐÐ* =1, RECORDS STORED IN ORDER WIT F4700156* RESPECT TO PRIMARY KEY F4700157* BIT 13 , =1, FILE IS CURRENTLY OPEN F4700158* =0, FILE IS CURRENTLY CLOSED F4700159* BIT 12 , =1, FILE IS BEING COMPRESSED F4700160* =0, FILE IS NOT BEING COMPRESSEDF4700161* BIT 11 , =1, FILE IS OPEN FOR SPECIAL F4700162* PROCESSING F4700163* =0, FILE IS NOT OPEN FOR SPECIALF4700164* PROCESSING F4700165* BIT 8 , =1, RECORDS CONTAIN BINARY DATA F4700166* =0, RECORDS DO NOT CONTAIN F4700167* BINARY DATA F4700168* BIT 0 , FILE TYPE F4700169* =0, SEQUENTIAL FILE F4700170* =1, INDEXED FILE F4700171 EQU NEDATM(FH+7) NUMBER OF EXISTING DATA RECORDS, MSB F4700172 EQU NEDATL(FH+8) NUMBER OF EXISTING DATA RECORDS, LSB F4700173 EQU SEQLTH(NEDATL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F4700174* OF FCB FOR A SEQUENTIAL FILE F4700175 SPC 1 F4700176 EQU NEXTBM(FH+9) NEXT FREE KEY INDEX BLOCK, MSB F4700177 EQU NEXTBL(FH+10) NEXT FREE KEY INDEX BLOCK, LSB F4700178 EQU TNKEYM(FH+11) TOTAL NUMBER OF KEY INDEX BLOCKS, MSB F4700179 EQU TNKEYL(FH+12) TOTAL NUMBER OF KEY INDEX BLOCKS, LSB F4700180ÐÐ EQU KEYBAM(FH+13) KEY INDEX BEGINNING SECTOR ADDRESS, MSB F4700181 EQU KEYBAL(FH+14) KEY INDEX BEGINNING SECTOR ADDRESS, LSB F4700182 EQU LENKY1(FH+15) LENGTH OF KEY NO. 1 F4700183 EQU POSKY1(FH+16) BYTE POSITION OF KEY NO. 1 F4700184 EQU LENKY2(FH+17) LENGTH OF KEY NO. 2 F4700185 EQU POSKY2(FH+18) BYTE POSITION OF KEY NO. 2 F4700186 EQU LENKY3(FH+19) LENGTH OF KEY NO. 3 F4700187 EQU POSKY3(FH+20) BYTE POSITION OF KEY NO. 3 F4700188 EQU LENKY4(FH+21) LENGTH OF KEY NO. 4 F4700189 EQU POSKY4(FH+22) BYTE POSITION OF KEY NO. 4 F4700190 EQU INDLEN(POSKY4-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F4700191* OF FCB FOR AN INDEXED FILE F4700192 EJT F4700193* THE FOLLOWING PORTION OF THE FCB EXISTS ONLY F4700194* ON MASS MEMORY. THESE 10 WORDS ARE NOT LOADEDF4700195* INTO EITHER OF THE FILE MANAGER CONTROLLED FCBF4700196* TABLES. F4700197 EQU TSFILM(FH+23) TOTAL NUMBER OF SECTORS IN FILE, MSB F4700198 EQU TSFILL(FH+24) TOTAL NUMBER OF SECTORS IN FILE, LSB F4700199 EQU NAME12(FH+25) FILE NAME, CHARACTERS 1 AND 2 F4700200 EQU NAME34(FH+26) FILE NAME, CHARACTERS 3 AND 4 F4700201 EQU NAME56(FH+27) FILE NAME, CHARACTERS 5 AND 6 F4700202 EQU NAME78(FH+28) FILE NAME, CHARACTERS 7 AND 8 F4700203 EQU OWNR12(FH+29) OWNER NAME, CHARACTERS 1 AND 2 F4700204 EQU OWNR34(FH+30) OWNER NAME, CHARACTERS 3 AND 4 F4700205ÐÐ EQU OWNR56(FH+31) OWNER NAME, CHARACTERS 5 AND 6 F4700206 EQU OWNR78(FH+32) OWNER NAME, CHARACTERS 7 AND 8 F4700207 EQU BYTLEN(FH+33) BYTE LENGTH OF RECORD F4700208* F4700209* FOR COMPRESS ONLY F4700210* F4700211 EQU PRSRNM(FH+34) RRN OF LAST PROCESSED RECORD - MSB F4700212 EQU PRSRNL(FH+35) RRN OF LAST PROCESSED RECORD - LSB F4700213 EQU NEWRNM(FH+36) RRN OF THE LATEST 'NEW' RECORD - MSB F4700214 EQU NEWRNL(FH+37) RRN OF THE LATEST 'NEW' RECORD - LSB F4700215 SPC 4 F4700216* WORDS 0 THRU 4 OF THE FCB HEADER AND WORDS F4700217* 6 THRU 10 OF THE FCB ARE REFERRED TO AS THE F4700218* SHARED SUBSET OF THE FCB. THEY INCLUDE THE F4700219* ONLY FCB WORDS THAT CAN BE MODIFIED AFTER FILEF4700220* CREATION. IF TWO OR MORE USERS HAVE THE SAME F4700221* FILE OPEN, THERE HAS TO BE A SINGLE MASTER F4700222* COPY OF THE SUBSET THAT RECEIVES (AND RECORDS)F4700223* ALL OF THE UPDATES. THE CONTROLLED SUBSET F4700224* WILL ALWAYS BE PART OF A MAIN MEMORY RESIDENT F4700225* FCB IF THE FCB IS IN A FM CONTROLLED TABLE. F4700226* IF THE FCB IS IN USER SPACE, THE SUBSET MAY ATF4700227* TIMES RESIDE IN THE SUBSET CONTROL TABLE. F4700228 SPC 2 F4700229* ALTERNATE NAMES FOR SUBSET WORDS F4700230ÐÐ EQU SAFCBI(FH+1) SUBSET ALTERNATE NAME FOR FCBIND F4700231 EQU SADATM(FH+2) SUBSET ALTERNATE NAME FOR NEDATM F4700232 EQU SADATL(FH+3) SUBSET ALTERNATE NAME FOR NEDATL F4700233 EQU SANXTM(FH+4) SUBSET ALTERNATE NAME FOR NEXTBM F4700234 EQU SANXTL(FH+5) SUBSET ALTERNATE NAME FOR NEXTBL F4700235 EJT F4700236* REQUEST PROCESSOR CONTROL TABLE F4700237* F4700238 EQU RP(10) INDEX TO START OF REQUEST PARAMETERS F4700239 EQU MR(RP+5) INDEX TO START OF MONITOR REQUEST PARAM LIST F4700240 EQU SS(MR+10) INDEX TO START OF SCRATCH PORTION OF PAR LIST F4700241* F4700242 EQU RPLOGU(1) LU NUMBER OF MM DEVICE F4700243 EQU RPAREQ(2) ACTIVE REQUEST FLAG (IF 0, NONE FOR TABLE) F4700244 EQU RPWAIT(3) START OF WAITING REQUEST QUEUE (IF 0, NO WAITGF4700245 EQU RPRLEV(4) REQUEST PRIORITY LEVEL - ACTIVE REQUEST F4700246 EQU RPRBF4(5) REQBUF ADDRESS - FIRST FOUR WORDS F4700247 EQU RPLTEA(6) LOCK TABLE ENTRY (ABSOLUTE) ADDRESS F4700248 EQU RPRTNJ(7) RETURN JUMP TO REQUEST PROCESSOR F4700249 EQU RPPADR(8) PROCESSOR ADDRESS F4700250 SPC 1 F4700251* PARAMETER LIST FOR REQUEST PROCESSOR F4700252 EQU RPFCBA(9) FCB ADDRESS FOR FILE F4700253 EQU RPRBMP(RP+0) REQBUF ADDRESS - MAIN PART F4700254 EQU RPPFP1(RP+1) REQUEST PARAMETER ADDRESS - FIRST + 1 F4700255ÐÐ EQU RPPFP2(RP+2) REQUEST PARAMETER ADDRESS - FIRST + 2 F4700256 EQU RPPFP3(RP+3) REQUEST PARAMETER ADDRESS - FIRST + 3 F4700257 EQU RPPFP4(RP+4) REQUEST PARAMETER ADDRESS - FIRST + 4 F4700258 SPC 1 F4700259* MAIN MONITOR REQUEST F4700260 EQU RPMREQ(MR+0) MONITOR REQUEST CODE WORD F4700261 EQU RPMRP1(MR+1) COMPLETION ADDRESS F4700262 EQU RPMRP2(MR+2) THREAD WORD F4700263 EQU RPMRP3(MR+3) LOGICAL UNIT FOR I/O F4700264 EQU RPMRP4(MR+4) NUMBER OF WORDS F4700265 EQU RPMRP5(MR+5) START CORE ADDRESS F4700266 EQU RPMRP6(MR+6) MASS MEMORY ADDRESS, MSB F4700267 EQU RPMRP7(MR+7) MASS MEMORY ADDRESS, LSB F4700268 EQU RPRCPT(MR+8) CONTROL POINT (FOR I/O REQUESTS) F4700269 EQU RPRETN(MR+9) SAVED RETURN ADDRESS F4700270* ALTERNATE COMMON NAMES F4700271 EQU REQBUF(RP+0) USERS FIRST CALL PARAMETER ADDRESS F4700272 EQU RECBUF(RP+1) RECORD BUFFER PARAMETER - FOR PUTS F4700273 EQU ISTAT(RP+4) USERS COMPLETION STATUS PARAMETER ADDRESS F4700274 EQU NORECS(RP+2) NUMBER OF RECORDS PARAMETER - FOR PUTS F4700275 EJT F4700276 EJT F4700277 SPC 5 F4700278NXTKIB NOP 0 F4700279 SPC 2 F4700280ÐÐ STQ* QSAVE F4700281 LDQ- I F4700282 STQ* ISAVE SAVE REG I F4700283* CLEAR LAST KIB FLAG F4700284 CLR A F4700285 STA LASTKB F4700286 LDQ FCBAD FCB ADDRESS - 1 F4700287* ADDR OF FCB IN MEMORY F4700288 STQ- I F4700289 LDA- TNKEYL,Q GET TOTAL NO. OF KIBS ALLOWED F4700290 LDQ- TNKEYM,Q FROM FCB F4700291 LLS 1 CHANGE TO MSB/ LSB FORMAT F4700292 ALS 15 F4700293 STQ* P1 PUT IN PARAMETER FOR SUBTRACTION F4700294 STA* P2 F4700295* F4700296* GET NEW KIB NUMBER FROM FCB F4700297 LDQ PCTADR CHECK IF SUBSET IS IN SUBSET TABLE 132*5370F4700298 LDQ- REQBUF,Q F4700299 LDQ- UCTADR,Q F4700300 LDA- FCBSAD,Q ADDR OF SUBSET F4700301 STA* P3 SAVE TEMP IN LOCAL STORAGE F4700302 TRA Q 132*5370F4700303 RTJ FMFSRC CHECK THE SUBSET ADDRESS 132*5370F4700304 SAZ NXT10 SKIP IF SUBSET NOT IN SUBSET TABLE 132*5370F4700305ÐÐ INQ SANXTL-1 USE EQUS FOR SUBSET 121*4626F4700306 STQ- I RI = ADDR OF NEW KIB NO. (MSB) 121*4626F4700307 INQ -SANXTL+1 121*4626F4700308 LDA- SANXTL,Q F4700309 LDQ- SANXTM,Q F4700310 JMP* NXT15 F4700311* F4700312NXT10 EQU NXT10(*) USE REGULAR FCB ADDRESSING 132*5370F4700313 INQ NEXTBL-1 121*4626F4700314 STQ- I RI = ADDR OF NEW KIB NO. (MSB) 121*4626F4700315 INQ -NEXTBL+1 121*4626F4700316 LDA- NEXTBL,Q F4700317 LDQ- NEXTBM,Q F4700318* F4700319NXT15 EQU NXT15(*) F4700320 LLS 1 CHANGE TO MSB/LSB FORMAT F4700321 ALS 15 F4700322 STQ* P3 F4700323 STA* P4 F4700324 SPC 3 F4700325 LDQ* ADRPAR F4700326 RTJ DWSUB DO SUBRACTION OF TOTAL-NEW F4700327 LDA* P7 F4700328 SAZ NXT30 F4700329* F4700330ÐÐ LDA REQSTA ANSWER IS NEGATIVE F4700331 EOR- ONEBIT+11 NEW NUMBER IS BAD F4700332 EOR- ONEBIT+15 F4700333 STA REQSTA SET ERROR FLAGS F4700334 JMP* NXT90 AND LEAVE F4700335* F4700336* F4700337NXT30 LDQ* P3 NEW NUMBER IS GOOD F4700338 LDA* P4 SAVE IN COMMON F4700339 ALS 1 F4700340 LRS 1 CHANGE BACK TO RRN FORMAT F4700341 STA NEWKBL F4700342 STQ NEWKBM F4700343* F4700344 LDQ- (ZERO),I PICKUP MSB/LSB OF NEW KIB NO. FROM FCB121*4626F4700345 LDA- 1,I 121*4626F4700346 RTJ FMBRRN BUMP RRN (OF KIB) BY 1 121*4626F4700347 STQ- (ZERO),I STORE BACK INCREMENTED NUMBER 121*4626F4700348 STA- 1,I 121*4626F4700349* F4700350 LDA* P5 CHECK IF IT IS THE LAST KIB F4700351 SAN NXT70 SEE IF DIFFERENCE OF SUBTRACTION IS ZERO F4700352 LDA* P6 F4700353 SAN NXT70 F4700354 ENA 1 DIFFERENCE IS ZERO MEANS THAT KIB NUMBER F4700355ÐÐ STA LASTKB IS THE LAST ONE, SO SET EOF FLAG FOR KIB F4700356* F4700357NXT70 EQU NXT70(*) F4700358* F4700359NXT90 EQU NXT90(*) ALL DONE F4700360 LDQ* ISAVE F4700361 STQ- I F4700362 LDQ* QSAVE F4700363 JMP* (NXTKIB) F4700364* F4700365* NO NEED TO UPDATE FCB FLAG BECAUSE RE-ENTRANT ROUTINE F4700366* PUT WILL DO IT F4700367 SPC 3 F4700368ISAVE NUM 0 F4700369QSAVE NUM 0 F4700370 SPC 3 F4700371* PARAMETER LIST FOR DOUBLE WORD SUBTRACTION F4700372ADRPAR ADC P1 ABSOLUTE ADDR OF LIST F4700373* F4700374P1 NUM 0 TOTAL NUMBER OF KIB F4700375P2 NUM 0 F4700376P3 NUM 0 NEXT KIB NUMBER F4700377* LOCAL STORAGE FOR SUBSET ADDRESS F4700378P4 NUM 0 F4700379P5 NUM 0 RESULT OF SUBTRACTION F4700380ÐÐP6 NUM 0 F4700381P7 NUM 0 ERROR FLAG, IF NON-ZERO MEANS ANS IS -VE F4700382 SPC 2 F4700383 END F4700384 NAM PLACE F48 A ITOS CCS 3.0 SL-149F4800001* FORTRAN INTERFACE TO PUT NEW RECORD IN FILE F4800002* CREDIT COLLECTION SYSTEM VERSION 3.0 F4800003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F4800004* COPYRIGHT CONTROL DATA CORPORATION 1979 F4800005* F4800006* F4800007**** F4800008* THIS IS THE FORTRAN INTERFACE FOR PUTREC. F4800009* WHEN A FORTRAN FILE MAMAGER PROGRAM NEEDS TO ADD A F4800010* NEW RECORD IN THE FILE, IT USES THE MAIN MEMORY RESI- F4800011* DENT SUBROUTINE, PUTREC. PLACE SETS UP THE INTER- F4800012* FACE TO PUTREC. F4800013* F4800014* CALLING SEQUENCE F4800015* CALL PLACE F4800016* F4800017* F4800018* INPUT : F4800019* ADDR OF THE PCT IN COMMON (PCTADR) F4800020* F4800021ÐÐ* F4800022* PROCESS : F4800023* SAVE REGS Q AND I F4800024* LOAD REG I WITH THE ADDR OF THE PCT F4800025* RETURN JUMP TO PUTREC F4800026* GET STATUS LEFT BY PUTREC, SAVE IN COMMON F4800027* RESTORE REGS Q AND I F4800028* LEAVE F4800029* F4800030* F4800031* EXIT : F4800032* THE RELATIVE RECORD NO. IS IN REQBUF F4800033* STATUS LOCALIZED IN COMMON (REQSTA) F4800034* F4800035* F4800036* F4800037* ENTRY POINT F4800038* F4800039 ENT PLACE F4800040* F4800041* F4800042* EXTERNAL F4800043* F4800044 EXT PUTREC WRITE A RECORD TO MASS MEMORY F4800045* F4800046ÐÐ* F4800047* COMMON F4800048 COM PCTADR F4800049 COM DUM(695) F4800050 COM REQSTA F4800051**** F4800052 EJT 0 F4800053* COMMUNICATION REGION CONSTANT F4800054 SPC 2 F4800055 EQU ZERO(2) CONSTANT F4800056 SPC 5 F4800057* REQUEST PROCESSOR CONTROL TABLE F4800058* F4800059 EQU RP(10) INDEX TO START OF REQUEST PARAMETERS F4800060 EQU MR(RP+5) INDEX TO START OF MONITOR REQUEST PARAM LIST F4800061 EQU SS(MR+10) INDEX TO START OF SCRATCH PORTION OF PAR LIST F4800062* F4800063 EQU RPLOGU(1) LU NUMBER OF MM DEVICE F4800064 EQU RPAREQ(2) ACTIVE REQUEST FLAG (IF 0, NONE FOR TABLE) F4800065 EQU RPWAIT(3) START OF WAITING REQUEST QUEUE (IF 0, NO WAITGF4800066 EQU RPRLEV(4) REQUEST PRIORITY LEVEL - ACTIVE REQUEST F4800067 EQU RPRBF4(5) REQBUF ADDRESS - FIRST FOUR WORDS F4800068 EQU RPLTEA(6) LOCK TABLE ENTRY (ABSOLUTE) ADDRESS F4800069 EQU RPRTNJ(7) RETURN JUMP TO REQUEST PROCESSOR F4800070 EQU RPPADR(8) PROCESSOR ADDRESS F4800071ÐÐ SPC 1 F4800072* PARAMETER LIST FOR REQUEST PROCESSOR F4800073 EQU RPFCBA(9) FCB ADDRESS FOR FILE F4800074 EQU RPRBMP(RP+0) REQBUF ADDRESS - MAIN PART F4800075 EQU RPPFP1(RP+1) REQUEST PARAMETER ADDRESS - FIRST + 1 F4800076 EQU RPPFP2(RP+2) REQUEST PARAMETER ADDRESS - FIRST + 2 F4800077 EQU RPPFP3(RP+3) REQUEST PARAMETER ADDRESS - FIRST + 3 F4800078 EQU RPPFP4(RP+4) REQUEST PARAMETER ADDRESS - FIRST + 4 F4800079 SPC 1 F4800080* MAIN MONITOR REQUEST F4800081 EQU RPMREQ(MR+0) MONITOR REQUEST CODE WORD F4800082 EQU RPMRP1(MR+1) COMPLETION ADDRESS F4800083 EQU RPMRP2(MR+2) THREAD WORD F4800084 EQU RPMRP3(MR+3) LOGICAL UNIT FOR I/O F4800085 EQU RPMRP4(MR+4) NUMBER OF WORDS F4800086 EQU RPMRP5(MR+5) START CORE ADDRESS F4800087 EQU RPMRP6(MR+6) MASS MEMORY ADDRESS, MSB F4800088 EQU RPMRP7(MR+7) MASS MEMORY ADDRESS, LSB F4800089 EQU RPRCPT(MR+8) CONTROL POINT (FOR I/O REQUESTS) F4800090 EQU RPRETN(MR+9) SAVED RETURN ADDRESS F4800091* ALTERNATE COMMON NAMES F4800092 EQU REQBUF(RP+0) USERS FIRST CALL PARAMETER ADDRESS F4800093 EQU RECBUF(RP+1) RECORD BUFFER PARAMETER - FOR PUTS F4800094 EQU ISTAT(RP+4) USERS COMPLETION STATUS PARAMETER ADDRESS F4800095 EQU NORECS(RP+2) NUMBER OF RECORDS PARAMETER - FOR PUTS F4800096ÐÐ EJT F4800097PLACE NOP 0 ENTRY POINT F4800098 STQ* QSAVE F4800099 LDQ- I SAVE REGS F4800100 STQ* ISAVE F4800101 LDA PCTADR F4800102 STA- I F4800103 RTJ PUTREC F4800104 LDQ- ISTAT,I F4800105 LDQ- (ZERO),Q LOCALIZE ISTAT F4800106 STQ REQSTA F4800107* F4800108 LDQ* ISAVE RESTORE REGS F4800109 STQ- I F4800110 LDQ* QSAVE F4800111 JMP* (PLACE) F4800112 SPC 3 F4800113ISAVE NUM 0 F4800114QSAVE NUM 0 F4800115 END F4800116 NAM CKADRP F49 A ITOS CCS 3.0 SL-149F4900001* FORTRAN INTERFACE TO CHECK FOR UNPROTECTED ADDRESS F4900002* CREDIT COLLECTION SYSTEM VERSION 3.0 F4900003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F4900004* COPYRIGHT CONTROL DATA CORPORATION 1979 F4900005ÐÐ* F4900006* F4900007**** F4900008* THIS IS THE FORTRAN INTERFACE TO THE CORE RESIDENT SUBROUTINE F4900009* CKUADR - CHECK UNPROTECTED ADDRESS F4900010* BEFORE A FILE MANAGER FORTRAN PROGRAM WRITES DATA TO F4900011* A USER PASSED SPACE, IT NEEDS TO SEE IF A UNPROTECTED F4900012* USER IS WRITING INTO PROTECTED MEMORY. MAIN MEMORY F4900013* RESIDENT SUBROUTINE (PART OF FMEXEC) CKUADR DOES THE F4900014* CHECKING. F4900015* F4900016* IF THE ADDR IS BAD. A JP02 ERROR IS FLAG AND CKUADR F4900017* NEVER RETURNS TO THE CALLING PROGRAM. F4900018* F4900019* CALLING SEQUENCE F4900020* CALL CKADRP (ADDR) F4900021* WHERE ADDR IS THE ADDR TO BE CHECKED F4900022* F4900023* F4900024* INPUT : F4900025* ADDRESS TO BE CHECKED (FROM PARAMETER) F4900026* ADDRESS OF THE PCT (PCTADR IN COMMON) F4900027* F4900028* F4900029* PROCESS : F4900030ÐÐ* SAVE REGS Q AND I F4900031* LOAD REG I WITH THE PCT ADDRESS F4900032* REG A CONTAINS ADDR TO BE CHECKED F4900033* REG Q IS ZERO F4900034* GO TO CKUADR F4900035* IF ADDR IS BAD, NEVER RETURNS F4900036* IF ADDR IS GOOD, RETURNS HERE. F4900037* RESTORE REGS Q AND I F4900038* F4900039* F4900040* OUTPUT : F4900041* NONE F4900042* F4900043* F4900044* ENTRY POINT F4900045* F4900046 ENT CKADRP F4900047* F4900048* EXTERNALS F4900049* F4900050 EXT Q8PREP PREPARE TO PICK UP PARAMETER F4900051 EXT Q8PKUP PICK UP ABSOLUTIZED PARAMETER F4900052 EXT CKUADR CHECK FOR UNPROTECTED ADDR ROUTINE F4900053* F4900054* F4900055ÐÐ* COMMON F4900056* F4900057 COM PCTADR F4900058**** F4900059 SPC 5 F4900060CKADRP NOP 0 ENTRY POINT F4900061 STQ* QSAVE F4900062 LDQ- I SAVE REGS F4900063 STQ* ISAVE F4900064 RTJ Q8PREP F4900065 ADC (CKADRP-*) F4900066 RTJ Q8PKUP RA CONTAINS THE ABSOLUTE ADDR TO BE CHECKED F4900067 LDQ PCTADR F4900068 STQ- I F4900069 CLR Q F4900070 RTJ CKUADR GO CHECK. IF BAD. NEVER RETURNS F4900071 LDQ* ISAVE F4900072 STQ- I F4900073 LDQ* QSAVE F4900074 JMP* (CKADRP) F4900075ISAVE NUM 0 F4900076QSAVE NUM 0 F4900077 END F4900078 NAM RDRECD F50 A ITOS CCS 3.0 SL-149F5000001* FORTRAN INTERFACE TO READ RECORD(S) FROM FILE F5000002ÐÐ* CREDIT COLLECTION SYSTEM VERSION 3.0 F5000003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F5000004* COPYRIGHT CONTROL DATA CORPORATION 1979 F5000005* F5000006* F5000007**** F5000008* THIS IS THE FORTRAN INTERFACE TO THE CORE RESIDENT RE-ENTRANT F5000009* SUBROUTINE READRC - READ A RECORD FROM MASS MEMORY F5000010* F5000011* WHEN A FORTRAN FILE MANAGER INDEXED FILE PROCESSOR F5000012* NEEDS TO RETRIEVE A RECORD FROM MASS MEMORY, IT USES F5000013* THE MAIN MEMORY RESIDENT ROUTINE READRC. F5000014* RDRECD IS THE INTERFACE TO READRC. F5000015* F5000016* CALLING SEQUENCE F5000017* CALL RDRECD (BUFFER) F5000018* WHERE BUFFER IS WHERE THE RECORD WILL BE F5000019* STORED BY READRC. F5000020* F5000021* F5000022* INPUT: F5000023* ADDR OF BUFFER TO PUT RECORD (FROM PARAMETER) F5000024* ADDR OF PCT (IN COMMON - PCTADR) F5000025* RELATIVE RECORD NUMBER OF RECORD TO READ (RRDATA) F5000026* F5000027ÐÐ* F5000028* PROCESS: F5000029* SAVE REG Q AND I F5000030* LOAD REG I WITH THE PCT ADDR F5000031* F5000032* PICK UP THE ABSOLUTE ADDR OF THE BUFFER FROM THE F5000033* PARAMETER, SAVE IT IN THE REQBUF FOR READRC. F5000034* F5000035* PICK UP THE RELATIVE RECORD NUMBER OF THE RECORD F5000036* TO READ, SAVE IN THE REQBUF FOR READRC. F5000037* F5000038* SET ENTRY IN REQBUF TO READ ONE RECORD ONLY. F5000039* F5000040* RETURN JUMP TO READRC TO READ THE RECORD SPECIFIED F5000041* SAVE STATUS SET BY READRC IN COMMON (REQSTA) F5000042* RESTORE REG Q AND I F5000043* LEAVE F5000044* F5000045* F5000046* OUTPUT: F5000047* CONTENT OF RECORD (BUFFER) F5000048* STATUS OF I/O (REQSTA) F5000049* F5000050* ENTRY POINT F5000051* F5000052ÐÐ ENT RDRECD F5000053* F5000054* F5000055* EXTERNAL F5000056* F5000057 EXT Q8PREP PREPARE TO PICK UP PARAMETER F5000058 EXT Q8PKUP PICK UP ABSOLUTIZED PARAMETER F5000059 EXT READRC READ RECORD FROM MASS MEMORY F5000060* F5000061* COMMON F5000062 SPC 5 F5000063 COM PCTADR F5000064 COM DUM(695) F5000065 COM REQSTA F5000066 COM DUM1(3) F5000067 COM RRDATA F5000068 EQU ZERO(2) ZERO CONSTANT F5000069**** F5000070 EJT 0 F5000071* REQUEST PROCESSOR CONTROL TABLE F5000072* F5000073 EQU RP(10) INDEX TO START OF REQUEST PARAMETERS F5000074 EQU MR(RP+5) INDEX TO START OF MONITOR REQUEST PARAM LIST F5000075 EQU SS(MR+10) INDEX TO START OF SCRATCH PORTION OF PAR LIST F5000076* F5000077ÐÐ EQU RPLOGU(1) LU NUMBER OF MM DEVICE F5000078 EQU RPAREQ(2) ACTIVE REQUEST FLAG (IF 0, NONE FOR TABLE) F5000079 EQU RPWAIT(3) START OF WAITING REQUEST QUEUE (IF 0, NO WAITGF5000080 EQU RPRLEV(4) REQUEST PRIORITY LEVEL - ACTIVE REQUEST F5000081 EQU RPRBF4(5) REQBUF ADDRESS - FIRST FOUR WORDS F5000082 EQU RPLTEA(6) LOCK TABLE ENTRY (ABSOLUTE) ADDRESS F5000083 EQU RPRTNJ(7) RETURN JUMP TO REQUEST PROCESSOR F5000084 EQU RPPADR(8) PROCESSOR ADDRESS F5000085 SPC 1 F5000086* PARAMETER LIST FOR REQUEST PROCESSOR F5000087 EQU RPFCBA(9) FCB ADDRESS FOR FILE F5000088 EQU RPRBMP(RP+0) REQBUF ADDRESS - MAIN PART F5000089 EQU RPPFP1(RP+1) REQUEST PARAMETER ADDRESS - FIRST + 1 F5000090 EQU RPPFP2(RP+2) REQUEST PARAMETER ADDRESS - FIRST + 2 F5000091 EQU RPPFP3(RP+3) REQUEST PARAMETER ADDRESS - FIRST + 3 F5000092 EQU RPPFP4(RP+4) REQUEST PARAMETER ADDRESS - FIRST + 4 F5000093 SPC 1 F5000094* MAIN MONITOR REQUEST F5000095 EQU RPMREQ(MR+0) MONITOR REQUEST CODE WORD F5000096 EQU RPMRP1(MR+1) COMPLETION ADDRESS F5000097 EQU RPMRP2(MR+2) THREAD WORD F5000098 EQU RPMRP3(MR+3) LOGICAL UNIT FOR I/O F5000099 EQU RPMRP4(MR+4) NUMBER OF WORDS F5000100 EQU RPMRP5(MR+5) START CORE ADDRESS F5000101 EQU RPMRP6(MR+6) MASS MEMORY ADDRESS, MSB F5000102ÐÐ EQU RPMRP7(MR+7) MASS MEMORY ADDRESS, LSB F5000103 EQU RPRCPT(MR+8) CONTROL POINT (FOR I/O REQUESTS) F5000104 EQU RPRETN(MR+9) SAVED RETURN ADDRESS F5000105* ALTERNATE COMMON NAMES F5000106 EQU REQBUF(RP+0) USERS FIRST CALL PARAMETER ADDRESS F5000107 EQU RECBUF(RP+1) RECORD BUFFER PARAMETER - FOR PUTS F5000108 EQU ISTAT(RP+4) USERS COMPLETION STATUS PARAMETER ADDRESS F5000109 EJT F5000110* SCRATCH FOR READRC F5000111* F5000112* FIRST 4 WORDS ARE USED AS INTERFACE WITH PROCESSORS F5000113* USING READRC AS A SUBROUTINE F5000114 EQU REDBUF(SS+0) BUFFER FOR READ OF RECORDS F5000115 EQU RELRNM(SS+1) RELATIVE RECORD NUMBER - MSB F5000116 EQU RELRNL(SS+2) RELATIVE RECORD NUMBER - LSB F5000117 EQU NORECS(SS+3) NUMBER OF RECORDS TO BE READ F5000118* F5000119 EJT F5000120RDRECD NOP 0 ENTRY POINT F5000121 STQ* QSAVE F5000122 LDQ- I SAVE REGS F5000123 STQ* ISAVE F5000124 LDA PCTADR F5000125 STA- I REG I CONTAINS THE ADDR OF PCT F5000126 RTJ Q8PREP F5000127ÐÐ ADC (RDRECD-*) F5000128 RTJ Q8PKUP F5000129 STA- REDBUF,I ADDRESS OF BUFFER TO STORE RECORD F5000130 LDA RRDATA GET RRN FROM COMMON F5000131 STA- RELRNM,I SAVE IN PCT FOR READRC F5000132 ENQ 1 F5000133 LDA RRDATA,Q F5000134 STA- RELRNL,I F5000135* F5000136 ENA 1 NO. OF RECORDS TO RETRIEVE IS ONE F5000137 STA- NORECS,I F5000138* F5000139 RTJ READRC F5000140 LDQ- ISTAT,I GET STATUS SET BY READRC F5000141 LDA- (ZERO),Q F5000142 ADD REQSTA ADD TO LOCAL STATUS F5000143 STA REQSTA ALL BITS ARE UNIQUELY SET BY THE TWO PROCESSORF5000144* (READRC AND INDEXED FILE PROCESSOR) F5000145 LDQ* ISAVE F5000146 STQ- I F5000147 LDQ* QSAVE RESTORE REGS F5000148 JMP* (RDRECD) F5000149QSAVE NUM 0 F5000150ISAVE NUM 0 F5000151 END F5000152ÐÐ NAM FWARCD F51 A ITOS CCS 3.0 SL-149F5100001* COMPUTE THE FWA OF A RECORD WITHIN A BUFFER F5100002* CREDIT COLLECTION SYSTEM VERSION 3.0 F5100003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F5100004* COPYRIGHT CONTROL DATA CORPORATION 1979 F5100005* F5100006* F5100007**** F5100008* THIS IS THE FORTRAN INTERFACE FOR COMPUTING THE FWA OF F5100009* A RECORD WITHIN AN BUFFER F5100010* F5100011* F5100012* WHEN MORE THAN ONE RECORD IS TO BE STORED IN A BUFFER, F5100013* THE PROGRAM NEEDS TO KNOW WHERE DOES EACH RECORD RESIDE F5100014* WITHIN THE BUFFER. THIS INTEGER FUNCTION WILL RETURN F5100015* THE FWA WITHIN THE BUFFER FOR THE NTH RECORD OF THAT F5100016* FILE. N STARTS FROM ZERO. F5100017* F5100018* CALLING SEQUENCE F5100019* I = FWARCD (RECCNT) F5100020* WHERE RECCNT IS THE RECORD COUNT WHICH STARTS F5100021* FROM ZERO F5100022* F5100023* F5100024* INPUT: F5100025ÐÐ* RECORD COUNT (PARAMETER) F5100026* ADDR OF PCT (IN COMMON - PCTADR) F5100027* F5100028* F5100029* PROCESS: F5100030* SAVE REGS Q AND I F5100031* PICK UP THE RECORD COUNT FROM PARAMETER, SAVE IN RA F5100032* LOAD REG I WITH THE PCT ADDR F5100033* F5100034* RETURN JUMP TO FM SUBROUTINE - CLFRIO WHICH RETURNS F5100035* THE NUMBER OF WORDS REQUIRED FOR N RECORDS (N IS F5100036* VALUE IN REG A) F5100037* F5100038* INCREMENT REG A BY ONE TO GET THE DESIRED ANSWER F5100039* RESTORE REGS Q AND I F5100040* LEAVE WITH ANSWER IN REG A F5100041* F5100042* F5100043* ENTRY POINT F5100044* F5100045 ENT FWARCD F5100046 SPC 1 F5100047* F5100048* EXTERNALS F5100049* F5100050ÐÐ EXT Q8PREP PREPARE TO PICK UP PARAMETER F5100051 EXT Q8PKUP PICK UP ABSOLUTIZED PARAMETER F5100052 EXT CLFRIO COMPUTE NO. OF WORDS FOR RECORD(S) F5100053* F5100054* F5100055* COMMON F5100056* F5100057 SPC 1 F5100058 COM PCTADR F5100059**** F5100060* F5100061* EQUIVALENCE F5100062* F5100063 EJT 0 F5100064 EQU ZERO(2) F5100065FWARCD NOP 0 F5100066 STQ* QSAVE SAVE REGS F5100067 LDQ- I F5100068 STQ* ISAVE F5100069 RTJ Q8PREP F5100070 ADC (FWARCD-*) F5100071 RTJ Q8PKUP RA HAS ADDR OF RECCNT F5100072 TRA Q F5100073 LDA- (ZERO),Q RA HAS RECCNT F5100074 LDQ PCTADR I REG CONTAINS PC TABLE ADDR F5100075ÐÐ STQ- I F5100076 RTJ CLFRIO RESULT IN RA F5100077* RA HAS THE LENGTH FOR RECCNT-1 RECORDS F5100078 INA 1 FWA FOR RECCNT IS RA + 1 F5100079 LDQ* ISAVE RESTORE REGS F5100080 STQ- I F5100081 LDQ* QSAVE F5100082 JMP* (FWARCD) F5100083QSAVE NUM 0 F5100084ISAVE NUM 0 F5100085 END F5100086 NAM WRTDEL F52 A ITOS CCS 3.0 SL-149F5200001* FORTRAN INTERFACE TO MARK A RECORD AS DELETED F5200002* CREDIT COLLECTION SYSTEM VERSION 3.0 F5200003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F5200004* COPYRIGHT CONTROL DATA CORPORATION 1979 F5200005* F5200006* F5200007**** F5200008* THE DELETE RECORD FROM AN INDEXED FILE PROCESSOR USES F5200009* THE FILE MANAGER MAIN MEMORY RESIDENT SUBROUTINE - F5200010* MRECAD TO MARK A RECORD AS DELETED ON MASS MEMORY. F5200011* F5200012* THIS IS THE INTERFACE TO MRECAD. F5200013* THE RECORD'S RELATIVE RECORD NUMBER, ITS BUFFER ADDR F5200014ÐÐ* IS ALREADY IN THE REQUEST BUFFER WHERE MRECAD CAN F5200015* GET TO. F5200016* F5200017* CALLING SEQUENCE F5200018* CALL WRTDEL F5200019* F5200020* F5200021* INPUT: F5200022* PCT ADDR (IN COMMON) F5200023* F5200024* F5200025* PROCESS: F5200026* SAVE REGS Q AND I F5200027* LOAD REG I WITH THE PCT ADDR F5200028* F5200029* RETURN JUMP TO MRECAD F5200030* ADD STATUS BITS RETURNED (IF ANY) TO LOCAL STATUS F5200031* IN COMMON (REQSTA) F5200032* F5200033* RESTORE REGS Q AND I F5200034* LEAVE F5200035* F5200036* F5200037* OUTPUT: F5200038* DELETED CODE WRITTEN ON MASS MEMORY F5200039ÐÐ* STATUS (REQSTA) F5200040* F5200041* F5200042* ENTRY POINT F5200043* F5200044 SPC 5 F5200045 ENT WRTDEL F5200046* F5200047* F5200048* EXTERNAL F5200049* F5200050 EXT MRECAD MARK RECORD AS DELETED ROUTINE F5200051* F5200052* F5200053* COMMON F5200054* F5200055 COM PCTADR F5200056 COM DUM(695) F5200057 COM REQSTA F5200058**** F5200059* F5200060* F5200061* EQUIVALENCE F5200062* F5200063* COMMUNICATION REGION CONSTANTS F5200064ÐÐ EQU ZERO(2) CONSTANT F5200065 EQU ONEMSK(3) ONE MASK TABLE F5200066 EQU ONEBIT($23) ONE BIT TABLE F5200067 EJT 0 F5200068* REQUEST PROCESSOR CONTROL TABLE F5200069* F5200070 EQU RP(10) INDEX TO START OF REQUEST PARAMETERS F5200071 EQU MR(RP+5) INDEX TO START OF MONITOR REQUEST PARAM LIST F5200072 EQU SS(MR+10) INDEX TO START OF SCRATCH PORTION OF PAR LIST F5200073* F5200074 EQU RPLOGU(1) LU NUMBER OF MM DEVICE F5200075 EQU RPAREQ(2) ACTIVE REQUEST FLAG (IF 0, NONE FOR TABLE) F5200076 EQU RPWAIT(3) START OF WAITING REQUEST QUEUE (IF 0, NO WAITGF5200077 EQU RPRLEV(4) REQUEST PRIORITY LEVEL - ACTIVE REQUEST F5200078 EQU RPRBF4(5) REQBUF ADDRESS - FIRST FOUR WORDS F5200079 EQU RPLTEA(6) LOCK TABLE ENTRY (ABSOLUTE) ADDRESS F5200080 EQU RPRTNJ(7) RETURN JUMP TO REQUEST PROCESSOR F5200081 EQU RPPADR(8) PROCESSOR ADDRESS F5200082 SPC 1 F5200083* PARAMETER LIST FOR REQUEST PROCESSOR F5200084 EQU RPFCBA(9) FCB ADDRESS FOR FILE F5200085 EQU RPRBMP(RP+0) REQBUF ADDRESS - MAIN PART F5200086 EQU RPPFP1(RP+1) REQUEST PARAMETER ADDRESS - FIRST + 1 F5200087 EQU RPPFP2(RP+2) REQUEST PARAMETER ADDRESS - FIRST + 2 F5200088 EQU RPPFP3(RP+3) REQUEST PARAMETER ADDRESS - FIRST + 3 F5200089ÐÐ EQU RPPFP4(RP+4) REQUEST PARAMETER ADDRESS - FIRST + 4 F5200090 SPC 1 F5200091* MAIN MONITOR REQUEST F5200092 EQU RPMREQ(MR+0) MONITOR REQUEST CODE WORD F5200093 EQU RPMRP1(MR+1) COMPLETION ADDRESS F5200094 EQU RPMRP2(MR+2) THREAD WORD F5200095 EQU RPMRP3(MR+3) LOGICAL UNIT FOR I/O F5200096 EQU RPMRP4(MR+4) NUMBER OF WORDS F5200097 EQU RPMRP5(MR+5) START CORE ADDRESS F5200098 EQU RPMRP6(MR+6) MASS MEMORY ADDRESS, MSB F5200099 EQU RPMRP7(MR+7) MASS MEMORY ADDRESS, LSB F5200100 EQU RPRCPT(MR+8) CONTROL POINT (FOR I/O REQUESTS) F5200101 EQU RPRETN(MR+9) SAVED RETURN ADDRESS F5200102* ALTERNATE COMMON NAMES F5200103 EQU REQBUF(RP+0) USERS FIRST CALL PARAMETER ADDRESS F5200104 EQU RECBUF(RP+1) RECORD BUFFER PARAMETER - FOR PUTS F5200105 EQU ISTAT(RP+4) USERS COMPLETION STATUS PARAMETER ADDRESS F5200106 EQU NORECS(RP+2) NUMBER OF RECORDS PARAMETER - FOR PUTS F5200107 EJT F5200108WRTDEL NOP 0 ENTRY POINT F5200109 STQ* QSAVE SAVE REG Q F5200110 LDQ- I F5200111 STQ* ISAVE SAVE REG I F5200112* F5200113 LDQ PCTADR F5200114ÐÐ STQ- I F5200115 RTJ MRECAD F5200116 LDQ- ISTAT,I F5200117 LDA- (ZERO),Q STATUS SET BY MRECAD F5200118 SAP WRT20 ADD LOCAL REQUEST (REQSTA) TO ISTAT F5200119 AND- ONEMSK+14 EXCEPT THE ERROR BIT, ALL OTHER BIT ARE UNIQUEF5200120 ADD REQSTA ISTAT HAS ERROR BIT SET, PRESERVE IT F5200121 SAN WRT10 F5200122 ADD- ONEBIT+15 F5200123WRT10 JMP* WRT30 F5200124* F5200125WRT20 ADD REQSTA F5200126WRT30 STA REQSTA F5200127 LDQ* ISAVE RESTORE REGS F5200128 STQ- I F5200129 LDQ* QSAVE F5200130 JMP* (WRTDEL) F5200131QSAVE NUM 0 F5200132ISAVE NUM 0 F5200133 END F5200134 NAM COMREC F53 A ITOS CCS 3.0 SL-149F5300001* FORTRAN INTERFACE TO COMPRESS RECORD(S) IN DATA AREA F5300002* CREDIT COLLECTION SYSTEM VERSION 3.0 F5300003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F5300004* COPYRIGHT CONTROL DATA CORPORATION 1979 F5300005ÐÐ* F5300006* F5300007**** F5300008* THE COMPRESS INDEXED FILE PROCESSOR USES THE MAIN MEMORY F5300009* RESIDENT SUBROUTINE COMSEQ TO COMPRESS RECORDS ON MASS F5300010* MEMORY. THIS IS THE FORTRAN INTERFACE TO COMSEQ. F5300011* F5300012* ONLY ONE RECORD CAN BE COMPRESSED PER CALL FOR AN INDEXED F5300013* FILE. F5300014* F5300015* CALLING SEQUENCE F5300016* CALL COMREC F5300017* F5300018* F5300019* INPUT: F5300020* PCT ADDR (IN COMMON - PCTADR) F5300021* F5300022* F5300023* PROCESS: F5300024* SAVE REGS Q AND I F5300025* LOAD REG I WITH THE PCT ADDR F5300026* F5300027* RETURN JUMP TO MAIN MEMORY RESIDENT SUBROUTINE COMSEQ. F5300028* COMSEQ HAS ALL INFO NEEDED FOR THE COMPRESSION IN F5300029* THE REQUEST BUFFER. F5300030ÐÐ* F5300031* SAVE THE STATUS RETURNED BY COMSEQ IN COMMON (REQSTA) F5300032* RESTORE REGS Q AND I F5300033* LEAVE F5300034* F5300035* F5300036* OUTPUT: F5300037* THE NUMBER OF RECORDS COMPRESSED(IN REQUEST BUFFER) =1 F5300038* THE RELATIVE RECORD NO. OF THE COMPRESSED RECORD F5300039* (IN REQUEST BUFFER) F5300040* STATUS OF THE I/O (REQSTA) F5300041* F5300042* F5300043* ENTRY POINT F5300044* F5300045 ENT COMREC F5300046* F5300047* EXTERNAL F5300048* F5300049 EXT COMSEQ COMPRESS RECORD ON MASS MEMORY F5300050 SPC 5 F5300051* F5300052* F5300053* COMMON F5300054* F5300055ÐÐ**** F5300056 COM PCTADR F5300057 COM DUM(695) F5300058 COM REQSTA F5300059 SPC 5 F5300060* COMMUNICATION REGION CONSTANT F5300061 SPC 2 F5300062 EQU ZERO(2) CONSTANT F5300063 SPC 5 F5300064* REQUEST PROCESSOR CONTROL TABLE F5300065* F5300066 EQU RP(10) INDEX TO START OF REQUEST PARAMETERS F5300067 EQU MR(RP+5) INDEX TO START OF MONITOR REQUEST PARAM LIST F5300068 EQU SS(MR+10) INDEX TO START OF SCRATCH PORTION OF PAR LIST F5300069* F5300070 EQU RPLOGU(1) LU NUMBER OF MM DEVICE F5300071 EQU RPAREQ(2) ACTIVE REQUEST FLAG (IF 0, NONE FOR TABLE) F5300072 EQU RPWAIT(3) START OF WAITING REQUEST QUEUE (IF 0, NO WAITGF5300073 EQU RPRLEV(4) REQUEST PRIORITY LEVEL - ACTIVE REQUEST F5300074 EQU RPRBF4(5) REQBUF ADDRESS - FIRST FOUR WORDS F5300075 EQU RPLTEA(6) LOCK TABLE ENTRY (ABSOLUTE) ADDRESS F5300076 EQU RPRTNJ(7) RETURN JUMP TO REQUEST PROCESSOR F5300077 EQU RPPADR(8) PROCESSOR ADDRESS F5300078 SPC 1 F5300079* PARAMETER LIST FOR REQUEST PROCESSOR F5300080ÐÐ EQU RPFCBA(9) FCB ADDRESS FOR FILE F5300081 EQU RPRBMP(RP+0) REQBUF ADDRESS - MAIN PART F5300082 EQU RPPFP1(RP+1) REQUEST PARAMETER ADDRESS - FIRST + 1 F5300083 EQU RPPFP2(RP+2) REQUEST PARAMETER ADDRESS - FIRST + 2 F5300084 EQU RPPFP3(RP+3) REQUEST PARAMETER ADDRESS - FIRST + 3 F5300085 EQU RPPFP4(RP+4) REQUEST PARAMETER ADDRESS - FIRST + 4 F5300086 SPC 1 F5300087* MAIN MONITOR REQUEST F5300088 EQU RPMREQ(MR+0) MONITOR REQUEST CODE WORD F5300089 EQU RPMRP1(MR+1) COMPLETION ADDRESS F5300090 EQU RPMRP2(MR+2) THREAD WORD F5300091 EQU RPMRP3(MR+3) LOGICAL UNIT FOR I/O F5300092 EQU RPMRP4(MR+4) NUMBER OF WORDS F5300093 EQU RPMRP5(MR+5) START CORE ADDRESS F5300094 EQU RPMRP6(MR+6) MASS MEMORY ADDRESS, MSB F5300095 EQU RPMRP7(MR+7) MASS MEMORY ADDRESS, LSB F5300096 EQU RPRCPT(MR+8) CONTROL POINT (FOR I/O REQUESTS) F5300097 EQU RPRETN(MR+9) SAVED RETURN ADDRESS F5300098* ALTERNATE COMMON NAMES F5300099 EQU REQBUF(RP+0) USERS FIRST CALL PARAMETER ADDRESS F5300100 EQU RECBUF(RP+1) RECORD BUFFER PARAMETER F5300101 EQU ISTAT(RP+4) USERS COMPLETION STATUS PARAMETER ADDRESS F5300102 EJT 0 F5300103COMREC NOP 0 ENTRY POINT F5300104 STQ* QSAVE F5300105ÐÐ LDQ- I SAVE REGS F5300106 STQ* ISAVE F5300107 LDA PCTADR F5300108 STA- I F5300109 RTJ COMSEQ F5300110 LDQ- ISTAT,I F5300111 LDQ- (ZERO),Q F5300112 STQ REQSTA F5300113 LDQ* ISAVE F5300114 STQ- I RESTORE REGS F5300115 LDQ* QSAVE F5300116 JMP* (COMREC) F5300117 SPC 3 F5300118QSAVE NUM 0 F5300119ISAVE NUM 0 F5300120 END F5300121 NAM VOLUSE F54 A ITOS CCS 3.0 SL-149F5400001* FILE MANAGER ENABLE/DISABLE VOLUME USE PROCESSOR F5400002* CREDIT COLLECTION SYSTEM VERSION 3.0 F5400003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F5400004* COPYRIGHT CONTROL DATA CORPORATION 1979 F5400005* F5400006 SPC 3 F5400007**** 121*4729F5400008* VOLUSE IS THE PROCESSOR FOR LOGICALLY MOUNTING AND DISMOUNTING F5400009ÐÐ* A VOLUME. THE CALLING SEQUENCE IS F5400010* F5400011* CALL VOLUSE (REQBUF, VOLNAM, VOLUNT, ISTAT) F5400012* F5400013* WHERE REQBUF IS THE REQUEST BUFFER F5400014* F5400015* VOLNAM IS THE ASCII VOLUME NAME FOR MOUNTING A F5400016* VOLUME F5400017* OR BINARY ZERO IN FIRST WORD FOR DISMOUNTING F5400018* A VOLUME F5400019* F5400020* VOLUNT IS THE 'SYSTEM' MASS MEMORY UNIT NO. OF THE F5400021* DRIVE CONTAINING THE VOLUME (NON-ZERO F5400022* POSITIVE INTEGER) F5400023* F5400024* ISTAT IS THE RETURN STATUS F5400025* F5400026* 121*4729F5400027* WHEN A VOLUME IS MOUNTED, IT MUST BE LOGICALLY MOUNTED 121*4729F5400028* BEFORE THE FILE MANAGER CAN USE IT TO STORE AND RETRIEVE 121*4729F5400029* RECORDS. MOUNTING VERIFIES THAT THE VOLUME NAME ON THE 121*4729F5400030* LABEL ON MASS MEMORY IS THE SAME AS THE ONE IN THE VIT 121*4729F5400031* (VOLUME INFO TABLE) IN THE SYSTEM. 121*4729F5400032* 121*4729F5400033* IF SO, MOVE INFO FROM THE LABEL TO THE VIT. AND THE 121*4729F5400034ÐÐ* VOLUME IS LOGICALLY MOUNTED. 121*4729F5400035* 121*4729F5400036* BEFORE A VOLUME BEING USED BY THE FILE MANAGER IS TO BE 121*4729F5400037* REMOVED PHYSICALLY, IT SHOULD BE LOGICALLY DISMOUNTED. 121*4729F5400038* 121*4729F5400039* VOLUSE SETS THE DISMOUNT BIT IN THE VIT FOR THE VOLUME.121*4729F5400040* EXECUTES THE ORDINAL DISMNT. DISMNT DOES A FORCE FILE 121*4729F5400041* CLOSE WHICH CLOSES ALL EXISTING OPENED FILES 121*4729F5400042* AND CLEANS UP 121*4729F5400043* 121*4729F5400044* F5400045* VOLUSE IS BROUGHT IN BY THE FMEXEC, WHICH SETS THE FIRST WORD F5400046* IN COMMON WITH THE PCT ADDRESS. UPON COMPLETING THE REQUEST, F5400047* VOLUSE RETURNS TO THE EXEC BY JUMPING TO FMCOMP F5400048 SPC 5 F5400049 ENT VOLUSE ENTRY POINT F5400050 SPC 2 F5400051* EXTERNALS F5400052 EXT CMPSTG COMPARE TWO STRINGS F5400053 EXT FMCOMP FMEXEC COMPLETE REQUEST ADDRESS F5400054 EXT CPSET SET CONTROL POINT F5400055* F5400056 EXT MMLUTB MASS MEMORY LOGICAL UNIT TABLE F5400057 EXT DISMNT DISMOUNT VOLUME SYSTEM ORDINAL F5400058 SPC 5 F5400059ÐÐ* F5400060* COMMON AREA F5400061* F5400062 COM PCTABL F5400063 COM FCBADR F5400064 COM VITBUF BUFFER TO SAVE LABEL FROM SECTOR ZERO F5400065 SPC 2 F5400066 EQU FMLEVL(9) PRIORITY LEVEL OF FILE MANAGER F5400067**** 121*4729F5400068 EQU VILBLM(21) VOLUME LABEL SECTOR - MSB 121*4729F5400069 EQU VILBLL(22) VOLUME LABEL SECTOR - LSB 121*4729F5400070 SPC 2 F5400071 SPC 3 F5400072* COMMUNICATION REGION CONSTANTS F5400073 EQU ZERO(2) CONSTANT F5400074 EQU ONEMSK(3) ONE MASK TABLE F5400075 EQU ONEBIT($23) ONE BIT TABLE F5400076 EQU AMONI($F4) REQUEST MONITOR ENTRY ADDRESS F5400077 EQU ADISP($EA) ADDRESS OF DISPATCHER F5400078* F5400079* MISCELLANEOUS F5400080 EQU DMTLEV(4) DISMOUNT ORDINAL PRIORITY LEVEL F5400081 EJT F5400082* VOLUME INFORMATION TABLE F5400083* F5400084ÐÐ EQU VISLUN(2) SYSTEM LOGICAL UNIT NUMBER (BIT 15=1,NOT READYF5400085* ACCESS VISLUN INDIRECTLY F5400086 EQU VINAME(1) VOLUME NAME - ASCII CHARACTERS 1 AND 2 F5400087* VOLUME NAME - ASCII CHARACTERS 3 AND 4 F5400088* VOLUME NAME - ASCII CHARACTERS 5 AND 6 F5400089* VOLUME NAME - ASCII CHARACTERS 7 AND 8 F5400090 EQU VINMBR(5) VOLUME NUMBER - (2 ASCII CHARACTERS) F5400091 EQU VIBMSM(6) BEGINNING OF MANAGEABLE SPACE - MSB F5400092 EQU VIBMSL(7) BEGINNING OF MANAGEABLE SPACE - LSB F5400093 EQU VIASDM(8) AVAILABLE SPACE DIRECTORY ADDRESS - MSB F5400094 EQU VIASDL(9) AVAILABLE SPACE DIRECTORY ADDRESS - LSB F5400095 EQU VIASDS(10) # SECTORS IN AVAILABLE SPACE DIRECTORY F5400096 EQU VILBAM(11) LARGEST BLOCK OF SPACE AVAILABLE - MSB F5400097 EQU VILBAL(12) LARGEST BLOCK OF SPACE AVAILABLE - LSB F5400098 EQU VIWPS(13) WORDS/SECTOR FOR VOLUME F5400099 EQU VIFDDM(14) FILE DEFINITION DIRECTORY ADDRESS - MSB F5400100 EQU VIFDDL(15) FILE DEFINITION DIRECTORY ADDRESS - LSB F5400101 EQU VIMAXF(16) MAX. NUMBER OF FILES PERMITTED ON VOLUME F5400102 EQU VICURF(17) CURRENT NUMBER OF FILES EXISTING ON VOLUME F5400103 EQU VINFDB(18) NUMBER OF BLOCKS IN FILE DEFINITION DIRECTORY F5400104 EQU VINXTB(19) NEXT AVAILABLE BLOCK IF FILE DEF. DIRECTORY F5400105 EQU VINOOF(20) NUMBER OF OPEN FILES ON VOLUME F5400106 EJT 0 F5400107* F5400108* LABEL INFORMATION ON MASS MEMORY F5400109ÐÐ* F5400110* F5400111* F5400112 EQU VLIFLG(0) VOLUME INITIALIZED FLAG F5400113 EQU VLNAME(2) VOLUME NAME F5400114 EQU VLNMBR(6) VOLUME NUMBER F5400115 EQU VLSER(7) VOLUME SERIAL F5400116 EQU VLSEC(12) VOLUME SECURITY CODE F5400117 EQU VLDATE(16) VOLUME CREATE DATE F5400118 EQU VLBMSM(20) BEGINNING OF MANAGEABLE SPACE (MSB) F5400119 EQU VLBMSL(21) BEGINNING OF MANAGEABLE SPACE (LSB) F5400120 EQU VLASDM(22) ALLOCATABLE SPACE DIRECTORY SECTOR (MSB) F5400121 EQU VLASDL(23) ALLOCATABLE SPACE DIRECTORY SECTOR (LSB) F5400122 EQU VLASDS(24) SIZE OF ALLOCATABLE SPACE DIRECTORY F5400123 EQU VLLBA(25) LARGEST BLOCK AVAILABLE(MSB) F5400124 EQU VLWPS(27) # WORDS/SECTOR F5400125 EQU VLFDD(28) ADDRESS OF FILE DIRECTORY F5400126 EQU VLMAXF(30) MAXIMUM NUMBER OF FILES F5400127 EQU VLCURF(31) CURRENT NUMBER OF FILES F5400128 EQU VLNFDB(32) NUMBER OF BLOCKS IN FILE DIRECTORY F5400129 EQU VLNXTB(33) NEXT AVAILABLE FILE DIRECTORY BLOCK F5400130 EJT F5400131* REQUEST PROCESSOR CONTROL TABLE F5400132* F5400133 EQU RP(10) INDEX TO START OF REQUEST PARAMETERS F5400134ÐÐ EQU MR(RP+5) INDEX TO START OF MONITOR REQUEST PARAM LIST F5400135 EQU SS(MR+10) INDEX TO START OF SCRATCH PORTION OF PAR LIST F5400136* F5400137 EQU RPLOGU(1) LU NUMBER OF MM DEVICE F5400138 EQU RPAREQ(2) ACTIVE REQUEST FLAG (IF 0, NONE FOR TABLE) F5400139 EQU RPWAIT(3) START OF WAITING REQUEST QUEUE (IF 0, NO WAITGF5400140 EQU RPRLEV(4) REQUEST PRIORITY LEVEL - ACTIVE REQUEST F5400141 EQU RPRBF4(5) REQBUF ADDRESS - FIRST FOUR WORDS F5400142 EQU RPLTEA(6) LOCK TABLE ENTRY (ABSOLUTE) ADDRESS F5400143 EQU RPRTNJ(7) RETURN JUMP TO REQUEST PROCESSOR F5400144 EQU RPPADR(8) PROCESSOR ADDRESS F5400145 SPC 1 F5400146* PARAMETER LIST FOR REQUEST PROCESSOR F5400147 EQU RPFCBA(9) FCB ADDRESS FOR FILE F5400148 EQU RPRBMP(RP+0) REQBUF ADDRESS - MAIN PART F5400149 EQU RPPFP1(RP+1) REQUEST PARAMETER ADDRESS - FIRST + 1 F5400150 EQU RPPFP2(RP+2) REQUEST PARAMETER ADDRESS - FIRST + 2 F5400151 EQU RPPFP3(RP+3) REQUEST PARAMETER ADDRESS - FIRST + 3 F5400152 EQU RPPFP4(RP+4) REQUEST PARAMETER ADDRESS - FIRST + 4 F5400153 SPC 1 F5400154* MAIN MONITOR REQUEST F5400155 EQU RPMREQ(MR+0) MONITOR REQUEST CODE WORD F5400156 EQU RPMRP1(MR+1) COMPLETION ADDRESS F5400157 EQU RPMRP2(MR+2) THREAD WORD F5400158 EQU RPMRP3(MR+3) LOGICAL UNIT FOR I/O F5400159ÐÐ EQU RPMRP4(MR+4) NUMBER OF WORDS F5400160 EQU RPMRP5(MR+5) START CORE ADDRESS F5400161 EQU RPMRP6(MR+6) MASS MEMORY ADDRESS, MSB F5400162 EQU RPMRP7(MR+7) MASS MEMORY ADDRESS, LSB F5400163 EQU RPRCPT(MR+8) CONTROL POINT (FOR I/O REQUESTS) F5400164 EQU RPRETN(MR+9) SAVED RETURN ADDRESS F5400165* F5400166 EQU REQBUF(RP+0) USERS FIRST CALL PARAMETER ADDRESS F5400167 EQU VOLNAM(RP+1) VOLUME NAME F5400168 EQU VOLUNT(RP+2) SYSTEM LOGICAL UNIT NO. FOR FM VOLUME F5400169 EQU ISTAT(RP+4) USERS COMPLETION STATUS PARAMETER ADDRESS F5400170 SPC 3 F5400171* SCRATCH FOR MM TO PARAMETER LIST F5400172 EQU MSBBSA(SS+0) BASE SECTOR ADDR, MSB F5400173 EQU LSBBSA(SS+1) BASE SECTOR ADDR, LSB (0) F5400174 EQU MSBRRN(SS+2) RRN - MSB F5400175 EQU LSBRRN(SS+3) RRN - LSB (1) F5400176 EQU VITLEN(SS+4) LENGTH OF A VIT F5400177 EQU NUMWRD(SS+5) NO. OF WORDS TO READ F5400178 EQU OFFSET(SS+6) OFFSET INTO RRN - 0 F5400179 EQU VITADR(SS+7) ADDR OF VIT IN MAIN MEMORY F5400180 EQU IOTYPE(SS+8) IO TYPE - 0 F5400181 EJT 0 F5400182VOLUSE NOP 0 F5400183* RI = PCT ADDRESS F5400184ÐÐ LDQ- VOLUNT,I CHECK VOLUME UNIT PARAMETER FOR VALIDITY F5400185 LDA- (ZERO),Q ASSURE IT IS NON-ZERO POSITIVE F5400186 SAM VOL05 F5400187 SAZ VOL05 F5400188 STA- RPLOGU,I STORE IN PCT FOR MM I/O F5400189 TCA A F5400190 ADD MMLUTB ASSURE LU IS IN RANGE F5400191 SAP VOL10 SKIP IF IN RANGE F5400192* F5400193VOL05 LDA =N$C000 VOLUME UNIT PARAMETER IS OUT OF RANGE F5400194 JMP* VOL90 F5400195* F5400196VOL10 LDQ- VOLNAM,I F5400197 LDA- (ZERO),Q FIRST WORD OF VOLUME NAME F5400198 SAN VOL20 SKIP IF VOLUME NAME DEFINED F5400199 JMP* VOL100 F5400200 SPC 5 F5400201* NONZERO MOUNT PROCESSOR F5400202VOL20 LDQ- VOLUNT,I GET ADDRESS OF PARAMETER F5400203 LDQ- (ZERO),Q VALUE OF SYSTEM LU FROM PARAMETER F5400204 LDQ MMLUTB,Q ABSOLUTE ADDR OF VIT F5400205 STQ* VITABS SAVE VIT ABSOLUTE ADDRESS F5400206 LDA- (VISLUN),Q VISLUN FROM VIT F5400207 SAM VOL30 F5400208* F5400209ÐÐ LDA =N$A000 VOLUME ALREADY MOUNTED F5400210 JMP* VOL90 F5400211* F5400212* SET UP PARAMETER LIST FOR READING LABEL FROM F5400213* VOLUME. F5400214VOL30 AND- ONEMSK+14 EXTRACT LU AND STORE IN PARAMETER LIST FOR I/OF5400215 STA- RPMRP3,I F5400216 CLR A F5400217 STA- VINOOF,Q ASSURE NO. OF OPEN FILES WORD IS 0 F5400218 LDA- VILBLM,Q SET MSB WORD OF MM ADDRESS 121*4729F5400219 EOR- ONEBIT+15 (SET BIT 15) 121*4729F5400220 STA- RPMRP6,I 121*4729F5400221 LDA- VILBLL,Q SET LSB WORD 121*4729F5400222 STA- RPMRP7,I 121*4729F5400223 ENA 96 SET NUMBER OF WORDS TO 96 F5400224 STA- RPMRP4,I F5400225 EJT F5400226 LDA =XCOMPL SET COMPLETION ADDRESS F5400227 STA- RPMRP1,I F5400228 LDA* REDCOD F5400229 STA- RPMREQ,I SET THE REQUEST CODE WORD F5400230 LDA =XVITBUF SET THE READ BUFFER ADDRESS F5400231 STA- RPMRP5,I F5400232 LDA- I GET THE ABS ADDRESS OF THE REQUEST AND STORE F5400233 INA RPMREQ FOR USE IN AN INDIRECT REQUEST F5400234ÐÐ STA* ADDR F5400235 RTJ- (AMONI) EXECUTE INDIRECT MONITOR REQUEST F5400236 NUM $2000 F5400237ADDR NUM 0 F5400238 JMP- (ADISP) F5400239 SPC 2 F5400240* D A T A A R E A F5400241* F5400242REDCOD ADC $4800+FMLEVL*$10+FMLEVL READ REQUEST CODE F5400243QSAVE NUM 0 SAVED I/O STATUS F5400244VITCOM NUM 0 ADDR OF VIT IN COMMON AREAD (LABEL FROM F5400245* MASS MEMORY) F5400246VITABS NUM 0 ABSOLUTE ADDRESS OF VIT IN MAIN MEMORY F5400247 SPC 2 F5400248COMPL INA -RPMREQ RESET I TO PCT ADDRESS F5400249 STA- I F5400250 STQ* QSAVE SAVE I/O STATUS F5400251 LDQ- RPRCPT,I F5400252 RTJ CPSET SET CONTROL POINT F5400253 LDQ* QSAVE RESTORE I/O STATUS F5400254 SQP VOL40 F5400255 LDA =N$8020 MM TO ERROR F5400256 JMP* VOL90 F5400257 EJT F5400258VOL40 LDQ- RPMRP5,I CHECK IF ASCII NAME IS SAME FROM MM AND F5400259ÐÐ INQ VLNAME F5400260 STQ* VOL50 PARAMETER F5400261 LDA- VOLNAM,I F5400262 STA* VOL60 F5400263 RTJ CMPSTG F5400264VOL50 ADC 0 F5400265VOL60 ADC 0 F5400266 ADC ONEBIT+2 F5400267* F5400268 SAZ VOL70 F5400269 LDA =N$8002 NOT THE SAME F5400270 JMP* VOL90 F5400271* F5400272VOL70 EQU VOL70(*) F5400273* FIX UP VIT IN MAIN MEMORY F5400274 LDQ* VITABS F5400275 LDA- (VISLUN),Q FIRST WORD IN VIT F5400276 AND- ONEMSK+14 CLEAR DISMOUNTED BIT F5400277 STA- (VISLUN),Q F5400278 SPC 2 F5400279* MOVE INFO FROM VOLUMN LABEL (MM) TO MAIN F5400280* MEMORY VIT F5400281 LDQ- RPMRP5,I SAVE ABSOLUTE ADDR IN COMMON AREA, I.E. VOL F5400282 STQ* VITCOM LABEL FROM MASS MEMORY F5400283 ENA 4 MOVE VOL NAME AND NUMBER F5400284ÐÐVOL72 STA- I F5400285 LDQ* VITCOM ADDR FOR VOL LABEL F5400286 LDA- VLNAME,B INFO FROM LABEL F5400287 LDQ* VITABS ABSOLUTE ADDR FOR VIT IN MAIN MEMORY F5400288 STA- VINAME,B F5400289* F5400290 LDA- I F5400291 INA -1 MOVE NEXT ENTRY F5400292 SAM VOL75 ALL DONE F5400293* F5400294 JMP* VOL72 F5400295* F5400296 EJT 0 F5400297VOL75 ENA 13 MOVE REST OF INFO FOR VIT F5400298VOL76 STA- I F5400299 LDQ* VITCOM SAME LOGIC AS PREVIOUS LOOP F5400300 LDA- VLBMSM,B F5400301 LDQ* VITABS F5400302 STA- VIBMSM,B F5400303 LDA- I F5400304 INA -1 F5400305 SAM VOL77 F5400306 JMP* VOL76 F5400307* F5400308VOL77 EQU VOL77(*) F5400309ÐÐ LDA PCTABL F5400310 STA- I F5400311 CLR A NO ERROR IN STATUS WORD F5400312 SPC 5 F5400313* F5400314VOL90 LDQ- ISTAT,I RA CONTAINS STATUS. F5400315 STA- (ZERO),Q F5400316 JMP FMCOMP LEAVE F5400317 EJT 0 F5400318VOL100 EQU VOL100(*) DISMOUNT VOLUME PROCESSOR F5400319 LDQ- VOLUNT,I (VOL NAME(1) = 0) F5400320 LDQ- (ZERO),Q GET UNIT NUMBER F5400321 LDQ MMLUTB,Q GET VIT ADDRESS F5400322 LDA- (VISLUN),Q SET MISMOUNT BIT F5400323 AND- ONEMSK+14 F5400324 EOR- ONEBIT+15 F5400325 STA- (VISLUN),Q F5400326* F5400327 LDA* ORDADR CHECK IF DISMNT ORDINAL IS IN THE SYSTEM F5400328 EOR- ONEMSK+14 F5400329 SAZ VOL110 SKIP IF NO F5400330* F5400331 LDQ- VOLUNT,I F5400332 LDQ- (ZERO),Q VOLUME UNIT NUMBER F5400333 ADQ- ONEBIT+15 ADD BIT 15 SO MSG WILL NOT BE OUTPUT F5400334ÐÐ* BY DISMNT F5400335* F5400336 RTJ- (AMONI) SCHEDULE THE DISMOUNT ORDINAL, PASS VOLUME F5400337 ADC $2400+DMTLEV NUMBER VIA THE Q REGISTER F5400338ORDADR ADC DISMNT F5400339* F5400340VOL110 CLR A F5400341 JMP* VOL90 F5400342 END F5400343 NAM CORFCB F55 A ITOS CCS 3.0 SL-149F5500001* PERFORM OPEN FILE RECOVERY PROCESSING AND CORRECT FCB F5500002* CREDIT COLLECTION SYSTEM VERSION 3.0 F5500003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F5500004* COPYRIGHT CONTROL DATA CORPORATION 1979 F5500005* F5500006**** F5500007* F5500008* THIS IS A SECONDARY PROCESSOR FOR OPEN FILE PROCESSOR. F5500009* F5500010* THIS ROUTINE UPDATES A FILE'S FILE CONTROL BLOCK (FCB) TO REFLECT F5500011* THE CURRENT STATE OF THE FILE AFTER THE FCB HAS BEEN FOUND TO BE F5500012* INACCURATE DUE TO A SYSTEM OUTAGE. F5500013* F5500014* THE SPECIFIC DATA UPDATED IS: F5500015* 1) NO. OF EXISTING DATA RECORDS F5500016ÐÐ* 2) NEXT FREE KEY INDEX BLOCK F5500017* F5500018* F5500019* THE FCB ON MASS MEMORY RECORDS THE NO. OF EXISTING RECORDS F5500020* IN THE FILE. IT IS UPATED AFTER FMNRCD (GLOBAL EQU) NEW F5500021* RECORDS HAVE BEEN ADDED TO THE FILE. THIS IS DONE SO AS F5500022* TO SAVE MASS MEMORY TRANSFER. F5500023* F5500024* AN EOF MARKER IS WRITTEN IN THE NEXT RECORD SPACE WHENEVER F5500025* A NEW RECORD IS ADDED TO THE FILE. EXCEPT IF THE NEW F5500026* RECORD IS THE LAST ONE DEFINED FOR THE FILE, NO EOF MARK F5500027* IS WRITTEN. F5500028* F5500029* IF A SYSTEM FAILURE OCCURS, THE FCB ON MASS MEMORY MIGHT F5500030* NOT REFLECT THE ACTUAL NUMBER OF RECORDS IN THE FILE. F5500031* F5500032* WHEN A USER NEXT OPENS A FILE, THE OPEN PROCESSOR WILL F5500033* FIND THAT THE FILE WAS LAST LEFT OPENED (NOT PROPERLY F5500034* CLOSED). IT WILL ATTEMPT TO RECOVER ALL DATA IN THE FILE. F5500035* F5500036* CORFCB IS SWAPPED INTO EXECUTION TO DO THE RECOVERY. F5500037* F5500038* CORFCB (CORRECT FCB) WILL START READING RECORDS FROM MASS F5500039* MEMORY LOOKING FOR THE EOF MARKER. IF ONE IS FOUND, THEN F5500040* THE PREVIOUS RECORD IS THE LAST ONE IN THE FILE. F5500041ÐÐ* CORFCB STARTS READING FROM THE RECORD NUMBER SAVED IN F5500042* THE FCB ON MASS MEMORY. IT ONLY HAS TO READ FMNRCD RECORD F5500043* SPACES. IF THE EOF MARKER CANNOT BE FOUND WITHIN FMNRCD F5500044* RECORDS, THEN THE EOF MARK IS LOST DURING THE SYSTEM F5500045* OUTAGE AND THE FILE IS NON-RECOVERABLE. F5500046* F5500047* F5500048* A SIMILIAR SCHEME IS DESIGNED FOR THE KEY INFO DIRECTORY. F5500049* SO IF AN INDEXED FILE IS TO BE RECOVERED, THEN THE SAME F5500050* PROCEDURE IS DONE TO THE KID AREA ON MASS MEMORY. F5500051* F5500052* F5500053* IF AT THE TIME OF SYSTEM OUTAGE, THE FILE WAS BEING COMPRESS- F5500054* ED, THEN THE SUBROUTINE COMPRS WILL DO THE RECOVERY FROM IT. F5500055* F5500056* CALLING SEQUENCE F5500057* CALL CORFCB F5500058* F5500059* PARAMETERS F5500060* F5500061* REG I = PCT ADDRESS F5500062* F5500063*E F5500064* PROCESS F5500065* CHECK IF RECOVERING FROM A COMPRESSING FILE, I.E., THE SYSTEM F5500066ÐÐ* FAILS WHEN A COMPRESS FILE WAS GOING ON. IF SO, CALL SUB- F5500067* ROUTINE COMPRS TO DO THE RECOVERY. F5500068* F5500069* F5500070* RECOVER THE DATA AREA FIRST. F5500071* GET THE RELATIVE RECORD NUMBER SAVED IN THE FCB. AT LEAST F5500072* THERE ARE THAT MANY RECORDS IN THE FILE. F5500073* F5500074* COMPUTE THE NUMBER OF RECORDS IN A SECTOR OF MASS MEMORY. F5500075* READ IN ONE SECTOR FROM THE DATA AREA STARTING FROM THE F5500076* NEXT RECORD NUMBER SAVED IN THE FCB. IF THE MAX NUMBER OF F5500077* RECORDS DEFINED IN THE FILE IS ALREADY REACHED, THEN THE F5500078* FILE IS FULL. F5500079* F5500080* AFTER ONE SECTOR IS READ IN FROM MASS MEMORY, GO THROUGH F5500081* THE FIRST TWO WORDS OF EACH RECORD SPACE TO LOOK FOR AN F5500082* EOF MARKER. AN EOF MARKER IS TWO WORDS WITH THE SAME F5500083* GLOBAL VALUE - FMEOFC. F5500084* F5500085* IF AN EOF MARKER IS FOUND, THE RECORD BEFORE IS THE LAST F5500086* EXISTING RECORD IN THE FILE. IF NOT FOUND, INCREMENT F5500087* THE RECORD NUMBER BY ONE. CHECK IF HAVE CHECKED FMNRCD F5500088* RECORDS. IF SO, THE EOF MARKER IS LOST, FLAG MASS MEMORY F5500089* ERROR. ALSO CHECK IF THE MAX NO. OF RECORDS ALLOWED FOR F5500090* THE FILE HAS BEEN REACHED. IF SO, THE FILE IS FULL. F5500091ÐÐ* F5500092* CONTINUE CHECKING THE RECORD IF CANNOT REACH A CONCLUSION F5500093* ON THE NO. OF EXISTING RECORDS. F5500094* F5500095* EXIT WHEN FOUND. F5500096* F5500097* F5500098* IF THE FILE IS AN INDEXED FILE, SET UP THE I/O READ TO F5500099* READ FROM THE KEY INFO DIRECTORY AREA ON MASS MEMORY. DO F5500100* THE SAME PROCEDURE AS FOR THE DATA AREA. F5500101* F5500102* F5500103* STORE THE NO. OF EXISTING RECORDS IN THE FILE AND THE NO. F5500104* OF KEY INFO BLOCK USED IN THE FCB. F5500105*E F5500106* EXIT F5500107* F5500108* EXIT F5500109* REQUEST FM EXEC TO SWAP THE PRIMARY PROCESSOR OF OPENFL F5500110* BACK TO EXECUTION F5500111* F5500112* THE FOLLOWING COMMON VARIABLES WILL BE SET UP: F5500113* BUF - INDETERMINABLE F5500114* STATUS - COMPLETION STATUS F5500115* = $8020 IF MASS MEMORY I/O ERROR F5500116ÐÐ* = $C020 IF COMPUTATION ERROR F5500117* F5500118 EJT F5500119* F5500120* ENTRY POINTS F5500121* F5500122 ENT CORFCB F5500123* F5500124* EXTERNALS F5500125* F5500126 EXT COMPRS UPDATE FCB ACCORDING TO COMPRESSION-IN-PROGRESF5500127 EXT DWSUB DOUBLE WORD SUBTRACT ROUTINE F5500128 EXT DWADD DOUBLE WORD ADD ROUTINE F5500129 EXT MMREAD MASS MEMORY READ ROUTINE F5500130 EXT FMBRRN BUMP RRN BY ONE 121*4625F5500131 EXT FMEOFC END-OF-FILE CODE F5500132 EXT FMNRCD NO. OF RECORDS ADDED BEFORE FCB IS UPDATED F5500133* ON MM F5500134 EXT FMCOMP RETURN TO EXEC IF ERROR F5500135 EXT FMSWAP BRING BACK PRIMARY PROCESSOR F5500136* F5500137* COMMON DECLARATIONS F5500138* F5500139 COM PCTABL PROCESSOR CONTROL TABLE ADDRESS F5500140 COM FCBMMA FCB MAIN MEMORY ADDR (SET BY EXECUTIVE) F5500141ÐÐ COM BUF(572) SCRATCH BUFFER F5500142 COM STATUS MODULE COMPLETION STATUS F5500143 COM VIT(21) VOLUME INFORMATION TABLE F5500144 COM FDB(2) FDB OF FILE BLOCK NO. F5500145 COM FDS INDEX INTO FDB TO FILE'S FDS F5500146 COM MMUNIT FILE'S MASS MEMORY UNIT NO. F5500147 COM SIZE WORDS/SECTOR OF VOLUME F5500148 COM FILE PSUEDO FILE ID F5500149 COM INITCM INITIAL OPEN FOR COMPRESSION FLAG F5500150 COM SPARE(104) SPARE COMMON F5500151**** F5500152* F5500153* EQUIVALENCES F5500154* F5500155 EQU ZERO(2) CONSTANT ZERO F5500156 EQU ONEBIT($23) ONEBIT MASK F5500157 EJT F5500158* REQUEST BUFFER INDEXES - FIRST 4 WORDS F5500159 EQU RBATHR(0) REQUEST BUFFER ADDRESS THREAD F5500160 EQU BUFAMP(1) BUFFER ADDRESS MAIN PART F5500161 EQU CNTLPT(2) CONTROL POINT (OR SPARE) F5500162 EQU RQINFO(3) REQUEST INFORMATION (MULTI-FIELD) F5500163* BITS USE F5500164* 15-12 SPARE F5500165* 11-04 REQUEST INDEX F5500166ÐÐ* 03-00 LEVEL OF REQUESTOR F5500167* F5500168* REQUEST BUFFER INDEXES - MAIN PART F5500169 EQU QREG(0) Q REGISTER F5500170 EQU IREG(1) I REGISTER F5500171 EQU PARLST(2) ADDRESS OF PARAMETER LIST F5500172 EQU RTNADR(2) RETURN ADDRESS TO USER (UPON RETURN FROM EXEC)F5500173 EQU UCTADR(3) UCT ENTRY ABSOLUTE ADDRESS F5500174 EQU USERID(4) USER IDENTIFIER F5500175 EQU FCBADR(5) FCB ADDRESS (MAY BE SET BY CALLER OR INTCPTR.)F5500176 EQU RADINT(6) RETURN ADDRESS TO INTERCEPTOR F5500177 EQU RPIDX(7) REQUEST PROCESSOR INDEX F5500178* BITS 14-00 REQUEST PROCESSOR INDEX F5500179* BIT 15 TYPE OF PROCESSOR F5500180* =0, SERIAL PROCESSOR F5500181* =1, REENTRANT PROCESSOR F5500182 EQU LOKREC(8) NUMBER OF RECORDS TO BE READ/WRITTEN PER I/O F5500183* CALL AND LOCK RECORDS ON RETRIEVE FLAG F5500184* BITS 14-00 NUMBER OF RECORDS PER CALL F5500185* BIT 15 =0, DO NOT LOCK ON RETRIEVE F5500186* =1, LOCK RECORDS ON RETRIEVE F5500187 EQU USEFLG(9) TYPE OF FILE USE FLAG F5500188* -1, OPEN FOR COMPRESSION F5500189* -2, OPEN FOR SPECIAL PROCESSING F5500190* 0, OPEN FOR ACESS VIA REL REC NO F5500191ÐÐ* 1, OPEN FOR RETRIEVAL VIA KEY 1 F5500192* 2, OPEN FOR RETRIEVAL VIA KEY 2 F5500193* 3, OPEN FOR RETRIEVAL VIA KEY 3 F5500194* 4, OPEN FOR RETRIEVAL VIA KEY 4 F5500195* F5500196 EJT F5500197* FILE CONTROL BLOCK EQUIVALENCES F5500198 EQU FH(4) LENGTH -1 OF FCB HEADER F5500199 EQU FILEID(ZERO) FILE IDENTIFIER F5500200* ACCESS FILEID INDIRECTLY F5500201* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBERF5500202* BITS 10-00 INDEX OF FCB IN FCB TABLE F5500203 EQU FCBFLG(1) FCB FLAGS F5500204* BITS 15-8, SPARE F5500205* BITS 7-00, NUMBER OF USERS USING FILE F5500206 EQU FILOCK(2) FILE LOCK FLAG (IF NON-0, CONTAINS USER ID) F5500207 EQU NUMSET(3) NUMBER OF SETS OF LOCKED RECORDS IN FILE F5500208 EQU NUMNEW(4) NUMBER OF NEW RECORDS SINCE FCB UPDATED ON MM F5500209 SPC 1 F5500210 EQU RECLEN(FH+1) RECORD LENGTH IN WORDS F5500211 EQU TDATRM(FH+2) TOTAL NUMBER OF DATA RECORDS, MSB F5500212 EQU TDATRL(FH+3) TOTAL NUMBER OF DATA RECORDS, LSB F5500213 EQU DATBAM(FH+4) DATA RECORDS BEGINNING SECTOR ADDRESS, MSB F5500214 EQU DATBAL(FH+5) DATA RECORDS BEGINNING SECTOR ADDRESS,LMSB F5500215 EQU FCBIND(FH+6) FCB INDICATORS F5500216ÐÐ* BIT 15 , SECTOR ALLIGNED RECORDS IF =1 F5500217* BIT 14 , STORAGE MODE FOR INDEXED FILE F5500218* =0, RECORDS STORED RANDOMLY WITHF5500219* RESPECT TO PRIMARY KEY F5500220* =1, RECORDS STORED IN ORDER WIT F5500221* RESPECT TO PRIMARY KEY F5500222* BIT 13 , =1, FILE IS CURRENTLY OPEN F5500223* =0, FILE IS CURRENTLY CLOSED F5500224* BIT 12 , =1, FILE IS BEING COMPRESSED F5500225* =0, FILE IS NOT BEING COMPRESSEDF5500226* BIT 11 , =1, FILE IS OPEN FOR SPECIAL F5500227* PROCESSING F5500228* =0, FILE IS NOT OPEN FOR SPECIALF5500229* PROCESSING F5500230* BIT 8 , =1, RECORDS CONTAIN BINARY DATA F5500231* =0, RECORDS DO NOT CONTAIN F5500232* BINARY DATA F5500233* BIT 0 , FILE TYPE F5500234* =0, SEQUENTIAL FILE F5500235* =1, INDEXED FILE F5500236 EQU NEDATM(FH+7) NUMBER OF EXISTING DATA RECORDS, MSB F5500237 EQU NEDATL(FH+8) NUMBER OF EXISTING DATA RECORDS, LSB F5500238 EQU SEQLTH(NEDATL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F5500239* OF FCB FOR A SEQUENTIAL FILE F5500240 SPC 1 F5500241ÐÐ EQU NEXTBM(FH+9) NEXT FREE KEY INDEX BLOCK, MSB F5500242 EQU NEXTBL(FH+10) NEXT FREE KEY INDEX BLOCK, LSB F5500243 EQU TNKEYM(FH+11) TOTAL NUMBER OF KEY INDEX BLOCKS, MSB F5500244 EQU TNKEYL(FH+12) TOTAL NUMBER OF KEY INDEX BLOCKS, LSB F5500245 EQU KEYBAM(FH+13) KEY INDEX BEGINNING SECTOR ADDRESS, MSB F5500246 EQU KEYBAL(FH+14) KEY INDEX BEGINNING SECTOR ADDRESS, LSB F5500247 EQU LENKY1(FH+15) LENGTH OF KEY NO. 1 F5500248 EQU POSKY1(FH+16) BYTE POSITION OF KEY NO. 1 F5500249 EQU LENKY2(FH+17) LENGTH OF KEY NO. 2 F5500250 EQU POSKY2(FH+18) BYTE POSITION OF KEY NO. 2 F5500251 EQU LENKY3(FH+19) LENGTH OF KEY NO. 3 F5500252 EQU POSKY3(FH+20) BYTE POSITION OF KEY NO. 3 F5500253 EQU LENKY4(FH+21) LENGTH OF KEY NO. 4 F5500254 EQU POSKY4(FH+22) BYTE POSITION OF KEY NO. 4 F5500255 EQU INDLEN(POSKY4-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F5500256* OF FCB FOR AN INDEXED FILE F5500257 EJT F5500258* THE FOLLOWING PORTION OF THE FCB EXISTS ONLY F5500259* ON MASS MEMORY. THESE 10 WORDS ARE NOT LOADEDF5500260* INTO EITHER OF THE FILE MANAGER CONTROLLED FCBF5500261* TABLES. F5500262 EQU TSFILM(FH+23) TOTAL NUMBER OF SECTORS IN FILE, MSB F5500263 EQU TSFILL(FH+24) TOTAL NUMBER OF SECTORS IN FILE, LSB F5500264 EQU NAME12(FH+25) FILE NAME, CHARACTERS 1 AND 2 F5500265 EQU NAME34(FH+26) FILE NAME, CHARACTERS 3 AND 4 F5500266ÐÐ EQU NAME56(FH+27) FILE NAME, CHARACTERS 5 AND 6 F5500267 EQU NAME78(FH+28) FILE NAME, CHARACTERS 7 AND 8 F5500268 EQU OWNR12(FH+29) OWNER NAME, CHARACTERS 1 AND 2 F5500269 EQU OWNR34(FH+30) OWNER NAME, CHARACTERS 3 AND 4 F5500270 EQU OWNR56(FH+31) OWNER NAME, CHARACTERS 5 AND 6 F5500271 EQU OWNR78(FH+32) OWNER NAME, CHARACTERS 7 AND 8 F5500272 EQU BYTLEN(FH+33) BYTE LENGTH OF RECORD F5500273* F5500274* FOR COMPRESS ONLY F5500275* F5500276 EQU PRSRNM(FH+34) RRN OF LAST PROCESSED RECORD - MSB F5500277 EQU PRSRNL(FH+35) RRN OF LAST PROCESSED RECORD - LSB F5500278 EQU NEWRNM(FH+36) RRN OF THE LATEST 'NEW' RECORD - MSB F5500279 EQU NEWRNL(FH+37) RRN OF THE LATEST 'NEW' RECORD - LSB F5500280 SPC 4 F5500281* WORDS 0 THRU 4 OF THE FCB HEADER AND WORDS F5500282* 6 THRU 10 OF THE FCB ARE REFERRED TO AS THE F5500283* SHARED SUBSET OF THE FCB. THEY INCLUDE THE F5500284* ONLY FCB WORDS THAT CAN BE MODIFIED AFTER FILEF5500285* CREATION. IF TWO OR MORE USERS HAVE THE SAME F5500286* FILE OPEN, THERE HAS TO BE A SINGLE MASTER F5500287* COPY OF THE SUBSET THAT RECEIVES (AND RECORDS)F5500288* ALL OF THE UPDATES. THE CONTROLLED SUBSET F5500289* WILL ALWAYS BE PART OF A MAIN MEMORY RESIDENT F5500290* FCB IF THE FCB IS IN A FM CONTROLLED TABLE. F5500291ÐÐ* IF THE FCB IS IN USER SPACE, THE SUBSET MAY ATF5500292* TIMES RESIDE IN THE SUBSET CONTROL TABLE. F5500293 SPC 2 F5500294* ALTERNATE NAMES FOR SUBSET WORDS F5500295 EQU SAFCBI(FH+1) SUBSET ALTERNATE NAME FOR FCBIND F5500296 EQU SADATM(FH+2) SUBSET ALTERNATE NAME FOR NEDATM F5500297 EQU SADATL(FH+3) SUBSET ALTERNATE NAME FOR NEDATL F5500298 EQU SANXTM(FH+4) SUBSET ALTERNATE NAME FOR NEXTBM F5500299 EQU SANXTL(FH+5) SUBSET ALTERNATE NAME FOR NEXTBL F5500300 EJT F5500301* REQUEST PROCESSOR CONTROL TABLE F5500302* F5500303 EQU RP(10) INDEX TO START OF REQUEST PARAMETERS F5500304 EQU MR(RP+5) INDEX TO START OF MONITOR REQUEST PARAM LIST F5500305 EQU SS(MR+10) INDEX TO START OF SCRATCH PORTION OF PAR LIST F5500306* F5500307 EQU RPLOGU(1) LU NUMBER OF MM DEVICE F5500308 EQU RPAREQ(2) ACTIVE REQUEST FLAG (IF 0, NONE FOR TABLE) F5500309 EQU RPWAIT(3) START OF WAITING REQUEST QUEUE (IF 0, NO WAITGF5500310 EQU RPRLEV(4) REQUEST PRIORITY LEVEL - ACTIVE REQUEST F5500311 EQU RPRBF4(5) REQBUF ADDRESS - FIRST FOUR WORDS F5500312 EQU RPLTEA(6) LOCK TABLE ENTRY (ABSOLUTE) ADDRESS F5500313 EQU RPRTNJ(7) RETURN JUMP TO REQUEST PROCESSOR F5500314 EQU RPPADR(8) PROCESSOR ADDRESS F5500315 SPC 1 F5500316ÐÐ* PARAMETER LIST FOR REQUEST PROCESSOR F5500317 EQU RPFCBA(9) FCB ADDRESS FOR FILE F5500318 EQU RPRBMP(RP+0) REQBUF ADDRESS - MAIN PART F5500319 EQU RPPFP1(RP+1) REQUEST PARAMETER ADDRESS - FIRST + 1 F5500320 EQU RPPFP2(RP+2) REQUEST PARAMETER ADDRESS - FIRST + 2 F5500321 EQU RPPFP3(RP+3) REQUEST PARAMETER ADDRESS - FIRST + 3 F5500322 EQU RPPFP4(RP+4) REQUEST PARAMETER ADDRESS - FIRST + 4 F5500323 SPC 1 F5500324* MAIN MONITOR REQUEST F5500325 EQU RPMREQ(MR+0) MONITOR REQUEST CODE WORD F5500326 EQU RPMRP1(MR+1) COMPLETION ADDRESS F5500327 EQU RPMRP2(MR+2) THREAD WORD F5500328 EQU RPMRP3(MR+3) LOGICAL UNIT FOR I/O F5500329 EQU RPMRP4(MR+4) NUMBER OF WORDS F5500330 EQU RPMRP5(MR+5) START CORE ADDRESS F5500331 EQU RPMRP6(MR+6) MASS MEMORY ADDRESS, MSB F5500332 EQU RPMRP7(MR+7) MASS MEMORY ADDRESS, LSB F5500333 EQU RPRCPT(MR+8) CONTROL POINT (FOR I/O REQUESTS) F5500334 EQU RPRETN(MR+9) SAVED RETURN ADDRESS F5500335* ALTERNATE COMMON NAMES F5500336 EQU REQBUF(RP+0) USERS FIRST CALL PARAMETER ADDRESS F5500337 EQU IDATA(RP+1) BUFFER WITH INFO FOR OPEN FILE F5500338 EQU ISTAT(RP+4) USERS COMPLETION STATUS PARAMETER ADDRESS F5500339 EJT F5500340CORFCB ADC 0 ENTRY F5500341ÐÐ LDQ- REQBUF,I F5500342 STQ* REQBFA REQUEST BUFFER ADDRESS F5500343 LDQ- FCBADR,Q FCB ADDRESS F5500344 STQ* LOCATE F5500345 LDA- FCBIND,Q GET INDICATOR WORD F5500346 AND- ONEBIT+12 SEE IF RECOVERING FROM COMPRESSION F5500347 SAZ P000 SKIP IF NO F5500348 STA INITCM SET FLAG FOR NOT CLEARING KIB NUMBER, SAVE F5500349* FOR COMPRESSING INDEXED FILE PROCESSOR F5500350 RTJ COMPRS UPDATE ACCORDING TO COMPRESSION-IN-PROGRESS F5500351 JMP EXIT F5500352* F5500353P000 LDA- FCBIND,Q CHECK IF THIS IS A BINARY DATA FILE F5500354 AND- ONEBIT+8 F5500355 SAZ P001 SKIP IF NO F5500356 JMP EXIT FILE IS OK, NO NEED TO DO CLEAN UP F5500357* F5500358P001 LDA- FCBIND,Q CHECK IF FILE IS OPEN FOR SPECIAL PROCESSING F5500359 AND- ONEBIT+11 F5500360 SAZ +002 SKIP IF NO F5500361 JMP EXIT DO NOT DO CLEANUP F5500362 EJT F5500363* F5500364* PREPARE TO READ DATA RECORDS TILL END-OF-FILE F5500365* START READ AT RECORD FOLLOWING LAST EXISTING DATA RECORD F5500366ÐÐ* F5500367P002 EQU P002(*) F5500368 CLR A CLEAR NO. OF RECORDS CHECKED SO FAR F5500369 STA* NOMISS DO NOT LET THIS NO. GO BEYOND FMNRCD F5500370* F5500371 STA* CHKKIB CLEAR CHECK KEY INFO BLOCK FLAG F5500372* F5500373 STQ- I ADDR OF FCB F5500374* F5500375 LDA- FCBIND,I DETERMINE NO. OF RECORDS PER SECTOR F5500376 ENQ 1 F5500377 SAM P010 SKIP IF RECORDS ARE SECTOR-ALIGNED F5500378 ENQ 0 COMPUTE NO. OF RECORDS/SECTOR F5500379 LDA SIZE F5500380 DVI- RECLEN,I F5500381 TRA Q F5500382 SQN P010 MINIMUM OF 1 RECORD/SECTOR F5500383 ENQ 1 F5500384P010 STQ* NUMREC+1 SAVE NO. OF RECORDS PER SECTOR F5500385* F5500386 LDQ- NEDATM,I CONVERT NO. OF EXISTING RECORDS TO MSB/LSB F5500387 STQ* CNTMSB F5500388 LDA- NEDATL,I F5500389 STA* CNTLSB F5500390 LLS 1 F5500391ÐÐ ALS 15 Q-REG = MSB, A-REG = LSB F5500392 INA 1 BUMP LSB TO NEXT RECORD NO. F5500393 SAP P040 SKIP IF NO OVERFLOW F5500394 ENA 0 F5500395 INQ 1 BUMP MSB F5500396P040 STQ* STRTRC SAVE STARTING RELATIVE RECORD NO. (MSB/LSB) F5500397 STA* STRTRC+1 F5500398 ALS 1 CONVERT TO RELATIVE RECORD NO. FORMAT F5500399 LRS 1 F5500400 STQ* RELREC F5500401 STA* RELREC+1 F5500402* F5500403 LDA- DATBAM,I SAVE DATA RECORD BEGINNING SECTOR ADDRESS F5500404 STA* SECADR F5500405 LDA- DATBAL,I F5500406 STA* SECADR+1 F5500407* F5500408 LDQ- RECLEN,I SET UP RECORD LENGTH FOR I/O F5500409 LDA- FCBIND,I SET BIT 15 IF SECTOR ALIGNED F5500410 AND- ONEBIT+15 ($8000) F5500411 EAQ Q F5500412 STQ* RECSIZ F5500413* F5500414 LDQ- TDATRM,I CONVERT TOTAL NO . OF RECORDS TO MSB/LSB F5500415 LDA- TDATRL,I F5500416ÐÐ LLS 1 F5500417 ALS 15 F5500418 STQ* TOTMSB SAVE IT F5500419 STA* TOTLSB F5500420 EJT F5500421* F5500422* INSURE DESIRED NO. OF RECORDS TO READ EXIST IN FILE F5500423* F5500424P050 LDQ =XTOTMSB SUBTRACT RRN OF FIRST RECORD NEEDED F5500425 RTJ DWSUB FROM TOTAL NO. OF RECORDS F5500426 LDA* SUBOV CHECK FOR ERROR F5500427 SAZ P060 SKIP IF NONE F5500428 JMP P200 ALL DONE F5500429* F5500430* DO ALL RECORDS EXIST F5500431P060 LDA* RESLTM IF MSB OF RESULT NOT 0, THEY DO F5500432 SAN P070 F5500433 LDA* RESLTL COMPARE RESULT WITH NO. OF NEEDED RECORDS F5500434 INA 1 F5500435 TRA Q F5500436 SUB* NUMREC+1 F5500437 SAP P070 SKIP IF ALL CAN BE READ F5500438 STQ* NUMREC+1 RESET NO. TO BE READ F5500439 EJT F5500440* F5500441ÐÐ* READ IN NEXT SET OF RECORDS TO BE CHECKED F5500442* F5500443P070 LDQ* NUMREC+1 COMPUTE BLOCKING SIZE FOR I/O F5500444 TRQ A F5500445 INQ -1 F5500446 SQN P080 SKIP IF NO. OF RECORDS NOT ONE F5500447 LDA SIZE BLOCK SIZE = SECTOR SIZE F5500448 JMP* P090 F5500449P080 MUI- RECLEN,I BLOCK SIZE = NO. OF RECORDS X RECORD LENGTH F5500450P090 STA* BLKSIZ F5500451* F5500452 LDQ =XSECADR DO READ F5500453 LDA PCTABL F5500454 STA- I F5500455 RTJ MMREAD F5500456 SQP P095 SKIP IF NO ERROR F5500457 INQ 0 F5500458 SQZ P093 SKIP IF ADDRESS COMPUTATION ERROR F5500459 LDA =N$8020 RETURN WITH I/O ERROR F5500460 JMP* P094 F5500461P093 LDA =N$C020 F5500462 SPC 2 F5500463P094 LDQ PCTABL E R R O R E X I T F5500464 STQ- I F5500465 LDQ- ISTAT,I SET STATUS IN USER'S PARAMETER F5500466ÐÐ STA- (ZERO),Q F5500467 JMP FMCOMP RETURN TO EXEC F5500468 SPC 2 F5500469P095 LDA* LOCATE RESET I-REG TO FCB ADDRESS F5500470 STA- I F5500471 JMP* P100 F5500472 EJT F5500473* F5500474* MISCELLANEOUS STORAGE F5500475* F5500476LOCATE ADC 0 F5500477REQBFA ADC 0 F5500478NOMISS NUM 0 COUNT NO. OF RECORDS CHECKED SO FAR F5500479CHKKIB NUM 0 CHECK KIB FLAG F5500480 SPC 2 F5500481ISAVE NUM 0 F5500482QSAVE NUM 0 F5500483INDEX NUM 0 POINTER TO RECORD WITHIN 'BUF' F5500484RECCNT NUM 0 NO. OF RECORDS CHECKED F5500485CNTMSB NUM 0 COUNT OF EXISTING DATA RECORDS (MSB) F5500486CNTLSB NUM 0 COUNT OF EXISTING DATA RECORDS (LSB) F5500487 SPC 3 F5500488* PARAMETER LIST FOR MM READ F5500489SECADR BZS SECADR(2) MM I/O SECTOR ADDRESS F5500490RELREC BZS RELREC(2) RELATIVE RECORD NO. F5500491ÐÐRECSIZ NUM 0 RECORD LENGTH (BIT 15 SET IF SECTOR ALIGNED) F5500492BLKSIZ NUM 0 NO. OF WORDS TO READ F5500493 NUM 0 WORD OFFSET F5500494BUFADR ADC SPARE I/O BUFFER ADDRESS F5500495 NUM 0 FILE I/O FLAG F5500496 SPC 3 F5500497* PARAMETER LIST FOR SUBTRACT F5500498TOTMSB NUM 0 TOTAL NO. OF RECORDS (MSB) F5500499TOTLSB NUM 0 TOTAL NO. OF RECORDS (LSB) F5500500STRTRC BZS STRTRC(2) RELATIVE RECORD NO. (MSB/LSB) F5500501RESLTM NUM 0 RESULT (MSB) F5500502RESLTL NUM 0 RESULT (LSB) F5500503SUBOV NUM 0 OVERFLOW INDICATOR F5500504 SPC 3 F5500505* PARAMETER LIST FOR ADD F5500506OLDREC BZS OLDREC(2) CURRENT STARTING RECORD NO. F5500507NUMREC BZS NUMREC(2) NO. OF RECORDS READ F5500508NEWREC BZS NEWREC(2) NEW STARTING RECORD NO. F5500509ADDOV NUM 0 F5500510 EJT F5500511* F5500512* LOOP THROUGH RECORDS JUST READ UNTIL END-OF-FILE F5500513* F5500514P100 LDQ* BUFADR GET INDEX TO FIRST RECORD F5500515 STQ* INDEX F5500516ÐÐ ENA 0 ZERO OUT RECORD COUNTER F5500517 STA* RECCNT F5500518* F5500519P110 LDA- (ZERO),Q GET WORD 1 OF RECORD F5500520 LDQ- 1,Q GET WORD 2 OF RECORD F5500521 EAQ A COMPARE THE 2 WORDS F5500522 SAZ P120 SKIP IF THE SAME F5500523 JMP* P130 GO BUMP EXISTING RECORD COUNTER F5500524* F5500525P120 TRQ A F5500526 EOR =XFMEOFC CHECK FOR END-OF-FILE F5500527 SAN P130 SKIP IF NO F5500528 JMP* P200 ALL DONE F5500529* F5500530P130 LDA* CNTLSB BUMP NO. OF EXISTING RECORDS F5500531 LDQ* CNTMSB 121*4625F5500532 RTJ FMBRRN BUMP BY 1 121*4625F5500533 STA* CNTLSB STORE IT BACK 121*4625F5500534 STQ* CNTMSB 121*4625F5500535 LDA* CHKKIB SKIP IF CHECKING KEY F5500536 SAN P145 F5500537 RAO* NOMISS ADD ONE TO NO. OF RECORDS MISSED F5500538 LDA* NOMISS IF MORE THAN FMNRCD RECORDS CHECKED. F5500539 SUB =XFMNRCD YET EOF IS NOT FOUND YET. MUST BE LOST F5500540 SAM P145 DURING SYSTEM CRASH. F5500541ÐÐ JMP* P093 SET ERROR FLAG AND LEAVE F5500542* F5500543P145 EQU P145(*) F5500544 RAO* RECCNT BUMP NO. OF RECORDS CLEARED F5500545 LDA* RECCNT F5500546 SUB* NUMREC+1 F5500547 SAZ P150 SKIP IF ALL RECORDS HAVE BEEN CHECKED F5500548 LDQ* INDEX INCREMENT INDEX TO NEXT RECORD F5500549 ADQ- RECLEN,I F5500550 STQ* INDEX F5500551 JMP* P110 CONTINUE F5500552 EJT F5500553* F5500554* COMPUTE RELATIVE RECORD NO. OF NEXT SET OF RECORDS F5500555* F5500556P150 LDA* STRTRC SET UP CALL TO ADD F5500557 STA* OLDREC F5500558 LDA* STRTRC+1 F5500559 STA* OLDREC+1 F5500560 LDQ =XOLDREC ADD NO. OF RECORDS READ TO OLD F5500561 RTJ DWADD STARTING RECORD NO. F5500562 LDQ* NEWREC RETURN NEW RECORD NO. F5500563 STQ* STRTRC F5500564 LDA* NEWREC+1 F5500565 STA* STRTRC+1 F5500566ÐÐ ALS 1 CONVERT IT TO RELATIVE RECORD NO. FORMAT F5500567 LRS 1 F5500568 STQ* RELREC F5500569 STA* RELREC+1 F5500570 JMP P050 GO CHECK FOR END-OF-FILE F5500571 EJT F5500572* F5500573* CHECK IF FCB UPDATE IS COMPLETE F5500574* F5500575P200 LDA* SECADR CHECK IF HAVE UPDATED KEY INDEX F5500576 EOR- KEYBAM,I F5500577 SAN P220 SKIP IF NO F5500578 LDA* SECADR+1 F5500579 EOR- KEYBAL,I F5500580 SAZ P230 SKIP IF YES F5500581* F5500582P220 LDA* CNTMSB UPDATE NO. OF EXISTING DATA RECORDS F5500583 STA- NEDATM,I F5500584 LDA* CNTLSB F5500585 STA- NEDATL,I F5500586 LDA- FCBIND,I CHECK IF FILE IS INDEXED F5500587 AND- ONEBIT (0001) F5500588 SAN P240 SKIP IF YES F5500589 JMP* EXIT F5500590* F5500591ÐÐP230 LDA* RELREC UPDATE NEXT FREE KIB NO. F5500592 STA- NEXTBM,I F5500593 LDA* RELREC+1 F5500594 STA- NEXTBL,I F5500595 JMP* EXIT F5500596 EJT F5500597* F5500598* PREPARE TO READ KEY INDEX BLOCKS TILL END-OF-FILE F5500599* F5500600P240 ENA 1 SET TO SEARCH KEY INDEX F5500601 STA* NUMREC+1 ONE RECORD AT A TIME F5500602 STA* CHKKIB F5500603* F5500604 LDA- KEYBAM,I SET I/O SECTOR ADDRESS F5500605 STA* SECADR F5500606 LDA- KEYBAL,I F5500607 STA* SECADR+1 F5500608* F5500609 LDA SIZE DETERMINE KIB SIZE F5500610 INA -96 F5500611 SAN P250 SENSE SECTOR SIZE NOT 96 WORDS F5500612 LDA =N288 SET KIB LENGTH TO 288 F5500613 JMP* P260 F5500614* F5500615P250 LDA =N572 COMPUTE WORD LENGTH OF KIB F5500616ÐÐ ENQ 0 F5500617 DVI SIZE F5500618 MUI SIZE F5500619P260 EOR- ONEBIT+15 ($8000) F5500620 STA* RECSIZ F5500621* F5500622 LDQ- NEXTBM,I START READ AT NEXT FREE KIB F5500623 STQ* RELREC F5500624 LDA- NEXTBL,I F5500625 STA* RELREC+1 F5500626 LLS 1 CONVERT TO MSB/LSB F5500627 ALS 15 F5500628 STQ* STRTRC F5500629 STA* STRTRC+1 F5500630* F5500631* F5500632 LDQ- TNKEYM,I SET UP ENDING KIB NO. (MSB/LSB) F5500633 LDA- TNKEYL,I F5500634 LLS 1 F5500635 ALS 15 F5500636 STQ* TOTMSB F5500637 STA* TOTLSB F5500638 JMP P050 GO DO READS F5500639 EJT F5500640* F5500641ÐÐ* ALL DONE F5500642* F5500643EXIT EQU EXIT(*) F5500644 ENQ -1 SET Q NEGATIVE TO BRING BACK PRIMARY F5500645 RTJ FMSWAP PROCESSOR. RETURN TO EXEC TO READ BACK F5500646* PRIMARY F5500647 END F5500648 NAM COMPRS F56 A ITOS CCS 3.0 SL-149F5600001* PERFORM OPEN FILE RECOVERY PROCESSING FOR ABORTED COMPRESSION F5600002* CREDIT COLLECTION SYSTEM VERSION 3.0 F5600003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F5600004* COPYRIGHT CONTROL DATA CORPORATION 1979 F5600005* F5600006**** F5600007* F5600008* THIS IS PART OF THE SECONDARY PROCESSOR FOR OPEN FILE. F5600009* THIS ROUTINE IS FOR RECOVERY OF A FILE WHICH WAS DOING A COMPRESS F5600010* DATA RECORD WHEN THE SYSTEM FAILED. F5600011* F5600012* F5600013* THE SPECIFIC DATA UPDATED IS: F5600014* 1) RRN OF THE LATEST 'NEW' RECORD AND THE LAST PROCESSED RECORD F5600015* 2) NEXT FREE KEY INDEX BLOCK F5600016* IT ALSO SETS UP ITEM (1) IN THE REQUEST BUFFER F5600017* F5600018ÐÐ* IN ORDER FOR THE COMPRESS FILE PROCESSOR TO WORK, IT NEEDS F5600019* TO KNOW THE RELATIVE RECORD NO. (RRN) OF THE LAST PROCESSED F5600020* RECORD AND THE RRN OF LATEST 'NEW' RECORD. THESE TWO RRN F5600021* ARE SAVED IN THE FCB ON MASS MEMORY. THEY ARE UPDATED AFTER F5600022* FMNRCD ( A GLOBAL VALUE) RECORDS ARE ADDED TO THE COMPRESSED F5600023* FILE. F5600024* F5600025* DURING THE COMPRESS, WHEN A GOOD RECORD IS WRITTEN BACK ON F5600026* MASS MEMORY, A MARKER IS ALSO WRITTEN INTO THE NEXT RECORD F5600027* SPACE. A MARKER IS THE TWO WORDS OF EOF CODE FOLLOWED BY F5600028* THE RRN OF THE LAST PROCESSED RECORD. THE MARKER IS NOT F5600029* WRITTEN ON MASS MEMORY WHEN THERE IS NOT ENOUGH SPACE TO F5600030* WRITE FOUR WORDS, I.E. (THE NO. PROCESSED - NO. OF NEW) X F5600031* LENGTH OF ONE RECORD IS LESS THAN FOUR. IN THAT CASE, THE F5600032* FCB ON MASS MEMORY IS UPDATED BUT SETTING BIT 15 OF THE FIRST F5600033* WORD OF THE RRN FOR LAST PROCESSED. F5600034*E F5600035* THIS IS THE RECOVERY SCHEME BUILT IN DURING COMPRESS FILE. F5600036* F5600037* F5600038* IN CASE THE SYSTEM FAILS DURING A COMPRESS FILE, THE FCB WILL F5600039* INDICATE THIS SITUATION. WHEN THE FILE IS NEXT OPEN FOR F5600040* COMPRESS, COMPRS WILL ATTEMPT TO RECOVER THE SITUATION. THE F5600041* PROCEDURE IS SIMILIAR TO CORFCB. IN ADDITION TO RECOVERING F5600042* THE LATEST EXISTING 'NEW' RECORD, THE RRN OF THE LAST PROCESSED F5600043ÐÐ* RECORD IS ALSO PICKED UP FROM THE DATA AREA AND SAVED IN THE F5600044* FCB. THE TWO RRN'S ARE ALSO STORED IN THE REQUEST BUFFER F5600045* SO THE NEXT COMPRESS FILE PROCESSOR CAN USE THEM. F5600046* F5600047* F5600048* IF THE FILE IS AN INDEXED FILE, THE SAME SCHEME USED IN F5600049* CORFCB TO RECOVER THE KEY INFO DIRECTORY IS USED. F5600050* F5600051* CALLING SEQUENCE F5600052* CALL COMPRS F5600053* F5600054* PARAMETERS F5600055* REG I = PCT ADDRESS F5600056* F5600057*E F5600058* F5600059* F5600060* PROCESS: F5600061* READ THE RRN OF THE LAST PROCESSED RECORD FROM THE FCB F5600062* ON MASS MEMORY. IF THE MSB IS NEGATIVE (BIT 15=1) THEN F5600063* THE INFO IN THE FCB IS THE CURRENT INFO, THERE IS NO MARKER F5600064* IN THE DATA AREA. CLEAR THE BIT 15 AND COPY THE TWO RRN'S F5600065* IN THE REQUEST BUFFER. EXIT. F5600066* F5600067* IF A MARKER EXISTS ON MASS MEMORY DATA AREA. START READ- F5600068ÐÐ* ING RECORD SPACES FROM THE LAST 'NEW' RECORD AREA. LOOK F5600069* FOR THE MARKER. THE LOGIC IS IDENTICAL TO THAT IN CORFCB. F5600070* F5600071* WHEN THE MARKER IS FOUND, THE RRN OF THE LAST PROCESSED F5600072* RECORD IS READ AND SAVE IN THE FCB AND REQUEST BUFFER. F5600073* F5600074* F5600075* THE SAME LOGIC IS USED TO RECOVER KEY INFO DIRECTORY ON F5600076* MASS MEMORY FOR INDEXED FILE. F5600077* F5600078* F5600079* EXIT F5600080* F5600081* THE FOLLOWING COMMON VARIABLES WILL BE SET UP: F5600082* STATUS - COMPLETION STATUS F5600083* = $8020 IF MASS MEMORY I/O ERROR ELSE UNCHANGED F5600084* F5600085 EJT F5600086* F5600087* ENTRY POINTS F5600088* F5600089 ENT COMPRS F5600090* F5600091* EXTERNALS F5600092* F5600093ÐÐ EXT DWSUB DOUBLE WORD SUBTRACT ROUTINE F5600094 EXT DWADD DOUBLE WORD ADD ROUTINE F5600095 EXT MMREAD MASS MEMORY READ ROUTINE F5600096 EXT FMBRRN BUMP RRN BY ONE 121*4624F5600097 EXT FMEOFC END-OF-FILE CODE F5600098 EXT FMNRCD NO. OF RECORDS ADDED BEFORE FCB IS UPDATED F5600099* ON MM F5600100* F5600101* COMMON DECLARATIONS F5600102* F5600103 COM PCTABL PROCESSOR CONTROL TABLE ADDRESS F5600104 COM FCBMMA FCB MAIN MEMORY ADDR (SET BY EXECUTIVE) F5600105 COM BUF(572) SCRATCH BUFFER F5600106 COM STATUS MODULE COMPLETION STATUS F5600107 COM VIT(21) VOLUME INFORMATION TABLE F5600108 COM FDB(2) FDB OF FILE BLOCK NO. F5600109 COM FDS INDEX INTO FDB TO FILE'S FDS F5600110 COM MMUNIT FILE'S MASS MEMORY UNIT NO. F5600111 COM SIZE WORDS/SECTOR OF VOLUME F5600112 COM FILE PSUEDO FILE ID F5600113 COM INITCM INITIAL OPEN FOR COMPRESSION FLAG F5600114 COM SPARE(104) SPARE COMMON F5600115**** F5600116* F5600117* EQUIVALENCES F5600118ÐÐ* F5600119 EQU ZERO(2) CONSTANT ZERO F5600120 EQU ONEBIT($23) ONEBIT MASK F5600121 EQU ONEMSK(3) ONE MASK TABLE F5600122 EJT F5600123* REQUEST BUFFER INDEXES - FIRST 4 WORDS F5600124 EQU RBATHR(0) REQUEST BUFFER ADDRESS THREAD F5600125 EQU BUFAMP(1) BUFFER ADDRESS MAIN PART F5600126 EQU CNTLPT(2) CONTROL POINT (OR SPARE) F5600127 EQU RQINFO(3) REQUEST INFORMATION (MULTI-FIELD) F5600128* BITS USE F5600129* 15-12 SPARE F5600130* 11-04 REQUEST INDEX F5600131* 03-00 LEVEL OF REQUESTOR F5600132* F5600133* REQUEST BUFFER INDEXES - MAIN PART F5600134 EQU QREG(0) Q REGISTER F5600135 EQU IREG(1) I REGISTER F5600136 EQU PARLST(2) ADDRESS OF PARAMETER LIST F5600137 EQU RTNADR(2) RETURN ADDRESS TO USER (UPON RETURN FROM EXEC)F5600138 EQU UCTADR(3) UCT ENTRY ABSOLUTE ADDRESS F5600139 EQU USERID(4) USER IDENTIFIER F5600140 EQU FCBADR(5) FCB ADDRESS (MAY BE SET BY CALLER OR INTCPTR.)F5600141 EQU RADINT(6) RETURN ADDRESS TO INTERCEPTOR F5600142 EQU RPIDX(7) REQUEST PROCESSOR INDEX F5600143ÐÐ* BITS 14-00 REQUEST PROCESSOR INDEX F5600144* BIT 15 TYPE OF PROCESSOR F5600145* =0, SERIAL PROCESSOR F5600146* =1, REENTRANT PROCESSOR F5600147 EQU LOKREC(8) NUMBER OF RECORDS TO BE READ/WRITTEN PER I/O F5600148* CALL AND LOCK RECORDS ON RETRIEVE FLAG F5600149* BITS 14-00 NUMBER OF RECORDS PER CALL F5600150* BIT 15 =0, DO NOT LOCK ON RETRIEVE F5600151* =1, LOCK RECORDS ON RETRIEVE F5600152 EQU USEFLG(9) TYPE OF FILE USE FLAG F5600153* -1, OPEN FOR COMPRESSION F5600154* -2, OPEN FOR SPECIAL PROCESSING F5600155* 0, OPEN FOR ACESS VIA REL REC NO F5600156* 1, OPEN FOR RETRIEVAL VIA KEY 1 F5600157* 2, OPEN FOR RETRIEVAL VIA KEY 2 F5600158* 3, OPEN FOR RETRIEVAL VIA KEY 3 F5600159* 4, OPEN FOR RETRIEVAL VIA KEY 4 F5600160* F5600161* F5600162* SCRATCH FOR COMSEQ F5600163* F5600164 EQU PRCRNM(16) RRN OF LAST PROCESSED RECORD, MSB F5600165 EQU PRCRNL(17) RRN OF LAST PROCESSED RECORD, LSB F5600166 EQU NETRNM(18) RRN OF THE LATEST 'NEW' RECORD - MSB F5600167 EQU NETRNL(19) RRN OF THE LATEST 'NEW' RECORD - LSB F5600168ÐÐ EJT F5600169* FILE CONTROL BLOCK EQUIVALENCES F5600170 EQU FH(4) LENGTH -1 OF FCB HEADER F5600171 EQU FILEID(ZERO) FILE IDENTIFIER F5600172* ACCESS FILEID INDIRECTLY F5600173* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBERF5600174* BITS 10-00 INDEX OF FCB IN FCB TABLE F5600175 EQU FCBFLG(1) FCB FLAGS F5600176* BITS 15-8, SPARE F5600177* BITS 7-00, NUMBER OF USERS USING FILE F5600178 EQU FILOCK(2) FILE LOCK FLAG (IF NON-0, CONTAINS USER ID) F5600179 EQU NUMSET(3) NUMBER OF SETS OF LOCKED RECORDS IN FILE F5600180 EQU NUMNEW(4) NUMBER OF NEW RECORDS SINCE FCB UPDATED ON MM F5600181 SPC 1 F5600182 EQU RECLEN(FH+1) RECORD LENGTH IN WORDS F5600183 EQU TDATRM(FH+2) TOTAL NUMBER OF DATA RECORDS, MSB F5600184 EQU TDATRL(FH+3) TOTAL NUMBER OF DATA RECORDS, LSB F5600185 EQU DATBAM(FH+4) DATA RECORDS BEGINNING SECTOR ADDRESS, MSB F5600186 EQU DATBAL(FH+5) DATA RECORDS BEGINNING SECTOR ADDRESS,LMSB F5600187 EQU FCBIND(FH+6) FCB INDICATORS F5600188* BIT 15 , SECTOR ALLIGNED RECORDS IF =1 F5600189* BIT 14 , STORAGE MODE FOR INDEXED FILE F5600190* =0, RECORDS STORED RANDOMLY WITHF5600191* RESPECT TO PRIMARY KEY F5600192* =1, RECORDS STORED IN ORDER WIT F5600193ÐÐ* RESPECT TO PRIMARY KEY F5600194* BIT 13 , =1, FILE IS CURRENTLY OPEN F5600195* =0, FILE IS CURRENTLY CLOSED F5600196* BIT 12 , =1, FILE IS BEING COMPRESSED F5600197* =0, FILE IS NOT BEING COMPRESSEDF5600198* BIT 11 , =1, FILE IS OPEN FOR SPECIAL F5600199* PROCESSING F5600200* =0, FILE IS NOT OPEN FOR SPECIALF5600201* PROCESSING F5600202* BIT 8 , =1, RECORDS CONTAIN BINARY DATA F5600203* =0, RECORDS DO NOT CONTAIN F5600204* BINARY DATA F5600205* BIT 0 , FILE TYPE F5600206* =0, SEQUENTIAL FILE F5600207* =1, INDEXED FILE F5600208 EQU NEDATM(FH+7) NUMBER OF EXISTING DATA RECORDS, MSB F5600209 EQU NEDATL(FH+8) NUMBER OF EXISTING DATA RECORDS, LSB F5600210 EQU SEQLTH(NEDATL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F5600211* OF FCB FOR A SEQUENTIAL FILE F5600212 SPC 1 F5600213 EQU NEXTBM(FH+9) NEXT FREE KEY INDEX BLOCK, MSB F5600214 EQU NEXTBL(FH+10) NEXT FREE KEY INDEX BLOCK, LSB F5600215 EQU TNKEYM(FH+11) TOTAL NUMBER OF KEY INDEX BLOCKS, MSB F5600216 EQU TNKEYL(FH+12) TOTAL NUMBER OF KEY INDEX BLOCKS, LSB F5600217 EQU KEYBAM(FH+13) KEY INDEX BEGINNING SECTOR ADDRESS, MSB F5600218ÐÐ EQU KEYBAL(FH+14) KEY INDEX BEGINNING SECTOR ADDRESS, LSB F5600219 EQU LENKY1(FH+15) LENGTH OF KEY NO. 1 F5600220 EQU POSKY1(FH+16) BYTE POSITION OF KEY NO. 1 F5600221 EQU LENKY2(FH+17) LENGTH OF KEY NO. 2 F5600222 EQU POSKY2(FH+18) BYTE POSITION OF KEY NO. 2 F5600223 EQU LENKY3(FH+19) LENGTH OF KEY NO. 3 F5600224 EQU POSKY3(FH+20) BYTE POSITION OF KEY NO. 3 F5600225 EQU LENKY4(FH+21) LENGTH OF KEY NO. 4 F5600226 EQU POSKY4(FH+22) BYTE POSITION OF KEY NO. 4 F5600227 EQU INDLEN(POSKY4-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION F5600228* OF FCB FOR AN INDEXED FILE F5600229 EJT F5600230* THE FOLLOWING PORTION OF THE FCB EXISTS ONLY F5600231* ON MASS MEMORY. THESE 10 WORDS ARE NOT LOADEDF5600232* INTO EITHER OF THE FILE MANAGER CONTROLLED FCBF5600233* TABLES. F5600234 EQU TSFILM(FH+23) TOTAL NUMBER OF SECTORS IN FILE, MSB F5600235 EQU TSFILL(FH+24) TOTAL NUMBER OF SECTORS IN FILE, LSB F5600236 EQU NAME12(FH+25) FILE NAME, CHARACTERS 1 AND 2 F5600237 EQU NAME34(FH+26) FILE NAME, CHARACTERS 3 AND 4 F5600238 EQU NAME56(FH+27) FILE NAME, CHARACTERS 5 AND 6 F5600239 EQU NAME78(FH+28) FILE NAME, CHARACTERS 7 AND 8 F5600240 EQU OWNR12(FH+29) OWNER NAME, CHARACTERS 1 AND 2 F5600241 EQU OWNR34(FH+30) OWNER NAME, CHARACTERS 3 AND 4 F5600242 EQU OWNR56(FH+31) OWNER NAME, CHARACTERS 5 AND 6 F5600243ÐÐ EQU OWNR78(FH+32) OWNER NAME, CHARACTERS 7 AND 8 F5600244 EQU BYTLEN(FH+33) BYTE LENGTH OF RECORD F5600245* F5600246* FOR COMPRESS ONLY F5600247* F5600248 EQU PRSRNM(FH+34) RRN OF LAST PROCESSED RECORD - MSB F5600249 EQU PRSRNL(FH+35) RRN OF LAST PROCESSED RECORD - LSB F5600250 EQU NEWRNM(FH+36) RRN OF THE LATEST 'NEW' RECORD - MSB F5600251 EQU NEWRNL(FH+37) RRN OF THE LATEST 'NEW' RECORD - LSB F5600252 SPC 4 F5600253* WORDS 0 THRU 4 OF THE FCB HEADER AND WORDS F5600254* 6 THRU 10 OF THE FCB ARE REFERRED TO AS THE F5600255* SHARED SUBSET OF THE FCB. THEY INCLUDE THE F5600256* ONLY FCB WORDS THAT CAN BE MODIFIED AFTER FILEF5600257* CREATION. IF TWO OR MORE USERS HAVE THE SAME F5600258* FILE OPEN, THERE HAS TO BE A SINGLE MASTER F5600259* COPY OF THE SUBSET THAT RECEIVES (AND RECORDS)F5600260* ALL OF THE UPDATES. THE CONTROLLED SUBSET F5600261* WILL ALWAYS BE PART OF A MAIN MEMORY RESIDENT F5600262* FCB IF THE FCB IS IN A FM CONTROLLED TABLE. F5600263* IF THE FCB IS IN USER SPACE, THE SUBSET MAY ATF5600264* TIMES RESIDE IN THE SUBSET CONTROL TABLE. F5600265 SPC 2 F5600266* ALTERNATE NAMES FOR SUBSET WORDS F5600267 EQU SAFCBI(FH+1) SUBSET ALTERNATE NAME FOR FCBIND F5600268ÐÐ EQU SADATM(FH+2) SUBSET ALTERNATE NAME FOR NEDATM F5600269 EQU SADATL(FH+3) SUBSET ALTERNATE NAME FOR NEDATL F5600270 EQU SANXTM(FH+4) SUBSET ALTERNATE NAME FOR NEXTBM F5600271 EQU SANXTL(FH+5) SUBSET ALTERNATE NAME FOR NEXTBL F5600272 EJT F5600273* REQUEST PROCESSOR CONTROL TABLE F5600274* F5600275 EQU RP(10) INDEX TO START OF REQUEST PARAMETERS F5600276 EQU MR(RP+5) INDEX TO START OF MONITOR REQUEST PARAM LIST F5600277 EQU SS(MR+10) INDEX TO START OF SCRATCH PORTION OF PAR LIST F5600278* F5600279 EQU RPLOGU(1) LU NUMBER OF MM DEVICE F5600280 EQU RPAREQ(2) ACTIVE REQUEST FLAG (IF 0, NONE FOR TABLE) F5600281 EQU RPWAIT(3) START OF WAITING REQUEST QUEUE (IF 0, NO WAITGF5600282 EQU RPRLEV(4) REQUEST PRIORITY LEVEL - ACTIVE REQUEST F5600283 EQU RPRBF4(5) REQBUF ADDRESS - FIRST FOUR WORDS F5600284 EQU RPLTEA(6) LOCK TABLE ENTRY (ABSOLUTE) ADDRESS F5600285 EQU RPRTNJ(7) RETURN JUMP TO REQUEST PROCESSOR F5600286 EQU RPPADR(8) PROCESSOR ADDRESS F5600287 SPC 1 F5600288* PARAMETER LIST FOR REQUEST PROCESSOR F5600289 EQU RPFCBA(9) FCB ADDRESS FOR FILE F5600290 EQU RPRBMP(RP+0) REQBUF ADDRESS - MAIN PART F5600291 EQU RPPFP1(RP+1) REQUEST PARAMETER ADDRESS - FIRST + 1 F5600292 EQU RPPFP2(RP+2) REQUEST PARAMETER ADDRESS - FIRST + 2 F5600293ÐÐ EQU RPPFP3(RP+3) REQUEST PARAMETER ADDRESS - FIRST + 3 F5600294 EQU RPPFP4(RP+4) REQUEST PARAMETER ADDRESS - FIRST + 4 F5600295 SPC 1 F5600296* MAIN MONITOR REQUEST F5600297 EQU RPMREQ(MR+0) MONITOR REQUEST CODE WORD F5600298 EQU RPMRP1(MR+1) COMPLETION ADDRESS F5600299 EQU RPMRP2(MR+2) THREAD WORD F5600300 EQU RPMRP3(MR+3) LOGICAL UNIT FOR I/O F5600301 EQU RPMRP4(MR+4) NUMBER OF WORDS F5600302 EQU RPMRP5(MR+5) START CORE ADDRESS F5600303 EQU RPMRP6(MR+6) MASS MEMORY ADDRESS, MSB F5600304 EQU RPMRP7(MR+7) MASS MEMORY ADDRESS, LSB F5600305 EQU RPRCPT(MR+8) CONTROL POINT (FOR I/O REQUESTS) F5600306 EQU RPRETN(MR+9) SAVED RETURN ADDRESS F5600307* ALTERNATE COMMON NAMES F5600308 EQU REQBUF(RP+0) USERS FIRST CALL PARAMETER ADDRESS F5600309 EQU IDATA(RP+1) BUFFER WITH INFO FOR OPEN FILE F5600310 EQU ISTAT(RP+4) USERS COMPLETION STATUS PARAMETER ADDRESS F5600311 EJT F5600312COMPRS ADC 0 ENTRY F5600313 LDQ- REQBUF,I F5600314 STQ* REQBFA REQUEST BUFFER ADDRESS F5600315 LDQ- FCBADR,Q FCB ADDRESS F5600316 STQ* LOCATE F5600317 EJT F5600318ÐÐ* F5600319* PREPARE TO READ DATA RECORDS TILL END-OF-FILE F5600320* START READ AT RECORD FOLLOWING LAST EXISTING DATA RECORD F5600321* F5600322P000 EQU P000(*) F5600323 CLR A CLEAR NO. OF RECORDS CHECKED SO FAR F5600324 STA* NOMISS DO NOT LET THIS NO. GO BEYOND FMNRCD F5600325* F5600326 STA* CHKKIB F5600327* F5600328 STQ- I ADDR OF FCB F5600329* F5600330 SPC 2 F5600331 LDA- PRSRNM,I F5600332 SAM P002 SEE IF THERE IS ANY MARKER F5600333 JMP* P005 YES, SKIP F5600334* F5600335P002 EQU P002(*) F5600336 LDQ* REQBFA THERE IS NO MARKER F5600337 AND- ONEMSK+14 DATA IN THE FCB IS THE CURRENT ONE F5600338 STA- PRCRNM,Q STORE RRN OF LAST PROCESSED RECORD INTO F5600339 LDA- PRSRNL,I REQUEST BUFFER F5600340 STA- PRCRNL,Q F5600341* F5600342 LDA- NEWRNM,I STORE RRN OF THE LATEST 'NEW' RECORD F5600343ÐÐ STA- NETRNM,Q IN REQUEST BUFFER F5600344 LDA- NEWRNL,I F5600345 STA- NETRNL,Q F5600346* F5600347 LDA- FCBIND,I SEE IF FILE IS INDEXED F5600348 AND- ONEBIT F5600349 SAN P003 F5600350 JMP EXIT NO, LEAVE F5600351* F5600352P003 JMP P240 YES, RECOVER KIB NO. F5600353P005 EQU P005(*) F5600354* F5600355* F5600356 LDA- FCBIND,I DETERMINE NO. OF RECORDS PER SECTOR F5600357 ENQ 1 F5600358 SAM P010 SKIP IF RECORDS ARE SECTOR-ALIGNED F5600359 ENQ 0 COMPUTE NO. OF RECORDS/SECTOR F5600360 LDA SIZE F5600361 DVI- RECLEN,I F5600362 TRA Q F5600363 SQN P010 MINIMUM OF 1 RECORD/SECTOR F5600364 ENQ 1 F5600365P010 STQ* NUMREC+1 SAVE NO. OF RECORDS PER SECTOR F5600366* F5600367 LDQ- NEWRNM,I CONVERT NO. OF EXISTING RECORDS TO MSB/LSB F5600368ÐÐ STQ* CNTMSB F5600369 LDA- NEWRNL,I F5600370 STA* CNTLSB F5600371 LLS 1 F5600372 ALS 15 Q-REG = MSB, A-REG = LSB F5600373 INA 1 BUMP LSB TO NEXT RECORD NO. F5600374 SAP P040 SKIP IF NO OVERFLOW F5600375 ENA 0 F5600376 INQ 1 BUMP MSB F5600377P040 STQ* STRTRC SAVE STARTING RELATIVE RECORD NO. (MSB/LSB) F5600378 STA* STRTRC+1 F5600379 ALS 1 CONVERT TO RELATIVE RECORD NO. FORMAT F5600380 LRS 1 F5600381 STQ* RELREC F5600382 STA* RELREC+1 F5600383* F5600384 LDA- DATBAM,I SAVE DATA RECORD BEGINNING SECTOR ADDRESS F5600385 STA* SECADR F5600386 LDA- DATBAL,I F5600387 STA* SECADR+1 F5600388* F5600389 LDQ- RECLEN,I SET UP RECORD LENGTH FOR I/O F5600390 LDA- FCBIND,I SET BIT 15 IF SECTOR ALIGNED F5600391 AND- ONEBIT+15 ($8000) F5600392 EAQ Q F5600393ÐÐ STQ* RECSIZ F5600394* F5600395 LDQ- TDATRM,I CONVERT TOTAL NO . OF RECORDS TO MSB/LSB F5600396 LDA- TDATRL,I F5600397 LLS 1 F5600398 ALS 15 F5600399 STQ* TOTMSB SAVE IT F5600400 STA* TOTLSB F5600401 EJT F5600402* F5600403* INSURE DESIRED NO. OF RECORDS TO READ EXIST IN FILE F5600404* F5600405P050 LDQ =XTOTMSB SUBTRACT RRN OF FIRST RECORD NEEDED F5600406 RTJ DWSUB FROM TOTAL NO. OF RECORDS F5600407 LDA* SUBOV CHECK FOR ERROR F5600408 SAZ P060 SKIP IF NONE F5600409 JMP P200 ALL DONE F5600410* F5600411* DO ALL RECORDS EXIST F5600412P060 LDA* RESLTM IF MSB OF RESULT NOT 0, THEY DO F5600413 SAN P070 F5600414 LDA* RESLTL COMPARE RESULT WITH NO. OF NEEDED RECORDS F5600415 INA 1 F5600416 TRA Q F5600417 SUB* NUMREC+1 F5600418ÐÐ SAP P070 SKIP IF ALL CAN BE READ F5600419 STQ* NUMREC+1 RESET NO. TO BE READ F5600420 EJT F5600421* F5600422* READ IN NEXT SET OF RECORDS TO BE CHECKED F5600423* F5600424P070 LDQ* NUMREC+1 COMPUTE BLOCKING SIZE FOR I/O F5600425 TRQ A F5600426 INQ -1 F5600427 SQN P080 SKIP IF NO. OF RECORDS NOT ONE F5600428 LDA SIZE BLOCK SIZE = SECTOR SIZE F5600429 JMP* P090 F5600430P080 MUI- RECLEN,I BLOCK SIZE = NO. OF RECORDS X RECORD LENGTH F5600431P090 STA* BLKSIZ F5600432* F5600433 LDQ =XSECADR DO READ F5600434 LDA PCTABL F5600435 STA- I F5600436 RTJ MMREAD F5600437 INQ 1 F5600438 SQZ P093 SKIP IF ADDRESS COMPUTATION ERROR F5600439 SQP P095 SKIP IF NO ERROR F5600440 LDA =N$8020 RETURN WITH I/O ERROR F5600441 JMP* P094 F5600442P093 LDA =N$C020 F5600443ÐÐP094 STA STATUS F5600444 JMP EXIT F5600445P095 LDA* LOCATE RESET I-REG TO FCB ADDRESS F5600446 STA- I F5600447 JMP* P100 F5600448 EJT F5600449* F5600450* MISCELLANEOUS STORAGE F5600451* F5600452LOCATE ADC 0 F5600453REQBFA ADC 0 F5600454NOMISS NUM 0 COUNT NO. OF RECORDS CHECKED SO FAR F5600455 SPC 2 F5600456CHKKIB NUM 0 F5600457* F5600458ISAVE NUM 0 F5600459QSAVE NUM 0 F5600460INDEX NUM 0 POINTER TO RECORD WITHIN 'BUF' F5600461RECCNT NUM 0 NO. OF RECORDS CHECKED F5600462CNTMSB NUM 0 COUNT OF EXISTING DATA RECORDS (MSB) F5600463CNTLSB NUM 0 COUNT OF EXISTING DATA RECORDS (LSB) F5600464DONMSB NUM 0 RRN OF THE LAST PROCESSED RECORD F5600465DONLSB NUM 0 PICKED UP FROM MARKER OR FCB F5600466 SPC 3 F5600467* PARAMETER LIST FOR MM READ F5600468ÐÐSECADR BZS SECADR(2) MM I/O SECTOR ADDRESS F5600469RELREC BZS RELREC(2) RELATIVE RECORD NO. F5600470RECSIZ NUM 0 RECORD LENGTH (BIT 15 SET IF SECTOR ALIGNED) F5600471BLKSIZ NUM 0 NO. OF WORDS TO READ F5600472 NUM 0 WORD OFFSET F5600473BUFADR ADC SPARE I/O BUFFER ADDRESS F5600474 NUM 0 FILE I/O FLAG F5600475 SPC 3 F5600476* PARAMETER LIST FOR SUBTRACT F5600477TOTMSB NUM 0 TOTAL NO. OF RECORDS (MSB) F5600478TOTLSB NUM 0 TOTAL NO. OF RECORDS (LSB) F5600479STRTRC BZS STRTRC(2) RELATIVE RECORD NO. (MSB/LSB) F5600480RESLTM NUM 0 RESULT (MSB) F5600481RESLTL NUM 0 RESULT (LSB) F5600482SUBOV NUM 0 OVERFLOW INDICATOR F5600483 SPC 3 F5600484* PARAMETER LIST FOR ADD F5600485OLDREC BZS OLDREC(2) CURRENT STARTING RECORD NO. F5600486NUMREC BZS NUMREC(2) NO. OF RECORDS READ F5600487NEWREC BZS NEWREC(2) NEW STARTING RECORD NO. F5600488ADDOV NUM 0 F5600489 EJT F5600490* F5600491* LOOP THROUGH RECORDS JUST READ UNTIL END-OF-FILE F5600492* F5600493ÐÐP100 LDQ* BUFADR GET INDEX TO FIRST RECORD F5600494 STQ* INDEX F5600495 ENA 0 ZERO OUT RECORD COUNTER F5600496 STA* RECCNT F5600497* F5600498P110 LDA- (ZERO),Q GET WORD 1 OF RECORD F5600499 LDQ- 1,Q GET WORD 2 OF RECORD F5600500 EAQ A COMPARE THE 2 WORDS F5600501 SAZ P120 SKIP IF THE SAME F5600502 JMP* P130 GO BUMP EXISTING RECORD COUNTER F5600503* F5600504P120 TRQ A F5600505 EOR =XFMEOFC CHECK FOR END-OF-FILE F5600506 SAN P130 SKIP IF NO F5600507* F5600508 LDQ* INDEX F5600509 LDA- 2,Q GET RRN OF THE LAST PROCESSED RECORD F5600510 STA* DONMSB FOR STORING IN FCB AND REQUEST BUFFER F5600511 LDA- 3,Q F5600512 STA* DONLSB F5600513 JMP* P200 ALL DONE F5600514* F5600515P130 LDA* CNTLSB BUMP NO. OF EXISTING RECORDS F5600516 LDQ* CNTMSB 121*4624F5600517 RTJ FMBRRN BUMP BY 1 121*4624F5600518ÐÐ STA* CNTLSB STORE IT BACK 121*4624F5600519 STQ* CNTMSB 121*4624F5600520 LDA* CHKKIB F5600521 SAN P145 F5600522 RAO* NOMISS ADD ONE TO NO. OF RECORDS MISSED F5600523 LDA* NOMISS IF MORE THAN FMNRCD RECORDS CHECKED. F5600524 SUB =XFMNRCD YET EOF IS NOT FOUND YET. MUST BE LOST F5600525 SAM P145 DURING SYSTEM CRASH. F5600526 JMP* P093 SET ERROR FLAG AND LEAVE F5600527* F5600528P145 EQU P145(*) F5600529 RAO* RECCNT BUMP NO. OF RECORDS CLEARED F5600530 LDA* RECCNT F5600531 SUB* NUMREC+1 F5600532 SAZ P150 SKIP IF ALL RECORDS HAVE BEEN CHECKED F5600533 LDQ* INDEX INCREMENT INDEX TO NEXT RECORD F5600534 ADQ- RECLEN,I F5600535 STQ* INDEX F5600536 JMP* P110 CONTINUE F5600537 EJT F5600538* F5600539* COMPUTE RELATIVE RECORD NO. OF NEXT SET OF RECORDS F5600540* F5600541P150 LDA* STRTRC SET UP CALL TO ADD F5600542 STA* OLDREC F5600543ÐÐ LDA* STRTRC+1 F5600544 STA* OLDREC+1 F5600545 LDQ =XOLDREC ADD NO. OF RECORDS READ TO OLD F5600546 RTJ DWADD STARTING RECORD NO. F5600547 LDQ* NEWREC RETURN NEW RECORD NO. F5600548 STQ* STRTRC F5600549 LDA* NEWREC+1 F5600550 STA* STRTRC+1 F5600551 ALS 1 CONVERT IT TO RELATIVE RECORD NO. FORMAT F5600552 LRS 1 F5600553 STQ* RELREC F5600554 STA* RELREC+1 F5600555 JMP P050 GO CHECK FOR END-OF-FILE F5600556 EJT F5600557* F5600558* CHECK IF FCB UPDATE IS COMPLETE F5600559* F5600560P200 LDA* SECADR CHECK IF HAVE UPDATED KEY INDEX F5600561 EOR- KEYBAM,I F5600562 SAN P220 F5600563 JMP* P230 SKIP IF YES F5600564 LDA* SECADR+1 F5600565 EOR- KEYBAL,I F5600566 SAN P220 F5600567 JMP* P230 YES, SKIP F5600568ÐÐ* F5600569P220 EQU P220(*) F5600570 LDQ* REQBFA F5600571 LDA* CNTMSB UPDATE RRN OF THE LATEST 'NEW' REOCRD IN FCB F5600572 STA- NEWRNM,I AND REQUEST BUFFER F5600573 STA- NETRNM,Q F5600574 LDA* CNTLSB F5600575 STA- NEWRNL,I F5600576 STA- NETRNL,Q F5600577* F5600578 LDA* DONMSB UPDATE RRN OF LAST PROCESSED RECORD IN FCB F5600579 STA- PRSRNM,I F5600580 STA- PRCRNM,Q F5600581 LDA* DONLSB F5600582 STA- PRSRNL,I AND REQUEST BUFFER F5600583 STA- PRCRNL,Q F5600584* F5600585 LDA- FCBIND,I CHECK IF FILE IS INDEXED F5600586 AND- ONEBIT (0001) F5600587 SAN P240 SKIP IF YES F5600588 JMP* EXIT F5600589* F5600590P230 LDA* RELREC UPDATE NEXT FREE KIB NO. F5600591 STA- NEXTBM,I F5600592 LDA* RELREC+1 F5600593ÐÐ STA- NEXTBL,I F5600594 JMP* EXIT F5600595 EJT F5600596* F5600597* PREPARE TO READ KEY INDEX BLOCKS TILL END-OF-FILE F5600598* F5600599P240 ENA 1 SET TO SEARCH KEY INDEX F5600600 STA* NUMREC+1 ONE RECORD AT A TIME F5600601 STA* CHKKIB F5600602* F5600603 LDA- KEYBAM,I SET I/O SECTOR ADDRESS F5600604 STA* SECADR F5600605 LDA- KEYBAL,I F5600606 STA* SECADR+1 F5600607* F5600608 LDA SIZE DETERMINE KIB SIZE F5600609 INA -96 F5600610 SAN P250 SENSE SECTOR LENGTH NOT 96 WORDS F5600611 LDA =N288 SET KIB LENGTH TO 288 F5600612 JMP* P260 F5600613* F5600614P250 LDA =N572 COMPUTE WORD LENGTH OF KIB F5600615 ENQ 0 F5600616 DVI SIZE F5600617 MUI SIZE F5600618ÐÐP260 EOR- ONEBIT+15 ($8000) F5600619 STA RECSIZ F5600620* F5600621 LDQ- NEXTBM,I START READ AT NEXT FREE KIB F5600622 STQ RELREC F5600623 LDA- NEXTBL,I F5600624 STA RELREC+1 F5600625 LLS 1 CONVERT TO MSB/LSB F5600626 ALS 15 F5600627 STQ STRTRC F5600628 STA STRTRC+1 F5600629* F5600630* F5600631 LDQ- TNKEYM,I SET UP ENDING KIB NO. (MSB/LSB) F5600632 LDA- TNKEYL,I F5600633 LLS 1 F5600634 ALS 15 F5600635 STQ TOTMSB F5600636 STA TOTLSB F5600637 JMP P050 GO DO READS F5600638 EJT F5600639* F5600640* ALL DONE F5600641* F5600642EXIT EQU EXIT(*) F5600643ÐÐ JMP (COMPRS) F5600644* PRIMARY F5600645 END F5600646 NAM BZS3K F57 A ITOS CCS 3.0 SL-149F5700001* BZS OF 3000 WORDS TO RESERVE PROCESSOR SWAP AREA SPACE F5700002* CREDIT COLLECTION SYSTEM VERSION 3.0 F5700003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F5700004* COPYRIGHT CONTROL DATA CORPORATION 1979 F5700005* F5700006* F5700007**** F5700008* RESERVE 3000 WORDS FOR USE AS MASS RESIDENT SWAP AREA F5700009**** F5700010 BZS BUFF(3000) F5700011 END F5700012 NAM FMENTP F58 A ITOS CCS 3.0 SL-149F5800001* FILE MANAGER REQUESTS ENTRY POINTS - NON-REENTRANT INTERCEPTOR F5800002* CREDIT COLLECTION SYSTEM VERSION 3.0 F5800003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F5800004* COPYRIGHT CONTROL DATA CORPORATION 1979 F5800005* F5800006* F5800007**** F5800008* FMENTP CONTAINS THE ENTRY POINTS FOR ALL FILE MANAGER F5800009* REQUESTS THAT CAN BE MADE BY THE NORMAL APPLICATION USER. F5800010ÐÐ* FMENTP INTERCEPTS ALL REQUESTS, PERFORMS SOME INITIALIZATIONF5800011* OF THE USER'S REQUEST BUFFER, SETS I-REG TO POINT TO REQBUF F5800012* AND EXECUTES A RETURN JUMP TO THE MAIN MEMORY RESIDENT FILE F5800013* MANAGER EXEC'S ENTRY POINT. THE FILE MANAGER EXEC RETURNS F5800014* TO FMENTP UPON COMPLETING A REQUEST. FMENTP WILL RETURN TO F5800015* THE CALLER. F5800016* F5800017* THE FOLLOWING INITIALIZATION OF THE USER'S REQUEST BUFFER F5800018* IS PERFORMED: F5800019* 1. Q-REG AND I-REG CONTENTS ARE SAVED IN REQBUF WORDS 5-6.F5800020* 2. REQBUF(1) IS CLEARED. F5800021* 3. THE CURRENT CONTROL POINT VALUE IS SAVED IN REQBUF(3). F5800022* 4. THE REQUEST INDEX IS COMPUTED AND STORED IN REQBUF(4). F5800023* 5. THE ABSOLUTE ADDRESS OF REQBUF(5) IS STORED IN F5800024* REQBUF(2). F5800025* 6. IF THE REQUEST IS FOR OPEN FILE, REQBUF(8) IS SET TO F5800026* ZERO (UCT ENTRY ADDRESS WORD). F5800027* F5800028* F5800029*E F5800030* FMENTP IS NONREENTRANT AND USABLE ONLY IN A SERIALIZED EXE- F5800031* CUTION ENVIRONMENT. PROGRAM FMCEPT SHOULD BE USED IN MAIN F5800032* MEMORY IF A REENTRANT VERSION IS NEEDED. F5800033* F5800034* FILE REQUESTS ENTRY POINTS F5800035ÐÐ ENT CREATE CREATE A FILE F5800036 ENT CLEAR CLEAR FILE F5800037 ENT DELETE DELETE FILE F5800038 ENT OPENFL OPEN FILE F5800039 ENT CLOSFL CLOSE FILE F5800040 ENT LOKFIL LOCK FILE F5800041 ENT UNLFIL UNLOCK FILE F5800042 ENT GETFCB GET FILE CONTROL BLOCK F5800043 ENT UPDFCB UPDATE FILE CONTROL BLOCK F5800044 ENT RENAME RENAME FILE F5800045 ENT PUTS PUT SEQUENTIAL RECORD F5800046 ENT WRITER WRITE INDEXED RECORD F5800047 ENT READR READ RECORD RANDOMLY F5800048 ENT GETS GET NEXT SEQUENTIAL RECORD F5800049 ENT UPDREC UPDATE RECORD F5800050 ENT DELREC DELETE RECORD F5800051 ENT COMFIL COMPRESS FILE F5800052 ENT VOLUSE ENABLE/DISABLE VOLUME USE F5800053 ENT REDUCE RETURN UNUSED FILE SPACE 122*4857F5800054* 122*4857F5800055* 122*4857F5800056* 122*4857F5800057 EXT CCP CONTROL POINT LOCATION F5800058 EXT END0V4 START OF PART 1 ADDRESS F5800059**** 122*4857F5800060ÐÐ EJT F5800061* EQUIVALENCES F5800062* COMMUNICATION REGION CONSTANTS F5800063 EQU ZERO(2) ZERO CONSTANT F5800064 EQU ONEMSK(3) ONE MASK TABLE F5800065 EQU ADRECT($E9) ADDRESS OF EXTENDED CORE TABLE F5800066 EQU FMEIDX(30) INDEX INTO EXT EXT CORE TABLE TO FM EXEC ENTRYF5800067* F5800068* REQUEST BUFFER INDEXES F5800069 EQU RBATHR(0) REQUEST BUFFER ADDRESS THREAD F5800070 EQU BUFAMP(1) BUFFER ADDRESS MAIN PART F5800071 EQU CNTLPT(2) CONTROL POINT (OR SPARE) F5800072 EQU RQINFO(3) REQUEST INFORMATION (MULTI-FIELD) F5800073 EQU QREG(4) Q REGISTER F5800074 EQU IREG(5) I REGISTER F5800075 EQU RTNADR(6) RETURN ADDRESS (UPON RETURN FROM EXEC) F5800076 EQU PARLST(6) ADDRESS OF PARAMETER LIST F5800077 EQU UCTADR(7) UCT ENTRY ABSOLUTE ADDRESS 122*4857F5800078* F5800079 EQU OPNIDX(4) OPENFL REQUEST INDEX F5800080 SPC 6 F5800081* *****************************************************************F5800082* ******** NOTE: THE ENTRY POINT ORDER MAY NOT BE CHANGED. F5800083* ******** 122*4857F5800084* ******** THE ENTRY POINT ORDER IS THE REVERSE OF THE O122*4857F5800085ÐÐ* ******** ENTRIES IN THE FMRCDT TABLE OF FMEXEC EXCEPT 122*4857F5800086* ******** THERE IS NO ENTRY FOR THE EXECUTIVE FUNCTION.122*4857F5800087* *****************************************************************F5800088 EJT F5800089* 122*4857F5800090REDUCE NUM 0 1. RETURN UNUSED FILE SPACE 122*4857F5800091 RTJ* CONT 122*4857F5800092* 122*4857F5800093VOLUSE NUM 0 2. ENABLE/DISABLE USE OF VOLUME 122*4857F5800094 RTJ* CONT F5800095* F5800096COMFIL NUM 0 3. COMPRESS FILE 122*4857F5800097 RTJ* CONT F5800098* F5800099DELREC NUM 0 4. DELETE RECORD 122*4857F5800100 RTJ* CONT F5800101* F5800102UPDREC NUM 0 5. UPDATE RECORD 122*4857F5800103 RTJ* CONT F5800104* F5800105GETS NUM 0 6. GET NEXT SEQUENTIAL RECORD 122*4857F5800106 RTJ* CONT F5800107* F5800108READR NUM 0 7. READ RECORD RANDOMLY 122*4857F5800109 RTJ* CONT F5800110ÐÐ* F5800111WRITER NUM 0 8. WRITE INDEXED RECORD 122*4857F5800112 RTJ* CONT F5800113* F5800114PUTS NUM 0 9. PUT SEQUENTIAL RECORD 122*4857F5800115 RTJ* CONT F5800116* F5800117RENAME NUM 0 10. RENAME FILE 122*4857F5800118 RTJ* CONT F5800119* F5800120UPDFCB NUM 0 11. UPDATE FILE CONTROL BLOCK 122*4857F5800121 RTJ* CONT F5800122* F5800123GETFCB NUM 0 12. GET FILE CON\ROL BLOCK 122*4857F5800124 RTJ* CONT F5800125* F5800126UNLFIL NUM 0 13. UNLOCK FILE 122*4857F5800127 RTJ* CONT F5800128* F5800129LOKFIL NUM 0 14. LOCK FILE 122*4857F5800130 RTJ* CONT F5800131* F5800132CLOSFL NUM 0 15. CLOSE FILE 122*4857F5800133 RTJ* CONT F5800134* F5800135ÐÐOPENFL NUM 0 16. OPEN FILE 122*4857F5800136 RTJ* CONT F5800137* F5800138DELETE NUM 0 17. DELETE FILE 122*4857F5800139 RTJ* CONT F5800140* F5800141CLEAR NUM 0 18. CLEAR FILE 122*4857F5800142 RTJ* CONT F5800143* F5800144CREATE NUM 0 19. CREATE FILE 122*4857F5800145 RTJ* CONT F5800146* INITIALIZE FIRST 6 WORDS OF REQUEST BUFFER F5800147* F5800148CONT NUM 0 F5800149 RTJ* HERE GET ABSOLUTE ADDRESS (OF CONT) F5800150HERE NUM 0 F5800151 STQ* QTEMP SAVE Q TEMPORARILY F5800152 LDQ* CONT F5800153 INQ -2 F5800154 LDQ- (ZERO),Q PICKUP ADDRESS OF USER PARAMETER LIST F5800155 STQ* PLIST SAVE IT F5800156 TRQ A SET A TO ADDRESS OF ADDRESS TO BE CHECKED F5800157 SAM AP05 SKIP IF FROM PART 1 F5800158 SUB =XEND0V4 CHECK IF PART 1 EXTENDS INTO BANK 0 F5800159 SAM AP10 SKIP IF NO F5800160ÐÐ* F5800161AP05 LDA- (ZERO),Q REQUEST FROM PART 1, ABSOLUTE ADDRESSING ONLY F5800162 JMP* AP20 F5800163* F5800164AP10 LDA- (ZERO),Q REQUEST FROM PART 0, A = ABS/REL PARAMETER ADRF5800165 SAP AP20 F5800166 AAQ A ABSOLUTIZE RELATIVE PARAMETER ADDRESS F5800167 AND- ONEMSK+14 F5800168AP20 LDQ- I PICK UP I-REG CONTENTS F5800169 STA- I SET I TO REQBUF ADDRESS F5800170 INA 4 F5800171 STA- BUFAMP,I SET REQBUF+4 ADDRESS F5800172 STQ- IREG,I SAVE ORIGINAL I-REG CONTENTS IN REQBUF F5800173 CLR A F5800174 STA- (ZERO),I CLEAR REQBUF(1) AND SAVE CONTROL POINT F5800175 LDA CCP F5800176 STA- CNTLPT,I PROTECT VIOLATION WILL BE FORCED IF USER F5800177* UNPROTECTED AND REQBUF PROTECTED F5800178 LDA* PLIST F5800179 STA- PARLST,I STORE USERS PARAM LIST ADDRESS IN REQBUF F5800180 LDA* HERE COMPUTE REQUEST INDEX AS A FUNCTION OF THE F5800181 SUB* CONT RELATIVE DISTANCE BETWEEN CONT AND THE REQUESTF5800182 INA -2 USED. F5800183 ENQ 0 F5800184 ARS 1 F5800185ÐÐ LDQ* QTEMP RELOAD Q WITH SAVED VALUE F5800186 STQ- QREG,I STORE IN REQBUF F5800187 INA 1 BUMP BY 1 F5800188 STA- RQINFO,I STORE REQUEST INDEX F5800189 INA -OPNIDX F5800190 SAN CONTIN SKIP IF NOT OPENFL CALL F5800191 STA- UCTADR,I CLEAR UCTADR WORD 122*4857F5800192CONTIN ENQ FMEIDX EXECUTE FILE MANAGER REQUEST EXECUTIVE F5800193 LDQ- (ADRECT),Q F5800194 RTJ- (ZERO),Q F5800195 EJT F5800196* RETURN FROM EXECUTIVE F5800197 LDA- RTNADR,I GET RETURN ADDRESS F5800198 STA* QTEMP SAVE FOR RETURN F5800199 LDQ- QREG,I RESTORE SAVED Q-REG AND I-REG F5800200 LDA- IREG,I F5800201 STA- I F5800202 JMP* (QTEMP) RETURN TO CALLER F5800203 SPC 3 F5800204PLIST NUM 0 SAVED USER PARAMETER LIST ADDRESS F5800205QTEMP NUM 0 SAVED Q-REG F5800206 END F5800207 NAM FMCEPT F59 A ITOS CCS 3.0 SL-149F5900001* FILE MANAGER REQUESTS ENTRY POINTS - REENTRANT INTERCEPTOR F5900002* CREDIT COLLECTION SYSTEM VERSION 3.0 F5900003ÐÐ* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA F5900004* COPYRIGHT CONTROL DATA CORPORATION 1979 F5900005* F5900006* F5900007**** F5900008* FMCEPT CONTAINS THE ENTRY POINTS FOR ALL FILE MANAGER F5900009* REQUESTS THAT CAN BE MADE BY THE NORMAL APPLICATION USER. F5900010* FMCEPT INTERCEPTS ALL REQUESTS, PERFORMS SOME INITIALIZATIONF5900011* OF THE USER'S REQUEST BUFFER, SETS I-REG TO POINT TO REQBUF F5900012* AND EXECUTES A RETURN JUMP TO THE MAIN MEMORY RESIDENT FILE F5900013* MANAGER EXEC'S ENTRY POINT. THE FILE MANAGER EXEC RETURNS F5900014* TO FMCEPT UPON COMPLETING A REQUEST. FMCEPT WILL RETURN TO F5900015* THE CALLER. F5900016* F5900017* THE FOLLOWING INITIALIZATION OF THE USER'S REQUEST BUFFER F5900018* IS PERFORMED: F5900019* 1. Q-REG AND I-REG CONTENTS ARE SAVED IN REQBUF WORDS 5-6.F5900020* 2. REQBUF(1) IS CLEARED. F5900021* 3. THE CURRENT CONTROL POINT VALUE IS SAVED IN REQBUF(3). F5900022* 4. THE REQUEST INDEX IS COMPUTED AND STORED IN REQBUF(4). F5900023* 5. THE ABSOLUTE ADDRESS OF REQBUF(5) IS STORED IN F5900024* REQBUF(2). F5900025* 6. IF THE REQUEST IS FOR OPEN FILE, REQBUF(8) IS SET TO F5900026* ZERO (UCT ENTRY ADDRESS WORD). F5900027* F5900028ÐÐ* F5900029* FMCEPT IS REENTRANT. THIS VERSION SHOULD BE USED IN MAIN F5900030* MEMORY ONLY. A DIFFERENT VERSION SHOULD BE USED FOR BACK- F5900031* GROUND AND/OR TIMESHARE-LIKE SWAPPING ENVIRONMENTS. F5900032*E F5900033* FILE REQUESTS ENTRY POINTS F5900034 ENT CREAT CREATE FILE CREATE F5900035 ENT DELET DELETE FILE DELETE F5900036 ENT OPENF OPEN FILE OPENFL F5900037 ENT CLOSF CLOSE FILE CLOSFL F5900038 ENT RENAM RENAME FILE RENAME F5900039 ENT PUTZ PUT SEQUENTIAL RECORD. PUTS F5900040 ENT READRX READ RECORD RANDOMLY READR F5900041 ENT GETZ GET NEXT SEQUENTIALLY GETS F5900042 ENT UPREC UPDATE RECORD UPDREC F5900043 ENT REDUC RETURN UNUSED FILE SPACE REDUCE F5900044* F5900045* F5900046 EXT CCP CONTROL POINT LOCATION F5900047 EXT END0V4 START OF PART 1 ADDRESS 121*4573F5900048**** F5900049 EJT F5900050* EQUIVALENCES F5900051* COMMUNICATION REGION CONSTANTS F5900052 EQU ZERO(2) ZERO CONSTANT F5900053ÐÐ EQU ONEMSK(3) ONE MASK TABLE F5900054 EQU ADRECT($E9) ADDRESS OF EXTENDED CORE TABLE F5900055 EQU FMEIDX(30) INDEX INTO EXT EXT CORE TABLE TO FM EXEC ENTRYF5900056* F5900057* REQUEST BUFFER INDEXES F5900058 EQU RBATHR(0) REQUEST BUFFER ADDRESS THREAD F5900059 EQU BUFAMP(1) BUFFER ADDRESS MAIN PART F5900060 EQU CNTLPT(2) CONTROL POINT (OR SPARE) F5900061 EQU RQINFO(3) REQUEST INFORMATION (MULTI-FIELD) F5900062 EQU QREG(4) Q REGISTER F5900063 EQU IREG(5) I REGISTER F5900064 EQU RTNADR(6) RETURN ADDRESS (UPON RETURN FROM EXEC) F5900065 EQU PARLST(6) ADDRESS OF PARAMETER LIST F5900066 EQU UCTADR(7) UCT ENTRY ABSOLUTE ADDRESS 121*4573F5900067* F5900068 EQU OPNIDX(4) OPENFL REQUEST INDEX F5900069* F5900070* FILE MANAGER SUBROUTINES F5900071 EXT ABSPAR ABSOLUTIZE PARAMETER ADDRESS F5900072 EJT F5900073* *****************************************************************F5900074* ******** NOTE: THE ENTRY POINT ORDER MAY NOT BE CHANGED. F5900075* ******** F5900076* ******** THE ENTRY POINT ORDER IS THE REVERSE OF THE ORDER OF F5900077* ******** ENTRIES IN THE FMRCDT TABLE OF FMEXEC EXCEPT THAT F5900078ÐÐ* ******** THERE IS NO ENTRY FOR THE EXECUTIVE FUNCTION. F5900079* *****************************************************************F5900080 SPC 2 F5900081* 122*4856F5900082REDUC NUM 0 1. RETURN UNUSED FILE SPACE F5900083 IIN 0 122*4856F5900084 RTJ* CONT 122*4856F5900085* 122*4856F5900086VOLUSE NUM 0 2. ENABLE/DISABLE USE OF VOLUME 122*4856F5900087 IIN 0 F5900088 RTJ* CONT F5900089* F5900090COMFIL NUM 0 3. COMPRESS FILE 122*4856F5900091 IIN 000 F5900092 RTJ* CONT F5900093* F5900094DELREC NUM 0 4. DELETE RECORD 122*4856F5900095 IIN 000 F5900096 RTJ* CONT F5900097* F5900098UPREC NUM 0 5. UPDATE RECORD F5900099 IIN 000 F5900100 RTJ* CONT F5900101* F5900102GETZ NUM 0 6. GET NEXT SEQUENTIAL RECORD F5900103ÐÐ IIN 000 F5900104 RTJ* CONT F5900105* F5900106READRX NUM 0 7. READ RECORD RANDOMLY F5900107 IIN 000 F5900108 RTJ* CONT F5900109* F5900110WRITER NUM 0 8. WRITE INDEXED RECORD 122*4856F5900111 IIN 000 F5900112 RTJ* CONT F5900113* F5900114PUTZ NUM 0 9. PUT SEQUEINTAL RECORD F5900115 IIN 000 F5900116 RTJ* CONT F5900117* F5900118RENAM NUM 0 10. RENAME FILE F5900119 IIN 000 F5900120 RTJ* CONT F5900121* F5900122UPDFCB NUM 0 11. UPDATE FILE CONTROL BLOCK 122*4856F5900123 IIN 000 F5900124 RTJ* CONT F5900125* F5900126GETFCB NUM 0 12. GET FILE CON\ROL BLOCK 122*4856F5900127 IIN 000 F5900128ÐÐ RTJ* CONT F5900129* F5900130UNLFIL NUM 0 13. UNLOCK FILE 122*4856F5900131 IIN 000 F5900132 RTJ* CONT F5900133 EJT F5900134LOKFIL NUM 0 14. LOCK FILE 122*4856F5900135 IIN 000 F5900136 RTJ* CONT F5900137* F5900138CLOSF NUM 0 15. CLOSE FILE F5900139 IIN 000 F5900140 RTJ* CONT F5900141* F5900142OPENF NUM 0 16. OPEN FILE F5900143 IIN 000 F5900144 RTJ* CONT F5900145* F5900146DELET NUM 0 17. DELETE FILE F5900147 IIN 000 F5900148 RTJ* CONT F5900149* F5900150CLEAR NUM 0 18. CLEAR FILE 122*4856F5900151 IIN 000 F5900152 RTJ* CONT F5900153ÐÐ* F5900154CREAT NUM 0 19. CREATE FILE F5900155 IIN 000 F5900156 RTJ* CONT F5900157* F5900158* F5900159* INITIALIZE FIRST 6 WORDS OF REQUEST BUFFER F5900160CONT NUM 0 F5900161 RTJ* HERE GET ABSOLUTE ADDRESS (OF CONT) F5900162HERE NUM 0 F5900163 STQ* QTEMP SAVE Q TEMPORARILY F5900164 LDQ* CONT F5900165 INQ -3 F5900166 LDQ- (ZERO),Q PICKUP ADDRESS OF USER PARAMETER LIST F5900167 STQ* PLIST SAVE IT F5900168 TRQ A SET A TO ADDRESS OF ADDRESS TO CHECK 121*4573F5900169 SAM AP05 SKIP IF FROM PART 1 121*4573F5900170 SUB =XEND0V4 CHECK IF PART 1 EXTENDS INTO BANK 0 121*4573F5900171 SAM AP10 SKIP IF NO 121*4573F5900172* 121*4573F5900173AP05 LDA- (ZERO),Q REQUEST FROM PART 1, ABSOLUTE 121*4573F5900174 JMP* AP20 ADDRESSING ONLY 121*4573F5900175* 121*4573F5900176AP10 LDA- (ZERO),Q REQUEST FROM PART 0, A = ABS/REL 121*4573F5900177 SAP AP20 PARAMETER ADRESSING 121*4573F5900178ÐÐ AAQ A ABSOLUTIZE RELATIVE PARAMETER ADDRESS 121*4573F5900179 AND- ONEMSK+14 121*4573F5900180 IIN 0 121*4573F5900181AP20 LDQ- I PICK UP I-REG CONTENTS 121*4573F5900182 STA- I SET I TO REQBUF ADDRESS F5900183 INA 4 F5900184 STA- BUFAMP,I SET REQBUF+4 ADDRESS F5900185 STQ- IREG,I SAVE ORIGINAL I-REG CONTENTS IN REQBUF F5900186 CLR A F5900187 STA- (ZERO),I CLEAR REQBUF(1) AND SAVE CONTROL POINT F5900188 LDA CCP F5900189 STA- CNTLPT,I PROTECT VIOLATION WILL BE FORCED IF USER F5900190* UNPROTECTED AND REQBUF PROTECTED F5900191 EJT F5900192 LDA* PLIST F5900193 STA- PARLST,I STORE USERS PARAM LIST ADDRESS IN REQBUF F5900194 LDA* HERE COMPUTE REQUEST INDEX AS A FUNCTION OF THE F5900195 SUB* CONT RELATIVE DISTANCE BETWEEN CONT AND THE REQUESTF5900196 INA -2 USED. F5900197 ENQ 0 F5900198 DVI- ONEMSK+1 F5900199 EIN 0 REENABLE INTERRUPTS F5900200 LDQ* QTEMP RELOAD Q WITH SAVED VALUE F5900201 STQ- QREG,I STORE IN REQBUF F5900202 INA 1 BUMP BY 1 F5900203ÐÐ STA- RQINFO,I STORE REQUEST INDEX F5900204 INA -OPNIDX F5900205 SAN CONTIN SKIP IF NOT OPENFL CALL F5900206 STA- UCTADR,I CLEAR UCTADR WORD 121*4573F5900207CONTIN ENQ FMEIDX EXECUTE FILE MANAGER REQUEST EXECUTIVE F5900208 LDQ- (ADRECT),Q F5900209 RTJ- (ZERO),Q F5900210 SPC 3 F5900211 IIN 0 RETURN FROM EXECUTIVE F5900212 LDA- RTNADR,I GET RETURN ADDRESS F5900213 STA* QTEMP SAVE FOR RETURN F5900214 LDQ- QREG,I RESTORE SAVED Q-REG AND I-REG F5900215 LDA- IREG,I F5900216 STA- I F5900217 EIN 0 F5900218 JMP* (QTEMP) RETURN TO CALLER F5900219 SPC 3 F5900220PLIST NUM 0 SAVED USER PARAMETER LIST ADDRESS F5900221QTEMP NUM 0 SAVED Q-REG F5900222 END F5900223 NAM PROC19 F60 A ITOS CCS 3.0 SL-149F6000001* PROVIDE FMEXEC WITH ENTRY POINT TO REDUCE PROCESSOR F6000002* CREDIT COLLECTION SYSTEM VERSION 3.0 F6000003* DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA , CA. F6000004* COPYRIGHT CONTROL DATA CORPORATION 1979 F6000005ÐÐ* F6000006**** F6000007* F6000008* ENTRY POINT TO REDUCE F6000009* F6000010**** F6000011* F6000012 EXT REDUCE F6000013PROC19 ADC REDUCE F6000014 END F6000015 NAM CFCBTL F61 A ITOS CCS 3.0 SL-149 00001* COMPUTE LENGTH OF FCBT IN SECTORS. 00002* CREDIT COLLECTION SYSTEM VERSION 3.0 00003* DATA SYSTEM-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00004* COPYRIGHT CONTROL DATA CORPORATION 1979 00005* 00006**** 00007* THIS ROUTINE COMPUTES THE LENGTH OF THE FCBT IN SECTORS. 00008* 00009* CALLING SEQUENCE: 00010* CALL CFCBTL (LENGTH) 00011* 00012* PARAMETERS: 00013* LENGTH - PASSED BACK TO CALLER 00014* 00015ÐÐ* EXIT: 00016* Q AND I REGISTER CONTENTS ARE PRESERVED 00017* 00018*E 00019 ENT CFCBTL PROGRAM ENTRY POINT 00020* 00021* EXTERNALS 00022 EXT Q8PREP PREPARE TO PICK UP PARAMETER ADDRESSES 00023 EXT Q8PKUP PICKUP/ABSOLUTIZE PARAMETER ADDRESS 00024* 00025* 00026* COMMON DECLARATIONS 00027 COM PCTABL 00028 COM FCBMMA 00029 COM BUF(572) 00030 COM STATUS 00031 COM VIT13W(13) VIT FIRST 13 WORDS 00032 COM VIWPS WORDS PER SECTOR 00033 COM VITN2W(2) VIT - NEXT 2 WORDS 00034 COM VIMAXF MAXIMUM NUMBER OF FILES 00035 COM VITL4W(4) VIT - LAST 4 WORDS 00036 COM SPARE(111) 00037 EJT 00038CFCBTL 0 0 ENTRY 00039 STQ* QSAVE 00040ÐÐ RTJ Q8PREP 00041 ADC* CFCBTL 00042 RTJ Q8PKUP 00043 STA* LENGTH 00044* 00045 LDA VIMAXF LENGTH = ((VIMAXF*96)+95)/96 00046 MUI =N96 00047 INA 95 00048 DVI VIWPS 00049 STA* (LENGTH) STORE IT FOR USER 00050 LDQ* QSAVE 00051 JMP* (CFCBTL) RETURN 00052 SPC 2 00053QSAVE NUM 0 00054LENGTH NUM 0 00055 END 00056 NAM CPKIBL F62 A ITOS CCS 3.0 SL-149 00001* COMPUTE LENGTH OF KIB IN SECTORS 00002* CREDIT COLLECTION SYSTEM VERSION 3.0 00003* DATA SYSTEM-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00004* COPYRIGHT CONTROL DATA CORPORATION 1979 00005* 00006**** 00007* 00008* THIS ROUTINE COMPUTES THE LENGTH OF A KIB IN SECTORS 00009ÐÐ* IF SECTOR LENGTH IS 96 WORDS, KIB LENGTH IS SET TO 3 TO REMAIN 00010* COMPATIBLE WITH PREVIOUS VERSIONS. 00011* 00012* IF SECTOR LENGTH IS NOT 96 WORDS, KIB LENGTH IS SET TO THE NUMBER 00013* OF SECTORS OF DATA THAT WILL FIT INTO A 572 WORD BUFFER. 00014* 00015* CALLING SEQUENCE: 00016* CALL CPKIBL (LENGTH) 00017* 00018* PARAMETERS: 00019* LENGTH - PASSED BACK TO CALLER 00020* 00021* EXIT: 00022* Q AND I REGISTERS ARE PRESERVED 00023* 00024*E 00025 ENT CPKIBL PROGRAM ENTRY POINT 00026* 00027* EXTERNALS 00028 EXT Q8PREP PREPARE TO PICKUP PARAMETER ADDRESS 00029 EXT Q8PKUP PICKUP/ABSOLUTIZE PARAMETER ADDRESS 00030* 00031* COMMON DECLARATIONS 00032 COM PCTABL,FCBMMA,BUF(572),STATUS 00033 COM VIT13W(13) VIT - FIRST 13 WORDS 00034ÐÐ COM VIWPS WORDS PER SECTOR 00035 COM VITL7W(7) VIT - LAST 7 WORDS 00036 COM SPARE(111) 00037 EJT 00038CPKIBL 0 0 00039 STQ* QSAVE 00040 RTJ Q8PREP 00041 ADC* CPKIBL 00042 RTJ Q8PKUP 00043 STA* LENGTH 00044* 00045CP00 LDA VIWPS 00046 INA -96 00047 SAN CP10 SENSE NOT 96 WORD SECTORS 00048 ENA 3 USE 3 AS KIB LENGTH 00049 JMP* CP20 00050* 00051CP10 LDA =N572 COMPUTE LENGTH = 572/VIWPS 00052 ENQ 0 00053 DVI* (CP00+1) 00054CP20 STA* (LENGTH) STORE IT FOR USER 00055 LDQ* QSAVE 00056 JMP* (CPKIBL) RETURN 00057* 00058QSAVE NUM 0 00059ÐÐLENGTH NUM 0 00060 END 00061 MON 00001 MACRO COMMON G0100001C G01 F ITOS CCS 3.0 SL-149G0100002**** G0100003C MACRO CONTAINING COMMON DEFINITIONS FOR CREATE, G0100004C CLEAR, DELETE, RENAME AND REDUCE. G0100005C G0100006 COMMON PCTABL,FCBMMA,BUF(572),STATUS,VIT(21),FDB(2),FDS G0100007 COMMON NUMSEC(2),SPARE(98) G0100008 COMMON TNKEYM(2), KEYBAM(2), NEXTBM(2), DATBAM(2) G0100009 INTEGER PCTABL, BUF, VIT, FDB, FDS, STATUS, FCBMMA G0100010 INTEGER TNKEYM, DATBAM, SPARE G0100011**** G0100012 END G0100013 MACRO OPNCOM G0100014C DECK-ID G01 CCS 2.1 SL-126G0100015**** G0100016C MACRO CONTAINING COMMON DEFS FOR OPEN AND CLOSE SUBS G0100017C G0100018 COMMON PCTABL,FCBMMA,BUF(572),STATUS,VIT(21),FDB(2),FDS G0100019 COMMON MMUNIT,SIZE,FILE,SPARE(105) G0100020 INTEGER PCTABL, FCBMMA, BUF, STATUS, VIT, FDB, FDS, SIZE, FILE G0100021 INTEGER SPARE G0100022ÐÐ**** G0100023 END G0100024 MACRO VITEQU G0100025C DECK-ID G01 CCS 2.1 SL-126G0100026**** G0100027C MACRO CONTAINING VOLUME INFORMATION TABLE EQUIVALENCES G0100028C G0100029C VOLUME INFORMATION TABLE EQUIVALENCES G0100030 INTEGER VISLUN, VINAME(4), VINMBR, VIBMSM, VIBMSL, VIASDM G0100031 INTEGER VIASDL, VILBAM, VILBAL, VIWPS, VIFDDM, VIFDDL G0100032 INTEGER VIMAXF, VICURF, VINFDB, VINXTB, VINOOF, VIASDS G0100033 EQUIVALENCE (VISLUN, VIT(1)), (VINAME, VIT(2)), (VINMBR, VIT(6)) G0100034 EQUIVALENCE (VIBMSM, VIT(7)), (VIBMSL, VIT(8)), (VIASDM, VIT(9)) G0100035 EQUIVALENCE (VIASDL, VIT(10)) G0100036 EQUIVALENCE (VIASDS, VIT(11)), (VILBAM, VIT(12)) G0100037 EQUIVALENCE (VILBAL, VIT(13)), (VIWPS, VIT(14)) G0100038 EQUIVALENCE (VIFDDM, VIT(15)), (VIFDDL, VIT(16)) G0100039 EQUIVALENCE (VIMAXF, VIT(17)), (VICURF, VIT(18)) G0100040 EQUIVALENCE (VINFDB, VIT(19)), (VINXTB, VIT(20)) G0100041 EQUIVALENCE (VINOOF, VIT(21)) G0100042**** G0100043 END G0100044 MACRO FMCOM G0100045C DECK-ID G01 CCS 2.1 SL-126G0100046**** G0100047ÐÐC MACRO CONTAINING COMMON DEFS FOR INDEXED FILE PROCESSORS G0100048C G0100049C --- C O M M O N F O R F M --- G0100050C -- DEC 21 , 76 ------ G01000515 G0100052C --THE FIRST TWO CARDS MUST BE IN ORDER. G0100053C --VALUES SET BY THE FM EXEC G0100054 COMMON / / PCTADR G0100055 COMMON / / FCBAD G0100056 COMMON / / EOF G0100057 COMMON / / FTHRUD G0100058 COMMON / / I G0100059 COMMON / / J G0100060 COMMON / / KEYBSC (2) G0100061 COMMON / / KEYFND G0100062 COMMON / / KEYLNG G0100063 COMMON / / KEYLWD G0100064 COMMON / / KEYTYP G0100065 COMMON / / KEYVAL(15) G0100066 COMMON / / KIBBUF(572) G0100067C --THESE TWO EOF VALUES MUST BE AFTER THE KIB BUFFER G0100068 COMMON / / KIBE1 G0100069 COMMON / / KIBE2 G0100070 COMMON / / KIBHRL G0100071 COMMON / / KIBLEN G0100072ÐÐ COMMON / / KIBTYP G0100073 COMMON / / KISA (17) G0100074 COMMON / / KISA1 (17) G0100075 COMMON / / KISBUF(17) G0100076 COMMON / / KISD (17) G0100077 COMMON / / KISFND G0100078 COMMON / / KISIDX G0100079 COMMON / / KISLNG G0100080 COMMON / / KLIDX (4) G0100081 COMMON / / LASTKB G0100082 COMMON / / LASTSS G0100083 COMMON / / LCKFLG G0100084 COMMON / / MAXKIS G0100085 COMMON / / NEWBUF G0100086C --THESE TWO MUST BE IN THIS ORDER G0100087 COMMON / / NEWKBM G0100088 COMMON / / NEWKBL G0100089 COMMON / / NOROOT G0100090 COMMON / / NKIBNL G0100091 COMMON / / NKIBNM G0100092 COMMON / / NUMKIS G0100093 COMMON / / ORDER G0100094 COMMON / / PKIBNL G0100095 COMMON / / PKIBNM G0100096 COMMON / / RECBSC (2) G0100097ÐÐ COMMON / / RECLNG G0100098 COMMON / / REQSTA G0100099 COMMON / / RKIBNO ( 2) G0100100 COMMON / / ROOT G0100101 COMMON / / RRDATA(2) G0100102 COMMON / / SSET G0100103 COMMON / / TOTREC G0100104 COMMON / / WPS G0100105 COMMON / / ZERO2(2) G01001061 G0100107 INTEGER CMPSTG, DATFUL, BADKEY, BADREQ, EOF , ERRIDC, FCBAD G0100108 INTEGER FCBADR, FTHRUD, FWAKIS, HITEOF, KEYBSC, KEYFND, KEYLNG G0100109 INTEGER KEYLWD, KEYTYP, KEYVAL, KIBBUF, KIBE1 , KIBE2 , KIBHRL G0100110 INTEGER KEYLEN, KIBSEC, KIBTYP, KIDERR, KIDFUL, KISA , KISA1 G0100111 INTEGER KISBUF, KISD , KISFND, KISIDX, KISLNG, KLIDX , LASTKB G0100112 INTEGER LASTSS, LCKFLG, LCKIDC, MAXKIS, MMIOER, NEWBUF, NEWKBL G0100113 INTEGER NEWKIB(2) , NKIBNL, NKIBNM, NOKEY , NOROOT, NUMKIS G0100114 INTEGER ORDER , PCTADR, PKIBNL, PKIBNM, RCDLCK, RECBSC, RECDUP G0100115 INTEGER RECLNG, REQSTA, RKIBNO, ROOT , RRDATA, SSET , TOTREC G0100116 INTEGER VIWPS, WPS, ZERO2, PREID, PRETYP, FILEID G0100117 EQUIVALENCE (FILEID, KISD(1)) G0100118 EQUIVALENCE (PREID, KISD(2)), (PRETYP, KISD(3)) G0100119**** G01001201 G0100121 END G0100122ÐÐ MACRO FMCOM2 G0100123C DECK-ID G01 CCS 2.1 SL-126G0100124**** G0100125 BYTE (ERRIDC, REQSTA(15=15)) G0100126 BYTE (BADREQ, REQSTA(13=13)) G0100127 BYTE (DATFUL, REQSTA(12=12)) G0100128 BYTE (KIDERR, REQSTA(11=11)) G0100129 BYTE (KIDFUL, REQSTA(11=11)) G0100130 BYTE (BADKEY, REQSTA(9=9)) G0100131 BYTE (NOKEY , REQSTA( 9= 9)) G0100132 BYTE (HITEOF, REQSTA( 8= 8)) G0100133 BYTE (RCDLCK, REQSTA( 7= 7)) G0100134 BYTE (MMIOER, REQSTA( 5= 5)) G0100135 BYTE (RECDUP, REQSTA( 4= 4)) G0100136 BYTE (LCKIDC, REQSTA( 2= 2)) G01001371 G0100138 EXTERNAL FMEOFC G01001391 G0100140 EQUIVALENCE (NEWKIB (1) ,NEWKBM) G0100141 EQUIVALENCE (NEWKIB (2) ,NEWKBL) G0100142**** G01001431 G0100144 END G0100145 MACRO FMCOM3 G0100146C DECK-ID G01 ITOS 1.2 SUMMARY-126G0100147ÐÐ**** G0100148C BADKEY - STATUS BIT : PRIMARY KEY IN RECORD IS DIFFERENT G0100149C FROM VALUE PASSED BY USER G0100150C BADREQ - STATUS BIT : REQUEST BUFFER IS NOT IN PROPER G0100151C STATE G0100152C CMPSTG - INTEGER FUNCTION G0100153C DATFUL - STATUS BIT: INSUFFICIENT ROOM TO STORE DATA G0100154C EOF - EOF ENCOUNTERED FLAG G0100155C ERRIDC - STATUS BIT: REQUEST ABORTED G0100156C FCBAD - ADDR OF FCB FOR CURRENT FILE (IN MAIN MEMORY) G0100157C FTHRUD - FATHER KIB ALREADY UPDATED FLAG G0100158C FWAKIS - INTEGER FUNCTION G0100159C HITEOF - STATUS BIT: EOF ENCOUNTERED G0100160C I - SCRTACH G0100161C J - SCRTACH G0100162C KEYBSC - BEGINNING SECTOR ADDRESS OF KEY INFO STRUCTURE G0100163C KEYFND - EXACT KEY VALUE FOUND, SET BY POSKID G0100164C KEYLNG - LENGTH OF KEY (IN BYTES) CURRENTLY WORKED ON G0100165C KEYLWD - LENGTH OF KEY IN WORDS G0100166C KEYTYP - KEY TYPE FOR KEY BEING WORKED ON (1<=KEYTYP<=4) G0100167C KEYVAL - VALUE OF KEY BEING WORKED ON G0100168C KIBBUF - BUFFER FOR KIB CURRENTLY WORKED ON G0100169C KIBE1 - EOF VALUE G0100170C KIBE2 - EOF VALUE G0100171C KIBHRL - LENGTH OF HEADER IN KIB BLOCK, BEFORE KIS STARTS G0100172ÐÐC KIBLEN - LENGTH OF KIB IN WORDS G0100173C KIBSEC - NO. OF SECTORS PER KIB G0100174C KIBTYP - POSITION OF KIB TYPE IB KIB HEADER G0100175C KIDERR - KID IS NOT FULLY UPDATED BECASUE IT IS MESS UP G0100176C KIDFUL - STATUS BIT: INDEXES NOT FULLY UPDATED DUE TO G0100177C INSUFFICIENT ROOM IN KEY INFO G0100178C KISA - KIS TO BE ADDED IN AN UPDATE G0100179C KISA1 - KIS TO BE ADDED IN AN UPDATE G0100180C KISBUF - KIS BUFFER CURRENTLY WORKED ON G0100181C KISD - KIS TO BE DELETED IN AN UPDATE G0100182C KISFND - FLAG WHETHER THE EXACT KIS IS FOUND G0100183C SET BY POSKID G0100184C KISLNG - LENGHT OF A KIS IN WORDS G0100185C KLIDX - INDEX INTO ENTRIES IN FCB FOR KEY LENGTH G0100186C OF THE DIFFERENT KEY TYPE G0100187C LASTKB - FLAG THAT THE LAST KIB IS BEGIN USED G0100188C LASTSS - LAST S.S. ENCOUNTERED FLAG. SET IN SUBROUTINE G0100189C NEXTSS G0100190C LCKFLG - RECORD IS TO BE LOCKED FLAG G0100191C LCKIDC - STATUS BIT: FILE IS LOCKED INDICATOR G0100192C MAXKIS - MAX NUMBER OF KISES IN A KIB G0100193C MMIOER - STATUS BIT: MASS MEMORY I/O ERROR G0100194C NEWBUF - FLAG THAT THE KIB IS A NEW ONE G0100195C NEWKBL - NEW KIB NUMBER, LSB G0100196C NEWKBM - NEW KIB NUMBER, MSB G0100197ÐÐC NEWKIB - RELATIVE KIB NUMBER OF LASTEST KIB G0100198C NKIBNL - POSITION OF NEXT KIB, LEAST SIGNIFICANT BITS G0100199C NKIBNM - POSITION OF NEXT KIB, MOST SIGNIFICANT BITS G0100200C NOKEY - STATUS BIT: KEY IS NOT FOUND G0100201C NOROOT - KIB TYPE FOR NOT ROOT, NOR S.S G0100202C NUMKIS - POSITION OF NUMBER OF KIS IN KIB G0100203C ORDER - FLAG WHETHER RECORDS ARE PRESENTED IN ASCENDING G0100204C ORDER W.R.T. PRIMARY KEY G0100205C PCTADR - PROCESS CONTROL TABLE ADDRESS G0100206C PKIBNL - POSITION OF PREVIOUS KIB, LEAST SIGNIFICANT BITS G0100207C PKIBNM - POSITION OF PREVIOUS KIB, MOST SIGNIFICANT BITS G0100208C RCDLCK - STATUS BIT: RECORD TRYING TO RETRIEVE IS LOCKED G0100209C RECBSC - BEGINNING SECTOR ADDRESS OF DATA BLOCK G0100210C RECDUP - STATUS BIT: KEY IS DUPLICATED G0100211C RECLNG - RECORD LENGTH IN WORDS G0100212C REQSTA - STATUS OF REQUEST ,LOCAL VERSION OF ISTAT G0100213C RKIBNO - RELATIVE KIB NUMBER IN KEY INFO SECTION G0100214C ROOT - KIB TYPE FOR ROOT G0100215C RRDATA - RELATIVE RECORD NO. IN DATA FILE G0100216C SSET - KIB TYPE FOR SEQUENCE SET G0100217C TOTREC - TOTAL NUMBER OF RECORDS TO BE RETRIEVED IN THIS G0100218C REQUEST G0100219C VIWPS - WORDS PER SECTOR IN VOLUME G0100220C WPS - WORDS PER SECTOR FOR THIS VOLUME G0100221C ZERO2 - CONSTANT G0100222ÐÐC G0100223C ENTRY IN REQBUF G0100224C WORD 1 - Q REGISTER G0100225C WORD 2 - I REGISTER G0100226C WORD 3 - ADDRESS OF PARAMETER LIST G0100227C WORD 4 - UCT ENTRY INDEX AND ACESS MODE G0100228C WORD 5 - USER IDENTIFIER G0100229C WORD 6 - FCB ADDRESS G0100230C WORD 7 RETURN ADDRESS TO INTERCEPTOR G0100231C WORD 8 REQUEST PROCESSOR INDEX G0100232C WORD 9 BIT 15 = 0 DO NOT LOCK RECORD ON RETRIEVAL G0100233C BIT 15 = 1 LOCK RECORD ON RETRIEVAL G0100234C BITS 14-00 NUMBER OF RECORDS PER CALL G0100235C WORD 10 - KEY TYPE G0100236C WORD 11 - NO. OF RECORDS ACTUALLY RETRIEVED G0100237C WORD 12 - REL REC NO. OF FIRST RECORD STORED/RETRIEVED,MSB G0100238C WORD 13 - REL REC NO. OF FIRST RECORD STORED/RETRIEVED,LSB G0100239C WORD 14 - REL KIB NO. OF LAST RETRIEVED KIB, MSB G0100240C WORD 15 - REL KIB NO. OF LAST RETRIEVED KIB, LSB G0100241C WORD 16 - INDEX OF KIS POINTING TO RECORD LAST RETRIEVED G0100242C WORD 17 - REL REC NO. OF LAST RETRIEVED RECORD, MSB G0100243C WORD 18 - REL REC NO. OF LAST RETRIEVED RECORD, LSB G0100244C--------------------------------------------------------------------- G0100245**** G0100246. G0100247ÐÐ END G0100248 MACRO FMINIT G0100249C DECK-ID G01 ITOS 1.2 SUMMARY-126G01002502 G0100251C --INITIALIZE PARAMETERS FOR THIS PROCESSOR G01002522 G0100253C --CLEAR STATUS OF THIS REQUEST G0100254 REQSTA = 0 G01002552 G0100256 RECLNG = FCB (14) G0100257 RECBSC (1) = FCB (9) G0100258 RECBSC (2) = FCB (10) G0100259 KEYBSC (1) = FCB (18) G0100260 KEYBSC (2) = FCB (19) G01002612 G0100262 KLIDX(1) = 20 G0100263 KLIDX(2) = 22 G0100264 KLIDX(3) =24 G0100265 KLIDX(4) = 26 G01002661 G0100267C --COMPUTE LENGTH OF A KIB G0100268 CALL CPUTKL G01002691 G0100270 KIBHRL = 6 G0100271 NUMKIS = 1 G0100272ÐÐ NKIBNM = 2 G0100273 NKIBNL = 3 G0100274 PKIBNM = 4 G0100275 PKIBNL = 5 G0100276 KIBTYP = 6 G01002771 G0100278 ROOT = 0 G0100279 NOROOT = 1 G0100280 SSET = 2 G01002811 G0100282 ZERO2(1) = 0 G0100283 ZERO2(2) = 0 G0100284**** G01002854 G0100286 END G0100287 SUBROUTINE CREATE (IFCBAD, REQBUF, IDATA, ISTAT) G0200001 1 /G02 F ITOS CCS 3.0 SL-149G0200002C FILE MANAGER CREATE FILE REQUEST PROCESSOR G0200003C CREDIT COLLECTION SYSTEM VERSION 3.0 G0200004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G0200005C COPYRIGHT CONTROL DATA CORPORATION 1979 G0200006C G0200007C*** G0200008C G0200009C THIS ROUTINE PROCESSES REQUESTS TO THE FILE MANAGER TO CREATE A FILE.G0200010ÐÐC G0200011C TO CREATE A FILE MEANS TO: G0200012C A) RESERVE VOLUME SPACE FOR THE FILE'S DATA AND, IF THE FILE IS G0200013C INDEXED, RESERVE VOLUME SPACE FOR AND INITIALIZE THE FILE'S G0200014C KEY STRUCTURE. G0200015C B) BUILD THE FDS. G0200016C C) BUILD THE FCB. G0200017C G0200018C IF THE FILE IS THE FIRST FILE TO BE CREATED ON THE INDICATED VOLUME, G0200019C THE FDD, FCBT AND FIAT WILL BE CREATED. G0200020C G0200021C PARAMETERS: (ALL ARE INTEGER TYPE) G0200022C G0200023C IFCBAD - FCB CORE-IMAGE ADDRESS. UNUSED. G0200024C G0200025C REQBUF - 24 WORD SCRATCH BUFFER. UNUSED G0200026C G0200027C IDATA - 24 WORD BUFFER: G0200028C WORD CONTENTS G0200029C ---- -------- G0200030C 1 - 4 FILE NAME. G0200031C 5 - 8 FILE OWNER NAME. G0200032C 9 - 12 FILE'S VOLUME NAME. G0200033C 13 RECORD LENGTH IN EVEN NO. OF BYTES. G0200034C 14 - 15 NO. OF RECORDS (MSB/LSB). G0200035ÐÐC 16(15=15) RECORD-SECTOR ALIGNMENT FLAG. =1 IF ALIGNED, G0200036C =0 IF NOT. G0200037C 16(14=14) RECORD ORDERING FLAG. =1 IF RECORDS WILL BE G0200038C PRESENTED IN ORDER WRT PRIMARY KEY, =0 IF NOT. G0200039C (MEANINGFUL ONLY IF FILE IS INDEXED) G0200040C 16(13=1) UNUSED. G0200041C 16(0=0) FILE TYPE FLAG. =1 IF FILE IS INDEXED, G0200042C =0 IF NOT. G0200043C 17 BYTE LENGTH OF KEY 1 (PRIMARY KEY). G0200044C 18 BYTE POSITION OF KEY 1. G0200045C 19 BYTE LENGTH OF KEY 2. G0200046C 20 BYTE POSITION OF KEY 2. G0200047C 21 BYTE LENGTH OF KEY 3. G0200048C 22 BYTE POSITION OF KEY 3. G0200049C 23 BYTE LENGTH OF KEY 4. G0200050C 24 BYTE POSITION OF KEY 4. G0200051C ISTAT - COMPLETION STATUS SET ON RETURN TO CALLER: G0200052C BIT MEANING G0200053C --- ------- G0200054C 15 FILE REQUEST REJECTED. G0200055C 14* FILE REQUEST ILLEGAL. G0200056C 13* VOLUME NOT READY. G0200057C 12* INSUFFICIENT VOLUME SPACE FOR FILE. G0200058C 11* INSUFFICIENT SPACE IN FDD FOR FILE. G0200059C 10* NON-UNIQUE FILE/OWNER NAME. G0200060ÐÐC 9 - 6 UNASSIGNED. G0200061C 5* MASS MEMORY I/O ERROR. G0200062C 4 - 0 UNASSIGNED. G0200063C * : BIT 15 WILL ALSO BE SET G0200064C G0200065C G0200066C THE FOLLOWING SUBROUTINES ARE USED BY CREATE G0200067C BLDFDD BUILD FDD, FCBT AND FIAT G0200068C GETSPC GET MM SPACE FOR FILE'S DATA AND KEY INDEX G0200069C FCBIX RESERVE/RELEASE BLOCKS WITH A FCBT (VIA FIAT) G0200070C BLDFDS BUILD A FILE DIRECTORY SEGMENT G0200071C BLDFCB BUILD A FILE CONTROL BLOCK G0200072C STOLBL STORE VOLUME RESIDENT LABEL G0200073C FMSCOM FM EXEC SERIAL PROCESSOR COMPLETION ROUTINE G0200074C FNDVIT SEARCH VIT'S FOR GIVEN VOLUME G0200075C FMSWAP FM EXEC SWAP PROCESSORS ROUTINE G0200076C G0200077 EXTERNAL FMSWAP G0200078C FOR A DEFINITION OF COMMON, SEE MACRO COMMON G0200079M COMMON G0200080C G0200081 INTEGER IDATA(24) G0200082 INTEGER VITSIZ, VITADR, REQBUF(24), DATA(24), DATSIZ, RECLEN G0200083C G0200084C FOR A DEFINITION OF A VIT, SEE MACRO VITEQU G0200085ÐÐM VITEQU G0200086C G0200087C SIZE OF THE 'IDATA' PARAMETER AND 'DATA' ARRAY G0200088 DATA DATSIZ /24/ G0200089C G0200090C SIZE OF THE VOLUME INFORMATION TABLE AND 'VIT' ARRAY G0200091 DATA VITSIZ/21/ G0200092C G0200093C MASS STORAGE RELEASE PROCESSOR INDEX G0200094 DATA MASREL /15/ G0200095C*** G0200096. G0200097C G0200098C G0200099C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0200100C START OF CODE G0200101C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0200102C G0200103C LOCALIZE IDATA G0200104 DO 10 I = 1, DATSIZ G0200105 10 DATA(I) = IDATA(I) G0200106C G0200107C SET COMPLETION STATUS TO NO ERROR G0200108 STATUS = 0 G0200109C G0200110ÐÐC- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0200111C VALIDATE PARAMETERS G0200112C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0200113C G0200114C INSURE RECORD LENGTH IS POSITIVE G0200115 IF (DATA(13) .LE. 0) GO TO 9100 G02001162 G0200117C INSURE THAT THE TOTAL NUMBER OF RECORDS IS NON-ZERO AND G0200118C IS A 24 BIT NUMBER G0200119C G0200120 IF (AND( DATA(14), $FF00) .NE. 0) GO TO 9100 G0200121 IF (AND(DATA(14) ,$00FF) .NE. 0) GO TO 50 G0200122 IF (AND( DATA(15) ,$FF00) .NE. 0) GO TO 50 G0200123 IF (AND(DATA(15) ,$00FF) .EQ.0) GO TO 9100 G0200124 50 CONTINUE G02001252 G0200126C G0200127C CHECK IF FILE IS INDEXED G0200128 IF (AND (DATA(16),1) .EQ. 0) GO TO 200 G0200129C G0200130C YES: INSURE FIRST KEY IS DEFINED G0200131 IF (DATA(17) .EQ. 0) GO TO 9100 G0200132C G0200133C INSURE ANY DEFINED KEY FIELDS LIE TOTALLY WITHIN THE RECORD G0200134C AND KEY LENGTH LIMITATION G0200135ÐÐ DO 100 I = 17, 23, 2 G0200136 IF (DATA(I) .EQ. 0) GO TO 150 G0200137 IF (IDATA(I+1) .LE. 0) GO TO 9100 G0200138 IF (IDATA(I) .LT. 0 .OR. IDATA(I) .GT. 29) GO TO 9100 G0200139 IF (DATA(13) .LT. DATA(I)+DATA(I+1)-1) GO TO 9100 G0200140 100 CONTINUE G0200141 GO TO 200 G0200142C G0200143C INSURE NO OTHER KEYS ARE DEFINED G0200144 150 DO 160 I = I, 23, 2 G0200145 IF (DATA(I) .NE. 0) GO TO 9100 G0200146 160 CONTINUE G0200147C G0200148C GET THE APPLICABLE VOLUME INFORMATION TABLE ADDRESS G0200149 200 CALL FNDVIT (DATA(9), VITADR, MMUNIT) G0200150C G0200151C IF THE TABLE COULD NOT BE FOUND THEN THE VOLUME IS NOT READY G0200152 IF (VITADR .EQ. 0) GO TO 9110 G0200153C G0200154C LOCALIZE THE VIT G0200155 J = VITADR G0200156 DO 300 I = 1, VITSIZ G0200157C G0200158C LDQ J GET NEXT WORD IN MAIN MEMORY G0200159C LDA- (ZERO),Q G0200160ÐÐC STA K G0200161C G0200162 ASSEM $E800, J, $C622, $6800, K G0200163 VIT(I) = K G0200164 300 J = J + 1 G0200165C G0200166C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0200167C PREPERATORY PROCESSING G0200168C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0200169C G0200170C CREATE THE FDD ET AL IF THIS HAS NOT ALREADY BEEN DONE: CHECK IF NO. G0200171C BLOCKS IN FDD IS ZERO G0200172 IF (VINFDB .NE. 0) GO TO 400 G0200173 CALL BLDFDD G0200174 IF (STATUS .NE. 0) GO TO 10000 G0200175C G0200176C CHECK IF THIS VOLUME'S ALLOWED MAX NO. OF FILES ALREADY EXIST G0200177 400 IF (VIMAXF .EQ. VICURF) GO TO 9120 G0200178C G0200179C RESERVE AND INITIALIZE SPACE FOR DATA AND KEY INDEX G0200180 CALL GETSPC (DATA) G0200181 IF (STATUS .NE. 0) GO TO 10000 G0200182C G0200183C RESERVE AN FCB G0200184 CALL FCBIX (INDEX, 1) G0200185ÐÐ IF (STATUS .NE. 0) GO TO 440 G0200186C G0200187C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0200188C BUILD THE FDS G0200189C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0200190C G0200191 CALL BLDFDS (DATA, INDEX) G0200192 IF (STATUS .EQ. 0) GO TO 500 G0200193C G0200194C ERROR DETECTED: RELEASE THE FCB AND DATA/KEY SPACE G0200195 I = STATUS G0200196 CALL FCBIX (INDEX, 0) G0200197 GO TO 450 G0200198C G0200199C CALL IN SECONDARY PROCESSOR TO RELEASE MASS STORAGE G0200200 440 I = STATUS G0200201 450 BUF(1) = DATBAM(1) G0200202 BUF(2) = DATBAM(2) G0200203C G0200204C LDQ MASREL G0200205C ENA 1 G0200206C RTJ+ FMSWAP G0200207C G0200208 ASSEM $E800, MASREL, $0A01, $5400, +FMSWAP G0200209 STATUS = I G0200210ÐÐ GO TO 10000 G0200211C G0200212C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0200213C BUILD THE FCB G0200214C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0200215C G0200216 500 CALL BLDFCB (DATA, INDEX) G0200217 IF (STATUS .NE. 0) GO TO 10000 G0200218C G0200219C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0200220C UPDATE EXTERNAL DATA G0200221C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0200222C G0200223C INCREMENT CURRENT NO. OF FILES ON VOLUME G0200224 VICURF = VICURF + 1 G0200225C G0200226C UPDATE CORE-RESIDENT VIT G0200227 J = VITADR G0200228 DO 600 I = 1, VITSIZ G0200229 K = VIT(I) G0200230C G0200231C LDQ J G0200232C STA- (ZERO),Q G0200233C G0200234 ASSEM $E800, J, $6622 G0200235ÐÐ 600 J = J + 1 G0200236C G0200237C UPDATE THE VOLUME-RESIDENT LABEL G0200238 CALL STOLBL G0200239C G0200240C RETURN TO CALLER G0200241 GO TO 10000 G0200242C G0200243C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0200244C SET ERROR INDICATORS IN COMPLETION STATUS WORD G0200245C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0200246C G0200247C-- FILE REQUEST ILLEGAL G0200248 9100 STATUS = $C000 G0200249 GO TO 10000 G0200250C G0200251C-- VOLUME NOT READY G0200252 9110 STATUS = $A000 G0200253 GO TO 10000 G0200254C G0200255C-- INSUFFICIENT ROOM FOR DATA/KEY ON VOLUME: THIS ERROR IS DETECTED G0200256C BY THE ROUTINE 'GETSPC' G0200257C G0200258C-- INSUFFICIENT ROOM IN FDD FOR FDS: THIS ERROR IS DETECTED IN THE G0200259C ROUTINE 'BLDFDS' G0200260ÐÐC G0200261C-- VOLUME ALREADY CONTAINS MAX ALLOWED NO. OF FILES G0200262 9120 STATUS = $8800 G0200263C G0200264C-- NON-UNIQUE FILE/OWNER NAME: THIS ERROR IS DETECTED IN THE ROUTINE G0200265C 'BLDFDS' G0200266C G0200267C-- MASS-MEMORY I/O ERROR: THIS ERROR IS DETECTED IN VARIOUS ROUTINES G0200268C G0200269C G0200270C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0200271C G0200272C RETURN TO FILE MANAGER EXECUTIVE G020027310000 ISTAT = STATUS G0200274 CALL FMSCOM G0200275 RETURN G0200276 END G0200277 SUBROUTINE BLDFDD G0300001 1 /G03 F ITOS CCS 3.0 SL-149G0300002C GET VOLUME SPACE FOR VOLUME'S FDD, FCBT AND FIAT G0300003C CREDIT COLLECTION SYSTEM VERSION 3.0 G0300004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G0300005C COPYRIGHT CONTROL DATA CORPORATION 1979 G0300006C G0300007C*** G0300008ÐÐC G0300009C THIS ROUTINE RESERVES SPACE FOR AND INITIALIZES A VOLUME'S G0300010C - FILE DEFINITION DIRECTORY (FDD) G0300011C - FILE CONTROL BLOCK TABLE (FCBT) G0300012C - FILE INDEX ALLOCATION TABLE (FIAT) G0300013C G0300014C ON RETURN THE FOLLOWING COMMON VARIABLES WILL BE SET UP: G0300015C G0300016C STATUS - COMPLETION STATUS SET ON RETURN TO CALLER: G0300017C =0 : NO ERROR OCURRED G0300018C =$8800 : INSUFFICIENT SPACE ON THE VOLUME FOR THE TABLES G0300019C =$8020 : MASS MEMORY I/O ERROR G0300020C G0300021C THE FOLLOWING SUBROUTINES ARE USED BY BLDFDD G0300022C MWRITF WRITE MASS MEMORY - FTN INTERFACE TO MMWRIT G0300023C FMSWAP FM EXEC SWAP PROCESSORS ROUTINE G0300024C CFCBTL COMPUTE FCBT LENGTH IN SECTORS G0300025C G0300026C FOR A DEFINITION OF COMMON, SEE MACRO COMMON G0300027M COMMON G0300028C G0300029C G0300030 EXTERNAL FMSWAP G0300031C FOR A DEFINITION OF A VIT, SEE MACRO VITEQU G0300032M VITEQU G0300033ÐÐ INTEGER FOUR, TOTAL(2) G0300034C G0300035 DATA FOUR/4/, TOTAL(1)/0/ G0300036C MASS STORAGE ALLOCATOR PROCESSOR INDEX G0300037 DATA MASALC /14/ G0300038C*** G0300039C G0300040C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -G0300041C COMPUTE SIZE OF SPACE REQUIRED FOR FDD, FCBT, AND FIAT G0300042C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -G0300043C G0300044C COMPUTE MINIMUM NO. OF FDB'S REQUIRED FOR FDD G0300045 MINFDB = VIMAXF / ((VIWPS-1)/9) G0300046C G0300047C ROUND THE QUOTIENT UP G0300048C G0300049C SQZ 2 G0300050C RAO MINFDB G0300051C G0300052 ASSEM $0142, $D800, MINFDB G0300053C G0300054C USE TWICE THE MINIMUM NUMBER OF FDBS FOR WORST CASE HASHING G0300055 NUMFDB = MINFDB * 2 G0300056C G0300057C G0300058ÐÐC COMPUTE LENGTH OF FCBT IN SECTORS G0300059 CALL CFCBTL (NSECTS) G0300060C COMPUTE TOTAL REQUIRED FOR FDD ET ALL: TOTAL SO FAR+NSECTS G0300061C SECTORS FOR THE FCBT + 2 SECTORS FOR THE FIAT. G0300062 TOTAL(2) = NUMFDB + NSECTS + 2 G0300063C G0300064C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -G0300065C RESERVE SPACE FOR FDD, FCBT, AND FIAT G0300066C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -G0300067C G0300068C CHECK IF SUFFICIENT SPACE IS AVAILABLE G0300069 IF (VILBAM - TOTAL(1)) 70, 50, 60 G0300070 50 IF (VILBAL .LE. TOTAL(2)) GO TO 70 G0300071C G0300072C CALL IN SECONDARY PROCESSOR TO ALLOCATE SPACE G0300073 60 BUF(1) = TOTAL(1) G0300074 BUF(2) = TOTAL(2) G0300075C G0300076C LDQ MASALC G0300077C ENA 1 G0300078C RTJ+ FMSWAP G0300079C G0300080 ASSEM $E800, MASALC, $0A01, $5400, +FMSWAP G0300081 IF (STATUS .EQ. 0) GO TO 90 G0300082C G0300083ÐÐC MASS MEMORY I/O ERROR G0300084 STATUS = $8020 G0300085 GO TO 10000 G0300086C G0300087C INSUFFICIENT SPACE G0300088 70 STATUS = $8800 G0300089 GO TO 10000 G0300090C G0300091C GET ALLOCATED SPACE ADDRESS G0300092 90 VIFDDM = BUF(1) G0300093 VIFDDL = BUF(2) G0300094C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -G0300095C INITIALIZE, I.E. ZERO OUT, THE RESERVED SPACE G0300096C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -G0300097C G0300098 100 DO 110 I = 1, VIWPS G0300099 110 BUF(I) = 0 G0300100 J = TOTAL(2) G0300101 DO 200 I = 1, J G0300102 CALL MWRITF (VIFDDM, TOTAL, VIWPS, VIWPS, 0, BUF, 0, STATUS) G0300103 IF (STATUS .NE. 0) GO TO 10000 G0300104C G0300105 200 TOTAL(2) = TOTAL(2) - 1 G0300106C G0300107C UPDATE NO. OF FDD BLOCKS G0300108ÐÐ VINFDB = NUMFDB G0300109C G0300110C UPDATE NEXT AVAILABLE BLOCK POINTER G0300111 VINXTB = MINFDB + 1 G0300112C G0300113C RETURN WITH NO ERROR G0300114 STATUS = 0 G0300115C G0300116C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -- G0300117C G0300118C RETURN TO CALLER G030011910000 RETURN G0300120 END G0300121 SUBROUTINE GETSPC (DATA) G0400001 1 /G04 F ITOS CCS 3.0 . SL-149G0400002C GET VOLUME SPACE FOR FILE'S DATA AND KEY INDEX G0400003C CREDIT COLLECTION SYSTEM VERSION 3.0 G0400004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G0400005C COPYRIGHT CONTROL DATA CORPORATION 1979 G0400006C G0400007C*** G0400008C G0400009C THIS ROUTINE RESERVES SPACE FOR AND INITIALIZES A FILE'S DATA G0400010C RECORDS AND, IF THE FILE IS INDEXED, ITS KEY INDEX G0400011C G0400012ÐÐC PARAMETERS: (ALL ARE INTEGER TYPE) G0400013C G0400014C DATA - 24 WORD BUFFER. CONTENTS DEFINED IN 'CREATE' G0400015C G0400016C ON RETURN THE FOLLOWING COMMON VARIABLES WILL BE SET UP: G0400017C G0400018C VIT - VOLUME INFORMATION TABLE G0400019C NUMSEC - TOTAL NO. OF SECTOR REQUIRED BY FILE G0400020C TNKEYM - 2 WORD ARRAY RETURNED WITH THE TOTAL NO. OF KEY INDEX G0400021C BLOCKS (MSB/LSB) G0400022C KEYBAM - 2 WORD ARRAY RETURNED WITH KEY INDEX BEGINNING SECTOR G0400023C ADDRESS (MSB/LSB) G0400024C NEXTBM - 2 WORD ARRAY RETURNED WITH LINK TO KEY INDEX FREE G0400025C SPACE (MSB/LSB) G0400026C DATBAM - 2 WORD ARRAY RETURNED WITH DATA RECORD BEGINNING SECTOR G0400027C ADDRESS (MSB/LSB) G0400028C STATUS - COMPLETION STATUS SET ON RETURN TO CALLER: G0400029C =0 : NO ERROR OCURRRED G0400030C =$C000 : INVALID REQUEST PARAMETERS G0400031C =$9000 : INSUFFICIENT VOLUME SPACE FOR DATA/KEY G0400032C =$8020 : MASS MEMORY I/O ERROR G0400033C G0400034C G0400035C THE FOLLOWING SUBROUTINES ARE USED BY GETSPC G0400036C FMSWAP FM EXEC SWAP PROCESSORS ROUTINE G0400037ÐÐC MWRITF WRITE MASS MEMORY - FTN INTERFACE TO MMWRIT G0400038C FDWADD DOUBLE WORD ADD - FORTRAN INTERFACE G0400039C FDWMUI DOUBLE WORD MULTIPLY - FORTRAN INTERFACE G0400040C DWDIV DOUBLE WORD DIVIDE G0400041C CPKIBL COMPUTE KIB LENGTH IN SECTORS G0400042C G0400043C FOR A DEFINITION OF COMMON, SEE MACRO COMMON G0400044M COMMON G0400045 EXTERNAL FMSWAP, FMEOFC G0400046C G0400047 INTEGER DATA(24), NUMREC(2), TEMP(2), OV, N(2), MM1(2), NUMKIB(2)G0400048 INTEGER NUMDAT(2), SECREC, ONE(2) G0400049C G0400050C FOR A DEFINITION OF A VIT, SEE MACRO VITEQU G0400051M VITEQU G0400052C G0400053 DATA MM1(1)/0/ G0400054C G0400055C ALLOCATE MASS STORAGE PROCESSOR INDEX G0400056 DATA MASALC /14/, ONE(1),ONE(2)/0,1/ G0400057C G0400058C*** G0400059. G0400060C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0400061C START OF CODE G0400062ÐÐC- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0400063C G0400064C INITIALIZE COMPLETION STATUS TO NO ERROR G0400065 STATUS = 0 G0400066C G0400067C INITIALIZE COUNTERS G0400068 DO 10 I = 1, 2 G0400069 NUMREC(I) = 0 G0400070 NUMKIB(I) = 0 G0400071 10 NUMSEC(I) = 0 G0400072C G0400073C CONVERT NO. OF RECORDS FROM RELATIVE RECORD TO DOUBLE WORD FORMAT G0400074C G0400075C LDQ DATA(14) G0400076C LDA DATA(15) G0400077C LLS 1 G0400078C ALS 15 G0400079C STQ NUMREC(1) G0400080C STA NUMREC(2) G0400081C G0400082 ASSEM $E400, +DATA(14), $C400, +DATA(15), $0FE1, $0FCF G0400083 ASSEM $4800, NUMREC(1), $6800, NUMREC(2) G0400084C G0400085C G0400086C COMPUTE RECORD LENGTH IN WORDS , ALLOW FOR ODD BYTE LENGTH G0400087ÐÐ LENGTH = (DATA(13)+1) / 2 G0400088C G0400089C CHECK IF FILE IS INDEXED G0400090 IF (AND (DATA(16), 1) .EQ. 0) GO TO 200 G0400091C G0400092C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0400093C COMPUTE NO. OF SECTORS REQUIRED BY KEY INDEX G0400094C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0400095C G0400096C G0400097C COMPUTE KIB LENGTH IN SECTORS G0400098 CALL CPKIBL (INC) G0400099C G0400100C LOOP OVER ALL DEFINED KEYS G0400101 DO 100 I = 17, 23, 2 G0400102C G0400103C EXIT LOOP IF THIS KEY IS NOT USED G0400104 IF (DATA(I) .EQ. 0) GO TO 150 G0400105C G0400106C INITIALIZE LEVEL TO 0 (COUNT LEVELS USED ON A PER KEY BASIS) G0400107 LEVEL = 0 G0400108C G0400109C COMPUTE NO. OF KIS'S PER KIB G0400110 M = ((INC*VIWPS) - 6) / (2+ (DATA(I)+1)/2) G0400111C G0400112ÐÐC ASSUME KIB'S WILL BE 50 PCT FILLED G0400113 M = M / 2 G0400114 MM1(2) = M - 1 G0400115C G0400116C BEGINNING ON LEVEL 1 AND PROCEEDING THROUGH HIGHER LEVELS OF THE G0400117C KEY INDEX, COMPUTE AND TOTAL UP THE NO. OF KIB'S REQUIRED FOR EACH G0400118C LEVEL. TOP LEVEL IS REACHED WHEN REQUIRED KIB'S IS ONE G0400119 N(1) = NUMREC(1) G0400120 N(2) = NUMREC(2) G0400121C G0400122C BUMP LEVELS BY 1 G0400123 50 LEVEL = LEVEL + 1 G0400124C G0400125C COMPUTE NO. OF KIB'S THIS LEVEL G0400126 CALL FDWADD (N, MM1, N, OV) G0400127 IF (OV .NE. 0) GO TO 9110 G0400128 CALL DWDIV (N, M, N, OV) G0400129 IF (OV .NE. 0) GO TO 9110 G0400130C G0400131C SUM UP G0400132 CALL FDWADD (NUMKIB, N, NUMKIB, OV) G0400133 IF (OV .NE. 0) GO TO 9110 G0400134C G0400135C EXIT LOOP IF TOP LEVEL HAS BEEN REACHED G0400136 IF (N(1) .NE. 0 .OR. N(2) .GT. 1) GO TO 50 G0400137ÐÐC G0400138C IF LEVEL = 1, ADD 1 TO NO. OF KEBS G0400139 IF (LEVEL .EQ. 1) CALL FDWADD (NUMKIB,ONE,NUMKIB,OV) G0400140 IF (OV .NE. 0) GO TO 9110 G0400141 100 CONTINUE G0400142C G0400143C COMPUTE TOTAL NO. OF SECTORS REQUIRED G0400144 150 CALL FDWMUI (NUMKIB, INC, NUMSEC, OV) G0400145 IF (OV .NE. 0) GO TO 9110 G0400146C G0400147C RETURN TOTAL NO. OF KIB'S G0400148 TNKEYM(1) = NUMKIB(1) G0400149 TNKEYM(2) = NUMKIB(2) G0400150C G0400151C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0400152C COMPUTE NO. OF SECTORS REQUIRED BY DATA RECORDS G0400153C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0400154C G0400155C CHECK IF DATA RECORDS WILL BE SECTOR ALIGNED G0400156 200 IF (DATA(16) .LT. 0) GO TO 250 G0400157C G0400158C NO: SECTORS REQUIRED = LEAST INTEGER GREATER THAN (NO. OF RECORDS G0400159C TIMES RECORD LENGTH / SECTOR LENGTH) G0400160 CALL FDWMUI (NUMREC, LENGTH, NUMDAT, OV) G0400161 IF (OV .NE. 0) GO TO 9110 G0400162ÐÐ MM1(2) = VIWPS-1 G0400163 CALL FDWADD (NUMDAT, MM1, NUMDAT, OV) G0400164 IF (OV .NE. 0) GO TO 9110 G0400165 CALL DWDIV (NUMDAT, VIWPS, NUMDAT, OV) G0400166 IF (OV .NE. 0) GO TO 9110 G0400167 GO TO 280 G0400168C G0400169C RECORDS ARE SECTOR ALIGNED: NO. REQUIRED = NO. OF RECORD TIMES G0400170C NO. OF SECTORS REQUIRED PER RECORD G0400171C COMPUTE THE LATTER TERM G0400172 250 SECREC = LENGTH / VIWPS G0400173C G0400174C ROUND UP THE RESULT G0400175C G0400176C SQZ 2 G0400177C RAO SECREC G0400178C G0400179 ASSEM $0142, $D800, SECREC G0400180C G0400181C COMPUTE TOTAL G0400182 CALL FDWMUI (NUMREC, SECREC, NUMDAT, OV) G0400183 IF (OV .NE. 0) GO TO 9110 G0400184C G0400185C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0400186C RESERVE TOTAL SPACE REQUIRED G0400187ÐÐC- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0400188C G0400189 280 CALL FDWADD (NUMSEC, NUMDAT, NUMSEC, OV) G0400190 IF (OV .NE. 0) GO TO 9110 G0400191C G0400192C CHECK IF ENOUGH SPACE IS AVAILABLE G0400193 IF (VILBAM - NUMSEC(1)) 9130, 290, 300 G0400194 290 IF (VILBAL .LE. NUMSEC(2)) GO TO 9130 G0400195C G0400196C CALL IN SECONDARY PROCESSOR TO ALLOCATE SPACE G0400197 300 BUF(1) = NUMSEC(1) G0400198 BUF(2) = NUMSEC(2) G0400199C G0400200C LDQ MASALC G0400201C ENA 1 G0400202C RTJ+ FMSWAP G0400203C G0400204 ASSEM $E800, MASALC, $0A01, $5400, +FMSWAP G0400205 IF (STATUS .NE. 0) GO TO 9120 G0400206C G0400207C G0400208C PICK UP ALLOCATED SPACE ADDRESS G0400209 DATBAM(1) = BUF(1) G0400210 DATBAM(2) = BUF(2) G0400211C G0400212ÐÐC STORE END OF FILE CODE IN 1ST TWO WORDS OF I/O BUFFER G0400213C G0400214C LDA =XFMEOFC G0400215C STA BUF G0400216C STA BUF+1 G0400217C G0400218 ASSEM $C000,FMEOFC,$6400,+BUF(1),$6400,+BUF(2) G0400219C G0400220C WRITE OUT I/O BUFFER TO PROVIDE EOF IN FIRST RECORD G0400221 CALL MWRITF (DATBAM,ONE,VIWPS,VIWPS,0,BUF,0,STATUS) G0400222 IF (STATUS .NE. 0) GO TO 10000 G0400223C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0400224C INITIALIZE KEY INDEX G0400225C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0400226C G0400227C CHECK IF FILE IS INDEXED G0400228 350 IF (AND (DATA(16), 1) .EQ. 0) GO TO 10000 G0400229C G0400230C COMPUTE STARTING ADDRESS OF THE INDEX G0400231 CALL FDWADD (DATBAM, NUMDAT, KEYBAM, OV) G0400232 IF (OV .NE. 0) GO TO 9110 G0400233C G0400234C INITIALIZE RELATIVE RECORD NO. INTO INDEX G0400235 TEMP(1) = 0 G0400236 TEMP(2) = 1 G0400237ÐÐC G0400238C ZERO OUT THE I/O BUFFER G0400239 DO 360 I = 1, VIWPS G0400240 360 BUF(I) = 0 G0400241C G0400242C ZERO OUT 1 KIB PER USED KEY G0400243 DO 400 I = 17, 23, 2 G0400244C G0400245C EXIT LOOP IF THIS KEY IS NOT USED G0400246 IF (DATA(I) .EQ. 0) GO TO 450 G0400247C G0400248C WRITE OUT A ZEROED KIB G0400249 DO 400 J = 1, INC G0400250 CALL MWRITF (KEYBAM, TEMP, VIWPS, VIWPS, 0, BUF, 0, STATUS) G0400251 IF (STATUS .NE. 0) GO TO 10000 G0400252C G0400253C BUMP RELATIVE RECORD NO. G0400254 TEMP(2) = TEMP(2) + 1 G0400255 400 CONTINUE G0400256C G0400257C RETURN LINK TO KEY INDEX FREE SPACE G0400258 450 NEXTBM(1) = 0 G0400259 NEXTBM(2) = (TEMP(2)-1)/INC + 1 G0400260C G0400261C STORE END OF FILE CODE IN 1ST TWO WORDS OF I/O BUFFER G0400262ÐÐC G0400263C LDA =XFMEOFC G0400264C STA BUF G0400265C STA BUF+1 G0400266C G0400267 ASSEM $C000,FMEOFC,$6400,+BUF(1),$6400,+BUF(2) G0400268C G0400269C SET KIB LENGTH G0400270 KIBLEN = VIWPS*INC G0400271C G0400272C WRITE OUT I/O BUFFER TO PROVIDE EOF'S IN NEXT KIB G0400273 CALL MWRITF (KEYBAM,NEXTBM,KIBLEN,VIWPS,0,BUF,0,STATUS) G0400274C G0400275 GO TO 10000 G0400276C G0400277C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0400278C ERROR PROCESSING G0400279C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0400280C G0400281C-- INVALID REQUEST PARAMETERS G0400282 9110 STATUS = $C000 G0400283 GO TO 10000 G0400284C G0400285C-- MASS MEMORY I/O ERROR G0400286 9120 STATUS = $8020 G0400287ÐÐ GO TO 10000 G0400288C-- INSUFFICIENT VOLUME SPACE G0400289 9130 STATUS = $9000 G0400290C G0400291C G0400292C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0400293C RETURN TO CALLER G040029410000 RETURN G0400295 END G0400296 SUBROUTINE BLDFDS (DATA, INDEX) G0500001 1 /G05 F ITOS CCS 3.0 SL-149G0500002C BUILD A FILE DIRECTORY SEGMENT (FDS) G0500003C CREDIT COLLECTION SYSTEM VERSION 3.0 G0500004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G0500005C COPYRIGHT CONTROL DATA CORPORATION 1979 G0500006C G0500007C*** G0500008C G0500009C THIS ROUTINE CREATES A FILE'S FILE DIRECTORY SEGMENT (FDS) G0500010C G0500011C PARAMETERS: (ALL ARE INTEGER TYPE) G0500012C G0500013C DATA - 8 WORD ARRAY: G0500014C WORD CONTENTS G0500015C ---- -------- G0500016ÐÐC 1-4 FILE NAME G0500017C 5-8 OWNER NAME G0500018C G0500019C INDEX - BLOCK NO. OF THE FILE'S RESERVED FCB G0500020C G0500021C ON RETURN THE FOLLOWING COMMON VARIABLES WILL BE SET UP: G0500022C G0500023C STATUS - COMPLETION STATUS SET ON RETURN TO CALLER: G0500024C =0 : NO ERROR OCURRED G0500025C =$8800 : INSUFFICIENT ROOM IN FDD FOR THE FDS G0500026C =$8400 : NON-UNIQUE FILE/OWNER NAME G0500027C =$8020 : MASS MEMORY I/O ERROR G0500028C G0500029C THE FOLLOWING SUBROUTINES ARE USED BY BLDFDS G0500030C FNDFDS FIND LOGICAL POSITION FOR AN FDS G0500031C MWRITF WRITE MASS MEMORY - FTN INTERFACE TO MMWRIT G0500032C G0500033C FOR A DEFINITION OF COMMON, SEE MACRO COMMON G0500034M COMMON G0500035C G0500036 INTEGER DATA(24) G0500037C G0500038C FOR A DEFINITION OF A VIT, SEE MACRO VITEQU G0500039M VITEQU G0500040C G0500041ÐÐC*** G0500042C G0500043C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0500044C SEARCH THE FDD FOR SPACE FOR THE NEW FDS G0500045C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0500046C G0500047 CALL FNDFDS (DATA) G0500048C G0500049C CHECK IF ROOM WAS FOUND G0500050 IF (STATUS .EQ. 1) GO TO 300 G0500051C G0500052C CHECK IF NO ROOM WAS FOUND G0500053 IF (STATUS .EQ. 0) GO TO 200 G0500054C G0500055C CHECK FOR FILE/OWNER NAME DUPLICATION G0500056 IF (STATUS .EQ. 2) GO TO 9120 G0500057C G0500058C MASS MEMORY I/O ERROR G0500059 GO TO 10000 G0500060C G0500061C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0500062C ALLOCATE A NEW FDB G0500063C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0500064C G0500065C CHECK IF ANY OVERFLOW FDB'S ARE STILL AVAILABLE G0500066ÐÐ 200 IF (VINFDB .LT. VINXTB) GO TO 9110 G0500067C G0500068C YES: THREAD THIS NEW FDB TO THE PREVIOUS ONE G0500069 BUF(1) = VINXTB G0500070C G0500071C WRITE OUT THE PREVIOUS FDB G0500072 CALL MWRITF (VIFDDM, FDB, VIWPS, VIWPS, 0, BUF, 0, STATUS) G0500073 IF (STATUS .NE. 0) GO TO 10000 G0500074C G0500075C ZERO OUT THE CORE FDB BUFFER G0500076 DO 250 I = 1, VIWPS G0500077 250 BUF(I) = 0 G0500078C G0500079C SET UP THE OVERFLOW BLOCK FOR STORE BACK G0500080 FDB(2) = VINXTB G0500081 FDS = 2 G0500082C G0500083C BUMP INDEX TO NEXT AVAILABLE OVERFLOW FDB G0500084 VINXTB = VINXTB + 1 G0500085C G0500086C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0500087C STORE THE NEW FDS G0500088C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0500089C G0500090C STORE FILE/OWNER NAMES G0500091ÐÐ 300 DO 310 I = 1, 8 G0500092 BUF(FDS) = DATA(I) G0500093 310 FDS = FDS + 1 G0500094C G0500095C STORE FCBT INDEX G0500096 BUF(FDS) = INDEX G0500097C G0500098C WRITE OUT THE FDB G0500099 STATUS = 0 G0500100 CALL MWRITF (VIFDDM, FDB, VIWPS, VIWPS, 0, BUF, 0, STATUS) G0500101C G0500102 GO TO 10000 G0500103C G0500104C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0500105C ERROR PROCESSING G0500106C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0500107C G0500108C-- INSUFFICIENT SPACE IN FDD G0500109 9110 STATUS = $8800 G0500110 GO TO 10000 G0500111C G0500112C-- NON-UNIQUE FILE/OWNER NAME G0500113 9120 STATUS = $8400 G0500114C G0500115C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0500116ÐÐC G0500117C RETURN G050011810000 RETURN G0500119 END G0500120 SUBROUTINE BLDFCB (DATA, INDEX) G0600001 1 /G06 F ITOS CCS 3.0 SL-149G0600002C BUILD A FILE CONTROL BLOCK (FCB) G0600003C CREDIT COLLECTION SYSTEM VERSION 3.0 G0600004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G0600005C COPYRIGHT CONTROL DATA CORPORATION 1979 G0600006C G0600007C*** G0600008C G0600009C THIS ROUTINE CREATES A FILE'S FILE CONTROL BLOCK. (FCB) G0600010C G0600011C PARAMETERS: (ALL ARE INTEGER TYPE) G0600012C G0600013C DATA - 24 WORD ARRAY. CONTENTS DESCRIBED IN 'CREATE' G0600014C G0600015C INDEX - BLOCK NO. OF THE RESERVED FCB G0600016C G0600017C ON RETURN THE FOLLOWING COMMON VARIABLES WILL BE SET UP: G0600018C G0600019C STATUS - COMPLETION STATUS SET ON RETURN TO CALLER: G0600020C =0 : NO ERROR OCURRED G0600021ÐÐC =$C000 : INVALID REQUEST PARAMETERS G0600022C =$8020 : MASS MEMORY I/O ERROR G0600023C G0600024C THE FOLLOWING SUBROUTINES ARE USED BY BLDFCB G0600025C MWRITF WRITE MASS MEMORY - FTN INTERFACE TO MMWRIT G0600026C CFCBTL COMPUTE LENGTH OF FCB IN SECTORS G0600027C FDWADD DOUBLE WORD ADD - FORTRAN INTERFACE G0600028C G0600029C FOR A DEFINITION OF COMMON, SEE MACRO COMMON G0600030M COMMON G0600031C G0600032 INTEGER DATA(24), TEMP(2) G0600033C G0600034C FOR A DEFINITION OF A VIT, SEE MACRO VITEQU G0600035M VITEQU G0600036 INTEGER IRRN(2) G0600037 DATA IRRN/0,0/ G0600038C*** G0600039. G0600040C G0600041C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -G0600042C G0600043C CLEAR OUT THE FCB CORE IMAGE BUFFER G0600044 DO 50 I = 1,96 G0600045 50 BUF(I) = 0 G0600046ÐÐC G0600047C BUILD THE FCB CORE IMAGE G0600048C G0600049C-- RECORD LENGTH , ALLOW ODD BYTE LENGTH G0600050 BUF(1) = (DATA(13)+1) /2 G0600051C G0600052C-- TOTAL NO. OF DATA RECORDS G0600053 BUF(2) = DATA(14) G0600054 BUF(3) = DATA(15) G0600055C G0600056C-- DATA RECORD BEGINNING SECTOR ADDRESS G0600057 BUF(4) = DATBAM(1) G0600058 BUF(5) = DATBAM(2) G0600059C G0600060C-- FCB INDICATOR G0600061 BUF(6) = AND (DATA(16), $C101) G0600062C G0600063C IS FILE INDEXED G0600064 IF (AND (DATA(16),1) .EQ. 0) GO TO 300 G0600065C G0600066C-- NEXT FREE KEY INDEX BLOCK G0600067 BUF(9) = NEXTBM(1) G0600068 BUF(10) = NEXTBM(2) G0600069C G0600070C-- TOTAL NO. OF KEY INDEX BLOCKS G0600071ÐÐ BUF(11) = TNKEYM(1) G0600072 BUF(12) = TNKEYM(2) G0600073C G0600074C-- KEY INDEX BEGINNING SECTOR ADDRESS G0600075 BUF(13) = KEYBAM(1) G0600076 BUF(14) = KEYBAM(2) G0600077C G0600078C-- KEYS' BYTE LENGTH AND POSITION G0600079 J = 17 G0600080 DO 200 I = 15, 22 G0600081 BUF(I) = DATA(J) G0600082 200 J = J+1 G0600083C G0600084C-- TOTAL NO. OF SECTORS IN FILE G0600085 300 BUF(23) = NUMSEC(1) G0600086 BUF(24) = NUMSEC(2) G0600087C G0600088C-- FILE AND OWNER NAMES G0600089 J = 1 G0600090 DO 400 I = 25, 32 G0600091 BUF(I) = DATA(J) G0600092 400 J = J + 1 G0600093C G0600094C STORE LENGTH OF RECORD IN BYTE AT END OF FCB G0600095 BUF(33) = DATA(13) G0600096ÐÐ2 G0600097C COMPUTE BASE ADDRESS OF THE FCBT G0600098 TEMP(1) = 0 G0600099 TEMP(2) = VINFDB G0600100 CALL FDWADD (TEMP, VIFDDM, TEMP, STATUS) G0600101 IRRN(2) = INDEX + 1 G0600102C G0600103C WRITE OUT THE FCB G0600104 CALL MWRITF (TEMP,IRRN,96,96,0,BUF,0,STATUS) G0600105 GO TO 10000 G0600106C G0600107C INVALID REQUEST PARAMETERS G0600108 9100 STATUS = $C000 G0600109C G0600110C RETURN TO CALLER G060011110000 RETURN G0600112 END G0600113 SUBROUTINE STOLBL G0700001 1 /G07 F ITOS CCS 3.0 SL-149G0700002C **************************************************************121*4620G0700003C UPDATE VOLUME-RESIDENT LABLE G0700004C CREDIT COLLECTION SYSTEM VERSION 3.0 G0700005C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G0700006C COPYRIGHT CONTROL DATA CORPORATION 1979 G0700007C G0700008ÐÐC*** G0700009C G0700010C THIS ROUTINE UPDATES THE VOLUME-RESIDENT LABEL TO REFLECT FILE G0700011C MANAGER MADE CHANGES TO THE VOLUME INFORMATION TABLE. G0700012C G0700013C INPUT IS THE VOLUME INFORMATION TABLE IN COMMON G0700014C G0700015C ON RETURN THE FOLLOWING COMMON VARIABLES WILL BE SET UP: G0700016C STATUS - COMPLETION STATUS: G0700017C =0 : NO ERROR OCCURED G0700018C =$8020 : MASS MEMORY I/O ERROR G0700019C G0700020C G0700021C THE FOLLOWING SUBROUTINES ARE USED BY STOLBL G0700022C MREADF READ MASS MEMORY - FTN INTERFACE TO MMREAD G0700023C MWRITF WRITE MASS MEMORY - FTN INTERFACE TO MMWRIT G0700024C G0700025C FOR A DEFINITION OF COMMON, SEE MACRO COMMON G0700026M COMMON G0700027C FOR A DEFINITION OF A VIT, SEE MACRO VITEQU G0700028M VITEQU G0700029C G0700030C **************************************************************121*4620G0700031 INTEGER LABADR(2), ONE(2) G0700032C **************************************************************121*4620G0700033ÐÐC G0700034C **************************************************************121*4620G0700035 DATA ONE/0,1/ G0700036C **************************************************************121*4620G0700037C G0700038C VOLUME LABEL EQUIVALENCES (VOLATILE SUBSET) G0700039 EQUIVALENCE (VLFDD, BUF(29)), (VLCURF, BUF(32)) G0700040 EQUIVALENCE (VLNFDB, BUF(33)), (VLNXTB, BUF(34)) G0700041 EQUIVALENCE (VLLBAM, BUF(26)), (VLLBAL, BUF(27)) G0700042 INTEGER VLFDD(2), VLCURF, VLNFDB, VLNXTB G0700043 INTEGER VLLBAM, VLLBAL G0700044C **************************************************************121*4620G0700045C G0700046 EXTERNAL MMLUTB G0700047C **************************************************************121*4620G0700048C*** G0700049C G0700050C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0700051C G0700052C **************************************************************121*4620G0700053C GET THE SECTOR ADDRESS OF THE LABEL G0700054C LDQ PCTABL G0700055 ASSEM $E400,+PCTABL G0700056C LDQ- RPLOGU,Q G0700057 ASSEM $E201 G0700058ÐÐC LDQ MMLUTB,Q G0700059 ASSEM $E600,+MMLUTB G0700060C LDA- VILBLM,Q G0700061 ASSEM $C215 G0700062C STA LABADR(1) G0700063 ASSEM $6800,LABADR(1) G0700064C LDA- VILBLL,Q G0700065 ASSEM $C216 G0700066C STA LABADR(2) G0700067 ASSEM $6800,LABADR(2) G0700068C G0700069C READ IN THE CURRENT LABEL FROM THE VOLUME G0700070 STATUS = 0 G0700071 CALL MREADF (LABADR, ONE, 96, 96, 0, BUF, 0, STATUS) G0700072C **************************************************************121*4620G0700073 IF (STATUS .NE. 0) GO TO 10000 G0700074C G0700075C UPDATE THE LABEL IMAGE G0700076C G0700077C-- FILE DEFINITION DIRECTORY ADDRESS G0700078 VLFDD(1) = VIFDDM G0700079 VLFDD(2) = VIFDDL G0700080C G0700081C-- LARGEST AVAILABLE BLOCK G0700082 VLLBAM = VILBAM G0700083ÐÐ VLLBAL = VILBAL G0700084C G0700085C-- CURRENT NO. OF FILES G0700086 VLCURF = VICURF G0700087C G0700088C-- NO. OF BLOCKS IN THE FILE DIRECTORY G0700089 VLNFDB = VINFDB G0700090C G0700091C-- NEXT AVAILABLE FILE DIRECTORY BLOCK G0700092 VLNXTB = VINXTB G0700093C G0700094C WRITE OUT THE LABEL G0700095C **************************************************************121*4620G0700096 CALL MWRITF (LABADR, ONE, 96, 96, 0, BUF, 0, STATUS) G0700097C **************************************************************121*4620G0700098C G0700099C RETURN TO CALLER G070010010000 RETURN G0700101 END G0700102 SUBROUTINE FCBIX (INDEX, CODE) G0800001 1 /G08 F ITOS CCS 3.0 SL-149G0800002C RESERVE AND RELEASE BLOCKS WITHIN THE FCBT (VIA FIAT) G0800003C CREDIT COLLECTION SYSTEM VERSION 3.0 G0800004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G0800005C COPYRIGHT CONTROL DATA CORPORATION 1979 G0800006ÐÐC G0800007C*** G0800008C G0800009C THIS ROUTINE RESERVES/RELEASES AN FCB WITHIN AN FCBT G0800010C G0800011C PARAMETERS: (ALL ARE INTEGER TYPE) G0800012C G0800013C INDEX - BLOCK NO. OF THE OPERATIVE FCB G0800014C G0800015C CODE - INDICATES FUNCTION TO BE PERFORMED: G0800016C =1 TO RESERVE AN FCB. 'INDEX' WILL BE SET ON RETURN G0800017C =0 TO RELEASE AN FCB. 'INDEX' SET ON ENTRY BY CALLER G0800018C G0800019C ON RETURN THE FOLLOWING COMMON VARIABLES WILL BE SET UP: G0800020C G0800021C STATUS - COMPLETION STATUS SET ON RETURN TO CALLER: G0800022C =0 : NO ERROR OCURRED G0800023C =$C000 : INVALID REQUEST PARAMETERS G0800024C =$8020 : MASS MEMORY I/O ERROR G0800025C G0800026C THE FOLLOWING SUBROUTINES ARE USED BY FCBIX G0800027C MREADF READ MASS MEMORY - FTN INTERFACE TO MMREAD G0800028C MWRITF WRITE MASS MEMORY - FTN INTERFACE TO MMWRIT G0800029C CFCBTL COMPUTE LENGTH OF FCBT IN SECTORS G0800030C G0800031ÐÐC FOR A DEFINITION OF COMMON, SEE MACRO COMMON G0800032M COMMON G0800033C G0800034 INTEGER CODE, SIXTEN, OV, RELREC(2) G0800035C G0800036C FOR A DEFINITION OF A VIT, SEE MACRO VITEQU G0800037M VITEQU G0800038C G0800039 DATA SIXTEN/16/ G0800040 DATA RELREC(1)/0/ G0800041C G0800042C*** G0800043C G0800044C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0800045C READ IN THE FIAT G0800046C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0800047C G0800048C G0800049C COMPUTE LENGTH OF FCBT IN SECTORS G0800050 CALL CFCBTL (LFCBT) G0800051C COMPUTE ADDRESS OF FIAT (OFFSET FROM START OF FDD) G0800052 RELREC(2) = VINFDB + LFCBT + 1 G0800053C G0800054C READ FIAT G0800055 CALL MREADF (VIFDDM, RELREC, VIWPS, 128, 0, BUF, 0, STATUS) G0800056ÐÐ IF (STATUS .NE. 0) GO TO 10000 G0800057C G0800058C BRANCH ACCORDING TO FUNCTION CODE G0800059 IF (CODE .EQ. 0) GO TO 1000 G0800060C G0800061C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0800062C RESERVE AN FCB G0800063C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0800064C G0800065C SCAN THE FIAT LEFT-TO-RIGHT TOP-TO-BOTTOM FOR THE FIRST CLEAR BIT G0800066 IX = 1 G0800067 M = (VIMAXF - 1)/16 +1 G0800068 DO 100 I = 1, M G0800069 DO 100 J = 15, 0, -1 G0800070C G0800071C GET SET-BIT MASK G0800072C G0800073C LDQ J G0800074C LDA ONEMSK,Q (ONEMSK EQU $23) G0800075C STA MASK G0800076C G0800077 ASSEM $E800, J, $C223, $6800, MASK G0800078C G0800079C CHECK FOR CLEAR BIT G0800080 IF (AND(BUF(I), MASK) .EQ. 0) GO TO 150 G0800081ÐÐC G0800082C BIT IS SET: CONTINUE SEARCH G0800083 IX = IX + 1 G0800084 100 CONTINUE G0800085 GO TO 9110 G0800086C G0800087C CHECK IF FCB INDEX IS WITHIN VIMAXF RANGE G0800088 150 IF (IX .GT. VIMAXF) GO TO 9110 G0800089C G0800090C SET THE FOUND CLEAR BIT: THIS ACTION RESERVES THE CORRESPONDING FCB G0800091 200 BUF(I) = OR (BUF(I), MASK) G0800092C G0800093C RETURN THE FCB INDEX G0800094 INDEX = IX- 1 G0800095 GO TO 2000 G0800096C G0800097C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0800098C RELEASE AN FCB G0800099C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0800100C G0800101C CONVERT THE FCB INDEX TO A WORD/BIT POSITION WITHIN THE FIAT G0800102 1000 I = INDEX/SIXTEN + 1 G0800103C G0800104C THE Q-REG CONTAINS THE COMPLEMENT OF THE BIT POSITION: GET THE G0800105C APPROPRIATE CLEAR-BIT MASK G0800106ÐÐC G0800107C TCQ Q G0800108C LDA $42,Q G0800109C STA MASK G0800110C G0800111 ASSEM $0852, $C242, $6800, MASK G0800112C G0800113C CLEAR THE BIT WITHIN THE FIAT: THIS ACTION RELEASES THE FCB G0800114 BUF(I) = AND (BUF(I), MASK) G0800115C G0800116C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0800117C WRITE OUT THE FIAT G0800118C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0800119C G0800120 2000 STATUS = 0 G0800121 CALL MWRITF (VIFDDM, RELREC, VIWPS, 128, 0, BUF, 0, STATUS) G0800122 GO TO 10000 G0800123C G0800124C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0800125C ERROR PROCESSING G0800126C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0800127C G0800128C SET INVALID PARAMETER INDICATION G0800129 9110 STATUS = $C020 G0800130C G0800131ÐÐC RETURN TO CALLER G080013210000 RETURN G0800133 END G0800134 SUBROUTINE FNDFDS (NAME) G0900001 1 /G09 F ITOS CCS 3.0 SL-149G0900002C FIND THE LOGICAL POSITION FOR AN FDS G0900003C CREDIT COLLECTION SYSTEM VERSION 3.0 G0900004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G0900005C COPYRIGHT CONTROL DATA CORPORATION 1979 G0900006C G0900007C*** G0900008C G0900009C THIS ROUTINE DETERMINES THE LOGICAL POSITION WITHIN THE ALLOCATED G0900010C BLOCKS OF AN FDD OF A SPECIFIED FILE'S FDS. THIS LOGICAL POSITION G0900011C IS EITHER THE FIRST AVAILABLE EMPTY SPACE FOR A NEW FDS OR IS THE G0900012C CURRENT LOCATION OF AN EXISTING FDS. G0900013C G0900014C PARAMETERS: (ALL ARE INTEGER TYPE) G0900015C G0900016C NAME - 4 WORD FILE NAME AND 4 WORD OWNER NAME G0900017C G0900018C ON RETURN THE FOLLOWING COMMON VARIABLES WILL BE SET UP: G0900019C G0900020C FDB - 2 WORD ARRAY RETURNED WITH THE RELATIVE RECORD NO. WITHIN G0900021C THE FDD OF THE FDB TO CONTAIN/CONTAINING THE FDS G0900022ÐÐC FDS - RETURNED WITH AN INDEX INTO THE FDB TO THE FILE'S FDS G0900023C BUF - 200 WORD BUFFER RETURNED CONTAINING THE SELECTED FDB G0900024C STATUS - COMPLETION STATUS SET ON RETURN TO CALLER: G0900025C =2 : FDS WAS LOCATED. RETURNED PARAMETERS POINT TO IT. G0900026C =1 : FDS WAS NOT LOCATED. RETURNED PARAMETERS POINT TO AN G0900027C AVAILABLE EMPTY SPACE. G0900028C =0 : FDS WAS NOT FOUND. NO EMPTY SPACE WAS AVAILABLE. G0900029C =$8020 : MASS MEMORY I/O ERROR G0900030C G0900031C THE FOLLOWING SUBROUTINES ARE USED BY FNDFDS G0900032C HASH GENERATE A HASH CODE FROM FILE NAME/OWNER G0900033C MREADF READ MASS MEMORY - FTN INTERFACE TO MMREAD G0900034C G0900035C FOR A DEFINITION OF COMMON, SEE MACRO COMMON G0900036M COMMON G0900037C G0900038 INTEGER NAME(8), IFDB(2) G0900039C G0900040C FOR A DEFINITION OF A VIT, SEE MACRO VITEQU G0900041M VITEQU G0900042C G0900043C*** G0900044C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0900045C G0900046C INITIALIZE G0900047ÐÐC G0900048 FDB(1) = 0 G0900049 IFDB(1) = 0 G0900050 IFDS = 0 G0900051 LAST = ( (VIWPS-1) /9) *9 - 7 G0900052C G0900053C GENERATE SCATTER CODED INDEX INTO FDD G0900054 CALL HASH (NAME, VINFDB, IFDB(2)) G0900055C ****************************************************** 121*4574G0900056 FDB(2) = IFDB(2) G0900057C ****************************************************** 121*4574G0900058C G0900059C READ IN THE FDB G0900060 100 CALL MREADF ( VIFDDM, IFDB, VIWPS, VIWPS, 0, BUF, 0, STATUS) G0900061 IF (STATUS .NE. 0) GO TO 10000 G0900062C G0900063C SCAN THIS FDB FOR THE GIVEN FILE/OWNER G0900064 DO 500 I = 2, LAST, 9 G0900065C G0900066C IS THIS FDS USED G0900067 IF (BUF(I) .NE. 0) GO TO 200 G0900068C G0900069C NO: IF IT HAS NOT ALREADY BEEN DONE, RECORD THIS FDB/FDS AS THE G0900070C FREE SPACE TO BE USED FOR A NEW FDS G0900071 IF (IFDS .NE. 0) GO TO 500 G0900072ÐÐ IFDS = I G0900073 FDB(2) = IFDB(2) G0900074 GO TO 500 G0900075C G0900076C COMPARE FILE AND OWNER NAMES G0900077 200 J = I G0900078 DO 300 K = 1, 8 G0900079 IF (BUF(J) .NE. NAME(K)) GO TO 500 G0900080 300 J = J + 1 G0900081C G0900082C MATCH WAS FOUND G0900083 GO TO 600 G0900084C G0900085 500 CONTINUE G0900086C G0900087C FDS NOT FOUND IN THIS BLOCK: READ IN NEXT TO BE SCANNED G0900088 IF (BUF(1) .EQ. 0) GO TO 700 G0900089 IFDB(2) = BUF(1) G0900090 GO TO 100 G0900091C G0900092C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0900093C FDS FOUND: RETURN ACCORDINGLY G0900094C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0900095C G0900096 600 IFDS = I G0900097ÐÐ FDB(2) = IFDB(2) G0900098 STATUS = 2 G0900099 GO TO 10000 G0900100C G0900101C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0900102C FDS NOT FOUND: RETURN ACCORDINGLY G0900103C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0900104C G0900105 700 STATUS = 0 G0900106 IF (IFDS .EQ. 0) GO TO 10000 G0900107C G0900108C RE-READ THE FDB, IF NECESSARY G0900109 IF (IFDB(2) .EQ. FDB(2)) GO TO 750 G0900110 CALL MREADF (VIFDDM, FDB, VIWPS, VIWPS, 0, BUF, 0, STATUS) G0900111 IF (STATUS .NE. 0) GO TO 10000 G0900112C G0900113C SET COMPLETION STATUS G0900114 750 STATUS = 1 G0900115C G0900116C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G0900117C G0900118C RETURN TO CALLER G090011910000 FDS = IFDS G0900120 RETURN G0900121 END G0900122ÐÐ SUBROUTINE HASH (NAME, VINFDB, INDEX) G1000001 1 /G10 F ITOS CCS 3.0 SL-149G1000002C GENERATE A HASH CODE FROM FILE/OWNER NAME G1000003C CREDIT COLLECTION SYSTEM VERSION 3.0 G1000004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G1000005C COPYRIGHT CONTROL DATA CORPORATION 1979 G1000006C G1000007C*** G1000008C G1000009C THIS ROUTINE GENERATES A SCATTER CODED INDEX INTO AN FDD BASED ON G1000010C A FILE AND OWNER NAME COMBINATION. THE INDEX IDENTIFIES THE START OFG1000011C THE CHAIN OF THE FDB'S IN WHICH THE FDS OF THE STIPULATED FILE G1000012C LOGICALLY SHOULD RESIDE. G1000013C G1000014C PARAMETERS: (ALL ARE INTEGER TYPE) G1000015C G1000016C NAME - 4 WORD FILE NAME AND 4 WORD OWNER NAME G1000017C G1000018C VINFDB - NO. OF FDB'S IN THE FDD. G1000019C G1000020C INDEX - RETURNED SET TO THE APPLICABLE FDB BLOCK NO. G1000021C G1000022C G1000023 INTEGER NAME(8), VINFDB, SUM G1000024C G1000025ÐÐC HASHING ALGORITHM IS AS FOLLOWS: G1000026C INDEX = (NAME SUM) MOD MINFDB + 1 G1000027C WHERE: NAME SUM = THE SUM OF ALL 8 WORDS OF THE FILE/OWNER NAMES G1000028C MINFDB = THE NO. OF BLOCKS IN THE MAIN BODY OF THE FDD, IE G1000029C EXCLUDING OVERFLOW AREA G1000030C*** G1000031C G1000032C COMPUTE THE NAME SUM G1000033 SUM = 0 G1000034 DO 100 I = 1, 8 G1000035 SUM = SUM + NAME(I) G1000036 100 SUM = AND(SUM, $7FFF) G1000037C G1000038C COMPUTE MINFDB G1000039 MINFDB = VINFDB/2 G1000040C G1000041C GENERATE INDEX INTO FDD MAIN BODY G1000042 I = SUM / MINFDB G1000043C G1000044C USE THE REMAINDER OF THE DIVIDE AS INDEX G1000045C G1000046C INQ 1 G1000047C STQ INDEX G1000048C G1000049 ASSEM $0D01, $4400, +INDEX G1000050ÐÐ END G1000051 SUBROUTINE CLEAR (IFCBAD, REQBUF, DATA, ISTAT) G1100001 1 /G11 F ITOS CCS 3.0 SL-149G1100002C FILE MANAGER CLEAR FILE REQUEST PROCESSOR G1100003C CREDIT COLLECTION SYSTEM VERSION 3.0 G1100004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G1100005C COPYRIGHT CONTROL DATA CORPORATION 1979 G1100006C G1100007C*** G1100008C G1100009C THIS ROUTINE PROCESSES REQUEST TO THE FILE MANAGER TO CLEAR A FILE. G1100010C G1100011C TO CLEAR A FILE MEANS TO: G1100012C A) ALTER THE FILE'S FCB TO MAKE IT APPEAR AS IF NO DATA HAD G1100013C EVER BEEN STORED. G1100014C B) IF THE FILE IS INDEXED, RE-INITIALIZE THE KEY INDEX. G1100015C G1100016C PARAMETERS: (ALL ARE INTEGER TYPE) G1100017C G1100018C IFCBAD - FCB CORE-IMAGE ADDRESS. UNUSED. G1100019C G1100020C REQBUF - 24 WORD SCRATCH BUFFER. UNUSED. G1100021C G1100022C DATA - 12 WORD BUFFER G1100023C WORD CONTENTS G1100024ÐÐC ---- -------- G1100025C 1-4 FILE NAME. G1100026C 5-8 FILE OWNER NAME. G1100027C 9-12 FILE VOLUME NAME. IF WORD 9 IS ZERO OR BLANK G1100028C ($2020), THIS NAME IS FILLED ON RETURN TO CALLER.G1100029C G1100030C ISTAT - COMPLETION STATUS SET ON RETURN TO CALLER: G1100031C BIT MEANING G1100032C --- -------- G1100033C 15 FILE REQUEST REJECTED. G1100034C 14* FILE REQUEST ILLEGAL. G1100035C 13* VOLUME NOT READY. G1100036C 12-6 UNUSED. G1100037C 5* MASS MEMORY I/O ERROR G1100038C 4-2 UNUSED. G1100039C 1* FILE COULD NOT BE LOCATED. G1100040C 0* FILE IS CURRENTLY OPEN G1100041C * : BIT 15 WILL ALSO BE SET G1100042C G1100043C THE FOLLOWING SUBROUTINES ARE USED BY CLEAR G1100044C IOVCHK OVERLAP CHECK INTEGER FUNCTION - FTN INTERFACEG1100045C FMSCOM FM EXEC SERIAL PROCESSOR COMPLETION ROUTINE G1100046C GETFDS GET A FILE'S FDS G1100047C UCTMGR UCT ENTRY MANAGER G1100048C MWRITF WRITE MASS MEMORY - FTN INTERFACE TO MMWRIT G1100049ÐÐC MREADF READ MASS MEMORY - FTN INTERFACE TO MMREAD G1100050C FDWADD DOUBLE WORD ADD - FORTRAN INTERFACE G1100051C CPKIBL COMPUTE KIB LENGTH IN SECTORS G1100052C G1100053C FOR A DEFINITION OF COMMON, SEE MACRO COMMON G1100054M COMMON G1100055C G1100056C GLOBAL EOF CODE G1100057 EXTERNAL FMEOFC G1100058C G1100059 INTEGER REQBUF(24), DATA(12) G1100060 INTEGER VITADR, RELREC(2) G1100061 INTEGER UCT(6), UCTENT G1100062 INTEGER TEMP(2) G1100063C G1100064C FOR A DEFINITION OF A VIT, SEE MACRO VITEQU G1100065M VITEQU G1100066C G1100067 DATA RELREC(1)/0/ G1100068 INTEGER INDEX(2) G1100069 DATA INDEX/0,0/ G1100070C G1100071C*** G1100072C G1100073C CHECK IF DATA BUFFER OVERLAPS REQBUF OR ISTAT G1100074ÐÐC IF SO, ABORT VIA RETURN TO FM EXEC G1100075 IF (IOVCHK(DATA,12) .NE. 0) CALL FMSCOM G1100076C G1100077C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -G1100078C UPDATE THE FCB G1100079C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -G1100080C G1100081C RETRIEVE THE FILE'S FDS G1100082 STATUS = 0 G1100083 CALL GETFDS (DATA, VITADR, MMUNIT) G1100084 IF (STATUS .NE. 0) GO TO 10000 G1100085C G1100086C SEARCH THE UCT FOR OCCURENCES OF THE FILE G1100087 UCT(2) = MMUNIT*$800 + BUF(FDS+8) G1100088 UCTENT = -1 G1100089 CALL UCTMGR (UCT, UCTENT, 2, IFLAG) G1100090C G1100091C RETURN WITH ERROR IF THE FILE IS CURRENTLY OPEN G1100092 IF (IFLAG .EQ. 0) GO TO 9110 G1100093C G1100094C COMPUTE BASE ADDRESS OF THE FCBT G1100095 TEMP(1) = 0 G1100096 TEMP(2) = VINFDB G1100097 CALL FDWADD (TEMP, VIFDDM, TEMP, STATUS) G1100098C G1100099ÐÐC READ IN THE FCB G1100100 INDEX(2) = BUF(FDS+8) + 1 G1100101 CALL MREADF (TEMP, INDEX, 96, 96, 0, BUF, 0, STATUS) G1100102 IF (STATUS .NE. 0) GO TO 10000 G1100103C G1100104C INSURE FILE IS MARKED CLOSED G1100105 BUF(6) = AND (BUF(6), $DFFF) G1100106C G1100107C CLEAR OUT THE NO. OF EXISTING RECORDS COUNTER G1100108 BUF(7) = 0 G1100109 BUF(8) = 0 G1100110C G1100111C CHECK IF FILE IS INDEXED G1100112 IF (AND (BUF(6),1) .EQ. 0) GO TO 300 G1100113C G1100114C COMPUTE LENGTH OF KIB IN SECTORS G1100115 CALL CPKIBL(INC) G1100116C G1100117 NBRSEC = 0 G1100118 DO 100 I = 15, 21, 2 G1100119 IF (BUF(I) .EQ. 0) GO TO 200 G1100120 100 NBRSEC = NBRSEC + INC G1100121C G1100122C RESET THE NEXT FREE KEY BLOCK INDEX G1100123 200 BUF(9) = 0 G1100124ÐÐ BUF(10) = (NBRSEC / INC) + 1 G1100125C G1100126C SAVE THE KEY INDEX BEGINNING SECTOR ADDRESS G1100127 KEYBAM(1) = BUF(13) G1100128 KEYBAM(2) = BUF(14) G1100129C G1100130C WRITE OUT THE FCB G1100131 300 CALL MWRITF (TEMP, INDEX, 96, 96, 0, BUF, 0, STATUS) G1100132 IF (STATUS .NE. 0) GO TO 10000 G1100133C G1100134C WRITE EOF CODE IN THE FIRST SECTOR FOR DATA AREA G1100135C SO THAT RECOVERY IN OPENFL CAN WORK G1100136 RELREC(1) = 0 G1100137 RELREC(2) = 1 G1100138C GET SECTOR ADDRESS FOR DATA AREA G1100139 DATBAM(1) = BUF(4) G1100140 DATBAM(2) = BUF(5) G1100141C G1100142C GET GLOBAL EOF CODE AND PUT IN ARRAY BUFFER G1100143C G1100144C LDA =XFMEOFC G1100145C STA BUF(1) G1100146C G1100147 ASSEM $C000, FMEOFC, $6400, +BUF G1100148 BUF(2) = BUF(1) G1100149ÐÐC G1100150C WRITE TO FIRST RECORD AREA G1100151 CALL MWRITF (DATBAM, RELREC, VIWPS, VIWPS, 0, BUF, 0, STATUS) G1100152 IF (STATUS .NE. 0) GO TO 10000 G1100153C G1100154C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -G1100155C RE-INITIALIZE THE KEY INDEX G1100156C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -G1100157C G1100158 IF (AND (BUF(6),1) .EQ. 0) GO TO 10000 G1100159C WRITE EOF CODE IN FIRST NON-ROOT KEY INFO BLOCK G1100160 RELREC(2) = NBRSEC+1 G1100161 CALL MWRITF (KEYBAM, RELREC, VIWPS, VIWPS, 0, BUF, 0, STATUS) G1100162 IF (STATUS .NE. 0) GO TO 10000 G1100163C G1100164C CLEAR OUT SCRATCH BUFFER G1100165 DO 400 I = 1, VIWPS G1100166 400 BUF(I) = 0 G1100167C G1100168C WRITE OUT CLEAR ROOT KIB'S G1100169 DO 500 I = 1, NBRSEC G1100170 RELREC(2) = I G1100171 CALL MWRITF (KEYBAM, RELREC, VIWPS, VIWPS, 0, BUF, 0, STATUS) G1100172 IF (STATUS .NE. 0) GO TO 10000 G1100173 500 CONTINUE G1100174ÐÐ GO TO 10000 G1100175C G1100176C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -G1100177C ERROR PROCESSING G1100178C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -G1100179C G1100180C ILLEGAL REQUEST PARAMETERS G1100181 9100 STATUS = $C000 G1100182 GO TO 10000 G1100183C G1100184C FILE IS CURRENTLY OPEN G1100185 9110 STATUS = $8001 G1100186C G1100187C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G1100188C G1100189C RETURN TO FILE MANAGER G110019010000 ISTAT = STATUS G1100191 CALL FMSCOM G1100192 RETURN G1100193 END G1100194 SUBROUTINE GETFDS (DATA, VITADR, MMUNIT) G1200001 1 /G12 F ITOS CCS 3.0 SL-149G1200002C GET A FILE'S FDS G1200003C CREDIT COLLECTION SYSTEM VERSION 3.0 G1200004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G1200005ÐÐC COPYRIGHT CONTROL DATA CORPORATION 1979 G1200006C G1200007C*** G1200008C G1200009C THIS ROUTINE RETRIEVES AN INDICATED FILE'S FILE DIRECTORY SEGMENT G1200010C G1200011C PARAMETERS: (ALL ARE INTEGER TYPE) G1200012C G1200013C DATA - 12 WORD BUFFER G1200014C WORD CONTENTS G1200015C ---- -------- G1200016C 1-4 FILE NAME. G1200017C 5-8 FILE OWNER NAME. G1200018C 9-12 FILE VOLUME NAME. IF WORD 9 IS ZERO OR BLANK G1200019C ($2020), THIS NAME IS FILLED ON RETURN TO CALLER.G1200020C G1200021C VITADR - RETURNED AS THE VOLUME INFORMATION TABLE ADDRESS. G1200022C G1200023C MMUNIT - RETURNED SET TO THE VOLUME'S MASS MEMORY UNIT NO. G1200024C G1200025C ON RETURN THE FOLLOWING COMMON VARIABLES WILL BE SET UP: G1200026C G1200027C FDB - 2 WORD ARRAY RETURNED WITH THE RELATIVE RECORD NO. OF G1200028C THE FDB THAT CONTAINS THE FDS. G1200029C FDS - RETURNED AS AN INDEX INTO THE FDB TO THE FDS. G1200030ÐÐC BUF - 200 WORD BUFFER RETURNED CONTAINING THE SELECTED FDB. G1200031C VIT - 21 WORD BUFFER RETURNED CONTAINING THE APPLICABLE VOLUME G1200032C INFORMATION TABLE. G1200033C STATUS - COMPLETION STATUS SET ON RETURN TO CALLER: G1200034C =0 : NO ERROR OCURRED G1200035C =$A000 : VOLUME NOT READY G1200036C =$8020 : MASS MEMORY I/O ERROR G1200037C =$8002 : FILE FDS NOT FOUND G1200038*E G1200039C THE FOLLOWING SUBROUTINES ARE USED BY GETFDS G1200040C CKUADR CHECK FOR ILLEGAL UNPROTECTED ADDRESS G1200041C FNDVIT SEARCH VIT'S FOR GIVEN VOLUME G1200042C FNDFDS FIND LOGICAL POSITION FOR AN FDS G1200043C SEARCH SEARCH ALL VOLUMES FOR A FILE'S FDS G1200044C G1200045C FOR A DEFINITION OF COMMON, SEE MACRO COMMON G1200046M COMMON G1200047C G1200048 EXTERNAL CKUADR G1200049 EXTERNAL MMLUTB G1200050C G1200051 INTEGER DATA(12), VITADR G1200052C G1200053C*** G1200054C G1200055ÐÐC- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -G1200056C G1200057C CHECK IF A VOLUME WAS SPECIFIED G1200058 IF (DATA(9) .EQ. 0 .OR. DATA(9) .EQ. $2020) GO TO 200 G1200059C G1200060C YES: GET THE APPLICABLE VIT ADDRESS G1200061 CALL FNDVIT (DATA(9), VITADR, MMUNIT) G1200062 IF (VITADR .EQ. 0) GO TO 9100 G1200063C G1200064C IF FDD STRUCTURE NOT DEFINED, EXIT WITH APPROPRIATE ERROR G1200065 IF (VIT(15).EQ.0 .AND. VIT(16).EQ.0) GO TO 9110 G1200066C G1200067C LOCATE THE FILE'S FDS G1200068 CALL FNDFDS (DATA) G1200069C G1200070C VERIFY IT WAS FOUND G1200071 IF (STATUS .EQ. 2) GO TO 9000 G1200072C G1200073C NO: CHECK IF IT WASN'T G1200074 IF (STATUS .GE. 0) GO TO 9110 G1200075C G1200076C MASS MEMORY I/O ERROR G1200077 GO TO 10000 G1200078C G1200079C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -G1200080ÐÐC VOLUME NAME WAS NOT SPECIFIED G1200081C G1200082C VALIDATE 'DATA' ADDRESS AS VOLUME NAME WILL BE RETURNED IN IT. G1200083C USE THE FILE MANAGER SUBROUTINE 'CKUADR' G1200084C G1200085C LDA PCTABL G1200086C STA- I G1200087C LDA =XDATA G1200088C ENQ 0 G1200089C RTJ+ CKUADR G1200090C LDA =XDATA(12) G1200091C RTJ+ CKUADR G1200092C G1200093 200 ASSEM $C400, +PCTABL, $60FF, $C000, +DATA, $0C00 G1200094 ASSEM $5400, +CKUADR, $C000, +DATA(12), $5400, CKUADR G1200095C G1200096C SEARCH ALL READIED VOLUMES' FDD'S FOR THE SPECIFIED FDS G1200097 CALL SEARCH (DATA, VITADR, MMUNIT) G1200098 IF (STATUS .NE. 0) GO TO 10000 G1200099C G1200100C TRANSFER VOLUME NAME FROM VIT TO CALLER'S ARRAY G1200101 J = 9 G1200102 DO 300 I = 2, 5 G1200103 DATA(J) = VIT(I) G1200104 300 J = J + 1 G1200105ÐÐ GO TO 10000 G1200106C G1200107C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G1200108C G1200109C RETURN WITH NO ERROR G1200110 9000 STATUS = 0 G1200111 GO TO 10000 G1200112C G1200113C VOLUME NOT READY G1200114 9100 STATUS = $A000 G1200115 GO TO 10000 G1200116C G1200117C FILE NOT FOUND G1200118 9110 STATUS = $8002 G1200119C G1200120C RETURN TO CALLER G120012110000 RETURN G1200122 END G1200123 SUBROUTINE SEARCH (DATA, VITADR, MMUNIT) G1300001 1 /G13 F ITOS CCS 3.0 SL-149G1300002C SEARCH ALL VOLUME'S FOR A FILE'S FDS G1300003C CREDIT COLLECTION SYSTEM VERSION 3.0 G1300004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G1300005C COPYRIGHT CONTROL DATA CORPORATION 1979 G1300006C G1300007ÐÐC*** G1300008C G1300009C THIS ROUTINE SEARCHES THROUGH THE FDD'S OF ALL READIED VOLUMES TO G1300010C FIND THE FDS OF A SPECIFIED FILE. G1300011C G1300012C PARAMETERS: (ALL ARE INTEGER TYPE) G1300013C G1300014C DATA - 8 WORD ARRAY: G1300015C WORD CONTENTS G1300016C ---- -------- G1300017C 1-4 FILE NAME. G1300018C 5-8 FILE OWNER NAME. G1300019C VITADR - RETURNED AS THE VOLUME INFORMATION TABLE ADDRESS. G1300020C G1300021C MMUNIT - RETURNED SET TO THE VOLUME'S MASS MEMORY UNIT NO. G1300022C G1300023C ON RETURN THE FOLLOWING COMMON VARIABLES WILL BE SET UP: G1300024C G1300025C FDB - 2 WORD ARRAY RETURNED WITH THE RELATIVE RECORD NO. OF THE G1300026C FDB THAT CONTAINS THE FDS. G1300027C FDS - RETURNED AS AN INDEX INTO THE FDB TO THE FDS. G1300028C BUF - 200 WORD BUFFER RETURNED CONTAINING THE SELECTED FDB. G1300029C VIT - 21 WORD BUFFER RETURNED CONTAINING THE APPLICABLE VOLUME G1300030C INFORMATION TABLE. G1300031C STATUS - COMPLETION STATUS SET ON RETURN TO CALLER: G1300032ÐÐC =0 : NO ERROR OCURRED G1300033C =$8020 : MASS MEMORY I/O ERROR G1300034C =$8002 : FILE FDS NOT FOUND G1300035C G1300036C THE FOLLOWING SUBROUTINES ARE USED BY SEARCH G1300037C FNDFDS FIND LOGICAL POSITION FOR AN FDS G1300038C G1300039C FOR A DEFINITION OF COMMON, SEE MACRO COMMON G1300040M COMMON G1300041C G1300042 EXTERNAL MMLUTB G1300043C G1300044 INTEGER DATA(8), VITADR, VITSIZ G1300045C FOR A DEFINITION OF A VIT, SEE MACRO VITEQU G1300046M VITEQU G1300047C G1300048C SIZE OF THE VIT G1300049 DATA VITSIZ/21/ G1300050C*** G1300051C G1300052C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -G1300053C G1300054C PICK UP NO. OF VIT'S G1300055C G1300056C LDA MMLUTB G1300057ÐÐC STA NUMVIT G1300058C G1300059 ASSEM $C400, +MMLUTB, $6800, NUMVIT G1300060C G1300061C LOOP THROUGH ALL VIT'S AND SEARCH EACH INDICATED VOLUME'S FDD G1300062 DO 200 MMUNIT = 1, NUMVIT G1300063C G1300064C STORE MMUNIT IN PCT G1300065C G1300066C LDA MMUNIT G1300067C LDQ PCTABL G1300068C STA- 1,Q G1300069C G1300070 ASSEM $C400, +MMUNIT, $E400, +PCTABL, $6201 G1300071C G1300072C PICK UP THIS VOLUME'S VIT ADDRESS G1300073C G1300074C LDA MMLUTB,Q G1300075C STA VITADR G1300076C G1300077 ASSEM $E400,+MMUNIT,$C600,+MMLUTB,$6400,+VITADR G1300078C G1300079C LOCALIZE THE VIT G1300080 J = VITADR G1300081 DO 100 K = 1, VITSIZ G1300082ÐÐC G1300083C LDQ J G1300084C LDA- (ZERO),Q G1300085C STA L G1300086 ASSEM $E800, J, $C622, $6800, L G1300087 VIT(K) = L G1300088 100 J = J + 1 G1300089C G1300090C SKIP OVER THIS VIT IF THE FDD IS NOT DEFINED OR THE VOLUME IS NOT G1300091C MOUNTED AND READY G1300092 IF (VINFDB .EQ. 0 .OR. VISLUN .LT. 0) GO TO 200 G1300093C G1300094C SEARCH FOR THE FDS ON THIS VOLUME G1300095 CALL FNDFDS (DATA) G1300096C G1300097C CHECK IF IT WAS FOUND G1300098 IF (STATUS .EQ. 2) GO TO 9000 G1300099C G1300100C IT WAS NOT: CHECK FOR MASS MEMORY I/O ERROR G1300101 IF (STATUS .LT. 0) GO TO 10000 G1300102C G1300103C CONTINUE SEARCH G1300104 200 CONTINUE G1300105C G1300106C THE FDS WAS NEVER FOUND: RETURN WITH ERROR G1300107ÐÐ STATUS = $8002 G1300108 GO TO 10000 G1300109C G1300110C RETURN WITH NO ERROR G1300111 9000 STATUS = 0 G1300112C G1300113C RETURN TO CALLER G130011410000 RETURN G1300115 END G1300116 SUBROUTINE DELETE (IFCBAD, REQBUF, DATA, ISTAT) G1400001 1 /G14 F ITOS CCS 3.0 SL-149G1400002C FILE MANAGER DELETE FILE REQUEST PROCESSOR G1400003C CREDIT COLLECTION SYSTEM VERSION 3.0 G1400004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G1400005C COPYRIGHT CONTROL DATA CORPORATION 1979 G1400006C G1400007C*** G1400008C G1400009C THIS ROUTINE PROCESSES REQUESTS TO THE FILE MANAGER TO DELETE A FILE.G1400010C G1400011C TO DELETE A FILE MEANS TO: G1400012C A) REMOVE THE FILE'S FDS FROM THE FDD G1400013C B) RELEASE ALL MASS MEMORY USED BY THE FILE G1400014C C) RELEASE THE FILE'S FCB FOR USE BY ANOTHER FILE G1400015C D) UPDATE THE VOLUME INFORMATION TABLE G1400016ÐÐC G1400017C PARAMETERS: (ALL ARE INTEGER TYPE) G1400018C G1400019C IFCBAD - FCB CORE-IMAGE ADDRESS. UNUSED. G1400020C G1400021C REQBUF - 24 WORD SCRATCH BUFFER. UNUSED. G1400022C G1400023C DATA - 12 WORD BUFFER G1400024C WORD CONTENTS G1400025C ---- -------- G1400026C 1-4 FILE NAME. G1400027C 5-8 FILE OWNER NAME. G1400028C 9-12 FILE VOLUME NAME. IF WORD 9 IS ZERO OR BLANK G1400029C ($2020), THIS NAME IS FILLED ON RETURN TO CALLER.G1400030*E G1400031C ISTAT - COMPLETION STATUS SET ON RETURN TO CALLER: G1400032C BIT MEANING G1400033C --- -------- G1400034C 15 FILE REQUEST REJECTED. G1400035C 14* FILE REQUEST ILLEGAL. G1400036C 13* VOLUME NOT READY. G1400037C 12-6 UNUSED. G1400038C 5* MASS MEMORY I/O ERROR G1400039C 4-2 UNUSED. G1400040C 1* FILE COULD NOT BE LOCATED. G1400041ÐÐC 0* FILE IS CURRENTLY OPEN G1400042C * : BIT 15 WILL ALSO BE SET G1400043M COMMON G1400044C G1400045C THE FOLLOWING SUBROUTINES ARE USED BY DELETE G1400046C FMSWAP FM EXEC SWAP PROCESSORS ROUTINE G1400047C IOVCHK OVERLAP CHECK INTEGER FUNCTION - FTN INTERFACEG1400048C FMSCOM FM EXEC SERIAL PROCESSOR COMPLETION ROUTINE G1400049C GETFDS GET A FILE'S FDS G1400050C UCTMGR UCT ENTRY MANAGER G1400051C MREADF READ MASS MEMORY - FTN INTERFACE TO MMREAD G1400052C MWRITF WRITE MASS MEMORY - FTN INTERFACE TO MMWRIT G1400053C FCBIX RESERVE/RELEASE BLOCKS WITH A FCBT (VIA FIAT) G1400054C STOLBL STORE VOLUME RESIDENT LABEL G1400055C FDWADD DOUBLE WORD ADD - FORTRAN INTERFACE G1400056C G1400057C FOR A DEFINITION OF COMMON, SEE MACRO COMMON G1400058C G1400059 EXTERNAL MMLUTB, FMSWAP G1400060C G1400061 INTEGER REQBUF(24), DATA(12), VITADR, FCBTIX, FCBADR(2) G1400062 INTEGER UCT(6), UCTENT G1400063 INTEGER VITSIZ G1400064 INTEGER TEMP(2) G1400065C G1400066ÐÐC FOR A DEFINITION OF A VIT, SEE MACRO VITEQU G1400067M VITEQU G1400068C G1400069C MASS STORAGE RELEASE PROCESSOR INDEX G1400070 DATA MASREL /15/ G1400071C SIZE OF VOLUME INFORMATION TABLE G1400072 DATA VITSIZ /21/ G1400073 DATA FCBADR(1)/0/ G1400074 INTEGER INDEX(2) G1400075 DATA INDEX/0,0/ G1400076C*** G1400077C G1400078C G1400079C CHECK IF DATA BUFFER OVERLAPS REQBUF OR ISTAT G1400080C IF SO, ABORT VIA RETURN TO FM EXEC G1400081 IF (IOVCHK(DATA,12) .NE. 0) CALL FMSCOM G1400082C G1400083C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -G1400084C REMOVE THE FDS G1400085C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G1400086C G1400087C RETRIEVE THE FILE'S FDS G1400088 STATUS = 0 G1400089 CALL GETFDS (DATA, VITADR, MMUNIT) G1400090 IF (STATUS .NE. 0) GO TO 10000 G1400091ÐÐC G1400092C SAVE THE FCBT INDEX G1400093 J = FDS+8 G1400094 FCBTIX = BUF(J) G1400095C G1400096C SEARCH THE UCT FOR OCCURENCES OF THE FILE G1400097 UCT(2) = MMUNIT*$800 + FCBTIX G1400098 UCTENT = -1 G1400099 CALL UCTMGR (UCT, UCTENT, 2, IFLAG) G1400100C G1400101C RETURN WITH ERROR IF THE FILE IS OPEN G1400102 IF (IFLAG .EQ. 0) GO TO 9110 G1400103C G1400104C ZERO OUT THE FDS G1400105 DO 100 I = FDS, J G1400106 100 BUF(I) = 0 G1400107C G1400108C WRITE OUT THE FDB G1400109 CALL MWRITF (VIFDDM, FDB, VIWPS, VIWPS, 0, BUF, 0, STATUS) G1400110 IF (STATUS .NE. 0) GO TO 10000 G1400111C G1400112C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G1400113C READ IN THE FCB G1400114C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G1400115C G1400116ÐÐC COMPUTE BASE ADDRESS OF THE FCBT G1400117 TEMP(1) = 0 G1400118 TEMP(2) = VINFDB G1400119 CALL FDWADD (TEMP,VIFDDM, TEMP, STATUS) G1400120C READ IN THE FCB G1400121 INDEX(2) = FCBTIX + 1 G1400122 CALL MREADF (TEMP, INDEX, 96, 96, 0, BUF, 0, STATUS) G1400123 IF (STATUS .NE. 0) GO TO 10000 G1400124C G1400125C SAVE THE DATA BEGINNING SECTOR ADDRESS G1400126 DATBAM(1) = BUF(4) G1400127 DATBAM(2) = BUF(5) G1400128C G1400129C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G1400130C RELEASE THE FCB G1400131C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G1400132C G1400133C ZERO OUT THE FCB G1400134 DO 400 I = 1, 96 G1400135 400 BUF(I) = 0 G1400136 CALL MWRITF (TEMP, INDEX, 96, 96, 0, BUF, 0, STATUS) G1400137 IF (STATUS .NE. 0) GO TO 10000 G1400138C G1400139C CLEAR THE FCB INDEX BIT IN THE FIAT G1400140 CALL FCBIX (FCBTIX, 0) G1400141ÐÐ IF (STATUS .NE. 0) GO TO 10000 G1400142C G1400143C CALL IN SECONDARY PROCESSOR TO RELEASE MASS STORAGE G1400144 BUF(1) = DATBAM(1) G1400145 BUF(2) = DATBAM(2) G1400146C G1400147C LDQ MASREL G1400148C ENA 1 G1400149C RTJ+ FMSWAP G1400150C G1400151 ASSEM $E800, MASREL, $0A01, $5400, +FMSWAP G1400152C G1400153C CHECK FOR ERROR G1400154 IF (STATUS .NE. 0) GO TO 9120 G1400155C G1400156C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -G1400157C UPDATE THE VIT G1400158C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -G1400159C G1400160C DECREMENT CURRENT NO. OF FILES G1400161 VICURF = VICURF - 1 G1400162C G1400163C UPDATE CORE-RESIDENT VIT G1400164 J = VITADR G1400165 DO 500 I = 1, VITSIZ G1400166ÐÐ K = VIT(I) G1400167C G1400168C LDQ J G1400169C STA- (ZERO),Q G1400170C G1400171 ASSEM $E800, J, $6622 G1400172 500 J = J + 1 G1400173C G1400174C UPDATE VOLUME-RESIDENT LABEL G1400175 CALL STOLBL G1400176 GO TO 10000 G1400177C G1400178C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G1400179C ERROR PROCESSING G1400180C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G1400181C G1400182C INVALID REQUEST PARAMETERS G1400183 9100 STATUS = $C000 G1400184 GO TO 10000 G1400185C G1400186C G1400187C FILE IS OPEN G1400188 9110 STATUS = $8001 G1400189 GO TO 10000 G1400190C G1400191ÐÐC MASS MEMORY I/O ERROR G1400192 9120 STATUS = $8020 G1400193C G1400194C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G1400195C G1400196C RETURN TO THE FILE MANAGER G140019710000 ISTAT = STATUS G1400198 CALL FMSCOM G1400199 RETURN G1400200 END G1400201 SUBROUTINE MOVFCB (FCBADR, SUBSET, REQBUF) G1500001 1 /G15 F ITOS CCS 3.0 SL-149G1500002C MOVE FCB TO MAIN MEMORY, DETERMINE REQ'D DATA STRUCTURES G1500003C CREDIT COLLECTION SYSTEM VERSION 3.0 G1500004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G1500005C COPYRIGHT CONTROL DATA CORPORATION 1979 G1500006C G1500007C*** G1500008C G1500009C THIS ROUTINE RELOCATES A FILE'S FCB FROM THE COMMON SCRATCH BUFFER G1500010C TO ITS PROPER LOCATION. THIS LOCATION IS WITHIN THE G1500011C 1) SEQUENTIAL FILE CONTROL BLOCK TABLE (FMFCBS) OR G1500012C 2) INDEXED FILE CONTROL BLOCK TABLE (FMFCBI) OR G1500013C 3) USER'S OWN SPACE G1500014C G1500015ÐÐC THIS ROUTINE ALSO MAKES THE DETERMINATION WHETHER ANY OF THE G1500016C FOLLOWING DATA STRUCTURES ARE REQUIRED: G1500017C 1) THE FCB HEADER G1500018C 2) THE FCB SHARED SUBSET ENTRY G1500019C 3) THE FILE SPACE LIMITS ENTRY G1500020C G1500021C IF A FILE BEING OPENED IS FOUND TO BE MARKED ON MASS MEMORY AS BEING G1500022C LEFT IN AN OPEN STATE, THE SECONDARY PROCESSOR CORFCB IS USED TO G1500023C CORRECT THE FCB OR TO SET STRUCTURES UP SO THAT AN ABORTED COMPRES- G1500024C SION CAN BE CONTINUED THRU COMPLETION. G1500025C G1500026C PARAMETERS: (ALL ARE INTEGER) G1500027C G1500028C FCBADR - RETURNED SET TO THE MAIN MEMORY ADDRESS OF G1500029C THE HEADER/FCB G1500030C G1500031C SUBSET - RETURNED SET TO THE MAIN MEMORY ADDRESS OF THE FCB SUBSET.G1500032C G1500033C REQBUF - 24 WORD BUFFER PASSED TO OPENFL G1500034C G1500035C ON RETURN TO CALLER THE FOLLOWING COMMON VARIABLES ARE SET UP: G1500036*E G1500037C STATUS - COMPLETION STATUS: G1500038C BIT MEANING G1500039C --- ------- G1500040ÐÐC 15 PROCESSING ERROR G1500041C 14* INVALID REQUEST PARAMETERS G1500042C 13 UNUSED G1500043C 12* NO SPACE IN SYSTEM TABLES G1500044C 11 UNUSED G1500045C 10* INTERNAL ERROR G1500046C 9-4 UNASSIGNED G1500047C 3 FCB MASS MEMORY UPDATE REQ'D G1500048C 2 FILE SPACE LIMIT ENTRY REQ'D G1500049C 1 SHARED SUBSET ENTRY REQ'D G1500050C IF BIT 15 IS SET, MASS MEMORY I/O ERROR G1500051C 0 UNUSED G1500052C * : BIT 15 WILL ALSO BE SET G1500053C G1500054. G1500055C G1500056C G1500057C THE FOLLOWING SUBROUTINES ARE USED BY MOVFCB G1500058C UCTMGR UCT ENTRY MANAGER G1500059C CKUADR CHECK FOR ILLEGAL UNPROTECTED ADDRESS G1500060C FMSWAP FM EXEC SWAP PROCESSORS ROUTINE G1500061C G1500062C FOR A DEFINITION OF COMMON, SEE MACRO OPNCOM G1500063M OPNCOM G1500064C G1500065ÐÐ EXTERNAL FCBSCT, FMFCBI, FMFCBS, FMMOIF, FMMOSF G1500066 EXTERNAL CKUADR, FMSWAP G1500067C G1500068 INTEGER FCBADR, REQBUF(24), UCT(6), UCTIDX, SEQLEN, FH G1500069 INTEGER SUBSET, UCTSIZ, CORFCB G1500070C G1500071C LENGTH OF AN ENTRY IN 'FMFCBI' G1500072 DATA IDXLEN /27/ G1500073C LENGTH OF AN ENTRY IN 'FMFCBS' G1500074 DATA SEQLEN/15/ G1500075C LENGTH OF AN FCB HEADER G1500076 DATA FH /5/ G1500077C SIZE OF A UCT ENTRY G1500078 DATA UCTSIZ/6/ G1500079C CORRECT FCB SECONDARY PROCESSOR INDEX G1500080 DATA CORFCB/17/ G1500081C*** G1500082C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G1500083C DETERMINE CURRENT USAGE OF THE FILE G1500084C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G1500085C G1500086C G1500087 STATUS = 0 G1500088 DO 5 I = 1, UCTSIZ G1500089 5 UCT(I) = 0 G1500090ÐÐC G1500091C GET ADDRESSES OF END AND START OF FMFCBS AND FMFCBI G1500092C G1500093C LDA =XFCBSCT G1500094C STA I G1500095C LDA =XFMFCBS G1500096C STA J G1500097C G1500098 ASSEM $C000, +FCBSCT, $6800, I, $C000, +FMFCBS, $6800, J G1500099C G1500100C SCAN THE UCT FOR USERS OF THE FILE G1500101 UCTIDX = -1 G1500102 UCT(2) = FILE G1500103 10 CALL UCTMGR (UCT, UCTIDX, 2, IFLAG) G1500104C G1500105C CHECK FOR ERROR G1500106 IF (IFLAG .LT. 0) GO TO 9100 G1500107C G1500108C CHECK IF END-OF-TABLE WAS REACHED G1500109 IF (IFLAG .NE. 0) GO TO 80 G1500110C G1500111C G1500112C CHECK IF THIS USER CARRIES THE FCB IN ITS OWN SPACE, I.E. OUTSIDE G1500113C OF FM TABLES. G1500114 IF (UCT(3) .LE. I .AND. UCT(3) .GE. J) GO TO 60 G1500115ÐÐC G1500116C YES: INDICATE SUBSET MIGHT BE REQUIRED G1500117 STATUS = 2 G1500118 GO TO 10 G1500119C G1500120C FCB RESIDES IN FM TABLES SPACE: SUBSET NOT REQUIRED G1500121 60 STATUS = 0 G1500122C G1500123C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G1500124C DETERMINE REQUIRED DATA STRUCTURES G1500125C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G1500126C G1500127C SAVE CURRENT FCB ADDRESS (MIGHT BE ZERO) G1500128 80 LOCATE = UCT(3) G1500129C G1500130C SAVE CURRENT SUBSET ADDRESS (MIGHT BE ZERO) G1500131 SUBSET = UCT(5) G1500132C G1500133C DID USER REQUEST FM TABLE SPACE FOR THE FCB G1500134 IF (REQBUF(6) .NE. 0) GO TO 100 G1500135C G1500136C YES: EXIT IF IT IS CURRENTLY THERE G1500137 IF (STATUS .EQ. 0 .AND. UCT(1) .NE. 0) GO TO 10000 G1500138C G1500139C RESET SUBSET ADDRESS G1500140ÐÐ SUBSET = 0 G1500141 GO TO 400 G1500142C G1500143C FCB IS TO RESIDE IN USER'S SPACE: CHECK IF SUBSET MIGHT BE REQUIRED G1500144 100 IF (STATUS .EQ. 0) GO TO 300 G1500145C G1500146C YES: NO NEED TO BUILD ONE IF PREVIOUS USER ALREADY HAS ONE G1500147 IF (LOCATE .EQ. SUBSET) GO TO 200 G1500148 STATUS = 0 G1500149 GO TO 300 G1500150 200 SUBSET = 0 G1500151C G1500152C SAVE USER'S FCB SPACE ADDRESS G1500153 300 LOCATE = REQBUF(6) G1500154C G1500155C INDICATE FILE SPACE LIMIT ENTRY IS REQUIRED G1500156 STATUS = STATUS + 4 G1500157C G1500158C CHECK IF THERE ARE ANY OTHER USERS G1500159 400 IF (UCT(1) .NE. 0) GO TO 500 G1500160C G1500161C INDICATE NEED FOR FCB MASS MEMORY UPDATE G1500162 STATUS = STATUS + 8 G1500163C G1500164C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G1500165ÐÐC RELOCATE THE FCB G1500166C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G1500167C G1500168C CHECK IF THE FILE IS INDEXED G1500169 500 IF (AND (BUF(6), 1) .EQ. 0) GO TO 600 G1500170C G1500171C YES: PREPARE TO SCAN THE FMFCBI G1500172C G1500173C LDA =XFMCBI G1500174C STA J G1500175C LDA =XFMMOIF G1500176C STA I G1500177C G1500178 ASSEM $C000, +FMFCBI, $6800, J G1500179 ASSEM $C000, +FMMOIF, $6800, I G1500180 LGH = IDXLEN G1500181 GO TO 700 G1500182C G1500183C PREPARE TO SCAN THE FMFCBS G1500184C G1500185C LDA =XFMFCBS G1500186C STA J G1500187C LDA =XFMMOSF G1500188C STA I G1500189C G1500190ÐÐ 600 ASSEM $C000, +FMFCBS, $6800, J G1500191 ASSEM $C000, +FMMOSF, $6800, I G1500192 LGH = SEQLEN G1500193C G1500194C G1500195C WILL THE FCB RESIDE IN A SYSTEM TABLE G1500196 700 IF (REQBUF(6) .EQ. 0) GO TO 720 G1500197C G1500198C NO: IT WILL RESIDE IN USER SPACE. INSURE USER ASKED FOR AT LEAST G1500199C THE MINIMUM NO. OF WORDS OF THE FCB G1500200 IF (REQBUF(17) .EQ. 0) GO TO 710 G1500201 IF (REQBUF(17) .LT. LGH) GO TO 9110 G1500202 LGH = REQBUF(17) + 5 G1500203C G1500204C INSURE AN UNPROTECTED USER DID NOT SPECIFY A PROTECTED AREA G1500205C FOR HIS FCB G1500206C G1500207C LDA PCTABL G1500208C STA- I G1500209C LDA LOCATE G1500210C ENQ 0 G1500211C RTJ+ CKUADR G1500212C ADD LGH G1500213C INA -1 G1500214C RTJ+ CKUADR G1500215ÐÐC G1500216 710 ASSEM $C400, +PCTABL, $60FF, $C800, LOCATE, $0C00 G1500217 ASSEM $5400, +CKUADR, $8800, LGH, $09FE, $5400, +CKUADR G1500218 GO TO 800 G1500219C G1500220C FIND ROOM IN A SYSTEM TABLE FOR THE FCB G1500221C COMPUTE ENDING ADDRESS OF SCAN G1500222 720 LAST = (I-1) * LGH + J G1500223+ 127*5188G1500224C G1500225C SCAN FOR AN ENTRY WITH ITS FIRST WORD = 0 G1500226 DO 750 LOCATE = J, LAST, LGH G1500227C G1500228C LDQ LOCATE G1500229C LDA- (ZERO),Q G1500230C SAN 2 G1500231C JMP 800 G1500232C G1500233 750 ASSEM $E800, LOCATE, $C622, $0112, $1800, 800 G1500234C G1500235C NO SPACE WAS FOUND: RETURN WITH ERROR G1500236 STATUS = $9000 G1500237 GO TO 10000 G1500238C G1500239C STORE FCB ADDRESS IN REQBUF (CORFCB NEEDS IT) G1500240ÐÐ 800 REQBUF(6) = LOCATE G1500241C G1500242C ZERO OUT THE FCB HEADER SPACE G1500243 J = LOCATE G1500244 DO 810 I = 1, FH G1500245C LDQ J G1500246C ENA 0 G1500247C STA- (ZERO),Q G1500248C G1500249 ASSEM $E800, J, $0A00, $6622 G1500250 810 J = J + 1 G1500251C G1500252C SET UP FILE ID G1500253C G1500254C LDQ LOCATE G1500255C LDA+ FILE G1500256C STA- (ZERO),Q G1500257C G1500258 ASSEM $E800, LOCATE, $C400, +FILE, $6622 G1500259C G1500260C MOVE THE FCB TO THE SPACE G1500261 LAST = LGH - FH G1500262 DO 820 I = 1, LAST G1500263 K = BUF(I) G1500264C G1500265ÐÐC LDA K G1500266C LDQ J G1500267C STA- (ZERO),Q G1500268C G1500269 ASSEM $C800, K, $E800, J, $6622 G1500270 820 J = J + 1 G1500271C G1500272C SAVE FCB ADDRESS AS SUBSET ADDRESS UNLESS A SUBSET EXISTS SEPERATELY G1500273 IF (SUBSET .EQ. 0) SUBSET = LOCATE G1500274C G1500275C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G1500276C VALIDATE THE MASS MEMORY IMAGE OF THE FCB G1500277C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G1500278C G1500279C ARE THERE ANY CURRENT FILE USERS G1500280 IF (UCT(1) .NE. 0) GO TO 10000 G1500281C G1500282C NO: WAS THE FILE MARKED OPEN ON MASS MEMORY G1500283 IF (AND (BUF(6),$2000) .EQ. 0) GO TO 10000 G1500284C G1500285C YES: MUST ASSUME A SYSTEM OUTAGE OCCURED AND THE FCB IS INACCURATE G1500286C (FILE MAY HAVE BEEN IN A COMPRESSION CYCLE). G1500287C CORRECT THIS SITUATION - USE CORFCB SECONDARY PROCESSOR. G1500288C G1500289C ENA 1 G1500290ÐÐC LDQ CORFCB G1500291C RTJ+ FMSWAP G1500292C G1500293 ASSEM $0A01,$E800, CORFCB, $5400, +FMSWAP G1500294 GO TO 10000 G1500295C G1500296C INDICATE THE FCB MUST BE WRITTEN TO MASS MEMORY G1500297 900 STATUS = AND (STATUS, $FFF7) + 8 G1500298 GO TO 10000 G1500299C G1500300C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G1500301C ERROR PROCESSING G1500302C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -G1500303C G1500304C-- INTERNAL ERROR G1500305 9100 STATUS = $9400 G1500306 GO TO 10000 G1500307C G1500308C-- INVALID REQUEST G1500309 9110 STATUS = $C000 G1500310C G1500311C RETURN TO CALLER G150031210000 FCBADR = LOCATE G1500313 RETURN G1500314 END G1500315ÐÐ SUBROUTINE CKRQST (IDATA, USER, UCTIDX, REQBUF) G1600001 1 /G16 F ITOS CCS 3.0 SL-149G1600002C VALIDATE OPEN FILE REQUEST G1600003C CREDIT COLLECTION SYSTEM VERSION 3.0 G1600004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G1600005C COPYRIGHT CONTROL DATA CORPORATION 1979 G1600006C G1600007C*** G1600008C G1600009C THIS ROUTINE VERIFIES THE SYSTEM HAS SUFFICIENT AVAILABLE RESOURCES G1600010C TO IMPLEMENT AN OPEN FILE REQUEST I.E. G1600011C 1) THERE IS AN EMPTY SPOT IN THE UCT G1600012C 2) THE USER HAS NOT REACHED HIS MAX PERMITTED NO. OF OPEN FILES G1600013C G1600014C PARAMETERS: (ALL ARE INTEGER TYPE) G1600015C G1600016C IDATA - 12 WORD DATA ARRAY: THE FIRST 12 WORDS OF THE ARRAY PASSEDG1600017C TO OPENFL. G1600018C G1600019C USER - THE ID OF THE USER OPENING THE FILE G1600020C G1600021C UCTIDX - RETURNED SET TO AN EMPTY SPOT IN THE UCT G1600022C G1600023C REQBUF - USER'S REQUEST BUFFER (MAIN PART) G1600024C WORD 6 HAS USER'S FCB ADDRESS - IF NON-ZERO G1600025ÐÐC WORD 17 HAS REQ'D FCB LENGTH IF NON-ZERO AND WORD 6 NOT 0G1600026*E G1600027C THE FOLLOWING COMMON VARIABLES ARE SET ON RETURN TO CALLER: G1600028C G1600029C BUF - CONTAINS THE FILE'S FCB G1600030C VIT - APPLICABLE VOLUME INFORMATION TABLE G1600031C FDB - MASS MEMORY ADDR OF THE FILE'S FDB (MSB/LSB) G1600032C FDS - INDEX INTO THE FDB TO THE FILE'S FDS G1600033C MMUNIT - FILE VOLUME'S MASS MEMORY UNIT NO. G1600034C SIZE - NO. OF WORDS/SECTOR OF VOLUME G1600035C FILE - RETURNED SET TO THE OPENING FILE'S PSUEDO FILE ID G1600036C STATUS - COMPLETION STATUS: G1600037C =0 : NO ERROR OCCURED. G1600038C =$C000 : INVALID PARAMETERS. G1600039C =$A000 : VOLUME NOT READY. G1600040C =$9000 : NO ROOM IN THE UCT WAS FOUND FOR A NEW ENTRY. G1600041C =$8800 : MAX NO. OF USER OPEN FILE OBTAINS. G1600042C =$8020 : MASS MEMORY I/O ERROR G1600043C =$8002 : FILE COULD NOT BE LOCATED G1600044C =$8001 : FILE ALREADY OPEN TO USER. G1600045C G1600046C THE FOLLOWING SUBROUTINES ARE USED BY CKRQST G1600047C GETFDS GET A FILE'S FDS G1600048C MREADF READ MASS MEMORY - FTN INTERFACE TO MMREAD G1600049C IOVCHK OVERLAP CHECK INTEGER FUNCTION - FTN INTERFACEG1600050ÐÐC FMSCOM FM EXEC SERIAL PROCESSOR COMPLETION ROUTINE G1600051C FDWADD DOUBLE WORD ADD - FORTRAN INTERFACE G1600052C G1600053C FOR A DEFINITION OF A VIT, SEE MACRO VITEQU G1600054. G1600055M VITEQU G1600056C FOR A DEFINITION OF COMMON, SEE MACRO OPNCOM G1600057M OPNCOM G1600058C G1600059 EXTERNAL FMMOSU, FMMOIU G1600060 EXTERNAL FMCOVL G1600061C G1600062 INTEGER IDATA(12), USER, FILE, UCTIDX, UCT(6), OPNCNT G1600063 INTEGER VITADR, FILTYP, FILOCK, FCBADR(2) G1600064C G1600065 INTEGER REQBUF(20) G1600066 DATA FCBADR(1)/0/ G1600067 INTEGER TEMP(2) G1600068 INTEGER INDEX(2) G1600069 DATA INDEX/0,0/ G1600070C G1600071C FCB BUFFER MINIMUM LENGTH FOR SEQUENTIAL FILE G1600072 DATA LENSEQ/15/ G1600073C FCB BUFFER MINIMUM LENGTH FOR INDEXED FILE G1600074 DATA LENIDX /27/ G1600075ÐÐ. G1600076C G1600077C*** G1600078C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G1600079C READ THE FCB INTO MAIN MEMORY G1600080C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G1600081C G1600082C GET THE FDS G1600083 STATUS = 0 G1600084 CALL GETFDS (IDATA, VITADR, MMUNIT) G1600085 IF (STATUS .NE. 0) GO TO 10000 G1600086C G1600087C FORM PSUEDO FILE ID G1600088 FILE = MMUNIT*$800 + BUF(FDS+8) G1600089C G1600090C READ FCB G1600091 SIZE = 96 G1600092 TEMP(1) = 0 G1600093 TEMP(2) = VINFDB G1600094 CALL FDWADD (TEMP,VIFDDM,TEMP,STATUS) G1600095 INDEX(2) = BUF(FDS+8) + 1 G1600096 CALL MREADF (TEMP, INDEX, 96, 96, 0, BUF, 0, STATUS) G1600097 IF (STATUS .NE. 0) GO TO 10000 G1600098C G1600099C DETERMINE FILE TYPE: SEQUENTIAL OR INDEXED G1600100ÐÐ FILTYP = AND (BUF(6), 1) G1600101C G1600102C IF BINARY DATA FILE, ILLEGAL TO OPEN FOR COMPRESSION G1600103C*********************************************************** 136*A002G1600104 IF (IDATA(13).EQ.-1 .AND. AND(BUF(6),$100).NE.0) GO TO 9100 G1600105C*********************************************************** 136*A002G1600106C G1600107C SKIP IF FCB NOT TO BE IN USER SPACE G1600108 IF (REQBUF(6) .EQ. 0) GO TO 10 G1600109C G1600110C SET UP TO CHECK FOR OVERLAP OF FCB BUFFER G1600111 LEN = LENSEQ G1600112 IF (FILTYP .EQ. 1) LEN = LENIDX G1600113C G1600114C IF OVERLAP OF FCB BUFFER WITH REQBUF OR ISTAT, ABORT REQUEST G1600115C G1600116C SET UP REGS FOR MAIN MEMORY RESIDENT ROUTINE FMCOVL G1600117C G1600118C REG I = PCT ADDR G1600119C LDA+ PCTABL G1600120C STA- I G1600121C G1600122 ASSEM $C000,+PCTABL,$60FF G1600123C G1600124C REG A = ABSOLUTE ADDR OF FCB BUFFER (IN REQBUF(6)) G1600125ÐÐC LOCALIZE ADDR G1600126C G1600127 I = REQBUF(6) G1600128C G1600129C LDA I G1600130C G1600131 ASSEM $C800,I G1600132C G1600133C REG Q = LENGTH G1600134C LDQ LEN G1600135C G1600136 ASSEM $E800, LEN G1600137C G1600138C RTJ FMCOVL G1600139C G1600140 ASSEM $5400, +FMCOVL G1600141C G1600142C RETURNS INDICATOR IN REG A G1600143C REG A = 0 MEANS GOOD G1600144C G1600145C NON-ZERO MEANS BAD G1600146C SAZ 2 G1600147C CALL FMSCOM G1600148C G1600149 ASSEM $0102 G1600150ÐÐC G1600151C LEAVE G1600152C G1600153 CALL FMSCOM G1600154C G1600155C DETERMINE RECORD RETRIEVAL TYPE: SEQUENTIAL OR INDEXED G1600156 10 IF (IDATA(13) .LE. 0) GO TO 80 G1600157C G1600158C INSURE THE FILE IS DEFINED AS INDEXED G1600159 IF (FILTYP .EQ. 0) GO TO 9100 G1600160C G1600161C INSURE DESIRED RETRIEVAL KEY IS A VALID ONE G1600162 I = (IDATA(13)-1)*2 + 15 G1600163 IF (BUF(I) .EQ. 0) GO TO 9100 G1600164C G1600165C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G1600166C VERIFY USER DOES NOT ALREADY HAVE HIS MAX PERMITTED NO. OF OPEN G1600167C FILES ALREADY OPEN AND THAT THE OPENING FILE IS NOT ALREADY OPEN TO G1600168C HIM G1600169C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G1600170C G1600171C GET LIMIT ON CONCURRENTLY OPEN USER FILES G1600172 80 OPNCNT = 0 G1600173C G1600174C LDA =XFMMOSU G1600175ÐÐC STA LIMIT G1600176C G1600177 ASSEM $C000, +FMMOSU, $6800, LIMIT G1600178 IF (FILTYP .EQ. 0) GO TO 90 G1600179C G1600180C LDA =XFMMOIU G1600181C STA LIMIT G1600182C G1600183 ASSEM $C000, +FMMOIU, $6800, LIMIT G1600184C G1600185C SCAN UCT FOR ENTRIES OF THIS USER G1600186 90 UCT(1) = USER G1600187 UCTIDX = -1 G1600188 100 CALL UCTMGR (UCT, UCTIDX, 1, STATUS) G1600189C G1600190C CHECK FOR END-OF-TABLE G1600191 IF (STATUS .EQ. 1) GO TO 300 G1600192C G1600193C CHECK IF OPENING FILE IS ALREADY OPEN TO USER G1600194 IF (UCT(2) .EQ. FILE) GO TO 9500 G1600195C G1600196C DETERMINE THIS FILE'S TYPE G1600197C G1600198C LDQ UCT(3) FCB ADDRESS G1600199C LDA- 10,Q GET FCBIND G1600200ÐÐC AND- ONEMSK (0001) G1600201C STA I G1600202C G1600203 ASSEM $E800, UCT(3), $C20A, $A003, $6800, I G1600204C G1600205C IS FILE TYPE SAME AS OPENING FILE'S G1600206 IF (FILTYP .NE. I) GO TO 100 G1600207C G1600208C BUMP COUNT G1600209 OPNCNT = OPNCNT + 1 G1600210 GO TO 100 G1600211C G1600212C CHECK CURRENT OPEN COUNT AGAINST LIMIT G1600213 300 IF (OPNCNT .EQ. LIMIT) GO TO 9200 G1600214C G1600215C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G1600216C LOCATE AVAILABLE SPOT IN THE UCT FOR A NEW ENTRY G1600217C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G1600218C G1600219 UCTIDX = -1 G1600220 CALL UCTMGR (UCT, UCTIDX, 0, STATUS) G1600221 IF (STATUS .EQ. 0) GO TO 10000 G1600222C G1600223C NOT FOUND: RETURN WITH ERROR G1600224 STATUS = $9000 G1600225ÐÐ GO TO 10000 G1600226C G1600227C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G1600228C ERROR PROCESSING G1600229C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G1600230C G1600231C-- INVALID PARAMETERS G1600232 9100 STATUS = $C000 G1600233 GO TO 10000 G1600234C G1600235C-- MAX ALLOWED USER OPEN FILES REACHED G1600236 9200 STATUS = $8800 G1600237 GO TO 10000 G1600238C G1600239C-- FILE ALREADY OPEN TO USER G1600240 9500 STATUS = $8001 G1600241C G1600242C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G1600243C G160024410000 RETURN G1600245 END G1600246 SUBROUTINE RENAME (IFCBAD, REQBUF, IDATA, NEWNAM, ISTAT) G1700001 1 /G17 F ITOS CCS 3.0 SL-149G1700002C FILE MANAGER RENAME FILE REQUEST PROCESSOR G1700003C CREDIT COLLECTION SYSTEM VERSION 3.0 G1700004ÐÐC DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G1700005C COPYRIGHT CONTROL DATA CORPORATION 1979 G1700006C G1700007C*** G1700008C G1700009C THIS ROUTINE PROCESSES REQUEST TO THE FILE MANAGER TO RENAME A FILE. G1700010C G1700011C TO RENAME A FILE MEANS TO: G1700012C A) DELETE THE FILE'S CURRENT FDS. G1700013C B) CREATE A NEW FDS UNDER THE NEW NAME. G1700014C 3) ALTER THE NAME IN THE FILE'S FCB. G1700015C G1700016C PARAMETERS: G1700017C G1700018C IFCBAD - UNUSED. G1700019C G1700020C REQBUF - 24 WORD SCRATCH BUFFER. UNUSED. G1700021C G1700022C IDATA - 12 WORD BUFFER: G1700023C WORD CONTENTS G1700024C ---- -------- G1700025C 1-4 CURRENT FILE NAME G1700026C 5-8 CURRENT OWNER NAME G1700027C 9-12 FILE'S VOLUME NAME. IF WORD 9 IS ZERO OR BLANK, G1700028C ($2020), THIS NAME WILL BE FILLED IN UPON RETURN G1700029ÐÐC TO CALLER. G1700030C G1700031C NEWNAM - 8 WORD BUFFER: G1700032C WORD CONTENTS G1700033C ---- -------- G1700034C 1-4 NEW FILE NAME G1700035C 5-8 NEW OWNER NAME G1700036*E G1700037C ISTAT - COMPLETION STATUS SET ON RETURN TO CALLER^ G1700038C BIT MEANING G1700039C --- -------- G1700040C 15 REQUEST REJECTED. G1700041C 14* FILE REQUEST ILLEGAL. G1700042C 13* VOLUME NOT READY. G1700043C 12 UNUSED. G1700044C 11* NO ROOM IN FDD FOR NEW FDS. G1700045C 10 UNUSED. G1700046C 10* NEW FILE/OWNER NAME NOT UNIQUE. G1700047C 9-6 UNUSED. G1700048C 5* MASS MEMORY I/O ERROR. G1700049C 4-2 UNUSED. G1700050C 1* FILE COULD NOT BE FOUND. G1700051C 0* FILE CURRENTLY OPEN. G1700052C G1700053C G1700054ÐÐC THE FOLLOWING SUBROUTINES ARE USED BY RENAME G1700055C FMSCOM FM EXEC SERIAL PROCESSOR COMPLETION ROUTINE G1700056C IOVCHK OVERLAP CHECK INTEGER FUNCTION - FTN INTERFACEG1700057C GETFDS GET A FILE'S FDS G1700058C UCTMGR UCT ENTRY MANAGER G1700059C MREADF READ MASS MEMORY - FTN INTERFACE TO MMREAD G1700060C MWRITF WRITE MASS MEMORY - FTN INTERFACE TO MMWRIT G1700061C BLDFDS BUILD A FILE DIRECTORY SEGMENT G1700062C FDWADD DOUBLE WORD ADD - FORTRAN INTERFACE G1700063C G1700064 EXTERNAL FMSCOM G1700065C FOR A DEFINITION OF COMMON, SEE MACRO OPNCOM G1700066M COMMON G1700067C FOR A DEFINITION OF A VIT, SEE MACRO VITEQU G1700068M VITEQU G1700069C G1700070 INTEGER REQBUF(24), IDATA(12), NEWNAM(8), VITADR, OLDFDB(2) G1700071 INTEGER OLDFDS, RELREC(2) G1700072 INTEGER UCT(6), UCTENT G1700073 INTEGER TEMP(2) G1700074 INTEGER IDEX(2) G1700075 DATA IDEX/0,0/ G1700076C G1700077 DATA RELREC(1) / 0/ G1700078C*** G1700079ÐÐC- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - G1700080C G1700081C G1700082C CHECK IF DATA BUFFER OVERLAPS REQBUF OR ISTAT G1700083C IF SO, ABORT VIA RETURN TO FM EXEC G1700084 IF (IOVCHK(IDATA,12) .NE. 0) CALL FMSCOM G1700085C G1700086C INITIALIZE STATUS TO ZERO G1700087 STATUS = 0 G1700088C G1700089C G1700090C GET THE FILE'S CURRENT FDS G1700091 CALL GETFDS (IDATA, VITADR, MMUNIT) G1700092 IF (STATUS .NE. 0) GO TO 10000 G1700093C G1700094C SAVE FDB/FDS ADDRESS G1700095 OLDFDB(1) = FDB(1) G1700096 OLDFDB(2) = FDB(2) G1700097 OLDFDS = FDS G1700098C G1700099C SAVE FCB INDEX G1700100 INDEX = BUF(FDS+8) G1700101C G1700102C SEARCH THE UCT FOR OCCURENCES OF THE FILE G1700103 UCT(2) = MMUNIT*$800 + INDEX G1700104ÐÐ UCTENT = -1 G1700105 CALL UCTMGR (UCT, UCTENT, 2, IFLAG) G1700106 IF (IFLAG .EQ. 1) GO TO 50 G1700107C G1700108C FILE IS OPEN: FLAG AN ERROR G1700109 STATUS = $8001 G1700110 GO TO 10000 G1700111C G1700112C COMPUTE BASE ADDRESS OF FCBT G1700113 50 TEMP(1) = 0 G1700114 TEMP(2) = VINFDB G1700115 CALL FDWADD (TEMP,VIFDDM,TEMP,STATUS) G1700116 IDEX(2) = INDEX + 1 G1700117C G1700118C READ IN THE FCB G1700119 CALL MREADF (TEMP, IDEX, 96, 96, 0, BUF, 0, STATUS) G1700120 IF (STATUS .NE. 0) GO TO 10000 G1700121C G1700122C G1700123C BUILD THE NEW FDS G1700124 CALL BLDFDS (NEWNAM, INDEX) G1700125 IF (STATUS .NE. 0) GO TO 10000 G1700126C G1700127C RE-READ THE OLD FDS G1700128 CALL MREADF (VIFDDM, OLDFDB, VIWPS, VIWPS, 0, BUF, 0, STATUS) G1700129ÐÐ IF (STATUS .NE. 0) GO TO 10000 G1700130C G1700131C RELEASE THE OLD FDS G1700132 DO 80 I = 1, 9 G1700133 BUF(OLDFDS) = 0 G1700134 80 OLDFDS = OLDFDS + 1 G1700135C G1700136 CALL MWRITF (VIFDDM, OLDFDB, VIWPS, VIWPS, 0, BUF, 0, STATUS) G1700137 IF (STATUS .NE. 0) GO TO 10000 G1700138C G1700139C RE-READ THE FCB G1700140 CALL MREADF (TEMP, IDEX, 96, 96, 0, BUF, 0, STATUS) G1700141 IF (STATUS .NE. 0) GO TO 10000 G1700142C G1700143C CHANGE THE NAMES IN THE FCB G1700144 J = 25 G1700145 DO 100 I = 1, 8 G1700146 BUF(J) = NEWNAM(I) G1700147 100 J = J + 1 G1700148 CALL MWRITF (TEMP, IDEX, 96, 96, 0, BUF, 0, STATUS) G1700149C G1700150C RETURN TO FILE MANAGER G170015110000 ISTAT = STATUS G1700152 CALL FMSCOM G1700153 RETURN G1700154ÐÐ END G1700155 SUBROUTINE ADDIDX (FCB ,REQBUF,RECBUF,KEYVL ,ISTAT) G1800001 1 /G18 F ITOS CCS 3.0 SL-149G1800002C FILE MANAGER WRITE RECORD REQUEST PROCESSOR G1800003C CREDIT COLLECTION SYSTEM VERSION 3.0 G1800004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G1800005C COPYRIGHT CONTROL DATA CORPORATION 1979 G1800006C G1800007C G1800008C*** G1800009C ADDIDX IS THE REQUEST PROCESSOR FOR THE WRITE A RECORD INTO G1800010C AN INDEXED FILE VIA KEY VALUE REQUEST. THE WRITER REQUEST G1800011C HAS THE FOLLOWING CALL SEQUENCE : G1800012C G1800013C CALL WRITER (REQBUF, RECBUF, KEYVAL, ISTAT) G1800014C G1800015C WHERE REQBUF IS THE FILE REQUEST BUFFER, G1800016C RECBUF IS THE RECORD BUFFER CONTAINING THE RECORD G1800017C TO BE STORED G1800018C KEYVAL IS THE BUFFER CONTAINING THE PRIMARY KEY G1800019C OF THE RECORD. THE KEY MUST BE LEFT G1800020C JUSTIFIED G1800021C ISTAT IS THE FILE REQUEST STATUS WORD. G1800022C G1800023C G1800024ÐÐC INPUT: G1800025C THE FM EXEC TRANSFERS CONTROL TO ADDIDX. G1800026C G1800027C G1800028C PROCESS: G1800029C ADDIDX PICKS UP ALL REVELENT INFO FROM THE FCB G1800030C EXTRACTS THE PRIMARY KEY FROM THE RECORD G1800031C VERIFIED THAT IT IS THE SAME AS THE KEYVAL PASSED FROM THE G1800032C USER G1800033C VERIFIES THAT THE PRIMARY KEY IS UNIQUE (HAS NOT BEEN USED G1800034C BEFORE) G1800035C CALLS PUTREC (MAIN MEMORY RESIDENT ROUTINE) TO PUT RECORD G1800036C AS LAST ENTRY IN DATA FILE G1800037C ADDS A KIS FOR EVERY KEY DEFINED FOR THIS FILE THUS G1800038C REFLECTING THIS ADDITION G1800039C G1800040*E G1800041C EXIT: G1800042C ADDIDX RETURNS TO THE EXEC VIA A CALL TO FMSCOM G1800043C G1800044C G1800045C THE FOLLOWING SUBROUTINES ARE USED BY ADDIDX G1800046C CMPSTG - COMPARES TWO STRINGS OF CHARACTER G1800047C CPUTKL - COMPUTE LENGTH OF A KEY INFO BLOCK G1800048C XTKEY - EXTRACT KEY FROM RECORD G1800049ÐÐC POSKID - POSITION INTO A KEY INFORMATION DIRECTORY G1800050C PLACE - WRITE A RECORD IN THE DATA AREA G1800051C ADDKIS - ADD A KEY INFO SEGMENT INTO A KEY INFO G1800052C DIRECTORY G1800053C CKUFCB - UPDATE FCB ON MASS MEMORY G1800054C FMSCOM FM EXEC SERIAL PROCESSOR COMPLETION ROUTINE G1800055C G1800056C FOR A DEFINITION OF FMCOM, SEE MACRO FMCOM G1800057M FMCOM G1800058C FOR A DEFINITION OF FMCOM2, SEE MACRO FMCOM2 G1800059M FMCOM2 G1800060C FOR DESCRIPTION OF VARIABLES, SEE MACRO FMCOM3G1800061C FOR A DEFINITION OF INIDAT, SEE MACRO INIDAT G1800062 INTEGER FCB(10) G1800063 INTEGER II(2) G1800064 INTEGER KEYVL(1) G1800065 INTEGER RECBUF(1) G1800066 INTEGER REQBUF(10) G1800067C CURRENT FILE ID (FILEID) G1800068C PREVIOUS FILE ID (PREID) G1800069C PREVIOUS KEY TYP (PRETYP) G1800070. G1800071C DO NOT CLEAR COMMON AREA, MAY CONTAIN INFO USEFUL FOR G1800072C ACROSS CALLS. G1800073M FMINIT G1800074ÐÐC*** G1800075. G1800076C --CLEAR RELATIVE RECORD NUMBER G1800077 RRDATA (1) = 0 G1800078 RRDATA (2) = 0 G18000793 G1800080C --PUT EOF SYMBOL AT END OF KIB BUFFER G1800081C --THIS IS FOR RECOVERY OF KIB , IN CASE THE SYSTEM CRASHED G1800082C G1800083C LDA =XFMEOFC GET SYMBOL FOR EOF G1800084C STA+ KIBE1 STORE AT END OF KIBBUF G1800085C G1800086 ASSEM $C000, FMEOFC, $ 6400, +KIBE1 G1800087C G1800088 KIBBUF(KIBLEN+1) = KIBE1 G1800089 KIBBUF(KIBLEN+2) = KIBE1 G18000902 G1800091C --EXTRACT PRIMARY KEY FROM RECORD G1800092 KEYTYP = 1 G1800093 CALL XTKEY (FCB,RECBUF) G1800094C --COMPARE THE KEY EXTRACTED FROM THE RECORD WITH THE KEY G1800095C --PASSED BY THE USER G1800096 KEYLWD = KEYLNG/2 G1800097 IF (CMPSTG(KEYVAL,KEYVL,KEYLWD) .NE. 0) GO TO 60 G1800098C --KEY PASSED MAY NOT BE ZERO FILLED G1800099ÐÐ IF (AND(KEYLNG,1) .EQ.0) GO TO 40 G1800100 KEYLWD = KEYLWD + 1 G1800101 IF (KEYVAL(KEYLWD) .NE. AND(KEYVL(KEYLWD) ,$FF00)) GO TO 60 G1800102 40 CONTINUE G1800103 GO TO 100 G18001042 G18001051 G1800106 60 CONTINUE G1800107C --PRIMARY KEY VALUE PASSED BY USER IS DIFFERENT FROM THE ONE G1800108C --EXTRACTED FROM THE RECORD G1800109 BADKEY = 1 G1800110 ERRIDC = 1 G1800111 GO TO 1100 G18001123 G1800113 100 CONTINUE G1800114C --STORE RECORD IN FILE AS LAST SEQUENTIAL RECORD G1800115C --RELATIVE RECORD NUMBER IS STORED IN RRDATA G1800116C --ERROR INDICATION, IF ANY, IS NOTED IN REQSTA G1800117C ********************************************************* 132*5399G1800118 II(1) = FCB(12) G1800119 II(2) = FCB(13) G1800120C ********************************************************* 132*5399G1800121 CALL PLACE G1800122C --MAY BE MM ERROR OR DATA FILE FULL ERROR G1800123 IF (REQSTA .LT. 0) GO TO 900 G1800124ÐÐC --RELATIVE RECORD NO. IS IN REQBUF G1800125 RRDATA(1) = REQBUF(12) G1800126 RRDATA(2) = REQBUF(13) G18001272 G1800128C -- MOVE PSEUDO FILEID TO FILEID G1800129 FILEID = FCB(1) G1800130C --UPDATE KEY INFO SECTION BY ADDING NEW KEYS FOR ALL G1800131C --KEY TYPES DEFINED FOR THIS FILE G1800132 DO 200 KEYTYP = 1, 4, 1 G1800133 I = KLIDX (KEYTYP) G1800134 KEYLNG = FCB (I) G1800135 IF (KEYLNG .EQ. 0) GO TO 200 G1800136C SAVE LAST KEY TYPE G1800137 ITYPE = KEYTYP G1800138C EXTRACT KEY VALUE G1800139 CALL XTKEY (FCB,RECBUF) G1800140C ADD KEY TO INDEX STRUCTURE G1800141 CALL ADDKIS G1800142 IF (REQSTA .LT. 0 ) GO TO 900 G1800143 200 CONTINUE G1800144 GO TO 1000 G18001452 G1800146C ********************************************************* 132*5399G1800147C ERROR IN GENERATION OF KEY STRUCTURE G1800148C G1800149ÐÐC RECORD MUST BE REMOVED FROM THE FILE G1800150C G1800151C SAVE CONTENTS OF 1ST 2 WORDS OF RECORD G1800152C G1800153 900 CONTINUE G1800154 ISAVE1 = RECBUF(1) G1800155 ISAVE2 = RECBUF(2) G1800156C G1800157C SAVE THE REQUEST STATUS. G1800158C G1800159 ISTSAV = REQSTA G1800160C G1800161C SET 1ST TWO WORDS TO EOF CODE G1800162C G1800163 RECBUF(1) = KIBE1 G1800164 RECBUF(2) = KIBE1 G1800165C G1800166C RESET THE NUMBER OF RECORDS TO THE NUMBER AT ENTRY TIME G1800167C G1800168 FCB(12) = II(1) G1800169 FCB(13) = II(2) G1800170C G1800171C WRITE THE RECORD TO THE FILE TO RESTORE THE EOF IN CORRECT PLACE G1800172C G1800173 CALL PLACE G1800174ÐÐC G1800175C RESTORE THE REQUEST STATUS. G1800176C G1800177 REQSTA = ISTSAV G1800178C G1800179C RESET THE NUMBER OF RECORDS TO THE NUMBER AT ENTRY TIME G1800180C G1800181 FCB(12) = II(1) G1800182 FCB(13) = II(2) G1800183C G1800184C RESTORE THE 1ST 2 WORDS OF THE RECORD BUFFER G1800185C G1800186 RECBUF(1) = ISAVE1 G1800187 RECBUF(2) = ISAVE2 G1800188 GO TO 1100 G1800189C ********************************************************* 132*5399G18001901 G1800191C --SEE IF NEED TO UPDATE FCB ON MM G1800192 1000 CALL CKUFCB G18001933 G18001942 G18001951 G1800196C --ALL DONE G1800197 1100 ISTAT = REQSTA G1800198C --RETURN TO FM EXEC G1800199ÐÐ1 G1800200C -- SAVE FILE ID AND KEY TYPE FOR NEXT TIME G1800201 PREID = FCB(1) G1800202 PRETYP = ITYPE G1800203 CALL FMSCOM G1800204 RETURN G1800205 END G1800206 SUBROUTINE ADDKIS G1900001 1 /G19 F ITOS CCS 3.0 SL-149G1900002C ADD A NEW KEY INFO SEGMENT INTO THE KEY INFO DIRECTORY G1900003C CREDIT COLLECTION SYSTEM VERSION 3.0 G1900004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G1900005C COPYRIGHT CONTROL DATA CORPORATION 1979 G1900006C G1900007C*** G1900008C G1900009C ADDKIS ADDS A KIS TO A KEY INFO STRUCTURE. G1900010C G1900011C AFTER A NEW RECORD HAS BEEN ADDED TO AN INDEXED FILE, ALL G1900012C THE KEY INFO STRUCTURE(S) DEFINED FOR THE FILE MUST BE G1900013C UPDATED TO REFLECT THIS ADDITION. THE UPDATE IS DONE BY G1900014C ADDING A NEW KIS TO THE KEY INFO STRUCTURE. A KIS CONTAINS G1900015C A KEY VALUE AND A RELATIVE RECORD NUMBER FOR THE NEW RECORD. G1900016C G1900017C THE UPDATE IS DONE SO THAT THE RECORD CAN BE RETRIEVED VIA G1900018ÐÐC KEY VALUE LATER G1900019C G1900020C INPUT: G1900021C ADDIDX CALLS ADDKIS G1900022C INPUT PARAMETER : G1900023C KEY TYPE FOR THIS ADD (KEYTYP) G1900024C KEY VALUE (KEYVAL) G1900025C RELATIVE RECORD NUMBER OF THE NEW RECORD (RRDATA) G1900026C KEY LENGTH IN BYTES (KEYLNG) G1900027C KIB LENGTH IN WORDS (KIBLEN) G1900028C KIB HEADER LENGTH (KIBHRL) G1900029C CURRENT FILE ID (FILEID) G1900030C PREVIOUS FILE ID (PREID) G1900031C PREVIOUS KEY TYPE (PRETYP) G1900032C ALL PARAMETERS ARE IN COMMON G19000332 G1900034C PROCESS: G1900035C CHECK FOR SPECIAL CASE, KIB MAY ALREADY BE G1900036C IN MEMORY (KIBBUF). G19000371 G1900038C LOOKS FOR THE RIGHT PLACE TO INSERT THE NEW KIS G1900039C IF THE KEY INFO STRUCTURE IS EMPTY, THEN BUILD THE ROOT G1900040C (WHOSE NUMBER MUST BE THE KEY TYPE) AND THE FIRST S.S. G1900041C G1900042C SEE IF THE KIB HAS ENOUGH SPACE TO CONTAIN THIS KIS. G1900043ÐÐC IF SO, INSERT KIS IN ITS PLACE. UPDATE FATHER KIB, IF G1900044C NECESSARY. G1900045C IF THE KIB DOES NOT HAVE ENOUGH SPACE TO INCLUDE THE KIS, G1900046C THEN NEED TO DO A BLOCK SPLIT. G1900047. G1900048C IN BLOCK SPLIT, A NEW KIB IS CREATED. SOME OF THE KISES G1900049C IN THE ORGINIAL KIB IS MOVED TO THE NEW KIB. THE FATHER G1900050C KIS IS UPDATED BY DELETING THE KIS POINTING TO THE G1900051C ORGINIAL KIB AND ADDING TWO NEW KISES POINTING TO G1900052C THESE TWO NEW KIBES. IF THE FATHER KIB IS FULL, A BLOCK G1900053C SPLIT ON THE FATHER KIB WILL BE DONE. G1900054. G1900055C IN CASE THE ROOT IS TO BE SPLIT. TWO TOTAL NEW KIBES WILL G1900056C BE CREATED AND A NEW ROOT CREATED. THE NUMBER FOR THE G1900057C ROOT IS THE KEY TYPE. BY KEEPING THE NUMBER OF THE ROOT G1900058C EQUAL TO THE KEY TYPE MAKES ANY RETRIEVAL OF THE KEY G1900059C EASIER. G1900060C G1900061C WHEN A NEW KIB IS CREATED, "THE POINTER TO FATHER KIB" OF G1900062C ITS SON KIB MUST BE CHANGED TO POINTING TO THIS NEW KIB. G1900063C THE UPDATE IS DONE FOR NON-SEQUENCE SET KIBES ONLY. G19000641 G1900065C EXIT: G1900066C RETURNS TO CALLING PROGRAM G1900067C G1900068ÐÐC THE FOLLOWING SUBROUTINES ARE USED BY ADDKIS G1900069C CMPSTG - COMPARES TWO STRINGS OF CHARACTER G1900070C FWAKIS - FIRST WORD OF A KIS IN A KIB G1900071C NXTKIB - RELATIVE KIB NO. FOR NEXT AVAILABLE KIB G1900072C POSKID - POSITION INTO A KEY INFORMATION DIRECTORY G1900073C RDKIB - READ A KIB INTO MAIN MEMORY G1900074C UDSKIB - UPDATE HEADER OF ALL KIBES ONE LEVEL DOWN G1900075C WRTKIB - WRITE A KIB TO MASS MEMORY G1900076C G1900077. G1900078C FOR A DEFINITION OF FMCOM, SEE MACRO FMCOM G1900079M FMCOM G1900080. G1900081C FOR A DEFINITION OF FMCOM2, SEE MACRO FMCOM2 G1900082M FMCOM2 G1900083 INTEGER OLDNUM (2) G1900084 INTEGER ROOTSP G1900085 INTEGER TOTKIS G1900086 INTEGER PREID G1900087 INTEGER SEQSET G1900088 INTEGER SPECAS G1900089 INTEGER SPCRKB(2) G19000901 G19000911 G1900092C PREID - PSEUDO-FILE ID FOR PREVIOUS CALL G1900093ÐÐC SEQSET - SEQUENCE SET FLAG G1900094C SPECAS - FLAG FOR SPECIAL CASE INSERTION G1900095C SPCRKB - RELATIVE KIB # FOR SPECIAL CASE G1900096. G1900097C --INITIALIZE VARIABLE G1900098 KEYLWD = (KEYLNG+1)/2 G1900099 KISLNG = KEYLWD + 2 G1900100 MAXKIS = (KIBLEN-KIBHRL) / KISLNG G1900101 FTHRUD = 0 G19001021 G1900103C -PRESET NEW KIB FLAG TO FALSE G1900104 NEWBUF = 0 G19001052 G1900106C --BUILD THE KIS TO BE ADDED IN BUFFER G1900107 DO 5 I = 1,KEYLWD G1900108 KISA1 (I) = KEYVAL(I) G1900109 5 CONTINUE G1900110 KISA1 (KEYLWD+1) = RRDATA (1) G1900111 KISA1 (KEYLWD+2) = RRDATA (2) G19001122 G1900113C---------------------------------------------------------------- G1900114C -- SPECIAL CASE: SAME FILE, SAME KEY LEVEL (1) G1900115C -- SAME (OR OTHER INDEX) PROCESSOR WAS PREVIOUS G1900116C -- PROCESSOR, AND KIB CONTAINS SEQUENCE SET. G1900117C -- THEREFORE, THIS KIB MAY BE THE SEQ. SET NEEDED. G1900118ÐÐC---------------------------------------------------------------- G1900119 SEQSET = 0 G1900120 CALL SPECAL(SPECAS) G1900121 IF (I .EQ. 0) GO TO 7 G19001221 G1900123C -- SPECIAL CASE: SCAN SEQ SET FOR PLACE TO INSERT THIS KEY G19001241 G1900125 I3 = -1 G1900126 TOTKIS = KIBBUF(NUMKIS) G1900127 DO 10 KISIDX = 1, TOTKIS G1900128 I = FWAKIS (KISIDX) G1900129 I2 = CMPSTG (KEYVAL, KIBBUF(I), KEYLWD) G1900130 IF (I2 .LT. 0 .AND. I3 .GE. 0) GO TO 15 G1900131 IF (I2 .EQ. 0 .AND. KEYTYP .EQ. 1) GO TO 20 G1900132 10 I3 = I2 G1900133 GO TO 7 G19001341 G1900135 15 SEQSET = 1 G1900136 GO TO 100 G19001371 G1900138C -- EXISTING KEY VALUE IN PRIMARY KEY INDEX G1900139 20 J = I + KEYLWD G1900140 IF (KIBBUF(J) .GE. 0) GO TO 850 G1900141C OK - ALL 0'S OR 1'S KEY G1900142 KIBBUF(J) = RRDATA(1) G1900143ÐÐ KIBBUF(J+1) = RRDATA(2) G1900144 GO TO 40 G1900145. G1900146C--------------------------------------------------------- G1900147C -NOT- SPECIAL CASE: G1900148C --POSITION IN CORRECT PLACE IN KEY INFO STRUCTURE G1900149C--------------------------------------------------------- G1900150 7 CALL POSKID G1900151 SEQSET = 1 G1900152 TOTKIS = KIBBUF (NUMKIS) G1900153 IF (REQSTA .LT. 0) GO TO 999 G1900154C -- IS THIS A FILE COMPRESS G1900155C IF SO, DISREGARD KEY FOUND FLAG G1900156C ENQ 10 (FCBIND) G1900157C LDA+ (FCBAD),Q G1900158C STA+ I G1900159 ASSEM $0C0A G1900160 ASSEM $C600, +FCBAD G1900161 ASSEM $6400, +I G1900162 IF (AND(I,$1000) .NE. 0) GO TO 72 G1900163C --PRIMARY KEY ALREADY EXISTS, FLAG ERROR G1900164 IF (KEYFND .EQ. KEYTYP) GO TO 850 G1900165 72 CONTINUE G1900166 IF (EOF. EQ. 0) GO TO 100 G1900167C EOF = YES G1900168ÐÐ IF (TOTKIS .NE. 0) GO TO 50 G1900169C --THE ROOT IS EMPTY G1900170C --BUILD ROOT G1900171C CLEAR KIB AREA G1900172 DO 8 I = 1, KIBLEN G1900173 8 KIBBUF(I) = 0 G19001741 G1900175 KIBBUF (NUMKIS) = 1 G1900176C --GET NEXT KIB NUMBER G1900177 CALL NXTKIB G1900178 IF (REQSTA .LT. 0) GO TO 999 G1900179C --POINTERS TO FATHER + BROTHER KIB ARE ALREADY ZERO G1900180C --KIB TYPE IS ALREADY ROOT G1900181C --KEEP THE RELATIVE KIB NO. = KEY TYPE G1900182 RKIBNO(1) = 0 G1900183 RKIBNO(2) = KEYTYP G1900184C --BUILD THE ONLY KIS G1900185 J = KIBHRL G1900186 DO 81 I = 1, KEYLWD G1900187 J = J+1 G1900188 KIBBUF(J) = $FFFF G1900189 81 CONTINUE G1900190C --POINTER TO NEXT LEVEL KIB IS THE NEW KIB NO. JUST OBTAINED G1900191 KIBBUF (J+1) = NEWKIB (1) G1900192 KIBBUF (J+2) = NEWKIB (2) G1900193ÐÐ CALL WRTKIB G1900194 IF (REQSTA .LT. 0) GO TO 999 G1900195. G1900196C --BUILD THE FIRST S.S. G19001971 G1900198C CLEAR KIB BUFFER G1900199 DO 32 I = 1, KIBLEN G1900200 32 KIBBUF(I) = 0 G19002011 G1900202C --ITS NUMBER IS THE NEW NUMBER JUST OBTAINED G1900203 RKIBNO(1) = NEWKIB(1) G1900204 RKIBNO(2) = NEWKIB(2) G1900205 NEWBUF = 1 G1900206C --POINTER TO FATHER KIB IS THE KEY TYPE G1900207 KIBBUF (PKIBNL) = KEYTYP G1900208C --THE KEY VALUE IS SAME ONE AS ROOT G1900209C --POINTER IS THE RELATIVE RECORD NUMBER G1900210C -- LOAD 1ST SEQUENCE SET WITH THE SMALLEST AND LARGEST G1900211C POSSIBLE KEY VALUES (SPEED-UP CHANGE) G19002121 G1900213C 1ST KIS = ALL 0'S KEY / RRN = -1,0 G1900214C 2ND KIS = KEYVAL / RRN = RRDATA G1900215C 3RD KIS = ALL F'S KEY / RRN = -2,0 G19002161 G1900217C KEY = ALL 0'S G1900218ÐÐ J = KIBHRL + KEYLWD + 1 G1900219C RRN = -1,0 G1900220 KIBBUF(J) = -1 G19002211 G1900222 J = J + 2 G1900223C 2ND KIS (REAL 1ST KIS) G1900224 K = KEYLWD + 2 G1900225 DO 34 I = 1, K G1900226 KIBBUF(J) = KISA1(I) G1900227 34 J = J + 1 G19002281 G1900229C KEY = ALL F'S G1900230 DO 36 I = 1, KEYLWD G1900231 KIBBUF(J) = $FFFF G1900232 36 J = J + 1 G1900233C RRN = -2,0 G1900234C ***** 138*A032G1900235C ***** 138*A032G1900236 KIBBUF(J) = -2 G19002371 G1900238C NUMBER OF KIS'S = 3 G1900239 KIBBUF(NUMKIS) = 3 G19002401 G1900241C --KIB TYPE IS S.S. G1900242 KIBBUF (KIBTYP) = SSET G1900243ÐÐ 40 CONTINUE G1900244 SEQSET = 1 G1900245 CALL WRTKIB G1900246C --NO NEED TO CHECK STATUS BECAUSE ALL DONE G1900247C --A L L D O N E G1900248 GO TO 1000 G1900249. G1900250 50 CONTINUE G1900251C --EOF THE KEY IS THE LARGEST ONE IN THE SET G1900252C --KIBBUF CONTAINS THE ROOT G1900253C --GO DOWN TO THE LARGEST S.S. CHANGE THE LAST KEY IN EACH G1900254C --KIB ON THE WAY DOWN SO AS TO SAVE UPDATING AFTER INSERTION G1900255C --BUT NOTE THIS, IN CASE THERE IS A SPLIT AT THE S.S. G1900256 FTHRUD = 1 G1900257C --WHILE KIB IS NOT S.S. DO G1900258 55 CONTINUE G1900259 TOTKIS = KIBBUF(NUMKIS) G1900260 IF (KIBBUF(KIBTYP) .EQ. SSET) GO TO 70 G1900261C --CHANGE KEY OF THE LAST KIS G1900262 I1= FWAKIS (TOTKIS) G1900263 DO 60 I = 1, KEYLWD G1900264 KIBBUF(I1) = KEYVAL(I) G1900265 I1 = I1 + 1 G1900266 60 CONTINUE G1900267 CALL WRTKIB G1900268ÐÐ IF (REQSTA .LT. 0) GO TO 999 G1900269C --POINTER TO NEXT LEVEL KIB G1900270 RKIBNO(1) = KIBBUF (I1) G1900271 RKIBNO(2) = KIBBUF (I1 + 1) G1900272 CALL RDKIB G1900273 IF (REQSTA .LT. 0) GO TO 999 G1900274 GO TO 55 G1900275 70 CONTINUE G1900276C --ENDWHILE G1900277C --ARRIVE AT S.S. G1900278C --THE NEW KIS IS TO BE ADDED IS THE VERY LAST ONE IN THIS KIB G1900279 KISIDX = TOTKIS + 1 G1900280. G1900281C -- I N S E R T R O U T I N E -- G1900282C A D D N E W K I S TO K I B G19002832 G1900284 100 CONTINUE G1900285 110 CONTINUE G1900286 IF (TOTKIS .EQ. MAXKIS) GO TO 200 G1900287C --NO NEED TO SPLIT G1900288C --JUST INSERT NEW KIS IN ITS PLACE IN THIS KIB G1900289C --UPDATE IS ALREADY DONE ON THE WAY DOWN IF THE KEY IS THE G1900290C --LARGEST ONE G19002912 G1900292C --MOVE ALL KISES AFTER THE NEW KIS ONE POSITION TO THE RIGHT G1900293ÐÐ J = (TOTKIS-KISIDX + 1) *KISLNG G1900294 I1 = FWAKIS (TOTKIS+1) -1 G1900295 I2 = I1 + KISLNG G1900296C --NO NEED TO MOVE KISES IF NEW KIS IS THE LAST ONE G1900297 IF (J .EQ.0) GO TO 125 G1900298 DO 120 I = 1,J G1900299 KIBBUF(I2) = KIBBUF (I1) G1900300 I2 = I2-1 G1900301 I1 = I1 - 1 G1900302 120 CONTINUE G1900303 125 CONTINUE G19003042 G1900305C -- ADD THE NEW KIS IN ITS PROPER PLACE G1900306 J = FWAKIS (KISIDX) G1900307 DO 130 I = 1, KISLNG G1900308 KIBBUF(J) = KISA1 (I) G1900309 J = J+1 G1900310 130 CONTINUE G1900311C --INCREMENT NUMBER OF KISES COUNT BY ONE G1900312 KIBBUF(NUMKIS) = KIBBUF(NUMKIS) + 1 G1900313 TOTKIS = KIBBUF (NUMKIS) G1900314 CALL WRTKIB G1900315C --ALL DONE G1900316 GO TO 1000 G1900317. G1900318ÐÐ 200 CONTINUE G19003192 G1900320C B L O C K S P L I T G19003212 G1900322C --THE KIB CANNOT HOLD ANOTHER KIS G1900323C --HAVE TO CREATE A NEW KIB AND MOVE SOME OF THE KISES IN THIS G1900324C --KIB TO THE NEW KIB G1900325 SPCRKB(1) = RKIBNO(1) G1900326 SPCRKB(2) = RKIBNO(2) G1900327 SEQSET = 0 G19003281 G19003292 G1900330C --SAVE THE LAST KEY IN THIS KIB, IT WILL BE DELETED FROM THE G1900331C --FATHER KIB G1900332 IF (FTHRUD .EQ. 0) GO TO 215 G1900333C G1900334C --FATHER WAS UPDATED ON THE WAY DOWN G1900335C --THE KEY TO LOOK FOR IS THE NEW KEY G1900336 DO 210 I = 1,KEYLWD G1900337 KISD (I) = KEYVAL(I) G1900338 210 CONTINUE G1900339 GO TO 230 G19003401 G1900341 215 CONTINUE G1900342C THIS IS THE KIS POINTING TO THIS KIB IN THE FATHER KIB. G1900343ÐÐC NEEDS TO CHANGE POINTER AFTER SPLIT. G1900344 J = FWAKIS (MAXKIS) G1900345 DO 220 I = 1, KEYLWD G1900346 KISD (I) = KIBBUF (J) G1900347 J = J+1 G1900348 220 CONTINUE G1900349 230 CONTINUE G1900350 KISD (KEYLWD+1) = RKIBNO(1) G1900351 KISD (KEYLWD+2) = RKIBNO(2) G19003522 G1900353C --CLEAR SPLIT ROOT FLAG G1900354 ROOTSP = 0 G1900355 IF (KIBBUF(KIBTYP) .NE. ROOT) GO TO 240 G1900356C --THE KIB BEING SPLIT IS THE ROOT G1900357C --WANT TO KEEP RELATIVE KIB NUMBER = KEY TYPE FOR THE ROOT G1900358C --GET NEW KIB NUMBER FOR THIS KIB G1900359 CALL NXTKIB G1900360 IF (REQSTA .LT. 0) GO TO 999 G1900361 RKIBNO (1) = NEWKIB (1) G1900362 RKIBNO (2) = NEWKIB (2) G1900363 NEWBUF = 1 G1900364 KIBBUF (KIBTYP) = NOROOT G1900365C --POINTER TO FATHER IS THE KEY TYPE G1900366 KIBBUF (PKIBNL) = KEYTYP G1900367C --FLAG THAT THE ROOT IS BEING SPLIT G1900368ÐÐ ROOTSP = 1 G19003692 G1900370 240 CONTINUE G1900371C ARRANGE THE FIRST KIB G19003722 G1900373C --MOVE THE LARGEST KIS TO A TEMP STORAGE G1900374 IF (KISIDX .GT. MAXKIS) GO TO 290 G1900375C --THE LARGEST KIS IS THE SAME G1900376 J = FWAKIS (MAXKIS) G1900377 DO 250 I = 1, KISLNG G1900378 KISBUF(I) = KIBBUF (J) G1900379 J = J+1 G1900380 250 CONTINUE G19003811 G1900382C --MOVE ALL KISES BIGGER THAN THE NEW ONE, ONE KIS POSITION TO G1900383C --THE RIGHT G1900384 J = (MAXKIS-KISIDX) * KISLNG G1900385 I1 = FWAKIS(MAXKIS) - 1 G1900386 I2 = I1 + KISLNG G1900387 DO 270 I = 1,J G1900388 KIBBUF (I2) = KIBBUF (I1) G1900389 I1 = I1-1 G1900390 I2 = I2-1 G1900391 270 CONTINUE G19003922 G1900393ÐÐC --INSERT THE NEW KIS G1900394 I1 = FWAKIS (KISIDX) G1900395 DO 280 I = 1,KISLNG G1900396 KIBBUF (I1) = KISA1 (I) G1900397 I1 = I1+1 G1900398 280 CONTINUE G1900399 GO TO 300 G19004003 G1900401 290 CONTINUE G1900402C --THE NEW KIS IS THE LARGEST ONE G1900403 DO 295 I = 1,KISLNG G1900404 KISBUF (I) = KISA1 (I) G1900405 295 CONTINUE G1900406. G1900407 300 CONTINUE G1900408C * 3 CARDS DELETED 132*5319G1900409C USE A 50-50 SPLIT 132*5319G1900410C --COMPUTE NUMBER OF KISES FOR THIS KIB G1900411 TOTKIS = (MAXKIS+2)/2 G1900412C * 18 CARDS DELETED 132*5319G1900413 KIBBUF (NUMKIS) = TOTKIS G1900414C * 1 CARD DELETED 132*5319G19004155 G1900416C --GET NEW KIB NUMBER FOR BROTHER KIB G1900417 CALL NXTKIB G1900418ÐÐ IF (REQSTA .LT. 0) GO TO 999 G1900419C --SAVE POINTER TO PRESENT BROTHER, FOR THE NEW KIB G1900420 OLDNUM(1) = KIBBUF (NKIBNM) G1900421 OLDNUM(2) = KIBBUF (NKIBNL) G1900422 KIBBUF(NKIBNM) = NEWKIB (1) G1900423 KIBBUF(NKIBNL) = NEWKIB (2) G1900424C --STORE INTO MM G1900425 CALL WRTKIB G1900426 IF (REQSTA .LT. 0) GO TO 999 G19004272 G1900428C --SAVE THE LARGEST KIS IN THIS KIB, TO BE ADDED TO FATHER KIB G1900429 J = FWAKIS (TOTKIS) G1900430 DO 510 I = 1,KEYLWD G1900431 KISA1(I) = KIBBUF (J) G1900432 J = J + 1 G1900433 510 CONTINUE G1900434 KISA1(KEYLWD+1) = RKIBNO (1) G1900435 KISA1(KEYLWD+2) = RKIBNO (2) G1900436C --UPDATE ALL SONS OF THIS KIB, IF IT WAS A ROOT G1900437 IF (ROOTSP .EQ. 0) GO TO 515 G1900438 CALL UDSKIB G1900439 IF (REQSTA .LT. 0) GO TO 999 G1900440 515 CONTINUE G19004413 G1900442C B U I L D N E W K I B (2ND KIB IN SPLIT) G1900443ÐÐ2 G1900444 RKIBNO(1) = NEWKIB (1) G1900445 RKIBNO(2) = NEWKIB (2) G1900446 NEWBUF = 1 G1900447C --POINTER TO FATHER IS THE SAME AS THE PREVIOUS ONE G1900448C --KIB TYPE IS SAME AS PREVIOUS ONE G1900449C --POINTER TO BROTHER KIB IS THE ONE RESERVED BY PREVIOUS KIB G1900450 KIBBUF (NKIBNM) = OLDNUM(1) G1900451 KIBBUF (NKIBNL) = OLDNUM(2) G19004522 G1900453C --MOVE ALL KISES NOT INCLUDED IN THE PREVIOUS KIB TO THE BEGINNING G1900454C --OF THIS KIB G1900455 I1 = FWAKIS (TOTKIS+1) G1900456 J = (MAXKIS-TOTKIS) * KISLNG G1900457 I2 = KIBHRL +1 G1900458 DO 520 I = 1,J G1900459 KIBBUF (I2) = KIBBUF (I1) G1900460 I1 = I1+1 G1900461 I2 = I2+1 G1900462 520 CONTINUE G1900463C --SIZE OF THIS KIB G1900464 TOTKIS = MAXKIS+1-TOTKIS G1900465C G1900466C --INCLUDE THE EXTRA KIS IN TEMP STORAGE G1900467 I1 = FWAKIS (TOTKIS) G1900468ÐÐ DO 530 I = 1,KISLNG G1900469 KIBBUF (I1) = KISBUF (I) G1900470 I1 = I1+1 G1900471 530 CONTINUE G1900472 KIBBUF (NUMKIS) = TOTKIS G19004731 G1900474C --WRITE TO MM G1900475 CALL WRTKIB G1900476 IF (REQSTA .LT. 0) GO TO 999 G1900477C G1900478C --THE KEY OF THE LARGEST KIS IN THIS KIB IS ALREADY IN THE G1900479C FATHER KIB. G1900480C SAVE THE RELATIVE KIB NO. OF THIS KIB SO THAT IT CAN BE CHANGED G1900481C IN THE FATHER KIB. G1900482 OLDNUM(1) = RKIBNO(1) G1900483 OLDNUM(2) = RKIBNO(2) G19004842 G1900485C --UPDATE ALL SONS G1900486 CALL UDSKIB G1900487C --FINISH BUILDING NEW KIB G19004883 G1900489C --SET UP FATHER KIB TO REFLECT THE SPLIT G1900490 IF (ROOTSP .EQ. 0) GO TO 570 G19004913 G1900492C --THE KIB THAT WAS SPLIT WAS THE ROOT G1900493ÐÐC --CREATE NEW ROOT TO POINT TO THE TWO KIBS G1900494C --ITS NUMBER IS THE KEY TYPE G1900495C --BUILD POINTER TO BIGGER KIB INTO KIS. G1900496 KISBUF(KEYLWD+1) = OLDNUM(1) G1900497 KISBUF(KEYLWD+2) = OLDNUM(2) G1900498 RKIBNO(1) = 0 G1900499 RKIBNO(2) = KEYTYP G1900500C --CLEAR POINTER TO FATHER, BROTHER G1900501C --KEY TYPE IS ROOT (=0) G1900502 DO 550 I=1,KIBHRL G1900503 KIBBUF(I) = 0 G1900504 550 CONTINUE G1900505 KIBBUF (NUMKIS) = 2 G1900506C --FILL IN THE TWO KISES G1900507 I1= KIBHRL + 1 G1900508 I2= I1+ KISLNG G1900509 DO 560 I = 1,KISLNG G1900510 KIBBUF(I1) = KISA1(I) G1900511 KIBBUF (I2)= KISBUF(I) G1900512 I1 = I1 + 1 G1900513 I2 = I2 + 1 G1900514 560 CONTINUE G1900515C G1900516 CALL WRTKIB G1900517 IF (REQSTA .LT. 0) GO TO 999 G1900518ÐÐ2 G1900519C --ALL DONE G1900520 GO TO 1000 G1900521. G1900522 570 CONTINUE G1900523C --THE KIB JUST SPLIT WAS NOT A ROOT G1900524C --DELETE THE OLD KIS POINTING TO OLD SON G1900525C --ADD THE TWO NEW KISES G1900526C --UPDATE FATHER G1900527C --READ IN FATHER KIB G1900528 RKIBNO (1) = KIBBUF (PKIBNM) G1900529 RKIBNO (2) = KIBBUF (PKIBNL) G1900530 CALL RDKIB G1900531 IF (REQSTA .LT. 0) GO TO 999 G1900532C --LOOK FOR THE KIS TO BE DELETED G1900533 TOTKIS = KIBBUF (NUMKIS) G1900534 KISIDX = 1 G1900535 580 CONTINUE G1900536 IF (KISIDX .GT. TOTKIS) GO TO 800 G1900537 J = FWAKIS (KISIDX) G1900538C ** 137*A017G1900539 IF (CMPSTG(KIBBUF(J), KISD, KISLNG)) 590,600,590 G1900540C ** 137*A017G1900541 590 KISIDX = KISIDX + 1 G1900542C --GO ON TO NEXT KIS IN KIB G1900543ÐÐ GO TO 580 G19005442 G1900545 600 CONTINUE G1900546C --FOUND PLACE POINTING TO THE OLD KIS G1900547C --CHANGE POINTER TO THE NEW KIB NO. THE KEY IS THE SAME G1900548 J = J+KEYLWD G1900549 KIBBUF(J) = OLDNUM(1) G1900550 KIBBUF(J+1) = OLDNUM(2) G1900551C G1900552C --INSERT THE LARGEST KIS OF THE SMALLER KIB (KISA1) IN G1900553C --THIS POSITION WITHIN THE FATHER KIB G1900554C G1900555 GO TO 110 G1900556. G1900557C------------ G1900558C --ERROR G1900559C------------ G1900560 800 CONTINUE G1900561 KIDFUL = 1 G1900562 ERRIDC = 1 G1900563 GO TO 3000 G19005641 G1900565 850 CONTINUE G1900566C DUPLICATE PRIMARY KEY, SET ERROR G1900567 RECDUP = 1 G1900568ÐÐ ERRIDC = 1 G19005691 G1900570 990 KEYFND = 1 G19005711 G1900572 1000 CONTINUE G1900573 IF (SPECAS .EQ. 0) GO TO 2050 G1900574 IF (SEQSET .NE. 0) GO TO 2000 G19005751 G1900576C -- IF IT IS SPECIAL CASE AND THERE WAS A BLOCK SPLIT THEN G1900577C -- NEED TO READ BACK SEQUENCE SET, G1900578 RKIBNO(1) = SPCRKB(1) G1900579 RKIBNO(2) = SPCRKB(2) G19005801 G1900581 CALL RDKIB G19005822 G1900583 2000 CONTINUE G1900584 2050 CONTINUE G19005851 G1900586 999 CONTINUE G19005871 G1900588 3000 CONTINUE G1900589 RETURN G1900590 END G1900591 INTEGER FUNCTION FWAKIS (IDUM) G2000001 1 /G20 F ITOS CCS 3.0 SL-149G2000002ÐÐC COMPUTE THE FWA OF A KIS WITHIN A KIB G2000003C CREDIT COLLECTION SYSTEM VERSION 3.0 G2000004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G2000005C COPYRIGHT CONTROL DATA CORPORATION 1979 G2000006C G2000007C*** G2000008C G20000095 G2000010C A KEY INFO BLOCK (KIB) CONTAINS A HEADER FOLLOWED BY A G2000011C NUMBER OF KEY INFO SEGMENTS (KIS). THIS INTEGER FUNCTION G2000012C RETURNS THE FIRST WORD ADDR OF THE NTH KIS WITHIN THE KIB. G2000013C N STARTS FROM ONE. G2000014C G2000015C G2000016C INPUT: G2000017C THE NO. OF KIS (FROM PARAMETER) G2000018C LENGTH OF KIB HEADER (KIBHRL) G2000019C LENGTH OF A KIS (KISLNG) G2000020C G2000021C G2000022C PROCESS: G2000023C INDEX IS HEADER LENGTH +(KIS LENGTH* (N-1)) G2000024C G2000025C OUTPUT: G2000026C INDEX AS INTEGER G2000027ÐÐC*** G2000028M FMCOM G2000029M FMCOM2 G2000030 FWAKIS = (IDUM-1)*KISLNG + KIBHRL + 1 G2000031 RETURN G2000032 END G2000033 SUBROUTINE NEXTSS G2100001 1 /G21 F ITOS CCS 3.0 SL-149G2100002C READ IN THE NEXT SEQUENCE SET G2100003C CREDIT COLLECTION SYSTEM VERSION 3.0 G2100004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G2100005C COPYRIGHT CONTROL DATA CORPORATION 1979 G2100006C G2100007C G2100008C*** G2100009C NEXTSS READS THE NEXT SEQUENCE SET IN A KEY INFORMATION G2100010C STRUCTURE. A SEQUENCE SET IS THE LOWEST LEVEL KIS IN A G2100011C KEY INFO STRUCTURE. A KIS IN A SEQUENCE SET (S.S.) CONTAINS G2100012C A KEY AND THE RELATIVE RECORD NUMBER OF THE RECORD CONTAIN- G2100013C ING THE KEY. G2100014C G2100015C ALL THE S.S. ARE LINKED IN ASCENDING ORDER W.R.T. THE KEY G2100016C VALUE. THE HEADER OF A S.S. CONTAINS THE POINTER TO THE G2100017C NEXT S.S. (KIBBUF(NKIBNM, NKIBNL)). G2100018C G2100019ÐÐC G2100020C INPUT: G2100021C THE CURRENT S.S. (KIBBUF) G2100022C BEGINNING SECTOR OF KIB (KEYBSC) G2100023C LENGTH OF KIB IN WORDS (KIBLEN) G2100024C G2100025C G2100026C PROCESS: G2100027C GET THE RELATIVE KIB NUMBER FOR THE NEXT S.S. FROM G2100028C THE HEADER OF THE CURRENT KIB G2100029C G2100030C IF THERE IS NO MORE S.S., THEN SET FLAG (LASTSS) AND G2100031C LEAVE. G2100032C OTHERWISE, READ IN THE NEW S.S. G2100033C G2100034C CHECK IF IT IS AN EMPTY KIB; THAT IS, ONE WHOSE KISES G2100035C HAVE BEEN DELETED. IF SO, REMOVE THE S.S. FROM THE G2100036C S.S. CHAIN AND READ IN THE NEXT S.S. G2100037C G2100038C EXIT WHEN A NON-EMPTY KIB IS READ IN OR NO MORE S.S. G2100039C IS IN THE CHAIN. G2100040C G2100041C G2100042C EXIT: G2100043C NON-EMPTY S.S.(IN KIBBUF) G2100044ÐÐC END OF S.S. FLAG (LASTSS) 1= YES IGNORE KIBBUF G2100045C 0= NO KIBBUF CONTAINS S.S. G2100046C G2100047C G2100048C THE FOLLOWING SUBROUTINES ARE USED BY NEXTSS G2100049C CMPSTG - COMPARES TWO STRINGS OF CHARACTER G2100050C MWRITF WRITE MASS MEMORY - FTN INTERFACE TO MMWRIT G2100051C RDKIB - READ A KIB INTO MAIN MEMORY G2100052C G2100053C FOR A DEFINITION OF FMCOM, SEE MACRO FMCOM G2100054M FMCOM G2100055C FOR A DEFINITION OF FMCOM2, SEE MACRO FMCOM2 G2100056M FMCOM2 G2100057 EQUIVALENCE (NONZRO, SSET) G2100058 INTEGER OLDNUM (2) G2100059C FOR DESCRIPTION OF VARIABLES, SEE MACRO FMCOM3G2100060C*** G21000615 G2100062C --CLEAR FLAG FOR FINDING AN EMPTY KIB G2100063 I = 0 G2100064 LASTSS = 0 G2100065C --SAVE RELATIVE KIB NUMBER G2100066 OLDNUM (1) = RKIBNO (1) G2100067 OLDNUM (2) = RKIBNO (2) G21000683 G2100069ÐÐC --NUMBER TO BROTHER G2100070 10 RKIBNO (1) = KIBBUF (NKIBNM) G2100071 RKIBNO (2) = KIBBUF (NKIBNL) G21000722 G2100073C --SEE IF LAST S.S. IS HERE G2100074 20 CONTINUE G2100075 IF (CMPSTG(RKIBNO,ZERO2,2) .NE. 0) GO TO 30 G2100076C --LAST S.S. G2100077 LASTSS = 1 G2100078 GO TO 40 G2100079C --READ NEXT KIB G2100080 30 CONTINUE G2100081 CALL RDKIB G2100082 IF (REQSTA .LT. 0) GO TO 90 G21000832 G2100084C --SEE IF THIS IS AN EMPTY KIB G2100085 IF (KIBBUF(NUMKIS) .NE. 0) GO TO 40 G2100086C --FOUND AN EMPTY KIB G2100087 I = 1 G2100088 GO TO 10 G21000892 G2100090 40 CONTINUE G2100091C -SEE IF THERE WERE ANY EMPTY KIB G2100092 IF (I .EQ. 0) GO TO 90 G2100093C --REMOVE ALL EMPTY KIBS FROM THE CHAIN G2100094ÐÐ CALL MWRITF (KEYBSC, OLDNUM, KIBLEN, 2, NKIBNM-1 ,RKIBNO, G2100095 2 NONZRO, REQSTA) G21000962 G2100097 90 CONTINUE G2100098 RETURN G2100099 END G2100100 SUBROUTINE POSKID G2200001 1 /G22 F ITOS CCS 3.0 SL-149G2200002C POSITION INTO THE KEY INFO DIRECTORY G2200003C CREDIT COLLECTION SYSTEM VERSION 3.0 G2200004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G2200005C COPYRIGHT CONTROL DATA CORPORATION 1979 G2200006C G2200007C G22000085 G2200009C*** G2200010C POSKID POSITIONS INTO A KEY INFORMATION DIRECTORY FOR G2200011C A SPECIFIED KEY. SEE ITOS FM 2.0 REF MANUAL, APPENDIX G2200012C FOR DETAILED DESCRIPTION OF THE STRUCTURE OF A KEY INFO G2200013C DIRECTORY. G2200014C G2200015C POSITIONING MEANS THE RELATIVE KIB NUMBER, AND THE KIS G2200016C NUMBER WITHIN THE KIB. G2200017C G2200018C THE RELATIVE KIB NUMBER OF THE ROOT FOR THE KEY INFO G2200019ÐÐC DIRECTORY IS THE KEY TYPE. WHICH IS BETWEEN 1 TO 4. G22000202 G2200021C INPUT -.KEY VALUE LOOKING FOR G2200022C G2200023C .KEY TYPE G2200024C G2200025C .RELATIVE RECORD NUMBER G2200026C IF ZERO, IT IS CALLED FROM RETRIEVAL ROUTINE, WANTS TO G2200027C POSITION TO THE FIRST KIS WITH THIS KEY. UPON RETURN G2200028C RRDATA WILL CONTAIN THE RELATIVE RECORD NUMBER OF THE G2200029C RECORD BEING POSITIONED AT. G2200030C IF NON-ZERO, THE CALLING PROGRAM IS LOOKING FOR THE G2200031C POSITION OF THE S.S WITH THE KEY AND RR DATA NO. ITS G2200032C VALUE WILL NOT BE CHANGED IN THIS SUBROUTINE G2200033C G2200034C G2200035C G2200036C PROCESS: G2200037C STARTING FROM THE ROOT OF THE KID FOR THE KEY TYPE, G2200038C LOOK FOR THE KIS WHOSE KEY VALUE IS EQUAL OR GREATER G2200039C THAN THE ONE BEING LOOK FOR. WHEN FOUND, GET THE G2200040C POINTER OF THE KIS. THE POINTER POINTS TO THE NEXT G2200041C LEVEL KIB IN THE KID. G2200042C G2200043C THE KIB IS SEARCHED IN THE SAME WAY AS THE ROOT. G2200044ÐÐC G2200045C WHEN KIB REACHED IS THE SEQUENCE SET, THEN THE POINTERS G2200046C IN THE KIS IS THE RELATIVE RECORD NUMBER OF THE G2200047C RECORD CONTAINING THE KEY IN THE KIS. G2200048C G2200049C IF THERE IS NO KIS WITH THE EXACT KEY VALUE, THEN G2200050C POSKID WILL POSITION AT THE KIS ONE BIGGER THAN THE G2200051C ONE BEING SEARCH FOR. G2200052C G2200053C G2200054C THE FOLLOWING SUBROUTINES ARE USED BY POSKID G2200055C CMPSTG - COMPARES TWO STRINGS OF CHARACTER G2200056C CMPSTG - COMPARES TWO STRINGS OF CHARACTER G2200057C FWAKIS - FIRST WORD OF A KIS IN A KIB G2200058C NEXTSS - READ NEXT SEQUENCE SET FROM MASS MEMORY G2200059C RDKIB - READ A KIB INTO MAIN MEMORY G22000602 G2200061C OUTPUT -.POSITIONING = REALTIVE KIB NUMBER (RKIBNO) G2200062C RELATIVE KIS NUMBER WITHIN THE KIB G2200063C (KISIDX) G2200064C G2200065C .THE CURRENT KEY INFO BLOCK IN KIBBUF G2200066C G2200067C .WHETHER THE KEY IS PRESENT OR NOT G2200068C IF KEY DOES NOT EXIST, THEN POSITIONING G2200069ÐÐC IS AT THE NEXT HIGHER KEY. G2200070C KEYFND = 1 MEANS FOUND KEY G2200071C KEYFND = 0 MEANS KEY NOT FOUND G2200072C G2200073C G2200074C G2200075C .WHETHER THE EXACT KIS (KEY + RELATIVE RECORD NO.) G2200076C IS FOUND, KISFND = 1 MEANS YES G2200077C KISFND = 0 MEANS NO G2200078C G2200079C .WHETHER EOF IS ENCOUNTERED (EOF) G2200080C G2200081C .THE RELATIVE RECORD NUMBER WITHIN THE FILE OF THAT G2200082C RECORD (RRDATA) G2200083C G2200084C ALL PARAMETERS ARE IN THE COMMON BLOCK G2200085C G2200086C FOR A DEFINITION OF FMCOM, SEE MACRO FMCOM G2200087M FMCOM G2200088C FOR A DEFINITION OF FMCOM2, SEE MACRO FMCOM2 G2200089M FMCOM2 G2200090 INTEGER BGKIS G2200091 INTEGER DONE G2200092 INTEGER GTNXT G2200093 INTEGER KEYLWD G2200094ÐÐ INTEGER KISTYP G2200095 INTEGER OLDNUM(2) G2200096 INTEGER TOTKIS G2200097 INTEGER REQCOD,WRTCOD,COMCOD G2200098+ 127*5186G2200099 DATA REQCOD/0/, WRTCOD/12/, COMCOD/17/ G2200100+ 127*5186G2200101C FOR DESCRIPTION OF VARIABLES, SEE MACRO FMCOM3G2200102C*** G2200103. G2200104C 127*5186G2200105C --EXTRACT AND SAVE LOCALLY THE REQUEST INDEX CODE (FROM THE 127*5186G2200106C USERS REQBUF. 127*5186G2200107 ASSEM $E400,+PCTADR G2200108+ LDQ+ PCTADR 127*5186G2200109 ASSEM $E205 G2200110+ LDQ- RPRBF4,Q 127*5186G2200111 ASSEM $C203 G2200112+ LDA- RQINFO,Q 127*5186G2200113 ASSEM $6400,+REQCOD G2200114+ STA+ REQCOD 127*5186G2200115 REQCOD = AND(REQCOD,$FF0) /$10 G2200116+ 127*5186G2200117C --LENGTH OF KIS G2200118 KEYLWD = (KEYLNG+1)/2 G2200119ÐÐ KISLNG = KEYLWD + 2 G2200120C --ASSUME EOF ENCOUNTERED G2200121 EOF = 1 G2200122 KEYFND = 0 G2200123 KISFND = 0 G2200124C --START FROM KIB WHOSE RELATIVE KIB NUMBER IS THE KEY TYPE G2200125 RKIBNO (1) = 0 G2200126 RKIBNO (2) = KEYTYP G2200127 DONE = 0 G22001285 G2200129C --REPEAT G2200130C -(WORK ON A NEW KIB) G2200131 100 CONTINUE G2200132C --READ KIB WHOSE RELATIVE BLOCK NO. IS RKIBNO G2200133 CALL RDKIB G2200134 IF (REQSTA .LT. 0) GO TO 999 G2200135 KISIDX = 1 G2200136 GTNXT = 0 G2200137 TOTKIS = KIBBUF (NUMKIS) G22001383 G2200139C --WHILE MORE KIS IN KIB G2200140C AND NOT DONE YET G2200141C AND DO NOT GET NEXT LEVEL KIB DO G22001422 G2200143 200 IF (KISIDX .GT. TOTKIS) GO TO 700 G2200144ÐÐ IF (GTNXT .EQ. 1) GO TO 700 G2200145 IF (DONE .EQ. 1) GO TO 700 G22001462 G2200147C --COMPARE KEY IN QUESTION WITH KEY IN KIS G2200148 BGKIS = FWAKIS (KISIDX) G2200149 IF (CMPSTG (KEYVAL,KIBBUF(BGKIS), KEYLWD)) 500,400,600 G22001502 G2200151 400 CONTINUE G2200152C -- THE TWO KEYS ARE EQUAL G2200153 KEYFND = 1 G2200154C 127*5186G2200155C --IF THIS REQUEST IS NOT A WRITER OR COMFIL REQUEST, 127*5186G2200156C CONTINUE AT 500. 127*5186G2200157 IF (REQCOD.NE.WRTCOD .AND. REQCOD.NE.COMCOD)GO TO 500 G2200158+ 127*5186G2200159C --CHECK IF MORE KISES HAVE THE SAME KEY. IF SO, POSI- 127*5186G2200160C TION TO THE LAST KIS WITH THE SAME KEY. 127*5186G2200161 450 IS1 = KISIDX G2200162+ 127*5186G2200163 IS2 = BGKIS G2200164+ 127*5186G2200165 KISIDX = KISIDX + 1 G2200166+ 127*5186G2200167 IF (KISIDX .GT. TOTKIS) GO TO 475 G2200168+ 127*5186G2200169ÐÐC 127*5186G2200170C --COMPARE KEY IN QUESTION WITH KEY IN USE 127*5186G2200171 BGKIS = FWAKIS(KISIDX) G2200172+ 127*5186G2200173 IF (CMPSTG(KEYVAL,KIBBUF(BGKIS),KEYLWD))475,450,450 G2200174+ 127*5186G2200175C 127*5186G2200176C --PREVIOUS KIS WAS THE ONE TO USE FOR SUBSEQUENT PRO- 127*5186G2200177C CESSING. 127*5186G2200178 475 KISIDX = IS1 G2200179+ 127*5186G2200180 BGKIS = IS2 G2200181+ 127*5186G22001822 G2200183 500 CONTINUE G2200184C -- KEY VALUE LESS THAN KEY IN KIS G2200185C -- PICK OUT POINTERS G2200186 I1 = BGKIS + KEYLWD G2200187 I = KIBBUF (I1) G2200188 J = KIBBUF (I1+1) G2200189C G2200190C --IF KIS IS SEQUENCE SET THEN POINTERS ARE RELATIVE G2200191C --RECORD NUMBERS G2200192 IF (KIBBUF (KIBTYP) .NE. SSET) GO TO 550 G2200193 EOF = 0 G2200194ÐÐ DONE = 1 G2200195 IF (CMPSTG (RRDATA ,ZERO2,2) .NE. 0) GO TO 510 G22001961 G2200197C INPUT RELATIVE RECORD NUMBER IS ZERO MEANS IT IS CALLED FROM G2200198C ADDIDX G2200199C WANTS TO POSITION HERE; THE FIRST S.S. WHOSE KEY IS KEYVAL. G2200200C -- RETURN THE NUMBER OF THE RECORD IN THE BUFFER AND LEAVE G2200201 RRDATA(1) = I G2200202 RRDATA(2) = J G2200203 GO TO 545 G22002041 G2200205 510 CONTINUE G2200206C --RELATIVE RECORD NUMBER IS NON-ZERO G2200207C --NEED TO POSITION TO KIS POINTING TO THE RECORD. G2200208C --SKIP OVER DUPLICATE KEY, IN CASE THERE ARE SOME G22002092 G2200210C -------------------- G2200211C 1X A B B B C 1 G2200212C 1------------------1 G2200213C X G22002141 G2200215C --MAKE MASTER KIS G2200216 DO 515 I = 1, KEYLWD G2200217 KISBUF(I) = KEYVAL(I) G2200218 515 CONTINUE G2200219ÐÐ KISBUF (KEYLWD+1) = RRDATA(1) G2200220 KISBUF (KEYLWD+2) = RRDATA(2) G2200221 OLDNUM(1) = RKIBNO(1) G2200222 OLDNUM(2) = RKIBNO(2) G22002232 G2200224C --COMPARE EACH KIS WITH THE MASTER KIS G2200225 520 CONTINUE G2200226 TOTKIS = KIBBUF (NUMKIS) G2200227 521 CONTINUE G2200228 IF (KISIDX .GT. TOTKIS) GO TO 525 G2200229C --WHILE THERE ARE MORE KISES IN THIS KIB DO G2200230 BGKIS = FWAKIS (KISIDX) G2200231 IF (CMPSTG (KISBUF, KIBBUF(BGKIS), KISLNG)) 535,540,523 G22002321 G2200233C --IF NOT YET AT RIGHT PLACE, THERE IS DUPLICATE KEY G2200234C --MOVE TO NEXT KIS G2200235 523 KISIDX = KISIDX + 1 G2200236 GO TO 521 G22002371 G2200238 525 CONTINUE G2200239C --EXHAUST ALL KISES IN THIS KIB G2200240C --READ IN BROTHER KIB G2200241C --REMEMBER NUMBER FOR THIS KIB, IN CASE NEED TO BACK UP G2200242 OLDNUM(1) = RKIBNO(1) G2200243 OLDNUM(2) = RKIBNO(2) G2200244ÐÐ CALL NEXTSS G2200245 IF (LASTSS .NE. 1) GO TO 530 G2200246C -- LAST S.S. FOUND, READ BACK LAST KIB IN MEMORY G2200247 RKIBNO (1) = OLDNUM (1) G2200248 RKIBNO (2) = OLDNUM (2) G2200249 CALL RDKIB G2200250 IF (REQSTA .LT. 0) GO TO 999 G2200251 KISIDX = KIBBUF (NUMKIS) + 1 G2200252 GO TO 545 G22002532 G2200254 530 CONTINUE G2200255 KISIDX = 1 G2200256 GO TO 520 G22002573 G2200258 535 CONTINUE G2200259C --FOUND PLACE WHERE KIS LOGICALLY SHOULD BE G2200260C --THE EXACT KIS IS NOT FOUND G2200261C --BACK UP TO THE PREVIOUS KIB, IN CASE G2200262C --WE ARE INSERTING "B" IN THIS SITUATION G22002631 G2200264C ------------------- 1- - - - - - - - - 1 G2200265C 1X A B B 1 1X C D 1 G2200266C 1-----------------1 1- - - - - - - - - 1 G2200267C X G2200268C G2200269ÐÐC --WE WILL BE POINTING TO "C" IN THE SECOND KIB G2200270C --WANT TO POINT TO THE LAST 'B' G22002712 G2200272 IF (KISIDX.NE.1) GO TO 545 G2200273 IF (CMPSTG(OLDNUM,RKIBNO,2) .EQ. 0) GO TO 545 G2200274C -BACK UP ONE KIB G2200275 RKIBNO(1) = OLDNUM(1) G2200276 RKIBNO(2) = OLDNUM(2) G2200277 CALL RDKIB G2200278 IF (REQSTA .LT. 0) GO TO 999 G2200279 KISIDX = KIBBUF(NUMKIS) + 1 G2200280 GO TO 545 G22002812 G2200282C --EXACT KIS FOUND G2200283 540 CONTINUE G2200284 KISFND = 1 G22002851 G2200286 545 CONTINUE G2200287 GO TO 670 G22002882 G2200289 550 CONTINUE G2200290C KIS IS NOT SEQUENCE SET, POINTERS ARE FOR NEXT LEVEL KIB G2200291 RKIBNO (1) = I G2200292 RKIBNO (2) = J G2200293 GTNXT = 1 G2200294ÐÐ GO TO 670 G22002952 G2200296 600 CONTINUE G2200297C -- KEY VALUE BIGGER THAN KEY IN KIS G2200298C -- MOVE TO NEXT KIS IN THIS KIB G2200299 KISIDX = KISIDX + 1 G22003002 G2200301 670 CONTINUE G2200302C --ENDWHILE G2200303C --(MOVE ON TO NEXT KIS IN THIS KIB) G2200304 GO TO 200 G22003055 G2200306 700 CONTINUE G2200307 IF (GTNXT .EQ. 1) GO TO 100 G2200308C --UNTIL NO MORE KIB TO READ G2200309C --ENDREPEAT G22003102 G2200311C --RETURN (ERROR OR NOT) G2200312 999 CONTINUE G2200313 RETURN G2200314C G2200315 END G2200316 SUBROUTINE RDKIB G2300001 1 /G23 F ITOS CCS 3.0 SL-149G2300002C READ IN A KEY INFO BLOCK FROM MASS MEMORY G2300003ÐÐC CREDIT COLLECTION SYSTEM VERSION 3.0 G2300004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G2300005C COPYRIGHT CONTROL DATA CORPORATION 1979 G2300006C G2300007C G2300008C*** G2300009C RDKIB READS A KEY INFORMATION BLOCK FROM MASS MEMORY G2300010C TO AN AREA IN COMMON (KIBBUF). G2300011C G2300012C G2300013C G2300014C INPUT: G2300015C BEGINNING SECTOR ADDR OF THE KEY INFORMATION DIRECTORY G2300016C (KEYBSC) G2300017C LENGTH OF A KIB (KIBLEN) G2300018C RELATIVE KIB NUMBER (RKIBNO) G2300019C G2300020C PROCESS: G2300021C SINCE ALL KIB ARE IN CONTINGUOUS MASS MEMORY, RDKIB G2300022C USES THE MASS MEMROY READ ROUTINE. G2300023C G2300024C OUTPUT: G2300025C ERROR INDICATOR (REQSTA) G2300026C MM ERROR IF REQSTA IS NON-ZERO G2300027C CONTENT OF THE KIB REQUESTED (KIBBUF) G2300028ÐÐC G2300029C THE FOLLOWING SUBROUTINES ARE USED BY RDKIB G2300030C MREADF READ MASS MEMORY - FTN INTERFACE TO MMREAD G2300031C G2300032C FOR A DEFINITION OF FMCOM, SEE MACRO FMCOM G2300033M FMCOM G2300034C FOR A DEFINITION OF FMCOM2, SEE MACRO FMCOM2 G2300035M FMCOM2 G2300036C FOR DESCRIPTION OF VARIABLES, SEE MACRO FMCOM3G2300037C*** G23000382 G2300039C --OFFSET IS ZERO G2300040 INTEGER OFFSET G2300041 EQUIVALENCE (OFFSET, ROOT) G2300042 EQUIVALENCE (NONZER, SSET) G2300043 CALL MREADF (KEYBSC, RKIBNO, KIBLEN, KIBLEN, OFFSET, KIBBUF, G2300044 1 NONZER, REQSTA) G2300045 RETURN G2300046 END G2300047 SUBROUTINE UDSKIB G2400001 1 /G24 F ITOS CCS 3.0 SL-149G2400002C UPDATE HEADER OF ALL KIB'S ONE LEVEL DOWN G2400003C CREDIT COLLECTION SYSTEM VERSION 3.0 G2400004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G2400005C COPYRIGHT CONTROL DATA CORPORATION 1979 G2400006ÐÐC G2400007C G2400008C*** G2400009C WHEN A NEW KIB HAS BEEN CREATED (BECAUSE OF A BLOCK G2400010C SPLIT), THE HEADER WORD OF ALL THE KIB'S IT POINTS G2400011C TO (THE SON KIB'S) HAS TO BE CHANGED SUCH THAT THEY G2400012C WILL BE POINTING TO THE NEW FATHER KIB. UDSKIB G2400013C CHANGES ALL THE HEADER WORDS. G2400014C G2400015C G2400016C INPUT: G2400017C THE NEW KIB (KIBBUF) G2400018C ITS RELATIVE KIB NUMBER (RKIBNO) G2400019C BEGINNING SECTOR ADDR OF KID (KEYBSC) G2400020C LENGTH OF A KIB (KIBLEN) G2400021C LENGTH OF A KEY IN WORDS (KEYLWD) G2400022C G2400023C G2400024C PROCESS: G2400025C EACH KIS IN THE KIB POINTS TO THE SON KIB. G2400026C FROM EACH KIS, GET THE RELATIVE KIB NUMBER OF THE G2400027C SON KIB. G2400028C G2400029C IN THE HEADER OF THE SON KIB, THERE IS AN ENTRY G2400030C POINTING TO THE FATHER KIB (WORDS 4,5 - PKIBNM). G2400031ÐÐC G2400032C WRITE THE RELATIVE KIB NUMBER OF THE NEW KIB (RKIBNO) G2400033C IN THE HEADER OF THE SON KIB. G2400034C G2400035C UPDATE HEADERS FOR ALL THE SON KIBS CONTAINED IN G2400036C THE NEW KIB. G2400037C G2400038C G2400039C OUTPUT: G2400040C ALL HEADERS UPDATED G2400041C G2400042C G2400043C THE FOLLOWING SUBROUTINES ARE USED BY UDSKIB G2400044C MWRITF WRITE MASS MEMORY - FTN INTERFACE TO MMWRIT G2400045C FOR A DEFINITION OF FMCOM, SEE MACRO FMCOM G2400046M FMCOM G2400047C FOR A DEFINITION OF FMCOM2, SEE MACRO FMCOM2 G2400048M FMCOM2 G2400049C FOR DESCRIPTION OF VARIABLES, SEE MACRO FMCOM3G2400050C*** G2400051 INTEGER TOTKIS G2400052 EQUIVALENCE (NONZER,SSET) G24000532 G2400054C --ONLY UPDATE SONS OF NON S.S. KIB G2400055 IF (KIBBUF(KIBTYP) .EQ. SSET) GO TO 150 G2400056ÐÐ TOTKIS = KIBBUF (NUMKIS) G2400057 DO 100 I = 1,TOTKIS G2400058 J = FWAKIS (I) + KEYLWD G2400059C --CHANGE ONLY POINTER TO FATHER IN HEADER OF SON G2400060 CALL MWRITF (KEYBSC, KIBBUF(J), KIBLEN, 2, PKIBNM-1, G2400061 1 RKIBNO, NONZER, REQSTA) G2400062 IF (REQSTA .LT. 0) GO TO 150 G2400063 100 CONTINUE G2400064 150 CONTINUE G2400065 RETURN G2400066 END G2400067 SUBROUTINE WRTKIB G2500001 1 /G25 F ITOS CCS 3.0 SL-149G2500002C WRITE A KEY INFO BLOCK ONTO MASS MEMORY G2500003C CREDIT COLLECTION SYSTEM VERSION 3.0 G2500004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G2500005C COPYRIGHT CONTROL DATA CORPORATION 1979 G2500006C G2500007C G2500008C*** G2500009C WRTKIB WRITES A KEY INFORMATION BLOCK TO MASS MEMORY G2500010C G2500011C G2500012C INPUT: G2500013C THE KIB TO BE WRITTEN (KIBBUF) G2500014ÐÐC ITS RELATIVE KIB NUMBER (RKIBNO) G2500015C WORDS PER SECTOR (WPS) G2500016C BEGINNING SECTOR ADDR OF KIB (KEYBSC) G2500017C LENGTH OF A KIB (KIBLEN) G2500018C G2500019C G2500020C PROCESS: G2500021C IN ORDER FOR RECOVERY TO WORK PROPERLY, AN EOF CODE G2500022C IS WRITTEN IN THE NEXT KIB LOCATION ON MASS MEMORY, G2500023C IF THIS KIB IS NOT THE LAST ONE. G2500024C G2500025C THE EXTRA WORDS ARE WRITTEN WHEN THE KIB IS A NEW G2500026C ONE; THAT IS, NOT AN UPDATE. G2500027C G2500028C AT THE BEGINNING OF EACH PROCESSOR, THE GLOBAL EOF G2500029C CODES ARE PLACED AFTER THE BUFFER ARRAY KIBBUF. G2500030C IF NECESSARY, AN EXTRA SECTOR CONTAINING THE EOF G2500031C CODE IS WRITTEN ON MASS MEMORY ALONG WITH THE KIB. G2500032C G2500033C THE SUBROUTINE MWRITF IS USED FOR THE WRITE. G2500034C G2500035C G2500036C OUTPUT: G2500037C THE KIB ON MASS MEMORY G2500038C STATUS NON-ZERO, IF I/O ERROR DETECTED G2500039ÐÐC G2500040C G2500041C THE FOLLOWING SUBROUTINES ARE USED BY WRTKIB G2500042C MWRITF WRITE MASS MEMORY - FTN INTERFACE TO MMWRIT G2500043C FOR A DEFINITION OF FMCOM, SEE MACRO FMCOM G2500044 G2500045M FMCOM G2500046C FOR A DEFINITION OF FMCOM2, SEE MACRO FMCOM2 G2500047M FMCOM2 G25000485 G2500049C FOR DESCRIPTION OF VARIABLES, SEE MACRO FMCOM3G2500050C*** G2500051 EQUIVALENCE (NONZER ,SSET) G2500052C OFFSET IS ZERO G2500053 INTEGER OFFSET G2500054 EQUIVALENCE (OFFSET, NEWBUF) G25000555 G2500056C --WRITE ONE MORE SECTOR (FOR THE 2 WORDS OF EOF) G2500057C --IF IT IS A NEW KIB AND NOT THE LAST KIB G2500058 I = KIBLEN G2500059 IF (NEWBUF .EQ. 1 .AND.LASTKB .EQ.0) I = I+WPS G2500060 NEWBUF = 0 G2500061 CALL MWRITF (KEYBSC , RKIBNO, KIBLEN,I,OFFSET, KIBBUF, G2500062 2 NONZER, REQSTA) G2500063 RETURN G2500064ÐÐ END G2500065 SUBROUTINE XTKEY (FCB, RECORD) G2600001 1 /G26 F ITOS CCS 3.0 SL-149G2600002C EXTRACT KEY FROM RECORD G2600003C CREDIT COLLECTION SYSTEM VERSION 3.0 G2600004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G2600005C COPYRIGHT CONTROL DATA CORPORATION 1979 G2600006C G2600007C G2600008C*** G2600009C ALL KEYS OF A RECORD FOR AN INDEXED FILE ARE CONTAINED G2600010C WITHIN THE RECORD. THE KEYS ARE CONTIGUOUS WITHIN G2600011C THE RECORD. G2600012C G2600013C THE KEY CAN START WITH AN EVEN OR ODD BYTE OF THE G2600014C RECORD. G2600015C G2600016C THE LENGTH OF THE KEY CAN BE EVEN OR ODD. G2600017C G2600018C G2600019C INPUT: G2600020C THE RECORD (PARAMETER) G2600021C FCB CONTAINING INFO ABOUT KEY POSITION AND LENGTH G2600022C (PARAMETER) G2600023C KEY TYPE (KEYTYP) G2600024ÐÐC G2600025C G2600026C PROCESS: G2600027C GET THE START BYTE OF KEY IN RECORD AND LENGTH OF G2600028C KEY IN BYTES FROM THE FCB FOR THE KEY TYPE. G2600029C G2600030C EXTRACT BYTE BY BYTE FROM THE RECORD. G2600031C PUT RESULT IN BUFFER KEYVAL, LEFT-JUSTIFIED. G2600032C G2600033C IF THE NUMBER OF BYTES IN THE KEY IS ODD, THE EXTRA G2600034C BYTE IN KEYVAL IS ZERO FILLED. G2600035C G2600036C G2600037C OUTPUT: G2600038C KEY VALUE LEFT-JUSTIFIED AND ZERO FILLED (KEYVAL) G2600039C G2600040C G2600041C FOR A DEFINITION OF FMCOM, SEE MACRO FMCOM G2600042M FMCOM G2600043C FOR A DEFINITION OF FMCOM2, SEE MACRO FMCOM2 G2600044M FMCOM2 G2600045C FOR DESCRIPTION OF VARIABLES, SEE MACRO FMCOM3G2600046C*** G2600047 INTEGER FCB(1) G2600048 INTEGER FRSTBY G2600049ÐÐ INTEGER FRSTWD G2600050 INTEGER KPIDX (4) G2600051 INTEGER LASTBY G2600052 INTEGER RECORD(1) G26000535 G2600054 DATA KPIDX /21,23,25,27/ G2600055. G2600056C --PICK UP DATA FROM FCB G2600057 I = KLIDX (KEYTYP) G2600058 KEYLNG = FCB (I) G2600059 I = KPIDX (KEYTYP) G2600060 FRSTBY = FCB (I) G26000612 G2600062C --LAST BYTE POSITION IN RECORD G2600063 LASTBY = FRSTBY+KEYLNG-1 G2600064C --I IS THE BYTE POSITION IN A RECORD G2600065C --J IS THE WORD POSITION IN A RECORD G2600066C --I1 IS THE BYTE POSITION IN KEYVAL BUFFER G2600067C --J1 IS THE WORD POSITION IN KEYVAL BUFFER G2600068 I1 = 0 G2600069 DO 300 I = FRSTBY, LASTBY G2600070 J = (I+1)/2 G2600071 I1= I1+1 G2600072 J1=(I1+1)/2 G2600073 IF (AND(I,1) .EQ. 0) GO TO 100 G2600074ÐÐC --EXTRACT LEFT-HAND BYTES, SHIFT TO RIGHT-HAND BYTES G2600075 IBYTE = AND (RECORD(J)/$100, $00FF) G2600076 GO TO 150 G2600077 100 CONTINUE G2600078C --EXTRACT RIGHT-HAND BYTES G2600079 IBYTE = AND (RECORD(J), $00FF) G2600080 150 CONTINUE G26000812 G2600082 IF (AND(I1,1) .EQ. 0) GO TO 200 G2600083C --PUT BYTE IN LEFT-HAND OF WORD IN KEY VALUE BUFFER G2600084 KEYVAL(J1) = IBYTE*$100 G2600085 GO TO 250 G26000861 G2600087 200 CONTINUE G2600088C --ADD BYTE TO RIGHT-HAND OF WORD IN KEY VALUE BUFFER G2600089 KEYVAL(J1) = KEYVAL(J1) + IBYTE G2600090 250 CONTINUE G2600091 300 CONTINUE G26000922 G2600093 END G2600094 SUBROUTINE RTVIDX (FCB ,REQBUF,RECBUF,KEYVL, ISTAT) G2700001 * /G27 F ITOS CCS 3.0 SL-149G2700002C FILE MANAGER READ RECORD PROCESSOR - READ BY KEY VALUE G2700003C CREDIT COLLECTION SYSTEM VERSION 3.0 G2700004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G2700005ÐÐC COPYRIGHT CONTROL DATA CORPORATION 1979 G2700006C G2700007C G27000082 G2700009C*** G2700010C RTVIDX IS THE REQUEST PROCESSOR FOR RETRIEVING A G2700011C RECORD FROM AN INDEXED FILE VIA A KEY VALUE. THE G2700012C FILE HAS TO BE OPENED SPECIFYING THE KEY TYPE FOR G2700013C RETRIEVAL. THE CALLING SEQUENCE FOR THE REQUEST IS G2700014C AS FOLLOWS: G2700015C G2700016C CALL READR (REQBUF, RECBUF, KEYVAL, ISTAT) G2700017C G2700018C WHERE REQBUF IS THE FM REQUEST BUFFER, G2700019C RECBUF IS THE BUFFER WHERE THE RECORD WILL G2700020C BE STORED, G2700021C G2700022C KEYVAL CONTAINS THE VALUE OF THE KEY THE G2700023C USER WANTS THE RECORD TO CONTAIN. G2700024C IF THE EXACT RECORD IS NOT FOUND, G2700025C KEYVAL WILL BE CHANGED TO BE THE G2700026C KEY OF THE RECORD ACTUALLY RETRIEVED, G2700027C G2700028C ISTAT IS THE REQUEST STATUS. G2700029C G2700030ÐÐC G2700031C INPUT: G2700032C THE FILE MANAGER EXEC TRANSFERS CONTROL TO RTVIDX AFTER G2700033C IT HAS BEEN BROUGHT INTO PARTITION 1 G2700034C G2700035C G2700036C PROCESS: G2700037C REVELENT INFORMATION IS OBTAINED FROM THE FCB. G2700038C GET THE KEY TYPE BEING OPENED, THAT IS, THE KEY TYPE G2700039C TO DO THE RETRIEVAL. G2700040CE G2700041C LOCALIZE THE KEY VALUE TO BASE THE RETRIEVAL ON. G2700042C IF THE BYTE LENGTH OF THE KEY IS ODD, THEN ZERO- G2700043C FILL THE LAST BYTE. G2700044C G2700045C CHECK FOR SPECIAL CASE (KIB IN MEMORY). G2700046C POSITION INTO THE KEY INFORMATION DIRECTORY FOR THE G2700047C KEY TYPE SPECIFIED AND FOR THE KEY VALUE. G2700048. G2700049C IF THE KEY VALUE SPECIFIED IS BIGGER THAN ANY EXIST- G2700050C ING KEY, THEN AN EOF INDICATOR IS SET. G2700051C IF THE KEY VALUE DOES NOT EXIST BUT THERE ARE KEYS G2700052C BIGGER THAN IT, THEN THE RECORD IMMEDIATELY BIGGER G2700053C THAN IT WILL BE RETRIEVED; AND THE CONDITION NOTED. G2700054C G2700055ÐÐC IF THE EXACT KEY IS FOUND, THE RECORD IS RETRIEVED. G2700056C IF THERE ARE MORE THAN ONE RECORD WITH THE SAME KEY G2700057C VALUE, THE FIRST RECORD STORED WITH THIS KEY IS G2700058C RETRIEVED. G2700059C G2700060C WHEN A RECORD IS RETRIEVED, POSITIONING INTO AN G2700061C INDEXED FILE IS SAID TO BE ACHIEVED. G2700062C G2700063C POSITIONING IMPLIES RECORDING THE KEY VALUE OF THE G2700064C LAST RETRIEVED RECORD, THE RELATIVE KEY INFO BLOCK (KIB) G2700065C NUMBER AND THE KEY INFO SEGMENT (KIS) NUMBER WITHIN G2700066C THE KIB POINTING TO THE RECORD LAST RETRIEVED, AND G2700067C THE RELATIVE RECORD NUMBER OF THE RECORD LAST RE- G2700068C TRIEVED. G2700069C G2700070C POSITIONING IS REQUIRED IN THIS PROCESSOR BECAUSE G2700071C GET NEXT (GETS) PROCESSOR NEEDS THE INFORMATION TO G2700072C RETRIEVE A RECORD. G2700073C G2700074C G2700075C IF NO RECORD IS RETRIEVED BECAUSE OF AN ERROR CONDI- G2700076C TION (EOF OR INPUT BUFFERS OVERLAP) THEN NO POSITION- G2700077C ING IS ACHIEVED. G2700078C G2700079C IF AN ERROR IS DETECTED BY RTVIDX THEN RTVIDX WILL G2700080ÐÐC DECREMENT THE RESERVED RECORD LOCK COUNT IF IT HAD G2700081C BEEN SET BY THE FM EXEC G2700082CE G2700083C G2700084C EXIT: G2700085C RTVIDX RETURNS TO THE FILE MANAGER EXEC VIA CALLING G2700086C G2700087C G2700088C THE FOLLOWING SUBROUTINES ARE USED BY RTVIDX G2700089C CKADRP - CHECK FOR UNPROTECTED ADDRESS G2700090C CPUTKL - COMPUTE LENGTH OF A KEY INFO BLOCK G2700091C FMSCOM FM EXEC SERIAL PROCESSOR COMPLETION ROUTINE G2700092C FWAKIS - FIRST WORD OF A KIS IN A KIB G2700093C IOVCHK OVERLAP CHECK INTEGER FUNCTION - FTN INTERFACEG2700094C POSKID - POSITION INTO A KEY INFORMATION DIRECTORY G2700095C RDRECD - READ A RECORD FROM MASS MEMORY G2700096. G2700097C FOR A DEFINITION OF FMCOM, SEE MACRO FMCOM G2700098M FMCOM G2700099. G2700100C FOR A DEFINITION OF FMCOM2, SEE MACRO FMCOM2 G2700101M FMCOM2 G2700102 INTEGER FCB(1) G2700103 INTEGER ISTAT G2700104 INTEGER KEYVL (1) G2700105ÐÐ INTEGER RECBUF (1) G2700106 INTEGER REQBUF (1) G2700107 INTEGER SPECAS, TOTKIS G2700108C NO. OF RESERVED ENTRIES IN THE RECORD LOCK TABLE G2700109 EXTERNAL NRERLE G2700110C FOR DESCRIPTION OF VARIABLES, SEE MACRO FMCOM3G2700111. G2700112C FOR A DEFINITION OF INIDAT, SEE MACRO INIDAT G2700113C*** G2700114M FMINIT G2700115. G2700116 KEYTYP = REQBUF (10) G2700117 I = KLIDX (KEYTYP) G2700118 KEYLNG = FCB (I) G2700119 KEYLWD = KEYLNG/2 G2700120 DO 10 I = 1,KEYLWD G2700121 KEYVAL (I) = KEYVL(I) G2700122 10 CONTINUE G2700123C --ZERO FILL LAST BYTE G2700124 IF (AND(KEYLNG,1) .EQ. 0) GO TO 20 G2700125 KEYLWD = KEYLWD + 1 G2700126 KEYVAL(KEYLWD) = AND (KEYVL(KEYLWD) ,$FF00) G2700127 20 CONTINUE G27001282 G2700129C CHECK IF KEYVL OVERLAPS WITH OTHER PARAMETER G2700130ÐÐC EXIT IF BAD G2700131 IF (IOVCHK(KEYVL,KEYLWD) .NE. 0) GO TO 200 G27001322 G2700133C --PICK UP LOCK RECORD FLAG G2700134 LCKFLG = AND( REQBUF(9), $8000) G27001352 G2700136C CHECK FOR SPECIAL CASE G2700137 FILEID = FCB(1) G2700138 CALL SPECAL (SPECAS) G2700139 IF (I .EQ. 0) GO TO 40 G27001401 G2700141C SPECIAL CASE TRUE - SCAN SEQ SET G2700142 TOTKIS = KIBBUF (NUMKIS) G2700143 DO 30 KISIDX = 1, TOTKIS G2700144 I = FWAKIS(KISIDX) G2700145 I2 = CMPSTG (KEYVAL, KIBBUF(I),KEYLWD) G2700146 IF (I2 .EQ. 0) GO TO 35 G2700147 30 CONTINUE G2700148 GO TO 40 G27001491 G2700150C KEY FOUND - GET RRN G2700151 35 J = I + KEYLWD G2700152 RRDATA(1) = KIBBUF(J) G2700153 RRDATA(2) = KIBBUF(J+1) G2700154C IF LAST KIS (ALL F'S KEY) THEN EOF G2700155ÐÐC ***** 139*A034G2700156C THIS CODE HAS TO RECOGNIZE 3 DIFFERENT END OF FILE CONDITIONS G2700157C 1. LAST KIS'S RRN = -2,0 G2700158C CORRECT END G2700159C 2. LAST KIS'S RRN = 0,-2 AND KEY IS ALL FFFF'S G2700160C SET BY ERROR IN EARLIER VERSION OF ADDKIS AND UTIL'S UPDIDX G2700161C 3. LAST KIS'S RRN = FFFF,FFFF G2700162C SET BY ERROR IN EARLIER VERSION OF UTIL'S LDIXOD G2700163 KEYWRD = KIBBUF(J-1) G2700164 ITEST1 = 0 G2700165 ITEST2 = 0 G2700166 ASSEM $C400,+RRDATA G2700167+ LDA+ RRDATA G2700168 ASSEM $0125 G2700169+ SAP 5 G2700170 ASSEM $0900 G2700171+ INA 0 G2700172 ASSEM $0113 G2700173+ SAN 3 G2700174 ASSEM $D400,+ITEST1 G2700175+ RAO+ ITEST1 G2700176 ASSEM $1808 G2700177+ JMP* *+8 G2700178 ASSEM $C400,+KEYWRD G2700179+ LDA+ KEYWRD G2700180ÐÐ ASSEM $0124 G2700181+ SAP 5 G2700182 ASSEM $0900 G2700183+ INA 0 G2700184 ASSEM $0112 G2700185+ SAN 2 G2700186 ASSEM $D400,+ITEST2 G2700187+ RAO+ ITEST2 G2700188 IF (RRDATA(1).EQ.-2 .OR. ITEST1.EQ.1) GO TO 100 G2700189 IF (RRDATA(1).EQ.0 .AND. RRDATA(2).EQ.-2 .AND. ITEST2.EQ.1) G2700190 1 GO TO 100 G2700191C ***** 139*A034G2700192 KEYFND = 1 G2700193 GO TO 45 G27001941 G2700195. G2700196C -- NOT SPECIAL CASE: G2700197C -- POSITION INTO KEY INFORMATION STRUCTURE G2700198C TO THE CORRECT POSITION G2700199C RETURNS EOF INDICATION, IF SO G2700200C RELATIVE KIB NUMBER G2700201C RELATIVE KIS NUMBER WITHIN THE KIB G2700202C THE RELATIVE RECORD NUMBER OF RECORD TO BE RETRIEVED G2700203C WHETHER THE EXACT KEY EXISTS OR NOT FLAG G2700204C G2700205ÐÐ 40 RRDATA(1) = 0 G2700206 RRDATA(2) = 0 G2700207 CALL POSKID G2700208 IF (REQSTA .LT. 0) GO TO 200 G2700209C G2700210C IF 1ST KIS (ALL 0'S KEY) GET NEXT KEY G2700211 IF (RRDATA .NE. -1) GO TO 43 G2700212 KISIDX = KISIDX + 1 G2700213C ***** 139*A034G2700214 KEYFND = 0 G2700215 43 CONTINUE G2700216C ***** 139*A034G2700217 J = FWAKIS (KISIDX) + KEYLWD G2700218 RRDATA(1) = KIBBUF(J) G2700219 RRDATA(2) = KIBBUF(J+1) G2700220C ***** 3 RECORDS DELETED 139*A034G2700221C --IF EOF IS NOT ENCOUNTERED THEN G2700222C --READ RECORD FROM FILE VIA RELATIVE RECORD NUMBER G2700223C ***** 139*A034G2700224C THIS CODE HAS TO RECOGNIZE 4 DIFFERENT END OF FILE CONDITIONS G2700225C 1. LAST KIS'S RRN = -2,0 G2700226C CORRECT END G2700227C 2. LAST KIS'S RRN = 0,-2 AND KEY IS ALL FFFF'S G2700228C SET BY ERROR IN EARLIER VERSION OF ADDKIS AND UTIL'S UPDIDX G2700229C 3. LAST KIS'S RRN = FFFF,FFFF G2700230ÐÐC SET BY ERROR IN EARLIER VERSION OF UTIL'S LDIXOD G2700231C 4. EOF FLAG SET TO 1 G2700232C EMPTY FILE G2700233 ITEST1 = 0 G2700234 ITEST2 = 0 G2700235 KEYWRD = KIBBUF(J-1) G2700236 ASSEM $C400,+RRDATA G2700237+ LDA+ RRDATA G2700238 ASSEM $0125 G2700239+ SAP 5 G2700240 ASSEM $0900 G2700241+ INA 0 G2700242 ASSEM $0113 G2700243+ SAN 3 G2700244 ASSEM $D400,+ITEST1 G2700245+ RAO+ ITEST1 G2700246 ASSEM $1808 G2700247+ JMP* *+8 G2700248 ASSEM $C400,+KEYWRD G2700249+ LDA+ KEYWRD G2700250 ASSEM $0124 G2700251+ SAP 5 G2700252 ASSEM $0900 G2700253+ INA 0 G2700254 ASSEM $0112 G2700255ÐÐ+ SAN 2 G2700256 ASSEM $D400,+ITEST2 G2700257+ RAO+ ITEST2 G2700258 IF (EOF.EQ.1 .OR. RRDATA(1).EQ.-2 .OR. ITEST1.EQ.1) GO TO 100 G2700259 IF (RRDATA(1).EQ.0 .AND. RRDATA(2).EQ.-2 .AND. ITEST2.EQ.1) G2700260 1 GO TO 100 G2700261C ***** 139*A034G2700262 IF (KEYFND .EQ. 0) NOKEY = 1 G2700263 45 CALL RDRECD (RECBUF) G2700264C --CHECK FOR ERRORS G2700265 IF (REQSTA .LT. 0) GO TO 300 G2700266C G27002673 G2700268C CHECK IF KEYVL IS WITHIN USER AREA. IF NOT, DOES NOT COME BACK. G2700269 CALL CKADRP(KEYVL) G2700270C --SET UP DATA IN REQUEST BUFFER, IN CASE DO GET SEQUENCE G2700271C --REQUEST NEXT G2700272C -- NUMBER OF RECORDS RETRIEVED G2700273 REQBUF (11) = 1 G2700274 REQBUF (12) = RRDATA (1) G2700275 REQBUF (13) = RRDATA (2) G2700276 REQBUF (14) = RKIBNO(1) G2700277 REQBUF (15) = RKIBNO(2) G2700278 REQBUF (16) = KISIDX G2700279 REQBUF (17) = RRDATA (1) G2700280ÐÐ REQBUF (18) = RRDATA (2) G27002812 G2700282C --SAVE KEY OF RECORD RETRIEVED IN USER AREA G2700283 J = FWAKIS (KISIDX) G2700284 DO 50 I = 1,KEYLWD G2700285 KEYVL (I) = KIBBUF (J) G2700286 J = J+1 G2700287 50 CONTINUE G27002882 G2700289 GO TO 900 G2700290. G2700291C --EOF ENCOUNTERED G2700292 100 CONTINUE G2700293 ERRIDC = 1 G2700294 HITEOF = 1 G27002952 G2700296C --ABNORMAL EXIT G2700297 200 CONTINUE G2700298C --DECREMENT LOCK RECORD RESERVED COUNTER G2700299 IF (LCKFLG .EQ. 0) GO TO 250 G2700300C G2700301C LDA+ NRELRC GET COUNT G2700302C G2700303C INA -1 DECREMENT BY ONE G2700304C STA* (*-2) STORE BACK G2700305ÐÐC G2700306 ASSEM $C400, NRERLE, $09FE, $6CFD G2700307C G2700308 250 CONTINUE G27003092 G2700310 300 CONTINUE G2700311C --ZERO OUT REQUEST BUFFER BECAUSE OF ERROR G2700312 DO 400 I = 11,18 G2700313 REQBUF(I) = 0 G2700314 400 CONTINUE G2700315 900 CONTINUE G2700316 ISTAT = REQSTA G27003171 G2700318 PREID = FCB(1) G2700319 PRETYP = KEYTYP G27003202 G2700321C --RETURN TO FM EXEC G2700322 CALL FMSCOM G2700323 RETURN G2700324 END G2700325 SUBROUTINE GETNDX (FCB ,REQBUF,RECBUF,KEYVL,ISTAT) G2800001 1 /G28 F ITOS CCS 3.0 SL-149G2800002C FILE MANAGER GET NEXT RECORD PROCESSOR - GET BY KEY VALUE G2800003C CREDIT COLLECTION SYSTEM VERSION 3.0 G2800004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G2800005ÐÐC COPYRIGHT CONTROL DATA CORPORATION 1979 G2800006C G2800007C G28000082 G2800009C*** G2800010C GETNDX IS THE REQUEST PROCESSOR FOR RETRIEVING A RECORD G2800011C FROM AN INDEXED FILE. THE KEY VALUE OF THE RECORD TO G2800012C BE RETRIEVED MUST BE ONE BIGGER THAN THAT OF THE RECORD G2800013C RETRIEVED IN THE PREVIOUS GETS CALL. THE GETS REQUEST G2800014C HAS THE FOLLOWING CALL SEQUENCE : G2800015C G2800016C CALL GETS (REQBUF, RECBUF, KEYVAL, ISTAT) G2800017C G2800018C WHERE REQBUF IS THE FILE REQUEST BUFFER G2800019C RECBUF IS THE RECORD BUFFER WHERE THE RECORD G2800020C WILL BE STORED G2800021C KEYVAL IS THE BUFFER CONTAINING THE KEY VALUE G2800022C OF THE RECORD RETRIEVED LAST TIME. G2800023C UPON EXIT, THE KEY VALUE OF THE RECORD G2800024C RETRIEVED THIS TIME WILL BE SAVED IN G2800025C THIS BUFFER G2800026C ISTAT IS THE FILE REQUEST STATUS WORD G2800027C G2800028C G2800029C MORE THAN ONE RECORD CAN BE RETRIEVED AT EACH CALL. G2800030ÐÐC BUT ONLY ONE RECORD CAN BE LOCKED. G2800031C G2800032C THE FM EXEC TRANSFERS CONTROL TO GETNDX AFTER THE G2800033C PROCESSOR IS BROUGHT INTO PARTITION ONE. THE PROCESSOR G2800034C IS SERIAL. G2800035C G2800036C UPON COMPLETION, THE PROCESSOR RETURNS TO THE FM EXEC G2800037C VIA FMSCOM. G2800038C G2800039C G2800040CE G2800041C INPUT DATA ABOUT THE RECORD LAST RETRIEVED G2800042C I.E. RELATIVE KIB NUMBER OF THE SEQUENCE SET G2800043C RELATIVE KIS INDEX WITHIN THE KIB G2800044C KEY VALUE USED FOR RETRIEVAL G2800045C RELATIVE RECORD NUMBER G2800046. G2800047C PROCESS FROM DATA ABOUT LAST RECORD, LOOK FOR THE NEXT G2800048C RECORD (KIB MAY ALREADY BE IN MEMORY-SPECIAL CASE). G2800049C THERE MAY BE ADDITION, BLOCK SPLIT OR DELETION OF G2800050C THE SEQUENCE SET SINCE THE LAST RETRIEVAL. G2800051C THE TASK IS TO FIND THE CORRECT PLACE IN THE S.S. G2800052C ANY NEW RECORD WHOSE KEY VALUE IS SMALLER THAN THE LAST G2800053C RETRIEVED ONE WILL NOT BE TOUCHED. THEY WILL BE SKIPPEDG2800054C G2800055ÐÐC ALL THE KISES WITH DIFFERENT KEY VALUES ARE ARRANGED G2800056C IN ORDER IN THE SEQUENCE SETS. G2800057C KISES WHOSE KEY VALUE ARE THE SAME ARE ARRANGED IN G2800058C ASCENDING ORDER OF THE RELATIVE RECORD NUMBER. G2800059C THUS IF KIS VALUE = KEY VALUE + RELATIVE RECORD NUMBER G2800060C THEN ALL KISES ARE IN ASCENDING ORDER G2800061C G2800062C OUTPUT EOF ENCOUNTERED FLAG G2800063C THE RECORD RETRIEVED G2800064C G2800065CE G2800066C THE FOLLOWING SUBROUTINES ARE USED BY GETNDX G2800067C CKADRP - CHECK FOR UNPROTECTED ADDRESS G2800068C CMPSTG - COMPARES TWO STRINGS OF CHARACTER G2800069C CKUTKL - COMPUTES LENGTH OF A KEY INFO BLOCK G2800070C FWAKIS - FIRST WORD OF A KIS IN A KIB G2800071C NEXTSS - READ NEXT SEQUENCE SET FROM MASS MEMORY G2800072C POSKIS - POSITION INTO A KEY INFORMATION DIRECTORY G2800073C RDKIB - READ A KIB INTO MAIN MEMORY G2800074C RDRECD - READ A RECORD FROM MASS MEMORY G2800075C FMSCOM - FM EXEC SERIAL PROCESSOR COMPLETION ROUTINE G2800076C FWARCD - FIRST WORD ADDR OF A RECORD WITHIN A BUFFER G2800077C IOVCHK - OVERLAP CHECK INTEGER FUNCTION - FTN INTERFACEG2800078C G2800079C G2800080ÐÐC FOR A DEFINITION OF FMCOM, SEE MACRO FMCOM G2800081. G2800082M FMCOM G2800083. G2800084C FOR A DEFINITION OF FMCOM2, SEE MACRO FMCOM2 G2800085M FMCOM2 G2800086 INTEGER BGKIS G2800087 INTEGER FCB(1) G2800088 INTEGER FSTRRN(2) G2800089 INTEGER FWARCD G2800090 INTEGER ISTAT G2800091 INTEGER KEYVL(1) G2800092 INTEGER OLDNUM(2) G2800093 INTEGER RECBUF(1) G2800094 INTEGER RECCNT G2800095 INTEGER REQBUF(1) G2800096 INTEGER SPECAS G2800097 INTEGER TOTKIS G28000982 G2800099 EXTERNAL NRERLE G2800100C FOR DESCRIPTION OF VARIABLES, SEE MACRO FMCOM3G2800101. G2800102C FOR A DEFINITION OF INIDAT, SEE MACRO INIDAT G2800103C*** G2800104M FMINIT G2800105ÐÐ. G2800106C --CLEAR KISBUF AND KEYVAL 127*5194G2800107 DO 1 I = 1,17 G2800108+ 127*5194G2800109 1 KISBUF(I) = 0 G2800110+ 127*5194G2800111 DO 2 I = 1,15 G2800112+ 127*5194G2800113 2 KEYVAL(I) = 0 G2800114+ 127*5194G2800115C --CLEAR THE REL RECORD NO. FOR THE FIRST RECORD RETRIEVED G2800116 FSTRRN(1) = 0 G2800117 FSTRRN(2) = 0 G28001181 G2800119C -MAKE SURE THAT THE NO. OF RECORDS TO GET IS NON-ZERO G2800120C -CANNOT LOCK RECORDS IF THE NO. OF RECORDS TO GET IS MORE THAN G2800121C -ONE. THESE CONDITIONS ARE CHECKED BY THE OPEN PROCESSOR. THEY G2800122C -ARE DOUBLE CHECKED HERE IN CASE REQBUF HAS BEEN CHANGED SINCE G2800123C -OPENED. G2800124 TOTREC = REQBUF (9) G2800125 IF (TOTREC .EQ. $8001) GO TO 5 G2800126 IF (TOTREC .GT. 0) GO TO 5 G2800127C --ERROR G2800128 3 BADREQ = 1 G2800129 ERRIDC = 1 G2800130ÐÐ GO TO 999 G2800131 5 CONTINUE G28001322 G2800133C --PICK UP DATA ABOUT THIS RETRIEVAL G2800134 TOTREC = AND (TOTREC, $7FFF) G2800135 KEYTYP = REQBUF (10) G2800136 RKIBNO(1) = REQBUF (14) G2800137 RKIBNO(2) = REQBUF (15) G2800138 KISIDX = REQBUF (16) G2800139 RRDATA (1) = REQBUF(17) G2800140 RRDATA (2) = REQBUF(18) G2800141 I = KLIDX(KEYTYP) G2800142 KEYLNG = FCB (I) G2800143 KEYLWD =(KEYLNG + 1)/2 G2800144 KISLNG = KEYLWD + 2 G28001451 G2800146C --COUNT NO. OF RECORDS RETRIEVED SO FAR G2800147 RECCNT = 0 G28001481 G2800149C CHECK IF KEYVL OVERLAPS WITH OTHER PARAMETER G2800150C SKIP, IF ERROR G2800151 IF (IOVCHK(KEYVL, KEYLWD) .NE. 0) GO TO 950 G2800152. G2800153C SEE IF THIS IS THE FIRST GETS AFTER OPEN G2800154C I.E., THERE WAS NO POSITIONING G2800155ÐÐ IF (RKIBNO(1) .NE. 0 .OR. G2800156 1 RKIBNO(2) .NE. 0) GO TO 40 G2800157C YES, GO TO THE FIRST S.S. FOR THIS KEY TYPE G2800158 RRDATA(1) = 0 G2800159 RRDATA(2) = 0 G2800160 KISIDX = 0 G2800161 CALL POSKID G2800162 IF (REQSTA .LT. 0) GO TO 950 G2800163 IF (EOF. EQ. 1) GO TO 900 G2800164C POSITION IS GOOD, RRN OF DATA IN RRDATA G2800165 IF (RRDATA .EQ. -1) GO TO 500 G2800166 GO TO 605 G28001671 G2800168C NO, CONTINUE FROM PREVIOUS POSITIONING G2800169C -- RECREATE LAST USED KIS (MASTER KIS) G2800170C -- KIS POINTING TO LAST RECORD IS IN KISBUF G2800171 40 DO 10 I = 1, KEYLWD G2800172 KISBUF(I) = KEYVL(I) G2800173 10 CONTINUE G2800174 KISBUF(KEYLWD+1) = RRDATA(1) G2800175 KISBUF(KEYLWD+2) = RRDATA(2) G2800176C CHECK FOR SPECIAL CASE G2800177 CALL SPECAL (SPECAS) G2800178 IF (I .EQ. 0) GO TO 80 G28001791 G2800180ÐÐC SPECIAL CASE TRUE - SCAN SEQ. SET G2800181 TOTKIS = KIBBUF (NUMKIS) G2800182 DO 50 I = 1, TOTKIS G2800183 I1 = FWAKIS(I) G2800184 I2 = CMPSTG(KISBUF, KIBBUF(I1), KISLNG) G2800185 IF (I2 .EQ. 0) GO TO 60 G2800186 50 CONTINUE G2800187 GO TO 80 G28001881 G2800189C FOUND PREVIOUS KEY/RRN - CKECK KISIDX G2800190 60 IF (I .EQ. KISIDX) GO TO 90 G28001911 G2800192C NOT SPECIAL CASE - READ IN KIB (RKIBNO) G2800193 80 CALL RDKIB G2800194 IF (REQSTA .LT. 0) GO TO 950 G28001951 G2800196. G2800197 90 CONTINUE G2800198 TOTKIS = KIBBUF (NUMKIS) G28001992 G2800200 IF (TOTKIS .GE. KISIDX) GO TO 100 G2800201C --THE NO. OF KIS IN KIB IS SMALLER THAN INDEX OF OLD KIS G2800202C --KIB HAS BEEN MADE SMALLER BECAUSE OF DELETION OR BLOCK SPLIT G2800203C --START FROM THE LARGEST KIS IN KIB, BACK UP AND LOOK FOR THE G2800204C --CORRECT PLACE G2800205ÐÐC G2800206 KISIDX = TOTKIS + 1 G2800207 GO TO 200 G28002085 G2800209 100 CONTINUE G2800210C --KIB MAY BE BIGGER OR UNCHANGED G2800211C --SEE IF THE KIS BEING POINTED TO IS THE OLD ONE G2800212C --IF TOO BIG, THEN NEED TO BACK UP TO CORRECT PLACE, (THERE G2800213C --WAS DELETION) G2800214C --IF TOO SMALL THEN NEED TO MOVE FORWARD AND SKIP OVER NEW G2800215C --RECORDS THAT WERE ADDED G28002162 G2800217 BGKIS = FWAKIS (KISIDX) G2800218 IF ( CMPSTG (KIBBUF(BGKIS), KISBUF, KISLNG) .LE. 0) GO TO 500 G2800219. G2800220C B A C K U P R O U T I N E G2800221 200 CONTINUE G2800222C G2800223C -- BACK UP ONE KIS AT A TIME, UNTIL THE KIS VALUE IS G2800224C LESS THAN OR EQUAL TO THE MASTER KIS (THE ONE POINTING G2800225C TO THE RECORD JUST RETRIEVED) G2800226C OR THERE IS NO MORE KIS IN THIS KIB G28002272 G2800228C --WHILE CURRENT KIS INDEX IS BIGGER THAN ONE (I.E. THERE ARE G2800229C --MORE KISES TO LOOK) G2800230ÐÐC --OR KIS VALUE STILL BIGGER THAN MASTER KIS DO G2800231C G2800232C G2800233 300 CONTINUE G2800234 KISIDX = KISIDX - 1 G2800235 IF (KISIDX .LT. 1) GO TO 400 G2800236 BGKIS = FWAKIS (KISIDX) G2800237 IF (CMPSTG (KIBBUF(BGKIS),KISBUF, KISLNG) .GT. 0) GO TO 300 G2800238 400 CONTINUE G2800239. G2800240C M O V E F O R W A R D R O U T I N E G28002412 G2800242C MOVE ONE KIS AT A TIME FORWARD UNTIL THE NEW KIS VALUE G2800243C IS BIGGER THAN THE MASTER KIS G2800244C GO ON TO THE NEXT SEQUENCE SET IF EXHAUST ALL KIS IN G2800245C THIS KIB G28002462 G2800247C --REPEAT G2800248 500 CONTINUE G2800249 TOTKIS = KIBBUF (NUMKIS) G2800250C --MOVE FORWARD G2800251 KISIDX = KISIDX +1 G2800252 IF (KISIDX .LE. TOTKIS) GO TO 600 G28002532 G2800254C --EXHAUST ALL KISES IN THIS KIB G2800255ÐÐC --READ IN NEXT SEQUENCE SET G2800256C G2800257C --REMEMBER NUMBER OF THIS KIB G2800258 OLDNUM(1) = RKIBNO(1) G2800259 OLDNUM(2) = RKIBNO(2) G2800260C G2800261 CALL NEXTSS G2800262 IF (REQSTA .LT. 0) GO TO 950 G2800263 IF (LASTSS .EQ. 1) GO TO 900 G2800264 KISIDX = 0 G2800265 GO TO 500 G28002662 G2800267 600 CONTINUE G2800268 BGKIS = FWAKIS (KISIDX) G2800269 IF (CMPSTG (KIBBUF(BGKIS), KISBUF, KISLNG) .LE. 0) GO TO 500 G2800270C --UNTIL KIS VALUE IS BIGGER THAN THE MASTER KIS VALUE G2800271C --ENDREPEAT G2800272. G2800273C --FOUND THE CORRECT KIS G2800274C --READ IN THE RECORD G2800275 I = FWAKIS (KISIDX) + KEYLWD G2800276C -- GET THE RELATIVE RECORD NUMBER FROM THE KIS G2800277 RRDATA(1) = KIBBUF(I) G2800278 RRDATA(2) = KIBBUF(I+1) G2800279C ************************************************************* 132*5365G2800280ÐÐC --CLEAR SPECIAL RECORD LOCK FLAG G2800281 IRLFLG = 0 G2800282C ************************************************************* 132*5365G2800283C ************************************************************* 139*A037G2800284C THIS CODE HAS TO RECOGNIZE 3 DIFFERENT END OF FILE CONDITIONS G2800285C 1. LAST KIS'S RRN = -2,0 G2800286C CORRECT END G2800287C 2. LAST KIS'S RRN = 0,-2 AND KEY IS ALL FFFF'S G2800288C SET BY ERROR IN EARLIER VERSION OF ADDKIS AND UTIL'S UPDIDX G2800289C 3. LAST KIS'S RRN = FFFF,FFFF G2800290C SET BY ERROR IN EARLIER VERSION OF UTIL'S LDIXOD G2800291 KEYWRD = KIBBUF(I-1) G2800292 ITEST1 = 0 G2800293 ITEST2 = 0 G2800294 ASSEM $C400,+RRDATA G2800295+ LDA+ RRDATA G2800296 ASSEM $0125 G2800297+ SAP 5 G2800298 ASSEM $0900 G2800299+ INA 0 G2800300 ASSEM $0113 G2800301+ SAN 3 G2800302 ASSEM $D400,+ITEST1 G2800303+ RAO+ ITEST1 G2800304 ASSEM $1808 G2800305ÐÐ+ JMP* *+8 G2800306 ASSEM $C400,+KEYWRD G2800307+ LDA+ KEYWRD G2800308 ASSEM $0124 G2800309+ SAP 5 G2800310 ASSEM $0900 G2800311+ INA 0 G2800312 ASSEM $0112 G2800313+ SAN 2 G2800314 ASSEM $D400,+ITEST2 G2800315+ RAO+ ITEST2 G2800316 IF (RRDATA(1).EQ.-2 .OR. ITEST1.EQ.1) GO TO 900 G2800317 IF (RRDATA(1).EQ.0 .AND. RRDATA(2).EQ.-2 .AND. ITEST2.EQ.1) G2800318 1 GO TO 900 G2800319C ************************************************************* 139*A037G28003205 G2800321C --COMPUTE THE FIRST WORD IN RECBUF FOR THIS RECORD G2800322 605 CONTINUE G2800323 I = FWARCD (RECCNT) G2800324 CALL RDRECD (RECBUF(I)) G28003251 G2800326C IF ERROR IS FOUND, LOCK ENTRY IS ALREADY DECREMENTED G2800327 IF (REQSTA .LT. 0) GO TO 999 G2800328 RECCNT = RECCNT +1 G28003291 G2800330ÐÐC --SAVE RELATIVE RECORD NUMBER FOR THE FIRST RECORD RETRIEVED G2800331 IF (RECCNT .NE. 1) GO TO 610 G2800332 FSTRRN(1) = RRDATA(1) G2800333 FSTRRN(2) = RRDATA(2) G2800334 610 CONTINUE G28003351 G2800336C ************************************************************* 132*5365G2800337C --CHECK IF RECORD LOCKED STATUS BIT SET G2800338 IF (RCDLCK.EQ.0) GO TO 620 G2800339C G2800340C --IT WAS SET. CLEAR IT AND SET SPECIAL RECORD LOCK FLAG G2800341 IRLFLG = $80 G2800342 RCDLCK = 0 G2800343 620 CONTINUE G2800344C G2800345C ************************************************************* 132*5365G2800346C --GET NEXT KIS IF THERE ARE MORE RECORDS TO RETRIEVE G2800347 IF (RECCNT .LT. TOTREC) GO TO 500 G2800348 GO TO 1000 G28003492 G2800350C --EOF IS ENCOUNTERED G2800351 900 HITEOF = 1 G2800352 IF (RECCNT .NE. 0) GO TO 1000 G2800353C --NO RECORD HAS BEEN RETRIEVED G2800354 ERRIDC = 1 G2800355ÐÐ2 G2800356 950 CONTINUE G2800357C ERROR EXIT, DECREMENT LOCK ENTRY IF NEEDED G2800358 IF (REQBUF(9) .GT. 0) GO TO 1000 G2800359C --EXEC RESERVED AN ENTRY IN THE LOCK TABLE. G2800360C --REMOVE THE RESERVE BY DECREMENTING THE COUNT BY ONE G2800361C G2800362C LDA+ NRERLE G2800363C G2800364C INA -1 G2800365C STA* (*-2) G2800366C G2800367 ASSEM $C400, NRERLE, $09FE, $6CFD G2800368C G28003692 G2800370 999 CONTINUE G28003712 G2800372 1000 CONTINUE G2800373C -CHECK IF KEYVL IS IN UNPROTECTED AREA. IF BAD, NEVER COME BACK. G2800374 CALL CKADRP (KEYVL) G2800375C ************************************************************* 132*5365G2800376 ISTAT = REQSTA + IRLFLG G2800377C --CHECK IF REJECTED BECAUSE OF RECORD LOCKED. G2800378C IF SO SKIP UPDATE OF KEYVL AND REQBUF. G2800379 IF (AND(REQSTA,$8080).NE.$8080) GO TO 1100 G2800380ÐÐC G2800381C --CLEAR REQBUF(15)-(17) FOR USER G2800382 RECBUF(11)=0 G2800383 RECBUF(12) = 0 G2800384 RECBUF(13) = 0 G2800385 GO TO 1120 G2800386C G28003871100 CONTINUE G2800388C ************************************************************* 132*5365G2800389C -SAVE ALL DATA IN REQBUF FOR THE NEXT REQUEST G2800390C * 1 CARD DELETED 132*5365G2800391 REQBUF (11) = RECCNT G2800392 REQBUF(12) = FSTRRN(1) G2800393 REQBUF(13) = FSTRRN(2) G2800394 REQBUF (14) = RKIBNO (1) G2800395 REQBUF (15) = RKIBNO (2) G2800396 REQBUF (16) = KISIDX G2800397 REQBUF (17) = RRDATA (1) G2800398 REQBUF (18) = RRDATA (2) G2800399 J = FWAKIS (KISIDX) G2800400 DO 1110 I = 1,KEYLWD G2800401 KEYVL (I) = KIBBUF (J) G2800402 J = J + 1 G2800403 1110 CONTINUE G28004042 G2800405ÐÐC --RETURN TO FM EXEC G2800406 1120 CONTINUE G2800407C SAVE KEY TYPE AND FILE ID G2800408 PRETYP = KEYTYP G2800409 PREID = FCB(1) G2800410 CALL FMSCOM G2800411 RETURN G2800412 END G2800413 SUBROUTINE DELIDX (FCB ,REQBUF,RECBUF, ISTAT) G2900001 1 /G29 F ITOS CCS 3.0 SL-149G2900002C FILE MANAGER DELETE A RECORD PROCESSOR - INDEXED FILE G2900003C CREDIT COLLECTION SYSTEM VERSION 3.0 G2900004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G2900005C COPYRIGHT CONTROL DATA CORPORATION 1979 G2900006C G2900007C G29000085 G2900009C*** G2900010C DELIDX IS THE REQUEST PROCESSOR FOR DELETING A RECORD FROM G2900011C AN INDEXED FILE. THE DELREC REQUEST HAS THE FOLLOWING CALL G2900012C SEQUENCE : G2900013C G2900014C CALL DELREC (REQBUF, RECBUF, ISTAT) G2900015C G2900016C WHERE REQBUF IS THE FILE REQUEST BUFFER G2900017ÐÐC RECBUF IS THE RECORD BUFFER CONTAINING THE RECORD G2900018C TO BE DELETED FROM THE FILE G2900019C ISTAT IS THE FILE REQUEST STATUS WORD G2900020C G2900021C G2900022C INPUT: G2900023C THE FM EXEC TRANSFERS CONTROL TO DELIDX G2900024C THE FIRST WORD IN COMMON = ADDR OF THE PCT G2900025C THE 2ND WORD IN COMMON = ADDR OF THE FCB G2900026C G2900027C PROCESS: G2900028C EXTRACTS ALL KEYS EMBEDDED WITHIN THE RECORD TO BE G2900029C DELETED G2900030C PICKS UP ALL INFORMATION FROM FCB AND INITIALIZE THE G2900031C COMMON AREA G2900032C THE RELATIVE RECORD NUMBER OF THE RECORD IS IN REQBUF G2900033C DELETES THE KIS POINTING TO THIS RECORD FROM THE KEY G2900034C INFORMATION STRUCTURE. G2900035C CALLS MRECAD (MAIN MEMORY RESIDENT ROUTINE MARKS RECORD G2900036C AS DELETED) TO WRITE THE SPECIAL DELETED CODE IN THE G2900037C DATA AREA FOR THIS RECORD. G2900038C THUS DELETEING IT FROM THE DATA AREA. G2900039C G2900040C EXIT : G2900041C DELIDX RETURNS TO THE EXEC VIA A CALL TO FMSCOM G2900042ÐÐC G2900043C G2900044C THE FOLLOWING SUBROUTINES ARE USED BY DELIDX G2900045C CPUTKL - COMPUTE LENGTH OF A KEY INFO BLOCK G2900046C DELKIS - DELETE A KIS FROM A KEY INFO DIRECTORY G2900047C FMSCOM FM EXEC SERIAL PROCESSOR COMPLETION ROUTINE G2900048C WRTDEL - WRITE DELETED CODE TO A RECORD ON MASS MEM G2900049C XTKEY - EXTRACT KEY FROM RECORD G29000502 G2900051C FOR A DEFINITION OF FMCOM, SEE MACRO FMCOM G2900052M FMCOM G2900053. G2900054C FOR A DEFINITION OF FMCOM2, SEE MACRO FMCOM2 G2900055M FMCOM2 G2900056 INTEGER FCB(1) G2900057 INTEGER ISTAT G2900058 INTEGER RECBUF(1) G2900059 INTEGER REQBUF(1) G2900060. G2900061C*** G29000625 G2900063C DO NOT CLEAR COMMON AREA G2900064M FMINIT G2900065. G2900066C -- MOVE RELATIVE RECORD TO COMMON VARIABLE G2900067ÐÐ RRDATA (1) = REQBUF (12) G2900068 RRDATA (2) = REQBUF (13) G29000692 G2900070C -- SAVE PSEUDO-FILE ID G2900071 FILEID = FCB(1) G29000722 G2900073C --DELETE KIS FOR EVERY KEY DEFINED FOR THE FILE G2900074C G2900075C CALCULATE MOST EFFICIENT SEQUENCE G2900076 KEYTYP = 1 G2900077 I3 = 1 G2900078 IF (PRETYP .LE. 1 .OR. PRETYP .GT. 4) GO TO 50 G2900079 KEYTYP = 4 G2900080 I3 = -1 G2900081 50 I = KLIDX (KEYTYP) G2900082 KEYLNG = FCB(I) G2900083 IF (KEYLNG .EQ. 0) GO TO 100 G2900084 ITYPE = KEYTYP G2900085C --EXTRACT KEY FROM RECORD G2900086 CALL XTKEY (FCB, RECBUF) G2900087C --DELETE KIS G2900088 CALL DELKIS G2900089C --MAY HAVE MM ERROR OR KID ERROR. G2900090C --LEAVE IF MM ERROR. KEEP TRYING IF KID ERROR. G2900091 IF (MMIOER .EQ. 1) GO TO 900 G2900092ÐÐ 100 KEYTYP = KEYTYP + I3 G2900093 IF (KEYTYP .GT. 0 .AND. G2900094 1 KEYTYP .LT. 5) GO TO 50 G2900095 200 CONTINUE G29000962 G2900097C --MARK THE RECORD AS DELETED G2900098 CALL WRTDEL G29000995 G2900100 900 ISTAT = REQSTA G29001012 G2900102 PREID = FCB(1) G2900103 PRETYP = ITYPE G2900104C --RETURN TO FM EXEC G2900105 CALL FMSCOM G2900106 RETURN G2900107 END G2900108 SUBROUTINE DELKIS G3000001 1 /G30 F ITOS CCS 3.0 SL-149G3000002C DELETE A KEY INFO SEGMENT FROM A KEY INFO DIRECTORY G3000003C CREDIT COLLECTION SYSTEM VERSION 3.0 G3000004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G3000005C COPYRIGHT CONTROL DATA CORPORATION 1979 G3000006C G3000007C G30000085 G3000009ÐÐC*** G3000010C THIS SUBROUTINE DELETES A KIS (FOR A SPECIFIC KEY) FROM G3000011C THE KEY INFORMATION STRUCTURE G3000012C G3000013C G3000014C INPUT : G3000015C KEY TYPE (KEYTYP) G3000016C KEY VALUE FOR THE KIS (KEYVAL) G3000017C RELATIVE RECORD NUMBER(RRDATA) G3000018C KEY LENGTH IN BYTES (KEYLNG) G3000019C ALL DATA IN COMMON G3000020C PREVIOUS KEY TYPE (PRETYP) G3000021C CURRENT KEY TYPE (KEYTYP) G3000022C PREVIOUS FILE ID (PREID) G3000023C CURRENT FILE ID (FILE ID) G3000024C G3000025C PROCESS: G3000026C CHECK FOR SPECIAL CASE (KIB IN KIBBUF) G3000027C LOOKS FOR THE KIS SPECIFIED BY THE DATA G3000028C DELETES IT FROM THE KIB BY DECREMENTING THE NO. OF KIS G3000029C BY ONE AND MOVING ALL LATER KISES ONE FORWARD. G3000030C IF THE KIB BECOMES EMPTY THEN LOOK FOR THE KIS POINTING G3000031C TO THIS KIB AND REMOVE IT. G3000032C IF THE KIB IS NOT EMPTY BUT KIS REMOVED IS THE LAST ONE, THEN G3000033C THE KIB POINTING TO THIS KIB (THE FATHER KIB) HAS TO BE UP- G3000034ÐÐC DATED TO POINTING TO THE 'NEW' LAST KIS. G3000035C G3000036C EXIT: G3000037C RETURNS TO CALLER G3000038C IF THERE IS MASS MEMORY ERROR OR KEY INFO STRUCTURE IS G3000039C BAD, THE ERROR CONDITIONS WILL BE NOTED IN THE STATUS G3000040C WORD. G3000041C G3000042CE G3000043C THE FOLLOWING SUBROUTINES ARE USED BY DELKIS G3000044C CMPSTG - COMPARES TWO STRINGS OF CHARACTER G3000045C FWAKIS - FIRST WORD OF A KIS IN A KIB G3000046C POSKID - POSITION INTO A KEY INFORMATION DIRECTORY G3000047C RDKIB - READ A KIB INTO MAIN MEMORY G3000048C UDFKIB - UPDATE KEY INFO BLOCK ONE LEVEL UP G3000049C WRTKIB - WRITE A KIB TO MASS MEMORY G30000505 G3000051C FOR A DEFINITION OF FMCOM, SEE MACRO FMCOM G3000052M FMCOM G3000053C FOR A DEFINITION OF FMCOM2, SEE MACRO FMCOM2 G3000054M FMCOM2 G3000055 INTEGER SPCRKB(2) G3000056 INTEGER SPECAS G3000057 INTEGER OLDNUM (2) G3000058 INTEGER RRLOCL (2) G3000059ÐÐ INTEGER TOTKIS G3000060C FOR DESCRIPTION OF VARIABLES, SEE MACRO FMCOM3G3000061C*** G30000622 G3000063C PREID - PREVIOUS PSEUDO-FILE ID USED (COMMON) G3000064C PRETYP - PREVIOUS KEY TYPE (COMMON) G30000652 G3000066. G3000067C INIT NEW KIB FLAG TO FALSE G3000068 NEWBUF = 0 G3000069C -- LENGTH OF KEY IN WORD G3000070 KEYLWD = (KEYLNG+1)/2 G3000071 KISLNG = KEYLWD + 2 G30000722 G3000073C --SAVE RELATIVE RECORD NUMBER G3000074 RRLOCL (1) = RRDATA (1) G3000075 RRLOCL (2) = RRDATA (2) G30000762 G3000077C------------------------------------------- G3000078C SPECIAL CASE IS: SAME FILE AND KEY TYPE AS PREVIOUS, G3000079C PREVIOUS PROCESSOR WAS AN INDEXED PROC., G3000080C AND SEQUENCE SET IS IN MEMORY. G3000081C------------------------------------------- G3000082 CALL SPECAL(SPECAS) G3000083 IF (I .EQ. 0) GO TO 400 G3000084ÐÐ1 G3000085C -- SPECIAL CASE: SCAN KIB FOR KEY/RRN TO DELETE G30000861 G3000087 TOTKIS = KIBBUF (NUMKIS) G3000088 DO 300 KISIDX = 1, TOTKIS G3000089 I = FWAKIS (KISIDX) G3000090 I2 = CMPSTG (KIBBUF(I), KEYVAL, KEYLWD) G3000091 IF (I2 .EQ. 0) GO TO 350 G3000092 300 CONTINUE G3000093 GO TO 400 G30000941 G3000095C -- KEY FOUND : CHECK RRN G3000096 350 J = I + KEYLWD G3000097 IF (KIBBUF(J) .NE. RRDATA(1) .OR. G3000098 1 KIBBUF(J+1) .NE. RRDATA(2)) GO TO 300 G30000991 G3000100C -- THIS IS THE ONE G3000101 GO TO 450 G30001022 G3000103 400 CONTINUE G3000104C -- NOT SPECIAL CASE: G3000105C --POSITION INTO KEY INFORMATION STRUCTURE G3000106 CALL POSKID G3000107 IF (REQSTA .LT. 0) GO TO 1000 G3000108 IF (KISFND.EQ. 0) GO TO 999 G3000109ÐÐ1 G3000110C -- E R A S E K I S F R O M K I B -- G3000111 450 CONTINUE G3000112C --DECREMENT THE NUMBER OF KISES IN THIS KIB BY ONE G3000113 KIBBUF(NUMKIS) = KIBBUF(NUMKIS) - 1 G3000114 IF (KIBBUF(NUMKIS) .NE.0) GO TO 700 G3000115. G3000116C -- ALL KISES ARE REMOVED FROM THIS KIB G3000117C -- LET IT BE LINKED BUT REMOVE THE KIS POINTING TO IT. G3000118C -- THE KIS IS IN A LEVEL HIGHER KIB G3000119C G3000120 CALL WRTKIB G3000121 IF (REQSTA .LT. 0) GO TO 1000 G3000122C G3000123C --SAVE KIB NUMBER OF THIS ONE G3000124 OLDNUM (1) = RKIBNO (1) G3000125 OLDNUM (2) = RKIBNO (2) G3000126C G3000127C --KIB OF A LEVEL HIGHER G3000128 RKIBNO (1) = KIBBUF (PKIBNM) G3000129 RKIBNO (2) = KIBBUF (PKIBNL) G3000130C G3000131C --IF PREVIOUS KIB DOES NOT EXIST, THEN WE ARE AT ROOT G3000132C --THE KEY INFORMATION STRUCTURE IS EMPTY G3000133 IF (CMPSTG (RKIBNO,ZERO2,2) .EQ. 0) GO TO 1000 G3000134ÐÐ CALL RDKIB G3000135 IF (REQSTA .LT. 0) GO TO 1000 G30001363 G3000137C --LOOK FOR THE CORRECT KIS WITHIN THIS KIB G30001381 G3000139C --GO THRU EACH KIS AND LOOK FOR THE ONE POINTING TO THE OLD KIB G3000140 TOTKIS = KIBBUF (NUMKIS) G3000141 KISIDX = 1 G3000142 500 CONTINUE G30001431 G3000144C --EXHAUST ALL KISES IN THIS KIB G3000145 IF (KISIDX .GT. TOTKIS) GO TO 999 G30001462 G3000147 J = FWAKIS(KISIDX) + KEYLWD G3000148C --LOOK FOR THE POINTER TO THE NUMBER OF OLDKIB G3000149 IF (CMPSTG(OLDNUM,KIBBUF(J),2) .EQ. 0) GO TO 450 G30001502 G3000151C --HAVE NOT FOUND THE CORRECT ONE, MOVE ON TO NEXT KIS G3000152 KISIDX = KISIDX + 1 G3000153 GO TO 500 G3000154. G3000155 700 CONTINUE G3000156C G3000157C --THIS IS THE L A S T KIB AFFECTED BY THIS DELETION G3000158C G3000159ÐÐ TOTKIS = KIBBUF (NUMKIS) G3000160C -- IF KISIDX GT TOTKIS, KIS IS LARGEST IN KIB, G3000161C -- FATHER KIB NEEDS UPDATAING G3000162 IF (KISIDX .GT. TOTKIS) GO TO 850 G3000163C G3000164C --MOVE ALL KISES,AFTER THE ONE TO BE REMOVED, ONE KIS LOCATION G3000165C --FORWARD WITHIN THE KIB G3000166 J = (TOTKIS-KISIDX+1) * KISLNG G3000167 I1 = FWAKIS (KISIDX) G3000168 I2 = I1 + KISLNG G3000169 DO 800 I = 1,J G3000170 KIBBUF(I1) = KIBBUF(I2) G3000171 I1 = I1 + 1 G3000172 I2 = I2 + 1 G3000173 800 CONTINUE G30001742 G3000175 CALL WRTKIB G3000176 GO TO 1000 G3000177. G3000178C E M P T Y K I B - L A S T K I S D E L E T E D G3000179C G3000180C NEED TO UPDATE FATHER KIB WHICH POINTS TO THIS KIB G3000181C G3000182 850 CONTINUE G3000183 CALL WRTKIB G3000184ÐÐ IF (REQSTA .LT. 0) GO TO 1000 G3000185 I1 = FWAKIS (KISIDX) G3000186 J = I1 - KISLNG G3000187C G3000188 DO 860 I = 1,KEYLWD G3000189C --KEY TO BE DELETED (FROM) G3000190 KISD (I) = KIBBUF (I1) G3000191C --KEY TO BE ADDED (CHANGED TO) G3000192 KISA (I) = KIBBUF (J ) G3000193 I1 = I1 + 1 G3000194 J = J + 1 G3000195 860 CONTINUE G3000196C --UPDATE FATHER ROUTINE G3000197 IF (SPECAS .EQ. 0) GO TO 910 G3000198 DO 900 I = 1,2 G3000199 900 SPCRKB(I) = RKIBNO(I) G3000200 910 CONTINUE G3000201 CALL UDFKIB G3000202 IF (SPECAS .EQ. 0) GO TO 1000 G3000203 DO 930 I = 1,2 G3000204 930 RKIBNO(I) = SPCRKB(I) G3000205 CALL RDKIB G3000206 IF (REQSTA .LT. 0) GO TO 1000 G3000207C G3000208C --ALL DONE G3000209ÐÐ GO TO 1000 G30002105 G3000211C -- F A T A L ERROR G3000212 999 CONTINUE G3000213 KIDERR = 1 G3000214 ERRIDC = 1 G30002155 G3000216 1000 CONTINUE G3000217 RRDATA(1) = RRLOCL(1) G3000218 RRDATA(2) = RRLOCL(2) G3000219 RETURN G3000220 END G3000221 SUBROUTINE UDFKIB G3100001 1 /G31 F ITOS CCS 3.0 SL-149G3100002C UPDATE KEY INFO BLOCK ONE LEVEL UP G3100003C CREDIT COLLECTION SYSTEM VERSION 3.0 G3100004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G3100005C COPYRIGHT CONTROL DATA CORPORATION 1979 G3100006C G3100007C G3100008C*** A NON-SEQUENCE SET KIB POINTS TO THE NEXT LOWER LEVEL G3100009C KIB'S (SON KIB'S) BY HAVING THE LARGEST KEYS IN THE G3100010C SON KIB'S AS PART OF THE KIS'S. IF THE LARGEST KEY G3100011C IN A NON-ROOT KIB HAS BEEN CHANGED, BECAUSE OF A G3100012C DELETION OR ADDITION, THE KIS IN THE FATHER KIB HAS G3100013ÐÐC TO BE CHANGED TO REFLECT THE CHANGE. G3100014C G3100015C INPUT KEY TO BE ADDED (KEYA) G3100016C KEY TO BE DELETED (KEYD) G3100017C KEY LENGTH IN WORD (KEYLWD) G3100018C KIB OF THE FIRST LEVEL SON (KIBBUF) G3100019C RELATIVE KIB NUMBER OF FIRST LEVEL SON (RKIBNO) G3100020C G3100021C G3100022C PROCESS: G3100023C IF THE KEY TO BE ADDED AND THE ONE TO BE DELETED IS G3100024C THE SAME, THEN DO NOT NEED TO UPDATE ANY KIB. G3100025C G3100026C OTHERWISE, READ IN FATHER KIB (ITS RELATIVE KIB G3100027C NUMBER IS IN THE HEADER OF THE LOWER LEVEL KIB). G3100028C SEARCH THROUGH THE KISES OF THE FATHER KIB AND LOOK G3100029C FOR THE KIS THAT IS POINTING TO THE SON KIB (I.E., G3100030C KEY TO BE DELETED AND RELATIVE KIB NUMBER OF SON G3100031C KIB). G3100032C G3100033C WHEN THE KIS IS FOUND, THEN CHANGE THE KEY TO THE G3100034C KEY TO BE ADDED. THERE IS NO NEED TO CHANGE THE G3100035C RELATIVE KIB NUMBER SINCE IT IS THE SAME. G3100036C G3100037C IF THE KIS THAT WAS MODIFIED IS THE LARGEST KEY IN G3100038ÐÐC THE KIB, THEN THE SAME PROCEDURE HAS TO BE DONE TO G3100039C ITS FATHER KIB. G3100040CE G3100041C THE PROCEDURE STOPS WHEN THE ROOT HAS ARRIVED (THE G3100042C RELATIVE KIB NUMBER FOR THE FATHER IS ZERO) OR THE G3100043C KIS BEING CHANGED IS NOT THE LARGEST ONE IN THE KIB. G3100044C G3100045C G3100046C OUTPUT: G3100047C ALL THE FATHER KIB'S THAT WERE AFFECTED WOULD BE G3100048C MODIFIED AND STORED BACK ON MASS MEMORY. G3100049C G3100050C G3100051C THE FOLLOWING SUBROUTINES ARE USED BY UDFKIB G3100052C CMPSTG - COMPARE TWO CHARACTER STRINGS G3100053C FWAKIS - FIRST WORD OF A KIS IN A KIB G3100054C RDKIB - READ A KIB INTO MAIN MEMORY G3100055C WRTKIB - WRITE A KIB TO MASS MEMORY G3100056M FMCOM G3100057C FOR A DEFINITION OF FMCOM2, SEE MACRO FMCOM2 G3100058M FMCOM2 G3100059 INTEGER BGKIS G3100060 INTEGER MORE G3100061 INTEGER OLDNUM(2) G3100062 INTEGER TOTKIS G3100063ÐÐC FOR DESCRIPTION OF VARIABLES, SEE MACRO FMCOM3G3100064C*** G3100065. G3100066C --NO NEED TO DO ANYTHING IF THE KEYS ARE THE SAME G3100067 IF (CMPSTG (KISA, KISD, KEYLWD) .EQ. 0) GO TO 900 G31000682 G3100069 MORE = 1 G3100070C --WHILE THERE ARE MORE FATHER KIB TO UPDATE DO G3100071 100 IF (MORE .EQ. 0) GO TO 900 G3100072C --SAVE RELATIVE KIB NUMBER OF THIS KIB G3100073 MORE = 0 G3100074 OLDNUM(1) = RKIBNO(1) G3100075 OLDNUM(2) = RKIBNO(2) G3100076C --POINTER TO FATHER KIB G3100077 RKIBNO(1) = KIBBUF (PKIBNM) G3100078 RKIBNO(2) = KIBBUF (PKIBNL) G31000792 G3100080C --BACK UP TO ROOT G3100081 IF (CMPSTG (RKIBNO,ZERO2,2) .EQ. 0) GO TO 600 G31000822 G3100083C --READ IN FATHER G3100084 CALL RDKIB G3100085 IF (REQSTA .LT. 0) GO TO 800 G31000861 G3100087 TOTKIS = KIBBUF (NUMKIS) G3100088ÐÐ KISIDX = 1 G3100089 200 CONTINUE G3100090C --LOOK FOR THE KIS POINTING TO THE SON KIB G31000911 G3100092C --FATAL ERROR IF EXHAUST ALL KISES G3100093 IF (KISIDX .GT. TOTKIS) GO TO 800 G3100094 BGKIS = FWAKIS (KISIDX) G3100095C --COMPARE EACH KEY IN THE KIB WITH KEY TO BE DELETED G3100096 IF (CMPSTG(KIBBUF(BGKIS) , KISD, KEYLWD) ) 400,300,800 G31000972 G3100098C --THE KEYS ARE CORRECT, CHECK IF POINTING TO SON G3100099 300 J = BGKIS + KEYLWD G3100100 IF (CMPSTG (OLDNUM,KIBBUF(J),2) .EQ. 0 ) GO TO 500 G3100101 400 KISIDX = KISIDX + 1 G3100102C --HAVE NOT FOUND CORRECT ONE, NEED TO GO TO NEXT KIS G3100103 GO TO 200 G31001045 G3100105 500 CONTINUE G3100106C --FOUND THE KIS G3100107C --CHANGE THE KEY PART TO KEYA G3100108 J = BGKIS G3100109 DO 550 I = 1,KEYLWD G3100110 KIBBUF(J) = KISA(I) G3100111 J = J+1 G3100112 550 CONTINUE G3100113ÐÐ CALL WRTKIB G31001142 G3100115C --NEED TO UPDATE FATHER, IF THIS IS THE LAST KIS IN THE KIB G3100116 IF (KISIDX .EQ. TOTKIS) MORE = 1 G3100117C --ENDWHILE G3100118 600 GO TO 100 G31001195 G3100120 800 CONTINUE G3100121C --E R R O R CANNOT FIND THE KIS POINTING TO SON G3100122 KIDERR = 1 G3100123 ERRIDC = 1 G31001244 G3100125 900 CONTINUE G3100126 RETURN G3100127 END G3100128 SUBROUTINE COMIDX (FCB, REQBUF, RECBUF, ISTAT) G3200001 1 /G32 F ITOS CCS 3.0 SL-149G3200002C FILE MANAGER COMPRESS FILE PROCESSOR - INDEXED FILE G3200003C CREDIT COLLECTION SYSTEM VERSION 3.0 G3200004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G3200005C COPYRIGHT CONTROL DATA CORPORATION 1979 G3200006C G3200007C G3200008C G3200009C G3200010ÐÐC*** G3200011C COMIDX IS THE PROCESSOR FOR COMPRESSING AN INDEXED FILE. G3200012C G3200013C THE COMFIL REQUEST HAS THE FOLLOWING CALLING SEQUENCE : G3200014C G3200015C CALL COMFIL (REQBUF, RECBUF, ISTAT) G3200016C G3200017C G3200018C WHERE REQBUF IS THE FILE REQUEST BUFFER G3200019C RECBUF IS THE BUFFER WHERE RECORD IS READ IN G3200020C BY THE FILE MANAGER, ONLY ONE RECORD G3200021C CAN BE COMPRESSED AT EACH CALL FOR G3200022C AN INDEXED FILE G3200023C ISTAT IS THE REQUEST STATUS WORD G3200024C G3200025C G3200026C G3200027C INPUT: G3200028C THE FILE MANAGER EXEC TRANSFERS CONTROL TO COMIDX G3200029C AFTER BRINGING IT INTO PARTITION 1. G3200030C FMEXEC ALSO ZERO'S THE FIRST KIB (ROOT). G3200031C G3200032C G3200033C PROCESS: G3200034C COMIDX PICKS UP ALL REVELENT INFORMATION FROM THE FCB. G3200035ÐÐC G3200036C COMPRESS RECORD ON DATA AREA- MAIN MEMORY RESIDENT G3200037C ROUTINE, COMSEQ. G3200038C AT MOST ONE NEW RECORD IS COMPRESSED PER CALL FOR G3200039C AN INDEXED FILE. G3200040CE G3200041C REQBUF(11) CONTAINS THE NUMBER OF RECORDS COMPRESSED. G3200042C IF IT IS ZERO, THEN THERE IS NOTHING TO DO. G3200043C IF NOT, THE RECORD IS IN BUFFER RECBUF AND ITS G3200044C RELATIVE RECORD NUMBER IS IN REQBUF(19) AND REQBUF(20). G3200045C G3200046C FOR EVERY KEY DEFINED FOR THIS FILE, THE KEY IS G3200047C EXTRACTED FROM THE RECORD AND THE KEY INFO DIRECTORY G3200048C IS UPDATED TO REFLECT THE ADDITION. G3200049C G3200050C THE FCB IS UPDATED ON MASS MEMORY TO REFLECT THE G3200051C NEW ADDITIONS AFTER A CERTAIN NUMBER OF RECORDS HAVE G3200052C BEEN COMPRESSED. G3200053C G3200054C G3200055C EXIT: G3200056C COMIDX RETURNS TO THE FILE MANAGER EXEC VIA FMSCOM G3200057C G3200058C G3200059C THE FOLLOWING SUBROUTINES ARE USED BY COMIDX G3200060ÐÐC ADDKIS - ADD A KEY INFO SEGMENT INTO A KEY INFO G3200061C DIRECTORY G3200062C CKUFCB - UPDATE FCB ON MASS MEMORY G3200063C COMREC - COMPRESS A RECORD ON MASS MEMORY G3200064C CPUTKL - COMPUTE LENGTH OF A KEY INFO BLOCK G3200065C FMSCOM FM EXEC SERIAL PROCESSOR COMPLETION ROUTINE G3200066C XTKEY - EXTRACT KEY FROM RECORD G3200067C G3200068. G3200069C FOR A DEFINITION OF FMCOM, SEE MACRO FMCOM G3200070M FMCOM G3200071. G3200072C FOR A DEFINITION OF FMCOM2, SEE MACRO FMCOM2 G3200073M FMCOM2 G3200074 INTEGER FCB(1) G3200075 INTEGER RECBUF(1) G3200076 INTEGER REQBUF(1) G3200077C FOR DESCRIPTION OF VARIABLES, SEE MACRO FMCOM3G3200078C FOR A DEFINITION OF INIDAT, SEE MACRO INIDAT G3200079C*** G3200080. G3200081C DO NOT CLEAR COMMON - PASSED INFORMATION G3200082M FMINIT G3200083. G3200084C --PUT EOF SYMBOL AT END OF KIB BUFFER G3200085ÐÐC --THIS IS FOR RECOVERY OF KIB , IN CASE THE SYSTEM CRASHED G3200086C G3200087C LDA =XFMEOFC GET SYMBOL FOR EOF G3200088C STA+ KIBE1 STORE AT END OF KIBBUF G3200089C G3200090 ASSEM $C000, FMEOFC, $ 6400, +KIBE1 G3200091C G3200092 KIBBUF(KIBLEN+1) = KIBE1 G3200093 KIBBUF(KIBLEN+2) = KIBE1 G32000942 G3200095C --CALL COMPRESS SEQUENTIAL FILE AS A SUBROUTINE TO COMPRESS G3200096C --DATA RECORDS G3200097 CALL COMREC G3200098C --FATAL ERROR FOUND G3200099 IF (REQSTA .LT. 0) GO TO 900 G3200100C --SKIP IF NO GOOD RECORD WAS FOUND. NO NEED TO UPDATE KEY INFO G3200101 IF (REQBUF(11) .EQ. 0) GO TO 900 G32001022 G3200103C --ONE GOOD RECORD WAS FOUND G3200104C --RELATIVE RECORD NO. IS IN REQBUF G3200105 RRDATA(1) = REQBUF(19) G3200106 RRDATA(2) = REQBUF(20) G32001072 G3200108C -- SAVE PSEUDO FILE ID G3200109 FILEID = FCB(1) G3200110ÐÐC --UPDATE KEY INFO SECTION BY ADDING NEW KEYS FOR ALL G3200111C --KEY TYPES DEFINED FOR THIS FILE G3200112 KEYTYP = 1 G3200113 I3 = 1 G3200114 IF (PRETYP .LT. 1 .OR. PRETYP .GT. 4) GO TO 100 G3200115 KEYTYP = 4 G3200116 I3 = -1 G3200117 100 CONTINUE G3200118 I = KLIDX (KEYTYP) G3200119 KEYLNG = FCB (I) G3200120 IF (KEYLNG .EQ. 0) GO TO 200 G3200121 ITYPE = KEYTYP G3200122 CALL XTKEY (FCB,RECBUF) G3200123 CALL ADDKIS G3200124 IF (REQSTA .LT. 0 ) GO TO 900 G3200125 200 KEYTYP = KEYTYP + I3 G3200126 IF (KEYTYP .GT. 0 .AND. KEYTYP .LT. 5) GO TO 100 G3200127 300 CONTINUE G3200128. G3200129C --SEE IF NEED TO UPDATE FCB ON MM G3200130 CALL CKUFCB G32001313 G3200132 900 CONTINUE G3200133C --ALL DONE G3200134 PREID = FCB(1) G3200135ÐÐ PRETYP = ITYPE G3200136 ISTAT = REQSTA G3200137C --RETURN TO FM EXEC G3200138 CALL FMSCOM G3200139 RETURN G3200140 END G3200141 SUBROUTINE MASALC G3300001 1 /G33 F ITOS CCS 3.0 SL-149G3300002C G3300003C CREDIT COLLECTION SYSTEM VERSION 3.0 G3300004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G3300005C COPYRIGHT CONTROL DATA CORPORATION 1979 G3300006C G3300007C ALLOCATE MASS MEMORY SECONDARY PROCESSOR G3300008C*** G3300009C G3300010C THE FOLLOWING SUBROUTINES ARE USED BY MASALC G3300011C MOVE MOVE WORDS FOR ALLOCATE/RELEASE PROCESSORS G3300012C FDWADD DOUBLE WORD ADD - FORTRAN INTERFACE G3300013C MREADF READ MASS MEMORY - FTN INTERFACE TO MMREAD G3300014C FDWSUB DOUBLE WORD SUBTRACT - FORTRAN INTERFACE G3300015C CHLGBL CHECK CURRENT DIRECTORY BLOCK FOR LARGST ENTRYG3300016C MWRITF WRITE MASS MEMORY - FTN INTERFACE TO MMWRIT G3300017C FMSWAP FM EXEC SWAP PROCESSORS ROUTINE G3300018C G3300019ÐÐC FOR A DEFINITION OF COMMON, SEE MACRO COMMON G3300020M COMMON G33000213 G3300022 EXTERNAL YERTO,MONTO,DAYTO,HORMIN G3300023 INTEGER RQSIZE(2),DIRSEC(2),LGBLOK(2),SECADD(2) G3300024 INTEGER SECSIZ,DIRSIZ G3300025 EQUIVALENCE (DIRSEC,VIT(9)),(LGBLOK,VIT(12)),(SECSIZ,VIT(14)) G3300026 EQUIVALENCE (DIRSIZ,VIT(11)) G3300027 INTEGER VINFDB G3300028 EQUIVALENCE (VINFDB,VIT(19)) G3300029 INTEGER DIRENT(4,1),AVSIZE(4,1),AVSECT(4,1) G3300030 EQUIVALENCE (DIRENT(1,1),BUF) G3300031 EQUIVALENCE (AVSIZE(1,1),DIRENT(1,1)) G3300032 EQUIVALENCE (AVSECT(1,1),DIRENT(3,1)) G3300033 INTEGER DREC(2) G3300034 DATA DREC/0,1/ G3300035 INTEGER AFLAG,CFLAG,EFLAG G3300036 INTEGER ZERO(2),ONE(2) G3300037 DATA ZERO,ONE/0,0,0,1/ G3300038 INTEGER HDRBLK(13) G3300039 DATA HDRBLK(1)/'AL'/ G3300040 EQUIVALENCE (RQSIZE,HDRBLK(2)),(SECADD,HDRBLK(4)) G3300041 DIMENSION ITEMP(2) G3300042 INTEGER ADDERR,NOSPAC G3300043 DATA ADDERR,NOSPAC/$C000,$9000/ G3300044ÐÐ INTEGER SYOWNR(4) G3300045 DATA SYOWNR/'$$ '/ G3300046C*** G3300047. G3300048* PUT DATE, TIME AND USER ID INTO HEADER BLOCK G33000491 G3300050 ASSEM $C400,+YERTO ,$6400,+HDRBLK(6) G3300051 ASSEM $C400,+MONTO ,$6400,+HDRBLK(7) G3300052 ASSEM $C400,+DAYTO ,$6400,+HDRBLK(8) G3300053 ASSEM $C400,+HORMIN,$6400,+HDRBLK(9) G33000541 G3300055 IF(VINFDB.NE.0) GO TO 10 G3300056 CALL MOVE (4,SYOWNR,HDRBLK(9)) G3300057 GO TO 20 G33000581 G3300059 10 ASSEM $E400,+PCTABL G3300060+ LDQ+ PCTABL G3300061 ASSEM $E20B G3300062+ LDQ- 11,Q G3300063 ASSEM $C204 G3300064+ LDA- 4,Q G3300065 ASSEM $6400,+HDRBLK(10) G3300066+ STA+ HDRBLK(10) G3300067 ASSEM $C205 G3300068+ LDA- 5,Q G3300069ÐÐ ASSEM $6400,+HDRBLK(11) G3300070+ STA+ HDRBLK(11) G3300071 ASSEM $C206 G3300072+ LDA- 6,Q G3300073 ASSEM $6400,+HDRBLK(12) G3300074+ STA+ HDRBLK(12) G3300075 ASSEM $C207 G3300076+ LDA- 7,Q G3300077 ASSEM $6400,+HDRBLK(13) G3300078+ STA+ HDRBLK(13) G33000792 G3300080* PICK UP REQUESTED # SECTORS FROM BUF(1),BUF(2) G3300081* ADD 1 TO REQUESTED SIZE TO ALLOW FOR HEADER BLOCK G33000821 G3300083 20 CALL FDWADD(BUF,ONE,RQSIZE,IOV) G33000842 G3300085* COMPUTE # OF DIRECTORY ENTRYS PER SECTOR G33000861 G3300087 NUMENT=SECSIZ/4 G33000882 G3300089* CLEAR LARGEST AVAILABLE SECTOR IN VIT G33000901 G3300091 CALL MOVE(2,ZERO,LGBLOK) G33000922 G3300093* INITIALIZE FLAGS AND POINTERS G3300094ÐÐ1 G3300095 CFLAG=0 G3300096 AFLAG=0 G3300097 EFLAG=0 G3300098. G3300099* READ OVER DIRECTORY SEGMENT G33001001 G3300101 100 CALL MREADF(DIRSEC,DREC,SECSIZ,SECSIZ,0,BUF,0,STATUS) G3300102 IF (STATUS.LT.0) GO TO 9000 G33001031 G3300104* SCAN ALL ENTRYS IN THIS SEGMENT G33001051 G3300106 200 DO 290 I=1,NUMENT G33001072 G3300108* IS THIS ENTRY THE END OF THE DIRECTORY? G33001091 G3300110 IF(DIRENT(1,I).NE.-1) GO TO 210 G3300111 EFLAG=1 G3300112 GO TO 300 G33001132 G3300114* IF SPACE HAS NOT BEEN ALLOCATED, ATTEMPT TO DO IT FROM THIS ENTRY G33001151 G3300116 210 IF(AFLAG.EQ.1) GO TO 220 G3300117 CALL FDWSUB(AVSIZE(1,I),RQSIZE,ITEMP,IOV) G3300118 IF(IOV.EQ.1) GO TO 220 G3300119ÐÐ CALL MOVE(2,AVSECT(1,I),SECADD) G3300120 CALL FDWADD(AVSECT(1,I),RQSIZE,AVSECT(1,I),IOV) G3300121 CALL MOVE(2,ITEMP,AVSIZE(1,I)) G3300122 AFLAG=1 G3300123 CFLAG=1 G33001242 G3300125* CHECK FOR NEW LARGEST BLOCK G33001261 G3300127 220 CALL CKLGBL(AVSIZE(1,I)) G33001282 G3300129* IF THERE ARE MORE ENTRYS IN THIS SEGMENT, STEP TO NEXT ONE G33001301 G3300131 290 CONTINUE G33001322 G3300133* IF DIRECTORY SEGMENT WAS UPDATED, WRITE IT BACK G33001341 G3300135 300 IF (CFLAG.EQ.0) GO TO 310 G3300136 CALL MWRITF(DIRSEC,DREC,SECSIZ,SECSIZ,0,BUF,0,STATUS) G3300137 IF(STATUS.LT.0) GO TO 9000 G3300138 CFLAG=0 G33001392 G3300140* IF NOT AT END OF DIRECTORY,STEP TO NEXT SEGMENT G33001411 G3300142 310 IF(EFLAG.EQ.1) GO TO 400 G3300143 DREC(2)=DREC(2)+1 G3300144ÐÐ IF(DREC(2).GT.DIRSIZ) GO TO 8010 G3300145 GO TO 100 G3300146. G3300147* IF SPACE HAS NOT BEEN ALLOCATED BY NOW, WE DON'T HAVE ANY G33001481 G3300149 400 IF(AFLAG.EQ.0) GO TO 8000 G3300150* WRITE OUT HEADER BLOCK G33001511 G3300152 CALL MWRITF(SECADD,ONE,13,13,0,HDRBLK,0,STATUS) G3300153 IF (STATUS.LT.0) GO TO 9000 G33001542 G3300155* CORRECT SECADD AND MOVE TO BUF FOR RETURN G33001561 G3300157 CALL FDWADD(SECADD,ONE,BUF,IOV) G3300158 STATUS=0 G3300159 GO TO 9000 G33001602 G3300161* IF(AVSIZE(1,I).GT.LGBLOK) LGBLOK=AVSIZE(1,I) G33001621 G3300163 7000 CALL FDWSUB(LGBLOK,AVSIZE(1,I),ITEMP,IOV) G3300164 IF(IOV.EQ.1) CALL MOVE(2,AVSIZE(1,I),LGBLOK) G3300165 GO TO IRTN G33001662 G3300167* NO SPACE AVAILABLE G33001681 G3300169ÐÐ 8000 STATUS=AND(STATUS,-NOSPAC)+NOSPAC G3300170 GO TO 9000 G33001712 G3300172* NO END OF DIRECTORY WITHIN 'DIRSIZ' SECTORS. GIVE ADDRESS ERROR. G33001731 G3300174 8010 STATUS=AND(STATUS,-ADDERR)+ADDERR G3300175 GO TO 9000 G33001762 G3300177* SET Q NEGATIVE TO READ CALLER BACK IN AND RETURN G33001781 G3300179 9000 ASSEM $CFE G3300180 CALL FMSWAP G33001811 G3300182 END G3300183 SUBROUTINE CKLGBL(NSEC) G3400001 1 /G34 F ITOS CCS 3.0 SL-149G3400002C CHECK CURRENT DIRECTORY BLOCK FOR LARGEST ENTRY G3400003C CREDIT COLLECTION SYSTEM VERSION 3.0 G3400004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G3400005C COPYRIGHT CONTROL DATA CORPORATION 1979 G3400006C G3400007C G3400008C*** G3400009C G3400010C THE FOLLOWING SUBROUTINES ARE USED BY CKLGBL G3400011ÐÐC MOVE MOVE WORDS FOR ALLOCATE/RELEASE PROCESSORS G3400012C FDWSUB DOUBLE WORD SUBTRACT - FORTRAN INTERFACE G3400013C G34000141 G3400015* IF(NSEC.GT.LGBLOK) LGBLOK=NSEC G34000163 G3400017C FOR A DEFINITION OF COMMON, SEE MACRO COMMON G3400018M COMMON G3400019C*** G34000203 G3400021 DIMENSION NSEC(2),LGBLOK(2),ITEMP(2) G3400022 EQUIVALENCE (LGBLOK,VIT(12)) G34000233 G3400024 CALL FDWSUB(LGBLOK,NSEC,ITEMP,IOV) G3400025 IF(IOV.EQ.1) CALL MOVE(2,NSEC,LGBLOK) G3400026 RETURN G3400027 END G3400028 SUBROUTINE MOVE (N,FROM,TO) G3500001 1 /G35 F ITOS CCS 3.0 SL-149G3500002C MOVE WORDS ROUTINE FOR ALLOCATE/RELEASE MASS MEM PROCESSORS G3500003C CREDIT COLLECTION SYSTEM VERSION 3.0 G3500004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G3500005C COPYRIGHT CONTROL DATA CORPORATION 1979 G3500006C G3500007C G3500008ÐÐC*** G3500009* MOVES N WORDS FROM 'FROM' TO 'TO' G3500010C G3500011C CALL SEQUENCE: G3500012C CALL MOVE (N,FROM,TO) G3500013C G3500014C WHERE: N = NUMBER OF WORDS TO BE MOVED G3500015C FROM IS SOURCE BUFFER G3500016C TO IS DESTINATION BUFFER G3500017C*** G35000183 G3500019 INTEGER FROM(1),TO(1) G3500020 DO 10 I=1,N G3500021 10 TO(I)=FROM(I) G3500022 RETURN G3500023 END G3500024 SUBROUTINE MASREL G3600001 1 /G36 F ITOS CCS 3.0 SL-149G3600002C RELEASE MASS MEMORY SECONDARY PROCESSOR G3600003C CREDIT COLLECTION SYSTEM VERSION 3.0 G3600004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G3600005C COPYRIGHT CONTROL DATA CORPORATION 1979 G3600006C G3600007C G3600008C*** G3600009ÐÐC G3600010C THE FOLLOWING SUBROUTINES ARE USED BY MASREL G3600011C GETENT GET NEXT MM SPACE DIRECTORY ENTRY G3600012C MOVE MOVE WORDS FOR ALLOCATE/RELEASE PROCESSORS G3600013C CHLGBL CHECK CURRENT DIRECTORY BLOCK FOR LARGST ENTRYG3600014C FDWADD DOUBLE WORD ADD - FORTRAN INTERFACE G3600015C MWRITF WRITE MASS MEMORY - FTN INTERFACE TO MMWRIT G3600016C FMSWAP FM EXEC SWAP PROCESSORS ROUTINE G3600017C G3600018C FOR A DEFINITION OF COMMON, SEE MACRO OPNCOM G3600019M COMMON G36000203 G3600021 INTEGER SECSIZ,DIRSEC(2) G3600022 EQUIVALENCE (SECSIZ,VIT(14)),(DIRSEC,VIT(9)) G3600023 INTEGER ENTRY(4,1),ENTSIZ(4,1),ENTSEC(4,1) G3600024 EQUIVALENCE (ENTRY(1,1),BUF) G3600025 EQUIVALENCE (ENTSIZ(1,1),ENTRY(1,1)) G3600026 EQUIVALENCE (ENTSEC(1,1),ENTRY(3,1)) G3600027 INTEGER BPTR,RFLAG,EFLAG G3600028 INTEGER HDRBLK(5) G3600029 INTEGER RETENT(4),NXTENT(4) G3600030 EQUIVALENCE (RETENT,HDRBLK(2)) G3600031 INTEGER RETSIZ(2),RETSEC(2),NXTSIZ(2),NXTSEC(2) G3600032 EQUIVALENCE (RETSIZ,RETENT),(RETSEC,RETENT(3)) G3600033 EQUIVALENCE (NXTSIZ,NXTENT),(NXTSEC,NXTENT(3)) G3600034ÐÐ INTEGER BADSEC G3600035 DATA BADSEC/$C000/ G3600036 INTEGER ZERO(2),ONE(2) G3600037 DATA ZERO,ONE/0,0,0,1/ G3600038 DIMENSION ITEMP(2) G3600039 INTEGER DREC(2) G3600040 DATA DREC/0,1/ G3600041C*** G3600042. G3600043* CORRECT PASSED SECTOR TO ALLOW FOR HEADER G36000441 G3600045 CALL FDWSUB(BUF,ONE,BUF,IOV) G36000462 G3600047* READ OVER HEADER BLOCK AND CHECK IT'S VALIDITY G36000481 G3600049 CALL MREADF(BUF,ONE,5,5,0,HDRBLK,0,STATUS) G3600050 IF(STATUS.LT.0) GO TO 9000 G3600051 IF(HDRBLK(1).NE.2HAL) GO TO 8000 G3600052 IF(RETSEC(1).NE.BUF(1).OR.RETSEC(2).NE.BUF(2)) GO TO 8000 G36000531 G3600054* INITIALIZE FOR DIRECTORY SCAN G3600055* G3600056 NUMENT=SECSIZ/4 G3600057 EFLAG=0 G3600058 RFLAG=0 G3600059ÐÐ CALL GETENT(NXTENT) G3600060. G3600061* BEGIN SCAN OF DIRECTORY SEGMENT G3600062* G3600063 100 BPTR=1 G36000641 G3600065* TEST FOR AND TRANSFER IF END OF DIRECTORY G3600066* G3600067 110 IF(NXTENT.NE.-1) GO TO 150 G3600068 IF(RFLAG.NE.0) GO TO 120 G3600069 CALL MOVE(4,RETENT,ENTRY(1,BPTR)) G3600070 CALL CKLGBL(ENTSIZ(1,BPTR)) G3600071 BPTR=BPTR+1 G3600072 120 ENTRY(1,BPTR)=-1 G3600073 EFLAG=1 G3600074 GO TO 320 G36000751 G3600076* IF RFLAG=0 MOVE EITHER NXTENT OR RETENT DEPENDING ON SECTOR G3600077* IF RFLAG=1 MOVE NXTENT G3600078* G3600079 150 IF(RFLAG.NE.0) GO TO 200 G3600080 CALL FDWSUB(NXTSEC,RETSEC,ITEMP,IOV) G3600081 IF(IOV.EQ.1) GO TO 200 G3600082 CALL MOVE(4,RETENT,ENTRY(1,BPTR)) G3600083 CALL CKLGBL(ENTSIZ(1,BPTR)) G3600084ÐÐ RFLAG=1 G3600085 GO TO 250 G3600086 200 CALL MOVE(4,NXTENT,ENTRY(1,BPTR)) G3600087 CALL GETENT(NXTENT) G36000881 G3600089* COMPUTE LAST SECTOR +1 OF PREVIOUS BLOCK G3600090* G3600091 250 IF(BPTR.EQ.1) GO TO 300 G3600092 BPTR=BPTR-1 G3600093 CALL FDWADD(ENTSIZ(1,BPTR),ENTSEC(1,BPTR),ITEMP,IOV) G3600094 BPTR=BPTR+1 G36000951 G3600096* CHECK FOR COMBINATION WITH CURRENT BLOCK G3600097* G3600098 IF(ITEMP(1).NE.ENTSEC(1,BPTR).OR.ITEMP(2).NE.ENTSEC(2,BPTR)) G3600099 * GO TO 300 G3600100 BPTR=BPTR-1 G3600101 CALL FDWADD(ENTSIZ(1,BPTR),ENTSIZ(1,BPTR+1),ENTSIZ(1,BPTR),IOV) G3600102 CALL CKLGBL(ENTSIZ(1,BPTR)) G36001031 G3600104* TEST FOR FULL BUFFER, WRITE IT OUT IF IT IS G3600105* G3600106 300 IF(BPTR.EQ.NUMENT) GO TO 320 G3600107 BPTR=BPTR+1 G3600108 GO TO 110 G3600109ÐÐ 320 CALL MWRITF(DIRSEC,DREC,SECSIZ,SECSIZ,0,BUF,0,STATUS) G3600110 IF(STATUS.LT.0) GO TO 9000 G3600111 DREC(2)=DREC(2)+1 G3600112 IF(EFLAG.EQ.0) GO TO 100 G3600113 GO TO 9000 G3600114. G3600115* ILLEGAL SECTOR ADDRESS ON RELEASE REQUEST G36001161 G3600117 8000 STATUS=AND(STATUS,-BADSEC)+BADSEC G3600118 GO TO 9000 G36001192 G3600120* SET Q NEGATIVE TO READ CALLER BACK IN AND RETURN G36001211 G3600122 9000 ASSEM $CFE G3600123 CALL FMSWAP G36001241 G3600125 END G3600126 SUBROUTINE GETENT(IBUF) G3700001 1 /G37 F ITOS CCS 3.0 SL-149G3700002C GET NEXT MASS MEMORY SPACE DIRECTORY ENTRY G3700003C CREDIT COLLECTION SYSTEM VERSION 3.0 G3700004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G3700005C COPYRIGHT CONTROL DATA CORPORATION 1979 G3700006C G3700007C G3700008ÐÐC*** G3700009CC G3700010C THE FOLLOWING SUBROUTINES ARE USED BY GETENT G3700011C MREADF READ MASS MEMORY - FTN INTERFACE TO MMREAD G3700012C MOVE MOVE WORDS FOR ALLOCATE/RELEASE PROCESSORS G3700013C FMSWAP FM EXEC SWAP PROCESSORS ROUTINE G3700014C G3700015C FOR A DEFINITION OF COMMON, SEE MACRO COMMON G3700016M COMMON G37000173 G3700018 INTEGER DIRSEC(2),SECSIZ,DIRSIZ G3700019 EQUIVALENCE (DIRSEC,VIT(9)),(SECSIZ,VIT(14)),(DIRSIZ,VIT(11)) G3700020 INTEGER DREC(2) G3700021 DATA DREC/0,0/ G3700022 INTEGER DBUF(572) G3700023 DATA IPTR/0/ G3700024 INTEGER DIRENT(4,1) G3700025 EQUIVALENCE (DIRENT(1,1),DBUF) G3700026 DIMENSION IBUF(4) G3700027C*** G3700028. G3700029* INITIALIZE G37000301 G3700031 NUMENT=SECSIZ/4 G37000322 G3700033ÐÐ* IF DBUF IS EMPTY, REFILL IT BEFORE CONTINUING G37000341 G3700035 IF(IPTR.NE.0) GO TO 100 G3700036 10 DREC(2)=DREC(2)+1 G3700037 CALL MREADF(DIRSEC,DREC,SECSIZ,SECSIZ,0,DBUF,0,STATUS) G3700038 IF(STATUS.LT.0) GO TO 9000 G3700039 IPTR=1 G37000402 G3700041* TEST FOR AN EMPTY ENTRY G37000421 G3700043 100 IF(DIRENT(1,IPTR).NE.0.OR.DIRENT(2,IPTR).NE.0) GO TO 200 G3700044 IPTR=IPTR+1 G3700045 IF(IPTR.LE.NUMENT) GO TO 100 G3700046 IPTR=0 G3700047 GO TO 10 G37000482 G3700049* MOVE THIS ENTRY TO IBUF, BUMP IPTR AND RETURN G37000501 G3700051 200 CALL MOVE(4,DIRENT(1,IPTR),IBUF) G3700052 IPTR=IPTR+1 G3700053 IF(IPTR.GT.NUMENT) IPTR=0 G3700054 RETURN G37000552 G3700056* I/O ERROR EXIT G37000571 G3700058ÐÐ 9000 ASSEM $0CFE G3700059+ ENQ -1 G3700060 CALL FMSWAP G3700061 END G3700062 SUBROUTINE REDUCE (IFCBAD, REQBUF, IDATA, ISTAT) G3800001 1 /G38 F ITOS CCS 3.0 SL-149G3800002C FILE MANAGER REDUCE FILE SPACE REQUEST PROCESSOR G3800003C CREDIT COLLECTION SYSTEM VERSION 3.0 G3800004C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CA. G3800005C COPYRIGHT CONTROL DATA CORPORATION 1979 G3800006C G3800007C*** G3800008C THIS ROUTINE PROCESSES REQUESTS TO THE FILE MANAGER TO G3800009C REDUCE A PREVIOUSLY ALLOCATED FILE SPACE, AND RETURN G3800010C THE UNUSED SPACE (DISK SECTORS) TO ALLOCATABLE MASS MEMORY. G3800011C G3800012C TO RETURN UNUSED FILE SPACE MEANS TO: G3800013C A) MODIFY (SHORTEN) THE FCB NUMBER OF RECORDS AND THE G3800014C NUMBER OF SECTORS INDICATORS. G3800015C B) MODIFY (SHORTEN) THE HEADER BLOCK NUMBER OF SECTORS G3800016C ALLOCATED INDICATOR. G3800017C C) RELEASE UNUSED MASS MEMORY SPACE. G3800018C G3800019C PARAMETERS: (ALL INTEGER) G3800020C G3800021ÐÐC IFCBAD - FCB CORE-IMAGE ADDRESS - UNUSED G3800022C G3800023C REQBUF - 24 WORD SCRATCH BUFFER - UNUSED G3800024C G3800025C IDATA - 24 WORD BUFFER G3800026C WORD CONTENT G3800027C ---- ------- G3800028C 1 - 4 FILE NAME G3800029C 5 - 8 FILE OWNER NAME G3800030C 9 - 12 FILE VOLUME NAME G3800031C 13 - 14 NUMBER OF RECORDS IN NEW SPACE G3800032C NOTE: MUST BE THAN ORIGINAL G3800033C G3800034C ISTAT - COMPLETION STATUS ON RETURN TO CALLER G3800035C G3800036C BIT MEANING G3800037C --- ------- G3800038C 15 FILE REQUEST REJECTED G3800039C 14* FILE REQUEST ILLEGAL G3800040C 13* VOLUME NOT READY G3800041C 12-6 UNASSIGNED G3800042C 5* MASS MEMORY I/O ERROR G3800043C 4 UNASSIGNED G3800044C 3* NUMBER OF RECORDS REQUESTED IS G3800045C GREATER THAN SIZE OF FILE, OR GREATER THANG3800046ÐÐC THE LAST EXISTING RECORD IN THE FILE. G3800047C 2* NOT A SEQUENTIAL FILE G3800048C 1* FILE NOT FOUND G3800049C 0* FILE IS CURRENTLY OPEN G3800050C G3800051C * = BIT 15 WILL ALSO BE SET G3800052C G3800053C SUBROUTINES G3800054C ----------- G3800055C G3800056C MWRITF - WRITE MASS MEMORY - FTN INTERFACE TO MMWRIT G3800057C MREADF - READ MASS MEMORY - FTN INTERFACE G3800058C FDWADD - FTN DOUBLE WORD ADD G3800059C FDWSUB - FTN DOUBLE WORD SUBTRACT G3800060C DWDIV - FTN DOUBLE WORD DIVIDE G3800061C UCTMGR - UCT ENTRY MANAGER G3800062C FMSWAP - FM EXEC SWAP PROCESSOR G3800063C GETFDS - GET FILES FDS G3800064C MREADF - READ MASS MEMORY - FTN INTERFACE TO MMREAD G3800065C MASREL - MASS MEMORY DE-ALLOCATION G3800066M COMMON G3800067M VITEQU G3800068C*** G3800069 EXTERNAL FMSCOM G3800070 EXTERNAL FMSWAP G3800071ÐÐC G3800072 INTEGER BSADD(2) G3800073 INTEGER FCBADR(2) G3800074 INTEGER FCBTIX G3800075 INTEGER HDRBLK(5) G3800076 INTEGER IDATA(14) G3800077 INTEGER IFCBAD G3800078 INTEGER IFLAG G3800079 INTEGER IOV G3800080 INTEGER ISTAT G3800081 INTEGER ITEMP(4) G3800082 INTEGER I(2) G3800083 INTEGER J G3800084 INTEGER K(2), L(2), M(2), N(2) G3800085 INTEGER MASREL G3800086 INTEGER MMUNIT G3800087 INTEGER OLDSAL(2) G3800088 INTEGER ONE(2) G3800089 INTEGER REQBUF(24) G3800090 INTEGER UCT(6) G3800091 INTEGER UCTENT G3800092 INTEGER VITADR G3800093 INTEGER TEMP(2) G3800094 INTEGER INDEX(2) G3800095 DATA INDEX/0,0/ G3800096ÐÐC G3800097 EQUIVALENCE (UCT, ITEMP) G3800098 EQUIVALENCE (UCT(5), BSADD) G3800099 EQUIVALENCE (I, IDATA(13)) G3800100 EQUIVALENCE (M, ITEMP) G3800101 EQUIVALENCE (N, ITEMP(3)) G3800102C CONSTANTS G3800103 DATA FCBADR/0,0/ G3800104 DATA ONE/0,1/ G3800105C MASS STORAGE RELEASE PROCESSOR INDEX G3800106 DATA MASREL/15/ G3800107C------------------- G3800108C GET THE FDS G3800109C------------------- G3800110 STATUS = 0 G3800111 CALL GETFDS (IDATA, VITADR, MMUNIT) G3800112C GETFDS SETS UP, IN COMMON : FDB(2),FDS,BUF(200), G3800113C VIT(21)AND STATUS. G3800114 IF (STATUS .NE. 0) GO TO 9900 G3800115C G3800116C SAVE THE FCBT INDEX G3800117 J = FDS G3800118 FCBTIX = BUF(J+8) G3800119C G3800120C SEARCH THE UCT FOR THE FILE G3800121ÐÐ UCT(2) = MMUNIT*$800 + FCBTIX G3800122 UCTENT = -1 G3800123 CALL UCTMGR (UCT, UCTENT, 2, IFLAG) G3800124C G3800125C IF FILE IS OPEN RETURN WITH ERROR STATUS G3800126 IF (IFLAG .EQ. 0) GO TO 9500 G3800127C G3800128C------------------- G3800129C READ IN THE FCB G3800130C------------------- G3800131C G3800132C COMPUTE FCBT BASE ADDRESS G3800133 TEMP(1) = 0 G3800134 TEMP(2) = VINFDB G3800135 CALL FDWADD (TEMP,VIFDDM,TEMP,STATUS) G3800136C G3800137C READ IN THE FCB G3800138 INDEX(2) = FCBTIX + 1 G3800139 CALL MREADF (TEMP, INDEX, 96, 96, 0, BUF, 0, STATUS) G3800140 IF (STATUS .NE. 0) GO TO 9900 G3800141C G3800142C G3800143C MUST BE SEQUENTIAL FILE G3800144 IF (AND (BUF(6), 1) .EQ. 1) GO TO 9700 G3800145C G3800146ÐÐC SAVE BEGINNING SECTOR ADDRESSES G3800147 BSADD(1) = BUF(4) G3800148 BSADD(2) = BUF(5) G3800149C G3800150C VERIFY PARAMETERS G3800151C NEW MINUS OLD NO. RECORDS G3800152 CALL FDWSUB (BUF(2), I, M, IOV) G3800153C NEW MINUS EXISTING NO. OF RECORDS G3800154 CALL FDWSUB (I, BUF(7), N, L) G3800155C NEW = OLD NO. RECORDS G3800156 IF (M + M(2) .EQ. 0) GO TO 9900 G3800157 IF ( (I .LT. 0) .OR. G3800158CC NEW NO. RECORDS = 0 G3800159 1 (I + I(2) .EQ. 0) .OR. G3800160C NEW .GT. OLD NO. RECORDS G3800161 2 (IOV .EQ. 1) .OR. G3800162C NEW .LT. NUMBER OF EXISTING RECORDS G3800163 3 (L .EQ. 1)) GO TO 9600 G3800164C G3800165C SAVE SECTOR ALLOCATION FIELD G3800166 OLDSAL(1) = BUF(23) G3800167 OLDSAL(2) = BUF(24) G3800168C G3800169C------------------------------------------------- G3800170C CONVERT NUMBER OF RECORDS TO NUMBER OF SECTORS G3800171ÐÐC------------------------------------------------- G3800172C G3800173C ARE RECORDS SECTOR ALIGNED ? G3800174 IF (BUF(6) .LT. 0) GO TO 500 G3800175C NO - SECTORS = LEAST INTEGER .GT.(NUMBER OF RECORDS G3800176C TIMES RECORD LENGTH DIVIDED BY SECTOR LENGTH) G3800177 CALL FDWMUI (I, BUF, M, IOV) G3800178 N = 0 G3800179 N(2) = VIWPS -1 G3800180 CALL FDWADD (M, N, M, IOV) G3800181 CALL DWDIV (M, VIWPS, N, IOV) G3800182 GO TO 600 G3800183C G3800184C YES - SECTORS = NO. RECORD TIMES NO. SECTORS PER RECORD G3800185500 M = BUF / VIWPS G3800186C ROUND UP RESULT G3800187C SQZ 2 G3800188C RAO ITEMP G3800189 ASSEM $0142, $D800, ITEMP G3800190C COMPUTE TOTAL G3800191 CALL FDWMUI (I, M, N, IOV) G3800192600 CONTINUE G3800193C G3800194C G3800195C MODIFY FCB RECORD NO. AND SECTOR ALLOCATION INDICATORS G3800196ÐÐC NO. OF RECORDS G3800197 BUF(2) = I G3800198 BUF(3) = I(2) G3800199C NO. OF SECTORS ALLOCATED G3800200 BUF(23) = N G3800201 BUF(24) = N(2) G3800202C VERIFY THAT NEW SECTORS .LT. OLD NO. OF SECTORS G3800203 CALL FDWSUB (OLDSAL, N, M, IOV) G3800204 IF (( M + M(2) ) .EQ. 0 ) GO TO 9900 G3800205 IF (IOV .EQ. 1) GO TO 9900 G3800206C G3800207C WRITE NEW FCB G3800208 CALL MWRITF (TEMP, INDEX, 96, 96, 0, BUF, 0, STATUS) G3800209 IF (STATUS .NE. 0) GO TO 9900 G3800210C G3800211C BSADD = SECTOR ADRS OF HEADER G3800212 CALL FDWSUB (BSADD, ONE, BSADD, IOV) G3800213C G3800214C GET HEADER BLOCK G3800215 CALL MREADF (BSADD, ONE, 5, 5, 0, HDRBLK, 0, STATUS) G3800216 IF (STATUS .NE. 0) GO TO 9900 G3800217C G3800218C VALIDATE HEADER G3800219 IF (HDRBLK(1) .NE. 2HAL) GO TO 9200 G3800220 CALL FDWADD (OLDSAL, ONE, OLDSAL, IOV) G3800221ÐÐ IF (HDRBLK(2) .NE. OLDSAL(1)) GO TO 9200 G3800222 IF (HDRBLK(3) .NE. OLDSAL(2)) GO TO 9200 G3800223 IF (HDRBLK(4) .NE. BSADD(1)) GO TO 9200 G3800224 IF (HDRBLK(5) .NE. BSADD(2)) GO TO 9200 G3800225C G3800226C MODIFY NUMBER OF SECTORS IN HEADER AND RE-WRITE IT G3800227 CALL FDWADD (N, ONE, HDRBLK(2), IOV) G3800228 CALL MWRITF (BSADD, ONE, 5, 5, 0, HDRBLK, 0, STATUS) G3800229 IF (STATUS .NE. 0) GO TO 9900 G3800230C G3800231C CALCULATE AND WRITE 'FAKE' HEADER BLOCK FOR MASREL G3800232C NEW HEADER ADDRESS G3800233 CALL FDWADD (HDRBLK(2), HDRBLK(4), HDRBLK(4), IOV) G3800234C CALCULATE NO. OF SECTORS TO DEALLOCATE G3800235 CALL FDWSUB (OLDSAL, HDRBLK(2), HDRBLK(2), IOV) G3800236 CALL MWRITF (HDRBLK(4), ONE, 5, 5, 0, HDRBLK, 0, STATUS) G3800237 IF (STATUS .NE. 0) GO TO 9900 G3800238C ADJUST HEADER ADRS FOR MASREL G3800239 CALL FDWADD (HDRBLK(4), ONE, BUF, IOV) G3800240C G3800241C CALL SECONDARY PROCESSOR TO RELEASE MASS STORAGE G3800242C G3800243C LDQ MASREL G3800244C ENA 1 G3800245C RTJ +FMSWAP G3800246ÐÐC G3800247 ASSEM $E800, MASREL, $0A01, $5400, +FMSWAP G3800248C G3800249 GO TO 9900 G3800250C G3800251C------------------------ G3800252C ERROR STATUS UPDATES G3800253C----------------------- G3800254C INVALID HEADER ERROR G38002559200 STATUS = AND(STATUS,-$C000 ) + $C000 G3800256 GO TO 9900 G3800257C G3800258C OPEN FILE ERROR G38002599500 STATUS = $8001 G3800260 GO TO 9900 G3800261C G3800262C NUMBER OF RECORDS .GT. NO. RECORDS ALLOCATED ERROR G38002639600 STATUS = $8008 G3800264 GO TO 9900 G3800265C G3800266C NOT SEQUENTIAL ERROR G38002679700 STATUS = $8004 G3800268C G3800269C G3800270C RETURN STATUS TO CALLER G3800271ÐÐ 9900 ISTAT = STATUS G3800272 CALL FMSCOM G3800273 RETURN G3800274 END G3800275 SUBROUTINE SPECAL (K) G3900001 1 /G39 F ITOS CCS 3.0 SL-149G3900002C CHECK FOR INDEX PROCESSOR SPECIAL CASE G3900003C CREDIT COLLECTION SYSTEM VERSION 3.0 G3900004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA G3900005C COPYRIGHT CONTROL DATA CORPORATION 1979 G39000062 G3900007M FMCOM G39000082 G3900009 EXTERNAL FMPPRO G39000101 G3900011 INTEGER K G3900012 INTEGER RTVIDX G3900013 INTEGER GETNDX G3900014 INTEGER DELIDX G3900015 INTEGER ADDIDX G3900016 INTEGER COMIDX G39000171 G3900018 DATA ADDIDX/9/ G3900019 DATA RTVIDX/10/ G3900020 DATA GETNDX/11/ G3900021ÐÐ DATA DELIDX/12/ G3900022 DATA COMIDX/13/ G3900023. G3900024C--------- G3900025C START CODE G3900026C--------- G39000271 G3900028C RESET SPECIAL CASE FLAG G3900029 K = 0 G3900030 I = 0 G3900031C TEST FOR PREVIOUS FILE ID AND KEY TYPE G3900032 IF (PREID .NE. FILEID .OR. G3900033 1 PRETYP .NE. KEYTYP) GO TO 100 G3900034C SET SPECIAL CASE FLAG TRUE G3900035 K = 1 G39000361 G3900037C TEST FOR PROCESSOR INDEX G3900038 J = AND ($FFFF, FMPPRO) G39000391 G3900040 IF (J .NE. ADDIDX .OR. G3900041 1 J .NE. RTVIDX .OR. G3900042 2 J .NE. GETNDX .OR. G3900043 4 J .NE. COMIDX .OR. G3900044 3 J .NE. DELIDX ) GO TO 100 G39000451 G3900046ÐÐC CHECK FOR SEQ SET IN KIBBUF G3900047 IF (KIBBUF(KIBTYP) .NE. SSET) GO TO 100 G3900048 I = 1 G3900049 100 RETURN G3900050 END G3900051 MON 00001 NAM SMCLNK H01 A ITOS CCS 3.0 SL-149H0100001* PROVIDES EXECUTION LINKAGE FROM LOAD TO DSORT. H0100002* CREDIT COLLECTION SYSTEM VERSION 3.0 H0100003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA H0100004* COPYRIGHT CONTROL DATA CORPORATION 1979 H0100005 SPC 5 H0100006**** H0100007*E H0100008* H0100009* H0100010* ****************** H0100011* * LINKAGE MODULE * H0100012* ****************** H0100013* H0100014* H0100015* FUNCTION H0100016* -------- H0100017* H0100018* THIS ROUTINE ALLOWS SYSTEM ROUTINES TO BE LOADED PRIOR TO DSORT. H0100019ÐÐ* H0100020* H0100021* GENERAL DESCRIPTION H0100022* ------------------- H0100023* H0100024* AS AN OVERLAY PROGRAM DSORT MUST MAKE AVAILABLE THE SYSTEM H0100025* SUBROUTINES THAT ARE LOADED WITH ITSELF TO EACH OVERLAY. SINCE H0100026* ALL OF THE STORAGE SPACE STARTING WITH INIT IN DSORT TO THE END H0100027* OF DSORT IS RESERVED FOR THE OVERLAYS, THE SYSTEM MODULES MUST H0100028* BE LOADED PRIOR TO DSORT. ALSO, BECAUSE THE LOADER EXPECTS TO H0100029* EXECUTE CODE STARTING AT THE FIRST WORD ADDRESS OF THE LOAD, H0100030* A LINKAGE ROUTINE IS NECESSARY TO JUMP OVER THE SYSTEM ROUTINES. H0100031* H0100032* H0100033* INPUT REQUIREMENTS H0100034* ------------------ H0100035* H0100036* THE LOADER TRANSFERS CONTROL TO SMCLNK WHEN DSORT AND ITS SYSTEM H0100037* ROUTINES ARE LOADED. SMCLNK DOES NOT ASSUME ANY REGISTER VALUES H0100038* ARE KNOWN. H0100039* H0100040* H0100041* OUTPUT H0100042* ------ H0100043* H0100044ÐÐ* SMCLNK JUMPS TO DSORT WITHOUT DEFINING HARDWARE REGISTERS. H0100045**** H0100046 EJT 0 H0100047**** H0100048*E H0100049* ENTRY/EXIT H0100050* ---------- H0100051* H0100052* ENTRY - NORMAL ENTRY FROM SYSTEM LOADER H0100053* H0100054* EXIT - JUMPS TO BOOTSTRAP OVERLAY LOADER (DSORT) H0100055* H0100056* H0100057* FLOW H0100058* ---- H0100059* H0100060* SMCLNK JUMPS TO DSORT. H0100061* H0100062* H0100063* SUBROUTINES H0100064* ----------- H0100065* NONE H0100066* H0100067* H0100068* MESSAGES H0100069ÐÐ* -------- H0100070* NONE H0100071* H0100072* H0100073* PARAMETERS H0100074* ---------- H0100075* H0100076* NONE H0100077* MISC H0100078* ---- H0100079* H0100080* LOAD ORDER: H0100081* SMCLNK H0100082* SYSTEM MODULES H0100083* DSORT H0100084* H0100085* H0100086* ** ENTRY POINTS ** H0100087* H0100088 ENT SMCLNK LINKAGE INTERCEPTOR H0100089* H0100090* ** EXTERNALS ** H0100091* H0100092 EXT DSORT ITOS SORT H0100093* H0100094ÐÐ* H0100095* ** EQUATES ** H0100096* H0100097* NONE H0100098**** H0100099 EJT 0 H0100100SMCLNK JMP+ DSORT JUMP OVER SYSTEM MODULES H0100101 END SMCLNK H0100102 NAM DSORT H02 A ITOS CCS 3.0 SL-149H0200001* BOOTSTRAP OVERLAY LOADER H0200002* CREDIT COLLECTION SYSTEM VERSION 3.0 H0200003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA H0200004* COPYRIGHT CONTROL DATA CORPORATION 1979 H0200005 SPC 5 H0200006**** H0200007*E H0200008* H0200009* H0200010* ****************** H0200011* * OVERLAY LOADER * H0200012* ****************** H0200013* H0200014* H0200015* FUNCTION H0200016* -------- H0200017ÐÐ* H0200018* DSORT LOADS OVERLAYS. H0200019* H0200020* H0200021* GENERAL DESCRIPTION H0200022* ------------------- H0200023* H0200024* DSORT ACTS AS A SUBROUTINE FOR LOADING OVERLAYS. THE OVERLAYS H0200025* ARE SMCMON, SMCEDT, SMCSRT, SMCIMG, AND SMCFMG. EACH OF THE H0200026* ABOVE OVERLAYS ARE LOADED ONCE AND IN THE ORDER LISTED. H0200027* H0200028* DSORT MUST PROVIDE THE CORE MEMORY REQUIREMENTS FOR THE OVERLAYS H0200029* AND THE OVERLAY TABLE SPACE SINCE THE ITOS SYSTEM DOES NOT ALLOW H0200030* MEMORY TO BE ALLOCATED DURING DSORT EXECUTION. THE EQUATE NPARTSH0200031* DEFINES THE NUMBER OF PAGES (2048 WORDS) DSORT WILL HAVE H0200032* AVAILABLE. H0200033* H0200034* H0200035* INPUT REQUIREMENTS H0200036* ------------------ H0200037* H0200038* EXCEPT FOR THE INITIAL CALL VIA JUMP FROM SMCLNK, DSORT EXPECTS H0200039* THE Q REGISTER,(Q), TO CONTAIN FIRST WORD ADDRESS FOR THE OVERLAYH0200040* TO BE LOADED AND THE A REGISTER, (A), TO HAVE AN INDEX TO WHICH H0200041* OVERLAY SHOULD BE LOADED. INDEXES -1,0,1,2, AND 3 CORRESPOND TO H0200042ÐÐ* THE ORDER THE ABOVE OVERLAYS ARE LISTED. H0200043* H0200044* THE INITIAL CALL TO DSORT FROM SMCLNK DOES NOT ASSUME ANY H0200045* REGISTERS ARE PRESET. DSORT WILL LOAD SMCMON FOR THE INITIAL H0200046* CALL. H0200047**** H0200048 EJT 0 H0200049**** H0200050*E H0200051* OUTPUT H0200052* ------ H0200053* H0200054* (Q),(I) = FWA OF EXTERNAL REFERENCE ADDRESS TABLE IF LOADING H0200055* SMCMON. H0200056* H0200057* = FWA OF FIXED TABLE IN SMCMON FOR ANY OTHER OVERLAY H0200058* LOADED. H0200059* H0200060* H0200061* ENTRY/EXIT H0200062* ---------- H0200063* H0200064* ENTRY - DSORT, INITIAL TIME VIA JUMP FROM SMCLNK H0200065* - LOAD, FOR ALL OTHER CALLS (ENTERED VIA RETURN JUMP FROM H0200066* SMCMON) H0200067ÐÐ* H0200068* EXIT - JUMPS TO THE SECOND LOCATION OF THE OVERLAY LOADED H0200069* H0200070* H0200071* H0200072* FLOW H0200073* ---- H0200074* H0200075* DSORT CALLS INIT TO ABSOLUTIZE ADDRESSES USED BY DSORT. INIT H0200076* READS FROM $$PGMNAM FILE TO FORMAT THE OVERLAY ADDRESS TABLE. H0200077* THIS TABLE CONSIST OF SECTOR ADDRESS, LENGTH AND AN UNUSED WORD H0200078* FOR EACH OVERLAY ENTRY. INIT THEN FAKES A SUBROUTINE CALL TO H0200079* LOAD TO INITIALLY LOAD SMCMON. H0200080* H0200081* SUBROUTINES H0200082* ----------- H0200083* H0200084* CLOSFL F.M. CLOSE PROCESSOR H0200085* OPENFL F.M. OPEN PROCESSOR H0200086* READR F.M. READ RANDOM PROCESSOR H0200087* H0200088* H0200089* MESSAGES H0200090* -------- H0200091* H0200092ÐÐ* NONE H0200093* H0200094**** H0200095 EJT 0 H0200096**** H0200097*E H0200098* PARAMETERS H0200099* ---------- H0200100* H0200101* ** EQUATES ** H0200102* H0200103ADISP EQU ADISP($EA) DISPATCHER ADDRESS H0200104AMONI EQU AMONI($F4) ADDRESS OF MONIOR H0200105FMPSIZ EQU FMPSIZ($E9) SIZE OF FMENTP H0200106LNKSIZ EQU LNKSIZ(2) SIZE OF SMCLNK H0200107LUNSIZ EQU LUNSIZ($5A) SIZE OF LUNEQ H0200108SLOP EQU SLOP($30) SMCLNK/LUNEQ/FMENTP MAY EXPAND -ALLOW FOR THISH0200109NPARTS EQU NPARTS(7) NO. OF PAGES IN PARTITION H0200110PRLVL EQU PRLVL(0) PRIORITY LEVEL FOR MONITOR REQUEST H0200111ZERO EQU ZERO(2) (2)=0. H0200112**** H0200113 EJT 0 H0200114* REQUEST BUFFER INDEXES - FIRST 4 WORDS H0200115 EQU RBATHR(0) REQUEST BUFFER ADDRESS THREAD H0200116 EQU BUFAMP(1) BUFFER ADDRESS MAIN PART H0200117ÐÐ EQU CNTLPT(2) CONTROL POINT (OR SPARE) H0200118 EQU RQINFO(3) REQUEST INFORMATION (MULTI-FIELD) H0200119* BITS USE H0200120* 15-12 SPARE H0200121* 11-04 REQUEST INDEX H0200122* 03-00 LEVEL OF REQUESTOR H0200123* H0200124* REQUEST BUFFER INDEXES - MAIN PART H0200125 EQU QREG(0) Q REGISTER H0200126 EQU IREG(1) I REGISTER H0200127 EQU PARLST(2) ADDRESS OF PARAMETER LIST H0200128 EQU RTNADR(2) RETURN ADDRESS TO USER (UPON RETURN FROM EXEC)H0200129 EQU UCTADR(3) UCT ENTRY ABSOLUTE ADDRESS H0200130 EQU USERID(4) USER IDENTIFIER H0200131 EQU FCBADR(5) FCB ADDRESS (MAY BE SET BY CALLER OR INTCPTR.)H0200132 EQU RADINT(6) RETURN ADDRESS TO INTERCEPTOR H0200133 EQU RPIDX(7) REQUEST PROCESSOR INDEX H0200134* BITS 14-00 REQUEST PROCESSOR INDEX H0200135* BIT 15 TYPE OF PROCESSOR H0200136* =0, SERIAL PROCESSOR H0200137* =1, REENTRANT PROCESSOR H0200138 EQU LOKREC(8) NUMBER OF RECORDS TO BE READ/WRITTEN PER I/O H0200139* CALL AND LOCK RECORDS ON RETRIEVE FLAG H0200140* BITS 14-00 NUMBER OF RECORDS PER CALL H0200141* BIT 15 =0, DO NOT LOCK ON RETRIEVE H0200142ÐÐ* =1, LOCK RECORDS ON RETRIEVE H0200143 EQU USEFLG(9) TYPE OF FILE USE FLAG H0200144* NEGATIVE, OPEN FOR COMPRESS ONLY H0200145* 0, OPEN FOR ACESS VIA REL REC NO H0200146* 1, OPEN FOR RETRIEVAL VIA KEY 1 H0200147* 2, OPEN FOR RETRIEVAL VIA KEY 2 H0200148* 3, OPEN FOR RETRIEVAL VIA KEY 3 H0200149* 4, OPEN FOR RETRIEVAL VIA KEY 4 H0200150 EQU NUMREC(10) NUMBER OF RECORDS ACTUALLY STORED/RETRIEVED H0200151 EQU RRNMSB(11) REL REC NUMBER OF STORED/RETRIEVED REC, MSB H0200152 EQU RRNLSB(12) REL REC NUMBER OF STORED/RETRIEVED REC, LSB H0200153 EQU RMPLEN(20) LENGTH OF REQBUF MAIN PART H0200154 EJT H0200155* FILE CONTROL BLOCK EQUIVALENCES H0200156 EQU FH(4) LENGTH -1 OF FCB HEADER H0200157 EQU FILEID(ZERO) FILE IDENTIFIER H0200158* ACCESS FILEID INDIRECTLY H0200159* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBERH0200160* BITS 10-00 INDEX OF FCB IN FCB TABLE H0200161 EQU FCBFLG(1) FCB FLAGS H0200162* BITS 15-8, SPARE H0200163* BITS 7-00, NUMBER OF USERS USING FILE H0200164 EQU FILOCK(2) FILE LOCK FLAG (IF NON-0, CONTAINS USER ID) H0200165 EQU NUMSET(3) NUMBER OF SETS OF LOCKED RECORDS IN FILE H0200166 EQU NUMNEW(4) NUMBER OF NEW RECORDS SINCE FCB UPDATED ON MM H0200167ÐÐ SPC 1 H0200168 EQU RECLEN(FH+1) RECORD LENGTH IN WORDS H0200169 EQU TDATRM(FH+2) TOTAL NUMBER OF DATA RECORDS, MSB H0200170 EQU TDATRL(FH+3) TOTAL NUMBER OF DATA RECORDS, LSB H0200171 EQU DATBAM(FH+4) DATA RECORDS BEGINNING SECTOR ADDRESS, MSB H0200172 EQU DATBAL(FH+5) DATA RECORDS BEGINNING SECTOR ADDRESS,LMSB H0200173 EQU FCBIND(FH+6) FCB INDICATORS H0200174* BIT 15 , SECTOR ALLIGNED RECORDS IF =1 H0200175* BIT 14 , STORAGE MODE FOR INDEXED FILE H0200176* =0, RECORDS STORED RANDOMLY WITHH0200177* RESPECT TO PRIMARY KEY H0200178* =1, RECORDS STORED IN ORDER WIT H0200179* RESPECT TO PRIMARY KEY H0200180* BIT 13 , =1, FILE IS CURRENTLY OPEN H0200181* =0, FILE IS CURRENTLY CLOSED H0200182* BIT 12 , =1, FILE IS BEING COMPRESSED H0200183* =0, FILE IS NOT BEING COMPRESSEDH0200184* BIT 0 , FILE TYPE H0200185* =0, SEQUENTIAL FILE H0200186* =1, INDEXED FILE H0200187 EQU NEDATM(FH+7) NUMBER OF EXISTING DATA RECORDS, MSB H0200188 EQU NEDATL(FH+8) NUMBER OF EXISTING DATA RECORDS, LSB H0200189 EQU SEQLTH(NEDATL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION H0200190* OF FCB FOR A SEQUENTIAL FILE H0200191 SPC 1 H0200192ÐÐ EQU NEXTBM(FH+9) NEXT FREE KEY INDEX BLOCK, MSB H0200193 EQU NEXTBL(FH+10) NEXT FREE KEY INDEX BLOCK, LSB H0200194 EQU TNKEYM(FH+11) TOTAL NUMBER OF KEY INDEX BLOCKS, MSB H0200195 EQU TNKEYL(FH+12) TOTAL NUMBER OF KEY INDEX BLOCKS, LSB H0200196 EQU KEYBAM(FH+13) KEY INDEX BEGINNING SECTOR ADDRESS, MSB H0200197 EQU KEYBAL(FH+14) KEY INDEX BEGINNING SECTOR ADDRESS, LSB H0200198 EQU LENKY1(FH+15) LENGTH OF KEY NO. 1 H0200199 EQU POSKY1(FH+16) BYTE POSITION OF KEY NO. 1 H0200200 EQU LENKY2(FH+17) LENGTH OF KEY NO. 2 H0200201 EQU POSKY2(FH+18) BYTE POSITION OF KEY NO. 2 H0200202 EQU LENKY3(FH+19) LENGTH OF KEY NO. 3 H0200203 EQU POSKY3(FH+20) BYTE POSITION OF KEY NO. 3 H0200204 EQU LENKY4(FH+21) LENGTH OF KEY NO. 4 H0200205 EQU POSKY4(FH+22) BYTE POSITION OF KEY NO. 4 H0200206 EQU INDLEN(POSKY4-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION H0200207* OF FCB FOR AN INDEXED FILE H0200208 EJT H0200209* THE FOLLOWING PORTION OF THE FCB EXISTS ONLY H0200210* ON MASS MEMORY. THESE 10 WORDS ARE NOT LOADEDH0200211* INTO EITHER OF THE FILE MANAGER CONTROLLED FCBH0200212* TABLES. H0200213 EQU TSFILM(FH+23) TOTAL NUMBER OF SECTORS IN FILE, MSB H0200214 EQU TSFILL(FH+24) TOTAL NUMBER OF SECTORS IN FILE, LSB H0200215 EQU NAME12(FH+25) FILE NAME, CHARACTERS 1 AND 2 H0200216 EQU NAME34(FH+26) FILE NAME, CHARACTERS 3 AND 4 H0200217ÐÐ EQU NAME56(FH+27) FILE NAME, CHARACTERS 5 AND 6 H0200218 EQU NAME78(FH+28) FILE NAME, CHARACTERS 7 AND 8 H0200219 EQU OWNR12(FH+29) OWNER NAME, CHARACTERS 1 AND 2 H0200220 EQU OWNR34(FH+30) OWNER NAME, CHARACTERS 3 AND 4 H0200221 EQU OWNR56(FH+31) OWNER NAME, CHARACTERS 5 AND 6 H0200222 EQU OWNR78(FH+32) OWNER NAME, CHARACTERS 7 AND 8 H0200223 EQU BYTLEN(FH+33) BYTE LENGTH OF RECORD H0200224* H0200225* FOR COMPRESS ONLY H0200226* H0200227 EQU PRSRNM(FH+34) RRN OF LAST PROCESSED RECORD - MSB H0200228 EQU PRSRNL(FH+35) RRN OF LAST PROCESSED RECORD - LSB H0200229 EQU NEWRNM(FH+36) RRN OF THE LATEST 'NEW' RECORD - MSB H0200230 EQU NEWRNL(FH+37) RRN OF THE LATEST 'NEW' RECORD - LSB H0200231 SPC 4 H0200232* WORDS 0 THRU 4 OF THE FCB HEADER AND WORDS H0200233* 6 THRU 10 OF THE FCB ARE REFERRED TO AS THE H0200234* SHARED SUBSET OF THE FCB. THEY INCLUDE THE H0200235* ONLY FCB WORDS THAT CAN BE MODIFIED AFTER FILEH0200236* CREATION. IF TWO OR MORE USERS HAVE THE SAME H0200237* FILE OPEN, THERE HAS TO BE A SINGLE MASTER H0200238* COPY OF THE SUBSET THAT RECEIVES (AND RECORDS)H0200239* ALL OF THE UPDATES. THE CONTROLLED SUBSET H0200240* WILL ALWAYS BE PART OF A MAIN MEMORY RESIDENT H0200241* FCB IF THE FCB IS IN A FM CONTROLLED TABLE. H0200242ÐÐ* IF THE FCB IS IN USER SPACE, THE SUBSET MAY ATH0200243* TIMES RESIDE IN THE SUBSET CONTROL TABLE. H0200244 SPC 2 H0200245* ALTERNATE NAMES FOR SUBSET WORDS H0200246 EQU SAFCBI(FH+1) SUBSET ALTERNATE NAME FOR FCBIND H0200247 EQU SADATM(FH+2) SUBSET ALTERNATE NAME FOR NEDATM H0200248 EQU SADATL(FH+3) SUBSET ALTERNATE NAME FOR NEDATL H0200249 EQU SANXTM(FH+4) SUBSET ALTERNATE NAME FOR NEXTBM H0200250 EQU SANXTL(FH+5) SUBSET ALTERNATE NAME FOR NEXTBL H0200251 EJT 0 H0200252**** H0200253* MISC H0200254* ---- H0200255* H0200256* ** ENTRY POINTS ** H0200257* H0200258 ENT DSORT H0200259* H0200260* ** EXTERNALS ** H0200261* H0200262 EXT CLOSFL F.M. CLOSE PROCESSOR H0200263 EXT CREATE F.M. CREATE PROCESSOR H0200264 EXT DELETE F.M. DELETE PROCESSOR H0200265 EXT GETFCB F.M. GETFCB PROCESSOR H0200266 EXT GETS GETS THE NEXT FILE MANAGER SEQUENTIAL RECORD H0200267ÐÐ EXT OPENFL F.M. OPEN PROCESSOR H0200268 EXT PUTS STORES THE NEXT FILE MANAGER SEQUENTIAL RECORDH0200269 EXT READR READ RANDOM FILE MANAGER 2.0 FILE H0200270 EXT SYSMSG PROGRAM MESSAGE PROCESSOR H0200271 EXT UPDFCB F.M. UPDATE FCB PROCESSOR H0200272**** H0200273 EJT H0200274DSORT RTJ* INIT INITIALIZE LOAD. H0200275HERE EQU HERE(*) RELOCATION REFERENCE POINT. H0200276* THE CALLING SEQUENCE IS (Q)ENTRY = FWA OF LOAD POINT. H0200277* (A)ENTRY = INDEX INTO FILENAME TABLE. H0200278* (DSORT)ENTRY = PARAMETER TO PASS TO LOADEE. H0200279* RTJ LOAD H0200280* THE MODULE INDICATED VIA (A)ENTRY IS LOADED AND GIVEN CONTROL, H0200281* WITH (Q) = (I) = PARAMETER, E.G. FWA OF FIXED TABLES. H0200282* (1ST WORD OF LOADEE) = FWA OF NSI OF CALLER OF LOAD. H0200283* AS THE EXCEPTION, DUE TO INIT, (SMCMON) = FWA OF LOAD. H0200284LOAD NUM 0 H0200285LOADSS STQ* LOADS SET LOAD POINT INTO GTFILE REQUEST. H0200286 TRA Q H0200287 LDA* LOADNM+2,Q H0200288 STA* LOADN SAVE PROGRAM LENGTH H0200289 LDA* LOADNM+1,Q H0200290 STA* LOADLS LSB SECTOR ADDRESS H0200291LOADRQ RTJ- (AMONI) H0200292ÐÐ VFD N1/0,N1/1,N5/4,N1/0,X4/PRLVL,X4/PRLVL H0200293LOADC ADC LOAD1-HERE COMPLETION. H0200294 NUM 0 THREAD. H0200295 VFD N3/0,N1/0,N2/2,N10/$C2 V,M,A,L. H0200296LOADN NUM 0 N. H0200297LOADS NUM 0 S. H0200298 NUM 0 MSB. H0200299LOADLS NUM 0 LSB. H0200300 JMP- (ADISP) GIVE UP CPU WHILE AWAITING COMPLETION. H0200301* IF MASS MEMORY ERRORS, EXECUTIVE WILL NOT XFER TO LOAD1 H0200302LOAD1 LDA* LOAD (A) = FWA OF NSI OF CALLER. H0200303 LDQ* LOADS (Q) = FWA OF LOADEE. H0200304 STA- (ZERO),Q FAKE RTJ FROM LOAD CALLER TO LOADEE. H0200305 LDQ* DSORT (Q) = PARAMETER TO PASS TO LOADEE. H0200306 STQ- I PASS PARAMETER IN I AS WELL. H0200307 RAO* LOADS () = 1 + FWA OF LOADEE. H0200308 JMP* (LOADS) JMP TO 2ND WORD OF LOADEE. H0200309 EJT 0 H0200310* EXTERNAL REFERENCE ADDRESS TABLE FOR SMCMON H0200311 SPC 2 H0200312XREF EQU XREF(*) START OF EXTERNAL TABLE H0200313SMCLWA ADC SMCEND-HERE LWA+1 OF MEMORY AVAILABLE TO DSORT H0200314XCLOSF ADC *-* SMCMON CLOSE ROUTINE - PATCHED BY SMCMON H0200315XOPEN ADC OPENFL F.M. OPEN PROCESSOR H0200316XDELET ADC DELETE F.M. DELETE PROCESSOR H0200317ÐÐXCREAT ADC CREATE F.M. CREATE PROCESSOR H0200318XCLOSE ADC CLOSFL F.M. CLOSE PROCESSOR H0200319XGETS ADC GETS F.M. GETS PROCESSOR H0200320XPUTS ADC PUTS F.M. PUTS PROCESSOR H0200321XGTFCB ADC GETFCB F.M. GET FCB PROCESSOR H0200322XUPFCB ADC UPDFCB F.M. UPDATE FCB PROCESSOR H0200323XSYMSG ADC SYSMSG PROGRAM MESSAGE PROCESSOR H0200324 SPC 5 H0200325OVLSRT BZS OVLSRT(3) START OF PROGRAM NAME TABLE H0200326 ALF 3,SMCMON H0200327LOADNM ALF 3,SMCEDT EDIT. H0200328 ALF 3,SMCSRT COPY OR INTERNAL SORT. H0200329 ALF 3,SMCIMG INTERMEDIATE MERGE. H0200330 ALF 3,SMCFMG FINAL MERGE H0200331OVLEND EQU OVLEND(*-3) END OF PROGRAM NAME TABLE H0200332 EJT 0 H0200333INIT NUM 0 H0200334 LDA* INIT (A) = FWA OF LOAD. H0200335 STA* LOAD INDIRECTLY MAKE (SMCMON) = FWA OF LOAD. H0200336 INA LOAD1-HERE (A) = RELOCATED (LOADC). H0200337 STA* LOADC H0200338 INA XREF-LOAD1 ABS. ADDRESS OF EXTERNAL REFERENCE TABLE H0200339 STA* DSORT INDIRECTLY TELL FWA OF XREF TO SMCMON H0200340 INA OVLEND-XREF ABS. ADDRESS OF OVLEND H0200341 STA* INT60 SAVE START ADDRESS H0200342ÐÐ INA REQBUF-OVLEND REQBUF ADDRESS H0200343 STA* INT10 OPEN PARAMETER H0200344 STA* INT50 READR PARAMETER H0200345 STA* INT100 CLOSE PARAMETER H0200346 INA IDATA-REQBUF IDATA ADDRESS H0200347 STA* INT20 OPEN PARAMETER H0200348 INA REQIND-IDATA REQIND ADDRESS H0200349 STA* INT30 OPEN PARAMETER H0200350 STA* INT80 READR PARAMETER H0200351 STA* INT110 CLOSE PARAMETER H0200352 INA FCBBUF-REQIND FCBBUF ADDRESS H0200353 STA* REQBUF+FCBADR+RQINFO+1 H0200354 INA KEYADR-FCBBUF H0200355 STA* INT70 KEY NAME H0200356 LDA* INIT H0200357 ADD* SMCLWA ABSOLUTIZE LWA+1 LOACATION H0200358 STA* SMCLWA H0200359 RTJ OPENFL OPEN PROGRAM LIBRARY NAME FILE H0200360INT10 ADC *-* REQBUF H0200361INT20 ADC *-* IDATA H0200362INT30 ADC *-* REQIND H0200363INT40 LDQ* INT60 H0200364 INQ -3 H0200365 STQ* INT60 BUFFER ADDRESS H0200366 LDQ* INT70 KEY ADDRESS H0200367ÐÐ INQ -3 H0200368 STQ* INT70 KEY ADDRESS H0200369 LDQ* (INT60) SAVE LAST PART OF NEXT KEY H0200370* READ LIBRARY ENTRY INTO KEY TABLE ENTRY H0200371* WORD 0 PROGRAM NAME H0200372* WORD 1 PROGRAM NAME H0200373* WORD 2 PROGRAM NAME H0200374* WORD 3 MSB SECTOR ADDRESS H0200375* WORD 4 LSB SECTOR ADDRESS H0200376* WORD 5 LENGTH OF PROGRAM H0200377 RTJ READR H0200378INT50 ADC *-* REQBUF H0200379INT60 ADC *-* RECBUF H0200380INT70 ADC *-* KEYVAL H0200381INT80 ADC *-* REQIND H0200382 SQZ INT90 ALL PROGRAM NAMES PROCESSED H0200383 JMP* INT40 H0200384INT90 RTJ CLOSFL CLOSE PROGRAM LIBRARY NAME FILE H0200385INT100 ADC *-* REQBUF H0200386INT110 ADC *-* REQIND H0200387 ENA -1*3 SELECT SMCMON FOR LOADING. H0200388 LDQ* INIT (Q) = RELOCATION FACTOR. H0200389 INQ INIT-HERE (Q) = FWA OF LOADPOINT FOR SMCMON. H0200390 JMP* LOADSS LOAD SMCMON. H0200391 EJT 0 H0200392ÐÐREQBUF BZS REQBUF(24) REQUEST BUFFER H0200393IDATA ALF /,$$PGMNAM/ H0200394 ALF /,$$ / H0200395 ALF /,SYSVOL / H0200396 NUM 1 KEY TO ACCESS FILE H0200397 NUM 1 NUMBER OF RECORDS TO RETRIEVE H0200398 BZS (1) NO RECORD LOCKS H0200399REQIND BSS REQIND REQUEST INDICATOR H0200400FCBBUF BSS FCBBUF(INDLEN+FH+1) SIZE OF FCBBUF FOR INDEX FILE H0200401 ALF 3,SMCMON H0200402 ALF 3,SMCEDT EDIT. H0200403 ALF 3,SMCSRT COPY OR INTERNAL SORT. H0200404 ALF 3,SMCIMG INTERMEDIATE MERGE. H0200405 ALF 3,SMCFMG FINAL MERGE H0200406KEYADR EQU KEYADR(*) END OF KEY TABLE H0200407SMCBUF EQU SMCBUF($800*NPARTS-$100+DSORT-*-FMPSIZ-LNKSIZ-LUNSIZ-SLOP) H0200408SMCSIZ EQU SMCSIZ(SMCBUF/96*96) TRUNCATE TO NEAREST SECTOR BOUNDARY H0200409 BSS (SMCSIZ) PAD TO CLOSEST SECTOR BOUNDARY LESS THAN H0200410* PARTITION SIZE H0200411SMCEND EQU SMCEND(*) LWA+1 H0200412 END DSORT H0200413 NAM SMCMON H03 A ITOS CCS 3.0 . SL-149H0300001* ESTABLISHES OVERLAY LOADING CONTROL- HAS COMMON SUBROUTINES H0300002* CREDIT COLLECTION SYSTEM VERSION 3.0 H0300003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA H0300004ÐÐ* COPYRIGHT CONTROL DATA CORPORATION 1979 H0300005 SPC 5 H0300006**** H0300007*E H0300008* ***************** H0300009* * DSORT MONITOR * H0300010* ***************** H0300011* H0300012* FUNCTION H0300013* -------- H0300014* H0300015* SMCMON MAKES CALLS TO THE LOAD SUBROUTINE IN DSORT TO LOAD H0300016* OVERLAYS. H0300017* H0300018* H0300019* GENERAL DESCRIPTION H0300020* ------------------- H0300021* H0300022* SMCMON CONSIST OF: H0300023* H0300024* 1. ROUTINE TO REQUEST OVERLAYS BE LOADED. H0300025* 2. SUBROUTINES USED BY ONE OR MORE OVERLAYS. H0300026* 3. FIXED TABLE SPACE FOR OVERLAY COMMUNICATION. H0300027* 4. INITIALIZATION SECTION. H0300028* H0300029ÐÐ* EACH SUBROUTINE WILL BE DESCRIBED IN A SECTION OF ITS OWN. H0300030* H0300031* SMCMON IS LOADED BY DSORT. SMCMON IS THE FIRST OVERLAY TO BE H0300032* LOADED. ALL OF ITS ROUTINES UP TO THE INITIALIZATION SECTION H0300033* WILL REMAIN IN MEMORY FOR THE DURATION OF THE SORT RUN. THE H0300034* LOCATIONS STARTING WITH THE INITIALIZER SUBROUTINE (INIT) WILL H0300035* BE USED BY OVERLAY SMCEDT TO BUILD THE VARIABLE TABLES NEEDED H0300036* TO DESCRIBE THE INPUT DIRECTIVES. SMCMON REQUEST THAT SMCEDT H0300037* BE LOADED AT THE END OF AVAILABLE CORE SPACE. THE VARIABLE H0300038* TABLES BUILD TOWARD SMCEDT. SMCMON LOADS OVERLAY SMCSRT STARTINGH0300039* AT THE END OF THE VARIABLE TABLE. THE LAST PORTION OF THE H0300040* VARIABLE TABLE SPACE IS NOT NEEDED FOR OVERLAYS SMCIMG AND H0300041* SMCFMG. THEY ARE LOADED STARTING WITH THE FIRST LOCATION NOT H0300042* NEEDED IN THE VARIABLE TABLES. EACH OF THE LAST THREE OVERLAYS H0300043* USE CORE SPACE FROM AN ADDRESS WITHIN ITSELF TO THE LAST WORD H0300044* ADDRESS AVAILABLE TO DSORT FOR TABLE SPACE. THIS SPACE IS USED H0300045* TO SORT AND MERGE RECORDS. H0300046**** H0300047 EJT 0 H0300048**** H0300049*E H0300050* INPUT REQUIREMENTS H0300051* ------------------ H0300052* H0300053* THE LOAD ROUTINE IN DSORT SETS THE FWA OF SMCMON TO THE FWA OF H0300054ÐÐ* THE LOAD SUBROUTINE. SMCMON USES THIS ADDRESS TO CALL LOAD. H0300055* LOAD PASSES BOTH Q AND I REGISTERS (Q), (I), WHICH ARE SET TO THEH0300056* FIRST WORD OF A EXTERNAL REFERENCE ADDRESS TABLE. THIS TABLE H0300057* CONTAINS: H0300058* H0300059* 1. LWA+1 OF AVAILABLE MEMORY TO DSORT. H0300060* 2. SMCMON CLOSE ROUTINE. H0300061* 3. THE ADDRESS OF EACH FILE MANAGER ROUTINE NEEDED. H0300062* 4. PROGRAM MESSAGE PROCESSOR. H0300063* H0300064* H0300065* OUTPUT H0300066* ------ H0300067* H0300068* NO REGISTERS ARE ASSUME SET WHEN SMCMON EXITS TO THE DISPATCHER. H0300069* H0300070* H0300071* ENTRY/EXIT H0300072* ---------- H0300073* H0300074* ENTRY - SMCMON IS LOADED VIA DSORT BY SUBROUTINE LOAD IN DSORT. H0300075* LOAD TRANSFERS TO THE SECOND LOCATION OF SMCMON. H0300076* H0300077* EXIT - SMCMON EXITS TO THE DISPATCHER WHEN DONE. IF AN ERROR H0300078* OCCURRED, THE DISPATCHER EXIT IS VIA THE BOMB ROUTINE. H0300079ÐÐ**** H0300080 EJT 0 H0300081**** H0300082*E H0300083* FLOW H0300084* ---- H0300085* H0300086* SMCMON DOES THE FOLLOWING: H0300087* H0300088* 1. EXECUTIES THE INITIALIZER SUBROUTINE (INIT). H0300089* H0300090* A. INIT SAVES INFORMATION PASSED BY DSORT. H0300091* B. INIT ABSOLUTIZES ALL NECESSARY ADDRESSES. H0300092* C. INIT CONFIGURES ITS PARAMETERS BASED UPON TERMINAL INFORM- H0300093* ATION. H0300094* D. INIT DETERMINES IF ENOUGH CORE IS AVAILABLE TO START THE H0300095* SORT. H0300096* E. INIT PREPARES TO CALL OVERLAY SMCEDT. H0300097* H0300098* 2. SMCMON REQUEST SMCEDT BE LOADED TO PROCESS INPUT DIRECTIVES. H0300099* 3. SMCMON REQUEST SMCSRT BE LOADED TO BEGIN THE SORT. H0300100* 4. IF A CORE SORT, SMCMON QUITS. H0300101* 5. IF MERGING IS NEEDED, OVERLAY SMCIMG IS LOADED IF INTERMEDIATEH0300102* MERGING IS NECESSARY. H0300103* 6. OVERLAY SMCFMG IS LOADED TO PERFORM FINAL MERGING. H0300104ÐÐ* 7. CONTROL AT PROGRAM COMPLETION IS RETURNED TO THE DISPATCHER. H0300105* H0300106* H0300107* SUBROUTINES H0300108* ----------- H0300109* H0300110* LOAD LOADS DSORT OVERLAYS H0300111* PGMIN FETCHES PROGRAM INFO FROM ITOS EXECUTIVE H0300112* XREF F.M. ADDRESSES REFERENCED VIA THIS TABLE (SEE H0300113* EXTERNAL ADDRESS EQUATE TABLE) H0300114* H0300115* H0300116* MESSAGES H0300117* -------- H0300118* H0300119* THE MESSAGES FOR ALL OVERLAYS IS LISTED IN THE EQUATES SECTION H0300120* UNDER 'MESSAGE PROCESSOR INDEX EQUATES'. H0300121**** H0300122 EJT 0 H0300123**** H0300124*E H0300125* PARAMETERS H0300126* ---------- H0300127* H0300128* IDATA EQUATES FOR FILE OPEN H0300129ÐÐ SPC 2 H0300130IFLNAM EQU IFLNAM(0) FILE NAME OFFSET H0300131OWRNAM EQU OWRNAM(IFLNAM+4) OWNER ID OFFSET H0300132VOLNAM EQU VOLNAM(OWRNAM+4) VOLUME NAME OFFSET H0300133 SPC 2 H0300134RETRVL EQU RETRVL(VOLNAM+4) RETRIEVAL TECHNIQUE OFFSET H0300135NUMRCD EQU NUMRCD(RETRVL+1) NUMBER OF RECORDS/ ACCESS OFFSET H0300136LCKFLG EQU LCKFLG(NUMRCD+1) LOCK FLAG OFFSET H0300137 SPC 2 H0300138RECSIZ EQU RECSIZ(VOLNAM+4) RECORD SIZE H0300139RECCNT EQU RECCNT(RECSIZ+1) TOTAL RECORD COUNT H0300140FLTYPE EQU FLTYPE(RECCNT+2) END OF IDATA BUFFER H0300141 SPC 5 H0300142* EXTERNAL ADDRESS EQUATE TABLE H0300143 SPC 2 H0300144XCLOSF EQU XCLOSF(0) SMCMON CLOSE FILE ROUTINE H0300145XOPEN EQU XOPEN(1) F.M. OPEN PROCESSOR H0300146XDELET EQU XDELET(2) F.M. DELETE PROCESSOR H0300147XCREAT EQU XCREAT(3) F.M. CREATE PROCESSOR H0300148XCLOSE EQU XCLOSE(4) F.M. CLOSE PROCESSOR H0300149XGETS EQU XGETS(5) F.M. GETS PROCESSOR H0300150XPUTS EQU XPUTS(6) F.M. PUTS PROCESSOR H0300151XGTFCB EQU XGTFCB(7) F.M. GETFCB PROCESSOR H0300152XUPFCB EQU XUPFCB(8) F.M. UPDFCB PROCESSOR H0300153XSYMSG EQU XSYMSG(9) PROGRAM MESSAGE PROCESSOR H0300154ÐÐ**** H0300155 EJT H0300156**** H0300157*E H0300158* OFTEN NEEDED CONSTANTS. H0300159 SPC 2 H0300160ZERO EQU ZERO(2) (2)=0. H0300161HX0020 EQU HX0020($28) ($28)=$0020. H0300162HX00FF EQU HX00FF($A) ($A)=$00FF. H0300163HX01FF EQU HX01FF($B) ($B)=$01FF. H0300164HX03FF EQU HX03FF($C) ($C)=$03FF. H0300165HX0400 EQU HX0400($2D) ($2D)=$0400. H0300166HX0800 EQU HX0800($2E) ($2E)=$0800. H0300167HX1000 EQU HX1000($2F) ($2F)=$1000. H0300168HX4000 EQU HX4000($31) ($31)=$4000. H0300169HX7FFF EQU HX7FFF($42) ($42)=$7FFF. H0300170HXFC00 EQU HXFC00($1C) ($1C)=$FC00. H0300171HXFFFF EQU HXFFFF($12) ($12)=$FFFF. H0300172HXFF00 EQU HXFF00($1A) ($1A)=$FF00. H0300173**** H0300174 EJT 0 H0300175**** H0300176*E H0300177* REQUEST BUFFER INDEXES - FIRST 4 WORDS H0300178 EQU RBATHR(0) REQUEST BUFFER ADDRESS THREAD H0300179ÐÐ EQU BUFAMP(1) BUFFER ADDRESS MAIN PART H0300180 EQU CNTLPT(2) CONTROL POINT (OR SPARE) H0300181 EQU RQINFO(3) REQUEST INFORMATION (MULTI-FIELD) H0300182* BITS USE H0300183* 15-12 SPARE H0300184* 11-04 REQUEST INDEX H0300185* 03-00 LEVEL OF REQUESTOR H0300186* H0300187* REQUEST BUFFER INDEXES - MAIN PART H0300188 EQU QREG(0) Q REGISTER H0300189 EQU IREG(1) I REGISTER H0300190 EQU PARLST(2) ADDRESS OF PARAMETER LIST H0300191 EQU RTNADR(2) RETURN ADDRESS TO USER (UPON RETURN FROM EXEC)H0300192 EQU UCTADR(3) UCT ENTRY ABSOLUTE ADDRESS H0300193 EQU USERID(4) USER IDENTIFIER H0300194 EQU FCBADR(5) FCB ADDRESS (MAY BE SET BY CALLER OR INTCPTR.)H0300195 EQU RADINT(6) RETURN ADDRESS TO INTERCEPTOR H0300196 EQU RPIDX(7) REQUEST PROCESSOR INDEX H0300197* BITS 14-00 REQUEST PROCESSOR INDEX H0300198* BIT 15 TYPE OF PROCESSOR H0300199* =0, SERIAL PROCESSOR H0300200* =1, REENTRANT PROCESSOR H0300201 EQU LOKREC(8) NUMBER OF RECORDS TO BE READ/WRITTEN PER I/O H0300202* CALL AND LOCK RECORDS ON RETRIEVE FLAG H0300203* BITS 14-00 NUMBER OF RECORDS PER CALL H0300204ÐÐ* BIT 15 =0, DO NOT LOCK ON RETRIEVE H0300205* =1, LOCK RECORDS ON RETRIEVE H0300206 EQU USEFLG(9) TYPE OF FILE USE FLAG H0300207* NEGATIVE, OPEN FOR COMPRESS ONLY H0300208* 0, OPEN FOR ACESS VIA REL REC NO H0300209* 1, OPEN FOR RETRIEVAL VIA KEY 1 H0300210* 2, OPEN FOR RETRIEVAL VIA KEY 2 H0300211* 3, OPEN FOR RETRIEVAL VIA KEY 3 H0300212* 4, OPEN FOR RETRIEVAL VIA KEY 4 H0300213 EQU NUMREC(10) NUMBER OF RECORDS ACTUALLY STORED/RETRIEVED H0300214 EQU RRNMSB(11) REL REC NUMBER OF STORED/RETRIEVED REC, MSB H0300215 EQU RRNLSB(12) REL REC NUMBER OF STORED/RETRIEVED REC, LSB H0300216 EQU RMPLEN(20) LENGTH OF REQBUF MAIN PART H0300217**** H0300218 EJT H0300219**** H0300220*E H0300221* VOLUME INFORMATION TABLE H0300222* H0300223 EQU VISLUN(2) SYSTEM LOGICAL UNIT NUMBER (BIT 15=1,NOT READYH0300224* ACCESS VISLUN INDIRECTLY H0300225 EQU VINAME(1) VOLUME NAME - ASCII CHARACTERS 1 AND 2 H0300226* VOLUME NAME - ASCII CHARACTERS 3 AND 4 H0300227* VOLUME NAME - ASCII CHARACTERS 5 AND 6 H0300228* VOLUME NAME - ASCII CHARACTERS 7 AND 8 H0300229ÐÐ EQU VINMBR(5) VOLUME NUMBER - (2 ASCII CHARACTERS) H0300230 EQU VIBMSM(6) BEGINNING OF MANAGEABLE SPACE - MSB H0300231 EQU VIBMSL(7) BEGINNING OF MANAGEABLE SPACE - LSB H0300232 EQU VIASDM(8) AVAILABLE SPACE DIRECTORY ADDRESS - MSB H0300233 EQU VIASDL(9) AVAILABLE SPACE DIRECTORY ADDRESS - LSB H0300234 EQU VIASDS(10) # SECTORS IN AVAILABLE SPACE DIRECTORY H0300235 EQU VILBAM(11) LARGEST BLOCK OF SPACE AVAILABLE - MSB H0300236 EQU VILBAL(12) LARGEST BLOCK OF SPACE AVAILABLE - LSB H0300237 EQU VIWPS(13) WORDS/SECTOR FOR VOLUME H0300238 EQU VIFDDM(14) FILE DEFINITION DIRECTORY ADDRESS - MSB H0300239 EQU VIFDDL(15) FILE DEFINITION DIRECTORY ADDRESS - LSB H0300240 EQU VIMAXF(16) MAX. NUMBER OF FILES PERMITTED ON VOLUME H0300241 EQU VICURF(17) CURRENT NUMBER OF FILES EXISTING ON VOLUME H0300242 EQU VINFDB(18) NUMBER OF BLOCKS IN FILE DEFINITION DIRECTORY H0300243 EQU VINXTB(19) NEXT AVAILABLE BLOCK IF FILE DEF. DIRECTORY H0300244 EQU VINOOF(20) NUMBER OF OPEN FILES ON VOLUME H0300245 SPC 1 H0300246* UCT ENTRY EQUIVALENCES H0300247 EQU UIDENT(ZERO) USER IDENTIFICATION H0300248 EQU FIDENT(1) PSEUDO FILE IDENTIFIER H0300249 EQU FCBCAD(2) FCB CORE ADDRESS H0300250 EQU FSLADR(3) FILE SPACE LIMITS TABLE ENTRY ADDRESS H0300251 EQU FCBSAD(4) FCB SUBSET ADDRESS H0300252**** H0300253 EJT H0300254ÐÐ**** H0300255*E H0300256* FILE CONTROL BLOCK EQUIVALENCES H0300257 EQU FH(4) LENGTH -1 OF FCB HEADER H0300258 EQU FILEID(ZERO) FILE IDENTIFIER H0300259* ACCESS FILEID INDIRECTLY H0300260* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBERH0300261* BITS 10-00 INDEX OF FCB IN FCB TABLE H0300262 EQU FCBFLG(1) FCB FLAGS H0300263* BITS 15-8, SPARE H0300264* BITS 7-00, NUMBER OF USERS USING FILE H0300265 EQU FILOCK(2) FILE LOCK FLAG (IF NON-0, CONTAINS USER ID) H0300266 EQU NUMSET(3) NUMBER OF SETS OF LOCKED RECORDS IN FILE H0300267 EQU NUMNEW(4) NUMBER OF NEW RECORDS SINCE FCB UPDATED ON MM H0300268 SPC 1 H0300269 EQU RECLEN(FH+1) RECORD LENGTH IN WORDS H0300270 EQU TDATRM(FH+2) TOTAL NUMBER OF DATA RECORDS, MSB H0300271 EQU TDATRL(FH+3) TOTAL NUMBER OF DATA RECORDS, LSB H0300272 EQU DATBAM(FH+4) DATA RECORDS BEGINNING SECTOR ADDRESS, MSB H0300273 EQU DATBAL(FH+5) DATA RECORDS BEGINNING SECTOR ADDRESS,LMSB H0300274 EQU FCBIND(FH+6) FCB INDICATORS H0300275* BIT 15 , SECTOR ALLIGNED RECORDS IF =1 H0300276* BIT 14 , STORAGE MODE FOR INDEXED FILE H0300277* =0, RECORDS STORED RANDOMLY WITHH0300278* RESPECT TO PRIMARY KEY H0300279ÐÐ* =1, RECORDS STORED IN ORDER WIT H0300280* RESPECT TO PRIMARY KEY H0300281* BIT 13 , =1, FILE IS CURRENTLY OPEN H0300282* =0, FILE IS CURRENTLY CLOSED H0300283* BIT 12 , =1, FILE IS BEING COMPRESSED H0300284* =0, FILE IS NOT BEING COMPRESSEDH0300285* BIT 0 , FILE TYPE H0300286* =0, SEQUENTIAL FILE H0300287* =1, INDEXED FILE H0300288 EQU NEDATM(FH+7) NUMBER OF EXISTING DATA RECORDS, MSB H0300289 EQU NEDATL(FH+8) NUMBER OF EXISTING DATA RECORDS, LSB H0300290 EQU SEQLTH(NEDATL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION H0300291* OF FCB FOR A SEQUENTIAL FILE H0300292 SPC 1 H0300293 EQU NEXTBM(FH+9) NEXT FREE KEY INDEX BLOCK, MSB H0300294 EQU NEXTBL(FH+10) NEXT FREE KEY INDEX BLOCK, LSB H0300295 EQU TNKEYM(FH+11) TOTAL NUMBER OF KEY INDEX BLOCKS, MSB H0300296 EQU TNKEYL(FH+12) TOTAL NUMBER OF KEY INDEX BLOCKS, LSB H0300297 EQU KEYBAM(FH+13) KEY INDEX BEGINNING SECTOR ADDRESS, MSB H0300298 EQU KEYBAL(FH+14) KEY INDEX BEGINNING SECTOR ADDRESS, LSB H0300299 EQU LENKY1(FH+15) LENGTH OF KEY NO. 1 H0300300 EQU POSKY1(FH+16) BYTE POSITION OF KEY NO. 1 H0300301 EQU LENKY2(FH+17) LENGTH OF KEY NO. 2 H0300302 EQU POSKY2(FH+18) BYTE POSITION OF KEY NO. 2 H0300303 EQU LENKY3(FH+19) LENGTH OF KEY NO. 3 H0300304ÐÐ EQU POSKY3(FH+20) BYTE POSITION OF KEY NO. 3 H0300305 EQU LENKY4(FH+21) LENGTH OF KEY NO. 4 H0300306**** H0300307 EJT H0300308**** H0300309*E H0300310 EQU POSKY4(FH+22) BYTE POSITION OF KEY NO. 4 H0300311 EQU INDLEN(POSKY4-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION H0300312* OF FCB FOR AN INDEXED FILE H0300313* THE FOLLOWING PORTION OF THE FCB EXISTS ONLY H0300314* ON MASS MEMORY. THESE 10 WORDS ARE NOT LOADEDH0300315* INTO EITHER OF THE FILE MANAGER CONTROLLED FCBH0300316* TABLES. H0300317 EQU TSFILM(FH+23) TOTAL NUMBER OF SECTORS IN FILE, MSB H0300318 EQU TSFILL(FH+24) TOTAL NUMBER OF SECTORS IN FILE, LSB H0300319 EQU NAME12(FH+25) FILE NAME, CHARACTERS 1 AND 2 H0300320 EQU NAME34(FH+26) FILE NAME, CHARACTERS 3 AND 4 H0300321 EQU NAME56(FH+27) FILE NAME, CHARACTERS 5 AND 6 H0300322 EQU NAME78(FH+28) FILE NAME, CHARACTERS 7 AND 8 H0300323 EQU OWNR12(FH+29) OWNER NAME, CHARACTERS 1 AND 2 H0300324 EQU OWNR34(FH+30) OWNER NAME, CHARACTERS 3 AND 4 H0300325 EQU OWNR56(FH+31) OWNER NAME, CHARACTERS 5 AND 6 H0300326 EQU OWNR78(FH+32) OWNER NAME, CHARACTERS 7 AND 8 H0300327 EQU BYTLEN(FH+33) BYTE LENGTH OF RECORD H0300328* H0300329ÐÐ* FOR COMPRESS ONLY H0300330* H0300331 EQU PRSRNM(FH+34) RRN OF LAST PROCESSED RECORD - MSB H0300332 EQU PRSRNL(FH+35) RRN OF LAST PROCESSED RECORD - LSB H0300333 EQU NEWRNM(FH+36) RRN OF THE LATEST 'NEW' RECORD - MSB H0300334 EQU NEWRNL(FH+37) RRN OF THE LATEST 'NEW' RECORD - LSB H0300335 SPC 4 H0300336* WORDS 0 THRU 4 OF THE FCB HEADER AND WORDS H0300337* 6 THRU 10 OF THE FCB ARE REFERRED TO AS THE H0300338* SHARED SUBSET OF THE FCB. THEY INCLUDE THE H0300339* ONLY FCB WORDS THAT CAN BE MODIFIED AFTER FILEH0300340* CREATION. IF TWO OR MORE USERS HAVE THE SAME H0300341* FILE OPEN, THERE HAS TO BE A SINGLE MASTER H0300342* COPY OF THE SUBSET THAT RECEIVES (AND RECORDS)H0300343* ALL OF THE UPDATES. THE CONTROLLED SUBSET H0300344* WILL ALWAYS BE PART OF A MAIN MEMORY RESIDENT H0300345* FCB IF THE FCB IS IN A FM CONTROLLED TABLE. H0300346* IF THE FCB IS IN USER SPACE, THE SUBSET MAY ATH0300347* TIMES RESIDE IN THE SUBSET CONTROL TABLE. H0300348 SPC 2 H0300349* ALTERNATE NAMES FOR SUBSET WORDS H0300350 EQU SAFCBI(FH+1) SUBSET ALTERNATE NAME FOR FCBIND H0300351 EQU SADATM(FH+2) SUBSET ALTERNATE NAME FOR NEDATM H0300352 EQU SADATL(FH+3) SUBSET ALTERNATE NAME FOR NEDATL H0300353 EQU SANXTM(FH+4) SUBSET ALTERNATE NAME FOR NEXTBM H0300354ÐÐ EQU SANXTL(FH+5) SUBSET ALTERNATE NAME FOR NEXTBL H0300355**** H0300356 EJT 0 H0300357**** H0300358*E H0300359* FILE TABLE STRUCTURE. H0300360LUN EQU LUN(ZERO) F.M. LOGICAL UNIT NUMBER H0300361FILNUM EQU FILNUM(1) F.M. FILE NUMBER H0300362RECLTH EQU RECLTH(FILNUM+1) RECORD LENGTH H0300363BUFLTH EQU BUFLTH(RECLTH+1) RECORD BLOCK LENGTH H0300364BUFWA EQU BUFWA(BUFLTH+1) FWA OF RECORD BLOCKED BUFFER H0300365RECNT EQU RECNT(BUFWA+1) NUMBER OF RECORDS ENCOUNTERED H0300366DOCNT EQU DOCNT(RECNT+2) NUMBER OF RECORDS PROCESSED H0300367ERRCNT EQU ERRCNT(DOCNT+2) NUMBER OF ERRORS FOUND FOR FILE H0300368RECFWA EQU RECFWA(ERRCNT+1) FWA OF NEXT RECORD IN BLOCK H0300369XFRLTH EQU XFRLTH(RECFWA+1) RECORD BLOCK LENGTH FOR I/O H0300370REQBUF EQU REQBUF(XFRLTH+1) REQUEST BUFFER H0300371REQIND EQU REQIND(REQBUF+24) REQUEST INDICATOR H0300372FCB EQU FCB(REQIND+1) FILE CONTROL BLOCK H0300373 EQU FMSLOP(2) FCB OVERFLOW CORE SPACE INTO FCB INDEX SECT. H0300374FTSIZE EQU FTSIZE(FCB+SEQLTH+FH+1+FMSLOP) SIZE OF FILE TABLE H0300375**** H0300376 EJT H0300377**** H0300378*E H0300379ÐÐ* MISC H0300380* ---- H0300381* H0300382* ** ENTRY POINTS ** H0300383* H0300384 ENT SMCMON H0300385* H0300386* ** EXTERNALS ** H0300387* H0300388 EXT ADAYTO DAY (ASCII) H0300389 EXT AMONTO MONTH (ASCII) H0300390 EXT AYERTO YEAR (ASCII) H0300391 EXT FMRDEL DELETE RECORD CODE H0300392 EXT MMLUTB MASS MEMORY LOGICAL UNIT TABLE H0300393 EXT PGMIN FETCHES PROGRAM INFO FROM ITOS EXECUTIVE H0300394 EXT WKSPLU WORK FILE LU H0300395* H0300396* ** EQUATES ** H0300397* H0300398ADISP EQU ADISP($EA) DISPATCHER ADDRESS H0300399AMONI EQU AMONI($F4) ADDRESS OF MONIOR H0300400BASMSG EQU BASMSG(350-1) BASE ADDRESS TO SORT MESSAGES H0300401EDTSIZ EQU EDTSIZ($600) SIZE OF EDIT RESIDENT. H0300402EXPIRE EQU EXPIRE($3939) EXPIRATION YEAR H0300403FMGSIZ EQU FMGSIZ($FE) SIZE OF FINAL-MERGE RESIDENT. H0300404ÐÐIMGSIZ EQU IMGSIZ($140) SIZE OF INTERMEDIATE-MERGE RESIDENT. H0300405PRLVL EQU PRLVL(0) PRIORITY LEVEL FOR MONITOR REQUEST H0300406SRTSIZ EQU SRTSIZ($1F1) SIZE OF INTERNAL SORT RESIDENT. H0300407 SPC 5 H0300408* EQUATES FOR WIERD CONDITIONS H0300409 SPC 2 H0300410HX4400 EQU HX4400($4400) WIERD REQIND BITS - CREATE H0300411HX4401 EQU HX4401($4401) WIERD REQIND BITS - OPEN H0300412HX6003 EQU HX6003($6003) WIERD REQIND BITS - DELETE H0300413HX600C EQU HX600C($600C) WIERD REQIND BITS - CLOSE H0300414**** H0300415 EJT H0300416**** H0300417*E H0300418* MESSAGE PROCESSOR INDEX EQUATES H0300419 SPC 3 H0300420MSGCLS EQU MSGCLS(1) 'CLOSFL REQIND = $ ' H0300421MSGOPN EQU MSGOPN(2) 'OPENFL REQIND = $ ' H0300422MSGDEL EQU MSGDEL(3) 'DELETE REQIND = $ ' H0300423MSGCRT EQU MSGCRT(4) 'CREATE REQIND = $ ' H0300424MSGRDD EQU MSGRDD(5) 'GETS REQIND = $ ' H0300425MSGWTD EQU MSGWTD(6) 'PUTS REQIND = $ ' H0300426MSGTFB EQU MSGTFB(7) 'GETFCB REQIND = $ ' H0300427MSGFCB EQU MSGFCB(8) 'UPDFCB REQIND = $ ' H0300428MSGVOL EQU MSGVOL(9) 'VOLUME= ' H0300429ÐÐMSFFNO EQU MSGFNO(10) 'FILNAM= ' H0300430* H0300431FM EQU FM(10) SIZE OF F.M. MESSAGE INDEX BLOCK H0300432* H0300433MSGABE EQU MSGABE(FM+1) 'ABNORMAL ERROR = ' H0300434MSGBDR EQU MSGBDR(FM+2) 'BLKSIZ/RECLTH .NE. 1,2,3...' H0300435MSGBLK EQU MSGBLK(FM+3) ' ' H0300436MSGBOM EQU MSGBOM(FM+4) 'FATAL ERROR' H0300437MSGDUN EQU MSGDUN(FM+5) 'DONE = ' H0300438MSGESC EQU MSGESC(FM+6) 'TYPE-IN ERROR' H0300439MSGEXP EQU MSGEXP(FM+7) 'EXPECTED /FOUND ' H0300440MSGIFL EQU MSGIFL(FM+8) 'CANNOT OPEN INPUT FILE' H0300441MSGTLC EQU MSGTLC(FM+9) 'TOO LITTLE CORE' H0300442MSGINE EQU MSGINE(FM+10) 'INTERPHASE RECORD COUNTS DISAGREE' H0300443MSGINP EQU MSGINP(FM+11) PRINTS INPUT DIRECTIVE CARD H0300444MSGPAS EQU MSGPAS(FM+12) 'PASSED = ' H0300445MSGSDE EQU MSGSDE(FM+13) 'SEQ. DIR. ERROR' H0300446MSGTLD EQU MSGTLD(FM+14) 'TOO LITTLE DISK' H0300447MSGTRC EQU MSGTRC(FM+15) 'OUTPUT RECORD COUNT BAD' H0300448MSGIFR EQU MSGIFR(FM+16) 'INPUT FILE LENGTHS ARE NOT EQUAL' H0300449MSGFLN EQU MSGFLN(FM+17) 'FN= , ' H0300450MSGOFR EQU MSGOFR(FM+18) 'OUTPUT FILE RECORD LENGTH IS ZERO' H0300451MSGASO EQU MSGASO(FM+19) 'ADDROUT SORTS ONLY 1 FILE' H0300452MSGVNM EQU MSGVNM(FM+20) 'VOLUME NOT MOUNTED' H0300453MSGSOK EQU MSGSOK(FM+21) 'START OF KEY FIELD OUTSIDE OF RECORD' H0300454ÐÐMSGKEB EQU MSGKEB(FM+22) 'KEY FIELD EXTENDS BEYOND END OF RECORD' H0300455**** H0300456 EJT H0300457SMCMON NUM 0 () = FWA OF LOAD IN SMC. H0300458 RTJ INIT INITIALIZE SMCMON. H0300459HERE EQU HERE(*) RELOC REFERENCE POINT. H0300460* AMONG OTHER THINGS, INIT VERIFIED THAT THERE WAS ENOUGH CORE TO LOAD H0300461* SMCEDT, AND INIT SET (A)EXIT = 0 TO SELECT SMCEDT, AND INIT SET H0300462* (Q)EXIT = FWA OF LOAD POINT OF SMCEDT, PREPARING FOR THE LOAD BELOW. H0300463 RTJ* (SMCMON) RUN EDIT. H0300464SMCDEF LDA =XPTSQFT-HERE (A) = FWA OF PUTSEQ FILE TABLE H0300465 STA- I H0300466 RTJ DEF DEFINE SEQUENCE DIRECTORY H0300467 LDQ YADRBF USED ONLY FOR ADDROUT SORTS H0300468 STQ RELAD1 ADDRESS FOR MSB PORTION OF REL REC NUMBER H0300469 INQ 1 H0300470 STQ RELAD2 ADDRESS FOR LSB PORTION OF REL REC NUMBER H0300471 ENA 1*3 SELECT SMCSRT. H0300472 LDQ YEND (Q) = 1 + LWA OF VARIABLE TABLES. H0300473 RTJ* (SMCMON) RUN SMCSRT. H0300474* SMCSRT TAKES A P+1 EXIT FOR A CORE SORT, AND A P+2 EXIT FOR A SORT RUNH0300475 JMP* SMCREL JMP IF A CORE SORT AND RELEASE SEQ DIRECTORY H0300476* IT]S A SORT RUN. H0300477* LET]S SEE IF INTERMEDIATE MERGING CAN BE SKIPPED. H0300478 LDA YFWAY (A) = MAXIMUM ORDER OF FINAL MERGE. H0300479ÐÐ SUB YSQ2MG SUBTRACT NO. OF STRINGS TO MERGE. H0300480 SAP SMCFMG SKIP INTERMEDIATE MERGING IF POSSIBLE. H0300481* LET]S CONTINUE SORT RUN WITH INTERMEDIATE MERGING. H0300482 ENA 2*3 SELECT SMCIMG. H0300483 LDQ YADRBF (Q) = 1 + LWA OF NEEDED VARIABLE TABLES. H0300484 INQ 2 ALLOW FOR REL RECORD NUMBERS STORED H0300485 RTJ* (SMCMON) RUN SMCIMG. H0300486SMCFMG ENA 3*3 SELECT SMCFMG. H0300487 LDQ YADRBF (Q) = 1 + LWA OF NEEDED VARIABLE TABLES. H0300488 INQ 2 ALLOW FOR REL RECORD NUMBERS STORED H0300489 RTJ* (SMCMON) RUN SMCFMG. H0300490* RELEASE THE SEG. LIST AND THE LAST SEGMENT OF THE SEQUENCE DIRECTORY. H0300491SMCREL LDA =XPTSQFT-HERE (A) = FWA OF PUTSEQ FILE-TABLE. H0300492 STA- I TELL REL WHAT FILE-TABLE TO USE. H0300493 RTJ REL RELEASE THE LAST SEGMENT OF THE SEQ. DIR. H0300494 JMP- (ADISP) EXIT TO MSOS. H0300495 EJT H0300496**** H0300497* ********************* H0300498* * SUBROUTINE USUAGE * H0300499* ********************* H0300500* H0300501* H0300502* THE FOLLOWING SUBROUTINES ARE RESIDENT IN SMCMON. THEY ARE CALLED H0300503* BY OVERLAYS SMCEDT, SMCSRT, SMCIMG, AND SMCFMG. H0300504ÐÐ* H0300505* 1. CMPKEY 15. DATMV 29. OPEN 43. CRTMSG H0300506* 2. CLR 16. MOVFWA 30. CLOSE 44. TYPIN H0300507* 3. BIGCNT 17. CLSU 31. COMIO 45. BINHEX H0300508* 4. BIGADD 18. REL 32. CLOSF 46. BZHXBT H0300509* 5. RECADD 19. GETSEQ 33. ISTUFF 47. BINDEC H0300510* 6. TYRCT 20. PUTSEQ 34. NAMEFL 48. HADOUT H0300511* 7. TYRCTY 21. BOS 35. DATE 49. BOMB H0300512* 8. GETU 22. EOS 36. GETFCB 50. TPDEC H0300513* 9. RAOADD 23. RDD 37. VOLSRH 51. BTDEC H0300514* 10. SELECT 24. WRTD 38. COLSEQ 52. TPHEX H0300515* 11. KYMOVE 25. DEF 39. MVCHRS 53. HXBCD H0300516* 12. BADBLK 26. CNTREC 40. MOVE 54. WIERD H0300517* 13. LUFNO 27. DEFFIL 41. SAVAQI 55. INIT H0300518* 14. PUTU 28. RELFIL 42. RESAQI 56. RELOC H0300519**** H0300520 EJT 0 H0300521**** H0300522*E H0300523* *********** H0300524* * CMP KEY * H0300525* *********** H0300526* H0300527* H0300528* THE CALLING SEQUENCE IS (A)ENTRY = FWA OF 1ST RECORD. H0300529ÐÐ* (Q)ENTRY = FWA OF 2ND RECORD. H0300530* RTJ CMPKEY H0300531* (KEYTBL)ENTRY = FWA OF THE KEY TABLE. H0300532* (I)EXIT = (I)ENTRY. H0300533* (KEYTBL)EXIT = (KEYTBL)ENTRY. H0300534* IF NO TIE, THEN H0300535* (A)EXIT = FWA OF WINNER RECORD H0300536* (Q)EXIT = FWA OF LOSER RECORD. H0300537* IF TIE, THEN H0300538* (A),(Q) EXIT = (A),(Q) ENTRY. H0300539* THE SPEED OF CMPKEY IS CRITICAL DUE TO GREATER FREQUENCY OF USAGE H0300540* THAN ANY OTHER ROUTINE. H0300541* H0300542* CMPKEY COMPARES TWO LOGICAL RECORDS AS PER USER-DEFINED KEY FIELDS. H0300543* THE KEY FIELDS ARE DEFINED BY A TABLE WHOSE FWA = (KEYTBL). H0300544* H0300545* CMPKEY BUMPS KEYPTR ALONG AS IT PROGRESSES THROUGH THE KEY TABLE, H0300546* COMPARING KEYS FROM THE MOST MAJOR TO THE MOST MINOR, AS PER THE H0300547* GUIDANCE OF THE KEY TABLE. H0300548* H0300549* THE KEY TABLE FORMAT WAS DESIGNED TO OPTIMIZE THE PERFORMANCE OF H0300550* CMPKEY. H0300551* H0300552* SAMPLE KEY STATEMENT AND CORRESPONDING KEY TABLE H0300553* H0300554ÐÐ* SAMPLE KEY STATEMENT H0300555* H0300556* KY=D,3,20,A,28,6,A,34,5,D,39,3,A,43,2 H0300557* H0300558* SAMPLE KEY TABLE H0300559* H0300560* D,3,20 * WORD 00 * (]15)=0,(]14-]0)=FWA KEY-FWA RECORD=0. H0300561* * WORD 01 * ()=-1+FWA CMPWD. H0300562* * WORD 02 * ()=1+LWA KEY-FWA RECORD=10. H0300563* H0300564* A,28,6 * WORD 03 * (]15)=0,(]14-]0)=FWA KEY-FWA RECORD=10. H0300565* * WORD 04 * ()=-1+FWA CMPCLA. H0300566* * WORD 05 * (]15)=0,(]14-]0)=FWA KEY-FWA RECORD=11. H0300567* * WORD 06 * ()=-1+FWA CMPWA. H0300568* * WORD 07 * ()=1+LWA KEY-FWA RECORD=13. H0300569* * WORD 08 * (]15)=0,(]14-]0)=FWA KEY-FWA RECORD=13. H0300570* * WORD 09 * ()=-1+FWA CMPCUA. H0300571**** H0300572 EJT 0 H0300573**** H0300574*E H0300575* A,34,5 * WORD 10 * (]15)=0,(]14-]0)=FWA KEY-FWA RECORD=13. H0300576* * WORD 11 * ()=-1+FWA CMPCUA. H0300577* * WORD 12 * (]15)=0,(]14-]0)=FWA KEY-FWA RECORD=14. H0300578* * WORD 13 * ()=-1+FWA CMPWA. H0300579ÐÐ* * WORD 14 * ()=1+LWA KEY-FWA RECORD=16. H0300580* H0300581* D,39,3 * WORD 15 * (]15)=0,(]14-]0)=FWA KEY-FWA RECORD=16. H0300582* * WORD 16 * ()=-1+FWA CMPLD. H0300583* * WORD 17 * (]15)=0,(]14-]0)=FWA KEY-FWA RECORD=17. H0300584* * WORD 18 * ()=-1+FWA CMPCUD. H0300585* H0300586* A,43,2 * WORD 19 * (]15)=0,(]14-]0)=FWA KEY-FWA RECORD=18. H0300587* * WORD 20 * ()=-1+FWA CMPLA. H0300588* H0300589* TABLE TERMINATOR * WORD 21 * ()=-0. H0300590* H0300591* AXIOMS DESCRIBING KEY TABLE GENERATION AND FORMAT H0300592* H0300593* A/D,(EVEN COLUMN),1 USES CMPCLA/CMPCLD. H0300594* A/D,(ODD COLUMN),1 USES CMPCUA/CMPCUD. H0300595* A/D,(ODD COLUMN),2 USES CMPLA/CMPLD. H0300596* A/D,(ODD COLUMN),(4+2N FOR N=0,1,2...) USES CMPWA/CMPWD. H0300597* H0300598* THE KEY TABLE ENDS WITH -0. H0300599* H0300600* NOTICE HOW THE AXIOMS APPLY TO THE SAMPLE KEY TABLE. H0300601**** H0300602 EJT H0300603* ASCENDING LOGICAL BINARY. H0300604ÐÐCMPLA LDA* (CMPA),I (A) = 16] L KEY OF AREC. H0300605 LDQ* (CMPQ),I (Q) = 16] L KEY OF QREC. H0300606 SAM CMPLA1 SKIP IF AREC -. H0300607* AREC +. H0300608 SQP CMPLA2 AREC +, SKIP IF QREC +. H0300609 JMP* CPAWON AREC +, QREC -. H0300610* AREC -. H0300611CMPLA1 SQP CMPLA3 AREC -, SKIP IF QREC +. H0300612* AREC AND QREC HAVE SAME SIGN. H0300613CMPLA2 SUB* (CMPQ),I (A) = AREC - QREC. H0300614* INA 0 NOT NEEDED SINCE -0 - +0 CAN]T HAPPEN HERE SINCE SAME SIGNS. H0300615 SAN CMPLA4 SKIP IF NO TIE. H0300616 JMP* CMPTIE JMP IF TIE. H0300617* AREC AND QREC HAVE SAME SIGN, NO TIE. H0300618CMPLA4 SAP CMPLA3 SAME SIGN, NO TIE, SKIP IF AREC-QREC +. H0300619 JMP* CPAWON NO TIE, AREC-QREC -. H0300620CMPLA3 JMP* CPQWON QREC WINS. H0300621 EJT H0300622* DESCENDING LOGICAL BINARY. H0300623CMPLD LDA* (CMPA),I (A) = 16] L KEY OF AREC. H0300624 LDQ* (CMPQ),I (Q) = 16] L KEY OF QREC. H0300625 SAP CMPLD1 SKIP IF AREC +. H0300626 SQM CMPLD2 AREC -, SKIP IF QREC -. H0300627 JMP* CPAWON AREC -. QREC +. AREC WINS. H0300628* AREC +. H0300629ÐÐCMPLD1 SQM CMPLD3 AREC +. SKIP IF QREC -. H0300630* AREC AND QREC HAVE SAME SIGN. H0300631CMPLD2 SUB* (CMPQ),I (A) = AREC - QREC. H0300632* INA 0 NOT NEEDED SINCE -0 - +0 CAN]T HAPPEN HERE SINCE SAME SIGNS. H0300633 SAN CMPLD4 SKIP IF NO TIE. H0300634 JMP* CMPTIE JMP IF TIE. H0300635* SAME SIGNS. NO TIE. H0300636CMPLD4 SAM CMPLD3 SAME SIGNS. NO TIE. SKIP IF AREC-QREC -. H0300637 JMP* CPAWON SAME SIGNS. NO TIE. AREC-QREC +. AREC WINS. H0300638CMPLD3 JMP* CPQWON QREC WINS. H0300639 EJT H0300640CMPA NUM 0 () = (A)ENTRY = FWA OF AREC. H0300641CMPQ NUM 0 () = (Q)ENTRY = FWA OF QREC. H0300642CMPI NUM 0 () = (I)ENTRY. H0300643CMPTIE RAO* KEYPTR POINT TO NEXT ENTRY IN KEY TABLE. H0300644CMPNXT LDA* (KEYPTR) (A) = (1ST WD OF CURRENT ENTRY IN KEY TBL). H0300645 SAM CPAWON SKIP IF END-OF-KEY-TABLE. H0300646 STA- I (I) = FWA OF KEY - FWA OF RECORD. H0300647 RAO* KEYPTR POINT TO ADDRESS OF TAILORED LOGIC. H0300648 LDQ* (KEYPTR) (Q) = -1 + FWA OF TAILORED LOGIC. H0300649 JMP- 1,Q JMP TO TAILORED LOGIC. H0300650KEYPTR NUM 0 () = FWA OF CURRENT WORD IN KEY TABLE. H0300651* AREC WINS. H0300652CPAWON LDA* CMPA (A) = (A)ENTRY = FWA OF AREC. H0300653 LDQ* CMPI (Q) = (I)ENTRY. H0300654ÐÐ STQ- I RESTORE (I)ENTRY. H0300655 LDQ* CMPQ (Q) = (Q)ENTRY = FWA OF QREC. H0300656 JMP* (CMPKEY) EXIT. H0300657* QREC WINS. H0300658CPQWON LDA* CMPQ (A) = (Q)ENTRY = FWA OF QREC. H0300659 LDQ* CMPI (Q) = (I)ENTRY. H0300660 STQ- I RESTORE (I)ENTRY. H0300661 LDQ* CMPA (Q) = (A)ENTRY = FWA OF AREC. H0300662 JMP* (CMPKEY) EXIT. H0300663***ENTRY TO COMPARE LOGIC*** H0300664CMPKEY NUM 0 H0300665 STA* CMPA SAVE (A)ENTRY. H0300666 STQ* CMPQ SAVE (Q)ENTRY. H0300667 LDQ- I (Q) = (I)ENTRY. H0300668 STQ* CMPI SAVE (I)ENTRY. H0300669 LDQ* (CMPKEY) (Q) = FWA OF THE KEY TABLE. H0300670 RAO* CMPKEY SET UP RETURN ADDRESS H0300671 STQ* KEYPTR POINT TO 1ST ENTRY OF KEY TABLE. H0300672 JMP* CMPNXT DO THE NEXT (I.E. 1ST) KEY. H0300673 EJT H0300674* ASCENDING SINGLE CHAR, EVEN COLUMN. H0300675CMPCLA LDA* (CMPQ),I H0300676 AND- HX00FF (A)7-0 = 1ST 8' OF QREC KEY. H0300677 TCA Q (Q) = - 1ST 8] OF QREC KEY. H0300678 LDA* (CMPA),I H0300679ÐÐ AND- HX00FF (A)7-0 = 1ST 8' OF AREC KEY. H0300680 AAQ A (A) = AREC - QREC. H0300681* INA 0 NOT NEEDED SINCE -0 - +0 CAN]T HAPPEN HERE SINCE BOTH ARE +. H0300682 SAN 1 SKIP IF NO TIE. H0300683 JMP* CMPTIE JMP IF TIE. H0300684* NO TIE. H0300685 SAP 1 NO TIE. SKIP IF AREC-QREC +. H0300686 JMP* CPAWON NO TIE. AREC-QREC -. H0300687* NO TIE. AREC-QREC +. QREC WINS. H0300688 JMP* CPQWON H0300689 EJT H0300690* DESCENDING SINGLE CHAR, EVEN COLUMN. H0300691CMPCLD LDA* (CMPQ),I H0300692 AND- HX00FF (A)7-0 = 1ST 8' OF QREC KEY. H0300693 TCA Q (Q) = - 1ST 8] OF QREC KEY. H0300694 LDA* (CMPA),I H0300695 AND- HX00FF (A)7-0 = 1ST 8' OF AREC KEY. H0300696 AAQ A (A) = AREC - QREC. H0300697* INA 0 NOT NEEDED SINCE -0 - +0 CAN]T HAPPEN SINCE BOTH ARE +. H0300698 SAN 1 SKIP IF NO TIE. H0300699 JMP* CMPTIE JMP IF TIE. H0300700* NO TIE. H0300701 SAM 1 NO TIE. SKIP IF AREC-QREC -. H0300702 JMP* CPAWON NO TIE. AREC-QREC +. H0300703* NO TIE. AREC-QREC -. QREC WINS. H0300704ÐÐ JMP* CPQWON H0300705 EJT H0300706* ASCENDING SINGLE CHAR, ODD COLUMN. H0300707CMPCUA LDA* (CMPQ),I H0300708 AND- HXFF00 (A)7-0 = 1ST 8' OF QREC KEY. H0300709 ALS 8 H0300710 TCA Q (Q) = - 1ST 8] OF QREC KEY. H0300711 LDA* (CMPA),I H0300712 AND- HXFF00 (A)7-0 = 1ST 8' OF AREC KEY. H0300713 ALS 8 H0300714 AAQ A (A) = AREC - QREC. H0300715* INA 0 NOT NEEDED SINCE -0 - +0 CAN]T HAPPEN SINCE BOTH ARE +. H0300716 SAN 1 SKIP IF NO TIE. H0300717 JMP* CMPTIE JMP IF TIE. H0300718* NO TIE. H0300719 SAP 1 NO TIE. SKIP IF AREC-QREC +. H0300720 JMP* CPAWON NO TIE. AREC-QREC -. H0300721* NO TIE. AREC-QREC +. QREC WINS. H0300722 JMP* CPQWON H0300723 EJT H0300724* DESCENDING SINGLE CHAR, ODD COLUMN. H0300725CMPCUD LDA* (CMPQ),I H0300726 AND- HXFF00 (A)7-0 = 1ST 8' OF QREC KEY. H0300727 ALS 8 H0300728 TCA Q (Q) = - 1ST 8] OF QREC KEY. H0300729ÐÐ LDA* (CMPA),I H0300730 AND- HXFF00 (A)7-0 = 1ST 8' OF AREC KEY. H0300731 ALS 8 H0300732 AAQ A (A) = AREC - QREC. H0300733* INA 0 NOT NEEDED SINCE -0 - +0 CAN]T HAPPEN SINCE BOTH ARE +. H0300734 SAN 1 SKIP IF NO TIE. H0300735 JMP* CMPTIE JMP IF TIE. H0300736* NO TIE. H0300737 SAM 1 NO TIE. SKIP IF AREC-QREC -. H0300738 JMP* CPAWON NO TIE. AREC-QREC +. H0300739* NO TIE. AREC-QREC -. QREC WINS. H0300740 JMP* CPQWON H0300741 EJT H0300742* ASCENDING MULTIPLE WORD LOGICAL BINARY KEY. H0300743CMPWA5 RAO- I (I) = FWA OF NEXT WORD OF KEY - FWA OF RECORD. H0300744 LDQ* KEYPTR (Q) = FWA OF 2ND WORD OF KEY TABLE ENTRY. H0300745 LDA- 1,Q (A) = (3RD WORD) = 1 + LWA OF KEY - FWA OF RECORD. H0300746 EOR- I (A)=0 IF DONE WITH KEY. H0300747 SAN CMPWA SKIP IF NOT DONE. H0300748* WE ARE DONE WITH KEY AND DIDN]T BREAK TIE. H0300749 RAO* KEYPTR (KEYPTR) = LWA OF ENTRY FOR CURRENT KEY. H0300750 JMP* CMPTIE DO NEXT KEY. H0300751CMPWA LDA* (CMPA),I (A) = NEXT WORD OF AREC KEY. H0300752 LDQ* (CMPQ),I (Q) = NEXT WORD OF QREC KEY. H0300753 SAM CMPWA1 SKIP IF AREC -. H0300754ÐÐ* AREC +. H0300755 SQP CMPWA2 AREC +. SKIP IF QREC +. H0300756 JMP* CPAWON AREC +. QREC -. AREC WINS. H0300757* AREC -. H0300758CMPWA1 SQP CMPWA3 AREC -. SKIP IF QREC +. H0300759* AREC AND QREC HAVE SAME SIGN. H0300760CMPWA2 SUB* (CMPQ),I (A) = AREC - QREC. H0300761* INA 0 NOT NEEDED SINCE -0 - +0 CAN]T HAPPEN HERE SINCE SAME SIGNS. H0300762 SAN CMPWA4 SKIP IF NO TIE. H0300763 JMP* CMPWA5 JMP IF TIE. H0300764* NO TIE. AREC AND QREC HAVE SAME SIGN. H0300765CMPWA4 SAP CMPWA3 NO TIE. SKIP IF AREC-QREC +. H0300766 JMP* CPAWON NO TIE. AREC-QREC -. H0300767CMPWA3 JMP* CPQWON QREC WINS. H0300768 EJT H0300769* DESCENDING MULTIPLE-WORD LOGICAL BINARY KEY. H0300770CMPWD5 RAO- I (I) = FWA OF NEXT WORD OF KEY - FWA OF RECORD. H0300771 LDQ* KEYPTR (Q) = FWA OF 2ND WORD OF KEY TABLE ENTRY. H0300772 LDA- 1,Q (A) = (3RD WORD) = 1 + LWA OF KEY - FWA OF RECORD. H0300773 EOR- I (A)=0 IF DONE WITH KEY. H0300774 SAN CMPWD SKIP IF NOT DONE. H0300775* WE ARE DONE WITH KEY AND DIDN]T BREAK TIE. H0300776 RAO* KEYPTR (KEYPTR) = LWA OF ENTRY FOR CURRENT KEY. H0300777 JMP* CMPTIE DO NEXT KEY. H0300778CMPWD LDA* (CMPA),I (A) = NEXT WORD OF AREC KEY. H0300779ÐÐ LDQ* (CMPQ),I (Q) = NEXT WORD OF QREC KEY. H0300780 SAP CMPWD1 SKIP IF AREC +. H0300781* AREC -. H0300782 SQM CMPWD2 AREC -. SKIP IF QREC -. H0300783 JMP* CPAWON AREC -. QREC +. H0300784* AREC +. H0300785CMPWD1 SQM CMPWD3 AREC +. SKIP IF QREC -. H0300786* AREC AND QREC HAVE SAME SIGN. H0300787CMPWD2 SUB* (CMPQ),I (A) = AREC - QREC. H0300788* INA 0 NOT NEEDED SINCE -0 - +0 CAN]T HAPPEN HERE SINCE SAME SIGNS. H0300789 SAN CMPWD4 SKIP IF NO TIE. H0300790 JMP* CMPWD5 JMP IF TIE. H0300791* NO TIE. AREC AND QREC HAVE SAME SIGN. H0300792CMPWD4 SAM CMPWD3 NO TIE. SKIP IF AREC-QREC -. H0300793 JMP* CPAWON NO TIE. AREC-QREC +. H0300794CMPWD3 JMP* CPQWON QREC WINS. H0300795 EJT H0300796**** H0300797*E H0300798* ******* H0300799* * CLR * H0300800* ******* H0300801* H0300802* H0300803* THE CALLING SEQUENCE IS (A) = FWA OF AREA TO ZERO. H0300804ÐÐ* (Q) = NO. OF WORDS TO ZERO. H0300805* RTJ CLR ZERO AREA FROM RIGHT TO LEFT. H0300806* (A),(Q),(I) EXIT = (A),(Q),(I) ENTRY. H0300807**** H0300808CLR NUM 0 H0300809 STA* CLRA SAVE (A)ENTRY AND SET FWA FOR ZEROING. H0300810 STQ* CLRQ SAVE (Q)ENTRY. H0300811 CLR A H0300812CLRINQ INQ -1 (Q) = RELATIVE LWA OF AREA NOT YET ZEROED. H0300813 SQP CLRSTA SKIP IF NOT YET DONE. H0300814 LDA* CLRA RESTORE (A)ENTRY. H0300815 LDQ* CLRQ RESTORE (Q)ENTRY. H0300816 JMP* (CLR) EXIT. H0300817CLRSTA STA+ 0,Q ZERO A WORD. H0300818CLRA EQU CLRA(*-1) H0300819 JMP* CLRINQ SEE IF WE ARE DONE YET. H0300820CLRQ NUM 0 () = (Q)ENTRY. H0300821 EJT H0300822**** H0300823*E H0300824* ********** H0300825* * BIGCNT * H0300826* ********** H0300827* H0300828* H0300829ÐÐ* THE CALLING SEQUENCE IS (Q)ENTRY = -1 + FWA OF 2 WORD COUNTER. H0300830* RTJ BIGCNT H0300831* (A),(Q),(I) EXIT = (A),(Q),(I) ENTRY. H0300832* BIGCNT COUNTS UP TO 9999 IN THE 2ND WORD. H0300833* WHEN THE 2ND WORD REACHES 10000, IT IS ZEROED, H0300834* AND 1 IS ADDED TO THE 1ST WORD. H0300835**** H0300836BIGCNT NUM 0 H0300837 STA* BIGCTA SAVE (A)ENTRY. H0300838 RAO- 2,Q INCREMENT 2ND WORD OF COUNT. H0300839 LDA- 2,Q (A) = TENTATIVE (2ND WORD OF COUNT). H0300840 SUB =N10000 (A).GE.0 IF OVERFLOW OF 2ND WORD OF COUNT. H0300841 SAM BIGCTX SKIP IF NO OVERFLOW. H0300842 STA- 2,Q ZERO 2ND WORD OF COUNT. H0300843 RAO- 1,Q INCREMENT 1ST WORD OF COUNT. H0300844BIGCTX LDA* BIGCTA RESTORE (A)ENTRY. H0300845 JMP* (BIGCNT) EXIT. H0300846BIGCTA NUM 0 () = (A)ENTRY. H0300847 EJT H0300848**** H0300849*E H0300850* ********** H0300851* * BIGADD * H0300852* ********** H0300853* H0300854ÐÐ* H0300855* 2-WORD-AUGEND + 2-WORD-ADDEND = 2-WORD-SUM. H0300856*...,$270F270F,...,$00010000,$0000270F,...,$00000000,$FFFE270F,... H0300857* = ...99999999,...,10000,9999,...,0,-1,... RESPECTIVELY. H0300858* THE CALLING SEQUENCE IS (Q)ENTRY = -1 + FWA OF 2-WORD-AUGEND. H0300859* (A)ENTRY=0 MEANS 2-WORD-ADDEND IS (YBIGQ),(YBIGA), ELSE H0300860* (A)ENTRY = FWA OF 2-WORD-ADDEND. H0300861* RTJ BIGADD H0300862* (Q)EXIT = (XBIGQ)EXIT = 1ST HALF OF SUM. H0300863* (A)EXIT = (XBIGA)EXIT = 2ND HALF OF SUM. H0300864**** H0300865BIGADD NUM 0 H0300866 SAN BGADSA SKIP IF (A) = FWA OF 2-WORD-ADDEND. H0300867BGADLA LDA =XXBIGQ-HERE USE (XBIGQ),(XBIGA) AS A-OPERAND. H0300868BGADSA STA* BIGFWA () = FWA OF 1ST HALF OF ADDEND. H0300869 LDA- 1,Q (A) = 1ST HALF OF AUGEND. H0300870 ADD* (BIGFWA) (A) = SUM OF 1ST HALVES OF AUGEND AND ADDENDH0300871 STA* XBIGQ SAVE TENTATIVE 1ST HALF OF SUM. H0300872 RAO* BIGFWA () = FWA OF 2ND HALF OF ADDEND. H0300873 LDA- 2,Q (A) = 1ST HALF OF AUGEND. H0300874 ADD* (BIGFWA) (A) = SUM OF 2ND HALVES OF AUGEND AND ADDENDH0300875* NOW TO CHECK FOR AND HANDLE CARRY FROM 2ND HALF TO 1ST HALF. H0300876 SUB* D10000 (A)15=0 IF THERE IS A CARRY. H0300877 SAP BGADDC SKIP IF THERE IS A CARRY. H0300878 ADD* D10000 UNDO THE ABOVE SUBTRACT IN CHECK FOR CARRY. H0300879ÐÐBGADDX STA* XBIGA (A) = 2ND HALF OF SUM. H0300880 LDQ* XBIGQ (Q) = 1ST HALF OF SUM. H0300881 JMP* (BIGADD) EXIT. H0300882BGADDC RAO* XBIGQ ADD THE CARRY TO 1ST HALF OF SUM. H0300883 JMP* BGADDX PREPARE TO EXIT. H0300884BIGFWA NUM 0 ()EXIT = 1 + FWA OF 2ND OPERAND. H0300885D10000 NUM 10000 H0300886XBIGQ NUM 0 () = 1ST HALF OF 2 WORD RESULT H0300887XBIGA NUM 0 () = 2ND HALF OF 2 WORD RESULT H0300888 EJT 0 H0300889**** H0300890*E H0300891* ********** H0300892* * RECADD * H0300893* ********** H0300894* H0300895* H0300896* THE CALLING SEQUENCE IS (I)ENTRY = CURRENT FWA OF FILE TABLE H0300897* RTJ RECADD H0300898* (I)EXIT = (I)ENTRY H0300899* ADDS EXISTING RECORD COUNT TO YRECNT, YRECNT+1 H0300900**** H0300901 SPC 2 H0300902RECADD NUM 0 H0300903 LDQ =XREQBUF,I REQUEST BUFFER ADDRESS H0300904ÐÐ LDQ- UCTADR+RQINFO+1,Q UCT ADDRESS H0300905 LDA- FCBSAD,Q FCB SUBSET ADDRESS H0300906 LDQ- FCBCAD,Q FCB CORE ADDRESS H0300907 EAQ A H0300908 SAN REC10 SKIP IF ALTERNATE NEEDED H0300909 INQ NEDATM-SADATM OFFSET TO NEDATM H0300910REC10 LDQ =XSADATM,Q ADDRESS TO NO. OF EXISTING RECORDS H0300911 STQ* CNTADR H0300912 LDQ* RCADR ADDRESS OF YRECNT -1 H0300913 LDA* (CNTADR) H0300914 ADD- 1,Q ACCUMULATE MOST SIGNIFICANT PART OF NUMBER H0300915 STA- 1,Q H0300916 RAO* CNTADR H0300917 LDA* (CNTADR) LEAST SIGNIFICANT OPERAND 1 H0300918 LDQ- 2,Q LEAST SIGNIFICANT OPERAND 2 H0300919 SAP REC20 H0300920 SQP REC30 SKIP IF (A) < 0, (Q) > 0, MAY OVERFLOW H0300921 AAQ A (A) < 0, (Q) > 0, AUTOMATIC OVERFLOW H0300922 JMP* REC40 H0300923REC20 SQP REC60 SKIP IF (A),(Q) > 0, NO OVERFLOW H0300924* (A),(Q) ARE OF OPPOSITE SIGNS. THEY MAY OVERFLOW H0300925REC30 AAQ A H0300926 SAM REC70 SKIP IF NO OVER FLOW OCCURS H0300927 SAZ REC50 H0300928REC40 LDQ* RCADR H0300929ÐÐ RAO- 1,Q BUMP MOST SIGNIFICANT PART SINCE OVERFLOW H0300930 INA -1 H0300931 JMP* REC80 H0300932REC50 SET A,Q INCLUDE $FFFF IN COUNT (NO OVERFLOW) H0300933REC60 AAQ A H0300934REC70 LDQ* RCADR H0300935REC80 STA- 2,Q SAVE LEAST SIGNIFICANT PART H0300936 JMP* (RECADD) RETURN H0300937 SPC 3 H0300938CNTADR BSS CNTADR ADDRESS OF OPERAND TO BE ADDED TO ACCUMULATOR H0300939RCADR ADC YRECNT-1-HERE -1+FWA OF ACCUMULATOR H0300940 EJT H0300941**** H0300942*E H0300943* ********* H0300944* * TYRCT * H0300945* ********* H0300946* H0300947* H0300948* TYRCT SHOULD BE CALLED AT THE END OF EACH FILE HANDLED BY GETU OR CLSUH0300949* TYRCT COMPUTES AND PUBLISHES THE NUMBER OF RECORDS PASSED AND INCLUDEDH0300950* TYRCT ADDS THE INCLUDED COUNT TO THE 2-WORD ACCUMULATOR H0300951* WHOSE FWA = (P+1). H0300952* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF FILE TABLE. H0300953* P RTJ TYRCT H0300954ÐÐ* P+1 -1 + FWA OF 2-WORD INCLUDED-ACCUMULATOR.H0300955* P+2 EXIT. H0300956* (YBIGQ),(YBIGA) EXIT H0300957* = NEW (INCLUDED-ACCUMULATOR). H0300958* (I)EXIT = (I)ENTRY. H0300959**** H0300960TYRCT0 ADC XBIGQ-HERE () = FWA OF XBIGQ. H0300961TYRCT1 ADC BTDEC-HERE () = FWA OF BTDEC. H0300962TYRCT NUM 0 H0300963 LDA- (LUN),I H0300964 ALS 15-14 H0300965 SAP TYRCT2 SKIP IF NOT WORK FILE H0300966 JMP* TYRCT5 DO NOT REPORT WORK FILE RECORD COUNTS H0300967TYRCT2 RTJ LUFNO IDENTIFY THE FILE. H0300968 LDQ- RECNT,I (Q) = UPPER HALF OF RECNT. H0300969 LDA- RECNT+1,I (A) = LOWER HALF OF RECNT. H0300970 RTJ* TYRCTY SET AND PUBLISH (YBIGQ),(YBIGA). H0300971 ADC MSGPAS 'PASSED = ' H0300972 LDA- DOCNT+1,I (A) = LOWER HALF OF DOCNT H0300973 LDQ- DOCNT,I (Q) = UPPER HALF OF DOCNT H0300974 RTJ* TYRCTY SET AND PUBLISH (YBIGQ),(YBIGA). H0300975 ADC MSGDUN 'DONE = ' H0300976 CLR A SELECT YBIGQ,YBIGA AS TWO-WORD ADDEND. H0300977 LDQ* (TYRCT) (Q) = -1 + FWA OF TWO-WORD AUGEND. H0300978 RTJ* BIGADD ACCUMULATE INCLUDED COUNTS. H0300979ÐÐ LDQ* (TYRCT) (Q) = -1 + FWA OF ACCUMULATOR. H0300980 STA- 2,Q SET 2ND WORD OF ACCUMULATOR. H0300981 LDA* (TYRCT0) (A) = UPPER HALF OF ACCUMULATED-INCLUDED CNTH0300982 STA- 1,Q SET 1ST WORD OF ACCUMULATOR. H0300983TYRCT5 RAO* TYRCT SET UP P+2 EXIT. H0300984 JMP* (TYRCT) EXIT. H0300985 EJT H0300986**** H0300987*E H0300988* ********** H0300989* * TYRCTY * H0300990* ********** H0300991* H0300992* H0300993* TYRCTY SETS (YBIGQ),(YBIGA) EXIT = (Q),(A) ENTRY, AND PUBLISHES H0300994* (Q),(A) ENTRY VIA BTDEC AS THE 4-WORD SUFFIX OF THE PREFIX H0300995* WHOSE FWA = (P+1). H0300996* THE CALLING SEQUENCE IS (Q),(A) ENTRY EACH ARE .GE. 0 AND .LE. 9999.H0300997* P RTJ TYRCTY H0300998* P+1 FWA OF PREFIX. H0300999* P+2 RETURN. H0301000**** H0301001TYRCTY NUM 0 H0301002 STQ* (TYRCT0) SET (YBIGQ) = (Q)ENTRY. H0301003 LDQ* TYRCT0 (Q) = FWA OF YBIGQ. H0301004ÐÐ STA- 1,Q SET (YBIGA) = (A)ENTRY. H0301005 TRQ A TELL BTDEC TO CONVERT (YBIGQ),(YBIGA). H0301006 LDQ* (TYRCTY) (Q) = FWA OF PREFIX. H0301007 RTJ* (TYRCT1) CALL BTDEC. H0301008 RAO* TYRCTY SET UP P+2 EXIT. H0301009 JMP* (TYRCTY) TAKE P+2 EXIT. H0301010 EJT H0301011**** H0301012*E H0301013* ******** H0301014* * GETU * H0301015* ******** H0301016* H0301017* H0301018* INPUT RECORDS ARE FIXED LENGTH. ONE OR MORE RECORDS ARE READ AS A H0301019* BLOCK. DELETED RECORDS IN BLOCK ARE IGNORED. RECORDS READ TO BE H0301020* SORTED MAY HAVE ALL CHARACTERS ALTERED IF ALTERNATING SEQUENCE H0301021* NEEDED. ALSO THESE RECORDS ARE EDITED FOR SELECTING ONLY CERTAIN H0301022* RECORDS FOR SORT. ADDROUT SORTS REBUILDS THE RECORD WITH RELATIVE H0301023* RECORD APPEARING FIRST AND KEYS SECOND. H0301024* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF FILE TABLE. H0301025* P RTJ GETU H0301026* P+1 EOF OR ERROR EXIT. H0301027* P+2 NORMAL EXIT. (A)EXIT = FWA OF RECORD. H0301028* (Q)EXIT = NO. WORDS IN REC.H0301029ÐÐ* (I)EXIT = (I)ENTRY. H0301030**** H0301031 SPC 3 H0301032GETU NUM 0 H0301033GETU10 LDQ* (RELAD1) MSB OF REL REC NO. H0301034 LDA* (RELAD2) LSB OF REL REC NO. H0301035 RTJ* RAOADD ADD 1 H0301036 STQ* (RELAD1) MSB OF NEW REL REC NO. H0301037 STA* (RELAD2) LSB OF NEW REL REC NO. H0301038GETU20 LDA- XFRLTH,I (A) = NO. OF WORDS TO BE DEBLOCKED. H0301039 SUB- RECLTH,I ALLOW FOR CURRENT RECORD. H0301040 STA- XFRLTH,I UPDATE NO. OF WORDS TO BE DEBLOCKED. H0301041 SAP GETU30 SKIP IF .GE. RECLTH TO BE DEBLOCKED. H0301042 RTJ RDD READ NEXT BLOCK. H0301043 JMP* GETUEF END THE FILE IF EOF OR ERROR. H0301044 LDA- BUFWA,I (A) = FWA OF 1ST RECORD IN BUFFER. H0301045 STA- RECFWA,I MAKE GETU GET 1ST RECORD AFTER READ. H0301046 LDQ- REQBUF+RQINFO+1+RRNMSB,I H0301047 LDA- REQBUF+RQINFO+1+RRNLSB,I H0301048 STQ* (RELAD1) SAVE MSB OF REL REC NO. (1ST REL IN BLOCK) H0301049 STA* (RELAD2) SAVE LSB OF REL REC NO. H0301050 JMP* GETU20 GET THE 1ST RECORD OF THE BLOCK. H0301051GETU30 LDQ- RECLTH,I (Q) = RECORD LENGTH IN WORDS. H0301052 LDA- RECFWA,I (A) = FWA OF CURRENT RECORD. H0301053 STA* FWAREC SAVE FWA OF CURRENT RECORD. H0301054ÐÐ AAQ A (A) = FWA OF NEXT RECORD. H0301055 STA- RECFWA,I SAVE FWA OF NEXT RECORD. H0301056 LDA DELETF H0301057 SAZ GETU40 SKIP IF NO DELETED RECORDS IN CURRENT BLOCK H0301058 LDA* (FWAREC) IST WORD OF CURRENT RECORD H0301059 EOR =XFMRDEL DELETE CODE H0301060 SAZ GETU50 H0301061GETU40 LDQ =XRECNT-1,I (Q) = -1 + FWA OF RECNT. H0301062 RTJ BIGCNT COUNT EACH RECORD. H0301063 LDA- (LUN),I H0301064 ALS 15-14 H0301065 SAP GETU45 SKIP IF NOT WORK FILE H0301066 JMP* GETU60 H0301067GETU45 LDA* FWAREC (A) = FWA OF CURRENT RECORD H0301068 LDQ- RECLTH,I NUMBER OF WORDS TO POSSIBLY CONVERT H0301069 RTJ COLSEQ DETERMINE IF ALTERNATE COLLATING SEQ NEEDED H0301070 RTJ SELECT SELECT RECORDS FOR SORT H0301071GETU50 JMP* GETU10 FETCH NEW RECORD IF LAST REJECTED H0301072 LDQ =XDOCNT-1,I (Q) = -1 + FWA OF DOCNT H0301073 RTJ BIGCNT COUNT EACH RECORD H0301074 LDQ* TOTREC MSB OF RECORD COUNT H0301075 LDA* TOTREC+1 LSB OF RECORD COUNT H0301076 RTJ RAOADD COUNT INPUT RECORDS H0301077 STQ* TOTREC MSB OF RECORD COUNT H0301078 STA* TOTREC+1 LSB OF RECORD COUNT H0301079ÐÐ RTJ KYMOVE REFORMAT RECORD IF ADDROUT H0301080 JMP* GETU70 P+1 EXIT IF ADDOUT RECORD H0301081GETU60 LDA* FWAREC (A) = FWA OF CURRENT RECORD. H0301082 LDQ- RECLTH,I (Q) = NO. WORDS IN RECORD H0301083GETU70 RAO* GETU SET UP P+2 EXIT. H0301084 JMP* (GETU) P+2 EXIT. H0301085* END THE FILE. H0301086GETUEF RTJ* TYRCT PUBLISH AND PASS RECORD COUNTS. H0301087GETU80 ADC YIRCNT-1-HERE () = -1 + FWA OF ACCUMULATOR. H0301088 JMP* (GETU) TAKE P+1(EOF OR ERROR) EXIT. H0301089 SPC 3 H0301090FWAREC NUM 0 () = FWA OF RECORD. H0301091RELAD1 NUM 0 ADDRESS OF MSB OF REL REC NUMBER H0301092RELAD2 NUM 0 ADDRESS OF LSB OF REL REC NUMBER H0301093TOTREC BZS TOTREC(2) TOTAL RECORD COUNT H0301094 EJT 0 H0301095**** H0301096*E H0301097* ********** H0301098* * RAOADD * H0301099* ********** H0301100* H0301101* H0301102* THE CALLING SEQUENCE IS (Q)ENTRY = MSB OF 2-WORD AUGEND H0301103* (A)ENTRY = LSB OF 2-WORD AUGEND H0301104ÐÐ* RTJ RAOADD H0301105* (Q)EXIT = MSB OF 2-WORD SUM H0301106* (A)EXIT = LSB OF 2-WORD SUM H0301107* (I)EXIT = (I)ENTRY H0301108* 1 IS ADDED TO DOUBLE WORD VALUE IN (Q),(A). (A) OVERFLOWS INTO (Q). H0301109* VALUE $FFFF INCLUDED IN COUNT. H0301110**** H0301111RAOADD NUM 0 H0301112 SAP RAO10 SKIP IF LSB PORTION IS 0-$7FFF H0301113 INA 0 CHECK FOR FFFF H0301114 SAN RAO10 SKIP IF OLD (A) # FFFF H0301115 INQ 1 ADD OVERFLOW INDICATOR H0301116 JMP* RAO20 H0301117RAO10 INA 1 BUMP LSB WORD H0301118 SAN RAO20 SKIP IF OLD (A) # FFFE H0301119 SET A H0301120RAO20 JMP* (RAOADD) RETURN H0301121 EJT 0 H0301122**** H0301123*E H0301124* ********** H0301125* * SELECT * H0301126* ********** H0301127* H0301128* H0301129ÐÐ* THE CALLING SEQUENCE IS RTJ SELECT H0301130* (I)EXIT = (I)ENTRY H0301131* (P+1)EXIT: RECORD NOT TO BE SORTED H0301132* (P+2)EXIT: RECORD SELECTED FOR SORTING H0301133* SELECT USES THE YFIELD AND YCOMPR TABLES TO COMPARE A KEY WITH H0301134* EITHER A SECOND KEY FIELD IN THE RECORD OR A HOLLERITH CONSTANT. THE H0301135* RECORD IS ACCEPTED OR REJECTED BASE UPON THE RELATION OF THE COMPARE. H0301136* THE KEY COMPARISON MUST HAVE BOTH KEYS (OR HOLLERITH CONSTANT) START H0301137* IN THE SAME POSITION OF A WORD. BOTH KEYS START ON WORD BOUNDARY OR H0301138* BOTH KEYS START OFF WORD BOUNDARY. THE SHIFT BUFFER IS USED TO ALIGN H0301139* ONE OF THE KEYS WHEN BOTH KEYS ARE INTERNAL TO THE RECORD AND ONE KEY H0301140* STARTS ON AN EVEN COLUMN POSITION AND THE SECOND KEY STARTS ON AN ODD H0301141* COLUMN POSITION. H0301142**** H0301143SELECT NUM 0 SEE IF RECORD TO BE INCLUDED IN SORT H0301144 LDQ YFIELD H0301145 LDA- (ZERO),Q REQUEST CODE WORD H0301146 SAM SEL10 SKIP IF RECORD SELECTION REQUESTED H0301147 JMP* SEL70 INCLUDE ALL SELECTED H0301148SEL10 ALS 15-14 IF BOTH KEYS IN RECORD, CHECK WORD ALIGNMENT H0301149 SAP SEL30 SKIP IF KEY ALIGN IN SAME WORD POSITION H0301150 LDA- 4,Q NO. OF CHARACTERS IN KEY H0301151 STA* SEL20 MINUS INDICATES FACTOR 2 SHIFTS FROM EVEN BNDYH0301152 LDA- 3,Q RELATIVE WORD OFFSET H0301153 ADD FWAREC ADD BASE ADDRESS OF RECORD H0301154ÐÐ LDQ YSHIFT DESTINATION ADDRESS OF RECORD H0301155 RTJ MVCHRS MOVE KEY FIELD TO SCRATCH BUFFER, OFFSET KEY H0301156SEL20 ADC *-* NO. OF CHARACTERS TO MOVE H0301157SEL30 LDA YCOMPR (A) = FWA OF KEY COMPARE TABLE H0301158 STA* SEL60 H0301159 LDQ YFIELD H0301160 LDA- (ZERO),Q H0301161 AND- HX1000 CHECK FOR IN RECORD BIASING FOR FACTOR 2 H0301162 SAZ SEL40 SKIP IF FACTOR 2 IS NOT IN RECORD H0301163 LDA FWAREC BIAS BY FWA OF RECORD H0301164SEL40 ADD- 2,Q (A) = FWA OF 2ND PSEUDO RECORD H0301165 LDQ- 1,Q (Q) = FWA OF 1ST PSEUDO RECORD H0301166 SQN SEL50 SKIP IF FACTOR 1 IS HOLLERITH FIELD H0301167 LDQ FWAREC USE FWA OF RECORD H0301168SEL50 LLS 16 (A) = FWA FOR FACTOR 1, (Q) = FWA FOR FACTOR 2H0301169 STA* KEYFWA (A) = FWA OF FACTOR 1 KEY FIELD H0301170 RTJ CMPKEY COMPARE 2 KEY FIELDS H0301171SEL60 ADC *-* FWA OF KEY COMPARE TABLE H0301172 LDQ YFIELD H0301173 LDQ- (ZERO),Q REQUEST CODE WORD H0301174 QLS 15-11 CHECK FOR .NE. TEST H0301175 SQM SEL65 SKIP IF TESTING FOR .NE. H0301176 EOR* KEYFWA SEE IF 1ST KEY WINS H0301177 SAN SEL80 SKIP IF FACTOR 2 WINNER (OMIT RECORD) H0301178 QLS 11-10 H0301179ÐÐ SQM SEL70 SKIP IF ALWAYS WINNER (LE,GE,EQ) H0301180 QLS 16+10-13 (A) < 0, LOOKING FOR LT OR GT (NOT EQ) H0301181SEL65 LDA (KEYPTR) LOOK FOR POSSIBLE TIE H0301182 EAQ A H0301183 SAP SEL80 SKIP IF RECORD FAILS TEST H0301184SEL70 RAO* SELECT P+2 EXIT INCLUDES RECORD IN SORT H0301185SEL80 JMP* (SELECT) RETURN H0301186 SPC 3 H0301187KEYFWA NUM 0 FWA FOR FACTOR 1 KEY FIELD H0301188 EJT 0 H0301189**** H0301190*E H0301191* ********** H0301192* * KYMOVE * H0301193* ********** H0301194* H0301195* H0301196* THE CALLING SEQUENCE IS RTJ KYMOVE H0301197* (A)EXIT = FWA OF ADDROUT RECORD H0301198* (Q)EXIT = ADDROUT RECORD LENGTH H0301199* (I)EXIT = (I)ENTRY H0301200* (P+1)EXIT, IF ADDROUT SORT H0301201* (P+2)EXIT, NOT ADDROUT SORT H0301202* H0301203* KYMOVE MOVES KEY FIELDS (ON FULL WORD BASES) TO ADDROUT RECORD. THE H0301204ÐÐ* FIRST 2 WORDS OF RECORD ALREADY CONTAIN THE RELATIVE RECORD NUMBER. H0301205* OVERLAPPING KEYS ARE PERMITTED. H0301206**** H0301207 SPC 3 H0301208KYMOVE NUM 0 H0301209 LDA YFLAG H0301210 SAM KYM10 SKIP IF ADDROUT SORT H0301211 RAO* KYMOVE SET UP P+2 RETURN IF NOT ADDROUT SORT H0301212 JMP* KYM40 RETURN H0301213KYM10 LDA YADOUT (A) = FWA OF ADDROUT RECORD BUFFER H0301214 STA* ADRKEY H0301215 LDA YADRBF (A) = FWA OF ADDROUT BUFFER H0301216 INA 2 SKIP OVER RELATIVE RECORD NUMBER H0301217KYM20 STA MVDEST (A) = CURRENT DEST ADDRESS FOR KEY H0301218 LDA* (ADRKEY) WORD OFFSET TO KEY FIELD H0301219 SAM KYM30 SKIP IF ALL KEYS MOVED H0301220 ADD FWAREC (A) = FWA OF KEY FIELD H0301221 STA MVSRCE H0301222 RAO* ADRKEY H0301223 LDQ* (ADRKEY) NUMBER OF WORDS TO MOVE H0301224 RTJ MOVE MOVE KEY FROM SOURCE RECORD TO ADDROUT RECORD H0301225 LDA* (ADRKEY) H0301226 RAO* ADRKEY H0301227 ADD MVDEST (A) = FWA OF NEXT KEY H0301228 JMP* KYM20 H0301229ÐÐKYM30 LDA YADRBF (A) = FWA OF ADDROUT RECORD H0301230 LDQ YOFT+RECLTH (A) = ADDROUT RECORD LENGTH H0301231KYM40 JMP* (KYMOVE) RETURN H0301232 SPC 3 H0301233ADRKEY NUM 0 WORD OFFSET TO KEY FIELD H0301234 EJT H0301235**** H0301236*E H0301237* ********** H0301238* * BADBLK * H0301239* ********** H0301240* H0301241* H0301242* BADBLK TYPES AN ERROR MESSAGE AND REPORTS THE FILE IN ERROR. H0301243* THE CALLING SEQUENCE IS (A)ENTRY = BINARY TO CONVERT TO SUFFIX. H0301244* (Q)ENTRY = PREFIX MESSAGE INDEX H0301245* (I)ENTRY = FWA OF THE FILE TABLE. H0301246* RTJ BADBLK H0301247**** H0301248BADBLK NUM 0 H0301249 RTJ HADOUT TYPE THE ERROR MESSAGE. H0301250 RTJ LUFNO PUBLISH LUN AND THEN FILNUM. H0301251 JMP* (BADBLK) H0301252 EJT H0301253**** H0301254ÐÐ*E H0301255* ********* H0301256* * LUFNO * H0301257* ********* H0301258* H0301259* H0301260* LUFNO ANNOUNCES THE VOLUME AND FILE NAME OF A FILE MANAGER FILE. H0301261* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF THE FILE TABLE. H0301262* RTJ LUFNO H0301263* (A),(Q),(I) EXIT = (A),(Q),(I) ENTRY. H0301264**** H0301265LUFNO NUM 0 H0301266 STA* LUFNOA SAVE (A)ENTRY. H0301267 STQ* LUFNOQ SAVE (Q)ENTRY. H0301268 RTJ ISTUFF DEFINE THE FILE AND VOLUME NAME H0301269 LDA COM20 IDATA BUFFER ADDRESS H0301270 INA VOLNAM VOLUME ADDRESS H0301271 ENQ MSGVOL 'VOLUME= ' H0301272 RTJ CRTMSG ANNOUNCE THE SYSTEM VOLUME H0301273 LDA COM20 ADDRESS OF FILE NAME H0301274 ENQ MSGFNO 'FILNAM= ' H0301275 RTJ CRTMSG ANNOUNCE THE FILNAM. H0301276 LDA* LUFNOA RESTORE (A)ENTRY. H0301277 LDQ* LUFNOQ RESTORE (Q)ENTRY. H0301278 JMP* (LUFNO) EXIT. H0301279ÐÐLUFNOA NUM 0 () = (A)ENTRY. H0301280LUFNOQ NUM 0 () = (Q)ENTRY. H0301281IDATA BZS IDATA(FLTYPE+1) BUFFER FOR DEFINING FILE SPECIFICATIONS H0301282 EJT H0301283**** H0301284*E H0301285* ******** H0301286* * PUTU * H0301287* ******** H0301288* H0301289* H0301290* PUTU BLOCKS RECORDS FOR OUTPUT VIA WRTD SUBROUTINE. IF THE FILE IS H0301291* THE OUTPUT FILE, PUTU WILL SEE TO IT THAT IT IS DEFINED. THE RECORD H0301292* DATA FOR THE OUTPUT FILE IS REFORMATTED FOR DATA ONLY OR ADDROUT H0301293* FILES. THE FINAL OUTPUT DATA WILL BE CONVERTED IF ERCDIC COLLATING H0301294* SEQUENCE WAS SPECIFIED. H0301295* THE CALLING SEQUENCE IS (A)ENTRY = FWA OF LOGICAL RECORD TO BE PUT. H0301296* (I)ENTRY = FWA OF FILE TABLE. H0301297* RTJ PUTU H0301298* (I)EXIT = FWA OF FILE TABLE. H0301299**** H0301300PUTU NUM 0 H0301301 STA* PUTUA SAVE MOVE SOURCE. H0301302 LDA- FILNUM,I H0301303 SAP PUT10 H0301304ÐÐ RTJ DEF DEFINE OUTPUT FILE H0301305PUT10 LDA* PUTUA H0301306 STA MVSRCE TELL MOVE WHERE TO GET LOGICAL RECORD. H0301307 LDA- RECFWA,I (A) = FWA OF AVAILABLE BUFFER SPACE. H0301308 STA MVDEST TELL MOVE WHERE TO SEND LOGICAL RECORD. H0301309 STA* RECADR SAVE FOR MOVFWA ROUTINE H0301310 LDQ- RECLTH,I (Q) = RECORD LENGTH. H0301311 AAQ A (A) = FWA DESTINATION OF NEXT RECORD. H0301312 STA- RECFWA,I REMEMBER DESTINATION FOR NEXT TIME. H0301313 SUB- BUFWA,I (A) = NO. WORDS ALREADY IN BUFFER. H0301314 SUB- BUFLTH,I SUBTRACT MAX. BLOCK LENGTH. H0301315 INA 2 ALLOW FOR EOF WORDS H0301316 SAM PUT20 SKIP IF RECORD FITS. H0301317 SAZ PUT20 SKIP IF RECORD FITS. H0301318 RTJ WRTD WRITE CURRENT BLOCK. H0301319 LDA- BUFWA,I (A) = FWA OF BUFFER. H0301320 STA- RECFWA,I SET RECORD DESTINATION. H0301321 JMP* PUT10 CHECK AGAIN WHETHER RECORD FITS. H0301322PUT20 LDA- (LUN),I CHECK FOR WORK FILE H0301323 ALS 15-14 H0301324 SAM PUT25 SKIP IF WORK FILE H0301325 LDA YFLAG H0301326 SAM PUT25 SKIP IF ADDROUT SORT H0301327 ALS 15-14 H0301328 SAM PUT30 SKIP IF FULL RECORD SORT H0301329ÐÐ RTJ* DATAMV MOVE DATA ONLY FIELDS TO RECORD BLOCK AREA H0301330 JMP* PUT40 H0301331PUT25 RTJ MOVE MOVE FULL RECORD OR RELATIVE REC NO. H0301332 JMP* PUT50 H0301333PUT30 RTJ MOVE MOVE FULL RECORD H0301334PUT40 LDA* RECADR (A) = FWA OF CURRENT RECORD H0301335 LDQ- RECLTH,I H0301336 TCQ Q (Q) = MINUS, CONVERTS EBCDIC TO ASCII H0301337 RTJ COLSEQ DETERMINE IF ALTERNATE COLLATING SEQUENCE H0301338PUT50 LDA- RECFWA,I H0301339 SUB- BUFWA,I H0301340 STA- XFRLTH,I REMEMBER BLOCK LENGTH FOR RECORD COUNT H0301341 LDQ =XRECNT-1,I (Q) = -1 + FWA OF RECNT. H0301342 RTJ BIGCNT COUNT EACH RECORD. H0301343 JMP* (PUTU) EXIT. H0301344 EJT 0 H0301345**** H0301346*E H0301347* ********** H0301348* * DATAMV * H0301349* ********** H0301350* H0301351* H0301352* THE CALLING SEQUENCE IS RTJ DATAMV H0301353* (I)EXIT = (I)ENTRY H0301354ÐÐ* DATA FIELDS DESCRIBE IN YADOUT TABLE ARE PACKED INTO OUTPUT RECORD H0301355**** H0301356 SPC 3 H0301357DATAMV NUM 0 H0301358 LDA YADOUT H0301359 STA* FCAWRD SAVE FWA OF DATA ONLY TABLE H0301360 ENQ 1 H0301361DATA00 STQ* LCAWRD CURRENT REL FCA = REL LCA+1 OF PREVIOUS FIELD H0301362 LDA* (FCAWRD) REL FCA OF DATA FIELD H0301363 SAP DATA10 H0301364 JMP* (DATAMV) RETURN H0301365DATA10 ADD* LCAWRD ADD LCA+1 OF LAST DATA FIELD H0301366 ALS 15-0 H0301367 SAM DATA20 SKIP IF FIELD MUST BE OFF SHIFTED H0301368 RTJ* MOVFWA DETERMINE SOURCE/ DESTINATION FWA OF MOVE H0301369 STA MVSRCE (A) = MOVE SOURCE ADDRESS H0301370 STQ MVDEST (Q) = MOVE DESTINATION ADDRESS H0301371 LDQ FCAWRD H0301372 LDQ- 1,Q (Q) = NUMBER OF CHARACTERS TO MOVE H0301373 INQ 1+1 ROUND UP (1) FOR ODD CHAR CNT, (1+1) FOR EVEN H0301374* IF ABOVE MOVES EXTRA WORD, OK, SINCE F.M. HAS EOF WORDS AT END OF BUF H0301375 QRS 1 (Q) = WORD COUNT H0301376 RTJ MOVE MOVE DATA FIELD H0301377 JMP* DATA40 H0301378DATA20 LDQ* FCAWRD MOVE FROM ODD CHARACTER BOUNDARY H0301379ÐÐ LDA- (ZERO),Q (A) = REL FCA OF DATA H0301380 LDQ- 1,Q (Q) = NO OF CHAR H0301381 ALS 15-0 H0301382 SAP DATA25 SKIP IF FCA ON ODD WORD BOUNDARY H0301383 TCQ Q CHARACTER STARTS ON EVEN BOUNDARY H0301384DATA25 STQ* DATA30 (Q) = NO. OF CHARACTERS TO MOVE H0301385 RTJ* MOVFWA DETERMINE SOURCE/ DESTINATION FWA OF MOVE H0301386 RTJ MVCHRS SHIFT CHARACTERS INTO FIELD H0301387DATA30 ADC *-* CHARACTER COUNT H0301388DATA40 LDQ* LCAWRD H0301389 QLS 15-0 H0301390 SQM DATA50 SKIP IF LCA + 1 IS ODD H0301391 LDA* (FWADAT) MERGE THE CHARACTERS TOGETHER H0301392 AND- HX00FF H0301393 EOR* LCAVAL H0301394 STA* (FWADAT) H0301395DATA50 QLS 1 (Q) = LCAWRD H0301396 RAO* FCAWRD ()= FWA OF CHARACTER COUNT FOR PREVIOUS FIELD H0301397 ADQ* (FCAWRD) (Q) = NEW LCA + 1 H0301398 RAO* FCAWRD H0301399 JMP* DATA00 LOOK FOR MORE DATA ENTRIES H0301400 SPC 3 H0301401FCAWRD NUM 0 () = REL FCA OF DATA FIELD H0301402FWADAT NUM 0 () = FWA OF DATA DESTINATION H0301403LCAVAL NUM 0 () = RIGHT CHAR IN LAST WORD OF PREVIOUS FIELDH0301404ÐÐLCAWRD NUM 1 () = REL LCA + 1 OF PREVIOUS DATA FIELD H0301405PUTUA NUM 0 () = FWA OF MOVE SOURCE. H0301406RECADR NUM 0 () = FWA OF CURRENT RECORD IN OUTPUT BUFFER H0301407 EJT 0 H0301408**** H0301409*E H0301410* ********** H0301411* * MOVFWA * H0301412* ********** H0301413* H0301414* H0301415* MOVFWA DETERMINES THE FIRST WORD ADDRESS OF THE SOURCE AND DESTINATIONH0301416* LOCATIONS FOR DATA TO BE MOVED IN A RECORD. H0301417* THE CALLING SEQUENCE IS RTJ MOVFWA H0301418* (A)EXIT = FWA OF MOVE SOURCE H0301419* (Q)EXIT = FWA OF MOVE DESTINATION H0301420* (I)EXIT = (I)ENTRY H0301421**** H0301422 SPC 3 H0301423MOVFWA NUM 0 H0301424 LDQ* LCAWRD (Q) = REL LCA + 1 OF PREVIOUS RECORD H0301425 INQ -1 ROUND DOWN H0301426 QRS 1 (Q) = REL FWA OF CURRENT RECORD H0301427 ADQ* RECADR (Q) = DESTINATION FWA FOR DATA FIELD H0301428 STQ* FWADAT (Q) = FWA OF DATA DESTINATION H0301429ÐÐ LDA- (ZERO),Q H0301430 AND- HXFF00 H0301431 STA* LCAVAL (A) = SAVE LEFT CHARACTER FOR POSSIBLE MERGE H0301432 LDA* (FCAWRD) (A) = REL FCA OF SOURCE RECORD H0301433 INA -1 ROUND DOWN H0301434 ARS 1 (A) = REL FWA OF SOURCE RECORD H0301435 ADD* PUTUA (A) = SOURCE FWA FOR DATA FIELD H0301436 JMP* (MOVFWA) RETURN H0301437 EJT H0301438**** H0301439*E H0301440* ******** H0301441* * CLSU * H0301442* ******** H0301443* H0301444* H0301445* CLSU WRITES A PARTIALLY FILLED OUTPUT BUFFER. H0301446* THIS HAPPENS WHEN ALL OF THE INFORMATION NEEDED FOR THE FILE HAS H0301447* BEEN PROVIDED. THE RECORD COUNT IS ALSO REPORTED FOR THE OUTPUT FILE.H0301448* THE CALLING SEQUENCE IS (I) = FWA OF FILE TABLE. H0301449* RTJ CLSU H0301450* (I)EXIT = (I)ENTRY. H0301451**** H0301452CLSU NUM 0 H0301453 LDQ- RECNT,I COUNT OF RECORDS PASSED H0301454ÐÐ LDA- RECNT+1,I H0301455 STQ- DOCNT,I FOR OUTPUT FILE, COUNT SAME FOR PASSED AS DONEH0301456 STA- DOCNT+1,I DONE COUNT H0301457 RTJ WRTD WRITE A PARTIALLY FILLED BLOCK. H0301458 RTJ TYRCT PUBLISH RECORD COUNT. H0301459CLSU01 ADC YORCNT-1-HERE () = -1 + FWA OF ACCUMULATOR. H0301460 JMP* (CLSU) EXIT. H0301461 EJT H0301462**** H0301463*E H0301464* ******* H0301465* * REL * H0301466* ******* H0301467* H0301468* H0301469* REL RELEASES AN FILE MANAGER FILE. H0301470* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF FILE TABLE. H0301471* RTJ REL RELEASE THE FILE. H0301472* (I)EXIT = (I)ENTRY. H0301473**** H0301474 SPC 3 H0301475REL NUM 0 H0301476 RTJ SAVAQI SAVE (A),(Q),(I) ENTRY. H0301477REL10 NUM 0,0,0 () = (A),(Q),(I) ENTRY. H0301478* SEE IF THERE IS A FILNUM TO RELEASE. H0301479ÐÐ LDA- FILNUM,I (A) = THE FILNUM. H0301480 SAN REL20 SKIP IF NONZERO FILNUM. H0301481 JMP* REL30 BYPASS RELFIL IF ZERO FILNAM. H0301482* THERE IS A FILNUM TO RELEASE. H0301483REL20 RTJ RELFIL H0301484REL30 RTJ RESAQI RESTORE (A),(Q),(I) ENTRY. H0301485REL40 ADC REL10-HERE () = FWA OF (A),(Q),(I) SAVE AREA. H0301486 JMP* (REL) EXIT. H0301487 EJT H0301488**** H0301489*E H0301490* ********** H0301491* * GETSEQ * H0301492* ********** H0301493* H0301494* H0301495* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF SEQ.(NOT DIR.) FILE TABLE.H0301496* RTJ GETSEQ H0301497* (A),(Q),(I) EXIT = (A),(Q),(I) ENTRY. H0301498* THE LUN AND FILNUM OF THE 1ST SEGMENT OF THE SEQ. ARE SET INTO H0301499* THE FILE TABLE FOR THE SEQ. H0301500* THE WORK FILE IS OPEN FOR FILE MANAGER CALLS. H0301501* THE RUN IS STOPPED IF AN ERROR OCCURS IN USE OF THE SEQ. DIRECTORY. H0301502**** H0301503GTSQCT NUM 0 ()ENTRY = NO. OF LAST SEQ. GOTTEN. H0301504ÐÐGETSEQ NUM 0 H0301505 RTJ SAVAQI SAVE (A)ENTRY,(Q)ENTRY,(I)ENTRY. H0301506GTSQA NUM 0,0,0 H0301507 RAO* GTSQCT MAINTAIN SEQ. CT. IN CORE TO CK. SEQ. DIR. H0301508GTSQ01 LDA =XGTSQFT-HERE (A) = FWA SEQ. DIR. FILE TABLE. H0301509 STA- I TELL RDD THE FWA OF SEQ. DIR. FILE TABLE. H0301510 RTJ RDD GET NEXT SEQ. DIR. ENTRY. H0301511 JMP* GTSQER STOP RUN IF EOF. H0301512 LDA* GTSQFT+ERRCNT (A)=0 IF NO RDD ERROR. H0301513 SAN GTSQ04 STOP RUN IF ERROR ON SEQ. DIR. H0301514 LDA* GTSQCT (A) = CORE SEQ. NO. H0301515 EOR* GTSQBF COMPARE WITH SEQ. NO. IN SEQ. DIR. H0301516GTSQ04 SAN GTSQER STOP RUN IF MISMATCH. H0301517 LDQ* GTSQA+2 (Q) = (I)ENTRY = FWA OF SEQ. FILE TABLE. H0301518 STQ- I H0301519 LDA* GTSQBF+1 (A) = LUN OF 1ST SEGMENT OF SEQUENCE. H0301520 STA- (LUN),I SET SEQ. LUN INTO SEQ. FILE TABLE. H0301521 LDA* GTSQBF+2 (A) = FILNUM OF 1ST SEGMENT OF SEQUENCE. H0301522 STA- FILNUM,I SET SEQ. FILNUM INTO SEQ. FILE TABLE. H0301523 RTJ OPEN OPEN FILE H0301524 JMP* GTSQER STOP RUN IF ERROR H0301525 RTJ RESAQI RESTORE (A),(Q),(I) ENTRY. H0301526GTSQ02 ADC GTSQA-HERE H0301527 JMP* (GETSEQ) EXIT. H0301528GTSQER ENQ MSGSDE 'SEQ. DIR. ERROR ' H0301529ÐÐ SET A DISABLE SUFFIX. H0301530 JMP BOMB STOP THE RUN. H0301531GTSQBF BZS GTSQBF(3) SEQ. NO./SEQ. LUN/ SEQ. FILNUM H0301532GTSQFT NUM $4000 () = D/W,SKIPCT,A/B,DOCNT,EXTENDED,LUN. H0301533 NUM 0 FILNUM. H0301534 NUM 3 RECLTH H0301535 NUM 3 LENGTH OF SEQ. DIR. ENTRY H0301536* AN ENTRY IN THE SEQUENCE DIRECTORY HAS THE FOLLOWING FORMAT H0301537* SEQ.NO. / SEQ. LUN / SEQ. FILNUM H0301538GTSQ03 ADC GTSQBF-HERE BUFWA. H0301539 NUM 0 USUALLY RECNT. HERE UNUSED. H0301540 NUM 0 USUALLY RECNT+1. HERE UNUSED. H0301541 NUM 0 USUALLY DOCNT. HERE IT IS UNUSED H0301542 NUM 0 USUALLY DOCNT+1. HERE IT IS UNUSED H0301543 NUM 0 ERRCNT. H0301544 NUM 0 RECFWA. H0301545 NUM 0 XFRLTH. H0301546 BZS (REQIND-REQBUF) REQBUF. H0301547 NUM 0 REQIND. H0301548 SPC 3 H0301549 EJT H0301550**** H0301551*E H0301552* ********** H0301553* * PUTSEQ * H0301554ÐÐ* ********** H0301555* H0301556* H0301557* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF OUTPUT-STRING FILE TABLE. H0301558* RTJ PUTSEQ H0301559* (A),(Q),(I) EXIT = (A),(Q),(I) ENTRY. H0301560* PUTSEQ WRITES THE WORK FILE SEQUENCE NUMBER, LOGICAL UNIT, AND THE H0301561* FILE NUMBER TO THE SEQUENCE DIRECTORY FILE. H0301562* THE RUN IS STOPPED IF AN ERROR OCCURS IN USE OF THE SEQ. DIRECTORY. H0301563**** H0301564PUTSEQ NUM 0 H0301565 RTJ SAVAQI SAVE (A)ENTRY,(Q)ENTRY,(I)ENTRY. H0301566PTSQA NUM 0,0,0 H0301567 RAO* PTSQBF UPDATE SEQ. NO. IN BUFFER. H0301568PTSQ04 LDA =XPTSQFT-HERE (A) = FWA OF PTSQFT. H0301569 STA- I TELL WRTD TO USE PTSQFT AS FILE TABLE. H0301570 ENA 3 DEFINE BLOCK LENGTH FOR STORES H0301571 STA- XFRLTH,I H0301572 RTJ WRTD WRITE NEW ENTRY IN SEQ. DIR. H0301573 LDA- ERRCNT,I (A)=0 IF NO ERRORS IN THE FILE. H0301574 SAZ PTSQ03 SKIP IF WRTD WAS CLEAN. H0301575 JMP* GTSQER EXIT. H0301576PTSQ03 LDA GTSQFT+FILNUM (A) = CURRENT GETSEQ SEQ. DIR. FILNUM. H0301577 SAZ PTSQ07 SKIP IF GETSEQ FILNUM IS NOT SET H0301578 JMP* PTSQ05 H0301579ÐÐ* TELL GETSEQ WHAT LUN AND WHAT FILNUM ARE 1ST FOR THE SEQ. DIRECTORY. H0301580PTSQ07 LDA- (LUN),I (A) = LUN OF 1ST SEGMENT OF THE SEQ. DIR. H0301581 STA GTSQFT TELL GETSEQ THE 1ST LUN. H0301582 LDA- FILNUM,I (A) = FILNUM OF 1ST SEGMENT OF THE SEQ. DIR.H0301583 STA GTSQFT+FILNUM TELL GETSEQ THE 1ST FILNUM. H0301584 LDA =XREQBUF,I REQBUF ADDRESS H0301585 STA MVSRCE H0301586PTSQ06 LDA =XGTSQFT+REQBUF-HERE H0301587 STA MVDEST H0301588 ENQ REQIND-REQBUF REQBUF LENGTH H0301589 RTJ MOVE MOVE REQBUF TO GTSQFT TABLE H0301590PTSQ05 RTJ RESAQI RESTORE (A),(Q),(I) ENTRY. H0301591PTSQ01 ADC PTSQA-HERE H0301592 JMP* (PUTSEQ) EXIT. H0301593PTSQFT NUM $4000 () = D/W,SKIPCT,A/B,DOCNT,EXTENDED,LUN. H0301594 NUM 0 FILNUM. H0301595 NUM 3 RECLTH H0301596 ADC 3+2 BUFLTH PLUS EOF WORDS H0301597PTSQ02 ADC PTSQBF-HERE BUFWA. H0301598 NUM 0 USUALLY RECNT. HERE UNUSED. H0301599 NUM 0 USUALLY RECNT+1. HERE UNUSED. H0301600 NUM 0 USUALLY DOCNT. HERE UNUSED H0301601 NUM 0 USUALLY DOCNT+1. HERE UNUSED H0301602 NUM 0 ERRCNT. H0301603 NUM 0 RECFWA. H0301604ÐÐ NUM 3 XFRLTH. H0301605 BZS (REQIND-REQBUF) REQBUF. H0301606 NUM 0 REQIND. H0301607 BSS (FTSIZE-FCB) FCB BUFFER H0301608* AN ENTRY IN THE SEQUENCE DIRECTORY HAS THE FOLLOWING FORMAT H0301609* SEQ.NO. / SEQ. LUN / SEQ. FILNUM H0301610PTSQBF BZS PTSQBF(5) INCLUDES EOF WORDS H0301611 EJT H0301612**** H0301613*E H0301614* ******* H0301615* * BOS * H0301616* ******* H0301617* H0301618* H0301619* BOS DEFINES NEW WORK FILE AND INFORMS PUTSEQ ON THE NEW FILE NAME. H0301620* THE CALLING SEQUENCE IS (I) = FWA OF OUTPUT STRING FILE TABLE. H0301621* RTJ BOS H0301622* (I)EXIT = (I)ENTRY. H0301623* ((LUN),I) AND (FILNUM,I) ARE SET AND THE H0301624* CORRESPONDING FILE IS DEFINED, VIA DEFFIL. H0301625* (A)EXIT = ((LUN),I)EXIT. H0301626* (Q)EXIT = (FILNUM,I)EXIT. H0301627**** H0301628BOS NUM 0 H0301629ÐÐ* 01=WORK FILE/0=SKIPCT/0=BINARY/0=DOCNT/0=EXTENDED/0=LUN, I.E. $4000. H0301630 LDA- HX4000 H0301631 STA- (LUN),I MAKE DEF FIND A LUN. H0301632 CLR A H0301633 STA- FILNUM,I MAKE DEF FIND A FILNUM. H0301634 RTJ DEF DEFINE FILNUM ON LUN. H0301635 LDA- (LUN),I (A) = (LUN WORD JUST SET BY DEF). H0301636 STA* PTSQBF+1 TELL PUTSEQ WHAT LUN TO RECORD. H0301637 LDQ- FILNUM,I (Q) = (FILNUM WORD JUST SET BY DEF). H0301638 STQ* PTSQBF+2 TELL PUTSEQ WHAT FILNUM TO RECORD. H0301639 JMP* (BOS) EXIT. H0301640 EJT 0 H0301641**** H0301642*E H0301643* ******* H0301644* * EOS * H0301645* ******* H0301646* H0301647* H0301648* EOS ENDS THE SEQUENCE FOR A WORK FILE. IT DOES: H0301649* 1. EMPTIES WORK BUFFER. H0301650* 2. CLOSES FILE. H0301651* 3. LOGS FILE IN SEQUENCE DIRECTORY. H0301652* H0301653* H0301654ÐÐ* THE CALLING SEQUENCE IS (I) = FWA OF OUTPUT STRING FILE TABLE. H0301655* RTJ EOS H0301656* (I)EXIT = (I)ENTRY. H0301657**** H0301658EOS NUM 0 H0301659 RTJ CLSU MAKE SURE THAT THE LAST RECORDS ARE WRITTEN.H0301660 RTJ CLOSE CLOSE THE FILE H0301661 RTJ* PUTSEQ TALLY THE COMPLETED SEQUENCE. H0301662 JMP* (EOS) EXIT. H0301663 EJT H0301664**** H0301665*E H0301666* ******* H0301667* * RDD * H0301668* ******* H0301669* H0301670* H0301671* RDD READS BLOCKED RECORDS SEQUENTIALLY. FOR SECTOR ALIGN FILE ONLY H0301672* ONE RECORD CAN BE READ AT A TIME. IF A WORK FILE REACHES END OF FILE H0301673* AND NO RECORDS WERE READ, THE FILE WILL BE RELEASED. H0301674* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF FILE TABLE. H0301675* P RTJ RDD H0301676* P+1 EOF OR ERROR RETURN. H0301677* P+2 NORMAL RETURN. H0301678* (I)EXIT = (I)ENTRY. H0301679ÐÐ**** H0301680 SPC 3 H0301681RDDI NUM 0 () = (I)ENTRY = FWA OF FILE TABLE. H0301682RDD NUM 0 H0301683 LDA- I (A) = (I)ENTRY = FWA OF FILE TABLE. H0301684 STA* RDDI SAVE (I)ENTRY. H0301685 LDA =XREQBUF,I (A) = FWA OF REQBUF. H0301686 STA* RDD10 TELL FWA OF REQBUF TO RTVSEQ. H0301687 LDA- BUFWA,I (A) = FWA OF BLOCK OF LOGICAL RECORDS. H0301688 STA* RDD20 TELL FWA OF FILE-MGR-REC BUFFER TO RTVSEQ. H0301689 LDA =XREQIND,I (A) = FWA OF REQIND. H0301690 STA* RDD30 TELL FWA OF REQIND TO RTVSEQ. H0301691 ENQ XGETS H0301692 LDQ (XREF),Q GET THE NEXT FILE-MANAGER SEQUENTIAL RECORD H0301693 RTJ- (ZERO),Q H0301694RDD10 ADC *-* REQBUF H0301695RDD20 ADC *-* RECBUF H0301696 ADC *-* KEYVAL - NOT USED AND NOT PATCHED H0301697RDD30 ADC *-* REQIND H0301698 LDA* RDDI (A) = (I) ENTRY = FWA OF FILE TABLE H0301699 STA- I H0301700 LDQ* (RDD30) (Q) = REQIND H0301701 SQN RDD60 H0301702 STQ* DELETF CLEAR DELETE BLOCK RECORD STATUS H0301703RDD35 LDQ* RDD10 REQBUF ADDRESS H0301704ÐÐ LDQ- RQINFO+1+FCBADR,Q FETCH FCB ADDRESS FOR FILE H0301705 LDA- RECLEN,Q FIXED RECORD LENGTH FOR FILE H0301706 EOR- RECLTH,I H0301707 SAN RDD50 SKIP IF RECORD LENGTH NOT SAME AS ON INFILE H0301708 LDA- RECLTH,I H0301709 LDQ* RDD10 REQBUF ADDRESS H0301710 MUI- RQINFO+1+NUMREC,Q NUMBER OF RECORDS ACTUALLY READ H0301711 STA- XFRLTH,I SAVE BLOCK LENGTH FOR DEBLOCKER H0301712 RAO* RDD SET UP P+2 (NORMAL) EXIT H0301713RDD40 JMP* (RDD) EXIT. H0301714RDD50 ENQ MSGBDR 'BLKSIZ/RECLTH .NE. 1,2,3...' H0301715 SET A DELETE SUFFIX H0301716 JMP* RDD90 H0301717RDD60 LDA* HX6042 MASK BITS 14,13,6,1 H0301718 LAQ A H0301719 SAN RDD70 WIERD CONDITION ENCOUNTERED H0301720 LDA* HX00A0 MASK BITS 7,5 H0301721 LAQ A H0301722 SAN RDD80 RECORD CURRENTLY LOCKED OR MASS MEMORY ERROR H0301723 QLS 15-4 H0301724 SQM RDD100 RECORD DELETED H0301725 QLS 4-8+16 H0301726 SQM RDD110 EOF DETECTED H0301727RDD70 RTJ WIERD ANNOUNCE AND HANDLE WIERD CONDITION H0301728 NUM 2 H0301729ÐÐRDD80 ENQ MSGRDD 'GETS REQIND = $ ' H0301730 LDA* (RDD30) (A) = REQIND H0301731RDD90 RAO- ERRCNT,I COUNT EACH ERROR. H0301732 RTJ BADBLK DISPLAY ERROR AND BLOCK, AND ACCEPT OPTION. H0301733 JMP* RDD40 TAKE P+1 (EOF) EXIT H0301734RDD100 RAO* DELETF ONE OR MORE RECORDS IN BLOCK DELETED H0301735 JMP* RDD35 DELETED RECORD(S) IN BLOCK READ H0301736RDD110 QLS 8-15+16 H0301737 SQP RDD130 SKIP IF RECORDS ACTUALLY READ H0301738 LDA- (LUN),I H0301739 ALS 15-14 (A)15 = 1 IFF WORK FILE H0301740 SAP RDD120 SKIP IF NOT WORK FILE H0301741 RTJ REL RELEASE EXHAUSTED WORK FILE H0301742RDD120 JMP* RDD40 TAKE P+1 (EOF) EXIT H0301743RDD130 JMP* RDD35 EOF RETURNED WITH ONE OR MORE RECORDS READ H0301744 SPC 3 H0301745HX6042 NUM $6042 H0301746HX00A0 NUM $00A0 H0301747DELETF BZS DELETF DELETE CODE STATUS,0=NO DELETE RECORDS FOR H0301748* CURRENT READ H0301749 EJT H0301750**** H0301751*E H0301752* ******** H0301753* * WRTD * H0301754ÐÐ* ******** H0301755* H0301756* H0301757* WRTD WRITES ONE OR MORE RECORDS FOR A SINGLE FILE MANAGER CALL. THESE H0301758* RECORDS ARE STORED SEQUENTIALLY. H0301759* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF FILE TABLE. H0301760* RTJ WRTD H0301761* (I)EXIT = (I)ENTRY. H0301762**** H0301763 SPC 3 H0301764WRTDI NUM 0 () = (I)ENTRY = FWA OF FILE TABLE. H0301765WRTD NUM 0 H0301766 LDA- I (A) = (I)ENTRY = FWA OF FILE TABLE. H0301767 STA* WRTDI SAVE (I)ENTRY. H0301768 LDA =XREQBUF,I (A) = FWA OF REQBUF. H0301769 STA* WRT030 H0301770 LDA- BUFWA,I (A) = 1 + FWA OF RECBUF. H0301771 STA* WRT040 H0301772 LDA- XFRLTH,I BLOCK RECORD WORD COUNT H0301773 CLR Q H0301774 DVI- RECLTH,I H0301775 STA* RECNUM NUMBER OF RECORDS TO WRITE H0301776 LDA =XREQIND,I (A) = FWA OF REQIND. H0301777 STA* WRT060 H0301778 LDA- FILNUM,I (A)=0 IF FILNUM MUST FIRST BE SET. H0301779ÐÐ SAN WRT020 SKIP IF FILNUM IS ALREADY SET. H0301780 RTJ DEF DEFINE THE FILE. H0301781WRT020 ENQ XPUTS H0301782 LDQ (XREF),Q PUTS H0301783 RTJ- (ZERO),Q H0301784WRT030 ADC *-* REQBUF H0301785WRT040 ADC *-* RECBUF H0301786WRT050 ADC RECNUM-HERE RECNUM H0301787WRT060 ADC *-* REQIND H0301788 LDA* WRTDI (A) = (I) ENTRY = FWA OF FILE TABLE H0301789 STA- I RESTORE (I)ENTRY H0301790 LDQ* (WRT060) (A) = REQIND H0301791 SQN WRT070 H0301792 STQ- XFRLTH,I CLEAR BLOCK LENGTH H0301793 JMP* (WRTD) EXIT. H0301794RECNUM BSS RECNUM NUMBER OF RECORDS TO WRITE H0301795WRT070 LDA* HX6004 H0301796 LAQ A H0301797 SAZ WRT080 CONDITION BAD BUT NOT WIERD H0301798 RTJ WIERD H0301799 NUM 3 H0301800WRT080 ENQ MSGWTD 'PUTS REQIND = $ ' H0301801 LDA* (WRT060) REQUEST INDICATOR H0301802 RTJ BADBLK H0301803 SET A,Q NO MESSAGE H0301804ÐÐ JMP BOMB STOP RUN H0301805 SPC 2 H0301806HX6004 NUM $6004 WIERD BITS 14,13,2 H0301807 EJT 0 H0301808**** H0301809*E H0301810* ******* H0301811* * DEF * H0301812* ******* H0301813* H0301814* H0301815* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF THE FILE-TABLE H0301816* RTJ DEF H0301817* (Q),(I) EXIT = (Q),(I) ENTRY H0301818* DEF DEFINES FILE AND OPENS FILE. IF FILE NAME IS NEGATIVE DEF CLOSES H0301819* AND RELEASES FILE BEFORE REDEFINING FILE. IF LUN = 0, THE SYSVOL H0301820* DEVICE IS SELECTED. ANY ERROR CONDITION FOR CLOSE AND RELEASE OF OLD H0301821* FILE IS IGNORED. ANY ERROR FOR DEFINING OR OPENING FILE RESULTS IN H0301822* THE SORT JOB TERMINATING. H0301823**** H0301824 SPC 3 H0301825DEFQ NUM 0 H0301826DEF NUM 0 H0301827 STQ* DEFQ SAVE Q H0301828 RAO ERRFLG DO NOT REPORT ERRORS SINCE FILE MAY NOT EXIST H0301829ÐÐ LDA- FILNUM,I H0301830 SAM DEF20 H0301831 SAN DEF15 H0301832 LDA* FILCNT H0301833 SAN DEF10 SKIP IF INFILE/OUTFILE ACCOUNTED FOR H0301834 LDA YDM H0301835 INA 1 ALLOW FOR OUTPUT FILE H0301836DEF10 INA 1 NEXT AVAILABLE FILE NUMBER H0301837 STA* FILCNT H0301838 STA- FILNUM,I SAVE FILE NUMBER H0301839DEF15 LDA- (LUN),I WORK FILE MAY EXIST IF PREVIOUS SORT H0301840* ABNORMALLY TERMINATED H0301841 ALS 15-14 H0301842 SAP DEF25 SKIP IF NOT WORK FILE H0301843 JMP* DEF23 RELEASE WORK FILE H0301844DEF20 AND- HX7FFF H0301845 STA- FILNUM,I RESTORE FILE NUMBER H0301846 RTJ CNTREC COUNT RECORDS (DEFINE REC CNT FOR OUTPUT FILE)H0301847DEF23 RTJ RELFIL H0301848DEF25 CLR A H0301849 STA* ERRFLG CONTINUE ERROR CHECKING H0301850 RTJ DEFFIL DEFINE FILE H0301851 JMP* DEF30 REPORT ERROR H0301852 RTJ OPEN H0301853 JMP* DEF30 REPORT ERROR H0301854ÐÐ RTJ DATE INSERT CREATION, EXPIRATION DATE FOR NEW FILE H0301855 LDQ* DEFQ RESTORE Q H0301856 JMP* (DEF) H0301857DEF30 ENQ MSGTLD 'TOO LITTLE DISK' H0301858 SET A DELETE OPTIONAL BOMB SUFFIX H0301859 JMP BOMB STOP RUN H0301860 SPC 3 H0301861FILCNT BZS FILCNT H0301862 EJT 0 H0301863**** H0301864*E H0301865* ********** H0301866* * CNTREC * H0301867* ********** H0301868* H0301869* H0301870* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF OUTPUT F.T. H0301871* RTJ CNTREC H0301872* (I)EXIT = (I)ENTRY H0301873* IF THE OUTPUT FILE IS ALREADY DEFINED AND IF THE TOTAL RECORD COUNT H0301874* FOR THAT FILE EXCEEDS THE ACTUAL COUNT REQUIRED FOR THE OUTPUT FILE, H0301875* THE EXISTING RECORD COUNT (MAX) WILL BE USED TO DEFINE THE OUTPUT H0301876* FILE. H0301877**** H0301878 SPC 3 H0301879ÐÐCNTREC NUM 0 H0301880 RTJ OPEN ATTEMPT TO OPEN FILE H0301881CNT10 ADC TOTREC-1-HERE ERROR EXIT NOT USED HERE H0301882 LDQ* CNT10 FWA-1 OF TOTAL RECORD COUNT FOR SORT H0301883 LDA- REQIND,I CHECK REQUEST INDICATOR FOR ERRORS H0301884 SAZ CNT15 SKIP IF NO ERRORS H0301885 INA -2 CHECK FOR FILE LOCK H0301886 SAZ CNT15 SKIP IF NO ERROR ON OPEN. H0301887 JMP* CNT20 ASSUME FILE DOES NOT EXIST. H0301888* EXIST H0301889* IF FILE IS STILL LOCKED WHEN ATTEMPTING TO REDEFINE, SORT WILL ABORT. H0301890* OPEN FILE WILL BE CLOSED BY RELFIL SUBROUTINE H0301891CNT15 LDA- 2,Q CONVERT 24 BIT SORT RECORD COUNT TO MSB/LSB H0301892 LDQ- 1,Q H0301893 LLS 1 H0301894 ARS 1 H0301895 AND- HX7FFF H0301896 STQ* CNTEMP MSB TOTREC H0301897 STA* CNTEMP+1 LSB TOTREC H0301898 LDQ- FCB+TDATRM,I CONVERT 24 BIT FILE RECORD COUNT TO MSB/LSB H0301899 LDA- FCB+TDATRL,I H0301900 LLS 1 H0301901 ARS 1 H0301902 AND- HX7FFF H0301903 LLS 16 A = MSB, Q = LSB FILE RECORD COUNT. H0301904ÐÐ SUB* CNTEMP H0301905 SAM CNT20 SKIP IF TOTREC LARGER H0301906 SAN CNT30 SKIP IF EXISTING COUNT LARGER H0301907 TRQ A H0301908 SUB* CNTEMP+1 H0301909 SAP CNT30 SKIP IF EXISTING TOTAL LARGER OR EQUAL H0301910CNT20 LDQ* CNT10 FWA-1 OF TOTAL RECORD COUNT OF SORT H0301911 LDA- 2,Q H0301912 LDQ- 1,Q MSB (MAX) H0301913 JMP* CNT40 H0301914CNT30 LDQ- FCB+TDATRM,I MSB (MAX) H0301915 LDA- FCB+TDATRL,I LSB H0301916CNT40 STQ YRECNT RECORD COUNT FOR FINAL OUTPUT FILE H0301917 STA YRECNT+1 H0301918 JMP* (CNTREC) H0301919CNTEMP NUM 0,0 H0301920 EJT 0 H0301921**** H0301922*E H0301923* ********** H0301924* * DEFFIL * H0301925* ********** H0301926* H0301927* H0301928* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF FILE TABLE H0301929ÐÐ* P RTJ DEFFIL H0301930* P+1 ERRORS EXIST H0301931* P+2 NO ERRORS EXIST H0301932* THE ROUTINE PERFORMS A F.M. 2.0 CREATE H0301933**** H0301934 SPC 3 H0301935DEFFIL NUM 0 H0301936 LDA YOFRL FINAL OUTPUT RECORD LENGTH (CHARS) H0301937 LDQ- (LUN),I H0301938 QLS 15-14 H0301939 SQP DEFF10 SKIP IF NOT WORK FILE H0301940 LDA- RECLTH,I H0301941 ALS 1 CONVERT TO BYTES H0301942DEFF10 LDQ* COM20 IDATA ADDRESS H0301943 STA- RECSIZ,Q DEFINE RECORD SIZE (FIXED LENGTH RECORDS) H0301944 LDA YRECNT RECORD COUNT FOR FILE H0301945 STA- RECCNT,Q MOST SIGNIFICANT PART H0301946 LDA YRECNT+1 LEAST SIGNIFICANT PART OF RECORD COUNT H0301947 STA- RECCNT+1,Q H0301948 CLR A H0301949 STA- FLTYPE,Q CREATE NONSECTOR ALIGNED SEQUENTIAL FILE H0301950 ENQ XCREAT H0301951 RTJ* COMIO H0301952 JMP* DEFF20 P+1 ERROR EXIT H0301953 RAO* DEFFIL P+2 NORMAL EXIT H0301954ÐÐDEFF20 JMP* (DEFFIL) EXIT H0301955 EJT 0 H0301956**** H0301957*E H0301958* ********** H0301959* * RELFIL * H0301960* ********** H0301961* H0301962* H0301963* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF FILE TABLE H0301964* P RTJ RELFIL H0301965* P+1 ERRORS EXIST H0301966* P+2 NO ERRORS EXIST H0301967* THE ROUTINE PERFORMS A F.M. 2.0 DELETE H0301968**** H0301969 SPC 3 H0301970RELFIL NUM 0 H0301971 RTJ CLOSE H0301972 ENQ XDELET REQUEST FILE TO BE DELETED H0301973 RTJ* COMIO H0301974 JMP* (RELFIL) EXIT H0301975 EJT 0 H0301976**** H0301977*E H0301978* ******** H0301979ÐÐ* * OPEN * H0301980* ******** H0301981* H0301982* H0301983* THIS SUBROUTINE OPENS A FILE MANAGER FILE. THE NUMBER OF RECORDS TO H0301984* RETRIEVE FOR EACH READ OPERATION IS SPECIFIED AT OPEN TIME. FOR A H0301985* SECTOR ALIGN FILE ONLY ONE RECORD WILL BE READ. FOR OTHER FILE TYPES H0301986* THE NUMBER OF RECORDS IS CONTROLLED BY THE BLOCKING SIZE AND RECORD H0301987* LENGTH. H0301988* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF FILE TABLE H0301989* P RTJ OPEN H0301990* P+1 ERRORS EXIST H0301991* P+2 NO ERRORS EXIST H0301992* (I) EXIT = (I) ENTRY H0301993**** H0301994 SPC 3 H0301995OPEN NUM 0 H0301996 LDA- BUFLTH,I BLOCKED RECORD WORD COUNT H0301997 CLR Q IF OUTPUT TYPE FILE MAY BE 2 WORDS TOO BIG H0301998* THIS IS OK H0301999 DVI- RECLTH,I NUMBER OF RECORDS TO READ H0302000OPEN10 LDQ* COM20 IDATA BUFFER ADDRESS H0302001 STA- NUMRCD,Q NUMBER OF RECORDS TO RETRIEVE H0302002 CLR A H0302003 STA- RETRVL,Q SEQUENTIAL FLAG H0302004ÐÐ STA- LCKFLG,Q RECORD LOCK FLAG H0302005 LDA =XRECNT,I (A) = FWA OF THE AREA TO ZERO. H0302006 ENQ FTSIZE-RECNT (Q) = NO. OF WORDS TO ZERO. H0302007 RTJ CLR ZERO THE AREA DESIGNATED BY (A),(Q). H0302008 LDA- BUFWA,I (A) = FWA OF DATA PORTION OF BUFFER. H0302009 STA- RECFWA,I MAKE PUTU START WITH FWA OF DATA PORTION. H0302010 LDA =XFCB,I SPECIFY FCB ADDRESS H0302011 STA- REQBUF+FCBADR+RQINFO+1,I H0302012 ENQ XOPEN REQUEST FILE TO BE OPENED H0302013 RTJ* COMIO H0302014 JMP* OPEN30 P+1 ERROR EXIT H0302015 LDQ* COM20 H0302016 LDA- NUMRCD,Q NUMBER OF RECORDS IN BLOCK H0302017 INA -1 H0302018 SAZ OPEN20 SKIP IF FILE OPEN FOR ONE RECORD/READ H0302019 LDQ =XFCB,I FCB ADDRESS H0302020 LDA- FCBIND,Q H0302021 SAP OPEN20 SKIP IF INPUT FILE NOT SECTOR ALIGNED H0302022 RTJ CLOSE CLOSE FILE SINCE ONLY ONE RECORD CAN BE READ H0302023 ENA 1 H0302024 JMP* OPEN10 REOPEN FILE WITH RETRIEVING ONE RECORD AT A H0302025* TIME H0302026OPEN20 RAO* OPEN P+2 NORMAL EXIT H0302027OPEN30 JMP* (OPEN) EXIT H0302028 EJT 0 H0302029ÐÐ**** H0302030*E H0302031* ********* H0302032* * CLOSE * H0302033* ********* H0302034* H0302035* H0302036* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF FILE TABLE H0302037* P RTJ CLOSE H0302038* P+1 ERRORS EXIST H0302039* P+2 NO ERRORS EXIST H0302040* (I)EXIT = (I) ENTRY H0302041* THIS ROUTINE PERFORMS A F.M. 2.0 CLOSE H0302042**** H0302043 SPC 3 H0302044CLOSE NUM 0 H0302045 ENQ XCLOSF REQUEST FILE TO BE CLOSED H0302046 RTJ* COMIO H0302047 JMP* (CLOSE) EXIT H0302048 EJT 0 H0302049**** H0302050*E H0302051* ********* H0302052* * COMIO * H0302053* ********* H0302054ÐÐ* H0302055* H0302056* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF THE FILE TABLE H0302057* (Q) ENTRY = 0, CLOSE REQUEST H0302058* = 1, OPEN REQUEST H0302059* = 2, DELETE REQUEST H0302060* = 3, CREATE REQUEST H0302061* P RTJ COMIO H0302062* P+1 ERROR RETURN H0302063* P+2 NO ERROR RETURN H0302064* (I)EXIT = (I) ENTRY H0302065* COMIO PERFORMS COMMON I/O FUNCTIONS. THESE INCLUDE CLOSE, OPEN, H0302066* DELETE,AND CREATE FILE MANAGER 2.0 FILES. ERROR CONDITIONS ARE H0302067* REPORTED BY COMIO. H0302068**** H0302069ERRFLG BZS ERRFLG ERROR BYPASS IF NONZERO H0302070COMIOI BSS COMIOI SAVE I H0302071COMIOQ BSS COMIOQ SAVE Q H0302072COMIO NUM 0 H0302073 LDA- I SAVE (I) H0302074 STA* COMIOI H0302075 STQ* COMIOQ SAVE (Q) H0302076 SQZ COM05 SKIP IF CLOSE FUNCTION H0302077 RTJ* ISTUFF SPECIFY FILE DESCRIPTION IN IDATA BUFFER H0302078COM05 LDA =XREQBUF,I H0302079ÐÐ STA* COM10 REQBUF ADDRESS H0302080 LDA =XREQIND,I H0302081 STA* COM30 REQIND ADDRESS H0302082 LDQ* COMIOQ H0302083 LDQ* (XREF),Q FETCH FILE MANAGER PROCESSOR H0302084 RTJ- (ZERO),Q H0302085COM10 ADC *-* REQBUF H0302086COM20 ADC IDATA-HERE IDATA H0302087COM30 ADC *-* REQIND H0302088 LDA* ERRFLG H0302089 SAN COM35 SKIP, IF ERROR BYPASS SET H0302090 LDA* (COM30) REQIND H0302091 SAN COM45 ERROR(S) NOTED H0302092COM35 LDQ* COMIOQ H0302093 QLS 15-0 LOOK FOR CLOSE OR DELETE FUNCTION H0302094 SQP COM40 SKIP FOR CLOSE OR DELETE USE P+1 EXIT H0302095 RAO COMIO INDICATE NO ERROR PROCESSING REQUIRED H0302096COM40 LDA* COMIOI RESTORE (I) H0302097 STA- I H0302098 JMP* (COMIO) EXIT. H0302099COM45 LDQ* COMIOQ REQUEST OPTION H0302100 LDQ* COM80,Q MASK FOR WIERD CONDITION H0302101 LAQ Q H0302102 SQZ COM60 SKIP IF ERROR NOT WIERD H0302103 LDQ* COMIOQ H0302104ÐÐ LDQ* COM90,Q H0302105 STQ* COM50 IDENTIFY PROCESSOR H0302106 RTJ WIERD H0302107COM50 ADC *-* H0302108COM60 LDQ* COMIOQ H0302109 LDQ* COM100,Q H0302110* THE (A) VALUE (REQIND) IS PRESERVED THRU POSSIBLE WIERD CALL H0302111 RTJ TPHEX DISPLAY ERROR H0302112 RTJ LUFNO ANNOUNCE VOLUME AND FILE NAME H0302113 JMP* COM40 P+1 EXIT WHEN ERROR EXIST H0302114 SPC 3 H0302115XREF ADC *-* EXTERNAL REFERENCE ADDRESS TABLE H0302116 SPC 2 H0302117COM80 ADC HX600C WIERD REQIND BITS - CLOSE H0302118 ADC HX4401 WIERD REQIND BITS - OPEN H0302119 ADC HX6003 WIERD REQIND BITS - DELETE H0302120 ADC HX4400 WIERD REQIND BITS - CREATE H0302121 SPC 2 H0302122COM90 NUM 13,4,1,5 WIERD CODE NO. TO IDENTIFY PROCESSOR H0302123 SPC 2 H0302124COM100 ADC MSGCLS 'CLOSFL REQIND = $ ' H0302125 ADC MSGOPN 'OPENFL REQIND = $ ' H0302126 ADC MSGDEL 'DELETE REQIND = $ ' H0302127 ADC MSGCRT 'CREATE REQIND = $ ' H0302128 EJT 0 H0302129ÐÐ**** H0302130*E H0302131* ********* H0302132* * CLOSF * H0302133* ********* H0302134* H0302135* H0302136* THE CALLING SEQUENCE IS P RTJ CLOSF (REQIND,IDATA,REQIND) H0302137* CLOSF CONVERTS THREE INPUT PARAMETERS TO TWO FOR CLOSFL CALL. THE H0302138* COMIO ROUTINE SETS UP CALL SEQUENCE EXPECTING TO PASS THREE PARAMETERSH0302139* AND CLOSF MUST CONVERT THIS TO TWO PARAMETERS. H0302140**** H0302141 SPC 3 H0302142CLOSF NUM 0 H0302143 LDA* (CLOSF) REQIND H0302144 STA* CLOS10 H0302145 RAO* CLOSF H0302146 RAO* CLOSF SKIP IDATA PARAMETER H0302147 LDA* (CLOSF) H0302148 STA* CLOS20 H0302149 RAO* CLOSF H0302150 ENQ XCLOSE H0302151 LDQ* (XREF),Q CLOSFL H0302152 RTJ- (ZERO),Q H0302153CLOS10 ADC *-* REQBUF H0302154ÐÐCLOS20 ADC *-* REQIND H0302155 JMP* (CLOSF) EXIT H0302156 EJT 0 H0302157**** H0302158*E H0302159* ********** H0302160* * ISTUFF * H0302161* ********** H0302162* H0302163* H0302164* THE CALLING SEQUENCE IS (I) ENTRY = FWA OF FILE TABLE H0302165* P RTJ ISTUFF H0302166* (I)EXIT = (I)ENTRY H0302167* ISTUFF DEFINES THE FILE NAME, OWNER NAME AND VOLUME NAME FOR IDATA H0302168* BUFFER H0302169**** H0302170 SPC 3 H0302171ISTUFF NUM 0 H0302172 LDA* FILNO CHECK TO SEE IF IDATA ALREADY DEFINED H0302173 EOR- FILNUM,I H0302174 SAN ISTU05 SKIP IF DIFFERENT FILE H0302175 JMP* ISTU70 IDATA SET UP PROPERLY H0302176ISTU05 LDA- FILNUM,I H0302177 STA* FILNO FLAG CURRENT FILE DEFINED H0302178 RTJ* NAMEFL ADD FILE NAME TO IDATA BUFFER H0302179ÐÐ ENQ RETRVL-VOLNAM H0302180 LDA =A CLEAR VOLUME NAME SLOT - SYSTEM DEFINES NAME H0302181ISTU10 SQZ ISTU30 H0302182 INQ -1 H0302183 STA IDATA+VOLNAM,Q H0302184 JMP* ISTU10 H0302185ISTU30 LDA- (LUN),I H0302186 AND- HX03FF (A) = LUN H0302187 SAN ISTU50 LUN SPECIFIED H0302188 LDA- (LUN),I H0302189 AND- HXFC00 (A) = D/W,SKIPCNT,A/B,DOCNT,EXTENDED,0. H0302190 EOR* LUSYSM ADD NEW LU H0302191 STA- (LUN),I H0302192 LDA* LUSYSM H0302193ISTU50 TRA Q H0302194 EOR- HX03FF H0302195 SAZ ISTU70 SKIP IF OPEN REQUEST TO FIND VOLUME H0302196 LDQ MMLUTB,Q VOLUME INFORMATION TABLE ADDRESS H0302197 INQ VINAME H0302198ISTU60 STQ MVSRCE SOURCE ADDRESS OF VOLUME NAME H0302199 LDQ COM20 H0302200 LDA =XVOLNAM,Q H0302201 STA MVDEST DESTINATION ADDRESS FOR VOLUME NAME H0302202 ENQ RETRVL-VOLNAM H0302203 RTJ MOVE H0302204ÐÐISTU70 JMP* (ISTUFF) EXIT. H0302205 SPC 3 H0302206FILNO NUM $FFFF CURRENT FILE DEFINED H0302207LUSYSM BSS LUSYSM LU FOR SYSTEM VOLUME H0302208 EJT 0 H0302209**** H0302210*E H0302211* ********** H0302212* * NAMEFL * H0302213* ********** H0302214* H0302215* H0302216* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF FILE TABLE H0302217* RTJ NAMEFL H0302218* (I)EXIT = (I) ENTRY H0302219* NAMFL DETERMINES THE FILE NAME FOR IDATA. IF THIS IS A WORK FILE, H0302220* NAMEFL BUILDS A UNIQUE FILE NAME. THE FIRST CHARACTER IS BLANK, THE H0302221* NEXT 2 CHARACTERS ARE UNIQUE ASCII (HEX) VALUES, AND THE LAST H0302222* CHARACTER IS THE PORT NUMBER. H0302223**** H0302224 SPC 3 H0302225NAMEFL NUM 0 H0302226 LDQ COM20 IDATA ADDRESS H0302227 INQ IFLNAM OFFSET TO FILE NAME H0302228 LDA- (LUN),I CHECK IF WORK FILE H0302229ÐÐ ALS 15-14 H0302230 SAM NAM10 SKIP IF NOT PREDEFINE NAMES H0302231 LDA- FILNUM,I H0302232 INA -1 H0302233 ALS 3 8 WORDS/ENTRY H0302234 ADD YNAMFL H0302235 STA MVSRCE SOURCE ADDRESS OF FILE NAME H0302236 STQ MVDEST DET. ADDRESS FOR FILE NAME H0302237 ENQ VOLNAM-IFLNAM NUMBER OF WORDS TO MOVE H0302238 RTJ MOVE H0302239 JMP* NAM20 RETURN H0302240NAM10 LDA =A FIRST CHARACTER OF FILE NAME H0302241 STA- (ZERO),Q H0302242 STA- OWRNAM,Q FILE BELONGS TO TERMINAL USER H0302243 STA- OWRNAM+1,Q H0302244 STA- OWRNAM+2,Q H0302245 STA- OWRNAM+3,Q H0302246 LDA* PORTID PORT IDENTIFIER H0302247 STA- 3,Q H0302248 INQ 1 FWA OF ASCII HEX BUFFER H0302249 LDA- FILNUM,I CURRENT FILE NUMBER H0302250 RTJ BINHEX H0302251NAM20 JMP* (NAMEFL) EXIT. H0302252 SPC 3 H0302253NOPORT BSS NOPORT(2) PORT IDENTIFIER H0302254ÐÐPORTID EQU PORTID(NOPORT+1) ASCII PORT NUMBER H0302255 EJT 0 H0302256**** H0302257*E H0302258* ******** H0302259* * DATE * H0302260* ******** H0302261* H0302262* H0302263* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF FILE TABLE H0302264* RTJ DATE H0302265* (I)EXIT = (I)ENTRY H0302266* DEFINE CREATION AND EXPIRATION DATES FOR NEWLY DEFINED FILE H0302267**** H0302268DATI NUM 0 H0302269DATE NUM 0 H0302270 LDA- I H0302271 STA* DATI SAVE (I) REGISTER H0302272 LDA AMONTO CREATION MONTH H0302273 STA* FCBBUF+91 H0302274 LDA ADAYTO CREATION DAY H0302275 STA* FCBBUF+92 H0302276 LDA AYERTO CREATION YEAR H0302277 STA* FCBBUF+93 H0302278 LDA =XEXPIRE H0302279ÐÐ STA* FCBBUF+88 EXPIRATION MONTH H0302280 STA* FCBBUF+89 EXPIRATION DAY H0302281 STA* FCBBUF+90 EXPIRATION YEAR H0302282 LDA =XREQBUF,I REQUEST BUFFER ADDRESS H0302283 STA* DAT10 H0302284 LDA =XREQIND,I REQUEST INDICATOR ADDRESS H0302285 STA* DAT30 H0302286 ENQ XUPFCB H0302287 LDQ (XREF),Q UPDATE FCB H0302288 RTJ- (ZERO),Q H0302289DAT10 ADC *-* REQBUF H0302290 ADC ZERO VOLNAM H0302291 ADC *-* UNUSED AND UNPATCHED H0302292DAT20 ADC FCBBUF-HERE FCBBUF H0302293DAT30 ADC *-* REQIND H0302294 LDA* DATI H0302295 STA- I RESTORE (I) REGISTER H0302296 LDA* (DAT30) REQIND H0302297 SAZ DAT50 SKIP IF NO ERROR H0302298 LDQ =N$7000 MASK BITS 14,13,12 H0302299 LAQ Q H0302300 SQZ DAT40 SKIP IF ERROR NOT WIERD H0302301 RTJ WIERD ANNOUNCE AND HANDLE WIERD CONDITION H0302302 NUM 14 H0302303DAT40 ENQ MSGFCB 'UPDFCB REQIND = $ ' H0302304ÐÐ RTJ TPHEX DISPLAY ERROR H0302305 RTJ LUFNO ANNOUNCE VOLUME AND FILE NAME H0302306DAT50 JMP* (DATE) RETURN H0302307 SPC 3 H0302308* WORD 8 OF FCBDAT INDICATES SEQUENTIAL FILE WHEN VALUE IS ZERO H0302309FCBDAT BZS FCBDAT(8) EXPIRATION CREATION DATES (ASCII) H0302310FCBBUF EQU FCBBUF(FCBDAT-88) H0302311 EJT 0 H0302312**** H0302313*E H0302314* ********** H0302315* * GETFCB * H0302316* ********** H0302317* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF FILE TABLE H0302318* RTJ GETFCB H0302319* (I)EXIT = (I)ENTRY H0302320* GETFCB READS ALL OF FCB INTO FCB BUFFER. THIS IS NEEDED TO H0302321* DETERMINE BYTE LENGTH OF RECORDS. H0302322**** H0302323 SPC 3 H0302324GETFI NUM 0 SAVE I H0302325GETFCB NUM 0 H0302326 LDA- I SAVE (I) H0302327 STA* GETFI H0302328 LDA =XREQBUF,I H0302329ÐÐ STA* GETF10 REQBUF ADDRESS H0302330 LDA =XFCB+FH+1,I ALLOW FOR FCB HEADER NOT READ IN H0302331 STA* GETF20 FCB ADDRESS H0302332 LDA =XREQIND,I H0302333 STA* GETF30 REQIND ADDRESS H0302334 ENQ XGTFCB H0302335 LDQ (XREF),Q GET THE ENTIRE FCB H0302336 RTJ- (ZERO),Q H0302337GETF10 ADC *-* REQBUF H0302338 ADC ZERO VOLNAM H0302339 ADC *-* UNUSED AND NOT PLUGGED H0302340GETF20 ADC *-* FCBBFR H0302341GETF30 ADC *-* REQIND H0302342 LDA* GETFI RESTORE (I) H0302343 STA- I H0302344 LDA* (GETF30) REQIND H0302345 SAZ GETF50 H0302346 AND =N$7000 MASK BITS 14,13,12 H0302347 SAZ GETF40 SKIP IF NO UNUSUAL CONDITION EXIST H0302348 RTJ WIERD ANNOUNCE AND HANDLE WIERD CONDITION H0302349 NUM 15 H0302350GETF40 ENQ MSGTFB 'GETFCB = $ ' H0302351 LDA* (GETF30) H0302352 RTJ BADBLK H0302353 SET A,Q H0302354ÐÐ JMP BOMB STOP RUN H0302355GETF50 JMP* (GETFCB) RETURN H0302356 EJT 0 H0302357**** H0302358*E H0302359* ********** H0302360* * VOLSRH * H0302361* ********** H0302362* H0302363* H0302364* DETERMINE F.M. LU FROM VOLUME NAME H0302365* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF FILE TABLE H0302366* (Q)ENTRY = 0, IDATA HAS VOLUME NAME H0302367* (Q)ENTRY = FWA OF VOLUME NAME H0302368* RTJ VOLSRH H0302369* (I)EXIT = (I)ENTRY H0302370* (Q)EXIT = 0 VOLUME NOT MOUNTED H0302371* (Q)EXIT # 0 F.M. LOGICAL UNIT H0302372**** H0302373 SPC 3 H0302374VOLI NUM 0 H0302375VOLSRH NUM 0 H0302376 LDA- I (I) = FWA IF FILE TABLE H0302377 STA* VOLI SAVE (I) REGISTER H0302378 SQN VOL00 SKIP IF VOLUME NAME NOT IN IDATA H0302379ÐÐ LDQ COM20 H0302380 INQ VOLNAM FWA OF VOLUME IN IDATA H0302381VOL00 STQ- I (Q) = FWA OF VOLUME H0302382 LDQ* (MMLADR) LENGTH OF MMLUTB H0302383VOL10 STQ* LU CURRENT FILE MANAGER LU TO TEST H0302384 LDQ* (MMLADR),Q H0302385 LDA- (ZERO),Q H0302386 SAM VOL30 SKIP IF DEVICE NOT MOUNTED H0302387 INQ VINAME ADDRESS OF VOLUME NAME IN VIT H0302388 STQ* VOLADR SAVE BASE ADDRESS OF VOLUME NAME H0302389 ENQ VOLNAM-RETRVL H0302390VOL20 LDA* (VOLADR) CURRENT CHARACTER FROM VOLUME NAME H0302391 EOR- RETRVL-VOLNAM,B COMPARE VOLUME NAME WITH 'REFERENCE NAME' H0302392 SAN VOL30 SKIP IF NOT PROPER NAME H0302393 INQ 1 H0302394 SQZ VOL40 SKIP IF VOLUME NAME FOUND H0302395 RAO* VOLADR CONTINUE COMPARE FOR VOLUME NAME H0302396 JMP* VOL20 H0302397VOL30 LDQ* LU H0302398 INQ -1 H0302399 SQZ VOL50 SKIP IF VOLUME NAME DOES NOT EXIST H0302400 JMP* VOL10 LOOK AT NEXT VIT H0302401VOL40 LDQ* LU RETURN F.M. VALUE H0302402VOL50 LDA* VOLI H0302403 STA- I RESTORE (I) H0302404ÐÐ JMP* (VOLSRH) RETURN H0302405 SPC 3 H0302406LU NUM 0 F.M. LOGICAL UNIT H0302407MMLADR ADC MMLUTB MASS MEMORY LOGICAL UNIT TABLE H0302408VOLADR ADC *-* ADDRESS OF VOLUME NAME H0302409 EJT 0 H0302410**** H0302411*E H0302412* ********** H0302413* * COLSEQ * H0302414* ********** H0302415* H0302416* H0302417* IF DATA IS TO BE SORTED BY EBCDIC COLLATING SEQUENCE, EACH INPUT H0302418* RECORD IS CONVERTED FROM ASCII TO EBCDIC. THE DATA ONLY PORTION OF H0302419* THE FINAL OUTPUT RECORD OR THE FULL RECORD IF FULL RECORDS ARE SORTED H0302420* ARE CONVERTED FROM EBCDIC TO ASCII. NOTE, THE ADDROUT FILE WILL NOT H0302421* CONVERT THE RELATIVE RECORD NUMBERS SINCE THEY WERE NEVER CONVERT TO H0302422* EBCDIC ON INPUT. H0302423* THE CALLING SEQUENCE IS (A)ENTRY = FWA OF FIELD TO BE CONVERTED H0302424* (Q)ENTRY = NUMBER OF WORDS TO CONVERT H0302425* RTJ COLSEQ H0302426* (I)EXIT = (I)ENTRY H0302427* IF (Q) .GT. 0 CONVERT ASCII TO EBCDIC H0302428* (Q) .LT. 0 CONVERT EBCDIC TO ASCII H0302429ÐÐ**** H0302430 SPC 5 H0302431COLSI NUM 0 SAVE (I) H0302432COLSEQ NUM 0 H0302433 STA* ADRREC SAVE BASE ADDRESS OF FIELD TO CONVERT H0302434 LDA* NOP H0302435 SQP COL10 SKIP IF ASCII TO EBCDIC CONVERSION H0302436 TCQ Q H0302437 LDA* ARS8 H0302438COL10 STA* COL40 DEFINE INSTRUCTION TO BE USED H0302439 LDA- I SAVE (I) REGISTER H0302440 STA* COLSI H0302441 LDA YFLAG FLAG WORD H0302442 ALS 15-13 H0302443 SAP COL30 SKIP IF CONVERSION NOT REQUIRED H0302444COL20 INQ -1 H0302445 SQM COL25 SKIP IF ALL WORDS CONVERTED H0302446 LDA* (ADRREC),Q H0302447 ARS 8 H0302448 RTJ* EXTRAC CONVERT LEFT CHARACTER H0302449 ALS 8 H0302450 STA* CNVERT H0302451 LDA* (ADRREC),Q H0302452 RTJ* EXTRAC CONVERT RIGHT CHARACTER H0302453 EOR* CNVERT H0302454ÐÐ STA* (ADRREC),Q STORE BACK INTO ORIGINAL WORD H0302455 JMP* COL20 H0302456COL25 LDA* COLSI H0302457 STA- I RESTORE (I) H0302458COL30 JMP* (COLSEQ) RETURN H0302459 SPC 5 H0302460EXTRAC NUM 0 H0302461 AND- HX00FF H0302462 STA- I H0302463 LDA STACK0,I GET CORRESPONDING CHARACTER FROM TABLE H0302464COL40 NOP 0 NOP FOR ASC-EBC,ARS 8 FOR EBC-ASC H0302465 AND- HX00FF H0302466 JMP* (EXTRAC) RETURN H0302467 SPC 2 H0302468ARS8 ARS 8 H0302469CNVERT NUM 0 H0302470NOP NOP 0 H0302471ADRREC ADC *-* H0302472 EJT 0 H0302473**** H0302474*E H0302475* ASCII/EBCDIC TRANSLATION TABLE FOR ALTERNATE COLLATING SEQUENCE H0302476* H0302477* H0302478* GRAPHIC ASCII EBCDIC GRAPHIC ASCII EBCDIC GRAPHIC ASCII EBCDIC H0302479ÐÐ* ------- ----- ------ ------- ----- ------ ------- ----- ------ H0302480* NULL 00 00 * + 2B 4E * V 56 E5 H0302481* SDM 01 01 * , 2C 6B * W 57 E6 H0302482* STX 02 02 * - 2D 60 * X 58 E7 H0302483* ETX 03 03 * . 2E 4B * Y 59 E8 H0302484* EOT 04 04 * / 2F 61 * Z 5A E9 H0302485* ENQ 05 05 * 0 30 F0 * [ 5B 4A H0302486* ACK 06 06 * 1 31 F1 * \ 5C 5F H0302487* BEL 07 07 * 2 32 F2 * ] 5D 27 H0302488* BS 08 08 * 3 33 F3 * ^ 5E 4F H0302489* HT 09 09 * 4 34 F4 * - 5F 6D H0302490* LF 0A 0A * 5 35 F5 * - 60 2D H0302491* VT 0B 0B * 6 36 F6 * A 61 2F H0302492* FF 0C 0C * 7 37 F7 * B 62 62 H0302493* CR 0D 0D * 8 38 F8 * C 63 63 H0302494* SO 0E 0E * 9 39 F9 * D 64 64 H0302495* SI 0F 0F * : 3A 7A * E 65 65 H0302496* DLE 10 10 * ; 3B 5E * F 66 66 H0302497* DC1 11 11 * < 3C 4C * G 67 67 H0302498* DC2 12 12 * = 3D 7E * H 68 68 H0302499* DC3 13 13 * > 3E 6E * I 69 69 H0302500* DC4 14 14 * ? 3F 6F * J 6A 6A H0302501* ANK 15 15 * @ 40 7C * K 6B 2C H0302502* SYN 16 16 * A 41 C1 * L 6C 25 H0302503* ETB 17 17 * B 42 C2 * M 6D 3B H0302504ÐÐ* CAN 18 18 * C 43 C3 * N 6E 3E H0302505* EM 19 19 * D 44 C4 * O 6F 3F H0302506* SUB 1A 1A * E 45 C5 * P 70 70 H0302507* ESC 1B 1B * F 46 C6 * Q 71 71 H0302508* FS 1C 1C * G 47 C7 * R 72 72 H0302509* GS 1D 1D * H 48 C8 * S 73 73 H0302510* RS 1E 1E * I 49 C9 * T 74 74 H0302511* US 1F 1F * J 4A D1 * U 75 75 H0302512* BLANK 20 40 * K 4B D2 * V 76 76 H0302513* ! 21 5A * L 4C D3 * W 77 77 H0302514* " 22 7F * M 4D D4 * X 78 78 H0302515* # 23 7B * N 4E D5 * Y 79 79 H0302516* $ 24 5B * O 4F D6 * Z 7A 3A H0302517* % 25 6C * P 50 D7 * O+ 7B C0 H0302518* & 26 50 * Q 51 D8 * : 7C 20 H0302519* ' 27 7D * R 52 D9 * O- 7D D0 H0302520* ( 28 4D * S 53 E2 * - 7E 22 H0302521* ) 29 5D * T 54 E3 * DELETE 7F 7F H0302522* * 2A 5C * U 55 E4 * 80 80 H0302523**** H0302524 EJT 0 H0302525**** H0302526*E ASCII/EBCDIC TRANSLATION TABLE FOR ALTERNATE COLLATING SEQUENCE H0302527* H0302528* H0302529ÐÐ* GRAPHIC ASCII EBCDIC GRAPHIC ASCII EBCDIC GRAPHIC ASCII EBCDIC H0302530* ------- ----- ------ ------- ----- ------ ------ ------ ------ H0302531* H0302532* H0302533* 81 81 * AC AC * D7 26 H0302534* 82 82 * AD AD * D8 51 H0302535* 83 83 * AE AE * D9 52 H0302536* 84 84 * AF AF * DA DA H0302537* 85 85 * B0 B0 * DB DB H0302538* 86 86 * B1 B1 * DC DC H0302539* 87 87 * B2 B2 * DD DD H0302540* 88 88 * B3 B3 * DE DE H0302541* 89 89 * B4 B4 * DF DF H0302542* 8A 8A * B5 B5 * E0 E0 H0302543* 8B 8B * B6 B6 * E1 E1 H0302544* 8C 8C * B7 B7 * E2 53 H0302545* 8D 8D * B8 B8 * E3 54 H0302546* 8E 8E * B9 B9 * E4 55 H0302547* 8F 8F * BA BA * E5 56 H0302548* 90 90 * BB BB * E6 57 H0302549* 91 91 * BC BC * E7 58 H0302550* 92 92 * BD BD * E8 59 H0302551* 93 93 * BE BE * E9 21 H0302552* 94 94 * BF BF * EA EA H0302553* 95 95 * C0 23 * EB EB H0302554ÐÐ* 96 96 * C1 41 * EC EC H0302555* 97 97 * C2 42 * ED ED H0302556* 98 98 * C3 43 * EE EE H0302557* 99 99 * C4 44 * EF EF H0302558* 9A 9A * C5 45 * F0 30 H0302559* 9B 9B * C6 46 * F1 31 H0302560* 9C 9C * C7 47 * F2 32 H0302561* 9D 9D * C8 48 * F3 33 H0302562* 9E 9E * C9 49 * F4 34 H0302563* 9F 9F * CA CA * F5 35 H0302564* A0 A0 * CB CB * F6 36 H0302565* A1 A1 * CC CC * F7 37 H0302566* A2 A2 * CD CD * F8 38 H0302567* A3 A3 * CE CE * F9 39 H0302568* A4 A4 * CF CF * FA FA H0302569* A5 A5 * D0 29 * FB FB H0302570* A6 A6 * D1 24 * FC FC H0302571* A7 A7 * D2 2E * FD FD H0302572* A8 A8 * D3 3C * FE FE H0302573* A9 A9 * D4 28 * FF FF H0302574* AA AA * D5 2B * H0302575* AB AB * D6 2A * H0302576**** H0302577 EJT 0 H0302578STACK0 VFD X8/$00,X8/$00 H0302579ÐÐ VFD X8/$01,X8/$01 H0302580 VFD X8/$02,X8/$02 H0302581 VFD X8/$03,X8/$03 H0302582 VFD X8/$04,X8/$04 H0302583 VFD X8/$05,X8/$05 H0302584 VFD X8/$06,X8/$06 H0302585 VFD X8/$07,X8/$07 H0302586 VFD X8/$08,X8/$08 H0302587 VFD X8/$09,X8/$09 H0302588 VFD X8/$0A,X8/$0A H0302589 VFD X8/$0B,X8/$0B H0302590 VFD X8/$0C,X8/$0C H0302591 VFD X8/$0D,X8/$0D H0302592 VFD X8/$0E,X8/$0E H0302593 VFD X8/$0F,X8/$0F H0302594 VFD X8/$10,X8/$10 H0302595 VFD X8/$11,X8/$11 H0302596 VFD X8/$12,X8/$12 H0302597 VFD X8/$13,X8/$13 H0302598 VFD X8/$14,X8/$14 H0302599 VFD X8/$15,X8/$15 H0302600 VFD X8/$16,X8/$16 H0302601 VFD X8/$17,X8/$17 H0302602 VFD X8/$18,X8/$18 H0302603 VFD X8/$19,X8/$19 H0302604ÐÐ VFD X8/$1A,X8/$1A H0302605 VFD X8/$1B,X8/$1B H0302606 VFD X8/$1C,X8/$1C H0302607 VFD X8/$1D,X8/$1D H0302608 VFD X8/$1E,X8/$1E H0302609 VFD X8/$1F,X8/$1F H0302610 VFD X8/$7C,X8/$40 H0302611 VFD X8/$E9,X8/$5A H0302612 VFD X8/$7F,X8/$7F H0302613 VFD X8/$C0,X8/$7B H0302614 VFD X8/$D1,X8/$5B H0302615 VFD X8/$6C,X8/$6C H0302616 VFD X8/$D7,X8/$50 H0302617 VFD X8/$5D,X8/$7D H0302618 VFD X8/$D4,X8/$4D H0302619 VFD X8/$D0,X8/$5D H0302620 VFD X8/$D6,X8/$5C H0302621 VFD X8/$D5,X8/$4E H0302622 VFD X8/$6B,X8/$6B H0302623 VFD X8/$60,X8/$60 H0302624 VFD X8/$D2,X8/$4B H0302625 VFD X8/$61,X8/$61 H0302626 VFD X8/$F0,X8/$F0 H0302627 VFD X8/$F1,X8/$F1 H0302628 VFD X8/$F2,X8/$F2 H0302629ÐÐ VFD X8/$F3,X8/$F3 H0302630 VFD X8/$F4,X8/$F4 H0302631 VFD X8/$F5,X8/$F5 H0302632 VFD X8/$F6,X8/$F6 H0302633 VFD X8/$F7,X8/$F7 H0302634 VFD X8/$F8,X8/$F8 H0302635 VFD X8/$F9,X8/$F9 H0302636 VFD X8/$7A,X8/$7A H0302637 VFD X8/$6D,X8/$5E H0302638 VFD X8/$D3,X8/$4C H0302639 VFD X8/$7E,X8/$7E H0302640 VFD X8/$6E,X8/$6E H0302641 VFD X8/$6F,X8/$6F H0302642 VFD X8/$20,X8/$7C H0302643 VFD X8/$C1,X8/$C1 H0302644 VFD X8/$C2,X8/$C2 H0302645 VFD X8/$C3,X8/$C3 H0302646 VFD X8/$C4,X8/$C4 H0302647 VFD X8/$C5,X8/$C5 H0302648 VFD X8/$C6,X8/$C6 H0302649 VFD X8/$C7,X8/$C7 H0302650 VFD X8/$C8,X8/$C8 H0302651 VFD X8/$C9,X8/$C9 H0302652 VFD X8/$5B,X8/$D1 H0302653 VFD X8/$2E,X8/$D2 H0302654ÐÐ VFD X8/$3C,X8/$D3 H0302655 VFD X8/$28,X8/$D4 H0302656 VFD X8/$2B,X8/$D5 H0302657 VFD X8/$5E,X8/$D6 H0302658 VFD X8/$26,X8/$D7 H0302659 VFD X8/$D8,X8/$D8 H0302660 VFD X8/$D9,X8/$D9 H0302661 VFD X8/$E2,X8/$E2 H0302662 VFD X8/$E3,X8/$E3 H0302663 VFD X8/$E4,X8/$E4 H0302664 VFD X8/$E5,X8/$E5 H0302665 VFD X8/$E6,X8/$E6 H0302666 VFD X8/$E7,X8/$E7 H0302667 VFD X8/$E8,X8/$E8 H0302668 VFD X8/$21,X8/$E9 H0302669 VFD X8/$24,X8/$4A H0302670 VFD X8/$2A,X8/$5F H0302671 VFD X8/$29,X8/$27 H0302672 VFD X8/$3B,X8/$4F H0302673 VFD X8/$5C,X8/$6D H0302674 VFD X8/$2D,X8/$2D H0302675 VFD X8/$2F,X8/$2F H0302676 VFD X8/$62,X8/$62 H0302677 VFD X8/$63,X8/$63 H0302678 VFD X8/$64,X8/$64 H0302679ÐÐ VFD X8/$65,X8/$65 H0302680 VFD X8/$66,X8/$66 H0302681 VFD X8/$67,X8/$67 H0302682 VFD X8/$68,X8/$68 H0302683 VFD X8/$69,X8/$69 H0302684 VFD X8/$6A,X8/$6A H0302685 VFD X8/$2C,X8/$2C H0302686 VFD X8/$25,X8/$25 H0302687 VFD X8/$5F,X8/$3B H0302688 VFD X8/$3E,X8/$3E H0302689 VFD X8/$3F,X8/$3F H0302690 VFD X8/$70,X8/$70 H0302691 VFD X8/$71,X8/$71 H0302692 VFD X8/$72,X8/$72 H0302693 VFD X8/$73,X8/$73 H0302694 VFD X8/$74,X8/$74 H0302695 VFD X8/$75,X8/$75 H0302696 VFD X8/$76,X8/$76 H0302697 VFD X8/$77,X8/$77 H0302698 VFD X8/$78,X8/$78 H0302699 VFD X8/$79,X8/$79 H0302700 VFD X8/$3A,X8/$3A H0302701 VFD X8/$23,X8/$C0 H0302702 VFD X8/$40,X8/$20 H0302703 VFD X8/$27,X8/$D0 H0302704ÐÐ VFD X8/$3D,X8/$3D H0302705 VFD X8/$22,X8/$22 H0302706 VFD X8/$80,X8/$80 H0302707 VFD X8/$81,X8/$81 H0302708 VFD X8/$82,X8/$82 H0302709 VFD X8/$83,X8/$83 H0302710 VFD X8/$84,X8/$84 H0302711 VFD X8/$85,X8/$85 H0302712 VFD X8/$86,X8/$86 H0302713 VFD X8/$87,X8/$87 H0302714 VFD X8/$88,X8/$88 H0302715 VFD X8/$89,X8/$89 H0302716 VFD X8/$8A,X8/$8A H0302717 VFD X8/$8B,X8/$8B H0302718 VFD X8/$8C,X8/$8C H0302719 VFD X8/$8D,X8/$8D H0302720 VFD X8/$8E,X8/$8E H0302721 VFD X8/$8F,X8/$8F H0302722 VFD X8/$90,X8/$90 H0302723 VFD X8/$91,X8/$91 H0302724 VFD X8/$92,X8/$92 H0302725 VFD X8/$93,X8/$93 H0302726 VFD X8/$94,X8/$94 H0302727 VFD X8/$95,X8/$95 H0302728 VFD X8/$96,X8/$96 H0302729ÐÐ VFD X8/$97,X8/$97 H0302730 VFD X8/$98,X8/$98 H0302731 VFD X8/$99,X8/$99 H0302732 VFD X8/$9A,X8/$9A H0302733 VFD X8/$9B,X8/$9B H0302734 VFD X8/$9C,X8/$9C H0302735 VFD X8/$9D,X8/$9D H0302736 VFD X8/$9E,X8/$9E H0302737 VFD X8/$9F,X8/$9F H0302738 VFD X8/$A0,X8/$A0 H0302739 VFD X8/$A1,X8/$A1 H0302740 VFD X8/$A2,X8/$A2 H0302741 VFD X8/$A3,X8/$A3 H0302742 VFD X8/$A4,X8/$A4 H0302743 VFD X8/$A5,X8/$A5 H0302744 VFD X8/$A6,X8/$A6 H0302745 VFD X8/$A7,X8/$A7 H0302746 VFD X8/$A8,X8/$A8 H0302747 VFD X8/$A9,X8/$A9 H0302748 VFD X8/$AA,X8/$AA H0302749 VFD X8/$AB,X8/$AB H0302750 VFD X8/$AC,X8/$AC H0302751 VFD X8/$AD,X8/$AD H0302752 VFD X8/$AE,X8/$AE H0302753 VFD X8/$AF,X8/$AF H0302754ÐÐ VFD X8/$B0,X8/$B0 H0302755 VFD X8/$B1,X8/$B1 H0302756 VFD X8/$B2,X8/$B2 H0302757 VFD X8/$B3,X8/$B3 H0302758 VFD X8/$B4,X8/$B4 H0302759 VFD X8/$B5,X8/$B5 H0302760 VFD X8/$B6,X8/$B6 H0302761 VFD X8/$B7,X8/$B7 H0302762 VFD X8/$B8,X8/$B8 H0302763 VFD X8/$B9,X8/$B9 H0302764 VFD X8/$BA,X8/$BA H0302765 VFD X8/$BB,X8/$BB H0302766 VFD X8/$BC,X8/$BC H0302767 VFD X8/$BD,X8/$BD H0302768 VFD X8/$BE,X8/$BE H0302769 VFD X8/$BF,X8/$BF H0302770 VFD X8/$7B,X8/$23 H0302771 VFD X8/$41,X8/$41 H0302772 VFD X8/$42,X8/$42 H0302773 VFD X8/$43,X8/$43 H0302774 VFD X8/$44,X8/$44 H0302775 VFD X8/$45,X8/$45 H0302776 VFD X8/$46,X8/$46 H0302777 VFD X8/$47,X8/$47 H0302778 VFD X8/$48,X8/$48 H0302779ÐÐ VFD X8/$49,X8/$49 H0302780 VFD X8/$CA,X8/$CA H0302781 VFD X8/$CB,X8/$CB H0302782 VFD X8/$CC,X8/$CC H0302783 VFD X8/$CD,X8/$CD H0302784 VFD X8/$CE,X8/$CE H0302785 VFD X8/$CF,X8/$CF H0302786 VFD X8/$7D,X8/$29 H0302787 VFD X8/$4A,X8/$24 H0302788 VFD X8/$4B,X8/$2E H0302789 VFD X8/$4C,X8/$3C H0302790 VFD X8/$4D,X8/$28 H0302791 VFD X8/$4E,X8/$2B H0302792 VFD X8/$4F,X8/$2A H0302793 VFD X8/$50,X8/$26 H0302794 VFD X8/$51,X8/$51 H0302795 VFD X8/$52,X8/$52 H0302796 VFD X8/$DA,X8/$DA H0302797 VFD X8/$DB,X8/$DB H0302798 VFD X8/$DC,X8/$DC H0302799 VFD X8/$DD,X8/$DD H0302800 VFD X8/$DE,X8/$DE H0302801 VFD X8/$DF,X8/$DF H0302802 VFD X8/$E0,X8/$E0 H0302803 VFD X8/$E1,X8/$E1 H0302804ÐÐ VFD X8/$53,X8/$53 H0302805 VFD X8/$54,X8/$54 H0302806 VFD X8/$55,X8/$55 H0302807 VFD X8/$56,X8/$56 H0302808 VFD X8/$57,X8/$57 H0302809 VFD X8/$58,X8/$58 H0302810 VFD X8/$59,X8/$59 H0302811 VFD X8/$5A,X8/$21 H0302812 VFD X8/$EA,X8/$EA H0302813 VFD X8/$EB,X8/$EB H0302814 VFD X8/$EC,X8/$EC H0302815 VFD X8/$ED,X8/$ED H0302816 VFD X8/$EE,X8/$EE H0302817 VFD X8/$EF,X8/$EF H0302818 VFD X8/$30,X8/$30 H0302819 VFD X8/$31,X8/$31 H0302820 VFD X8/$32,X8/$32 H0302821 VFD X8/$33,X8/$33 H0302822 VFD X8/$34,X8/$34 H0302823 VFD X8/$35,X8/$35 H0302824 VFD X8/$36,X8/$36 H0302825 VFD X8/$37,X8/$37 H0302826 VFD X8/$38,X8/$38 H0302827 VFD X8/$39,X8/$39 H0302828 VFD X8/$FA,X8/$FA H0302829ÐÐ VFD X8/$FB,X8/$FB H0302830 VFD X8/$FC,X8/$FC H0302831 VFD X8/$FD,X8/$FD H0302832 VFD X8/$FE,X8/$FE H0302833 VFD X8/$FF,X8/$FF H0302834 EJT 0 H0302835**** H0302836*E H0302837* ********** H0302838* * MVCHRS * H0302839* ********** H0302840* H0302841* H0302842* THIS ROUTINE MOVES A CHARACTER STRING AND OFFSETS THE STRING ONE H0302843* CHARACTER POSITION TO THE LEFT WITHIN THE WORD STRUCTURE FOR THE H0302844* STRING. THE SAME STARTING WORD LOCATION FOR THE STRING CAN BE H0302845* SPECIFIED BOTH AS SOURCE FOR THE MOVE AND DESTINATION AFTER THE MOVE. H0302846* THE CALLING SEQUENCE IS (A)ENTRY = FWA OF KEY FIELD H0302847* (Q)ENTRY = FWA OF SHIFTED KEY FIELD H0302848* RTJ MVCHRS MOVE AND SHIFT CHARACTERS H0302849* ADC KYCOLS - NUMBER OF CHARACTERS IN FIELD H0302850* <0, CHAR STARTS ON EVEN BOUNDARY H0302851* >0, CHAR STARTS ON ODD BOUNDARY H0302852* (I)EXIT = (I) ENTRY H0302853**** H0302854ÐÐ SPC 3 H0302855MVCHRS NUM 0 H0302856 STA* MVSRCE SOURCE ADDRESS H0302857 STQ* MVDEST DESTINATION ADDRESS H0302858 LDA* (MVCHRS) NO. OF CHARACTERS TO MOVE H0302859 TRA Q H0302860 SAM MVC10 SKIP IF NEGATIVE COUNT H0302861 TCQ Q MAKE COUNT NEGATIVE H0302862MVC10 INQ -1 ROUND (UP) IN CASE CHAR COUNT ODD H0302863 QRS 1 H0302864 STQ* PASCNT NUMBER OF TIMES TO STORE WORDS H0302865 SAP MVC20 SKIP IF SOURCE KEY FIELD NOT ON WORD BOUNDARY H0302866 ALS 15 H0302867* THE INSTRUCTION BELOW IS SAP BECAUSE (A) IS NEGATIVE H0302868 SAP MVC30 SKIP IF ODD CHARACTER COUNT IN KEY FIELD H0302869 INQ -1 (INCREASE) PASS COUNT BY ONE SINCE KEY EVEN H0302870 STQ* PASCNT H0302871 JMP* MVC30 H0302872MVC20 LDQ* (MVSRCE) PRELOAD (Q) H0302873 RAO* MVSRCE H0302874MVC30 LDA* (MVSRCE) MOVE IN NEW WORD FOR SHIFT H0302875 LLS 8 H0302876 STQ* (MVDEST) SAVE CURRENT SHIFT WORD H0302877 LLS 8 H0302878 RAO* PASCNT H0302879ÐÐ LDA* PASCNT H0302880 SAZ MVC40 SKIP IF WE ARE DONE H0302881 RAO* MVSRCE ADVANCE TO NEXT WORD H0302882 RAO* MVDEST ADVANCE TO NEXT WORD H0302883 JMP* MVC30 H0302884MVC40 RAO* MVCHRS SKIP OVER PARAMETER BEING PASSED H0302885 JMP* (MVCHRS) RETURN H0302886 SPC 3 H0302887PASCNT NUM 0 NO. OF WORDS TO STORE FOR SHIFTED CHARACTERS H0302888 EJT H0302889**** H0302890*E H0302891* ******** H0302892* * MOVE * H0302893* ******** H0302894* H0302895* H0302896* MOVE RIGHT TO LEFT. H0302897* MOVE MUST BE FAST. DURING A SINGLE SORT RUN, MOVE MOVES EACH BYTE OF H0302898* EACH LOGICAL RECORD SEVERAL TIMES, DESPITE THE FACT THAT THE NUMBER OFH0302899* SUCH MOVES IS REDUCED BY MOVING POINTERS INSTEAD OF LOGICAL RECORDS, H0302900* WHENEVER POSSIBLE. H0302901* WORD-TIMES = 4 + 9 * WORDS-TO-MOVE, E.G. 364 = F(80 BYTES), 4 = F(0). H0302902* THE CALLING SEQUENCE IS (MVSRCE)ENTRY = FWA OF SOURCE. H0302903* (MVDEST)ENTRY = FWA OF DESTINATION. H0302904ÐÐ* (Q)ENTRY = NO. OF WORDS TO MOVE. H0302905* RTJ MOVE MOVE IFF (Q)ENTRY .GE. 1. H0302906* (A)EXIT = (LAST WORD MOVED). H0302907* (Q)EXIT = -1. H0302908* (I),(MVSRCE),(MVDEST) EXIT = ENTRY. H0302909**** H0302910MOVE NUM 0 H0302911MVLOOP INQ -1 (Q) = FWA NEXT SOURCE WORD - FWA OF SOURCE, H0302912* = FWA NEXT DESTINATION WORD - FWA OF DESTINATION.H0302913 SQP MVLDA SKIP IF MORE WORDS TO MOVE. H0302914 JMP* (MOVE) EXIT. H0302915MVLDA LDA* (MVSRCE),Q (A) = (NEXT WORD TO MOVE). H0302916 STA* (MVDEST),Q MOVE A WORD. H0302917 JMP* MVLOOP EXIT OR MOVE NEXT WORD. H0302918MVSRCE NUM 0 () = FWA OF SOURCE. H0302919MVDEST NUM 0 () = FWA OF DESTINATION. H0302920 EJT H0302921**** H0302922*E H0302923* ********** H0302924* * SAVAQI * H0302925* ********** H0302926* H0302927* H0302928* SAVAQI SAVES THE (A), (Q), AND (I) REGISTERS. H0302929ÐÐ* THE CALLING SEQUENCE RTJ SAVAQI H0302930* (A)EXIT = (A)ENTRY H0302931* (Q)EXIT = (Q)ENTRY H0302932* (I)EXIT = (I)ENTRY H0302933**** H0302934SAVAQI NUM 0 H0302935 STA* (SAVAQI) SAVE (A)ENTRY. H0302936 RAO* SAVAQI () = FWA OF Q SAVE AREA. H0302937 STQ* (SAVAQI) SAVE (Q)ENTRY. H0302938 RAO* SAVAQI () = FWA OF I SAVE AREA. H0302939 LDQ- I (Q) = (I)ENTRY. H0302940 STQ* (SAVAQI) SAVE (I). H0302941 RAO* SAVAQI () = FWA OF NSI OF CALLER. H0302942 LDQ* SAVAQI (Q) = FWA OF NSI OF CALLER. H0302943 INQ -3 (Q) = FWA OF A SAVE AREA. H0302944 LDQ- 1,Q (Q) = (Q)ENTRY. H0302945 JMP* (SAVAQI) EXIT. H0302946 SPC 3 H0302947 EJT 0 H0302948**** H0302949*E H0302950* ********** H0302951* * RESAQI * H0302952* ********** H0302953* H0302954ÐÐ* H0302955* RESAQI RESTORES THE (A), (Q), AND (I) REGISTERS SAVED BY SAVAQI H0302956* ROUTINE. SOME ROUTINES MODIFY THE SAVED RESULTS IN ORDER TO SPECIFY H0302957* VALUES FOR CERTAIN OF THESE REGISTERS. H0302958* THE CALLING SEQUENCE IS RTJ RESAQI H0302959* (A)EXIT = (A)ENTRY FROM SAVAQI H0302960* (Q)EXIT = (Q)ENTRY FROM SAVAQI H0302961* (I)EXIT = (I)ENTRY FROM SAVAQI H0302962**** H0302963RESAQI NUM 0 H0302964 LDQ* (RESAQI) (Q) = FWA OF A,Q,I SAVE AREA. H0302965 LDA- 2,Q (A) = SAVED (I). H0302966 STA- I RESTORE (I). H0302967 LDA- (ZERO),Q RESTORE (A). H0302968 LDQ- 1,Q RESTORE (Q). H0302969 RAO* RESAQI SET UP P+2 EXIT. H0302970 JMP* (RESAQI) TAKE P+2 EXIT. H0302971 EJT 0 H0302972**** H0302973*E H0302974* ********** H0302975* * CRTMSG * H0302976* ********** H0302977* H0302978* H0302979ÐÐ* THE CALLING SEQUENCE IS (A) ENTRY = FWA OF DATA BUFFER H0302980* (Q)ENTRY = MESSAGE INDEX H0302981* RTJ CRTMSG OUTPUT MESSAGE H0302982* (I)EXIT = (I)ENTRY H0302983* CRTMSG USES THE ITOS GENERAL MESSAGE PROCESSOR TO OUTPUT MESSAGES H0302984**** H0302985 SPC 3 H0302986CRTI NUM 0 H0302987CRTMSG NUM 0 H0302988 STA* CRT20 DATA ADDRESS IN CASE IT IS NEEDED H0302989 ADQ =XBASMSG BASE ADDRESS TO SORT MESSAGES H0302990 STQ* CRT30 MESSAGE INDEX H0302991 LDA- I H0302992 STA* CRTI H0302993 ENQ XSYMSG H0302994 LDQ (XREF),Q H0302995 RTJ- (ZERO),Q CALL SYSMSG H0302996CRT10 ADC CRT30-HERE H0302997CRT20 ADC *-* DATA BUFFER ADDRESS H0302998 LDA* CRTI H0302999 STA- I RESTORE (I) H0303000 JMP* (CRTMSG) RETURN H0303001 SPC 3 H0303002CRT30 ADC *-* MESSAGE INDEX H0303003 EJT H0303004ÐÐ**** H0303005*E H0303006* ********* H0303007* * TYPIN * H0303008* ********* H0303009* H0303010* H0303011* THE TYPIN SUBROUTINE IS USED ONLY TO SUPPLY THE INPUT DIRECTIVES TO H0303012* DSORT EDITOR (SMCEDT). H0303013* TYPIN READS INTO A BUFFER WHOSE FWA FOLLOWS RTJ TYPIN. H0303014* THE CALLING SEQUENCE IS P RTJ TYPIN H0303015* P+1 FWA OF BUFFER = 1 + FWA OF BUFFER LENGTHH0303016* P+2 RETURN WITH (A) = NO. CHARACTERS OBTAIN H0303017* (Q),(I) = (Q)ENTRY,(I)ENTRY.H0303018**** H0303019TYPIN NUM 0 H0303020 RTJ SAVAQI H0303021TYPINA NUM 0,0,0 H0303022 LDQ* (TYPIN) (Q) = FWA OF BUFFER. H0303023 RAO* TYPIN () = FWA OF NSI. H0303024 STQ* TYPINS PLACE FWA OF BUFFER INTO FREAD. H0303025 INQ -2 (Q) = -1 + FWA OF LENGTH WORD. H0303026 LDQ- 1,Q (Q) = BUFFER LENGTH IN WORDS. H0303027 STQ* TYPINN PLACE BUFFER LENGTH INTO FREAD. H0303028 RTJ- (AMONI) H0303029ÐÐ VFD N1/0,N1/1,N5/4,N1/0,X4/PRLVL,X4/PRLVL H0303030TYPIN1 ADC TYPINC-HERE COMPLETION. H0303031 NUM 0 THREAD. H0303032TYPINL BSS TYPINL LU WORD H0303033TYPINN NUM 0 NO. OF WORDS TO FREAD. H0303034TYPINS NUM 0 FWA OF FREAD BUFFER. H0303035 JMP- (ADISP) GIVE UP CPU DURING IO. H0303036TYPINC SQP TYPING SKIP IF FREAD IS GOOD. H0303037 JMP* TYPINB JMP IF FREAD IS BAD. H0303038TYPING LDQ* TYPINN (A) = DESIRED LENGTH OF TRANSFER. H0303039 ADQ* TYPINS (Q) = 1 + LWA OF BUFFER. H0303040 LDA- (ZERO),Q (A) = ACTUAL TRANSFER LENGTH IN CHARACTERS H0303041 STA* TYPINA CAUSE (A)EXIT TO = NO. OF CHARACTERS READ H0303042 SAZ TYPINB CONSIDER NO TRANSFER TO BE AN ERROR. H0303043 RTJ RESAQI RESTORE (Q)ENTRY,(I)ENTRY. SET (A)EXIT. H0303044TYPIN2 ADC TYPINA-HERE FWA OF (A),(Q),(I) SAVE AREA. H0303045 JMP* (TYPIN) EXIT. H0303046TYPINB ENQ MSGESC 'TYPE-IN ERROR' H0303047 SET A TELL BOMB TO USE TYPOUT, NOT TPHEX. H0303048 JMP BOMB SMC ABNORMALLY TERMINATES. H0303049 EJT H0303050**** H0303051*E H0303052* ********** H0303053* * BINHEX * H0303054ÐÐ* ********** H0303055* H0303056* H0303057* BINHEX CONVERTS ONE WORD OF DATA TO TWO WORDS OF (HEX) ASCII VALUES. H0303058* THE CALLING SEQUENCE IS (A)ENTRY = BINARY TO BE CONVERTED TO HEX. H0303059* (Q)ENTRY = FWA OF 2-WORD BUFFER. H0303060* RTJ BINHEX H0303061* (A),(Q),(I) EXIT = (A),(Q),(I) ENTRY. H0303062**** H0303063BINHEX NUM 0 H0303064 STA* B2HXA SAVE (A)ENTRY. H0303065 STQ* B2HXQ SAVE (Q)ENTRY. H0303066 STQ* B2HXPT SET POINTER TO HEX BUFFER. H0303067B2HXLP RTJ* B2HXBT SET (Q) = 8] HEX VERSION OF NEXT 4] OF (A). H0303068 QLS 8 LEFT-ADJUST IN (Q) THE 1ST OR 3RD HEX DIGIT.H0303069 STQ* (B2HXPT) SET 1ST OR 3RD HEX DIGIT INTO BUFFER. H0303070 RTJ* B2HXBT SET (Q) = 8] HEX VERSION OF NEXT 4] OF (A). H0303071 ADQ* (B2HXPT) ADD TO (Q) THE 2ND OR 4TH HEX DIGIT. H0303072 STQ* (B2HXPT) SET 1ST,2ND OR 3RD,4TH HEX DIGITS INTO BUF. H0303073 LDQ* B2HXQ (Q) = (Q)ENTRY. H0303074 TCQ Q SUBTRACT THE 2 ADDRESSES H0303075 ADQ* B2HXPT (Q) = 0, 1ST PASS, (Q) # 0 2ND PASS H0303076 SQN B2HXIT SKIP IF ALL DONE. H0303077 RAO* B2HXPT POINT TO 2ND WORD OF BUFFER. H0303078 JMP* B2HXLP CONVERT THE 2ND HALF OF (A)ENTRY. H0303079ÐÐB2HXIT LDA* B2HXA RESTORE (A)ENTRY. H0303080 LDQ* B2HXQ RESTORE (Q)ENTRY. H0303081 JMP* (BINHEX) EXIT. H0303082 EJT 0 H0303083**** H0303084*E H0303085* ********** H0303086* * B2HXBT * H0303087* ********** H0303088* H0303089* H0303090* B2HXBT CONVERTS THE UPPER 4 BITS OF (A) TO A (HEX) ASCII DIGIT. THE H0303091* (A) VALUE IS SHIFTED 4 BITS FOR THE NEXT CALL TO B2HXBT. H0303092* THE CALLING SEQUENCE IS (A)ENTRY = $WXYZ. H0303093* RTJ B2HXBT H0303094* (A)EXIT = $XYZ0. H0303095* (Q)EXIT = $30,...,$39,$41,...,$46 H0303096* AS W IS 0,..., 9, $A,..., $F. H0303097**** H0303098B2HXBT NUM 0 H0303099 CLR Q PREPARE TO SET (Q) = NEXT 4] OF (A). H0303100 LLS 4 SET (Q) = NEXT 4] OF (A). H0303101 INQ -10 (Q)15=1 IF WE ARE TO GENERATE $30,...,$39. H0303102 SQM 1 SKIP TO GENERATE ONE OF $30,...,$39. H0303103 INQ $41-10-$30 PREPARE TO GENERATE ONE OF $41,...,$46. H0303104ÐÐ INQ 10+$30 (Q) = 8] HEX VERSION OF THE LATEST 4] OF (A)H0303105 JMP* (B2HXBT) EXIT. H0303106B2HXA NUM 0 () = (A)ENTRY. H0303107B2HXQ NUM 0 () = (Q)ENTRY. H0303108B2HXPT NUM 0 () = FWA OF CURRENT HEX BUFFER WORD. H0303109 EJT H0303110**** H0303111*E H0303112* ********** H0303113* * BINDEC * H0303114* ********** H0303115* H0303116* H0303117* BINDEC HANGS IF (A)ENTRY .GE. 10000, ELSE BINDEC CONVERTS (A)ENTRY H0303118* TO 4 ASCII DECIMAL DIGITS AND PLACES THESE DECIMAL DIGITS IN THE H0303119* TWO WORD BUFFER WITH FWA = (Q)ENTRY. H0303120* THE CALLING SEQUENCE IS (A)ENTRY = BINARY TO CONVERT TO BCD. H0303121* (Q)ENTRY = FWA OF 2-WORD-BUFFER. H0303122* RTJ BINDEC H0303123* (A),(Q),(I) EXIT = (A),(Q),(I) ENTRY. H0303124**** H0303125BINDEC NUM 0 H0303126 RTJ SAVAQI SAVE ALL REGISTERS. H0303127B2DA NUM 0 () = (A)ENTRY. H0303128B2DQ NUM 0 () = (Q)ENTRY. H0303129ÐÐ NUM 0 () = (I)ENTRY. H0303130 SUB =N10000 (A)15=1 IF NO. TO CONVERT .LE. 9999. H0303131 SAM B2DBOK SKIP IF NO. TO CONVERT .LE. 9999. H0303132 RTJ WIERD ANNOUNCE AND HANDLE WIERD CONDITION. H0303133 NUM -6 ANNOUNCE ERROR NO.6 AND STOP THE RUN. H0303134B2DBOK LDA* B2DA (A) = NO. TO CONVERT. H0303135 STQ- I (I) = FWA OF DESTINATION OF CONVERSION. H0303136 LDQ =A00 (Q) = TWO ASCII ZEROS. H0303137 STQ- 1,I ZERO 2ND WD OF DEST IN CASE B2DLUP DONE ONCE. H0303138B2DLUP CLR Q (Q)=0. (A) = BITS TO CONVERT. H0303139 DVI* B2D10 (Q) = 4TH OR 2ND DIGIT (1ST IS MOST SIG.). H0303140 INQ $30 (Q)15-8=0. (Q)7-0 = 4TH OR 2ND ASCII DIGIT. H0303141 STQ- (ZERO),I SET 1ST OR 2ND WORD OF DESTINATION. H0303142 CLR Q (Q)=0. (A) = BITS TO CONVERT. H0303143 DVI* B2D10 (Q) = 3RD OR 1ST DIGIT (1ST IS MOST SIG.). H0303144 INQ $30 (Q)15-8=0. (Q)7-0 = 3RD OR 1ST ASCII DIGIT. H0303145 QLS 8 (Q)15-8 = 3RD OR 1ST ASCII DIGIT. (Q)7-0=0. H0303146 ADQ- (ZERO),I (Q) = 3RD,4TH OR 2ND,1ST ASCII DIGITS. H0303147 STQ- (ZERO),I SET 1ST OR 2ND WORD OF DESTINATION. H0303148 RAO- I NEXT B2DLUP WILL DO 2ND WORD. 1ST WORD NOW DONE.H0303149 SAZ B2DXIT SKIP IF NO MORE TO CONVERT. H0303150 JMP* B2DLUP H0303151* NOW WE MUST EXCHANGE THE TWO WORDS SINCE THEY WERE CREATED IN REVERSE H0303152* ORDER TO TAKE ADVANTAGE OF THE RAO INSTRUCTION. H0303153B2DXIT LDA* B2DQ (A) = FWA OF 2-WORD-BUFFER. H0303154ÐÐ STA- I (I) = FWA OF 3RD,4TH ASCII DIGITS. H0303155 LDQ- 1,I (Q) = 1ST,2ND ASCII DIGITS FROM 2ND DEST. WORD. H0303156 LDA- (ZERO),I (A) = 3RD,4TH ASCII DIGITS FROM 1ST DEST. WORD. H0303157 STQ- (ZERO),I (1ST DEST. WORD) = 1ST,2ND ASCII DIGITS. H0303158 STA- 1,I (2ND DEST. WORD) = 3RD,4TH ASCII DIGITS. H0303159 RTJ RESAQI RESTORE ALL REGISTERS. H0303160B2D01 ADC B2DA-HERE () = FWA OF A,Q,I SAVE AREA. H0303161 JMP* (BINDEC) EXIT. H0303162B2D10 NUM 10 OUR RADIX. H0303163 EJT H0303164**** H0303165*E H0303166* ********** H0303167* * HADOUT * H0303168* ********** H0303169* H0303170* H0303171* HADOUT DETERMINES FROM (A), AND (Q) WHETHER TO DISPLAY PREFIX AND/OR H0303172* HEX VALUE OF MESSAGE. H0303173* THE CALLING SEQUENCE IS (A)ENTRY = -0 OR 16] TO MAKE INTO BCD OR HEXH0303174* (Q)ENTRY = -0 OR INDEX FOR ASCII PREFIX. H0303175* (HXBCDS)ENTRY = EVEN,ODD FOR HEX,BCD. H0303176* RTJ HADOUT OUTPUT HEX,ASCII, OR DECIMAL. H0303177* (A),(Q),(I),(HXBCDS) EXIT = ENTRY. H0303178**** H0303179ÐÐHADOUT NUM 0 H0303180 RTJ SAVAQI SAVE (A),(Q),(I) ENTRY. H0303181HADOA NUM 0,0,0 () = (A),(Q),(I) ENTRY. H0303182 EOR- HXFFFF (A)=0 IF (A)ENTRY = -0. H0303183 SAZ HADOAF SKIP IF (A)ENTRY = -0. H0303184 SET A SET (A)=-0 TO TEST WHETHER (Q)ENTRY=-0. H0303185 EAQ A (A)=0 IF (Q)ENTRY = -0. H0303186 SAN HADOTX SKIP IF (Q)ENTRY = FWA OF PREFIX. H0303187 ENQ ZERO TELL TPHEX THAT PREFIX LENGTH IS ZERO. H0303188HADOTX LDA* HADOA (A) = BINARY TO CONVERT TO HEX OR BCD. H0303189 RTJ* TPHEX ANNOUNCE PREFIX AND HEX OR BCD SUFFIX. H0303190HADOXT RTJ RESAQI RESTORE (A),(Q),(I) ENTRY. H0303191HADO01 ADC HADOA-HERE () = FWA OF HADOA. H0303192 JMP* (HADOUT) EXIT. H0303193HADOAF SET A SET (A)=-0 TO TEST WHETHER (Q)ENTRY=-0. H0303194 EAQ A (A)=0 IF (Q)ENTRY = -0. H0303195 SAZ HADOFF SKIP IF -0 = (Q)ENTRY AS WELL AS (A)ENTRY. H0303196 RTJ CRTMSG ANNOUNCE PREFIX WITHOUT SUFFIX. H0303197HADOFF JMP* HADOXT PREPARE TO EXIT. H0303198 EJT H0303199**** H0303200*E H0303201* ******** H0303202* * BOMB * H0303203* ******** H0303204ÐÐ* H0303205* H0303206* BOMB ALWAYS OUTPUTS THE MESSAGE ]FATAL ERROR] AND THEN STOPS THE RUN. H0303207* BOMB MAY PRECEDE THE ABOVE MESSAGE WITH ANOTHER MESSAGE ACCORDING H0303208* TO (A),(Q),(HXBCDS) ENTRY. H0303209* THE CALLING SEQUENCE IS (A)ENTRY = -0 OR 16] TO MAKE INTO BCD OR HEXH0303210* (Q)ENTRY = -0 OR INDEX FOR ASCII PREFIX H0303211* (HXBCDS)ENTRY = EVEN,ODD FOR HEX,BCD. H0303212* JMP BOMB GIVE UP CPU FOREVER, I.E. DIE. H0303213**** H0303214BOMB RTJ* HADOUT OUTPUT OPTIONAL MESSAGE DEPENDING ON PARAMS.H0303215 ENQ MSGBOM 'FATAL ERROR' H0303216 RTJ CRTMSG ANNOUNCE ]FATAL ERROR]. H0303217 LDA* MODE H0303218 SAZ BOMBZ SKIP IF ABORT ADDRESS NOT GIVEN H0303219 RAO* (MODE) TELL EXECUTIVE TO EXIT PROCEDURE STREAM H0303220BOMBZ JMP- (ADISP) GIVE UP THE CPU. H0303221 SPC 3 H0303222MODE BSS MODE 0 = INTERACTIVE, 1 = PROCEDURE STREAM H0303223 EJT H0303224**** H0303225*E H0303226* ********* H0303227* * TPDEC * H0303228* ********* H0303229ÐÐ* H0303230* H0303231* TPDEC ENTRY INFORMS TPHEX SUBROUTINE THAT THE BINARY VALUE IS TO BE H0303232* CONVERTED TO BCD SUFFIX. H0303233* THE CALLING SEQUENCE IS (A)ENTRY = BINARY TO BECOME BCD SUFFIX, H0303234* OR = FWA OF 2 WORDS OF BINARY. H0303235* (Q)ENTRY = FWA OF PREFIX H0303236* = 1 + FWA OF PREFIX LENGTH. H0303237* RTJ TPDEC H0303238* (A)EXIT = (A)ENTRY. (Q)EXIT = (Q)ENTRY. H0303239**** H0303240TPDEC NUM 0 H0303241 RTJ* TPHEX PUBLISH PREFIX WITH BCD SUFFIX. H0303242TPDECX JMP* (TPDEC) EXIT. H0303243 EJT 0 H0303244**** H0303245*E H0303246* ********* H0303247* * BTDEC * H0303248* ********* H0303249* H0303250* H0303251* BTDEC INFORMS TPHEX SUBROUTINE THAT THE 2 BINARY VALUES ARE TO BE H0303252* CONVERTED INTO 4 WORDS OF BCD SUFFIX. H0303253* THE CALLING SEQUENCE IS (A)ENTRY = FWA OF 2 BINARY WORDS H0303254ÐÐ* TO BECOME 4-WORD BCD SUFFIX. H0303255* (Q)ENTRY = FWA OF PREFIX H0303256* = 1 + FWA OF PREFIX LENGTH. H0303257* RTJ BTDEC H0303258* (A),(Q),(I) EXIT = (A),(Q),(I) ENTRY. H0303259**** H0303260BTDEC NUM 0 H0303261 RTJ* TPDEC PUBLISH PREFIX WITH BCD SUFFIX. H0303262BTDECX JMP* (BTDEC) EXIT. H0303263 EJT H0303264**** H0303265*E H0303266* ********* H0303267* * TPHEX * H0303268* ********* H0303269* H0303270* H0303271* THE CALLING SEQUENCE IS (A)ENTRY DESIGNATES BINARY TO CONVERT TO H0303272* HEX OR BCD SUFFIX. H0303273* (Q)ENTRY = MESSAGE INDEX. H0303274* RTJ TPHEX H0303275* (A)EXIT = (A)ENTRY. (Q)EXIT = (Q)ENTRY. H0303276* TPHEX CONVERTS (A)ENTRY TO A HEX SUFFIX UNLESS TPHEX WAS CALLED BY H0303277* TPDEC, WHICH CAUSES A BCD SUFFIX. H0303278* IF BTDEC CALLED TPDEC CALLED TPHEX, H0303279ÐÐ* THEN (A)ENTRY = FWA OF 2 BINARY WORDS, H0303280* EACH .GE. 0 AND .LE. 9999, TO CONVERT TO 4 WORDS OF BCD. H0303281* IF TPDEC CALLED TPHEX, BUT BTDEC DID NOT CALL TPDEC, H0303282* THEN (A)ENTRY IS CONVERTED TO 2 BCD WORDS IF 0 .LE. (A)ENTRY .LE. 9999H0303283* AND TO 4 BCD WORDS IF 10000 .LE. (A)ENTRY .LE. 65535. H0303284**** H0303285TPHEX NUM 0 H0303286 STA* TPHEXA SAVE (A)ENTRY. H0303287 INQ 0 LOOK FOR 0, $FFFF H0303288 SQN TPHEX3 SKIP IF PREFIX EXIST H0303289 ENQ MSGBLK ' ' H0303290TPHEX3 STQ* TPHEXQ SAVE (Q)ENTRY. H0303291TPHEX1 LDQ =XTPHXSX+2-HERE (Q) = FWA OF HEX BUFFER. H0303292* SEE TPDEC W.R.T. TPHEX AND HXBCD. H0303293 RTJ* HXBCD CONVERT (A)ENTRY TO HEX OR BCD IN BUFFER. H0303294TPHEX2 LDA =XTPHXSX-HERE (A) = 1 + LWA OF PREFIX DESTINATION. H0303295 LDQ* TPHEXQ MESSAGE INDEX H0303296 RTJ CRTMSG PUBLISH THE MESSAGE. H0303297 LDA* TPHEXA RESTORE (A)ENTRY. H0303298 LDQ* TPHEXQ RESTORE (Q)ENTRY. H0303299 JMP* (TPHEX) EXIT. H0303300TPHEXA NUM 0 () = (A)ENTRY. H0303301TPHEXQ NUM 0 () = (Q)ENTRY. H0303302TPHXSX ALF /, =XX/ START OF SUFFIX. ALTERED BY HXBCD. H0303303 NUM 0,0,0,0 HEX OR BCD BUFFER WITHIN SUFFIX. H0303304ÐÐ EJT H0303305**** H0303306*E H0303307* ********* H0303308* * HXBCD * H0303309* ********* H0303310* H0303311* H0303312* IF (TPHEX)ENTRY INDICATE THAT TPHEX WAS NOT CALLED BY TPDEC, H0303313* THEN (TPHEXA)ENTRY ARE CONVERTED TO HEX. IF TPDEC IS THE CALLER, H0303314* THEN BCD IS PRODUCED, EITHER FROM (TPHEXA)ENTRY OR FROM 2 WORDS H0303315* WITH FWA = (TPHEXA)ENTRY. SEE TPDEC AND BTDEC. H0303316* (Q)ENTRY = FWA OF HEX OR BCD BUFFER. H0303317* RTJ HXBCD H0303318**** H0303319HXBCD NUM 0 H0303320 STQ* HXBCDQ SAVE (Q)ENTRY. H0303321 LDA =A (A) = TWO BLANK BYTES. H0303322 STA* TPHXSX+1 SET BCD IDENTIFIER INTO SUFFIX. H0303323 STA* TPHXSX+4 BLANK THE 1ST OPTIONAL BCD WORD. H0303324 STA* TPHXSX+5 BLANK THE 2ND OPTIONAL BCD WORD. H0303325 LDA* TPHEX (A) = FWA OF NSI OF TPHEX CALLER. H0303326HXBCD0 EOR =XTPDECX-HERE (A)=0 IF TPDEC CALLED TPHEX. H0303327 SAZ HXBCDD SKIP IF TPDEC CALLED TPHEX. H0303328 LDA =A $ H0303329ÐÐ STA* TPHXSX+1 SET HEX IDENTIFIER INTO SUFFIX. H0303330 LDA* TPHEXA (A) = BINARY TO CONVERT TO HEX. H0303331 RTJ BINHEX FORM HEX IN BUFFER WITH FWA = (Q). H0303332 JMP* (HXBCD) EXIT. H0303333HXBCDD LDA* TPDEC (A) = FWA OF NSI OF TPDEC CALLER. H0303334HXBCD1 EOR =XBTDECX-HERE (A)=0 IF BTDEC CALLED TPDEC. H0303335 SAN HXBCDT SKIP IF BTDEC DIDN]T CALL TPDEC. H0303336 LDA* (TPHEXA) (A) = (1ST BINARY WORD). H0303337 LDQ* TPHEXA (Q) = FWA OF 1ST BINARY WORD. H0303338 LDQ- 1,Q (Q) = (2ND BINARY WORD). H0303339 JMP* HXBCD4 CONVERT THE TWO WORDS. H0303340HXBCDT CLR Q PREPARE TO DIVIDE. H0303341 LDA* TPHEXA (A) = BINARY TO CONVERT TO BCD. H0303342 DVI =N10000 (Q) = REMAINDER. (A) = QUOTIENT. H0303343 SAN HXBCD4 SKIP IF 4 WORDS OF BCD TO MAKE. H0303344 TRQ A (A) = BINARY TO CONVERT TO BCD. H0303345HXBCD2 LDQ* HXBCDQ (Q) = FWA OF BCD DESTINATION. H0303346 RTJ BINDEC FORM BCD IN BUFFER WITH FWA = (Q). H0303347 JMP* (HXBCD) EXIT. H0303348HXBCD4 STQ* HXBCDA SAVE CONVERTEE FOR LOWER BCD. H0303349 LDQ* HXBCDQ (Q) = FWA OF UPPER BCD DESTINATION. H0303350 RTJ BINDEC FORM 1ST 2 (OF 4) BCD WORDS. H0303351 RAO* HXBCDQ () = FWA OF 2ND BCD WORD. H0303352 RAO* HXBCDQ () = FWA OF 3RD BCD WORD. H0303353 LDA* HXBCDA (A) = CONVERTEE FOR LOWER BCD. H0303354ÐÐ JMP* HXBCD2 FORM 2ND 2 (OF 4) BCD WORDS. H0303355HXBCDA NUM 0 () = CONVERTEE FOR LOWER BCD. H0303356HXBCDQ NUM 0 () = (Q)ENTRY. H0303357 EJT 0 H0303358**** H0303359*E H0303360* ********* H0303361* * WIERD * H0303362* ********* H0303363* H0303364* H0303365* THE CALLING SEQUENCE IS P RTJ WIERD H0303366* P+1 CONDITION., OR ITS COMPLEMENT H0303367* P+2 EXIT FOR POSITIVE CONDITION NO. H0303368* (A),(Q),(I) EXIT = (A),(Q),(I) ENTRY. H0303369* THE WIERD SUBROUTINE REPORTS THE ABNORMAL ERROR CONDITION PASSED TO ITH0303370* THE ERROR NUMBERS ARE: H0303371* 1, FILE MANAGER DELETE ERROR H0303372* 2, FILE MANAGER GETS ERROR H0303373* 3, FILE MANAGER PUTS ERROR H0303374* 4, FILE MANAGER OPENFL ERROR H0303375* 5, FILE MANAGER CREATE ERROR H0303376* -6, (A) > 100000 PASSED TO BINDEC SUBROUTINE H0303377* -7, SMCEDT LENGTH ERROR H0303378* -8, SMCSRT LENGTH ERROR H0303379ÐÐ* -9, INTERMEDIATE MERGE WAS NOT NEEDED H0303380*-10, SMCIMG LENGTH ERROR H0303381*-11, INTERMEDIATE MERGE WAS NEEDED H0303382*-12, SMCFMG LENGTH ERROR H0303383* 13, FILE MANAGER CLOSFL ERROR H0303384* 14, FILE MANAGER UPDFCB ERROR H0303385* 15, FILE MANAGER GETFCB ERROR H0303386* WIERD JUMPS TO BOMB FOR NEGATIVE CONDITION NUMBERS. H0303387**** H0303388WIERDA NUM 0 () = (A)ENTRY. H0303389WIERDQ NUM 0 () = (Q)ENTRY. H0303390WIERD NUM 0 H0303391 STA* WIERDA SAVE (A) ENTRY. H0303392 STQ* WIERDQ SAVE (Q)ENTRY. H0303393 ENQ MSGABE 'ABNORMAL ERROR = H0303394 LDA* (WIERD) (A) = NO. OF THE WIERD CONDITION. H0303395 SAP WIERDT SKIP IF POSITIVE CONDITION. H0303396 TCA A COMPLEMENT NEGATIVE CONDITION NO. H0303397WIERDT RTJ TPDEC ANNOUNCE THE WIERD CONDITION. H0303398 LDA* (WIERD) (A) 15=1 IF FATAL CONDITION. H0303399 SAM WIERDB BOMB IF ORDERED TO. H0303400 LDA* WIERDA RESTORE (A)ENTRY. H0303401 LDQ* WIERDQ RESTORE (Q)ENTRY. H0303402 RAO* WIERD SET UP FOR P+2 EXIT. H0303403 JMP* (WIERD) TAKE P+2 EXIT. H0303404ÐÐWIERDB SET A,Q DESELECT OPTIONAL BOMB MESSAGE. H0303405 JMP BOMB STOP THE RUN. H0303406 EJT H0303407***SMC FIXED TABLES*** H0303408YNAMFL ADC YNAMEF-HERE () = FWA OF FILE NAME TABLE H0303409YIFTAD NUM 0 () = FWA OF INPUT FILE TABLES DEFINED BY SMCEDT.H0303410YADOUT NUM 0 () = FWA OF ADDROUT TABLE H0303411YKEY NUM 0 () = FWA OF KEY TABLE H0303412YADRBF NUM 0 () = FWA OF ADDROUT RECORD BUFFER H0303413YFIELD NUM 0 () = FWA HEADER PART OF COMPARE TABLE H0303414YCOMPR NUM 0 () = FWA KEY COMPARE TABLE H0303415YSHIFT NUM 0 () = FWA KEY SHIFTED FIELD H0303416YEND NUM 0 () = 1 + LWA OF VARIABLE TABLES. H0303417YHICOR NUM 0 () = 1 + LWA OF AVAILABLE CORE. H0303418YEDTSZ ADC EDTSIZ () = SIZE OF EDIT RESIDENT. H0303419YSRTSZ ADC SRTSIZ () = SIZE OF INTERNAL-SORT RESIDENT. H0303420YIMGSZ ADC IMGSIZ () = SIZE OF INTERMEDIATE-MERGE RESIDENT. H0303421YFMGSZ ADC FMGSIZ () = SIZE OF FINAL-MERGE RESIDENT. H0303422YPHASE NUM -1 () = NUMBER OF CURRENT PHASE. H0303423YDM NUM 0 () = NO. OF INPUT FILES. H0303424YFLAG NUM 0 () = SORT OPTION FLAG WORD H0303425YG NUM 0 () = NO. OF REAL BINS IN TOURNAMENT. H0303426YIWAY NUM 0 () = MAXIMUM WAY OF INTERMEDIATE MERGE. H0303427YFWAY NUM 0 () = MAXIMUM WAY OF FINAL MERGE. H0303428YMAXIB NUM 0 () = MAXIMUM OF USER INPUT BLOCK SIZES. H0303429ÐÐYWKBSZ NUM 0 () = WORK FILE BLOCK SIZE. H0303430* (YSRCNT),(YSRCNT+1) ARE SET BY INIT OF SMCIMG OR OF SMCFMG. H0303431YIRCNT NUM 0,0 () = NO. OF RECORDS INPUT TO PHASE. H0303432YORCNT NUM 0,0 () = NO. OF RECORDS OUTPUT FROM PHASE. H0303433YSQ2MG NUM 0 () = NO. OF SEQUENCES LEFT TO MERGE. H0303434YSEQCT NUM 0 () = NO. OF SEQUENCES OUT OF SMCSRT. H0303435YCMPKY ADC CMPKEY-HERE () = FWA OF CMPKEY. H0303436YRCADD ADC RECADD-HERE () = FWA OF RECADD H0303437YGETU ADC GETU-HERE () = FWA OF GETU. H0303438YPUTU ADC PUTU-HERE () = FWA OF PUTU. H0303439YCLSU ADC CLSU-HERE () = FWA OF CLSU. H0303440YGTSEQ ADC GETSEQ-HERE () = FWA OF GETSEQ. H0303441YBOS ADC BOS-HERE () = FWA OF BOS. H0303442YEOS ADC EOS-HERE () = FWA OF EOS. H0303443YOFRL NUM 0 () = NO. OF CHARACTERS IN FINAL OUTPUT FILE. H0303444YRECNT NUM 0,0 () = NO. OF RECORDS IN FILE FOR DEF H0303445YOPEN ADC OPEN-HERE () = FWA OF OPEN H0303446YCLOSE ADC CLOSE-HERE () = FWA OF CLOSE H0303447YGTFCB ADC GETFCB-HERE () = FWA OF GETFCB H0303448YVOLSR ADC VOLSRH-HERE () = FWA OF VOLSRH H0303449YCLSEQ ADC COLSEQ-HERE () = FWA OF COLSEQ H0303450YMVCHR ADC MVCHRS-HERE () = FWA OF MVCHRS H0303451YSVAQI ADC SAVAQI-HERE () = FWA OF SAVAQI. H0303452YREAQI ADC RESAQI-HERE () = FWA OF RESAQI. H0303453YCRMSG ADC CRTMSG-HERE () = FWA OF CRTMSG. H0303454ÐÐYTYPIN ADC TYPIN-HERE () = FWA OF TYPIN. H0303455YBOMB ADC BOMB-HERE () = FWA OF BOMB. H0303456YWIERD ADC WIERD-HERE () = FWA OF WIERD. H0303457YOFT BZS YOFT(REQBUF) 1ST PART OF OUTPUT FILE TABLE. H0303458YCMPLA ADC CMPLA-1-HERE () = -1 + FWA OF CMPLA. H0303459YCMPLD ADC CMPLD-1-HERE () = -1 + FWA OF CMPLD. H0303460YCMCLA ADC CMPCLA-1-HERE () = -1 + FWA OF CMPCLA. H0303461YCMCLD ADC CMPCLD-1-HERE () = -1 + FWA OF CMPCLD. H0303462YCMPWA ADC CMPWA-1-HERE () = -1 + FWA OF CMPWA. H0303463YCMPWD ADC CMPWD-1-HERE () = -1 + FWA OF CMPWD. H0303464YCMCUA ADC CMPCUA-1-HERE () = -1 + FWA OF CMPCUA. H0303465YCMCUD ADC CMPCUD-1-HERE () = -1 + FWA OF CMPCUD. H0303466 BZS (YOFT+FTSIZE-*) LAST PART OF OUTPUT FILE TABLE. H0303467YNAMEF EQU YNAMEF(*) SMCEDT WILL BUILD THE FILE NAME TABLE. H0303468 EJT H0303469**** H0303470*E H0303471* ******** H0303472* * INIT * H0303473* ******** H0303474* H0303475* H0303476* INIT CONFIGURES THE RUN BASED UPON INFORMATION PASSED BY DSORT AND H0303477* THE EXECUTIVE ROUTINE PGMIN. INTERNAL ADDRESSES ARE ABSOLUTIZED. H0303478* THE CALLING SEQUENCE IS (Q)ENTRY = FWA OF THE EXTERNAL REF. ADDR TABLEH0303479ÐÐ* (I)ENTRY = FWA OF THE EXTERNAL REF. ADDR TABLEH0303480* RTJ INIT H0303481* (A)EXIT = INDEX TO LOAD SMCEDT H0303482* (Q)EXIT = FWA WHERE SMCEDT IS TO BE LOADED H0303483**** H0303484INIT NUM 0 H0303485* (Q), (I) = SMC2 EXTERNAL ADDRESS TABLE H0303486 LDA- (I) H0303487 STA YHICOR (A) = 1 + LWA AVAILABLE CORE. H0303488 INQ 1 H0303489 STQ XREF SAVE FWA OF F.M. ADDRESSES H0303490 RTJ* RELOC RELOCATE ALL RELOCATABLES. H0303491INIT06 LDA =XCLOSF-HERE H0303492 ENQ XCLOSF H0303493 STA (XREF),Q ADDRESS OF CLOSF ROUTINE H0303494 RTJ PGMIN H0303495PGM10 ADC IDUSER-HERE ASCII USER ID H0303496PGM20 ADC TYPINL-HERE SYSTEM LU H0303497PGM30 ADC MODE-HERE MODE OF OPERATION H0303498PGM40 ADC NOPORT-HERE TERMINAL PORT NUMBER H0303499 LDA* (PGM20) DEFINE INPUT LU H0303500 EOR- HX1000 SET WORDS NOT CHARACTERS H0303501 STA* (PGM20) H0303502 LDA* (PGM40) NOPORT H0303503 LDQ* PGM40 ADDRESS TO STORE ASCII PORT ID H0303504ÐÐ RTJ BINDEC CONVERT NUMBER TO ASCII DEC. H0303505 LDQ WKSPLU LU USED FOR WORK SPACE H0303506 STQ LUSYSM SAVE F.M. LU FOR WORK FILES H0303507 LDQ SMCMON (Q) = 1 + FWA OF DSORT. H0303508 INQ -1 (Q) = FWA OF DSORT. H0303509INIT05 LDA =XYNAMFL-HERE (A) = FWA OF FIXED TABLES. H0303510 STA- (ZERO),Q TELL LOAD TO PASS IT ON TO HIS LOADEE. H0303511 LDA YHICOR (A) = 1 + LWA AVAILABLE CORE. H0303512 SUB YEDTSZ (A) = FWA OF LOAD POINT OF SMCEDT. H0303513 TRA Q (Q) = FWA OF LOAD POINT OF SMCEDT. H0303514 SUB YNAMFL (A)15=1 IF TOO LITTLE CORE. H0303515 SAP INIT04 SKIP IF ENOUGH CORE. H0303516 ENQ MSGTLC 'TOO LITTLE CORE' H0303517 SET A DELETE SUFFIX. H0303518 JMP BOMB ABNORMALLY TERMINATE. H0303519INIT04 CLR A SELECT SMCEDT. H0303520 JMP* (INIT) EXIT. H0303521IDUSER BSS IDUSER(4) ASCII USER IDENTIFICATION H0303522 EJT H0303523**** H0303524*E H0303525* ********* H0303526* * RELOC * H0303527* ********* H0303528* H0303529ÐÐ* H0303530* THE CALLING SEQUENCE IS RTJ RELOC H0303531* (I)EXIT = (I)ENTRY H0303532* RELOC RELOCATES THE WORDS MENTIONED IN THE LIST, RELOC4. H0303533**** H0303534RELOC NUM 0 H0303535 ENQ RELOC3 (Q) = NO. OF ENTRIES IN RELOC4. H0303536RELOC7 INQ -1 (Q) = INDEX TO NEXT RELOCATEE. H0303537 SQP RELOC6 SKIP IF NOT DONE. H0303538 JMP* (RELOC) EXIT IF DONE. H0303539RELOC6 LDA* RELOC4,Q (A) = FWA OF RELOCATEE - FWA OF HERE. H0303540 ADD* INIT (A) = FWA OF RELOCATEE. H0303541 STA* RELOC5 SAVE FWA OF RELOCATEE. H0303542 LDA* (RELOC5) (A) = RELOCATEE. H0303543 ADD* INIT (A) = RELOCATED (RELOCATEE). H0303544 STA* (RELOC5) SET RELOCATEE. H0303545 JMP* RELOC7 JMP TO SEE IF DONE. H0303546RELOC5 NUM 0 () = FWA OF RELOCATEE. H0303547RELOC4 EQU RELOC4(*) H0303548 ADC SMCDEF+1-HERE H0303549 ADC SMCREL+1-HERE H0303550 ADC BGADLA+1-HERE H0303551 ADC RCADR-HERE H0303552 ADC TYRCT0-HERE H0303553 ADC TYRCT1-HERE H0303554ÐÐ ADC GETU80-HERE H0303555 ADC CLSU01-HERE H0303556 ADC REL40-HERE H0303557 ADC GTSQ01+1-HERE H0303558 ADC GTSQ02-HERE H0303559 ADC GTSQ03-HERE H0303560 ADC PTSQ04+1-HERE H0303561 ADC PTSQ06+1-HERE H0303562 ADC PTSQ01-HERE H0303563 ADC PTSQ02-HERE H0303564 ADC WRT050-HERE H0303565 ADC CNT10-HERE H0303566 ADC COM20-HERE H0303567 ADC DAT20-HERE H0303568 ADC CRT10-HERE H0303569 ADC TYPIN1-HERE H0303570 ADC TYPIN2-HERE H0303571 ADC B2D01-HERE H0303572 ADC HADO01-HERE H0303573 ADC TPHEX1+1-HERE H0303574 ADC TPHEX2+1-HERE H0303575 ADC HXBCD0+1-HERE H0303576 ADC HXBCD1+1-HERE H0303577 ADC YNAMFL-HERE H0303578 ADC YCMPKY-HERE H0303579ÐÐ ADC YRCADD-HERE H0303580 ADC YGETU-HERE H0303581 ADC YPUTU-HERE H0303582 ADC YCLSU-HERE H0303583 ADC YGTSEQ-HERE H0303584 ADC YBOS-HERE H0303585 ADC YEOS-HERE H0303586 ADC YOPEN-HERE H0303587 ADC YCLOSE-HERE H0303588 ADC YGTFCB-HERE H0303589 ADC YVOLSR-HERE H0303590 ADC YCLSEQ-HERE H0303591 ADC YMVCHR-HERE H0303592 ADC YSVAQI-HERE H0303593 ADC YREAQI-HERE H0303594 ADC YCRMSG-HERE H0303595 ADC YTYPIN-HERE H0303596 ADC YBOMB-HERE H0303597 ADC YWIERD-HERE H0303598 ADC YCMPLA-HERE H0303599 ADC YCMPLD-HERE H0303600 ADC YCMCLA-HERE H0303601 ADC YCMCLD-HERE H0303602 ADC YCMPWA-HERE H0303603 ADC YCMPWD-HERE H0303604ÐÐ ADC YCMCUA-HERE H0303605 ADC YCMCUD-HERE H0303606 ADC INIT06+1-HERE H0303607 ADC PGM10-HERE H0303608 ADC PGM20-HERE H0303609 ADC PGM30-HERE H0303610 ADC PGM40-HERE H0303611 ADC INIT05+1-HERE H0303612RELOC3 EQU RELOC3(*-RELOC4) H0303613 END SMCMON H0303614 NAM SMCEDT H04 A ITOS CCS 3.0 SL-149H0400001* PROCESSES INPUT DIRECTIVES H0400002* CREDIT COLLECTION SYSTEM VERSION 3.0 H0400003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA H0400004* COPYRIGHT CONTROL DATA CORPORATION 1979 H0400005**** H0400006*E H0400007* **************** H0400008* * INPUT EDITOR * H0400009* **************** H0400010* H0400011* H0400012* FUNCTION H0400013* -------- H0400014* H0400015ÐÐ* THE SMCEDT OVERLAY READS AND PROCESSES THE INPUT DIRECTIVES TO H0400016* DSORT. IT ALSO DETERMINES HOW TABLE SPACE IS TO BE ALLOCATED H0400017* FOR THE VARIOUS TABLES REQUIRED BY DSORT OVERLAYS. H0400018* H0400019* H0400020* GENERAL DESCRIPTION H0400021* ------------------- H0400022* H0400023* THE SMCEDT OVERLAY LOADS AT THE END OF DSORT. THE SMCMON ROUTINEH0400024* IS RESPONSIBLE FOR LOADING SMCEDT. THE CORE SPACE FROM THE FIXEDH0400025* TABLE IN SMCMON IS USED TO BUILD VARIABLE TABLES NEED BY THE H0400026* SMCMON, SMCSRT, SMCIMG, AND SMCFMG OVERLAYS. THESE VARIABLE H0400027* TABLES ARE BUILT BASED UPON INPUT DIRECTIVES VALUES READ BY H0400028* SMCEDT. THE VARIABLE TABLES INCLUDE: H0400029* 1. LIST OF ALL FILE AND OWNER NAMES FOR ALL INPUT FILES AND THE H0400030* OUTPUT FILE. H0400031* 2. A PARTIAL FILE TABLE DESCRIPTION FOR EACH INPUT FILE. THE H0400032* INFORMATION KEPT HERE INCLUDES (1) THE FILE MANAGER LOGICAL H0400033* UNIT FOR THE FILE, (2) A PSEUDO FILE NUMBER THAT ASSOCIATES A H0400034* NUMBER WITH A FILE NAME TABLE ENTRY (YNAMFL = FWA OF THIS TABLE),H0400035* (3) A TABLE THAT DEFINES KEY FIELDS TO BE SORTED (ADDROUT SORT) H0400036* OR A TABLE THAT DEFINES THE DATA FIELDS OF A RECORD (NONKEY H0400037* FIELDS OF RECORD FOR DATA ONLY SORTS),(4) A SPECIAL FORMATTED H0400038* KEY INFORMATION TABLE FOR PERFORMING THE SORT, (5) A RECORD AREA H0400039* USED TO FORMAT ADDROUT RECORDS FOR THE SORT, (6) A TABLE THAT H0400040ÐÐ* SPECIFIES INFORMATION FOR RECORD SELECTION (DECIDING WHICH H0400041* RECORDS TO KEEP FOR SORTING), (7) A KEY COMPARE TABLE THAT IS H0400042* FORMATTED THE SAME AS THE KEY INFORMATION TABLE AND IS USED TO H0400043* SELECT RECORDS FOR SORTING, AND (8) A SHIFT TABLE THAT OFFSETS H0400044* ONE KEY COMPARE FIELD FOR RECORD SELECTION. H0400045* H0400046* THE VARIABLE TABLES BUILD TOWARD THE SMCEDT OVERLAY. VARIABLE H0400047* TABLE SPACE MAY OVERLAP THE FIRST PART OF SMCEDT. THE INITIAL H0400048* LOGIC EXECUTED IN SMCEDT IS STRUCTURED SUCH THAT THESE ROUTINES H0400049* ARE EXECUTED ONCE AND THIS SPACE MAY BE USED FOR THE VARIABLE H0400050* TABLES. H0400051* H0400052**** H0400053 EJT 0 H0400054**** H0400055*E H0400056* INPUT REQUIREMENTS H0400057* ------------------ H0400058* H0400059* ALL INPUT DIRECTIVES START IN COLUMN 1. BLANKS ARE MEANINGFUL H0400060* AND SHOULD ONLY APPEAR IN THE FILE NAME, HOLLERITH CONSTANT H0400061* FIELD, OR AS A SEPARATOR FOR COMMENT INFORMATION. COMMENTS MAY H0400062* APPEAR ON ANY CARD AFTER THE REQUIRED DATA HAS BEEN PROVIDED. H0400063* H0400064* INPUT FILE NAMES: H0400065ÐÐ* H0400066* FN=FILE NAME, OWNER NAME H0400067* . H0400068* . H0400069* . H0400070* FN=FILE NAME, OWNER NAME H0400071* H0400072* EACH INPUT FILE AND OWNER NAME IS LISTED ON A SEPARATE CARD. H0400073* LEADING BLANK CHARACTERS OF FILE AND OWNER NAMES MUST BE H0400074* SPECIFIED. THE NAMES ARE 8 CHARACTERS IN LENGTH. SINCE THE H0400075* VOLUME NAME IS NOT SPECIFIED, IT IS ASSUMED THAT THE FILE NAME/ H0400076* OWNER NAME ARE UNIQUE FOR ALL VOLUMES MOUNTED ON THE SYSTEM. H0400077* THERE IS NO LIMIT TO THE NUMBER OF INPUT FILES FOR A TAG-ALONG H0400078* SORT. AN ADDROUT SORT WILL SORT ONE INPUT FILE. H0400079* H0400080* OUTPUT FILE NAME: H0400081* H0400082* F2=FILE NAME, OWNER NAME, VOLUME NAME H0400083* H0400084* THE OUTPUT FILE, OWNER, AND VOLUME NAMES ARE 8 CHARACTERS LONG. H0400085* THE OUTPUT FILE MAY ALREADY EXIST. IF IT DOES IT IS RELEASED H0400086* AND REDEFINED PRIOR TO STORING RECORDS IN THE FILE. THE OUTPUT H0400087* FILE NAME CAN BE THE SAME AS ONE OF THE INPUT FILE NAMES. H0400088* IF THE OUTPUT FILE IS PREDEFINED, AND IF THE TOTAL RECORD COUNT H0400089* IS GREATER THAN WHAT DSORT REQUIRES, THE TOTAL RECORD COUNT FOR H0400090ÐÐ* THE EXISTING FILE WILL BE USED. IF THE FILE HAS A TOTAL RECORD H0400091* COUNT LESS THAN WHAT DSORT NEEDS, DSORT WILL RECREATE THE FILE H0400092* WITH THE TOTAL RECORD COUNT THE SAME AS THE NUMBER OF RECORDS H0400093* SORTED. H0400094**** H0400095 EJT 0 H0400096**** H0400097*E H0400098* OPTION CARD: H0400099* H0400100* OP=ADDR/TAG, F/D, A/E H0400101* H0400102* ADDR/TAG MAY BE ABBREVIATED TO A/T. H0400103* H0400104* ADDR - SELECTS ADDROUT SORT. EACH OUTPUT RECORD IS 2 WORDS LON H0400105* AND CONTAINS A FILE MANAGER RELATIVE RECORD NUMBER. H0400106* TAG - SELECTS TAG-ALONG SORT. H0400107* H0400108* F - FULL RECORD OPTION. FOR TAG-ALONG SORTS BOTH THE CONTRO H0400109* AND DATA FIELDS ARE INCLUDED IN THE OUTPUT RECORDS. H0400110* D - DATA PORTION ONLY. ONLY THE DATA FIELDS ARE INCLUDED IN H0400111* THE FINAL OUTPUT RECORDS FOR A TAG-ALONG SORT. H0400112* H0400113* A - REQUEST STANDARD ASCII COLLATING SEQUENCE. H0400114* E - REQUEST ALTERNATE EBCDIC COLLATING SEQUENCE. H0400115ÐÐ* H0400116* SORT FIELD DESCRIPTION: H0400117* H0400118* KF=A/D,KEYCOL,KEYCOLS,...,A/D,KEYCOL,KEYCOLS,.... H0400119* H0400120* A - CONTROL FIELD TO BE SORTED IN ASCENDING ORDER H0400121* D - CONTROL FIELD TO BE SORTED IN DESCENDING ORDER H0400122* H0400123* KEYCOL = STARTING COLUMN OF CONTROL FIELD, THE FIRST COLUMN H0400124* POSITION OF A RECORD WOULD BE COLUMN 1. H0400125* KEYCOLS= NUMBER OF CHARACTERS IN CONTROL FIELD. H0400126* THE SORT FIELD DESCRIPTION CARD SHOULD NOT EXTEND BEYOND COLUMN H0400127* 72. IF MORE INFORMATION IS REQUIRED, ADDITIONAL CARDS MAY BE H0400128* USED. A BLANK CHARACTER IMMEDIATELY FOLLOWING THE LAST KEYCOLS H0400129* VALUE TERMINATES THE SORT FIELD DESCRIPTION. H0400130**** H0400131 EJT 0 H0400132**** H0400133*E H0400134* RECORD SELECTION DESCRIPTION: H0400135* H0400136* 'HOLLERITH CONSTANT' H0400137* SL=OMIT/INCLUDE,KEYCOL,KEYCOLS,OP, H0400138* KEYCOL H0400139* H0400140ÐÐ* OMIT/INCLUDE MAY BE ABBREVIATED TO O/I. H0400141* H0400142* OMIT - IF FIRST FIELD DESCRIPTOR SATISFIES CONDITION OF SECO DH0400143* DESCRIPTOR, THE RECORD WILL NOT BE INCLUDED IN SORT. H0400144* INCLUDE - IF FIRST FIELD DESCRIPTOR SATISFIES CONDITION OF SECO DH0400145* DESCRIPTOR, THE RECORD WILL BE INCLUDED IN SORT. IF H0400146* FIELD DESCRIPTORS ARE OMITTED, ALL RECORDS ARE TO BE H0400147* INCLUDED IN THE SORT. H0400148* H0400149* KEYCOL = STARTING COLUMN OF KEY FIELD H0400150* KEYCOLS= NUMBER OF CHARACTERS IN KEY FIELD H0400151* H0400152* OP - THE COMPARE FACTOR. FOR THE CONDITION TO BE TRUE, THE H0400153* FOLLOWING COMPARE FACTORS ARE DESCRIBED: H0400154* H0400155* EQ - FIRST FIELD DESCRIPTOR MUST EQUAL SECOND DESCRIPTOR H0400156* NE - FIRST FIELD DESCRIPTOR MUST NOT EQUAL SECOND DESCRIPT H0400157* OR H0400158* LT - FIRST FIELD DESCRIPTOR MUST BE LESS THAN SECOND H0400159* DESCRIPTOR H0400160* GT - FIRST FIELD DESCRIPTOR MUST BE GREATER THAN SECOND H0400161* DESCRIPTOR H0400162* LE - FIRST FIELD DESCRIPTION MUST BE LESS THAN OR EQUAL TO H0400163* SECOND DESCRIPTOR H0400164* GE - FIRST FIELD DESCRIPTOR MUST BE GREATER THAN OR EQUAL H0400165ÐÐ* TO SECOND DESCRIPTOR H0400166* H0400167* 'HOLLERITH CONSTANT' = 1-20 CHARACTERS ENCLOSED WITH ' ' H0400168* H0400169* THE SECOND DESCRIPTOR IS EITHER THE HOLLERITH CONSTANT OR THE H0400170* SECOND RECORD FIELD. H0400171* IF THE ALTERNATE EBCDIC COLLATING SEQUENCE IS SPECIFIED, THE H0400172* FIELD DESCRIPTOR COMPARISON IS DONE USING THE EBCDIC SEQUENCE. H0400173* H0400174* H0400175* IN ADDITION TO SPECIFYING THE INPUT DIRECTIVES TO SMCEDT, THE H0400176* I REGISTER MUST BE PRESET ON ENTRY TO SMCEDT. H0400177* THE I REGISTER (I) = FWA OF THE FIXED TABLE SPACE IN SMCMON. H0400178**** H0400179 EJT 0 H0400180**** H0400181*E H0400182* OUTPUT H0400183* ------ H0400184* H0400185* THE REGISTER VALUES ARE NOT REQUIRED WHEN RETURNING TO SMCMON. H0400186* H0400187* H0400188* ENTRY/EXIT H0400189* ---------- H0400190ÐÐ* H0400191* ENTRY - H0400192* THE LENGTH OF SMCEDT IS CALCULATED TO THE NEXT SECTOR. THIS H0400193* LENGTH IN WORDS IS SUBSTRACTED FROM THE LAST WORD ADDRESS OF H0400194* DSORT BY SMCMON IN ORDER TO ESTABLISH THE FIRST WORD ADDRESS THATH0400195* SMCEDT WILL BE LOADED. THE SMCEDT PROGRAM IS EXECUTED BY H0400196* PASSING THE FIRST WORD ADDRESS (FWA) AND THE SMCEDT LOAD INDEX H0400197* (1) TO THE LOAD SUBROUTINE IN DSORT. SMCMON MAKES THE CALL TO H0400198* THE LOAD SUBROUTINE. LOADS JUMPS TO THE FWA + 1 OF SMCEDT. H0400199* H0400200* EXIT - H0400201* THE RETURN ADDRESS TO SMCMON WAS PLACED INTO THE FIRST WORD OF H0400202* SMCEDT. SMCEDT SAVES THIS ADDRESS (EDTXIT+1) IN THE FAR END OF H0400203* SMCMON IN CASE THE FIRST PART OF SMCEDT IS DESTROYED BY THE H0400204* VARIABLE TABLES. IF AN ERROR IS FOUND SMCEDT TERMINATES THE RUN H0400205* BY JUMPING TO THE BOMB ROUTINE IN SMCMON. H0400206* H0400207* H0400208* FLOW H0400209* ---- H0400210* H0400211* SMCEDT DOES THE FOLLOWING: H0400212* H0400213* 1. ABSOLUTIZES ALL OF THE RELOCATABLE VALUES. H0400214* 2. LINKS SMCMON ADDRESSES REQUIRED BY SMCEDT. H0400215ÐÐ* 3. READS THE INPUT AND OUTPUT FILE NAME DESCRIPTION INTO THE H0400216* YNAMFL TABLE. (FIRST VARIABLE LENGTH TABLE). H0400217* 3. OPENS EACH INPUT FILE TO SHOW THAT FILE EXIST AND TO PROVIDE H0400218* INFORMATION TO BUILD THE PARTIAL FILE TABLE. H0400219* 4. SET FLAGS IN YFLAG WORD TO IDENTIFY OPTIONS FROM THE OP CARD. H0400220* 5. DEFINES ADDROUT RECORD BUFFER AND KEY OR DATA TABLE. H0400221* 6. BUILDS THE KEY INFORMATION TABLE USED TO SORT RECORDS. H0400222* 7. SETS UP THE COMPARE TABLES FOR RECORD SELECTION. H0400223* 8. ALLOCATES AVAILABLE SPACE FOR EACH OF THE REMAINING OVERLAYS H0400224* (SMCSRT), SMCIMG, SMCFMG). H0400225* 9. RETURNS TO SMCMON (OR EXITS AT ANY OF THE ABOVE POINTS TO THE H0400226* BOMB ROUTINE IF AN ERROR IS FOUND). H0400227**** H0400228 EJT 0 H0400229**** H0400230*E H0400231* SUBROUTINES H0400232* ----------- H0400233* H0400234* BOMB: TERMINATES THE RUN BECAUSE AN ERROR ENCOUNTERED H0400235* CLOSE: A FILE MANAGER FILE IS CLOSED H0400236* CLOSEQ: ASCII/ EBCDIC CONVERSION SUBROUTINE H0400237* CRTMSG: PRINTS A CRT MESSAGE H0400238* GETFCB: FETCHES EXTENDED FCB FOR ADDITIONAL F.M. INFORMATION H0400239* MVCHRS: SHIFTS CHARACTER STRING ONE POSITION TO LEFT DURING MOVEH0400240ÐÐ* OPEN: A FILE MANAGER FILE IS OPENED H0400241* RECADD: ACCUMULATES RECORD COUNT FOR INPUT FILES H0400242* RESAQI: RESET REGISTERS (A), (Q), AND (I) ON EXIT FROM ROUTINE H0400243* SAVAQI: SAVES REGISTERS (A), (Q), AND (I) ON ENTRY TO SUBROUTINEH0400244* TYPIN: PROVIDES INPUT DIRECTIVE INFORMATION H0400245* WIERD: REPORTS UNUSUAL ERROR CONDITIONS ENCOUNTERED H0400246* H0400247* H0400248* MESSAGES H0400249* -------- H0400250* H0400251* THE MESSAGES FOR ALL OVERLAYS IS LISTED IN THE EQUATES SECTION H0400252* UNDER 'MESSAGE PROCESSOR INDEX EQUATES'. IN ADDITION, SMCEDT H0400253* REPORTS FOR THE 'EXPECTED' PORTION OF THE 'EXPECTED/ FOUND' ERRORH0400254* MESSAGE THE FOLLOWING: H0400255* 1. EXPECTED , H0400256* 2. EXPECTED (VOLUME NAME) H0400257* 3. EXPECTED (ADDR/TAG) H0400258* 4. EXPECTED (F/D) H0400259* 5. EXPECTED (A/E) H0400260* 6. EXPECTED (A/D) H0400261* 7. EXPECTED (KEYCOL) H0400262* 8. EXPECTED (KEYCOLS) H0400263* 9. EXPECTED (OMIT/INCLUDE) H0400264* 10.EXPECTED (EQ/NE/LT/GT/LE/GE) H0400265ÐÐ* 11.EXPECTED ('HOLLERITH DATA') H0400266* 12.EXPECTED FN H0400267* 13.EXPECTED F2 H0400268* 14.EXPECTED 0P H0400269* 15.EXPECTED KF H0400270* 16.EXPECTED SL H0400271**** H0400272 EJT H0400273**** H0400274*E H0400275* PARAMETERS H0400276* ---------- H0400277* H0400278*OFTEN NEEDED CONSTANTS. H0400279ZERO EQU ZERO(2) (2)=0. H0400280HX0001 EQU HX0001($3) ($3)=$00001. H0400281HX00FF EQU HX00FF($A) ($A) = $00FF. H0400282HX03FF EQU HX03FF($C) ($C)=$03FF. H0400283HX0400 EQU HX0400($2D) ($2D)=$0400. H0400284HX0800 EQU HX0800($2E) ($2E)=$0800. H0400285HX1000 EQU HX1000($2F) ($2F)=$1000. H0400286HX2000 EQU HX2000($30) ($30)=$2000. H0400287HX4000 EQU HX4000($31) ($31)=$4000. H0400288HX7FFF EQU HX7FFF($42) ($42)=$7FFF. H0400289HX8000 EQU HX8000($32) ($32)=$8000. H0400290ÐÐHXFFFF EQU HXFFFF($12) ($12)=$FFFF. H0400291**** H0400292 EJT H0400293**** H0400294*E H0400295* FILE CONTROL BLOCK EQUIVALENCES H0400296 EQU FH(4) LENGTH -1 OF FCB HEADER H0400297 EQU FILEID(ZERO) FILE IDENTIFIER H0400298* ACCESS FILEID INDIRECTLY H0400299* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBERH0400300* BITS 10-00 INDEX OF FCB IN FCB TABLE H0400301 EQU FCBFLG(1) FCB FLAGS H0400302* BITS 15-8, SPARE H0400303* BITS 7-00, NUMBER OF USERS USING FILE H0400304 EQU FILOCK(2) FILE LOCK FLAG (IF NON-0, CONTAINS USER ID) H0400305 EQU NUMSET(3) NUMBER OF SETS OF LOCKED RECORDS IN FILE H0400306 EQU NUMNEW(4) NUMBER OF NEW RECORDS SINCE FCB UPDATED ON MM H0400307 SPC 1 H0400308 EQU RECLEN(FH+1) RECORD LENGTH IN WORDS H0400309 EQU TDATRM(FH+2) TOTAL NUMBER OF DATA RECORDS, MSB H0400310 EQU TDATRL(FH+3) TOTAL NUMBER OF DATA RECORDS, LSB H0400311 EQU DATBAM(FH+4) DATA RECORDS BEGINNING SECTOR ADDRESS, MSB H0400312 EQU DATBAL(FH+5) DATA RECORDS BEGINNING SECTOR ADDRESS,LMSB H0400313 EQU FCBIND(FH+6) FCB INDICATORS H0400314* BIT 15 , SECTOR ALLIGNED RECORDS IF =1 H0400315ÐÐ* BIT 14 , STORAGE MODE FOR INDEXED FILE H0400316* =0, RECORDS STORED RANDOMLY WITHH0400317* RESPECT TO PRIMARY KEY H0400318* =1, RECORDS STORED IN ORDER WIT H0400319* RESPECT TO PRIMARY KEY H0400320* BIT 13 , =1, FILE IS CURRENTLY OPEN H0400321* =0, FILE IS CURRENTLY CLOSED H0400322* BIT 12 , =1, FILE IS BEING COMPRESSED H0400323* =0, FILE IS NOT BEING COMPRESSEDH0400324* BIT 0 , FILE TYPE H0400325* =0, SEQUENTIAL FILE H0400326* =1, INDEXED FILE H0400327 EQU NEDATM(FH+7) NUMBER OF EXISTING DATA RECORDS, MSB H0400328 EQU NEDATL(FH+8) NUMBER OF EXISTING DATA RECORDS, LSB H0400329 EQU SEQLTH(NEDATL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION H0400330* OF FCB FOR A SEQUENTIAL FILE H0400331 SPC 1 H0400332 EQU NEXTBM(FH+9) NEXT FREE KEY INDEX BLOCK, MSB H0400333 EQU NEXTBL(FH+10) NEXT FREE KEY INDEX BLOCK, LSB H0400334 EQU TNKEYM(FH+11) TOTAL NUMBER OF KEY INDEX BLOCKS, MSB H0400335 EQU TNKEYL(FH+12) TOTAL NUMBER OF KEY INDEX BLOCKS, LSB H0400336 EQU KEYBAM(FH+13) KEY INDEX BEGINNING SECTOR ADDRESS, MSB H0400337 EQU KEYBAL(FH+14) KEY INDEX BEGINNING SECTOR ADDRESS, LSB H0400338 EQU LENKY1(FH+15) LENGTH OF KEY NO. 1 H0400339 EQU POSKY1(FH+16) BYTE POSITION OF KEY NO. 1 H0400340ÐÐ EQU LENKY2(FH+17) LENGTH OF KEY NO. 2 H0400341 EQU POSKY2(FH+18) BYTE POSITION OF KEY NO. 2 H0400342 EQU LENKY3(FH+19) LENGTH OF KEY NO. 3 H0400343 EQU POSKY3(FH+20) BYTE POSITION OF KEY NO. 3 H0400344 EQU LENKY4(FH+21) LENGTH OF KEY NO. 4 H0400345**** H0400346 EJT H0400347**** H0400348*E H0400349 EQU POSKY4(FH+22) BYTE POSITION OF KEY NO. 4 H0400350 EQU INDLEN(POSKY4-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION H0400351* OF FCB FOR AN INDEXED FILE H0400352* THE FOLLOWING PORTION OF THE FCB EXISTS ONLY H0400353* ON MASS MEMORY. THESE 10 WORDS ARE NOT LOADEDH0400354* INTO EITHER OF THE FILE MANAGER CONTROLLED FCBH0400355* TABLES. H0400356 EQU TSFILM(FH+23) TOTAL NUMBER OF SECTORS IN FILE, MSB H0400357 EQU TSFILL(FH+24) TOTAL NUMBER OF SECTORS IN FILE, LSB H0400358 EQU NAME12(FH+25) FILE NAME, CHARACTERS 1 AND 2 H0400359 EQU NAME34(FH+26) FILE NAME, CHARACTERS 3 AND 4 H0400360 EQU NAME56(FH+27) FILE NAME, CHARACTERS 5 AND 6 H0400361 EQU NAME78(FH+28) FILE NAME, CHARACTERS 7 AND 8 H0400362 EQU OWNR12(FH+29) OWNER NAME, CHARACTERS 1 AND 2 H0400363 EQU OWNR34(FH+30) OWNER NAME, CHARACTERS 3 AND 4 H0400364 EQU OWNR56(FH+31) OWNER NAME, CHARACTERS 5 AND 6 H0400365ÐÐ EQU OWNR78(FH+32) OWNER NAME, CHARACTERS 7 AND 8 H0400366 EQU BYTLEN(FH+33) BYTE LENGTH OF RECORD H0400367* H0400368* FOR COMPRESS ONLY H0400369* H0400370 EQU PRSRNM(FH+34) RRN OF LAST PROCESSED RECORD - MSB H0400371 EQU PRSRNL(FH+35) RRN OF LAST PROCESSED RECORD - LSB H0400372 EQU NEWRNM(FH+36) RRN OF THE LATEST 'NEW' RECORD - MSB H0400373 EQU NEWRNL(FH+37) RRN OF THE LATEST 'NEW' RECORD - LSB H0400374 SPC 4 H0400375* WORDS 0 THRU 4 OF THE FCB HEADER AND WORDS H0400376* 6 THRU 10 OF THE FCB ARE REFERRED TO AS THE H0400377* SHARED SUBSET OF THE FCB. THEY INCLUDE THE H0400378* ONLY FCB WORDS THAT CAN BE MODIFIED AFTER FILEH0400379* CREATION. IF TWO OR MORE USERS HAVE THE SAME H0400380* FILE OPEN, THERE HAS TO BE A SINGLE MASTER H0400381* COPY OF THE SUBSET THAT RECEIVES (AND RECORDS)H0400382* ALL OF THE UPDATES. THE CONTROLLED SUBSET H0400383* WILL ALWAYS BE PART OF A MAIN MEMORY RESIDENT H0400384* FCB IF THE FCB IS IN A FM CONTROLLED TABLE. H0400385* IF THE FCB IS IN USER SPACE, THE SUBSET MAY ATH0400386* TIMES RESIDE IN THE SUBSET CONTROL TABLE. H0400387 SPC 2 H0400388* ALTERNATE NAMES FOR SUBSET WORDS H0400389 EQU SAFCBI(FH+1) SUBSET ALTERNATE NAME FOR FCBIND H0400390ÐÐ EQU SADATM(FH+2) SUBSET ALTERNATE NAME FOR NEDATM H0400391 EQU SADATL(FH+3) SUBSET ALTERNATE NAME FOR NEDATL H0400392 EQU SANXTM(FH+4) SUBSET ALTERNATE NAME FOR NEXTBM H0400393 EQU SANXTL(FH+5) SUBSET ALTERNATE NAME FOR NEXTBL H0400394**** H0400395 EJT 0 H0400396**** H0400397*E H0400398* FILE TABLE STRUCTURE. H0400399LUN EQU LUN(ZERO) F.M. LOGICAL UNIT NUMBER H0400400FILNUM EQU FILNUM(1) F.M. FILE NUMBER H0400401RECLTH EQU RECLTH(FILNUM+1) RECORD LENGTH H0400402BUFLTH EQU BUFLTH(RECLTH+1) RECORD BLOCK LENGTH H0400403BUFWA EQU BUFWA(BUFLTH+1) FWA OF RECORD BLOCKED BUFFER H0400404RECNT EQU RECNT(BUFWA+1) NUMBER OF RECORDS ENCOUNTERED H0400405DOCNT EQU DOCNT(RECNT+2) NUMBER OF RECORDS PROCESSED H0400406ERRCNT EQU ERRCNT(DOCNT+2) NUMBER OF ERRORS FOUND FOR FILE H0400407RECFWA EQU RECFWA(ERRCNT+1) FWA OF NEXT RECORD IN BLOCK H0400408XFRLTH EQU XFRLTH(RECFWA+1) RECORD BLOCK LENGTH FOR I/O H0400409REQBUF EQU REQBUF(XFRLTH+1) REQUEST BUFFER H0400410REQIND EQU REQIND(REQBUF+24) REQUEST INDICATOR H0400411FCB EQU FCB(REQIND+1) FILE CONTROL BLOCK H0400412 EQU FMSLOP(2) FCB OVERFLOW CORE SPACE INTO FCB INDEX SECT. H0400413FTSIZE EQU FTSIZE(FCB+SEQLTH+FH+1+FMSLOP) SIZE OF FILE TABLE H0400414**** H0400415ÐÐ EJT H0400416**** H0400417*E H0400418*SMC FIXED-TABLE STRUCTURE. H0400419 SPC 2 H0400420YNAMFL EQU YNAMFL(ZERO) () = FWA ASCII FILE, OWNER, VOLUME TABLE H0400421YIFTAD EQU YIFTAD(1) () = FWA OF INPUT FILE TABLE (FT) H0400422YADOUT EQU YADOUT(YIFTAD+1) () = KEY OR DATA DESCRIPTION TABLE FOR REC.H0400423YKEY EQU YKEY(YADOUT+1) () = KEY TABLE FOR SORT FIELDS H0400424YADRBF EQU YADRBF(YKEY+1) () = ADDROUT CONVERSION SPACE FOR RECORD H0400425YFIELD EQU YFIELD(YADRBF+1) () = RECORD SELECTION TABLE H0400426YCOMPR EQU YCOMPR(YFIELD+1) () = KEY FIELD FOR RECORD SELECTION H0400427YSHIFT EQU YSHIFT(YCOMPR+1) () = KEY OFFSET SPACE FOR RECORD SELECTION H0400428YEND EQU YEND(YSHIFT+1) () = END OF VARIABLE TABLES H0400429YHICOR EQU YHICOR(YEND+1) () = TOTAL AVAILABLE SORT CORE MEMORY SPACEH0400430YEDTSZ EQU YEDTSZ(YHICOR+1) () = SIZE OF INPUT EDITOR OVERLAY H0400431YSRTSZ EQU YSRTSZ(YEDTSZ+1) () = SIZE OF SORT OVERLAY H0400432YIMGSZ EQU YIMGSZ(YSRTSZ+1) () = SIZE OF INTERMEDIATE MERGE OVERLAY H0400433YFMGSZ EQU YFMGSZ(YIMGSZ+1) () = SIZE OF FINAL MERGE OVERLAY H0400434YPHASE EQU YPHASE(YFMGSZ+1) () = OVERLAY NUMBER CURRENTLY EXECUTING H0400435YDM EQU YDM(YPHASE+1) () = NUMBER OF INPUT FILES H0400436YFLAG EQU YFLAG(YDM+1) () = BIT 15 - (0/1) = (TAG/ADDR) H0400437* 14 - (0/1) = (DATA/FULL RECORD) H0400438* 13 - (0/1) = (ASCII/EBCDIC) H0400439* 12 - (0/1) = (OMIT/INCLUDE) H0400440ÐÐYG EQU YG(YFLAG+1) () = NUMBER OF SORT BINS (RECORDS) H0400441YIWAY EQU YIWAY(YG+1) () = MAX NUMBER OF INTERMEDIATE MERGE FILESH0400442YFWAY EQU YFWAY(YIWAY+1) () = MAX NUMBER OF FINAL MERGE FILES H0400443YMAXIB EQU YMAXIB(YFWAY+1) () = INPUT BLOCK FACTOR (IN WORDS) H0400444YWKBSZ EQU YWKBSZ(YMAXIB+1) () = WORK SPACE AVAILABLE (IN WORDS) H0400445YIRCNT EQU YIRCNT(YWKBSZ+1) () = INPUT RECORD COUNT TO SORT H0400446YORCNT EQU YORCNT(YIRCNT+2) () = OUTPUT RECORD COUNT FROM SORT H0400447YSQ2MG EQU YSQ2MG(YORCNT+2) () = NUMBER OF MERGE FILES TO BE PROCESSED H0400448YSEQCT EQU YSEQCT(YSQ2MG+1) () = TOTAL NUMBER OF MERGE FILES H0400449YCMPKY EQU YCMPKY(YSEQCT+1) () = PROCESSOR - COMPARES KEYS H0400450YRCADD EQU YRCADD(YCMPKY+1) () = PROCESSOR - ACCUMULATES EXIST. REC CNTH0400451YGETU EQU YGETU(YRCADD+1) () = PROCESSOR - DEBLOCKS F.M. RECORDS H0400452YPUTU EQU YPUTU(YGETU+1) () = PROCESSOR - BLOCKS F.M. RECORDS H0400453YCLSU EQU YCLSU(YPUTU+1) () = PROCESSOR - FLUSHES OUTPUT BUFFER H0400454YGTSEQ EQU YGTSEQ(YCLSU+1) () = PROCESSOR - FINDS MERGE STRING TO USE H0400455YBOS EQU YBOS(YGTSEQ+1) () = PROCESSOR - DEFINES MERGE WORK FILE H0400456YEOS EQU YEOS(YBOS+1) () = PROCESSOR - CLOSES MERGE WORK FILE H0400457YOFRL EQU YOFRL(YEOS+1) () = OUTPUT FILE RECORD SIZE (CHARS) H0400458YRECNT EQU YRECNT(YOFRL+1) () = RECORT COUNT FOR EACH FILE H0400459YOPEN EQU YOPEN(YRECNT+2) () = PROCESSOR - OPENS F.M. FILES H0400460YCLOSE EQU YCLOSE(YOPEN+1) () = PROCESSOR - CLOSES F.M. FILES H0400461YGTFCB EQU YGTFCB(YCLOSE+1) () = PROCESSOR - READS EXTENDED FCB H0400462YVOLSR EQU YVOLSR(YGTFCB+1) () = PROCESSOR - FIND F.M. LU FROM VOLUME H0400463YCLSEQ EQU YCLSEQ(YVOLSR+1) () = PROCESSOR - COLLATING SEQUENCE ROUTINEH0400464YMVCHR EQU YMVCHR(YCLSEQ+1) () = PROCESSOR - OFFSETS CHARACTER STRING H0400465ÐÐYSVAQI EQU YSVAQI(YMVCHR+1) () = PROCESSOR - SAVES REGISTERS A,Q,I H0400466YREAQI EQU YREAQI(YSVAQI+1) () = PROCESSOR - RESTORES REGISTERS A,Q,I H0400467**** H0400468 EJT 0 H0400469**** H0400470*E H0400471YCRMSG EQU YCRMSG(YREAQI+1) () = PROCESSOR - PRINTS MESSAGES TO CRT H0400472YTYPIN EQU YTYPIN(YCRMSG+1) () = PROCESSOR - INPUTS INPUT DIRECTIVES H0400473YBOMB EQU YBOMB(YTYPIN+1) () = PROCESSOR - TERMINATES RUN WITH ERROR H0400474YWIERD EQU YWIERD(YBOMB+1) () = PROCESSOR - REPORTS UNUSUAL ERROR H0400475YOFT EQU YOFT(YWIERD+1) () = FWA OF OUTPUT FILE TABLE H0400476YCMPLA EQU YCMPLA(YOFT+REQBUF) = PROCESSOR - ASCENDING LOGICAL BINARY H0400477YCMPLD EQU YCMPLD(YCMPLA+1) () = PROCESSOR - DESCENDING LOGICAL BINARY H0400478YCMCLA EQU YCMCLA(YCMPLD+1) () = PROCESSOR - ASCENDING EVEN COLUMN CHARH0400479YCMCLD EQU YCMCLD(YCMCLA+1) () = PROCESSOR DESCEND EVEN COLUMN CHAR H0400480YCMPWA EQU YCMPWA(YCMCLD+1) () = PROCESSOR - ASCENDING WORDS BINARY KEYH0400481YCMPWD EQU YCMPWD(YCMPWA+1) () = PROCESSOR - DESCENDING WRDS BINARY KEYH0400482YCMCUA EQU YCMCUA(YCMPWD+1) () = PROCESSOR - ASCENDING ODD COLUMN CHAR H0400483YCMCUD EQU YCMCUD(YCMCUA+1) () = PROCESSOR - DESCENDING ODD COLUMN CHARH0400484YOUTFT EQU YOUTFT(YOFT+FTSIZE) = LWA OF FIXED TABLES H0400485**** H0400486 EJT H0400487**** H0400488*E H0400489* MISC H0400490ÐÐ* ---- H0400491* H0400492* ** ENTRY POINTS ** H0400493* H0400494 ENT SMCEDT H0400495* H0400496* ** EXTERNALS ** H0400497* H0400498 EXT FMMOSU MAX NO. OF OPEN SEQ. FILES/ USER H0400499 EXT WKSPLU WORK SPACE FILE LU H0400500* H0400501* ** EQUATES ** H0400502* H0400503ENDWRD EQU ENDWRD(36) H0400504ENDCOL EQU ENDCOL(2*ENDWRD) H0400505PLUG EQU PLUG($7FFF) H0400506**** H0400507 EJT 0 H0400508**** H0400509*E H0400510* ******************************** H0400511* * SMCMON VARIABLE TABLE LAYOUT * H0400512* ******************************** H0400513* H0400514* H0400515ÐÐ* YNAMFL ************************* H0400516* * INPUT FILE NAME(1) * 8 CHARACTERS H0400517* * OWNER NAME(1) * 8 CHARACTERS H0400518* * . * H0400519* * . * H0400520* * . * H0400521* * INPUT FILE NAME(N) * H0400522* * OWNER NAME(N) * H0400523* * OUTPUT FILE NAME * 8 CHARACTERS H0400524* * OWNER NAME * 8 CHARACTERS H0400525* YIFTAD ************************* H0400526* * INPUT FILE(1) TABLE * 4 WORD ENTRIES/TABLE H0400527* * . * H0400528* * . * H0400529* * INPUT FILE(N) TABLE * H0400530* * . * H0400531* YADOUT ************************* H0400532* * START COLUMN * SPECIFIES EITHER KEY FIELDS H0400533* * NUMBER OF COLUMNS * OF RECORD OR DATA FIELDS OF H0400534* * . * RECORD. H0400535* * . * H0400536* * . * THIS TABLE WILL NOT EXIST FOR H0400537* * START COLUMN * FULL RECORD TAG-ALONG SORTS H0400538* * NUMBER OF COLUMNS * H0400539* * - 0 * END OF TABLE INDICATOR H0400540ÐÐ* YKEY ************************* H0400541* * REL WORD OFFSET * STARTS WITH 0 H0400542* * KEY COMPARE PROCESSOR * ADDRESS IS IN SMCMON H0400543* * LCA+1 OF WORD BLOCK * X THIS WORD OF ENTRY APPEARS H0400544* * . * ONLY FOR MULTIPLE FULL WORDS H0400545* * . * OF KEY FIELD H0400546* * . * H0400547* * REL WORD OFFSET * H0400548* * KEY COMPARE PROCESSOR * H0400549* * LCA+1 OF WORD BLOCK * H0400550* * - 0 * END OF TABLE INDICATOR H0400551* YADRBF ************************* H0400552* * REL RECORD NUMBER MSB * FILE MANAGER RELATIVE RECORD H0400553* * REL RECORD NUMBER LSB * NUMBERS H0400554* * FIRST KEY FIELD * X H0400555* * . * X THESE ENTRIES OCCUR ONLY FOR H0400556* * . * X ADDROUT SORTS H0400557* * . * X H0400558* * LAST KEY FIELD * X H0400559* ************************* H0400560**** H0400561 EJT 0 H0400562**** H0400563*E H0400564* ******************************** H0400565ÐÐ* * SMCMON VARIABLE TABLE LAYOUT * H0400566* ******************************** H0400567* H0400568* H0400569* YFIELD ************************* H0400570* * CODE WORD * ONLY CODE WORD WILL EXIST H0400571* * FACTOR(1) ADDRESS * IF SL=INCLUDE H0400572* * FACTOR(2) ADDRESS * H0400573* * RECORD REL. ADDRESS * X THESE 2 WORDS ARE USED ONLY H0400574* * KEYCOLS * X IF BOTH KEYS IN RECORD AND H0400575* * HOLLERITH CONSTANT * KEYS ARE NOT WORD ALIGNED H0400576* * . * H0400577* * . * HOLLERITH CONSTANT FIELD WILL H0400578* * . * NOT OCCUR IF NOT SPECIFIED H0400579* * END OF CONSTANT * H0400580* YCOMPR ************************* H0400581* * REL WORD OFFSET * SAME AS YKEY ENTRIES, EXCEPT H0400582* * KEY COMPARE PROCESSOR * THIS TABLE DESCRIBES ONLY H0400583* * LCA+1 OF WORD BLOCK * ONE KEY FIELD H0400584* * . * H0400585* * . * THIS TABLE WILL NOT EXIST H0400586* * . * IF SL=INCLUDE H0400587* * REL WORD OFFSET * H0400588* * KEY COMPARE PROCESSOR * H0400589* * - 0 * END OF TABLE INDICATOR H0400590ÐÐ* YSHIFT ************************* H0400591* * SHIFT BUFFER FOR * SIZE DEPENDS ON SIZE OF H0400592* * THE KEY FIELD * COMPARE FIELD H0400593* * * THIS TABLE WILL NOT EXIST H0400594* * * IF SHIFT BUFFER IS NOT NEEDED H0400595* YEND ************************* H0400596**** H0400597 EJT 0 H0400598**** H0400599*E H0400600* MESSAGE PROCESSOR INDEX EQUATES H0400601 SPC 3 H0400602MSGCLS EQU MSGCLS(1) 'CLOSFL REQIND = $ ' H0400603MSGOPN EQU MSGOPN(2) 'OPENFL REQIND = $ ' H0400604MSGDEL EQU MSGDEL(3) 'DELETE REQIND = $ ' H0400605MSGCRT EQU MSGCRT(4) 'CREATE REQIND = $ ' H0400606MSGRDD EQU MSGRDD(5) 'GETS REQIND = $ ' H0400607MSGWTD EQU MSGWTD(6) 'PUTS REQIND = $ ' H0400608MSGTFB EQU MSGTFB(7) 'GETFCB REQIND = $ ' H0400609MSGFCB EQU MSGFCB(8) 'UPDFCB REQIND = $ ' H0400610MSGVOL EQU MSGVOL(9) 'VOLUME= ' H0400611MSFFNO EQU MSGFNO(10) 'FILNAM= ' H0400612* H0400613FM EQU FM(10) SIZE OF F.M. MESSAGE INDEX BLOCK H0400614* H0400615ÐÐMSGABE EQU MSGABE(FM+1) 'ABNORMAL ERROR = ' H0400616MSGBDR EQU MSGBDR(FM+2) 'BLKSIZ/RECLTH .NE. 1,2,3...' H0400617MSGBLK EQU MSGBLK(FM+3) ' ' H0400618MSGBOM EQU MSGBOM(FM+4) 'FATAL ERROR' H0400619MSGDUN EQU MSGDUN(FM+5) 'DONE = ' H0400620MSGESC EQU MSGESC(FM+6) 'TYPE-IN ERROR' H0400621MSGEXP EQU MSGEXP(FM+7) 'EXPECTED /FOUND ' H0400622MSGIFL EQU MSGIFL(FM+8) 'CANNOT OPEN INPUT FILE' H0400623MSGTLC EQU MSGTLC(FM+9) 'TOO LITTLE CORE' H0400624MSGINE EQU MSGINE(FM+10) 'INTERPHASE RECORD COUNTS DISAGREE' H0400625MSGINP EQU MSGINP(FM+11) PRINTS INPUT DIRECTIVE CARD H0400626MSGPAS EQU MSGPAS(FM+12) 'PASSED = ' H0400627MSGSDE EQU MSGSDE(FM+13) 'SEQ. DIR. ERROR' H0400628MSGTLD EQU MSGTLD(FM+14) 'TOO LITTLE DISK' H0400629MSGTRC EQU MSGTRC(FM+15) 'OUTPUT RECORD COUNT BAD' H0400630MSGIFR EQU MSGIFR(FM+16) 'INPUT FILE LENGTHS ARE NOT EQUAL' H0400631MSGFLN EQU MSGFLN(FM+17) 'FN= , ' H0400632MSGOFR EQU MSGOFR(FM+18) 'OUTPUT FILE RECORD LENGTH IS ZERO' H0400633MSGASO EQU MSGASO(FM+19) 'ADDROUT SORTS ONLY 1 FILE' H0400634MSGVNM EQU MSGVNM(FM+20) 'VOLUME NOT MOUNTED' H0400635MSGSOK EQU MSGSOK(FM+21) 'START OF KEY FIELD OUTSIDE OF RECORD' H0400636MSGKEB EQU MSGKEB(FM+22) 'KEY FIELD EXTENDS BEYOND END OF RECORD' H0400637**** H0400638 EJT H0400639* ****************************************************************** H0400640ÐÐ* * THIS SECTION OF SMCEDT MAY BE WIPED OUT BY THE VARIABLE TABLES * H0400641* ****************************************************************** H0400642* H0400643* H0400644SMCEDT NUM 0 H0400645 CLR A (A) = PHASE NO. OF SMCEDT. H0400646 STA- YPHASE,I TELL FIXED TABLES THAT SMCEDT IS RUNNING. H0400647 LDA* SMCEDT (A) = FWA OF NSI OF SMCMON. H0400648 STA EDTXIT+1 SAFEGUARD RETURN FROM OVERLAY BY TABLES. H0400649 RTJ RELOC RELOCATE ALL RELOCATABLES. H0400650 RTJ LINK RESOLVE ALL SMCEDT REFERENCES TO SMCMON. H0400651 JMP EDITRX H0400652 EJT H0400653**** H0400654*E H0400655* ******************** H0400656* * SUBROUTINE USAGE * H0400657* ******************** H0400658* H0400659* H0400660* THE FOLLOWING LIST OF SUBROUTINES APPEAR IN THE ORDER THAT THEY OCCUR H0400661* IN OVERLAY SMCEDT. H0400662* 1. RELOC 12. MEM 23. PRENAM H0400663* 2. LINK 13. DETG 24. PREFIX H0400664* 3. IOFIL 14. MOVE 25. BIGNAM H0400665ÐÐ* 4. FTDEF 15. BLANK 26. POSNUM H0400666* 5. OPTION 16. NEWSCL 27. OVRFLW H0400667* 6. KEYS 17. SCLBYT 28. COMPOS H0400668* 7. KEYSET 18. ALFNUM 29. COMMA H0400669* 8. KEYTBL 19. FILCHR 30. COMALF H0400670* 9. KEYFWA 20. NXTCHR 31. ALPHA H0400671* 10. KRANGE 21. TOKEN 32. EDITRX H0400672* 11. SELECT 22. DIGTST 33. SCDIAG H0400673**** H0400674 EJT 0 H0400675**** H0400676*E H0400677* ********* H0400678* * RELOC * H0400679* ********* H0400680* H0400681* H0400682*RELOC DISABLES ITSELF AFTER THE 1ST CALL. H0400683*ON THE 1ST CALL, RELOC RELOCATES THE WORDS MENTIONED IN THE LIST, H0400684* RELOC4. RELOC4 CONTAINS ALL OF THE RELOCATABLE SYMBOLS IN SMCEDT. H0400685* THE CALLING SEQUENCE IS RTJ RELOC H0400686* (I)EXIT = (I)ENTRY H0400687* H0400688**** H0400689RELOC NUM 0 H0400690ÐÐ* 3 CARDS DELETED. H0400691 RTJ* HERE SET RELOCATION FACTOR. H0400692HERE NUM 0 () = 0 OR FWA OF HERE. H0400693 ENQ RELOC3 (Q) = NO. OF ENTRIES IN RELOC4. H0400694RELOC7 INQ -1 (Q) = INDEX TO NEXT RELOCATEE. H0400695 SQP RELOC6 SKIP IF NOT DONE. H0400696 JMP* (RELOC) EXIT IF DONE. H0400697RELOC6 LDA* RELOC4,Q (A) = FWA OF RELOCATEE - (HERE). H0400698 ADD* HERE (A) = FWA OF RELOCATEE. H0400699 STA* RELOC5 SAVE FWA OF RELOCATEE. H0400700 LDA* (RELOC5) (A) = RELOCATEE. H0400701 ADD* HERE (A) = RELOCATED (RELOCATEE). H0400702 STA* (RELOC5) SET RELOCATEE. H0400703 JMP* RELOC7 JMP TO SEE IF DONE. H0400704RELOC5 NUM 0 () = FWA OF RELOCATEE. H0400705RELOC4 EQU RELOC4(*) H0400706 ADC IOF10+1-HERE H0400707 ADC IOF20+1-HERE H0400708 ADC OPT00+1-HERE H0400709 ADC OPT10+1-HERE H0400710 ADC OPT30+1-HERE H0400711 ADC OPT50+1-HERE H0400712 ADC KEY00+1-HERE H0400713 ADC KEY10+1-HERE H0400714 ADC KEY40+1-HERE H0400715ÐÐ ADC KEY50+1-HERE H0400716 ADC SEL00+1-HERE H0400717 ADC SEL10+1-HERE H0400718 ADC SEL40+1-HERE H0400719 ADC SEL50+1-HERE H0400720 ADC SEL60+1-HERE H0400721 ADC SEL210+1-HERE H0400722 ADC SCL60-HERE H0400723 ADC SCL90-HERE H0400724 ADC TOK75+1-HERE H0400725 ADC PR30+1-HERE H0400726 ADC COMMAE+1-HERE H0400727 ADC SCDIA2+1-HERE H0400728RELOC3 EQU RELOC3(*-RELOC4) H0400729 EJT H0400730**** H0400731*E H0400732* ******** H0400733* * LINK * H0400734* ******** H0400735* H0400736* H0400737* THE LINK SUBROUTINE PLUGS ADDRESSES OF SUBROUTINES LOCATED IN SMCMON H0400738* INTO LOCATIONS NEEDING THEN IN SMCEDT. THIS ROUTINE ESTABLISHES THE H0400739* OVERLAY COMMUNICATION BETWEEN SMCEDT AND SMCMON. H0400740ÐÐ* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF SMCMON FIXED TABLE H0400741* RTJ LINK H0400742* (Q),(I)EXIT = (Q),(I)ENTRY H0400743* H0400744**** H0400745LINK NUM 0 H0400746 LDA- YVOLSR,I (A)=FWA OF VOLSRH H0400747 STA IOF40+1 H0400748 STA FTD60+1 H0400749 LDA- YOPEN,I (A) = FWA OF OPEN H0400750 STA FTD20+1 H0400751 LDA- YGTFCB,I (A) = FWA OF GETFCB H0400752 STA FTD25+1 H0400753 LDA- YRCADD,I (A) = FWA OF RECADD H0400754 STA FTD30+1 H0400755 LDA- YCLOSE,I (A) = FWA OF CLOSE H0400756 STA FTD40+1 H0400757 LDA- YCRMSG,I (A) = FWA OF CRTMSG. H0400758 STA FTD85+1 H0400759 STA SCDIA3+1 H0400760 STA SCDIA5+1 H0400761 LDA- YCLSEQ,I (A) = FWA OF COLSEQ H0400762 STA SEL230+1 H0400763 LDA- YMVCHR,I (A) = FWA OF MVCHRS H0400764 STA SEL234+1 H0400765ÐÐ LDA- YSVAQI,I (A) = FWA OF SAVAQI. H0400766 STA SCL10-1 H0400767 LDA- YREAQI,I H0400768 STA SCL50+1 H0400769 LDA- YTYPIN,I (A) = FWA OF TYPIN. H0400770 STA SCL80+1 H0400771 LDA- YBOMB,I (A) = FWA OF BOMB. H0400772 STA EDTBMB+1 H0400773 LDA- YWIERD,I (A) = FWA OF WIERD IN SMCMON. H0400774 STA* WIERD SAVE FWA OF WIERD. H0400775 LDA- YEDTSZ,I (A) = TABULATED SIZE OF SMCEDT. H0400776 EOR =XEDTSIZ COMPARE TABULATED TO ACTUAL. H0400777 SAZ LINK01 SKIP IF TABULATED = ACTUAL. H0400778 RTJ* (WIERD) ANNOUNCE AND HANDLE WIERD CONDITION. H0400779 NUM -7 ANNOUNCE ERROR NO.7 AND STOP THE RUN. H0400780LINK01 EQU LINK01(*) H0400781 JMP* (LINK) EXIT. H0400782WIERD NUM 0 () = FWA OF WIERD IN SMCMON. H0400783 EJT 0 H0400784**** H0400785*E H0400786* ********* H0400787* * IOFIL * H0400788* ********* H0400789* H0400790ÐÐ* H0400791* THE INPUT AND OUTPUT FILES AND THEIR ASSOCIATED OWNER NAMES ARE H0400792* STORED IN TO THE FILE NAME TABLE. YNAMFL, WHICH IS LOCATED IN THE H0400793* FIXED TABLE AREA OF SMCMON, SPECIFIES THE STARTING LOCATION OF THIS H0400794* TABLE. THE FILE NAME TABLE IS THE FIRST VARIABLE TABLE BUILT. ALL H0400795* OF THE INPUT FILES AND THEIR OWNER NAMES ARE SAVED BEFORE THE OUTPUT H0400796* FILE AND OWNER NAME. IF THE OWNER NAME IS ALL BLANKS, THE FILE IS A H0400797* COMMON FILE. IF THE VOLUME NAME IS ALL BLANKS, THE INSTALLATION H0400798* EQUATE WKSPLU DEFINES WHICH FILE MANAGER LOGICAL UNIT TO USED. ONLY H0400799* ONE ADDROUT INPUT FILE CAN BE SPECIFIED. ANY NUMBER OF INPUT FILES H0400800* ARE ALLOWED IF THE SORT IS NOT ADDROUT. H0400801* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF SMCMON FIXED TABLE H0400802* RTJ IOFIL H0400803* (I)EXIT = (I) ENTRY H0400804* H0400805**** H0400806IOFIL NUM 0 H0400807 LDA- (YNAMFL),I H0400808 STA FILFWA FWA OF INPUT/OUTPUT NON WORK FILE NAMES H0400809IOF10 LDQ =XMSGE13-HERE (Q) = FWA OF ERROR MESSAGE WE MIGHT USE H0400810 RTJ PRENAM CHECK FOR PROPER CARD IDENTIFIER H0400811 RTJ ALFNUM LOOK FOR FILE NAME H0400812 RTJ COMMA LOOK FOR COMMA H0400813 RTJ ALFNUM LOOK FOR OWNER NAME H0400814 SQN IOF15 SKIP IF FIELD NOT ALL BLANKS H0400815ÐÐ LDQ FILFWA H0400816 INQ -4 (Q) = FWA OF LAST FIELD H0400817 CLR A H0400818 STA- (ZERO),Q REQUEST COMMON FILE H0400819IOF15 RTJ NXTCHR FETCH NEXT CHARACTER H0400820 SAM IOF30 SKIP IF OUTPUT FILE H0400821 LDQ TABIND H0400822 SQN IOF20 SKIP IF NO VOLUME FOR OUTPUT FILE H0400823 RAO- YDM,I COUNT INPUT FILES TO BE SORTED H0400824 JMP* IOF10 LOOK FOR NEXT FILE NAME H0400825IOF20 LDQ =XMSGE03-HERE REPORT ERROR, NO VOLUME FIELD SPECIFIED H0400826 JMP SCDIAG REPORT ERROR THEN QUIT. H0400827IOF30 LDQ FILFWA SAVE START OF FILE TABLE H0400828 STQ- YIFTAD,I H0400829 RTJ ALFNUM H0400830 SQZ IOF47 SKIP IF VOLUME NAME NOT SUPPLIED H0400831 LDQ- YIFTAD,I LOCATION OF VOLUME NAME H0400832* INIT REPLACES PLUG BELOW WITH FWA OF VOLSRH H0400833IOF40 RTJ+ PLUG VERIFY VOLUME EXIST AND IS MOUNTED H0400834 SQN IOF50 SKIP IF VOLUME IS MOUNTED H0400835 LDA- YIFTAD,I ADDRESS OF VOLUME NAME H0400836 ENQ MSGVNM 'VOLUME NOT MOUNTED' H0400837 JMP SCDIA5 REPORT ERROR THEN QUIT H0400838IOF47 LDQ WKSPLU USE WORK SPACE LOGICAL UNIT H0400839IOF50 STQ- YOFT,I ADD LUN TO OUTPUT FILE TABLE H0400840ÐÐ JMP* (IOFIL) RETURN H0400841 EJT 0 H0400842**** H0400843*E H0400844* ********* H0400845* * FTDEF * H0400846* ********* H0400847* H0400848* H0400849* THE FTDEF SUBROUTINE OPENS THE INPUT FILES TO SHOW THAT (1) THE FILE H0400850* EXIST, AND (2) TO DETERMINE THE RECORD LENGTH, NUMBER OF RECORDS, AND H0400851* THE FILE MANAGER LOGICAL UNIT NUMBER FOR THE FILE. EACH INPUT AND H0400852* OUTPUT FILE IS IDENTIFIED BY A UNIQUE NUMBER. THE FILE NUMBER OF THE H0400853* FIRST INPUT FILE IS 1, THE SECOND INPUT FILE 2,ETC. EACH FILE NUMBER H0400854* MAPS AS AN ENTRY NUMBER INTO THE FILE NAME TABLE. IF THE FILE NUMBER H0400855* IS GREATER THAN WHAT IS ASSIGNED TO THE OUTPUT FILE, A FILE NAME IS H0400856* CREATED BASED UPON THE TERMINAL ID AND THE FILE NUMBER (SEE NAMEFL IN H0400857* SMCMON FOR DESCRIPTION). H0400858* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF SMCMON FIXED TABLE H0400859* RTJ FTDEF H0400860* (I)EXIT = (I)ENTRY H0400861**** H0400862 SPC 3 H0400863FTDI NUM 0 H0400864FTDEF NUM 0 H0400865ÐÐ LDA- I (A) = FWA OF FIXED TABLES H0400866 STA* FTDI SAVE (I) H0400867 CLR A H0400868 LDQ- YIFTAD,I H0400869FTD10 STQ- I CURRENT FWA OF INPUT FILE TABLE H0400870 INA 1 H0400871 STA- FILNUM,I DEFINE INPUT FILE BY NUMBER H0400872 STA- BUFLTH,I PROVIDE TEMPORARY BUFLTH AND RECLTH FOR OPEN H0400873 STA- RECLTH,I H0400874 LDA- HX03FF FLAG LUN TO ALLOW F.M. TO SEARCH FOR VOLUME H0400875 STA- (LUN),I TEMPORARY DEFINE LOGICAL UNIT H0400876* NOTE FILE TABLE EXPANDED ON OPEN, BUT DOES NOT WIPE OUT ANY DEFINED H0400877* VARIABLE TABLE. H0400878* INIT REPLACES PLUG BELOW WITH FWA OF OPEN H0400879FTD20 RTJ+ PLUG OPEN INPUT FILE H0400880 JMP* FTD70 STOP THE RUN IF ERROR H0400881* INIT REPLACES PLUG BELOW WITH GETFCB H0400882FTD25 RTJ+ PLUG READ ALL FCB INTO BUFFER H0400883* INIT REPLACES PLUG BELOW WITH FWA OF RECADD H0400884FTD30 RTJ+ PLUG H0400885* INIT REPLACES PLUG BELOW WITH FWA OF CLOSE H0400886FTD40 RTJ+ PLUG CLOSE FILE TO SAVE FCB SPACE H0400887 LDA- FCB+RECLEN,I FIND ACTUAL RECORD LENGTH H0400888 STA- RECLTH,I H0400889 LDQ* RECSIZ H0400890ÐÐ SQN FTD50 SKIP IF RECORD LENGTH DEFINED FOR FIRST FILE H0400891 STA* RECSIZ H0400892 LDQ* FTDI (Q) = FIXED TABLE ADDRESS H0400893 LDA- FCB+BYTLEN,I TEMPORARY SAVE RECORD SIZE IN BYTES FOR DATA H0400894 STA- YOFRL,Q ONLY SORTS H0400895 STA MAXLEN SAVE FOR KEY SIZE COMPARISON H0400896 CLR Q (Q) = FLAG TO SELECT VOLUME NAME IN DATA H0400897 JMP* FTD60 H0400898FTD50 EAQ Q H0400899 ENA MSGIFR 'INPUT FILE RECORD LENGTHS ARE NOT EQUAL' H0400900 SQN FTD80 SKIP IF REC LENGTHS NOT SAME FOR INPUT FILES H0400901* (Q) = 0 IS FLAG TO SELECT VOLUME NAME SPECIFIED IN IDATA. H0400902* INIT REPLACES PLUG BELOW WITH FWA OF VOLSRH H0400903FTD60 RTJ+ PLUG DETERMINE F.M. LU FROM VOLUME NAME H0400904 STQ- (LUN),I H0400905 LDA- FILNUM,I USE CURRENT FILE NUMBER TO SPECIFY NEXT FILE H0400906 LDQ* FTDI (Q) = FWA OF FIXED TABLES H0400907 EOR- YDM,Q CHECK TO SEE IF ALL INPUT FILE TABLES DEFINED H0400908 LDQ- I H0400909 INQ BUFWA ADVANCE TO NEXT FILE TABLE H0400910 SAZ FTD90 SKIP IF ALL FILE TABLES DEFINED H0400911 LDA- FILNUM,I H0400912 JMP* FTD10 H0400913FTD70 ENA MSGIFL 'CANNOT OPEN INPUT FILE' H0400914FTD80 STA* FTDMSG TEMP SAVE MESSAGE ADDRESS TO BE USED H0400915ÐÐ LDA- FILNUM,I H0400916 INA -1 (A) = TABLE ENTRY NUMBER H0400917 ALS 3 8 WORDS ENTRIES PER TABLE H0400918 LDQ* FTDI H0400919 ADD- (YNAMFL),Q BASE ADDRESS TO FILE NAME H0400920 ENQ MSGFLN PRINTS INPUT FILE NAME H0400921* INIT REPLACES PLUG BELOW WITH FWA OF CRTMSG H0400922FTD85 RTJ+ PLUG TYPE THE MESSAGE H0400923 LDQ* FTDMSG ERROR MESSAGE INDEX H0400924 JMP SCDIA5 REPORT ERROR H0400925FTD90 LDA* FTDI H0400926 STA- I RESTORE FIRST WORD ADDRESS OF FIXED TABLES H0400927 STQ- YKEY,I START OF KEY TABLE H0400928 STQ- YADOUT,I OR START OF ADDROUT TABLE IF ADDROUT FILE SORTH0400929 LDA- YDM,I H0400930 INA 1 H0400931 EOR- HX8000 INDICATE OUTPUT FILE MUST BE RELEASED AND DEF H0400932 STA- YOFT+FILNUM,I OUTPUT FILE, FILE NUMBER H0400933 LDA* RECSIZ DEFINE RECORD LENGTH H0400934 STA- YOFT+RECLTH,I H0400935 JMP* (FTDEF) RETURN H0400936 SPC 3 H0400937FTDMSG NUM 0 ERROR MESSAGE ADDRESS H0400938RECSIZ NUM 0 RECORD LENGTH OF INPUT FILES H0400939 EJT 0 H0400940ÐÐ**** H0400941*E H0400942* ********** H0400943* * OPTION * H0400944* ********** H0400945* H0400946* H0400947* THE OPTION SUBROUTINE SETS FLAG BITS IN WORD YFLAG. SINCE ALL OF THE H0400948* FLAG SETTINGS ARE NOT YET DEFINED (SUBROUTINE SELECT ADDS MORE TO H0400949* YFLAG), THE FLAG SETTINGS ARE RIGHT JUSTIFIED IN OPTION AND LATER H0400950* LEFT JUSTIFIED IN SELECT SUBROUTINE. H0400951* H0400952* RIGHT/ LEFT JUSTIFIED MEANING: H0400953* BIT 3 BIT 15 0, TAG-ALONG SORT; 1, ADDROUT SORT H0400954* 2 14 0, DATA ONLY OUTPUT,; 1, FULL RECORD OUTPUT H0400955* 1 13 0, ASCII COLLATING SEQUENCE; 1, EBCDIC SEQ. H0400956* 0 12 0, OMIT RECORDS; 1, INCLUDE RECORDS (SET IN H0400957* SELECT SUBROUTINE) H0400958* H0400959* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF SMCMON FIXED TABLE H0400960* RTJ OPTION H0400961* (I)EXIT = (I)ENTRY H0400962* H0400963**** H0400964OPTION NUM 0 H0400965ÐÐOPT00 LDQ =XMSGE15-HERE (Q) = FWA OF ERROR MESSAGE WE MIGHT USE H0400966 RTJ PRENAM CHECK FOR PROPER CARD IDENTIFIER H0400967OPT10 LDQ =XMSGE04-HERE (Q) = FWA OF ERROR MESSAGE WE MIGHT USE H0400968 RTJ PREFIX SAVE FIRST CHARACTER ONLY OF ALPHA FIELD H0400969 INA -$54 LOOK FOR 'T' H0400970 SAZ OPT20 SKIP IF TAG-ALONG SORT H0400971 INA -$41+$54 LOOK FOR 'A' H0400972 SAN OPT40 SKIP IF NOT ADDROUT SORT H0400973 LDA- YDM,I NUMBER OF INPUT FILES ONLY 1 FOR ADDOUT SORT H0400974 INA -1 H0400975 SAN OPT45 SKIP IF INPUT FILE COUNT NOT 1 H0400976 ENA 8 INDICATE ADDROUT SORT REQUESTED H0400977OPT20 STA- YFLAG,I TEMPORARY SAVE SORT OPTION H0400978OPT30 LDQ =XMSGE05-HERE (Q) = FWA OF ERROR MESSAGE WE MIGHT USE H0400979 RTJ ALPHA ALPHA CHARACTER H0400980 INA -$44 LOOK FOR 'D' H0400981 SAZ OPT50 SKIP IF DATA ONLY OPTION H0400982 LDQ- YFLAG,I H0400983 SQN OPT50 SKIP IF ADDROUT (DATA ONLY) H0400984 INA -$46+$44 LOOK FOR 'F' H0400985OPT40 SAN OPT60 SKIP IF NOT VALID CHARACTER H0400986 ENA 4 INDICATE FULL RECORD OUTPUT REQUESTED H0400987 STA- YFLAG,I TEMPORARY SAVE FLAGS H0400988 JMP* OPT50 H0400989OPT45 ENQ MSGASO 'ADDROUT SORTS ONLY 1 FILE' H0400990ÐÐ JMP SCDIA5 REPORT THE ERROR MESSAGE H0400991OPT50 LDQ =XMSGE06-HERE (Q) = FWA OF ERROR MESSAGE WE MIGHT USE H0400992 RTJ COMALF EXPECT COMMA, ALPHA CHARACTER H0400993 INA -$41 LOOK FOR 'A' H0400994 SAZ OPT70 SKIP IF ASCII COLLATING SEQUENCE H0400995 INA -$45+$41 LOOK FOR 'E' H0400996OPT60 SAN OPT80 SKIP IF NOT VALID CHARACTER H0400997 ENA 2 INDICATE EBCDIC COLLATING SEQUENCE REQUESTED H0400998 EOR- YFLAG,I MERGE SORT OPTION FLAGS H0400999 STA- YFLAG,I H0401000OPT70 JMP* (OPTION) RETURN H0401001OPT80 JMP ALFERR REPORT ERROR H0401002 EJT H0401003**** H0401004*E H0401005* ******** H0401006* * KEYS * H0401007* ******** H0401008* H0401009* H0401010* THE KEYS SUBROUTINE BUILDS THE KEY TABLE (YKEY) AND BUILDS THE ADDROUTH0401011* OR DATA ONLY TABLE (YADOUT) IF THESE OPTIONS ARE IN EFFECT. IF THE H0401012* YADOUT TABLE IS BUILT, IT APPEARS PRIOR TO THE KEY TABLE. IT IS H0401013* NECESSARY TO REFORMAT THE YADOUT TABLE IN ORDER TO PROVIDE THE PROPER H0401014* ARRANGEMENT NEEDED BY SMCMON ROUTINES KYMOVE (FOR ADDROUT) AND DATAMV H0401015ÐÐ* (FOR DATA ONLY). BEFORE YADOUT IS REFORMATTED, THE STARTING COLUMN, H0401016* LENGTH OF KEY, AND ASCENDING/DECENDING FLAG ARE EXTRACTED FOR BUILDINGH0401017* THE KEY TABLE. THE KEY TABLE STRUCTURE IS SHOWN UNDER SUBROUTINE H0401018* KEYTBL. H0401019* H0401020* THE YADOUT TABLE IS BUILT IN 2 PHASES IF ADDROUT SORT IS REQUESTED. H0401021* H0401022* PHASE 1: YADOUT TABLE FOR ADDROUT USAGE H0401023* H0401024* H0401025* ****************** H0401026* * KYCOLS(1) * KYCOLS (1) = FIRST KEY LENGTH IN CHARACTERS H0401027* * A/D KEYCOL(1) * A/D = BIT 15 0/1 = ASCENDING/DECENDING KEY H0401028* * . * KEYCOL(1) = STARTING COLUMN POSITION H0401029* * . * H0401030* * . * H0401031* * . * H0401032* * KYCOLS(N) * KYCOLS(N) = LAST KEY LENGTH H0401033* * A/D KEYCOL(N) * A/D = ASCENDING/DECENDING KEY H0401034* * - 0 * END OF TABLE INDICATOR H0401035* ****************** KEYCOL(N) = STARTING COLUMN OF LAST KEY H0401036* H0401037* THE FIRST KEY FIELD ENTRY CORRESPONDS TO THE FIRST KEY FIELD DESCRIP- H0401038* TION ON THE KF= CARD. THIS IS THE PRIMARY KEY FOR SORTING. THE H0401039* KYCOLS(N)/ KEYCOL(N) ENTRY CORRESPONDS TO THE LAST KEY ON THE KF= H0401040ÐÐ* CARD. H0401041**** H0401042 EJT 0 H0401043**** H0401044*E H0401045* PHASE 2: YADOUT TABLE FOR ADDROUT USAGE H0401046* H0401047* H0401048* ***************************** H0401049* * REL WORD OFFSET OF KEY(1) * COLUMNS 1 AND 2 MAP INTO WORD 0 H0401050* * KEY LENGTH IN WORDS * LENGTH IS ROUNDED UP H0401051* * . * H0401052* * . * H0401053* * . * H0401054* * . * H0401055* * REL WORD OFFSET OF KEY(N) * H0401056* * KEY LENGTH IN WORDS * H0401057* * - 0 * END OF TABLE INDICATOR H0401058* ***************************** H0401059* H0401060* EACH KEY FIELD IS MOVED (IN WORDS) FROM THE INPUT RECORD INTO THE H0401061* ADDROUT RECORD AREA. THE VARIABLE TABLE CONTAINS SPACE FOR THIS H0401062* RECORD AND IT IS IDENTIFIED BY THE FIXED TABLE ENTRY YADRBF. THE H0401063* FIRST 2 WORDS OF YADRBF ARE RESERVED FOR THE FILE MANAGER RELATIVE H0401064* RECORD NUMBER. THESE WORDS ARE USED REGARDLESS OF SORT OPTION,IE, H0401065ÐÐ* ADDREOUT, OR FULL RECORD SORT. THE FORMAT OF THIS TABLE IS: H0401066* H0401067* H0401068* ******************************** H0401069* * RELATIVE RECORD NUMBER (MSB) * H0401070* * RELATIVE RECORD NUMBER (LSB) * H0401071* * FIRST KEY FIELD * H0401072* * SECOND KEY FIELD * H0401073* * . * H0401074* * . * H0401075* * . * H0401076* * . * H0401077* * LAST KEY FIELD * H0401078* * - 0 * END OF TABLE INDICATOR H0401079* ******************************** H0401080* H0401081* NOTE THE KEY MAY START EITHER IN THE FIRST COLUMN OR THE SECOND H0401082* COLUMN OF THE ABOVE KEY FIELD. THE CORE SPACE FOR THIS RECORD AREA H0401083* FOLLOWS THE KEY TABLE (YKEY). H0401084**** H0401085 EJT 0 H0401086**** H0401087*E H0401088* IF A DATA ONLY SORT IS REQUESTED, THE DATA IN YADOUT TABLE IS TREATED H0401089* AS FOLLOWS: H0401090ÐÐ* H0401091* H0401092* ******************** H0401093* * FCA OF RECORD * FCA IS ALWAYS 1 H0401094* * LENGTH OF RECORD * LENGTH IS SIZE OF INPUT RECORD IN BYTES H0401095* * KYCOLS(1) * REMAINING ENTRIES SAME AS 1ST PHASE FOR H0401096* * A/D KEYCOLS(1) * ADDROUT SORT. H0401097* * . * H0401098* * . * H0401099* * . * H0401100* * . * H0401101* * KYCOLS(N) * H0401102* * A/D KEYCOLS(N) * H0401103* * - 0 * END OF TABLE INDICATOR H0401104* ******************** H0401105* H0401106* THE FIRST ENTRY REPRESENTS THE ENTIRE RECORD AREA. THE REMAINING H0401107* ENTRIES WILL BE USED TO FRAGMENT THE FIRST ENTRY. IF A KEY FIELD H0401108* IS COMPLETELY WITHIN THE DATA AREA OF THE FIRST ENTRY A NEW ENTRY IS H0401109* CREATED TO SHOW THE FRAGMENTED PART. THE NEW ENTRY WILL BE ADDED H0401110* STARTING WITH THE FIRST KYCOLS ENTRY. ADDITIONAL KEY FIELDS MAY H0401111* FRAGMENT ONE OR MORE OF THE EXISTING DATA SECTIONS. WHEN THIS OCCURS H0401112* THESE ENTRIES ARE ADDED AFTER THE LAST FRAGMENT SECTION WAS ADDED. H0401113* ONE OR MORE OF THE DATA FRAGMENTS MAY BECOME EMPTY BECAUSE A KEY H0401114* FIELD COMPLETELY OVERLAPS THE DATA FRAGMENT ENTRY. THE FRAGMENT H0401115ÐÐ* LENGTH IS SET TO ZERO OR MINUS TO INDICATE ENTRY NO LONGER EXIST. H0401116* H0401117* THE YADOUT FORMAT AFTER PASS 2 IS. H0401118* H0401119* H0401120* ******************* H0401121* * FCA OF DATA(1) * H0401122* * FRAGMENT LENGTH * LENGTH IS IN CHARACTERS H0401123* * . * H0401124* * . * ENTRIES NOT ORDERED H0401125* * . * MAY CONTAIN UNUSED ENTRIES H0401126* * . * H0401127* * FCA OF DATA(N) * H0401128* * FRAGMENT LENGTH * H0401129* * - 0 * END OF TABLE INDICATOR H0401130* ******************* H0401131* H0401132* THE YADOUT TABLE MAY HAVE MANY UNUSED ENTRIES AND THE FCA FOR EACH H0401133* DATA FRAGMENT IS NOT ORDERED FROM FIRST DATA AREA TO LAST DATA AREA. H0401134**** H0401135 EJT 0 H0401136**** H0401137*E H0401138* THE FINAL PASS THROUGH THIS TABLE REMOVES UNUSED ENTRIES AND SORTS H0401139* THE DATA FRAGMENTS IN ASCENDING ORDER. H0401140ÐÐ* H0401141* H0401142* ******************* H0401143* * FCA OF DATA(1) * H0401144* * FRAGMENT LENGTH * H0401145* * . * ORDERED ENTRIES H0401146* * . * NO UNUSED ENTRIES H0401147* * . * H0401148* * . * H0401149* * FCA OF DATA(N) * H0401150* * FRAGMENT LENGTH * H0401151* * - 0 * H0401152* ******************* H0401153* H0401154* IF KEY FIELDS OCCUPY ALL OF THE RECORD, NO DATA FIELDS EXIST FOR THE H0401155* FINAL OUTPUT RECORD. THIS CASE WILL BE REPORTED AS A FATAL ERROR. H0401156**** H0401157 EJT 0 H0401158**** H0401159*E H0401160* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF SMCMON FIXED TABLE H0401161* RTJ KEYS H0401162* (I)EXIT = (I) ENTRY H0401163**** H0401164KEYS NUM 0 H0401165ÐÐKEY00 LDQ =XMSGE16-HERE (Q) = FWA OF ERROR MESSAGE WE MIGHT USE H0401166 RTJ PRENAM CHECK FOR PROPER CARD IDENTIFIER H0401167 LDQ- YKEY,I (Q) = FWA OF KEY TABLE. H0401168 LDA- YFLAG,I LOOK FOR DATA ONLY SORT H0401169 ALS 15-3 H0401170 SAM KEY05 SKIP IF ADDROUT H0401171 AND- HX4000 MASK DATA ONLY BIT H0401172 SAN KEY05 SKIP IF NOT DATA ONLY H0401173 STQ DATABL START OF DATA ONLY TABLE H0401174 ENA 1 STARTING COLUMN H0401175 STA- (ZERO),Q H0401176 LDA- YOFRL,I RECORD LENGTH IN CHARACTERS H0401177 STA- 1,Q H0401178 CLR A H0401179 STA- YOFRL,I PRESET FOR ACCUMULATING DATA FIELDS H0401180 INQ 2 DATA ONLY, NEED 2 EXTRA WORDS H0401181KEY05 STQ KEYPTR SAY THERE IS NOTHING IN THE KEY TABLE YET. H0401182 STQ ADRPTR SAY THERE IS NOTHING IN ADDROUT TABLE YET H0401183 STQ DATLWA LWA FOR DATABL ENTRY H0401184KEY10 LDQ =XMSGE07-HERE (Q) = FWA OF ERROR MESSAGE WE MIGHT USE. H0401185 RTJ ALPHA LOOK FOR A/D H0401186 INA -$41 $41 IS ASCII FOR ]A]. H0401187 SAZ KEY30 SKIP IF ]A]. H0401188 INA -$44+$41 $44 IS ASCII FOR ]D]. H0401189 SAZ KEY20 SKIP IF ]D]. H0401190ÐÐ JMP ALFERR JMP IF NOT ]A]/]D]. H0401191KEY20 ENA 1 CAUSE DESCENDING LOGIC TO BE STACKED. H0401192KEY30 STA KEYLPT FLAG ASCENDING/ DESCENDING ORDER H0401193KEY40 LDQ =XMSGE08-HERE (Q) = FWA OF ERROR MESSAGE WE MIGHT USE. H0401194 RTJ COMPOS LOOK FOR COMMA THEN KEYCOL. H0401195 STA KEYCOL REMEMBER STARTING COLUMN OF KEY. H0401196KEY50 LDQ =XMSGE09-HERE (Q) = FWA OF ERROR MESSAGE WE MIGHT USE. H0401197 RTJ COMPOS LOOK FOR COMMA THEN KEYCOLS. H0401198 STA KYCOLS REMEMBER NO. OF COLUMNS IN KEY. H0401199 STA (KEYPTR) BUILD ADDROUT TABLE ENTRY H0401200 LDA KEYCOL STARTING COLUMN H0401201 RTJ KRANGE VERIFY KEY FIELD WITHIN RECORD H0401202 LDQ- YFLAG,I H0401203 QLS 15-2 H0401204 SQP KEY60 SKIP IF DATA ONLY (OR ADDROUT) SORT H0401205 RTJ KEYTBL BUILD KEY TABLE ENTRY(S) H0401206 JMP* KEY70 H0401207KEY60 RAO KEYPTR H0401208 LDA KEYLPT H0401209 ALS 15-0 H0401210 EOR KEYCOL COMBINE A/D FLAG WITH KEYCOL H0401211 STA (KEYPTR) H0401212 RAO KEYPTR H0401213KEY70 RTJ NXTCHR LOOK FOR COMMA. H0401214 SAP KEY80 SKIP IF NOT COMMA (END OF KEY DESCRIPTION) H0401215ÐÐ JMP* KEY10 DO NEXT KEY. H0401216KEY80 LDQ- YFLAG,I H0401217 QLS 15-2 LOOK FOR DATA OPTION H0401218KEY90 SET A H0401219 STA (KEYPTR) STACK THE TABLE TERMINATOR. H0401220 RAO KEYPTR H0401221 LDA KEYPTR (A) = 1 + LWA OF KEY TABLE. H0401222 SQP KEY100 SKIP IF KEY TABLE NEEDS TO BE BUILT H0401223 STA- YADRBF,I (A) = FWA OF ADDROUT RECORD BUFFER H0401224 JMP* KEY200 H0401225KEY100 STA- YKEY,I (A) = FWA OF KEY TABLE H0401226 QLS 15-0 H0401227 SQM KEY105 SKIP IF ADDROUT FILE H0401228 JMP* KEY120 H0401229KEY105 ENA 4 FINAL OUTPUT RECORD LENGTH FOR ADDROUT FILE H0401230 STA- YOFRL,I H0401231KEY110 RTJ KEYSET H0401232 JMP* KEY90 JUMP IF ALL ADDROUT TABLE ENTRIES EXAMINED H0401233 ALS 15 DOES KEY START ON EVEN COLUMN 123*4907H0401234 SAM KEY112 SKIP IF KEY STARTS ON ODD COLUMN 123*4907H0401235 INQ 1 CNT. LEADING CHAR. FOR FINDING WD. CNT123*4907H0401236KEY112 ALS 1 RESET(A) 123*4907H0401237 INQ 1 ROUND UP FOR KEYS NOT WORD ALIGNED H0401238 QRS 1 H0401239 STQ (ADRPTR) NO OF WORDS REQUIRED FOR KEY IN YADRBF BUFFER H0401240ÐÐ ADQ ADRBUF ACCUMULATE ADDROUT BUFFER SIZE H0401241 STQ* ADRBUF H0401242 STQ- YOFT+RECLTH,I MERGE RECORD LENGTH FOR OUTPUT FILE H0401243 INA -1 H0401244 ARS 1 H0401245 LDQ* ADRPTR H0401246 INQ -1 H0401247 STA- (ZERO),Q REL WORD OFFSET TO KEY IN INPUT RECORD H0401248 LDA KEYCOL EXTRACT EVEN OR ODD CHAR POSITION H0401249 INA -1 H0401250 AND- HX0001 H0401251 LDQ* FCAKEY (A) = FCA OF KEY FOR REFORMATTED RECORD H0401252 AAQ A ADD BASE CHARACTER POSITION H0401253 STA* KEYCOL ADJUSTED KEY POSITION FOR ADDROUT SORT H0401254 ADQ* (ADRPTR) OFFSET TO NEXT KEY IN RECORD H0401255 ADQ* (ADRPTR) ADD TWICE SINCE ADDING IN CHARACTERS H0401256 STQ* FCAKEY H0401257 RAO* ADRPTR H0401258 RTJ KEYTBL BUILD KEY TABLE ENTRY(S) H0401259 JMP* KEY110 H0401260* BUILD DATA ONLY TABLE. THIS TABLE IS SIMILAR TO ADDROUT TABLE EXCEPT H0401261* TABLE REFLECTS ALL NON KEY AREAS. H0401262KEY115 RAO* ADRPTR H0401263 RTJ KEYTBL BUILD KEY TABLE ENTRY(S) H0401264KEY120 RTJ* KEYSET H0401265ÐÐ JMP* KEY90 JUMP IF ALL ADDROUT TABLE ENTRIES EXAMINED H0401266 LDA* DATABL RESET TABLE INDEXES TO DATABL 1ST ENTRY H0401267KEY130 STA* DATWD1 (A) = ADDRESS TO START COLUMN OF DATA AREA H0401268 INA 1 H0401269 STA* DATWD2 (A) = ADDRESS TO COLUMN COUNT OF DATA AREA H0401270 LDA* (DATWD1) (A) = FCA OF DATA FIELD H0401271 SAP KEY140 H0401272 JMP* KEY115 DATABL EXHAUSTED (FETCH NEW KEY FIELD) H0401273KEY140 LDQ* (DATWD2) (Q) = DATA FIELD CHARACTER COUNT H0401274 SQM KEY150 SKIP IF DATA ENTRY NO LONGER EXIST H0401275 SQZ KEY150 SKIP IF DATA ENTRY NO LONGER EXIST H0401276 AAQ A (A) = LCA + 1 OF DATA ENTRY H0401277 SUB* KEYCOL CHECK IF THIS KEY IS IN THIS DATA FIELD H0401278 TCA Q H0401279 INQ 0 IF KEYCOL = LCA + 1 H0401280 SQM KEY160 SKIP IF KEY IS NOT BEYOND THIS DATA FIELD H0401281KEY150 JMP* KEY180 LOOK AT NEXT DATABL ENTRY H0401282KEY160 SUB* KYCOLS (A) = LCA+1 OF DATA - LCA+1 OF KEY H0401283 SAZ KEY170 SKIP IF KEY ENDS WHERE DATA FIELD ENDS H0401284 SAM KEY170 SKIP IF END OF KEY DOES EXTEND BEYOND DATA H0401285 LDA* (DATWD1) CHECK TO SEE IF KEY OVERLAPS START OF DATA H0401286 SUB* KEYCOL H0401287 SAM KEY190 SKIP IF KEY FIELD ENTIRELY WITHIN DATA FIELD H0401288 SUB* KYCOLS (A) = NO. OF CHARS KEY FIELD OVERLAPS DATA H0401289 SAP KEY180 SKIP IF KEY FIELD DOES NOT OVERLAP DATA H0401290ÐÐ TRA Q (A) = NO. OF WORDS THAT DATA FIELD IS REDUCED H0401291 TCA A H0401292 ADD* (DATWD1) H0401293 STA* (DATWD1) (A) = FCA OF DATA FIELD, (A) > 0 H0401294KEY170 ADQ* (DATWD2) REDUCE SIZE OF DATA FIELD H0401295 STQ* (DATWD2) IF (A) = 0 OR (A) < 0, DATA FIELD EXHAUSTED H0401296KEY180 LDA* DATWD1 ADVANCE TO NEXT DATABL ENTRY H0401297 INA 2 H0401298 JMP* KEY130 LOOK AT NEXT DATABL ENTRY H0401299KEY190 TCA Q DATA FIELD WILL BE SPLIT INTO TWO FIELDS H0401300 LDA* (DATWD2) (A) = OLD LENGTH OF DATA FIELD H0401301 STQ* (DATWD2) (Q) = LENGTH OF 1ST HALF OF DATA FIELD H0401302 ADD* (DATWD1) (A) = LCA+1 OF OLD DATA FIELD H0401303 LDQ* KEYCOL H0401304 ADQ* KYCOLS (Q) = LCA+1 OF KEY FIELD H0401305 STQ* (DATLWA) (Q) = FCA OF NEW DATA FIELD H0401306 SUB* (DATLWA) (A) = LCA+1 OF OLD DATA - LCA+1 OF KEY FIELD H0401307 RAO* DATLWA H0401308 STA* (DATLWA) (A) = LENGTH OF 2ND DATA FIELD H0401309 RAO* DATLWA ADVANCE TO NEXT AVAILABLE SLOT IN DATABL H0401310 JMP* KEY115 LOOK AT NEXT KEY FIELD H0401311KEY200 ADD* ADRBUF ALLOW FOR ADDROUT BUFFER (OR 2 REL REC WORDS) H0401312 STA- YFIELD,I (A) = FWA OF KEY COMPARE TABLE H0401313 LDQ* DATABL (Q) = FWA FOR REF ENTRY H0401314 SQN KEY230 SKIP IF DATA ONLY SORT H0401315ÐÐ JMP* KEY320 DATABL DOES NOT NEED ORDERING H0401316KEY230 LDA- (ZERO),Q H0401317 EOR- HXFFFF H0401318 SAZ KEY270 SKIP IF CURRENT REF ENTRY AT END OF TABLE H0401319 LDA- 1,Q H0401320 SAZ KEY240 H0401321 SAP KEY250 SKIP IF CURRENT REF ENTRY NONEMPTY H0401322KEY240 LDA- HX7FFF MAKE EMPTY ENTRY LOSER IN COMPARISON H0401323 STA- (ZERO),Q H0401324KEY250 STQ* DATWD1 (Q) = FWA OF CURRENT REF ENTRY H0401325 INQ 1 H0401326 STQ* DATWD2 (Q) = FWA OF 2ND WORD IN REF ENTRY H0401327KEY260 LDA- 1,Q H0401328 EOR- HXFFFF H0401329 SAN KEY290 SKIP IF MORE ENTRIES TO SEARCH H0401330 LDQ* DATWD1 PICK UP NEXT REFERENCE ENTRY H0401331 LDA* (DATWD1) CHECK TO SEE IF WINNER REF ENTRY IS EMPTY H0401332 EOR- HX7FFF H0401333 SAN KEY280 SKIP IF CURRENT WINNER NONEMPTY H0401334KEY270 JMP* KEY310 DONE H0401335KEY280 INQ 2 H0401336 LDA- YOFRL,I ACCUMULATE OUTPUT FILE RECORD LENGTH H0401337 ADD* (DATWD2) H0401338 STA- YOFRL,I H0401339 JMP* KEY230 H0401340ÐÐKEY290 LDA- 2,Q SEE IF CURRENT COMPARE ENTRY IS EMPTY H0401341 SAM KEY300 SKIP IF EMPTY ENTRY H0401342 SAZ KEY300 SKIP IF EMPTY ENTRY H0401343 STA* CMPWD2 SAVE 2ND WORD VALUE H0401344 LDA- 1,Q H0401345 STA* CMPWD1 SAVE 1ST WORD VALUE H0401346 SUB* (DATWD1) H0401347 SAP KEY300 SKIP IF COMPARISON ENTRY GREATER THAN REF H0401348 LDA* (DATWD1) SWITCH ENTRIES H0401349 STA- 1,Q H0401350 LDA* (DATWD2) H0401351 STA- 2,Q H0401352 LDA* CMPWD1 H0401353 STA* (DATWD1) H0401354 LDA* CMPWD2 H0401355 STA* (DATWD2) H0401356KEY300 INQ 2 LOOK AT NEXT ENTRY H0401357 JMP* KEY260 H0401358KEY310 SET A FLAG END OF TABLE H0401359 STA- (ZERO),Q H0401360 LDA- YOFRL,I H0401361 SAN KEY320 SKIP IF DATA ONLY OPTION CONTAINS RECORD DATA H0401362 ENQ MSGOFR 'OUTPUT FILE RECORD LENGTH IS ZERO' H0401363 JMP SCDIA5 REPORT ERROR H0401364KEY320 JMP (KEYS) EXIT. H0401365ÐÐ SPC 3 H0401366ADRBUF NUM 2 PRESET ACCUMULATOR TO CONTAIN REL REC WORDS H0401367ADRPTR NUM 0 () = INDEX TO ADDROUT TABLE H0401368CMPWD1 NUM 0 VALUE OF 1ST WORD OF WINNER DATABL ENTRY H0401369CMPWD2 NUM 0 VALUE OF 2ND WORD OF WINNER DATABL ENTRY H0401370DATABL NUM 0 () = FWA OF DATA ONLY SORT TABLE H0401371DATLWA NUM 0 () = FWA OF ADDED DATA FIELD H0401372DATWD1 NUM 0 () = FWA OF DATABL ENTRY H0401373DATWD2 NUM 0 () = FWA + 1 OF DATABL ENTRY H0401374FCAKEY NUM 5 () = FCA OF KEY FOR REFORMATTED RECORD H0401375KEYLPT NUM 0 () = INDEX INTO YCMPFA,YCMPFD,... H0401376KEYPTR NUM 0 () = FWA OF CURRENT WORD OF KEY TABLE. H0401377KEYCOL NUM 0 () = STARTING COLUMN OF CURRENT KEY. H0401378KYCOLS NUM 0 () = NO. OF COLUMNS IN CURRENT KEY. H0401379KYWLEN NUM 0 () = NO. WORDS IN WORD KEY. H0401380 EJT 0 H0401381**** H0401382*E H0401383* ********** H0401384* * KEYSET * H0401385* ********** H0401386* H0401387* H0401388* KEYSET SUBROUTINE EXTRACTS THE STARTING KEY COLUMN, THE NUMBER OF H0401389* COLUMNS IN KEY FIELD, AND ASCENDING/DECENDING COLLATING ORDER OF H0401390ÐÐ* EACH KEY FROM THE YADOUT TABLE. THE YADOUT TABLE CONTAINS THE ABOVE H0401391* INFORMATION ONLY ON THE 1ST CONVERSION PHASE. (SEE KEYS DESCRIPTION).H0401392* THE ABOVE INFORMATION IS USED TO BUILD THE KEY TABLE VIA KEYTBL H0401393* SUBROUTINE AND TO RESTRUCTURE YADOUT TABLE ITSELF. H0401394* THE CALLING SEQUENCE IS RTJ KEYSET H0401395* (A)EXIT = KEYCOL VALUE H0401396* (Q)EXIT = KEYCOL VALUE OR < 0 IF END OF TABLE H0401397* (P+1)EXIT = END OF YADOUT REACHED H0401398* (P+2)EXIT = FOUND EXISTING ENTRY H0401399**** H0401400KEYSET NUM 0 H0401401 LDQ* (ADRPTR) KYCOLS VALUE H0401402 SQM KYS10 SKIP IF NO MORE ENTRIES IN ADDROUT TABLE H0401403 STQ* KYCOLS SAVE FOR BUILDING KEY TABLE H0401404 SET A (A) = END OF TABLE INDICATOR FOR DATABL H0401405 STA* (ADRPTR) H0401406 RAO* ADRPTR H0401407 LDA* (ADRPTR) A/D FLAG + KEYCOL H0401408 AND- HX8000 H0401409 ALS 1 H0401410 STA* KEYLPT A/D FLAG H0401411 LDA* (ADRPTR) H0401412 AND- HX7FFF H0401413 STA* KEYCOL SAVE FOR BUILDING KEY TABLE H0401414 RAO* KEYSET SET UP P+2 RETURN IF MORE ENTRIES H0401415ÐÐKYS10 JMP* (KEYSET) RETURN H0401416 EJT 0 H0401417**** H0401418*E H0401419* ********** H0401420* * KEYTBL * H0401421* ********** H0401422* H0401423* H0401424* THE KEYTBL SUBROUTINE TAKES THE STARTING KEY COLUMN (KEYCOL), THE H0401425* NUMBER OF COLUMNS IN KEY (KYCOLS), AND THE ASCENDING/ DECENDING H0401426* FLAG (KEYLPT,0/1) AND BUILDS THE KEY TABLE. THE KEY TABLE IS H0401427* DESIGNED TO MINIMIZE THE TIME REQUIRED TO SELECT A COMPARE PROCESSOR H0401428* IN SMCMON THAT WILL COMPARE 2 KEYS. THE COMPARE PROCESSORS IN H0401429* SMCMON ASSUMES THE TWO KEYS ARE ALIGNED THE SAME WITHIN THE WORD H0401430* STRUCTURE OF THE HARDWARE,IE, BOTH KEYS EITHER START ON A EVEN OR H0401431* ODD WORD BOUNDARY. THERE IS A PROCESSOR FOR 1 CHARACTER STARTING ON H0401432* AN EVEN BOUNDARY; 1 CHARACTER STARTING ON AN ODD WORD BOUNDARY; 2 H0401433* CHARACTERS THAT FILL ONE WORD; AND SEVERAL CHARACTERS THAT OCCUPY H0401434* FULL WORDS. THE KEY FIELD IS BROKEN DOWN STARTING WITH THE LEFT MOST H0401435* CHARACTER AND MAPPED INTO ONE OF THE ABOVE PROCESSORS. SINCE BOTH H0401436* ASCENDING AND DECENDING KEYS EXIST,ALL OR THE ABOVE PROCESSORS ARE H0401437* REPEATED, ONE FOR ASCENDING SORTING AND THE OTHER FOR DECENDING H0401438* SORTING. THE STARTING COLUMN IS CONVERTED TO AN RELATIVE WORD OFFSET H0401439* IN THE RECORD. IF KEYCOLS = 1 OR 2, THE RELATIVE WORD OFFSET WOULD H0401440ÐÐ* BE 0. H0401441* H0401442* THE TABLE FORMAT IS: H0401443* H0401444* ************************** H0401445* * REL RECORD OFFSET * WORD OFFSET STARTING WITH ZERO H0401446* * YCMPWA PROCESSOR (A/D) * ADDRESS OF SMCMON PROCESSOR H0401447* * LCA+1 OF KEY * LAST CHARACTER + 1 OF BLOCKED FULL H0401448* * * WORDS H0401449* * * H0401450* * REL RECORD OFFSET * H0401451* * YCMCUA (A/D) * ADDRESS OF SMCMON PROCESSOR FOR ONE H0401452* * * CHARACTER COMPARE (EVEN COLUMN) H0401453* * * H0401454* * REL RECORD OFFET * H0401455* * YCMCLA (A/D) * ADDRESS OF SMCMON PROCESSOR FOR ONE H0401456* * * CHARACTER COMPARE (ODD COLUMN) H0401457* * * H0401458* * REL RECORD OFFSET * H0401459* * YCMPLA * ADDRESS OF SMCMON PROCESSOR FOR ONE H0401460* * * WORD COMPARE H0401461* * - 0 * END OF TABLE INDICATOR H0401462* ************************** H0401463**** H0401464 EJT 0 H0401465ÐÐ**** H0401466*E H0401467* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF SMCMON FIXED TABLE H0401468* RTJ KEYTBL H0401469* (I)EXIT = (I)ENTRY H0401470* H0401471**** H0401472KEYTBL NUM 0 H0401473 LDA* KEYCOL (A) = STARTING COLUMN OF KEY. H0401474 ALS 15 (A)15=1 IFF KEYCOL IS ODD. H0401475 SAM KYT10 SKIP IF KEYCOL IS ODD. H0401476 JMP* KYT60 JMP IF KEYCOL IS EVEN. I.E. LOWER CHARACTER. H0401477KYT10 LDA* KYCOLS (A) = NO. OF COLUMNS REMAINING OF C KEY. H0401478 INA -1 H0401479 SAN KYT20 SKIP IF .GE. 2 COLUMNS REMAIN OF C KEY. H0401480 JMP* KYT40 JMP IF 1 COLUMN REMAINS OF C KEY. H0401481KYT20 INA -3 H0401482 SAP KYT30 SKIP IF .GE. 4 COLUMNS REMAIN OF C KEY. H0401483 JMP* KYT70 JMP IF 2 .LE. REMAINING COLUMNS .LE. 3. H0401484KYT30 RTJ* KEYFWA FROM KEYCOL, COMPUTE AND STACK REL. FWA OF KEY. H0401485 LDQ* KEYLPT (Q) = 0 FOR ASCENDING, 1 FOR DESCENDING. H0401486 LDA- YCMPWA,B (A) = -1 + FWA OF PROPER COMPARE LOGIC. H0401487 STA* (KEYPTR) STACK -1 + FWA OF THE COMPARE LOGIC. H0401488 RAO* KEYPTR POINT TO NEXT FREE WORD OF KEY TABLE. H0401489 LDA* KYCOLS (A) = NO. OF COLUMNS REMAINING OF C KEY. H0401490ÐÐ ARS 1 (A) = NO. OF WORDS OF WORD KEY. H0401491 ALS 1 (A) = NO. OF BYTES OF WORD KEY. H0401492 STA* KYWLEN SAVE LENGTH OF WORD KEY. H0401493 ADD* KEYCOL (A) = 1 + LAST COLUMN OF WORD KEY. H0401494 STA* KEYCOL SAVE IT FOR POSTERITY AND FOR COMING KEYFWA CALLH0401495 RTJ* KEYFWA STACK 1 + LWA OF WORD KEY. H0401496 LDA* KYCOLS (A) = NO. OF REMAINING COLUMNS BEFORE WORD KEY. H0401497 SUB* KYWLEN (A) = NO. OF COLUMNS AFTER WORD KEY. H0401498 SAZ KYT50 SKIP TO SEE IF THERE IS ANOTHER KEY TO DO. H0401499 STA* KYCOLS UPDATE NO. OF COLUMNS REMAINING OF C KEY. H0401500KYT40 RTJ* KEYFWA FROM KEYCOL, COMPUTE AND STACK REL. FWA OF KEY. H0401501 LDQ* KEYLPT (Q) = 0 FOR ASCENDING, 1 FOR DESCENDING. H0401502 LDA- YCMCUA,B (A) = -1 + FWA OF PROPER COMPARE LOGIC. H0401503 STA* (KEYPTR) STACK -1 + FWA OF THE COMPARE LOGIC. H0401504 RAO* KEYPTR POINT TO NEXT FREE WORD OF KEY TABLE. H0401505KYT50 JMP* (KEYTBL) RETURN H0401506KYT60 RTJ* KEYFWA FROM KEYCOL, COMPUTE AND STACK REL. FWA OF KEY. H0401507 LDQ* KEYLPT (Q) = 0 FOR ASCENDING, 1 FOR DESCENDING. H0401508 LDA- YCMCLA,B (A) = -1 + FWA OF PROPER COMPARE LOGIC. H0401509 STA* (KEYPTR) STACK -1 + FWA OF THE COMPARE LOGIC. H0401510 RAO* KEYPTR POINT TO NEXT FREE WORD OF KEY TABLE. H0401511 LDA* KYCOLS (A) = NO. OF COLUMNS BEFORE LOWER CHARACTER. H0401512 INA -1 (A) = NO. OF COLUMNS AFTER LOWER CHARACTER. H0401513 SAZ KYT80 SKIP TO SEE IF THERE IS ANOTHER KEY TO DO. H0401514 STA* KYCOLS UPDATE NO. OF COLUMNS REMAINING OF C KEY. H0401515ÐÐ RAO* KEYCOL UPDATE STARTING COLUMN OF REMAINDER OF C KEY. H0401516 JMP* KYT10 DO NEXT PART OF C KEY. H0401517KYT70 RTJ* KEYFWA FROM KEYCOL, COMPUTE AND STACK REL. FWA OF KEY. H0401518 LDQ* KEYLPT (Q) = 0 FOR ASCENDING, 1 FOR DESCENDING. H0401519 LDA- YCMPLA,B (A) = -1 + FWA OF PROPER COMPARE LOGIC. H0401520 STA* (KEYPTR) STACK -1 + FWA OF THE COMPARE LOGIC. H0401521 RAO* KEYPTR POINT TO NEXT FREE WORD OF KEY TABLE. H0401522 LDA* KYCOLS (A) = NO. OF COLUMNS BEFORE IMPLIED L KEY. H0401523 INA -2 (A) = NO. OF COLUMNS AFTER IMPLIED L KEY. H0401524 SAN KYT90 SKIP IF C KEY NOT YET EXHAUSTED. H0401525KYT80 JMP* (KEYTBL) RETURN H0401526KYT90 STA* KYCOLS UPDATE NO. OF COLUMNS REMAINING OF C KEY. H0401527 RAO* KEYCOL H0401528 RAO* KEYCOL NOW (KEYCOL) = NO. OF NEXT COL. OF C KEY. H0401529 JMP* KYT40 JMP TO GENERATE LAST PART OF C KEY. H0401530 EJT 0 H0401531**** H0401532*E H0401533* ********** H0401534* * KEYFWA * H0401535* ********** H0401536* H0401537* H0401538* KEYFWA STORES THE RELATIVE WORD OFFSET OF A KEY INTO THE KEY TABLE. H0401539* THE CALLING SEQUENCE IS RTJ KEYFWA H0401540ÐÐ* (Q), (I)EXIT = (Q), (I)ENTRY H0401541* H0401542**** H0401543KEYFWA NUM 0 H0401544 LDA* KEYCOL (A) = STARTING COLUMN OF KEY. H0401545 INA -1 (A) = FCA OF KEY - FWA OF RECORD. H0401546 ARS 1 (A) = FWA OF KEY - FWA OF RECORD. H0401547 STA* (KEYPTR) STACK RELATIVE FWA OF KEY. H0401548 RAO* KEYPTR POINT TO NEXT FREE WORD OF KEY TABLE. H0401549 JMP* (KEYFWA) EXIT. H0401550 EJT 0 H0401551**** H0401552*E H0401553* ********** H0401554* * KRANGE * H0401555* ********** H0401556* H0401557* H0401558* KRANGE VERIFIES THAT KEY FIELD IS ENTIRELY WITHIN INPUT RECORD. H0401559* THE CALLING SEQUENCE IS (A) = FCA OF KEY FIELD H0401560* RTJ KRANGE H0401561* (I)EXIT = (I)ENTRY. H0401562**** H0401563 SPC 3 H0401564KRANGE NUM 0 H0401565ÐÐ SAZ KRNG10 SKIP IF KEY STARTS BEFORE BEGINNING OF RECORD H0401566 STA* COLUMN SAVE FCA H0401567 SUB* MAXLEN INPUT RECORD LENGTH IN CHARACTERS H0401568 INA -1 H0401569 SAP KRNG10 SKIP IF KEY STARTS AFTER END OF RECORD H0401570 ADD* KYCOLS H0401571 INA -1 H0401572 ENQ MSGKEB 'KEY FIELD EXTENDS BEYOND END OF RECORD' H0401573 SAP KRNG20 SKIP IF KEY FIELD EXTENDS BEYOND RECORD H0401574 LDA* COLUMN RESTORE FCA H0401575 JMP* (KRANGE) RETURN H0401576KRNG10 ENQ MSGSOK 'START OF KEY FIELD OUTSIDE OF RECORD' H0401577KRNG20 STQ* COLUMN SAVE ERROR MESSAGE NUMBER HERE H0401578 ENQ MSGINP H0401579 LDA SCL90 BUFFER ADDRESS FOR MESSAGE PROCESSOR H0401580 RTJ (SCDIA3+1) PRINTS INPUT DIRECTIVE CARD H0401581 LDQ* COLUMN ERROR MESSAGE NUMBER H0401582 JMP SCDIA5 REPORT THE ERROR THEN BOMB H0401583 SPC 3 H0401584COLUMN NUM 0 STARTING COLUMN ADDRESS H0401585MAXLEN NUM 0 INPUT RECORD LENGTH IN CHARACTERS H0401586 EJT 0 H0401587**** H0401588*E H0401589* ********** H0401590ÐÐ* * SELECT * H0401591* ********** H0401592* H0401593* H0401594* THE SELECT SUBROUTINE BUILDS THE YFIELD, YCOMPR, AND YSHIFT TABLES IN H0401595* SMCMON VARIABLE TABLE SPACE. THESE TABLES ARE USED TO SELECT OR H0401596* REJECT INPUT RECORDS BY COMPARING ONE KEY COMPARE FIELD WITHIN THE H0401597* RECORD WITH EITHER (1) A HOLLERITH CONSTANT OR (2) A SECOND KEY H0401598* COMPARE FIELD IN THE RECORD. IF A EBCDIC COLLATING SEQUENCE IS H0401599* SPECIFIED, THE ENTIRE RECORD AND THE HOLLERITH CONSTANT, IF USED, ARE H0401600* CONVERTED INTO A EBCDIC REPRESENTATION PRIOR TO COMPARING VALUES. IF H0401601* THE SECOND COMPARE FACTOR IS A FIELD WITHIN THE RECORD AND IF THE H0401602* STARTING COLUMN POSITION FOR BOTH KEYS IS NOT EVEN OR ODD, THE SHIFT H0401603* BUFFER (YSHIFT = FWA OF TABLE) MUST BE PROVIDE TO OFFSET ONE OF THE 2 H0401604* KEYS, SUCH THAT BOTH KEYS ARE ALIGNED THE SAME WITHIN THE HARDWARE H0401605* WORD STRUCTURE. THIS IS NECESSARY FOR THE KEY COMPARE PROCESSORS IN H0401606* SMCMON TO WORK PROPERLY. H0401607* THE COMPARISON OF KEY FIELD WITH KEY FIELD OR HOLLERITH CONSTANT IS H0401608* ABBREVIATED AS COMPARING ONE FACTOR WITH A SECOND FACTOR. INITIALLY H0401609* THE FIRST KEY FIELD SPECIFIED ON THE SL= CARD IS FACTOR 1. THE H0401610* HOLLERITH CONSTANT OR THE SECOND KEY FIELD INITIALLY IS FACTOR 2. H0401611* H0401612* THE COMPARE OPERATOR IS ASSIGN VALUES. THESE VALUES ARE: H0401613* H0401614* VALUE OPERATOR H0401615ÐÐ* ----- -------- H0401616* 0 EQ H0401617* 1 LT H0401618* 2 GT H0401619* 3 LE H0401620* 4 GE H0401621* 5 NE H0401622* H0401623* NOTICE THAT 5-VALUE RESULTS IN THE COMPLEMENT RELATIONSHIP. H0401624* EXAMPLE H0401625* H0401626* GE = 4, 5-4 = 1 = LT H0401627**** H0401628 EJT 0 H0401629**** H0401630*E H0401631* IF THE INCLUDE OPTION IS REPRESENTED BY I, THE OMIT OPTION BY 0, F1 H0401632* AS FACTOR 1 AND F2 AS FACTOR 2, THEN: H0401633* H0401634* O,F1,EQ,F2 BECOMES I,F1,NE,F2 H0401635* O,F1,LT,F2 BECOMES I,F1,GE,F2 H0401636* O,F1,GT,F2 BECOMES I,F1,LE,F2 H0401637* O,F1,LE,F2 BECOMES I,F1,GT,F2 H0401638* O,F1,GE,F2 BECOMES I,F1,LT,F2 H0401639* O,F1,NE,F2 BECOMES I,F1,EQ,F2 H0401640ÐÐ* H0401641* THUS ONCE THE OPERATOR IS CONVERTED TO A VALUE 0-5, THE COMPLEMENT H0401642* RELATIONSHIP IS KNOWN BY TAKING 5-VALUE. H0401643* H0401644* THE ABOVE MAPPING TAKES ONE FURTHER STEP: H0401645* H0401646* I,F1,EQ,F2 BECOMES I,F1,EQ,F2 H0401647* I,F1,LT,F2 BECOMES I,F1,LT,F2 H0401648* I,F1,GT,F2 BECOMES I,F1,GT,F2 H0401649* I,F1,LE,F2 BECOMES I,F2,GE,F1 H0401650* I,F1,GE,F2 BECOMES I,F2,LE,F1 H0401651* I,F1,NE,F2 BECOMES I,F2,NE,F1 H0401652* H0401653* WHEN FACTORS SWITCH,IE, F2 APPEARS TO LEFT OF OPERATOR AND F1 TO THE H0401654* RIGHT OF THE OPERATOR, F2 AND F1 ARE RELATED SUCH THAT LEFT OPERATOR H0401655* BECOMES F1 AND RIGHT OPERATOR BECOMES F2. H0401656* IF ORDER TO SELECT A WINNER FROM F1 AND F2 THE FOLLOWING RULES EXIST H0401657* FOR SPECIFING ASCENDING OR DECENDING SORT ORDER: H0401658* H0401659* IF COMPARISON IS LESS THAN: F1,LT,F2 USE ASCENDING ORDER FOR F1 TO H0401660* WIN. H0401661* IF COMPARISON IS GREATER THAN: F1,GT,F2 USE DESCENDING ORDER FOR F1 TOH0401662* WIN. H0401663* ASCENDING ORDER IS ALSO USED FOR LE, EQ, AND NE. H0401664**** H0401665ÐÐ EJT 0 H0401666**** H0401667*E H0401668* THE KEY COMPARE TABLE IS BUILT FOR FACTOR 1. THE SECOND FACTOR IS H0401669* MADE TO CONFORM TO THE KEY COMPARE PROCESSORS IN SMCMON. BASICALLY H0401670* THE SMCMON KEY PROCESSORS MUST KNOW THAT THE KEYS ARE WORD ALIGN AND H0401671* KNOW THE STARTING ADDRESS OF THE RECORD. THE STARTING ADDRESS OF H0401672* FACTOR 2 IS FAKED, IN ORDER TO MAKE THE RELATIVE WORD OFFSET IN H0401673* FACTOR 1 APPLY TO FACTOR 2. FACTOR 1 MAY BE A KEY FIELD IN THE RECORDH0401674* OR THE HOLLERITH CONSTANT. IF IT IS THE HOLLERITH CONSTANT, THE H0401675* HOLLERITH CONSTANT WAS OFFSET ONE CHARACTER TO THE LEFT, IF NECESSARY H0401676* TO ALIGN FACTOR 2 WITH FACTOR 1. THUS THE SHIFT BUFFER IS NEVER H0401677* NEEDED WHEN USING THE HOLLERITH CONSTANT. THE WORD OFFSET FOR THE H0401678* HOLLERITH CONSTANT WILL BE ZERO. THEREFORE THE OFFSET FOR FACTOR 2 H0401679* IS THE RELATIVE WORD OFFSET OF THE KEY COMPARE FIELD. NOTICE THAT H0401680* THE ACTUAL FWA OF THE RECORD IS NOT NOW KNOWN. THE RELATIVE OFFSET H0401681* IS ADDED TO THE FWA OF THE RECORD IN SUBROUTINE SELECT OF SMCMON AT H0401682* A TIME THAT THE FWA IS KNOWN. THE ADDRESS FORMED BY ADDING THE FWA H0401683* OF THE RECORD TO THE RELATIVE KEY OFFSET, POSITIONS THIS SECOND KEY H0401684* WITH A ZERO OFFSET, THE SAME AS FOR THE HOLLERITH CONSTANT. IF FACTORH0401685* 1 IS IN THE RECORD THEN FACTOR 2 CAN BE IN THE RECORD IF KEYS ARE H0401686* WORD ALIGNED, IN THE SHIFT BUFFER IF KEYS ARE NOT ALIGNED, OR IN THE H0401687* HOLLERITH CONSTANT BUFFER. SINCE THE COMPARE KEY TABLE BIASED FACTOR H0401688* 1 FROM THE BEGINNING OF THE RECORD, FACTOR 2 IS BIASED BY THE RELATIVEH0401689* RECORD OFFSET OF FACTOR 1. NOTICE THAT THIS BIAS FACTOR MAY BE H0401690ÐÐ* NEGATIVE. IF THE ACTUAL ADDRESS OF FACTOR 2 IS KNOWN, IE, THE SHIFT H0401691* BUFFER OR HOLLERITH CONSTANT BUFFER WILL BE USED, THEN THE ACTUAL H0401692* FWA FOR FACTOR 2 IN SMCMON COMPARE KEY PROCESSOR CAN BE DETERMINED. H0401693* OTHERWISE THE RELATIVE OFFSET MUST BE ADDED TO THE FIRST WORD ADDRESS H0401694* OF THE RECORD IN SMCMON SELECT ROUTINE. H0401695**** H0401696 EJT 0 H0401697**** H0401698*E H0401699* THE FORMAT FOR YFIELD TABLE IS: H0401700* H0401701* YFIELD ********************** H0401702* * CODE WORD * H0401703* * FACTOR 1 ADDRESS * H0401704* * FACTOR 2 ADDRESS * H0401705* * FACTOR 2 REL ADR * H0401706* * LENGTH OF KEY * H0401707* * HOLLERITH CONSTANT * H0401708* * . * H0401709* * . * H0401710* * . * H0401711* * END OF CONSTANT * H0401712* ********************** H0401713* H0401714* CODE WORD H0401715ÐÐ* --------- H0401716* BIT 15 = 0, INCLUDE ALL RECORDS H0401717* BIT 15 = 1, SELECT INPUT RECORDS FOR SORTING H0401718* BIT 14 = 0, KEY DOES NOT NEED SHIFTING H0401719* BIT 14 = 1, KEY NEEDS TO BE SHIFTED (ALIGNED WITH FACTOR 1) H0401720* BIT 13 = 0, KEY COMPARISON MUST BE EQUAL (EQ) H0401721* BIT 13 = 1, FACTOR 1 MUST BE LESS THAT (LT) OR GREATER THAN (GT) F2 H0401722* BIT 12 = 0, FACTOR 2 NOT IN RECORD. HOLLERITH CONSTANT OR SHIFT BUFFERH0401723* BIT 12 = 1, FACTOR 2 IS IN RECORD H0401724* BIT 11 = 0, OPERATOR IS NOT NOT EQUAL (NE) H0401725* BIT 11 = 1, OPERATOR IS NOT EQUAL (EQ) H0401726* BIT 10 = 0, OPERATOR IS NOT (LE) OR (GE) H0401727* BIT 10 = 1, OPERATOR IS (LE) OR (GE) H0401728* H0401729* FACTOR 1 ADDRESS = 0 IF FACTOR 1 IN RECORD. (FLAG TO USE FWA OF REC.) H0401730* FACTOR 1 ADDRESS # 0, THEN VALUE IS ADDRESS OF HOLLERITH CONSTANT H0401731* FACTOR 2 ADDRESS = RELATIVE OFFSET FROM FWA OF RECORD TO STARTING H0401732* ADDRESS FOR KEY COMPARE. H0401733* = ACTUAL ADDRESS FOR FACTOR 2 KEY COMPARE. H0401734* H0401735* FACTOR 2 REL ADR = WORD OFFSET FROM START OF RECORD TO FACTOR 2. USE H0401736* TO MOVE KEY TO SHIFT BUFFER H0401737* H0401738* LENGTH OF KEY = LENGTH IN CHARACTERS OF KEY FIELD. VALUE WILL BE H0401739* NEGATIVE IF KEY TO BE MOVED IS WORD ALIGNED. H0401740ÐÐ* H0401741* HOLLERITH CONSTANT = 1 TO 20 CHARACTERS THAT IS CONVERTED TO EBCDIC H0401742* IF EBCDIC COLLATING SPECIFIED, AND OFFSET ONE H0401743* CHARACTER IF KEY IN RECORD NOT WORD ALIGNED. THISH0401744* FIELD WILL NOT BE PROVIDED IF THE HOLLERITH H0401745* CONSTANT OPTION IS NOT SELECTED. H0401746**** H0401747 EJT 0 H0401748**** H0401749*E H0401750* THE FORMAT FOR THE YCOMPR TABLE IS: H0401751* H0401752* YCOMPR ************************ H0401753* * REL WORD OFFSET * H0401754* * KEY COMPARE PROCESSOR* H0401755* * LCA+1 OF WORD BLOCK * H0401756* * . * FORMAT SAME AS YKEY TABLE. THIS H0401757* * . * TABLE DESCRIBES ONLY ONE KEY H0401758* * . * FIELD H0401759* * REL WORD OFFSET * H0401760* * KEY COMPARE PROCESSOR* H0401761* * - 0 * H0401762* ************************ H0401763* H0401764* THE FORMAT FOR THE YSHIFT TABLE IS: H0401765ÐÐ* H0401766* YSHIFT ******************** H0401767* * SHIFT BUFFER FOR * H0401768* * FACTOR 2 * H0401769* ******************** H0401770* H0401771* THE SELECT SUBROUTINE IN SMCMON MOVES FACTOR 2 KEY WITHIN THE RECORD H0401772* TO THE SHIFT BUFFER. THE KEY IS OFFSET ONE CHARACTER POSITION DURING H0401773* THE MOVE. H0401774* H0401775* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF SMCMON FIXED TABLE H0401776* RTJ SELECT H0401777* (I)EXIT = (I)ENTRY H0401778* H0401779**** H0401780 EJT 0 H0401781SELECT NUM 0 H0401782SEL00 LDQ =XMSGE17-HERE (Q) = FWA OF ERROR MESSAGE WE MIGHT USE H0401783 RTJ PRENAM CHECK FOR PROPER CARD IDENTIFIER H0401784SEL10 LDQ =XMSGE10-HERE (Q) = FWA OF ERROR MESSAGE WE MIGHT USE H0401785 RTJ PREFIX LOOK FOR LEADING CHARACTER OF ALPHA FIELD H0401786 INA -$4F LOOK FOR 'O' H0401787 SAZ SEL30 SKIP IF OMIT OPTION H0401788 INA -$49+$4F LOOK FOR 'I' H0401789 SAZ SEL20 SKIP IF INCLUDE OPTION H0401790ÐÐ JMP* SEL120 REPORT THE ERROR H0401791SEL20 ENA 1 INDICATE RECORD INCLUDE OPTION REQUESTED H0401792SEL30 EOR- YFLAG,I MASK IN OTHER OPTIONS H0401793 ALS 15-3 LEFT JUSTIFY FLAG WORD H0401794 STA- YFLAG,I H0401795 ALS 15-12 H0401796 SAP SEL40 SKIP IF OMIT OPTION SELECTED H0401797 LDA BYTBIN CHECK FOR 'I' ONLY OPTION H0401798 INA -$20 LOOK FOR BLANK SEPARATOR H0401799 SAN SEL40 SKIP IF MORE INFO H0401800 LDQ- YFIELD,I H0401801 STA- (ZERO),Q INDICATE 'I' ONLY OPTION SELECTED H0401802 LDA- YFIELD,I SET END OF VARIABLE LENGTH TABLES H0401803 INA 1 H0401804 JMP SEL350 H0401805SEL40 LDQ =XMSGE08-HERE (Q) = FWA OF ERROR MESSAGE WE MIGHT USE H0401806 RTJ POSNUM LOOK FOR KEYCOL H0401807 STA* KYCOL1 REMEMBER STARTING COLUMN OF KEY H0401808 STA KEYCOL STARTING COLUMN H0401809SEL50 LDQ =XMSGE09-HERE (Q) = FWA OF ERROR MESSAGE WE MIGHT USE H0401810 RTJ COMPOS LOOK FOR COMMA THEN KEYCOLS H0401811 STA KYCOLS REMEMBER NO. OF COLUMNS IN KEY H0401812 TCA A INDICATED FIELD ON WORD BOUNDARY H0401813 STA* SEL236 H0401814 LDA KEYCOL STARTING COLUMN H0401815ÐÐ RTJ KRANGE VERIFY KEY FIELD WITHIN RECORD H0401816SEL60 LDQ =XMSGE11-HERE (Q) = FWA OF ERROR MESSAGE WE MIGHT USE H0401817 RTJ COMALF LOOK FOR EQUALITY OPTION H0401818 STA* OP H0401819 LDQ* SEL60+1 (Q) = FWA OF ERROR MESSAGE WE MIGHT USE H0401820 RTJ ALPHA PICK UP SECOND CHARACTER H0401821 LDQ* OP LEFT CHARACTER H0401822 INA -$45 LOOK FOR 'E' H0401823 SAN SEL90 SKIP IF SECOND CHARACTER NOT E H0401824 INQ -$4C LOOK FOR 'L' H0401825 SQZ SEL80 SKIP IF 'L' H0401826 INQ -$47+$4C LOOK FOR 'G' H0401827 SQZ SEL70 SKIP IF 'G' H0401828 INQ -$4E+$47 LOOK FOR 'N' H0401829 SQN SEL110 REPORT ERROR (LEFT CHARACTER BAD) H0401830 RAO* EQUVAL NE, EQUVAL = 5 H0401831SEL70 RAO* EQUVAL GE, EQUVAL = 4 H0401832SEL80 RAO* EQUVAL LE, EQUVAL = 3 H0401833 JMP* SEL130 CONTINUE TO BUILD EQUALITY CODE H0401834SEL90 INA -$51+$45 LOOK FOR 'Q' H0401835 SAN SEL100 SKIP IF NOT 'Q' H0401836 INQ -$45 LOOK FOR 'E' H0401837 SQZ SEL150 SKIP IF 'E' H0401838 JMP* SEL110 REPORT ERROR (LEFT CHARACTER BAD) H0401839SEL100 INA -$54+$51 LOOK FOR 'T' H0401840ÐÐ SAN SEL120 SKIP IF NOT VALID CHARACTER (RIGHT CHAR BAD) H0401841 INQ -$4C LOOK FOR 'L' H0401842 SQZ SEL140 SKIP IF 'L' H0401843 INQ -$47+$4C LOOK FOR 'G' H0401844 SQZ SEL130 SKIP IF 'G' H0401845SEL110 LDQ* OP LEFT CHARACTER BAD H0401846 ADQ- HX2000 H0401847 STQ REPLY RESET REPLY IN MSGEXP H0401848SEL120 JMP ALFERR REPORT INPUT ERROR H0401849SEL130 RAO* EQUVAL GT, EQUVAL = 2 H0401850SEL140 RAO* EQUVAL LT, EQUVAL = 1 H0401851SEL150 RTJ COMMA EQ, EQUVAL = 0 H0401852 LDA- YFIELD,I H0401853 INA 5 ALLOW FOR HEADER PART OF TABLE H0401854 STA* KEYWRD H0401855 STA HOLADR (A) = FWA OF POSSIBLE HOLLERITH FIELD H0401856 LDQ* SEL40+1 (Q) = FWA OF ERROR MSG. WE MIGHT USE 123*4896H0401857 STQ BIGQSV OVRFLW MAY REPORT ERROR H0401858 RTJ TOKEN LOOK FOR SECOND DESCRIPTOR H0401859 JMP* SEL160 ALPHA EXIT - LOOK FOR HOLLERITH CONSTANT H0401860 RTJ OVRFLW COMBINE BOTH (A) AND (Q) IF NECESSARY H0401861 RTJ KRANGE VERIFY KEY FIELD WITHIN RECORD H0401862 JMP* SEL240 SAVE START OF SECOND FIELD H0401863 SPC 3 H0401864CHRCNT NUM 0 COUNT OF CHARACTERS IN HOLLERITH STRING H0401865ÐÐEQUVAL NUM 0 0-EQ, 1-LT, 2-GT, 3-LE, 4-GE, 5-NE H0401866KEYWRD NUM 0 WORD POSITION WITHIN KEY COMPARE TABLE H0401867KYCOL1 NUM 0 STARTING COLUMN OF 1ST FACTOR H0401868OP NUM 0 FIRST CHARACTER OF EQUALITY OPERATOR H0401869 SPC 3 H0401870SEL160 STA DELMIT CHANGE DELIMITOR CHARACTER H0401871 INA -$27 LOOK FOR ' H0401872 SAZ SEL180 SKIP IF ' FOUND H0401873 JMP* SEL210 ANNOUNCE ERROR AND QUIT H0401874SEL180 RTJ NXTCHR FETCH CHARACTER H0401875 SAM SEL200 SKIP IF END OF HOLLERITH FIELD H0401876 ALS 8 LEFT CHARACTER H0401877 STA* (KEYWRD) H0401878 RAO* CHRCNT COUNT ACTUAL CHARACTERS IN HOLLERITH FIELD H0401879 LDA* CHRCNT DETERMINE HOW MANY CHARACTERS HAVE BEEN SAVED H0401880 INA -21 H0401881 SAP SEL210 SKIP IF MORE THAN 20 CHARACTERS (10 WORDS) H0401882 RTJ NXTCHR FETCH RIGHT CHARACTER H0401883 SAM SEL190 SKIP IF END OF HOLLERITH FIELD H0401884 EOR* (KEYWRD) H0401885 STA* (KEYWRD) COMBINE CHARACTERS INTO WORD H0401886 RAO* CHRCNT COUNT ACTUAL CHARACTERS IN HOLLERITH FIELD H0401887 RAO* KEYWRD ADVANCE TO NEXT WORD H0401888 JMP* SEL180 CONTINUE LOOKING FOR HOLLERITH CHARACTERS H0401889SEL190 RAO* KEYWRD POSITION TO START OF KEY COMPARE H0401890ÐÐSEL200 LDA* CHRCNT H0401891 EOR KYCOLS H0401892 SAZ SEL220 SKIP IF RIGHT CHARACTER COUNT SPECIFIED H0401893SEL210 LDQ =XMSGE12-HERE H0401894 JMP SCDIAG ANNOUNCE ERROR THEN QUIT H0401895SEL220 LDQ* CHRCNT H0401896 INQ 1 ROUND UP FOR POSSIBLE ODD COLUMN COUNT H0401897 QRS 1 CONVERT TO WORD COUNT - ASCII TO EBCDIC H0401898 LDA* HOLADR (A) = FWA OF HOLLERITH CONSTANT H0401899* INIT REPLACES PLUG BELOW WITH FWA OF COLSEQ H0401900SEL230 RTJ+ PLUG DETERMINE IF ALTERNATE COLLATING SEQ NEED H0401901 LDQ* KYCOL1 H0401902 QLS 15 H0401903 ENA 1 (A) = PRESET IF KEY ON WORD BOUNDARY H0401904 SQM SEL238 SKIP IF BOTH FIELD FACTORS ON WORD BOUNDARY H0401905 LDA* HOLADR (A) = FWA OF HOLLERITH FIELD H0401906 TRA Q (Q) = FWA OF SHIFTED HOLLERITH FIELD H0401907* INIT REPLACES PLUG BELOW WITH FWA MVCHRS H0401908SEL234 RTJ+ PLUG OFFSET HOLLERITH FIELD ONE CHARACTER H0401909SEL236 ADC KYCOLS ACTUAL FIELD SIZE IN CHARACTERS H0401910 LDA* CHRCNT H0401911 AND- HX0001 H0401912 SAN SEL237 SKIP IF ODD CHARACTER COUNT - (A) = 1 H0401913 RAO* KEYWRD INDICATE EXTRA WORD NEEDED FOR HOLLERITH FIELDH0401914SEL237 ENA 2 STARTING CHARACTER POSITION OF HOLLERITH FIELDH0401915ÐÐSEL238 RAO* HOLFAC FLAG FACT THAT HOLLERITH FIELD USED H0401916SEL240 STA* KYCOL2 H0401917 ADD* KYCOL1 H0401918 AND- HX0001 IF BIT 0 IS 0 BOTH FIELDS WORD ALIGNED H0401919 ALS 14 H0401920 STA* EVNODD IF BIT 14 IS ZERO BOTH FIELDS START IN THE H0401921* SAME CHARACTER POSITION OF THE WORD H0401922 LDA* KEYWRD H0401923 STA- YCOMPR,I H0401924 STA KEYPTR SAY THERE IS NOTHING IN KEY COMPARE TABLE YET H0401925 LDA- YFLAG,I CHECK FOR OMIT/INCLUDE SELECTION H0401926 ALS 15-12 H0401927 SAM SEL250 SKIP IF INCLUDE FIELD SELECTED H0401928 ENA 5 H0401929 SUB* EQUVAL ESTABLISH COMPLEMENT CONDITION H0401930 STA* EQUVAL H0401931SEL250 LDA* EQUVAL SEE IF 2 CONDITIONS SHOULD BE REDUCED TO H0401932 SAZ SEL254 SKIP IF TIE EXPECTED H0401933 INA -3 ONE CONDITION IE, GE TO LT, LE TO GT H0401934 SAP SEL256 SKIP IF TESTING FOR NE,GE,LE H0401935 LDA- HX2000 EXPECT LT OR GT H0401936SEL254 JMP* SEL262 H0401937SEL256 LDA* KYCOL2 SWITCH FACTOR 1 AND FACTOR 2 AROUND H0401938 STA KEYCOL H0401939 LDQ* KYCOL1 H0401940ÐÐ STA* KYCOL1 H0401941 STQ* KYCOL2 H0401942 LDA* HOLFAC IF HOLLERITH FIELD INDICATE FACTORS SWITCHED H0401943 ALS 1 H0401944 STA* HOLFAC H0401945 ENA 5 INVERT ORDER FOR OPTION H0401946 SUB* EQUVAL H0401947 STA* EQUVAL H0401948 SAN SEL260 SKIP IF .NE. REQUEST NOT SELECTED H0401949 LDA- HX0800 .NE. RECORD COMPARISON BIT H0401950 JMP* SEL262 H0401951SEL260 LDA- HX0400 ALLOW TIES TO BE ACCEPTED H0401952SEL262 LDQ* EVNODD H0401953 EAQ A H0401954 SQN SEL264 SKIP IF SHIFT COUNT REQUIRED H0401955 LDQ* HOLFAC H0401956 INQ -1 H0401957 SQZ SEL264 SKIP IF FACTOR 2 HOLLERITH H0401958 EOR- HX1000 FACTOR 2 IS IN RECORD H0401959SEL264 EOR- HX8000 INDICATE RECORD SELECTION REQUIRED H0401960 LDQ- YFIELD,I H0401961 STA- (ZERO),Q SAVE FLAGS IN CODE WORD H0401962 LDA* KYCOL2 (A) = STARTING COLUMN OF KEY H0401963 INA -1 (A) = FCA OF KEY - FWA OF RECORD H0401964 ARS 1 (A) = FWA OF KEY - FWA OF RECORD H0401965ÐÐ STA- 3,Q H0401966 LDA* EQUVAL H0401967 SAZ SEL270 SKIP IF EQUAL OPTION SELECT H0401968 INA -1 H0401969SEL270 STA KEYLPT EQ,LT ASCENDING ORDER, GT DESCENDING ORDER H0401970 JMP* SEL280 H0401971EVNODD NUM 0 BIT 0 = 0, BOTH KEY FIELDS ALIGNED THE SAME H0401972FAC1 NUM 0 TEMP SAVE FACTOR 1 ADDRESS H0401973HOLADR NUM 0 FWA OF HOLLERITH FIELD H0401974HOLFAC NUM 0 HOLLERITH FACTOR H0401975KYCOL2 NUM 0 STARTING COLUMN OF 2ND FACTOR H0401976SEL280 RTJ KEYTBL BUILD KEY COMPARE TABLE ENTRY(S) H0401977 ENA -0 H0401978 STA (KEYPTR) TERMINATE TABLE H0401979 LDA KEYPTR H0401980 INA 1 H0401981 STA- YSHIFT,I START OF SHIFT TABLE (IF NEEDED) H0401982 STA- YEND,I SAVE LWA + 1 OF VARIABLE TABLES IF NO SHIFT BFH0401983 LDQ* HOLFAC H0401984 INQ -2 H0401985 SQN SEL300 SKIP IF FACTOR 1 NOT HOLLERITH FIELD H0401986* SINCE HOLLERITH FIELD USES REL OFFSET OF FACTOR 1 AS ZERO WORDS, THE H0401987* RELATVE OFFSET OF FACTOR 2 MUST ALSO BE ZERO FOR CMPKEY ROUTINE. THUS H0401988* THE FWA OF FACTOR 2 RECORD POSITION MUST BE ADJUSTED FOR THIS FACT. H0401989* THE RELATIVE WORD OFFSET MUST BE PROVIDED SINCE ACTUAL FWA OF RECORD H0401990ÐÐ* IS NOT KNOWN. H0401991 LDQ- YFIELD,I H0401992 LDA- 3,Q REL WORD OFFSET FOR FACTOR 2 H0401993 LDQ* HOLADR (Q) = FWA OF FACTOR H0401994 JMP* SEL330 H0401995* FACTOR 1 COMPARE KEY IS IN RECORD AND IS BIASED FROM START OF RECORD. H0401996* THE 1ST WORD OF THE KEY COMPARE TABLE HAS THIS BIAS NUMBER. FACTOR 2 H0401997* MAY BE HOLLERITH FIELD, IN RECORD, OR IN SHIFT BUFFER. EACH LOCATION H0401998* MUST BE NEGATIVE BIAS BY FACTOR 1 FOR CMPKEY ROUTINE. H0401999SEL300 INQ -1+2 LOOK FOR FACTOR 2 BEING HOLLERITH FIELD H0402000 LDA* HOLADR (A) = FWA OF HOLLERITH FIELD H0402001 SQZ SEL310 SKIP IF FACTOR 2 IS HOLLERITH FIELD H0402002 LDQ- YFIELD,I H0402003 LDQ- (ZERO),Q FLAG CODE WORD H0402004 QLS 15-12 LOOK FOR FACTOR 2 IN THE RECORD H0402005 LDA* KYCOL2 H0402006 SUB KYCOL1 (A) = DIFFERENCE EVEN SINCE BOTH KEYS IN REC. H0402007 ARS 1 (A) = WORD DIFFERENCE H0402008 SQM SEL320 SKIP IF IN RECORD FACTOR 2 H0402009 LDA- YSHIFT,I (A) = FWA OF SHIFT BUFFER H0402010SEL310 LDQ- YCOMPR,I H0402011 SUB- (ZERO),Q FACTOR 1 BIAS H0402012SEL320 CLR Q INDICATE FACTOR 1 IN RECORD H0402013SEL330 STQ* FAC1 H0402014 LDQ- YFIELD,I H0402015ÐÐ STA- 2,Q FACTOR 2 ADDRESS H0402016 LDA* FAC1 H0402017 STA- 1,Q FACTOR 1 ADDRESS H0402018 LDQ* EVNODD H0402019 SQZ SEL360 SKIP IF BOTH KEYS START IN SAME WORD POSITION H0402020 LDQ* KYCOL2 H0402021 QLS 15 H0402022 LDA SEL236 - KYCOLS (EVEN WORD BOUNDARY) H0402023 SQM SEL340 SKIP IF FACTOR 2 COMPARE KEY ON WORD BOUNDARY H0402024 TCA A KYCOLS (FACTOR 2 ON ODD WORD BOUNDARY) H0402025SEL340 LDQ- YFIELD,I H0402026 STA- 4,Q SAVE NO. OF CHARACTERS TO MOVE TO SHIFT BUFFERH0402027 SAP SEL345 SKIP IF KYCOLS IS POSITIVE H0402028 TCA A KYCOLS H0402029SEL345 INA 1+2 ROUND UP AND ALLOW FOR EXTRA OFF-SHIFTED WORD H0402030 ARS 1 CONVERT TO WORDS H0402031 ADD- YSHIFT,I H0402032SEL350 STA- YEND,I SAVE LWA + 1 OF VARIABLE TABLES H0402033SEL360 JMP (SELECT) RETURN H0402034 EJT 0 H0402035**** H0402036*E H0402037* ******* H0402038* * MEM * H0402039* ******* H0402040ÐÐ* H0402041* H0402042* THE MEM SUBROUTINE COMPUTES THE AMOUNT OF CORE SPACE THAT CAN BE H0402043* RESERVED FOR INPUT AND OUTPUT RECORD BLOCKING. THIS SPACE IS USED BY H0402044* OVERLAYS SMCSRT, SMCIMG, AND SMCFMG. IN ADDITION THE SIZE OF EACH H0402045* WORK FILE IS COMPUTED. H0402046* TO DESCRIBE THE CORE SPACE FOR INPUT AND OUTPUT BLOCKING THE FOLLOWINGH0402047* EQUATIONS ARE SOLVED BASED UPON THE INTERNAL STRUCTURE OF DSORT H0402048* OVERLAYS. H0402049* H0402050* LET: H0402051* M = MEMORY SPACE FROM END OF VARIABLE TABLES NEEDED TO END OF DSORT H0402052* S = SIZE OF SMCSRT OVERLAY (RESIDENT CODE ONLY) H0402053* N = INPUT RECORD BLOCKING SIZE H0402054* W = WORK BLOCK SIZE H0402055* I = SIZE OF SMCIMG OVERLAY (RESIDENT CODE ONLY) H0402056* F = SIZE OF SMCFMG OVERLAY (RESIDENT CODE ONLY) H0402057* R = SORT RECORD LENGTH H0402058* B = OUTPUT BUFFER ELNGTH H0402059* T = FILE MANAGER OUTPUT RECORD LENGTH (INCLUDES 2 WORDS FOR EOF) H0402060* Z = SIZE OF FILE TABLE FOR EACH INPUT FILE H0402061* X = MAXIMUM FILE COUNT FOR MERGING H0402062* TO MAKE THE CALCULATIONS EASIER: W = N + 2 H0402063* H0402064* THE FILE MANAGER OUTPUT REC. LENGTH: T = B + 2 H0402065ÐÐ* H0402066* THE NUMBER OF MERGE STRINGS: X = (M-I-W)/(4+Z+N) = (M-I-N-2)/(4+Z+N) H0402067* H0402068* SOLVING FOR INPUT REC BLOCKING: N = (M-I-2-X(4+Z))/(X+1) H0402069* M, I, X, AND Z ARE KNOWN. H0402070* H0402071* ALSO THE NO. OF MERGE STRINGS: X = (M-F-T)/(4+Z+N) H0402072* H0402073* BECOMES: M-F-B-2 = X(4+Z+N) H0402074* H0402075* FROM FIRST EQUATION FOR MERGE STRINGS: M-I-N-2 = X(4+Z+N) H0402076* H0402077* WE FIND: N-I-N-2-M+F+B+2 = 0 H0402078* H0402079* OR F-I-N+B = 0 H0402080* H0402081* OR B = N+I-F H0402082* H0402083* FINALLY T = N+(I-F)+2 THE FINAL OUTPUT BLOCKING IS A FACTOR OF H0402084* OF SIZE OF SMCIMG AND SMCFMG. H0402085* H0402086* THE NUMBER OF RECORD BINS FOR SORTING IS: G = (M-S-N-W)/(R+2) H0402087**** H0402088 EJT 0 H0402089**** H0402090ÐÐ*E H0402091* NOTICE THAT ALL FACTORS ARE KNOWN FOR G AND BASICALLY THE RECORD H0402092* SIZE DETERMINES THE NUMBER OF RECORD BINS FOR SORTING. H0402093* H0402094* THE FILE MANAGER 2.0 SYSTEM REQUIRES THAT THE NUMBER OF RECORDS TO BE H0402095* STORED INTO A FILE BE KNOWN AT CREATE TIME. IN THEORY, DSORT WOULD H0402096* LIKE TO STORE AS MANY SORTED RECORDS AS POSSIBLE TO AN OUTPUT WORK H0402097* FILE. TO DO THIS, THE WORK FILE WOULD NEED TO BE AS LARGE AS THE H0402098* REMAINING OUTPUT RECORDS NOT YET READ. THE TOTAL INPUT RECORD COUNT H0402099* IS KNOWN SINCE SMCEDT OPENS EACH INPUT FILE AND ACCUMULATES THE RECORDH0402100* COUNT FROM THE FILE MANAGER FCB TABLE. HOWEVER, IN PRACTICE, THE H0402101* WORK FILES WOULD LIKELY BE VERY SHORT AND THE SPACE UNUSED IN THE H0402102* WORK FILE WOULD BE VERY LARGE. SINCE THIS WOULD BE A VERY INEFFICENT H0402103* WAY OF OPERATING, DSORT DOES NOT USE THIS APPROACH. SINCE DSORTS IS H0402104* ABLE TO HOLD G RECORDS FOR SORTING (SEE EQUATIONS ABOVE), THE AVERAGE H0402105* NUMBER OF RECORDS THAT WOULD REMAIN IN SORT SEQUENCE FOR A WORK FILE H0402106* IS 2G. THIS IS THE SIZE EACH WORK FILE IS CREATED. A SEQUENCE FILE H0402107* KEEPS TRACK OF ALL OF THE WORK FILES (MERGE STRINGS) THAT MAY BE H0402108* CREATED. THE SIZE OF THIS FILE NEEDS TO BE KNOWN AHEAD OF TIME ALSO. H0402109* IT IS POSSIBLE THAT A NOW WORK FILE NEEDS TO BE CREATED AFTER STORING H0402110* G RECORDS. THIS FACTOR IS USED TO DETERMINE MAXIMUM RECORD COUNT IN H0402111* THE SEQUENCE FILE. H0402112* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF SMCMON FIXED TABLE H0402113* RTJ MEM H0402114* (I)EXIT = (I)ENTRY H0402115ÐÐ* H0402116**** H0402117MEM NUM 0 H0402118* COMPUTE HOW MUCH CORE AN OVERLAY MAY HAVE. H0402119 LDA* OPNCNT DETERMINE MAX MERGE COUNT H0402120 INA -4 ALLOW FOR SEQ.,OUTPUT, MESSAGE, AND PROCEDURE H0402121* FILES H0402122 STA- YIWAY,I H0402123 STA- YFWAY,I H0402124 INA 1 H0402125 STA* DIVISR TEMP SAVE DIVISOR H0402126 ENA FTSIZE+1+2+1 FILE SPACE NEEDED BY EACH INPUT FILE H0402127 MUI- YIWAY,I USE MAXIMUM MERGE FILE COUNT H0402128 TCA Q H0402129 LDA- YHICOR,I (A) = 1 + MAXIMUM AVAILABLE ADDRESS H0402130 SUB- YADRBF,I SUBTRACT 1 + LWA OF NEEDED VARIABLE TABLES H0402131 INA -2-2 ALLOW FOR END OF FILE WORDS F.M. NEEDS H0402132* AND FOR REL RECORD NUMBERS THAT ARE STORED H0402133 AAQ A H0402134 SUB- YIMGSZ,I H0402135 CLR Q H0402136 DVI* DIVISR (A) = MAX POSSIBLE WORKSIZ AND INPUT BLKSIZ H0402137 STA- YMAXIB,I H0402138 INA 2 ALLOW FOR EOF WORDS H0402139 STA- YWKBSZ,I WORK SIZE H0402140ÐÐ INA -2 MAX BLOCKING FOR INPUT/WORKSIZ H0402141 ADD- YIMGSZ,I H0402142 SUB- YFMGSZ,I (A) = MAXIMUM OUTPUT BLOCKING H0402143 LDQ- YOFRL,I OUTPUT RECORD LENGTH (CHARS) H0402144 INQ 1 ROUND UP H0402145 QRS 1 H0402146 STQ* DIVISR NUMBER OF WORDS FOR FINAL OUTPUT RECORD H0402147 CLR Q H0402148 DVI* DIVISR H0402149 MUI* DIVISR H0402150 INA 2 ALLOW FOR EOF WORDS H0402151 STA- YOFT+BUFLTH,I H0402152* ADD BUFFER LENGTH TO ALL INPUT FILE TABLES H0402153 LDQ- YIFTAD,I START OF ALL INPUT FILE TABLES H0402154MEM10 LDA- YMAXIB,I MAXIMUM BLOCKING IN WORDS H0402155 STA- BUFLTH,Q H0402156 INQ BUFWA POSITION TO START OF NEXT INPUT TABLE H0402157 TRQ A H0402158 EOR- YADOUT,I H0402159 SAZ MEM20 SKIP IF ALL INPUT FILE TABLES HAD BUFLTH ADDEDH0402160 JMP* MEM10 H0402161* COMPUTE NO. OF WORDS OF CORE AVAILABLE TO THE TOURNAMENT. H0402162MEM20 LDA RECSIZ CHECK FOR MAXIMUM LENGTH RECORD H0402163 SUB- YOFT+RECLTH,I H0402164 SAP MEM24 SKIP IF INPUT RECORD LENGTH GREATER H0402165ÐÐ CLR A ADDROUT RECORD > INPUT RECORD SIZE H0402166MEM24 ADD- YOFT+RECLTH,I (A) = MAX RECORD LENGTH H0402167 SUB- YMAXIB,I WILL RECORD FIT IN RECORD BLOCK? H0402168 SAZ MEM26 SKIP IF IT FITS H0402169 SAP MEM28 SKIP IF IT DOES NOT FIT H0402170MEM26 LDA- YHICOR,I (A) = 1 + MAXIMUM AVAILABLE ADDRESS H0402171 SUB- YEND,I SUBTRACT 1 + LWA OF VARIABLE TABLES H0402172 SUB- YSRTSZ,I SUBTRACT SIZE OF INTERNAL SORT LOGIC. H0402173 SUB- YMAXIB,I SUBTRACT SIZE OF INPUT BUFFER. H0402174 SUB- YWKBSZ,I SUBTRACT SIZE OF WORK BLOCK SIZE. H0402175* NOW (A) = NO. OF WORDS OF CORE AVAILABLE TO THE SORT TOURNAMENT. H0402176 SAP MEM30 SKIP IF BALANCE NOT YET OVERDRAWN. H0402177MEM28 JMP* (MEM) TAKE P+1(BAD) EXIT. H0402178DIVISR NUM 0 DIVISOR H0402179* COMPUTE G. H0402180MEM30 LDQ- YOFT+RECLTH,I (Q) = BINSIZ. H0402181 RTJ* DETG (A) = G. H0402182 STA- YG,I SAVE G. H0402183 INA -1 (A)15=1 IF G IS TOO SMALL. H0402184 SAM MEM40 SKIP IF G NOT OK H0402185* DEFINE MAXIMUM NUMBER OF RECORDS FOR SEQUENTIAL DIRECTORY H0402186 SOV 0 CLEAR OVERFLOW INDICATOR H0402187 LDQ- YRECNT,I H0402188 LDA- YRECNT+1,I H0402189 LLS 1 DOUBLE COUNT FOR PYRAMID MERGE FILE COUNT H0402190ÐÐ DVI- YG,I MOST MERGE STRINGS (INPUT REC COUNT/G) H0402191 SOV MEM40 SKIP IF FILE COUNT TOO LARGE H0402192 STA- YRECNT+1,I LEAST SIGNIFICANT PART OF REC COUNT/FILE H0402193 RAO- YRECNT+1,I ROUND UP IN CASE DIVISION HAS REMAINDER H0402194* DETERMINE IF MERGE FILE COUNT AFTER 1ST SORT > 1024 H0402195 ARS 10+2 IF ABOVE LLS 1 WAS LRS 1, THEN (A) = LEAST H0402196* MERGE STRINGS (REC FILLS FILES: 2*G) H0402197 SAN MEM40 SKIP IF FILE COUNT EXCEEDS MAX FILE COUNT 1024H0402198 STA- YRECNT,I H0402199 RAO* MEM SET UP P+2 (GOOD) EXIT H0402200MEM40 JMP* (MEM) TAKE P+1(BAD) EXIT. H0402201 SPC 3 H0402202OPNCNT ADC FMMOSU MAX NO. OF OPEN SEQ. FILES/ USER H0402203 EJT H0402204**** H0402205*E H0402206* ******** H0402207* * DETG * H0402208* ******** H0402209* H0402210* H0402211* THE DETG SUBROUTINE DETERMINES THE MAXIMUM NUMBER OF RECORD BINS IN H0402212* OVERLAY SMCSRT FOR SORTING. H0402213*THE CALLING SEQUENCE IS (A)ENTRY = NO. OF WORDS AVAILABLE. H0402214* (Q)ENTRY = BIN SIZE IN WORDS. H0402215ÐÐ* RTJ DETG H0402216* (A)EXIT = G. H0402217**** H0402218DETG NUM 0 H0402219 INQ 2 ALLOW 1 WORD FOR SEQ. NO. AND 1 WORD FOR TAG. H0402220 STQ* DETGQ (Q) = SIZE, IN WORDS, OF BIN+SEQ.NO.+TAG. H0402221 CLR Q PREPARE FOR DIVIDE. H0402222 DVI* DETGQ (A) = (AREA+TAG)/(BIN+SEQ.NO.+TAG). H0402223*AT THIS POINT, (A)=G IF (A) IS EVEN. H0402224*IF (A) IS ODD, (A)=G IF (Q) .GE. SIZE, IN WORDS, OF SEQ.NO.+TAG, H0402225*ELSE (A)=G+1. H0402226 STA* DETGG SAVE TENTATIVE VALUE OF G. H0402227 ALS 15 (A)15=1 IF G IS ODD. H0402228 SAP DETGX SKIP IF G IS EVEN AND DETGG IS OK. H0402229*IF (Q) .GE. NO. WORDS IN SEQ.NO.+TAG, THEN G IS ODD AND DETGG IS OK. H0402230 INQ -2 ALLOW FOR EXTRA SEQ. NO. AND TAG. H0402231 SQP DETGX SKIP IF G IS ODD AND DETGG IS OK. H0402232*G IS EVEN. G = -1+(DETGG). H0402233 LDA* DETGG REDUCE (DETGG) BY 1. H0402234 INA -1 H0402235 STA* DETGG H0402236DETGX LDA* DETGG (A) = G. H0402237 JMP* (DETG) EXIT. H0402238DETGQ NUM 0 () = (Q)ENTRY = NO. WORDS IN BIN+SEQ.NO.+TAG. H0402239DETGG NUM 0 () = G. H0402240ÐÐ EJT H0402241**** H0402242*E H0402243* ******** H0402244* * MOVE * H0402245* ******** H0402246* H0402247* H0402248* MOVE RIGHT TO LEFT. H0402249* MOVE MUST BE FAST. DURING A SINGLE SORT RUN, MOVE MOVES EACH BYTE OF H0402250* EACH LOGICAL RECORD SEVERAL TIMES, DESPITE THE FACT THAT THE NUMBER OFH0402251* SUCH MOVES IS REDUCED BY MOVING POINTERS INSTEAD OF LOGICAL RECORDS, H0402252* WHENEVER POSSIBLE. H0402253* WORD-TIMES = 4 + 9 * WORDS-TO-MOVE, E.G. 364 = F(80 BYTES), 4 = F(0). H0402254* THE CALLING SEQUENCE IS (MVSRCE)ENTRY = FWA OF SOURCE. H0402255* (MVDEST)ENTRY = FWA OF DESTINATION. H0402256* (Q)ENTRY = NO. OF WORDS TO MOVE. H0402257* RTJ MOVE MOVE IFF (Q)ENTRY .GE. 1. H0402258* (A)EXIT = (LAST WORD MOVED). H0402259* (Q)EXIT = -1. H0402260* (I),(MVSRCE),(MVDEST) EXIT = ENTRY. H0402261**** H0402262MOVE NUM 0 H0402263MVLOOP INQ -1 (Q) = FWA NEXT SOURCE WORD - FWA OF SOURCE, H0402264* = FWA NEXT DESTINATION WORD - FWA OF DESTINATION.H0402265ÐÐ SQP MVLDA SKIP IF MORE WORDS TO MOVE. H0402266 JMP* (MOVE) EXIT. H0402267MVLDA LDA* (MVSRCE),Q (A) = (NEXT WORD TO MOVE). H0402268 STA* (MVDEST),Q MOVE A WORD. H0402269 JMP* MVLOOP EXIT OR MOVE NEXT WORD. H0402270MVSRCE NUM 0 () = FWA OF SOURCE. H0402271MVDEST NUM 0 () = FWA OF DESTINATION. H0402272 EJT 0 H0402273**** H0402274*E H0402275* ********* H0402276* * BLANK * H0402277* ********* H0402278* H0402279* H0402280* BLANK RIGHT TO LEFT. H0402281* TO BLANK THE MOVE DESTINATION BUFFER, CALL BLANK JUST BEFORE MOVE. H0402282* THE CALLING SEQUENCE IS (MVDEST)ENTRY = FWA OF DESTINATION. H0402283* P RTJ BLANK BLANK DESTINATION BUFFER. H0402284* P+1 NO. OF WORDS TO BLANK. H0402285* P+2 EXIT. H0402286* (A)EXIT = TWO BLANK BYTES. H0402287* (I) EXIT = (I) ENTRY. H0402288**** H0402289BLANK NUM 0 H0402290ÐÐ LDA =A (A) = TWO BLANK BYTES. H0402291 LDQ* (BLANK) (Q) = NO. OF WORDS TO BLANK. H0402292BLANKL SQZ BLANKX SKIP IF ZERO WORDS LEFT TO BLANK. H0402293 INQ -1 POINT TO NEXT WORD TO BLANK. H0402294 STA* (MVDEST),Q BLANK THAT WORD. H0402295 JMP* BLANKL SEE IF THERE IS A NEXT WORD TO BLANK. H0402296BLANKX RAO* BLANK SET UP P+2 EXIT. H0402297 JMP* (BLANK) TAKE P+2 EXIT. H0402298 EJT H0402299**** H0402300*E H0402301* ********** H0402302* * NEWSCL * H0402303* ********** H0402304* H0402305* H0402306* NEWSCL FORCES THE SCLBYT ROUTINE TO START READING A NEW CARD. H0402307* THE CALLING SEQUENCE IS RTJ NEWSCL H0402308* (Q), (I)EXIT = (Q), (I)ENTRY H0402309* H0402310**** H0402311NEWSCL NUM 0 H0402312 ENA ENDCOL H0402313 STA* SCLDEX FORCE SCLBUF TO BE RELOADED AT NEXT SCLBYT CALL.H0402314 JMP* (NEWSCL) EXIT. H0402315ÐÐ EJT H0402316**** H0402317*E H0402318* ********** H0402319* * SCLBYT * H0402320* ********** H0402321* H0402322* H0402323* SCLBYT SUPPLIES SUCCESSIVE BYTES OF SORT CONTROL LANGUAGE. H0402324* THE CALLING SEQUENCE IS RTJ SCLBYT H0402325* (A)EXIT = NEXT NONBLANK BYTE .NE. $FF. H0402326* (BYTBIN)EXIT = (A)EXIT. H0402327* (Q),(I) EXIT = (Q),(I) ENTRY. H0402328**** H0402329*THE FOLLOWING COMMENT APPLIES AT ENTRY TO SCLBYT. H0402330SCLDEX NUM -1 () = FCA LAST BYTE - FCA SCLBUF. H0402331SCLBYT NUM 0 H0402332* INIT REPLACES PLUG BELOW WITH FWA OF SAVAQI. H0402333 RTJ+ PLUG SAVE ALL REGS. H0402334SCL10 NUM 0,0,0 ()EXIT = (A),(Q),(I) EXIT. H0402335SCL20 RAO* SCLDEX (SCLDEX) = FCA CURRENT SCL BYTE - FCA SCLBUF. H0402336 LDA* SCLDEX (A) = FCA CURRENT SCL BYTE - FCA SCLBUF. H0402337 SUB* SCLLIM (A)=0 IFF SENT APPLIES AT ENTRY TO SCLBYT. H0402338 SAP SCL70 SKIP IF SCLBUF EMPTY. H0402339 LDQ* SCLDEX (Q) = FCA CURRENT SCL BYTE - FCA SCLBUF. H0402340ÐÐ* THE LRS BELOW RELIES ON (A)15=0 BEFORE THE LLS. THE ABOVE LOGIC MAKES H0402341* THIS AN OK ASSUMPTION. AFTER THE LLS, (Q) = FWA CURR BYTE - FWA SCLBUFH0402342* WHILE (A)15=1 IFF THE CURR BYTE IS IN THE LOWER HALF OF A WORD. H0402343 LRS 1 (Q) = WD INDEX NEXT BYTE. (A)15=0 IFF LEFT HALF-WORD.H0402344 SAP SCL30 SKIP IF CURR BYTE IS LEFT HALF-WORD. H0402345 LDA* SCLBUF,Q (A)7-0 = CURR BYTE OF SCL. H0402346 JMP* SCL40 JMP TO SET (A)15-8 = 0. H0402347SCL30 LDA* SCLBUF,Q (A)15-8 = CURR BYTE OF SCL. H0402348 ARS 8 (A)7-0 = CURR BYTE OF SCL. H0402349SCL40 AND- HX00FF (A)15-8=0. (A)7-0 = CURRENT BYTE OF SCL. H0402350 STA* SCL10 RESAQI WILL SET (A)EXIT = CURRENT BYTE OF SCL. H0402351* INIT REPLACES PLUG BELOW WITH FWA OF RESAQI. H0402352SCL50 RTJ+ PLUG SET (A)EXIT, RESTORE(Q),(I) ENTRY. H0402353SCL60 ADC SCL10-HERE () = FWA OF A,Q,I SAVE AREA. H0402354 STA* BYTBIN () = NEW BYTE OF SCL. H0402355 JMP* (SCLBYT) EXIT. H0402356SCL70 LDA* SCL90 TELL BLANK SUBROUTINE WHERE BUFFER IS LOCATED H0402357 STA* MVDEST H0402358 RTJ BLANK INPUT LINE WILL BE PRINTED IF IN ERROR H0402359 ADC ENDWRD () = LENGTH OF SCLBUF H0402360* INIT REPLACES PLUG BELOW WITH FWA OF TYPIN. H0402361SCL80 RTJ+ PLUG READ A LINE OF SCL. H0402362SCL90 ADC SCLBUF-HERE () = FWA OF TYPIN BUFFER. H0402363 ENA -1 -1 IMPLIES THE LAST BYTE JUST PRECEDED SCLBUF.H0402364 STA SCLDEX INITIALIZE BYTE INDEX FOR NEW SCLBUF LOAD. H0402365ÐÐ JMP* SCL20 BEGIN TO SCAN NEW SCLBUF LOAD. H0402366 SPC 3 H0402367 ADC ENDWRD () = LENGTH OF SCLBUF. H0402368SCLBUF BZS SCLBUF(ENDWRD+1) SORT CONTROL LANGUAGE INPUT BUFFER. H0402369* ALLOW FOR ACTUAL MESSAGE LENGTH H0402370SCLLIM EQU SCLLIM(SCLBUF+ENDWRD) NO. CHAR IN LAST READ H0402371 EJT 0 H0402372**** H0402373*E H0402374* ********** H0402375* * ALFNUM * H0402376* ********** H0402377* H0402378* H0402379* ALFNUM FETCHES THE FILE NAME FOR THE FILE. THE FILE NAME IS BLANK H0402380* FILLED WHEN COMMA IS ENCOUNTERED. NUMERIAL VALUES ARE NOT CONVERTED. H0402381* THIS SUBROUTINE ALSO PROCESSES THE OWNER NAME. H0402382* THE CALLING SEQUENCE IS RTJ ALFNUM H0402383* (Q)EXIT = 0 IF ENTIRE FIELD IS BLANK H0402384* (I)EXIT = (I)ENTRY H0402385**** H0402386 SPC 3 H0402387ALFNUM NUM 0 H0402388 LDA* FILFWA START ADDRESS FOR FILNAM BUFFER H0402389 INA 4 H0402390ÐÐ STA* FILLWA LWA + 1 FOR FILNAM BUFFER H0402391ALFN10 RTJ* FILCHR FETCH NEXT CHARACTER H0402392 ALS 8 H0402393 STA* (FILFWA) H0402394 RTJ* FILCHR H0402395 EOR* (FILFWA) FILL WORD FOR FILE NAME H0402396 STA* (FILFWA) H0402397 LDQ* BLANKS H0402398 SQN ALFN15 SKIP IF FIELD NON BLANK H0402399 EOR =A LOOK FOR BLANKS H0402400 STA* BLANKS H0402401ALFN15 RAO* FILFWA H0402402 LDA* FILFWA H0402403 EOR* FILLWA H0402404 SAZ ALFN20 SKIP IF 4 WORDS HAVE BEEN PROCESSED H0402405 JMP* ALFN10 H0402406ALFN20 LDQ* BNKFLG FILL CHAR FLAG H0402407 SQZ ALFN30 SKIP IF COMMA WAS NOT ENCOUNTERED H0402408 STA* BNKFLG RESET FILL CHAR FLAG H0402409 LDQ* SCLDEX RESET CHAR INDEX H0402410 INQ -1 H0402411 STQ* SCLDEX READ ONE CHAR TOO MANY H0402412ALFN30 LDQ* BLANKS RETURN FIELD INDICATOR FOR ALL BLANKS H0402413 STA* BLANKS CLEAR FLAG H0402414 JMP* (ALFNUM) RETURN H0402415ÐÐ SPC 2 H0402416BLANKS BZS BLANKS INDICATOR TO DETERMINE IF FIELD ALL BLANK H0402417FILFWA BSS FILFWA FWA FOR FILE NAME H0402418FILLWA BSS FILLWA LWA FOR FILE NAME H0402419 EJT 0 H0402420**** H0402421*E H0402422* ********** H0402423* * FILCHR * H0402424* ********** H0402425* H0402426* H0402427* FILCHR PROVIDES FOR BLANK FILLING A CHARACTER STRING. H0402428* THE CALLING SEQUENCE IS RTJ FILCHR H0402429* (A)EXIT = BLANK CHARACTER OR NEXT CHARACTER H0402430* (Q), (I)EXIT = (Q), (I) ENTRY H0402431* H0402432**** H0402433FILCHR NUM 0 H0402434 LDA* BNKFLG H0402435 SAN FILC10 SKIP IF BLANK TO BE SUPPLIED H0402436 RTJ* NXTCHR FETCH NEXT CHARACTER H0402437 SAP FILC10 SKIP IF CHAR NOT COMMA H0402438 ENA $20 H0402439 STA* BNKFLG SET FLAG TO INDICATE NAME TO BE BLANKED FILLEDH0402440ÐÐFILC10 JMP* (FILCHR) RETURN H0402441 SPC 3 H0402442BNKFLG NUM 0 FLAG TO BLANK FILL H0402443 EJT 0 H0402444**** H0402445*E H0402446* ********** H0402447* * NXTCHR * H0402448* ********** H0402449* H0402450* H0402451* NXTCHR FETCHES THE NEXT CHARACTER FROM AN INPUT CARD. IF THE H0402452* CHARACTER IS THE DELIMITER, IF CONDITION IS RETURN VIA (A) = -0. H0402453* THE CALLING SEQUENCE IS RTJ NXTCHR H0402454* (A)EXIT = NEXT CHARACTER H0402455* (A)EXIT = -0, IF DELIMITER FOUND H0402456* (I)EXIT = (I)ENTRY H0402457* H0402458**** H0402459NXTCHR NUM 0 H0402460 RTJ SCLBYT SET (A) = NEXT NONBLANK BYTE. H0402461 TRA Q (Q)15-8=0. (Q)7-0 = THE BYTE. H0402462 STA TOKVAL SET TENTATIVE VALUE OF TOKEN. H0402463 ADQ- HX2000 MAKE (Q)15-8 = BLANK. H0402464 STQ REPLY SET REPLY IN MSGEXP. H0402465ÐÐ TCA Q H0402466 ADQ* DELMIT LOOK FOR DELIMITOR H0402467 SQN NXT10 SKIP IF NOT COMMA. H0402468 ENA -0 SET BYTBIN EMPTY. H0402469 STA* BYTBIN H0402470NXT10 JMP* (NXTCHR) RETURN H0402471 SPC 2 H0402472DELMIT NUM $2C DELIMITOR H0402473 EJT H0402474**** H0402475*E H0402476* ********* H0402477* * TOKEN * H0402478* ********* H0402479* H0402480* H0402481* THE TOKEN SUBROUTINE CONVERTS UP TO 8 DECIMAL CHARACTERS INTO 2 WORDS H0402482* OF DECIMAL VALUE. THE FIRST WORD (MSB) IS 10,000 TIMES THE GIVEN H0402483* VALUE. THE SECOND WORD (LSB) REPRESENTS A VALUE UP TO 10,000. H0402484* THE CALLING SEQUENCE IS RTJ TOKEN H0402485* (Q)EXIT = MSB WORD,10,000 TIMES DECIMAL VALUE H0402486* (A)EXIT = LSB WORD, 0-9999 DECIMAL VALUE OR H0402487* (A)EXIT = ALPHA CHARACTER H0402488* (P+1)EXIT = ERROR EXIT OR ALPHA CHARACTER H0402489* (P+2)EXIT = NORMAL EXIT, NO ERRORS H0402490ÐÐ* H0402491**** H0402492BYTBIN NUM $FF () = -0,$FF, OR LAST NONBLANK SCL BYTE. H0402493TOKI NUM 0 () = (I)ENTRY. H0402494TOKEN NUM 0 H0402495 LDA- I (A) = (I)ENTRY. H0402496 STA* TOKI SAVE (I)ENTRY. H0402497 RTJ NXTCHR FETCH NEXT CHAR H0402498 SAM TOK20 TAKE P+1(ALPHA) EXIT. H0402499 JMP* TOK30 SKIP IF NOT COMMA. H0402500TOK10 RAO* TOKEN ENTER HERE FOR P+2(NUMBER) EXIT. H0402501TOK20 LDA* TOKI (A) = (I)ENTRY. P+1(ALPHA) EXIT. H0402502 STA- I RESTORE (I)ENTRY. H0402503 LDA* TOKVAL (A) = VALUE OF TOKEN. H0402504 JMP* (TOKEN) P+1, P+2 FOR ALPHA, NUMBER H0402505TOKDCT NUM 0 COUNT OF DIGITS SO FAR FOUND FOR CURRENT TOKEN. H0402506TOKVAL NUM 0,0 H0402507BYTSTK BZS BYTSTK(8) H0402508TOK30 RTJ* DIGTST CHECK FOR DECIMAL DIGIT. H0402509 JMP* TOK20 TAKE P+1 EXIT SINCE ALPHA H0402510*THE LOGIC BELOW ATTEMPTS TO GET AND STACK A STRING OF .LE. 8 DIGITS. H0402511 ENA 0 H0402512 STA* TOKDCT H0402513 STA* TOKVAL H0402514 STA* TOKVAL+1 H0402515ÐÐTOK60 RAO* TOKDCT COUNT EACH DIGIT IN CURRENT NUMBER. H0402516 LDA* BYTBIN (A)15-8=0. (A)7-0 = THE ASCII DIGIT. H0402517 LDQ* TOKDCT (Q) = ORDINAL OF CURRENT DIGIT. H0402518 STA* BYTSTK-1,Q STACK THE CURRENT DIGIT. H0402519 RTJ SCLBYT GET NEXT NONBLANK BYTE. H0402520 RTJ* DIGTST CHECK FOR DECIMAL DIGIT. H0402521 JMP* TOK70 JMP IF NOT DECIMAL DIGIT. H0402522 INQ -8 8 DIGITS IS OUR LIMIT. H0402523 SQZ 1 SKIP IF WE]VE BAGGED OUR LIMIT. H0402524 JMP* TOK60 COUNT AND STACK NEW DIGIT. H0402525TOK70 LDA SCLDEX RESET CHARACTER INDEX H0402526 INA -1 READ ONE CHAR TOO MANY H0402527 STA SCLDEX H0402528*THE LOGIC BELOW RIGHT-ADJUSTS THE DIGIT-STRING WITHIN BYTSTK. H0402529TOK75 LDA =XBYTSTK-HERE (A) = FWA FROM WHICH TO MOVE. H0402530 STA MVSRCE TELL MOVE. H0402531 LDQ* TOKDCT (Q) = NO. OF DIGITS IN STRING. H0402532 TCQ Q (Q) = - NO. OF DIGITS IN STRING. H0402533 INQ 8 (Q) = ]TO] FWA - ]FROM] FWA. H0402534 AAQ A (A) = FWA TO WHICH TO MOVE. H0402535 STA MVDEST TELL MOVE. H0402536 LDQ* TOKDCT (Q) = LENGTH OF MOVE. H0402537 RTJ MOVE RIGHT-ADJUST THE DIGIT STRING. H0402538*TO COMPLETE THE RIGHT-ADJUSTMENT, FILL FRONT OF BYTSTK WITH ZEROES. H0402539 LDQ* TOKDCT (Q) = NO. OF DIGITS IN STRING. H0402540ÐÐ TCQ Q (Q) = - NO. OF DIGITS IN STRING. H0402541 INQ 8 (Q) = NO. OF LEADING ZEROS NEEDED. H0402542 ENA $30 (A) = ASCII ZERO. H0402543TOK80 SQZ TOK90 SKIP IF ALL DONE. H0402544 INQ -1 POINT TO NEXT RECIPIENT OF ZERO. H0402545 STA BYTSTK,Q STACK A LEADING ZERO. H0402546 JMP* TOK80 JMP TO STACK NEXT ZERO. H0402547*NOW WE REPLACE EACH ASCII DIGIT STACKED WITH ITS BINARY VALUE. H0402548TOK90 ENQ 7 START WITH RIGHTHAND DIGIT. H0402549TOK100 LDA* BYTSTK,Q (A) = ASCII DIGIT. H0402550 INA -$30 (A) = BINARY VALUE. H0402551 STA* BYTSTK,Q REPLACE ASCII WITH BINARY. H0402552 SQZ TOK110 SKIP IF ALL DONE. H0402553 INQ -1 POINT TO NEXT WORD TO CONVERT. H0402554 JMP* TOK100 JMP TO CONVERT NEXT WORD. H0402555*NOW WE HAVE A RIGHT-JUSTIFIED STRING OF 8 DECIMAL DIGITS. H0402556*EACH DIGIT IS REPRESENTED BY ITS VALUE AS 16] OF BINARY. H0402557*LET]S SPLIT THE 8-DIGIT STRING INTO 2 4-DIGIT STRINGS. H0402558*THEN LET]S CONVERT EACH 4-DIGIT STRING TO 16] OF BINARY, H0402559*.GE. 0 AND .LE. 9999 IN DECIMAL VALUE. H0402560TOK110 ENA -3 START WITH LEFTHAND DIGIT H0402561 STA- I OF RIGHTHAND 4-DIGIT STRING. H0402562TOK120 LDA* BYTSTK+7,I (A) = DIGIT. H0402563 MUI* TOKFAC+3,I ALLOW FOR SIGNIFICANCE OF DIGIT. H0402564 ADD* TOKVAL ACCUMULATE NET WORTH OF H0402565ÐÐ STA* TOKVAL RIGHTHAND 4-DIGIT STRING. H0402566 LDA- I (A) = INDEX OF LATEST DIGIT. H0402567 SAZ TOK130 SKIP IF ALL DONE WITH RIGHTHAND STRING. H0402568 RAO- I POINT TO NEXT DIGIT. H0402569 JMP* TOK120 HANDLE THE NEXT DIGIT. H0402570TOKFAC NUM 1000,100,10,1 DIVISORS FOR EUCLID]S ALGORITHM. H0402571TOK130 ENA -3 START WITH LEFTHAND DIGIT H0402572 STA- I OF LEFTHAND 4-DIGIT STRING. H0402573TOK140 LDA* BYTSTK+3,I (A) = DIGIT. H0402574 MUI* TOKFAC+3,I ALLOW FOR SIGNIFICANCE OF DIGIT. H0402575 ADD* TOKVAL+1 ACCUMULATE NET WORTH OF H0402576 STA* TOKVAL+1 LEFTHAND 4-DIGIT STRING. H0402577 LDA- I (A) = INDEX OF LATEST DIGIT. H0402578 SAZ TOK150 SKIP IF ALL DONE WITH LEFTHAND STRING. H0402579 RAO- I POINT TO NEXT DIGIT. H0402580 JMP* TOK140 HANDLE THE NEXT DIGIT. H0402581TOK150 LDQ* TOKVAL+1 (Q) = VALUE OF LEFTHAND 4-DIGIT STRING. H0402582 JMP* TOK10 TAKE P+2(NUMBER) EXIT. H0402583 EJT H0402584**** H0402585*E H0402586* ********** H0402587* * DIGTST * H0402588* ********** H0402589* H0402590ÐÐ* H0402591* DIGTST DETERMINES IF CHARACTER IS ASCII DECIMAL DIGIT. H0402592* THE CALLING SEQUENCE IS (A)ENTRY = CHARACTER (RIGHT JUSTIFIED) H0402593* RTJ DIGTST H0402594* (Q), (I)EXIT = (Q), (I)ENTRY H0402595* (P+1)EXIT = NOT ASCII DECIMAL H0402596* (P+2)EXIT = ALL CHARACTERS ASCII DECIMAL H0402597* H0402598**** H0402599DIGTST NUM 0 H0402600 STA* DIGA SAVE (A)ENTRY. H0402601 LDA BYTBIN (A) = CURRENT SCL BYTE. H0402602 INA -$30 (A)15=0 IF DIGIT. H0402603 SAM DIGXIT IF NOT DIGIT, SKIP TO TAKE P+1 RETURN. H0402604 INA -$3A+$30 (A)15=1 IF DIGIT. H0402605 SAP DIGXIT IF NOT DIGIT, SKIP TO TAKE P+1 RETURN. H0402606 RAO DIGTST SET UP P+2 RETURN SINCE DIGIT. H0402607DIGXIT LDA* DIGA RESTORE (A)ENTRY. H0402608 JMP* (DIGTST) EXIT. H0402609DIGA NUM 0 () = (A)ENTRY. H0402610 EJT 0 H0402611**** H0402612*E H0402613* ********** H0402614* * PRENAM * H0402615ÐÐ* ********** H0402616* H0402617* H0402618* PRENAM VERIFIES THE CARD PREFIX NAME IS CORRECT H0402619* THE CALLING SEQUENCE IS (Q) = FWA OF ERROR MESSAGE H0402620* RTJ PRENAM H0402621* (I)EXIT = (I)ENTRY H0402622**** H0402623 SPC 3 H0402624PRENAM NUM 0 H0402625 RTJ NEWSCL MAKE 1ST TOKEN CALL IMMEDIATELY DO FREAD H0402626 RTJ ALPHA LOOK FOR LEADING CHARACTER H0402627 ALS 8 H0402628 STA* PREALF 1ST CHARACTER ON CARD H0402629 RTJ NXTCHR 2ND CHARACTER MAY BE ALPHA OR NUMERIC H0402630 EOR* PREALF PICK UP 1ST WORD H0402631 STA REPLY DISPLAY ALL OF PREFIX H0402632 LDQ* TABIND H0402633 SQZ PR20 SKIP IF FILE NAME, SINCE NAME MAY BE REPEATED H0402634PR10 RAO* TABIND H0402635 LDQ* TABIND H0402636PR20 EOR* NAMTAB,Q H0402637 SAZ PR40 SKIP IF PROPER MATCH FOUND H0402638 SQN PR50 SKIP IF SPELLING OR OUT OF ORDER CARD H0402639 EOR* NAMTAB,Q RESET (A) TO ACTUAL ASCII VALUE H0402640ÐÐ LDQ- YDM,I H0402641 SQZ PR50 SKIP IF 1ST INPUT FILE PREFIX BAD H0402642PR30 LDQ =XMSGE14-HERE (Q) = FWA OF ERROR MESSAGE WE MIGHT USE H0402643 STQ ALFQ OUTPUT FILE ERROR MESSAGE ADDRESS H0402644 JMP* PR10 H0402645PR40 RTJ NXTCHR H0402646 INA -$3D LOOK FOR = H0402647 SAN PR50 SKIP IF NOT PROPER SEPARATOR H0402648 JMP* (PRENAM) RETURN H0402649PR50 JMP ALFERR REPORT INPUT ERROR H0402650 SPC 3 H0402651NAMTAB ALF $,FN$ PREFIX NAME TABLE (INPUT FILE) H0402652 ALF $,F2$ (OUTPUT FILE) H0402653 ALF $,OP$ (OPTIONS) H0402654 ALF $,KF$ (KEY FIELD) H0402655 ALF $,SL$ (SELECTIONS) H0402656 SPC 1 H0402657PREALF NUM 0 PREFIX NAME WORD H0402658TABIND NUM 0 NAMTAB TABLE INDEX H0402659 EJT 0 H0402660**** H0402661*E H0402662* ********** H0402663* * PREFIX * H0402664* ********** H0402665ÐÐ* H0402666* H0402667* THE PREFIX SUBROUTINE RETURNS THE FIRST CHARACTER ONLY OF A CHARACTER H0402668* STRING. THE ADDR/TAG AND OMIT/INCLUDE OPTIONS CAN BE ABBREVIATED. H0402669* ONLY THE LEADING CHARACTER NEEDS TO BE SPECIFIED. ALL OTHER H0402670* CHARACTERS IN THE NAME ARE IGNORED. H0402671* THE CALLING SEQUENCE IS (A)ENTRY = FWA OF ERROR MESSAGE FOR ERRORS H0402672* RTJ PREFIX H0402673* (A)EXIT = LEADING CHARACTER IN STRING H0402674* (I)EXIT = (I)ENTRY H0402675* H0402676**** H0402677PREFIX NUM 0 H0402678 RTJ ALPHA FIRST CHARACTER MUST BE ALPHA H0402679 STA* ALFVAL (A) = FIRST CHARACTER OF STRING H0402680PRE10 RTJ NXTCHR SCAN FOR FIELD TERMINATOR H0402681 SAM PRE20 FOUND COMMA H0402682 INA -$20 CHECK FOR BLANK H0402683 SAZ PRE20 H0402684 JMP* PRE10 CONTINUE SEARCH FOR TERMINATOR H0402685PRE20 LDA* ALFVAL (A) = FIRST CHARACTER OF STRING H0402686 TRA Q H0402687 ADQ- HX2000 H0402688 STQ REPLY RESET REPLY IN MSGEXP H0402689 JMP* (PREFIX) RETURN H0402690ÐÐ SPC 3 H0402691ALFVAL NUM 0 LEADING CHARACTER OF STRING H0402692 EJT H0402693**** H0402694*E H0402695* ********** H0402696* * BIGNUM * H0402697* ********** H0402698* H0402699* H0402700* THE BIGNUM SUBROUTINE EXPECTS TO READ DECIMAL FIELD FROM CARD. IF THEH0402701* FIELD IS NOT DECIMAL IT IS REPORTED AS AN ERROR. H0402702* THE CALLING SEQUENCE IS (Q)ENTRY = FWA OF ERROR MESSAGE FOR ERRORS H0402703* RTJ BIGNUM H0402704* (A) = LSB PORTION OF DECIMAL VALUE (SEE TOKEN)H0402705* (Q) = MSB PART OF DECIMAL VALUE (SEE TOKEN) H0402706* (I)EXIT = (I)ENTRY H0402707* H0402708**** H0402709BIGNUM NUM 0 H0402710 STQ* BIGQSV SAVE FWA OF MESSAGE. H0402711 RTJ TOKEN LOOK FOR NO. H0402712 JMP* BIGERR JMP IF ALPHA. EXPECTED NO. H0402713 JMP* (BIGNUM) EXIT IF NO. H0402714BIGERR LDQ* BIGQSV (Q) = FWA OF MESSAGE. H0402715ÐÐ JMP SCDIAG ANNOUNCE ERROR AND QUIT. H0402716BIGQSV NUM 0 () = FWA OF MESSAGE. H0402717 EJT H0402718**** H0402719*E H0402720* ********** H0402721* * POSNUM * H0402722* ********** H0402723* H0402724* H0402725* POSNUM DOES A P+1 RETURN IF THE TOKEN IS A NO. .GE. 1 AND .LE. 32767. H0402726* POSNUM REJECTS TOKENS OTHER THAN THE FOREGOING TYPE. (A)EXIT, AT P+1,H0402727* = THE NO. IN BINARY FORM. (Q)ENTRY = FWA OF MESSAGE TO ISSUE FOR A H0402728* BAD TOKEN. H0402729* THE CALLING SEQUENCE IS (Q)ENTRY = FWA OF ERROR MESSAGE FOR ERRORS H0402730* RTJ POSNUM H0402731* (A)EXIT = DECIMAL VALUE 1 - 32767 H0402732* (I)EXIT = (I)ENTRY H0402733* H0402734**** H0402735POSNUM NUM 0 H0402736 RTJ* BIGNUM LOOK FOR NO. H0402737 RTJ* OVRFLW LOOK TO SEE THAT (A) AND (Q) NOT LARGER 32767 H0402738 JMP* (POSNUM) RETURN H0402739 EJT 0 H0402740ÐÐ**** H0402741*E H0402742* ********** H0402743* * OVRFLW * H0402744* ********** H0402745* H0402746* H0402747* OVRFLOW CHECKS TOKEN VALUE FOR NO. .GE. 1 AND .LE. 32767. H0402748* THE CALLING SEQUENCE IS (Q)ENTRY = UPPER DECIMAL DIGITS H0402749* (A)ENTRY = LOWER DECIMAL DIGITS H0402750* RTJ OVRFLW H0402751* (A)EXIT = COMBINED DECIMAL VALUE H0402752* (I)EXIT = (I)ENTRY H0402753* H0402754**** H0402755OVRFLW NUM 0 H0402756 STQ* POSQ SAVE UPPER DIGITS. H0402757 STA* POSA SAVE LOWER DIGITS. H0402758 SQN POSNZ SKIP IF NONZERO REPLY. H0402759 SAN POSNZ SKIP IF NONZERO REPLY. H0402760 JMP* POSERR A ZERO REPLY IS AN ERROR. H0402761POSNZ INQ -4 H0402762 SQP POSERR SKIP IF NO. .GE. 40000. H0402763 LDA* POSQ H0402764 MUI =N10000 CONVERT TOP DIGIT. (A) = BINARY EQUIVALENT. H0402765ÐÐ SOV 0 CLEAR OVERFLOW. H0402766 ADD* POSA ADD THE LOWER DIGITS. H0402767 SOV POSERR SKIP IF OVERFLOW. H0402768 JMP* (OVRFLW) NO OVERFLOW, SO TAKE P+1 EXIT WITH (A) = NO. H0402769POSERR JMP* BIGERR ANNOUNCE ERROR, REQUEST REPLY, LET OP RETRY. H0402770POSA NUM 0 () = UPPER DIGITS. H0402771POSQ NUM 0 () = LOWER DIGITS. H0402772 EJT H0402773**** H0402774*E H0402775* ********** H0402776* * COMPOS * H0402777* ********** H0402778* H0402779* H0402780* A CALL TO COMPOS EXPECTS THE NEXT INFORMATION READ FROM A INPUT H0402781* DIRECTIVE CARD TO CONTAIN A COMMA FOLLOWED BY A DECIMAL VALUE. THE H0402782* VALUE IS CONVERTED AND RETURNED IN (A). H0402783* THE CALLING SEQUENCE IS (Q)ENTRY = FWA OF ERROR MESSAGE FOR ERRORS H0402784* RTJ COMPOS H0402785* (A)EXIT = DECIMAL VALUE 1 - 32767 H0402786* (I)EXIT = (I)ENTRY H0402787* H0402788**** H0402789COMPOS NUM 0 H0402790ÐÐ STQ* COMPS1 SAVE FWA OF MESSAGE. H0402791 RTJ COMMA LOOK FOR COMMA. H0402792 LDQ* COMPS1 (Q) = FWA OF MESSAGE. H0402793 RTJ POSNUM LOOK FOR NO. .GE. 1 AND .LE. 32767. H0402794 JMP* (COMPOS) TAKE P+1 EXIT WITH (A) = NO. H0402795COMPS1 NUM 0 () = (Q)ENTRY = FWA OF MESSAGE. H0402796 EJT H0402797**** H0402798*E H0402799* ********* H0402800* * COMMA * H0402801* ********* H0402802* H0402803* H0402804* THE NEXT FIELD ON AN INPUT DIRECTIVE CARD IS EXPECTED TO CONTAIN A H0402805* COMMA. IF NOT, AN ERROR IS REPORTED. H0402806* THE CALLING SEQUENCE IS RTJ COMMA H0402807* (I)EXIT = (I)ENTRY H0402808* H0402809**** H0402810COMMA NUM 0 H0402811 RTJ TOKEN LOOK FOR COMMA. H0402812 JMP* COMMA2 JMP IF ALPHA. H0402813COMMAE LDQ =XMSGE01-HERE (Q) = FWA OF ERROR MESSAGE. H0402814 JMP SCDIAG ANNOUNCE ERROR AND QUIT. H0402815ÐÐCOMMA2 INA -$2C $2C IS ASCII FOR COMMA. H0402816 SAZ COMMA3 SKIP IF COMMA. H0402817 JMP* COMMAE JMP IF NOT COMMA. H0402818COMMA3 JMP* (COMMA) H0402819 EJT H0402820**** H0402821*E H0402822* ********** H0402823* * COMALF * H0402824* ********** H0402825* H0402826* H0402827* THE COMALF ROUTINE EXPECTS THE NEXT INFORMATION ON A INPUT DIRECTIVE H0402828* CARD TO CONTAIN A COMMA FOLLOWED BY ALPHA CHARACTER. H0402829* THE CALLING SEQUENCE IS (Q)ENTRY = FWA OF ERROR MESSAGE FOR ERRORS H0402830* RTJ COMALF H0402831* (A)EXIT = ALPHA CHARACTER H0402832* (I)EXIT = (I)ENTRY H0402833* H0402834**** H0402835COMALF NUM 0 H0402836 STQ* COMAL1 SAVE FWA OF MESSAGE. H0402837 RTJ COMMA LOOK FOR COMMA. H0402838 LDQ* COMAL1 (Q) = FWA OF MESSAGE. H0402839 RTJ ALPHA LOOK FOR ALPHABETIC TOKEN. H0402840ÐÐ JMP* (COMALF) TAKE P+1 EXIT WITH (A) = ALPHABETIC TOKEN. H0402841COMAL1 NUM 0 () = (Q)ENTRY = FWA OF MESSAGE. H0402842 EJT H0402843**** H0402844*E H0402845* ********* H0402846* * ALPHA * H0402847* ********* H0402848* H0402849* H0402850* THE ALPHA ROUTINE RETURNS IN (A) THE NEXT CHARACTER TO BE READ. THIS H0402851* CHARACTER MUST BE AN ALPHA CHARACTER OR AN ERROR IS REPORTED. H0402852* THE CALLING SEQUENCE IS (Q)ENTRY = FWA OF ERROR MESSAGE FOR ERRORS H0402853* RTJ ALPHA H0402854* (A)EXIT = ALPHA CHARACTER H0402855* (I)EXIT = (I)ENTRY H0402856* H0402857**** H0402858ALPHA NUM 0 H0402859 STQ* ALFQ SAVE FWA OF MESSAGE. H0402860 RTJ TOKEN LOOK FOR ALPHA. H0402861 JMP* (ALPHA) TAKE P+1 EXIT IF ALPHA H0402862ALFERR LDQ* ALFQ (Q) = FWA OF MESSAGE. H0402863 JMP SCDIAG ANNOUNCE ERROR AND QUIT. H0402864ALFQ NUM 0 FWA OF MESSAGE. H0402865ÐÐ EJT H0402866**** H0402867*E H0402868* ********** H0402869* * EDITRX * H0402870* ********** H0402871* H0402872* H0402873* EDITRX CONTROLS THE FLOW FOR EXECUTING SMCEDT OVERLAY. H0402874* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF SMCMON FIXED TABLE H0402875* JMP EDITRX H0402876* H0402877**** H0402878EDITRX RTJ IOFIL BUILD NAME FILE TABLE, FIND OUTPUT FILE LU NO.H0402879 RTJ FTDEF BUILD INPUT FILE TABLE H0402880 RTJ OPTION PROCESS OPTION CARD - ADDR/TAG, F/D, A/E H0402881 RTJ KEYS BUILD KEY TABLE H0402882 RTJ SELECT BUILD KEY COMPARE TABLE H0402883 RTJ MEM DETERMINE BLOCKING FACTORS H0402884 JMP* EDIT10 JMP IF TOO LITTLE CORE. H0402885EDTXIT JMP+ 0 RETURN TO SMCMON. H0402886EDIT10 ENQ MSGTLC 'TOO LITTLE CORE' H0402887 SET A DELETE SUFFIX. H0402888* INIT REPLACES PLUG BELOW WITH FWA OF BOMB. H0402889EDTBMB JMP+ PLUG H0402890ÐÐ EJT H0402891**** H0402892*E H0402893* ********** H0402894* * SCDIAG * H0402895* ********** H0402896* H0402897* H0402898* THE SCDIAG REPORTS THE ERROR CONDITION FOUND THAT WAS ASSOCIATED WITH H0402899* AN INPUT DIRECTIVE ERROR. H0402900* THE CALLING SEQUENCE IS (Q)ENTRY = FWA OF PARAMETER EXPECTED H0402901* JMP SCDIAG H0402902* H0402903**** H0402904SCDIAG STQ MVSRCE (Q) = FWA OF EXPECTED TOKEN. H0402905 INQ -1 (Q) = FWA OF MESSAGE LENGTH. H0402906 LDQ- (ZERO),Q (Q) = NO. OF WORDS IN MESSAGE. H0402907SCDIA2 LDA =XMSGE00-HERE (A) = FWA OF EXPECTED-TOKEN-AREA OF MSG. H0402908 STA MVDEST TELL MOVE WHERE TO PLACE EXPECTATION. H0402909 RTJ MOVE MOVE EXPECTED TOKEN TO MESSAGE. H0402910* FIRST PRINT INPUT DIRECTIVE THAT IS IN ERROR. H0402911 ENQ MSGINP PRINTS INPUT DIRECTIVE CARD H0402912 LDA SCL90 BUFFER ADDRESS FOR MESSAGE PROCESSOR H0402913* INIT REPLACES PLUG BELOW WITH FWA OF CRTMSG. H0402914SCDIA3 RTJ+ PLUG TYPE THE MESSAGE. H0402915ÐÐ ENQ MSGEXP 'EXPECTED /FOUND ' H0402916 LDA* SCDIA2+1 IDATA BUFFER FOR MESSAGE PROCESSOR H0402917* INIT REPLACES PLUG BELOW WITH FWA OF CRTMSG. H0402918SCDIA5 RTJ+ PLUG TYPE THE MESSAGE. H0402919 SET A,Q DELETE OPTIONAL MESSAGE OF BOMB. H0402920 JMP EDTBMB SMC ABNORMALLY TERMINATES. H0402921 EJT H0402922* ********************************** H0402923* * EXPECTED/ FOUND ERROR MESSAGES * H0402924* ********************************** H0402925* H0402926* H0402927MSGE00 ALF 10, H0402928 NUM $0D0A $0D=RETURN. $0A=LINE FEED. H0402929REPLY NUM 0 H0402930 ADC MNDE01-MSGE01 H0402931MSGE01 ALF $,,$ H0402932MNDE01 EQU MNDE01(*) H0402933 ADC MNDE03-MSGE03 H0402934MSGE03 ALF $,(VOLUME NAME)$ H0402935MNDE03 EQU MNDE03(*) H0402936 ADC MNDE04-MSGE04 H0402937MSGE04 ALF $,(ADDR/TAG)$ H0402938MNDE04 EQU MNDE04(*) H0402939 ADC MNDE05-MSGE05 H0402940ÐÐMSGE05 ALF $,(F/D)$ H0402941MNDE05 EQU MNDE05(*) H0402942 ADC MNDE06-MSGE06 H0402943MSGE06 ALF $,(A/E)$ H0402944MNDE06 EQU MNDE06(*) H0402945 ADC MNDE07-MSGE07 H0402946MSGE07 ALF $,(A/D)$ H0402947MNDE07 EQU MNDE07(*) H0402948 ADC MNDE08-MSGE08 H0402949MSGE08 ALF $,(KEYCOL)$ H0402950MNDE08 EQU MNDE08(*) H0402951 ADC MNDE09-MSGE09 H0402952MSGE09 ALF $,(KEYCOLS)$ H0402953MNDE09 EQU MNDE09(*) H0402954 ADC MNDE10-MSGE10 H0402955MSGE10 ALF $,(OMIT/INCLUDE)$ H0402956MNDE10 EQU MNDE10(*) H0402957 ADC MNDE11-MSGE11 H0402958MSGE11 ALF $,(EQ/NE/LT/GT/LE/GE)$ H0402959MNDE11 EQU MNDE11(*) H0402960 ADC MNDE12-MSGE12 H0402961MSGE12 ALF $,('HOLLERITH DATA')$ H0402962MNDE12 EQU MNDE12(*) H0402963 ADC MNDE13-MSGE13 H0402964MSGE13 ALF $,FN$ H0402965ÐÐMNDE13 EQU MNDE13(*) H0402966 ADC MNDE14-MSGE14 H0402967MSGE14 ALF $,F2$ H0402968MNDE14 EQU MNDE14(*) H0402969 ADC MNDE15-MSGE15 H0402970MSGE15 ALF $,OP$ H0402971MNDE15 EQU MNDE15(*) H0402972 ADC MNDE16-MSGE16 H0402973MSGE16 ALF $,KF$ H0402974MNDE16 EQU MNDE16(*) H0402975 ADC MNDE17-MSGE17 H0402976MSGE17 ALF $,SL$ H0402977MNDE17 EQU MNDE17(*) H0402978* TOTAL SIZE OF EDIT LOGIC. H0402979* SMCEDT LOADS HIGH, SO TO AVOID ERRORS ON OVERLAY REQUEST H0402980* THE SIZE OF SMCEDT MUST BE ROUNDED UP TO THE NEAREST WHOLE H0402981* NUMBER OF SECTORS. H0402982EDTSZ1 EQU EDTSZ1(*-SMCEDT+95) H0402983EDTSIZ EQU EDTSIZ(EDTSZ1/96*96) H0402984 END SMCEDT H0402985 NAM SMCSRT H05 A ITOS CCS 3.0 SL-149H0500001* CREATES SORTED MERGE STRINGS H0500002* CREDIT COLLECTION SYSTEM VERSION 3.0 H0500003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA H0500004* COPYRIGHT CONTROL DATA CORPORATION 1979 H0500005ÐÐ SPC 5 H0500006**** H0500007*E H0500008* **************** H0500009* * SORT OVERLAY * H0500010* **************** H0500011* H0500012* H0500013* FUNCTION H0500014* -------- H0500015* H0500016* THE SMCSRT OVERLAY SORTS THE INPUT RECORDS AND EITHER (1) CREATES H0500017* THE FINAL OUTPUT FILE (CORE SORT), OR (2) GENERATES ONE OR MORE OUTPUTH0500018* MERGE STRINGS FOR OVERLAYS SMCIMG AND SMCFMG TO MERGE. H0500019* H0500020* H0500021* GENERAL DESCRIPTION H0500022* ------------------- H0500023* H0500024* THE SMCSRT OVERLAY READS INPUT RECORDS, EXCLUDING RECORDS NOT REQUEST-H0500025* ED FOR SORTING, AND MOVES THE RECORDS TO A QUEUING AREA CALLED THE H0500026* RECORD BIN. A QUEUING ROUTINE, CALLED THE TOURNAMENT, DELAYS AND H0500027* SAVES SOME LOGICAL RECORDS, WHILE ADVANCING OTHERS, SO AS TO COPY H0500028* LOGICAL RECORDS IN BURSTS (CALLED SEQUENCES OR STRINGS) OF USER H0500029* DEFINED ORDER. H0500030ÐÐ* H0500031* MOVEMENT OF LOGICAL RECORDS IS MINIMIZED BY MOVING POINTERS INSTEAD, H0500032* WHENEVER POSSIBLE. THEREFORE, SMCSRT MOVES EACH LOGICAL RECORD TWICE,H0500033* 1ST FROM THE INPUT BUFFER TO THE QUEUE, AND 2ND, FROM THE QUEUE TO THEH0500034* OUTPUT BUFFER. H0500035* H0500036* THE G (GROUP SITE) OF THE TOURNAMENT IS THE NUMBER OF LOGICAL RECORDS H0500037* THAT THE TOURNAMENT CAN HOLD (I.E. DELAY) AT ONE TIME. H0500038* H0500039* NOT COUNTING THE LAST SEQUENCE THAT COULD BE PRODUCED BY THE TOURNA- H0500040* MENT, THE AVERAGE NUMBER OF RECORDS PER SEQUENCE COULD BE G * O, WHEREH0500041* O IS A FUNCTION OF THE INHERENT ORDERING OF TOURNAMENT INPUT RELATIVE H0500042* TO THE OUTPUT ORDER OF THE TOURNAMENT. HOWEVER BECAUSE OF FILE MANAGERH0500043* LIMITIATIONS (SEE MEM IMS DESCRIPTION), THE SCHEME USED WILL ALLOW H0500044* ONLY 2 * G RECORDS SAVED PER MERGE STRING. H0500045**** H0500046 EJT 0 H0500047**** H0500048*E H0500049* NORMALLY, SMCSRT WILL PRODUCE MORE THAN ONE SEQUENCE. THEREFORE, H0500050* USUALLY, SMCSRT OUTPUTS TO WORK FILES IN PREPARATION FOR THE RECURSIVEH0500051* MERGING OF THE TWO OR MORE SEQUENCES. FOR THE SAKE OF THE SUBSEQUENT H0500052* MERGING, BOTH THE SEQUENCES AND A DIRECTORY OF THESE SEQUENCES WILL H0500053* HAVE BEEN WRITTEN BY SMCSRT. H0500054* H0500055ÐÐ* HOWEVER, WHEN IT IS FEASIBLE, SMCSRT WILL OUTPUT ONE SEQUENCE DIRECTLYH0500056* TO THE USER OUTPUT FILE, AFTER WHICH SMCSRT RETURNS TO SMCMON, TELLINGH0500057* SMCMON TO TERMINATE THE RUN. EACH OF THE FOLLOWING CONDITIONS MUST H0500058* BE MET FOR A CORE SORT TO OCCUR: H0500059* H0500060* 1. TOURNAMENT INPUT RECORD COUNT IS LESS THAN G RECORDS. H0500061* 2. THE BLOCK FACTOR FOR THE OUTPUT FILE IS LESS THAN WORK BLOCK SIZE H0500062* PLUS THE INPUT BLOCK SIZE. H0500063* H0500064* H0500065* INPUT REQUIREMENTS H0500066* ------------------ H0500067* H0500068* THE SMCSRT IS ENTERED AT THE SECOND LOCATION WITHIN ITSELF. THE (I) H0500069* CONTAINS THE FIRST WORD ADDRESS OF SMCMON FIXED TABLE SPACE. H0500070* H0500071* H0500072* OUTPUT H0500073* ------ H0500074* H0500075* THE SMCSRT OVERLAY DOES NOT SET REGISTER VALUES TO SPECIFIC VALUES H0500076* WHEN IT IS DONE. H0500077* H0500078* H0500079* ENTRY/EXIT H0500080ÐÐ* ---------- H0500081* H0500082* ENTRY - H0500083* THE SMCSRT OVERLAY IS LOADED BY THE LOAD SUBROUTINE IN DSORT. SMCMON H0500084* MAKES A SUBROUTINE CALL TO LOAD PASSING THE OVERLAY INDEX (REQUEST TO H0500085* LOAD SMCSRT) AND THE FWA OF SMCSRT. SMCSRT IS LOADED AT THE END OF H0500086* THE VARIABLE TABLES BUILT BY SMCEDT. THE LOAD SUBROUTINE IN DSORT H0500087* SETS THE RETURN ADDRESS TO SMCMON IN THE FIRST LOCATION OF SMCSRT AND H0500088* THEN JUMPS TO THE SECOND LOCATION IN SMCSRT. H0500089* H0500090* EXIT - H0500091* SMCSRT EITHER RETURNS TO SMCMON VIA THE RETURN ADDRESS SET IN THE H0500092* FIRST LOCATION OF SMCSRT, OR EXITS TO THE BOMB ROUTINE IN SMCMON IF H0500093* ERRORS OCCUR. H0500094**** H0500095 EJT 0 H0500096**** H0500097*E H0500098* FLOW H0500099* ---- H0500100* H0500101* THE SMCSRT OVERLAY PERFORMS THE FOLLOWING: H0500102* 1. SETS UP THE WORK TABLE SPACE FOR THE INPUT AND OUTPUT FILES H0500103* 2. DEFINES THE TOURNAMENT TABLE SPACE AND INITIALIZES THESE TABLES H0500104* 3. FETCHES A RECORD TO BE SORTED H0500105ÐÐ* 4. SUBMITS IT TO THE TOURNAMENT H0500106* 5. DISPOSE OF A WINNER, REAL OR DUMMY RECORD FROM THE TOURNAMENT H0500107* 6. REPEAT STEPS 2 THRU 5 UNTIL TOURNAMENT IS FLUSHED H0500108* H0500109* H0500110* SUBROUTINES H0500111* ----------- H0500112* H0500113* BOMB: TERMINATES SORT RUN WHEN ERROR ENCOUNTERED H0500114* BOS: STARTS NEW WORK FILE SEQUENCE H0500115* CLOSE: CLOSES FILE MANAGER FILE H0500116* CMPKEY: COMPARES 2 KEYS TO DETERMINE WINNER H0500117* CRTMSG: DISPLAYS MESSAGE H0500118* EOS: ENDS WORK FILE SEQUENCE H0500119* GETU: FETCHES NEXT RECORD TO BE SORTED H0500120* OPEN: OPENS FILE MANAGER FILE H0500121* PUTU: MOVES RECORD TO OUTPUT FILE H0500122* WIERD: REPORTS ABNORMAL ERROR CONDITIONS H0500123* H0500124* H0500125* MESSAGES H0500126* -------- H0500127* H0500128* THE MESSAGES FOR ALL OVERLAYS ARE LISTED IN THE EQUATES SECTION H0500129* UNDER 'MESSAGE PROCESSOR INDEX EQUATES'. H0500130ÐÐ**** H0500131 EJT H0500132**** H0500133*E H0500134* PARAMETERS H0500135* ---------- H0500136* H0500137* OFTEN NEEDED CONSTANTS. H0500138ZERO EQU ZERO(2) (2)=0. H0500139HX7FFF EQU HX7FFF($42) ($42)=$7FFF. H0500140 SPC 5 H0500141* TOURNAMENT ARRAYS H0500142* ----------------- H0500143* ******* H0500144* * RSA * H0500145* ******* H0500146* H0500147* RECORD STORAGE AREA - H0500148* H0500149* FOR THE INTERNAL SORT, THIS IS AN ARRAY OF BINS, EACH HOLDING ONE H0500150* LOGICAL RECORD. H0500151* FOR THE INTERMEDIATE MERGE AND THE FINAL MERGE, THIS IS AN ARRAY OF H0500152* TWO WORD LINES. H0500153* H0500154* WORD CONTENTS H0500155ÐÐ* 0 FWA OF A LOGICAL RECORD RESIDING IN AN INPUT BUFFER H0500156* H0500157* 1 FWA OF THE FILE TABLE CORRESPONDING TO THE INPUT BUFFER AND H0500158* TO THE FILE FROM WHICH CAME THE LOGICAL RECORD H0500159* H0500160* THE RANK OF EACH RSA BIN RELATIVE TO THE OTHER RSA BINS IS RECORDED H0500161* VIA A BINARY TREE STRUCTURE CALLED THE TSA (Q.V.) H0500162* H0500163* FOR THE SAKE OF THIS BINARY TREE STRUCTURE, AN IMAGINARY RSA BIN MAY H0500164* BE USED (C.F. SEQUENCE NUMBER ARRAY) TO LET THE TREE STRUCTURE HAVE H0500165* AN EVEN NUMBER OF RSA BINS TO DEAL WITH, WHEN THE NUMBER OF REAL RSA H0500166* BINS IS ODD. H0500167**** H0500168 EJT 0 H0500169**** H0500170*E H0500171* ******* H0500172* * SNA * H0500173* ******* H0500174* H0500175* SEQUENCE NUMBER ARRAY - H0500176* H0500177* THIS TABLE OF ONE-WORD BINARY NUMBERS IS PARALLEL TO THE RSA AND IS H0500178* USED AS THE MAJOR KEY FIELDS IN COMPARING THE LOGICAL RECORDS H0500179* ASSOCIATED WITH THE RSA. H0500180ÐÐ* H0500181* WHEN THE NUMBER OF RSA BINS IS EVEN, THERE IS EXACTLY ONE SEQUENCE H0500182* NUMBER FOR EACH RSA BIN. H0500183* H0500184* TO PRESERVE THE BINARY TREE STRUCTURE WHEN THE NUMBER OF RSA BINS IS H0500185* ODD, THERE IS ONE SEQUENCE NUMBER OF $7FFF. THIS "LOSING-DUMMY" H0500186* SEQUENCE NUMBER IS HELD BY LAST WORD OF THE SEQUENCE NUMBER ARRAY. H0500187* H0500188* H0500189* ******* H0500190* * TSA * H0500191* ******* H0500192* H0500193* TAG STORAGE AREA - H0500194* H0500195* IMAGINE THAT THE RSA BINS, REAL AND IMAGINARY, ARE NUMBERED 0,...,G-1.H0500196* LET EACH SUCH NUMBER BE CALLED A BIN INDEX. EACH OF THE G BIN INDICESH0500197* DESIGNATES AN RSA BIN, AS WELL AS THE CORRESPONDING ENTRY IN THE H0500198* SEQUENCE NUMBER ARRAY. H0500199* H0500200* THERE WILL BE G-1 ONE WORD ENTRIES IN THE TSA TO INDICATE THE RELATIVEH0500201* RANK OF EACH RSA BIN. EACH TSA ENTRY CONTAINS A BIN INDEX TO H0500202* DESIGNATE THE LOSER OF ONE CONTEST BETWEEN TWO RSA BINS IN A BINARY H0500203* TREE STRUCTURE OF SUCH CONTEST, I.E. A TOURNAMENT. H0500204**** H0500205ÐÐ EJT H0500206**** H0500207*E H0500208* FILE CONTROL BLOCK EQUIVALENCES H0500209 EQU FH(4) LENGTH -1 OF FCB HEADER H0500210 EQU FILEID(ZERO) FILE IDENTIFIER H0500211* ACCESS FILEID INDIRECTLY H0500212* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBERH0500213* BITS 10-00 INDEX OF FCB IN FCB TABLE H0500214 EQU FCBFLG(1) FCB FLAGS H0500215* BITS 15-8, SPARE H0500216* BITS 7-00, NUMBER OF USERS USING FILE H0500217 EQU FILOCK(2) FILE LOCK FLAG (IF NON-0, CONTAINS USER ID) H0500218 EQU NUMSET(3) NUMBER OF SETS OF LOCKED RECORDS IN FILE H0500219 EQU NUMNEW(4) NUMBER OF NEW RECORDS SINCE FCB UPDATED ON MM H0500220 SPC 1 H0500221 EQU RECLEN(FH+1) RECORD LENGTH IN WORDS H0500222 EQU TDATRM(FH+2) TOTAL NUMBER OF DATA RECORDS, MSB H0500223 EQU TDATRL(FH+3) TOTAL NUMBER OF DATA RECORDS, LSB H0500224 EQU DATBAM(FH+4) DATA RECORDS BEGINNING SECTOR ADDRESS, MSB H0500225 EQU DATBAL(FH+5) DATA RECORDS BEGINNING SECTOR ADDRESS,LMSB H0500226 EQU FCBIND(FH+6) FCB INDICATORS H0500227* BIT 15 , SECTOR ALLIGNED RECORDS IF =1 H0500228* BIT 14 , STORAGE MODE FOR INDEXED FILE H0500229* =0, RECORDS STORED RANDOMLY WITHH0500230ÐÐ* RESPECT TO PRIMARY KEY H0500231* =1, RECORDS STORED IN ORDER WIT H0500232* RESPECT TO PRIMARY KEY H0500233* BIT 13 , =1, FILE IS CURRENTLY OPEN H0500234* =0, FILE IS CURRENTLY CLOSED H0500235* BIT 12 , =1, FILE IS BEING COMPRESSED H0500236* =0, FILE IS NOT BEING COMPRESSEDH0500237* BIT 0 , FILE TYPE H0500238* =0, SEQUENTIAL FILE H0500239* =1, INDEXED FILE H0500240 EQU NEDATM(FH+7) NUMBER OF EXISTING DATA RECORDS, MSB H0500241 EQU NEDATL(FH+8) NUMBER OF EXISTING DATA RECORDS, LSB H0500242 EQU SEQLTH(NEDATL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION H0500243* OF FCB FOR A SEQUENTIAL FILE H0500244 SPC 1 H0500245 EQU NEXTBM(FH+9) NEXT FREE KEY INDEX BLOCK, MSB H0500246 EQU NEXTBL(FH+10) NEXT FREE KEY INDEX BLOCK, LSB H0500247 EQU TNKEYM(FH+11) TOTAL NUMBER OF KEY INDEX BLOCKS, MSB H0500248 EQU TNKEYL(FH+12) TOTAL NUMBER OF KEY INDEX BLOCKS, LSB H0500249 EQU KEYBAM(FH+13) KEY INDEX BEGINNING SECTOR ADDRESS, MSB H0500250 EQU KEYBAL(FH+14) KEY INDEX BEGINNING SECTOR ADDRESS, LSB H0500251 EQU LENKY1(FH+15) LENGTH OF KEY NO. 1 H0500252 EQU POSKY1(FH+16) BYTE POSITION OF KEY NO. 1 H0500253 EQU LENKY2(FH+17) LENGTH OF KEY NO. 2 H0500254 EQU POSKY2(FH+18) BYTE POSITION OF KEY NO. 2 H0500255ÐÐ EQU LENKY3(FH+19) LENGTH OF KEY NO. 3 H0500256 EQU POSKY3(FH+20) BYTE POSITION OF KEY NO. 3 H0500257 EQU LENKY4(FH+21) LENGTH OF KEY NO. 4 H0500258**** H0500259 EJT 0 H0500260**** H0500261*E H0500262 EQU POSKY4(FH+22) BYTE POSITION OF KEY NO. 4 H0500263 EQU INDLEN(POSKY4-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION H0500264* OF FCB FOR AN INDEXED FILE H0500265* THE FOLLOWING PORTION OF THE FCB EXISTS ONLY H0500266* ON MASS MEMORY. THESE 10 WORDS ARE NOT LOADEDH0500267* INTO EITHER OF THE FILE MANAGER CONTROLLED FCBH0500268* TABLES. H0500269 EQU TSFILM(FH+23) TOTAL NUMBER OF SECTORS IN FILE, MSB H0500270 EQU TSFILL(FH+24) TOTAL NUMBER OF SECTORS IN FILE, LSB H0500271 EQU NAME12(FH+25) FILE NAME, CHARACTERS 1 AND 2 H0500272 EQU NAME34(FH+26) FILE NAME, CHARACTERS 3 AND 4 H0500273 EQU NAME56(FH+27) FILE NAME, CHARACTERS 5 AND 6 H0500274 EQU NAME78(FH+28) FILE NAME, CHARACTERS 7 AND 8 H0500275 EQU OWNR12(FH+29) OWNER NAME, CHARACTERS 1 AND 2 H0500276 EQU OWNR34(FH+30) OWNER NAME, CHARACTERS 3 AND 4 H0500277 EQU OWNR56(FH+31) OWNER NAME, CHARACTERS 5 AND 6 H0500278 EQU OWNR78(FH+32) OWNER NAME, CHARACTERS 7 AND 8 H0500279 EQU BYTLEN(FH+33) BYTE LENGTH OF RECORD H0500280ÐÐ* H0500281* FOR COMPRESS ONLY H0500282* H0500283 EQU PRSRNM(FH+34) RRN OF LAST PROCESSED RECORD - MSB H0500284 EQU PRSRNL(FH+35) RRN OF LAST PROCESSED RECORD - LSB H0500285 EQU NEWRNM(FH+36) RRN OF THE LATEST 'NEW' RECORD - MSB H0500286 EQU NEWRNL(FH+37) RRN OF THE LATEST 'NEW' RECORD - LSB H0500287 SPC 4 H0500288* WORDS 0 THRU 4 OF THE FCB HEADER AND WORDS H0500289* 6 THRU 10 OF THE FCB ARE REFERRED TO AS THE H0500290* SHARED SUBSET OF THE FCB. THEY INCLUDE THE H0500291* ONLY FCB WORDS THAT CAN BE MODIFIED AFTER FILEH0500292* CREATION. IF TWO OR MORE USERS HAVE THE SAME H0500293* FILE OPEN, THERE HAS TO BE A SINGLE MASTER H0500294* COPY OF THE SUBSET THAT RECEIVES (AND RECORDS)H0500295* ALL OF THE UPDATES. THE CONTROLLED SUBSET H0500296* WILL ALWAYS BE PART OF A MAIN MEMORY RESIDENT H0500297* FCB IF THE FCB IS IN A FM CONTROLLED TABLE. H0500298* IF THE FCB IS IN USER SPACE, THE SUBSET MAY ATH0500299* TIMES RESIDE IN THE SUBSET CONTROL TABLE. H0500300 SPC 2 H0500301* ALTERNATE NAMES FOR SUBSET WORDS H0500302 EQU SAFCBI(FH+1) SUBSET ALTERNATE NAME FOR FCBIND H0500303 EQU SADATM(FH+2) SUBSET ALTERNATE NAME FOR NEDATM H0500304 EQU SADATL(FH+3) SUBSET ALTERNATE NAME FOR NEDATL H0500305ÐÐ EQU SANXTM(FH+4) SUBSET ALTERNATE NAME FOR NEXTBM H0500306 EQU SANXTL(FH+5) SUBSET ALTERNATE NAME FOR NEXTBL H0500307**** H0500308 EJT 0 H0500309**** H0500310*E H0500311* FILE TABLE STRUCTURE. H0500312LUN EQU LUN(ZERO) F.M. LOGICAL UNIT NUMBER H0500313FILNUM EQU FILNUM(1) F.M. FILE NUMBER H0500314RECLTH EQU RECLTH(FILNUM+1) RECORD LENGTH H0500315BUFLTH EQU BUFLTH(RECLTH+1) RECORD BLOCK LENGTH H0500316BUFWA EQU BUFWA(BUFLTH+1) FWA OF RECORD BLOCKED BUFFER H0500317RECNT EQU RECNT(BUFWA+1) NUMBER OF RECORDS ENCOUNTERED H0500318DOCNT EQU DOCNT(RECNT+2) NUMBER OF RECORDS PROCESSED H0500319ERRCNT EQU ERRCNT(DOCNT+2) NUMBER OF ERRORS FOUND FOR FILE H0500320RECFWA EQU RECFWA(ERRCNT+1) FWA OF NEXT RECORD IN BLOCK H0500321XFRLTH EQU XFRLTH(RECFWA+1) RECORD BLOCK LENGTH FOR I/O H0500322REQBUF EQU REQBUF(XFRLTH+1) REQUEST BUFFER H0500323REQIND EQU REQIND(REQBUF+24) REQUEST INDICATOR H0500324FCB EQU FCB(REQIND+1) FILE CONTROL BLOCK H0500325 EQU FMSLOP(2) FCB OVERFLOW CORE SPACE INTO FCB INDEX SECT. H0500326FTSIZE EQU FTSIZE(FCB+SEQLTH+FH+1+FMSLOP) SIZE OF FILE TABLE H0500327**** H0500328 EJT H0500329**** H0500330ÐÐ*E H0500331*SMC FIXED-TABLE STRUCTURE. H0500332 SPC 2 H0500333YNAMFL EQU YNAMFL(ZERO) () = FWA ASCII FILE, OWNER, VOLUME TABLE H0500334YIFTAD EQU YIFTAD(1) () = FWA OF INPUT FILE TABLE (FT) H0500335YADOUT EQU YADOUT(YIFTAD+1) () = KEY OR DATA DESCRIPTION TABLE FOR REC.H0500336YKEY EQU YKEY(YADOUT+1) () = KEY TABLE FOR SORT FIELDS H0500337YADRBF EQU YADRBF(YKEY+1) () = ADDROUT CONVERSION SPACE FOR RECORD H0500338YFIELD EQU YFIELD(YADRBF+1) () = RECORD SELECTION TABLE H0500339YCOMPR EQU YCOMPR(YFIELD+1) () = KEY FIELD FOR RECORD SELECTION H0500340YSHIFT EQU YSHIFT(YCOMPR+1) () = KEY OFFSET SPACE FOR RECORD SELECTION H0500341YEND EQU YEND(YSHIFT+1) () = END OF VARIABLE TABLES H0500342YHICOR EQU YHICOR(YEND+1) () = TOTAL AVAILABLE SORT CORE MEMORY SPACEH0500343YEDTSZ EQU YEDTSZ(YHICOR+1) () = SIZE OF INPUT EDITOR OVERLAY H0500344YSRTSZ EQU YSRTSZ(YEDTSZ+1) () = SIZE OF SORT OVERLAY H0500345YIMGSZ EQU YIMGSZ(YSRTSZ+1) () = SIZE OF INTERMEDIATE MERGE OVERLAY H0500346YFMGSZ EQU YFMGSZ(YIMGSZ+1) () = SIZE OF FINAL MERGE OVERLAY H0500347YPHASE EQU YPHASE(YFMGSZ+1) () = OVERLAY NUMBER CURRENTLY EXECUTING H0500348YDM EQU YDM(YPHASE+1) () = NUMBER OF INPUT FILES H0500349YFLAG EQU YFLAG(YDM+1) () = BIT 15 - (0/1) = (TAG/ADDR) H0500350* 14 - (0/1) = (DATA/FULL RECORD) H0500351* 13 - (0/1) = (ASCII/EBCDIC) H0500352* 12 - (0/1) = (OMIT/INCLUDE) H0500353YG EQU YG(YFLAG+1) () = NUMBER OF SORT BINS (RECORDS) H0500354YIWAY EQU YIWAY(YG+1) () = MAX NUMBER OF INTERMEDIATE MERGE FILESH0500355ÐÐYFWAY EQU YFWAY(YIWAY+1) () = MAX NUMBER OF FINAL MERGE FILES H0500356YMAXIB EQU YMAXIB(YFWAY+1) () = INPUT BLOCK FACTOR (IN WORDS) H0500357YWKBSZ EQU YWKBSZ(YMAXIB+1) () = WORK SPACE AVAILABLE (IN WORDS) H0500358YIRCNT EQU YIRCNT(YWKBSZ+1) () = INPUT RECORD COUNT TO SORT H0500359YORCNT EQU YORCNT(YIRCNT+2) () = OUTPUT RECORD COUNT FROM SORT H0500360YSQ2MG EQU YSQ2MG(YORCNT+2) () = NUMBER OF MERGE FILES TO BE PROCESSED H0500361YSEQCT EQU YSEQCT(YSQ2MG+1) () = TOTAL NUMBER OF MERGE FILES H0500362YCMPKY EQU YCMPKY(YSEQCT+1) () = PROCESSOR - COMPARES KEYS H0500363YRCADD EQU YRCADD(YCMPKY+1) () = PROCESSOR - ACCUMULATES EXIST. REC CNTH0500364YGETU EQU YGETU(YRCADD+1) () = PROCESSOR - DEBLOCKS F.M. RECORDS H0500365YPUTU EQU YPUTU(YGETU+1) () = PROCESSOR - BLOCKS F.M. RECORDS H0500366YCLSU EQU YCLSU(YPUTU+1) () = PROCESSOR - FLUSHES OUTPUT BUFFER H0500367YGTSEQ EQU YGTSEQ(YCLSU+1) () = PROCESSOR - FINDS MERGE STRING TO USE H0500368YBOS EQU YBOS(YGTSEQ+1) () = PROCESSOR - DEFINES MERGE WORK FILE H0500369YEOS EQU YEOS(YBOS+1) () = PROCESSOR - CLOSES MERGE WORK FILE H0500370YOFRL EQU YOFRL(YEOS+1) () = OUTPUT FILE RECORD SIZE (CHARS) H0500371YRECNT EQU YRECNT(YOFRL+1) () = RECORT COUNT FOR EACH FILE H0500372YOPEN EQU YOPEN(YRECNT+2) () = PROCESSOR - OPENS F.M. FILES H0500373YCLOSE EQU YCLOSE(YOPEN+1) () = PROCESSOR - CLOSES F.M. FILES H0500374YGTFCB EQU YGTFCB(YCLOSE+1) () = PROCESSOR - READS EXTENDED FCB H0500375YVOLSR EQU YVOLSR(YGTFCB+1) () = PROCESSOR - FIND F.M. LU FROM VOLUME H0500376YCLSEQ EQU YCLSEQ(YVOLSR+1) () = PROCESSOR - COLLATING SEQUENCE ROUTINEH0500377YMVCHR EQU YMVCHR(YCLSEQ+1) () = PROCESSOR - OFFSETS CHARACTER STRING H0500378YSVAQI EQU YSVAQI(YMVCHR+1) () = PROCESSOR - SAVES REGISTERS A,Q,I H0500379YREAQI EQU YREAQI(YSVAQI+1) () = PROCESSOR - RESTORES REGISTERS A,Q,I H0500380ÐÐ**** H0500381 EJT H0500382**** H0500383*E H0500384YCRMSG EQU YCRMSG(YREAQI+1) () = PROCESSOR - PRINTS MESSAGES TO CRT H0500385YTYPIN EQU YTYPIN(YCRMSG+1) () = PROCESSOR - INPUTS INPUT DIRECTIVES H0500386YBOMB EQU YBOMB(YTYPIN+1) () = PROCESSOR - TERMINATES RUN WITH ERROR H0500387YWIERD EQU YWIERD(YBOMB+1) () = PROCESSOR - REPORTS UNUSUAL ERROR H0500388YOFT EQU YOFT(YWIERD+1) () = FWA OF OUTPUT FILE TABLE H0500389YCMPLA EQU YCMPLA(YOFT+REQBUF) = PROCESSOR - ASCENDING LOGICAL BINARY H0500390YCMPLD EQU YCMPLD(YCMPLA+1) () = PROCESSOR - DESCENDING LOGICAL BINARY H0500391YCMCLA EQU YCMCLA(YCMPLD+1) () = PROCESSOR - ASCENDING EVEN COLUMN CHARH0500392YCMCLD EQU YCMCLD(YCMCLA+1) () = PROCESSOR DESCEND EVEN COLUMN CHAR H0500393YCMPWA EQU YCMPWA(YCMCLD+1) () = PROCESSOR - ASCENDING WORDS BINARY KEYH0500394YCMPWD EQU YCMPWD(YCMPWA+1) () = PROCESSOR - DESCENDING WRDS BINARY KEYH0500395YCMCUA EQU YCMCUA(YCMPWD+1) () = PROCESSOR - ASCENDING ODD COLUMN CHAR H0500396YCMCUD EQU YCMCUD(YCMCUA+1) () = PROCESSOR - DESCENDING ODD COLUMN CHARH0500397YOUTFT EQU YOUTFT(YOFT+FTSIZE) = LWA OF FIXED TABLES H0500398**** H0500399 EJT H0500400**** H0500401*E H0500402* MISC H0500403* ---- H0500404* H0500405ÐÐ* ** ENTRY POINTS ** H0500406* H0500407 ENT SMCSRT H0500408* H0500409* ** EXTERNALS ** H0500410* H0500411* NONE H0500412* H0500413* ** EQUATES ** H0500414* H0500415PLUG EQU PLUG($7FFF) H0500416**** H0500417 EJT 0 H0500418**** H0500419*E H0500420* MESSAGE PROCESSOR INDEX EQUATES H0500421 SPC 3 H0500422MSGCLS EQU MSGCLS(1) 'CLOSFL REQIND = $ ' H0500423MSGOPN EQU MSGOPN(2) 'OPENFL REQIND = $ ' H0500424MSGDEL EQU MSGDEL(3) 'DELETE REQIND = $ ' H0500425MSGCRT EQU MSGCRT(4) 'CREATE REQIND = $ ' H0500426MSGRDD EQU MSGRDD(5) 'GETS REQIND = $ ' H0500427MSGWTD EQU MSGWTD(6) 'PUTS REQIND = $ ' H0500428MSGTFB EQU MSGTFB(7) 'GETFCB REQIND = $ ' H0500429MSGFCB EQU MSGFCB(8) 'UPDFCB REQIND = $ ' H0500430ÐÐMSGVOL EQU MSGVOL(9) 'VOLUME= ' H0500431MSFFNO EQU MSGFNO(10) 'FILNAM= ' H0500432* H0500433FM EQU FM(10) SIZE OF F.M. MESSAGE INDEX BLOCK H0500434* H0500435MSGABE EQU MSGABE(FM+1) 'ABNORMAL ERROR = ' H0500436MSGBDR EQU MSGBDR(FM+2) 'BLKSIZ/RECLTH .NE. 1,2,3...' H0500437MSGBLK EQU MSGBLK(FM+3) ' ' H0500438MSGBOM EQU MSGBOM(FM+4) 'FATAL ERROR' H0500439MSGDUN EQU MSGDUN(FM+5) 'DONE = ' H0500440MSGESC EQU MSGESC(FM+6) 'TYPE-IN ERROR' H0500441MSGEXP EQU MSGEXP(FM+7) 'EXPECTED /FOUND ' H0500442MSGIFL EQU MSGIFL(FM+8) 'CANNOT OPEN INPUT FILE' H0500443MSGTLC EQU MSGTLC(FM+9) 'TOO LITTLE CORE' H0500444MSGINE EQU MSGINE(FM+10) 'INTERPHASE RECORD COUNTS DISAGREE' H0500445MSGINP EQU MSGINP(FM+11) PRINTS INPUT DIRECTIVE CARD H0500446MSGPAS EQU MSGPAS(FM+12) 'PASSED = ' H0500447MSGSDE EQU MSGSDE(FM+13) 'SEQ. DIR. ERROR' H0500448MSGTLD EQU MSGTLD(FM+14) 'TOO LITTLE DISK' H0500449MSGTRC EQU MSGTRC(FM+15) 'OUTPUT RECORD COUNT BAD' H0500450MSGIFR EQU MSGIFR(FM+16) 'INPUT FILE LENGTHS ARE NOT EQUAL' H0500451MSGFLN EQU MSGFLN(FM+17) 'FN= , ' H0500452MSGOFR EQU MSGOFR(FM+18) 'OUTPUT FILE RECORD LENGTH IS ZERO' H0500453MSGASO EQU MSGASO(FM+19) 'ADDROUT SORTS ONLY 1 FILE' H0500454MSGVNM EQU MSGVNM(FM+20) 'VOLUME NOT MOUNTED' H0500455ÐÐMSGSOK EQU MSGSOK(FM+21) 'START OF KEY FIELD OUTSIDE OF RECORD' H0500456MSGKEB EQU MSGKEB(FM+22) 'KEY FIELD EXTENDS BEYOND END OF RECORD' H0500457**** H0500458 EJT H0500459SMCSRT NUM 0 H0500460 RTJ INIT INITIALIZE SMCSRT. H0500461HERE EQU HERE(*) RELOC REFERENCE POINT. H0500462MAINLP RTJ GET SUBMIT A REAL OR DUMMY RECORD TO THE TOURNAMENT.H0500463 RTJ TOURN RUN THE TOURNAMENT. H0500464 RTJ PUT DISPOSE OF THE WINNER, REAL OR DUMMY. H0500465 JMP* MAINLP REPEAT CYCLE UNTIL TOURNAMENT IS FLUSHED. H0500466ENDSRT LDQ FWAFXY (Q) = FWA OF FIXED TABLES. H0500467 LDA =XYOFT,Q H0500468 EOR FWAOFT H0500469 SAN ENDOUT SKIP IF NOT CORE SORT H0500470 LDA- YORCNT+1,Q (A) = LOW ORDER OUTPUT RECORD COUNT H0500471 EOR- YIRCNT+1,Q COMPARE WITH INTERNAL SORT H0500472 SAN ENDERR SKIP IF BAD RECORD COUNT H0500473 LDA- YORCNT,Q (A) = HIGH ORDER OUTPUT RECORD COUNT H0500474 EOR- YIRCNT,Q COMPARE WITH INTERNAL SORT H0500475 SAZ ENDOUT SKIP IF RECORD COUNT AGREES H0500476ENDERR ENQ MSGTRC 'OUTPUT RECORD COUNT BAD' H0500477 JMP IEOR14 PRINT MESSAGE THEN BOMB H0500478ENDOUT JMP* (SMCSRT) EXIT TO SMC MONITOR. H0500479 EJT H0500480ÐÐ**** H0500481*E H0500482* ******** H0500483* * IEOR * H0500484* ******** H0500485* H0500486* H0500487* IEOR MAKES SEVERAL INPUT FILES SEEM LIKE ONE FILE . H0500488* EACH INPUT FILE IS READ IN THE ORDER IT WAS SPECIFIED ON THE FN CARD. H0500489* THE CALLING SEQUENCE IS P RTJ IEOR H0500490* P+1 END-OF-INPUT. H0500491* P+2 NORMAL. (A) = FWA OF RECORD. H0500492* (Q) = LENGTH, IN WORDS, OF RECORH0500493* (I)EXIT = FWA OF FILE TABLE EXPANSION. H0500494**** H0500495IEOR NUM 0 H0500496 LDA FWAIFT (A) = FWA OF EXPANDED FILE TABLE. H0500497 STA- I (I) = FWA OF EXPANDED FILE TABLE. H0500498*THE BELOW INST. BECOMES NOP VIA IEOR01. H0500499* THUS, WE BEGIN IEOR BY GOING TO IEOR01 TO GET THE 1ST FILE. H0500500* LATER, WE WILL GO TO IEOR01 TO GET THE NEXT FILE, H0500501* WHENEVER THE CURRENT FILE ENDS. H0500502IEOR08 JMP* IEOR01 GET 1ST FILE. H0500503* INIT REPLACES PLUG BELOW WITH FWA OF GETU. H0500504IEOR03 RTJ+ PLUG GET NEXT RECORD. H0500505ÐÐ JMP* IEOR00 IF EOF, THEN JMP TO GET NEXT FILE. H0500506 RAO* IEOR SET UP P+2 EXIT. H0500507 JMP* (IEOR) P+2 EXIT. H0500508* INIT REPLACES PLUG BELOW WITH FWA OF CLOSE H0500509IEOR00 RTJ+ PLUG CLOSE INPUT FILE H0500510IEOR01 LDA* IEOR05 (A) = NOP. H0500511 STA* IEOR08 DEACTIVATE IEOR08. H0500512 LDQ* OVRUFT (Q) = 1 + LWA OF UNEXPANDED INPUT FILE TABLES. H0500513 LDA* IEOR02 (A) = FWA OF NEW FILE TABLE. H0500514 EAQ Q (Q)=0 IF NO MORE FILE TABLES TO EXPAND. H0500515 SQN IEOR04 SKIP IF WE GOT A FILE TABLE. H0500516 JMP* (IEOR) P+1 EXIT IF NO MORE FILES. H0500517OVRUFT NUM 0 () = 1 + LWA OF UNEXPANDED INPUT FILE TABLESH0500518IEOR04 STA MVSRCE TELL MOVE WHERE TO GET FILE TABLE. H0500519 ENQ BUFWA TELL MOVE HOW MUCH TO MOVE. H0500520 AAQ A (A) = FWA OF NEXT FILE TABLE. H0500521 STA* IEOR02 REMEMBER FWA OF NEXT FILE TABLE. H0500522 LDA- I (A) = FWA OF FILE TABLE EXPANSION. H0500523 STA MVDEST TELL MOVE WHERE TO PUT FILE TABLE. H0500524 RTJ MOVE MOVE NEW FILE TABLE TO EXPANSION AREA. H0500525* INIT REPLACES PLUG BELOW WITH FWA OF OPEN H0500526IEOR12 RTJ+ PLUG OPEN INPUT FILE H0500527 JMP* IEOR13 ERROR TRYING TO OPEN FILE H0500528 JMP* IEOR03 DO 1ST GET ON NEW FILE. H0500529IEOR13 ENQ MSGIFL 'CANNOT OPEN INPUT FILE' H0500530ÐÐ* INIT REPLACES PLUG BELOW WITH FWA OF CRTMSG H0500531IEOR14 RTJ+ PLUG TYPE THE MESSAGE H0500532 SET A,Q H0500533* INIT REPLACES PLUG BELOW WITH FWA OF BOMB H0500534IEOR15 JMP+ PLUG H0500535 SPC 3 H0500536*IEOR02 MUST BE INITIALIZED AT RUN TIME. H0500537IEOR02 NUM 0 FWA OF CURRENT FILE TABLE. H0500538IEOR05 NOP 0 USE TO DEACTIVATE LOGIC. H0500539IEORFT BZS IEORFT(FTSIZE) EXPANSION OF INPUT FILE TABLE FROM EDIT. H0500540 BZS (INDLEN-SEQLTH) ALLOW FOR POSSIBLE INDEX FILE -EXPAND FCBH0500541 EJT H0500542**** H0500543*E H0500544* ******** H0500545* * MOVE * H0500546* ******** H0500547* H0500548* H0500549* MOVE RIGHT TO LEFT. H0500550* MOVE MUST BE FAST. DURING A SINGLE SORT RUN, MOVE MOVES EACH BYTE OF H0500551* EACH LOGICAL RECORD SEVERAL TIMES, DESPITE THE FACT THAT THE NUMBER OFH0500552* SUCH MOVES IS REDUCED BY MOVING POINTERS INSTEAD OF LOGICAL RECORDS, H0500553* WHENEVER POSSIBLE. H0500554* WORD-TIMES = 4 + 9 * WORDS-TO-MOVE, E.G. 364 = F(80 BYTES), 4 = F(0). H0500555ÐÐ* THE CALLING SEQUENCE IS (MVSRCE)ENTRY = FWA OF SOURCE. H0500556* (MVDEST)ENTRY = FWA OF DESTINATION. H0500557* (Q)ENTRY = NO. OF WORDS TO MOVE. H0500558* RTJ MOVE MOVE IFF (Q)ENTRY .GE. 1. H0500559* (A)EXIT = (LAST WORD MOVED). H0500560* (Q)EXIT = -1. H0500561* (I),(MVSRCE),(MVDEST) EXIT = ENTRY. H0500562**** H0500563MOVE NUM 0 H0500564MVLOOP INQ -1 (Q) = FWA NEXT SOURCE WORD - FWA OF SOURCE, H0500565* = FWA NEXT DESTINATION WORD - FWA OF DESTINATION.H0500566 SQP MVLDA SKIP IF MORE WORDS TO MOVE. H0500567 JMP* (MOVE) EXIT. H0500568MVLDA LDA* (MVSRCE),Q (A) = (NEXT WORD TO MOVE). H0500569 STA* (MVDEST),Q MOVE A WORD. H0500570 JMP* MVLOOP EXIT OR MOVE NEXT WORD. H0500571MVSRCE NUM 0 () = FWA OF SOURCE. H0500572MVDEST NUM 0 () = FWA OF DESTINATION. H0500573 EJT H0500574**** H0500575*E H0500576* ******* H0500577* * GET * H0500578* ******* H0500579* H0500580ÐÐ* H0500581* EACH RECORD READ IS MOVED INTO THE SLOT IN THE RECORD BIN AREA FOR THEH0500582* PREVIOUS WINNER. IF THE NEW RECORD IS SEQUENCED SUCH THAT IT CAN BE H0500583* ADDED TO THE CURRENT OUTPUT MERGE STRING AND CONTINUE TO MAINTAIN H0500584* SORT ORDER, THEN IT IS FLAGGED IN THE SEQUENCE DIRECTORY AS A H0500585* CANDIDATE FOR SORTING DURING THIS SEQUENCE. OTHERWISE IT BECOMES A H0500586* CANDIDATE FOR THE NEXT SORT SEQUENCE. INITIALLY ALL INPUT RECORDS H0500587* BECOME A CANDIDATE FOR THE NEXT SEQUENCE UNTIL EITHER (1) ALL RECORD H0500588* BINS ARE FULL, OR (2) UNTIL ALL INPUT RECORDS READ (LESS INPUT RECORDSH0500589* THAN RECORD BINS TO HOLD RECORDS). H0500590* H0500591* AN ADDROUT SORT MUST CONVERT THE INPUT RECORD INTO AN ADDROUT RECORD H0500592* PRIOR TO MOVING THE RECORD INTO A RECORD BIN SLOT. THIS IS REQUIRED H0500593* BECAUSE THE NEW RECORD MUST BE COMPARED TO THE LAST WINNER RECORD TO H0500594* DETERMINE IF THE NEW RECORD IS A CANDIDATE FOR SORTING INTO THE H0500595* CURRENT MERGE STRING. THE ORIGINAL INPUT RECORD AREA MAY NOT BE H0500596* LARGE ENOUGH FOR THE ADDROUT RECORD, SINCE ADDROUT RECORD CONTAINS H0500597* IN ADDITION TO KEYS THE RELATIVE RECORD NUMBERS. ALSO OVERLAPPING H0500598* KEYS WILL INCREASE THE SIZE OF THE ADDROUT RECORD. THEREFORE VARIABLEH0500599* TABLE SPACE SPECIFIED BY YADRBF DEFINES THE AREA USED TO CONVERT INPUTH0500600* RECORDS TO ADDROUT RECORDS. H0500601* H0500602* END OF FILE IS INDICATED BY IEOR SUBROUTINE WHEN ALL INPUT RECORDS H0500603* FROM ALL INPUT FILES HAVE BEEN READ. THE GET SUBROUTINE WILL DO A H0500604* CORE SORT IF: H0500605ÐÐ* 1. ALL RECORDS FIT INTO RECORD STORAGE BIN AREA. H0500606* 2. THE MERGE BUFFER LENGTH PLUS THE INPUT BUFFER SIZE IS LARGE H0500607* ENOUGH TO CONTAIN THE FINAL OUTPUT BUFFER SIZE. H0500608* H0500609* IF NO RECORDS ARE READ, THE SORT WILL BE TERMINATED. H0500610* THE CALLING SEQUENCE IS RTJ GET H0500611* H0500612**** H0500613GETLEN NUM 0 () = (Q) FROM IEOR, I.E. REC. LENGTH. H0500614GET NUM 0 H0500615*THE NOP BELOW IS REPLACED WITH JMP* GETMAX-GETEHK AT EOI. H0500616GETEHK NOP 0 H0500617 RTJ IEOR GET NEXT RECORD. H0500618 JMP* GETEOI JMP IF END OF INPUT. H0500619 STA* MVSRCE TELL MOVE FWA OF NEW RECORD. H0500620 STQ* GETLEN SAVE RECORD LENGTH. H0500621***WARNING*** H0500622* FOR PROPER HANDLING OF TIES, CALL CMPKEY WITH (A) = FWA OF LAST WINNERH0500623* AND (Q) = FWA OF NEW RECORD. THIS WILL ALLOW A SERIES OF EQUAL RECORDSH0500624* TO ENTER THE SAME SEQUENCE, DUE TO CMPKEY SETTING (A),(Q) EXIT = H0500625* (A),(Q) ENTRY FOR TIES. H0500626 TRA Q (Q) = FWA OF NEW RECORD. H0500627 LDA* TFWA (A) = FWA OF LAST WINNER BIN. H0500628 STA* MVDEST TELL MOVE WHERE TO PUT NEW RECORD. H0500629*THE INSTRUCTION BELOW IS REPLACED WITH NOP WHEN 1ST REAL RECORD WINS H0500630ÐÐ*TOURNAMENT. H0500631GETNIT JMP* GETNXT PUT 1ST G RECORDS IN NEXT SEQ. H0500632* INIT REPLACES PLUG BELOW WITH FWA OF CMPKEY. H0500633GETCMP RTJ+ PLUG COMPARE NEW RECORD TO LAST WINNER. H0500634ADRKEY ADC *-* ADDRESS OF KEY TABLE H0500635 SUB* TFWA (A)=0 IF LAST WINNER BEAT NEW RECORD. H0500636 SAZ GETCUR SKIP IF LAST WINNER BEAT NEW RECORD. H0500637GETNXT ENA 1 BEGIN TO COMPUTE NEXT SEQUENCE NUMBER. H0500638GETCUR ADD* CURSEQ (A) = SEQUENCE NUMBER, EITHER CURRENT OR NEXT. H0500639 STA* GETNRS REMEMBER SEQUENCE NUMBER. H0500640 LDQ* GETLEN TELL MOVE HOW MUCH TO MOVE. H0500641 RTJ* MOVE MOVE NEW RECORD TO BIN OF LAST WINNER. H0500642 LDA* GETNRS (A) = SEQUENCE NUMBER, EITHER CURRENT OR NEXT. H0500643GETSEQ LDQ* TRIAL (Q) = NO. OF WINNER BIN, 0...G-1. H0500644 STA* (FWASEQ),Q SET SEQ. NO. INTO SEQ. ARRAY. H0500645 JMP* (GET) EXIT. H0500646GETNRS NUM 0 () = SEQUENCE NUMBER OF NEW RECORD. H0500647GBIG NUM 0,0 () = TWO-WORD FORM OF G. H0500648GETEOI LDQ FWAFXY (Q) = FWA OF FIXED TABLES. H0500649 LDA* GBIG (A) = HIGH ORDER G. H0500650 SUB- YIRCNT,Q COMPARE WITH INPUT RECORD COUNT. H0500651 SAM GETP2X SKIP IF INPUT RECORD COUNT .GT. G. H0500652 SAN GETZCK SKIP IF INPUT RECORD COUNT .LT. G. H0500653* HIGH ORDER VALUES TIE. LET US COMPARE LOW ORDER VALUES. H0500654 LDA- YIRCNT+1,Q (A) = LOW ORDER INPUT RECORD COUNT. H0500655ÐÐ SUB* GBIG+1 COMPARE WITH LOW ORDER G. H0500656 SAM GETZCK SKIP IF INPUT RECORD COUNT .LT. G. H0500657* MERGING IS NEEDED SINCE RECORD COUNT .GE. G. H0500658GETP2X RAO SMCSRT TELL SMCMON THAT MERGING IS NEEDED. H0500659GETSHK LDA* GETJMP (A) = JMP* GETMAX-GETEHK. H0500660* FORCE FLUSH OF TOURNAMENT AND BYPASS OF RTJ IEOR. H0500661 STA* GETEHK H0500662GETMAX LDA* MAXSEQ (A) = $7FFF,$7FFE,$7FFD,...,$7FFF-G+1. H0500663 INA -1 (A) = $7FFE,$7FFD,$7FFC,...,$7FFE-G+1. H0500664 STA* MAXSEQ MAKE EACH LOSING DUMMY DIFFER IN SEQ. NO. H0500665 JMP* GETSEQ JMP TO SET SEQ. NO. INTO SEQ. ARRAY. H0500666* WE KNOW G .GE. INPUT RECORD COUNT. LET US CHECK FOR NULL INPUT. H0500667GETZCK LDA- YIRCNT+1,Q (A) = LOW ORDER INPUT RECORD COUNT. H0500668 SAN GETBCK SKIP IF NON-NULL INPUT. H0500669 LDA- YIRCNT,Q (A) = HIGH ORDER INPUT RECORD COUNT. H0500670 SAN GETBCK SKIP IF NON-NULL INPUT. H0500671 JMP ENDSRT VIA P+1 EXIT, TELL SMCMON THAT RUN IS OVER. H0500672GETJMP JMP* GETMAX-GETEHK+* USED TO MODIFY TOURN FOR FLUSHING. H0500673* WE KNOW THAT TOURN CURRENTLY HOLDS ONE NON-NULL SEQUENCE CONTAINING H0500674* ALL THE INPUT RECORDS. LET US CHECK WHETHER SMCSRT CAN AFFORD THE H0500675* FINAL-OUTPUT BUFFER. H0500676GETBCK LDA* FWARSA (A) = 1 + LWA OF TOTAL IO BUFFER SPACE. H0500677* (SOUTFT+BUFWA) = FWA OF DATA-AREA OF OUTPUT-BUFFER. H0500678 SUB SOUTFT+BUFWA (A) = BUFFER-DATA SIZE SMCSRT CAN AFFORD. H0500679 SUB- YOFT+BUFLTH,Q SUBTRACT DATA-SIZE OF FINAL-OUTPUT BUFFER. H0500680ÐÐ SAP GETTDP SKIP IF SMCSRT CAN AFFORD FINAL-OUTPUT BUFFEH0500681 JMP* GETP2X WE WILL HAVE TO OUTPUT TO A WORK FILE. H0500682* MODIFY SMCSRT TO DUMP RSA OF TOURN DIRECTLY TO FINAL-OUTPUT FILE. H0500683GETTDP LDA =XYOFT,Q (A) = FWA OF FINAL-OUTPUT FILE TABLE. H0500684 STA FWAOFT TELL SMCSRT TO OUTPUT TO FINAL-OUTPUT FILE. H0500685 LDA =N$0B00 (A) = NOP INSTRUCTION. H0500686 STA PUTBOS DISABLE USE OF STRING-DIRECTORY. H0500687 STA PUTBOS+1 H0500688 LDA- YCLSU,Q (A) = FWA OF CLSU. H0500689 STA PUTEOS+1 DISABLE USE OF STRING-DIRECTORY. H0500690 LDA- YOFRL,Q OUTPUT RECORD SIZE (CHARS) H0500691 INA 1 ROUND UP H0500692 ARS 1 CONVERT TO WORDS H0500693 STA- YOFT+RECLTH,Q INFORM WRITE ROUTINE OF FINAL OUTPUT REC SIZE H0500694 JMP* GETSHK PREPARE TO FLUSH RSA. H0500695 EJT H0500696**** H0500697*E H0500698* ********* H0500699* * TOURN * H0500700* ********* H0500701* H0500702* H0500703* THE TOURN SUBROUTINE IS USE TO SELECT THE NEXT WINNING RECORD FROM H0500704* THE G RECORDS CONTAINED IN THE RECORD BINS. SOME OF THESE RECORDS H0500705ÐÐ* MAY BE DUMMY RECORDS IF THE RECORD BIN IS NOT FULL. THE INITIAL H0500706* TRIAL RECORD IS THE LAST RECORD STORED INTO THE RECORD BIN. ITS H0500707* SEQUENCE NUMBER IS COMPARED TO ALL OF ITS COMPETITORS UNTIL ITS H0500708* SEQUENCE NUMBER IS GREATER THAN A COMPETITOR OR IN THE CASE OF TIES H0500709* THE KEY VALUES OF THE COMPETITOR WIN OVER THE TRIAL RECORD. WHEN A H0500710* COMPETITOR RECORD WINS, THE ROLE OF THE COMPETITOR AND TRIAL RECORD H0500711* SWITCH. THE OLD TRIAL RECORD BECOMES AN ENTRY IN THE TAG STORAGE H0500712* AREA. TO INITIALLY SELECT A COMPETITOR ENTRY, G-1-TRIAL BECOMES THE H0500713* FIRST SELECTION. THIS INDEX REPRESENTS BOTH THE RECORD ORDINAL IN H0500714* THE RECORD BIN AND AN ORDINAL IN THE TAG STORAGE AREA USED TO SELECT H0500715* AN ENTRY FROM THE SEQUENCE NUMBER ARRAY. AFTER COMPARING THE TRIAL H0500716* TO THE COMPETITOR AND ESTABLISHING THE WINNER, THE NEXT COMPETITOR H0500717* IS SELECTED BY TAKING HALF OF THE OLD COMPETITOR INDEX (BINARY SEARCH)H0500718* AND USE THIS VALUE AS THE NEW COMPETITOR INDEX. WHEN THIS INDEX H0500719* BECOMES ZERO, THE BINARY SELECTION PROCESS IS COMPLETED AND THE H0500720* CURRENT TRIAL ENTRY BECOMES THE WINNER. H0500721* THE CALLING SEQUENCE IS RTJ TOURN H0500722* H0500723**** H0500724TRIAL NUM 0 () = BIN INDEX OF TRIAL RECORD. H0500725FWASEQ NUM 0 () = FWA OF SEQ. NO. ARRAY. H0500726FWARSA NUM 0 () = FWA OF RECORD STORAGE AREA. H0500727TFWA NUM 0 () = FWA OF TRIAL BIN. H0500728MAXSEQ NUM $7FFF () = 1 + SEQ. NO. OF NEXT LOSING DUMMY. H0500729CURSEQ NUM 0 () = NO. OF CURRENT SEQUENCE. H0500730ÐÐTOURN NUM 0 H0500731 LDQ* TRIAL (Q) = BIN INDEX OF TRIAL RECORD. H0500732 LDA* (FWASEQ),Q (A) = SEQ. NO. OF TRIAL RECORD. H0500733 QRS 1 (Q) = FLOOR(TRIAL BIN INDEX/2). H0500734 TCQ Q (Q) = -FLOOR(TRIAL BIN INDEX/2). H0500735 ADQ* TAGCNT (Q) = INDEX OF BASE TAG OF TRIAL AND COMPETITOR.H0500736 STQ- I (I) = INDEX OF CURRENT TAG. H0500737CMPSEQ LDQ* (PRETSA),I (Q) = INDEX OF COMPETITOR BIN. H0500738 SUB* (FWASEQ),Q (A) = TRIAL SEQ. NO. - COMPETITOR SEQ. NO. H0500739 SAM TWINS SKIP IF TRIAL WINS DUE TO LOWER SEQ. NO. H0500740 SAN CWINS SKIP IF TRIAL LOSES DUE TO HIGHER SEQ. NO. H0500741 JMP* SEQTIE JMP IF SEQUENCE NUMBERS TIE. H0500742CWINS LDA* TRIAL (A) = BIN INDEX OF TRIAL RECORD. H0500743 LDQ* (PRETSA),I (Q) = INDEX OF COMPETITOR BIN. H0500744 STA* (PRETSA),I RECORD TRIAL AS LOSER. H0500745 STQ* TRIAL RECORD COMPETITOR AS NEW TRIAL. H0500746 JMP* TWINS1 SEE IF THERE IS A NEXT TREE LEVEL. H0500747TWINS LDQ* TRIAL (Q) = BIN INDEX OF TRIAL RECORD. H0500748TWINS1 LDA- I (A) = INDEX OF LAST TAG. H0500749 ARS 1 (A) = INDEX OF CURRENT TAG. H0500750 SAN NXTLVL SKIP IF THERE IS A NEXT TREE LEVEL. H0500751 TRQ A (A) = BIN INDEX OF WINNER RECORD. H0500752 MUI* BINSIZ H0500753 ADD* FWARSA (A) = FWA OF WINNER RECORD. H0500754 STA* TFWA (A) = FWA OF TRIAL BIN. H0500755ÐÐ JMP* (TOURN) EXIT IF END OF TREE. H0500756NXTLVL STA- I UPDATE TREE LEVEL. (I) = INDEX OF CURRENT TAG. H0500757 LDA* (FWASEQ),Q (A) = SEQ. NO. OF TRIAL. H0500758 JMP* CMPSEQ H0500759SEQTIE TRQ A (A) = BIN INDEX OF COMPETITOR RECORD. H0500760 MUI* BINSIZ H0500761 ADD* FWARSA (A) = FWA OF COMPETITOR RECORD. H0500762 STA* CFWA SAVE FWA OF COMPETITOR RECORD. H0500763 LDA* TRIAL (A) = BIN INDEX OF TRIAL RECORD. H0500764 MUI* BINSIZ H0500765 ADD* FWARSA (A) = FWA OF TRIAL RECORD. H0500766 LDQ* CFWA (Q) = FWA OF COMPETITOR RECORD. H0500767***WARNING*** H0500768* EFFICIENCY DEMANDS THAT TRIAL WINS TIES. H0500769* CALL CMPKEY WITH (A)ENTRY = FWA OF TRIAL. H0500770* INIT REPLACES PLUG BELOW WITH FWA OF CMPKEY. H0500771TRNCMP RTJ+ PLUG (A) = FWA OF WINNER RECORD. H0500772KEYADR ADC *-* ADDRESS OF KEY TABLE H0500773 EOR* CFWA (A)=0 IF COMPETITOR WON. H0500774 SAZ JCWINS SKIP IF COMPETITOR WON. H0500775 JMP* TWINS JMP IF TRIAL WON. H0500776JCWINS JMP* CWINS JMP IF COMPETITOR WON. H0500777G NUM 0 () = TOTAL NO. OF RSA BINS, PSEUDO OR REAL. H0500778TAGCNT NUM 0 () = NO. OF TSA TAGS = G-1. H0500779PRETSA NUM 0 () = -1 + FWA OF TAG STORAGE AREA. H0500780ÐÐOVRTSA NUM 0 () = 1 + LWA OF TSA. H0500781BINSIZ NUM 0 () = NO. OF WORDS IN AN RSA BIN. H0500782CFWA NUM 0 () = FWA OF COMPETITOR RECORD. H0500783FWAFXY NUM 0 () = FWA OF FIXED TABLES. H0500784FWAIFT ADC IEORFT-HERE () = FWA OF EXPANDED INPUT FILE TABLE. H0500785FWAOFT ADC SOUTFT-HERE () = FWA OF OUTPUT FILE TABLE. H0500786 EJT H0500787**** H0500788*E H0500789* ******* H0500790* * PUT * H0500791* ******* H0500792* H0500793* H0500794* EACH CALL TO PUT SUBROUTINE ATTEMPTS TO MOVE ONE RECORD FROM THE H0500795* RECORD BIN TO THE OUTPUT BUFFER. INITIALLY THE RECORD TO BE SELECTED H0500796* WILL BE A DUMMY RECORD. UNTIL A RECORD IS FOUND WITH A WINNING H0500797* SEQUENCE NUMBER (VALUE OF 1 INITIALLY WINS), ALL DUMMY RECORDS ARE H0500798* IGNORED. ONCE A WINNING RECORD IS ACCEPTED, ALL RECORDS UNTIL A H0500799* TRAILING DUMMY RECORD IS FOUND, WILL BE BLOCKED INTO H0500800* THE OUTPUT BUFFER. THE TRAILING DUMMY RECORD INDICATES ALL REAL H0500801* RECORDS HAVE BEEN FLUSHED FROM TOURNAMENT. H0500802* H0500803* THE PUT SUBROUTINE WANTS TO OUTPUT TO THE SAME MERGE FILE UNTIL H0500804* EITHER: H0500805ÐÐ* 1. THE WORK FILE IS FULL OF RECORDS. H0500806* 2. NO MORE RECORDS CAN BE ADDED TO THE CURRENT MERGE STRING AND STILLH0500807* BE ABLE TO MAINTAIN SORT ORDER. H0500808* H0500809* WHEN THE WORK FILE MUST BE TERMINATED, A NEW WORK FILE IS CREATED TO H0500810* CONTINUE THE SORT. IF A CORE SORT CAN BE PERFORMED, THE WORK FILES H0500811* ARE REPLACED BY THE FINAL OUTPUT FILE. H0500812* THE CALLING SEQUENCE IS RTJ PUT H0500813* (P+1)EXIT = MORE REAL RECORD TO PROCESS H0500814* (ENDSRT)EXIT = ALL REAL RECORDS OUTPUT H0500815**** H0500816PUT NUM 0 H0500817 LDQ* FWAOFT (Q) = FWA OF OUTPUT FILE TABLE. H0500818 STQ- I TELL BOS,PUTU,EOS. H0500819 LDQ* TRIAL (Q) = NO. OF WINNER BIN. H0500820 LDA* (FWASEQ),Q (A) = SEQ. NO. OF WINNER. H0500821 SUB* CURSEQ (A) = WIN. SEQ. NO. - CUR. SEQ. NO. H0500822 SAZ PUTLTG SKIP IF WINNING-DUMMY OR CURRENT-SEQ. REAL. H0500823 SAP PUTGEG SKIP IF REAL RECORD OR LOSING DUMMY. H0500824*THE BELOW INSTRUCTION BECOMES A NOP WHEN THE 1ST REAL WINNER EMERGES. H0500825PUTLTG JMP* (PUT) EXIT. H0500826PUTPUT LDA* RECDEC SAVE MAX RECORD COUNT FOR FILE H0500827 INA -1 H0500828 STA* RECDEC H0500829 SAM PUTEOS SKIP IF FILE FULL OF RECORDS H0500830ÐÐ LDA* TFWA (A) = FWA OF WINNER BIN. H0500831* INIT REPLACES PLUG BELOW WITH FWA OF PUTU. H0500832PUTU RTJ+ PLUG OUTPUT THE LOGICAL RECORD. H0500833 JMP* (PUT) EXIT. H0500834*THE BELOW INSTRUCTION BECOMES A NOP WHEN THE 1ST REAL WINNER EMERGES. H0500835PUTGEG JMP* PUT1ST JUMP TO INITIALIZE FOR REAL RECORDS. H0500836* INIT REPLACES PLUG BELOW WITH FWA OF EOS. H0500837PUTEOS RTJ+ PLUG END THE CURRENT STRING. H0500838 LDQ* TRIAL (Q) = NO. OF WINNER BIN. H0500839 LDA* (FWASEQ),Q (A) = SEQ. OF WINNER BIN. H0500840 SUB* MAXSEQ (A) = WIN. SEQ. - MAX. SEQ. H0500841 SAM PUTGON SKIP IF REAL WINNER. H0500842 JMP ENDSRT JMP IF LOSING DUMMY. H0500843PUT1ST LDA* PUTNOP ALTER PUT LOGIC DUE TO EMERGENCE OF REAL WINNER.H0500844 STA* PUTLTG H0500845 STA* PUTGEG H0500846 STA GETNIT ALTER GET LOGIC DUE TO EMERGENCE OF REAL WINNER.H0500847PUTGON LDA* RECDEC H0500848 SAM PUTBOS SKIP IF WORKING ON SAME SEQUENCE H0500849 RAO CURSEQ NEXT SEQ BECOMES CURRENT. H0500850* INIT REPLACES PLUG BELOW WITH FWA OF BOS. H0500851PUTBOS RTJ+ PLUG BEGIN THE NEXT STRING. H0500852 LDQ* FWAFXY FIX TABLE ADDRESS H0500853 RAO- YSEQCT,Q MERGE FILE COUNT - SAVE FOR NEXT PHASE H0500854 RAO- YSQ2MG,Q MERGE FILE COUNT - SAVE FOR NEXT PHASE H0500855ÐÐ LDA- YRECNT+1,Q H0500856 STA* RECDEC SAVE MAX RECORD COUNT FOR FILE H0500857 JMP* PUTPUT OUTPUT THE RECORD. H0500858RECDEC NUM 0 RECORD DECREMENT COUNTER FOR MERGE FILE H0500859PUTNOP NOP 0 H0500860 EJT H0500861**** H0500862*E H0500863* ********** H0500864* * TURNIT * H0500865* ********** H0500866* H0500867* H0500868* THE TURNIT SUBROUTINE DEFINES TABLE SPACE FOR THE RECORD BIN AREA, H0500869* THE SEQUENCE NUMBER ARRAY, AND THE TAG STORAGE AREA. THE LATTER TWO H0500870* TABLES ARE PRESET WITH INITIAL VALUES PRIOR TO SORTING. THE MEM H0500871* SUBROUTINE IN OVERLAY SMCEDT DETERMINES THE AMOUNT OF SPACE THAT H0500872* COULD BE ASSIGNED TO THESE TABLES. H0500873* H0500874* FWARSA ************* H0500875* * RECORD(I) * H0500876* * . * RECORD BIN HOLDS G RECORDS H0500877* * . * H0500878* * . * H0500879* * RECORD(J) * H0500880ÐÐ* FWASEQ ************* H0500881* * 0 * H0500882* * 1 * H0500883* * . * H0500884* * . * THESE ARE THE PRESET SEQUENCE NUMBERS H0500885* * . * H0500886* * G-2 * H0500887* PRETSA * G-1 * THIS ENTRY IS SET TO $7FFF IF G IS ODD TO H0500888* ************* INDICATE DUMMY RECORD BIN H0500889* * G-2 * H0500890* * G-4 * (NOTE:PRETSA IS OFFSET ONE WORD POSITION) H0500891* * . * H0500892* * . * H0500893* * . * THESE VALUES ARE PRESET FOR THE TAG H0500894* * 2 * STORAGE AREA H0500895* * G-1 * H0500896* * G-3 * H0500897* * . * H0500898* * . * H0500899* * . * H0500900* * 1 * H0500901* OVRTSA ************* END OF TABLE SPACE (TOP OF CORE) H0500902* THE CALLING SEQUENCE IS (A)ENTRY = SIZE IN WORDS OF EACH RSA BIN. H0500903* (Q)ENTRY = NO. OF REAL RSA BINS. H0500904* (I)ENTRY = FWA OF FIXED TABLES. H0500905ÐÐ* (FWARSA)ENTRY = FWA OF THE RSA. H0500906* RTJ TURNIT H0500907* OUTPUTS ARE BINSIZ,TNITEG,G,TAGCNT,CURSEQ,FWASEQ,PRETSA,OVRTSA, H0500908* TRIAL,TFWA, SEQ. NO. ARRAY, TSA ARRAY, H0500909* (A)EXIT = (FWARSA), H0500910* (Q)EXIT=JUNK, (I)EXIT = (I)ENTRY. H0500911**** H0500912TURNIT NUM 0 H0500913 STA BINSIZ SAVE RSA BIN LENGTH FOR TOURN AND TURNIT. H0500914* THE FOLLOWING INQ,LRS,QLS ROUND (Q) UP TO THE NEAREST EVEN INTEGER. H0500915 INQ 1 (Q) = 1 + NO. OF REAL RSA BINS. H0500916 LRS 1 (Q) = HALF OF NEAREST EVEN NO. .GE. (Q)ENTRYH0500917 STA* TNITEG (TNITEG)15=1 IF NO. OF REAL BINS IS EVEN. H0500918 QLS 1 (Q) = NEAREST EVEN NO. .GE. (Q)ENTRY. H0500919 STQ* G (G) = TOTAL NO. OF RSA BINS, PSEUDO OR REAL.H0500920 INQ -1 (Q) = NO. OF TSA TAGS. H0500921 STQ* TAGCNT H0500922 STQ CURSEQ () .GE. SEQ. NO. OF ANY WINNING DUMMY. H0500923* COMPUTE RSA SIZE BY INITIALLY ASSUMING ALL RSA BINS ARE REAL BINS, H0500924* THEN, IF THERE WAS A PSEUDO BIN, WE SUBTRACT (BINSIZ). H0500925 LDA* G H0500926 MUI* BINSIZ (A) = (G)*(BINSIZ). H0500927 LDQ* TNITEG (Q)15=1 IF ALL BINS ARE REAL BINS. H0500928 SQM TNITRX SKIP IF ALL BINS ARE REAL BINS. H0500929 SUB* BINSIZ REPLACE A REAL BIN WITH A PSEUDO BIN. H0500930ÐÐ* WE ENTER THE NEXT LOGIC WITH (A) = NO. OF WORDS IN RSA. H0500931TNITRX ADD FWARSA ADD NO. OF WORDS IN RSA TO FWA OF RSA. H0500932 STA FWASEQ () = FWA OF SEQUENCE NUMBER ARRAY. H0500933 ADD* TAGCNT ADD -1 + SIZE OF SEQ. NO. ARRAY. H0500934 STA* PRETSA () = -1 + FWA OF TAG STORAGE AREA. H0500935 ADD* G ADD 1 + SIZE OF TAG STORAGE AREA. H0500936 STA* OVRTSA () = 1 + LWA OF TAG STORAGE AREA. H0500937* TENTATIVELY SET SEQ. NO. ARRAY AS IF NO. OF REAL BINS WERE EVEN. H0500938* LATER, WE WILL CHANGE THE SEQUENCE NO. OF THE LAST RSA BIN H0500939* TO $7FFF IF THE LAST RSA BIN IS A PSEUDO BIN, I.E. IF THE NO. OF H0500940* REAL BINS IS ODD. H0500941 LDQ* TAGCNT (Q) = G-1. H0500942TNITSQ STQ (FWASEQ),Q SET SEQ(I)=I FOR I=G-1 TO I=0 STEP -1. H0500943 SQZ TNITAG SKIP IF ALL SEQ. NUMBERS ARE SET. H0500944 INQ -1 DECREMENT INDEX. POINT TO NEXT SEQ. NO. H0500945 JMP* TNITSQ SET NEXT SEQ. NO. H0500946TNITEG NUM 0 ()15=1 IF NO. OF REAL BINS IS EVEN. H0500947TNITAG LDA G (A)=G SO THAT (A) MAY START = G-2 AT TNITA1.H0500948TNITA1 INA -2 (A) = (NEXT TAG). H0500949 SAM TNIDMY SKIP IF DONE WITH ALL TAGS. H0500950 SAZ TNITA2 SKIP IF DONE WITH NON-BASE TAGS. H0500951 INQ 1 POINT TO NEXT TAG TO SET. H0500952 STA* (PRETSA),Q SET TAGS = G-2,G-4,...,2,G-1,G-3,...,1. H0500953 JMP* TNITA1 SET NEXT TAG. H0500954TNITA2 LDA G H0500955ÐÐ INA 1 (A)=G+1 SO THAT (A) MAY START = G-1 AT TNITA1. H0500956 JMP* TNITA1 JMP TO DO BASE (I.E. LOWEST LEVEL) TAGS. H0500957* BECAUSE OF THE ABOVE LOGIC, (Q) = (TAGCNT) = (G) - 1. H0500958* BELOW, SET LAST SEQ. NO. TO $7FFF IF NO. OF REAL BINS IS ODD. H0500959TNIDMY LDA* TNITEG (A)15=1 IF NO. OF REAL BINS IS EVEN. H0500960 SAM TNITXT SKIP IF NO. OF REAL BINS IS EVEN. H0500961 LDA- HX7FFF A SEQ. NO. OF $7FFF CAUSES ETERNAL LOSER. H0500962 STA (FWASEQ),Q THE CORRESPONDING PSEUDO BIN CAN]T WIN NOW. H0500963* MAKE IT APPEAR THAT 1ST RSA BIN WAS THE LAST WINNER. H0500964TNITXT CLR A H0500965 STA TRIAL () = INDEX OF 1ST RSA BIN. H0500966 LDA FWARSA (A) = FWA OF RECORD STORAGE AREA. H0500967 STA TFWA () = FWA OF 1ST RSA BIN. H0500968 JMP* (TURNIT) EXIT. H0500969 EJT H0500970**** H0500971*E H0500972* ******** H0500973* * INIT * H0500974* ******** H0500975* H0500976* H0500977* INIT INITIALIZES THE INTERNAL SORT. H0500978* THE INIT SUBROUTINE READYS THE OUTPUT FILE TABLE FOR EITHER MERGING H0500979* OR CREATING FINAL OUTPUT FILE. ALSO THE BUFFER SPACE FOR THE OUTPUT H0500980ÐÐ* AND INPUT FILES ARE RESERVED. H0500981* H0500982* THE CORE LAYOUT ASSUMED IS H0500983* 1ST-DSORT H0500984* 2ND-SMCMON H0500985* 3RD-FIXED TABLES H0500986* 4TH-VARIABLE TABLES H0500987* 5TH-SMCSRT PERMANENT LOGIC H0500988* 6TH-SMCSRT TEMPORARY LOGIC AND WORK AREA H0500989* 7TH-TOP OF CORE H0500990* H0500991* THE WORK AREA LAYOUT IS H0500992* 1ST-FILE TABLE FOR OUTPUT WORK FILE H0500993* 2ND-BUFFER FOR OUTPUT WORK FILE H0500994* 3RD-BUFFER FOR INPUT FILE SET H0500995* 4TH-RECORD STORAGE AREA H0500996* 5TH-SEQUENCE NUMBER ARRAY H0500997* 6TH-TAG STORAGE AREA H0500998* H0500999* THE CALLING SEQUENCE IS (Q),(I)ENTRY = FWA OF SMCMON FIXED TABLES H0501000* RTJ INIT H0501001* (I)EXIT = (I)ENTRY H0501002**** H0501003INIT NUM 0 () = FWA OF HERE. H0501004 ENA 1 (A) = PHASE NO. OF SMCSRT. H0501005ÐÐ STA- YPHASE,I TELL FIXED TABLES THAT SMCSRT IS RUNNING. H0501006 STQ FWAFXY () = FWA OF FIXED TABLES. H0501007 RTJ RELOC RELOCATE ALL RELOCATABLES. H0501008 RTJ LINK RESOLVE SMCSRT REFERENCES TO SMCMON. H0501009 LDA- YKEY,I DEFINE FWA OF KEY TABLE H0501010 STA KEYADR H0501011 STA ADRKEY H0501012 LDA- YIFTAD,I (A) = FWA OF UNEXPANDED INPUT FILE TABLES. H0501013 STA IEOR02 () = FWA OF NEXT FILE TABLE TO EXPAND. H0501014* READY FINAL-OUTPUT FILE-TABLE IN CASE IT WILL BE NEEDED. H0501015 LDA* SOUTFT+BUFWA H0501016 STA- YOFT+BUFWA,I FOR CORE SORT H0501017 ADD- YWKBSZ,I ALLOW FOR WORK BUFFER DATA AREA. H0501018 STA IEORFT+BUFWA H0501019 ADD- YMAXIB,I H0501020 STA FWARSA H0501021* TELL RECLTH AND BUFLTH TO SOUTFT H0501022 LDA- YOFT+RECLTH,I (A) = LOGICAL RECORD SIZE. H0501023 STA* SOUTFT+RECLTH TELL TO WORK-FILE FILE-TABLE. H0501024 LDA- YWKBSZ,I (A) = WORK BUFFER DATA SIZE + EOF WORDS H0501025 STA* SOUTFT+BUFLTH TELL TO WORK-FILE FILE-TABLE. H0501026 LDA- YMAXIB,I YWKBSZ = YMAXIB + 2 H0501027 CLR Q MAKE YWKBSZ A MULTIPLE OF MERGE RECORD SIZE H0501028 DVI- YOFT+RECLTH,I H0501029 MUI- YOFT+RECLTH,I H0501030ÐÐ INA 2 ADD EOF WORDS H0501031 STA- YWKBSZ,I H0501032* SET UP GBIG FOR USE IN DETECTING AN OPPORTUNITY TO DO A CORE SORT. H0501033 CLR Q PREPARE TO DIVIDE. H0501034 LDA- YG,I (A) = NO. OF REAL RSA BINS. H0501035 DVI =N10000 SPLIT NO. INTO TWO WORD VERSION. H0501036 STA GBIG SET 1ST OF TWO WORDS. H0501037 STQ GBIG+1 SET 2ND OF TWO WORDS. H0501038* DEFINE MAXIMUM LENGTH OF EACH MERGE STRING H0501039 CLR Q H0501040 STQ- YRECNT,I MOST SIGNIFICANT PART H0501041 LDA* SOUTFT+BUFLTH H0501042 INA -2 EXCLUDED ARE EOF WORDS H0501043 DVI* SOUTFT+RECLTH H0501044 STA* RECBLK NUMBER OF RECORDS/BLOCK H0501045 LDA- YG,I H0501046 ALS 1 DOUBLE SIZE H0501047 ADD* RECBLK MAKE NUMBER OF BLOCKED RECORDS PER FILE A H0501048 INA -1 MULTIPLE OF BLOCKED RECORD SIZE H0501049 CLR Q H0501050 DVI* RECBLK H0501051 MUI* RECBLK H0501052 STA- YRECNT+1,I LEAST SIGNIFICANT PART H0501053* INITIALIZE THE TOURNAMENT AND ITS ARRAYS. H0501054 LDA- YOFT+RECLTH,I H0501055ÐÐ LDQ- YG,I H0501056 RTJ TURNIT H0501057 JMP* (INIT) H0501058 SPC 3 H0501059RECBLK BSS RECBLK RECORDS/BLOCK H0501060 EJT H0501061SOUTFT EQU SOUTFT(*) H0501062 BSS (BUFWA) H0501063 ADC SOUTBF-HERE () = FWA OF SOUTBF. H0501064 BSS (FTSIZE-1-BUFWA) H0501065SOUTBF EQU SOUTBF(*) THE BUFFER FOR THE MERGE OUTPUT FILE. H0501066 EJT H0501067**** H0501068*E H0501069* ********* H0501070* * RELOC * H0501071* ********* H0501072* H0501073* H0501074* RELOC RELOCATES THE WORDS MENTIONED IN THE LIST, RELOC4. H0501075* THE RELOC4 LIST REPRESENTS ALL ADDRESSES THAT NEED TO BE ABSOLUTIZED. H0501076* THE CALLING SEQUENCE IS RTJ RELOC H0501077* (I)EXIT = (I)ENTRY H0501078**** H0501079RELOC NUM 0 H0501080ÐÐ ENQ RELOC3 (Q) = NO. OF ENTRIES IN RELOC4. H0501081RELOC7 INQ -1 (Q) = INDEX TO NEXT RELOCATEE. H0501082 SQP RELOC6 SKIP IF NOT DONE. H0501083 JMP* (RELOC) EXIT IF DONE. H0501084RELOC6 LDA* RELOC4,Q (A) = FWA OF RELOCATEE - FWA OF HERE. H0501085 ADD* INIT (A) = FWA OF RELOCATEE. H0501086 STA* RELOC5 SAVE FWA OF RELOCATEE. H0501087 LDA* (RELOC5) (A) = RELOCATEE. H0501088 ADD* INIT (A) = RELOCATED (RELOCATEE). H0501089 STA* (RELOC5) SET RELOCATEE. H0501090 JMP* RELOC7 JMP TO SEE IF DONE. H0501091RELOC5 NUM 0 () = FWA OF RELOCATEE. H0501092RELOC4 EQU RELOC4(*) H0501093 ADC FWAIFT-HERE H0501094 ADC FWAOFT-HERE H0501095 ADC SOUTFT+BUFWA-HERE H0501096RELOC3 EQU RELOC3(*-RELOC4) H0501097 EJT H0501098**** H0501099*E H0501100* ******** H0501101* * LINK * H0501102* ******** H0501103* H0501104* H0501105ÐÐ* LINK RESOLVES THE REFERENCES OF SMCSRT TO SMCMON. H0501106* ALL PROCESSOR ADDRESSES IN SMCMON THAT SMCSRT NEEDS ARE LINKED HERE. H0501107* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF SMCMON FIXED TABLE H0501108* RTJ LINK H0501109* (Q),(I)EXIT = (Q),(I)ENTRY H0501110**** H0501111LINK NUM 0 H0501112 LDA- YGETU,I (A) = FWA OF GETU. H0501113 STA IEOR03+1 H0501114 LDA- YCLOSE,I (A) = FWA OF CLOSE H0501115 STA IEOR00+1 H0501116 LDA- YOPEN,I (A) = FWA OF OPEN H0501117 STA IEOR12+1 H0501118 LDA- YCRMSG,I (A) = FWA OF CRTMSG. H0501119 STA IEOR14+1 H0501120 LDA- YBOMB,I (A) = FWA OF BOMB H0501121 STA IEOR15+1 H0501122 LDA- YCMPKY,I (A) = FWA OF CMPKEY. H0501123 STA GETCMP+1 H0501124 STA TRNCMP+1 H0501125 LDA- YPUTU,I (A) = FWA OF PUTU. H0501126 STA PUTU+1 H0501127 LDA- YEOS,I (A) = FWA OF EOS. H0501128 STA PUTEOS+1 H0501129 LDA- YBOS,I (A) = FWA OF BOS. H0501130ÐÐ STA PUTBOS+1 H0501131 LDA- YADOUT,I (A) = 1 + LWA OF UNEXPANDED INPUT FILE TABLES. H0501132 STA OVRUFT TELL IEOR WHEN TO STOP GETTING FILE TABLES. H0501133 LDA- YWIERD,I (A) = FWA OF WIERD IN SMCMON. H0501134 STA* WIERD SAVE FWA OF WIERD. H0501135 LDA- YSRTSZ,I (A) = TABULATED SIZE OF SMCSRT RESIDENT. H0501136 EOR =XSRTSIZ COMPARE TABULATED TO ACTUAL. H0501137 SAZ LINK01 SKIP IF TABULATED = ACTUAL. H0501138 RTJ* (WIERD) ANNOUNCE AND HANDLE WIERD CONDITION. H0501139 NUM -8 ANNOUNCE ERROR NO.8 AND STOP THE RUN. H0501140LINK01 EQU LINK01(*) H0501141 JMP* (LINK) EXIT. H0501142WIERD NUM 0 () = FWA OF WIERD IN SMCMON. H0501143* SIZE OF SMCSRT RESIDENT LOGIC. H0501144SRTSIZ EQU SRTSIZ(SOUTBF-SMCSRT) H0501145 END SMCSRT H0501146 NAM SMCIMG H06 A ITOS CCS 3.0 SL-149H0600001* PERFORMS INTERMEDIATE MERGE H0600002* CREDIT COLLECTION SYSTEM VERSION 3.0 H0600003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA H0600004* COPYRIGHT CONTROL DATA CORPORATION 1979 H0600005 SPC 5 H0600006**** H0600007*E H0600008* ********************** H0600009ÐÐ* * INTERMEDIATE MERGE * H0600010* ********************** H0600011* H0600012* H0600013* FUNCTION H0600014* -------- H0600015* H0600016* SMCIMG COMBINES MANY MERGE STRINGS INTO A SINGLE MERGE STRING UNTIL H0600017* ALL OF THE SINGLE MERGE STRINGS CAN BE COMBINED INTO A FINAL MERGE H0600018* STRING. OVERLAY SMCFMG WILL PERFORM THE FINAL MERGE. H0600019* H0600020* H0600021* GENERAL DESCRIPTION H0600022* ------------------- H0600023* H0600024* SMCIMG IS CALLED WHEN NEITHER SMCSRT ALONE, NOR SMCSRT FOLLOWED BY H0600025* SMCFMG WOULD BE ADEQUATE TO PRODUCE A SINGLE SEQUENCE ON THE USER H0600026* OUTPUT FILE FROM THE USER INPUT. H0600027* H0600028* SMCIMG MERGES THE SEQUENCES PRODUCED BY SMCSRT UNTIL FEW ENOUGH H0600029* SEQUENCES EXIST TO ALLOW SMCFMG TO MERGE THE REMAINING SEQUENCES INTO H0600030* ONE FINAL SEQUENCE ON THE USER OUTPUT FILE. H0600031* H0600032* SMCIMG USES ONLY WORK FILES FOR INPUT AND OUTPUT. AN ENTRY IS ADDED H0600033* TO THE SEQUENCE DIRECTORY FOR EACH SEQUENCE SMCIMG OUTPUTS. THUS H0600034ÐÐ* SMCIMG ADDS TO THE SEQUENCE DIRECTORY BEGUN BY SMCSRT. H0600035* H0600036* RECURSION MAY BE INVOLVED SINCE SMCIMG MAY HAVE TO MERGE STRINGS H0600037* PROVIDED EARLIER BY SMCIMG. H0600038* H0600039* ONE MAY CONSIDER THAT A TREE STRUCTURE IS FORMED BY THE PATTERN OF H0600040* MERGES PERFORMED BY SMCIMG AND SMCFMG, TAKEN TOGETHER. SMCIMG H0600041* DETERMINE AND OPTIMIZES THIS TREE STRUCTURE BEFORE MERGING. H0600042**** H0600043 EJT 0 H0600044**** H0600045*E H0600046* THE FIRST MERGE PERFORMED, COMBINES 1STWAY SEQUENCES, WHILE THE H0600047* REMAINING MERGES COMBINE IWAY (THE MAXIMUM POSSIBLE FOR SMCIMG) H0600048* SEQUENCES. THE SHORTEST STRINGS ARE COMBINED FIRST. THE MAXIMUM H0600049* MERGE SEQUENCE IS LIMITED TO THE NUMBER OF FILE MANAGER SEQUENTIAL H0600050* FILES THAT CAN BE OPEN AT ANY GIVEN TIME FOR A USER. H0600051* H0600052* THE RESULT OF THE PRECEDING STRATEGY IS MINIMIZATION OF U, THE UNIT H0600053* STRINGS RATING OF ALL MERGING PERFORMED BY SMGIMG, I.E., HOW MANY H0600054* TIMES ALL DATA FROM AN ORIGINAL STRING FROM SMCSRT IS PROCESSED BY H0600055* SMCIMG. H0600056* H0600057* BEFORE ANY MERGING, SMCIMG COMPUTES 1STWAY AND U. H0600058* H0600059ÐÐ* WHEN THE USER FILE HAVE THE SAME EFFECTIVE TRANSFER RATE AS THE WORK H0600060* FILES, I.E., INPUT RECORDS NOT SECTOR ALIGNED), THE TOTAL RUN TIME IS H0600061* ROUGHLY 1 (FOR SMCSRT) + U/S (FOR SMCIMG) + 1 (FOR SMCFMG) = 2 + U/S H0600062* TIMES THE TIME FOR SMCSRT. H0600063* H0600064* FOR SMCSRT AND SMCIMG, EACH WILL INVOLVE AT MOST ONE PASS OF ALL THE H0600065* INPUT DATA, BUT SMCIMG COULD INVOLVE SEVERAL PASSES. THEREFORE AT H0600066* BEST, SMCIMG WILL NOT BE USED, AND AT WORST, SMCIMG WILL ACCOUNT FOR H0600067* MOST OF THE RUN TIME. H0600068* H0600069* WHEN PERFORMING A MERGE, SMCIMG USES AN ADAPTATION OF THE TOURNAMENT H0600070* OF SMCSRT. THE SMCIMG QUEUE IS BEING FED BY SEVERAL INPUT SEQUENCES H0600071* AT THE SAME TIME, IN CONTRAST WITH THE SERIAL INPUT OF PROBABLY H0600072* UNSORTED FILES TO THE SMCSRT QUEUE. H0600073* H0600074* SINCE THE INPUT TO THE SMCIMG QUEUE IS SORTED, THE SEPARATE INPUT H0600075* BUFFERS CONSTITUTE THE ACTUAL LOGICAL RECORD DELAY AREA, AND WITHIN H0600076* A SINGLE MERGE, EACH LOGICAL RECORD NEED BE MOVED ONLY ONCE, VIZ, H0600077* FROM THE CORRESPONDING INPUT BUFFER TO THE OUTPUT BUFFER. H0600078* H0600079* H0600080* INPUT REQUIREMENTS H0600081* ------------------ H0600082* H0600083* THE SMCIMG OVERLAY IS ENTERED AT THE SECOND LOCATION WITHIN ITSELF. H0600084ÐÐ* THE I REGISTER (I) CONTAINS THE FIRST WORD ADDRESS OF SMCMON FIXED H0600085* TABLE SPACE. H0600086* H0600087* H0600088* OUTPUT H0600089* ------ H0600090* H0600091* THE SMCIMG OVERLAY DOES NOT SET REGISTER VALUES TO SPECIFIC VALUES H0600092* WHEN IT IS DONE. H0600093**** H0600094 EJT 0 H0600095**** H0600096*E H0600097* ENTRY/EXIT H0600098* ---------- H0600099* H0600100* ENTRY - H0600101* THE SMCIMG OVERLAY IS LOADED BY THE LOAD SUBROUTINE IN DSORT. SMCMON H0600102* MAKES A SUBROUTINE CALL TO LOAD PASSING THE OVERLAY INDEX (REQUEST TO H0600103* LOAD SMCIMG) AND THE FWA OF SMCIMG. SMCIMG IS LOADED AFTER THE H0600104* ADDROUT RELATIVE RECORD NUMBER WORDS IN THE VARIABLE TABLE AREA. THE H0600105* LOAD SUBROUTINE IN DSORT SETS THE RETURN ADDRESS TO SMCMON IN THE H0600106* FIRST LOCATION OF SMCIMG AND THEN JUMPS TO THE SECOND LOCATION IN H0600107* SMCIMG. H0600108* H0600109ÐÐ* EXIT - H0600110* SMCIMG RETURNS TO SMCMON WHEN THE NUMBER OF SEQUENCES TO BE MERGED IS H0600111* LESS THAN OR EQUAL TO FWAY, THE MAXIMUM NUMBER OF SEQUENCES THAT H0600112* SMCFMG CAN HANDLE. THE RETURN ADDRESS TO SMCMON IS SET IN THE FIRST H0600113* LOCATION OF SMCIMG. IF A FILE MANAGER ERROR IS DETECTED CONTROL IS H0600114* TRANSFERRED TO THE BOMB ROUTINE IN SMCMON. H0600115* H0600116* H0600117* FLOW H0600118* ---- H0600119* H0600120* THE SMCIMG OVERLAY PERFORMS THE FOLLOWING: H0600121* 1. SETS UP THE WORK TABLE SPACE FOR THE INPUT AND OUTPUT FILES H0600122* 2. DEFINES THE TOURNAMENT TABLE SPACE AND INITIALIZES THESE TABLES H0600123* 3. FETCHES A RECORD TO BE SORTED H0600124* 4. SUBMITS IT TO THE TOURNAMENT H0600125* 5. DISPOSE OF A WINNER, REAL OR DUMMY RECORD FROM THE TOURNAMENT H0600126* 6. REPEAT STEPS 2 THRU 5 UNTIL TOURNAMENT IS FLUSHED H0600127* H0600128* H0600129* SUBROUTINES H0600130* ----------- H0600131* H0600132* BOS: STARTS NEW WORK FILE SEQUENCE H0600133* CMPKEY: COMPARES 2 KEYS TO DETERMINE WINNER H0600134ÐÐ* EOS: ENDS WORK FILE SEQUENCE H0600135* GETU: FETCHES NEXT RECORD TO BE MERGED H0600136* GETSEQ: GETS LOGICAL UNIT AND FILE NUMBER OF NEXT FILE TO BE MERGED H0600137* PUTU: MOVES RECORD TO OUTPUT FILE H0600138* RECADD: ACCUMULATES RECORD COUNT FOR INPUT FILES H0600139* WIERD: REPORTS ABNORMAL ERROR CONDITIONS H0600140* H0600141* H0600142* MESSAGES H0600143* -------- H0600144* H0600145* THE MESSAGES FOR ALL OVERLAYS ARE LISTED IN THE EQUATE SECTION H0600146* UNDER 'MESSAGE PROCESSOR INDEX EQUATES'. H0600147**** H0600148 EJT H0600149**** H0600150*E H0600151* PARAMETERS H0600152* ---------- H0600153* H0600154* OFTEN NEEDED CONSTANTS. H0600155ZERO EQU ZERO(2) (2)=0. H0600156HX7FFF EQU HX7FFF($42) ($42)=$7FFF. H0600157**** H0600158 EJT H0600159ÐÐ**** H0600160*E H0600161* FILE CONTROL BLOCK EQUIVALENCES H0600162 EQU FH(4) LENGTH -1 OF FCB HEADER H0600163 EQU FILEID(ZERO) FILE IDENTIFIER H0600164* ACCESS FILEID INDIRECTLY H0600165* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBERH0600166* BITS 10-00 INDEX OF FCB IN FCB TABLE H0600167 EQU FCBFLG(1) FCB FLAGS H0600168* BITS 15-8, SPARE H0600169* BITS 7-00, NUMBER OF USERS USING FILE H0600170 EQU FILOCK(2) FILE LOCK FLAG (IF NON-0, CONTAINS USER ID) H0600171 EQU NUMSET(3) NUMBER OF SETS OF LOCKED RECORDS IN FILE H0600172 EQU NUMNEW(4) NUMBER OF NEW RECORDS SINCE FCB UPDATED ON MM H0600173 SPC 1 H0600174 EQU RECLEN(FH+1) RECORD LENGTH IN WORDS H0600175 EQU TDATRM(FH+2) TOTAL NUMBER OF DATA RECORDS, MSB H0600176 EQU TDATRL(FH+3) TOTAL NUMBER OF DATA RECORDS, LSB H0600177 EQU DATBAM(FH+4) DATA RECORDS BEGINNING SECTOR ADDRESS, MSB H0600178 EQU DATBAL(FH+5) DATA RECORDS BEGINNING SECTOR ADDRESS,LMSB H0600179 EQU FCBIND(FH+6) FCB INDICATORS H0600180* BIT 15 , SECTOR ALLIGNED RECORDS IF =1 H0600181* BIT 14 , STORAGE MODE FOR INDEXED FILE H0600182* =0, RECORDS STORED RANDOMLY WITHH0600183* RESPECT TO PRIMARY KEY H0600184ÐÐ* =1, RECORDS STORED IN ORDER WIT H0600185* RESPECT TO PRIMARY KEY H0600186* BIT 13 , =1, FILE IS CURRENTLY OPEN H0600187* =0, FILE IS CURRENTLY CLOSED H0600188* BIT 12 , =1, FILE IS BEING COMPRESSED H0600189* =0, FILE IS NOT BEING COMPRESSEDH0600190* BIT 0 , FILE TYPE H0600191* =0, SEQUENTIAL FILE H0600192* =1, INDEXED FILE H0600193 EQU NEDATM(FH+7) NUMBER OF EXISTING DATA RECORDS, MSB H0600194 EQU NEDATL(FH+8) NUMBER OF EXISTING DATA RECORDS, LSB H0600195 EQU SEQLTH(NEDATL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION H0600196* OF FCB FOR A SEQUENTIAL FILE H0600197 SPC 1 H0600198 EQU NEXTBM(FH+9) NEXT FREE KEY INDEX BLOCK, MSB H0600199 EQU NEXTBL(FH+10) NEXT FREE KEY INDEX BLOCK, LSB H0600200 EQU TNKEYM(FH+11) TOTAL NUMBER OF KEY INDEX BLOCKS, MSB H0600201 EQU TNKEYL(FH+12) TOTAL NUMBER OF KEY INDEX BLOCKS, LSB H0600202 EQU KEYBAM(FH+13) KEY INDEX BEGINNING SECTOR ADDRESS, MSB H0600203 EQU KEYBAL(FH+14) KEY INDEX BEGINNING SECTOR ADDRESS, LSB H0600204 EQU LENKY1(FH+15) LENGTH OF KEY NO. 1 H0600205 EQU POSKY1(FH+16) BYTE POSITION OF KEY NO. 1 H0600206 EQU LENKY2(FH+17) LENGTH OF KEY NO. 2 H0600207 EQU POSKY2(FH+18) BYTE POSITION OF KEY NO. 2 H0600208 EQU LENKY3(FH+19) LENGTH OF KEY NO. 3 H0600209ÐÐ EQU POSKY3(FH+20) BYTE POSITION OF KEY NO. 3 H0600210 EQU LENKY4(FH+21) LENGTH OF KEY NO. 4 H0600211**** H0600212 EJT H0600213**** H0600214*E H0600215 EQU POSKY4(FH+22) BYTE POSITION OF KEY NO. 4 H0600216 EQU INDLEN(POSKY4-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION H0600217* OF FCB FOR AN INDEXED FILE H0600218* THE FOLLOWING PORTION OF THE FCB EXISTS ONLY H0600219* ON MASS MEMORY. THESE 10 WORDS ARE NOT LOADEDH0600220* INTO EITHER OF THE FILE MANAGER CONTROLLED FCBH0600221* TABLES. H0600222 EQU TSFILM(FH+23) TOTAL NUMBER OF SECTORS IN FILE, MSB H0600223 EQU TSFILL(FH+24) TOTAL NUMBER OF SECTORS IN FILE, LSB H0600224 EQU NAME12(FH+25) FILE NAME, CHARACTERS 1 AND 2 H0600225 EQU NAME34(FH+26) FILE NAME, CHARACTERS 3 AND 4 H0600226 EQU NAME56(FH+27) FILE NAME, CHARACTERS 5 AND 6 H0600227 EQU NAME78(FH+28) FILE NAME, CHARACTERS 7 AND 8 H0600228 EQU OWNR12(FH+29) OWNER NAME, CHARACTERS 1 AND 2 H0600229 EQU OWNR34(FH+30) OWNER NAME, CHARACTERS 3 AND 4 H0600230 EQU OWNR56(FH+31) OWNER NAME, CHARACTERS 5 AND 6 H0600231 EQU OWNR78(FH+32) OWNER NAME, CHARACTERS 7 AND 8 H0600232 EQU BYTLEN(FH+33) BYTE LENGTH OF RECORD H0600233* H0600234ÐÐ* FOR COMPRESS ONLY H0600235* H0600236 EQU PRSRNM(FH+34) RRN OF LAST PROCESSED RECORD - MSB H0600237 EQU PRSRNL(FH+35) RRN OF LAST PROCESSED RECORD - LSB H0600238 EQU NEWRNM(FH+36) RRN OF THE LATEST 'NEW' RECORD - MSB H0600239 EQU NEWRNL(FH+37) RRN OF THE LATEST 'NEW' RECORD - LSB H0600240 SPC 4 H0600241* WORDS 0 THRU 4 OF THE FCB HEADER AND WORDS H0600242* 6 THRU 10 OF THE FCB ARE REFERRED TO AS THE H0600243* SHARED SUBSET OF THE FCB. THEY INCLUDE THE H0600244* ONLY FCB WORDS THAT CAN BE MODIFIED AFTER FILEH0600245* CREATION. IF TWO OR MORE USERS HAVE THE SAME H0600246* FILE OPEN, THERE HAS TO BE A SINGLE MASTER H0600247* COPY OF THE SUBSET THAT RECEIVES (AND RECORDS)H0600248* ALL OF THE UPDATES. THE CONTROLLED SUBSET H0600249* WILL ALWAYS BE PART OF A MAIN MEMORY RESIDENT H0600250* FCB IF THE FCB IS IN A FM CONTROLLED TABLE. H0600251* IF THE FCB IS IN USER SPACE, THE SUBSET MAY ATH0600252* TIMES RESIDE IN THE SUBSET CONTROL TABLE. H0600253 SPC 2 H0600254* ALTERNATE NAMES FOR SUBSET WORDS H0600255 EQU SAFCBI(FH+1) SUBSET ALTERNATE NAME FOR FCBIND H0600256 EQU SADATM(FH+2) SUBSET ALTERNATE NAME FOR NEDATM H0600257 EQU SADATL(FH+3) SUBSET ALTERNATE NAME FOR NEDATL H0600258 EQU SANXTM(FH+4) SUBSET ALTERNATE NAME FOR NEXTBM H0600259ÐÐ EQU SANXTL(FH+5) SUBSET ALTERNATE NAME FOR NEXTBL H0600260**** H0600261 EJT 0 H0600262**** H0600263*E H0600264* FILE TABLE STRUCTURE. H0600265LUN EQU LUN(ZERO) F.M. LOGICAL UNIT NUMBER H0600266FILNUM EQU FILNUM(1) F.M. FILE NUMBER H0600267RECLTH EQU RECLTH(FILNUM+1) RECORD LENGTH H0600268BUFLTH EQU BUFLTH(RECLTH+1) RECORD BLOCK LENGTH H0600269BUFWA EQU BUFWA(BUFLTH+1) FWA OF RECORD BLOCKED BUFFER H0600270RECNT EQU RECNT(BUFWA+1) NUMBER OF RECORDS ENCOUNTERED H0600271DOCNT EQU DOCNT(RECNT+2) NUMBER OF RECORDS PROCESSED H0600272ERRCNT EQU ERRCNT(DOCNT+2) NUMBER OF ERRORS FOUND FOR FILE H0600273RECFWA EQU RECFWA(ERRCNT+1) FWA OF NEXT RECORD IN BLOCK H0600274XFRLTH EQU XFRLTH(RECFWA+1) RECORD BLOCK LENGTH FOR I/O H0600275REQBUF EQU REQBUF(XFRLTH+1) REQUEST BUFFER H0600276REQIND EQU REQIND(REQBUF+24) REQUEST INDICATOR H0600277FCB EQU FCB(REQIND+1) FILE CONTROL BLOCK H0600278 EQU FMSLOP(2) FCB OVERFLOW CORE SPACE INTO FCB INDEX SECT. H0600279FTSIZE EQU FTSIZE(FCB+SEQLTH+FH+1+FMSLOP) SIZE OF FILE TABLE H0600280**** H0600281 EJT H0600282**** H0600283*E H0600284ÐÐ*SMC FIXED-TABLE STRUCTURE. H0600285 SPC 2 H0600286YNAMFL EQU YNAMFL(ZERO) () = FWA ASCII FILE, OWNER, VOLUME TABLE H0600287YIFTAD EQU YIFTAD(1) () = FWA OF INPUT FILE TABLE (FT) H0600288YADOUT EQU YADOUT(YIFTAD+1) () = KEY OR DATA DESCRIPTION TABLE FOR REC.H0600289YKEY EQU YKEY(YADOUT+1) () = KEY TABLE FOR SORT FIELDS H0600290YADRBF EQU YADRBF(YKEY+1) () = ADDROUT CONVERSION SPACE FOR RECORD H0600291YFIELD EQU YFIELD(YADRBF+1) () = RECORD SELECTION TABLE H0600292YCOMPR EQU YCOMPR(YFIELD+1) () = KEY FIELD FOR RECORD SELECTION H0600293YSHIFT EQU YSHIFT(YCOMPR+1) () = KEY OFFSET SPACE FOR RECORD SELECTION H0600294YEND EQU YEND(YSHIFT+1) () = END OF VARIABLE TABLES H0600295YHICOR EQU YHICOR(YEND+1) () = TOTAL AVAILABLE SORT CORE MEMORY SPACEH0600296YEDTSZ EQU YEDTSZ(YHICOR+1) () = SIZE OF INPUT EDITOR OVERLAY H0600297YSRTSZ EQU YSRTSZ(YEDTSZ+1) () = SIZE OF SORT OVERLAY H0600298YIMGSZ EQU YIMGSZ(YSRTSZ+1) () = SIZE OF INTERMEDIATE MERGE OVERLAY H0600299YFMGSZ EQU YFMGSZ(YIMGSZ+1) () = SIZE OF FINAL MERGE OVERLAY H0600300YPHASE EQU YPHASE(YFMGSZ+1) () = OVERLAY NUMBER CURRENTLY EXECUTING H0600301YDM EQU YDM(YPHASE+1) () = NUMBER OF INPUT FILES H0600302YFLAG EQU YFLAG(YDM+1) () = BIT 15 - (0/1) = (TAG/ADDR) H0600303* 14 - (0/1) = (DATA/FULL RECORD) H0600304* 13 - (0/1) = (ASCII/EBCDIC) H0600305* 12 - (0/1) = (OMIT/INCLUDE) H0600306YG EQU YG(YFLAG+1) () = NUMBER OF SORT BINS (RECORDS) H0600307YIWAY EQU YIWAY(YG+1) () = MAX NUMBER OF INTERMEDIATE MERGE FILESH0600308YFWAY EQU YFWAY(YIWAY+1) () = MAX NUMBER OF FINAL MERGE FILES H0600309ÐÐYMAXIB EQU YMAXIB(YFWAY+1) () = INPUT BLOCK FACTOR (IN WORDS) H0600310YWKBSZ EQU YWKBSZ(YMAXIB+1) () = WORK SPACE AVAILABLE (IN WORDS) H0600311YIRCNT EQU YIRCNT(YWKBSZ+1) () = INPUT RECORD COUNT TO SORT H0600312YORCNT EQU YORCNT(YIRCNT+2) () = OUTPUT RECORD COUNT FROM SORT H0600313YSQ2MG EQU YSQ2MG(YORCNT+2) () = NUMBER OF MERGE FILES TO BE PROCESSED H0600314YSEQCT EQU YSEQCT(YSQ2MG+1) () = TOTAL NUMBER OF MERGE FILES H0600315YCMPKY EQU YCMPKY(YSEQCT+1) () = PROCESSOR - COMPARES KEYS H0600316YRCADD EQU YRCADD(YCMPKY+1) () = PROCESSOR - ACCUMULATES EXIST. REC CNTH0600317YGETU EQU YGETU(YRCADD+1) () = PROCESSOR - DEBLOCKS F.M. RECORDS H0600318YPUTU EQU YPUTU(YGETU+1) () = PROCESSOR - BLOCKS F.M. RECORDS H0600319YCLSU EQU YCLSU(YPUTU+1) () = PROCESSOR - FLUSHES OUTPUT BUFFER H0600320YGTSEQ EQU YGTSEQ(YCLSU+1) () = PROCESSOR - FINDS MERGE STRING TO USE H0600321YBOS EQU YBOS(YGTSEQ+1) () = PROCESSOR - DEFINES MERGE WORK FILE H0600322YEOS EQU YEOS(YBOS+1) () = PROCESSOR - CLOSES MERGE WORK FILE H0600323YOFRL EQU YOFRL(YEOS+1) () = OUTPUT FILE RECORD SIZE (CHARS) H0600324YRECNT EQU YRECNT(YOFRL+1) () = RECORT COUNT FOR EACH FILE H0600325YOPEN EQU YOPEN(YRECNT+2) () = PROCESSOR - OPENS F.M. FILES H0600326YCLOSE EQU YCLOSE(YOPEN+1) () = PROCESSOR - CLOSES F.M. FILES H0600327YGTFCB EQU YGTFCB(YCLOSE+1) () = PROCESSOR - READS EXTENDED FCB H0600328YVOLSR EQU YVOLSR(YGTFCB+1) () = PROCESSOR - FIND F.M. LU FROM VOLUME H0600329YCLSEQ EQU YCLSEQ(YVOLSR+1) () = PROCESSOR - COLLATING SEQUENCE ROUTINEH0600330YMVCHR EQU YMVCHR(YCLSEQ+1) () = PROCESSOR - OFFSETS CHARACTER STRING H0600331YSVAQI EQU YSVAQI(YMVCHR+1) () = PROCESSOR - SAVES REGISTERS A,Q,I H0600332YREAQI EQU YREAQI(YSVAQI+1) () = PROCESSOR - RESTORES REGISTERS A,Q,I H0600333**** H0600334ÐÐ EJT 0 H0600335**** H0600336*E H0600337YCRMSG EQU YCRMSG(YREAQI+1) () = PROCESSOR - PRINTS MESSAGES TO CRT H0600338YTYPIN EQU YTYPIN(YCRMSG+1) () = PROCESSOR - INPUTS INPUT DIRECTIVES H0600339YBOMB EQU YBOMB(YTYPIN+1) () = PROCESSOR - TERMINATES RUN WITH ERROR H0600340YWIERD EQU YWIERD(YBOMB+1) () = PROCESSOR - REPORTS UNUSUAL ERROR H0600341YOFT EQU YOFT(YWIERD+1) () = FWA OF OUTPUT FILE TABLE H0600342YCMPLA EQU YCMPLA(YOFT+REQBUF) = PROCESSOR - ASCENDING LOGICAL BINARY H0600343YCMPLD EQU YCMPLD(YCMPLA+1) () = PROCESSOR - DESCENDING LOGICAL BINARY H0600344YCMCLA EQU YCMCLA(YCMPLD+1) () = PROCESSOR - ASCENDING EVEN COLUMN CHARH0600345YCMCLD EQU YCMCLD(YCMCLA+1) () = PROCESSOR DESCEND EVEN COLUMN CHAR H0600346YCMPWA EQU YCMPWA(YCMCLD+1) () = PROCESSOR - ASCENDING WORDS BINARY KEYH0600347YCMPWD EQU YCMPWD(YCMPWA+1) () = PROCESSOR - DESCENDING WRDS BINARY KEYH0600348YCMCUA EQU YCMCUA(YCMPWD+1) () = PROCESSOR - ASCENDING ODD COLUMN CHAR H0600349YCMCUD EQU YCMCUD(YCMCUA+1) () = PROCESSOR - DESCENDING ODD COLUMN CHARH0600350YOUTFT EQU YOUTFT(YOFT+FTSIZE) = LWA OF FIXED TABLES H0600351**** H0600352 EJT H0600353**** H0600354*E H0600355* MISC H0600356* ---- H0600357* H0600358* ** ENTRY POINTS ** H0600359ÐÐ* H0600360 ENT SMCIMG H0600361* H0600362* ** EXTERNALS ** H0600363* H0600364* NONE H0600365* H0600366* ** EQUATES ** H0600367* H0600368ADISP EQU ADISP($EA) H0600369AMONI EQU AMONI($F4) H0600370PLUG EQU PLUG($7FFF) H0600371**** H0600372 EJT 0 H0600373**** H0600374*E H0600375* MESSAGE PROCESSOR INDEX EQUATES H0600376 SPC 3 H0600377MSGCLS EQU MSGCLS(1) 'CLOSFL REQIND = $ ' H0600378MSGOPN EQU MSGOPN(2) 'OPENFL REQIND = $ ' H0600379MSGDEL EQU MSGDEL(3) 'DELETE REQIND = $ ' H0600380MSGCRT EQU MSGCRT(4) 'CREATE REQIND = $ ' H0600381MSGRDD EQU MSGRDD(5) 'GETS REQIND = $ ' H0600382MSGWTD EQU MSGWTD(6) 'PUTS REQIND = $ ' H0600383MSGTFB EQU MSGTFB(7) 'GETFCB REQIND = $ ' H0600384ÐÐMSGFCB EQU MSGFCB(8) 'UPDFCB REQIND = $ ' H0600385MSGVOL EQU MSGVOL(9) 'VOLUME= ' H0600386MSFFNO EQU MSGFNO(10) 'FILNAM= ' H0600387* H0600388FM EQU FM(10) SIZE OF F.M. MESSAGE INDEX BLOCK H0600389* H0600390MSGABE EQU MSGABE(FM+1) 'ABNORMAL ERROR = ' H0600391MSGBDR EQU MSGBDR(FM+2) 'BLKSIZ/RECLTH .NE. 1,2,3...' H0600392MSGBLK EQU MSGBLK(FM+3) ' ' H0600393MSGBOM EQU MSGBOM(FM+4) 'FATAL ERROR' H0600394MSGDUN EQU MSGDUN(FM+5) 'DONE = ' H0600395MSGESC EQU MSGESC(FM+6) 'TYPE-IN ERROR' H0600396MSGEXP EQU MSGEXP(FM+7) 'EXPECTED /FOUND ' H0600397MSGIFL EQU MSGIFL(FM+8) 'CANNOT OPEN INPUT FILE' H0600398MSGTLC EQU MSGTLC(FM+9) 'TOO LITTLE CORE' H0600399MSGINE EQU MSGINE(FM+10) 'INTERPHASE RECORD COUNTS DISAGREE' H0600400MSGINP EQU MSGINP(FM+11) PRINTS INPUT DIRECTIVE CARD H0600401MSGPAS EQU MSGPAS(FM+12) 'PASSED = ' H0600402MSGSDE EQU MSGSDE(FM+13) 'SEQ. DIR. ERROR' H0600403MSGTLD EQU MSGTLD(FM+14) 'TOO LITTLE DISK' H0600404MSGTRC EQU MSGTRC(FM+15) 'OUTPUT RECORD COUNT BAD' H0600405MSGIFR EQU MSGIFR(FM+16) 'INPUT FILE LENGTHS ARE NOT EQUAL' H0600406MSGFLN EQU MSGFLN(FM+17) 'FN= , ' H0600407MSGOFR EQU MSGOFR(FM+18) 'OUTPUT FILE RECORD LENGTH IS ZERO' H0600408MSGASO EQU MSGASO(FM+19) 'ADDROUT SORTS ONLY 1 FILE' H0600409ÐÐMSGVNM EQU MSGVNM(FM+20) 'VOLUME NOT MOUNTED' H0600410MSGSOK EQU MSGSOK(FM+21) 'START OF KEY FIELD OUTSIDE OF RECORD' H0600411MSGKEB EQU MSGKEB(FM+22) 'KEY FIELD EXTENDS BEYOND END OF RECORD' H0600412**** H0600413 EJT H0600414SMCIMG NUM 0 H0600415 RTJ INIT INITIALIZE THIS PHASE. H0600416HERE EQU HERE(*) RELOC REFERENCE POINT. H0600417SEQMRG RTJ MGINIT INITIALIZE THIS MERGE. H0600418RECMRG RTJ* GET SUBMIT SEQUENCE NO. AND/OR RECORD TO MTOURN.H0600419 RTJ* MTOURN DETERMINE WINNING RECORD. H0600420 RTJ PUT TAKE P+1 OR P+2 EXIT. H0600421 JMP* FMGCHK WINNER WAS LOSING-DUMMY. H0600422 JMP* RECMRG WINNER WAS WINNING-DUMMY OR REAL-RECORD. H0600423FMGCHK LDQ FWAFXY (Q) = FWA OF FIXED TABLES. H0600424* A MERGE OF M STRINGS REDUCES THE NUMBER OF STRINGS TO BE MERGED BY H0600425* M-1 BECAUSE OF THE STRING OUTPUT BY THAT MERGE. H0600426 LDA- YSQ2MG,Q (A) = PREVIOUS NO. OF STRINGS TO BE MERGED. H0600427 INA 1 ALLOW FOR THE STRING OUTPUT BY THE MERGE. H0600428 SUB M ALLOW FOR THE STRINGS INPUT BY THE MERGE. H0600429 STA- YSQ2MG,Q (A) = CURRENT NO. OF STRINGS TO BE MERGED. H0600430 TCA A (A) = - CURRENT NO. OF STRINGS TO BE MERGED.H0600431 ADD- YFWAY,Q (A) = FINAL MERGE ORDER - NO. STRINGS TO DO.H0600432 SAP ENDIMG SKIP IF FINAL MERGE CAN BEGIN. H0600433 LDA- YIWAY,Q (A)= MAXIMUM INTERMEDIATE MERGE ORDER H0600434ÐÐ STA M MAKE EACH I-MERGE MAXIMAL CEPT THE 1ST H0600435 JMP* SEQMRG DO NEXT INTERMEDIATE MERGE. H0600436ENDIMG JMP* (SMCIMG) EXIT. H0600437 EJT H0600438**** H0600439*E H0600440* ******* H0600441* * GET * H0600442* ******* H0600443* H0600444* H0600445* THE GET SUBROUTINE SAVES THE FWA OF THE NEXT RECORD READ IN THE FIRST H0600446* WORD OF A RECORD STORAGE SLOT THAT WAS VACATED BY A PREVIOUS MERGE H0600447* WINNER. THE RECORD COMES FROM THE SAME FILE AS THE PREVIOUS WINNER. H0600448* WHEN EOF IS REACH FOR A INPUT MERGE FILE, THE SEQUENCE NUMBER FOR H0600449* THAT FILE IS FLAGGED AS A DUMMY LOSER. OTHERWISE ALL RECORDS THAT H0600450* ARE INDICATED BY THE RSA TABLE ARE CANDIDATES FOR MERGING. H0600451* THE CALLING SEQUENCE IS RTJ GET (GET NEXT RECORD) H0600452* H0600453**** H0600454GET NUM 0 H0600455 LDQ* TFWA (Q) = FWA OF LAST WINNER BIN. H0600456 LDA- 1,Q (A) = FWA OF LAST WINNER FILE TABLE. H0600457 STA- I TELL GETU WHAT FILE TABLE TO USE. H0600458* INIT REPLACES PLUG BELOW WITH FWA OF GETU. H0600459ÐÐGETGET RTJ+ PLUG GET NEXT RECORD FROM LAST WINNER FILE TABLE.H0600460 JMP* GETEOF SUBMIT A LOSING DUMMY IF EOF. H0600461 STA* (TFWA) SUBMIT FWA OF NEW RECORD TO MTOURN. H0600462 LDA* G (A) = SEQ. NO. OF A REAL RECORD. H0600463GETSEQ LDQ* TRIAL (Q) = LAST-WINNER-BIN NO., I.E. 0,...,G-1. H0600464 STA* (FWASEQ),Q STORE SEQ. NO. IN SEQ. NO. ARRAY. H0600465 JMP* (GET) EXIT. H0600466GETEOF LDA* MAXSEQ (A) = $7FFF,$7FFE,$7FFD,... H0600467 INA -1 (A) = $7FFE,$7FFD,$7FFC,... H0600468 STA* MAXSEQ MAKE EACH LOSING DUMMY DIFFER IN SEQ. NO. H0600469 JMP* GETSEQ SUBMIT THE SEQUENCE NUMBER TO MTOURN. H0600470 EJT H0600471**** H0600472*E H0600473* ********** H0600474* * MTOURN * H0600475* ********** H0600476* H0600477* H0600478* THE MTOURN SUBROUTINE IS USED TO SELECT THE NEXT WINNING RECORD FROM H0600479* THE RECORDS TO BE MERGED. ONE RECORD IS A REPRESENTIVE OF EACH FILE H0600480* TO BE MERGED. SOME OF THESE RECORDS ARE FLAGGED VIA THE SEQUENCE H0600481* NUMBER ARRAY AS DUMMY RECORDS IF THE RSA IS NOT FULL. THE H0600482* LAST RECORD RECORDED IN THE RSA BECOMES THE TRIAL RECORD. ITS H0600483* SEQUENCE NUMBER IS COMPARED TO ALL OF ITS COMPETITORS UNTIL ITS H0600484ÐÐ* SEQUENCE NUMBER IS GREATER THAN A COMPETITOR OR IN THE CASE OF TIES H0600485* THE KEY VALUES OF THE COMPETITOR WIN OVER THE TRIAL RECORD. WHEN A H0600486* COMPETITOR RECORD WINS, THE ROLE OF THE COMPETITOR AND TRIAL RECORD H0600487* SWITCH. THE OLD TRIAL RECORD BECOMES AN ENTRY IN THE TAG STORAGE H0600488* AREA. TO INITIALLY SELECT A COMPETITOR ENTRY, G-1-TRIAL BECOMES THE H0600489* FIRST SELECTION. THIS INDEX REPRESENTS BOTH THE RECORD ORDINAL IN H0600490* THE RSA AND AN ORDINAL IN THE TAG STORAGE AREA USED TO SELECT H0600491* AN ENTRY FROM THE SEQUENCE NUMBER ARRAY. AFTER COMPARING THE TRIAL H0600492* TO THE COMPETITOR AND ESTABLISHING THE WINNER, THE NEXT COMPETITOR H0600493* IS SELECTED BY TAKING HALF OF THE OLD COMPETITOR INDEX (BINARY SEARCH)H0600494* AND USE THIS VALUE AS THE NEW COMPETITOR INDEX. WHEN THIS INDEX H0600495* BECOMES ZERO, THE BINARY SELECTION PROCESS IS COMPLETED AND THE H0600496* CURRENT TRIAL ENTRY BECOMES THE WINNER. H0600497* MTOURN USES 2-WORD RSA BINS. H0600498* (1ST WORD) = FWA OF A LOGICAL RECORD WITHIN AN INPUT BUFFER. H0600499* (2ND WORD) = FWA OF THE FILE-TABLE FOR THE CORRESPONDING INPUT FILE. H0600500* THE CALLING SEQUENCE IS RTJ MTOURN H0600501* H0600502**** H0600503MTOURN NUM 0 H0600504 LDQ* TRIAL (Q) = BIN INDEX OF TRIAL RECORD. H0600505 LDA* (FWASEQ),Q (A) = SEQ. NO. OF TRIAL RECORD. H0600506 QRS 1 (Q) = FLOOR(TRIAL BIN INDEX/2). H0600507 TCQ Q (Q) = -FLOOR(TRIAL BIN INDEX/2). H0600508 ADQ* TAGCNT (Q) = INDEX OF BASE TAG OF TRIAL AND COMPETITOR.H0600509ÐÐ STQ- I (I) = INDEX OF CURRENT TAG. H0600510CMPSEQ LDQ* (PRETSA),I (Q) = INDEX OF COMPETITOR BIN. H0600511 SUB* (FWASEQ),Q (A) = TRIAL SEQ. NO. - COMPETITOR SEQ. NO. H0600512 SAM TWINS SKIP IF TRIAL WINS DUE TO LOWER SEQ. NO. H0600513 SAN CWINS SKIP IF TRIAL LOSES DUE TO HIGHER SEQ. NO. H0600514 JMP* SEQTIE JMP IF SEQUENCE NUMBERS TIE. H0600515CWINS LDA* TRIAL (A) = BIN INDEX OF TRIAL RECORD. H0600516 LDQ* (PRETSA),I (Q) = INDEX OF COMPETITOR BIN. H0600517 STA* (PRETSA),I RECORD TRIAL AS LOSER. H0600518 STQ* TRIAL RECORD COMPETITOR AS NEW TRIAL. H0600519 JMP* TWINS1 SEE IF THERE IS A NEXT TREE LEVEL. H0600520TWINS LDQ* TRIAL (Q) = BIN INDEX OF TRIAL RECORD. H0600521TWINS1 LDA- I (A) = INDEX OF LAST TAG. H0600522 ARS 1 (A) = INDEX OF CURRENT TAG. H0600523 SAN NXTLVL SKIP IF THERE IS A NEXT TREE LEVEL. H0600524* THE FOLLOWING EXIT LOGIC IS A STREAMLINED VERSION OF THAT H0600525* IN THE SMCSRT TOURNAMENT. H0600526 QLS 1 (Q) = FWA OF WINNER BIN - FWA OF RSA. H0600527 ADQ* FWARSA (Q) = FWA OF WINNER BIN. H0600528 STQ* TFWA WINNER BIN WILL BE NEXT TRIAL. H0600529 JMP* (MTOURN) EXIT IF END OF TREE. H0600530NXTLVL STA- I UPDATE TREE LEVEL. (I) = INDEX OF CURRENT TAG. H0600531 LDA* (FWASEQ),Q (A) = SEQ. NO. OF TRIAL. H0600532 JMP* CMPSEQ H0600533*A MERGE NETWORK IS FORMED WHEN THE FOLLOWING SEQTIE VERSION IS H0600534ÐÐ*SUBSTITUTED FOR THAT IN TOURN. H0600535SEQTIE QLS 1 (Q) = FWA OF COMPETITOR BIN - FWA OF RSA. H0600536 LDQ* (FWARSA),Q (Q) = FWA OF COMPETITOR RECORD. H0600537 LDA* TRIAL (A) = BIN INDEX OF TRIAL ITEM. H0600538 ALS 1 ALLOW 2 WORDS PER BIN. H0600539 ADD* FWARSA (A) = FWA OF TRIAL ITEM. H0600540 STA* TFWA SAVE FWA OF TRIAL ITEM. H0600541 LDA* (TFWA) (A) = FWA OF TRIAL RECORD. H0600542***WARNING*** H0600543* EFFICIENCY DEMANDS THAT TRIAL WINS TIES. H0600544* CALL CMPKEY WITH (A)ENTRY = FWA OF TRIAL. H0600545* INIT REPLACES PLUG BELOW WITH FWA OF CMPKEY. H0600546TRNCMP RTJ+ PLUG (A) = FWA OF WINNER RECORD. H0600547KEYADR ADC *-* ADDRESS OF KEY TABLE H0600548 EOR* (TFWA) (A)=0 IF TRIAL RECORD WON. H0600549 SAN JCWINS SKIP IF COMPETITOR RECORD WON. H0600550 JMP* TWINS JMP IF TRIAL RECORD WON. H0600551JCWINS JMP* CWINS JMP IF COMPETITOR RECORD WON. H0600552TRIAL NUM 0 () = BIN INDEX OF TRIAL RECORD. H0600553G NUM 0 () = TOTAL NO. OF RSA BINS, PSEUDO OR REAL. H0600554M NUM 0 () = CURRENT MERGE ORDER. H0600555TAGCNT NUM 0 () = NO. OF TSA TAGS = G-1. H0600556FWASEQ NUM 0 () = FWA OF SEQ. NO. ARRAY. H0600557PRETSA NUM 0 () = -1 + FWA OF TAG STORAGE AREA. H0600558OVRTSA NUM 0 () = 1 + LWA OF TSA. H0600559ÐÐBINSIZ NUM 0 () = NO. OF WORDS IN AN RSA BIN. H0600560FWARSA NUM 0 () = FWA OF RECORD STORAGE AREA. H0600561TFWA NUM 0 () = FWA OF TRIAL BIN. H0600562MAXSEQ NUM $7FFF () = 1 + SEQ. NO. OF NEXT LOS+NG DUMMY. H0600563FWAFXY NUM 0 () = FWA OF FIXED TABLES. H0600564 EJT H0600565**** H0600566*E H0600567* ******* H0600568* * PUT * H0600569* ******* H0600570* H0600571* H0600572* EACH CALL TO PUT SUBROUTINE ATTEMPTS TO MOVE ONE RECORD FROM THE H0600573* RECORD BIN TO THE OUTPUT BUFFER. INITIALLY THE RECORD TO BE SELECTED H0600574* WILL BE A DUMMY RECORD. UNTIL A RECORD IS FOUND WITH A WINNING H0600575* SEQUENCE NUMBER (VALUE OF 1 INITIALLY WINS), ALL DUMMY RECORDS ARE H0600576* IGNORED. ONCE A WINNING RECORD IS ACCEPTED, ALL RECORDS UNTIL A H0600577* TRAILING DUMMY RECORD IS FOUND, WILL BE BLOCKED INTO H0600578* THE OUTPUT BUFFER. THE TRAILING DUMMY RECORD INDICATES ALL REAL H0600579* RECORDS HAVE BEEN FLUSHED FROM TOURNAMENT. H0600580* H0600581* THE PUT SUBROUTINE WANTS TO OUTPUT TO THE SAME MERGE FILE UNTIL H0600582* ALL RECORDS FROM THE INPUT MERGE FILES HAVE BEEN PROCESSED. A NEW H0600583* WORK FILE WILL BE CREATED FOR THE NEXT MERGE STRING BY SUBROUTINE H0600584ÐÐ* MGINIT. H0600585* THE CALLING SEQUENCE IS P RTJ PUT H0600586* P+1 LOSING-DUMMY EXIT. H0600587* P+2 WINNING-DUMMY OR NORMAL EXIT. H0600588* H0600589**** H0600590PUT NUM 0 H0600591PUTSTI LDA =XIOUTFT-HERE (A) = FWA OF MERGE-OUTPUT FILE-TABLE. H0600592 STA- I TELL PUTU WHAT FILE-TABLE TO USE. H0600593 LDQ* TRIAL (Q) = NO. OF WINNER BIN. H0600594 LDA* (FWASEQ),Q (A) = SEQ. NO. OF WINNER. H0600595 SUB* G (A)15=1 IF WINNING-DUMMY. H0600596 SAP PUTGEG SKIP IF NOT WINNING-DUMMY. H0600597 JMP* PUTP2 DISCARD WINNING-DUMMY. H0600598PUTGEG SAZ PUTEQG SKIP IF WINNER IS REAL-RECORD. H0600599* A LOSING DUMMY WON, THEREFORE THE OUTPUT STRING ENDS. H0600600* INIT REPLACES PLUG BELOW WITH FWA OF EOS. H0600601PUTEOS RTJ+ PLUG WRITE PARTIAL BLOCK. UPDATE SEQ. DIRECTORY. H0600602 JMP* (PUT) TAKE P+1(END-OF-STRING) EXIT. H0600603PUTEQG LDA* (TFWA) (Q) = FWA OF CURRENT WINNING RECORD. H0600604* INIT REPLACES PLUG BELOW WITH FWA OF PUTU. H0600605PUTPUT RTJ+ PLUG OUTPUT THE RECORD. H0600606PUTP2 RAO* PUT SET UP P+2 EXIT. H0600607 JMP* (PUT) TAKE P+2 EXIT. H0600608 EJT H0600609ÐÐ**** H0600610*E H0600611* ********** H0600612* * MGINIT * H0600613* ********** H0600614* H0600615* H0600616* THE MGINIT SUBROUTINE IS CALLED ONCE FOR EACH MERGE. THIS ROUTINE H0600617* INITIALIZES TABLES REQUIRED FOR THE NEXT MERGE CYCLE. H0600618* THE CALLING SEQUENCE IS RTJ MGINIT (MERGE INITIALIZATION) H0600619* H0600620**** H0600621MGINIT NUM 0 H0600622 LDA- HX7FFF (A) = SEQ. NO. OF PSEUDO BIN. H0600623 STA* MAXSEQ () = 1 + SEQ. NO. OF NEXT LOSING DUMMY. H0600624* PREPARE TO CALL TURNIT. H0600625 ENA 2 (A) = 2 = SIZE OF RSA BIN. H0600626 LDQ* M (Q) = NO. OF REAL RSA BINS. H0600627 RTJ* TURNIT INITIALIZE MTOURN AND ARRAYS. H0600628 RTJ* FTINIT INITIALIZE INPUT FILE TABLES. H0600629MGNIT1 LDA =XIOUTFT-HERE (A) = FWA OF OUTPUT FILE TABLE. H0600630 STA- I TELL BOS WHAT FILE TABLE TO USE. H0600631* INIT REPLACES PLUG BELOW WITH FWA OF BOS. H0600632MGNIT2 RTJ+ PLUG INITIALIZE OUTPUT FILE AND FILE TABLE. H0600633 JMP* (MGINIT) EXIT. H0600634ÐÐ EJT H0600635**** H0600636*E H0600637* ********* H0600638* *TURNIT * H0600639* ********* H0600640* H0600641* H0600642*THE TURNIT SUBROUTINE DEFINES TABLE SPACE FOR THE RECORD STORAGE AREA, H0600643* THE SEQUENCE NUMBER ARRAY, AND THE TAG STORAGE AREA. TURNIT PRESETS H0600644* THE LATTER TWO TABLES WITH INITIAL VALUES PRIOR TO MERGING. H0600645* H0600646* FWARSA ************* H0600647* * RECORD * RECORD STORAGE AREA CONTAINS YIWAY ENTRIESH0600648* * STORAGE * 1ST WORD OF ENTRY = FWA OF RECORD H0600649* * AREA * 2ND WORD OF ENTRY = FWA OF FILE TABLE H0600650* FWASEQ ************* H0600651* * 0 * G = NUMBER OF MERGE FILES H0600652* * 1 * H0600653* * . * H0600654* * . * THESE ARE THE PRESET SEQUENCE NUMBERS H0600655* * . * H0600656* * G-2 * H0600657* PRETSA * G-1 * THIS ENTRY IS SET TO $7FFF IF G IS ODD TO H0600658* ************* INDICATE DUMMY RECORD BIN H0600659ÐÐ* * G-2 * H0600660* * G-4 * (NOTE:PRETSA IS OFFSET ONE WORD POSITION) H0600661* * . * H0600662* * . * H0600663* * . * THESE VALUES ARE PRESET FOR THE TAG H0600664* * 2 * STORAGE AREA H0600665* * G-1 * H0600666* * G-3 * H0600667* * . * H0600668* * . * H0600669* * . * H0600670* * 1 * H0600671* OVRTSA ************* END OF TABLE SPACE (TOP OF CORE) H0600672* THE CALLING SEQUENCE IS (A)ENTRY = SIZE IN WORDS OF EACH RSA BIN. H0600673* (Q)ENTRY = NO. OF REAL RSA BINS. H0600674* (I)ENTRY = FWA OF FIXED TABLES. H0600675* (FWARSA)ENTRY = FWA OF THE RSA. H0600676* RTJ TURNIT H0600677* OUTPUTS ARE BINSIZ,TNITEG,G,TAGCNT,CURSEQ,FWASEQ,PRETSA,OVRTSA, H0600678* TRIAL,TFWA, SEQ. NO. ARRAY, TSA ARRAY, H0600679* (A)EXIT = (FWARSA), H0600680* (Q)EXIT=JUNK, (I)EXIT = (I)ENTRY. H0600681* H0600682**** H0600683TURNIT NUM 0 H0600684ÐÐ STA* BINSIZ SAVE RSA BIN LENGTH FOR TOURN AND TURNIT. H0600685* THE FOLLOWING INQ,LRS,QLS ROUND (Q) UP TO THE NEAREST EVEN INTEGER. H0600686 INQ 1 (Q) = 1 + NO. OF REAL RSA BINS. H0600687 LRS 1 (Q) = HALF OF NEAREST EVEN NO. .GE. (Q)ENTRYH0600688 STA* TNITEG (TNITEG)15=1 IF NO. OF REAL BINS IS EVEN. H0600689 QLS 1 (Q) = NEAREST EVEN NO. .GE. (Q)ENTRY. H0600690 STQ* G (G) = TOTAL NO. OF RSA BINS, PSEUDO OR REAL.H0600691 INQ -1 (Q) = NO. OF TSA TAGS. H0600692 STQ* TAGCNT H0600693* COMPUTE RSA SIZE BY INITIALLY ASSUMING ALL RSA BINS ARE REAL BINS, H0600694* THEN, IF THERE WAS A PSEUDO BIN, WE SUBTRACT (BINSIZ). H0600695 LDA* G H0600696 MUI* BINSIZ (A) = (G)*(BINSIZ). H0600697 LDQ* TNITEG (Q)15=1 IF ALL BINS ARE REAL BINS. H0600698 SQM TNITRX SKIP IF ALL BINS ARE REAL BINS. H0600699 SUB* BINSIZ REPLACE A REAL BIN WITH A PSEUDO BIN. H0600700* WE ENTER THE NEXT LOGIC WITH (A) = NO. OF WORDS IN RSA. H0600701TNITRX ADD* FWARSA ADD NO. OF WORDS IN RSA TO FWA OF RSA. H0600702 STA* FWASEQ () = FWA OF SEQUENCE NUMBER ARRAY. H0600703 ADD* TAGCNT ADD -1 + SIZE OF SEQ. NO. ARRAY. H0600704 STA* PRETSA () = -1 + FWA OF TAG STORAGE AREA. H0600705 ADD* G ADD 1 + SIZE OF TAG STORAGE AREA. H0600706 STA* OVRTSA () = 1 + LWA OF TAG STORAGE AREA. H0600707* TENTATIVELY SET SEQ. NO. ARRAY AS IF NO. OF REAL BINS WERE EVEN. H0600708* LATER, WE WILL CHANGE THE SEQUENCE NO. OF THE LAST RSA BIN H0600709ÐÐ* TO $7FFF IF THE LAST RSA BIN IS A PSEUDO BIN, I.E. IF THE NO. OF H0600710* REAL BINS IS ODD. H0600711 LDQ* TAGCNT (Q) = G-1. H0600712TNITSQ STQ* (FWASEQ),Q SET SEQ(I)=I FOR I=G-1 TO I=0 STEP -1. H0600713 SQZ TNITAG SKIP IF ALL SEQ. NUMBERS ARE SET. H0600714 INQ -1 DECREMENT INDEX. POINT TO NEXT SEQ. NO. H0600715 JMP* TNITSQ SET NEXT SEQ. NO. H0600716TNITEG NUM 0 ()15=1 IF NO. OF REAL BINS IS EVEN. H0600717TNITAG LDA G (A)=G SO THAT (A) MAY START = G-2 AT TNITA1.H0600718TNITA1 INA -2 (A) = (NEXT TAG). H0600719 SAM TNIDMY SKIP IF DONE WITH ALL TAGS. H0600720 SAZ TNITA2 SKIP IF DONE WITH NON-BASE TAGS. H0600721 INQ 1 POINT TO NEXT TAG TO SET. H0600722 STA (PRETSA),Q SET TAGS = G-2,G-4,...,2,G-1,G-3,...,1. H0600723 JMP* TNITA1 SET NEXT TAG. H0600724TNITA2 LDA G H0600725 INA 1 (A)=G+1 SO THAT (A) MAY START = G-1 AT TNITA1. H0600726 JMP* TNITA1 JMP TO DO BASE (I.E. LOWEST LEVEL) TAGS. H0600727* BECAUSE OF THE ABOVE LOGIC, (Q) = (TAGCNT) = (G) - 1. H0600728* BELOW, SET LAST SEQ. NO. TO $7FFF IF NO. OF REAL BINS IS ODD. H0600729TNIDMY LDA* TNITEG (A)15=1 IF NO. OF REAL BINS IS EVEN. H0600730 SAM TNITXT SKIP IF NO. OF REAL BINS IS EVEN. H0600731 LDA- HX7FFF A SEQ. NO. OF $7FFF CAUSES ETERNAL LOSER. H0600732 STA (FWASEQ),Q THE CORRESPONDING PSEUDO BIN CAN]T WIN NOW. H0600733* MAKE IT APPEAR THAT 1ST RSA BIN WAS THE LAST WINNER. H0600734ÐÐTNITXT CLR A H0600735 STA TRIAL () = INDEX OF 1ST RSA BIN. H0600736 LDA FWARSA (A) = FWA OF RECORD STORAGE AREA. H0600737 STA TFWA () = FWA OF 1ST RSA BIN. H0600738 JMP* (TURNIT) EXIT. H0600739 EJT H0600740**** H0600741*E H0600742* ********** H0600743* * FTINIT * H0600744* ********** H0600745* H0600746* H0600747* THE FTINIT SUBROUTINE SUPPLIES THE LOGICAL UNIT AND MERGE FILE NUMBER H0600748* TO EACH INPUT FILE TABLE. THE ADDRESS OF EACH FILE TABLE IS INSERTED H0600749* INTO THE 2ND WORD OF EACH RECORD STORAGE AREA ENTRY. THIS STEP IS H0600750* NECESSARY SINCE THE RSA TABLE IS NOT A FIXED LENGTH THE FIRST PASS H0600751* AS COMPARED TO SUCCESIVE PASSES FOR MERGING. H0600752* THE ACCUMULATE BLOCKED RECORD COUNT FOR ALL RECORDS TO BE MERGED IS H0600753* SAVED FOR DEFINDING THE OUTPUT MERGE RECORD COUNT. H0600754* THE CALLING SEQUENCE IS RTJ FTINIT (FILE TABLE INITIALIZATION) H0600755* H0600756**** H0600757FTINIT NUM 0 H0600758 LDQ FWAFXY FWA OF FIXED TABLES H0600759ÐÐ CLR A H0600760 STA- YRECNT,Q H0600761 STA- YRECNT+1,Q CLEAR FILE COUNT FOR CURRENT OUPUT MERGE FILE H0600762 LDA G CALCULATE INDEX TO ENTRY POSITION IN FWARSA H0600763 LDQ* TNITEG H0600764 SQM FTNIT3 H0600765 INA -1 NUMBER OF REAL BINS H0600766FTNIT3 ALS 1 H0600767 STA* FTINDX H0600768 ENA FTSIZE (A) = SIZE OF ONE FILE TABLE. H0600769 MUI M (A) = SIZE OF M FILE TABLES. H0600770 ADD* FWAIFT (A) = 1 + LWA OF INPUT FILE TABLES. H0600771FTNIT1 INA -FTSIZE (A) = FWA OF NEXT INPUT FILE TABLE. H0600772 STA- I TELL GETSEQ AND CLRFT WHICH FT TO USE. H0600773 SUB* FWAIFT (A)15=1 IF WE ARE DONE. H0600774 SAP FTNIT2 SKIP IF NOT YET DONE. H0600775 JMP* (FTINIT) EXIT IF DONE. H0600776* INIT REPLACES PLUG BELOW WITH FWA OF GETSEQ. H0600777FTNIT2 RTJ+ PLUG GET AN INPUT STRING. H0600778* THE EXISTING RECORD COUNT CONSISTS OF BLOCKED RECORDS. THE NEW RECORDH0600779* COUNT WILL ALSO BE BLOCKED. THEREFORE OUTPUT FROM RECADD IS CORRECT. H0600780* INIT REPLACES PLUG BELOW WITH FWA OF RECADD H0600781FTNIT4 RTJ+ PLUG ACCUMULATE OUTPUT MERGE RECORD COUNT H0600782 LDA- I (A) = FWA OF CURRENT INPUT FILE TABLE. H0600783 LDQ* FTINDX H0600784ÐÐ INQ -2 H0600785 STQ* FTINDX H0600786 STA* (INIT02),Q STORE FWA OF AN INPUT FILE TABLE. H0600787 JMP* FTNIT1 SEE IF WE ARE DONE. H0600788FWAIFT NUM 0 () = FWA OF THE INPUT FILE TABLES. H0600789FTINDX NUM 0 ()=CURRENT ADDRESS OF FWARSA ENTRY FOR FT ADDRH0600790 EJT H0600791**** H0600792*E H0600793* ******** H0600794* * INIT * H0600795* ******** H0600796* H0600797* THE INIT SUBROUTINE ESTABLISHES INFORMATION NEEDED INITIALLY SET,I.E.,H0600798* ABSOLUTIZING ADDRESSES, LINKING SMCMON PROCESSOR ADDRESSES TO SMCIMG, H0600799* DETERMINING ORDER OF INITIAL MERGE, AND SETING UP BUFFERS NEEDED FOR H0600800* THE MERGE. IN ADDITION THE RECORD AND BUFFER LENGTHS AND FWA OF EACH H0600801* INPUT OR OUTPUT RECORD BUFFER ARE STUFFED INTO THE FILE TABLE FOR EACHH0600802* FILE BUFFER DEFINED. H0600803* BELOW SHOWS THE TABLES SET UP BY INIT: H0600804* IOUTFT ******************* H0600805* * OUTPUT * H0600806* * FILE * H0600807* * TABLE * H0600808* ******************* H0600809ÐÐ* * OUTPUT * H0600810* * BLOCKED * AREA USED FOR EACH OUTPUT MERGE H0600811* * BUFFER * STRING H0600812* ******************* H0600813* ****************** H0600814* * INPUT BLOCKED * SIZE OF EACH BUFFER 2 WORDS LESS H0600815* * RECORD AREA (1) * THAN OUTPUT BUFFER H0600816* ******************* H0600817* * . * H0600818* * . * H0600819* * . * H0600820* ******************* H0600821* * INPUT BLOCKED * H0600822* * RECORD AREA (N) * N = YIWAY (INTERMEDIATE MERGE ORDER)H0600823* FWAIFT ******************* H0600824* * INPUT FILE * H0600825* * TABLE (1) * H0600826* ******************* H0600827* * . * H0600828* * . * H0600829* * . * H0600830* ******************* H0600831* * INPUT FILE * H0600832* * TABLE (N) * H0600833* FWARSA ******************* H0600834ÐÐ* * /INPUT FILE * THE ADDRESSES SPECIFIED ARE THE H0600835* * TABLE (1) ADDR * 2ND WORD OF A 2 WORD ENTRY H0600836* ******************* H0600837* * . * H0600838* * . * H0600839* * . * H0600840* ******************* H0600841* * /INPUT FILE * H0600842* * TABLE (N) ADDR * H0600843* ******************* H0600844* THE CALLING SEQUENCE IS (Q),(I)ENTRY = FWA OF SMCMON FIXED TABLE H0600845* RTJ INIT H0600846* (I)EXIT = (I)ENTRY H0600847* H0600848**** H0600849INIT NUM 0 () = FWA OF HERE. H0600850 ENA 2 (A) = PHASE NO. OF SMCIMG. H0600851 STA- YPHASE,I TELL FIXED TABLES THAT SMCIMG IS RUNNING. H0600852 STQ FWAFXY () = FWA OF FIXED TABLES. H0600853 RTJ RELOC RELOCATE ALL RELOCATABLES. H0600854 RTJ LINK RESOLVE SMCIMG REFERENCES TO SMCMON. H0600855 LDA- YKEY,I DEFINE FWA OF KEY TABLE H0600856 STA KEYADR H0600857 RTJ DETM SET (YU),(Y0WAY),(M). H0600858 LDA- YOFT+RECLTH,I (A) = NO. OF WORDS PER LOGICAL RECORD. H0600859ÐÐ STA* IOUTFT+RECLTH TELL RECLTH TO OUTPUT WORK FILE TABLE. H0600860 LDA- YWKBSZ,I (A) = NO. OF DATA WORDS PER WORK BUFFER. H0600861 STA* IOUTFT+BUFLTH TELL BUFLTH TO OUTPUT WORK FILE TABLE. H0600862 INA -2 (A) = TOTAL NO. OF WORDS PER WORK BUFFER H0600863 MUI- YIWAY,I (A) = MAX. NO. OF WORDS NEEDED FOR IN. BUFS.H0600864 ADD* IOUTFT+BUFWA ADD FWA OF OUTPUT WORK BUFFER DATA. H0600865 ADD* IOUTFT+BUFLTH ADD MAX. NO. OF OUTPUT BUFFER DATA WORDS. H0600866 STA FWAIFT () = FWA OF THE MERGE INPUT FILE TABLES. H0600867 STA* INIT05 () = 1 + LWA OF INPUT WORK FILE BUFFERS. H0600868 ENA FTSIZE (A) = NO. OF WORDS PER FILE TABLE. H0600869 MUI- YIWAY,I ALLOW FOR MAX. NO. OF INPUT FILE TABLES. H0600870 ADD FWAIFT ADD FWA OF INPUT FILE TABLES. H0600871 STA FWARSA () = FWA OF RSA FOR MTOURN. H0600872* SET THE 2ND WORD OF EACH RSA BIN TO FWA OF THE CORRESPONDING H0600873* INPUT FILE TABLE. H0600874* ALSO SET (RECLTH),(BUFLTH),(BUFWA) FOR EACH INPUT WORK FILE TABLE. H0600875 STA* INIT02 PREPARE FOR INDIRECT ADDRESSING OF RSA. H0600876 RAO* INIT02 () = FWA OF 1ST RECIPIENT OF INPUT FT FWA. H0600877 LDQ- YIWAY,I (Q) = MAXIMUM INTERMEDIATE MERGE ORDER. H0600878 QLS 1 ALLOW 2 WORDS PER RSA BIN. H0600879INIT03 INQ -2 POINT TO NEXT INPUT FT FWA RECIPIENT. H0600880 SQP INIT04 SKIP IF NOT YET DONE. H0600881 JMP* (INIT) EXIT. H0600882INIT05 NUM 0 () = 1 + LWA OF NEXT LOWER INPUT BUFFER. H0600883INIT04 INA -FTSIZE (A) = NEXT INPUT FT FWA TO STORE. H0600884ÐÐ STA- I (I) = FWA OF CURRENT INPUT FILE TABLE. H0600885 LDA* IOUTFT+BUFLTH (A) = NO. OF DATA WORDS PER WORK BUFFER. H0600886 INA -2 INPUT BUFFER LENGTH TWO WORDS LESS THAN H0600887* OUTPUT BUFFER BECAUSE OF EOF PROCESSING H0600888 STA- BUFLTH,I TELL EACH INPUT WORK FILE TABLE. H0600889 LDA* INIT05 (A) = 1 + LWA OF CORRESPONDING DATA WORDS. H0600890 SUB- BUFLTH,I (A) = FWA OF CORRESPONDING DATA WORDS H0600891 STA- BUFWA,I TELL FILE TABLE WHERE ITS DATA WORDS ARE. H0600892 STA* INIT05 () = 1 + LWA OF NEXT LOWER INPUT BIFFER. H0600893 LDA* IOUTFT+RECLTH (A) = NO. OF WORDS PER LOGICAL RECORD. H0600894 STA- RECLTH,I SET RECORD LENGTH OF EACH INPUT FILE TABLE. H0600895 LDA- I (A) = FWA OF CURRENT INPUT WORK FILE TABLE. H0600896 JMP* INIT03 SEE IF WE ARE ALL DONE. H0600897 SPC 3 H0600898INIT02 NUM 0 () = 1 + (FWARSA). H0600899X0WAY NUM 0 () = WAY OF 1ST INTERMEDIATE MERGE H0600900XU NUM 0 () = UNIT-STRINGS RATING OF SMCIMG H0600901 EJT H0600902IOUTFT EQU IOUTFT(*) THE FILE TABLE FOR THE I-MERGE OUTPUT FILE. H0600903 BSS (BUFWA) H0600904 ADC IOUTBF-HERE () = FWA OF IOUTBF. H0600905 BSS (FTSIZE-1-BUFWA) H0600906IOUTBF EQU IOUTBF(*) THE BUFFER FOR THE I-MERGE OUTPUT FILE. H0600907 EJT H0600908**** H0600909ÐÐ*E H0600910* ******** H0600911* * DETM * H0600912* ******** H0600913* H0600914* H0600915* DETM HANGS IF SMCIMG SHOULDN]T HAVE BEEN LOADED. H0600916* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF FIXED TABLES. H0600917* (YSEQCT)ENTRY = NO. OF STRINGS FROM SMCSRT. H0600918* (YIWAY)ENTRY = MAX. INTERMEDIATE MERGE ORDERH0600919* (YFWAY)ENTRY = MAX. FINAL MERGE ORDER. H0600920* (YU)ENTRY = 0. H0600921* RTJ DETM H0600922* (I),(YSEQCT),(YIWAY),(YFWAY) EXIT = ENTRY. H0600923* (YU)EXIT = NO. OF UNIT STRINGS FOR SMCIMG. H0600924* (Y0WAY)EXIT = ORDER OF 1ST MERGE OF SMCIMG. H0600925* (M)EXIT = (Y0WAY)EXIT. H0600926* H0600927* THE FOLLOWING ALGORITHM, VIZ. DETM, SUCCESSIVELY APPROXIMATES THE H0600928* MERGE PATTERN REQUIRED TO HANDLE ALL STRINGS FROM THE INTERNAL SORT. H0600929* H0600930* WE START WITH THE FINAL OUTPUT STRING AND THEN WORK BACKWARDS FROM H0600931* THE FINAL MERGE TO THE LAST INTERMEDIATE MERGE ... TO THE 1ST H0600932* INTERMEDIATE MERGE, UNTIL THE RESULTING TREE STRUCTURE HAS A FANOUT H0600933* EQUAL TO THE NUMBER OF STRINGS FROM THE INTERNAL SORT. H0600934ÐÐ* H0600935* WE ALWAYS EXTEND THE FANOUT WITH MAXIMAL-ORDER MERGES, EXCEPT FOR THE H0600936* FIRST MERGE, WHETHER INTERMEDIATE OR FINAL, WHOSE ORDER IS THAT NEEDEDH0600937* TO BRING THE FANOUT TO EQUALITY WITH THE NUMBER OF STRINGS FROM THE H0600938* INTERNAL SORT. H0600939* H0600940* PERFORMANCE IS OPTIMIZED BY THE PRACTICE OF USING THE MAXIMUM MERGE H0600941* ORDERS POSSIBLE, SINCE THIS REDUCES THE NUMBER OF LEVELS IN THE MERGE H0600942* PATTERN, THEREBY REDUCING THE NUMBER OF TIMES A GIVEN STRING FROM THE H0600943* INTERNAL SORT, I.E. UNIT STRING, IS HANDLED. H0600944* H0600945* IF WE COUNT EACH TIME EACH UNIT STRING IS MERGED, WE GET THE H0600946* UNIT-STRINGS RATING OF THE MERGES. THE NUMBER H0600947* OF MERGE PASSES WOULD BE THE UNIT STRINGS RATING OF THE MERGING H0600948* DIVIDED BY THE NUMBER OF STRINGS FROM THE INTERNAL SORT. H0600949* H0600950**** H0600951DETM NUM 0 H0600952 LDA- YFWAY,I (A) = MAXIMUM ORDER OF FINAL MERGE. H0600953 STA* DETMF REMEMBER CURRENT FANOUT. H0600954 SUB- YSEQCT,I (A)15=1 IF INTERMEDIATE MERGE IS NEEDED. H0600955 SAM DETMI SKIP IF INTERMEDIATE MERGE IS NEEDED. H0600956 RTJ (WIERD) ANNOUNCE AND HANDLE WIERD CONDITION. H0600957 NUM -9 ANNOUNCE ERROR NO.9 AND STOP THE RUN. H0600958* LET]S SEE IF WE NEED ONE MORE COMPLETE INTERMEDIATE MERGE PASS H0600959ÐÐ* TO GET ADEQUATE FANOUT. H0600960DETMI LDA- YIWAY,I (A) = MAXIMUM ORDER OF INTERMEDIATE MERGE. H0600961* ADDING A COMPLETE INTERMEDIATE PASS WOULD MULTIPLY THE FANOUT H0600962* BY THE ORDER OF THE MERGES IN THAT PASS. H0600963 MUI* DETMF (A) = FANOUT IF INTERMEDIATE PASS IS ADDED. H0600964 TRA Q SAVE PROPOSED FANOUT IN Q. H0600965 SUB- YSEQCT,I (A)15=1 IF PROPOSED FANOUT IS TOO LOW. H0600966 SAP DETMDF SKIP IF PROPOSED FANOUT IS AT LEAST ENOUGH. H0600967* WE NEED ONE MORE COMPLETE INTERMEDIATE MERGE PASS, AND THEN SOME. H0600968 STQ* DETMF UPDATE FANOUT ASSUMING ADDITION OF I-PASS. H0600969* THE UNIT STRINGS RATING MUST ALSO REFLECT THE ADDITION OF THE I-PASS. H0600970 LDA- YSEQCT,I (A) = USR INCREMENT DUE TO ADDED I-PASS. H0600971 ADD* XU ADD THE OLD UNIT STRINGS RATING. H0600972 STA* XU UPDATE THE UNIT STRINGS RATING. H0600973 JMP* DETMI SEE IF WE NEED YET ANOTHER COMPLETE I-PASS. H0600974* THE BELOW CODE ASSUMES WE NEED AT MOST ONE MORE COMPLETE I-PASS. H0600975* THE QUESTION IS WHETHER WE NEED ONLY ADD A PARTIAL I-PASS, H0600976* AND HOW PARTIAL, I.E. HOW MANY MERGES AND IS ONE OF THEM NON-MAXIMAL. H0600977* IF A NON-MAXIMAL I-MERGE CAN BE USED, WHAT IS ITS ORDER. H0600978DETMDF LDA- YIWAY,I (A) = MAXIMUM ORDER OF AN I-MERGE. H0600979 INA -1 (A) = I-MERGE STRING-REDUCTION CAPACITY. H0600980 STA* DETMI1 SAVE STRING-REDUCTION RATING OF ONE I-MERGE.H0600981 LDA- YSEQCT,I (A) = TOTAL FANOUT NEEDED. H0600982 SUB* DETMF (A) = ADDITIONAL FANOUT NEEDED. H0600983* WE WILL NOW COMPUTE THE NUMBER OF ADDITIONAL I-MERGES NEEDED BY H0600984ÐÐ* DIVIDING THE ADDITIONAL FANOUT NEEDED BY THE STRING-REDUCTION H0600985* RATING OF ONE MAXIMAL-ORDER I-MERGE. H0600986 CLR Q PREPARE TO DIVIDE. H0600987* THE FOLLOWING DVI SETS (A) = NO. OF ADDITIONAL MAXIMAL I-MERGES NEEDEDH0600988* AND SETS (Q) = STRING-REDUCTION RATING, = -1 + MERGE ORDER, OF ANY H0600989* ADDITIONAL NON-MAXIMAL I-MERGE NEEDED. H0600990 DVI* DETMI1 (A) = NO. OF EXTRA MAXIMAL I-MERGES NEEDED. H0600991 STQ* X0WAY (Q) = -1 + ORDER OF NON-MAXIMAL I-MERGE. H0600992 MUI- YIWAY,I (A) = USR INCREMENT BY EXTRA MAX. I-MERGES. H0600993 ADD* XU (A) = TOTAL USR EXCEPT FOR NON-MAX I-MERGE. H0600994 LDQ* X0WAY (Q) = -1 + ORDER OF NON-MAXIMAL I-MERGE. H0600995 SQN DETMRA SKIP IF A NON-MAXIMAL I-MERGE IS NEEDED. H0600996* ONLY MAXIMAL I-MERGES WILL BE USED, THEREFORE ORDER OF 1ST MERGE H0600997* OF RUN WILL BE MAXIMUM INTERMEDIATE-MERGE ORDER. H0600998 LDQ- YIWAY,I (A) = MAXIMUM INTERMEDIATE-MERGE ORDER. H0600999DETMXT STQ* X0WAY SET ORDER OF 1ST MERGE IN RUN. H0601000 STQ M SET ORDER OF NEXT INTERMEDIATE MERGE. H0601001 STA* XU SET PREDICTED UNIT STRING RATING. H0601002 JMP* (DETM) EXIT. H0601003DETMRA INQ 1 (Q) = ORDER OF NON-MAXIMAL I-MERGE. H0601004 AAQ A (A) = TOTAL USR FOR SMCIMG. H0601005 JMP* DETMXT RECORD THE TOTAL AND EXIT. H0601006DETMF NUM 0 () = CURRENT FANOUT. H0601007DETMI1 NUM 0 () = -1 + MAXIMUM ORDER OF I-MERGE. H0601008 EJT H0601009ÐÐ**** H0601010*E H0601011* ********* H0601012* * RELOC * H0601013* ********* H0601014* H0601015* H0601016* RELOC RELOCATES THE WORDS MENTIONED IN THE LIST, RELOC4. H0601017* THE RELOC4 LIST REPRESENTS ALL ADDRESSES THAT NEED TO BE ABSOLUTIZED. H0601018* THE CALLING SEQUENCE IS RTJ RELOC H0601019* (I)EXIT = (I)ENTRY H0601020* H0601021**** H0601022RELOC NUM 0 H0601023 ENQ RELOC3 (Q) = NO. OF ENTRIES IN RELOC4. H0601024RELOC7 INQ -1 (Q) = INDEX TO NEXT RELOCATEE. H0601025 SQP RELOC6 SKIP IF NOT DONE. H0601026 JMP* (RELOC) EXIT IF DONE. H0601027RELOC6 LDA* RELOC4,Q (A) = FWA OF RELOCATEE - FWA OF HERE. H0601028 ADD INIT (A) = FWA OF RELOCATEE. H0601029 STA* RELOC5 SAVE FWA OF RELOCATEE. H0601030 LDA* (RELOC5) (A) = RELOCATEE. H0601031 ADD INIT (A) = RELOCATED (RELOCATEE). H0601032 STA* (RELOC5) SET RELOCATEE. H0601033 JMP* RELOC7 JMP TO SEE IF DONE. H0601034ÐÐRELOC5 NUM 0 () = FWA OF RELOCATEE. H0601035RELOC4 EQU RELOC4(*) H0601036 ADC PUTSTI+1-HERE H0601037 ADC MGNIT1+1-HERE H0601038 ADC IOUTFT+BUFWA-HERE H0601039RELOC3 EQU RELOC3(*-RELOC4) H0601040 EJT H0601041**** H0601042*E H0601043* ******** H0601044* * LINK * H0601045* ******** H0601046* ALL PROCESSOR ADDRESSES IN SMCMON THAT SMCIMG NEEDS ARE LINKED HERE. H0601047* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF SMCMON FISED TABLE H0601048* RTJ LINK H0601049* (Q),(I)EXIT = (Q),(I)ENTRY H0601050* H0601051**** H0601052LINK NUM 0 H0601053 LDA- YGETU,I H0601054 STA GETGET+1 H0601055 LDA- YCMPKY,I H0601056 STA TRNCMP+1 H0601057 LDA- YEOS,I H0601058 STA PUTEOS+1 H0601059ÐÐ LDA- YPUTU,I H0601060 STA PUTPUT+1 H0601061 LDA- YBOS,I H0601062 STA MGNIT2+1 H0601063 LDA- YGTSEQ,I H0601064 STA FTNIT2+1 H0601065 LDA- YRCADD,I H0601066 STA FTNIT4+1 H0601067 LDA- YWIERD,I (A) = FWA OF WIERD IN SMCMON. H0601068 STA* WIERD SAVE FWA OF WIERD. H0601069 LDA- YIMGSZ,I (A) = TABULATED SIZE OF SMCIMG RESIDENT. H0601070 EOR =XIMGSIZ COMPARE TABULATED TO ACTUAL. H0601071 SAZ LINK01 SKIP IF TABULATED = ACTUAL. H0601072 RTJ* (WIERD) ANNOUNCE AND HANDLE WIERD CONDITION. H0601073 NUM -10 ANNOUNCE ERROR NO.10 AND STOP THE RUN. H0601074LINK01 EQU LINK01(*) H0601075 JMP* (LINK) EXIT. H0601076WIERD NUM 0 () = FWA OF WIERD IN SMCMON. H0601077* SIZE OF SMCIMG RESIDENT LOGIC. H0601078IMGSIZ EQU IMGSIZ(IOUTBF-SMCIMG) H0601079 END SMCIMG H0601080 NAM SMCFMG H07 A ITOS CCS 3.0 SL-149H0700001* GENERATES FINAL MERGE H0700002* CREDIT COLLECTION SYSTEM VERSION 3.0 H0700003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA H0700004ÐÐ* COPYRIGHT CONTROL DATA CORPORATION 1979 H0700005 SPC 5 H0700006**** H0700007*E H0700008* *************** H0700009* * FINAL MERGE * H0700010* *************** H0700011* H0700012* H0700013* FUNCTION H0700014* -------- H0700015* H0700016* SMCFMG MERGES THE SEQUENCES PRODUCED BY SMCSRT OR BY SMCIMG, IF H0700017* SMCIMG IS NEEDED, INTO ONE FINAL SEQUENCE ON THE USER OUTPUT FILE. H0700018* H0700019* H0700020* GENERAL DESCRIPTION H0700021* ------------------- H0700022* H0700023* THE INPUT FILES TO SMCFMG ARE WORK FILES AND THE OUTPUT FILE IS THE H0700024* USERS FILE. H0700025* H0700026* RECURSION WILL NOT BE INVOLVED SINCE SMCIMG WILL HAVE MERGED ENOUGH H0700027* STRINGS UNTIL SMCFMG CAN HANDLE ALL REMAINING STRINGS IN ONE PASS. H0700028* H0700029ÐÐ* THE FINAL MERGE PERFORMED, COMBINES FWAY OR LESS SEQUENCES. THE H0700030* MAXIMUM POSSIBLE SEQUENCES WOULD BE FWAY. FWAY IS LIMITED TO THE H0700031* NUMBER OF FILE MANAGER SEQUENTIAL FILES THAT CAN BE OPENED AT ANY H0700032* GIVEN TIME FOR A USER. H0700033* H0700034* WHEN PERFORMING A MERGE, SMCFMG USES AN ADAPTATION OF THE TOURNAMENT H0700035* OF SMCSRT. THE SMCFMG QUEUE IS BEING FED BY SEVERAL INPUT SEQUENCES H0700036* AT THE SAME TIME, IN CONTRAST WITH THE SERIAL INPUT OF PROBABLY H0700037* UNSORTED FILES TO THE SMCSRT QUEUE. H0700038* H0700039* SINCE THE INPUT TO THE SMCFMG QUEUE IS SORTED, THE SEPARATE INPUT H0700040* BUFFERS CONSTITUTE THE ACTUAL LOGICAL RECORD DELAY AREA, AND WITHIN H0700041* A SINGLE MERGE, EACH LOGICAL RECORD NEED BE MOVED ONLY ONCE, VIZ, H0700042* FROM THE CORRESPONDING INPUT BUFFER TO THE OUTPUT BUFFER. H0700043**** H0700044 EJT 0 H0700045**** H0700046*E H0700047* INPUT REQUIREMENTS H0700048* ------------------ H0700049* H0700050* THE SMCFMG OVERLAY IS ENTERED AT THE SECOND LOCATION WITHIN ITSELF. H0700051* THE I REGISTER (I) CONTAINS THE FIRST WORD ADDRESS OF SMCMON FIXED H0700052* TABLE SPACE. H0700053* H0700054ÐÐ* H0700055* OUTPUT H0700056* ------ H0700057* H0700058* THE SMCFMG OVERLAY DOES NOT SET REGISTER VALUES TO SPECIFIC VALUES H0700059* WHEN IT IS DONE. H0700060* H0700061* H0700062* ENTRY/EXIT H0700063* ---------- H0700064* H0700065* ENTRY - H0700066* THE SMCFMG OVERLAY IS LOADED BY THE LOAD SUBROUTINE IN DSORT. SMCMON H0700067* MAKES A SUBROUTINE CALL TO LOAD PASSING THE OVERLAY INDEX (REQUEST TO H0700068* LOAD SMCFMG) AND THE FWA OF SMCFMG. SMCFMG IS LOADED AFTER THE H0700069* ADDROUT RELATIVE RECORD NUMBER WORDS IN THE VARIABLE TABLE AREA. THE H0700070* LOAD SUBROUTINE IN DSORT SETS THE RETURN ADDRESS TO SMCMON IN THE H0700071* FIRST LOCATION OF SMCFMG AND THEN JUMPS TO THE SECOND LOCATION IN H0700072* SMCFMG. H0700073* H0700074* EXIT - H0700075* SMCFMG RETURNS TO SMCMON WHEN THE REMAINING SEQUENCES (LESS THAN OR H0700076* EQUAL TO FWAY) ARE COMBINED INTO THE FINAL OUTPUT USER FILE. THE H0700077* RETURN ADDRESS TO SMCMON IS SET IN THE FIRST LOCATION OF SMCFMG. H0700078* H0700079ÐÐ* IF A FILE MANAGER ERROR IS DETECTED, CONTROL IS TRANSFERRED TO THE H0700080* BOMB ROUTINE IN SMCMON. H0700081**** H0700082 EJT 0 H0700083**** H0700084*E H0700085* FLOW H0700086* ---- H0700087* H0700088* THE SMCFMG OVERLAY PERFORMS THE FOLLOWING: H0700089* H0700090* 1. SETS UP THE WORK TABLE SPACE FOR THE INPUT AND OUTPUT FILES H0700091* 2. DEFINES THE TOURNAMENT TABLE SPACE AND INITIALIZES THESE TABLES H0700092* 3. FETCHES A RECORD TO BE SORTED H0700093* 4. SUBMITS IT TO THE TOURNAMENT H0700094* 5. DISPOSE OF A WINNER, REAL OR DUMMY RECORD FROM THE TOURNAMENT H0700095* 6. REPEAT STEPS 2 THRU 5 UNTIL TOURNAMENT IS FLUSHED H0700096* H0700097* H0700098* SUBROUTINES H0700099* ----------- H0700100* H0700101* BOMB: TERMINATES SORT RUN WHEN ERROR ENCOUNTERED H0700102* CLSU: FLUSHES OUTPUT BUFFER AND REPORTS FILE STATISTICS H0700103* CMPKEY: COMPARES 2 KEYS TO DETERMINE WINNER H0700104ÐÐ* CRTMSG: DISPAYS MESSAGE H0700105* GETU: FETCHES NEXT RECORD TO BE MERGED H0700106* GETSEQ: GETS LOGICAL UNIT AND FILE NUMBER OF NEXT FILE TO BE MERGED H0700107* PUTU: MOVES RECORD TO OUTPUT FILE H0700108* WIERD: REPORTS ABNORMAL ERROR CONDITIONS H0700109* H0700110* H0700111* MESSAGES H0700112* -------- H0700113* H0700114* THE MESSAGES FOR ALL OVERLAYS ARE LISTED IN THE EQUATE SECTION H0700115* UNDER 'MESSAGE PROCESSOR INDEX EQUATES'. H0700116**** H0700117 EJT H0700118**** H0700119*E H0700120* PARAMETERS H0700121* ---------- H0700122* H0700123*OFTEN NEEDED CONSTANTS. H0700124ZERO EQU ZERO(2) (2)=0. H0700125HX7FFF EQU HX7FFF($42) ($42)=$7FFF. H0700126**** H0700127 EJT H0700128**** H0700129ÐÐ*E H0700130* FILE CONTROL BLOCK EQUIVALENCES H0700131 EQU FH(4) LENGTH -1 OF FCB HEADER H0700132 EQU FILEID(ZERO) FILE IDENTIFIER H0700133* ACCESS FILEID INDIRECTLY H0700134* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBERH0700135* BITS 10-00 INDEX OF FCB IN FCB TABLE H0700136 EQU FCBFLG(1) FCB FLAGS H0700137* BITS 15-8, SPARE H0700138* BITS 7-00, NUMBER OF USERS USING FILE H0700139 EQU FILOCK(2) FILE LOCK FLAG (IF NON-0, CONTAINS USER ID) H0700140 EQU NUMSET(3) NUMBER OF SETS OF LOCKED RECORDS IN FILE H0700141 EQU NUMNEW(4) NUMBER OF NEW RECORDS SINCE FCB UPDATED ON MM H0700142 SPC 1 H0700143 EQU RECLEN(FH+1) RECORD LENGTH IN WORDS H0700144 EQU TDATRM(FH+2) TOTAL NUMBER OF DATA RECORDS, MSB H0700145 EQU TDATRL(FH+3) TOTAL NUMBER OF DATA RECORDS, LSB H0700146 EQU DATBAM(FH+4) DATA RECORDS BEGINNING SECTOR ADDRESS, MSB H0700147 EQU DATBAL(FH+5) DATA RECORDS BEGINNING SECTOR ADDRESS,LMSB H0700148 EQU FCBIND(FH+6) FCB INDICATORS H0700149* BIT 15 , SECTOR ALLIGNED RECORDS IF =1 H0700150* BIT 14 , STORAGE MODE FOR INDEXED FILE H0700151* =0, RECORDS STORED RANDOMLY WITHH0700152* RESPECT TO PRIMARY KEY H0700153* =1, RECORDS STORED IN ORDER WIT H0700154ÐÐ* RESPECT TO PRIMARY KEY H0700155* BIT 13 , =1, FILE IS CURRENTLY OPEN H0700156* =0, FILE IS CURRENTLY CLOSED H0700157* BIT 12 , =1, FILE IS BEING COMPRESSED H0700158* =0, FILE IS NOT BEING COMPRESSEDH0700159* BIT 0 , FILE TYPE H0700160* =0, SEQUENTIAL FILE H0700161* =1, INDEXED FILE H0700162 EQU NEDATM(FH+7) NUMBER OF EXISTING DATA RECORDS, MSB H0700163 EQU NEDATL(FH+8) NUMBER OF EXISTING DATA RECORDS, LSB H0700164 EQU SEQLTH(NEDATL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION H0700165* OF FCB FOR A SEQUENTIAL FILE H0700166 SPC 1 H0700167 EQU NEXTBM(FH+9) NEXT FREE KEY INDEX BLOCK, MSB H0700168 EQU NEXTBL(FH+10) NEXT FREE KEY INDEX BLOCK, LSB H0700169 EQU TNKEYM(FH+11) TOTAL NUMBER OF KEY INDEX BLOCKS, MSB H0700170 EQU TNKEYL(FH+12) TOTAL NUMBER OF KEY INDEX BLOCKS, LSB H0700171 EQU KEYBAM(FH+13) KEY INDEX BEGINNING SECTOR ADDRESS, MSB H0700172 EQU KEYBAL(FH+14) KEY INDEX BEGINNING SECTOR ADDRESS, LSB H0700173 EQU LENKY1(FH+15) LENGTH OF KEY NO. 1 H0700174 EQU POSKY1(FH+16) BYTE POSITION OF KEY NO. 1 H0700175 EQU LENKY2(FH+17) LENGTH OF KEY NO. 2 H0700176 EQU POSKY2(FH+18) BYTE POSITION OF KEY NO. 2 H0700177 EQU LENKY3(FH+19) LENGTH OF KEY NO. 3 H0700178 EQU POSKY3(FH+20) BYTE POSITION OF KEY NO. 3 H0700179ÐÐ EQU LENKY4(FH+21) LENGTH OF KEY NO. 4 H0700180**** H0700181 EJT H0700182**** H0700183*E H0700184 EQU POSKY4(FH+22) BYTE POSITION OF KEY NO. 4 H0700185 EQU INDLEN(POSKY4-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION H0700186* OF FCB FOR AN INDEXED FILE H0700187* THE FOLLOWING PORTION OF THE FCB EXISTS ONLY H0700188* ON MASS MEMORY. THESE 10 WORDS ARE NOT LOADEDH0700189* INTO EITHER OF THE FILE MANAGER CONTROLLED FCBH0700190* TABLES. H0700191 EQU TSFILM(FH+23) TOTAL NUMBER OF SECTORS IN FILE, MSB H0700192 EQU TSFILL(FH+24) TOTAL NUMBER OF SECTORS IN FILE, LSB H0700193 EQU NAME12(FH+25) FILE NAME, CHARACTERS 1 AND 2 H0700194 EQU NAME34(FH+26) FILE NAME, CHARACTERS 3 AND 4 H0700195 EQU NAME56(FH+27) FILE NAME, CHARACTERS 5 AND 6 H0700196 EQU NAME78(FH+28) FILE NAME, CHARACTERS 7 AND 8 H0700197 EQU OWNR12(FH+29) OWNER NAME, CHARACTERS 1 AND 2 H0700198 EQU OWNR34(FH+30) OWNER NAME, CHARACTERS 3 AND 4 H0700199 EQU OWNR56(FH+31) OWNER NAME, CHARACTERS 5 AND 6 H0700200 EQU OWNR78(FH+32) OWNER NAME, CHARACTERS 7 AND 8 H0700201 EQU BYTLEN(FH+33) BYTE LENGTH OF RECORD H0700202* H0700203* FOR COMPRESS ONLY H0700204ÐÐ* H0700205 EQU PRSRNM(FH+34) RRN OF LAST PROCESSED RECORD - MSB H0700206 EQU PRSRNL(FH+35) RRN OF LAST PROCESSED RECORD - LSB H0700207 EQU NEWRNM(FH+36) RRN OF THE LATEST 'NEW' RECORD - MSB H0700208 EQU NEWRNL(FH+37) RRN OF THE LATEST 'NEW' RECORD - LSB H0700209 SPC 4 H0700210* WORDS 0 THRU 4 OF THE FCB HEADER AND WORDS H0700211* 6 THRU 10 OF THE FCB ARE REFERRED TO AS THE H0700212* SHARED SUBSET OF THE FCB. THEY INCLUDE THE H0700213* ONLY FCB WORDS THAT CAN BE MODIFIED AFTER FILEH0700214* CREATION. IF TWO OR MORE USERS HAVE THE SAME H0700215* FILE OPEN, THERE HAS TO BE A SINGLE MASTER H0700216* COPY OF THE SUBSET THAT RECEIVES (AND RECORDS)H0700217* ALL OF THE UPDATES. THE CONTROLLED SUBSET H0700218* WILL ALWAYS BE PART OF A MAIN MEMORY RESIDENT H0700219* FCB IF THE FCB IS IN A FM CONTROLLED TABLE. H0700220* IF THE FCB IS IN USER SPACE, THE SUBSET MAY ATH0700221* TIMES RESIDE IN THE SUBSET CONTROL TABLE. H0700222 SPC 2 H0700223* ALTERNATE NAMES FOR SUBSET WORDS H0700224 EQU SAFCBI(FH+1) SUBSET ALTERNATE NAME FOR FCBIND H0700225 EQU SADATM(FH+2) SUBSET ALTERNATE NAME FOR NEDATM H0700226 EQU SADATL(FH+3) SUBSET ALTERNATE NAME FOR NEDATL H0700227 EQU SANXTM(FH+4) SUBSET ALTERNATE NAME FOR NEXTBM H0700228 EQU SANXTL(FH+5) SUBSET ALTERNATE NAME FOR NEXTBL H0700229ÐÐ**** H0700230 EJT 0 H0700231**** H0700232*E H0700233* FILE TABLE STRUCTURE. H0700234LUN EQU LUN(ZERO) F.M. LOGICAL UNIT NUMBER H0700235FILNUM EQU FILNUM(1) F.M. FILE NUMBER H0700236RECLTH EQU RECLTH(FILNUM+1) RECORD LENGTH H0700237BUFLTH EQU BUFLTH(RECLTH+1) RECORD BLOCK LENGTH H0700238BUFWA EQU BUFWA(BUFLTH+1) FWA OF RECORD BLOCKED BUFFER H0700239RECNT EQU RECNT(BUFWA+1) NUMBER OF RECORDS ENCOUNTERED H0700240DOCNT EQU DOCNT(RECNT+2) NUMBER OF RECORDS PROCESSED H0700241ERRCNT EQU ERRCNT(DOCNT+2) NUMBER OF ERRORS FOUND FOR FILE H0700242RECFWA EQU RECFWA(ERRCNT+1) FWA OF NEXT RECORD IN BLOCK H0700243XFRLTH EQU XFRLTH(RECFWA+1) RECORD BLOCK LENGTH FOR I/O H0700244REQBUF EQU REQBUF(XFRLTH+1) REQUEST BUFFER H0700245REQIND EQU REQIND(REQBUF+24) REQUEST INDICATOR H0700246FCB EQU FCB(REQIND+1) FILE CONTROL BLOCK H0700247 EQU FMSLOP(2) FCB OVERFLOW CORE SPACE INTO FCB INDEX SECT. H0700248FTSIZE EQU FTSIZE(FCB+SEQLTH+FH+1+FMSLOP) SIZE OF FILE TABLE H0700249**** H0700250 EJT H0700251**** H0700252*E H0700253*SMC FIXED-TABLE STRUCTURE. H0700254ÐÐ SPC 2 H0700255YNAMFL EQU YNAMFL(ZERO) () = FWA ASCII FILE, OWNER, VOLUME TABLE H0700256YIFTAD EQU YIFTAD(1) () = FWA OF INPUT FILE TABLE (FT) H0700257YADOUT EQU YADOUT(YIFTAD+1) () = KEY OR DATA DESCRIPTION TABLE FOR REC.H0700258YKEY EQU YKEY(YADOUT+1) () = KEY TABLE FOR SORT FIELDS H0700259YADRBF EQU YADRBF(YKEY+1) () = ADDROUT CONVERSION SPACE FOR RECORD H0700260YFIELD EQU YFIELD(YADRBF+1) () = RECORD SELECTION TABLE H0700261YCOMPR EQU YCOMPR(YFIELD+1) () = KEY FIELD FOR RECORD SELECTION H0700262YSHIFT EQU YSHIFT(YCOMPR+1) () = KEY OFFSET SPACE FOR RECORD SELECTION H0700263YEND EQU YEND(YSHIFT+1) () = END OF VARIABLE TABLES H0700264YHICOR EQU YHICOR(YEND+1) () = TOTAL AVAILABLE SORT CORE MEMORY SPACEH0700265YEDTSZ EQU YEDTSZ(YHICOR+1) () = SIZE OF INPUT EDITOR OVERLAY H0700266YSRTSZ EQU YSRTSZ(YEDTSZ+1) () = SIZE OF SORT OVERLAY H0700267YIMGSZ EQU YIMGSZ(YSRTSZ+1) () = SIZE OF INTERMEDIATE MERGE OVERLAY H0700268YFMGSZ EQU YFMGSZ(YIMGSZ+1) () = SIZE OF FINAL MERGE OVERLAY H0700269YPHASE EQU YPHASE(YFMGSZ+1) () = OVERLAY NUMBER CURRENTLY EXECUTING H0700270YDM EQU YDM(YPHASE+1) () = NUMBER OF INPUT FILES H0700271YFLAG EQU YFLAG(YDM+1) () = BIT 15 - (0/1) = (TAG/ADDR) H0700272* 14 - (0/1) = (DATA/FULL RECORD) H0700273* 13 - (0/1) = (ASCII/EBCDIC) H0700274* 12 - (0/1) = (OMIT/INCLUDE) H0700275YG EQU YG(YFLAG+1) () = NUMBER OF SORT BINS (RECORDS) H0700276YIWAY EQU YIWAY(YG+1) () = MAX NUMBER OF INTERMEDIATE MERGE FILESH0700277YFWAY EQU YFWAY(YIWAY+1) () = MAX NUMBER OF FINAL MERGE FILES H0700278YMAXIB EQU YMAXIB(YFWAY+1) () = INPUT BLOCK FACTOR (IN WORDS) H0700279ÐÐYWKBSZ EQU YWKBSZ(YMAXIB+1) () = WORK SPACE AVAILABLE (IN WORDS) H0700280YIRCNT EQU YIRCNT(YWKBSZ+1) () = INPUT RECORD COUNT TO SORT H0700281YORCNT EQU YORCNT(YIRCNT+2) () = OUTPUT RECORD COUNT FROM SORT H0700282YSQ2MG EQU YSQ2MG(YORCNT+2) () = NUMBER OF MERGE FILES TO BE PROCESSED H0700283YSEQCT EQU YSEQCT(YSQ2MG+1) () = TOTAL NUMBER OF MERGE FILES H0700284YCMPKY EQU YCMPKY(YSEQCT+1) () = PROCESSOR - COMPARES KEYS H0700285YRCADD EQU YRCADD(YCMPKY+1) () = PROCESSOR - ACCUMULATES EXIST. REC CNTH0700286YGETU EQU YGETU(YRCADD+1) () = PROCESSOR - DEBLOCKS F.M. RECORDS H0700287YPUTU EQU YPUTU(YGETU+1) () = PROCESSOR - BLOCKS F.M. RECORDS H0700288YCLSU EQU YCLSU(YPUTU+1) () = PROCESSOR - FLUSHES OUTPUT BUFFER H0700289YGTSEQ EQU YGTSEQ(YCLSU+1) () = PROCESSOR - FINDS MERGE STRING TO USE H0700290YBOS EQU YBOS(YGTSEQ+1) () = PROCESSOR - DEFINES MERGE WORK FILE H0700291YEOS EQU YEOS(YBOS+1) () = PROCESSOR - CLOSES MERGE WORK FILE H0700292YOFRL EQU YOFRL(YEOS+1) () = OUTPUT FILE RECORD SIZE (CHARS) H0700293YRECNT EQU YRECNT(YOFRL+1) () = RECORT COUNT FOR EACH FILE H0700294YOPEN EQU YOPEN(YRECNT+2) () = PROCESSOR - OPENS F.M. FILES H0700295YCLOSE EQU YCLOSE(YOPEN+1) () = PROCESSOR - CLOSES F.M. FILES H0700296YGTFCB EQU YGTFCB(YCLOSE+1) () = PROCESSOR - READS EXTENDED FCB H0700297YVOLSR EQU YVOLSR(YGTFCB+1) () = PROCESSOR - FIND F.M. LU FROM VOLUME H0700298YCLSEQ EQU YCLSEQ(YVOLSR+1) () = PROCESSOR - COLLATING SEQUENCE ROUTINEH0700299YMVCHR EQU YMVCHR(YCLSEQ+1) () = PROCESSOR - OFFSETS CHARACTER STRING H0700300YSVAQI EQU YSVAQI(YMVCHR+1) () = PROCESSOR - SAVES REGISTERS A,Q,I H0700301YREAQI EQU YREAQI(YSVAQI+1) () = PROCESSOR - RESTORES REGISTERS A,Q,I H0700302**** H0700303 EJT H0700304ÐÐ**** H0700305*E H0700306YCRMSG EQU YCRMSG(YREAQI+1) () = PROCESSOR - PRINTS MESSAGES TO CRT H0700307YTYPIN EQU YTYPIN(YCRMSG+1) () = PROCESSOR - INPUTS INPUT DIRECTIVES H0700308YBOMB EQU YBOMB(YTYPIN+1) () = PROCESSOR - TERMINATES RUN WITH ERROR H0700309YWIERD EQU YWIERD(YBOMB+1) () = PROCESSOR - REPORTS UNUSUAL ERROR H0700310YOFT EQU YOFT(YWIERD+1) () = FWA OF OUTPUT FILE TABLE H0700311YCMPLA EQU YCMPLA(YOFT+REQBUF) = PROCESSOR - ASCENDING LOGICAL BINARY H0700312YCMPLD EQU YCMPLD(YCMPLA+1) () = PROCESSOR - DESCENDING LOGICAL BINARY H0700313YCMCLA EQU YCMCLA(YCMPLD+1) () = PROCESSOR - ASCENDING EVEN COLUMN CHARH0700314YCMCLD EQU YCMCLD(YCMCLA+1) () = PROCESSOR DESCEND EVEN COLUMN CHAR H0700315YCMPWA EQU YCMPWA(YCMCLD+1) () = PROCESSOR - ASCENDING WORDS BINARY KEYH0700316YCMPWD EQU YCMPWD(YCMPWA+1) () = PROCESSOR - DESCENDING WRDS BINARY KEYH0700317YCMCUA EQU YCMCUA(YCMPWD+1) () = PROCESSOR - ASCENDING ODD COLUMN CHAR H0700318YCMCUD EQU YCMCUD(YCMCUA+1) () = PROCESSOR - DESCENDING ODD COLUMN CHARH0700319YOUTFT EQU YOUTFT(YOFT+FTSIZE) = LWA OF FIXED TABLES H0700320**** H0700321 EJT 0 H0700322**** H0700323*E H0700324* MISC H0700325* ---- H0700326* H0700327* ** ENTRY POINTS ** H0700328* H0700329ÐÐ ENT SMCFMG H0700330* H0700331* ** EXTERNALS ** H0700332* H0700333* NONE H0700334* H0700335* ** EQUATES ** H0700336* H0700337ADISP EQU ADISP($EA) H0700338AMONI EQU AMONI($F4) H0700339PLUG EQU PLUG($7FFF) H0700340**** H0700341 EJT 0 H0700342**** H0700343*E H0700344* MESSAGE PROCESSOR INDEX EQUATES H0700345 SPC 3 H0700346MSGCLS EQU MSGCLS(1) 'CLOSFL REQIND = $ ' H0700347MSGOPN EQU MSGOPN(2) 'OPENFL REQIND = $ ' H0700348MSGDEL EQU MSGDEL(3) 'DELETE REQIND = $ ' H0700349MSGCRT EQU MSGCRT(4) 'CREATE REQIND = $ ' H0700350MSGRDD EQU MSGRDD(5) 'GETS REQIND = $ ' H0700351MSGWTD EQU MSGWTD(6) 'PUTS REQIND = $ ' H0700352MSGTFB EQU MSGTFB(7) 'GETFCB REQIND = $ ' H0700353MSGFCB EQU MSGFCB(8) 'UPDFCB REQIND = $ ' H0700354ÐÐMSGVOL EQU MSGVOL(9) 'VOLUME= ' H0700355MSFFNO EQU MSGFNO(10) 'FILNAM= ' H0700356* H0700357FM EQU FM(10) SIZE OF F.M. MESSAGE INDEX BLOCK H0700358* H0700359MSGABE EQU MSGABE(FM+1) 'ABNORMAL ERROR = ' H0700360MSGBDR EQU MSGBDR(FM+2) 'BLKSIZ/RECLTH .NE. 1,2,3...' H0700361MSGBLK EQU MSGBLK(FM+3) ' ' H0700362MSGBOM EQU MSGBOM(FM+4) 'FATAL ERROR' H0700363MSGDUN EQU MSGDUN(FM+5) 'DONE = ' H0700364MSGESC EQU MSGESC(FM+6) 'TYPE-IN ERROR' H0700365MSGEXP EQU MSGEXP(FM+7) 'EXPECTED /FOUND ' H0700366MSGIFL EQU MSGIFL(FM+8) 'CANNOT OPEN INPUT FILE' H0700367MSGTLC EQU MSGTLC(FM+9) 'TOO LITTLE CORE' H0700368MSGINE EQU MSGINE(FM+10) 'INTERPHASE RECORD COUNTS DISAGREE' H0700369MSGINP EQU MSGINP(FM+11) PRINTS INPUT DIRECTIVE CARD H0700370MSGPAS EQU MSGPAS(FM+12) 'PASSED = ' H0700371MSGSDE EQU MSGSDE(FM+13) 'SEQ. DIR. ERROR' H0700372MSGTLD EQU MSGTLD(FM+14) 'TOO LITTLE DISK' H0700373MSGTRC EQU MSGTRC(FM+15) 'OUTPUT RECORD COUNT BAD' H0700374MSGIFR EQU MSGIFR(FM+16) 'INPUT FILE LENGTHS ARE NOT EQUAL' H0700375MSGFLN EQU MSGFLN(FM+17) 'FN= , ' H0700376MSGOFR EQU MSGOFR(FM+18) 'OUTPUT FILE RECORD LENGTH IS ZERO' H0700377MSGASO EQU MSGASO(FM+19) 'ADDROUT SORTS ONLY 1 FILE' H0700378MSGVNM EQU MSGVNM(FM+20) 'VOLUME NOT MOUNTED' H0700379ÐÐMSGSOK EQU MSGSOK(FM+21) 'START OF KEY FIELD OUTSIDE OF RECORD' H0700380MSGKEB EQU MSGKEB(FM+22) 'KEY FIELD EXTENDS BEYOND END OF RECORD' H0700381**** H0700382 EJT H0700383SMCFMG NUM 0 H0700384 RTJ INIT INITIALIZE THIS PHASE. H0700385HERE EQU HERE(*) RELOC REFERENCE POINT. H0700386RECMRG RTJ* GET SUBMIT SEQUENCE NO. AND/OR RECORD TO MTOURN.H0700387 RTJ* MTOURN DETERMINE WINNING RECORD. H0700388 RTJ PUT TAKE P+1 OR P+2 EXIT. H0700389 JMP* ENDFMG WINNER WAS LOSING-DUMMY. H0700390 JMP* RECMRG WINNER WAS WINNING-DUMMY OR REAL-RECORD. H0700391 EJT H0700392ENDFMG LDA FWAFXY (A) = FWA OF FIXED TABLES. H0700393 STA- I SIMPLIFY ACCESS TO FIXED TABLES. H0700394 LDA- YORCNT+1,I (A) = LOW ORDER OUTPUT RECORD COUNT. H0700395 EOR- YIRCNT+1,I COMPARE WITH INTERNAL SORT. H0700396 SAN ENDINE SKIP IF INTERPHASE INEQUALITY. H0700397 LDA- YORCNT,I (A) = HIGH ORDER OUTPUT RECORD COUNT. H0700398 EOR- YIRCNT,I COMPARE WITH INTERNAL SORT. H0700399 SAZ END002 SKIP IF INTERPHASE EQUALITY. H0700400ENDINE ENQ MSGINE 'INTERPHASE RECORD COUNTS DISAGREE' H0700401* INIT REPLACES PLUG BELOW WITH FWA OF CRTMSG. H0700402ENDTY1 RTJ+ PLUG H0700403 SET A,Q DISABLE BOMB OPTIONAL MESSAGE H0700404ÐÐ* INIT REPLACES PLUG BELOW WITH FWA OF BOMB H0700405ENDBMB JMP+ PLUG TERMINATE THE RUN H0700406END002 JMP* (SMCFMG) EXIT. H0700407 EJT H0700408**** H0700409*E H0700410* ******* H0700411* * GET * H0700412* ******* H0700413* H0700414* H0700415* THE GET SUBROUTINE SAVES THE FWA OF THE NEXT RECORD READ IN THE FIRST H0700416* WORD OF A RECORD STORAGE SLOT THAT WAS VACATED BY A PREVIOUS MERGE H0700417* WINNER. THE RECORD COMES FROM THE SAME FILE AS THE PREVIOUS WINNER. H0700418* WHEN EOF IS REACH FOR A INPUT MERGE FILE, THE SEQUENCE NUMBER FOR H0700419* THAT FILE IS FLAGGED AS A DUMMY LOSER. OTHERWISE ALL RECORDS THAT H0700420* ARE INDICATED BY THE RSA TABLE ARE CANDIDATES FOR MERGING. H0700421* THE CALLING SEQUENCE IS RTJ GET (GET NEXT RECORD) H0700422* H0700423**** H0700424GET NUM 0 H0700425 LDQ* TFWA (Q) = FWA OF LAST WINNER BIN. H0700426 LDA- 1,Q (A) = FWA OF LAST WINNER FILE TABLE. H0700427 STA- I TELL GETU WHAT FILE TABLE TO USE. H0700428* INIT REPLACES PLUG BELOW WITH FWA OF GETU. H0700429ÐÐGETGET RTJ+ PLUG GET NEXT RECORD FROM LAST WINNER FILE TABLE.H0700430 JMP* GETEOF SUBMIT A LOSING DUMMY IF EOF. H0700431 STA* (TFWA) SUBMIT FWA OF NEW RECORD TO MTOURN. H0700432 LDA* G (A) = SEQ. NO. OF A REAL RECORD. H0700433GETSEQ LDQ* TRIAL (Q) = LAST-WINNER-BIN NO., I.E. 0,...,G-1. H0700434 STA* (FWASEQ),Q STORE SEQ. NO. IN SEQ. NO. ARRAY. H0700435 JMP* (GET) EXIT. H0700436GETEOF LDA* MAXSEQ (A) = $7FFF,$7FFE,$7FFD,... H0700437 INA -1 (A) = $7FFE,$7FFD,$7FFC,... H0700438 STA* MAXSEQ MAKE EACH LOSING DUMMY DIFFER IN SEQ. NO. H0700439 JMP* GETSEQ SUBMIT THE SEQUENCE NUMBER TO MTOURN. H0700440 EJT H0700441**** H0700442*E H0700443* ********** H0700444* * MTOURN * H0700445* ********** H0700446* H0700447* H0700448* THE MTOURN SUBROUTINE IS USED TO SELECT THE NEXT WINNING RECORD FROM H0700449* THE RECORDS TO BE MERGED. ONE RECORD IS A REPRESENTIVE OF EACH FILE H0700450* TO BE MERGED. SOME OF THESE RECORDS ARE FLAGGED VIA THE SEQUENCE H0700451* NUMBER ARRAY AS DUMMY RECORDS IF THE RSA IS NOT FULL. THE H0700452* LAST RECORD RECORDED IN THE RSA BECOMES THE TRIAL RECORD. ITS H0700453* SEQUENCE NUMBER IS COMPARED TO ALL OF ITS COMPETITORS UNTIL ITS H0700454ÐÐ* SEQUENCE NUMBER IS GREATER THAN A COMPETITOR OR IN THE CASE OF TIES H0700455* THE KEY VALUES OF THE COMPETITOR WIN OVER THE TRIAL RECORD. WHEN A H0700456* COMPETITOR RECORD WINS, THE ROLE OF THE COMPETITOR AND TRIAL RECORD H0700457* SWITCH. THE OLD TRIAL RECORD BECOMES AN ENTRY IN THE TAG STORAGE H0700458* AREA. TO INITIALLY SELECT A COMPETITOR ENTRY, G-1-TRIAL BECOMES THE H0700459* FIRST SELECTION. THIS INDEX REPRESENTS BOTH THE RECORD ORDINAL IN H0700460* THE RSA AND AN ORDINAL IN THE TAG STORAGE AREA USED TO SELECT H0700461* AN ENTRY FROM THE SEQUENCE NUMBER ARRAY. AFTER COMPARING THE TRIAL H0700462* TO THE COMPETITOR AND ESTABLISHING THE WINNER, THE NEXT COMPETITOR H0700463* IS SELECTED BY TAKING HALF OF THE OLD COMPETITOR INDEX (BINARY SEARCH)H0700464* AND USE THIS VALUE AS THE NEW COMPETITOR INDEX. WHEN THIS INDEX H0700465* BECOMES ZERO, THE BINARY SELECTION PROCESS IS COMPLETED AND THE H0700466* CURRENT TRIAL ENTRY BECOMES THE WINNER. H0700467* MTOURN USES 2-WORD RSA BINS. H0700468* (1ST WORD) = FWA OF A LOGICAL RECORD WITHIN AN INPUT BUFFER. H0700469* (2ND WORD) = FWA OF THE FILE-TABLE FOR THE CORRESPONDING INPUT FILE. H0700470* THE CALLING SEQUENCE IS RTJ MTOURN H0700471* H0700472**** H0700473MTOURN NUM 0 H0700474 LDQ* TRIAL (Q) = BIN INDEX OF TRIAL RECORD. H0700475 LDA* (FWASEQ),Q (A) = SEQ. NO. OF TRIAL RECORD. H0700476 QRS 1 (Q) = FLOOR(TRIAL BIN INDEX/2). H0700477 TCQ Q (Q) = -FLOOR(TRIAL BIN INDEX/2). H0700478 ADQ* TAGCNT (Q) = INDEX OF BASE TAG OF TRIAL AND COMPETITOR.H0700479ÐÐ STQ- I (I) = INDEX OF CURRENT TAG. H0700480CMPSEQ LDQ* (PRETSA),I (Q) = INDEX OF COMPETITOR BIN. H0700481 SUB* (FWASEQ),Q (A) = TRIAL SEQ. NO. - COMPETITOR SEQ. NO. H0700482 SAM TWINS SKIP IF TRIAL WINS DUE TO LOWER SEQ. NO. H0700483 SAN CWINS SKIP IF TRIAL LOSES DUE TO HIGHER SEQ. NO. H0700484 JMP* SEQTIE JMP IF SEQUENCE NUMBERS TIE. H0700485CWINS LDA* TRIAL (A) = BIN INDEX OF TRIAL RECORD. H0700486 LDQ* (PRETSA),I (Q) = INDEX OF COMPETITOR BIN. H0700487 STA* (PRETSA),I RECORD TRIAL AS LOSER. H0700488 STQ* TRIAL RECORD COMPETITOR AS NEW TRIAL. H0700489 JMP* TWINS1 SEE IF THERE IS A NEXT TREE LEVEL. H0700490TWINS LDQ* TRIAL (Q) = BIN INDEX OF TRIAL RECORD. H0700491TWINS1 LDA- I (A) = INDEX OF LAST TAG. H0700492 ARS 1 (A) = INDEX OF CURRENT TAG. H0700493 SAN NXTLVL SKIP IF THERE IS A NEXT TREE LEVEL. H0700494* THE FOLLOWING EXIT LOGIC IS A STREAMLINED VERSION OF THAT H0700495* IN THE SMCSRT TOURNAMENT. H0700496 QLS 1 (Q) = FWA OF WINNER BIN - FWA OF RSA. H0700497 ADQ* FWARSA (Q) = FWA OF WINNER BIN. H0700498 STQ* TFWA WINNER BIN WILL BE NEXT TRIAL. H0700499 JMP* (MTOURN) EXIT IF END OF TREE. H0700500NXTLVL STA- I UPDATE TREE LEVEL. (I) = INDEX OF CURRENT TAG. H0700501 LDA* (FWASEQ),Q (A) = SEQ. NO. OF TRIAL. H0700502 JMP* CMPSEQ H0700503*A MERGE NETWORK IS FORMED WHEN THE FOLLOWING SEQTIE VERSION IS H0700504ÐÐ*SUBSTITUTED FOR THAT IN TOURN. H0700505SEQTIE QLS 1 (Q) = FWA OF COMPETITOR BIN - FWA OF RSA. H0700506 LDQ* (FWARSA),Q (Q) = FWA OF COMPETITOR RECORD. H0700507 LDA* TRIAL (A) = BIN INDEX OF TRIAL ITEM. H0700508 ALS 1 ALLOW 2 WORDS PER BIN. H0700509 ADD* FWARSA (A) = FWA OF TRIAL ITEM. H0700510 STA* TFWA SAVE FWA OF TRIAL ITEM. H0700511 LDA* (TFWA) (A) = FWA OF TRIAL RECORD. H0700512***WARNING*** H0700513* EFFICIENCY DEMANDS THAT TRIAL WINS TIES. H0700514* CALL CMPKEY WITH (A)ENTRY = FWA OF TRIAL. H0700515* INIT REPLACES PLUG BELOW WITH FWA OF CMPKEY. H0700516TRNCMP RTJ+ PLUG (A) = FWA OF WINNER RECORD. H0700517KEYADR ADC *-* ADDRESS OF KEY TABLE H0700518 EOR* (TFWA) (A)=0 IF TRIAL RECORD WON. H0700519 SAN JCWINS SKIP IF COMPETITOR RECORD WON. H0700520 JMP* TWINS JMP IF TRIAL RECORD WON. H0700521JCWINS JMP* CWINS JMP IF COMPETITOR RECORD WON. H0700522TRIAL NUM 0 () = BIN INDEX OF TRIAL RECORD. H0700523G NUM 0 () = TOTAL NO. OF RSA BINS, PSEUDO OR REAL. H0700524M NUM 0 () = CURRENT MERGE ORDER. H0700525TAGCNT NUM 0 () = NO. OF TSA TAGS = G-1. H0700526FWASEQ NUM 0 () = FWA OF SEQ. NO. ARRAY. H0700527PRETSA NUM 0 () = -1 + FWA OF TAG STORAGE AREA. H0700528OVRTSA NUM 0 () = 1 + LWA OF TSA. H0700529ÐÐBINSIZ NUM 0 () = NO. OF WORDS IN AN RSA BIN. H0700530FWARSA NUM 0 () = FWA OF RECORD STORAGE AREA. H0700531TFWA NUM 0 () = FWA OF TRIAL BIN. H0700532MAXSEQ NUM $7FFF () = 1 + SEQ. NO. OF NEXT LOSING DUMMY. H0700533FWAIFT NUM 0 () = FWA OF EXPANDED INPUT FILE TABLE. H0700534FWAFXY NUM 0 () = FWA OF FIXED TABLES. H0700535 EJT H0700536**** H0700537*E H0700538* ******* H0700539* * PUT * H0700540* ******* H0700541* H0700542* H0700543* EACH CALL TO PUT SUBROUTINE ATTEMPTS TO MOVE ONE RECORD FROM THE H0700544* RECORD BIN TO THE OUTPUT BUFFER. INITIALLY THE RECORD TO BE SELECTED H0700545* WILL BE A DUMMY RECORD. UNTIL A RECORD IS FOUND WITH A WINNING H0700546* SEQUENCE NUMBER (VALUE OF 1 INITIALLY WINS), ALL DUMMY RECORDS ARE H0700547* IGNORED. ONCE A WINNING RECORD IS ACCEPTED, ALL RECORDS UNTIL A H0700548* TRAILING DUMMY RECORD IS FOUND, WILL BE BLOCKED INTO H0700549* THE OUTPUT BUFFER. THE TRAILING DUMMY RECORD INDICATES ALL REAL H0700550* RECORDS HAVE BEEN FLUSHED FROM TOURNAMENT. H0700551* H0700552* THE PUT SUBROUTINE OUTPUTS TO THE USERS OUTPUT FILE. THE NUMBER OF H0700553* RECORDS STORED IS DETERMINED BY WHICH RECORDS WERE SELECTED FOR THE H0700554ÐÐ* SORT. THE SIZE OF THE OUTPUT FILE WILL BE AT LEAST AS LARGE AS THE H0700555* NUMBER OF RECORDS STORED AND WILL BE LARGER IF THE OUTPUT FILE WAS H0700556* ALREADY DEFINED AND CONTAINED MORE RECORDS THAN DSORT NEEDS. H0700557* THE CALLING SEQUENCE IS P RTJ PUT H0700558* P+1 LOSING-DUMMY EXIT. H0700559* P+2 WINNING-DUMMY OR NORMAL EXIT. H0700560* H0700561**** H0700562PUT NUM 0 H0700563 LDQ* FWAFXY (Q) = FWA OF FIXED TABLES. H0700564 LDA =XYOFT,Q (A) = FWA OF FINAL-OUTPUT FILE-TABLE. H0700565 STA- I TELL PUTU WHAT FILE-TABLE TO USE. H0700566 LDQ* TRIAL (Q) = NO. OF WINNER BIN. H0700567 LDA* (FWASEQ),Q (A) = SEQUENCE NO. OF WINNER. H0700568 SUB* G (A)15=1 IF WINNING-DUMMY. H0700569 SAP PUTGEG SKIP IF NOT WINNING-DUMMY. H0700570 JMP* PUTP2 DISCARD WINNING-DUMMY. H0700571PUTGEG SAZ PUTEQG SKIP IF WINNER IS REAL-RECORD. H0700572* A LOSING DUMMY WON, THEREFORE THE OUTPUT STRING ENDS. H0700573* INIT REPLACES PLUG BELOW WITH FWA OF CLSU. H0700574PUTCLS RTJ+ PLUG MAKE SURE THAT THE LAST RECORDS ARE WRITTEN.H0700575 JMP* (PUT) TAKE P+1(END-OF-STRING) EXIT. H0700576PUTEQG LDA* (TFWA) (Q) = FWA OF CURRENT WINNING RECORD. H0700577* INIT REPLACES PLUG BELOW WITH FWA OF PUTU. H0700578PUTPUT RTJ+ PLUG OUTPUT THE RECORD. H0700579ÐÐPUTP2 RAO* PUT SET UP P+2 EXIT. H0700580 JMP* (PUT) TAKE P+2 EXIT. H0700581 EJT H0700582**** H0700583*E H0700584* ********* H0700585* *TURNIT * H0700586* ********* H0700587* H0700588* H0700589* THE TURNIT SUBROUTINE DEFINES TABLE SPACE FOR THE RECORD STORAGE AREA,H0700590* THE SEQUENCE NUMBER ARRAY, AND THE TAG STORAGE AREA. TURNIT PRESETS H0700591* THE LATTER TWO TABLES WITH INITIAL VALUES PRIOR TO MERGING. H0700592* H0700593* FWARSA ************* H0700594* * RECORD * RECORD STORAGE AREA CONTAINS YIWAY ENTRIESH0700595* * STORAGE * 1ST WORD OF ENTRY = FWA OF RECORD H0700596* * AREA * 2ND WORD OF ENTRY = FWA OF FILE TABLE H0700597* FWASEQ ************* H0700598* * 0 * G = NUMBER OF MERGE FILES H0700599* * 1 * H0700600* * . * H0700601* * . * THESE ARE THE PRESET SEQUENCE NUMBERS H0700602* * . * H0700603* * G-2 * H0700604ÐÐ* PRETSA * G-1 * THIS ENTRY IS SET TO $7FFF IF G IS ODD TO H0700605* ************* INDICATE DUMMY RECORD BIN H0700606* * G-2 * H0700607* * G-4 * (NOTE:PRETSA IS OFFSET ONE WORD POSITION) H0700608* * . * H0700609* * . * H0700610* * . * THESE VALUES ARE PRESET FOR THE TAG H0700611* * 2 * STORAGE AREA H0700612* * G-1 * H0700613* * G-3 * H0700614* * . * H0700615* * . * H0700616* * . * H0700617* * 1 * H0700618* OVRTSA ************* END OF TABLE SPACE (TOP OF CORE) H0700619* THE CALLING SEQUENCE IS (A)ENTRY = SIZE IN WORDS OF EACH RSA BIN. H0700620* (Q)ENTRY = NO. OF REAL RSA BINS. H0700621* (I)ENTRY = FWA OF FIXED TABLES. H0700622* (FWARSA)ENTRY = FWA OF THE RSA. H0700623* RTJ TURNIT H0700624* OUTPUTS ARE BINSIZ,TNITEG,G,TAGCNT,CURSEQ,FWASEQ,PRETSA,OVRTSA, H0700625* TRIAL,TFWA, SEQ. NO. ARRAY, TSA ARRAY, H0700626* (A)EXIT = (FWARSA), H0700627* (Q)EXIT=JUNK, (I)EXIT = (I)ENTRY. H0700628* H0700629ÐÐ**** H0700630TURNIT NUM 0 H0700631 STA* BINSIZ SAVE RSA BIN LENGTH FOR TOURN AND TURNIT. H0700632* THE FOLLOWING INQ,LRS,QLS ROUND (Q) UP TO THE NEAREST EVEN INTEGER. H0700633 INQ 1 (Q) = 1 + NO. OF REAL RSA BINS. H0700634 LRS 1 (Q) = HALF OF NEAREST EVEN NO. .GE. (Q)ENTRYH0700635 STA* TNITEG (TNITEG)15=1 IF NO. OF REAL BINS IS EVEN. H0700636 QLS 1 (Q) = NEAREST EVEN NO. .GE. (Q)ENTRY. H0700637 STQ* G (G) = TOTAL NO. OF RSA BINS, PSEUDO OR REAL.H0700638 INQ -1 (Q) = NO. OF TSA TAGS. H0700639 STQ* TAGCNT H0700640* COMPUTE RSA SIZE BY INITIALLY ASSUMING ALL RSA BINS ARE REAL BINS, H0700641* THEN, IF THERE WAS A PSEUDO BIN, WE SUBTRACT (BINSIZ). H0700642 LDA* G H0700643 MUI* BINSIZ (A) = (G)*(BINSIZ). H0700644 LDQ* TNITEG (Q)15=1 IF ALL BINS ARE REAL BINS. H0700645 SQM TNITRX SKIP IF ALL BINS ARE REAL BINS. H0700646 SUB* BINSIZ REPLACE A REAL BIN WITH A PSEUDO BIN. H0700647* WE ENTER THE NEXT LOGIC WITH (A) = NO. OF WORDS IN RSA. H0700648TNITRX ADD* FWARSA ADD NO. OF WORDS IN RSA TO FWA OF RSA. H0700649 STA* FWASEQ () = FWA OF SEQUENCE NUMBER ARRAY. H0700650 ADD* TAGCNT ADD -1 + SIZE OF SEQ. NO. ARRAY. H0700651 STA* PRETSA () = -1 + FWA OF TAG STORAGE AREA. H0700652 ADD* G ADD 1 + SIZE OF TAG STORAGE AREA. H0700653 STA* OVRTSA () = 1 + LWA OF TAG STORAGE AREA. H0700654ÐÐ* TENTATIVELY SET SEQ. NO. ARRAY AS IF NO. OF REAL BINS WERE EVEN. H0700655* LATER, WE WILL CHANGE THE SEQUENCE NO. OF THE LAST RSA BIN H0700656* TO $7FFF IF THE LAST RSA BIN IS A PSEUDO BIN, I.E. IF THE NO. OF H0700657* REAL BINS IS ODD. H0700658 LDQ* TAGCNT (Q) = G-1. H0700659TNITSQ STQ* (FWASEQ),Q SET SEQ(I)=I FOR I=G-1 TO I=0 STEP -1. H0700660 SQZ TNITAG SKIP IF ALL SEQ. NUMBERS ARE SET. H0700661 INQ -1 DECREMENT INDEX. POINT TO NEXT SEQ. NO. H0700662 JMP* TNITSQ SET NEXT SEQ. NO. H0700663TNITEG NUM 0 ()15=1 IF NO. OF REAL BINS IS EVEN. H0700664TNITAG LDA G (A)=G SO THAT (A) MAY START = G-2 AT TNITA1.H0700665TNITA1 INA -2 (A) = (NEXT TAG). H0700666 SAM TNIDMY SKIP IF DONE WITH ALL TAGS. H0700667 SAZ TNITA2 SKIP IF DONE WITH NON-BASE TAGS. H0700668 INQ 1 POINT TO NEXT TAG TO SET. H0700669 STA* (PRETSA),Q SET TAGS = G-2,G-4,...,2,G-1,G-3,...,1. H0700670 JMP* TNITA1 SET NEXT TAG. H0700671TNITA2 LDA G H0700672 INA 1 (A)=G+1 SO THAT (A) MAY START = G-1 AT TNITA1. H0700673 JMP* TNITA1 JMP TO DO BASE (I.E. LOWEST LEVEL) TAGS. H0700674* BECAUSE OF THE ABOVE LOGIC, (Q) = (TAGCNT) = (G) - 1. H0700675* BELOW, SET LAST SEQ. NO. TO $7FFF IF NO. OF REAL BINS IS ODD. H0700676TNIDMY LDA* TNITEG (A)15=1 IF NO. OF REAL BINS IS EVEN. H0700677 SAM TNITXT SKIP IF NO. OF REAL BINS IS EVEN. H0700678 LDA- HX7FFF A SEQ. NO. OF $7FFF CAUSES ETERNAL LOSER. H0700679ÐÐ STA (FWASEQ),Q THE CORRESPONDING PSEUDO BIN CAN]T WIN NOW. H0700680* MAKE IT APPEAR THAT 1ST RSA BIN WAS THE LAST WINNER. H0700681TNITXT CLR A H0700682 STA TRIAL () = INDEX OF 1ST RSA BIN. H0700683 LDA FWARSA (A) = FWA OF RECORD STORAGE AREA. H0700684 STA TFWA () = FWA OF 1ST RSA BIN. H0700685 JMP* (TURNIT) EXIT. H0700686 EJT H0700687**** H0700688*E H0700689* ******** H0700690* * INIT * H0700691* ******** H0700692* H0700693* H0700694* THE INIT SUBROUTINE ESTABLISHES INFORMATION NEEDED INITIALLY SET,I.E.,H0700695* ABSOLUTIZING ADDRESSES, LINKING SMCMON PROCESSOR ADDRESSES TO SMCFMG, H0700696* AND SETTING UP BUFFERS NEEDED FOR THE FINAL MERGE. THE LOGICAL UNIT, H0700697* FILE NUMBER, RECORD LENGTH, BUFFER SIZE AND FWA OF FINAL OUTPUT H0700698* BUFFER ARE STUFFED INTO THE FILE TABLE FOR EACH FILE BUFFER REQUIRED. H0700699* H0700700* ALSO THE ADDRESS OF EACH FILE TABLE IS INSERTED INTO THE 2ND WORD OF H0700701* EACH RECORD STORAGE AREA ENTRY. H0700702* H0700703* BELOW SHOWS THE TABLES SET UP BY INIT: H0700704ÐÐ* H0700705* FOUTBF ******************* H0700706* * OUTPUT * H0700707* * BLOCKED * AREA USED FOR EACH OUTPUT MERGE H0700708* * BUFFER * STRING H0700709* ******************* H0700710* * INPUT BLOCKED * SIZE OF EACH BUFFER 2 WORDS LESS H0700711* * RECORD AREA (1) * THAN OUTPUT BUFFER H0700712* ******************* H0700713* * . * H0700714* * . * H0700715* * . * H0700716* ******************* H0700717* * INPUT BLOCKED * H0700718* * RECORD AREA (N) * N = YFWAY (FINAL MERGE ORDER) H0700719* FWAIFT ******************* H0700720* * INPUT FILE * H0700721* * TABLE (1) * H0700722* ******************* H0700723* * . * H0700724* * . * H0700725* * . * H0700726* ******************* H0700727* * INPUT FILE * H0700728* * TABLE (N) * H0700729ÐÐ* FWARSA ******************* H0700730* * /INPUT FILE * THE ADDRESSES SPECIFIED ARE THE H0700731* * TABLE (1) ADDR * 2ND WORD OF A 2 WORD ENTRY H0700732* ******************* H0700733* * . * H0700734* * . * H0700735* * . * H0700736* ******************* H0700737* * /INPUT FILE * H0700738* * TABLE (N) ADDR * H0700739* ******************* H0700740* THE CALLING SEQUENCE IS (Q),(I)ENTRY = FWA OF SMCMON FIXED TABLES H0700741* RTJ INIT H0700742* (I)EXIT = (I)ENTRY H0700743* H0700744**** H0700745INIT NUM 0 () = FWA OF HERE. H0700746 ENA 3 (A) = PHASE NO. OF SMCFMG. H0700747 STA- YPHASE,I TELL FIXED TABLES THAT SMCFMG IS RUNNING. H0700748 STQ FWAFXY () = FWA OF FIXED TABLES. H0700749 RTJ RELOC RELOCATE ALL RELOCATABLES. H0700750 RTJ LINK RESOLVE SMCFMG REFERENCES TO SMCMON. H0700751 LDA- YKEY,I DEFINE FWA OF KEY TABLE H0700752 STA KEYADR H0700753* VERIFY THAT SMCFMG WON]T BE OVERLOADED WITH TOO MANY STRINGS. H0700754ÐÐ LDA- YFWAY,I (A) = MAXIMUM MERGE ORDER. H0700755 SUB- YSQ2MG,I SUBTRACT NO. OF SEQUENCES TO MERGE. H0700756 SAP INIT79 SKIP IF NOT TOO MANY SEQUENCES. H0700757 RTJ (WIERD) ANNOUNCE AND HANDLE WIERD CONDITION. H0700758 NUM -11 ANNOUNCE ERROR NO.11 AND STOP THE RUN. H0700759* ALLOCATE CORE AND INITIALIZE MTOURN. H0700760INIT79 LDA- YOFT+RECLTH,I (A) = NO. OF WORDS PER LOGICAL RECORD. H0700761 STA* INIT07 SAVE LOGICAL RECORD SIZE. H0700762 LDA- YOFRL,I OUTPUT RECORD CHAR COUNT H0700763 INA 1 ROUND UP H0700764 ARS 1 (A) = RECORD LENGTH IN WORDS H0700765 STA- YOFT+RECLTH,I FINAL OUTPUT RECORD SIZE H0700766 LDA =XYOFT,I (A) = FWA OF OUTPUT FILE TABLE. H0700767 STA- I TELL BUFALO WHICH FILE TABLE TO USE. H0700768INIT99 LDA =XFOUTBF-HERE (A) = 1 + LWA OF RESIDENT SMCFMG. H0700769 STA- BUFWA,I () = FWA OF NEXT BUFFER TO ALLOCATE. H0700770 ADD- BUFLTH,I H0700771 STA* FWABUF 1+LWA OF OUTPUT BUFFER H0700772 LDA FWAFXY (A) = FWA OF FIXED TABLES. H0700773 STA- I RESTORE (I)ENTRY. H0700774 LDA- YWKBSZ,I (A) = NO. OF DATA WORDS PER WORK BUFFER. H0700775 INA -2 (A) = NO. OF WORDS PER WORK BUFFER. H0700776 STA* INIT06 KEEP WORK-BUFFER-DATA-SIZE HANDY. H0700777 MUI- YSQ2MG,I NO. OF WORDS FOR INPUT WORK BUFFERS. H0700778 ADD* FWABUF ADD FWA OF INPUT WORK BUFFERS. H0700779ÐÐ STA FWAIFT () = FWA OF THE MERGE INPUT FILE TABLES. H0700780 STA* INIT05 () = 1 + LWA OF WORK INPUT BUFFERS. H0700781 ENA FTSIZE (A) = NO. OF WORDS PER FILE TABLE. H0700782 MUI- YSQ2MG,I (A) = NO. OF WORDS FOR INPUT FILE TABLES. H0700783 ADD FWAIFT (A) = 1 + LWA OF INPUT FILE TABLES. H0700784 STA FWARSA () = FWA OF RSA FOR MTOURN. H0700785 INA 1 (A) = FWA OF 1ST RECIPIENT OF INPUT FT FWA. H0700786 STA* INIT02 SAVE FOR ADDRESSING 2ND WORD OF EACH RSA BINH0700787* SET THE 2ND WORD OF EACH RSA BIN TO FWA OF THE CORRESPONDING H0700788* INPUT FILE TABLE. H0700789* ALSO SET (RECLTH),(BUFLTH),(BUFWA) FOR EACH INPUT WORK FILE TABLE. H0700790 LDA FWARSA (A) = FWA OF RSA FOR MTOURN. H0700791 LDQ- YSQ2MG,I (Q) = ACTUAL MERGE ORDER. H0700792 STQ M SAVE ACTUAL MERGE-ORDER. H0700793 QLS 1 ALLOW 2 WORDS PER RSA BIN. H0700794INIT03 INQ -2 POINT TO NEXT INPUT FT FWA RECIPIENT. H0700795 SQP INIT04 SKIP IF NOT YET DONE. H0700796 LDA FWAFXY (A) = FWA OF FIXED TABLES. H0700797 STA- I TELL TURNIT THE FWA OF FIXED TABLES. H0700798 ENA 2 TELL TURNIT THE NO. OF WORDS PER RSA BIN. H0700799 LDQ M TELL TURNIT THE NO. OF RSA BINS. H0700800 RTJ TURNIT INITIALIZE MTOURN ARRAYS. H0700801 JMP* (INIT) EXIT. H0700802INIT05 NUM 0 () = 1 + LWA OF NEXT LOWER INPUT BUFFER. H0700803INIT06 NUM 0 () = SIZE OF DATA PART OF WORK BUFFER. H0700804ÐÐINIT07 NUM 0 () = LOGICAL RECORD SIZE. H0700805INIT04 INA -FTSIZE (A) = NEXT INPUT FT FWA TO STORE. H0700806 STA* (INIT02),Q STORE FWA OF AN INPUT FILE TABLE. H0700807 STA- I (I) = FWA OF CURRENT INPUT FILE TABLE. H0700808 LDA* INIT05 (A) = 1 + LWA OF CORRESPONDING DATA WORDS. H0700809 SUB* INIT06 (A) = FWA OF CORRESPONDING DATA WORDS. H0700810 STA- BUFWA,I TELL FILE TABLE WHERE ITS DATA WORDS ARE. H0700811 STA* INIT05 () = 1 + LWA OF NEXT LOWER INPUT BUFFER. H0700812 LDA* INIT07 (A) = NO. OF WORDS PER LOGICAL RECORD. H0700813 STA- RECLTH,I SET RECORD LENGTH OF EACH INPUT FILE TABLE. H0700814 LDA* INIT06 (A) = NO. OF DATA WORDS PER WORK BUFFER. H0700815 STA- BUFLTH,I TELL EACH INPUT WORK FILE TABLE. H0700816* LINK REPLACES PLUG BELOW WITH FWA OF GETSEQ. H0700817INIT75 RTJ+ PLUG GET A WORK STRING. H0700818 LDA- I (A) = FWA OF CURRENT INPUT WORK FILE TABLE. H0700819 JMP* INIT03 SEE IF WE ARE ALL DONE. H0700820INIT02 NUM 0 () = 1 + (FWARSA). H0700821FWABUF NUM 0 ()ENTRY = 1 + LWA OF LAST BUFFER ALLOCATED. H0700822 EJT H0700823FOUTBF EQU FOUTBF(*) THE BUFFER FOR THE F-MERGE OUTPUT FILE. H0700824 EJT H0700825**** H0700826*E H0700827* ********* H0700828* * RELOC * H0700829ÐÐ* ********* H0700830* H0700831* H0700832* RELOC RELOCATES THE WORDS MENTIONED IN THE LIST, RELOC4. H0700833* THE RELOC4 LIST REPRESENTS ALL ADDRESSES THAT NEED TO BE ABSOLUTIZED. H0700834* THE CALLING SEQUENCE IS RTJ RELOC H0700835* (I)EXIT = (I)ENTRY H0700836* H0700837**** H0700838RELOC NUM 0 H0700839 ENQ RELOC3 (Q) = NO. OF ENTRIES IN RELOC4. H0700840RELOC7 INQ -1 (Q) = INDEX TO NEXT RELOCATEE. H0700841 SQP RELOC6 SKIP IF NOT DONE. H0700842 JMP* (RELOC) EXIT IF DONE. H0700843RELOC6 LDA* RELOC4,Q (A) = FWA OF RELOCATEE - FWA OF HERE. H0700844 ADD INIT (A) = FWA OF RELOCATEE. H0700845 STA* RELOC5 SAVE FWA OF RELOCATEE. H0700846 LDA* (RELOC5) (A) = RELOCATEE. H0700847 ADD INIT (A) = RELOCATED (RELOCATEE). H0700848 STA* (RELOC5) SET RELOCATEE. H0700849 JMP* RELOC7 JMP TO SEE IF DONE. H0700850RELOC5 NUM 0 () = FWA OF RELOCATEE. H0700851RELOC4 EQU RELOC4(*) H0700852 ADC INIT99+1-HERE H0700853RELOC3 EQU RELOC3(*-RELOC4) H0700854ÐÐ EJT H0700855**** H0700856*E H0700857* ******** H0700858* * LINK * H0700859* ******** H0700860* H0700861* H0700862* ALL PROCESSOR ADDRESSES IN SMCMON THAT SMCFMG NEEDS ARE LINKED HERE. H0700863* THE CALLING SEQUENCE IS (I)ENTRY = FWA OF SMCMON FISED TABLE H0700864* RTJ LINK H0700865* (Q),(I)EXIT = (Q),(I)ENTRY H0700866* H0700867**** H0700868LINK NUM 0 H0700869 LDA- YCRMSG,I H0700870 STA ENDTY1+1 H0700871 LDA- YBOMB,I H0700872 STA ENDBMB+1 H0700873 LDA- YGETU,I H0700874 STA GETGET+1 H0700875 LDA- YCMPKY,I H0700876 STA TRNCMP+1 H0700877 LDA- YCLSU,I H0700878 STA PUTCLS+1 H0700879ÐÐ LDA- YPUTU,I H0700880 STA PUTPUT+1 H0700881 LDA- YGTSEQ,I H0700882 STA INIT75+1 H0700883 LDA- YWIERD,I (A) = FWA OF WIERD IN SMCMON. H0700884 STA* WIERD SAVE FWA OF WIERD. H0700885 LDA- YFMGSZ,I (A) = TABULATED SIZE OF SMCFMG RESIDENT. H0700886 EOR =XFMGSIZ COMPARE TABULATED TO ACTUAL. H0700887 SAZ LINK02 SKIP IF TABULATED = ACTUAL. H0700888 RTJ* (WIERD) ANNOUNCE AND HANDLE WIERD CONDITION. H0700889 NUM -12 ANNOUNCE ERROR NO.12 AND STOP THE RUN. H0700890LINK02 EQU LINK02(*) H0700891 JMP* (LINK) H0700892WIERD NUM 0 () = FWA OF WIERD IN SMCMON. H0700893* SIZE OF SMCFMG RESIDENT LOGIC. H0700894FMGSIZ EQU FMGSIZ(FOUTBF-SMCFMG) H0700895 END SMCFMG H0700896 NAM DPTAM2 I01 A ITOS CCS 3.0 SL-149I0100001* I0100002* CREDIT COLLECTION SYSTEM VERSION 3.0 I0100003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA I0100004* COPYRIGHT CONTROL DATA CORPORATION 1978 I0100005* I0100006* I0100007 ENT IPTAM2 INITIATOR ENTRY I0100008ÐÐ EXT MAS300 MASS RESIDENT DRIVER EXIT ROUTINE I0100009 EXT* KPTAM2 KERNEL SUBROUTINE I0100010 EXT MAKQ GENERATE V-FIELD VALUE I0100011 EXT LOG LOG AN ERROR IN THE ENGINERRING FILE I0100012 EXT ALTDEV REPORT AN ERROR TO THE OPERATOR I0100013 EJT I0100014* I0100015* MSOS LOWCORE EQUATES I0100016* I0100017LPMASK EQU LPMASK($02) I0100018NZERO EQU NZERO($12) I0100019ZERO EQU ZERO($22) I0100020ONEBIT EQU ONEBIT($23) I0100021ONE EQU ONE(ONEBIT) I0100022ZROBIT EQU ZROBIT($33) I0100023AFNR EQU AFNR($B5) FIND NEXT REQUEST I0100024ACOMPR EQU ACOMPR($B6) COMPLETE REQUEST I0100025ADISP EQU ADISP($EA) DISPATCHER I0100026 SPC 3 I0100027* I0100028* FM 2.0 FILE CONTROL BLOCK (FCB) EQUATES I0100029* I0100030NUMNEW EQU NUMNEW(4) NUMBER OF RECORDS ACCESSED SINCE LAST UPDATE I0100031RECLEN EQU RECLEN(5) NUMBER OF WORDS PER RECORD I0100032TDATRM EQU TDATRM(6) TOTAL NUMBER OF DATA RECORDS, MSB I0100033ÐÐTDATRL EQU TDATRL(7) TOTAL NUMBER OF DATA RECORDS, LSB I0100034NEDATM EQU NEDATM(11) NUMBER OF EXISTING DATA RECORDS, MSB I0100035NEDATL EQU NEDATL(12) NUMBER OF EXISTING DATA RECORDS, LSB I0100036 EJT I0100037* I0100038* PTAM2 PHYSICAL DEVICE TABLE EQUATES I0100039* I0100040ELU EQU ELU(5) LOGICAL UNIT NUMBER I0100041EPTR EQU EPTR(6) REQUEST POINTER I0100042NUMWDS EQU NUMWDS(7) NUMBER OF WORDS TO TRANSFER I0100043EREQST EQU EREQST(8) REQUEST STATUS I0100044ESTAT1 EQU ESTAT1(9) STATUS WORD NUMBER 1 I0100045ECCOR EQU ECCOR(10) FIRST WORD ADDRESS OF TRANSFER I0100046ELSTWD EQU ELSTWD(11) LAST WORD + 1 OF TRANSFER I0100047ESTAT2 EQU ESTAT2(12) HARDWARE STATUS I0100048MASLGN EQU MASLGN(13) RESERVED I0100049MASSEC EQU MASSEC(14) RESERVED I0100050RETURN EQU RETURN(15) RESERVED I0100051FLTCOD EQU FLTCOD(16) KERNEL FAULT CODE I0100052RECNOM EQU RECNOM(17) RECORD NUMBER (MSB) I0100053RECNOL EQU RECNOL(18) RECORD NUMBER (LSB) I0100054RECSIZ EQU RECSIZ(19) RECORD SIZE (SET AT CREATE TIME) I0100055REQBUF EQU REQBUF(20) FM 2.0 REQUEST BUFFER I0100056FCBADR EQU FCBADR(29) ADDRESS OF THE FCB (REQBUF+9) I0100057BUFADR EQU BUFADR(44) ADDRESS OF THE IN-CORE BUFFER I0100058ÐÐNXTPDT EQU NXTPDT(45) POINTER TO THE NEXT PDT I0100059 SPC 2 I0100060* I0100061* ESTAT2 EQUATES FOR PTAM2 I0100062* I0100063RITEON EQU RITEON(15) BIT 15 IS WRITE ENABLED I0100064EOF EQU EOF(11) BIT 11 IS END OF FILE I0100065BOT EQU BOT(10) BIT 10 IS BEGINNING OF TAPE (BOT) I0100066EOT EQU EOT(09) BIT 09 IS END OF TAPE I0100067BOTEOT EQU BOTEOT($0600) BITS FOR EITHER BOT OR EOT I0100068ALRMBT EQU ALRMBT(5) BIT 05 IS ALARM STATUS (H/W ERROR) I0100069READY EQU READY(0) BIT 00 IS READY (OPENED) I0100070 SPC 2 I0100071* I0100072* EREQST EQUATES FOR PTAM2 I0100073* I0100074ERRBIT EQU ERRBIT(14) I/O ERROR BIT IN EREQST I0100075 SPC 2 I0100076* I0100077* FLTCOD EQUATES FOR PTAM2 I0100078* I0100079ALARM EQU ALARM($4002) VALUE OF 02 INDICATES AN ALARM (FM ERROR) I0100080PARITY EQU PARITY($4003) VALUE OF 03 IS A PARITY ERROR (READ PAST EOI) I0100081NORING EQU NORING(13) VALUE OF 13 INDICATES A WRITE WITH NO RING IN I0100082EOTRED EQU EOTRED($4015) VALUE OF 21 INDICATES END OF TAPE ON READ I0100083ÐÐNOROOM EQU NOROOM($401A) VALUE OF 26 INDICATES NOT ENOUGH REC. SPACE I0100084NOTOPN EQU NOTOPN(28) VALUE OF 28 INDICATES NOT OPENED (NOT READY) I0100085SHORTW EQU SHORTW(31) VALUE OF 31 INDICATES AN ATTEMPT TO RITE SHORTI0100086RECLRG EQU RECLRG(74) VALUE OF 74 INDICATES RECSIZ TO BIG (W/OPEN) I0100087 EJT I0100088IPTAM2 EQU IPTAM2(*) I0100089*** IF THE DRIVER IS BUSY THEN I0100090 LDA* BUSY I0100091 SAZ NOTBSY I0100092*** GO TO THE DISPATCHER I0100093 JMP- (ADISP) I0100094*** ELSE I0100095NOTBSY EQU NOTBSY(*) I0100096*** SET THE DRIVER BUSY I0100097 STQ* BUSY I0100098*** SAVE THE PDT ADDRESS IN I I0100099NEWPDT EQU NEWPDT(*) I0100100 STQ- I I0100101*** IF THESE ARE REQUESTS ON THIS PDT THEN I0100102CHKREQ RTJ- (AFNR) I0100103 JMP* NORQST I0100104*** MAKE SURE 'BUSY' POINTS TO THIS PDT I0100105 SRI* BUSY I0100106*** GO PROCESS THE REQUEST I0100107 RTJ KPTAM2 I0100108ÐÐ*** CALCULATE THE V-FIELD IN ESTAT1 I0100109 RTJ+ MAKQ I0100110*** IF THERE IS A FAULT THEN I0100111 LDA- FLTCOD,I I0100112 SAZ NOFLT I0100113*** CALCULATE THE ERROR NUMBER FOR LOG I0100114 LDQ- ONEBIT+7 I0100115 ADQ- ELU,I I0100116 QLS 8 I0100117 ADQ- FLTCOD,I I0100118*** SAVE THE ERROR IN THE ENGINEERING I0100119*** FILE I0100120 RTJ+ LOG I0100121*** CLEAR THE BUSY FLAG I0100122 CLR A I0100123 STA* BUSY I0100124*** REPORT THE ERROR TO OPERATOR I0100125 JMP+ ALTDEV I0100126*** ELSE I0100127NOFLT EQU NOFLT(*) I0100128*** COMPLETE THE REQUEST I0100129 RTJ- (ACOMPR) I0100130*** ENDIF I0100131*** GO BACK AND CHECK FOR MORE REQUESTS I0100132 JMP* CHKREQ I0100133ÐÐ*** ELSE I0100134NORQST EQU NORQST(*) I0100135*** GET THE ADDRESS OF THE NEXT PDT I0100136 LDQ- NXTPDT,I I0100137*** IF ALL PDTS HAVE BEEN LOOKED AT THEN I0100138 TRQ A I0100139 EOR* BUSY I0100140 SAN MORPDT I0100141*** CLEAR BUSY FLAG I0100142 STA* BUSY I0100143*** EXIT TO MASS EXECUTIVE I0100144 JMP+ MAS300 I0100145*** ELSE I0100146MORPDT EQU MORPDT(*) I0100147*** GO BACK TO LOOK FOR REQUESTS ON I0100148*** THIS PDT. I0100149 JMP* NEWPDT I0100150*** ENDIF I0100151*** ENDIF I0100152*** ENDIF I0100153BUSY ADC *-* I0100154 END I0100155 NAM KPTAM2 I02 A ITOS CCS 3.0 SL-149I0200001* I0200002* CREDIT COLLECTION SYSTEM VERSION 3.0 I0200003ÐÐ* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA I0200004* COPYRIGHT CONTROL DATA CORPORATION 1978 I0200005* I0200006* I0200007 ENT KPTAM2 PSEUDO-TAPE KERNEL SUBROUTINE I0200008 ENT PTEROR PSEUDO-TAPE ERROR EXIT ENTRY (RETURNS) I0200009* I0200010 EXT* PTMOTN PSEUDO-TAPE MOTION PROCESSOR I0200011 EXT* PTREAD PSEUDO-TAPE READ REQUEST PROCESSOR I0200012 EXT* PTRITE PSEUDO-TAPE WRITE REQUEST PROCESSOR I0200013 EXT* PTVRDY PSEUDO-TAPE READY CHECKER I0200014 EJT I0200015* I0200016* MSOS LOWCORE EQUATES I0200017* I0200018LPMASK EQU LPMASK($02) I0200019NZERO EQU NZERO($12) I0200020ZERO EQU ZERO($22) I0200021ONEBIT EQU ONEBIT($23) I0200022ONE EQU ONE(ONEBIT) I0200023ZROBIT EQU ZROBIT($33) I0200024AFNR EQU AFNR($B5) FIND NEXT REQUEST I0200025ACOMPR EQU ACOMPR($B6) COMPLETE REQUEST I0200026ADISP EQU ADISP($EA) DISPATCHER I0200027 SPC 3 I0200028ÐÐ* I0200029* FM 2.0 FILE CONTROL BLOCK (FCB) EQUATES I0200030* I0200031NUMNEW EQU NUMNEW(4) NUMBER OF RECORDS ACCESSED SINCE LAST UPDATE I0200032RECLEN EQU RECLEN(5) NUMBER OF WORDS PER RECORD I0200033TDATRM EQU TDATRM(6) TOTAL NUMBER OF DATA RECORDS, MSB I0200034TDATRL EQU TDATRL(7) TOTAL NUMBER OF DATA RECORDS, LSB I0200035NEDATM EQU NEDATM(11) NUMBER OF EXISTING DATA RECORDS, MSB I0200036NEDATL EQU NEDATL(12) NUMBER OF EXISTING DATA RECORDS, LSB I0200037 EJT I0200038* I0200039* PTAM2 PHYSICAL DEVICE TABLE EQUATES I0200040* I0200041ELU EQU ELU(5) LOGICAL UNIT NUMBER I0200042EPTR EQU EPTR(6) REQUEST POINTER I0200043NUMWDS EQU NUMWDS(7) NUMBER OF WORDS TO TRANSFER I0200044EREQST EQU EREQST(8) REQUEST STATUS I0200045ESTAT1 EQU ESTAT1(9) STATUS WORD NUMBER 1 I0200046ECCOR EQU ECCOR(10) FIRST WORD ADDRESS OF TRANSFER I0200047ELSTWD EQU ELSTWD(11) LAST WORD + 1 OF TRANSFER I0200048ESTAT2 EQU ESTAT2(12) HARDWARE STATUS I0200049MASLGN EQU MASLGN(13) RESERVED I0200050MASSEC EQU MASSEC(14) RESERVED I0200051RETURN EQU RETURN(15) RESERVED I0200052FLTCOD EQU FLTCOD(16) KERNEL FAULT CODE I0200053ÐÐRECNOM EQU RECNOM(17) RECORD NUMBER (MSB) I0200054RECNOL EQU RECNOL(18) RECORD NUMBER (LSB) I0200055RECSIZ EQU RECSIZ(19) RECORD SIZE (SET AT CREATE TIME) I0200056REQBUF EQU REQBUF(20) FM 2.0 REQUEST BUFFER I0200057FCBADR EQU FCBADR(29) ADDRESS OF THE FCB (REQBUF+9) I0200058BUFADR EQU BUFADR(44) ADDRESS OF THE IN-CORE BUFFER I0200059NXTPDT EQU NXTPDT(45) POINTER TO THE NEXT PDT I0200060 SPC 2 I0200061* I0200062* ESTAT2 EQUATES FOR PTAM2 I0200063* I0200064RITEON EQU RITEON(15) BIT 15 IS WRITE ENABLED I0200065EOF EQU EOF(11) BIT 11 IS END OF FILE I0200066BOT EQU BOT(10) BIT 10 IS BEGINNING OF TAPE (BOT) I0200067EOT EQU EOT(09) BIT 09 IS END OF TAPE I0200068BOTEOT EQU BOTEOT($0600) BITS FOR EITHER BOT OR EOT I0200069ALRMBT EQU ALRMBT(5) BIT 05 IS ALARM STATUS (H/W ERROR) I0200070READY EQU READY(0) BIT 00 IS READY (OPENED) I0200071 SPC 2 I0200072* I0200073* EREQST EQUATES FOR PTAM2 I0200074* I0200075ERRBIT EQU ERRBIT(14) I/O ERROR BIT IN EREQST I0200076 SPC 2 I0200077* I0200078ÐÐ* FLTCOD EQUATES FOR PTAM2 I0200079* I0200080ALARM EQU ALARM($4002) VALUE OF 02 INDICATES AN ALARM (FM ERROR) I0200081PARITY EQU PARITY($4003) VALUE OF 03 IS A PARITY ERROR (READ PAST EOI) I0200082NORING EQU NORING(13) VALUE OF 13 INDICATES A WRITE WITH NO RING IN I0200083EOTRED EQU EOTRED($4015) VALUE OF 21 INDICATES END OF TAPE ON READ I0200084NOROOM EQU NOROOM($401A) VALUE OF 26 INDICATES NOT ENOUGH REC. SPACE I0200085NOTOPN EQU NOTOPN(28) VALUE OF 28 INDICATES NOT OPENED (NOT READY) I0200086SHORTW EQU SHORTW(31) VALUE OF 31 INDICATES AN ATTEMPT TO RITE SHORTI0200087RECLRG EQU RECLRG(74) VALUE OF 74 INDICATES RECSIZ TO BIG (W/OPEN) I0200088 EJT I0200089KPTAM2 ADC *-* I0200090*** CLEAR ALL OF THE DYNAMIC STATUS BITS IN ESTAT2I0200091 LDA- ESTAT2,I I0200092 AND* STAMSK I0200093 STA- ESTAT2,I I0200094*** CLEAR THE FAULT CODE I0200095 CLR A I0200096 STA- FLTCOD,I I0200097*** IF THIS IS A MOTION REQUEST THEN I0200098 LDQ- EPTR,I I0200099 LFA- (ZERO),13,5,Q I0200100 INA -14 I0200101 SAN NOTMOT I0200102*** GO PROCESS THE MOTION REQUEST I0200103ÐÐ RTJ PTMOTN I0200104*** ELSE I0200105 JMP* ENDREQ I0200106NOTMOT EQU NOTMOT(*) I0200107*** VERIFY THAT THE LU IS READY I0200108 RTJ PTVRDY I0200109*** CALCULATE THE NUMBER OF WORDS REQUESTED I0200110 LDA- ELSTWD,I I0200111 SUB- ECCOR,I I0200112 STA- NUMWDS,I I0200113*** IF THIS IS A READ REQUEST THEN I0200114 SFZ- ESTAT1,0,1,I I0200115 JMP* WRITER I0200116*** GO PERFORM THE READ OPERATION I0200117 RTJ PTREAD I0200118*** ELSE I0200119 JMP* ENDREQ I0200120WRITER EQU WRITER(*) I0200121*** GO PERFORM THE WRITE OPERATION I0200122 RTJ PTRITE I0200123*** ENDIF I0200124*** ENDIF I0200125ENDREQ EQU ENDREQ(*) I0200126PTEROR EQU PTEROR(*) I0200127*** RETURN TO THE DRIVER I0200128ÐÐ JMP* (KPTAM2) I0200129* I0200130STAMSK NUM $F7DF NON-DYNAMIC STATUS BITS (ESTAT2) I0200131 END I0200132 NAM PTMOTN I03 A ITOS CCS 3.0 SL-149I0300001* I0300002* CREDIT COLLECTION SYSTEM VERSION 3.0 I0300003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA I0300004* COPYRIGHT CONTROL DATA CORPORATION 1978 I0300005* I0300006 ENT PTMOTN I0300007* I0300008 EXT* CLOSF FM 2.0 CLOSE FILE REQUEST PROCESSOR. I0300009 EXT* DECREC PSEUDO-TAPE ROUTINE TO DECREMENT RECNO I0300010 EXT* GETREC PSEUDO-TAPE ROUTINE TO READ A RECORD I0300011 EXT* INCREC PSEUDO-TAPE ROUTINE TO INCREMENT RECNO I0300012 EXT* PTADDR PSEUDO-TAPE ROUTINE TO ADD 24BIT NUMBERS I0300013 EXT* PTALRM PSEUDO-TAPE ROUTINE FOR AN ALARM CONDITION I0300014 EXT* PTCLRB PSEUDO-TAPE ROUTINE TO CLEAR THE BUFFER I0300015 EXT* PTERCD PSEUDO-TAPE ERROR CODE GENERATION ROUTINE I0300016 EXT* PTSUBR PSEUDO-TAPE SUBTRACTION ROUTINE I0300017 EXT* PTVRDY PSEUDO-TAPE ROUTINE TO CHECK READY I0300018 EXT* RECPUT PSEUDO-TAPE ROUTINE TO WRITE A RECORD I0300019* I0300020 EXT PTBSIZ SIZE OF THE PT BUFFER IN MEMORY I0300021ÐÐ EXT COMPV4 I0300022 EXT PTEOFV PSEUDO-TAPE END OF FILE VALUE I0300023 EJT I0300024* I0300025* MSOS LOWCORE EQUATES I0300026* I0300027LPMASK EQU LPMASK($02) I0300028NZERO EQU NZERO($12) I0300029ZERO EQU ZERO($22) I0300030ONEBIT EQU ONEBIT($23) I0300031ONE EQU ONE(ONEBIT) I0300032ZROBIT EQU ZROBIT($33) I0300033AFNR EQU AFNR($B5) FIND NEXT REQUEST I0300034ACOMPR EQU ACOMPR($B6) COMPLETE REQUEST I0300035ADISP EQU ADISP($EA) DISPATCHER I0300036 SPC 3 I0300037* I0300038* FM 2.0 FILE CONTROL BLOCK (FCB) EQUATES I0300039* I0300040NUMNEW EQU NUMNEW(4) NUMBER OF RECORDS ACCESSED SINCE LAST UPDATE I0300041RECLEN EQU RECLEN(5) NUMBER OF WORDS PER RECORD I0300042TDATRM EQU TDATRM(6) TOTAL NUMBER OF DATA RECORDS, MSB I0300043TDATRL EQU TDATRL(7) TOTAL NUMBER OF DATA RECORDS, LSB I0300044NEDATM EQU NEDATM(11) NUMBER OF EXISTING DATA RECORDS, MSB I0300045NEDATL EQU NEDATL(12) NUMBER OF EXISTING DATA RECORDS, LSB I0300046ÐÐ EJT I0300047* I0300048* PTAM2 PHYSICAL DEVICE TABLE EQUATES I0300049* I0300050ELU EQU ELU(5) LOGICAL UNIT NUMBER I0300051EPTR EQU EPTR(6) REQUEST POINTER I0300052NUMWDS EQU NUMWDS(7) NUMBER OF WORDS TO TRANSFER I0300053EREQST EQU EREQST(8) REQUEST STATUS I0300054ESTAT1 EQU ESTAT1(9) STATUS WORD NUMBER 1 I0300055ECCOR EQU ECCOR(10) FIRST WORD ADDRESS OF TRANSFER I0300056ELSTWD EQU ELSTWD(11) LAST WORD + 1 OF TRANSFER I0300057ESTAT2 EQU ESTAT2(12) HARDWARE STATUS I0300058MASLGN EQU MASLGN(13) RESERVED I0300059MASSEC EQU MASSEC(14) RESERVED I0300060RETURN EQU RETURN(15) RESERVED I0300061FLTCOD EQU FLTCOD(16) KERNEL FAULT CODE I0300062RECNOM EQU RECNOM(17) RECORD NUMBER (MSB) I0300063RECNOL EQU RECNOL(18) RECORD NUMBER (LSB) I0300064RECSIZ EQU RECSIZ(19) RECORD SIZE (SET AT CREATE TIME) I0300065REQBUF EQU REQBUF(20) FM 2.0 REQUEST BUFFER I0300066FCBADR EQU FCBADR(29) ADDRESS OF THE FCB (REQBUF+9) I0300067BUFADR EQU BUFADR(44) ADDRESS OF THE IN-CORE BUFFER I0300068NXTPDT EQU NXTPDT(45) POINTER TO THE NEXT PDT I0300069 SPC 2 I0300070* I0300071ÐÐ* ESTAT2 EQUATES FOR PTAM2 I0300072* I0300073RITEON EQU RITEON(15) BIT 15 IS WRITE ENABLED I0300074EOF EQU EOF(11) BIT 11 IS END OF FILE I0300075BOT EQU BOT(10) BIT 10 IS BEGINNING OF TAPE (BOT) I0300076EOT EQU EOT(09) BIT 09 IS END OF TAPE I0300077BOTEOT EQU BOTEOT($0600) BITS FOR EITHER BOT OR EOT I0300078ALRMBT EQU ALRMBT(5) BIT 05 IS ALARM STATUS (H/W ERROR) I0300079READY EQU READY(0) BIT 00 IS READY (OPENED) I0300080 SPC 2 I0300081* I0300082* EREQST EQUATES FOR PTAM2 I0300083* I0300084ERRBIT EQU ERRBIT(14) I/O ERROR BIT IN EREQST I0300085 SPC 2 I0300086* I0300087* FLTCOD EQUATES FOR PTAM2 I0300088* I0300089ALARM EQU ALARM($4002) VALUE OF 02 INDICATES AN ALARM (FM ERROR) I0300090PARITY EQU PARITY($4003) VALUE OF 03 IS A PARITY ERROR (READ PAST EOI) I0300091NORING EQU NORING(13) VALUE OF 13 INDICATES A WRITE WITH NO RING IN I0300092EOTRED EQU EOTRED($4015) VALUE OF 21 INDICATES END OF TAPE ON READ I0300093NOROOM EQU NOROOM($401A) VALUE OF 26 INDICATES NOT ENOUGH REC. SPACE I0300094NOTOPN EQU NOTOPN(28) VALUE OF 28 INDICATES NOT OPENED (NOT READY) I0300095SHORTW EQU SHORTW(31) VALUE OF 31 INDICATES AN ATTEMPT TO RITE SHORTI0300096ÐÐRECLRG EQU RECLRG(74) VALUE OF 74 INDICATES RECSIZ TO BIG (W/OPEN) I0300097 EJT I0300098PTMOTN ADC *-* I0300099*** GET THE MOTION CODE FROM THE REQUEST I0300100 LDQ- EPTR,I I0300101 LDA- 4,Q I0300102 SAN NEXT 136*A011I0300103 JMP* MOTXIT IF MOTION CODE .EQ. 0 THEN RETURN 136*A011I0300104NEXT STA* MOTCOD ELSE CONTINUE, CHECK TYPE 136*A011I0300105*** IF THIS IS AN OPEN REQUEST THEN I0300106 AND* HF0FF I0300107 SAN NORMAL I0300108*** PROCESS THE 'OPEN' REQUEST I0300109 RTJ* PTOPEN I0300110 JMP* MOTXIT I0300111*** ELSE I0300112NORMAL EQU NORMAL(*) I0300113*** VERIFY THAT THE LU IS READY I0300114 RTJ PTVRDY I0300115*** IF THIS IS A REPEATED REQUEST THEN I0300116 LDA* MOTCOD I0300117 SAP NOTRPT I0300118*** CLEAR THE REPEAT FLAG I0300119 CLR Q I0300120*** STRIP OFF THE LOOP LIMIT I0300121ÐÐ AND- LPMASK+12 I0300122*** ELSE I0300123 JMP* ENDIF1 I0300124NOTRPT EQU NOTRPT(*) I0300125*** SET THE REPEAT FLAG I0300126 SET Q I0300127*** SET THE LOOP LIMIT TO 1 I0300128 ENA 1 I0300129*** ENDIF I0300130ENDIF1 EQU ENDIF1(*) I0300131*** SAVE THE REPEAT FLAG AND LOOP LIMIT I0300132 STA* COUNTR I0300133 STQ* RPTFLG I0300134*** REPEAT I0300135MOTLOP EQU MOTLOP(*) I0300136*** STRIP OFF THE NEXT REQ. CODE BITS I0300137 LFA* MOTCOD,14,3 I0300138 TRA Q I0300139*** SHIFT THE MOTION CODE AROUND BY 4 BITS I0300140 LFA* MOTCOD,11,12 I0300141 ALS 4 I0300142 STA* MOTCOD I0300143*** SET THE LOOP COUNTER TO 0 I0300144 CLR A I0300145 STA* CNT I0300146ÐÐ*** WHILE THE LOOP CNT .LT. LOOP LIMIT DO I0300147WHILE EQU WHILE(*) I0300148 LDA* CNT I0300149 SUB* COUNTR I0300150 SAP MOTDUN I0300151*** LOAD A WITH THE LOOP LIMIT I0300152 LDA* COUNTR I0300153*** EXECUTE THE MOTION CODE I0300154 JMP* JMPTBL,Q I0300155MOTRTN EQU MOTRTN(*) I0300156*** IF EITHER BOT OR EOT IS NOW SET THEN I0300157 LDA- ESTAT2,I I0300158 AND =XBOTEOT I0300159 SAZ NOTBET I0300160*** SET THE LOOP LIMIT TO 1 I0300161 ENA 1 I0300162 STA* COUNTR I0300163*** (ELSE) I0300164NOTBET EQU NOTBET(*) I0300165*** ENDIF I0300166*** INCREMENT THE LOOP COUNT I0300167 RAO* CNT I0300168*** ENDWHILE I0300169 JMP* WHILE I0300170MOTDUN EQU MOTDUN(*) I0300171ÐÐ*** UNTIL THE REPEAT FLAG IS FALSE I0300172*** OR AN ERROR HAS OCCURED I0300173 LDA* RPTFLG I0300174 SFZ- EREQST,ERRBIT,1,I I0300175 CLR A I0300176 SAZ NORPT I0300177 JMP* MOTLOP I0300178*** ENDREPEAT I0300179NORPT EQU NORPT(*) I0300180*** ENDIF I0300181MOTXIT EQU MOTXIT(*) I0300182*** RETURN TO KPTAM2 I0300183 JMP* (PTMOTN) I0300184 EJT I0300185MOTCOD ADC *-* MOTION CODE VALUE I0300186HF0FF NUM $F0FF CONSTANT I0300187COUNTR ADC *-* MOTION REQUEST LOOP LIMIT I0300188RPTFLG ADC *-* MOTION REQUEST REPEAT FLAG I0300189CNT ADC *-* MOTION REQUEST LOOP COUNTER I0300190JMPTBL JMP* MOTXIT O - TERMINATE PROCESSING I0300191 JMP* BSPREC 1 - BACKSPACE RECORD(S) I0300192 JMP* RITEOF 2 - WRITE EOF(S) I0300193 JMP* REWIND 3 - REWIND I0300194 JMP* UNLOAD 4 - UNLOAD (CLOSE AND MAKE NOT READY) I0300195 JMP* ADVFIL 5 - ADVANCE FILE(S) I0300196ÐÐ JMP* BSPFIL 6 - BACKSPACE FILE(S) I0300197 JMP ADVREC 7 - ADVANCE RECORD(S) I0300198 EJT I0300199* I0300200* PTAM2 'OPEN FILE' REQUEST PROCESSOR I0300201* I0300202PTOPEN ADC *-* I0300203*** CLOSE ANY PREVIOUSLY OPENED FILE I0300204 RTJ* PTCLOS I0300205*** MOVE THE REQUEST BUFFER TO THE PDT I0300206 LDQ- EPTR,I I0300207 LDA- 5,Q I0300208 STA* AREQBF I0300209 ENQ 23 I0300210RQBLOP LDA* (AREQBF),Q I0300211 STA- REQBUF,B I0300212 DQP *-RQBLOP I0300213*** IF THIS FILE HAS RECORDS .GT. THE MAXSIZ THEN I0300214 LDQ- FCBADR,I I0300215 LDA- RECLEN,Q I0300216 STA- RECSIZ,I I0300217 SUB =XPTBSIZ I0300218 INA -1 I0300219 SAM SIZOK I0300220*** SET UP ERROR (RECORD SIZE TO LARGE) I0300221ÐÐ RTJ PTERCD I0300222 ADC RECLRG I0300223*** CLOSE THE FILE I0300224 RTJ* PTCLOS I0300225*** ELSE I0300226 JMP* ENDIF I0300227SIZOK EQU SIZOK(*) I0300228*** IF THE OPEN PARAMETER IS ODD THEN I0300229 SFN* MOTCOD,8,1 I0300230 JMP* EVEN I0300231*** POSITION THE FILE AT BOT I0300232 CLR A I0300233 STA- RECNOM,I I0300234 STA- RECNOL,I I0300235 SEF- ESTAT2,BOT,1,I I0300236*** ELSE I0300237 JMP* ENDIF2 I0300238EVEN EQU EVEN(*) I0300239*** POSITION THE FILE AT THE LAST RECORD I0300240 LDQ- FCBADR,I I0300241 LDA- NEDATM,Q I0300242 STA- RECNOM,I I0300243 LR1- NEDATL,Q I0300244 SR1- RECNOL,I I0300245*** IF THERE ARE ANY RECORDS IN THE FILE THEN I0300246ÐÐ SAN GETLR I0300247 S1Z ENDIF2-*-1 I0300248GETLR EQU GETLR(*) I0300249*** READ RECORD(RECNOM,RECNOL)TO POSITION I0300250*** THE FILE FOR POSSIBLE WRITES I0300251 RTJ GETREC I0300252*** ENDIF I0300253ENDIF2 EQU ENDIF2(*) I0300254* ALLOW AN OPEN FILE CALL WITH THE APPEND OPTION ON A FILE THAT I0300255* HAS AN EOF ON THE END OF IT. I0300256 SFN- ESTAT2,11,1,I SENSE END-OF-FILE I0300257 JMP* NOEOF I0300258 CLF- ESTAT2,11,1,I CLEAR EOF BIT I0300259 CLF- ESTAT2,5,1,I CLEAR ALARM BIT(H/W) I0300260 CLF- EREQST,14,1,I CLEAR I/O ERROR BIT I0300261*** LOAD A WITH ESTAT2 WITHOUT BIT15 I0300262NOEOF LFA- ESTAT2,14,15,I I0300263*** IF THE OPEN PARAMETER HAS BIT 9 SET THEN I0300264 SFZ* MOTCOD,9,1 I0300265*** SET THE WRITE ENABLE FLAG IN ESTAT2 I0300266 EOR- ONEBIT+15 I0300267*** (ELSE) I0300268*** ENDIF I0300269*** SET THE READY BIT IN ESTAT2 I0300270 INA 1 I0300271ÐÐ*** SAVE THE NEW ESTAT2 VALUE I0300272 STA- ESTAT2,I I0300273*** ENDIF I0300274ENDIF EQU ENDIF(*) I0300275*** RETURN I0300276 JMP* (PTOPEN) I0300277AREQBF ADC *-* ADDRESS OF THE REQUEST BUFFER I0300278 EJT I0300279BSPREC EQU BSPREC(*) I0300280*** SUBTRACT THE LOOP LIMIT FROM RECNO I0300281 RTJ PTSUBR I0300282*** IF THE RESULT IS .LT. 0 THEN I0300283 SQP NOBSRE I0300284*** GO REWIND THE FILE I0300285 JMP* REWIND I0300286*** ELSE I0300287NOBSRE EQU NOBSRE(*) I0300288*** IF THE RECORD NO. IS ZERO THEN I0300289 SAN NOTLPT I0300290 SQN NOTLPT I0300291*** SET LOAT POINT (BOT) I0300292 JMP* SETBOT I0300293*** (ELSE) I0300294NOTLPT EQU NOTLPT(*) I0300295*** ENDIF I0300296ÐÐ*** ENDIF I0300297*** RETURN I0300298 JMP* MOTDUN I0300299 EJT I0300300RITEOF EQU RITEOF(*) I0300301*** CLEAR THE BUFFER TO ZEROS I0300302 RTJ PTCLRB I0300303*** DATA BUFFER(1) := EOF VALUE I0300304 LDQ- BUFADR,I I0300305 LDA =XPTEOFV I0300306 STA- (ZERO),Q I0300307*** WRITE THE END OF FILE RECORD I0300308 RTJ RECPUT I0300309*** IF THERE WAS NO ERROR THEN I0300310 SAN REOFER I0300311*** RETURN NORMALLY I0300312RTN1 JMP* MOTRTN I0300313*** ELSE I0300314REOFER EQU REOFER(*) I0300315*** RETURN WITH ERROR I0300316 JMP* MOTXIT I0300317*** ENDIF I0300318 EJT I0300319REWIND EQU REWIND(*) I0300320** CLEAR EOT STATUS I0300321ÐÐ CLF- ESTAT2,EOT,1,I I0300322*** SET THE RECORD NUMBER TO 0 I0300323 CLR A I0300324 STA- RECNOM,I I0300325 STA- RECNOL,I I0300326*** SET LOAD POINT STATUS I0300327SETBOT EQU SETBOT(*) I0300328 SEF- ESTAT2,BOT,1,I I0300329*** RETURN (NO LOOPING) I0300330DUN1 JMP* MOTDUN I0300331 SPC 3 I0300332UNLOAD EQU UNLOAD(*) I0300333*** CLOSE THE FILE I0300334 RTJ* PTCLOS I0300335*** RETURN (TERMINATED) I0300336 JMP* MOTXIT I0300337 EJT I0300338PTCLOS ADC *-* I0300339*** IF THE FILE IS NOT READY THEN I0300340 SFN- ESTAT2,READY,1,I I0300341*** RETURN (ALREADY CLOSED) I0300342 JMP* (PTCLOS) I0300343*** (ELSE) I0300344*** ENDIF I0300345*** CLEAR READY STATUS IN ESTAT2 I0300346ÐÐ CLF- ESTAT2,READY,1,I I0300347*** CLOSE THE FILE I0300348 XFI A I0300349 INA REQBUF I0300350 STA* AREQ1 I0300351 RTJ CLOSF I0300352AREQ1 ADC *-* I0300353 ADC ISTAT I0300354*** IF THERE WAS AN ERROR I0300355 LDA* ISTAT I0300356 SAP CLOSOK I0300357*** GENERATE AN ALARM ERROR I0300358 RTJ PTALRM I0300359*** GO TO ERROR EXIT I0300360XIT1 JMP* MOTXIT I0300361*** ELSE I0300362CLOSOK EQU CLOSOK(*) I0300363*** RETURN I0300364 JMP* (PTCLOS) I0300365*** ENDIF I0300366ISTAT ADC *-* I0300367 EJT I0300368ADVFIL EQU ADVFIL(*) I0300369*** INCREMENT THE RECORD NUMBER I0300370 RTJ INCREC I0300371ÐÐ*** IF THERE WAS NO ERROR THEN I0300372 SAN ADVFER I0300373*** READ THE NEXT RECORD TO THE IN-MEM. BUFFER I0300374 RTJ GETREC I0300375*** IF THERE WAS NO ERROR THEN I0300376 SAN ADVFER I0300377*** IF THIS IS AN EOF THEN I0300378 SFZ- ESTAT2,EOF,1,I I0300379*** RETURN I0300380 JMP* RTN1 I0300381*** ELSE I0300382*** KEEP LOOKING FOR EOF RECORD I0300383 JMP* ADVFIL I0300384*** ENDIF I0300385*** ELSE I0300386*** RETURN WITH ERROR I0300387*** ENDIF I0300388*** ELSE I0300389*** RETURN WITH ERROR I0300390ADVFER EQU ADVFER(*) I0300391*** ENDIF I0300392 JMP* DUN1 I0300393 EJT I0300394BSPFIL EQU BSPFIL(*) I0300395*** IF THE TAPE IS CURRENTLY AT LOAD POINT THEN I0300396ÐÐ SFZ- ESTAT2,BOT,1,I I0300397*** RETURN (NO ERROR OR EOF STATUS SET) I0300398 JMP* RTN1 I0300399*** (ELSE) I0300400*** ENDIF I0300401*** REPEAT I0300402BSPFRP EQU BSPFRP(*) I0300403*** READ THE CURRENT RECORD I0300404 RTJ GETREC I0300405*** SAVE THE READ ERROR FLAG I0300406 XFA 4 I0300407*** DECREMENT THE RECORD NUMBER I0300408 RTJ DECREC I0300409*** IF THERE WAS AN ERROR I0300410 SAN BSPFER I0300411 S4Z NOBFER-*-1 I0300412BSPFER EQU BSPFER(*) I0300413*** RETURN WITH ERROR I0300414DUN2 JMP* DUN1 I0300415*** (ELSE) I0300416NOBFER EQU NOBFER(*) I0300417*** ENDIF I0300418*** UNTIL AN EOF IS ENCOUNTERED I0300419 SFN- ESTAT2,EOF,1,I I0300420 JMP* BSPFRP I0300421ÐÐ*** ENDREPEAT I0300422*** RETURN (EOF FOUND) I0300423RTN2 JMP* RTN1 I0300424 EJT I0300425ADVREC EQU ADVREC(*) I0300426*** ADD THE LOOP LIMIT TO THE RECORD NUMBER I0300427 RTJ PTADDR I0300428*** IF THE NEW RECORD NUMBER IS .GT. THE NUMBER I0300429*** OF EXISTING RECORDS THEN I0300430 LDQ- FCBADR,I I0300431 LDA- RECNOM,I I0300432 SUB- NEDATM,Q I0300433 SAM RNLTNR I0300434 SAN RNGENR I0300435 LDA- NEDATL,Q I0300436 LDQ- RECNOL,I I0300437 RTJ+ COMPV4 I0300438 SAZ RNLTNR I0300439 INA 0 I0300440 SAN RNLTNR I0300441RNGENR EQU RNGENR(*) I0300442*** MOVE THE EXISTING NO. OF RECORDS TO RECNO I0300443 LDA- NEDATM,Q I0300444 STA- RECNOM,I I0300445 LDA- NEDATL,Q I0300446ÐÐ STA- RECNOL,I I0300447*** REPORT A PARITY ERROR I0300448 RTJ PTERCD I0300449 ADC PARITY I0300450*** (ELSE) I0300451RNLTNR EQU RNLTNR(*) I0300452*** ENDIF I0300453*** READ THE RECORD I0300454 RTJ GETREC I0300455*** IF THERE WAS NO ERROR I0300456 SAN ADVRER I0300457*** RETURN I0300458 JMP* DUN2 I0300459*** ELSE I0300460ADVRER EQU ADVRER(*) I0300461*** RETURN WITH ERROR I0300462 JMP* XIT1 I0300463*** ENDIF I0300464 END I0300465 NAM PTREAD I04 A ITOS CCS 3.0 SL-149I0400001* I0400002* CREDIT COLLECTION SYSTEM VERSION 3.0 I0400003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA CALIFORNIA I0400004* COPYRIGHT CONTROL DATA CORPORATION 1978 I0400005* I0400006ÐÐ* I0400007 ENT PTREAD PSUEDO-TAPE READ REQUEST PROCESSOR I0400008* I0400009 EXT* INCREC PSEUDO-TAPE ROUTINE TO INCREMENT RECNO I0400010 EXT* GETREC PSEUDO-TAPE ROUTINE TO GET A RECORD I0400011 EXT* PTMOVE PSEUDO-TAPE ROUTINE USED TO MOVE BUFFERS I0400012 EJT I0400013* I0400014* MSOS LOWCORE EQUATES I0400015* I0400016LPMASK EQU LPMASK($02) I0400017NZERO EQU NZERO($12) I0400018ZERO EQU ZERO($22) I0400019ONEBIT EQU ONEBIT($23) I0400020ONE EQU ONE(ONEBIT) I0400021ZROBIT EQU ZROBIT($33) I0400022AFNR EQU AFNR($B5) FIND NEXT REQUEST I0400023ACOMPR EQU ACOMPR($B6) COMPLETE REQUEST I0400024ADISP EQU ADISP($EA) DISPATCHER I0400025 SPC 3 I0400026* I0400027* FM 2.0 FILE CONTROL BLOCK (FCB) EQUATES I0400028* I0400029NUMNEW EQU NUMNEW(4) NUMBER OF RECORDS ACCESSED SINCE LAST UPDATE I0400030RECLEN EQU RECLEN(5) NUMBER OF WORDS PER RECORD I0400031ÐÐTDATRM EQU TDATRM(6) TOTAL NUMBER OF DATA RECORDS, MSB I0400032TDATRL EQU TDATRL(7) TOTAL NUMBER OF DATA RECORDS, LSB I0400033NEDATM EQU NEDATM(11) NUMBER OF EXISTING DATA RECORDS, MSB I0400034NEDATL EQU NEDATL(12) NUMBER OF EXISTING DATA RECORDS, LSB I0400035 EJT I0400036* I0400037* PTAM2 PHYSICAL DEVICE TABLE EQUATES I0400038* I0400039ELU EQU ELU(5) LOGICAL UNIT NUMBER I0400040EPTR EQU EPTR(6) REQUEST POINTER I0400041NUMWDS EQU NUMWDS(7) NUMBER OF WORDS TO TRANSFER I0400042EREQST EQU EREQST(8) REQUEST STATUS I0400043ESTAT1 EQU ESTAT1(9) STATUS WORD NUMBER 1 I0400044ECCOR EQU ECCOR(10) FIRST WORD ADDRESS OF TRANSFER I0400045ELSTWD EQU ELSTWD(11) LAST WORD + 1 OF TRANSFER I0400046ESTAT2 EQU ESTAT2(12) HARDWARE STATUS I0400047MASLGN EQU MASLGN(13) RESERVED I0400048MASSEC EQU MASSEC(14) RESERVED I0400049RETURN EQU RETURN(15) RESERVED I0400050FLTCOD EQU FLTCOD(16) KERNEL FAULT CODE I0400051RECNOM EQU RECNOM(17) RECORD NUMBER (MSB) I0400052RECNOL EQU RECNOL(18) RECORD NUMBER (LSB) I0400053RECSIZ EQU RECSIZ(19) RECORD SIZE (SET AT CREATE TIME) I0400054REQBUF EQU REQBUF(20) FM 2.0 REQUEST BUFFER I0400055FCBADR EQU FCBADR(29) ADDRESS OF THE FCB (REQBUF+9) I0400056ÐÐBUFADR EQU BUFADR(44) ADDRESS OF THE IN-CORE BUFFER I0400057NXTPDT EQU NXTPDT(45) POINTER TO THE NEXT PDT I0400058 SPC 2 I0400059* I0400060* ESTAT2 EQUATES FOR PTAM2 I0400061* I0400062RITEON EQU RITEON(15) BIT 15 IS WRITE ENABLED I0400063EOF EQU EOF(11) BIT 11 IS END OF FILE I0400064BOT EQU BOT(10) BIT 10 IS BEGINNING OF TAPE (BOT) I0400065EOT EQU EOT(09) BIT 09 IS END OF TAPE I0400066BOTEOT EQU BOTEOT($0600) BITS FOR EITHER BOT OR EOT I0400067ALRMBT EQU ALRMBT(5) BIT 05 IS ALARM STATUS (H/W ERROR) I0400068READY EQU READY(0) BIT 00 IS READY (OPENED) I0400069 SPC 2 I0400070* I0400071* EREQST EQUATES FOR PTAM2 I0400072* I0400073ERRBIT EQU ERRBIT(14) I/O ERROR BIT IN EREQST I0400074 SPC 2 I0400075* I0400076* FLTCOD EQUATES FOR PTAM2 I0400077* I0400078ALARM EQU ALARM($4002) VALUE OF 02 INDICATES AN ALARM (FM ERROR) I0400079PARITY EQU PARITY($4003) VALUE OF 03 IS A PARITY ERROR (READ PAST EOI) I0400080NORING EQU NORING(13) VALUE OF 13 INDICATES A WRITE WITH NO RING IN I0400081ÐÐEOTRED EQU EOTRED($4015) VALUE OF 21 INDICATES END OF TAPE ON READ I0400082NOROOM EQU NOROOM($401A) VALUE OF 26 INDICATES NOT ENOUGH REC. SPACE I0400083NOTOPN EQU NOTOPN(28) VALUE OF 28 INDICATES NOT OPENED (NOT READY) I0400084SHORTW EQU SHORTW(31) VALUE OF 31 INDICATES AN ATTEMPT TO RITE SHORTI0400085RECLRG EQU RECLRG(74) VALUE OF 74 INDICATES RECSIZ TO BIG (W/OPEN) I0400086 EJT I0400087PTREAD ADC *-* I0400088*** INCREMENT THE RECORD NUMBER I0400089 RTJ INCREC I0400090*** IF THERE IS NO ERROR THEN I0400091 SAZ NOERR I0400092 JMP* ERROR I0400093*** IF THE NUMBER OF WORDS TO XFER IS .GE. I0400094*** THE SIZE OF THE RECORDS IN THE FILE THEN I0400095NOERR LDA- NUMWDS,I I0400096 SUB- RECSIZ,I I0400097 SAM NLTWPR I0400098*** MAKE THE NUMBER OF WORDS TO XFER I0400099*** EQUAL TO THE SIZE OF ONE BUFFER I0400100 LDA- RECSIZ,I I0400101 STA- NUMWDS,I I0400102*** (ELSE) I0400103NLTWPR EQU NLTWPR(*) I0400104*** ENDIF I0400105*** READ ONE RECORD TO THE IN-MEM BUFFER I0400106ÐÐ RTJ GETREC I0400107*** MOVE NUMWDS WORDS TO THE USER I0400108 LDA- BUFADR,I I0400109 LDQ- ECCOR,I I0400110 RTJ PTMOVE I0400111*** INC. ECCOR BY THE NUMBER OF WORDS XFERED I0400112 LDA- NUMWDS,I I0400113 SFZ- ESTAT2,EOF,1,I I0400114 ENA 1 I0400115 ADD- ECCOR,I I0400116 STA- ECCOR,I I0400117*** (ELSE) I0400118ERROR EQU ERROR(*) I0400119*** ENDIF I0400120*** RETURN I0400121 JMP* (PTREAD) I0400122 END I0400123 NAM PTRITE I05 A ITOS CCS 3.0 SL-149I0500001* I0500002* CREDIT COLLECTION SYSTEM VERSION 3.0 I0500003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA I0500004* COPYRIGHT CONTROL DATA CORPORATION 1978 I0500005* I0500006* I0500007 ENT PTRITE I0500008ÐÐ* I0500009 EXT* RECPUT PSEUDO-TAPE ROUTINE TO PUT A RECORD I0500010 EXT* PTERCD PSEUDO-TAPE ROUTINE SET UP AN ERROR CODE I0500011 EXT* PTCLRB PSEUDO-TAPE ROUTINE TO CLEAR THE IN-MEM BUFFERI0500012 EXT* PTMOVE PSEUDO-TAPE ROUTINE USED TO MOVE BUFFERS I0500013 EJT I0500014* I0500015* MSOS LOWCORE EQUATES I0500016* I0500017LPMASK EQU LPMASK($02) I0500018NZERO EQU NZERO($12) I0500019ZERO EQU ZERO($22) I0500020ONEBIT EQU ONEBIT($23) I0500021ONE EQU ONE(ONEBIT) I0500022ZROBIT EQU ZROBIT($33) I0500023AFNR EQU AFNR($B5) FIND NEXT REQUEST I0500024ACOMPR EQU ACOMPR($B6) COMPLETE REQUEST I0500025ADISP EQU ADISP($EA) DISPATCHER I0500026 SPC 3 I0500027* I0500028* FM 2.0 FILE CONTROL BLOCK (FCB) EQUATES I0500029* I0500030NUMNEW EQU NUMNEW(4) NUMBER OF RECORDS ACCESSED SINCE LAST UPDATE I0500031RECLEN EQU RECLEN(5) NUMBER OF WORDS PER RECORD I0500032TDATRM EQU TDATRM(6) TOTAL NUMBER OF DATA RECORDS, MSB I0500033ÐÐTDATRL EQU TDATRL(7) TOTAL NUMBER OF DATA RECORDS, LSB I0500034NEDATM EQU NEDATM(11) NUMBER OF EXISTING DATA RECORDS, MSB I0500035NEDATL EQU NEDATL(12) NUMBER OF EXISTING DATA RECORDS, LSB I0500036 EJT I0500037* I0500038* PTAM2 PHYSICAL DEVICE TABLE EQUATES I0500039* I0500040ELU EQU ELU(5) LOGICAL UNIT NUMBER I0500041EPTR EQU EPTR(6) REQUEST POINTER I0500042NUMWDS EQU NUMWDS(7) NUMBER OF WORDS TO TRANSFER I0500043EREQST EQU EREQST(8) REQUEST STATUS I0500044ESTAT1 EQU ESTAT1(9) STATUS WORD NUMBER 1 I0500045ECCOR EQU ECCOR(10) FIRST WORD ADDRESS OF TRANSFER I0500046ELSTWD EQU ELSTWD(11) LAST WORD + 1 OF TRANSFER I0500047ESTAT2 EQU ESTAT2(12) HARDWARE STATUS I0500048MASLGN EQU MASLGN(13) RESERVED I0500049MASSEC EQU MASSEC(14) RESERVED I0500050RETURN EQU RETURN(15) RESERVED I0500051FLTCOD EQU FLTCOD(16) KERNEL FAULT CODE I0500052RECNOM EQU RECNOM(17) RECORD NUMBER (MSB) I0500053RECNOL EQU RECNOL(18) RECORD NUMBER (LSB) I0500054RECSIZ EQU RECSIZ(19) RECORD SIZE (SET AT CREATE TIME) I0500055REQBUF EQU REQBUF(20) FM 2.0 REQUEST BUFFER I0500056FCBADR EQU FCBADR(29) ADDRESS OF THE FCB (REQBUF+9) I0500057BUFADR EQU BUFADR(44) ADDRESS OF THE IN-CORE BUFFER I0500058ÐÐNXTPDT EQU NXTPDT(45) POINTER TO THE NEXT PDT I0500059 SPC 2 I0500060* I0500061* ESTAT2 EQUATES FOR PTAM2 I0500062* I0500063RITEON EQU RITEON(15) BIT 15 IS WRITE ENABLED I0500064EOF EQU EOF(11) BIT 11 IS END OF FILE I0500065BOT EQU BOT(10) BIT 10 IS BEGINNING OF TAPE (BOT) I0500066EOT EQU EOT(09) BIT 09 IS END OF TAPE I0500067BOTEOT EQU BOTEOT($0600) BITS FOR EITHER BOT OR EOT I0500068ALRMBT EQU ALRMBT(5) BIT 05 IS ALARM STATUS (H/W ERROR) I0500069READY EQU READY(0) BIT 00 IS READY (OPENED) I0500070 SPC 2 I0500071* I0500072* EREQST EQUATES FOR PTAM2 I0500073* I0500074ERRBIT EQU ERRBIT(14) I/O ERROR BIT IN EREQST I0500075 SPC 2 I0500076* I0500077* FLTCOD EQUATES FOR PTAM2 I0500078* I0500079ALARM EQU ALARM($4002) VALUE OF 02 INDICATES AN ALARM (FM ERROR) I0500080PARITY EQU PARITY($4003) VALUE OF 03 IS A PARITY ERROR (READ PAST EOI) I0500081NORING EQU NORING(13) VALUE OF 13 INDICATES A WRITE WITH NO RING IN I0500082EOTRED EQU EOTRED($4015) VALUE OF 21 INDICATES END OF TAPE ON READ I0500083ÐÐNOROOM EQU NOROOM($401A) VALUE OF 26 INDICATES NOT ENOUGH REC. SPACE I0500084NOTOPN EQU NOTOPN(28) VALUE OF 28 INDICATES NOT OPENED (NOT READY) I0500085SHORTW EQU SHORTW(31) VALUE OF 31 INDICATES AN ATTEMPT TO RITE SHORTI0500086RECLRG EQU RECLRG(74) VALUE OF 74 INDICATES RECSIZ TO BIG (W/OPEN) I0500087 EJT I0500088PTRITE ADC *-* I0500089*** IF THE NUMBER OF WORDS REQUESTED IS .GT. 1 I0500090*** WORD THEN I0500091 SFN- NUMWDS,15,15,I I0500092 JMP* NOISE I0500093*** IF THE NUMBER OF WORDS TO XFER IS .LE. I0500094*** THE SIZE OF THE RECORDS ON A FILE THEN I0500095 LDA- RECSIZ,I I0500096 SUB- NUMWDS,I I0500097 SAP SIZOK I0500098 JMP* TOBIG I0500099SIZOK EQU SIZOK(*) I0500100*** CLEAR THE BUFFER I0500101 RTJ PTCLRB I0500102*** MOVE THE DATA TO THE PT BUFFER I0500103 LDA- ECCOR,I I0500104 LDQ- BUFADR,I I0500105 RTJ PTMOVE I0500106*** SET ECCOR FOR A FULL WRITE I0500107 LDA- ELSTWD,I I0500108ÐÐ STA- ECCOR,I I0500109*** WRITE THE RECORD I0500110 RTJ RECPUT I0500111*** ELSE I0500112 JMP* ENDIF3 I0500113TOBIG EQU TOBIG(*) I0500114*** SET ERROR (RECORD TO BIG TO WRITE) I0500115 RTJ PTERCD I0500116 ADC RECLRG I0500117*** ENDIF I0500118ENDIF3 EQU ENDIF3(*) I0500119*** ELSE I0500120 JMP* ENDIF2 I0500121NOISE EQU NOISE(*) I0500122*** SET UP ERROR (RECORD TO SHORT TO WRITE) I0500123 RTJ PTERCD I0500124 ADC SHORTW I0500125*** ENDIF I0500126ENDIF2 EQU ENDIF2(*) I0500127*** RETURN I0500128 JMP* (PTRITE) I0500129 END I0500130 NAM PTSUBS I06 A ITOS CCS 3.0 SL-149I0600001* I0600002* CREDIT COLLECTION SYSTEM VERSION 3.0 I0600003ÐÐ* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA I0600004* COPYRIGHT CONTROL DATA CORPORATION 1978 I0600005* I0600006* I0600007 ENT DECREC DECREMENT THE RECORD NUMBER I0600008 ENT GETREC GET A RECORD I0600009 ENT INCREC INCREMENT THE RECORD NUMBER I0600010 ENT PTADDR DO DOUBLE WORD ADDITION (24BITS+16BITS) I0600011 ENT PTALRM PSEUDO-TAPE ALARM ERROR GENERATOR I0600012 ENT PTCLRB CLEAR THE IN-MEM BUFFER I0600013 ENT PTERCD GENERATE AN ERROR CODE (ESTAT1 AND FLT COD) I0600014 ENT PTMOVE PSEUDO-TAPE ROUTINE USED TO MOVE BUFFERS I0600015 ENT PTSUBR DO DOUBLE WORD SUBTRACTION (24BITS-16BITS) I0600016 ENT PTVRDY VERIFY THAT THE 'TAPE' IS READY (FILE OPENED) I0600017 ENT RECPUT PUT A RECORD I0600018* I0600019 EXT DWADD DOUBLE WORD ADDITION ROUTINE I0600020 EXT* PTEROR PSEUDO-TAPE KERNAL ERROR ENTRY I0600021 EXT* PUTZ FM WRITE A RECORD ROUTINE. I0600022 EXT* READRX FM READ A RECORD ROUTINE. I0600023* I0600024 EXT PTBSIZ PSEUDO-TAPE BUFFER SIZE I0600025 EXT PTEOFV PSEUDO-TAPE END OF FILE VALUE I0600026 EJT I0600027* I0600028ÐÐ* MSOS LOWCORE EQUATES I0600029* I0600030LPMASK EQU LPMASK($02) I0600031NZERO EQU NZERO($12) I0600032ZERO EQU ZERO($22) I0600033ONEBIT EQU ONEBIT($23) I0600034ONE EQU ONE(ONEBIT) I0600035ZROBIT EQU ZROBIT($33) I0600036AFNR EQU AFNR($B5) FIND NEXT REQUEST I0600037ACOMPR EQU ACOMPR($B6) COMPLETE REQUEST I0600038ADISP EQU ADISP($EA) DISPATCHER I0600039 EQU EXTABL($E9) ADDRESS OF EXTENDED COMM. REGION I0600040 EQU FMDEFT(31) INDEX TO FILE MANAGER DEFINITION TABLE I0600041 EQU FMNRCD(17) NUMBER OF NEW RECORDS BEFORE UPDATE OF FCB I0600042 SPC 3 I0600043* I0600044* FM 2.0 FILE CONTROL BLOCK (FCB) EQUATES I0600045* I0600046NUMNEW EQU NUMNEW(4) NUMBER OF RECORDS ACCESSED SINCE LAST UPDATE I0600047RECLEN EQU RECLEN(5) NUMBER OF WORDS PER RECORD I0600048TDATRM EQU TDATRM(6) TOTAL NUMBER OF DATA RECORDS, MSB I0600049TDATRL EQU TDATRL(7) TOTAL NUMBER OF DATA RECORDS, LSB I0600050NEDATM EQU NEDATM(11) NUMBER OF EXISTING DATA RECORDS, MSB I0600051NEDATL EQU NEDATL(12) NUMBER OF EXISTING DATA RECORDS, LSB I0600052 EJT I0600053ÐÐ* I0600054* PTAM2 PHYSICAL DEVICE TABLE EQUATES I0600055* I0600056ELU EQU ELU(5) LOGICAL UNIT NUMBER I0600057EPTR EQU EPTR(6) REQUEST POINTER I0600058NUMWDS EQU NUMWDS(7) NUMBER OF WORDS TO TRANSFER I0600059EREQST EQU EREQST(8) REQUEST STATUS I0600060ESTAT1 EQU ESTAT1(9) STATUS WORD NUMBER 1 I0600061ECCOR EQU ECCOR(10) FIRST WORD ADDRESS OF TRANSFER I0600062ELSTWD EQU ELSTWD(11) LAST WORD + 1 OF TRANSFER I0600063ESTAT2 EQU ESTAT2(12) HARDWARE STATUS I0600064MASLGN EQU MASLGN(13) RESERVED I0600065MASSEC EQU MASSEC(14) RESERVED I0600066RETURN EQU RETURN(15) RESERVED I0600067FLTCOD EQU FLTCOD(16) KERNEL FAULT CODE I0600068RECNOM EQU RECNOM(17) RECORD NUMBER (MSB) I0600069RECNOL EQU RECNOL(18) RECORD NUMBER (LSB) I0600070RECSIZ EQU RECSIZ(19) RECORD SIZE (SET AT CREATE TIME) I0600071REQBUF EQU REQBUF(20) FM 2.0 REQUEST BUFFER I0600072FCBADR EQU FCBADR(29) ADDRESS OF THE FCB (REQBUF+9) I0600073BUFADR EQU BUFADR(44) ADDRESS OF THE IN-CORE BUFFER I0600074NXTPDT EQU NXTPDT(45) POINTER TO THE NEXT PDT I0600075 SPC 2 I0600076* I0600077* ESTAT2 EQUATES FOR PTAM2 I0600078ÐÐ* I0600079RITEON EQU RITEON(15) BIT 15 IS WRITE ENABLED I0600080EOF EQU EOF(11) BIT 11 IS END OF FILE I0600081BOT EQU BOT(10) BIT 10 IS BEGINNING OF TAPE (BOT) I0600082EOT EQU EOT(09) BIT 09 IS END OF TAPE I0600083BOTEOT EQU BOTEOT($0600) BITS FOR EITHER BOT OR EOT I0600084ALRMBT EQU ALRMBT(5) BIT 05 IS ALARM STATUS (H/W ERROR) I0600085READY EQU READY(0) BIT 00 IS READY (OPENED) I0600086 SPC 2 I0600087* I0600088* EREQST EQUATES FOR PTAM2 I0600089* I0600090ERRBIT EQU ERRBIT(14) I/O ERROR BIT IN EREQST I0600091 SPC 2 I0600092* I0600093* FLTCOD EQUATES FOR PTAM2 I0600094* I0600095ALARM EQU ALARM($4002) VALUE OF 02 INDICATES AN ALARM (FM ERROR) I0600096PARITY EQU PARITY($4003) VALUE OF 03 IS A PARITY ERROR (READ PAST EOI) I0600097NORING EQU NORING(13) VALUE OF 13 INDICATES A WRITE WITH NO RING IN I0600098EOTRED EQU EOTRED($4015) VALUE OF 21 INDICATES END OF TAPE ON READ I0600099NOROOM EQU NOROOM($401A) VALUE OF 26 INDICATES NOT ENOUGH REC. SPACE I0600100NOTOPN EQU NOTOPN(28) VALUE OF 28 INDICATES NOT OPENED (NOT READY) I0600101SHORTW EQU SHORTW(31) VALUE OF 31 INDICATES AN ATTEMPT TO RITE SHORTI0600102RECLRG EQU RECLRG(74) VALUE OF 74 INDICATES RECSIZ TO BIG (W/OPEN) I0600103ÐÐ EJT I0600104* I0600105* ROUTINE USED TO READ A RECORD FROM THE FILE. I0600106* THIS ROUTINE ALSO CHECKS FOR AN EOF RECORD I0600107* I0600108* AT EXIT A = ERROR FLAG (0 = NO ERROR) I0600109* I0600110GETREC ADC *-* I0600111*** READ THE RECORD I0600112 XFI A I0600113 INA RECNOM I0600114 STA* ARCSPG I0600115 INA REQBUF-RECNOM I0600116 STA* AREQBG I0600117 LDA- BUFADR,I I0600118 STA* ARECBG I0600119 RTJ READRX I0600120AREQBG ADC *-* I0600121ARECBG ADC *-* I0600122ARCSPG ADC *-* I0600123 ADC ISTATG I0600124*** IF THERE WAS AN ERROR THEN I0600125 LDA* ISTATG I0600126 SAP NOERRG I0600127*** IF BIT 8 (ISTATG) IS SET THEN I0600128ÐÐ AND- ONEBIT+8 I0600129 SAZ NOEOTG I0600130* ALLOW DRIVER TO RETURN EOF STATUS TO CALLER AFTER ALL RECORDS I0600131* HAVE BEEN READ FROM FILE. NO ERROR WILL BE LOGGED ON THE I0600132* CONSOLE. OTHERWISE, EOT STATUS WOULD BE SET AND ERROR LOGGED I0600133* ON THE CONSOLE. I0600134 JMP* SETEOF I0600135NOEOTG EQU NOEOTG(*) I0600136*** GENERATE AN ALARM ERROR (A NOT 0 AT RTN)I0600137 RTJ* PTALRM I0600138*** ENDIF I0600139EOTG EQU EOTG(*) I0600140*** ELSE I0600141 JMP* ENDIF1 I0600142NOERRG EQU NOERRG(*) I0600143*** IF THIS IS AN EOF RECORD THEN I0600144 ENQ 1 I0600145 SFZ* (ARECBG),15,16,Q I0600146 JMP* NOTEOF I0600147MAYBE1 LDA =XPTEOFV I0600148 EOR* (ARECBG) I0600149 SAN NOTEOF I0600150*** SET EOF AND ALARM BITS IN ESTAT2 I0600151SETEOF SEF- ESTAT2,EOF,1,I I0600152 SEF- ESTAT2,ALRMBT,1,I I0600153ÐÐ*** SET THE ERROR BIT IN EREQST I0600154 SEF- EREQST,ERRBIT,1,I I0600155*** (ELSE) I0600156NOTEOF EQU NOTEOF(*) I0600157*** ENDIF I0600158*** CLEAR A (NO ERROR) I0600159 CLR A I0600160*** ENDIF I0600161ENDIF1 EQU ENDIF1(*) I0600162*** RETURN (A IS ERROR FLAG, A=0 IS NO ERROR) I0600163 JMP* (GETREC) I0600164ISTATG ADC *-* STATUS FOR GETREC CALL TO READR I0600165 EJT I0600166RECPUT ADC *-* I0600167*** IF WRITE IS ENABLED THEN I0600168 SFN- ESTAT2,RITEON,1,I I0600169 JMP* NORITE I0600170*** CLEAR BOT AND EOT STATUS BITS I0600171 LDA- ESTAT2,I I0600172 AND =X(-BOTEOT) I0600173 STA- ESTAT2,I I0600174*** IF THE CURRENT RECORD NUMBER IS NOT THE I0600175*** SAME AS THE LAST RECORD STORED IN THE FILEI0600176*** THEN I0600177 LDQ- FCBADR,I I0600178ÐÐ LDA- RECNOM,I I0600179 CAE- NEDATM,Q I0600180 JMP* UPDATE I0600181 LDA- RECNOL,I I0600182 CAN- NEDATL,Q I0600183 JMP* REQUAL I0600184UPDATE EQU UPDATE(*) I0600185*** MOVE RECNO TO THE FCB I0600186 LDA- RECNOM,I I0600187 STA- NEDATM,Q I0600188 LDA- RECNOL,I I0600189 STA- NEDATL,Q I0600190*** CHANGE THE FCB TO FORCE MM UPDATE I0600191 XFQ 1 I0600192 LDQ- EXTABL EXTENDED COMM. REGION I0600193 LDQ- FMDEFT,Q ADDRESS OF FILE MANAGER DEFINITION TABLE I0600194 LDA- FMNRCD,Q NO. OF NEW RECORDS BEFORE UPDATE OF FCB I0600195 XF1 Q I0600196 STA- NUMNEW,Q I0600197*** (ELSE) I0600198REQUAL EQU REQUAL(*) I0600199*** ENDIF I0600200*** STORE THE RECORD I0600201 XFI A I0600202 INA REQBUF I0600203ÐÐ STA* AREQBP I0600204 LDA- BUFADR,I I0600205 STA* ARECBP I0600206 RTJ PUTZ I0600207AREQBP ADC *-* I0600208ARECBP ADC *-* I0600209 ADC ONE I0600210 ADC ISTATP I0600211*** IF THERE WAS AN ERROR THEN I0600212 LDA* ISTATP I0600213 SAP NOERRP I0600214*** IF BIT 12 (ISTATP) IS SET THEN I0600215 AND- ONEBIT+12 I0600216 SAZ NOEOTP I0600217*** SET END OF TAPE STATUS I0600218 SEF- ESTAT2,EOT,1,I I0600219*** GENERATE A NO ROOM ERROR I0600220 RTJ* PTERCD I0600221 ADC NOROOM I0600222*** ELSE I0600223 JMP* EOTP I0600224NOEOTP EQU NOEOTP(*) I0600225*** GENERATE AN ALARM ERROR (A NOT ZERO) I0600226 RTJ* PTALRM I0600227*** ENDIF I0600228ÐÐEOTP EQU EOTP(*) I0600229*** ELSE I0600230 JMP* ENDIF5 I0600231NOERRP EQU NOERRP(*) I0600232*** INCREMENT THE RECORD NUMBER I0600233 RTJ* INCREC I0600234*** ENDIF I0600235ENDIF5 EQU ENDIF5(*) I0600236*** ELSE I0600237 JMP* ENDIF6 I0600238NORITE EQU NORITE(*) I0600239*** SET ALARM (NO WRITE RING) I0600240 RTJ* PTALRM I0600241 RTJ* PTERCD I0600242 ADC NORING I0600243*** ENDIF I0600244ENDIF6 EQU ENDIF6(*) I0600245*** RETURN (A IS ERROR FLAG, A=0 IS NO ERROR) I0600246 JMP* (RECPUT) I0600247ISTATP ADC *-* STATUS FOR PUTREC CALL TO PUTS I0600248 EJT I0600249PTCLRB ADC *-* I0600250*** CLEAR THE IN-MEM BUFFER I0600251 LDA- BUFADR,I I0600252 STA* ABUFER I0600253ÐÐ LDQ =XPTBSIZ (SIZE-2) I0600254 CLR A I0600255CLRLOP STA* (ABUFER),Q I0600256 DQP *-CLRLOP I0600257*** RETURN I0600258 JMP* (PTCLRB) I0600259ABUFER ADC *-* I0600260 SPC 3 I0600261PTALRM ADC *-* I0600262*** SET UP THE FAULT CODE I0600263 RTJ* PTERCD I0600264 ADC ALARM I0600265*** RETURN I0600266 JMP* (PTALRM) I0600267 SPC 3 I0600268PTERCD ADC *-* I0600269*** GET THE PASSED FAULT CODE I0600270 LDA* (PTERCD) I0600271 SFA- FLTCOD,7,8,I I0600272*** SET THE ERROR BIT IN EREQST I0600273 SEF- EREQST,ERRBIT,1,I I0600274*** IF THE ALARM FLAG IS SET THEN I0600275 ALS 1 I0600276 SAP NOALRM I0600277*** SET THE ALARM STATUS BIT I0600278ÐÐ SEF- ESTAT2,ALRMBT,1,I I0600279*** (ELSE) I0600280NOALRM EQU NOALRM(*) I0600281*** ENDIF I0600282*** BUMP THE RETURN ADDRESS I0600283 RAO* PTERCD I0600284*** RETURN (A NOT 0) I0600285 JMP* (PTERCD) I0600286 EJT I0600287INCREC ADC *-* I0600288*** CLEAR BOT STATUS I0600289 CLF- ESTAT2,BOT,1,I I0600290*** IF THERE ARE NO MORE RECORDS IN THE FILE THEN I0600291 LDQ- FCBADR,I I0600292 LDA- RECNOM,I I0600293 CAE- TDATRM,Q I0600294 JMP* MORERC I0600295 LDA- RECNOL,I I0600296 CAE- TDATRL,Q I0600297 JMP* MORERC I0600298*** SET EOT STATUS I0600299 SEF- ESTAT2,EOT,1,I I0600300*** IF THIS IS A WRITE OPERATION THEN I0600301 SFN- ESTAT1,0,1,I I0600302 JMP* REDEOT I0600303ÐÐ*** GENERATE FAULT CODE FOR WRITE (A NON-0) I0600304 RTJ* PTERCD I0600305 ADC NOROOM I0600306*** ELSE I0600307 JMP* ENDIF8 I0600308REDEOT EQU REDEOT(*) I0600309*** GENERATE THE FAULT CODE FOR READ (A # 0)I0600310 RTJ* PTERCD I0600311 ADC EOTRED I0600312*** ENDIF I0600313ENDIF8 EQU ENDIF8(*) I0600314*** ELSE I0600315 JMP* ENDIF7 I0600316MORERC EQU MORERC(*) I0600317*** INCREMENT RECNO BY 1 I0600318 ENA 1 I0600319 RTJ* PTADDR I0600320*** CLR A (NO ERROR FLAG) I0600321 CLR A I0600322*** ENDIF I0600323ENDIF7 EQU ENDIF7(*) I0600324*** RETURN I0600325 JMP* (INCREC) I0600326 EJT I0600327DECREC ADC *-* I0600328ÐÐ*** CLEAR EOT STATUS I0600329 CLF- ESTAT2,EOT,1,I I0600330*** IF LOAD POINT IS SET ALREADY THEN I0600331 SFN- ESTAT2,BOT,1,I I0600332 JMP* NOLDPT I0600333*** SET A NON-ZERO FOR ERROR FLAG I0600334 SET A I0600335*** ELSE I0600336 JMP* ENDIFD I0600337NOLDPT EQU NOLDPT(*) I0600338*** SUBTRACT ONE FROM RECNO I0600339 ENA 1 I0600340 RTJ* PTSUBR I0600341*** IF RECNO IS NOW ZERO THEN I0600342 EAQ A I0600343 SAN RECNTO I0600344*** SET LOADPOINT STATUS I0600345 SEF- ESTAT2,BOT,1,I I0600346*** (ELSE) I0600347RECNTO EQU RECNTO(*) I0600348*** ENDIF I0600349*** CLEAR A (NO ERROR) I0600350 CLR A I0600351*** ENDIF I0600352ENDIFD EQU ENDIFD(*) I0600353ÐÐ*** RETURN I0600354 JMP* (DECREC) I0600355 EJT I0600356PTADDR ADC *-* I0600357*** CLEAR BOT STATUS I0600358 CLF- ESTAT2,BOT,1,I I0600359*** SAVE THE VALUE TO ADD TO RECNO IN 30BIT FORM I0600360 CLR Q I0600361ASBEGN LLS 1 I0600362 ALS 15 I0600363 STQ* VALUEM I0600364 STA* VALUEL I0600365*** CONVERT RECNO TO 30BIT FORM I0600366 LDQ- RECNOM,I I0600367 LDA- RECNOL,I I0600368 LLS 1 I0600369 ALS 15 I0600370 STQ* RECVLM I0600371 STA* RECVLL I0600372*** PUT THE BUFFER ADDRESS INTO Q I0600373 SJQ* HERE I0600374HERE INQ RECVLM-HERE+1 I0600375*** DO THE ADDITION I0600376 RTJ+ DWADD I0600377*** SET Q/A TO THE RESULT I0600378ÐÐ LDQ* RESULM I0600379 LDA* RESULL I0600380 ALS 1 I0600381 LRS 1 I0600382*** SAVE THE RESULT IN RECNO I0600383 STQ- RECNOM,I I0600384 STA- RECNOL,I I0600385*** RETURN I0600386 JMP* (PTADDR) I0600387RECVLM ADC *-* RECORD NUMBER VALUE, MSB I0600388RECVLL ADC *-* RECORD NUMBER VALUE, LSB I0600389VALUEM ADC *-* VALUE TO ADD, MSB I0600390VALUEL ADC *-* VALUE TO ADD, LSB I0600391RESULM ADC *-* RESULTANT VALUE, MSB I0600392RESULL ADC *-* RESULTANT VALUE, LSB I0600393ERRFLG ADC *-* ERROR FLAG I0600394 EJT I0600395PTSUBR ADC *-* I0600396*** CLEAR EOT STATUS I0600397 CLF- ESTAT2,EOT,1,I I0600398*** MOVE THE RETURN ADDRESS TO PTADDR I0600399 LDQ* PTSUBR I0600400 STQ* PTADDR I0600401*** COMPLEMENT THE SUBTRAHEND I0600402 TCA A I0600403ÐÐ SET Q I0600404*** DO THE SUBTRACTION AS AN ADDITION I0600405 JMP* ASBEGN I0600406 EJT I0600407PTVRDY ADC *-* I0600408*** IF THE TAPE IS READY THEN I0600409 SFZ- ESTAT2,READY,1,I I0600410*** RETURN I0600411 JMP* (PTVRDY) I0600412*** ELSE I0600413*** GENERATE AN ERROR FOR FILE NOT READY(OPEN) I0600414 RTJ* PTERCD I0600415 ADC NOTOPN I0600416*** RETURN TO THE ERROR EXIT OF THE KERNEL I0600417 JMP PTEROR I0600418*** ENDIF I0600419 EJT I0600420PTMOVE ADC *-* I0600421*** SAVE THE FROM AND TO ADDRESSES I0600422 STA* AOLD I0600423 STQ* ANEW I0600424*** COMPUTE THE NUMBER OF WORDS TO MOVE I0600425 LDQ- NUMWDS,I I0600426 SFZ- ESTAT2,EOF,1,I I0600427 ENQ 1 I0600428ÐÐ INQ -1 I0600429*** MOVE THE DATA I0600430MOVE LDA* (AOLD),Q I0600431 STA* (ANEW),Q I0600432 DQP *-MOVE I0600433*** RETURN I0600434 JMP* (PTMOVE) I0600435AOLD ADC *-* I0600436ANEW ADC *-* I0600437 END I0600438 NAM JOBENT M04 A ITOS CCS 3.0 SL-149M0400001* MASS STORAGE OPERATING SYSTEM VERSION 5.0 M0400002* SMALL SYSTEMS DIVISION, LA JOLLA, CALIFORNIA M0400003* COPYRIGHT CONTROL DATA CORPORATION 1976 M0400004 SPC 2 M0400005* PROGRAM BASE- MSOS 3.0 JOBENT **MSOS 4.0M0400006 SPC 1 M0400007 SPC 1 M0400008* JOB PROCESSOR CONTROL MODULE M0400009 SPC 1 M0400010***************************************************** M0400011 SPC 2 M0400012 ENT JBENT M0400013 ENT JBPRO M0400014 ENT MIPBUF M0400015ÐÐ SPC 1 M0400016 EXT FILE1,FILE2 M0400017 EXT JBCNFG JOB CANCEL FLAG M0400018 EXT MIB M0400019 EXT JOBIND M0400020 EXT SWTCH M0400021 EXT LIBEDT,RCOVER M0400022 EXT JPSWT TEMP. LOC. FOR MIINP BUFFER ADR. OR M0400023* AN INDEX TO THE TRANTA TABLE OR M0400024* A NEG. VALUE SET BY JOBENT OR JBKILL M0400025 EXT JOBPRO,JPLOAD,JPCHGE,JPT13 M0400026 EXT JLGOV4,JCRDV4,JPFLV4,NAMEV4 **MSOS 4.0M0400027 EXT JPSTV4,AFILV4 **MSOS 4.0M0400028 EXT IUP **MSOS 4.0M0400029 EXT INPTV4 **MSOS 4.0M0400030 EXT BATCLU (TRVEC) 116*4366M0400031 EXT NUMLU 116*4366M0400032 EXT AUTFB AUTOLOAD LIST DEVICE M0400033 EXT RESTOR M0400034 EXT TRANV M0400035 EXT JKIN M0400036 EXT* T3 M0400037 EXT* T5 M0400038 EXT* T7 M0400039 EXT* T11 M0400040ÐÐ EXT* XMRESV RESERVE ITOS USER MEMORY M0400041 EXT BATINP FILE BATCH STD. INPUT (SYSDAT) M0400042 SPC 1 M0400043 EQU DISP($EA) M0400044 EQU ZERO($22) M0400045 EQU AMONI($F4),ADISP($EA) 116*4366M0400046 EQU TEN($46) 116*4366M0400047 EQU H00FF($A) 116*4366M0400048 EQU H7FFF($11) **MSOS 4.0M0400049 EQU L(36) INPUT BUFFER LENGTH **MSOS 4.0M0400050 SPC 2 M0400051JBENT NUM $C8FE ENTRY POINT M0400052**** NOTICE - THE INSTRUCTION LDA* M0400053**** *-1 CAN NOT BE ASSEMBLED M0400054**** BECAUSE IT REFERENCES A LOC. M0400055**** OUTSIDE THE PROGRAM M0400056 STA* (F1) STORE LOCATION OF JOBENT FILE M0400057 STA* ENTTBL STORE FWA OF JOBENT IN ENTRY POINT TABLE M0400058 SPC 1 M0400059 STQ* SAVBUF SAVE MIINP BUFFER ADDRESS **MSOS 4.0M0400060 JMP* BUFF1 M0400061ERRM ALF 1,JP **MSOS 4.0M0400062 ALF 1, **MSOS 4.0M0400063 ALF 1,, **MSOS 4.0M0400064 SPC 1 M0400065ÐÐ*********************************************************************** M0400066 SPC 1 M0400067* AFTER THE INITIAL PASS THROUGH JOBENT THIS AREA WILL BE M0400068* OVERLAID BY THE MIPBUF BUFFER. M0400069 SPC 1 M0400070BUFF1 ENQ LENGTH LOAD Q WITH THE LENGTH OF ENTRY POINT TABLE M0400071LOOP LDA* ENTTBL,Q PICK UP RELATIVE ENTRY POINT ADDRESS M0400072 ADD* ENTTBL ADD FWA OF JOBENT M0400073 STA TRANV,Q STORE IN TRVEC M0400074 INQ -1 M0400075 SQZ OUT M0400076 JMP* LOOP M0400077OUT LDQ- $E9 ADDR OF EXTENDED CORE TABLE M0400078 LDQ- 9,Q ADDR OF RCTV IN MONI **MSOS 4.0M0400079 LDA* JB1 IF THERE IS NO **MSOS 4.0M0400080 AND- H7FFF T7 MODULE DON'T TRY **MSOS 4.0M0400081 EOR- H7FFF **MSOS 4.0M0400082 SAN 1 **MSOS 4.0M0400083 JMP* BUFF2+2 AND LINK **MSOS 4.0M0400084 LDA* (F1) M0400085 INA JB1-JBENT M0400086 JMP* BUFF2 **MSOS 4.0M0400087 SPC 1 M0400088 EQU ENDB(*-BUFF1) **MSOS 4.0M0400089 BZS FILL(L-ENDB) **MSOS 4.0M0400090ÐÐ BZS DRV(1) WORD FOR DRIVERS ON SHORT READ **MSOS 4.0M0400091*********************************************************************** M0400092 SPC 1 M0400093* THIS AREA WILL BE OVERLAID BY THE TRNTBL BUFFER. M0400094 SPC 1 M0400095BUFF2 ADD* JB1 M0400096 STA- 7,Q LOADER REQUEST M0400097 LDA* (F1) M0400098 INA JB2-JBENT M0400099 ADD* JB2 M0400100 STA- 11,Q CORE REQUEST M0400101 LDA* (F1) M0400102BPS INA JB3-JBENT M0400103RI ADD* JB3 M0400104LOADEP STA- 3,Q STATUS REQUEST M0400105 LDA* (F1) M0400106 INA JB4-JBENT M0400107JFLG ADD* JB4 **MSOS 4.0M0400108 STA- 5,Q EXIT REQUEST M0400109 SPC 1 M0400110 ENA 0 THIS IS THE LAST LOCATION OF TRANTA **MSOS 4.0M0400111* TABLE BUFFER.. NEXT 22 LOCATIONS **MSOS 4.0M0400112* ARE 3 WORDS--JOB NAME. 3 WORDS-- **MSOS 4.0M0400113* ACCOUNT NUMBER.. 16 WORDS PARAMETER**MSOS 4.0M0400114* BUFFER FOR FILES **MSOS 4.0M0400115ÐÐJNAME JMP* BRL **MSOS 4.0M0400116 SPC 1 **MSOS 4.0M0400117* TABLE OF ENTRY POINTS TO JOBENT **MSOS 4.0M0400118ENTTBL NUM 0 FWA OF JOBENT **MSOS 4.0M0400119 ADC JBPRO-JBENT SCHEDULE J P MODULES (JBPTROE) **MSOS 4.0M0400120 ADC ERRM-JBENT JO3 JO4 ERRORS (ERRMSG) **MSOS 4.0M0400121 ADC MIPBUF-JBENT LOCAL INPUT BUFFER (MIBUF) **MSOS 4.0M0400122 ADC TRNTBL-JBENT TRANSFER TABLE ADDRESS (TRNVEC) **MSOS 4.0M0400123FILTAB ADC LIB-JBENT SCHEDULE LIBEDT **MSOS 4.0M0400124 ADC RECOVR-JBENT SCHEDULE RCOVER (RECOV) **MSOS 4.0M0400125 ADC SAVQ1-JBENT INDEX PASSED TO J.P. POUTINES M0400126 ADC FILTAB-JBENT FILE PARAMETER TABLE (PARBV4) **MSOS 4.0M0400127 EQU LENGTH(*-ENTTBL-1) **MSOS 4.0M0400128 SPC 1 **MSOS 4.0M0400129 SPC 1 M0400130*********************************************************************** M0400131 SPC 1 M0400132BRL STA* BPS CLEAR THESE THREE LOCATIONS IN WHAT **MSOS 4.0M0400133 STA* RI BE THE TRNTBL BUFFER BEFORE SCHEDULING M0400134 STA* LOADEP JOBPRO M0400135 STA* JFLG **MSOS 4.0M0400136 SET A SET FIRST WORD TO INDICATE NO **MSOS 4.0M0400137 STA* JNAME JOB NAME YET **MSOS 4.0M0400138 LDQ* SAVBUF PICK UP MIINP BUFFER ADDRESS M0400139 STQ* (JBST) SAVE INPUT BUFFER ADDRESS IN TRVEC 61*1295 M0400140ÐÐ STQ- I SAVE BUFFER ADDRESS IN I REG. M0400141 ENQ L-1 **MSOS 4.0M0400142MVBUF LDA- (I),Q TRANSFER MIINP BUFFER TO BUFFER IN JOBENT M0400143 STA* MIPBUF,Q STORE IN MIPBUF LOCAL M0400144 INQ -1 M0400145 SQM 1 M0400146 JMP* MVBUF M0400147* LOAD AND GO SECTOR NUMBER M0400148 ENA 1 M0400149 STA- $E4 M0400150 SPC 1 M0400151 LDA INPTV4 RESET CONTROL INPUT DEVICE **MSOS 4.0M0400152 STA IUP **MSOS 4.0M0400153ABATCL STA+ BATCLU SET BATCH CONTROL STATEMENT LU = SYS. 116*4366M0400154* CONTROL LU 116*4366M0400155 LDA- 3,I 116*4366M0400156 SUB =A,F SEE IF FILE BATCH M0400157 SAN JOB065 NOT FILE BATCH M0400158 LDA+ AUTFB CURRENT LIST DEVICE LU (BATCH OUTPUT) M0400159 LDQ- $E9 ADDRESS OF THE EXTENDED COMM. REGION M0400160 STA- 3,Q STORE INTO THE COSY LIST LU M0400161 LDA =XBATINP STD. FILE BATCH LU. M0400162 JMP* JOB115 M0400163JOB065 LDA- 3,I M0400164 INA 0 116*4366M0400165ÐÐ SAN JOB070 SENSE LU SPECIFIED 116*4366M0400166 JMP* JOB130 GO PROCESS *BATCH 116*4366M0400167JOB070 LDA- 5,I 116*4366M0400168 LDQ- 4,I 116*4366M0400169 LRS 8 116*4366M0400170 INA 0 116*4366M0400171 SAZ JOB080 SENSE 2 DIGITS OR LESS 116*4366M0400172 JMP* JP05ER 116*4366M0400173F1 ADC FILE1 116*4366M0400174JB1 ADC T7 116*4366M0400175JB2 ADC T11 116*4366M0400176JB3 ADC T3 116*4366M0400177JB4 ADC T5 116*4366M0400178SAVBUF NUM 0 116*4366M0400179JOB080 TRQ A 116*4366M0400180 INA 0 (PREVIOUS SIGN EXTENSION WILL RESULT 116*4366M0400181* IN $FFFF 116*4366M0400182 SAN JOB082 SENSE 2 DIGITS 116*4366M0400183 LDQ- 3,I 116*4366M0400184 LRS 8 116*4366M0400185 ARS 8 (ADJUST FOR 1 DIGITS) 116*4366M0400186 EOR =N$3000 116*4366M0400187 JMP* JOB084 116*4366M0400188JOB082 LRS 8 116*4366M0400189 LDQ- 3,I 116*4366M0400190ÐÐ LRS 8 116*4366M0400191JOB084 INQ -$2C 116*4366M0400192 SQZ JOB090 SENSE DELIMITER A COMMA 116*4366M0400193 JMP* JP05ER 116*4366M0400194JOB090 SUB =N$3030 116*4366M0400195 ENQ 0 116*4366M0400196 DVI =N$100 116*4366M0400197 STQ* TEMP1 116*4366M0400198 MUI- TEN 116*4366M0400199 ADD* TEMP1 116*4366M0400200 STA* TEMP1 116*4366M0400201 INA -2 116*4366M0400202 SAP JOB110 SENSE LU NOT=1(ALLOVATOR) 116*4366M0400203JOB100 JMP* JP05ER 116*4366M0400204JOB110 SUB =XNUMLU 116*4366M0400205 SAP JP05ER SENSE LU .GT. MAX. 116*4366M0400206 LDA* TEMP1 116*4366M0400207JOB115 STA+ IUP UPDATE CONTROL STATEMENT LU 116*4366M0400208 STA* (ABATCL+1) SET BATCH CONTROL STATEMENT LU 116*4366M0400209 JMP* JOB130 116*4366M0400210* ERROR STATEMENT AFTER MI 116*4366M0400211JP05ER RTJ- (AMONI) OUTPUT JP05 ERROR 116*4366M0400212PARMER NUM $0D00 116*4366M0400213 ADC JOB125-PARMER 116*4366M0400214 ADC 0,$18FC,2 116*4366M0400215ÐÐ ADC JP05-PARMER 116*4366M0400216 JMP- (ADISP) 116*4366M0400217JOB125 CLR A CLEAR MIB TO ALLOW MI 116*4366M0400218 STA+ MIB 116*4366M0400219 RTJ- (AMONI) RELEASE JOBENT 116*4366M0400220 NUM $1901 116*4366M0400221 ADC (JBENT-*+1) 116*4366M0400222JP05 ALF 2,JP05 116*4366M0400223TEMP1 NUM 0 116*4366M0400224JOB130 RTJ* ALLATE M0400225 LDQ* SAVBUF M0400226 STQ- I 116*4366M0400227 ENQ 3 **MSOS 4.0M0400228SJBPRO STQ* SAVQ1 M0400229 LDA* JBPADR SCHEDULE JOBPRO **MSOS 4.0M0400230 JMP* JBPRO0 M0400231JBPRO STQ* SAVQ1 SAVE INDEX TO PROPER ROUTINE WITHIN THE M0400232* SCHEDULED MODULE OR AN EXECUTION ADDRESS M0400233 TRA Q MOVE INDEX FOR PROPER MODULE TO Q REG. M0400234 LDA* TBL,Q Q REG. 0=JPT13, 1=JOBPRO, 2=JPLOAD, M0400235* 3=JPCHGE, 4=RESTOR, 5=JLGOV4 **MSOS 4.0M0400236* 6=JCRDV4, 7=JBFLV4, 8=NAMEC4 **MSOS 4.0M0400237* 9=JPSTV4, 10=AFILV4 **MSOS 4.0M0400238JBPRO0 STA* SCHADR M0400239* RELEASE FILES TWO AND THREE M0400240ÐÐ RTJ MRELF RELEASE SPECIFIED FILE M0400241 LDQ* SAVQ1 INDEX TO LOC IN SCHEDULED MODULE TO BEGIN M0400242* EXECUTION OR AN EXECUTION ADDRESS. M0400243SCHED RTJ- ($F4) M0400244 NUM $1200 M0400245SCHADR ADC 0 M0400246 JMP- (DISP) M0400247* 5 CARDS DELETED 116*4366M0400248 SPC 2 M0400249 SPC 1 M0400250 SPC 2 M0400251TBL ADC (JPT13) M0400252JBPADR ADC (JOBPRO) M0400253 ADC (JPLOAD) M0400254 ADC (JPCHGE) M0400255 ADC (RESTOR) M0400256 ADC (JLGOV4) **MSOS 4.0M0400257 ADC (JCRDV4) **MSOS 4.0M0400258 ADC (JPFLV4) **MSOS 4.0M0400259 ADC (NAMEV4) **MSOS 4.0M0400260 ADC (JPSTV4) **MSOS 4.0M0400261 ADC (AFILV4) **MSOS 4.0M0400262 SPC 2 M0400263F2 ADC FILE2 M0400264SWT ADC SWTCH M0400265ÐÐJB ADC JOBIND M0400266JBST ADC JPSWT 61*1295 M0400267 SPC 2 M0400268SAVI NUM 0 M0400269SAVQ1 NUM 0 M0400270* 1 CARD DELETED 116*4366M0400271 EQU MIPBUF(BUFF1) M0400272 EQU TRNTBL(BUFF2) M0400273 SPC 1 M0400274***************************************************** M0400275 SPC 1 M0400276* THIS ROUTINE RELEASES FILE3 (PROTEC) IF PRESENTLY M0400277* INCORE, RELEASES FILE2 (JOB PROC. MODS.) AND SCHEDULES M0400278* LIBEDIT WITH THE RETURN LOCATION STORED IN Q. M0400279 SPC 1 M0400280***************************************************** M0400281 SPC 2 M0400282LIB RTJ* REL RELEASE OUTSTANDING FILES M0400283 LDQ* (F1) M0400284 ADQ =XLB2-JBENT M0400285 RTJ- ($F4) SCHDLE LIBEDT M0400286TWLVE NUM $1200 M0400287 ADC (LIBEDT) M0400288 JMP- (DISP) M0400289 SPC 1 M0400290ÐÐ SPC 1 M0400291************************ RETURN FROM LIBEDT ******************** M0400292 SPC 1 M0400293 RAO* SAVQ THIS MUST REMAIN BEFORE TAG LB2 **MSOS 4.0M0400294LB2 ENA 1 M0400295 STA- $E4 RESET LOAD AND GO ON RETURN FROM LIBEDT M0400296LB4 RAO MIB SET MIB FLAG TO LOCK OUT OTHER ENTRIES M0400297 ENA 0 M0400298 STA* (SWT) CLEAR SWITCH FOR JP LOCK-OUT. M0400299 STA LOADEP CLEAR LOADER IN CORE FLAG 116*4366M0400300 SET Q M0400301 STQ* (JBST) **MSOS 4.0M0400302 STQ* (JB) RESET J.P. IN CORE FLAG **MSOS 4.0M0400303 LDA* SAVQ **MSOS 4.0M0400304 SAN 1 **MSOS 4.0M0400305 JMP* SJBPRO-1 **MSOS 4.0M0400306 ENA 0 LIBEDT IS TERMINATING **MSOS 4.0M0400307 STA* SAVQ ABNORMALLY **MSOS 4.0M0400308 ENQ 6 TELL JOBPRO TO **MSOS 4.0M0400309 JMP* SJBPRO ABORT JOB **MSOS 4.0M0400310 SPC 1 M0400311SAVQ NUM $0000 M0400312 SPC 1 M0400313* THIS ROUTINE RELEASES FILE3 (PROTEC) IF PRESENTLY M0400314* INCORE, RELEASES FILE2 (JOB PROC. MODS.) AND SCHEDULES RECOVERY M0400315ÐÐ* WITH THE RETURN LOCATION STORED IN LOCATION $EE. M0400316 SPC 1 M0400317RECOVR RTJ* REL RELEASE ANY UNUSED FILES **MSOS 4.0M0400318 LDQ* (F1) M0400319 ADQ =XRC2-JBENT SET RETURN IN $EE TO RC2 M0400320 STQ- $EE M0400321 RTJ- ($F4) M0400322 NUM $1200 M0400323 ADC (RCOVER) M0400324 JMP- (DISP) M0400325 SPC 1 M0400326RC2 IIN 0 RETURN FROM RECOVERY PROGRAM **MSOS 4.0M0400327 ENA 0 M0400328 STA RI CLEAR RECOVERY SWITCH 116*4366M0400329 STA BPS BREAKPOINT SWITCH 116*4366M0400330 STA LOADEP LOADER FLAG 116*4366M0400331 JMP* LB4 **MSOS 4.0M0400332 SPC 3 M0400333REL ADC 0 RELEASE FILE2, FILE3 ROUTINE IF THEY'RE IN M0400334 IIN 0 M0400335 LDA JBCNFG IF CANCEL FLAG SET - GO AWAY AND LET IT M0400336 SAZ GO1 TAKE OVER. IF NOT SET, CONTINUE ON M0400337 JMP- ($EA) M0400338GO1 STA* (JB) SET JOB PROCESSOR NOT ACTIVE M0400339 STA JKIN M0400340ÐÐ SET A SET LIBEDT IN FLAG M0400341 STA* (SWT) M0400342 EIN 0 M0400343 SET Q RELEASE AREA 3 M0400344 RTJ* MRELF M0400345 JMP* (REL) M0400346MRELF NOP 0 M0400347 SQZ LOPER DON'T RELEASE 3 IF T13 OR JLGOV4 M0400348 INQ -5 ARE BEING CALLED M0400349 SQZ LOPER PROTEC IS THERE M0400350 ENQ 1 SET TO RELEASE FILE3 AND FILE2 M0400351LOPER LDA* (F2),Q M0400352 SAZ CK IF ALREADY RELEASED - TO NEXT ONE M0400353 STA* REL1 NOT RELEASED - RELEASE IT M0400354 CLR A M0400355 STA* (F2),Q ZERO FLAG M0400356 RTJ- ($F4) M0400357 ADC $1800 RELEASE M0400358REL1 ADC 0 M0400359CK SQZ CONT ALL COMPLETED - LEAVE M0400360 INQ -1 M0400361 JMP* LOPER NO - TRY AGAIN M0400362CONT JMP* (MRELF) M0400363 SPC 1 M0400364SAVA NUM 0 M0400365ÐÐALLATE NUM 0 M0400366 LDA- $F6 M0400367 SUB- $F7 M0400368 INA -1 M0400369 ENQ 0 M0400370 LLS 5 M0400371 SAZ KILL1 ON A PAGE BOUNDARY M0400372 INQ 1 M0400373KILL1 LDA- $F7 DETERMINE BASE ADDRESS TO ALLOCATE M0400374 INA 1 M0400375 AND- $1D ($F800) MAKE EVEN PAGE M0400376 RTJ XMRESV RESERVE THE BATCH AREA FROM THE USER AREA M0400377* M0400378 JMP* (ALLATE) M0400379 END M0400380 NAM JPSTV4 M08 A ITOS CCS 3.0 SL-149M0800001* MASS STORAGE OPERATING SYSTEM VERSION 5.0 M0800002* SMALL SYSTEMS DIVISION, LA JOLLA, CALIFORNIA M0800003* COPYRIGHT CONTROL DATA CORPORATION 1976 M0800004 SPC 2 M0800005 ENT V4JPV4 **MSOS 4.0M0800006 EXT* XMRETN RETURN USER AREA TO ITOS EXECUTIVE M0800007 EXT* CLPTFL ROUTINE TO CLOSE ALL PSEUDO-TAPES M0800008 EXT INPTV4 **MSOS 4.0M0800009 EXT TRNVEC,IUP,JOBIND,LOADIN M0800010ÐÐ EXT IP1,RELFLE,FILE2,JBPROE M0800011 EXT MIB **MSOS 4.1**M0800012 EXT LOG1A M0800013 EQU EQ(8) M0800014 EQU LPMSK(2) M0800015 EQU DISP($EA) **MSOS 4.0M0800016 EQU REQXT($B9) **MSOS 4.0M0800017 SPC 1 M0800018* JPST ROUTINE * M0800019* HANDLES *B, *U, *V, *SR, *, AND *Z INPUT STATEMENTS ** M0800020 SPC 2 M0800021V4JPV4 NUM $C8FE **MSOS 4.0M0800022 STA* (F2) STORE FWA IN TRVEC **MSOS 4.0M0800023 ENA 0 **MSOS 4.0M0800024 STA MIB CLEAR JOB LOCKOUT **MSOS 4.0M0800025 LDQ TRNVEC TRANTA TABLE ADDRESS IN JOBENT **MSOS 4.0M0800026 TRQ A **MSOS 4.0M0800027JPST LDQ- 10,Q REQUEST CODE **MSOS 4.0M0800028 INQ -1 M0800029 LDQ* TAB,Q M0800030 JMP* JPST,Q M0800031RETRF3 ENQ 14 SCHEDULE JOBPRO **MSOS 4.0M0800032 ENA 1 **MSOS 4.0M0800033GETMOD STA* INDEX MODULE INDEX **MSOS 4.0M0800034 LDA JBPROE GET NEXT CONTROL **MSOS 4.0M0800035ÐÐ STA- I STATEMENT **MSOS 4.0M0800036 LDA* INDEX **MSOS 4.0M0800037 JMP- (I) **MSOS 4.0M0800038INDEX NUM 0 **MSOS 4.0M0800039COMDEV NUM $18FD **MSOS 4.0M0800040F2 ADC FILE2 **MSOS 4.0M0800041 SPC 1 M0800042 SPC 1 M0800043* ******************************************************************** M0800044 SPC 1 M0800045TAB ADC BPLOAD-JPST M0800046 ADC TYPEIN-JPST M0800047 ADC STDINP-JPST M0800048 ADC SGNOFF-JPST M0800049 ADC SETREC-JPST M0800050 ADC RESUME-JPST M0800051 ADC WEOF-JPST **MSOS 4.0M0800052 SPC 1 M0800053* ******************************************************************** M0800054 SPC 1 M0800055*** *B JOB PROCESSOR STATEMENT M0800056* SET THE BREAK-POINT LOAD SWITCH M0800057 SPC 1 M0800058BPLOAD TRA Q TRANTA ADDTESS **MSOS 4.0M0800059 STA- 7,Q SET BPS **MSOS 4.0M0800060ÐÐ JMP* RETRF3 M0800061 SPC 1 M0800062*** *U JOB PROCESSOR STATEMENT M0800063* READ ALL CONTROL STATEMENTS FROM COMMENT MEDIUM M0800064 SPC 1 M0800065TYPEIN LDA* COMDEV SET INPUT COMMENT TO TTY **MSOS 4.0M0800066 STA* (IUPP) M0800067 JMP* RETRF3 M0800068 SPC 1 M0800069 SPC 1 M0800070*** *V JOB PROCESSOR STATEMENT M0800071* READ ALL CONTROL STATEMENTS FROM STANDARD M0800072* INPUT DEVICE M0800073 SPC 1 M0800074STDINP LDA =N$18F9 SET INPUT UNIT TO SBI M0800075 STA* (IUPP) M0800076 JMP* RETRF3 M0800077 SPC 1 M0800078*** *SR JOB PROCESSOR STATEMENT M0800079 SPC 1 M0800080SETREC TRA Q **MSOS 4.0M0800081 LDA- 2,Q INPUT BUFFER **MSOS 4.0M0800082 STA- I **MSOS 4.0M0800083 LDA- 1,I **MSOS 4.0M0800084 AND- $A FF **MSOS 4.0M0800085ÐÐ SUB- $A IF NOT RECOVERY GO TO JPLOAD **MSOS 4.0M0800086 SAN GETLD NOT AN *SR **MSOS 4.0M0800087 STQ- 8,Q SET RECOVERY INDICATOR **MSOS 4.0M0800088 JMP* RETRF3 M0800089GETLD ENA 2 **MSOS 4.0M0800090 JMP* GETMOD GET JPLOAD THRU JOBENT **MSOS 4.0M0800091 SPC 2 M0800092* THIS ROUTINE WILL CAUSE THE JOB PROCESSOR TO CONTINUE WITH ($E4) = 1 M0800093* AND THE LOADER-IN-CORE FLAG SET TO ZERO **MSOS 4.0M0800094 SPC 2 M0800095RESUME ENA 1 SET START OF SCRATCH TO BEGINNING M0800096 STA- $E4 M0800097 ENA 0 **MSOS 4.0M0800098 STA LOADIN **MSOS 4.0M0800099 JMP* RETRF3 M0800100IUPP ADC IUP **MSOS 4.0M0800101 SPC 1 M0800102***************************************************** M0800103 SPC 1 M0800104*** *Z JOB PROCESSOR STATEMENT M0800105* *Z WILL TERMINATE THE BATCH SUBSYSTEM **MSOS 4.0M0800106 SPC 1 M0800107SGNOFF LDQ- $FB GET CURRENT LIST LU M0800108 STQ* WEOFB+4 M0800109 LDQ LOG1A,Q GET PHYSTB ADDRESS M0800110ÐÐ LDA- EQ,Q GET EQUIPMENT CLASS, TYPE M0800111 AND- LPMSK+14 M0800112 ARS 4 M0800113 SUB =N$28A IS LIST = BATCH OUTPUT DEVICE M0800114 SAN NOEOF SKIP IF NOT M0800115WEOFB RTJ- ($F4) WRITE EOF TO LIST DEVICE M0800116 ADC $1D00 M0800117 ADC NOEOF-WEOFB-1 M0800118 NUM 0 M0800119 NUM 0 M0800120 NUM $2000 M0800121 JMP- ($EA) M0800122NOEOF ENA 0 M0800123 STA JOBIND M0800124 STA LOADIN M0800125 ENA 1 M0800126 STA- $E4 M0800127 SPC 1 M0800128 LDQ- $E9 ADDR OF EXTENDED CORE TABLE **MSOS 4.0M0800129 LDQ- 9,Q ADDR OF RCTV IN MONI **MSOS 4.0M0800130 LDA- REQXT M0800131 STA- 3,Q M0800132 STA- 5,Q M0800133 STA- 7,Q M0800134 STA- 11,Q M0800135ÐÐ STA- 13,Q M0800136 LDA- DISP M0800137 STA IP1 SET PROTECT FAULT RETURN TO DISPATCHER M0800138 RTJ CLPTFL CLOSE ALL PSEUDO-TAPES THAT ARE OPEN M0800139 LDA INPTV4 RESET CONTROL INPUT DEVICE **MSOS 4.0M0800140 STA* (IUPP) **MSOS 4.0M0800141 LDA- $F6 FIND NUMBER OF PAGES TO RELEASE M0800142 SUB- $F7 M0800143 INA -1 M0800144 ENQ 0 M0800145 LLS 5 M0800146 SAZ KILL1 ON A PAGE BOUNDARY M0800147 INQ 1 M0800148KILL1 LDA- $F7 DETERMINE BASE ADDRESS TO RELEASE M0800149 INA 1 M0800150 AND- $1D ($F800) MAKE EVEN PAGE M0800151 RTJ XMRETN RETURN THE BATCH AREA TO THE ITOS EXECUTIVE M0800152* M0800153 CLR A M0800154 RTJ RELFLE M0800155 SPC 5 **MSOS 4.0M0800156* *EOF PROCESSOR **MSOS 4.0M0800157* *EOF WILL WRITE ONE END OF FILE **MSOS 4.0M0800158* TP THE STANDARD BINARY OUTPUT DECICE **MSOS 4.0M0800159 SPC 3 **MSOS 4.0M0800160ÐÐWEOF TRA Q **MSOS 4.0M0800161 LDQ- 2,Q INPUT BUFFER ADDRESS **MSOS 4.0M0800162 LDA- 2,Q **MSOS 4.0M0800163 INA 0 **MSOS 4.0M0800164 SAZ 1 **MSOS 4.0M0800165 JMP* GETLD NOT A CONTROL STATEMENT **MSOS 4.0M0800166 LDA- $FA **MSOS 4.0M0800167 STA* REQ+3 **MSOS 4.0M0800168 RTJ- ($F4) **MSOS 4.0M0800169REQ NUM $1D00 **MSOS 4.0M0800170 ADC COMP-REQ **MSOS 4.0M0800171 NUM 0,0,$2000 M0800172 JMP- ($EA) M0800173COMP JMP* RETRF3 M0800174 END M0800175 NAM JOBPRO M09 A ITOS CCS 3.0 SL-149M0900001* M0900002* CREDIT COLLECTION SYSTEM VERSION 3.0 M0900003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA M0900004* COPYRIGHT CONTROL DATA CORPORATION 1978 M0900005* M0900006 SPC 2 M0900007***************************************************** M0900008 SPC 1 M0900009* JOB PROCESSOR SECONDARY CONTROL MODULE **MSOS 4.0M0900010ÐÐ SPC 1 M0900011***************************************************** M0900012 SPC 2 M0900013 ENT JOBTWO M0900014 ENT RF3 M0900015 ENT JO3T ERROR RETURN FROM DUMMY 1,2,3 **MSOS 4.1**M0900016 ENT RI M0900017 SPC 1 M0900018 EXT TRNVEC ABS. ADDRESS OF TRANTA BUFFER IN JOBENT M0900019 EXT JBPROE ENTRY POINT TO JOBENT (TRVEC) M0900020 EXT MIBUF ADDR. OF JOBENT MIBUF (TRVEC) M0900021 EXT JPSWT SWITCH IN TRVEC SET BY JOBENT M0900022 EXT JBCNFG JOB CANCEL FLAG M0900023 EXT RECOV M0900024 EXT ERRMSG M0900025 EXT NSTACK M0900026 EXT TRANV M0900027 EXT IUP M0900028 EXT MIB M0900029 EXT FILE3 M0900030 EXT JOBIND **MSOS 4.0M0900031 EXT LOG1A **MSOS 4.0M0900032 EXT BATCLU (TRVEC) 116*4366M0900033 EXT* CLPTFL CLOSES ALL PSEUDO-TAPE FILES THAT ARE OPEN M0900034 EXT* BFCLOS FORCE FILE CLOSE SUBROUTINE M0900035ÐÐ EXT VINPV4 M0900036 EXT* ONE,TWO,THREE M0900037 EXT JBCFGZ M0900038 EQU HFF($A) M0900039 EQU H7FFF($11),HFFFF($12) M0900040 EQU LPMSK(2) M0900041 EQU REQXT($B9) M0900042 SPC 1 M0900043 EQU DISP($EA) M0900044 EQU ZERO($22) **MSOS 4.0M0900045 SPC 2 M0900046JOBTWO NUM $C8FE ENTRY POINT M0900047 STA (F3) M0900048JP1 STQ* SAVQ2 SAVE Q REG. M0900049 STA TRANTA **MSOS 4.0M0900050 ADD =XTRANTA-JOBTWO **MSOS 4.0M0900051 STA TRANV ADD. OF JOBPRO TRANTA TABLE STORED M0900052* IN TRVEC. M0900053 ENA 7 M0900054 ADD TRNVEC **MSOS 4.0M0900055 STA- I M0900056 ENQ -6 **MSOS 4.0M0900057LOOP LDA- (I) MOVE CONTENTS OF BPI, RI, AND LOADEP**MSOS 4.0M0900058 STA TRANTA+13,Q AND ERROR NUMBER,STACK ADDR. JOB FLA**MSOS 4.0M0900059 RAO- I M0900060ÐÐ INQ 1 **MSOS 4.0M0900061 SQZ OUT2 M0900062 JMP* LOOP M0900063OUT2 LDQ* SAVQ2 M0900064 SQM JB-*-1 SKIP IF Q IS SET NEG. M0900065 LDA JOBIND **MSOS 4.0M0900066 EQU JOBI(*-1) **MSOS 4.0M0900067 SAN OUT3A **MSOS 4.0M0900068OUT2A SET A EITHER INITIAL CALL OR BACK FROM **MSOS 4.0M0900069* LIBEDT OR RECOVERY **MSOS 4.0M0900070 STA* (JOBI) **MSOS 4.0M0900071OUT3 LDQ TRANTA,Q **MSOS 4.0M0900072 JMP* JOBTWO,Q JUMP THROUGH THE ADDRESS IN THE TRANTA M0900073* TABLE TO THE PROPER ROUTINE. M0900074OUT3A SAP JBP **MSOS 4.0M0900075 JMP* OUT3 **MSOS 4.0M0900076SAVQ2 NUM 0 M0900077JB LDQ JPSWT JPSWT IS SET NEG. AFTER RETURN FROM M0900078* LIBEDT AND RECOVERY. JOBENT STORES THE M0900079* MIINP BUFFER ADDRESS IN HERE. IF A NEW M0900080* J P STMT. IS READ IN BY JOBPRO, THE ADDRESS M0900081* OF MIBUF IN JOBENT IS STORED IN INPBUF M0900082* AT TAG RD3. M0900083 STQ INPBUF STORE MIINP BUFFER ADDR IN TRANTA TA**MSOS 4.0M0900084 SQP JBPRO-*-1 M0900085ÐÐ CLR A M0900086 STA (MIB1) CLEAR MIB SWITCH **MSOS 4.0M0900087 JMP JOBP TYPE 'J' AND INPUT CONTROL STATEMENT M0900088JBP TRA Q T7 OR JPLOAD TERMINATED ON A CONTROL**MSOS 4.0M0900089* STATEMENT. JOBIND IS BUFFER ADDRESS **MSOS 4.0M0900090* OF CONTROL STATEMENT. **MSOS 4.0M0900091 SET A **MSOS 4.0M0900092 STA* (JOBI) RESET FOR NORMAL CONTROL CARD PROC. **MSOS 4.0M0900093JBPRO JMP SSI STATEMENT ALREADY INPUT, MOVE TO SM BUF M0900094 SPC 1 M0900095JPTAB ALF 1,K, K JP REQ. NO. 0 M0900096 NUM $42FF B JP REQ. NO. 1 M0900097 NUM $55FF U JP REQ. NO. 2 M0900098 NUM $56FF V JP REQ. NO. 3 M0900099 NUM $5AFF Z JP REQ. NO. 4 M0900100 ALF 1,SR SR JP REQ. NO. 5 M0900101 NUM $FFFF * JP REQ. NO. 6 M0900102 ALF 1,EO EO JP REQ. NO. 7 **MSOS 4.0M0900103 ALF 1,V, V, JP REQ. NO. 8 M0900104 ALF 1,CS CS JP REQ. NO. 9 **MSOS 4.0M0900105 ALF 1,AD AD JP REQ. NO. A M0900106 ALF 1,BS BS JP REQ. NO. B M0900107 ALF 1,R, R, JP REQ. NO. C M0900108 ALF 1,JO JO JP REQ. NO. D M0900109 ALF 1,CT CT JP REQ. NO. E M0900110ÐÐ ALF 1,PA PA JP REQ. NO. F M0900111 ALF 1,UN UN JP REQ. NO. 10 M0900112 ALF 1,FI FI JP REQ. NO. 11 M0900113 ALF 1,PU PU JP REQ. NO. 12 M0900114 ALF 1,MO MO JP REQ. NO. 13 M0900115 ALF 1,RE RE JP REQ. NO. 14 M0900116 ALF 1,DE DE JP REQ. NO. 15 M0900117 ALF 1,CL CL JP REQ. NO. 16 M0900118 ALF 1,OP OP JP REQ. NO. 17 M0900119 NUM $31FF 1 JP REQ. NO. 18 M0900120 NUM $32FF 2 JP REQ. NO. 19 M0900121 NUM $33FF 3 JP REQ. NO. 1A M0900122JPTABL BSS JPTABL(0) M0900123SAVQ NUM $0000 M0900124TEMP NUM 0 **MSOS 4.0M0900125 SPC 1 M0900126JOBP4 LDQ- ($22),I GET FIRST TWO WORDS. M0900127 LDA- 1,I M0900128 LLS 8 M0900129 STQ* TEMP SAVE SECOND AND THIRD CHAR. M0900130 AND- $A CHECK FOR ASTERICK M0900131 INA -$2A M0900132 SAZ 1 M0900133 JMP* JO3T M0900134 LDA* TRANTA+12 IS A JOB IN PROGRESS **MSOS 4.0M0900135ÐÐ SAN JOLK YES **MSOS 4.0M0900136 LDA* JPTAB+4 LET AN *Z THRU **MSOS 4.0M0900137 EOR* TEMP **MSOS 4.0M0900138 SAZ JOLKA1 M0900139 EOR* HEXDF TEST FOR BLANK M0900140 SAZ JOLKA1 M0900141JCHK LDA* JPTAB+13 NO-BUT MAY BE A JOB CARD M0900142 EOR* TEMP **MSOS 4.0M0900143 SAZ JOLKA LET JCRDV4 DO THE REST OF THE CHECK **MSOS 4.0M0900144 LDA* JPTAB+8 V, ALLOWED TO START INPUT **MSOS 4.0M0900145 EOR* TEMP FROM OTHER THAN STANDARD **MSOS 4.0M0900146JOLKA1 SAZ JOLKA M0900147 LDA =N$3135 **MSOS 4.0M0900148 JMP* JO3T1 ABORT THE JOB **MSOS 4.0M0900149JOLK LDA* TTYEOF *G - EOF FOR TTY **MSOS 4.0M0900150 EAQ A **MSOS 4.0M0900151 SAN JOLKA **MSOS 4.0M0900152 JMP TERMA TERMINATE JOB **MSOS 4.0M0900153HEXDF NUM $DF M0900154TTYEOF NUM $47FF **MSOS 4.0M0900155JOLKA ENQ JPTABL-JPTAB-1 SEARCH THE TABLE **MSOS 4.0M0900156RETRY LDA* JPTAB,Q CHECK FOR REQUEST WORD. M0900157 EOR* TEMP M0900158 SAZ JOBP6-*-1 M0900159 EOR* HEXDF M0900160ÐÐ SAZ JOBP6-*-1 M0900161 INQ -1 M0900162 SQM 1 M0900163 JMP* RETRY LOOP AROUND FOR NEXT STATEMENT M0900164JOBP6 STQ* QREG REQUEST NUMBER **MSOS 4.0M0900165 RTJ JBKMIB CHECK FOR JOB CANCEL **MSOS 4.0M0900166 RTJ* MVTBL MOVE TRANTA TABLE TO JOBENT **MSOS 4.0M0900167 LDQ* QREG **MSOS 4.0M0900168 ENA 0 **MSOS 4.0M0900169 SQM IDXTBL JPLOAD CONTROL STATEMENT **MSOS 4.0M0900170 SQN 1 **MSOS 4.0M0900171 JMP* IDXTBL+6 K **MSOS 4.0M0900172 INQ -8 M0900173 SQP 1 **MSOS 4.0M0900174 SQM IDXTBL+2 *,B,SR,U,V,Z,EOF **MSOS 4.0M0900175 INQ -4 M0900176 SQP 1 **MSOS 4.0M0900177 SQM IDXTBL+6 CSY,V,ADR,ADF,BSR,BSF M0900178 SQZ IDXTBL+5 R **MSOS 4.0M0900179 INQ -4 **MSOS 4.0M0900180 SQM IDXTBL+4 JOB,CTO,PAUS **MSOS 4.0M0900181 INQ -8 **MSOS 4.0M0900182 SQM IDXTBL+3 REWIND,FILES **MSOS 4.0M0900183 JMP* JOBP9 1,2,3 **MSOS 4.1**M0900184IDXTBL INA -8 JPLOAD **MSOS 4.0M0900185ÐÐ INA 1 AFILV4 **MSOS 4.0M0900186 INA 2 JPSTV4 **MSOS 4.0M0900187 INA 1 JPFLV4 **MSOS 4.0M0900188 INA 2 JCRDB4 **MSOS 4.0M0900189 INA 1 RESTOR **MSOS 4.0M0900190 INA 3 JPCHGE **MSOS 4.0M0900191JBPEX ENQ 0 **MSOS 4.0M0900192 STA* INDEX **MSOS 4.0M0900193 LDA JBPROE **MSOS 4.0M0900194 STA- I **MSOS 4.0M0900195 LDA* INDEX **MSOS 4.0M0900196 JMP- (I) **MSOS 4.0M0900197INDEX NUM 0 **MSOS 4.0M0900198TERM RTJ* RELFIL **MSOS 4.0M0900199 ENA 7 A JOB IS ABNORMALLY TERMINATING SO **MSOS 4.0M0900200 SET Q SCHEDULE FILE MOD TO CLOSE OPEN JOB **MSOS 4.0M0900201 JMP* JBPEX+1 FILES- RETURN WILL BE AT CLSDON **MSOS 4.0M0900202 SPC 1 M0900203 SPC 1 M0900204JO3T LDA =N$3033 SET UP 03 ERROR CODE **MSOS 4.0M0900205JO3T1 LDQ* (TRNTB) JOBENT TRANTA TABLE **MSOS 4.0M0900206 STA- 10,Q STORE ERROR IN TRANTA ERROR WORD **MSOS 4.0M0900207 JMP* TERM **MSOS 4.0M0900208***** THIS ROUTINE MOVES THE TRANTA TABLE TO JOBENT ******** M0900209 SPC 1 M0900210ÐÐMVTBL NUM 0 M0900211 LDA TRNVEC GET TRN TBL ADDR IN JOBENT **MSOS 4.0M0900212 EQU TRNTB(*-1) **MSOS 4.0M0900213 STA- I FROM TRVEC AND SAVE **MSOS 4.0M0900214 ENQ LENGTH M0900215MOVE LDA* TRANTA,Q TRANSFER TRANTA TABLE TO JOBENT M0900216 STA- (I),Q **MSOS 4.0M0900217 SQZ 2 M0900218 INQ -1 M0900219 JMP* MOVE M0900220 JMP* (MVTBL) M0900221 EJT M0900222* VECTOR TABLE FOR JOB PROCESSOR M0900223 SPC 2 M0900224TRANTA NUM $7FFF 0 - ABSOLUTE LOCATION OF JOBTWO M0900225 ADC JBPRO-JOBTWO 1 - RETURN WHEN STATEMENT ALREADY INPUT M0900226INPBUF NUM 0 2 - ABS. ADDR. OF INPUT BUFFER IN JOBENT M0900227 ADC JOBP-JOBTWO 3 - RETURN WHEN NO STATEMENT - 'J' PRINTED M0900228 ADC CLSDON-JOBTWO 4-RETURN AFTER FILES CLOSED **MSOS 4.0M0900229 ADC FILHD-JOBTWO 5-ROUTINE FOR FILE MODS **MSOS 4.0M0900230 ADC TERM-JOBTWO 6-START ABNORMAL JOB TERMINATION **MSOS 4.0M0900231BPS NUM 0 7 - BREAKPOINT SWITCH M0900232RI NUM 0 8 - RECOVERY ON/OFF SWITCH M0900233LOADEP NUM 0 9 - LOADER ENTRY POINT M0900234QREG NUM 0 10 - REQUEST NUMBER M0900235ÐÐSTCK NUM 0 11 - LOCATION OF PROTECT PROCESSOR REQ STACK M0900236JFLG NUM 0 12-INDICATES IF A JOB IS IN PROGRESS**MSOS 4.0M0900237NN ADC NSTACK 13 - NO. OF ENTRIES IN PROTEC STACK M0900238 ADC RF3-JOBTWO 14 - RETURN TO RELEASE FILE 3 'OUTPUT J' M0900239 EQU LENGTH(*-TRANTA-1) **MSOS 4.0M0900240 SPC 2 M0900241JOBP9 LDA* TABLE,Q GET ADDRESS OF PROGRAM M0900242 AAQ A M0900243 INA TABLE-JOBP10 M0900244 STA* JOBP10 M0900245 LDA SSI1 RESTORE INPUT BUFFER POINTER M0900246 STA- I M0900247 RTJ* * M0900248JOBP10 NUM $0000 M0900249 JMP* JOBP GET NEXT STATEMENT M0900250 SPC 1 M0900251TABLE ADC ONE RELATIVE TRANSFER TABLE M0900252 ADC TWO USERS PROGRAMS. M0900253 ADC THREE M0900254* USER CAN ADD PROGRAM NAMES HERE. M0900255 SPC 1 M0900256F3 ADC FILE3 **MSOS 4.0M0900257MIB1 ADC MIB M0900258 SPC 1 M0900259RELFIL NOP 0 M0900260ÐÐ RTJ JBKMIB M0900261 CLR Q M0900262 STQ* (MIB1) CLEAR MIB FLAG M0900263 JMP* (RELFIL) RTS M0900264 SPC 3 M0900265FILHD RTJ* RELFIL M0900266 ENA 0 **MSOS 4.0M0900267 JMP* IDXTBL+1 SCHEDULE THE SECOND PORTION OF **MSOS 4.0M0900268* THE FILE HANDLER **MSOS 4.0M0900269RF3 RTJ* RELFIL M0900270JOBP LDA (IUPP) CHECK FOR TYPE PF INPUT **MSOS 4.0M0900271 STA* READLU M0900272 AND- $A MEDIUM M0900273 SUB- $FD INPUT COMMENT DEVICE **MSOS 4.0M0900274 SAZ JOBP1 YES **MSOS 4.0M0900275 ADD- $FD **MSOS 4.0M0900276 SUB =N$FD **MSOS 4.0M0900277JOBP1 STA* COMSW **MSOS 4.0M0900278 SAN JOBP61 DON'T PRINT A -J- ON THE LIST DEVICE**MSOS 4.0M0900279WRIT RTJ* JBKILL CHECK FOR JOB CANCEL FLAG SET M0900280 RTJ- ($F4) OUTPUT J M0900281 ADC $D00,WRIT1-WRIT-2 **MSOS 4.0M0900282WRITHD ADC 0 M0900283WRITLU ADC $18FC,$2 M0900284 ADC WRITO-*+5 M0900285ÐÐ JMP- (DISP) **MSOS 4.0M0900286WRIT1 SQP JOBP61 **MSOS 4.0M0900287 JMP* WRIT M0900288JOBP61 LDA* (F3) FIND ABS. LOC. OF SM M0900289 ADD =XSM1-JOBTWO M0900290 STA- I M0900291 LDA* (STABUF) GET ADDRESS INPUT BUF IN JOBENT **MSOS 4.0M0900292 STA* SET+1 **MSOS 4.0M0900293 ENA -0 SET BUFFER TO $FFFF M0900294 ENQ L-1 M0900295SET STA+ 0,Q STORE IN MIBUF IN JOBENT **MSOS 4.0M0900296 STA* SM1,Q STORE IN LOCAL BUFFER M0900297 INQ -1 M0900298 SQM READR M0900299 JMP* SET M0900300READR RTJ* JBKILL CHECK FOR JOB CANCEL FLAG SET M0900301 LDA MIBUF SET BUFFER ADDRESS IN CASE M0900302 STA* READLU+2 MONITOR IS IN UPPER BANK M0900303 RTJ- ($F4) READ JP STATEMENT M0900304REDPAR NUM $800,0 M0900305RDTHD ADC 0 M0900306READLU ADC 0,L+1,(MIBUF) M0900307RD2 LDA* RDTHD CHECK FOR COMPLETION OF I/O M0900308 SAZ RD1 M0900309 JMP* RD2 M0900310ÐÐRD1 LDA* READLU CHECK FOR I/O ERROR M0900311 SAP RD3 IF A READ ERROR, M0900312 ALS 4 **MSOS 4.0M0900313 SAM RD1A TTY ERROR **MSOS 4.0M0900314 ENQ 0 **MSOS 4.0M0900315 LLS 12 **MSOS 4.0M0900316 LDQ LOG1A,Q PSYTAB OF INPUT DEVICE **MSOS 4.0M0900317 LDA- 12,Q LOOK FOR EOF **MSOS 4.0M0900318 ALS 4 **MSOS 4.0M0900319 SAP RD1A **MSOS 4.0M0900320 JMP TERMA EOF--TERMINATE JOB **MSOS 4.0M0900321RD1A JMP RESTR RESTORE INPUT ON FAILURE **MSOS 4.0M0900322 SPC 2 *601 M0900323SM1A ADC (MIBUF) ABS ADDR. OF INPUT BUFFER IN JOBENT M0900324 SPC 1 M0900325RD3 LDQ MIBUF **MSOS 4.0M0900326 EQU STABUF(*-1) **MSOS 4.0M0900327 JMP* SSI TRANSFER MIINP BUFFER M0900328SMCKS ENQ L-1 M0900329 LDA* (STABUF) ADDR. OF INPUT BUFFER IN JOBENT **MSOS 4.0M0900330 STA* SMCKS2+1 **MSOS 4.0M0900331 STA* SMCKS3+1 **MSOS 4.0M0900332SMCKS1 LDA* SM1,Q GET WORD FROM STATEMENT BUFFER M0900333 EOR- HFFFF IS WORD $FFFF M0900334 SAZ BCKGND YES, STORE INTO BUFFERS M0900335ÐÐ LDA* SM1,Q NO M0900336 EOR =N$20FF IS WORD $20FF M0900337 SAZ BCKGND YES, FILL ENTIRE WORD WITH $FFFF M0900338 LDA* SM1,Q NO M0900339 EOR =N$2020 IS WORD $2020 M0900340 SAN SMX NO, MUST HAVE A VALID CHARACTER M0900341BCKGND LDA- HFFFF YES, FILL ENTIRE WORD WITH $FFFF M0900342 STA* SM1,Q IN LOCAL BUFFER M0900343SMCKS2 STA+ 0,Q AND IN JOBENT BUFFER M0900344 INQ -1 M0900345 SQZ SMX M0900346 JMP* SMCKS1 LOOP M0900347SMX LDA* SM1,Q IS LOWER CHARACTER A SPACE ($20) M0900348 AND- HFF M0900349 EOR- $28 ($0020) M0900350 SAZ SMX1 YES, BACKGROUND LOWER CHARACTER M0900351 LDA* SM1,Q NO, ENTIRE WORD IS VALID TO PROCESS M0900352 JMP* SMCKS3 M0900353SMX1 LDA* SM1,Q PUT $FF INTO LOWER CHARACTER M0900354 AND- $1A ($FF00) M0900355 EOR- HFF M0900356SMX1A STA* SM1,Q M0900357SMCKS3 STA+ 0,Q M0900358SMY LDA* COMSW M0900359 SAZ JJOBP4-*-1 M0900360ÐÐ LDQ* SM1+1 **MSOS 4.0M0900361 LDA* SM1+2 **MSOS 4.0M0900362 LRS 8 **MSOS 4.0M0900363 SUB* B DON'T COPY A JOB CARD **MSOS 4.0M0900364 SAZ JJOBP4 JCRDV4 WILL DO IT **MSOS 4.0M0900365 RTJ- ($F4) M0900366SMWRIT ADC $D00,0,0,$18FB,L COPY SM BUFFER TO LIST OUTPUT M0900367 ADC SM1-SMWRIT M0900368SMW1 LDA* SMWRIT+2 M0900369 SAZ JJOBP4 M0900370 JMP* SMW1 M0900371JJOBP4 RTJ* JBKILL CHECK FOR JOB CANCEL FLAG SET M0900372 JMP JOBP4 M0900373COMSW NUM 0 M0900374WRITO ALF 1,J M0900375 NUM $0DFF M0900376 SPC 1 M0900377B ALF 1,B, **MSOS 4.0M0900378 EJT M0900379* THIS SUBROUTINE CHECKS FOR JOB CANCEL FLAG SET AND, IF CLEAR, SETS M0900380* MIB FLAG FOR JOB LOCKOUT. M0900381 SPC 2 M0900382JBKMIB ADC 0 M0900383 RTJ* JBKILL CHECK FOR JOB CANCEL FLAG SET M0900384 RAO MIB NOT SET SET MIB SWITCH **MSOS 4.0M0900385ÐÐ EQU MIBFLG(*-1) **MSOS 4.0M0900386 JMP* (JBKMIB) RETURN TO SENDER M0900387* THIS SUBROUTINE CHECKS THE JOB CANCEL FLAG. IF SET, IT EXITS TO M0900388* THE DISP. TO WAIT FOR JOBKILL M0900389 SPC 2 M0900390JBKILL ADC 0 M0900391 LDA JBCNFG CHECK FOR JOB KILL MODULE ACTIVE M0900392 SAZ RETURN M0900393 JMP- ($EA) M0900394RETURN JMP* (JBKILL) NOT ACTIVE- RETURN WITH INHIBITED INTERRUPTS M0900395 SPC 1 M0900396 SPC 1 M0900397* THIS ROUTINE SAVES THE JOB PROCESSOR STATEMENT M0900398* DEFINE BY LOCATION SPECIFIED IN Q REGISTER. M0900399 SPC 1 M0900400 EQU L(36) **MSOS 4.0M0900401SSI RTJ* SSI1 MOVE STATEMENT TO INTERNAL BUFFER M0900402 BSS SM1(L) STATEMENT BUFFER M0900403 NUM $FFFF M0900404SSI1 0 0 ABS LOCATION OF SM1 BUFFER M0900405 LDA* SSI1 M0900406 STA- I I POINTS TO BEGINNING OF INPUT BUFFER M0900407 STQ* BUFPTR SET BUFPTR TO POINT TO SOURCE BUFFER M0900408 STQ INPBUF M0900409 ENQ L-1 M0900410ÐÐLOP1 LDA* (BUFPTR),Q PICK-UP FROM USERS M0900411 STA- (I),Q INTO LOCAL M0900412 SQZ OUT1 IF Q ZERO - DONE M0900413 INQ -1 M0900414 JMP* LOP1 NEXT WORD M0900415OUT1 STQ* (MIBFLG) CLEAR MIB SWITCH **MSOS 4.0M0900416 JMP* SMCKS GET LOCAL BUFFER AND BUFFER IN JOBENT M0900417* BACKGROUNDED M0900418BUFPTR ADC 0 POINTER TO USERS BUFFER M0900419 EJT M0900420*********************************************************** M0900421* THIS AREA IS ENTERED AFTER TERM LOGIC HAS CALLED FILE **MSOS 4.0M0900422* MODULE TO CLOSE JOB FILES FOR ABNORMAL TERM. **MSOS 4.0M0900423****************************************************************MSOS 4.0M0900424CLSDON LDA TRANTA+10 ERROR CODE **MSOS 4.0M0900425 SAP J MINUS FOR *T RESPONSE TO M0900426 LDA NAME+2 LOADER ERROR M0900427J LDQ ERRMSG PICK UP ADDRESS OF ERRM IN JOBENT M0900428 STQ* JSTART STORE IN WRITE REQ. M0900429 STA- ($23),Q STORE CORRECT ERROR NO. IN SM IN JOBENT M0900430 INQ L+3 Q POINTS TO MIPBUF+1 IN JOBENT **MSOS 4.0M0900431* MIPBUF IN JOBENT M0900432 STQ- I M0900433 ENQ -L-3 **MSOS 4.0M0900434J1 LDA- (ZERO),B CHECK FOR A NULL CHARACTER **MSOS 4.0M0900435ÐÐ TCA A M0900436 SAZ J2A **MSOS 4.0M0900437 RAO* JN **MSOS 4.0M0900438 INQ 1 **MSOS 4.0M0900439 SQZ J2A **MSOS 4.0M0900440 JMP* J1 M0900441 SPC 1 M0900442J2A RTJ* WRERR WRITE ERROR MESSAGE M0900443 JMP* ERRAG M0900444WRERR NOP 0 M0900445 RTJ- ($F4) M0900446 NUM $C00,$0,$0,$18FC M0900447JN NUM $0000 M0900448JSTART ADC 0 STARTING ADDRESS OF MIPBUF IN JOBENT M0900449 LDA* JN-2 WAIT FOR COMPLETION M0900450 SAZ 1 M0900451 JMP* *-2 M0900452 LDQ* JN-1 CHECK FOR ERROR ON WRITTING M0900453* 2 CARDS DELETED M0900454 JMP* (WRERR) M0900455ERRAG LDA =N$18FB M0900456 STA* JN-1 M0900457 LDA- $FC LU OF COMMENT DEVICE M0900458 SUB- $FB LU OF STD.PRINT DEVICE M0900459 SAZ GONXT1 IF.EQ.PRINT MESSAGE ONLY ONCE M0900460ÐÐ RTJ* WRERR M0900461GONXT1 RAO* JN-1 M0900462 ENA 0 **MSOS 4.0M0900463 STA* JN CLEAR WORD COUNT **MSOS 4.0M0900464 LDA* (IUPP) INPUT DEVICE **MSOS 4.0M0900465 STA* MLU **MSOS 4.0M0900466 RTJ- ($F4) GET THE NEXT JOB **MSOS 4.0M0900467 NUM $1C00,0 SKIP TO EOF ON INPUT UNIT **MSOS 4.0M0900468TH NUM 0 **MSOS 4.0M0900469MLU NUM 0 **MSOS 4.0M0900470 NUM $5000 **MSOS 4.0M0900471 LDA* TH **MSOS 4.0M0900472 SAZ 1 **MSOS 4.0M0900473 JMP* *-2 **MSOS 4.0M0900474 LDQ TRNVEC ADDRESS OF TRANTA TABLE IN JOBENT **MSOS 4.0M0900475 EQU TRATBL(*-1) **MSOS 4.0M0900476 LDA- 15,Q **MSOS 4.0M0900477 SAM ABOR NO JOB NAME **MSOS 4.0M0900478 STA* NAME **MSOS 4.0M0900479 LDA- 16,Q **MSOS 4.0M0900480 STA* NAME+1 **MSOS 4.0M0900481 LDA- 17,Q **MSOS 4.0M0900482 STA* NAME+2 **MSOS 4.0M0900483ABOR ENA -0 CLEAR JOB NAME **MSOS 4.0M0900484 STA- 15,Q CLEAR JOB NAME **MSOS 4.0M0900485ÐÐ RTJ* ABERR M0900486 JMP* TERM1+1 M0900487ABERR NOP 0 M0900488ABORT RTJ- ($F4) **MSOS 4.0M0900489 ADC $D00,TERM1-ABORT-1,0,$18FC,8 M0900490 ADC NAME-ABORT-1 **MSOS 4.0M0900491 JMP- (DISP) **MSOS 4.0M0900492TERM1 JMP* (ABERR) M0900493 LDA =N$18FB M0900494 STA* ABORT+4 M0900495 LDA- $FC LU OF COMMENT DEVICE M0900496 SUB- $FB LU OF STD.PRINT DEVICE M0900497 SAZ GONXT2 IF.EQ.PRINT LESSAGE ONLY ONCE M0900498 RTJ* ABERR M0900499GONXT2 RAO* ABORT+4 M0900500TERMA ENA 1 **MSOS 4.0M0900501 STA- $E4 **MSOS 4.0M0900502 LDA- $C1 M0900503 STA* SECT+1 M0900504 RTJ CLPTFL CLOSE ALL OPEN FILES M0900505 RTJ- ($F4) M0900506ABFC ADC $1303 SCHEDULE TO LEVEL 3 TO CLOSE FILE MGR FILES M0900507 ADC BFCLS-ABFC M0900508 JMP- (DISP) M0900509BFCLS RTJ BFCLOS FORCE FILES CLOSED M0900510ÐÐ RTJ- ($F4) M0900511BBFC ADC $1300 SCHEDULE BACK TO LEVEL 0 M0900512 ADC STRTM-BBFC M0900513 JMP- (DISP) M0900514STRTM RTJ- ($F4) WRITE *T ON SCRATCH UNIT M0900515 NUM $D00,0 M0900516THR NUM 0,$8C2,0 M0900517 ADC STRTEE-STRTM-1 M0900518SECT NUM 0,0 M0900519 LDA* THR M0900520 SAZ 1 M0900521 JMP* *-2 M0900522 ENA 0 **MSOS 4.0M0900523 LDQ* (TRATBL) **MSOS 4.0M0900524 STA- 12,Q CLEAR JOB IN PROGRESS FLAG **MSOS 4.0M0900525 STA TRANTA+12 **MSOS 4.0M0900526 STA JBCFGZ CLEAR JOB ABORT FLAG M0900527 STA TRANTA+9 CLEAR LOADER IN CORE FLAG M0900528 STA TRANTA+7 CLEAR BREAKPOINT SWITCH M0900529 STA VINPV4 CLEAR *V,LU WHEN THE JOB ABORTS M0900530* (CODE TO RESET PRINTER MODE FOR BATCH OUTPUT DELETED HERE.) M0900531 LDA+ BATCLU BATCH CONTROL STATEMENT LU 116*4366M0900532 STA* (IUPP) **MSOS 4.0M0900533RSET LDA RI **MSOS 4.0M0900534 SAZ GETMOR **MSOS 4.0M0900535ÐÐ SET Q **MSOS 4.0M0900536 ENA 0 **MSOS 4.0M0900537 STA RI **MSOS 4.0M0900538 LDA RECOV SCHEDULE RCOVER **MSOS 4.0M0900539 STA- I THRU JOBENT **MSOS 4.0M0900540 JMP- (I) **MSOS 4.0M0900541GETMOR JMP RF3 GET ANOTHER JOB **MSOS 4.0M0900542IUPP ADC IUP **MSOS 4.0M0900543RESTR LDA =N$18FD *390 M0900544 EQU COMDEV(*-1) **MSOS 4.0M0900545 STA* (IUPP) M0900546 JMP JOBP M0900547SAVIT ADC 0 M0900548NAME ALF 3, JOB **MSOS 4.0M0900549 ALF 5, ABORTED **MSOS 4.0M0900550STRTEE ALF 1,*T M0900551 END M0900552 NAM CLPTFL I09 A ITOS CCS 3.0 SL-149I0900001* I0900002* CREDIT COLLECTION SYSTEM VERSION 3.0 I0900003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA I0900004* COPYRIGHT CONTROL DATA CORPORATION 1978 I0900005* I0900006 ENT CLPTFL CLOSE ALL PSUDEO TAPE FILES I0900007 SPC 2 I0900008ÐÐ EQU X($100) RELATIVE PARAMTER REQUEST I0900009 EQU TPMOTN(14*512+X) TAPE MOTION REQUEST CODE I0900010 EQU MONI($F4) MSOS MONITOR I0900011 EQU DISP($EA) DISPATCHER I0900012 EQU ESTAT2(12) STATUS WORD IN PHYSTB I0900013 EQU READY($0001) CODE FOR READY STATUS I0900014 SPC 2 I0900015 EXT* IVPTTC INTEGER FUNCTION TO VERIFY PSUEDO TAPE TYPE I0900016 EXT LOG1A LOGICAL UNIT TABLE FOR MSOS I0900017 SPC 2 I0900018CLPTFL 0 0 CLOSE ALL PSUEDO TAPE FILES I0900019 STQ* QSAV I0900020 LDA- I I0900021 STA* ISAV I0900022 LDQ LOG1A # OF LU'S I0900023LOOP STQ* NLU SAVE IN TEMP I0900024 STQ* LU SAVE IN MOTION REQUEST I0900025 RTJ IVPTTC IF THIS IS A PSUEDO TAPE, THEN I0900026 ADC (LU-*) I0900027 SAN ISTAPE IF A.NE.0, IT IS A TAPE I0900028 JMP* NOTTAP I0900029ISTAPE EQU ISTAPE(*) I0900030* IF THE UNIT IS READY THEN CLOSE IT I0900031 LDQ LOG1A,Q PHYSTB ADDRESS I0900032 LDA- ESTAT2,Q I0900033ÐÐ AND =XREADY I0900034 SAZ NOTRDY I0900035* I0900036* CLOSE THE FILE VIA A UNLOAD MOTION REQUEST I0900037 RTJ- (MONI) I0900038REQ ADC TPMOTN,COMP-REQ,0 I0900039LU ADC 0 LOGICAL UNIT I0900040COMMD ADC $4000 UNLOAD COMMAND CODE I0900041 JMP- (DISP) I0900042NLU ADC 0 TEMP I0900043NOTTAP EQU NOTTAP(*) NOT A TAPE UNIT I0900044NOTRDY EQU NOTRDY(*) UNIT NOT READY I0900045COMP EQU COMP(*) COMPLETION OF MONITOR REQUEST I0900046* DECREMENT NLU AND REPEAT UNTIL NLU IS 0 I0900047 LDQ* NLU I0900048 INQ -1 I0900049 SQZ DONE I0900050 JMP* LOOP I0900051DONE EQU DONE(*) I0900052 LDA* ISAV I0900053 STA- I I0900054 LDQ* QSAV I0900055 JMP* (CLPTFL) RETURN I0900056QSAV ADC 0 I0900057ISAV ADC 0 I0900058ÐÐ END I0900059 NAM IVPTTC I10 A ITOS CCS 3.0 SL-149I1000001* I1000002* CREDIT COLLECTION SYSTEM VERSION 3.0 I1000003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA I1000004* COPYRIGHT CONTROL DATA CORPORATION 1978 I1000005* I1000006 ENT IVPTTC VERIFY PSUEDO TAPE TYPE CODE I1000007 SPC 2 I1000008 EQU ZERO($22) A ZERO I1000009 EQU EREQST(8) WORD 8 OF THE PHYSICAL DEVICE TABLE I1000010 SPC 2 I1000011 EXT LOG1A I1000012 SPC 2 I1000013* CALLING SEQUENCE IS: I1000014* I=IVPTTC(LU): WHERE LU IS THE LOGICAL UNIT NUMBER I1000015* I=1 IF LU IS A PSUEDO TAPE,ELSE I=0 I1000016 SPC 2 I1000017IVPTTC 0 0 VERIFY THE TYPE CODE TO BE PSUEDO TAPE I1000018 EXT* Q8PREP,Q8PKUP I1000019 RTJ Q8PREP I1000020 ADC (IVPTTC-*) I1000021 RTJ Q8PKUP I1000022 TRA Q I1000023* PICK UP THE LOGICAL UNIT NUMBER I1000024ÐÐ LDQ- (ZERO),Q I1000025* COMPARE EREQST 13=11 FOR 1, MAG TAPE TYPE I1000026* COMPARE EREQST 10=4 FOR 36, PSUEDO TAPE I1000027 LDA LOG1A,Q ADDRESS OF THE PHYSICAL DEVICE TABLE I1000028 STA- I I1000029 LDA- EREQST,I I1000030 AND =N$3FF0 I1000031 EOR =N$0A40 I1000032 SAZ ISTAPE I1000033 ENA 0 I1000034 JMP* EXIT 0=FALSE I1000035ISTAPE ENA 1 1= TRUE. IT IS A PSUEDO TAPE I1000036EXIT JMP* (IVPTTC) RETURN WITH RESULT VALUE IN A I1000037 END I1000038 NAM Q8PREP I11 A ITOS CCS 3.0 SL-149I1100001* I1100002* CREDIT COLLECTION SYSTEM VERSION 3.0 I1100003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA I1100004* COPYRIGHT CONTROL DATA CORPORATION 1978 I1100005* I1100006* NOTE: THIS ROUTINE WORKS FOR PART 0 ROUTINES ONLY I1100007 ENT Q8PREP,Q8PKUP I1100008Q8PREP 0 0 I1100009 LDA* (Q8PREP) I1100010 ADD* Q8PREP I1100011ÐÐ STA* ENTAD POINTS TO THE CALLER'S ENTRY POINT I1100012 RAO* Q8PREP I1100013 JMP* (Q8PREP) RETURN I1100014 SPC 2 I1100015Q8PKUP 0 0 PICK UP THE PARAMETERS ADDRESS IN A I1100016 LDA* (ENTAD) I1100017 STA* PARADD I1100018 LDA* (PARADD) 2ND LEVEL CALLER OF 1ST LEVEL I1100019 SAP ABS B15 NOT SET IMPLIES ABSOLUTE ADDRESS I1100020* PARAMETER ADDRESS = (P) MOD 15 BITS I1100021* B15 SET IMPLIES SELF-RELATIVE ADDRESS I1100022* PARAMETER ADDRESS = P+(P) MOD 15 BITS I1100023 ADD* PARADD I1100024 AND- LPMSK+15 I1100025ABS EQU ABS(*) I1100026 RAO* (ENTAD) BUMP SUBROUTINE'S ENTRY POINT I1100027 JMP* (Q8PKUP) I1100028ENTAD ADC 0 ENTRY POINT OF 1ST LEVEL CALLER I1100029PARADD ADC 0 PARAMETER ADDRESS OF 2ND LEVEL CALLER I1100030 EQU LPMSK(2) LOW CORE MASK AREA I1100031 END I1100032 NAM BFCLOS I12 A ITOS CCS 3.0 SL-149I1200001* FORCE FILE CLOSE SUBROUTINE I1200002* CREDIT COLLECTION SYSTEM VERSION 3.0 I1200003* DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA I1200004ÐÐ* COPYRIGHT CONTROL DATA CORPORATION 1979 I1200005* I1200006* THIS PROGRAM WILL EXECUTE A FORCED FILE CLOSE REQUEST TO I1200007* CLOSE ANY FILES THAT WERE LEFT OPEN BY A PREVIOUSLY EXECUTEDI1200008* BACKGROUND PROGRAM. I1200009* I1200010 EQU FMEIDX(30) FILE MANAGER'S INDEX INTO EXTENDED CORE TABLE I1200011 EQU ADRECT($E9) ADDRESS OF EXTENDED CORE TABLE I1200012 EQU HIGHP1($F6) HIGHEST UNPROTECTED+1 I1200013 EQU LOWM1($F7) LOWEST UNPROTECTED-1 I1200014 EQU AMONI($F4) ADDRESS OF REQUEST MONITOR ENTRY I1200015 EQU ZERO($22) SYSTEM ZERO I1200016* I1200017 ENT BFCLOS I1200018* I1200019BFCLOS NOP 0 ENTRY I1200020* I1200021 RTJ* HERE I1200022HERE NOP 0 I1200023 LDQ* HERE ABSOLUTIZE LOCATIONS I1200024 ENA REQBUF-HERE I1200025 AAQ A I1200026 STA* PLIST I1200027 INA -1 I1200028 STA* PLIST+1 I1200029ÐÐ ENA WORD5-HERE I1200030 AAQ A I1200031 STA* REQBUF+1 I1200032 ENA PLIST-HERE I1200033 AAQ A I1200034 STA* WORD5+2 I1200035 LDA- LOWM1 STORE BEGINNING AND ENDING ADDRESS OF I1200036 INA 1 BACKGROUND USER SPACE I1200037 STA* WORD16 I1200038 LDA- HIGHP1 I1200039 INA -1 I1200040 STA* WORD17 I1200041 ENA 0 I1200042 STA* REQBUF+3 I1200043 STA* REQBUF+13 I1200044 STA* REQBUF+14 I1200045* I1200046 LDA* PLIST SET I TO ADDRESS OF REQBUF I1200047 STA- I I1200048 ENQ FMEIDX SET FM'S INDEX INTO EXTENDED CORE TABLE I1200049 LDQ- (ADRECT),Q PICKUP ADDRESS OF EXEC I1200050 RTJ- (ZERO),Q EXECUTE IT I1200051* I1200052 JMP* (BFCLOS) I1200053 SPC 3 I1200054ÐÐ************************************************************************I1200055* I1200056* THE ORDER OF THE FOLLOWING 'NUM' AND 'ADC' CARDS MAY NOT I1200057* BE CHANGED I1200058* I1200059************************************************************************I1200060* PARAMETER LIST FOR FAKED FFCLOS CALL I1200061PLIST ADC REQBUF REQUEST I1200062 ADC ISTAT STATUS WORD ADDRESS I1200063* I1200064ISTAT NUM 0 STATUS WORD I1200065* I1200066* REQUEST BUFFER FOR FORCED FILE CLOSE I1200067REQBUF NUM 0 1. THREAD WORD I1200068 ADC WORD5 2. ABSOLUTE ADDRESS OF WORD5 I1200069 NUM 0 3. CONTROL POINT I1200070 NUM 0 4. REQUEST INDEX - 0 I1200071* I1200072WORD5 NUM 0 5. SAVED Q-REQ - NOT NEEDED I1200073 NUM 0 6. SAVED I-REG - NOT NEEDED I1200074 ADC PLIST 7. ADDRESS OF PARAMETER LIST I1200075 NUM 0,0,0,0,0,0 8-13 I1200076 NUM 0 14. VOLUME ID - 0 I1200077 NUM 0 15. USER ID - 0 I1200078WORD16 NUM 0 16. FWA OF USER'S I1200079ÐÐWORD17 NUM 0 17. LWA OF USER'S SPACE I1200080 NUM 0,0,0,0,0,0,0 18-24 I1200081 END I1200082 NAM JPFLV4 I13 A ITOS CCS 3.0 SL-149M8200001* MASS STORAGE OPERATING SYSTEM VERSION 5.0 M8200002* SMALL SYSTEMS DIVISION, LA JOLLA, CALIFORNIA M8200003* COPYRIGHT CONTROL DATA CORPORATION 1976 M8200004 SPC 2 M8200005* JOB PROCESSOR FILE REQUEST PROGRAM MODULE1 M8200006* 1700 MASS STORAGE OPERATING SYSTEM VERSION 5 W/ FILE MGR 2.0 M8200007* SMALL COMPUTER DEVELOPMENT DIVISION, LA JOLLA, CALIFORNIA M8200008* COPYRIGHT CONTROL DATA CORPORATION 1973 M8200009 SPC 2 M8200010** ** ** ** ** M8200011* M8200012* THIS MODULE IS ENTERED FROM THE JOB PROCESSOR FOR PROCESSING M8200013* A REQUEST REGARDING A JOB PROCESSOR FILE M8200014* M8200015* THIS MODULE VALIDATES THE GIVEN REQUEST FORMAT- M8200016* CORRECT REQUEST CODE AND CORRECT NUMBER OF CORRECTLY M8200017* FORMATTED PARAMETERS M8200018* FOR A CORRECT REQUEST THE PARAMETEERS ARE SAVED IN A M8200019* BUFFER JPFLBF IN THE JOBENT PROGRAM. AN EXIT IS NADE M8200020* TO THE JOB PROCESSOR WHICH IN TURN CALLS MODULE 2 -JPF2V4- TO M8200021* ACTUALLY EXECUTE THE REQUEST M8200022ÐÐ* M8200023* FOR AN INCORRECT REQUEST RETURN IS MADE TO THE JOB PROCESSOR M8200024* WITH THE APPROPRIATE ERROR CODE M8200025* M8200026 SPC 4 M8200027* M8200028****** EQUATE CARDS M8200029 EQU LPMASK($2) M8200030 EQU NZERO($12) M8200031 EQU ZERO($22) M8200032 EQU ONEBIT($23) M8200033 EQU TEN($46) TEN DECIMAL M8200034 EQU ADISP($EA) M8200035 EQU AMONI($F4) M8200036 EQU SCHEDL($1300) RELATIVE SCHEDULER CALL M8200037 EQU MONI($F4) MONITOR M8200038 EQU DISP($EA) DISPATCHER M8200039 SPC 4 M8200040* M8200041* FIRST WORD IS THE NUMBER OF PARAMETERS. M8200042 EQU V01(1) REQUEST CODE M8200043 EQU V02(2) ) M8200044 EQU V03(3) ) 1ST PARAMETER M8200045 EQU V04(4) ) M8200046* M8200047ÐÐ EQU V05(5) ) M8200048 EQU V06(6) ) 2ND PARAMETER M8200049 EQU V07(7) ) M8200050* M8200051 EQU V08(8) ) M8200052 EQU V09(9) ) THIRD PARAMETER M8200053 EQU V10(10) ) M8200054* M8200055 EQU V11(11) ) M8200056 EQU V12(12) ) 4TH PARAMETER M8200057 EQU V13(13) ) M8200058* M8200059 EQU V14(14) ) M8200060 EQU V15(15) ) 5TH PARAMETER M8200061 EQU V16(16) ) M8200062* M8200063 EQU V17(17) M8200064 EQU V18(18) M8200065 EQU V19(19) M8200066 EQU V20(20) M8200067 EQU V21(21) M8200068 EQU V22(22) TEMPORARY CHAR STORAGE M8200069 EQU V23(23) CHARACTER STORAGE ADDRESS M8200070 EQU V24(24) M8200071 EQU V25(25) TEMPORARY USAGE M8200072ÐÐ EQU V26(26) ADDRESS OF FLBUF2 M8200073 EQU V27(27) TOTAL NUMBER OF FILES CHECKED SO FAR M8200074* M8200075 SPC 4 M8200076*******ENTRY POINTS M8200077 ENT JPFL M8200078* M8200079 SPC 4 M8200080*******EXTERNAL POINTS M8200081 EXT* CLPTFL CLOSES ALL OPEN PSEUDO-TAPE FILES M8200082 EXT* OPNPT2 OPEN PSUEDO TAPE VERSION 2 PROCESSOR M8200083 EXT MIBUF SMI BUFFER ADDRESS M8200084 EXT PKEYV4 M8200085 EXT JBPROE ENTRY POINT TO JOBENT(TRNVEC) M8200086 EXT TRNVEC ABS.ADRS OF TRANTA BUFFER IN JOBENT M8200087 EXT MIB M8200088 EXT JBFLV4 NBR OF JP FILES IN SYSTEM M8200089 EXT LOG1A M8200090 EXT FILE3 M8200091 EXT PARBV4 LOC. WITH THE ADDRESS OF THE JOBENT BUFFER M8200092 EJT M8200093* M8200094JPFL NUM $C8FE M8200095 STA* (F3) M8200096* SAVE START ADDRESS OF JBFL PROGRAM M8200097ÐÐ STA* JBV01 M8200098* M8200099* SAVE THE CONTENTS OF REGISTER Q M8200100* M8200101 STQ* JBV03 M8200102* M8200103* SAVE INPUT REQUEST BUFFER ADDRESS M8200104 LDQ MIBUF M8200105* IN HERE M8200106 STQ* JBV02 M8200107* M8200108* COMPUTE THE OTHER ABSOLUTE ADDRESSES OF LOCATIONS M8200109* REFERRED TO IN THIS MODULE M8200110* M8200111 LDQ* FLBF1A REQUEST PARAMETER BUFFER ADDRESS M8200112 ADQ* JBV01 ADD BASE ADDRESS M8200113 STQ* FLBF1A M8200114 STQ- I M8200115 SPC 2 M8200116* M8200117* M8200118* CHECK WHETHER THE REQUEST IS TO CLOSE ALL THE FILES M8200119* OPENED SO FAR. M8200120* M8200121JBFL02 LDQ* JBV03 M8200122ÐÐ SQP JBFL05 NOT SUCH A REQUEST. SKIP M8200123 RTJ* TESTFM TEST FILE MANAGER PRESENT TEST M8200124 STQ- 1,I JUMP TO CLOSE ALL PREVIOUSLY OPENED FILES M8200125 JMP FL0190 M8200126* M8200127* EXIT TO CALLER. NO FILES TO BE CLOSED M8200128* M8200129JBFL05 INQ -7 M8200130 SQP NOFMTS REWIND OR UNLOAD M8200131 RTJ* TESTFM TEST FILE MANAGER PRESENT TEST M8200132NOFMTS JMP FL0001 EXIT TO PROCESSOR M8200133 SPC 2 M8200134TESTFM NUM 0 CHECK FOR FILE MANAGER PRESENT M8200135* DUMMY TEST M8200136 JMP* (TESTFM) FILES PRESENT, OK TO RETURN M8200137NOFM JMP FL0070 JP04, NO FILES, CANT OPERATE M8200138* M8200139 EJT M8200140* M8200141*******VARIABLES USED M8200142* M8200143F3 ADC FILE3 M8200144JBV01 ADC 0 START ADDRESS OF JBFL PROGRAM M8200145JBV02 ADC 0 INPUT REQUEST BUFFER ADDRESS M8200146JBV03 NUM 0 TEMPY STORAGE FOR Q PASSED BY CALLER M8200147ÐÐ* M8200148FLBF1A ADC FLBUF1-JPFL ADDRESS OF FLBUF1 M8200149* M8200150* THE BUFFER FLBUF1 IS USED TO SAVE THE PARAMETERS OF THE M8200151* GIVEN REQUEST.THE TEMPY STORAGE FOR SAVING INTERMEDIATE M8200152* INFORMATION IS THE LATTER PART OF THIS BUFFER M8200153* M8200154FLBUF1 BZS FLBUF1(28) M8200155 EJT M8200156* M8200157* REQUESTS AND THEIR CODES TABLE M8200158* M8200159FLT001 EQU FLT001(*) M8200160 ALF 3,OPEN M8200161 NUM 2 REQUEST CODE 2 FOR OPEN M8200162* M8200163 ALF 3,CLOSE M8200164 NUM 3 REQUEST CODE 3 FOR CLOSE M8200165* M8200166 ALF 3,REW M8200167 NUM 7 REQUEST CODE 7 FOR REWIND M8200168* M8200169 ALF 3,UNL M8200170 NUM 8 REQUEST CODE 8 FOR UNLOAD M8200171* M8200172ÐÐ NUM $FFFF END OF REQUEST CODE TABLE. M8200173* M8200174 SPC 4 M8200175* M8200176* ADDRESSES OF THE VAIDATION S/ROUTINES M8200177* M8200178FLT002 EQU FLT002(*) M8200179 ADC ERR,ERR 0,1 M8200180 ADC FL0150-JPFL +2 OPEN M8200181 ADC FL0160-JPFL +3 CLOSE M8200182 ADC ERR +4 M8200183 ADC ERR +5 M8200184 ADC ERR +6 M8200185 ADC FL0170-JPFL +7 REWIND M8200186 ADC FL0170-JPFL +8 UNLOAD M8200187* M8200188 EJT M8200189* M8200190 SPC 4 M8200191* M8200192* EXTRACT THE PARAMETERS OF THE REQUEST AND SAVE THEM M8200193* IN BUFFER FLBUF1 M8200194* THE REQUEST CODE WILL ALSO BE SAVED IN FLBUF1. M8200195* M8200196FL0001 LDA* FLBF1A M8200197ÐÐ STA- I M8200198 ENA 1 M8200199 RTJ FLS01 COLLECT THE CODE CHARACTERS M8200200 JMP* FL0007 INVALID CHARACTER JUMP M8200201* M8200202* COME HERE FOR THE COMMA OR END OF REQUEST DELIMITER M8200203* M8200204* VALIDATE THE REQUEST CODE. M8200205* AFTER THE REQUEST CODE IS SAVED IN V19,V20,AND V21 VALIDATE. M8200206* THE CODE. M8200207* THE VALID CODES ARE IN FLT001 TABLE. M8200208* M8200209FL0002 ENQ 0 M8200210FL0003 LDA* FLT001,Q ADDRESS OF FLT001 M8200211 SAM FL0007 END OF TABLE SKIP M8200212 EOR- V19,I M8200213 SAZ FL0005 FIRST TWO CHARS MATCH.SKIP M8200214 INQ 4 GET NEXT TABLE ADDRESS. M8200215 JMP* FL0003 M8200216* M8200217FL0005 INQ 1 M8200218 LDA* FLT001,Q CHECK NEXT TWO CHARACTERS M8200219 EOR- V20,I M8200220 SAN FL007D SKIP IF NO MATCH OF 3RD AND 4TH CHARS M8200221 INQ 1 M8200222ÐÐ LDA* FLT001,Q CHECK NEXT TWO CHARACTERS M8200223 EOR- V21,I M8200224 SAZ FL0008 MATCH FOUND.SKIP M8200225* M8200226 JMP* FL007E JUMP IF NO MATCH OF 5TH AND 6TH CHARS M8200227* SET UP TO CALL A PROGRAM WITH THE GINEN NAME M8200228* M8200229FL0007 LDA JBPROE GET RETURN M8200230 STA* FL007A+1 TO JOBENT M8200231 ENQ 0 RESET THE LOCKOUT FLAG M8200232 STQ* (FL007B) M8200233 LDQ- ONEBIT+15 SET Q NEGATUVE M8200234 ENA 2 INDEX TO SCHDULE JPLOAD M8200235FL007A JMP+ 0 M8200236* M8200237FL007D INQ 1 SET UP TO GET NEXT CODE ENTRY M8200238FL007E INQ 2 SET UP TO GET NEXT CODE ENTRY M8200239 JMP* FL0003 PROCESS NEXT ENTRY M8200240* M8200241FL007B ADC MIB M8200242* M8200243* SAVE THE REQUEST CODE IN THE PARAMETER BUFFER M8200244* M8200245FL0008 INQ 1 M8200246 LDA* FLT001,Q M8200247ÐÐ STA- 1,I REQUEST CODE M8200248* M8200249* M8200250* IF NO PARAMETERS ARE REQUIRED, GO TO PARAMETER VALIDATION PHASE M8200251* M8200252 TRA Q M8200253 LDA FL0080,Q NEGATIVE MEANS NONE REQUIRED M8200254 SAP FL0010 M8200255 JMP FL0100 M8200256* M8200257* CHECK ANY MORE PARAMETERS FOR THE REQUEST. M8200258* M8200259FL0010 LDA- V22,I CHARACTER GOT LAST M8200260 INA -$2C CHECK IT TO BE A COMMA M8200261 SAZ FL0012 SKIP IF A COMMA M8200262 JMP* FL0050 OTHERWSIE JUMP TO PROCESS REQUEST. M8200263* M8200264* FOR A COMMA CHECK WHETHER FIVE(MAX NBR FOR A REQUEST) M8200265* ALREADY SAVED. IF YES,REJECT. J04 M8200266* M8200267FL0012 LDA- (ZERO),I M8200268 INA -5 M8200269 SAM FL0014 OK LESS THAN 5 M8200270 JMP* FL0070 REJECT. J04. INVALID PARAMETER M8200271* M8200272ÐÐ* SET UP TO GET THE PARAMETERS OF THE REQUEST,IF ANY M8200273* M8200274FL0014 RAO- V17,I UPDATE CHARACTER INDEX M8200275 LDA- V17,I M8200276 RTJ FLS01 COLLECT PARAMETER M8200277 JMP* FL0070 REJECT. J04. INVALID PARAMETER M8200278* M8200279* SAVE THE PARAMETER IN THE REQUEST PARAMETER BUFFER M8200280* COMPUTE STORAGE ADDRESS 3*PARAM NBR + 2 M8200281* M8200282FL0020 LDA- (ZERO),I PARAMETER NUMBER M8200283 RTJ FLS02 M8200284* M8200285 LDA- V19,I SAVE THE 6 CHARACTERS OF THE PARAMETER. M8200286 STA- (ZERO),Q M8200287 LDA- V20,I M8200288 STA- 1,Q M8200289 LDA- V21,I M8200290 STA- 2,Q M8200291* M8200292 RAO- (ZERO),I UPDATE NUMBER OF PARAMETERS SAVED M8200293* M8200294* AND BRANCH TO GET THE NEXT PARAMETER IF ANY M8200295* M8200296 JMP* FL0010 M8200297ÐÐ SPC 4 M8200298* M8200299* AFTER ALL THE PARAMETERS OF A REQUEST HAVE BEEN COLLECTED M8200300* CHECK CORRECT NUMBER OF PARAMETERS HAVE BEEN OBTAINED. M8200301* M8200302FL0050 LDQ- 1,I REQUEST CODE M8200303 LDA* FL0080,Q ANY PARAMETERS REQUIRED ON THIS REQ. M8200304 SAN CKPRM YES, CHECK NUMBER ENTERED M8200305 JMP* FL0060 NO, CONTINUE WITHOUT CHECK M8200306CKPRM LDA- (ZERO),I YES, WERE ANY ENTERED M8200307 SAN CKNUM YES, VALIDATE NUMBER ENTERED M8200308 JMP* FL0070 NO, FLAG AS ILLEGAL PARAMETER M8200309CKNUM SUB* FL0080,Q TEST IF NUMBER OF PARMS. IS CORRECT M8200310 SAZ FL0060 VALID, EXACTLY MAXIMUM NUMBER M8200311 SAP FL0070 TOO MANY, REJECT AS ILLEGAL PARAM. M8200312* M8200313FL0060 JMP* FL0100 JUMP TO VALIDATE THE PARAMETERS. M8200314* M8200315ERROR4 EQU ERROR4(*) M8200316 EQU ERR(ERROR4-JPFL) RELATIVE LABEL FOR ERROR4 M8200317FL0070 LDA =A04 ILLEGAL PARAMETER. ERROR. J04 M8200318* M8200319FL0072 ENQ 6 M8200320* M8200321FL0075 STQ* FL0079 SAVE Q TEMPORARLIY M8200322ÐÐ LDQ TRNVEC GET TRANTA+10 M8200323 INQ 10 M8200324 STA- (ZERO),Q AND SAVE THE ERROR CODE M8200325* M8200326 LDQ* FL0079 GET Q CONTENTS M8200327* M8200328FL0076 LDA JBPROE GET RETURN M8200329 STA* FL007A+1 TO JOBENT M8200330* M8200331 ENA 0 M8200332 STA* (FL007B) M8200333 ENA 1 INDEX TO SCHEDULE JOBPRO M8200334 JMP* FL007A M8200335* M8200336FL0079 NUM 0 TEMPORARRY Q STORAGE M8200337* M8200338* M8200339 SPC 4 M8200340* M8200341* NUMBER OF VALID PARAMETERS FOR REQUESTS M8200342* M8200343FL0080 NUM 0 +0 M8200344 NUM 0 +1 M8200345 NUM -1 +2 OPEN M8200346 NUM -1 +3 CLOSE M8200347ÐÐ NUM 0 +4 M8200348 NUM 0 +5 M8200349 NUM 0 +6 M8200350 NUM 5 +7 REWIND M8200351 NUM 5 +8 UNLOAD M8200352* M8200353 SPC 4 M8200354* M8200355* PICK UP THE PARAMETER VALIDATION ROUTINE M8200356* M8200357FL0100 LDQ- 1,I REQUEST CODE M8200358* M8200359 LDQ FLT002,Q REQUEST CODE=INDEX TO TABLE M8200360 ADQ JBV01 M8200361 JMP- (ZERO),Q M8200362* M8200363 SPC 4 M8200364* M8200365 EJT M8200366* M8200367* *OPEN,FN=FILENAME,VL=VOLUME NAME,OW=OWNER NAME,M,LU=XX '...' M8200368* WHERE M=R FOR READ, W FOR WRITE OR A FOR APPEND M8200369* AND LU=XX SPECIFIES THE LOGICAL UNIT NUMBER. '...' IS A COMMENT M8200370* M8200371* M8200372ÐÐFL0150 EQU FL0150(*) M8200373* M8200374* SCHEDULE UP TO LEVEL 3 TO CALL FILE MANAGER 2 M8200375* M8200376 RTJ- (MONI) M8200377FL0151 ADC SCHEDL+3,FL0152-FL0151 M8200378 JMP- (DISP) M8200379FL0152 EQU FL0152(*) M8200380 LDA JBV02 ADDRESS OF JOBENT BUFFER M8200381 INA 3 M8200382 STA* AIBUF M8200383 RTJ OPNPT2 CALL OPNPT2(AIBUF,IERR) M8200384AIBUF ADC 0 M8200385 ADC (IERR-*) M8200386* M8200387* SCHEDULE BACK DOWN TO LEVEL 0 TO CONTINUE JOB PROCESSOR M8200388 RTJ- (MONI) M8200389FL0153 ADC SCHEDL+0,FL0154-FL0153 M8200390 JMP- (DISP) M8200391FL0154 EQU FL0154(*) M8200392 LDA* IERR M8200393 SAZ NOERR IF IERR IS NON-ZERO, THEN GO TO JPXX OUTPUT M8200394 JMP FL0072 PRINT JPXX, STATEMENT M8200395IERR ADC 0 ERROR RESULT RETURNED M8200396* M8200397ÐÐNOERR EQU NOERR(*) M8200398 LDA JBPROE M8200399 STA* EXIT RETURN TO JOB PROCESSOR M8200400 ENA 0 M8200401 STA MIB CLEAR MANUAL INTERRUPT BUSY FLAG M8200402 ENA 1 A=1,Q=14 FOR RETURN W/O ERROR M8200403 ENQ 14 M8200404 JMP* (EXIT) M8200405EXIT ADC 0 M8200406 EJT M8200407* CLOSE - EITHER *CLOSE OR *CLOSE, M8200408* *CLOSE CLOSES ALL OPENED FILES. M8200409* *CLOSE, CLOSES ONLY THOSE FILES THAT ARE SPECIFIED. M8200410* M8200411FL0160 EQU FL0160(*) M8200412* IF THERE WERE NO PARAMETERS ENTERED THEN M8200413 LDA- (ZERO),I M8200414 SAN FL0170 M8200415* CLOSE ALL OPEN FILES M8200416 RTJ CLPTFL M8200417* RETURN TO THE JOB PROCESSOR M8200418 JMP* NOERR M8200419* ELSE M8200420* CLOSE ONLY THE SELECTED FILES (UNLOAD) M8200421* ENDIF M8200422ÐÐ EJT M8200423 SPC 4 M8200424* M8200425* COME HERE TO VALIDATE THE REWIND AND THE UNLOAD REQUEST M8200426* M8200427* THE MAXIMUM NUMBER OF PARAMETERS IS 5. M8200428* M8200429* THE PARAMETER CAN BE ONE OR TWO DIGIT NUMBER( 0-9,00-99) M8200430* M8200431FL0170 ENA 0 SAVE CURRENT PARAMETER NUMBER M8200432 STA* FLV171 M8200433* M8200434FL0171 LDA* FLV171 M8200435* M8200436* M8200437* CHECK ALL PARAMETERS CHECKED M8200438* M8200439 SUB- (ZERO),I M8200440 SAM FL0172 SKIP IF ALL NOT CHECKED M8200441* M8200442* SAVE THE NBR OF PARAMETERS IN V16 FOR LATER USE ( IN JPF2V4) M8200443 LDA- (ZERO),I M8200444 STA- V16,I M8200445 JMP* FL0190 OTHERWISE EXIT M8200446* M8200447ÐÐFL0172 LDA* FLV171 GET THE PARAMETER ADDRESS M8200448 RTJ FLS02 M8200449* M8200450* CHECK IT TO BE ONE OR TWO DIGIT NUMBER M8200451* M8200452 RTJ FLS13 M8200453* M8200454* M8200455* COME HERE TO PROCESS THE NEXT PARAMETER M8200456* M8200457 RAO* FLV171 M8200458 JMP* FL0171 M8200459* M8200460FLV171 NUM 0 TEMPORARY STORAGE M8200461* M8200462* M8200463 EJT M8200464* M8200465* AFTER COMPLETING THE VALIDATION OF A REQUEST ALL THE M8200466* VALIDATED PARAMETERS AND THE REQUEST CODE WILL BE M8200467* MOVED TO THE JOBENT BUFFER- JPFLBF- FOR USE BY THE M8200468* MODULE 2(JPF2V4) FOR TAKING THE APPROPRIATE ACTION M8200469* AS PER THE REQUEST CODE M8200470* M8200471FL0190 ENA 15 TOTAL NBR OF WORDS(MAX 16) M8200472ÐÐ RAO- I UPDATE INDEX TO FLBUF1 BUFFER M8200473* M8200474 LDQ PARBV4 GET ADDRESS OF JOBENT BUFFER M8200475FL0192 STA* FL0197 SAVE CURRENT WORD INDEX M8200476* M8200477 LDA* (FL0197),I CURRENT WORD M8200478* M8200479 STA* (FL0197),Q SAVE WORD M8200480* M8200481 LDA* FL0197 CHECK ALL WORDS NOVED M8200482 INA -1 M8200483 SAM FL0195 SKIP IF ALL MOVED M8200484* M8200485 JMP* FL0192 OTHERWISE LOOP M8200486* M8200487FL0195 CLR A CLEAR THE MIB SWITCH M8200488 STA* (FL0198) M8200489 ENQ 5 M8200490 LDA JBPROE M8200491 STA* FL0196+1 M8200492 ENA 1 M8200493* M8200494FL0196 JMP+ 0 M8200495* M8200496FL0197 NUM 0 TEMP STORAGE M8200497ÐÐFL0198 ADC MIB M8200498* M8200499 EJT M8200500* M8200501* M8200502* COMMON SUBROUTINE TO COLLECT THE CHARACTERS OF A PARAMETER M8200503* M8200504* FOR A VALID PARAMETER M8200505* .IT MUST BE ONE THRU SIX ALPHANUMERIC CHARS M8200506* .THE DELIMITER MUST BE A COMMA,OR $FF. M8200507* M8200508* INPUT M8200509* (A)= CHAR POSITION IN THE BUFFER M8200510* UPPER CHAR (B8-15) OF BUFFER+0=CHAR POSITION 0 M8200511* LOWER CHAR (B0-7) OF BUFFER+0=CHAR POSITION 1 M8200512* UPPER CHAR (B8-15) OF BUFFER+1=CHAR POSITION 2 M8200513* AND SO ON. M8200514* M8200515* OUTPUT M8200516* V17=UPDATED TO REFLECT NEXT CHAR POSITION IN BUFFER M8200517* V18=NUMBER OF CHARACTERS IN THE PARAMETERS M8200518* V19=FIRST TWO CHARACTERS M8200519* V20=NEXT TWO CHARACTERS M8200520* V21=LAST TWO CHARACTERS M8200521* V22=DELIMITER CHARACTER (COMMA OR $FF) M8200522ÐÐ* M8200523* EXIT M8200524* M8200525* RETURN+0 INVALID NOT AN ALPHANUMERIC M8200526* RETURN+1 COMMA OR END OF REQUEST DELIMITER M8200527* M8200528* CELLS USED V17,18,22,23,19,20,21 M8200529* M8200530FLS01 ADC 0 M8200531 STA- V17,I SAVE INPUT CHAR POSITION M8200532 ENA 0 M8200533 STA- V18,I CLEAR CHAR STORED COUNT M8200534* M8200535 LDQ- I INITIALIZE PARAMETER STORAGE ADDRESS M8200536 INQ 19 M8200537 STQ- V23,I M8200538* M8200539* BLANK OUT THE THREE WORD PARAMETER STORE AREA M8200540* M8200541 LDA =N$2020 M8200542 STA- (ZERO),Q M8200543 STA- 1,Q M8200544 STA- 2,Q M8200545* M8200546FLS010 LDQ JBV02 INPUT REQUEST BUFFER ADDRESS M8200547ÐÐ* M8200548 RTJ FLS11 GET THE CHARACTER M8200549* M8200550 STA- V22,I SAVE CHARACTER TEMPORARILY M8200551* M8200552 SAZ FLS011 SKIP IF END OF REQUEST M8200553* CHECK CHAR TO BE AN ALPHAMERIC, $FF, OR COMMA. M8200554* M8200555 EOR- LPMASK+8 M8200556 SAN FLS013 NOT A BLANK SKIP M8200557FLS011 JMP* FLS01D END OF REQUEST ($FF OR 0) M8200558* M8200559FLS013 LDA- V22,I M8200560 INA -$2C M8200561 SAN FLS014 NOT A COMMA.SKIP M8200562 JMP* FLS01D COMMA.JUMP M8200563FLS014 LDA- V22,I CHECK CHAR TO BE AN ALPHANUMERIC M8200564 INA -$30 M8200565 SAM FLS015 INVALID CHARACTER. SKIP M8200566 INA -10 M8200567 SAM FLS016 VALID NUM CHAR 0-9 M8200568 LDA- V22,I M8200569 INA -$41 M8200570 SAM FLS015 INVALID CHAR M8200571 INA -$1A M8200572ÐÐ SAM FLS016 VALID ALPHA CHAR M8200573* M8200574FLS015 JMP* FLS01F M8200575* M8200576* FOR A VALID CHAR CHECK NBR OF CHARS ALREADY SAVED. 6 INVALID M8200577* M8200578FLS016 LDA- V18,I M8200579 INA -6 M8200580 SAM FLS017 M8200581 JMP* FLS01F INVALID IF 6 CHARS ALREADY SAVED M8200582* M8200583* SAVE CHARACTER IN APPROPRIATE SLOT. M8200584* M8200585FLS017 RAO- V18,I UPDATE CHAR COUNT M8200586 LDQ- V23,I CHARACTER STORAGE ADDRESS M8200587 LDA- V18,I CURRENT CHARACTER COUNT M8200588 INA -3 COMPUTE PARAMETER STORAGE ADDRESS M8200589 SAM FLS01A M8200590 INQ 1 M8200591 INA -2 M8200592 SAM FLS01A M8200593 INQ 1 M8200594* M8200595FLS01A LDA- V18,I M8200596 ALS 15 M8200597ÐÐ* M8200598* (Q)= ADDRESS OF THE WORD FOR THE CHARACTER STORAGE M8200599* M8200600* CHECK CHARACTER TO BE STORED IN THE UPPER OR LOWER POSTION M8200601* M8200602* FOR CHARACTER COUNT=1,3,5 CHARACTER WILL BE IN UPPER POSTION M8200603* FOR CHARACTER COUNT= 2,4,6 CHARACTER WILL BE IN LOWER POSITION M8200604* M8200605 SAM FLS018 SKIP IF UPPER POSITION OF CHARACTER M8200606* M8200607* FOR THE LOWER POSITION OF CHARACTR M8200608* M8200609 LDA- (ZERO),Q M8200610 AND- NZERO+8 M8200611 JMP* FLS019 M8200612* M8200613* FOR THE UPPER CHARACTER M8200614* M8200615* M8200616FLS018 LDA- V22,I ADJUST CHARACTER FOR STORAGE M8200617 ALS 8 M8200618 STA- V22,I M8200619* M8200620 LDA- (ZERO),Q M8200621 AND- LPMASK+8 M8200622ÐÐ* M8200623FLS019 EOR- V22,I SAVE THE CHARACTER M8200624* M8200625 STA- (ZERO),Q M8200626* M8200627* SET UP TO GET NEXT CHAR M8200628* M8200629 RAO- V17,I M8200630 JMP* FLS010 M8200631* M8200632FLS01D LDA- V18,I REJECT IF NO CHAR STORED M8200633 SAZ FLS01F REJECT M8200634 RAO* FLS01 ERROR FREE EXIT M8200635* M8200636* M8200637FLS01F JMP* (FLS01) EXIT.NON ALPHANUM/COMMA M8200638* M8200639 EJT M8200640* M8200641* COMMON SUBROUTINE TO COMPUTE THE START ADDRESS M8200642* OF A PARAMETER IN THE PARAMETER BUFFER M8200643* M8200644* INPUT M8200645* (A) = PARAMETER NUMBER 0- 4 M8200646* M8200647ÐÐ* =(3*NUMBER+2)+I M8200648* M8200649* OUTPUT M8200650* (Q)= START ADDRESS OF THE PARAMETER M8200651* M8200652FLS02 ADC 0 M8200653 TRA Q M8200654 ALS 1 M8200655 AAQ A M8200656 INA 2 M8200657 ADD- I M8200658 TRA Q M8200659* M8200660 JMP* (FLS02) EXIT M8200661* M8200662 EJT M8200663* M8200664* M8200665* M8200666* COMMON SUBROUTINE TO CONVERT AN ASCII WORD TO A BINARY VALUE M8200667* M8200668* INPUT M8200669* (A)= ASCII WORD EXAMPLE M8200670* 19(DEC)=3139(ASCII) M8200671* M8200672ÐÐ* OUTPUT M8200673* (A)= BINARY VALUE M8200674* EXAMPLE M8200675* (A)=ASCII WORD 3139 (DECIMAL 19) M8200676* (Q) (A) M8200677FLS10 ADC 0 Q A M8200678* M8200679 STQ* FLS101 SAVE REGISTER Q 3139 M8200680* M8200681* VALIDATE THE PARAMETER AS TWO NUMERALS (00-99) M8200682* M8200683 STA* FLS102 SAVE IT TEMPORARILY. M8200684* M8200685 AND =N$F0F0 M8200686 EOR =N$3030 M8200687 SAZ FLS104 NUMERIC. SKIP M8200688FLS103 JMP FL0070 JP04, INVALID PARAMETER M8200689* M8200690FLS104 LDA* FLS102 M8200691 TRA Q 3139 3139 M8200692 AND- LPMASK+4 3139 0009 M8200693 LLS 16 0009 3139 M8200694 ARS 8 0009 0031 M8200695 STQ* FLS102 M8200696 AND- LPMASK+4 0009 0001 M8200697ÐÐ TRA Q 0001 0001 M8200698 ALS 3 0001 0008 M8200699 AAQ A 0001 0009 M8200700 AAQ A 0001 000A M8200701 ADD* FLS102 0013 (HEX)M8200702* M8200703 LDQ* FLS101 RESTORE Q M8200704 JMP* (FLS10) EXIT. M8200705* M8200706FLS101 NUM 0 TEMPORARY STORAGE M8200707FLS102 NUM 0 TEMPY STORAGE M8200708* M8200709 EJT M8200710* M8200711* COMMON SUBROUTINE TO GET A CHAR(INDEX IN V17) FROM M8200712* A BUFFER (ADDRESS IN Q) M8200713* M8200714* INPUT M8200715* V17=CHARACTER INDEX M8200716* 0=UPPER CHAR(B8-15) OF WORD1 M8200717* 1=LOWER CHAR(B0-7) OF WORD1 M8200718* 2=UPPER CHAR(B8-15)OF WORD2, M8200719* AND SO ON. M8200720* M8200721* OUTPUT M8200722ÐÐ* A BITS 0-7= CHARACTER M8200723* M8200724FLS11 ADC 0 M8200725 LDA- V17,I CHARACTER INDEX M8200726 ARS 1 M8200727 AAQ Q Q=WORD ADDRESS M8200728 STQ* FLS11V M8200729* M8200730 LDA- V17,I CHECK UPPER OR LOWER CHARRACTER M8200731 AND- LPMASK+1 M8200732* M8200733 LDQ* (FLS11V) GET WORD M8200734 SAZ FLS11D SKIP IF UPPER CHARACTER (A=0) M8200735* M8200736 TRQ A M8200737 JMP* FLS11E M8200738* M8200739FLS11D TRQ A GET LOWER CHARACTER M8200740 ALS 8 M8200741* M8200742FLS11E AND- LPMASK+8 M8200743* M8200744 JMP* (FLS11) EXIT M8200745* M8200746FLS11V NUM 0 TEMP STORAGE M8200747ÐÐ EJT M8200748* M8200749* COMMON SUBROUTINE TO VALIDATE A PARAMETER AS A VALID LU. M8200750* NUMBER OF 1 OR 2 NUMERALS AND ALSI .LE. LEGAL LU NUMBER(ALOG1A) M8200751* M8200752* INPUT M8200753* (Q)=PARAMETER ADDRESS M8200754* M8200755FLS13 ADC 0 M8200756* M8200757* CHECK IR TO BE ONE OR TWO DIGIT NUMBER M8200758* M8200759 LDA- 1,Q M8200760 EOR =N$2020 M8200761 SAZ FLS132 M8200762FLS131 JMP* FLS103 OTHERWISE REJECT(J04) M8200763* M8200764FLS132 LDA- (ZERO),Q CONVERT THE NBR TO BINARY M8200765 AND- LPMASK+8 M8200766 INA -$20 M8200767 SAN FLS134 SKIP IF 2 CHARACTERS M8200768 LDA- (ZERO),Q M8200769 AND- NZERO+8 M8200770 INA $30 M8200771 ALS 8 M8200772ÐÐ JMP* FLS135 M8200773* M8200774FLS134 LDA- (ZERO),Q M8200775* M8200776FLS135 RTJ FLS10 M8200777* M8200778 STA- (ZERO),Q SAVE THE BINARY NUMBER M8200779* M8200780* VALIDATE THE NBR TO BE A VALID LEGAL LU M8200781* M8200782 SUB* (ALOG1A) M8200783 SAZ FLS136 EQ. OK M8200784 SAM FLS136 LT. OK M8200785* M8200786 JMP* FLS131 OTHERWISE REJECT M8200787* M8200788FLS136 LDA- V01,I REQUEST CODE M8200789 INA -7 M8200790 SAP FLS139 SKIP FOR THE REWIND AND UNLOAD REQUESTS M8200791 LDQ- (ZERO),Q FOR OTHERS CHECK LU REFERS A PSUEDO DRIVER M8200792* M8200793 LDQ* (ALOG1A),Q M8200794 LDA- 8,Q EQPT CODE M8200795 ARS 4 M8200796 AND- LPMASK+7 M8200797ÐÐ INA -36 M8200798 SAZ FLS139 SKIP IF A PSUEDO DRIVER M8200799 JMP* FLS131 OTHERWISE REJEXT M8200800* M8200801FLS139 JMP* (FLS13) EXIT M8200802* M8200803ALOG1A ADC LOG1A M8200804 END JPFL M8200805 NAM GETFLD I14 A ITOS CCS 3.0 SL-149 00001* GET NEXT INPUT FIELD 00002* CREDIT COLLECTION SYSTEM VERSION 3.0 00003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00004* COPYRIGHT CONTROL DATA CORPORATION 1979 00005* 00006**** 00007* 00008* FUNCTION 00009* 00010* THIS ROUTINE SEARCHES AN ASCII BUFFER AND RETURNS WITH THE 00011* FIELD CONTENTS IN AN OUTPUT BUFFER(SBUF) 00012* THE FIELDS ARE CONTROLLED BY DELIMETERS AND BLANKS ARE IGNORED 00013* 00014* GENERAL DESCRIPTION 00015* 00016* GETFLD SEARCHES THE ASCII INPUT BUFFER (IBUF),STARTING AT A 00017ÐÐ* SPECIFIED WORD LOCATION(SWORD) AND A SPECIFIED BYTE LOCATION 00018* WITHIN THE WORD (SCHAR) 00019* CHARACTERS ARE EXTRACTED FROM THE STRING AND STORED INTO THE 00020* OUTPUT BUFFER (SBUF) 00021* AT RETURN THE LOCATIONS SWORD AND SCHAR WILL BE UPDATED FOR 00022* THE NEXT CALL 00023* 00024* A STATUS WORD (STAT) WILL BE RETURNED,INDICATING THE TERMINATION 00025* OF THE SEARCH 00026* STAT = 0 SEARCH TERMINATED AT A COMMA 00027* 1 A SEMI-COLON 00028* 2 AN END-OF-LINE 00029* 3 AN EQUAL-SIGN 00030* 00031* BLANKS ARE IGNORED 00032* 00033* CALLING PROCEDURE 00034* 00035* CALL GETFLD(IBUF,SBUF,SWORD,SCHAR,STAT) 00036* 00037* IBUF = INPUT BUFFER (40 WORDS) 00038* SBUF = OUTPUT BUFFER (20 WORDS) 00039* SWORD= START WORD LOCATION INDEX (0-39) 00040* SCHAR= START BYTE LOCATION INDICATOR(0=UPPER,1=LOWER) 00041* STAT = STATUS TO BE RETURNED 00042ÐÐ* 00043* ENTRY POINT 00044* 00045 ENT GETFLD 00046* 00047* EXTERNALS 00048* 00049 EXT* Q8PREP,Q8PKUP 00050* 00051* EQUIVALENCES 00052* 00053 EQU ZERO($22) 00054 EQU ONEBIT($23) 00055 EQU LPMASK(2) 00056 EQU NZERO($12) 00057 EQU BLANK($20) 00058 EQU ETX($03) 00059 EQU EQUAL($3D) 00060 EQU COMMA($2C) 00061 EQU QUOTE($27) B 00062**** 00063 EJT 00064GETFLD NOP 00065 RTJ Q8PREP 00066 ADC* GETFLD 00067ÐÐ RTJ Q8PKUP 00068 STA* IBUF 00069 RTJ Q8PKUP 00070 STA* SBUF 00071 RTJ Q8PKUP 00072 STA* SWORD 00073 RTJ Q8PKUP 00074 STA* SCHAR 00075 RTJ Q8PKUP 00076 STA* STAT 00077* 00078* INITIALIZATION 00079* 00080 ENA 0 00081 STA* END CLEAR END FLAG 00082 STA* (STAT) STATUS 00083OKA ENQ 36 YES, SET LAST TO 72 120*4570 00084* 00085GF0 LDA* ETXCOD STORE ETX-CODE 00086 STA* (IBUF),Q 00087* 00088OKD ENQ 19 00089 LDA SPACES 00090GF1 STA* (SBUF),Q WITH SPACES 00091 SQZ GF2 00092ÐÐ INQ -1 00093 JMP* GF1 00094GF2 STQ* OWORD SET OUTPUT POINTER WORD LOCATION 00095 STQ* OCHAR BYTE INDICATOR 00096* 00097* GET NEXT CHARACTER FROM INPUT STRING 00098* 00099GF3 LDQ* (SWORD) GET NEXT INPUT WORD 00100 LDA* (IBUF),Q 00101 LDQ* (SCHAR) UPPER OR LOWER HALF 00102 SQN GF4 00103 ARS 8 UPPER HALF 00104GF4 AND- LPMASK+8 $00FF 00105 STA* TEMP SAVE TEMPORARELY 00106 TRA Q 00107* 00108* CHECK FOR SPECIAL CHARACTERS 00109* 00110 INA -BLANK IS IT A SPACE ? 00111 SAN GF5 NO 00112 JMP* NXTCHR YES,IGNORE 00113GF5 LDA* END FIELD TERMINATOR ALREADY DETECTED 00114 SAZ GF51 NO 00115 JMP* (GETFLD) YES,EXIT 00116GF51 TRQ A 00117ÐÐ INA -ETX IS IT END OF INPUT ? 00118 SAN GF61 NO 00119 JMP* GF11 YES,SET END STATUS AND EXIT 00120GF61 TRQ A CHECK FOR $FF (END OF INPUT) 00121 EOR- LPMASK+8 00122 SAN GF65 00123 JMP* GF11 $FF FOUND, EXIT WITH END OF INPUT STATUS. 00124GF65 TRQ A 00125 INA -EQUAL IS IT AN EQUAL-SIGN ? 00126 SAN GF7 NO 00127 ENA 3 YES,SET STATUS = 3 00128 STA* (STAT) 00129 RAO* END SET END 00130 JMP* NXTCHR CONTINUE TO NEXT NON-BLANK CHAR 00131GF7 TRQ A IS IT A COMMA 00132 INA -COMMA IS IT A COMMA ? 00133 SAN GF75 NO 00134 ENA 0 YES,STATUS=0 00135GF77 STA* (STAT) 00136 RAO* END 00137 JMP* NXTCHR 00138GF75 TRQ A 00139 INA -QUOTE IS IT A" SIGN (COMMENT FIELD)? B 00140 SAN GF8 NO 00141 ENA 1 YES,STATUS=1 00142ÐÐ JMP* GF115 00143* 00144* LOCAL VARIABLES 00145* 00146IBUF NUM 0 00147SBUF NUM 0 00148SWORD NUM 0 00149SCHAR NUM 0 00150STAT NUM 0 00151END NUM 0 00152OWORD NUM 0 00153OCHAR NUM 0 00154TEMP NUM 0 00155SPACES ALF 1, 00156ETXCOD NUM $0320 00157 EJT 00158* 00159* STORE CHARACTERS IN OUTPUT BUFFER 00160* 00161GF8 LDQ* OWORD 00162 LDA* (SBUF),Q 00163 LDQ* OCHAR UPPER OF LOWER BYTE TO STORE 00164 SQN GF9 LOWER 00165 AND- LPMASK+8 $00FF UPPER BYTE MUST BE STORED 00166 LDQ* TEMP 00167ÐÐ QLS 8 00168 EAQ A 00169 LDQ* OWORD 00170 STA* (SBUF),Q 00171 JMP* GF10 00172GF9 LDQ* OWORD STORE LOWER BYTE IN SBUF 00173 AND- NZERO+8 $FF00 00174 EOR* TEMP 00175 STA* (SBUF),Q 00176GF10 LDA* OCHAR 00177 EOR- ONEBIT 00178 STA* OCHAR 00179 SAN NXTCHR 00180 LDA* OWORD 00181 INA 1 00182 STA* OWORD 00183* 00184* END OF FIELD PROCESSING 00185* 00186NXTCHR LDA* (SWORD) LAST WORD OF INPUT BUFFER REACHED 00187 INA -35 120*4570 00188 SAN GF12 NO 00189 LDA* (SCHAR) YES,IS IT LAST CHAR 00190 SAZ GF12 NO 00191GF11 ENA 2 YES,SET STATUS =2 00192ÐÐGF115 STA* (STAT) 00193 JMP* (GETFLD) 00194GF12 LDA* (SCHAR) 00195 EOR- ONEBIT SWITCH CHARACTER 00196 STA* (SCHAR) 00197 SAN GF13 LOWER HALF OF SAME WORD 00198 LDA* (SWORD) UPPER HALF OF NXT WORD 00199 INA 1 00200 STA* (SWORD) 00201GF13 JMP* GF3 GET NEXT CHAR 00202 END 00203 NAM PTOPEN I15 A ITOS CCS 3.0 SL-149 00001* PSEUDO TAPE OPEN MODULE 00002* CREDIT COLLECTION SYSTEM VERSION 3.0 00003* DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00004* COPYRIGHT CONTROL DATA CORPORATION 1979 00005 ENT PTOPEN 00006* 00007* THIS MODULE MAKES A SPECIAL MOTION REQUEST TO THE PASSED LU. 00008* THE PURPOSE IS TO PERFORM A 'OPEN FILE' REQUEST TO A PSEUDO- 00009* TAPE LOGICAL UNIT UNDER FILE MANAGER 2. 00010* 00011* THE CALLING SEQUENCE IS: 00012* CALL PTOPEN(LU,OPNTYP,IERR) 00013* WHERE THE PARAMETERS ARE DEFINED AS FOLLOWS: 00014ÐÐ* LU - LOGICAL UNIT NUMBER 00015* OPNTYP - TYPE OF OPEN REQUIRED 00016* 1 - OPEN FOR READ ONLY 00017* 2 - OPEN FOR ADDITIONS AT END OF FILE 00018* 3 - OPEN FOR WRITES AT BEGIN. OF FILE 00019* IERR - ERROR FLAG RETURNED FROM THE DRIVER 00020* 00021 EXT* Q8PREP,Q8PKUP 00022* 00023PTOPEN ADC *-* 00024*** PCK UP ALL OF THE PARAMETER'S ADDRESSES 00025 RTJ Q8PREP 00026 ADC* PTOPEN 00027 RTJ Q8PKUP 00028 STA* ALU LOGICAL UNIT 00029 RTJ Q8PKUP 00030 STA* AREQBF REQUEST BUFFER 00031 RTJ Q8PKUP 00032 STA* AOPNTY OPEN REQUEST TYPE 00033 RTJ Q8PKUP 00034 STA* AISTAT STATUS AFTEER REQUEST IS MADE 00035* 00036*** MOVE THE LU NUMBER TO THE REQUEST 00037 LDA* (ALU) 00038 STA* LU 00039ÐÐ*** MOVE THE OPEN TYPE CODE 00040 LDA* (AOPNTY) 00041 ALS 8 00042 STA* MOTCOD 00043*** MAKE THE PSEUDO-MOTION REQUEST 00044 SJA* HERE 00045HERE ADD =XMOTREQ-HERE+1 00046 STA* PARADR 00047 RTJ- ($F4) 00048 ADC $2000 00049PARADR ADC *-* 00050*** WAIT UNTIL THE I/O IS DONE 00051IOLOOP LDA* THRD 00052 SAZ IODONE 00053 JMP* IOLOOP 00054IODONE EQU IODONE(*) 00055*** PASS THE V-FIELD BACK TO THE CALLER 00056 LDA* LU 00057 AND =N$E000 00058 STA* (AISTAT) 00059*** RETURN 00060 JMP* (PTOPEN) 00061 EJT 00062MOTREQ ADC $5C00,0 00063THRD ADC *-* 00064ÐÐLU ADC *-* 00065MOTCOD ADC *-* 00066AREQBF ADC *-* 00067* 00068ALU ADC *-* 00069AOPNTY ADC *-* 00070AISTAT ADC *-* 00071 END 00072 NAM JPF2V4 I16 A ITOS CCS 3.0 SL-149M8300001* JOB PROCESSOR FILE REQUEST PROGRAM MODULE 2 M8300002* MASS STORAGE OPERATING SYSTEM VERSION 5.0 M8300003* SMALL SYSTEMS DIVISION, LA JOLLA, CALIFORNIA M8300004* COPYRIGHT CONTROL DATA CORPORATION 1976 M8300005 SPC 2 M8300006* M8300007* THIS MODULE IS ENTERED FROM THE JOB PROCESSOR FOR M8300008* PROCESSING A REQUEST FOR A JOB FILE. M8300009* THE JOB PROCESSOR FILE M8300010* M8300011* THE REQUEST WAS ALREADY CHECKED FOR THE ACCURACY IF THE M8300012* VALIDATED REQUEST CODE AND THE NUMBER AND FORMAT M8300013* OF THE PARAMETERS OF A REQUEST M8300014* M8300015* THE REQUEST CODE AND THE PARAMETERS ARE SAVED IN M8300016* THE JOBENT BUFFER JPFLBF M8300017ÐÐ* M8300018* MODULE 2 TAKES THE APPROPRIATE ACTION ON THE REQUEST AS PER M8300019* MOVE THE REQUEST CODE AND THE PARAMETERS FROM THE JOBENT M8300020* THE REQUEST CODE M8300021* AFTER EXECUTION THE CONTROL IS RETURNED TO THE JOB PROCESSOR M8300022* M8300023* DIAGNOSTICS ARE TYPED IN CASE OF AN INVALID PARAMETER(S) M8300024* M8300025 SPC 4 M8300026* M8300027****** EQUATE CARDS M8300028 EQU LPMASK($2) M8300029 EQU NZERO($12) M8300030 EQU ZERO($22) M8300031 EQU ONEBIT($23) M8300032 EQU TEN($46) TEN DECIMAL M8300033 EQU ADISP($EA) M8300034 EQU AMONI($F4) M8300035 SPC 4 M8300036* M8300037* FIRST WORD IS THE NUMBER OF PARAMETERS. M8300038 EQU V01(1) REQUEST CODE M8300039 EQU V02(2) ) M8300040 EQU V03(3) ) 1ST PARAMETER M8300041 EQU V04(4) ) M8300042ÐÐ* M8300043 EQU V05(5) ) M8300044 EQU V06(6) ) 2ND PARAMETER M8300045 EQU V07(7) ) M8300046* M8300047 EQU V08(8) ) M8300048 EQU V09(9) ) THIRD PARAMETER M8300049 EQU V10(10) ) M8300050* M8300051 EQU V11(11) ) M8300052 EQU V12(12) ) 4TH PARAMETER M8300053 EQU V13(13) ) M8300054* M8300055 EQU V14(14) ) M8300056 EQU V15(15) ) 5TH PARAMETER M8300057 EQU V16(16) ) M8300058* M8300059 EQU V17(17) M8300060 EQU V18(18) M8300061 EQU V19(19) M8300062 EQU V20(20) M8300063 EQU V21(21) M8300064 EQU V22(22) TEMPORARY CHAR STORAGE M8300065 EQU V23(23) CHARACTER STORAGE ADDRESS M8300066 EQU V24(24) M8300067ÐÐ EQU V25(25) TEMPORARY USAGE M8300068 EQU V26(26) ADDRESS OF FLBUF2 M8300069 EQU V27(27) TOTAL NUMBER OF FILES CHECKED SO FAR M8300070* M8300071 SPC 4 M8300072*******ENTRY POINTS M8300073 ENT JPF2 M8300074* M8300075 SPC 4 M8300076*******EXTERNAL POINTS M8300077 EXT* CLPTFL CLOSES ALL OPEN PSEUDO TAPES M8300078 EXT MIBUF SMI BUFFER ADDRESS M8300079 EXT JBPROE ENTRY POINT TO JOBENT(TRNVEC) M8300080 EXT TRNVEC ABS.ADRS OF TRANTA BUFFER IN JOBENT M8300081 EXT MIB M8300082 EXT LOG1A M8300083 EXT FILE3 M8300084 EXT PARBV4 LOC. WITH THE ADDRESS OF THE JOBENT BUFFER M8300085 EXT FBASV4 FIRST FILE NBR USED BY JOB PROCESSOR M8300086 EXT JBFLV4 NBR OF JOB PROCESSOR FILES IN SYSTEM M8300087 EXT RELFIL FILE MANAGER RELEASE ROUTINE M8300088 EJT M8300089* M8300090 EQU JPF2(*) ENTRY POINT M8300091JPFL NUM $C8FE M8300092ÐÐ STA* (F3) M8300093* SAVE START ADDRESS OF JBFL PROGRAM M8300094 STA* JBV01 M8300095* M8300096* SAVE INPUT REQUEST BUFFER ADDRESS M8300097 LDQ MIBUF M8300098* IN HERE M8300099 STQ* JBV02 M8300100* M8300101* COMPUTE THE OTHER ABSOLUTE ADDRESSES OF LOCATIONS M8300102* REFERRED TO IN THIS MODULE M8300103* M8300104 LDQ* FLBF1A REQUEST PARAMETER BUFFER ADDRESS M8300105 AAQ Q M8300106 STQ* FLBF1A M8300107 STQ- I M8300108* M8300109 LDQ* FLBF2A FILE BLOCK BUFFER ADDRESS M8300110 AAQ Q M8300111 STQ* FLBF2A M8300112 STQ- V26,I M8300113* M8300114* M8300115* M8300116* MOVE THE REQUEST COSE AND THE PARAMETERS FROM THE JOBENT M8300117ÐÐ* BUFFER JBFLBF TO THE LOCAL BUFFER FLBUF1 M8300118* M8300119 ENA 15 INDEX=15 M8300120 RAO- I ADJUST I M8300121* M8300122 LDQ PARBV4 GET ADDRESS OF JOBENT BUFFER M8300123* M8300124JBFL02 STA* JBV04 SAVE CURRENT INDEX M8300125* M8300126 LDA* (JBV04),Q GET WORD M8300127 STA* (JBV04),I STORE WORD M8300128* M8300129 LDA* JBV04 CHECK IF ALL WORDS MOVED M8300130 INA -1 M8300131 SAM JBFL04 SKIP IF ALL MOVED M8300132 JMP* JBFL02 OTHERWISE LOOP M8300133* M8300134JBFL04 LDA- I RESTORE I M8300135 INA -1 M8300136 STA- I M8300137* M8300138* M8300139* M8300140 LDA- 1,I FOR REQUESTS OUT OF RANGE GO TO JP04 M8300141 INA -MAXRC MAXIMUM REQUEST CODE M8300142ÐÐ SAM JBFL05 OK IF LESS THAN MAXRC M8300143* M8300144 ENQ 4 M8300145 JMP FL0622 M8300146* M8300147* M8300148JBFL05 LDA- 1,I IF THE REQUEST CODE IS -0, THEN CLOSE ALL M8300149 SAP JBFL06 PSUEDO TAPE FILES. M8300150* M8300151 RTJ CLPTFL CLOSE ALL PSUEDO TAPE FILES ROUTINE M8300152 JMP FL0620 EXIT M8300153* M8300154JBFL06 EQU JBFL06(*) M8300155 LDQ- 1,I GET REQUEST CODE AND EXIT TO M8300156 LDQ FLT003,Q THE APPROPRIATE ROUTINE M8300157 ADQ JBV01 M8300158 JMP- (ZERO),Q M8300159* M8300160 EJT M8300161* M8300162*******VARIABLES USED M8300163* M8300164F3 ADC FILE3 M8300165JBV01 ADC 0 START ADDRESS OF JBFL PROGRAM M8300166JBV02 ADC 0 INPUT REQUEST BUFFER ADDRESS M8300167ÐÐJBV04 NUM 0 TEMP STORAGE M8300168* M8300169FLBF1A ADC FLBUF1-JPFL ADDRESS OF FLBUF1 M8300170FLBF2A ADC FLBUF2-JPFL ADDRESS OF FLBUF2 M8300171* M8300172* M8300173* THE BUFFER FLBUF1 IS USED TO SAVE THE PARAMETERS OF THE M8300174* GIVEN REQUEST.THE TEMPY STORAGE FOR SAVING INTERMEDIATE M8300175* INFORMATION IS THE LATTER PART OF THIS BUFFER M8300176* M8300177FLBUF1 BZS FLBUF1(28) M8300178* M8300179* THE BUFFER FLBUF2 IS USED TO READ THE FILE BLOCK AVAILABLE M8300180* ON ONE SECTOR OF THE MASS STORAGE FILE. M8300181* M8300182FLBUF2 BZS FLBUF2(96) M8300183* M8300184* M8300185 EJT M8300186* JOB ABORTED M8300187JBFIOE LDA =A09 JP09, I/O ERROR IN EXECUTION OF REQUEST M8300188* JOB ABORTED M8300189 JMP FL0072 M8300190* M8300191 EJT M8300192ÐÐ* M8300193* FILE HANDLING ROUTINE ADDRESS TABLES M8300194* M8300195FLT003 ADC XX,XX,XX,XX,XX,XX,XX M8300196 ADC FL0700-JPFL +7 REWIND M8300197 ADC FL0700-JPFL +8 UNLOAD M8300198 EQU MAXRC(*-FLT003) MAXIMUM REQUEST CODE PLUS 1 M8300199* M8300200 EJT M8300201* M8300202* M8300203* M8300204FL0300 EQU FL0300(*),XX(FL0300-JPFL) M8300205 LDA =A04 JP04, ILLEGAL CONTROL STATEMENT M8300206 JMP FL0072 ERROR EXIT M8300207 EJT M8300208* M8300209 SPC 4 M8300210* M8300211* SET UP TO TYPE J AND INPUT CONTROL STATEMENT M8300212* M8300213FL0620 ENQ 0 M8300214 LDA- V01,I ARE WE ABORTING A JOB M8300215 SAM 1 YES M8300216 INQ 10 M8300217ÐÐ INQ 4 M8300218* M8300219FL0622 CLR A CLEAR MIB SWITCH M8300220 STA* (FL0625) M8300221 LDA JBPROE M8300222 STA* FL0629+1 M8300223 ENA 1 M8300224* M8300225FL0629 JMP+ 0 M8300226* M8300227* M8300228FL0625 ADC MIB M8300229* M8300230* M8300231* M8300232* M8300233 EJT M8300234* M8300235FLV651 NUM 0 TEMPY STORAGE M8300236* M8300237* M8300238 EJT M8300239* M8300240* REWIND/UNLOAD REQUEST M8300241* M8300242ÐÐ* THE MAXIMUM NUMBER OF PARAMETERS IN A REWIND/UNLOAD M8300243* REQUEST IS 5. M8300244* M8300245* THE PARAMETERS OF A REWIND/UNLOAD REQUEST SPECIFY A M8300246* LOGICAL UNIT NUMBER M8300247* M8300248* FOR A LU THE EQUIVALENT BINARY NUMBER IS THE PARAMETER M8300249* M8300250* GET THE NUMBER OF PARAMETERS IN THE REW/UNL REQUEST M8300251* IT WAS SAVED AT V16,I( BY JPFLV4). PICK IT UP AND SAVE IN V00,I M8300252* M8300253FL0700 LDA- V16,I M8300254 STA- (ZERO),I M8300255 STA* FLV651 M8300256 ENQ 3 M8300257* M8300258* CHECK IT FOR REWIND/ UNLOAD REQUEST M8300259* M8300260 LDA- V01,I REQUEST CODE M8300261 INA -7 M8300262 SAZ FL0704 SKIP IF REWIND REQUEST M8300263* M8300264 INQ 1 M8300265* M8300266FL0704 QLS 12 M8300267ÐÐ STQ* FL0726 M8300268* M8300269FL0705 LDA* FLV651 NBR OF PARAMETERS M8300270 INA -1 M8300271 RTJ FLS02 GET PARAMETER ADDRESS M8300272* M8300273 LDA- (ZERO),Q SAVE THE GIVEN LU IN REQUEST. M8300274 STA* FL0725 M8300275* M8300276* M8300277* REWIND REQUEST M8300278* M8300279FL0720 RTJ- (AMONI) M8300280 NUM $1D00 M8300281 ADC FL0742-FL0720-1 M8300282FL0724 ADC 0 +2 THREAD M8300283FL0725 NUM 0 +3 V,M,A,LU M8300284FL0726 NUM 0 +4 MOTION REQ CODE (3=REW,4=UNLOAD). M8300285* M8300286FL0730 JMP- (ADISP) DISPATCHER EXIT. M8300287* M8300288* M8300289FL0742 LDA FLBF1A RESTORS I M8300290 STA- I M8300291 LDA* FLV651 M8300292ÐÐ INA -1 M8300293 SAZ FL0745 SKIP IF ALL DONE M8300294* M8300295 STA* FLV651 OTHERWISE UPDATE NBR YET TO BE DONE M8300296 JMP* FL0705 AND BUILD NEXT REW/UNL REQUEST M8300297* M8300298FL0745 JMP FL0620 EXIT FROM THE ROUTINE M8300299* M8300300 EJT M8300301* M8300302* COMMON SUBROUTINE TO COMPUTE THE START ADDRESS M8300303* OF A PARAMETER IN THE PARAMETER BUFFER M8300304* M8300305* INPUT M8300306* (A) = PARAMETER NUMBER 0- 4 M8300307* M8300308* =(3*NUMBER+2)+I M8300309* M8300310* OUTPUT M8300311* (Q)= START ADDRESS OF THE PARAMETER M8300312* M8300313FLS02 ADC 0 M8300314 TRA Q M8300315 ALS 1 M8300316 AAQ A M8300317ÐÐ INA 2 M8300318 ADD- I M8300319 TRA Q M8300320* M8300321 JMP* (FLS02) EXIT M8300322* M8300323* M8300324 EJT M8300325* M8300326* TYPE THE ERROR MESSAGE M8300327* M8300328FL0070 LDA =A04 J04, ILLEGAL PARAMTER M8300329* M8300330FL0072 LDQ TRNVEC M8300331 STA- 10,Q SAVE ERROR CODE M8300332 ENQ 6 TERMINATE IN JOBPRO M8300333 LDA JBPROE GET RETURN M8300334 STA* FL007A+1 TO JOBENT M8300335 ENA 0 M8300336 STA (FL0625) CLEAR MIB M8300337 ENA 1 M8300338FL007A JMP+ 0 M8300339* M8300340* M8300341* M8300342ÐÐ END JPFL M8300343 NAM UP I17 A ITOS CCS 3.0 SL-149 00001* UP A DOWNED TERMINAL ROUTINE 00002* CREDIT COLLECTION SYSTEM VERSION 3.0 00003* DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CLAIFORNIA 00004* COPYRIGHT CONTROL DATA CORPORATION 1979 00005* 00006* THIS PROGRAM IS DESIGNED TO PUT A GIVEN TERMINAL BACK INTO 00007* SERVICE AFTER IT HAS MYSTERIOUSLY BEEN LOCKED OUT BY THE 00008* 2550 (CCP 1.0 RUNNING IN CPU II). 00009* THE USER WILL INPUT A TERMINAL NUMBER TO THIS PROGRAM VIA 00010* AN INTERACTIVE CONVERSATION AT THE MASTER CONSOLE. THIS PROGRAM 00011* WILL THEN JUMP INTO THE 2550 DRIVER AT A SPECIAL ENTRY POINT. 00012* THE 2550 DRIVER WILL THEN PROCEED TO TAKE SPECIFIED TERMINAL 00013* OUT OF SERVICE AND PUT IT BACK INTO SERVICE IN AN ATTEMPT TO 00014* MAKE THE LINE OPERATIONAL AGAIN. 00015* 00016* ENTRY TO THIS PROGRAM IS VIA MIPRO. 00017* MANUAL INTERRUPT 00018* ENTER 'UP' CARRIAGE RETURN. 00019* 00020* 00021 SPC 3 00022AMONI EQU AMONI($F4) LOCATION CONTAINING ADDRESS OF THE MONITOR. 00023ADISP EQU ADISP($EA) LOCATION CONTAINING ADDRESS OF THE DISPATCHER. 00024ÐÐZERO EQU ZERO($22) LOCATION CONTAINING A ZERO. 00025NBRLIN EXT NBRLIN MAXIMUM NUMBER OF TERMINALS IN SYSTEM. 00026FIXONE EXT FIXONE CONVERSION ROUTINE IN 2550 DRIVER. 00027LN4 EXT LN4 INITIATES LINE RECOVERY IN 2550 DRIVER. 00028CCPLU EXT CCPLU CONTAINS ADDRESS OF 2550 DRIVER PHYSTAB. 00029 EJT 00030UP NUM $C8FE A = ADDRESS OF THIS PROGRAM IN MEMORY. 00031 STA* UP022 SAVE ADDRESS IN RELEASE MEMORY CALL. 00032 ENQ 1 00033 RTJ WRITE SAY HELLO. 00034UP020 ENQ 2 00035 RTJ WRITE ASK FOR TERMINAL NUMBER. 00036 RTJ* INPUT INPUT DATA. 00037 RTJ* ASCDEC CONVERT INPUT DATA TO BINARY IF POSSIBLE. 00038 STA* TRMNL SAVE THE TERMINAL NUMBER. 00039 ENQ 1 00040 RTJ* COMPAR SKIP ONE LOCATION IF INPUT = EXIT. 00041 JMP* UP030 INPUT DATA NOT = 'EXIT'. 00042 ENQ 9 00043 RTJ WRITE SAY GOOD BYE. 00044 RTJ- (AMONI) 00045 NUM $1801 RELEASE CORE, AND EXIT TO DISPATCHER. 00046UP022 NUM 0 ADDRESS OF PROGRAM IN ALLOCATABLE CORE. 00047 SPC 2 00048UP030 LDA* TRMNL 00049ÐÐ SAP UP032 SKIP IF ONLY LEGAL DECIMAL DIGITS WERE INPUT. 00050 ENQ 6 00051 RTJ WRITE WRITE ILLEGAL CHARACTER INPUT MESSAGE. 00052 JMP* UP020 ASK FOR NEW TERMINAL NUMBER. 00053UP032 LDA* TRMNL 00054 SAZ UP033 SKIP IF TERMINAL NUMBER IS TO SMALL. 00055 LDA* MAXTRM A = MAXIMUM LEGAL TERMINAL NUMBER. 00056 SUB* TRMNL SUBTRACT TERMINAL NUMBER. 00057 SAP UP034 SKIP IF TERMINAL NUMBER IS NOT OUT OF RANGE. 00058UP033 LDA* MAXTRM A = MAXIMUM LEGAL TERMINAL NUMBER. 00059 ENQ 5 00060 RTJ* WRITE WRITE OUT OF RANGE ERROR MESSAGE. 00061 JMP* UP020 ASK FOR ANOTHER TERMINAL NUMBER. 00062 SPC 2 00063UP034 LDA* TRMNL A = REQUESTED TERMINAL NUMBER. 00064 ENQ 3 00065 RTJ* WRITE WRITE VERIFICATION MESSAGE. 00066 RTJ* INPUT READ VERIVICATION FROM OPERATOR. 00067 ENQ 2 00068 RTJ* COMPAR SKIP ONE LOCATION IF INPUT DATA = 'YES'. 00069 JMP* UP060 NOT 'YES', CHECK FOR 'NO'. 00070 LDQ+ CCPLU Q = 2550 DRIVER PHYSTAB ADDRESS. 00071 LFA- (ZERO),3,4,Q A = 2550 DRIVER PRIORITY LEVEL. 00072 SFA* UP040,3,4 00073 RTJ- (AMONI) SCHEDULE UP TO 2550 DRIVER LEVEL. 00074ÐÐUP040 NUM $1300 00075 ADC UP042-UP040 00076 ENQ 4 00077 LDA* TRMNL A = TERMINAL NUMBER. 00078 RTJ* WRITE WRITE A CONFIRMATION MESSAGE. 00079 JMP* UP020 ASK FOR ANOTHER TERMINAL NUMBER. 00080 SPC 2 00081UP042 LR1* TRMNL REGISTER 1 = TERMINAL NUMBER. 00082 LRI+ CCPLU I = 2550 DRIVER PHYSTAB ADDRESS. 00083 RTJ FIXONE RETURNS PORT TABLE ADDRESS IN REGISTER 1. 00084 JMP LN4 BEGIN LINE RECOVERY. 00085 SPC 3 00086UP060 ENQ 3 00087 RTJ* COMPAR SKIP ONE LOCATION IF INPUT DATA = 'NO'. 00088 JMP* UP065 INCORRECT VERIFICATION INPUT. 00089 ENQ 7 00090 RTJ* WRITE WRITE ABORT MESSAGE. 00091 JMP* UP020 ASK FOR ANOTHER TERMINAL NUMBER. 00092UP065 ENQ 8 00093 RTJ* WRITE WRITE VERIFICATION INPUT ERROR MESSAGE. 00094 JMP* UP034 ASK FOR VERIFICATION AGAIN. 00095TRMNL NUM 0 REQUESTED TERMINAL NUMBER. 00096MAXTRM ADC NBRLIN MAXIMUM LEGAL TERMINAL NUMBER. 00097 EJT 00098********************************************************************** 00099ÐÐ* * 00100* THIS ROUTINE IS USED TO COMPARE TWO CHARACTER STRINGS. * 00101* THE FIRST STRING IS SPECIFIED BY AN INDEX PASSED TO THIS * 00102* ROUTINE IN THE Q REGISTER. THE SECOND STRING IS IN THE * 00103* INPUT BUFFER (INBUFF). THE LENGTH OF THE STRING IS ALSO * 00104* SPECIFIED BY THE INDEX PASSED IN Q. STRINGS TO BE COMPARED * 00105* MUST BE AN EVEN NUMBER OF CHARACTERS LONG. * 00106* * 00107* ENTRY: * 00108* Q = INDEX OF STRING TO COMAPRE THE INPUT BUFFER TO. * 00109* RTJ COMPAR * 00110* * 00111* EXIT: * 00112* RETURN IS TO P IF THE STRINGS DO NOT MATCH. * 00113* RETURN IS TO P+1 IF THE STRINGS DO MATCH. * 00114* * 00115********************************************************************** 00116 SPC 2 00117COMPAR 0 0 00118 LDA* COM900,Q 00119 CLR Q 00120 LLS 8 Q = STARTING WORD INDEX. 00121 ARS 8 A = LENGTH-1 OF STRING. 00122 XFA I I = LENGTH-1 OF STRING. 00123COM040 LDA* COM800,B A = LAST WORD OF SPECIFIED STRING. 00124ÐÐ CAE* INBUFF,I SKIP IF THIS WORD OF STRING = INPUT DATA WORD. 00125 JMP* COM050 NOT EQUAL, JUMP. 00126 DIP *-COM040 CHECK THE NEXT WORD. 00127 RAO* COMPAR THE STRINGS ARE EQUAL, RETURN TO P+1. 00128COM050 JMP* (COMPAR) RETURN. 00129COM800 ALF *,EXIT* STRING TABLE. 00130 NUM $FFFF 00131 ALF *,YE* 00132 NUM $53FF 00133 ALF *,NO* 00134 NUM $FFFF 00135* THE FOLLOWING TABLE CONATINS THE STARTING STRING POSITION AND 00136* LENGTH FOR A SPECIFIED STRING IN THE STRING TABLE. 00137* BITS 15-08 = STARTING WORD OF THE STRING. 00138* BITS 07-00 = LENGTH - 1 OF STRING IN WORDS. 00139COM900 NUM 0 00140 NUM $0002 EXIT 00141 NUM $0301 YES 00142 NUM $0501 NO 00143 EJT 00144********************************************************************** 00145* * 00146* THIS ROUTINE IS CALLED TO INPUT DATA FROM THE STANDARD * 00147* COMMENT INPUT DEVICE. IT EXECUTES A FORMATTED READ OF * 00148* 5 WORDS. THE INPUT BUFFER IS BACKGROUNDED TO $FFFF BEFORE * 00149ÐÐ* THE READ REQUEST IS MADE. * 00150* * 00151* ENTRY: * 00152* RTJ INPUT * 00153* * 00154* EXIT: * 00155* RETURNS TO THE CALLER. * 00156* * 00157* ERRORS: * 00158* INPUT ERRORS CAUSE THE READ REQUEST TO BE REPEATED. * 00159* * 00160********************************************************************** 00161 SPC 2 00162INPUT 0 0 00163 LDA- $EF A = CURRENT RUNNING PRIORITY. 00164 SFA* INP020,3,4 SET UP COMPLETION PRIORITY. 00165 ENQ 4 00166 LDA* INP100 00167INP005 STA* INBUFF,Q 00168 DQP *-INP005 BACKGROUND INPUT BUFFER TO $FFFF. 00169INP010 RTJ- (AMONI) 00170INP020 NUM $0900 FORMAT READ REQUEST. 00171 ADC INP070-INP020 COMPLETION ADDRESS. 00172 NUM 0 THREAD WORD. 00173 NUM $18FD LOGICAL UNIT = STANDARD COMMENT DEVICE. 00174ÐÐ NUM 5 LENGTH. 00175 ADC INBUFF-INP020 BUFFER ADDRESS. 00176 JMP- (ADISP) 00177 SPC 3 00178INP070 SQP INP080 SKIP IF NO INPUT ERRORS DETECTED. 00179 JMP* INP010 REPEAT THE INPUT REQUEST. 00180INP080 JMP* (INPUT) RETURN. 00181INBUFF BZS INBUFF(5) 00182INP100 NUM $FFFF 00183 EJT 00184********************************************************************** 00185* * 00186* THIS ROUTINE IS CALLED TO CONVERT INPUT DATA TO A LEGAL * 00187* TERMINAL NUMBER. IT CONVERTS INPUT CHARACTERS FROM ASCII * 00188* TO BINARY. EACH INPUT CHARACTER MUST BE A DECIMAL DIGIT. * 00189* THE PROGRAM STOPS CONVERTING WHEN A VALUE GREATER THAN * 00190* THE LARGEST LEGAL TERMINAL NUMBER HAS BEEN CONVERTED OR * 00191* AN ILLEGAL DIGIT HAS BEEN DETECTED. * 00192* * 00193* ENTRY: * 00194* RTJ ASCDEC * 00195* * 00196* EXIT: * 00197* RETURNS TO CALLER. * 00198* A = CONVERTED VALUE IF NO ILLEGAL CHARACTERS WERE * 00199ÐÐ* DETECTED. * 00200* A = $FFFF IF AN ILLEGAL CHARACTER HAS BEEN DETECTED. * 00201* * 00202********************************************************************** 00203 SPC 3 00204ASCDEC 0 0 00205 CLR A 00206 STA* ASC100 CLEAR THE ACCUMULATOR. 00207 LRI- ZERO ZERO THE CHARACTER COUNTER. 00208ASC020 LCA* INBUFF,I A = A CHARACTER. 00209 INA -$30 00210 SAP ASC028 SKIP IF THIS IS NOT AN ILLEGAL DECIMAL CHAR. 00211 JMP* ASC050 AN ILLEGAL DECIMAL CHARACTER HAS BEEN FOUND. 00212ASC028 INA -10 00213 SAM ASC030 SKIP IF THIS IS A LEGAL DECIMAL CHARACTER. 00214 JMP* ASC040 GO CHECK FOR END OF DATA CHARACTER (FF). 00215ASC030 INA 10 00216 STA* ASC101 SAVE THIS GOOD CONVERTED DIGIT. 00217 LDA* ASC100 00218 MUI =N$A 00219 ADD* ASC101 ADD IN THE NEW DIGIT. 00220 STA* ASC100 UPDATE THE ACCUMULATOR. 00221 LDA* MAXTRM 00222 SUB* ASC100 00223 SAM ASC060 SKIP IF THE CONVERTED VALUE IS GREATER THAN 00224ÐÐ* THE LARGEST LEGAL TERMINAL NUMBER. 00225 RAO- I BUMP THE CHARACTER INDEX. 00226 JMP* ASC020 CONVERT THE NEXT CHARACTER. 00227ASC040 SUB =N$C5 00228 SAZ ASC060 SKIP IF END OF DATA WAS ENCOUNTERED (FF). 00229ASC050 SET A 00230 JMP* ASC080 ILLEGAL CHARACTER DETECTED, RETURN A = FFFF. 00231ASC060 LDA* ASC100 GOOD CONVERSION, RETURN A = CONVERTED VALUE. 00232ASC080 JMP* (ASCDEC) RETURN. 00233ASC100 NUM 0 ACCUMULATOR. 00234ASC101 NUM 0 LAST GOOD CONVERTED DIGIT. 00235 EJT 00236********************************************************************** 00237* * 00238* THIS ROUTINE IS USED TO WRITE MESSAGES TO THE STANDARD * 00239* COMMENT OUTPUT DEVICE. IF THE REQUESTED MESSAGE REQUIRES A * 00240* VALUE TO BE CONVERTED TO ASCII BEFORE OUTPUT, THAT VALUE IS * 00241* PASSED TO THIS ROUTINE IN THE A REGISTER. * 00242* * 00243* ENTRY: * 00244* Q = MESSAGE NUMBER. * 00245* A = VALUE TO BE CONVERTED FOR THIS MESSAGE NUMBER * 00246* IF ONE IS REQUIRED BY THE MESSAGE. * 00247* RTJ WRITE * 00248* * 00249ÐÐ* EXIT: * 00250* RETURN IS TO THE CALLER. * 00251* * 00252* ERRORS: * 00253* DETECTED I/O ERRORS CAUSE THE WRITE TO BE REPEATED. * 00254* * 00255********************************************************************** 00256WRITE 0 0 00257 STA* WRI100 SAVE THE VALUE TO CONVERT. 00258 STA* WRI101 SAVE THE MESSAGE NUMBER. 00259 LDA- $EF A = CURRENT PRIORITY LEVEL. 00260 SFA* WRI020,3,4 00261 LDA* WRI800,Q A = LENGTH OF THIS MESSAGE. 00262 STA* WRI050 00263 LDA* WRI700,Q A = RELATIVE BUFFER ADDRESS. 00264 STA* WRI060 00265 LDQ* WRI600,Q Q = DATA CONVERSION INDEX. 00266 SQZ WRI010 SKIP IF DATA CONVERSION NOT REQUIRED. 00267 LDA* WRI100 A = VALUE TO CONVERT. 00268 RTJ DECASC DO THE CONVERSION. 00269 SPC 2 00270WRI010 RTJ- (AMONI) 00271WRI020 NUM $0D00 FORMAT WRITE. 00272 ADC WRI070-WRI020 COMPLETION ADDRESS. 00273 NUM 0 THREAD. 00274ÐÐ NUM $18FD LOGICAL UNIT = STANDARD COMMENT OUTPUT DEVICE. 00275WRI050 NUM 0 LENGTH. 00276WRI060 NUM 0 BUFFER ADDRESS. 00277 JMP- (ADISP) 00278 SPC 2 00279WRI070 SQP WRI072 SKIP IF NO I/O ERRORS. 00280 JMP* WRI010 REPEAT THE REQUEST. 00281WRI072 JMP* (WRITE) RETURN. 00282WRI100 NUM 0 VALUE TO BE CONVERTED. 00283WRI101 NUM 0 MESSAGE NUMBER. 00284 EJT 00285WRI600 NUM 0 DATA CONVERSION INDEX TABLE. 00286 NUM 0 MESSAGE 1 00287 NUM 0 MESSAGE 2 00288 NUM $63 MESSAGE 3 00289 NUM $81 MESSAGE 4 00290 NUM $DA MESSAGE 5 00291 NUM 0 MESSAGE 6 00292 NUM 0 MESSAGE 7 00293 NUM 0 MESSAGE 8 00294 NUM 0 MESSAGE 9 00295WRI700 NUM 0 MESSAGE RELATIVE ADDRESS TABLE. 00296 ADC WRI901-WRI020 00297 ADC WRI902-WRI020 00298 ADC WRI903-WRI020 00299ÐÐ ADC WRI904-WRI020 00300 ADC WRI905-WRI020 00301 ADC WRI906-WRI020 00302 ADC WRI907-WRI020 00303 ADC WRI908-WRI020 00304 ADC WRI909-WRI020 00305WRI800 NUM 0 MESSAGE LENGTH TABLE. 00306 ADC WRI902-WRI901 00307 ADC WRI903-WRI902 00308 ADC WRI904-WRI903 00309 ADC WRI905-WRI904 00310 ADC WRI906-WRI905 00311 ADC WRI907-WRI906 00312 ADC WRI908-WRI907 00313 ADC WRI909-WRI908 00314 ADC WRI910-WRI909 00315WRI900 EQU WRI900(*) MESSAGE TABLE. 00316WRI901 ALF +, TERMINAL RESTART PROGRAM IN.+ 00317WRI902 ALF +,:R ENTER TERMINAL NUMBER IN DECIMAL:+ 00318WRI903 ALF +, DO YOU WANT TO RESTART TERMINAL XX (YES/NO)?+ 00319WRI904 ALF +, TERMINAL NUMBER XX IS NOW OPERATIONAL.+ 00320WRI905 ALF +, TERMINAL NUMBER IS OUT OF RANGE.+ 00321 NUM $200D CARRIAGE RETURN. 00322 ALF +, LEGAL NUMBERS ARE 01 THROUGH XX.+ 00323WRI906 ALF +, NON-DECIMAL DIGIT ENTERED.+ 00324ÐÐWRI907 ALF +, REQUESTED RESTART IGNORED.+ 00325WRI908 ALF +, YOU MUST ENTER YES OR NO.+ 00326WRI909 ALF +,:R TERMINAL RESTART PROGRAM OUT.+ 00327WRI910 EQU WRI910(*) 00328 EJT 00329********************************************************************** 00330* * 00331* THIS ROUTINE IS CALLED TO CONVERT A BINARY NUMBER TO DECIMAL * 00332* ASCII CHARACTERS. THIS ROUTINE WILL CONVERT 2 DIGITS ONLY. * 00333* * 00334* ENTRY: * 00335* A = VALUE TO BE CONVERTED. * 00336* Q = CHARACTER INDEX OF LOCATION TO STORE CONVERTED DATA. * 00337* * 00338* EXIT: * 00339* RETURN IS TO CALLER. * 00340* * 00341********************************************************************** 00342 SPC 2 00343DECASC 0 0 00344 STQ* DEC101 SAVE THE CHARACTER INDEX. 00345 CLR Q 00346 DVI =N$A A = DIGIT 1., Q = DIGIT 2. 00347 STQ* DEC102 SAVE DIGIT 2. 00348 INA $30 CONVERT DIGIT 1 TO ASCII. 00349ÐÐ LDQ* DEC101 Q = CHARACTER INDEX. 00350 SCA WRI901,Q STORE THE FIRST CHARACTER. 00351 INQ 1 BUMP THE CHARACTER INDEX. 00352 LDA* DEC102 A = DIGIT 2. 00353 INA $30 CONVERT DIGIT 2 TO ASCII. 00354 SCA WRI901,Q STORE THE SECOND CHARACTER. 00355 JMP* (DECASC) RETURN. 00356DEC101 NUM 0 CHARACTER INDEX. 00357DEC102 NUM 0 DIGIT 2. 00358 END 00359 NAM SMDCFG I18 A ITOS CCS 3.0 SL-149 00001* SMD CONFIGURATION ORDINAL 00002* CREDIT COLLECTION SYSTEM VERSION 3.0 00003* DATA-SYSTEMS - LA JOLLA DIVISION,LA JOLLA,CALIFORNIA 00004* COPYRIGHT CONTROL DATA CORPORATION 1979 00005 SPC 2 00006* FOR Q = 0 ON ENTRY..... 00007 SPC 1 00008* THIS ORDINAL CONFIGURES SMD UNITS 1-3 FOR 50MB(96 OR 569 WORD 00009* SECTORS) OR 300MB(96 WORD SECTOR) DRIVES. 00010* (UNIT NOS. ARE SAME AS ITOS UTILITY DISK UNIT NOS.) 00011* 00012* ENTRY TO THIS PROGRAM IS VIA MIPRO. 00013* MANUAL INTERRUPT,ENTER 'SMDC' CARRIAGE RETURN. 00014* 00015ÐÐ SPC 2 00016* FOR Q = 1 ON ENTRY.... 00017 SPC 1 00018* THIS ORDINAL CONFIGURES THE TEXT TO BE DISPLAYED AT AUTOLOAD 00019* AND AT TERMINAL SIGN-ON. THE TEXT IS UPDATED IN CORE AND IN THE 00020* CORE IMAGE ON MASS MEMORY. 00021* ENTRY TO THIS PROGRAM IS VIA MIPRO. 00022* MANUAL INTERRUPT, ENTER 'SYID' , CARRIAGE RETURN. 00023 SPC 2 00024* FOR Q = 2 ON ENTRY. 00025 SPC 1 00026* THIS ORDINAL ENABLES OR DISABLES THE LOWER CASE OPTION FOR THE 00027* LINE PRINTER. THE CHANGE IS MADE IN CORE AND IN THE CORE IMAGE ON 00028* MASS MEMORY. 00029* ENTRY TO THIS PROGRAM IS VIA MIPRO. 00030* MANUAL INTERRUPT, ENTER 'LPCF' , CARRIAGE RETURN. 00031 SPC 2 00032 EXT P83310 SMD UNIT 0 PHY. DEV. TBL. 00033 EXT LOG1A LOGICAL UNIT VECTOR TABLE 00034 EXT MMLUTB ADDR. OF FM VECTOR TBL. TO VIT TBLS.(IN SYSDAT 00035 EXT SYSID ADDR. OF SYSTEM ID TEXT (IN SYSDAT) 00036 SPC 2 00037 SPC 2 00038 EQU AMONI($F4),ADISP($EA),ZERO($22) 00039 EQU H7FFF($11),H00FF($A) 00040ÐÐ SPC 1 00041 EQU VITWPS(13) WDS/SECTOR IN VIT TBL. 00042 SPC 1 00043* SMD PHY. DEV. TBL. EQUIVALENCES 00044 EQU LOGDRV(39) LOGICAL UNIT OF DRIVE(PLUG NO.) 00045 EQU NUMHDS(49) NO. OF HEADS(5 OR 19) 00046 EQU OTHER(66) P. D. T. THREAD 00047 EQU DRVSAK(68) SELECT ACK. STATUS/MASK 00048 EQU MXWDSR(70) MAX. WDS. PER SECTOR 00049 EQU MXSRTK(71) MAX. NO. OF SECTORS PER TRACK 00050 SPC 1 00051 EQU WRDSEC(96) WORDS PER SECTOR (SYSVOL) 00052 SPC 1 00053 EQU EDLWRC(38) ENABLE/DISABLE LOWER CASE INDEX INTO LP PDT. 00054 SPC 2 00055SMDCFG QLS 1 00056 JMP* QVECTR,Q 00057QVECTR JMP SMDC Q = 0, SMD CONFIGURE. 00058 JMP SYID Q = 1, SYSTEM ID TEXT DEFINITION 00059 JMP LPCF Q = 2, LINE PRINTER LOWER CASE ENABLE/DISABLE. 00060 SPC 2 00061******** CONFIGURE S M D LOGIC 00062 SPC 1 00063SMDC ENQ 1 00064 RTJ WRITE DISPLAY 'IN' MSG. 00065ÐÐSMD01 ENQ 2 00066 RTJ WRITE DISPLAY 'INPUT FORMAT' MSG. 00067 ENQ 3 00068 RTJ WRITE DISPLAY 'INPUT PARAMETERS' MSG. 00069 RTJ INPUT INPUT DATA 00070 ENQ 1 00071 RTJ COMPAR SKIP ONE LOCATION IF INPUT = 'EXIT' 00072 JMP* VIP INPUT NOT = 'EXIT' 00073 ENQ 7 00074 RTJ WRITE DISPLAY 'OUT' MSG. 00075 RTJ- (AMONI) 00076RELSE NUM $1901 RELEASE CORE, EXIT TO DISPATCHER 00077 ADC (SMDCFG-RELSE) 00078 SPC 2 00079******** VERIFY INPUT PARAMETERS FOR LEGALITY 00080VIP LRI- ZERO INITIALIZE CHAR. INDEX FOR ASCDEC ROUTINE 00081 RTJ ASCDEC UNIT PARAMETER 00082 STA* UNIT 00083 RTJ* PARCHK CHECK PARAMETER 00084 NUM 1 SET OF LEGAL UNITS 00085 NUM 2 00086 NUM 3 00087 NUM -1 00088 RTJ ASCDEC TYPE PARAMETER 00089 STA* TYPE 00090ÐÐ RTJ* PARCHK 00091D50 NUM 20 SET OF LEGAL TYPES 00092D300 NUM 40 00093 NUM -1 00094 RTJ ASCDEC SECTOR SIZE PARAMETER 00095 STA* SECSIZ 00096 RTJ* PARCHK 00097D96 NUM 96 SET OF LEGAL SECTOR SIZES 00098D569 NUM 569 00099 NUM -1 00100******** LOCATE PHY. DEV. TBL. ADDRESS VIA VIT TABLE 00101PI LDQ* UNIT 00102 INQ 1 00103 LDQ* (AMLUT),Q (= ADDR. OF VIT TBL.) 00104 LDA- (ZERO),Q (= LU NO. AND MOUNT FLAG) 00105 SAM P100 SENSE NOT MOUNTED 00106 ENQ 8 00107 RTJ WRITE OUTPUT VOLUME MOUNTED MSG. 00108 JMP* SMD01 00109AMLUT ADC MMLUTB 00110ALOG1A ADC LOG1A 00111P100 AND- H7FFF (REMOVE NOT MOUNTED FLAG) 00112 TRA Q 00113 LDA* (ALOG1A),Q = ADDR. OF P. D. T. 00114 STA- I 00115ÐÐ******** PROCESS INPUT 00116PI001 LDA* TYPE 00117 SUB* D50 00118 SAZ PI01 SENSE 50MB TYPE 00119 JMP* PI20 00120PI01 LDA* SECSIZ 00121 SUB* D96 00122 SAZ PI02 SENSE 96 WDS/SECTOR 00123 JMP* PI06 00124PI02 LDA- NUMHDS,I 00125 INA -5 00126 SAZ PI03 SENSE ALREADY 50MB 00127 JMP* PI04 00128PI03 LDA- MXWDSR,I 00129 EOR* D96 00130 SAZ PI05 SENSE ALREADY 96 WDS/SECTOR 00131******** CONFIGURE DRIVE FOR 50MB,96 WDS/SECTOR 00132PI04 RTJ CNFDRV 00133 NUM 5 00134 NUM 96 00135 NUM 64 00136 NUM $80EF 00137 JMP* PI22 OUTPUT UNIT CONFIGURED MSG. 00138PI05 JMP* PI21 OUTPUT ALREADY CONFIGURED MSG. 00139PI06 LDA- NUMHDS,I 00140ÐÐ INA -5 00141 SAZ PI07 SENSE ALREADY 50MB DRIVE 00142 JMP* PI08 00143PI07 LDA- MXWDSR,I 00144 EOR* D569 00145 SAZ PI09 SENSE ALREADY 569 WDS/SECTOR 00146******** CONFIGURE DRIVER FOR 50MB,569 WDS/SECTOR 00147PI08 RTJ CNFDRV 00148 NUM 5 00149 NUM 569 00150 NUM 16 00151 NUM $80EF 00152 JMP* PI22 OUTPUT UNIT CONFIGURED MSG. 00153PI09 JMP* PI21 OUTPUT ALREADY CONFIGURED MSG. 00154PI20 LDA- NUMHDS,I 00155 INA -19 00156 SAZ PI21 SENSE ALREADY 300MB DRIVE 00157******** CONFIGURE DRIVE FOR 300MB,96 WDS/SECTOR 00158 RTJ CNFDRV 00159 NUM 19 00160 NUM 96 00161 NUM 64 00162 NUM $C0EF 00163 JMP* PI22 00164PI21 ENQ 5 00165ÐÐ RTJ WRITE OUTPUT ALREADY CONFIGURED MSG. 00166 JMP* SMD01 00167******** UPDATE CORE VIT 00168PI22 LDQ* UNIT 00169 INQ 1 00170 LDQ* (AMLUT),Q 00171 LDA- MXWDSR,I 00172 STA- VITWPS,Q 00173******** WRITE CHANGES TO CORE IMAGE. 00174 RTJ MMIMAG 00175 ENQ 4 00176 RTJ WRITE OUTPUT CONFIGURED MSG. 00177 JMP* SMD01 00178 SPC 2 00179UNIT NUM 0 00180TYPE NUM 0 00181SECSIZ NUM 0 00182AP8331 ADC P83310 ADDR. OF SMD UNIT 0 PHY. DEV. TBL. 00183 EJT 00184********************************************************************* 00185* CHECK FOR LEGAL PARAMETER ROUTINE * 00186* ROUTINE COMPARES VALUE AGAINST A SET OF VALUES AND RETURNS * 00187* IF A MATCH IS FOUND. IF NO MATCH IS FOUND, ILLEGAL MSG. * 00188* IS DISPLAYED THEN REQUEST FOR INPUT IS INITIATED. * 00189* * 00190ÐÐ* ENTRY: A-REG. = VALUE * 00191* RTJ PARCHK * 00192* SET OF VALUES (POSITIVE,NON-ZERO VALUES) * 00193* (END SET WITH -1) * 00194* EXIT: RETURN IF LEGAL PARAMETER * 00195* REQUEST INPUT IF ILLEGAL PARAMETER * 00196* * 00197********************************************************************* 00198 SPC 2 00199PARCHK 0 0 00200 CLR Q 00201 STA* T1 00202PAR1 LDA* (PARCHK) 00203 SAM PAR3 SENSE END OF LEGAL PARAMETER SET 00204 SUB* T1 00205 SAN PAR2 SENSE NO MATCH 00206 INQ 1 00207PAR2 RAO* PARCHK 00208 JMP* PAR1 00209PAR3 SQZ PAR4 SENSE NO MATCH FOUND 00210 RAO* PARCHK 00211 JMP* (PARCHK) RETURN 00212PAR4 ENQ 6 00213 RTJ WRITE DISPLAY 'ILLEGAL CONFIGURE' MSG. 00214 JMP SMD01 00215ÐÐT1 0 0 00216 EJT 00217********************************************************************* 00218* * 00219* THIS ROUTINE IS USED TO COMPARE TWO CHARACTER STRINGS. * 00220* THE FIRST STRING IS SPECIFIED BY AN INDEX PASSED TO THIS * 00221* ROUTINE IN THE Q REGISTER. THE SECOND STRING IS IN THE * 00222* INPUT BUFFER (INBUFF). THE LENGTH OF THE STRING IS ALSO * 00223* SPECIFIED BY THE INDEX PASSED IN Q. STRINGS TO BE COMPARED * 00224* MUST BE AN EVEN NUMBER OF CHARACTERS LONG. * 00225* * 00226* ENTRY: * 00227* Q = INDEX OF STRING TO COMAPRE THE INPUT BUFFER TO. * 00228* RTJ COMPAR * 00229* * 00230* EXIT: * 00231* RETURN IS TO P IF THE STRINGS DO NOT MATCH. * 00232* RETURN IS TO P+1 IF THE STRINGS DO MATCH. * 00233* * 00234********************************************************************** 00235 SPC 2 00236COMPAR 0 0 00237 LDA* COM900,Q 00238 CLR Q 00239 LLS 8 Q = STARTING WORD INDEX. 00240ÐÐ ARS 8 A = LENGTH-1 OF STRING. 00241 XFA I I = LENGTH-1 OF STRING. 00242COM040 LDA* COM800,B A = LAST WORD OF SPECIFIED STRING. 00243 CAE* INBUFF,I SKIP IF THIS WORD OF STRING = INPUT DATA WORD. 00244 JMP* COM050 NOT EQUAL, JUMP. 00245 DIP *-COM040 CHECK THE NEXT WORD. 00246 RAO* COMPAR THE STRINGS ARE EQUAL, RETURN TO P+1. 00247COM050 JMP* (COMPAR) RETURN. 00248COM800 ALF *,EXIT* STRING TABLE. 00249 NUM $FFFF 00250 ALF *,YE* 00251 NUM $53FF 00252 ALF *,NO* 00253 NUM $FFFF 00254* THE FOLLOWING TABLE CONATINS THE STARTING STRING POSITION AND 00255* LENGTH FOR A SPECIFIED STRING IN THE STRING TABLE. 00256* BITS 15-08 = STARTING WORD OF THE STRING. 00257* BITS 07-00 = LENGTH - 1 OF STRING IN WORDS. 00258COM900 NUM 0 00259 NUM $0002 EXIT 00260 NUM $0301 YES 00261 NUM $0501 NO 00262 EJT 00263********************************************************************** 00264* * 00265ÐÐ* THIS ROUTINE IS CALLED TO INPUT DATA FROM THE STANDARD * 00266* COMMENT INPUT DEVICE. IT EXECUTES A FORMATTED READ OF * 00267* 5 WORDS. THE INPUT BUFFER IS BACKGROUNDED TO $FFFF BEFORE * 00268* THE READ REQUEST IS MADE. * 00269* * 00270* ENTRY: * 00271* RTJ INPUT * 00272* * 00273* EXIT: * 00274* RETURNS TO THE CALLER. * 00275* * 00276* ERRORS: * 00277* INPUT ERRORS CAUSE THE READ REQUEST TO BE REPEATED. * 00278* * 00279********************************************************************** 00280 SPC 2 00281INPUT 0 0 00282 LDA- $EF A = CURRENT RUNNING PRIORITY. 00283 SFA* INP020,3,4 SET UP COMPLETION PRIORITY. 00284 ENQ 39 00285 LDA* INP100 00286INP005 STA* INBUFF,Q 00287 DQP *-INP005 BACKGROUND INPUT BUFFER TO $FFFF. 00288INP010 RTJ- (AMONI) 00289INP020 NUM $0900 FORMAT READ REQUEST. 00290ÐÐ ADC INP070-INP020 COMPLETION ADDRESS. 00291 NUM 0 THREAD WORD. 00292 NUM $18FD LOGICAL UNIT = STANDARD COMMENT DEVICE. 00293 NUM 40 LENGTH. 00294 ADC INBUFF-INP020 BUFFER ADDRESS. 00295 JMP- (ADISP) 00296 SPC 3 00297INP070 SQP INP080 SKIP IF NO INPUT ERRORS DETECTED. 00298 JMP* INP010 REPEAT THE INPUT REQUEST. 00299INP080 JMP* (INPUT) RETURN. 00300INBUFF BZS INBUFF(40) 00301INP100 NUM $FFFF 00302 EJT 00303********************************************************************** 00304* * 00305* ENTRY: * 00306* RTJ ASCDEC * 00307* * 00308* * 00309* ENTRY: * 00310* RTJ ASCDEC * 00311* * 00312* EXIT: * 00313* RETURNS TO CALLER. * 00314* A = CONVERTED VALUE IF NO ILLEGAL CHARACTERS WERE * 00315ÐÐ* DETECTED. * 00316* A = $FFFF IF AN ILLEGAL CHARACTER HAS BEEN DETECTED. * 00317* * 00318********************************************************************** 00319 SPC 3 00320ASCDEC 0 0 00321 CLR A 00322 STA* ASC100 CLEAR THE ACCUMULATOR. 00323ASC020 LCA* INBUFF,I A = A CHARACTER. 00324 RAO- I BUMP THE CHARCATER INDEX 00325 INA -$30 00326 SAP ASC028 SKIP IF THIS IS NOT AN ILLEGAL DECIMAL CHAR. 00327 INA -10 (ADJUST SO COMMON CHECK WORKS) 00328 JMP* ASC040 AN ILLEGAL DECIMAL CHARACTER HAS BEEN FOUND. 00329ASC028 INA -10 00330 SAM ASC030 SKIP IF THIS IS A LEGAL DECIMAL CHARACTER. 00331 JMP* ASC040 GO CHECK FOR END OF DATA CHARACTER (FF). 00332ASC030 INA 10 00333 STA* ASC101 SAVE THIS GOOD CONVERTED DIGIT. 00334 LDA* ASC100 00335 MUI =N$A 00336 ADD* ASC101 ADD IN THE NEW DIGIT. 00337 STA* ASC100 UPDATE THE ACCUMULATOR. 00338 JMP* ASC020 CONVERT THE NEXT CHARACTER. 00339ASC040 INA -$2C+$30+10 00340ÐÐ SAZ ASC060 SENSE DELIMITER(COMMA), TERMINATE FIELD 00341 SUB =N$D3 ($FF-$2C) 00342 SAZ ASC060 SKIP IF END OF DATA WAS ENCOUNTERED (FF). 00343 ENQ 6 00344 RTJ* WRITE DISPLAY 'ILLEGAL CONFIGURE' MSG. 00345 JMP SMD01 00346ASC060 LDA* ASC100 GOOD CONVERSION, RETURN A = CONVERTED VALUE. 00347ASC080 JMP* (ASCDEC) RETURN. 00348ASC100 NUM 0 ACCUMULATOR. 00349ASC101 NUM 0 LAST GOOD CONVERTED DIGIT. 00350 EJT 00351********************************************************************** 00352* * 00353* THIS ROUTINE IS USED TO WRITE MESSAGES TO THE STANDARD * 00354* COMMENT OUTPUT DEVICE. * 00355* * 00356* ENTRY: * 00357* Q = MESSAGE NUMBER. * 00358* RTJ WRITE * 00359* * 00360* EXIT: * 00361* RETURN IS TO THE CALLER. * 00362* * 00363* ERRORS: * 00364* DETECTED I/O ERRORS CAUSE THE WRITE TO BE REPEATED. * 00365ÐÐ* * 00366********************************************************************** 00367WRITE 0 0 00368 LDA- $EF A = CURRENT PRIORITY LEVEL. 00369 SFA* WRI020,3,4 00370 LDA* WRI800,Q A = LENGTH OF THIS MESSAGE. 00371 STA* WRI050 00372 LDA* WRI700,Q A = RELATIVE BUFFER ADDRESS. 00373 STA* WRI060 00374 LDA UNIT CONVERT UNIT NO. TO ASCII 00375 ADD =N$2030 00376 STA WRI904+2 TO MSG 4 00377 STA WRI905+2 TO MSG 5 00378 SPC 2 00379WRI010 RTJ- (AMONI) 00380WRI020 NUM $0D00 FORMAT WRITE. 00381 ADC WRI070-WRI020 COMPLETION ADDRESS. 00382 NUM 0 THREAD. 00383 NUM $18FD LOGICAL UNIT = STANDARD COMMENT OUTPUT DEVICE. 00384WRI050 NUM 0 LENGTH. 00385WRI060 NUM 0 BUFFER ADDRESS. 00386 JMP- (ADISP) 00387 SPC 2 00388WRI070 SQP WRI072 SKIP IF NO I/O ERRORS. 00389 JMP* WRI010 REPEAT THE REQUEST. 00390ÐÐWRI072 JMP* (WRITE) RETURN. 00391WRI100 NUM 0 VALUE TO BE CONVERTED. 00392WRI101 NUM 0 MESSAGE NUMBER. 00393 EJT 00394WRI700 NUM 0 MESSAGE RELATIVE ADDRESS TABLE. 00395 ADC WRI901-WRI020 00396 ADC WRI902-WRI020 00397 ADC WRI903-WRI020 00398 ADC WRI904-WRI020 00399 ADC WRI905-WRI020 00400 ADC WRI906-WRI020 00401 ADC WRI907-WRI020 00402 ADC WRI908-WRI020 00403 ADC WRI909-WRI020 00404 ADC WRI910-WRI020 00405 ADC WRI911-WRI020 00406 ADC WRI912-WRI020 00407 ADC WRI913-WRI020 00408 ADC WRI914-WRI020 00409 ADC WRI915-WRI020 00410 ADC WRI916-WRI020 00411 ADC WRI917-WRI020 00412 ADC WRI918-WRI020 00413 ADC WRI919-WRI020 00414 ADC WRI920-WRI020 00415ÐÐWRI800 NUM 0 MESSAGE LENGTH TABLE. 00416 ADC WRI902-WRI901 00417 ADC WRI903-WRI902 00418 ADC WRI904-WRI903 00419 ADC WRI905-WRI904 00420 ADC WRI906-WRI905 00421 ADC WRI907-WRI906 00422 ADC WRI908-WRI907 00423 ADC WRI909-WRI908 00424 ADC WRI910-WRI909 00425 ADC WRI911-WRI910 00426 ADC WRI912-WRI911 00427 ADC WRI913-WRI912 00428 ADC WRI914-WRI913 00429 ADC WRI915-WRI914 00430 ADC WRI916-WRI915 00431 ADC WRI917-WRI916 00432 ADC WRI918-WRI917 00433 ADC WRI919-WRI918 00434 ADC WRI920-WRI919 00435 ADC WRI921-WRI920 00436WRI900 EQU WRI900(*) MESSAGE TABLE. 00437WRI901 ALF +,SMD CONFIG IN+ 00438WRI902 ALF +,INPUT FORMAT (TYPE 'EXIT' TO EXIT)+ 00439WRI903 ALF +,UNIT NO.(1-3),DRIVE TYPE(20,40),SECTOR SIZE(96,569)....+ 00440ÐÐWRI904 ALF +,UNIT $ CONFIGURED. 00441WRI905 ALF +,UNIT $ ALREADY CONFIGURED AS REQUESTED.+ 00442WRI906 ALF +,ILLEGAL CONFIGURE REQUESTED.+ 00443WRI907 ALF +,SMD CONFIG OUT+ 00444WRI908 ALF +,REQUESTED UNIT MOUNTED. NO CONFIGURE DONE.+ 00445WRI909 ALF +,SYID IN+ 00446WRI910 ALF +,ENTER 32 CHARACTERS OF TEXT...+ 00447WRI911 ALF +,SYID OUT+ 00448WRI912 ALF +,LPCF IN+ 00449WRI913 ALF +,LOWER CASE CURRENTLY DISABLED.+ 00450WRI914 ALF +,LOWER CASE CURRENTLY ENABLED.+ 00451WRI915 ALF +,ENTER 'E' TO ENABLE LOWER CASE.+ 00452WRI916 ALF +,ENTER 'D' TO DISABLE LOWER CASE...+ 00453WRI917 ALF +,LPCF OUT+ 00454WRI918 ALF +, + 00455WRI919 ALF +, + 00456WRI920 ALF +, + 00457WRI921 EQU WRI921(*) 00458 EJT 00459********************************************************************* 00460* * 00461* THIS ROUTINE WRITES CHANGED WORDS IN PHY. DEV. TBL. * 00462* AND VIT TABLE TO CORE IMAGE. * 00463* ENTRY - I-REG. = PHY. DEV. TBL. ADDRESS * 00464* Q-REG. = VIT TABLE ADDRESS * 00465ÐÐ* * 00466********************************************************************* 00467 SPC 1 00468MMIMAG 0 0 00469 INQ VITWPS 00470 STQ* AWPS (=ADDR. OF WDS/SECTOR IN VIT TBL.) 00471 LDQ- $E9 00472 LDA- 4,Q CALC. WORD ADDR. OF WDS/SECTOR IN VIT TBL. 00473 MUI =XWRDSEC ON CORE IMAGE. 00474 ADD* AWPS 00475 STA* LSBWPS 00476 LDQ- $E9 CALC. WORD ADDR. OF P. D. T. ON CORE IMAGE 00477 LDA- 4,Q STARTING AT NUMHDS WORD 00478 MUI =XWRDSEC 00479 ADD- I 00480 INA NUMHDS 00481 STA* LSBNHD 00482 LDA- I CALC. CORE ADDRESS OF NUMHDS WORD IN P.D.T. 00483 INA NUMHDS 00484 STA* SNHDS 00485 RTJ* MYLOC 00486MYLOC 0 0 00487 LDA* MYLOC 00488 ADD =XWCA-MYLOC 00489 STA* WCAP 00490ÐÐ INA WCA2-WCA 00491 STA* WCAP2 00492 LDA- $EF 00493 EOR* WPARM 00494 STA* WPARM 00495 STA* WPARM2 00496 RTJ- (AMONI) WRITE TO PHY. DEV. TBL. ON CORE IMAGE 00497WPARM NUM $4400 (WRITE REQUEST) 00498WCAP NUM 0 00499 NUM 0 00500 NUM 8 LU 00501 NUM 23 LENGTH(FROM NUMHDS TO MXSRTK) 00502SNHDS NUM 0 00503 NUM 0 MSB (ASSUME 0) 00504LSBNHD NUM 0 LSB 00505 JMP- (ADISP) 00506* (NOTE: NO CHECK FOR MM ERRORS ON CCS SYSTEM.) 00507WCA RTJ- (AMONI) WRITE TO VIT TABLE ON CORE IMAGE. 00508WPARM2 NUM $4400 00509WCAP2 NUM 0,0,8,1 CA,THD,LU,LENGTH 00510AWPS NUM 0,0 S,MSB 00511LSBWPS NUM 0 LSB 00512 JMP- (ADISP) 00513* (NOTE: NO CHECK FOR MM ERRORS ON CCS SYSTEM.) 00514WCA2 JMP* (MMIMAG) RETURN 00515ÐÐ SPC 2 00516****** CONFIGURE SYSTEM IDENTIFYING TEXT USED AT AUTOLOAD AND TERMINAL 00517****** SIGN-ON. 00518 SPC 2 00519SYID ENQ 9 00520 RTJ WRITE DISPLAY 'SYID IN' MESSAGE 00521 ENQ 10 00522 RTJ WRITE DISPLAY 'ENTER TEXT' MESSAGE 00523 RTJ INPUT INPUT DATA 00524 ENQ 1 00525 RTJ COMPAR SKIP 1 LOCATION IF INPUT = 'EXIT' 00526 JMP* SYID10 00527SYIDX ENQ 11 00528 RTJ WRITE DISPLAY 'OUT' MESSAGE 00529 JMP RELSE-1 00530 SPC 1 00531* MOVE TEXT TO CORE 'SYID' (TEXT CONSISTS OF 32 CHARACTERS) 00532SYID10 ENQ 16 INITAILIZE TEXT TO SPACES. 00533 LDA =N$2020 00534SYID20 INQ -1 00535 SQM SYID30 SENSE DONE 00536 STA+ SYSID,Q 00537 JMP* SYID20 00538SYID30 ENQ 0 00539 STQ- I 00540ÐÐSYID40 LCA INBUFF,I 00541 SUB- H00FF 00542 SAZ SYID50 SENSE END OF TEXT ENTERED 00543 ADD- H00FF 00544 LDQ- I 00545 INQ -32 00546 SQZ SYID50 SENSE MAX. NO. OF CHARS. 00547 SCA+ SYSID,I 00548 RAO- I 00549 JMP* SYID40 00550******** WRITE TEXT TO CORE IMAGE 00551SYID50 LDA =XSYSID 00552 ENQ 16 00553 RTJ CIMAGE 00554 JMP* SYIDX EXIT ORDINAL 00555 EJT 00556******** CONFIGURE LINE PRINTER LOWER CASE OPTION 00557******** LINE PRINTER PHY. DEV. TBL. WORD 38, BIT 15: 00558******** 0 = LOWER CASE DISABLED 00559******** 1 = LOWER CASE ENABLED 00560 SPC 2 00561LPCF ENQ 12 00562 RTJ WRITE DISPLAY 'LPCF IN' MESSAGE 00563 ENQ 9 LP LOGICAL UNIT 00564 LDQ (ALOG1A),Q 00565ÐÐ LDA- EDLWRC,Q 00566 ENQ 13 (DISABLED MSG CODE) 00567 SAP LPCF10 SENSE LOWER CASE DISABLED 00568 ENQ 14 (ENABLED MSG CODE) 00569LPCF10 RTJ WRITE DISPLAY LOWER CASE STATUS MESSAGE. 00570LPCF15 ENQ 15 00571 RTJ WRITE DISPLAY 'ENTER E' MESSAGE 00572 ENQ 16 00573 RTJ WRITE DISPLAY 'ENTER D' MESSAGE 00574 RTJ INPUT INPUT DATA 00575 ENQ 1 00576 RTJ COMPAR SKIP 1 LOCATION IF INPUT = EXIT 00577 JMP* LPCF20 00578LPCFX ENQ 17 00579 RTJ WRITE DISPLAY 'OUT' MESSAGE 00580 JMP RELSE-1 EXIT ORDINAL 00581 SPC 1 00582LPCF20 ENQ 9 00583 LDQ (ALOG1A),Q (SETUP I-REG. = ADDR. OF EN/DIS WORD) 00584 INQ EDLWRC 00585 STQ- I 00586 LDA INBUFF 00587 ALS 8 00588 AND- H00FF 00589 INA -$44 00590ÐÐ SAZ LPCF30 SENSE 'D' ENTERED 00591 INA -1 00592 SAZ LPCF40 SENSE 'E' ENTERED 00593 JMP* LPCF15 (NOT D OR E) 00594LPCF30 ENQ 0 SET FOR DISABLE 00595 JMP* LPCF50 00596LPCF40 ENQ 1 SET FOR ENABLE 00597LPCF50 LDA- (ZERO),I 00598 ALS 1 00599 LRS 1 00600 STA- (ZERO),I UPDATE PDT WITH REQUESTED LOWER CASE STATE 00601******** WRITE TO CORE IMAGE 00602 LDA- I 00603 ENQ 1 (LENGTH) 00604 RTJ* CIMAGE WRITE TO CORE IMAGE 00605 JMP* LPCFX EXIT ORDINAL 00606 SPC 2 00607************************************************************ 00608* * 00609* WRITE TO CORE IMAGE ROUTINE * 00610* ENTRY: A= CORE ADDRESS 00611* Q= LENGTH * 00612* * 00613************************************************************ 00614 SPC 1 00615ÐÐCIMAGE 0 0 00616 STQ* LCI 00617 STA* SCI 00618 LDQ- $E9 00619 LDA- 4,Q 00620 MUI =XWRDSEC 00621 ADD* SCI 00622 STA* LSBCI 00623 RTJ* MYADDR 00624MYADDR 0 0 00625 LDA* MYADDR 00626 ADD =XCI10-MYADDR 00627 STA* CACI 00628 LDA- $EF 00629 EOR* RCCI 00630 STA* RCCI 00631 RTJ- (AMONI) 00632RCCI NUM $4400 WRITE REQUEST 00633CACI NUM 0 00634 NUM 0 00635 NUM 8 LU 00636LCI NUM 0 LENGTH 00637SCI NUM 0 CORE ADDR. 00638 NUM 0 MSB(ASSUME 0) 00639LSBCI NUM 0 LSB(WORD ADDRESSING) 00640ÐÐ JMP- (ADISP) 00641* NOTE: NO CHECK FOR MM ERROR IN CCS SYSTEM) 00642CI10 JMP* (CIMAGE) RETURN 00643 EJT 00644********************************************************************** 00645* * 00646* CONFIGURE DRIVE ROUTINE * 00647* CALLING SEQUENCE: * 00648* RTJ CNFDRV * 00649* NUM (NO. OF HEADS PER CYLINDER) * 00650* NUM (NO. OF WORDS PER SECTOR) * 00651* NUM (NO. OF SECTORS PER TRACK) 00652* NUM (ACKNOWLEDGE DRIVE MASK) * 00653* * 00654********************************************************************** 00655 SPC 1 00656CNFDRV 0 0 00657 LDQ* CNFDRV 00658 LDA- (ZERO),Q 00659 STA- NUMHDS,I NO. OF HEADS 00660 LDA- 1,Q 00661 STA- MXWDSR,I WORDS PER SECTOR 00662 LDA- 2,Q 00663 STA- MXSRTK,I SECTORS PER TRACK 00664 LDA UNIT 00665ÐÐ ALS 8 00666 EOR- 3,Q 00667 STA- DRVSAK,I ACKNOWLEDGE DRIVE MASK 00668 JMP- 4,Q 00669 END 00670 MON 00001 OPT LPCR 00001 SUBROUTINE OPNPT2 (IBUFF,IERR) 00001 1 /J01 F ITOS CCS 3.0 SL-149 00002C CREDIT COLLECTION SYSTEM VERSION 3.0 00003C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00004C COPYRIGHT CONTROL DATA CORPORATION 1979 00005C 00006 INTEGER BLANKS 00007 INTEGER CONVRT 00008 INTEGER ERR04 00009 INTEGER ERR09 00010 INTEGER ERR10 00011 INTEGER ERR16 00012 INTEGER ERR17 00013 INTEGER ERR18 00014 INTEGER ERR19 00015 INTEGER ERR20 00016 INTEGER ERR21 00017 INTEGER IVPTTC 00018ÐÐ INTEGER I 00019 INTEGER IERR 00020 INTEGER INDEX 00021 INTEGER ISTAT 00022 INTEGER J 00023 INTEGER K 00024 INTEGER LU 00025 INTEGER LULOW 00026 INTEGER LUUPR 00027 INTEGER LUTEMP 00028 INTEGER OPNTYP 00029 INTEGER REQD 00030 INTEGER SCHAR 00031 INTEGER STAT 00032 INTEGER SWORD 00033 INTEGER FIELD(20) 00034 INTEGER FIELD1 00035 INTEGER FIELD2 00036 INTEGER IBUFF(1) 00037 INTEGER IDATA(15) 00038 INTEGER IIDATA(15) 00039 INTEGER REQBUF(24) 00040C 00041 DATA BLANKS /' '/ 00042 DATA ERR04 /'04'/ 00043ÐÐ DATA ERR09 /'09'/ 00044 DATA ERR10 /'10'/ 00045 DATA ERR16 /'16'/ 00046 DATA ERR17 /'17'/ 00047 DATA ERR18 /'18'/ 00048 DATA ERR19 /'19'/ 00049 DATA ERR20 /'20'/ 00050 DATA ERR21 /'21'/ 00051 DATA IIDATA /12*' ',0,1,0/ 00052C 00053 EQUIVALENCE (FIELD1,FIELD(1)) 00054 EQUIVALENCE (FIELD2,FIELD(2)) 00055C 00056 BYTE (LULOW,FIELD1(7=0)) 00057 BYTE (LUUPR,FIELD1(15=8)) 00058C 00059 RELATIVE CONVRT 00060 RELATIVE GETFLD 00061 RELATIVE IVPTTC 00062 RELATIVE OPENFL 00063 RELATIVE PARIDX 00064 RELATIVE PTOPEN 00065 RELATIVE Q8PKUP 00066 RELATIVE Q8PREP 00067C 00068ÐÐC** * INITIALIZE THE REQUEST BUFFER 00069 I5010 = 1 00070 J5010 = 24 00071 K5010 = 1 00072 DO 5010 I = I5010 , J5010 , K5010 00073 REQBUF(I) = 0 000745010 CONTINUE 00075C** * INITIALIZE THE IDATA ARRAY 00076 I5020 = 1 00077 J5020 = 15 00078 K5020 = 1 00079 DO 5020 I = I5020 , J5020 , K5020 00080 IDATA(I) = IIDATA(I) 000815020 CONTINUE 00082C** * INITIALIZE THE POINTERS TO IBUFF 00083 SWORD = 0 00084 SCHAR = 0 00085C** * INITIALIZE THE OTHER VARIABLES 00086 REQD = 0 00087 I = 0 00088 IERR = 0 00089 OPNTYP = 1 00090C** * REPEAT 000915030 CONTINUE 00092C** **** GET THE NEXT FIELD FROM THE INPUT ARRAY 00093ÐÐ CALL GETFLD(IBUFF,FIELD,SWORD,SCHAR,STAT) 00094C** **** IF THE DELIMITER IS AN EQUAL SIGN(=) THEN 00095 IF (.NOT.( STAT.EQ.3 )) GO TO 5040 00096C** ******* IF THE PREVIOUS DELIMITER WAS NOT AN EQUAL SIGN THEN 00097 IF (.NOT.( I.EQ.0 )) GO TO 5050 00098C** ********** CALCULATE THE PARAMETER INDEX NUMBER 00099 CALL PARIDX(FIELD,INDEX,IERR) 00100C** ********** IF THERE WAS NO ERROR THEN 00101 IF (.NOT.( IERR.EQ.0 )) GO TO 5060 00102C** ************* IF THE INDEX IS GREATER THAN 4 THEN 00103 IF (.NOT.( INDEX.GT.4 )) GO TO 5070 00104C** **************** THIS IS ERROR 17 (= SIGN USED) 00105 IERR = ERR17 00106C** ************* ELSE 00107 GO TO 5080 001085070 CONTINUE 00109C** **************** IF THE INDEX IS 4 THEN 00110 IF (.NOT.( INDEX.EQ.4 )) GO TO 5090 00111C** ******************* SET I TO -1 TO FLAG 'LU' 00112 I = -1 00113C** **************** ELSE 00114 GO TO 5100 001155090 CONTINUE 00116C** ******************* SET I TO INDEX INTO THE IDATA ADDAY 00117 I = 4*(INDEX-1)+1 00118ÐÐC** **************** ENDIF; 001195100 CONTINUE 00120C** ************* (ELSE) 00121C** ************* ENDIF; 001225080 CONTINUE 00123C** ********** (ELSE) 00124C** ********** ENDIF; 001255060 CONTINUE 00126C** ******* ELSE 00127 GO TO 5110 001285050 CONTINUE 00129C** ********** THIS IS ERROR 17 (TWO EQUAL SIGNS) 00130 IERR = ERR17 00131C** ******* ENDIF; 001325110 CONTINUE 00133C** **** ELSE 00134 GO TO 5120 001355040 CONTINUE 00136C** ******* THE DELIMITER MUST BE A COMMA, END OF LINE OR A COMMENT 00137C** ******* IF THERE WAS A PREVIOUS EQUAL SIGN THEN 00138 IF (.NOT.( I.NE.0 )) GO TO 5130 00139C** ********** IF I IS NEGATIVE THEN 00140 IF (.NOT.( I.LT.0 )) GO TO 5140 00141C** ************* IF THE SECOND WORD OF THE FIELD IS ' 'THEN 00142 IF (.NOT.( FIELD2.EQ.BLANKS )) GO TO 5150 00143ÐÐC** **************** SET BIT 1 IN THE REQUIRED FLAG 00144 REQD = OR(REQD,2) 00145C** **************** CONVERT THE LU VALUE TO BINARY 00146 LUTEMP = LUUPR 00147 LU = CONVRT(LUTEMP,IERR) 00148 LUTEMP = LULOW 00149 IF (.NOT.( LUTEMP.NE.$20 )) GO TO 5160 00150 LU = 10*LU+CONVRT(LUTEMP,IERR) 001515160 CONTINUE 00152C** **************** IF NO ERROR OCCURRED IN THE CONVERSION THEN 00153 IF (.NOT.( IERR.EQ.0 )) GO TO 5170 00154C** ******************* IF THIS IS NOT A PSEUDO-TAPE LU THEN 00155 IF (.NOT.( IVPTTC(LU).EQ.0 )) GO TO 5180 00156C** ********************** THIS IS ERROR 19 00157 IERR = ERR19 00158C** ******************* (ELSE) 00159C** ******************* ENDIF; 001605180 CONTINUE 00161C** **************** (ELSE) 00162C** **************** ENDIF; 001635170 CONTINUE 00164C** ************* ELSE 00165 GO TO 5190 001665150 CONTINUE 00167C** **************** THIS IS ERROR 18 (ILLEGAL LU) 00168ÐÐ IERR = ERR18 00169C** ************* ENDIF; 001705190 CONTINUE 00171C** ********** ELSE 00172 GO TO 5200 001735140 CONTINUE 00174C** ************* IF THIS IS THE FILE NAME THEN 00175 IF (.NOT.( I.EQ.1 )) GO TO 5210 00176C** **************** SET BIT 0 OF THE REQUIRED FLAG 00177 REQD = OR(REQD,1) 00178C** ************* (ELSE) 00179C** ************* ENDIF; 001805210 CONTINUE 00181C** ************* MOVE THE FIELD TO THE IDATA ARRAY 00182 I5220 = 0 00183 J5220 = 3 00184 K5220 = 1 00185 DO 5220 J = I5220 , J5220 , K5220 00186 K = J+I 00187 IDATA(K) = FIELD(J+1) 001885220 CONTINUE 00189C** ********** ENDIF; 001905200 CONTINUE 00191C** ********** CLEAR THE EQUAL SIGN FLAG 00192 I = 0 00193ÐÐC** ******* ELSE 00194 GO TO 5230 001955130 CONTINUE 00196C** ********** CALCULATE THE PARAMETER INDEX 00197 CALL PARIDX(FIELD,INDEX,IERR) 00198C** ********** IF THIS PARAMETER DOES NOT REQUIRE AN = SIGN THEN 00199 IF (.NOT.( INDEX.GE.5 )) GO TO 5240 00200C** ************* IF THIS IS A READ/WRITE PARAMETER THEN 00201 IF (.NOT.( INDEX.LE.7 )) GO TO 5250 00202C** **************** CALCULATE THE TYPE OF OPEN REQUIRED 00203 OPNTYP = INDEX-4 00204C** ************* ELSE 00205 GO TO 5260 002065250 CONTINUE 00207C** **************** IF THIS IS A FILE LOCK PARAMETER THEN 00208 IF (.NOT.( INDEX.EQ.8 )) GO TO 5270 00209C** ******************* SET WORD 15 OF IDATA TO -1 00210 IDATA(15) = -1 00211C** **************** ELSE 00212 GO TO 5280 002135270 CONTINUE 00214C** ******************* SET WORD 15 OF IDATA TO 1 00215 IDATA(15) = 1 00216C** **************** ENDIF; 002175280 CONTINUE 00218ÐÐC** ************* ENDIF; 002195260 CONTINUE 00220C** ********** ELSE 00221 GO TO 5290 002225240 CONTINUE 00223C** ************* IF THERE IS NO ERROR YET THEN 00224 IF (.NOT.( IERR.EQ.0 )) GO TO 5300 00225C** **************** THIS IS ERROR 16 (MISSING = SIGN) 00226 IERR = ERR16 00227C** ************* (ELSE) 00228C** ************* ENDIF; 002295300 CONTINUE 00230C** ********** ENDIF; 002315290 CONTINUE 00232C** ******* ENDIF; 002335230 CONTINUE 00234C** **** ENDIF; 002355120 CONTINUE 00236C** **** UNTIL THERE IS AN ERROR OR THE END OF INFORMATION IS REACHED 00237 IF (.NOT.( IERR.NE.0.OR.STAT.EQ.2.OR.STAT.EQ.1 )) GO TO 5030 00238C** * ENDREPEAT; 00239C** * IF NO ERROR OCCURRED THEN 00240 IF (.NOT.( IERR.EQ.0 )) GO TO 5310 00241C** **** IF ALL OF THE REQUIRED PARAMETERS WERE ENTERED THEN 00242 IF (.NOT.( REQD.EQ.3 )) GO TO 5320 00243ÐÐC** ******* OPEN THE REQUESTED FILE 00244 CALL OPENFL(REQBUF,IDATA,ISTAT) 00245C** ******* IF NO ERROR OCCURRED THEN 00246 IF (.NOT.( ISTAT.GE.0 )) GO TO 5330 00247C** ********** OPEN THE PSEUDO-TAPE 00248 CALL PTOPEN(LU,REQBUF,OPNTYP,ISTAT) 00249C** ********** IF AN ERROR OCCURRED THEN 00250 IF (.NOT.( ISTAT.LT.0 )) GO TO 5340 00251C** ************* THIS IS ERROR 10 00252 IERR = ERR10 00253C** ********** (ELSE) 00254C** ********** ENDIF; 002555340 CONTINUE 00256C** ******* ELSE 00257 GO TO 5350 002585330 CONTINUE 00259C** ********** IF BIT 5 OF THE ERROR STATUS IS SET THEN 00260 IF (.NOT.( AND(ISTAT,$20).NE.0 )) GO TO 5360 00261C** ************* THIS IS ERROR 9 00262 IERR = ERR09 00263C** ********** ELSE 00264 GO TO 5370 002655360 CONTINUE 00266C** ************* THIS IS ERROR 10 00267 IERR = ERR10 00268ÐÐC** ********** ENDIF; 002695370 CONTINUE 00270C** ******* ENDIF; 002715350 CONTINUE 00272C** **** ELSE 00273 GO TO 5380 002745320 CONTINUE 00275C** ******* THIS IS ERROR 21 00276 IERR = ERR21 00277C** **** ENDIF; 002785380 CONTINUE 00279C** * (ELSE) 00280C** * ENDIF; 002815310 CONTINUE 00282 RETURN 00283 END 00284 SUBROUTINE PARIDX(FIELD,INDEX,IERR) 00001 1 /J02 F ITOS CCS 3.0 SL-149 00002C CREDIT COLLECTION SYSTEM VERSION 3.0 00003C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00004C COPYRIGHT CONTROL DATA CORPORATION 1979 00005 INTEGER FIELD(1) 00006 INTEGER INDEX 00007 INTEGER IERR 00008 INTEGER DONE 00009ÐÐ INTEGER ERR04 00010 INTEGER BLANKS 00011 INTEGER NAMES(9) 00012C 00013 DATA BLANKS /' '/ 00014 DATA ERR04 /'04'/ 00015 DATA NAMES /'FNOWVLLUR A W FLRL'/ 00016C 00017 RELATIVE Q8PKUP 00018 RELATIVE Q8PREP 00019C** * INITIALIZE THE INDEX AND DONE FLAG 00020 INDEX = 0 00021 DONE = 0 00022C** * IF THE SECOND WORD OF THE PASSES FIELD IS BLANKS THEN 00023 IF (.NOT.( FIELD(2).EQ.BLANKS )) GO TO 5010 00024C** **** REPEAT 000255020 CONTINUE 00026C** ******* IF THIS NAME IS THE CORRECT ONE THEN 00027 IF (.NOT.( NAMES(INDEX+1).EQ.FIELD(1) )) GO TO 5030 00028C** ********** SET THE DONE FLAG TRUE 00029 DONE = 1 00030C** ******* (ELSE) 00031C** ******* ENDIF; 000325030 CONTINUE 00033C** ******* INCREMENT THE INDEX 00034ÐÐ INDEX = INDEX+1 00035C** ******* UNTIL THE NAME IS FOUND OR ALL ENTRIES HAVE BEEN TRIED 00036 IF (.NOT.( DONE.EQ.1.OR.INDEX.EQ.9 )) GO TO 5020 00037C** * ENDREPEAT 00038C** * (ELSE) 00039C** * ENDIF; 000405010 CONTINUE 00041C** * IF THE NAME WAS NOT FOUND THEN 00042 IF (.NOT.( DONE.EQ.0 )) GO TO 5040 00043C** **** RESET THE INDEX 00044 INDEX = 0 00045C** **** SET THE ERROR INDICATOR FOR ERROR 04 00046 IERR = ERR04 00047C** * (ELSE) 00048C** * ENDIF; 000495040 CONTINUE 00050 RETURN 00051 END 00052 INTEGER FUNCTION CONVRT(NUM,IERR) 00001 1 /J03 F ITOS CCS 3.0 SL-149 00002C CREDIT COLLECTION SYSTEM VERSION 3.0 00003C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00004C COPYRIGHT CONTROL DATA CORPORATION 1979 00005 INTEGER NUM 00006 INTEGER IERR 00007ÐÐ INTEGER ERR18 00008C 00009 DATA ERR18 /'18'/ 00010C 00011 RELATIVE Q8PKUP 00012 RELATIVE Q8PREP 00013C** * IF THIS IS NOT A LEGAL DECIMAL NUMBER THEN 00014 IF (.NOT.( NUM.LT.$30.OR.NUM.GT.$39 )) GO TO 5010 00015C** **** THIS IS ERROR 18 00016 IERR = ERR18 00017C** * ELSE 00018 GO TO 5020 000195010 CONTINUE 00020C** **** CONVERT THE ASCII DIGIT TO DECIMAL 00021 CONVRT = NUM-$30 00022C** * ENDIF; 000235020 CONTINUE 00024 RETURN 00025 END 00026 PROGRAM SAVLAB 00001 1 /J04 F ITOS CCS 3.0 SL-149 00002C CREDIT COLLECTION SYSTEM VERSION 3.0 00003C COPYRIGHT CONTROL DATA CORPORATION, 1978 00004C DATA SYSTEMS,LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00005C 00006ÐÐC 00007C THIS PROGRAM REWRITES THE VOLUME LABEL FROM ADDRESS '0' TO 00008C ADDRESS '7000'. THIS IS TO ENABLE THE CREATION OF A NEW 00009C SYSTEM, VIA DTLP...... 00010C 00011C COMPLETED / TESTED 10/15/78 JPM 00012C 00013C 00014 RELATIVE FREAD 00015 RELATIVE FWRITE 00016 RELATIVE DISPAT 00017 RELATIVE RELESE 00018C 00019C 00020 00021C 00022C 00023 INTEGER CONSOL, IFLAG 00024 INTEGER LABBUF (96) 00025 INTEGER DSKLU 00026 INTEGER TEMP(8) 00027 INTEGER LTH(3) 00028 INTEGER BUF(27) 00029 INTEGER LTH1(3) 00030C 00031ÐÐC 00032 DATA LABL /27/ 00033 DATA CONSOL / 4 / 00034 DATA DSKLU / 8 / 00035 DATA LTH / 96, 0, 0/ 00036 DATA LTH1 /96, 0, $7000/ 00037 DATA BUF /'VOLUME LABEL HAS BEEN SAVED AT SECTOR 7000 ON DRIVE 0'/ 00038C 00039C 00040 ASSEM $C0EF, $6800, IFLAG 00041C 00042C 00043 ASSIGN 110 TO IRTN 00044 DO 100 I = 1, 96 00045 100 LABBUF (I) = $2020 00046 CALL FREAD (DSKLU,LABBUF,LTH,IRTN,IFLAG,TEMP) 00047 CALL DISPAT 00048 110 ASSIGN 120 TO IRTN 00049 CALL FWRITE (DSKLU,LABBUF,LTH1,IRTN,IFLAG,TEMP) 00050 CALL DISPAT 00051 120 ASSIGN 130 TO IRTN 00052 CALL FWRITE (CONSOL,BUF,LABL,IRTN,IFLAG,TEMP) 00053 CALL DISPAT 00054 130 CONTINUE 00055C 00056ÐÐC RELEASE CORE AND EXIT. 00057 ASSEM $C805,$0901,$6803,$54F4,$1901,SAVLAB 00058C 00059C 00060 END 00061 PROGRAM RESLAB 00001 1 /J05 F ITOS CCS 3.0 SL-149 00002C RESTORE LABEL ORDINAL 00003C CREDIT COLLECTION SYSTEM VERSION 3.0 00004C COPYRIGHT CONTROL DATA CORPORATION, 1978 00005C DATA SYSTEMS, LA JOLLA DIVISION, LA JOLLA,CALIFORNIA 00006C 00007C 00008C THIS PROGRAM RESTORES THE VOLUME LABEL BACK TO ADDRESS '0' 00009C FROM ADDRESS $7000' AFTER DTLP..... 00010C 00011C COMPLETED / TESTED 10/15/78 JPM 00012C 00013C 00014 RELATIVE FREAD 00015 RELATIVE FWRITE 00016 RELATIVE DISPAT 00017 RELATIVE RELESE 00018C 00019C 00020ÐÐC 00021C 00022C 00023 INTEGER CONSOL,IFLAG 00024 INTEGER LABBUF(96) 00025 INTEGER DSKLU 00026 INTEGER TEMP(8) 00027 INTEGER LTH(3) 00028 INTEGER BUF (31) 00029 INTEGER BUF1 (15) 00030 INTEGER LTH1(3) 00031C 00032C 00033 DATA LABL /31/ 00034 DATA CONSOL / 4 / 00035 DATA DSKLU / 8 / 00036 DATA LTH /96, 0, 0/ 00037 DATA LTH1 /96, 0, $7000/ 00038 DATA BUF/'THE VOLUME LABEL HAS BEEN RESTORED FROM SECTOR 7000 ON D 00039 1RIVE 0'/ 00040 DATA BUF1/'SYSTEM MUST BE AUTOLOADED.....'/ 00041C 00042C 00043 ASSEM $C0EF, $6800, IFLAG 00044C 00045ÐÐC 00046 ASSIGN 110 TO IRTN 00047 DO 100 I = 1, 96 00048 100 LABBUF (I)=$2020 00049 CALL FREAD (DSKLU,LABBUF,LTH1,IRTN,IFLAG,TEMP) 00050 CALL DISPAT 00051 110 ASSIGN 120 TO IRTN 00052 CALL FWRITE (DSKLU,LABBUF,LTH,IRTN,IFLAG,TEMP) 00053 CALL DISPAT 00054 120 ASSIGN 130 TO IRTN 00055 CALL FWRITE (CONSOL,BUF,LABL,IRTN,IFLAG,TEMP) 00056 CALL DISPAT 00057 130 ASSIGN 140 TO IRTN 00058 CALL FWRITE (CONSOL,BUF1,15,IRTN,IFLAG,TEMP) 00059 CALL DISPAT 00060C KILL SYSTEM. 00061 140 CALL SYFAIL 00062C 00063C 00064C 00065 END 00066 MON 00001 NAM FMUTEQ Q01 A ITOS CCS 3.0 SL-149B0200001* FILE MANAGER UTILITY EXECUTIVE PROGRAM B0200002* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4867B0200003ÐÐ* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B0200004* COPYRIGHT CONTROL DATA CORPORATION 1979 B0200005* B0200006**** B0200007* B0200008* FMUTEX : FILE-MANAGER UTILITY EXECUTIVE 122*4873B0200009* B0200010* B0200011* FUNCTION B0200012* B0200013* THE EXECUTIVE DISPLAYS THE PROMPTING LINE(S) IF APPLICABLE B0200014* READS THE INPUT RECORD(S),CHECKS THE REQUESTED COMMAND CODE B0200015* LOADS AND TRANSFERS CONTROL TO THE REQUESTED PROCESSOR B0200016* B0200017* B0200018* GENERAL DESCRIPTION B0200019* B0200020* THE EXECUTIVE ACCEPTS INPUT FROM EITHER AN INTERACTIVE DEVICE B0200021* OR THE DEVICE IT WAS INITIATED ON B0200022* THE EXECUTIVE AND ITS PROCESSORS RUN UNDER THE ITOS 1.0 EXECUTIVEB0200023* IT ACCEPTS INPUT-STRINGS LIKE B0200024* B0200025* COMMAND CODE,PARAMETER-STRING (CR) B0200026* OR B0200027* COMMAND CODE,PARAMETER-STRING;(CR) B0200028ÐÐ* PARAMETER-STRING (CR) B0200029* PARAMETER STRINGS ARE B0200030* P1,P2,P3 (P IS PARAMETER VALUE) B0200031* OR B0200032* P1,,P3 OR P1, ,P3 B0200033* OR B0200034* I1=P1,I2=P2,,I4=P4, ,I6=P6 (I=PARAMETER IDENT) B0200035* B0200036* ONLY THE FIRST FOUR CHARACTERS OF THE COMMAND CODE ARE CHECKED B0200037* B0200038* CONTROL LU IS ASSUMED TO BE THE INTERACTIVE DEVICE OR THE B0200039* DECLARED INPUT DEVICE,WHOEVER CALLED UTIL B0200040* B0200041* B0200042* FLOW B0200043* B0200044* ON ENTRY A RETURN JMP IS DONE TO PGMIN IN ORDER TO OBTAIN B0200045* THE ENTRY PARAMETERS (ID-USER,LUN,MODE,NOPORT) B0200046* BIT 12 OF LUNIT IS SET TO SPECIFY WORD-MODE I/O B0200047* INTERRUPT ADDR IS FMUT1 B0200048* IF IN INTERACTIVE MODE (MODE=0) A PROMPTING MSG IS DISPLAYED B0200049* TO INDICATE THE UTILITIES ARE LOADED B0200050* THE MSG IS B0200051* UTIL IN B0200052* READY B0200053ÐÐ* AND THE PROMPTING INDICATOR(PIND) IS SET TO ZERO B0200054* IF IN BATCH-MODE(MODE=NOT EQ 0) PIND=-1 B0200055* NEXT A READ WILL BE DONE TO READ IN THE REQUIRED COMMAND B0200056* AT COMPLETION OF THE READ,A CALL TO THE SUBROUTINE B0200057* GETFLD IS DONE TO OBTAIN THE FIRST FIELD OF THE INPUTBUFFER B0200058* (INBUF).THE FIRST FIELD IS MOVED TO ANOTHER BUFFER(CODE) B0200059* A CHECK IS DONE TO SEE IF CODE CONTAINS: B0200060* 1. EXIT B0200061* 2. INPUT B0200062* 3. OUTPUT B0200063* 4. HELP B0200064* IF ONE OF THESE IS FOUND,A JUMP TO THE CORRESPONDING B0200065* SUBPROGRAM WITHIN FMUTEX IS DONE B0200066* IF NONE OF THE ABOVE IS FOUND A CALL IS DONE TO THE B0200067* SUBROUTINE COMSEK B0200068* IF THE COMMAND CODE CANNOT BE FOUND,ERROR 31 IS DISPLAYED B0200069* ELSE A CHECK IS DONE TO SEE IF THE COMMAND IS ALLOWED TO B0200070* BE EXECUTED FROM THIS TERMINAL AND IF ITOS SHOULD OR B0200071* SHOULD NOT BE DISABLED. B0200072* THE 6 CHARACTER COMMAND NAME FOUND BY COMSEK WILL NOW B0200073* BE MOVED TO A BUFFER(CLBUF1) AND TO CODE B0200074* THE SCREEN WILL BE CLEARED AND THE COMMAND-NAME IS B0200075* DISPLAYED IF IN INTERACTIVE MODE B0200076* NEXT A FM-CALL IS MADE TO OBTAIN THE INFORMATION B0200077* NECESSARY TO READ IN THE COMMAND-PROCESSOR B0200078ÐÐ* THIS INFO IS CONTAINED IN FILE $$PGMNAM B0200079* THE COMMAND PROCESSOR IS READ INTO THE USER AREA(UTSTRT) B0200080* AND CONTROL IS TRANSFERRED TO THE COMMAND PROCESSOR B0200081* B0200082* B0200083* OUTPUT B0200084* B0200085* WHEN A JMP IS DONE TO UTSTRT TO START THE COMMAND B0200086* PROCESSOR THE FOLLOWING BUFFERS ARE SET B0200087* B0200088* INBUF CONTAINS THE FIRST LINE OF DATA IF READ FROM B0200089* A BATCH DEVICE B0200090* ELSE THE COMMAND-CODE B0200091* CODE CONTAINS THE 6 CHAR COMMAND-CODE B0200092* LUNIT CONTAINS THE LOG.UNIT NUMBER OF THE DEVICE B0200093* MODE IF 0 ,INTERACTIVE-ELSE BATCH-MODE B0200094* IDUSER USER-ID LOGGED IN WITH B0200095* NOPORT TERMINAL PORT NO. B0200096* SWORD START INDEX OF NEXT FIELD WORD IN INBUF B0200097* SBYTE START INDEX OF NEXT FIELD BYTE IN INBUF B0200098* PARLST ADDR OF THE CORRESPONDING PARAMETER LIST TABLE B0200099* PIND PROMPTING LEVEL INDICATOR (-1,0,+1) B0200100* B0200101* B0200102* SUBROUTINES B0200103ÐÐ* B0200104* PGMIN OBTAIN INPUT PARAMETERS B0200105* PGMOUT EXIT TO ITOS 1.0 EXECUTIVE B0200106* PGMINT ALLOW INTERRUPT B0200107* WTREAD TERMINAL WRITE/READ REQUEST B0200108* GETFLD GET NEXT FLD B0200109* OUTEQ SET OUTPUT TO BE THE SPECIFIED DEVICE B0200110* INPEQ SET INPUT TO BE THE SPECIFIED DEVICE B0200111* COMSEK SEARCH FOR COMMAND CODE B0200112* READR FM 2.0 READ FILE REQUEST B0200113* OPENFL FM 2.0 OPEN FILE REQUEST B0200114* CLOSFL FM 2.0 CLOSE FILE REQUEST B0200115* UTSTRT UTIL 1.0 PROCESSOR AREA B0200116* SYSMSG SYSTEM ERROR MSG ROUTINE B0200117* B0200118* PARAMETERS B0200119* B0200120* LABELED COMMON AREA B0200121* B0200122* COMCOD(133) COMMAND CODE TABLE B0200123* FOUR WORD ENTRIES B0200124* 0-2 6 CHARACTER COMMAND CODE B0200125* 3 ADDR OF CORRESPONDING PARAMETER B0200126* PROCESSING TABLE B0200127* B0200128ÐÐ* PARNAM(124) PARAMETER MNEMONIC TABLE B0200129* THREE WORD PER ENTRY B0200130* 1 TWO CHAR.PARAMETER IDENTIFIER B0200131* 2 LENGTH OF PARAMETER VALUE B0200132* WHEN ENTERED B0200133* 3 STORE AREA B0200134* PPHELP(2) PARAMETER PROCESSING TABLE FOR HELP B0200135* PPINIT(4) INIT B0200136* PPDEFI(17) DEFINE B0200137* PPSTAT(4) STATUS B0200138* PPRELO(5) RELOAD 122*4875B0200139* PPDUMP(5) DUMP 122*4875B0200140* PPCOPY(6) COPY B0200141* PPDELE(4) DELETE B0200142* PPCLEA(3) CLEAR B0200143* PPLIST(6) LIST 122*4875B0200144* PPREANA(5) RENAME B0200145* PPCOMM(2) COMMAND B0200146* PPEXIT(1) EXIT B0200147* PPMOUN(3) MOUNT B0200148* PPDISM(2) DISMOUNT B0200149* PPSAVE(3) SAVE B0200150* PPBATC(8) BATCH B0200151* PPLOAD(6) LOAD B0200152* PPPURG(3) PURGE B0200153ÐÐ* PPINPU(2) INPUT B0200154* PPOUTP(2) OUTPUT B0200155* PPCOMP(3) COMPRESS B0200156* PPHOST(4) HOST B0200157* PPSET(3) SET B0200158* PPBATS(4) BATCH STATUS B0200159* PPDISC(2) DISCARD B0200160* PPDISP(7) DISPOSE B0200161* PPFLUSH(3) FLUSH B0200162* PPPRINT(3) PRINT B0200163* DUMMY(6) TEMPORARY STORE AREA OF SOME PARAMETERS B0200164* INBUF(41) INPUT BUFFER TO READ IN B0200165* CODE(20) OUTPUT BUFFER FROM GETFLD B0200166* LUNIT LOGICAL UNIT NO OF THIS TERMINAL B0200167* MODE INDICATES INTERACTIVE MODE OR BATCH MODE B0200168* IDUSER(4) USER-ID LOGGED IN WITH B0200169* NOPORT TERMINAL PORT NO B0200170* SWORD INDEX USED BY GETFLD B0200171* SBYTE INDEX USED BY GETFLD B0200172* PARLST ADDR OF PARAMETER PROCESSING TABLE B0200173* NOCOD ALARM INDICATOR USED BY COMSEK B0200174* PIND PROMPTING LEVEL INDICATOR B0200175* REQBUF(24) USED BY FM 2.0 CALLS REFER TO ERS FM 2.0 B0200176* IDATA(24) USED BY FM 2.0 CALLS REFER TO ERS FM 2.0 B0200177* PARDEF(24) CONTAINS DEFAULTS FOR IDATA B0200178ÐÐ* FCBHDR(5) REFER TO ERS FM 2.0 B0200179* FDBBUF(96) FILE CONTROL BLOCK REFER TO ERS FM 2.0 B0200180* B0200181* B0200182* MESSAGES B0200183* B0200184* UTIL IN INDICATES THE UTILITIES ARE LOADED B0200185* READY READY TO ACCEPT NEXT UTIL 1.0 COMMAND B0200186* B0200187* ERROR MESSAGES B0200188* B0200189* 30 REQUESTED PROCESSOR NOT FOUND B0200190* 31 REQUESTED UTIL COMMAND ILLEGAL B0200191* 32 ILLEGAL COMMAND FORMAT B0200192* 75 ITOS SHOULD BE DISABLED B0200193* 76 SUPERVISOR COMMAND ONLY B0200194* B0200195* MISC B0200196* B0200197* SUPERVISOR COMMAND TABLE SUPCOM B0200198* B0200199**** B0200200 EJT B0200201* B0200202* ENTRY POINTS B0200203ÐÐ* B0200204 ENT FMUTEX B0200205* B0200206* EXTERNALS B0200207* B0200208 EXT PGMIN B0200209 EXT PGMOUT B0200210 EXT PGMINT B0200211 EXT WTREAD B0200212 EXT GETFLD B0200213 EXT OUTEQ B0200214 EXT INPEQ B0200215 EXT COMSEK B0200216 EXT READR B0200217 EXT OPENFL B0200218 EXT CLOSFL B0200219 EXT UTSTRT B0200220 EXT SYSMSG B0200221 EXT TSNABL ITOS ENABLE FLAG B0200222* B0200223* EQUATES B0200224* B0200225 EQU INPLEN(40) LENGTH OF INPUT BUFFER B0200226 EQU ZROBIT($33) B0200227 EQU ONEBIT($23) B0200228ÐÐ EQU ONE($03) B0200229 EQU TWO($24) B0200230 EJT B0200231* B0200232* LABELED COMMON AREA B0200233* B0200234 DAT COMCOD(133),PARNAM(124) B0200235 DAT PPHELP(2) B0200236 DAT PPINIT(4) B0200237 DAT PPDEFI(17) DEFINE B0200238 DAT PPSTAT(4) B0200239 DAT PPRELO(5) 122*4875B0200240 DAT PPDUMP(5) 122*4875B0200241 DAT PPCOPY(6) B0200242 DAT PPDELE(4) DELETE B0200243 DAT PPCLEA(3) B0200244 DAT PPLIST(6) 122*4875B0200245 DAT PPRENA(5) B0200246 DAT PPCOMM(2) B0200247 DAT PPEXIT(1) B0200248 DAT PPMOUN(3) B0200249 DAT PPDISM(2) B0200250 DAT PPSAVE(3) B0200251 DAT PPBATC(8) BATCH B0200252 DAT PPLOAD(6) LOAD B0200253ÐÐ DAT PPPURG(3) B0200254 DAT PPINPU(2) B0200255 DAT PPOUTP(2) B0200256 DAT PPCOMP(3) B0200257 DAT PPHOST(4) HOST B0200258 DAT PPSET(3) SET B0200259 DAT PPBATS(4) BATCH STATUS B0200260 DAT PPDISC(2) DISCARD B0200261 DAT PPDISP(7) B0200262 DAT PPFLUS(3) FLUSH B0200263 DAT PPPRIN(3) PRINT B0200264 DAT DUMMY(6) B0200265 DAT INBUF(41),CODE(20) B0200266 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B0200267 DAT REQBUF(24),IDATA(24) B0200268 DAT PARDEF(24) B0200269 DAT FCBHDR(5) B0200270 DAT FCBBUF(96) B0200271 DAT ISPARE(69) SPARE LABELED COMMON B0200272 EQU ENDCOM(ISPARE+69) END OF COMMON AREA B0200273 EQU COMLEN(ENDCOM-COMCOD) B0200274 EJT B0200275* B0200276* ZEROISE ALL OF LABELED COMMON B0200277* B0200278ÐÐ ORG COMCOD B0200279 BZS ZEROES(COMLEN) B0200280* B0200281 ORG PIND B0200282 NUM -1 PRESET PROMPTING LEVEL B0200283* B0200284* COMMAND CODE TABLE B0200285* B0200286 ORG COMCOD B0200287 ALF 3,HELP B0200288 ADC PPHELP B0200289 ALF 3,INIT B0200290 ADC PPINIT B0200291 ALF 3,DEFINE B0200292 ADC PPDEFI B0200293 ALF 3,STATUS B0200294 ADC PPSTAT B0200295 ALF 3,RELOAD B0200296 ADC PPRELO B0200297 ALF 3,DUMP B0200298 ADC PPDUMP B0200299 ALF 3,COPY B0200300 ADC PPCOPY B0200301 ALF 3,DELETE B0200302 ADC PPDELE B0200303ÐÐ ALF 3,CLEAR B0200304 ADC PPCLEA B0200305 ALF 3,LIST B0200306 ADC PPLIST B0200307 ALF 3,RENAME B0200308 ADC PPRENA B0200309 ALF 3,COMMAND B0200310 ADC PPCOMM B0200311 ALF 3,EXIT B0200312 ADC PPEXIT B0200313 ALF 3,MOUNT B0200314 ADC PPMOUN B0200315 ALF 3,DISMOUNT B0200316 ADC PPDISM B0200317 ALF 3,SAVE B0200318 ADC PPSAVE B0200319 ALF 3,BATCH B0200320 ADC PPBATC B0200321 ALF 3,LOAD B0200322 ADC PPLOAD B0200323 ALF 3,PURGE B0200324 ADC PPPURG B0200325 ALF 3,INPUT B0200326 ADC PPINPU B0200327 ALF 3,OUTPUT B0200328ÐÐ ADC PPOUTP B0200329 ALF 3,COMPRES B0200330 ADC PPCOMP B0200331 ALF 3,HOST B0200332 ADC PPHOST B0200333 ALF 3,SET B0200334 ADC PPSET B0200335 ALF 3,BATS BATCH FILE STATUS. B0200336 ADC PPBATS B0200337 ALF 3,DISCARD B0200338 ADC PPDISC B0200339 ALF 3,DISPOSE B0200340 ADC PPDISP B0200341 ALF 3,FLUSH B0200342 ADC PPFLUSH B0200343 ALF 3,PRINT B0200344 ADC PPPRIN B0200345 NUM $FFFF END OF TABLE B0200346 EJT B0200347* B0200348 ORG PARNAM B0200349* B0200350* PARAMETER MNEMONIC TABLE B0200351* B0200352* WORD 1 = TWO CHAR.PARAMETER IDENTIFIER B0200353ÐÐ* B0200354* 2 = PARAMETER VALUE LENGTH IN BYTES B0200355* B0200356* 3 = POINTER TO IDATA IF APPLICABLE B0200357* POINTER TO FCBBUF IF APPLICABLE B0200358* OR TO TEMPORARY SAVE AREA (DUMMY) B0200359* B0200360* FOR IDATA REFER TO FILE-MANAGER 2.0 ERS B0200361* B0200362 ALF 1,FN 1 FILE-NAME B0200363 NUM 8 B0200364 ADC IDATA B0200365 ALF 1,OW 2 OWNER-NAME B0200366 NUM 8 B0200367 ADC IDATA+4 B0200368 ALF 1,VL 3 VOLUME-NAME B0200369 NUM 8 B0200370 ADC IDATA+8 B0200371 ALF 1,DK 4 DISK-UNIT B0200372 NUM 2 B0200373 ADC DUMMY+2 B0200374 ALF 1,NF 5 NO.OF FILES B0200375 NUM 4 B0200376 ADC DUMMY B0200377 ALF 1,ED 6 EXPIRATION DATE B0200378ÐÐ NUM 6 B0200379 ADC FCBBUF+88 B0200380 ALF 1,TY 7 FILE-TYPE B0200381 NUM 1 B0200382 ADC IDATA+15 B0200383 ALF 1,LR 8 LENGTH OF RECORD B0200384 NUM 5 B0200385 ADC IDATA+12 B0200386 ALF 1,NR 9 NO. OF RECORDS B0200387 NUM 8 B0200388 ADC IDATA+13 B0200389 ALF 1,K1 10 KEY1 B0200390 NUM 2 B0200391 ADC IDATA+16 B0200392 ALF 1,P1 11 KEY11 POSTION B0200393 NUM 4 B0200394 ADC IDATA+17 B0200395 ALF 1,K2 12 KEY2 B0200396 NUM 2 B0200397 ADC IDATA+18 B0200398 ALF 1,P2 13 KEY2 POSITION B0200399 NUM 4 B0200400 ADC IDATA+19 B0200401 ALF 1,K3 14 KEY3 B0200402 NUM 2 B0200403ÐÐ ADC IDATA+20 B0200404 ALF 1,P3 15 KEY3 POSITION B0200405 NUM 4 B0200406 ADC IDATA+21 B0200407 ALF 1,K4 16 KEY4 B0200408 NUM 2 B0200409 ADC IDATA+22 B0200410 ALF 1,P4 17 KEY4 POSITION B0200411 NUM 4 B0200412 ADC IDATA+23 B0200413 ALF 1,SA 18 SECTOR ALIGNMENT B0200414 NUM 1 B0200415 ADC IDATA+15 B0200416 ALF 1,I 19 INPUT-UNIT B0200417 NUM 8 B0200418 ADC DUMMY B0200419 ALF 1,P 20 OUTPUT-UNIT B0200420 NUM 8 B0200421 ADC DUMMY B0200422 ALF 1,M 21 MODE B0200423 NUM 1 B0200424 ADC DUMMY+5 B0200425 ALF 1,L 22 LIST-UNIT B0200426 NUM 8 B0200427 ADC DUMMY B0200428ÐÐ ALF 1,F2 23 FILE-NAME 2 B0200429 NUM 8 B0200430 ADC IDATA B0200431 ALF 1,V2 24 VOLUME-NAME 2 B0200432 NUM 8 B0200433 ADC IDATA+8 B0200434 ALF 1,D2 25 DISK 2 B0200435 NUM 2 B0200436 ADC DUMMY+2 B0200437 ALF 1,PN 26 PROGRAM NAME B0200438 NUM 6 B0200439 ADC DUMMY B0200440 ALF 1,F 27 FORMAT SPECIFICATION 122*4869B0200441 NUM 1 122*4869B0200442 ADC DUMMY+4 122*4869B0200443 ALF 1,HO 28 HOST NAME B0200444 NUM 4 B0200445 ADC DUMMY+4 B0200446 ALF 1,OP 29 OPTION B0200447 NUM 6 B0200448 ADC IDATA+19 B0200449 ALF 1,NC 30 NUMBER OF CHARACTERS B0200450 NUM 3 B0200451 ADC DUMMY B0200452 ALF 1,SC 31 STARTING CHARACTER B0200453ÐÐ NUM 3 B0200454 ADC DUMMY+4 B0200455 ALF 1,DO 32 DAYS OLD B0200456 NUM 3 B0200457 ADC DUMMY B0200458 ALF 1,PT 33 PROTOCOL TYPE B0200459 NUM 2 B0200460 ADC DUMMY B0200461 ALF 1,JN 34 JOB NUMBER B0200462 NUM 4 B0200463 ADC IDATA+22 B0200464 ALF 1,LU 35 BATCH INPUT LU B0200465 NUM 2 B0200466 ADC DUMMY B0200467 ALF 1,M 36 BATCH MODE B0200468 NUM 1 B0200469 ADC IDATA+17 B0200470 NUM 0 END OF TABLE B0200471* B0200472 EJT B0200473* B0200474* PARAMETER PROCESSING TABLE B0200475* B0200476* BIT SET TO DESCRIPTION B0200477* B0200478ÐÐ* 00-07 NN INDEX TO PARAMETER MNEMONIC TABLE (PARNAM)B0200479* 08 0 RIGHT JUSTIFY B0200480* 1 LEFT JUSTIFY B0200481* 09 0 NO CONVERSION B0200482* 1 ASCII-BINARY CONVERSION B0200483* 10 0 ONE-WORD BINARY OUTPUT B0200484* 1 TWO-WORD BINARY OUTPUT B0200485* 11 0 STANDARD PROCESSING B0200486* 1 SPECIAL PROCESSING(SA,TY) B0200487* 12 0 REQUIRED PARAMETER B0200488* 1 OPTIONAL PARAMETER B0200489* 13-14 NOT USED B0200490* 15 FOUND FLAG B0200491* B0200492 ORG PPHELP B0200493 NUM $1015 B0200494 NUM 0 B0200495 ORG PPINIT B0200496 NUM $0103 INIT VL B0200497 NUM $1205 NF B0200498 NUM $0204 DK B0200499 NUM 0 END OF PARAMETER STRING B0200500 ORG PPDEFI B0200501 NUM $0101 DEFINE FN B0200502 NUM $1102 DEFINE OW B0200503ÐÐ NUM $1103 VL B0200504 NUM $1006 ED B0200505 NUM $1807 TY B0200506 NUM $1208 LR B0200507 NUM $1609 NR B0200508 NUM $120A K1 B0200509 NUM $120B P1 B0200510 NUM $120C K2 B0200511 NUM $120D P2 B0200512 NUM $120E K3 B0200513 NUM $120F P3 B0200514 NUM $1210 K4 B0200515 NUM $1211 P4 B0200516 NUM $1812 SA B0200517 NUM 0 END OF PARAMETER STRING B0200518 ORG PPSTAT B0200519 NUM $1101 STATUS FN B0200520 NUM $1102 OW B0200521 NUM $1103 VL B0200522 NUM 0 B0200523 ORG PPRELO B0200524 NUM $1101 RELOAD FN B0200525 NUM $1102 OW 122*4870B0200526 NUM $1103 VL B0200527 NUM $1813 I 122*4861B0200528ÐÐ NUM 0 B0200529 ORG PPDUMP B0200530 NUM $1101 DUMP FN B0200531 NUM $1102 OW B0200532 NUM $1103 VL B0200533 NUM $1814 P 122*4861B0200534 NUM $0 B0200535 ORG PPCOPY B0200536 NUM $0101 COPY FN B0200537 NUM $1103 VL B0200538 NUM $0117 F2 B0200539 NUM $1102 OW B0200540 NUM $1118 V2 B0200541 NUM 0 B0200542 ORG PPDELE B0200543 NUM $0101 DELETE FN B0200544 NUM $1102 DELETE OW B0200545 NUM $1103 VL B0200546 NUM 0 B0200547 ORG PPCLEA B0200548 NUM $0101 CLEAR FN B0200549 NUM $1103 VL B0200550 NUM 0 B0200551 ORG PPLIST B0200552 NUM $0101 LIST FN B0200553ÐÐ NUM $1103 VL B0200554 NUM $1815 M B0200555 NUM $1816 L B0200556 NUM $181B F 122*4869B0200557 NUM 0 B0200558 ORG PPRENA B0200559 NUM $0101 RENAME FN B0200560 NUM $1103 VL B0200561 NUM $1117 F2 B0200562 NUM $1006 ED B0200563 NUM 0 B0200564 ORG PPCOMM B0200565 NUM $1015 COMMAND M B0200566 NUM 0 B0200567 ORG PPEXIT B0200568 NUM 0 B0200569 ORG PPMOUN B0200570 NUM $0103 MOUNT VL B0200571 NUM $0204 DK B0200572 NUM 0 B0200573 ORG PPDISM B0200574 NUM $0204 DISMOUNT DK B0200575 NUM 0 B0200576 ORG PPSAVE B0200577 NUM $204 SAVE DK B0200578ÐÐ NUM $219 D2 B0200579 NUM 0 B0200580 ORG PPBATC B0200581 NUM $0101 BATCH FN B0200582 NUM $1102 OW B0200583 NUM $1103 VL B0200584 NUM $111C HO B0200585 NUM $1807 TY B0200586 NUM $111A PN B0200587 NUM $1824 BATCH MODE B0200588 NUM 0 B0200589 ORG PPLOAD B0200590 NUM $0101 LOAD FN B0200591 NUM $1102 LOAD OW B0200592 NUM $1103 VL B0200593 NUM $1813 I B0200594 NUM $1815 M B0200595 NUM 0 B0200596 ORG PPPURG B0200597 NUM $1102 PURGE OW B0200598 NUM $1103 VL B0200599 NUM 0 B0200600 ORG PPINPU B0200601 NUM $0813 I B0200602 NUM 0 B0200603ÐÐ ORG PPOUTP B0200604 NUM $0814 P B0200605 NUM 0 B0200606 ORG PPCOMP B0200607 NUM $0101 COMPRESS FN B0200608 NUM $1103 VL B0200609 NUM 0 B0200610 ORG PPHOST B0200611 NUM $011C HO B0200612 NUM $011D OP B0200613 NUM $0121 PT B0200614 NUM 0 B0200615 ORG PPSET B0200616 NUM $011C HO B0200617 NUM $0223 LU B0200618 NUM 0 B0200619 ORG PPBATS B0200620 NUM $1122 JN B0200621 NUM $111C HO B0200622 NUM $1116 L B0200623 NUM 0 B0200624 ORG PPDISC B0200625 NUM $0122 JN B0200626 NUM 0 B0200627 ORG PPDISP B0200628ÐÐ NUM $0122 JN B0200629 NUM $011D OP B0200630 NUM $121E NC B0200631 NUM $121F SC B0200632 NUM $1118 V2 B0200633 NUM $101 FN B0200634 NUM 0 B0200635 ORG PPFLUS B0200636 NUM $011C HO B0200637 NUM $0220 DO B0200638 NUM 0 B0200639 ORG PPPRIN B0200640 NUM $011D OP B0200641 NUM $1116 L B0200642 NUM 0 B0200643 NUM 0 END OF PPTAB B0200644 EJT B0200645* B0200646 ORG PARDEF B0200647**** B0200648* B0200649* PARAMETER DEFAULT VALUES ********* B0200650* B0200651 ALF 4, FILE NAME B0200652 ALF 4, OWNER NAME B0200653ÐÐ ALF 4, VOLUME NAME B0200654 NUM 192 RECORD LENGTH (BYTES) B0200655 NUM 0,1024 NO. OF RECORDS B0200656 NUM 0 S/A=N,SEQUENTIAL FILE 122*4874B0200657 NUM 1,1 LENGTH AND POSITION OF KEY 1 B0200658 NUM 0,0 LENGTH AND POSITION OF KEY 4 B0200659 NUM 0,0 LENGTH AND POSITION OF KEY 2 B0200660 NUM 0,0 LENGTH AND POSITION OF KEY 3 B0200661**** B0200662 ORG* B0200663 EJT B0200664* B0200665* START OF FILE-MANAGER UTILITIES EXECUTIVE B0200666* B0200667FMUTEX NOP B0200668 RTJ PGMIN OBTAIN ENTRY PARAMETERS B0200669 ADC IDUSER ASCII USER INFO B0200670 ADC LUNIT SYST LOG UNIT B0200671 ADC MODE CURRENT MODE OF OPERATION B0200672 ADC NOPORT USER TMNL PORT NO B0200673* B0200674 LDA LUNIT SET BIT 12 OF LUNIT FOR WORD-MODE B0200675 AND- ZROBIT+12 $EFFF B0200676 EOR- ONEBIT+12 $1000 B0200677 STA LUNIT B0200678ÐÐ* B0200679 RTJ PGMINT ALLOW INTERRUPT(EXCLAMATION MARK) B0200680 ADC IADDR B0200681 ADC ZRO B0200682* B0200683 LDA MODE ARE WE IN INTERACTIVE MODE B0200684 SAN FMUT0 NO B0200685 STA PIND SET PROMPTING LEVEL 0 B0200686* B0200687 RTJ WTREAD DISPLAY 'UTIL' B0200688 ADC LUNIT LOGIGAL UNIT NUMBER B0200689 ADC NOCUR NO CURSOR POSITIONING REQUESTED B0200690 ADC MSG1 OUTPUT BUFFER ADDRESS B0200691 ADC LENG1 LENGTH OF MSG 1 B0200692 ADC NOCUR NO CURSOR POSITIONING REQUESTED B0200693 ADC DUMMY B0200694 ADC ZRO B0200695 ADC TC TERMINATION CODE B0200696 JMP* FMUT2 B0200697FMUT0 ENA -1 B0200698 STA PIND SET PROMPTING LEVEL -1 B0200699 EJT B0200700* B0200701* READ NEXT LINE OF DATA FROM INPUT DEVICE B0200702* B0200703ÐÐFMUT1 RTJ PROMPT GO DISPLAY READY B0200704FMUT2 RTJ WTREAD B0200705 ADC LUNIT B0200706 ADC NOCUR NO CURSOR POSITIONING REQUESTED B0200707 ADC DUMMY B0200708 ADC ZRO B0200709 ADC NOCUR NO CURSOR POSITIONING REQUESTED B0200710 ADC INBUF B0200711 ADC BUFLEN B0200712 ADC TC B0200713* B0200714* INITIALIZE FOR COMMAND SEEK B0200715* B0200716 ENA 0 B0200717 STA END B0200718 STA SWORD B0200719 STA SBYTE B0200720 RTJ GETFLD B0200721 ADC INBUF INPUT STRING BUFFER (40 WORDS) B0200722 ADC CODE OUTPUT BUFFER (20 WORDS B0200723 ADC SWORD STARTING WORD INDEX B0200724 ADC SBYTE STARTING CHAR INDEX B0200725 ADC STATUS STATUS TO RETURN B0200726 LDA STATUS IS IT END OF STRING B0200727 SUB N2 B0200728ÐÐ SAN SCOMSK NO B0200729 RAO END YES,SET END FLAG B0200730 EJT B0200731* B0200732* START OF CHECKING COMMAND CODES B0200733* B0200734SCOMSK LDA CODE IS IT AN EXIT COMMAND B0200735 SUB EXCOM B0200736 SAN NOEND NO B0200737 JMP ENDUT1 YES,STOP EXECUTION B0200738* B0200739NOEND LDA CODE IS IT AN INPUT COMMAND B0200740 SUB INPCOM B0200741 SAN NOINP NO B0200742 LDA CODE+1 B0200743 SUB INPCOM+1 CHECK FOR PU B0200744 SAN NOINP B0200745 JMP CINPUT B0200746NOINP LDA CODE IS IT AN OUTPUT COMMAND B0200747 SUB OUTCOM B0200748 SAN NOOUT NO B0200749 JMP COUPU B0200750* B0200751NOOUT LDA CODE IS IT A HELP COMMAND B0200752 SUB HLPCOM B0200753ÐÐ SAZ CSTAT IT IS A HELP-COMMAND B0200754 JMP* NOHELP B0200755* B0200756CSTAT LDA STATUS FIELD TERMINATED BY AN EOL B0200757 INA -2 B0200758 SAZ PRO2 YES B0200759 INA 2 NO,TERMINATED BY A COMMA B0200760 SAZ PRO1 YES,PROMPTING LEVEL 1 IS SET B0200761 ENA 2 ILLEGAL COMMAND FORMAT B0200762 JMP ALARM B0200763PRO1 ENA 1 B0200764SETPRO STA PIND B0200765 JMP* FMUT1 GO,READ NEXT LINE B0200766* B0200767PRO2 LDA MODE ARE WE IN INTERACTIVE MODE B0200768 SAN NOPRO NO B0200769 CLR A YES B0200770 JMP* SETPRO B0200771* B0200772NOPRO ENA -1 NO PROMPTING B0200773 JMP* SETPRO B0200774* B0200775NOHELP RTJ COMSEK SEARCH COMCOD FOR CODE MATCH B0200776 ADC CODE B0200777 ADC NOCOD B0200778ÐÐ ADC PARLST B0200779* B0200780 LDQ NOCOD IS COMMAND LEGAL B0200781 SQP CMDFND YES B0200782 ENA 1 ILLEGAL COMMAND B0200783 JMP ALARM B0200784* B0200785CMDFND TRQ A CALCULATE INDEX TO SUPCOM B0200786 ARS 2 B0200787 STA- I B0200788 LDA SUPCOM,I B0200789 SAP CNDCHK CHECK CONDITIONS B0200790 ENA 1 31 REQUESTED COMMAND NOT LEGAL B0200791 JMP ALARM B0200792* B0200793* CONDITION CHECK B0200794* B0200795CNDCHK AND- ONE SHOULD ITOS BE DISABLED ? B0200796 SAZ CHKTML NO,CHECK FOR SUPERVISOR ONLY B0200797 LDA TSNABL GET ITOS ENABLED FLAG B0200798 SAZ CHKTML ITOS IS DISABLED B0200799 ENA 45 75 ITOS SHOULD BE DISABLED B0200800 JMP ALARM B0200801* B0200802* CHECK FOR SUPERVISOR TERMINAL ONLY COMMAND B0200803ÐÐ* B0200804CHKTML LDA SUPCOM,I B0200805 ARS 1 B0200806 AND- ONE B0200807 SAZ MOVCOM NOT A SUPERVISOR COMMAND B0200808 LDA NOPORT CHECK IF TERMINAL IS SUPERVISOR B0200809 SAZ MOVCOM YES,IT IS A SUPERVISOR B0200810 ENA 46 76 SUPERVISOR COMMAND ONLY B0200811 JMP ALARM B0200812* B0200813MOVCOM CLR A MOVE 6 CHAR. COMMAND CODE B0200814 STA- I B0200815 LDA UT STORE UT IN FRONT OF THE B0200816 STA CODE PROCESSOR NAME TO CALL IN THE FILE B0200817MVCMD LDA COMCOD,B GET COMMAND FROM COMCOD TABLE B0200818 STA CODE+1,I B0200819 STA CLBUF1,I B0200820 LDA- I CHECK IF COMMAND MOVED COMPLETELY B0200821 SUB- TWO B0200822 SAZ DSPPRG DISPLAY PROCESSOR NAME B0200823 RAO- I B0200824 JMP* MVCMD B0200825* B0200826DSPPRG LDA MODE INTERACTIVE ? B0200827 SAN LDPGM NO B0200828ÐÐ RTJ WTREAD CLEAR SCREEN AND DISPLAY PROC.NAME B0200829 ADC LUNIT B0200830 ADC NOCUR B0200831 ADC CLBUF B0200832 ADC LENCL B0200833 ADC NOCUR B0200834 ADC DUMMY B0200835 ADC ZRO B0200836 ADC TC B0200837* B0200838* CLEAR REQUEST BUFFER B0200839* B0200840LDPGM LDQ =N23 B0200841LDP1 CLR A B0200842 STA REQBUF,Q B0200843 INQ -1 B0200844 SQM LDPG B0200845 JMP* LDP1 B0200846* B0200847LDPG LDA =XFCBHDR B0200848 STA REQBUF+9 B0200849* B0200850 RTJ OPENFL OPEN THE PROG.NAME FILE B0200851 ADC REQBUF B0200852 ADC NDATA B0200853ÐÐ ADC STATUS RETURN STATUS OF FM REQUEST B0200854* B0200855 LDA STATUS CHECK IF OPENED CORRECTLY B0200856 SAZ RDNAM YES B0200857 ENA 3 NO,FILE REQUEST REJECTED B0200858 JMP ALARM B0200859* B0200860RDNAM RTJ READR READ THE DESIRED ENTRY B0200861 ADC REQBUF B0200862 ADC INFO 6 WORD OUTPUT BUFFER B0200863 ADC CODE CONTAINS THE PRG.NAME ASKED FOR B0200864 ADC STATUS B0200865* B0200866 RTJ CLOSFL CLOSE THE PGMNAM FILE B0200867 ADC REQBUF B0200868 ADC ISTAT B0200869* B0200870 LDA STATUS CHECK IF PROGRAM FOUND B0200871 SAZ BLDREQ B0200872* B0200873 ENA 0 UTILITY PROCESSOR NOT FOUND B0200874 JMP* ALARM B0200875* B0200876BLDREQ LDA INFO+3 BUILD THE PGM READ REQUEST B0200877 STA* MSBP B0200878ÐÐ LDA INFO+4 B0200879 STA* LSBP B0200880 LDA INFO+5 B0200881 STA* PLEN B0200882* B0200883* READ IN THE DESIRED COMMAND PROCESSOR B0200884* B0200885REDPRO RTJ- ($F4) B0200886 NUM $4844 FREAD REQUEST B0200887 NUM 0 B0200888 NUM 0 B0200889 NUM $08C2 SYSTEM DISK B0200890PLEN NUM 0 B0200891 ADC UTSTRT B0200892MSBP NUM 0 B0200893LSBP NUM 0 B0200894* B0200895 RTJ UTSTRT START THE COMMAND PROCESSOR B0200896* B0200897 RTJ PGMINT RESET CONTROL D ENTRY B0200898 ADC IADDR B0200899 ADC ZRO B0200900 RTJ PGMIN OBTAIN ENTRY PARAMETERS B0200901 ADC IDUSER ASCII USER INFO B0200902 ADC LUNIT SYST LOG UNIT B0200903ÐÐ ADC MODE CURRENT MODE OF OPERATION B0200904 ADC NOPORT USER TMNL PORT NO B0200905* B0200906 LDA LUNIT SET BIT 12 FOR WORD MODE B0200907 AND- ZROBIT+12 B0200908 EOR- ONEBIT+12 B0200909 STA LUNIT B0200910* B0200911 LDA MODE HAS MODE CHANGED TO INTERACTIVE ? B0200912 SAN RDNXT NO B0200913 LDA PIND YES,CHECK PROMPTING INDICATOR B0200914 SAP RDNXT SET FOR PROMPTING ALREADY B0200915 CLR A SET FOR HELP MODE PROMPTING B0200916 STA PIND B0200917RDNXT JMP FMUT1 GO,READ NEXT COMAND B0200918 EJT B0200919* B0200920* CHANGE INPUT UNIT B0200921* B0200922CINPUT LDA* STATUS B0200923 SUB* N3 TERMINATED ON A =SIGN B0200924 SAZ RUNAM YES B0200925 ENA 2 ILLEGAL COMMAND FORMAT B0200926 JMP* ALARM NO B0200927* B0200928ÐÐ* READ UNIT NAME B0200929* B0200930RUNAM RTJ GETFLD B0200931 ADC INBUF B0200932 ADC CODE B0200933 ADC SWORD B0200934 ADC SBYTE B0200935 ADC STATUS B0200936* B0200937 LDA* STATUS B0200938 SUB* N2 IS IT END OF LINE B0200939 SAN CINP2 NO B0200940 RAO* END B0200941CINP2 RTJ INPEQ B0200942 ADC CODE B0200943 ADC STATUS B0200944* B0200945 LDA* STATUS IS COMMAND ACCEPTED ? B0200946 SAN IOER B0200947 JMP FMUT1 B0200948* B0200949IOER ENA $22 B0200950 JMP* ALARM B0200951 EJT B0200952* B0200953ÐÐ* CHANGE OUTPUT UNIT B0200954* B0200955COUPU RTJ GETFLD B0200956 ADC INBUF B0200957 ADC CODE B0200958 ADC SWORD B0200959 ADC SBYTE B0200960 ADC STATUS B0200961* B0200962 RTJ OUTEQ B0200963 ADC CODE B0200964 ADC STATUS B0200965* B0200966 LDA* STATUS B0200967 SAN OUTERR B0200968 JMP FMUT1 B0200969* B0200970OUTERR JMP* IOER B0200971 EJT B0200972* B0200973* DISPLAY READY DEPENDING UPON PIND B0200974* B0200975PROMPT NOP B0200976 LDA PIND PROMPTING WANTED B0200977 SAM EXT0 NO B0200978ÐÐ* B0200979 RTJ WTREAD B0200980 ADC LUNIT B0200981 ADC NOCUR NO CURSOR POSITIONING REQUESTED B0200982 ADC MSG2 B0200983 ADC LENG2 B0200984 ADC NOCUR NO CURSOR POSITIONING REQUESTED B0200985 ADC DUMMY B0200986 ADC ZRO B0200987 ADC TC B0200988* B0200989EXT0 JMP* (PROMPT) B0200990* B0200991ENDUT1 RTJ WTREAD DISPLAY END OF UTIL MESSAGE B0200992 ADC LUNIT B0200993 ADC NOCUR B0200994 ADC ENDMSG B0200995 ADC ELENG B0200996 ADC NOCUR B0200997 ADC DUMMY B0200998 ADC ZRO B0200999 ADC TC B0201000* B0201001 RTJ PGMOUT CONTROL GOES BACK TO ITOS B0201002 EJT B0201003ÐÐ* B0201004* ALARM ROUTINE B0201005* B0201006ALARM ADD* ERNUM ADD BASE ERROR NO. TO ERROR CODE B0201007 STA* INDEX B0201008 LDA MODE INTERACTIVE ? B0201009 SAN ALARM1 NO B0201010 RTJ SYSMSG DISPLAY ERROR B0201011 ADC INDEX B0201012 ADC ERBUF B0201013* B0201014ALARM1 JMP FMUT1 READ NEXT LINE B0201015* B0201016INDEX NUM 0 B0201017ERBUF NUM 0 B0201018ERNUM NUM 30 ERROR BASE NUMBER B0201019 EJT B0201020* B0201021* LOCAL VARIABLES B0201022* B0201023N2 NUM 2 B0201024N3 NUM 3 B0201025HLPCOM ALF 1,HE B0201026OUTCOM ALF 1,OU B0201027INPCOM ALF 2,INPU INPUT-COMMAND B0201028ÐÐEXCOM ALF 1,EX EXIT-COMMAND B0201029TC NUM 0 B0201030END NUM 0 B0201031STATUS NUM 0 B0201032IADDR ADC FMUT1 B0201033NDATA ALF 4,$$PGMNAM B0201034 ALF 4,$$ B0201035 ALF 4, B0201036 NUM 1,1,0 B0201037INFO BZS INFO(6) B0201038ISTAT NUM 0 B0201039* B0201040* FMUTEX MESSAGES B0201041* B0201042MSG1 NUM $1800 CLEAR SCREEN B0201043 ALF 4, QTIL IN B0201044 NUM $0A0D LF/CR B0201045 ALF 4, READY B0201046 EQU MSG1L(*-MSG1) B0201047MSG2 NUM $0A0D LF/CR B0201048 ALF 4, READY B0201049 EQU MSG2L(*-MSG2) B0201050CLBUF NUM $1800 CLEAR SCREEN B0201051CLBUF1 ALF 3, B0201052 NUM $0A0D LF/CR B0201053ÐÐ EQU LCL(*-CLBUF) B0201054ENDMSG NUM $0A0D LF/CR B0201055 ALF 10, END QTIL B0201056 NUM $0A0D LF/CR B0201057 EQU EMSGL(*-ENDMSG) B0201058* B0201059NOCUR NUM -1 B0201060ZRO NUM 0 B0201061BUFLEN ADC INPLEN B0201062LENG1 ADC MSG1L B0201063LENG2 ADC MSG2L B0201064LENCL ADC LCL B0201065ELENG ADC EMSGL B0201066UT ALF 1,QT B0201067 EJT B0201068**** B0201069* B0201070* SUPERVISOR COMMAND TABLE B0201071* B0201072* THE ORDER OF THIS TABLE MUST BE THE SAME AS COMCOD-TABLE B0201073* B0201074* BIT 0 = 1 ITOS MUST BE DISABLED B0201075* BIT 1 = 1 ONLY ALLOWED FOR MASTER TERMINAL B0201076* B0201077* BIT 15 = 1 NON-EXCISTING COMMAND B0201078ÐÐ* B0201079SUPCOM NUM 0 HELP B0201080 NUM 2 INIT B0201081 NUM 0 DEFINE B0201082 NUM 0 STATUS 122*4867B0201083 NUM 2 RELOAD B0201084 NUM 2 DUMP B0201085 NUM 0 COPY B0201086 NUM 0 DELETE B0201087 NUM 0 CLEAR B0201088 NUM 0 LIST B0201089 NUM 0 RENAME B0201090 NUM 0 COMMAND B0201091 NUM 0 EXIT B0201092 NUM 2 MOUNT B0201093 NUM 2 DISMOUNT B0201094 NUM 3 SAVE B0201095 NUM 0 BATCH B0201096 NUM 0 LOAD B0201097 NUM 3 PURGE B0201098 NUM 2 INPUT B0201099 NUM 2 OUTPUT B0201100 NUM 0 COMPRESS B0201101 NUM 2 HOST B0201102 NUM 2 SET B0201103ÐÐ NUM 0 BATCH STATUS (BATS) B0201104 NUM 0 DISCARD B0201105 NUM 0 DISPOSE B0201106* ALLOW FLUSH FROM PROCEDURE STREAM B0201107 NUM 0 FLUSH B0201108 NUM 2 PRINT B0201109 NUM $FFFF B0201110* B0201111**** B0201112 END B0201113 NAM NXTVOQ Q02 A ITOS CCS 3.0 SL-149B0500001* GET LU OF NEXT MOUNTED VOLUME B0500002* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B0500003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B0500004* COPYRIGHT CONTROL DATA CORPORATION 1979 B0500005* B0500006**** B0500007* B0500008* FUNCTION B0500009* B0500010* THIS ROUTINE SEARCHES THE NEXT MOUNTED VOLUME B0500011* B0500012* B0500013* GENERAL DESCRIPTION B0500014* B0500015ÐÐ* ON ENTRY THE PARAMETER MMUNIT IS CHECKED TO SEE IF IT B0500016* IS WITHIN THE RANGE OF THE NO OF DISK-UNITS ATTACHED B0500017* TO THE SYSTEM (NO OF DISK UNITS IS IN MMLUTB) B0500018* THE CORE-RESIDENT VOLUME INFORMATION TABLE CORRESPONDING B0500019* WITH MMUNIT IS NOW CHECKED TO SEE IF A VOLUME IS MOUNTED B0500020* IF SO, THE VOLUME-NAME FROM THE VIT IS TRANSFERRED TO B0500021* THE COMMON AREA IDATA(9)-IDATA(12) B0500022* IF NOT,MMUNIT IS INCREMENTED BY ONE AND SEARCH WILL B0500023* CONTINUE B0500024* IF THE END OF MMLUTB IS REACHED AND NO VOLUME IS FOUND B0500025* TO BE MOUNTED,MMUNIT IS SET TO ZERO B0500026* B0500027* B0500028* INPUT REQUIREMENTS B0500029* B0500030* MMUNIT PHYSICAL DISK-UNIT NO. STARTING AT 1 B0500031* B0500032* B0500033* OUTPUT B0500034* B0500035* IF A MOUNTED VOLUME IS FOUND,IDATA(9-12) CONTAINS B0500036* VOLUME-NAME B0500037* ELSE MMUNIT=0 B0500038* B0500039* B0500040ÐÐ* CALLING SEQUENCE B0500041* B0500042* CALL NXTVOL (MMUNIT) B0500043* B0500044* B0500045* ENTRY POINT B0500046* B0500047 ENT NXTVOL B0500048* B0500049* EXTERNALS B0500050* B0500051 EXT MMLUTB B0500052 EXT Q8PREP B0500053 EXT Q8PKUP B0500054* B0500055* LABELED COMMON AREA B0500056* B0500057 DAT COMCOD(133),PARNAM(124) B0500058 DAT PPHELP(2) B0500059 DAT PPINIT(4) B0500060 DAT PPDEFI(17) DEFINE B0500061 DAT PPSTAT(4) B0500062 DAT PPRELO(5) 122*4875B0500063 DAT PPDUMP(5) 122*4875B0500064 DAT PPCOPY(6) B0500065ÐÐ DAT PPDELE(4) DELETE B0500066 DAT PPCLEA(3) B0500067 DAT PPLIST(6) 122*4875B0500068 DAT PPRENA(5) B0500069 DAT PPCOMM(2) B0500070 DAT PPEXIT(1) B0500071 DAT PPMOUN(3) B0500072 DAT PPDISM(2) B0500073 DAT PPSAVE(3) B0500074 DAT PPBATC(8) BATCH B0500075 DAT PPLOAD(6) LOAD B0500076 DAT PPPURG(3) B0500077 DAT PPINPU(2) B0500078 DAT PPOUTP(2) B0500079 DAT PPCOMP(3) B0500080 DAT PPHOST(4) HOST B0500081 DAT PPSET(3) SET B0500082 DAT PPBATS(4) BATCH STATUS B0500083 DAT PPDISC(2) DISCARD B0500084 DAT PPDISP(7) DISPOSE B0500085 DAT PPFLUS(3) FLUSH B0500086 DAT PPPRIN(3) PRINT B0500087 DAT DUMMY(6) B0500088 DAT INBUF(41),CODE(20) B0500089 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B0500090ÐÐ DAT REQBUF(24),IDATA(24) B0500091 DAT PARDEF(24) B0500092 DAT FCBHDR(5) B0500093 DAT FCBBUF(96) B0500094 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B0500095 EQU COMLEN(ENDCOM-COMCOD) B0500096* B0500097* B0500098* EQUIVALENCES B0500099* B0500100 EQU ZERO(2) B0500101* B0500102* VOLUME INFORMATION TABLE B0500103* B0500104 EQU VISLUN(2) SYSTEM LOGICAL UNIT NUMBER (BIT 15=1,NOT READYB0500105* ACCESS VISLUN INDIRECTLY B0500106 EQU VINAME(1) VOLUME NAME - ASCII CHARACTERS 1 AND 2 B0500107* VOLUME NAME - ASCII CHARACTERS 3 AND 4 B0500108* VOLUME NAME - ASCII CHARACTERS 5 AND 6 B0500109* VOLUME NAME - ASCII CHARACTERS 7 AND 8 B0500110 EQU VINMBR(5) VOLUME NUMBER - (2 ASCII CHARACTERS) B0500111 EQU VIBMSM(6) BEGINNING OF MANAGEABLE SPACE - MSB B0500112 EQU VIBMSL(7) BEGINNING OF MANAGEABLE SPACE - LSB B0500113 EQU VIASDM(8) AVAILABLE SPACE DIRECTORY ADDRESS - MSB B0500114 EQU VIASDL(9) AVAILABLE SPACE DIRECTORY ADDRESS - LSB B0500115ÐÐ EQU VIASDS(10) # SECTORS IN AVAILABLE SPACE DIRECTORY B0500116 EQU VILBAM(11) LARGEST BLOCK OF SPACE AVAILABLE - MSB B0500117 EQU VILBAL(12) LARGEST BLOCK OF SPACE AVAILABLE - LSB B0500118 EQU VIWPS(13) WORDS/SECTOR FOR VOLUME B0500119 EQU VIFDDM(14) FILE DEFINITION DIRECTORY ADDRESS - MSB B0500120 EQU VIFDDL(15) FILE DEFINITION DIRECTORY ADDRESS - LSB B0500121 EQU VIMAXF(16) MAX. NUMBER OF FILES PERMITTED ON VOLUME B0500122 EQU VICURF(17) CURRENT NUMBER OF FILES EXISTING ON VOLUME B0500123 EQU VINFDB(18) NUMBER OF BLOCKS IN FILE DEFINITION DIRECTORY B0500124 EQU VINXTB(19) NEXT AVAILABLE BLOCK IF FILE DEF. DIRECTORY B0500125 EQU VINOOF(20) NUMBER OF OPEN FILES ON VOLUME B0500126* B0500127**** B0500128NXTVOL NOP B0500129 STQ* QSAVE SAVE Q REGISTER B0500130 LDA- I B0500131 STA* ISAVE SAVE I REGISTER B0500132* B0500133 RTJ Q8PREP B0500134 ADC* NXTVOL PICK UP PARAMETERS B0500135* B0500136HERE RTJ Q8PKUP B0500137 STA* MMUNIT SAVE MMUNIT ADDRESS B0500138 CLR Q CHECK IF MMUNIT B0500139 LDA MMLUTB,Q IS WITHIN RANGE B0500140ÐÐ SUB* (MMUNIT) B0500141 SAP TLOOP IT IS B0500142 JMP* ENDTAB B0500143* B0500144* GET NEXT MOUNTED VOLUME-NAME B0500145* B0500146TLOOP LDQ* (MMUNIT) Q=CUURENT INDEX B0500147ADDR LDA MMLUTB,Q GET TABLE ADDRESS B0500148 STA- I B0500149 LDA- (VISLUN),I IS VOLUME MOUNTED ? B0500150 SAM NEXT SKIP IF NOT B0500151 LDA- I B0500152 INA VINAME B0500153 STA- I B0500154 ENQ 3 B0500155* B0500156NLOOP LDA- (ZERO),B TRANSFER VOLUME NAME B0500157 STA IDATA+8,Q B0500158 INQ -1 B0500159 SQM END NAME TRANSFERRED B0500160 JMP* NLOOP NOT YET B0500161* B0500162NEXT LDA* (MMUNIT) SET READY TO GET NEXT VIT B0500163 SUB* (ADDR+1) B0500164 SAZ ENDTAB END OF VITTAB REACHED B0500165ÐÐ RAO* (MMUNIT) NO B0500166 JMP* TLOOP B0500167* B0500168ENDTAB ENA 0 B0500169 STA* (MMUNIT) B0500170* B0500171END LDQ* QSAVE RESTORE Q REGISTER B0500172 LDA* ISAVE RESTORE I REGISTER B0500173 STA- I B0500174 JMP* (NXTVOL) RETURN B0500175* B0500176* LOCAL VARIABLES B0500177* B0500178MMUNIT NUM 0 B0500179QSAVE NUM 0 B0500180ISAVE NUM 0 B0500181 END B0500182 NAM COMSEQ Q03 A ITOS CCS 3.0 SL-149B0600001* SEARCH FOR VALID COMMAND CODE B0600002* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B0600003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B0600004* COPYRIGHT CONTROL DATA CORPORATION 1979 B0600005* B0600006**** B0600007* B0600008ÐÐ* COMSEK :COMMAND-CODE SEEK ROUTINE B0600009* B0600010* FUNCTION B0600011* B0600012* THIS ROUTINE SEARCHES A COMMAND-CODE TABLE (COMCOD) B0600013* TO CHECK IF THE COMMAND ENTERED (CODE) IS LEGAL B0600014* B0600015* GENERAL DESCRIPTION B0600016* B0600017* CONSEK TESTS IF THE COMMAND CODE CONTAINED IN A B0600018* TWO-WORD BUFFER (CODE) CORRESPONDS WITH ONE OF B0600019* THE ENTRIES IN THE COMCOD-TABLE B0600020* B0600021* IF NO MATCH IS FOUND AN ERROR MSG WILL BE FORWARDED B0600022* B0600023* CALLING PROCEDURE B0600024* B0600025* CALL COMSEK (CODE,STAT,PARLST) B0600026* B0600027* CODE = ADDRESS OF INPUT STRING B0600028* STAT = INDEX IN COMCOD TABLE B0600029* PARLST= ADDRESS OF PARAMETER PROCESSING TABLE B0600030* B0600031* INPUT REQUIREMENTS B0600032* B0600033ÐÐ* CODE CONTAINS THE FOUR CHARACTER COMMAND-CODE B0600034* B0600035* B0600036* OUTPUT B0600037* B0600038* STAT IF COMMAND FOUND CONTAINS INDEX TO COMCOD B0600039* ELSE IS SET TO MINUS B0600040* PARLST CONTAINS ADDR OF PARAMETER PROCESSING TABLE B0600041* B0600042* B0600043* TABLES USED B0600044* B0600045* COMCOD COMMAND CODE TABLE B0600046* B0600047* B0600048* ENTRY POINTS B0600049* B0600050 ENT COMSEK B0600051* B0600052* LABELED COMMON AREA B0600053* B0600054 DAT COMCOD(133),PARNAM(124) B0600055 DAT PPHELP(2) B0600056 DAT PPINIT(4) B0600057 DAT PPDEFI(17) DEFINE B0600058ÐÐ DAT PPSTAT(4) B0600059 DAT PPRELO(5) 122*4875B0600060 DAT PPDUMP(5) 122*4875B0600061 DAT PPCOPY(6) B0600062 DAT PPDELE(4) DELETE B0600063 DAT PPCLEA(3) B0600064 DAT PPLIST(6) 122*4875B0600065 DAT PPRENA(5) B0600066 DAT PPCOMM(2) B0600067 DAT PPEXIT(1) B0600068 DAT PPMOUN(3) B0600069 DAT PPDISM(2) B0600070 DAT PPSAVE(3) B0600071 DAT PPBATC(8) BATCH B0600072 DAT PPLOAD(6) LOAD B0600073 DAT PPPURG(3) B0600074 DAT PPINPU(2) B0600075 DAT PPOUTP(2) B0600076 DAT PPCOMP(3) B0600077 DAT PPHOST(4) HOST B0600078 DAT PPSET(3) SET B0600079 DAT PPBATS(4) BATCH STATUS B0600080 DAT PPDISC(2) DISCARD B0600081 DAT PPDISP(7) DISPOSE B0600082 DAT PPFLUS(3) FLUSH B0600083ÐÐ DAT PPPRIN(3) PRINT B0600084 DAT DUMMY(6) B0600085 DAT INBUF(41),CODE(20) B0600086 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B0600087 DAT REQBUF(24),IDATA(24) B0600088 DAT PARDEF(24) B0600089 DAT FCBHDR(5) B0600090 DAT FCBBUF(96) B0600091 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B0600092 EQU COMLEN(ENDCOM-COMCOD) B0600093**** B0600094* B0600095COMSEK NOP B0600096 LDA* (COMSEK) B0600097 STA* ICODE B0600098 RAO* COMSEK B0600099 LDA* (COMSEK) B0600100 STA* STAT B0600101 RAO* COMSEK B0600102 LDA* (COMSEK) B0600103 STA* PPTAB B0600104 RAO* COMSEK B0600105* B0600106 ENQ 0 B0600107 STQ- I B0600108ÐÐCONTC LDA COMCOD,Q IS THIS END OF TABLE B0600109 SAP NOTEND NO B0600110 JMP* WRONG YES,ILLEGAL COMMAND CODE B0600111NOTEND SUB* (ICODE) B0600112 SAZ MATCH1 B0600113 INQ 1 B0600114NOMTCH INQ 3 B0600115 JMP* CONTC B0600116* B0600117MATCH1 INQ 1 FIRST TWO CHAR ARE EQUAL B0600118 ENA 1 B0600119 STA- I B0600120 LDA COMCOD,Q B0600121 SUB* (ICODE),I B0600122 SAZ FOUND COMMAND FOUND B0600123 JMP* NOMTCH B0600124* B0600125FOUND INQ -1 B0600126 STQ* (STAT) B0600127 INQ 3 B0600128 LDQ COMCOD,Q B0600129 STQ* (PPTAB) STORE PARAMETER LIST ADDRESS B0600130 JMP* (COMSEK) B0600131* B0600132* COMMAND DOES NOT EXCIST B0600133ÐÐ* B0600134WRONG ENA -1 B0600135 STA* (STAT) B0600136 JMP* (COMSEK) B0600137* B0600138* LOCAL VARIABLES B0600139* B0600140ICODE NUM 0 B0600141STAT NUM 0 B0600142PPTAB NUM 0 B0600143* B0600144 END B0600145 NAM QETDEF Q04 A ITOS CCS 3.0 SL-149B1400001* START ROUTINE FOR COMMAND PROCESSOR DEFINE B1400002* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B1400003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B1400004* COPYRIGHT CONTROL DATA CORPORATION 1979 B1400005* B1400006* B1400007* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B1400008* AN ENTRY POINT FOR THE COMMAND PROCESSOR DEFINE B1400009* IN OREDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B1400010* B1400011* B1400012* B1400013ÐÐ* LABELED COMMON AREA B1400014* B1400015 DAT COMCOD(89),PARNAM(83) 122*4875B1400016 DAT PPHELP(2) B1400017 DAT PPINIT(4) B1400018 DAT PPDEFI(16) B1400019 DAT PPSTAT(4) B1400020 DAT PPRELO(5) 122*4875B1400021 DAT PPDUMP(5) 122*4875B1400022 DAT PPCOPY(6) B1400023 DAT PPDELE(3) B1400024 DAT PPCLEA(3) B1400025 DAT PPLIST(6) 122*4875B1400026 DAT PPRENA(5) B1400027 DAT PPCOMM(2) B1400028 DAT PPEXIT(1) B1400029 DAT PPMOUN(3) B1400030 DAT PPDISM(2) B1400031 DAT PPSAVE(3) B1400032 DAT PPBATC(7) 122*4875B1400033 DAT PPLOAD(5) B1400034 DAT PPPURG(3) B1400035 DAT PPINPU(2) B1400036 DAT PPOUTP(2) B1400037 DAT PPCOMP(3) B1400038ÐÐ DAT DUMMY(6) B1400039 DAT INBUF(41),CODE(20) B1400040 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B1400041 DAT REQBUF(24),IDATA(24) B1400042 DAT PARDEF(24) B1400043 DAT FCBHDR(5) B1400044 DAT FCBBUF(96) B1400045 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B1400046 EQU COMLEN(ENDCOM-COMCOD) B1400047* B1400048 ENT MARKER B1400049 ENT UTSTRT B1400050* B1400051 EXT DEFINQ B1400052* B1400053MARKER NOP 0 B1400054 RTJ DEFINQ B1400055 JMP* (MARKER) B1400056* B1400057 EQU UTSTRT(MARKER) B1400058* B1400059 END B1400060 NAM QETDEL Q05 A ITOS CCS 3.0 SL-149B1800001* START ROUTINE FOR COMMAND PROCESSOR DELETE B1800002* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B1800003ÐÐ* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B1800004* COPYRIGHT CONTROL DATA CORPORATION 1979 B1800005* B1800006* B1800007* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B1800008* AN ENTRY POINT FOR THE COMMAND PROCESSOR DELETE B1800009* IN OREDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B1800010* B1800011* B1800012* B1800013* LABELED COMMON AREA B1800014* B1800015 DAT COMCOD(89),PARNAM(83) 122*4875B1800016 DAT PPHELP(2) B1800017 DAT PPINIT(4) B1800018 DAT PPDEFI(16) B1800019 DAT PPSTAT(4) B1800020 DAT PPRELO(5) 122*4875B1800021 DAT PPDUMP(5) 122*4875B1800022 DAT PPCOPY(6) B1800023 DAT PPDELE(3) B1800024 DAT PPCLEA(3) B1800025 DAT PPLIST(6) 122*4875B1800026 DAT PPRENA(5) B1800027 DAT PPCOMM(2) B1800028ÐÐ DAT PPEXIT(1) B1800029 DAT PPMOUN(3) B1800030 DAT PPDISM(2) B1800031 DAT PPSAVE(3) B1800032 DAT PPBATC(7) 122*4875B1800033 DAT PPLOAD(5) B1800034 DAT PPPURG(3) B1800035 DAT PPINPU(2) B1800036 DAT PPOUTP(2) B1800037 DAT PPCOMP(3) B1800038 DAT DUMMY(6) B1800039 DAT INBUF(41),CODE(20) B1800040 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B1800041 DAT REQBUF(24),IDATA(24) B1800042 DAT PARDEF(24) B1800043 DAT FCBHDR(5) B1800044 DAT FCBBUF(96) B1800045 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B1800046 EQU COMLEN(ENDCOM-COMCOD) B1800047* B1800048 ENT MARKER B1800049 ENT UTSTRT B1800050* B1800051 EXT DELETQ B1800052* B1800053ÐÐMARKER NOP 0 B1800054 RTJ DELETQ B1800055 JMP* (MARKER) B1800056* B1800057 EQU UTSTRT(MARKER) B1800058* B1800059 END B1800060 NAM COMANQ Q06 A ITOS CCS 3.0 SL-149B2300001* COMMAND PROCESSOR FOR COMMAND B2300002* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B2300003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B2300004* COPYRIGHT CONTROL DATA CORPORATION 1979 B2300005* B2300006**** B2300007* B2300008* FUNCTION B2300009* B2300010* THIS FMU-COMMAND PROCESSOR PRINTS A LIST OF ALL POSSIBLE B2300011* FMUTIL COMMANDS ON THE SELECTED OUTPUT DEVICE B2300012* B2300013* B2300014* GENERAL DESCRIPTION B2300015* B2300016* ON ENTRY IT WILL SKIP PAST THE FIRST FIELD OF THE INPUT-BUFFER B2300017* (INBUF). IF THIS FIELD IS TERMINATED ON A COMMA IT WILL DO B2300018ÐÐ* ANOTHER GETFLD AND CHECK IF THIS IS A NON-BLANK FIELD B2300019* IF SO,IT WILL PRINT THE CORRESPONDING PARAMETER LIST OF THE B2300020* COMMAND TOO B2300021* B2300022* B2300023* COMMAND FORMAT B2300024* B2300025* COMMAND B2300026* COMMAND,X B2300027* B2300028* B2300029* ENTRY POINTS B2300030* B2300031 ENT COMAND B2300032 ENT UTSTRT B2300033* B2300034* B2300035* EXTERNALS B2300036* B2300037 EXT WTREAD B2300038 EXT PGMOUT B2300039 EXT GETFLD B2300040 EXT CLRSCR B2300041* B2300042* B2300043ÐÐ* EQUATES B2300044* B2300045 EQU ZERO($22) B2300046 EQU LPMASK(2) B2300047* B2300048* LABELED COMMON AREA B2300049* B2300050 DAT COMCOD(133),PARNAM(124) B2300051 DAT PPHELP(2) B2300052 DAT PPINIT(4) B2300053 DAT PPDEFI(17) DEFINE B2300054 DAT PPSTAT(4) B2300055 DAT PPRELO(5) 122*4875B2300056 DAT PPDUMP(5) 122*4875B2300057 DAT PPCOPY(6) B2300058 DAT PPDELE(4) DELETE B2300059 DAT PPCLEA(3) B2300060 DAT PPLIST(6) 122*4875B2300061 DAT PPRENA(5) B2300062 DAT PPCOMM(2) B2300063 DAT PPEXIT(1) B2300064 DAT PPMOUN(3) B2300065 DAT PPDISM(2) B2300066 DAT PPSAVE(3) B2300067 DAT PPBATC(8) BATCH B2300068ÐÐ DAT PPLOAD(6) LOAD B2300069 DAT PPPURG(3) B2300070 DAT PPINPU(2) B2300071 DAT PPOUTP(2) B2300072 DAT PPCOMP(3) B2300073 DAT PPHOST(4) HOST B2300074 DAT PPSET(3) SET B2300075 DAT PPBATS(4) BATCH STATUS B2300076 DAT PPDISC(2) DISCARD B2300077 DAT PPDISP(7) DISPOSE B2300078 DAT PPFLUS(3) FLUSH B2300079 DAT PPPRIN(3) PRINT B2300080 DAT DUMMY(6) B2300081 DAT INBUF(41),CODE(20) B2300082 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B2300083 DAT REQBUF(24),IDATA(24) B2300084 DAT PARDEF(24) B2300085 DAT FCBHDR(5) B2300086 DAT FCBBUF(96) B2300087 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B2300088 EQU COMLEN(ENDCOM-COMCOD) B2300089* B2300090**** B2300091 EJT B2300092* B2300093ÐÐ* START OF THE LIST PROCESSOR B2300094* B2300095COMAND NOP B2300096 ENA 0 B2300097 STA SWORD B2300098 STA SBYTE B2300099* B2300100 RTJ GETFLD SKIP PAST FIRST FIELD B2300101 ADC INBUF B2300102 ADC CODE B2300103 ADC SWORD B2300104 ADC SBYTE B2300105 ADC STATUS B2300106* B2300107 LDA STATUS B2300108 SAZ NXTFLD THERE IS A NEXT FIELD B2300109 JMP* NOLST NO PARAMETER LIST DESIRED B2300110* B2300111NXTFLD RTJ GETFLD SEE IF THERE IS A PARAMETER LIST DESIRED B2300112 ADC INBUF ADDRESS OF INPUT BUFFER B2300113 ADC CODE ADDRESS OF OUTPUT BUFFER B2300114 ADC SWORD START WORD IN INPUT BUFFER B2300115 ADC SBYTE START BYTE OF INPUT BUFFER B2300116 ADC STATUS STATUS TO RETURN B2300117* B2300118ÐÐ LDA CODE B2300119 SUB BLANK CHECK IF BLANK B2300120 SAZ NOLST YES,NO PARMMLIST REQUIRED B2300121* B2300122 ENA -1 B2300123 STA PARMIN SET PARLST REQ. INDICATOR B2300124 JMP* LST1 B2300125* B2300126NOLST CLR A NO PARLST REQ B2300127 STA PARMIN RESET PARLST REQ. INDICAROR B2300128* B2300129LST1 ENQ 0 B2300130NXTCOM ENA 0 GET NEXT COMMAND B2300131 STA- I B2300132NXT LDA COMCOD,Q B2300133 SAP STOR B2300134 JMP* (COMAND) B2300135* B2300136STOR STA OUTBUF,I B2300137 RAO- I B2300138 INQ 1 B2300139 LDA- I COMMAND COMPLETE B2300140 SUB N3 B2300141 SAZ DISPLY YES B2300142 JMP* NXT B2300143ÐÐDISPLY LDA FTSW IS IT FIRST TIME ? B2300144 SAN CMDDIS NO,DISPLY COMMAND B2300145 RTJ CLRSCR CLEAR THE SCREEN B2300146 ADC LUNIT B2300147* B2300148 ENA -1 B2300149 STA FTSW SET FIRST TIME SWITCH NON-ZERO B2300150CMDDIS LDA COMCOD,Q B2300151 STA PPTAB B2300152 RAO LINCNT INCREMENT LINE COUNTER B2300153 LDA LINCNT CHECK IF SCREEN FULL B2300154 SUB =N24 B2300155 SAZ PAUSE B2300156* B2300157 RTJ WTREAD B2300158 ADC LUNIT B2300159 ADC NOCUR NO CURSOR POSITIONING REQUESTED B2300160 ADC DISBUF B2300161 ADC MESLEN B2300162 ADC NOCUR NO CURSOR POSITIONING REQUESTED B2300163 ADC DUMMY B2300164 ADC ZRO B2300165 ADC TC B2300166 LDA* PARMIN IS PARLST REQUIRED B2300167 SAN LST2 YES B2300168ÐÐ INQ 1 B2300169 JMP* NXTCOM B2300170LST2 JMP* PRMLST B2300171* B2300172PAUSE RTJ WTREAD B2300173 ADC LUNIT B2300174 ADC NOCUR B2300175 ADC PAUSBF B2300176 ADC MSPAUS B2300177 ADC NOCUR B2300178 ADC DUMMY B2300179 ADC N3 B2300180 ADC TC B2300181 CLR A RESET FIRST TIME SWITCH B2300182 STA FTSW B2300183 STA* LINCNT RESET LINE COUNTER B2300184 JMP* DISPLY B2300185PRMLST STQ* QSAV SAVE Q TEMP B2300186* B2300187 LDA* PPTAB GET PPTAB ADDRESS B2300188 STA- I B2300189NXTPAR LDA- (ZERO),I IS THERE A PARAMETER LIST B2300190 SAN PRM1 YES B2300191 JMP* INCR NO B2300192PRM1 LDA* BCOM STORE BLANK COMMA FIRST B2300193ÐÐ LDQ* LSTWRD POINTER IN PARMLST BUFFER B2300194 STA* PARBUF,Q B2300195 RAO* LSTWRD UPDATE POINTER B2300196 LDA- (ZERO),I GET FIRST ENTRY IN PPTAB SPECIFIED B2300197 SAZ ENDLST END OF PPTAB B2300198* B2300199 AND- LPMASK+8 MASK OUT INDEX B2300200 INA -1 CALCULATE INDEX TO PARNAM B2300201 MUI* N3 B2300202 TRA Q B2300203* B2300204 LDA PARNAM,Q GET PARAMETER IDENTIFIER B2300205 LDQ* LSTWRD B2300206 STA* PARBUF,Q B2300207* B2300208 RAO- I B2300209 RAO* LSTWRD B2300210 LDA- (ZERO),I B2300211 SAZ ENDLST END OF PARAMETER LIST B2300212 JMP* NXTPAR GET NEXT PARAMETER B2300213* B2300214ENDLST RTJ WTREAD DISPLAY PARAMETER LIST B2300215 ADC LUNIT B2300216 ADC NOCUR B2300217 ADC PARBUF B2300218ÐÐ ADC LSTWRD B2300219 ADC NOCUR B2300220 ADC DUMMY B2300221 ADC ZRO B2300222 ADC TC B2300223* B2300224INCR LDA- I B2300225 INA 1 B2300226 STA- I B2300227 STA* PPTAB SET READY FOR NEXT PARAMETER MNEMONIC B2300228 LDA- (ZERO),I CHECK IF NEXT WORD NON-ZERO B2300229 SAN NXTLST THIS WORD IS START OF NXT LIST B2300230 JMP* INCR NXT LIST NOT YET REACHED B2300231* B2300232NXTLST CLR A B2300233 STA* LSTWRD B2300234 LDQ* QSAV B2300235 INQ 1 B2300236 JMP NXTCOM B2300237* B2300238* LOCAL VARIABLES B2300239* B2300240BCOM ALF 1, , B2300241LSTWRD NUM 0 B2300242QSAV NUM 0 B2300243ÐÐPARMIN NUM 0 B2300244PARBUF BSS PARBUF(32) B2300245STATUS NUM 0 B2300246* B2300247DISBUF NUM $0A0D LF/CR B2300248 BSS OUTBUF(3) B2300249 EQU DISBL(*-DISBUF) B2300250MESLEN ADC DISBL B2300251PAUSBF NUM $0A0D LF/CR B2300252 ALF 3,PAUSE B2300253 EQU PAUSLN(*-PAUSBF) B2300254MSPAUS ADC PAUSLN B2300255LINCNT NUM 0 LINE COUNTER B2300256N3 NUM 3 B2300257TC NUM 0 B2300258NOCUR NUM -1 B2300259ZRO NUM 0 B2300260BLANK ALF 1, B2300261PPTAB ADC PPHELP B2300262FTSW NUM 0 B2300263 EQU UTSTRT(COMAND) B2300264* B2300265 END B2300266 NAM QTLOAD Q07 A ITOS CCS 3.0 SL-149B2800001* START ROUTINE FOR COMMAND PROCESSOR LOAD B2800002ÐÐ* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B2800003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B2800004* COPYRIGHT CONTROL DATA CORPORATION 1979 B2800005* B2800006* B2800007* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B2800008* AN ENTRY POINT FOR THE COMMAND PROCESSOR LOAD B2800009* IN OREDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B2800010* B2800011* B2800012* B2800013 ENT MARKER B2800014 ENT UTSTRT B2800015* B2800016 EXT PRELOQ B2800017* B2800018MARKER NOP 0 B2800019 RTJ PRELOQ B2800020 JMP* (MARKER) B2800021* B2800022 EQU UTSTRT(MARKER) B2800023* B2800024 END B2800025 NAM ORDERQ Q08 A ITOS CCS 3.0 SL-149B5600001* UTILITY DUMMY INTERFACE ROUTINE B5600002ÐÐ* CREDIT COLLECTION SYSTEM VERSION 3.0 B5600003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B5600004* COPYRIGHT CONTROL DATA CORPORATION 1979 B5600005* B5600006* ********************************************* B5600007* * * B5600008* * DUMMY INTERFACE BETWEEN PROCESSOR * B5600009* * AND LOAD OPTION ANALYZER * B5600010* * * B5600011* *****************************************'*** B5600012* B5600013* B5600014******* ROUTINE ENTRY METHOD : B5600015* B5600016* THIS ROUTINE IS ENTERED BY JUMP FROM PRE-LOAD WITH B5600017* RETURN ADDRESS IN A-REGISTER B5600018* B5600019* B5600020******* EXIT CONDITION : B5600021* B5600022* EXIT BACK TO PRE-LOAD ROUTINE WITH A-REGISTER B5600023* CONTAINS EXIT INDICATOR (O FOR EXIT, NON-ZERO FOR B5600024* OVERLAY NEXT MODULE). A-REGISTER IS SET BY B5600025* PROCESSOR. B5600026* B5600027ÐÐ* B5600028******* ROUTINE FUNCTION : B5600029* B5600030* THIS ROUTINE IS A DUMMY AND SERVES TWO MAJOR B5600031* FUNCTIONS. THEY ARE : (1) UNIQUE LOAD PROCESSOR B5600032* ENTRY NAME, AND (2) BINARY FILE ENTRY NAME. B5600033* B5600034* B5600035* B5600036 SPC 3 B5600037* B5600038******* *** E N T R Y N A M E B5600039* B5600040 SPC 1 B5600041 ENT UTSPEC LOAD SPECIAL OVERLAY MARKER B5600042 SPC 2 B5600043* B5600044****** *** E X T E R N A L B5600045* B5600046 SPC 1 B5600047 EXT LDIXOQ ORDERED INDEXED FILE B5600048 SPC 5 B5600049* B5600050****** ***** P R O G R A M S T A R T ***** B5600051* B5600052ÐÐ SPC 2 B5600053UTSPEC NOP 0 ENTRY B5600054 STA* RETADD RETURN ADDRESS SAVE B5600055 RTJ LDIXOQ B5600056 ADC UTSPEC DUMMY PARAMETER B5600057 JMP* (RETADD) RETURN TO SENDER B5600058RETADD NUM 0 RETURN ADDRESS (FILLED) B5600059 END B5600060 NAM PRELOQ Q09 A ITOS CCS 3.0 SL-149B5700001* UTILITY LOAD FUNCTION MODE ANALYZER B5700002* CREDIT COLLECTION SYSTEM VERSION 3.0 B5700003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B5700004* COPYRIGHT CONTROL DATA CORPORATION 1979 B5700005* B5700006* *****************************************' B5700007* * * B5700008* * ROUTINE TO DETERMINE LOAD MODE * B5700009* * * B5700010* ****************************************** B5700011* B5700012* B5700013****** ROUTINE FUNCITON : B5700014* B5700015* THIS ROUTINE SERVES AS BUFFERING TO DETERMINE WHICH B5700016* 'LOAD' MODULE TO BE EXECUTED. THE NORMAL LOAD MODULEB5700017ÐÐ* IS CALLED AT ENTRY, REGARDLESS. AFTER ANALYSIS THE B5700018* PARAMETER, THIS ROUTINE IS CALLED,IF IT IS 'INDEXED B5700019* FILE', TO OVERLAY THE PROPER PROCESSING MODULE. B5700020* OTHERWISE LOADING IS COMPLETED PRIOR TO CONTROL TO B5700021* RETURN TO THIS MODULE. B5700022* B5700023* OVERLAY FLAG (IN A-REGISTER) FROM MODULE 'LOAD'. B5700024* B5700025* 0 = LOADING DONE (EXIT) B5700026* 1 = ORDERED INDEXED FILE LOADING B5700027* 2 = NON-ORDERED INDEXED FILE LOADING B5700028* B5700029* B5700030****** CALLING SEQUENCE : B5700031* B5700032* RTJ PRELOD B5700033* B5700034* B5700035* B5700036****** CALL METHOD TO PROCESSOR : B5700037* B5700038* JMP NEXTLO+1 LAST LOCATION OF THIS ROUTINE + 1 B5700039* B5700040* A-REGISTER = RETURN ADDRESS B5700041* B5700042ÐÐ SPC 3 B5700043* B5700044****** *** E N T R Y N A M E B5700045* B5700046 SPC 1 B5700047 ENT PRELOQ ENTRY NAME B5700048 SPC 2 B5700049* B5700050****** *** E X T E R N A L S B5700051* B5700052 SPC 1 B5700053 EXT FMULOD MODULE STARTING LOCATION B5700054 EXT CLOSFL CLOSE FILE B5700055 EXT OPENFL OPEN FILE B5700056 EXT READR READ 1 RECORD B5700057 EXT SYSMSG PRINT ERROR MESSAGE B5700058 SPC 3 B5700059* B5700060****** *** E Q U I V A L E N C E S B5700061* B5700062 SPC 1 B5700063AMONI EQU AMONI($F4) MONITOR B5700064ADISP EQU ADISP($EA) DISPATCHER B5700065CURLV EQU CURLV($EF) CURRENT PRIORITY LEVEL B5700066D EQU D(1) 'D' BIT B5700067ÐÐFRED EQU FRED(4) F-READ REQUEST CODE B5700068NULL EQU NULL(0) NULL B5700069RP EQU RP(4) REQUEST PRIORITY B5700070THREE EQU THREE(4) CONSTANT 3 B5700071 SPC 1 B5700072* ERROR CODE B5700073 SPC 1 B5700074ER30 EQU ER30(30) UTILITY PROCESSOR NOT FOUND B5700075ER33 EQU ER33(33) OPEN FILE REJECT B5700076 SPC 3 B5700077* B5700078* B5700079* LABELED COMMON AREA B5700080* B5700081 DAT COMCOD(133),PARNAM(121) B5700082 DAT PPHELP(2) B5700083 DAT PPINIT(4) B5700084 DAT PPDEFI(17) DEFINE B5700085 DAT PPSTAT(4) B5700086 DAT PPRELO(5) 122*4875B5700087 DAT PPDUMP(5) 122*4875B5700088 DAT PPCOPY(6) B5700089 DAT PPDELE(4) DELETE B5700090 DAT PPCLEA(3) B5700091 DAT PPLIST(6) 122*4875B5700092ÐÐ DAT PPRENA(5) B5700093 DAT PPCOMM(2) B5700094 DAT PPEXIT(1) B5700095 DAT PPMOUN(3) B5700096 DAT PPDISM(2) B5700097 DAT PPSAVE(3) B5700098 DAT PPBATC(5) BATCH B5700099 DAT PPLOAD(6) LOAD B5700100 DAT PPPURG(3) B5700101 DAT PPINPU(2) B5700102 DAT PPOUTP(2) B5700103 DAT PPCOMP(3) B5700104 DAT PPHOST(4) HOST B5700105 DAT PPSET(3) SET B5700106 DAT PPBATS(4) BATCH STATUS B5700107 DAT PPDISC(2) DISCARD B5700108 DAT PPDISP(7) DISPOSE B5700109 DAT PPFLUS(3) FLUSH B5700110 DAT PPPRIN(3) PRINT B5700111 DAT DUMMY(6) B5700112 DAT INBUF(41),CODE(20) B5700113 DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B5700114 DAT REQBUF(24),IDATA(24) B5700115 DAT PARDEF(24) B5700116 DAT FCBHDR(5) B5700117ÐÐ DAT FCBBUF(96) B5700118 EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B5700119 EQU COMLEN(ENDCOM-COMCOD) B5700120 SPC 5 B5700121* B5700122****** ***** P R O G R A M S T A R T ***** B5700123* B5700124 SPC 2 B5700125PRELOQ NOP 0 ENTRY B5700126SETUP LDA =XCOMBAK GET UP RETURN ADDRESS B5700127TOEX LDQ =XNEXTLO SET PROCESSOR ADDRESS (MINUS 1) B5700128 JMP- 1,Q JUMP TO PROCESSOR B5700129COMBAK SAN INDEX SKIP ON REQUEST FOR INDEXED FILE MODULE B5700130GETOUT JMP* (PRELOQ) RETURN TO SENDER, DONE. B5700131 SPC 2 B5700132* B5700133*----- SET UP GET FILE REQUEST TO OVERLAY PROPER LOAD MODULE B5700134* B5700135* 1 = ORDERED INDEX REQUEST B5700136* 2 = RANDOM INDEX REQUEST B5700137* B5700138 SPC 1 B5700139INDEX INA -1 CALCULATE INDEX TO MOVE FILE NAME FOR B5700140 MUI- THREE REQUEST B5700141 STA- I B5700142ÐÐRLDNAM LDA* NAME,B B5700143 STA* CODEX,Q B5700144 INQ 1 B5700145 TRQ A B5700146 INA -3 B5700147 SAZ TOCLR B5700148 JMP* RLDNAM B5700149 SPC 2 B5700150* CLEAR REQUEST BUFFER AND OPEN FILE B5700151 SPC 1 B5700152TOCLR ENQ 23 CLERE REQUEST BUFFER B5700153 CLR A B5700154CLREQB STA* REQBUX,Q B5700155 SQZ TOPNFL B5700156 INQ -1 B5700157 JMP* CLREQB B5700158* B5700159TOPNFL LDA =XFCBHDR B5700160 STA* REQBUX+9 B5700161 RTJ OPENFL OPEN FILE (SYSTEM PROGRAM FILE) B5700162 ADC REQBUX B5700163 ADC NDATA B5700164 ADC STATUS B5700165 SPC 1 B5700166* UPON RETURN, CHECK STATUS B5700167ÐÐ SPC 1 B5700168 LDA* STATUS CHECK IF OK B5700169 SAZ REDNAM B5700170 ENA ER33 B5700171 JMP* ERROR B5700172* B5700173REDNAM RTJ READR READ THE DESIRE ENTRY RECORD B5700174 ADC REQBUX B5700175 ADC INFO B5700176 ADC CODEX B5700177 ADC STATUS B5700178* B5700179 RTJ CLOSFL CLOSE FILE B5700180 ADC REQBUX B5700181 ADC STATUS+1 B5700182* B5700183 SPC 1 B5700184* CHECK IF PROGRAM FOUND B5700185 SPC 1 B5700186 LDA* STATUS CHECK IF PROCESSOR FOUND B5700187 SAZ LODPFD YES, SKIP B5700188 ENA ER30 NO, SET ERROR CODE AND TO ERROR PROCESSING B5700189 JMP* ERROR B5700190 SPC 3 B5700191* B5700192ÐÐ* B5700193*----- GET MM ADDRESS AND READ B5700194* B5700195* B5700196 SPC 1 B5700197LODPFD LDA* INFO+3 GET PROCESS PROGRAM FILE MASS MEMORY ADDRESS B5700198 STA* MSB MSB B5700199 LDA* INFO+4 LSB B5700200 STA* LSB B5700201 LDA* INFO+5 LENGTH B5700202 STA* LENGTH B5700203 LDA- CURLV ASSEMBLE CALL CODE WITH CURRENT PRIORITY B5700204 ADD* CALCOD B5700205 STA* REQCOD B5700206 LDA* TOEX+1 GENERATE OVERLAY ADDRESS AND SAVE B5700207 INA 1 B5700208 STA* STADDR B5700209* B5700210* READ INTO OVERLAY AREA B5700211* B5700212 RTJ- (AMONI) B5700213REQCOD VFD X2/D,X5/FRED,X1/NULL,X4/RP,X4/NULL B5700214 ADC TOSTAR 1. COMPLETION ADD. B5700215 NUM 0 2. THREAD B5700216 NUM $08C2 3. LU (LIBRARY) B5700217ÐÐLENGTH NUM 0 4. LENGTH (FILLED) B5700218STADDR NUM 0 5. OVERLAY STARTING ADD. (FILLED) B5700219MSB NUM 0 6. MSB OF MM ADD. (FILLED) B5700220LSB NUM 0 7. LSB (FILLED) B5700221 JMP- (ADISP) B5700222 SPC 2 B5700223* B5700224***** TO START PROGRAM B5700225* B5700226 SPC 1 B5700227TOSTAR JMP* SETUP TO TRANSFER CONTROL TO PROCESSOR B5700228 SPC 3 B5700229* B5700230*----- *** ERROR ERROR B5700231* B5700232 SPC 1 B5700233ERROR STA* STATUS B5700234 RTJ SYSMSG B5700235 ADC STATUS B5700236 ADC NONE B5700237 ENA 0 B5700238 JMP* GETOUT B5700239 SPC 3 B5700240* B5700241****** ***** ***** ***** ***** ***** B5700242ÐÐ* B5700243* B5700244* CONSTANTS AND STORAGES B5700245* B5700246 SPC 1 B5700247STATUS NUM 0,0 B5700248CALCOD VFD X2/D,X5/FRED,X1/NULL,X4/RP,X4/NULL B5700249 SPC 1 B5700250* INDEXED FILE LOAD NAMES B5700251NAME ALF *,QTORLD* 1- ORDERED INDEX LOAD B5700252 ALF *,QTRMLD* 2- RANDOM INDEX LOAD B5700253INFO BZS INFO(6) B5700254CODEX BZS CODEX(4) B5700255REQBUX BZS REQBUX(24) B5700256NDATA ALF *,$$PGMNAM$$ * B5700257 NUM 1,1,0 B5700258NONE EQU NONE(*-1) B5700259NEXTLO EQU NEXTLO(*-1) B5700260 END B5700261 NAM RANDOQ Q10 A ITOS CCS 3.0 SL-149B5800001* UTILITY DUMMY INTERFACE ROUTINE B5800002* CREDIT COLLECTION SYSTEM VERSION 3.0 B5800003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B5800004* COPYRIGHT CONTROL DATA CORPORATION 1979 B5800005* B5800006ÐÐ* *****************************************'*** B5800007* * * B5800008* * DUMMY INTERFACE BETWEEN PROCESSOR * B5800009* * AND LOAD OPTION ANALYZER * B5800010* * * B5800011* ********************************************* B5800012* B5800013* B5800014******* ROUTINE ENTRY METHOD : B5800015* B5800016* THIS ROUTINE IS ENTERED BY JUMP FROM PRE-LOAD WITH B5800017* RETURN ADDRESS IN A-REGISTER B5800018* B5800019* B5800020******* EXIT CONDITION : B5800021* B5800022* EXIT BACK TO PRE-LOAD ROUTINE WITH A-REGISTER B5800023* CONTAINS EXIT INDICATOR (O FOR EXIT, NON-ZERO FOR B5800024* OVERLAY NEXT MODULE). A-REGISTER IS SET BY B5800025* PROCESSOR. B5800026* B5800027* B5800028******* ROUTINE FUNCTION : B5800029* B5800030* THIS ROUTINE IS A DUMMY AND SERVES TWO MAJOR B5800031ÐÐ* FUNCTIONS. THEY ARE : (1) UNIQUE LOAD PROCESSOR B5800032* ENTRY NAME, AND (2) BINARY FILE ENTRY NAME. B5800033* B5800034* B5800035* B5800036 SPC 3 B5800037* B5800038******* *** E N T R Y N A M E B5800039* B5800040 SPC 1 B5800041 ENT UTSPEC LOAD SPECIAL OVERLAY MARKER B5800042 SPC 2 B5800043* B5800044****** *** E X T E R N A L B5800045* B5800046 SPC 1 B5800047 EXT BLDIDQ RANDOM INDEX LOAD B5800048 SPC 5 B5800049* B5800050****** ***** P R O G R A M S T A R T ***** B5800051* B5800052 SPC 2 B5800053UTSPEC NOP 0 ENTRY B5800054 STA* RETADD RETURN ADDRESS SAVE B5800055 RTJ BLDIDQ RANDOM INDEXED FILE PROCESSOR B5800056ÐÐ ADC UTSPEC DUMMY PARAMETER B5800057 JMP* (RETADD) RETURN TO SENDER B5800058RETADD NUM 0 RETURN ADDRESS (FILLED) B5800059 END B5800060 NAM SEQLOQ Q11 A ITOS CCS 3.0 SL-149B5900001* UTILITY DUMMY INTERFACE ROUTINE B5900002* CREDIT COLLECTION SYSTEM VERSION 3.0 B5900003* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B5900004* COPYRIGHT CONTROL DATA CORPORATION 1979 B5900005* B5900006* *****************************************'*** B5900007* * * B5900008* * DUMMY INTERFACE BETWEEN PROCESSOR * B5900009* * AND LOAD OPTION ANALYZER * B5900010* * * B5900011* ********************************************* B5900012* B5900013* B5900014******* ROUTINE ENTRY METHOD : B5900015* B5900016* THIS ROUTINE IS ENTERED BY JUMP FROM PRE-LOAD WITH B5900017* RETURN ADDRESS IN A-REGISTER B5900018* B5900019* B5900020******* EXIT CONDITION : B5900021ÐÐ* B5900022* EXIT BACK TO PRE-LOAD ROUTINE WITH A-REGISTER B5900023* CONTAINS EXIT INDICATOR (O FOR EXIT, NON-ZERO FOR B5900024* OVERLAY NEXT MODULE). A-REGISTER IS SET BY B5900025* PROCESSOR. B5900026* B5900027* B5900028******* ROUTINE FUNCTION : B5900029* B5900030* THIS ROUTINE IS A DUMMY AND SERVES TWO MAJOR B5900031* FUNCTIONS. THEY ARE : (1) UNIQUE LOAD PROCESSOR B5900032* ENTRY NAME, AND (2) BINARY FILE ENTRY NAME. B5900033* B5900034* B5900035* B5900036 SPC 2 B5900037* B5900038****** *** E X T E R N A L B5900039* B5900040 SPC 1 B5900041 EXT LOADQ SEQUENTIAL FILE LOAD B5900042 SPC 5 B5900043* B5900044****** ***** P R O G R A M S T A R T ***** B5900045* B5900046ÐÐ SPC 2 B5900047UTSPEC NOP 0 ENTRY B5900048 STA* RETADD RETURN ADDRESS SAVE B5900049 RTJ LOADQ CALL ORDERED INDEXED FILE LOAD B5900050 ADC UTSPEC DUMMY PARAMETER B5900051 JMP* (RETADD) RETURN TO SENDER B5900052RETADD NUM 0 RETURN ADDRESS (FILLED) B5900053 END B5900054 MON 00001 MACRO FMUCOQ C0100001C Q12 F ITOS CCS 3.0 SL-149C0100002C COMMON MACRO FOR UTILITY FORTRAN PROGRAMS C0100003C ************************************************************* 122*4875C0100004C CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.1 C0100005C ************************************************************* 122*4875C0100006C THIS IS THE LABELED COMMON AREA FOR THE FILE-MANAGER UTILITY PROGRAMSC0100007C C0100008 INTEGER COMCOD,PARNAM,PPHELP,PPINIT,PPDEFI C0100009 INTEGER PPSTAT,PPRELO,PPDUMP,PPCOPY,PPDELE C0100010 INTEGER PPCLEA,PPLIST,PPRENA,PPCOMM,PPEXIT C0100011 INTEGER PPMOUN,PPDISM,PPSAVE,PPBATC,PPLOAD C0100012 INTEGER PPPURG,PPINPU,PPOUTP,PPCOMP,DUMMY C0100013 INTEGER CODE,SWORD,SBYTE,PARLST,PIND,REQBUF C0100014 INTEGER PARDEF C0100015 INTEGER PPHOST,PPSET,PPBATS,PPDISC C0100016ÐÐ INTEGER PPDISP,PPFLUS,PPPRIN C0100017 INTEGER FCBHDR,FCBBUF C0100018C C0100019C ************************************************************* 122*4875C0100020 COMMON /AA/COMCOD(133),PARNAM(124) C0100021C ************************************************************* 122*4875C0100022 COMMON /AA/PPHELP(2),PPINIT(4),PPDEFI(17) C0100023C ************************************************************* 122*4875C0100024 COMMON /AA/PPSTAT(4),PPRELO(5),PPDUMP(5) C0100025C ************************************************************* 122*4875C0100026 COMMON /AA/PPCOPY(6),PPDELE(4),PPCLEA(3) C0100027C ************************************************************* 122*4875C0100028 COMMON /AA/PPLIST(6),PPRENA(5),PPCOMM(2) C0100029C ************************************************************* 122*4875C0100030 COMMON /AA/PPEXIT(1),PPMOUN(3),PPDISM(2) C0100031C ************************************************************* 122*4875C0100032 COMMON /AA/PPSAVE(3),PPBATC(8),PPLOAD(6) C0100033C ************************************************************* 122*4875C0100034 COMMON /AA/PPPURG(3),PPINPU(2),PPOUTP(2) C0100035 COMMON /AA/PPCOMP(3) C0100036 COMMON /AA/PPHOST(4),PPSET(3),PPBATS(4),PPDISC(2) C0100037 COMMON /AA/PPDISP(7),PPFLUS(3),PPPRIN(3) C0100038 COMMON /AA/DUMMY(6) C0100039 COMMON /AA/INBUF(41),CODE(20) C0100040 COMMON /AA/LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST C0100041ÐÐ COMMON /AA/NOCOD,PIND,REQBUF(24),IDATA(24) C0100042 COMMON /AA/PARDEF(24) C0100043 COMMON /AA/FCBHDR(5),FCBBUF(96) C0100044 COMMON /AA/ISPARE(69) C0100045C THE ISPARE ARRAY WAS ADDED TO MAKE THE LENGTH C0100046C OF THIS DEFINITION OF COMMON TO BE THE SAME AS C0100047C FMCOM'S DEFINITION. THIS WAS LENGTHENED FOR LARGE C0100048C SECTOR IMPLEMENTATION. C0100049C .................... END OF FMUCOM MACRO ..................... C0100050 END C0100051 SUBROUTINE DEFINQ C0700001 1 /Q13 F ITOS CCS 3.0 . SL-149C0700002C COMMAND PROCESSOR FOR DEFINE C0700003C CREDIT COLLECTION SYSTEM VERSION 3.0 C0700004C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C0700005C COPYRIGHT CONTROL DATA CORPORATION 1979 C0700006C C0700007C C0700008M FMUCOQ C0700009C C0700010 INTEGER OWNR12,OWNR34,OWNR56,OWNR78,RECLEN,TDATRM,TDATRL C0700011 INTEGER DATBAM,DATBAL,FCBIND,TNKEYM,TNKEYL,POSKY1,POSKY2 C0700012 INTEGER POSKY3,POSKY4,TSFILM,TSFILL,EXPDAT(3),CRTDAT(3),FILTYP C0700013 INTEGER NOCUR,ZRO,ERBUF,PARNUM,PARID,PPTEMP(17),PPTAB(17) C0700014 INTEGER BUFLEN,TC,OUTP,BLANK,QUEST,STAT,OPN,WVL C0700015ÐÐ INTEGER VLASDL,VLASDM,RECCNT,FSTAT,FTYPE,FCBAD C0700016 INTEGER SEQTYP,INDTYP,ADRTYP,DIRTYP C0700017 INTEGER TODAY,FCBTEM(3),VOLNAM(4) C0700018 INTEGER GOINDX,DSIZ,FLGTYP,RECBUF C0700019 INTEGER DESTIN C0700020+ DESTINATION ADDRESS FOR MOVER (SOMETIMES) C0700021C C0700022 DIMENSION IPNAM(17) C0700023 DIMENSION IJUST(17) C0700024 DIMENSION ICONV(17) C0700025 DIMENSION IREQ(17) C0700026 DIMENSION IFND(17) C0700027 DIMENSION NAME(96) C0700028 DIMENSION NREC(2),NR(4) C0700029 DIMENSION GOINDX(17) C0700030C ************************************************************* 130*5291C0700031 DIMENSION RECBUF(8602) C0700032C ************************************************************* 130*5291C0700033C C0700034. C0700035 EQUIVALENCE (PPDEFI,PPTAB) C0700036C C0700037C FILE CONTROL BLOCK C0700038C C0700039 EQUIVALENCE (RECLEN,FCBBUF(1)) C0700040ÐÐ EQUIVALENCE (TDATRM,FCBBUF(2)) C0700041 EQUIVALENCE (TDATRL,FCBBUF(3)) C0700042 EQUIVALENCE (DATBAM,FCBBUF(4)) C0700043 EQUIVALENCE (DATBAL,FCBBUF(5)) C0700044 EQUIVALENCE (FCBIND,FCBBUF(6)) C0700045 EQUIVALENCE (NEDATM,FCBBUF(7)) C0700046 EQUIVALENCE (NEDATL,FCBBUF(8)) C0700047 EQUIVALENCE (NEXTBM,FCBBUF(9)) C0700048 EQUIVALENCE (NEXTBL,FCBBUF(10)) C0700049 EQUIVALENCE (TNKEYM,FCBBUF(11)) C0700050 EQUIVALENCE (TNKEYL,FCBBUF(12)) C0700051 EQUIVALENCE (KEYBAM,FCBBUF(13)) C0700052 EQUIVALENCE (KEYBAL,FCBBUF(14)) C0700053 EQUIVALENCE (LENKY1,FCBBUF(15)) C0700054 EQUIVALENCE (POSKY1,FCBBUF(16)) C0700055 EQUIVALENCE (LENKY2,FCBBUF(17)) C0700056 EQUIVALENCE (POSKY2,FCBBUF(18)) C0700057 EQUIVALENCE (LENKY3,FCBBUF(19)) C0700058 EQUIVALENCE (POSKY3,FCBBUF(20)) C0700059 EQUIVALENCE (LENKY4,FCBBUF(21)) C0700060 EQUIVALENCE (POSKY4,FCBBUF(22)) C0700061 EQUIVALENCE (TSFILM,FCBBUF(23)) C0700062 EQUIVALENCE (TSFILL,FCBBUF(24)) C0700063 EQUIVALENCE (NAME12,FCBBUF(25)) C0700064 EQUIVALENCE (OWNR12,FCBBUF(29)) C0700065ÐÐ EQUIVALENCE (EXPDAT(1),FCBBUF(89)) C0700066 EQUIVALENCE (CRTDAT(1),FCBBUF(92)) C0700067 EQUIVALENCE (FILTYP,FCBBUF(95)) C0700068 EQUIVALENCE (MAXREC,IDATA(13)) C0700069+ RECORD LENGTH FOR DEFINED FILE C0700070C C0700071C EXTERNALS C0700072C C0700073 EXTERNAL WTREAD C0700074 EXTERNAL GETFLD C0700075 EXTERNAL ITSERR C0700076 EXTERNAL MOVEL C0700077 EXTERNAL MOVER C0700078 EXTERNAL OPENFL C0700079 EXTERNAL GETFCB C0700080 EXTERNAL TODAY C0700081 EXTERNAL SEKVIT C0700082 EXTERNAL GETSSZ C0700083C C0700084 INTEGER CNVRT C0700085C ************************************************************* 130*5291C0700086 INTEGER RCBLEN C0700087 INTEGER SECLEN C0700088C ************************************************************* 130*5291C0700089C C0700090ÐÐ. C0700091 BYTE (IFN,IPROC(0=0)) C0700092 BYTE (IOW,IPROC(1=1)) C0700093 BYTE (IVL,IPROC(2=2)) C0700094C C0700095 BYTE (IFND,PPTEMP(15=15)) C0700096 BYTE (IREQ,PPTEMP(12=12)) C0700097 BYTE (ICONV,PPTEMP(10=9)) C0700098 BYTE (IJUST,PPTEMP(8=8)) C0700099 BYTE (IPNAM,PPTEMP(7=0)) C0700100C C0700101 BYTE (ICHAR,CODE(1)(15=8)) C0700102C C0700103 BYTE (IOUT,ISTAT(12=12)) C0700104 BYTE(GOINDX,PPTEMP(11=8)) C0700105C C0700106 DATA NAME/'FILE-NAME =OWNER-NAME =VOLUME-NAME=EXPIRE DATE=FILE TYC0700107 1PE =RCRD LENGTH=NUMBR RCRDS=KEY1 LENGTH=KEY1 POSITN=KEY2 LENGTH=KC0700108 2EY2 POSITN=KEY3 LENGTH=KEY3 POSITN=KEY4 LENGTH=KEY4 POSITN=SCTR ALC0700109 3GNED='/ C0700110 DATA NOCUR/-1/,ZRO/0/ C0700111 DATA BUFLEN/40/ C0700112 DATA BLANK/$2020/ C0700113 DATA QUEST/'? '/ C0700114 DATA SEQTYP/' S'/ C0700115ÐÐ DATA INDTYP/' I'/ C0700116 DATA ADRTYP/' A'/ C0700117 DATA DIRTYP/' D'/ C0700118C ************************************************************* 130*5291C0700119 C0700120 DATA RCBLEN/9600/ C0700121C ************************************************************* 130*5291C0700122C C0700123C INITIALISATION C0700124C C0700125 11 INDEX=0 C0700126+ ERROR MSG NO. C0700127 ERBUF=0 C0700128+ ERROR MSG BUF C0700129 ISTAT=0 C0700130+ STATUS OF FM-REQUEST C0700131 LNGO=0 C0700132+ LENGTH OF FIELD TO MOVE C0700133 MORPAR=0 C0700134+ INDICATOR IF MORE PARAMETERS NEEDED C0700135 MORLIN=0 C0700136+ INDICATOR IF MORE LINES NEED TO BE READ C0700137 PARNUM=0 C0700138+ COUNT OF REQ.AND NOT FOUND PARAMETERS C0700139 IP=1 C0700140ÐÐ PARID=0 C0700141 MORFIL=0 C0700142 IFTSW=0 C0700143 IDFLG=0 C0700144 FLGTYP=0 C0700145 LENREC=0 C0700146 LENKEY=0 C0700147 IFLTYP=0 C0700148+ (DEFAULT IS SEQUENTIAL) C0700149. C0700150. C0700151 IINTRP=0 C0700152 ASSIGN 9998 TO INTLOC C0700153 CALL PGMINT(INTLOC,IINTRP) C0700154C C0700155C COPY THE PARAMETER PROCESSING TABLE C0700156C C0700157 I=0 C0700158 10 I=I+1 C0700159 PPTEMP(I)=PPTAB(I) C0700160 IF(PPTEMP(I))10,20,10 C0700161C C0700162C C0700163C C0700164 20 DO 30 I=1,24 C0700165ÐÐ REQBUF(I)=0 C0700166 IDATA(I)=PARDEF(I) C0700167 30 CONTINUE C0700168 IDATA(9)=$5359 C0700169+ SET VOLUME LABEL = 'SYSVOL ' C0700170 IDATA(10)=$5356 C0700171 IDATA(11)=$4F4C C0700172 CALL TODAY(FCBTEM) C0700173 EXPDAT(1)=FCBTEM(1) C0700174+ DEFAULT EXPIRE DATE = TODAY C0700175 EXPDAT(2)=FCBTEM(2) C0700176 EXPDAT(3)=FCBTEM(3) C0700177C C0700178 35 IF(FLGTYP)38,36,38 C0700179+ TEST FOR SEQUENTIAL(0=YES, NZ=NO) C0700180 36 I=(IPNAM(IP)-1)*3+1 C0700181+ CALCULATE SUBSCRIPT INTO MNEMONIC TABLC0700182 IF(PARNAM(I).NE.$4B31)GO TO 38 C0700183+ TEST FOR K1-IF SO, GO TO SA PARMC0700184 DO 37 I=17,24 C0700185+ ZERO OUT IDATA FOR SEQUENTIAL C0700186 37 IDATA(I)=0 C0700187 IP=IP+8 C0700188+ GO TO SA PARAMETER C0700189 38 IF(PIND)109,70,40 C0700190ÐÐC C0700191C PROMPTING LEVEL = 1 FULL PARAMETERS WILL BE DISPLAYED C0700192C C0700193 40 KI=IP C0700194 I=(IP-1)*6+1 C0700195 IF(IPNAM(IP))50,420,50 C0700196C C0700197 50 J=I+5 C0700198 K=1 C0700199 CODE(K)=$0A0D C0700200+ SET CR/LF C0700201 DO 60 I=I,J C0700202 K=K+1 C0700203 CODE(K)=NAME(I) C0700204 60 CONTINUE C0700205 I=KI C0700206C C0700207 LNGO=7 C0700208 GO TO 90 C0700209C C0700210. C0700211C PROMPTING LEVEL = 0 PARAMETER ABBREVIATIONS WILL BE DISPLAYED C0700212C C0700213 70 I=IP C0700214 K=IPNAM(IP) C0700215ÐÐ+ INDEX TO PARAM.MNEM.TABLE C0700216 IF(K)80,100,80 C0700217 80 K=(K-1)*3+1 C0700218C C0700219 CODE(1)=$0A0D C0700220 CODE(2)=PARNAM(K) C0700221 CODE(3)=$3D20 C0700222 LNGO=3 C0700223C C0700224C DISPLAY NEXT PARAMETER-IDENT C0700225C C0700226 90 CALL WTREAD (LUNIT,NOCUR,CODE,LNGO,NOCUR,DUMMY,ZRO,TC) C0700227C C0700228 PARID=IP C0700229+ INDEX IN PARNAM-TABLE C0700230 IFND(I)=1 C0700231+ SET FOUND FLAG C0700232 IP=IP+1 C0700233+ INCR. INDEX TO PPTEMP C0700234 MORPAR=1 C0700235+ SET INDICATOR FOR MORE PARAMETERS NEEDED C0700236 GO TO 120 C0700237C C0700238C END OF PARAMETER LIST, ISSUE FM-REQUEST C0700239C C0700240ÐÐ 100 MORPAR=0 C0700241 GO TO 420 C0700242C C0700243C PROMPTING LEVEL = -1, NO PROMPTING DONE C0700244C C0700245 109 I=0 C0700246 110 IF(MORLIN)115,130,130 C0700247+ DO WE NEED TO READ MORE LINES C0700248 115 MORLIN=0 C0700249C C0700250C READ NEXT LINE C0700251C C0700252 120 CALL WTREAD (LUNIT,NOCUR,DUMMY,ZRO,NOCUR,INBUF,BUFLEN,TC) C0700253C C0700254C RESET SWORD AND SBYTE C0700255C C0700256 SBYTE=0 C0700257 SWORD=0 C0700258C C0700259 130 CALL GETFLD (INBUF,CODE,SWORD,SBYTE,STAT) C0700260C C0700261 140 IF (STAT-2)150,160,200 C0700262 150 IF (STAT-1)260,250,250 C0700263C C0700264. C0700265ÐÐC EOL DETECTED,COUNT NO OF REQUIRED AND NOT FOUND PARAMETERS (STATUS=2)C0700266C C0700267 160 IF(PIND)161,162,162 C0700268 161 MORPAR=0 C0700269C C0700270C CHECK IF FULL NAME DESIRED. . . . C0700271C C0700272 162 IF(CODE(1)-QUEST)164,163,164 C0700273 163 IF (PIND .NE. -1) IP=IP-1 C0700274 GO TO 40 C0700275C C0700276C CHECK IF PARAMETER ENTERED C0700277C C0700278 164 IF(ICHAR.NE.$20)GO TO 170 C0700279C C0700280+ NO - NOT ENTERED C0700281 IFND(IP-1)=0 C0700282 I=(IPNAM(IP-1)-1)*3+1 C0700283 IF(PARNAM(I).EQ.$4B31)LENKEY=1 C0700284 IF(IREQ(IP-1).EQ.0)PARNUM=PARNUM+1 C0700285 IF (PIND .EQ. -1) GO TO 420 C0700286 GO TO 35 C0700287C C0700288 170 I=I+1 C0700289 IF(PPTEMP(I))170,270,180 C0700290ÐÐ. C0700291C C0700292C PARAMETER NOT FOUND,IS IT REQUIRED C0700293C C0700294 180 IF(IREQ(I))170,190,170 C0700295C C0700296C YES IT IS REQUIRED C0700297C C0700298 190 PARNUM=PARNUM+1 C0700299+ NO OF REQ PARAMETERS C0700300 GO TO 170 C0700301C C0700302C PARAMETER-ID FOUND (STATUS=3) C0700303C C0700304 200 I=1 C0700305 210 K=IPNAM(I) C0700306 K=(K-1)*3+1 C0700307C C0700308 IF (CODE(1)-PARNAM(K))230,220,230 C0700309C C0700310C PARAMETER-ID CORRESPONDS WITH PARAM.MNEMONIC TABLE C0700311C C0700312 220 PARID=I C0700313 IP=I+1 C0700314 IFND(I)=1 C0700315ÐÐ GO TO 130 C0700316C C0700317 230 I=I+1 C0700318+ NO MATCH,CONTINUE C0700319 IF(IPNAM(I))210,240,210 C0700320C C0700321 240 INDEX=69 C0700322+ 69 - PARAMETER ENTRY ERROR C0700323 GO TO 9999 C0700324C C0700325. C0700326C FIELD TERMINATED ON A SEMI-COLON (STATUS=1) C0700327C C0700328 250 MORLIN=-1 C0700329+ SET INDICATOR TO READ MORE LINES C0700330C C0700331C FIELD TERMINATED ON A COMMA (STATUS=0) C0700332C C0700333 260 MORPAR=1 C0700334+ SET INDICATOR FOR MORE PARAMETERS C0700335C C0700336C CHECK IF PARAMETER ENTERED C0700337C C0700338 IF(ICHAR.NE.$20)GO TO 270 C0700339 I=(IPNAM(IP-1)-1)*3+1 C0700340ÐÐ IF(PARNAM(I).EQ.$4B31)LENKEY=1 C0700341 IFND(IP)=0 C0700342 IP=IP+1 C0700343+ NO C0700344 GO TO 400 C0700345C C0700346C STORE PARAMETER VALUES INTO REQUIRED LOCATIONS C0700347C C0700348 270 IF (PARID)290,290,280 C0700349+ PARAMETER-ID FOUND C0700350 280 I=PARID C0700351+ YES C0700352 GO TO 300 C0700353C C0700354 290 I=IP+1 C0700355 IF (ICHAR .NE. $20) IFND(I)=1 C0700356 IP=IP+1 C0700357C C0700358 300 IPNAMI=IPNAM(I) C0700359 I=(IPNAM(I)-1)*3+1 C0700360+ CALCULATE SUBSCRIPT INTO MNEMONIC TABLC0700361C C0700362 LNGO=PARNAM(I+1) C0700363 OUTP=PARNAM(I+2) C0700364C C0700365ÐÐC STORE INTO DESIGNATED OUTPUT FIELD C0700366C C0700367C GET ADDRESS OF NR C0700368C C0700369 ASSEM $C000,+NR C0700370 ASSEM $6800,IADR C0700371C C0700372C C0700373. C0700374C COMPUTED GO TO BASED ON PPTAB BITS WHICH DESIGNATE C0700375C SHIFTING, CONVERSION, ETC. AS FOLLOWS: C0700376C ******************************************************************** C0700377C C0700378C BIT VALUE MEANING C0700379C C0700380C 8 0 RIGHT JUSTIFY C0700381C 1 LEFT JUSTIFY C0700382C C0700383C 9 0 NO CONVERSION C0700384C 1 ASCII-BINARY CONVERSION C0700385C C0700386C 10 0 ONE-WORD BINARY OUTPUT C0700387C 1 TWO-WORD BINARY OUTPUT C0700388C C0700389C 11 0 STANDARD PROCESSING AS ABOVE C0700390ÐÐC 1 SPECIAL PROCESSING (SA,TY) C0700391C C0700392C ******************************************************************** C0700393C C0700394 IF(GOINDX(PARID))906,304,301 C0700395 301 GO TO(302,306,906,906,906,308,906,310,310,310,310,310,310,310 C0700396 1,310),GOINDX(PARID) C0700397C C0700398C LEFT JUSTIFIED, NO CONVERSION C0700399C C0700400 302 CALL MOVEL(CODE,OUTP,LNGO) C0700401 GO TO 314 C0700402C C0700403C RIGHT JUSTIFIED, NO CONVERSION C0700404C C0700405 304 CALL MOVER(CODE,LNGO,OUTP,LNGO) C0700406 GO TO 314 C0700407C C0700408C ASCII - BINARY CONVERSION, ONE-WORD OUTPUT C0700409C C0700410 306 DSIZ=8 C0700411 CALL MOVER(CODE,LNGO,IADR,DSIZ) C0700412 IF (CNVRT(NR,NREC) .NE. 0) GO TO 911 C0700413C C0700414C MOVE BINARY OUTPUT TO DESTINATION . . . C0700415ÐÐC C0700416 ASSEM $E400,+OUTP C0700417 ASSEM $C400,+NREC(2) C0700418 ASSEM $6622 C0700419C C0700420 GO TO 314 C0700421C C0700422C ASCII - BINARY CONVERSION, TWO-WORD OUTPUT C0700423C C0700424 308 DSIZ=8 C0700425 CALL MOVER(CODE,LNGO,IADR,DSIZ) C0700426 IF (CNVRT(NR,NREC) .NE. 0) GO TO 911 C0700427C C0700428C MOVE BINARY OUTPUT TO DESTINATION . . . C0700429C C0700430C ************************************************************* 130*5306C0700431 ASSEM $C0FF C0700432+ LDA- I C0700433 ASSEM $680E C0700434+ STA* *+14 C0700435 ASSEM $C400,+OUTP C0700436+ LDA+ OUTP C0700437 ASSEM $60FF C0700438+ STA- I C0700439 ASSEM $E400,+NREC(1) C0700440ÐÐ+ LDQ+ NREC(1) C0700441 ASSEM $C400,+NREC(2) C0700442+ LDA+ NREC(2) C0700443 ASSEM $0FC1 C0700444+ ALS 1 C0700445 ASSEM $0F61 C0700446+ LRS 1 C0700447 ASSEM $44FF C0700448+ STQ- (I) C0700449 ASSEM $D0FF C0700450+ RAO- I C0700451 ASSEM $64FF C0700452+ STA- (I) C0700453 ASSEM $C000,$0 C0700454+ LDA =N0 C0700455 ASSEM $60FF C0700456+ STA- I C0700457C ************************************************************* 130*5306C0700458C C0700459 GO TO 314 C0700460C C0700461. C0700462C SPECIAL CASES . . . FURTHER TESTING REQUIRED C0700463C C0700464C C0700465ÐÐC TEST FOR PARAMETER 07 (TYPE) C0700466 310 IF(IPNAM(IP-1).EQ.07)GO TO 312 C0700467 IF(IPNAM(IP-1).NE.$12)GO TO 904 C0700468C C0700469C PARAMETER IS 12 (SECTOR ALIGNED) C0700470C C0700471C ************************************************************* 122*4874C0700472 IF (CODE(1).NE.$4E20) IDATA(16)=AND(IDATA(16),$7FFF)+$8000 C0700473C ************************************************************* 122*4874C0700474 GO TO 314 C0700475C C0700476C PARAMETER IS 07 (TYPE) C0700477C C0700478 312 IF(CODE(1).EQ.$4F20.OR.CODE(1).EQ.$5220)IDATA(16)=OR(IDATA(16), C0700479 1$0001) C0700480C ************************************************************* 122*4866C0700481C IF THIS IS AN ORDERED FILE, SET THE ORDERED BIT IN IDATA(16) C0700482 IF (CODE(1).EQ.$4F20) IDATA(16)=OR(IDATA(16),$4000) C0700483C *****************************************************'******* 122*4866C0700484C C0700485C TEST BELOW FOR 'D' (DIRECT) TYPE FILE . . . C0700486C C0700487 IF(CODE(1).EQ.$4420)IDFLG=1 C0700488C C0700489C ******************************************************************* C0700490ÐÐC C0700491C PARAMETER LIMIT CHECKS C0700492C COMPUTED GO TO BASED ON PARAMETER ORDINAL; ROUTINES C0700493C WILL DO LIMIT CHECKS AND EITHER RETURN BELOW, OR C0700494C RE-PROMPT THE USER, OR HALT ON ERROR IF NON-INTERACTIVE. C0700495C C0700496 314 GO TO(700,700,700,710,720,730,750,760,770,780,790,780,790,780,790 C0700497 1,780,790,800,400,400,810,400),IPNAMI C0700498C C0700499C TEST FIRST CHARACTER FOR NON-BLANK C0700500C C0700501 700 IF(ICHAR.NE.$20)GO TO 400 C0700502 GO TO 900 C0700503C C0700504C CHECK DISK UNIT FOR.LE.MAXIMUM UNITS C0700505C C0700506 710 ASSEM $C000,MMLUTB C0700507 ASSEM $6800,MLUTB C0700508 IF(NREC(2).LE.MLUTB)GO TO 400 C0700509 GO TO 900 C0700510C C0700511C CHECK NO. OF FILES FOR THE RANGE 1-1024 C0700512C C0700513 720 IF(NREC(2).GE.1.AND.NREC(2).LE.1024)GO TO 400 C0700514 GO TO 900 C0700515ÐÐC C0700516. C0700517C CHECK EXPIRE DATE FOR LEGAL LIMITS(DATE GE TODAY, MONTH C0700518C LE 12, DAY LE 31; EXCEPTION - 999999 PERMISSIBLE) C0700519C C0700520 730 CALL TODAY(FCBTEM) C0700521 IF(CODE(3).LT.FCBTEM(3))GO TO 900 C0700522 IF(CODE(3).GT.FCBTEM(3))GO TO 740 C0700523C EXPIRE DATE IS THIS YEAR C0700524 IF(CODE(1).GT.$3132.OR.CODE(1).LT.FCBTEM(1))GO TO 735 C0700525 IF(CODE(1).GT.FCBTEM(1))GO TO 740 C0700526C EXPIRE DATE IS THIS MONTH C0700527 IF(CODE(2).GT.$3331.OR.CODE(2).LT.FCBTEM(2))GO TO 735 C0700528 GO TO 400 C0700529C AT THIS POINT,ONLY 999999 IS ACCEPTABLE C0700530 735 IF(CODE(1).NE.$3939.OR.CODE(2).NE.$3939.OR.CODE(3).NE.$3939) C0700531 1GO TO 900 C0700532 GO TO 400 C0700533C NOW VERIFY MONTH, DAY FOR MAX VALUES C0700534 740 IF(CODE(1).LE.$3132.AND.CODE(1).GE.$3031.AND.CODE(2).LE.$3331.AND.C0700535 1CODE(2).GE.$3031)GO TO 400 C0700536 GO TO 735 C0700537C C0700538C CHECK TYPE FOR D,O,R,S AND FLAG IF NON-SEQUENTIAL(O,R) C0700539C C0700540ÐÐ 750 FLGTYP=0 C0700541+ SET TYPE FLAG SEQUENTIAL C0700542 IF(ICHAR.EQ.$53)GO TO 400 C0700543+ S TYPE C0700544 IF(ICHAR.EQ.$44)GO TO 752 C0700545+ D TYPE C0700546 IF(ICHAR.EQ.$52)GO TO 754 C0700547+ R TYPE C0700548 IF(ICHAR.EQ.$4F)GO TO 754 C0700549+ O TYPE C0700550 GO TO 900 C0700551+ NONE OF THE ABOVE = ERROR C0700552 752 IFLTYP=3 C0700553 GO TO 400 C0700554 754 IFLTYP=1 C0700555 755 FLGTYP=1 C0700556+ SET TYPE FLAG NON-SEQUENTIAL C0700557 GO TO 400 C0700558C C0700559C CHECK RECORD LENGTH FOR THE RANGE 2-32766. C0700560C C0700561 760 LENREC=NREC(2) C0700562 IF(NREC(1))900,764,900 C0700563 764 IF(NREC(2)-2)900,400,767 C0700564 767 IF(NREC(2)-32766)400,400,900 C0700565ÐÐC C0700566C CHECK NUMBER OF RECORDS FOR THE RANGE 1-16,777,215 C0700567C C0700568 770 IF(NREC(1))900,774,772 C0700569 772 IF(NREC(1)-127)400,400,900 C0700570C ************************************************************* 130*5306C0700571 774 IF (AND($FF,NREC(2)).EQ.0 .AND. AND((NREC(2)/$100),$FF).EQ.0) C0700572 1 GO TO 900 C0700573 GO TO 400 C0700574C ************************************************************* 130*5306C0700575. C0700576C C0700577C CHECK KEY LENGTH FOR THE RANGE 1-29, IF NON-SEQUENTIAL FILE. C0700578C C0700579 780 IF(FLGTYP.EQ.0)GO TO 900 C0700580 LENKEY=NREC(2) C0700581 IF(NREC(1))900,784,900 C0700582 784 IF(NREC(2))900,900,786 C0700583 786 IF(NREC(2)-29)400,400,900 C0700584C C0700585C CHECK KEY POSN FOR THE RANGE 1-(RECLENTH-KEYLENTH), IF NON-SEQ. C0700586C C0700587 790 IF(FLGTYP.EQ.0)GO TO 900 C0700588 IF(NREC(1))900,794,900 C0700589 794 IF(NREC(2))900,900,796 C0700590ÐÐ 796 IF(LENREC.EQ.0)LENREC=192 C0700591 IF((NREC(2)-1)-(LENREC-LENKEY))400,400,900 C0700592C C0700593C CHECK SA FOR YES OR NO C0700594C C0700595 800 IF(ICHAR.EQ.$59.OR.ICHAR.EQ.$4E)GO TO 400 C0700596 GO TO 900 C0700597C C0700598C CHECK MODE FOR A, E, OR B C0700599C C0700600 810 IF(ICHAR.EQ.$41.OR.ICHAR.EQ.$45.OR.ICHAR.EQ.$42)GO TO 400 C0700601 GO TO 900 C0700602C C0700603C PROCESS AND REPORT ERRORS C0700604C C0700605 900 INDEX=69 C0700606 910 CALL SYSMSG(INDEX,ERBUF) C0700607 911 CONTINUE C0700608 IF(MODE.NE.0.AND.MODE.NE.$1000)GO TO 9996 C0700609 IF(PIND.EQ.-1)GO TO 9998 C0700610+ CHECK FOR NO PROMPTING C0700611 IP=IP-1 C0700612 GO TO 35 C0700613C C0700614C ******************************************************************* C0700615ÐÐ. C0700616C C0700617 400 PARID=0 C0700618 IF(MORPAR)35,420,35 C0700619+ ARE THERE MORE PARAM TO BE PROCESSED C0700620C C0700621 420 IF (PARNUM)240,430,240 C0700622+ ARE ALL REQUIRED PARAMETERS FOUND C0700623C C0700624 430 CONTINUE C0700625C C0700626C CREATE THE REQUESTED FILE C0700627C C0700628 1000 CALL CREATE (REQBUF,IDATA,ISTAT) C0700629 IF(ISTAT)1020,1100,1100 C0700630 1020 CALL ERCHK(ISTAT,REQBUF(4)) C0700631+ GO FIND WHICH ISTAT BIT IS ON C0700632 GO TO 9994 C0700633C C0700634 1100 IREQ10=REQBUF(10) C0700635 DO 1110 I=1,24 C0700636 REQBUF(I)=0 C0700637 1110 CONTINUE C0700638 REQBUF(10)=IREQ10 C0700639 NREC(2)=MAXREC C0700640ÐÐ+ SAVE NO. OF RECORDS FOR LATER C0700641 IDATA(13)=0 C0700642 IDATA(14)=1 C0700643 IDATA(15)=-1 C0700644C SETUP FOR FCB IN USER SPACE C0700645 REQBUF(13) = 96 C0700646 ASSEM $C000,+FCBHDR C0700647+ LDA =FCBHDR C0700648 ASSEM $6400,+REQBUF(10) C0700649+ STA+ REQBUF+9 C0700650C SAVE EXPIRE DATE(IN FCBBUF+88-90) OVER OPENFL,GETFCB CALLS C0700651 FCBTEM(1) = EXPDAT(1) C0700652 FCBTEM(2) = EXPDAT(2) C0700653 FCBBUF(3) = EXPDAT(3) C0700654C C0700655 CALL OPENFL(REQBUF,IDATA,ISTAT) C0700656 IF(ISTAT)1120,1200,1200 C0700657 1120 CALL ERCHK(ISTAT,REQBUF(4)) C0700658+ GO FIND WHICH ISTAT BIT IS ON C0700659 GO TO 9994 C0700660C C0700661 1200 VOLNAM(1)=0 C0700662 CALL GETFCB(REQBUF,VOLNAM,INDEX,FCBBUF,ISTAT) C0700663 IF(ISTAT)1210,1240,1240 C0700664 1210 CALL ERCHK(ISTAT,REQBUF(4)) C0700665ÐÐ+ GO FIND WHICH ISTAT BIT IS ON C0700666 GO TO 9994 C0700667C C0700668C UPDATE FCB C0700669C C0700670 1240 EXPDAT(1)=FCBTEM(1) C0700671+ RESTORE EXPIRE DATE C0700672 EXPDAT(2)=FCBTEM(2) C0700673 EXPDAT(3)=FCBTEM(3) C0700674 CALL TODAY(FCBTEM) C0700675 CRTDAT(1) =FCBTEM(1) C0700676+ INSERT CREATE DATE C0700677 CRTDAT(2) =FCBTEM(2) C0700678 CRTDAT(3) =FCBTEM(3) C0700679 FILTYP=IFLTYP C0700680C C0700681 CALL UPDFCB(REQBUF,VOLNAM,INDEX,FCBBUF,ISTAT) C0700682 IF(ISTAT)1250,1255,1255 C0700683 1250 CALL ERCHK(ISTAT,REQBUF(4)) C0700684 GO TO 9994 C0700685+ GO FIND WHICH ISTAT BIT IS ON C0700686 1255 IF(IDFLG.EQ.0)GO TO 1300 C0700687+ CHECK FOR DIRECT FILE C0700688C C0700689C DIRECT FILE WANTED . . . C0700690ÐÐC C0700691C ************************************************************* 122*4591C0700692 IF (NREC(2).LE.512) GO TO 1260 C0700693C ************************************************************* 122*4591C0700694+ CHECK RECORD LENGTH FOR MAX C0700695 INDEX=69 C0700696 GO TO 9999 C0700697C ************************************************************* 130*5291C0700698 1260 DO 1265 I = 1,RCBLEN C0700699C ************************************************************* 130*5291C0700700 1265 RECBUF(I)=$2020 C0700701+ BLANK OUT BUFFER C0700702C ************************************************************* 130*5291C0700703C COMPUTE NO. OF RECORDS PER BUFFERC0700704C C0700705C GET SECTOR LENGTH IN WORDS C0700706 CALL GETSSZ (FCBHDR,SECLEN) C0700707 NRECS = RCBLEN / FCBBUF(1) C0700708 IF (AND(FCBIND,$8000) .EQ. 0) GO TO 1270 C0700709 NUMSEC = FCBBUF(1) / SECLEN C0700710 IF ((NUMSEC*SECLEN) .LT. RECLEN) NUMSEC = NUMSEC + 1 C0700711 NRECS = RCBLEN / (SECLEN*NUMSEC) C0700712C STORE A SET OF NRECS RECORDS C0700713 1270 CALL PUTS (REQBUF,RECBUF,NRECS,ISTAT) C0700714C ************************************************************* 130*5291C0700715ÐÐ IF(IOUT)1300,1280,1300 C0700716+ CHECK FOR LAST RECORD C0700717 1280 IF(ISTAT)1285,1270,1270 C0700718 1285 CALL ERCHK(ISTAT,REQBUF(4)) C0700719+ GO FIND WHICH ISTAT BIT IS ON C0700720 GO TO 9994 C0700721 1300 CALL CLOSFL(REQBUF,ISTAT) C0700722 IF(ISTAT)1320,1400,1400 C0700723 1320 CALL ERCHK(ISTAT,REQBUF(4)) C0700724+ GO FIND WHICH ISTAT BIT IS ON C0700725 GO TO 9994 C0700726C C0700727 1400 RETURN C0700728C C0700729C C0700730 904 INDEX=69 C0700731+ 69 - PARAMETER ENTRY ERROR C0700732 GO TO 9999 C0700733 906 INDEX=70 C0700734+ 70 - PARAMETER ENTRY ERROR C0700735 9999 CALL SYSMSG(INDEX,ERBUF) C07007369994 IF(PIND)9995,9995,11 C0700737 9995 IF(MODE)9996,9998,9996 C0700738 9996 ASSEM $E400,+MODE C0700739 ASSEM $D622 C0700740ÐÐ 9998 CALL CLOSFL(REQBUF,ISTAT) C0700741+ CLOSE FILE FOR SAFETY C0700742 GO TO 1400 C0700743C C0700744 END C0700745 SUBROUTINE DELETQ C1300001 1 /Q14 F ITOS CCS 3.0 SL-149C1300002C COMMAND PROCESSOR FOR DELETE C1300003C CREDIT COLLECTION SYSTEM VERSION 3.0ED SYSTEM VERSION 1.0 C1300004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C1300005C COPYRIGHT CONTROL DATA CORPORATION 1979 C1300006C C1300007C*** C1300008C C1300009C FUNCTION C1300010C C1300011C THIS IS THE REQUEST PROCESSOR FOR THE FILE-MANAGER UTILITY C1300012C ITS PURPOSE IS TO DELETE ALL SPACE ON MASS-STORAGE HELD BY C1300013C THE SPECIFIED FILE AND TO REMOVE THE ENTRY FROM THE DIRECTORY C1300014C C1300015C GENERAL DESCRIPTION C1300016C C1300017C UPON ENTRY THE PARAMETER PROCESSING TABLE(PPDELE) IS COPIED C1300018C INTO A TEMPORARILY TABLE(PPTEMP) C1300019C REQBUF IS INITIALIZED TO ALL ZEROES C1300020ÐÐC IDATA IS COPIED FROM THE DEFAULT TABLE (PARDEF) C1300021C NEXT A CHECK IS DONE WHICH PROMPTING LEVEL (PIND) IS REQUIRED C1300022C C1300023C C1300024C INPUT REQUIREMENT S C1300025C C1300026C INBUF BUFFER CONTAINING COMMAND FORMAT INPUT C1300027C LUNIT LOGICAL UNIT NO TO READ FROM C1300028C MODE MODE OF OPERATION (0=INTERACTIVE ELSE BATCH) C1300029C PIND PROMPTING LEVEL INDICATOR (-1,0,1) C1300030C C1300031C C1300032C MISCELLANEOUS C1300033C C1300034C MORPAR 0 IF END OF PARAMETER LIST IS DETECTED C1300035C 1 IF MORE PARAMETERS ARE NEEDED C1300036C MORLIN 0 IF PARAMETERLIST IS CONTAINED ON ONE RECORD C1300037C -1 IF PARAMETERLIST CONSISTS OF MORE RECORDS C1300038C IP INDEX TO PARAMETER PROCESSING TABLE C1300039C C1300040C COMMAND FORMAT C1300041C C1300042C DELETE,FN=AAAAAAAA,VL=AAAAAAAA C1300043C C1300044C DELETE,FFFFFFFF,VVVVVVVV C1300045ÐÐC C1300046C DELETE,FN=AAAAAAAA C1300047C C1300048C C1300049C*** C1300050M FMUCOQ C1300051C C1300052 INTEGER BUFLEN,TC,ZRO,OUTP C1300053 INTEGER BLANK,ERBUF C1300054 INTEGER PARNUM,STATUS,PARID C1300055 INTEGER OPN,WVL C1300056 INTEGER PPTAB(4) C1300057 INTEGER STAT C1300058C C1300059 INTEGER PPTEMP(17) C1300060 INTEGER IPNAM(17) C1300061 INTEGER IJUST(17) C1300062 INTEGER ICONV(17) C1300063 INTEGER IREQ(17) C1300064 INTEGER IFND(17) C1300065 INTEGER QUEST C1300066C C1300067 BYTE (IPNAM,PPTEMP(7=0)) C1300068 BYTE (IJUST,PPTEMP(8=8)) C1300069 BYTE (ICONV,PPTEMP(10=9)) C1300070ÐÐ BYTE (IREQ,PPTEMP(12=12)) C1300071 BYTE (IFND,PPTEMP(15=15)) C1300072C C1300073 DIMENSION NAME(18) C1300074C C1300075 BYTE(OPN,ISTAT(0=0)) C1300076 BYTE(NFD,ISTAT(1=1)) C1300077 BYTE(MME,ISTAT(5=5)) C1300078 BYTE(WVL,ISTAT(13=13)) C1300079 BYTE(ILR,ISTAT(14=14)) C1300080* C1300081 EQUIVALENCE (PPDELE,PPTAB) C1300082* C1300083C C1300084 DATA NAME/'FILE-NAME =OWNER-NAME =VOLUME-NAME='/ C1300085 DATA BUFLEN/40/ C1300086 DATA BLANK/$2020/ C1300087 DATA QUEST/'? '/ C1300088 DATA ZRO/0/,NOCUR/-1/ C1300089C C1300090C EXTERNALS C1300091C C1300092 EXTERNAL WTREAD C1300093 EXTERNAL GETFLD C1300094 EXTERNAL SYSMSG C1300095ÐÐ EXTERNAL MOVEL C1300096 EXTERNAL MOVER C1300097 EXTERNAL DELETE C1300098C C1300099C INITIALISATION C1300100C C1300101 11 INDEX=0 C1300102+ ERROR MSG NO. C1300103 ERBUF=0 C1300104+ ERROR MSG BUF C1300105 ISTAT=0 C1300106+ STATUS OF FM-REQUEST C1300107 LNGO=0 C1300108+ LENGTH OF FIELD TO MOVE C1300109 MORPAR=0 C1300110+ INDICATOR IF MORE PARAMETERS NEEDED C1300111 MORLIN=0 C1300112+ INDICATOR IF MORE LINES NEED TO BE READ C1300113 PARNUM=0 C1300114+ COUNT OF REQ.AND NOT FOUND PARAMETERS C1300115 PARID=0 C1300116 IFLAG=0 C1300117 IP=1 C1300118C C1300119 ASSIGN 9998 TO INTLOC C1300120ÐÐ CALL PGMINT(INTLOC,IFLAG) C1300121C C1300122C COPY THE PARAMETER PROCESSING TABLE C1300123C C1300124 I=0 C1300125 10 I=I+1 C1300126 PPTEMP(I)=PPTAB(I) C1300127 IF(PPTEMP(I))10,20,10 C1300128C C1300129C C1300130C C1300131 20 DO 30 I=1,24 C1300132 REQBUF(I)=0 C1300133 IDATA(I)=PARDEF(I) C1300134 30 CONTINUE C1300135C C1300136 35 IF(PIND)110,70,40 C1300137C C1300138C PROMPTING LEVEL = 1 FULL PARAMETERS WILL BE DISPLAYED C1300139C C1300140 40 KI=IP C1300141 I=(IP-1)*6+1 C1300142 IF(IPNAM(IP))50,100,50 C1300143C C1300144 50 J=I+5 C1300145ÐÐ K=1 C1300146 CODE(K)=$0A0D C1300147+ SET CR/LF C1300148 DO 60 I=I,J C1300149 K=K+1 C1300150 CODE(K)=NAME(I) C1300151 60 CONTINUE C1300152C C1300153 I=KI C1300154 LNGO=7 C1300155 GO TO 90 C1300156C C1300157C PROMPTING LEVEL = 0 PARAMETER ABBREVIATIONS WILL BE DISPLAYED C1300158C C1300159 70 I=IP C1300160 K=IPNAM(IP) C1300161+ INDEX TO PARAM.MNEM.TABLE C1300162 IF(K)80,100,80 C1300163 80 K=(K-1)*3+1 C1300164C C1300165 CODE(1)=$0A0D C1300166 CODE(2)=PARNAM(K) C1300167 CODE(3)=$3D20 C1300168 LNGO=3 C1300169C C1300170ÐÐC DISPLAY NEXT PARAMETER-IDENT C1300171C C1300172 90 CALL WTREAD (LUNIT,NOCUR,CODE,LNGO,NOCUR,DUMMY,ZRO,TC) C1300173C C1300174 PARID=IP C1300175+ INDEX IN PARNAM-TABLE C1300176 IFND(I)=1 C1300177+ SET FOUND FLAG C1300178 IP=IP+1 C1300179+ INCR. INDEX TO PPTEMP C1300180 MORPAR=1 C1300181+ SET INDICATOR FOR MORE PARAMETERS NEEDED C1300182 GO TO 120 C1300183C C1300184C END OF PARAMETER LIST, ISSUE FM-REQUEST C1300185C C1300186 100 MORPAR=0 C1300187 GO TO 320 C1300188C C1300189C PROMPTING LEVEL = -1, NO PROMPTING DONE C1300190C C1300191 110 IF(MORLIN)115,130,130 C1300192+ DO WE NEED TO READ MORE LINES C1300193 115 MORLIN=0 C1300194C C1300195ÐÐC READ NEXT LINE C1300196C C1300197 120 CALL WTREAD (LUNIT,NOCUR,DUMMY,ZRO,NOCUR,INBUF,BUFLEN,TC) C1300198C C1300199C RESET SWORD AND SBYTE C1300200C C1300201 SBYTE=0 C1300202 SWORD=0 C1300203C C1300204 130 CALL GETFLD (INBUF,CODE,SWORD,SBYTE,STAT) C1300205C C1300206 140 IF (STAT-2)150,160,200 C1300207 150 IF (STAT-1)260,250,250 C1300208C C1300209C EOL DETECTED,COUNT NO OF REQUIRED AND NOT FOUND PARAMETERS (STATUS=1)C1300210C C1300211 160 IF(PIND)161,162,162 C1300212 161 MORPAR=0 C1300213C C1300214C CHECK IF FULL NAME DESIRED C1300215C C1300216 162 IF (CODE(1)-QUEST)164,163,164 C1300217C C1300218C YES,FULL NAME FOR THIS PARAMETER ONLY C1300219C C1300220ÐÐ 163 IF (PIND .NE. -1) IP=IP-1 C1300221 GO TO 40 C1300222C C1300223C CHECK IF PARAMETER ENTERED C1300224C C1300225 164 IF(CODE(1)-BLANK)270,165,270 C1300226 165 IFND(IP-1)=0 C1300227 IF (PIND .EQ. -1) GO TO 320 C1300228 GO TO 35 C1300229C C1300230C PARAMETER-ID FOUND (STATUS=3) C1300231C C1300232 200 I=1 C1300233 210 K=IPNAM(I) C1300234 K=(K-1)*3+1 C1300235C C1300236 IF (CODE(1)-PARNAM(K))230,220,230 C1300237C C1300238C PARAMETER-ID CORRESPONDS WITH PARAM.MNEMONIC TABLE C1300239C C1300240 220 PARID=I C1300241 IFND(I)=1 C1300242 GO TO 130 C1300243C C1300244 230 I=I+1 C1300245ÐÐ+ NO MATCH,CONTINUE C1300246 IF(IPNAM(I))210,240,210 C1300247C C1300248 240 INDEX=39 C1300249+ PARAMETER ILLEGAL C1300250 GO TO 9999 C1300251C C1300252C FIELD TERMINATED ON A SEMI-COLON (STATUS=1) C1300253C C1300254 250 MORLIN=-1 C1300255+ SET INDICATOR TO READ MORE LINES C1300256C C1300257C FIELD TERMINATED ON A COMMA (STATUS=0) C1300258C C1300259 260 MORPAR=1 C1300260+ SET INDICATOR FOR MORE PARAMETERS C1300261 IF(CODE(1) .NE. BLANK)GO TO 270 C1300262 IFND(IP)=0 C1300263 IP=IP+1 C1300264 GO TO 35 C1300265C C1300266C STORE PARAMETER VALUES INTO REQUIRED LOCATIONS C1300267C C1300268 270 IF (PARID)290,290,280 C1300269+ PARAMETER-ID FOUND C1300270ÐÐ 280 I=PARID C1300271+ YES C1300272 GO TO 300 C1300273C C1300274 290 I=IP C1300275 IF (CODE(1) .NE. BLANK) IFND(I)=1 C1300276 IP=IP+1 C1300277C C1300278 300 I=(IPNAM(I)-1)*3+1 C1300279C C1300280 LNGO=PARNAM(I+1) C1300281 OUTP=PARNAM(I+2) C1300282C C1300283C STORE INTO DESIGNATED OUTPUT FIELD C1300284C C1300285 CALL MOVEL (CODE,OUTP,LNGO) C1300286C C1300287 PARID=0 C1300288 IF(MORPAR)310,320,310 C1300289+ ARE THERE MORE PARAM TO BE PROCESSED C1300290 310 IF(PIND)110,70,40 C1300291+ YES C1300292C C1300293C ARE ALL REQUIRED PARAMETERS FOUND ? C1300294C C1300295ÐÐ 320 I=0 C1300296 330 I=I+1 C1300297 IF(PPTEMP(I))330,360,340 C1300298C C1300299C PARAMETER NOT FOUND,IS IT REQUIRED ? C1300300C C1300301 340 IF(IREQ(I))330,350,330 C1300302C C1300303C YES IT IS REQUIRED C1300304C C1300305 350 PARNUM=PARNUM+1 C1300306 GO TO 330 C1300307C C1300308C END OF PPTAB C1300309C C1300310 360 IF(PARNUM)240,400,240 C1300311+ ARE ALL REQUIRED PARAMETERS FOUND C1300312C C1300313C C1300314C C1300315 400 CALL DELETE (REQBUF,IDATA,ISTAT) C1300316+ NO C1300317C C1300318 IF(ISTAT)8000,9000,9000 C1300319+ REQUEST OK C1300320ÐÐC C1300321C FILE REQUEST REJECTED C1300322C C1300323 8000 CALL ERCHK(ISTAT,REQBUF(4)) C1300324 GO TO 9995 C1300325C C1300326 9000 GO TO 9998 C1300327C C1300328C ERROR ROUTINE C1300329C C1300330 9999 CALL SYSMSG(INDEX,ERBUF) C1300331 9995 IF(PIND) 9996,9996,11 C1300332 9996 IF(MODE) 9997,9998,9997 C1300333 9997 ASSEM $E400,+MODE C1300334 ASSEM $D622 C1300335C C1300336 9998 RETURN C1300337 END C1300338 INTEGER FUNCTION LOADQ(IXXXX) C2100001 1 /Q15 F ITOS CCS 3.0 SL-149C2100002C COMMAND PROCESSOR FOR LOAD C2100003C CREDIT COLLECTION SYSTEM VERSION 3.0 C2100004C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C2100005C COPYRIGHT CONTROL DATA CORPORATION 1979 C2100006C ************************************************************* 122*4872C2100007ÐÐC*** C2100008C *****************************************************'******* 122*4872C2100009C C2100010C C2100011C FUNCTION C2100012C C2100013C THIS PROCESSOR READS DATA RECORDS FROM A SPECIFIED UNIT RECORD C2100014C DEVICE INTO A FILE MANAGER FILE WHICH HAS BEEN DEFINED PRIOR C2100015C TO EXECUTING THIS COMMAND C2100016C C2100017C MAX RECORD LENGTH IS 512 BYTES C2100018C C2100019C GENERAL DESCRIPTION C2100020C C2100021C ************************************************************* 122*4872C2100022C AFTER ALL PARAMETERS HAVE BEEN READ A VALIDITY CHECK IS DONE C2100023C THE FILE IS OPENED AND THE FCB IS READ INTO USER-AREA C2100024C IF RECLEN EXCEEDS 512 BUYTES,ERROR 64 IS DISPLAYED C2100025C THE LOGICAL UNIT NO IS OBTAINED AND A READ OF ONE RECORD C2100026C IS DONE BY THE ROUTINE REDREC C2100027C EVERY ABNORMAL CONDITION IS TREATED AS AN EOF BY REDREC C2100028C LOAD WILL STOP WHEN THE FILE-SPACE IS FILLED INDICATING AN C2100029C ERROR MSG(55)OR WHEN REDREC DTECTS EITHER AN EOF OR A C2100030C PSEUDO-EOF (/*) C2100031C IF THE INPUT DATA IS SPECIFIED WITH M=A OR DEFAULT C2100032ÐÐC NO CONVERSION TAKES PLACE C2100033C IF M=E THE FILE WILL BE CONVERTED FROM EBCDIC TO ASCII USING C2100034C THE ASCEBC ROUTINE C2100035C A SEQUENTIAL FILE IS STORED BY MEANS OF PUTS REQUEST C2100036C AN INDEXED FILE IS STORED BY MEANS OF A WRITER USING THE EXTRACTEDC2100037C KEY-VALUE STORED IN KEYVAL C2100038C A LOAD OF A DIRECT FILE CHANGES THE FILETO SEQ. C2100039C ************************************************************* 122*4872C2100040C C2100041C C2100042C COMMAND FORMAT C2100043C C2100044C LOAD,FN=AAAAAAAA,VL=AAAAAAAA,I=NNNNNNNN,M=A C2100045C C2100046M FMUCOQ C2100047. C2100048C C2100049 INTEGER OWNR12,OWNR34,OWNR56,OWNR78,RECLEN,TDATRM,TDATRL C2100050 INTEGER DATBAM,DATBAL,FCBIND,TNKEYM,TNKEYL,POSKY1,POSKY2 C2100051 INTEGER POSKY3,POSKY4,TSFILM,TSFILL,EXPDAT,CRTDAT,FILTYP C2100052 INTEGER NOCUR,ZRO,ERBUF,PARNUM,PARID,PPTEMP(17),PPTAB(6) C2100053 INTEGER BUFLEN,TC,OUTP,BLANK,QUEST,STAT,OPN,WVL,FTYPE C2100054 INTEGER OPN,WVL C2100055 INTEGER RECBUF C2100056 INTEGER ASEBSW C2100057ÐÐC C2100058 INTEGER BUFSIZ,SECLEN C2100059 INTEGER LOADQ C2100060C ***** 138*A029C2100061 INTEGER TOTREC C2100062 INTEGER LOG1A C2100063 INTEGER OBL000 C2100064C ***** 138*A029C2100065C C2100066 DIMENSION IPNAM(17) C2100067 DIMENSION IREQ(17) C2100068 DIMENSION IFND(17) C2100069 DIMENSION NAME(30) C2100070 DIMENSION NAME12(4) C2100071 DIMENSION OWNR12(4) C2100072 DIMENSION KEYVAL(15) C2100073 DIMENSION IODEF(4) C2100074C C2100075 DIMENSION KARAEO( 7) C2100076 DIMENSION RECBUF(4002) C2100077C ***** 138*A029C2100078 DIMENSION TOTREC(2) C2100079C C2100080 EQUIVALENCE (PPLOAD,PPTAB) C2100081. C2100082ÐÐC C2100083C FILE CONTROL BLOCK C2100084C C2100085 EQUIVALENCE (RECLEN,FCBBUF(1)) C2100086 EQUIVALENCE (TDATRM,FCBBUF(2)) C2100087 EQUIVALENCE (TDATRL,FCBBUF(3)) C2100088 EQUIVALENCE (DATBAM,FCBBUF(4)) C2100089 EQUIVALENCE (DATBAL,FCBBUF(5)) C2100090 EQUIVALENCE (FCBIND,FCBBUF(6)) C2100091 EQUIVALENCE (NEDATM,FCBBUF(7)) C2100092 EQUIVALENCE (NEDATL,FCBBUF(8)) C2100093 EQUIVALENCE (NEXTBM,FCBBUF(9)) C2100094 EQUIVALENCE (NEXTBL,FCBBUF(10)) C2100095 EQUIVALENCE (TNKEYM,FCBBUF(11)) C2100096 EQUIVALENCE (TNKEYL,FCBBUF(12)) C2100097 EQUIVALENCE (KEYBAM,FCBBUF(13)) C2100098 EQUIVALENCE (KEYBAL,FCBBUF(14)) C2100099 EQUIVALENCE (LENKY1,FCBBUF(15)) C2100100 EQUIVALENCE (POSKY1,FCBBUF(16)) C2100101 EQUIVALENCE (LENKY2,FCBBUF(17)) C2100102 EQUIVALENCE (POSKY2,FCBBUF(18)) C2100103 EQUIVALENCE (LENKY3,FCBBUF(19)) C2100104 EQUIVALENCE (POSKY3,FCBBUF(20)) C2100105 EQUIVALENCE (LENKY4,FCBBUF(21)) C2100106 EQUIVALENCE (POSKY4,FCBBUF(22)) C2100107ÐÐ EQUIVALENCE (TSFILM,FCBBUF(23)) C2100108 EQUIVALENCE (TSFILL,FCBBUF(24)) C2100109 EQUIVALENCE (NAME12,FCBBUF(25)) C2100110 EQUIVALENCE (OWNR12,FCBBUF(29)) C2100111 EQUIVALENCE (EXPDAT,FCBBUF(89)) C2100112 EQUIVALENCE (CRTDAT,FCBBUF(92)) C2100113 EQUIVALENCE (FTYPE,FCBBUF(95)) C2100114C C2100115C EXTERNALS C2100116C C2100117 EXTERNAL MMLUTB C2100118 EXTERNAL WTREAD C2100119 EXTERNAL GETFLD C2100120 EXTERNAL ASCEBC C2100121 EXTERNAL SYSMSG C2100122 EXTERNAL MOVEL C2100123 EXTERNAL OPENFL C2100124 EXTERNAL GETFCB C2100125C ***** 138*A029C2100126 EXTERNAL LOG1A C2100127 EXTERNAL OBL000 C2100128C ***** 138*A029C2100129 EXTERNAL GETSSZ C2100130C C2100131C C2100132ÐÐ BYTE (IFND,PPTEMP(15=15)) C2100133 BYTE (IREQ,PPTEMP(12=12)) C2100134 BYTE (IPNAM,PPTEMP(7=0)) C2100135C C2100136 BYTE (OPN,ISTAT(0=0)) C2100137 BYTE (NFD,ISTAT(1=1)) C2100138 BYTE (LOK,ISTAT(2=2)) C2100139 BYTE (IRLOK,ISTAT(3=3)) C2100140 BYTE (INUNK,ISTAT(4=4)) C2100141 BYTE (MME,ISTAT(5=5)) C2100142 BYTE (IWKY,ISTAT(9=9)) C2100143 BYTE (IFE,ISTAT(10=10)) C2100144 BYTE (MFOS,ISTAT(11=11)) C2100145 BYTE (MFO,ISTAT(12=12)) C2100146 BYTE (IOUT,ISTAT(12=12)) C2100147 BYTE (WVL,ISTAT(13=13)) C2100148 BYTE (ILR,ISTAT(14=14)) C2100149C C2100150 DATA NAME/'FILE-NAME =OWNER-NAME =VOLUME-NAME=INPUT UNIT =MODE C2100151 2 ='/ C2100152 DATA NOCUR/-1/,ZRO/0/ C2100153 DATA BUFLEN/40/ C2100154 DATA BLANK/$2020/ C2100155 DATA QUEST/'? '/ C2100156 DATA IODEF/'TERMINAL'/ C2100157ÐÐC C2100158 DATA BUFSIZ/ 4000/ C2100159 DATA KARAEO/ 'A ', 'E ', 'AO', 'EO', 'OA', 'OE', 'O '/ C2100160 DATA LOADQ/0/, NOFRCD/0/ C2100161C ************************************************************* 122*4872C2100162C*** C2100163C ************************************************************* 122*4872C2100164. C2100165C C2100166C INITIALISATION C2100167C C2100168 11 INDEX=0 C2100169+ ERROR MSG NO. C2100170 ERBUF=0 C2100171+ ERROR MSG BUF C2100172 ISTAT=0 C2100173+ STATUS OF FM-REQUEST C2100174 LNGO=0 C2100175+ LENGTH OF FIELD TO MOVE C2100176 MORPAR=0 C2100177+ INDICATOR IF MORE PARAMETERS NEEDED C2100178 MORLIN=0 C2100179+ INDICATOR IF MORE LINES NEED TO BE READ C2100180 PARNUM=0 C2100181+ COUNT OF REQ.AND NOT FOUND PARAMETERS C2100182ÐÐ PARID=0 C2100183 IFLAG=0 C2100184 IP=1 C2100185 DUMMY(6)=$4120 C2100186+ PRESET TO ASCII C2100187 DUMMY(1)=2HTE C2100188 DUMMY(2)=2HRM C2100189 DUMMY(3)=2HIN C2100190 DUMMY(4)=2HAL C2100191 LOADQ = 0 C2100192C C2100193 ASSIGN 9998 TO INTLOC C2100194 CALL PGMINT(INTLOC,IFLAG) C2100195C C2100196C COPY THE PARAMETER PROCESSING TABLE C2100197C C2100198 I=0 C2100199 10 I=I+1 C2100200 PPTEMP(I)=PPTAB(I) C2100201 IF(PPTEMP(I))10,20,10 C2100202C C2100203C C2100204C C2100205 20 DO 30 I=1,24 C2100206 REQBUF(I)=0 C2100207ÐÐ IDATA(I)=PARDEF(I) C2100208 30 CONTINUE C2100209C C2100210 35 IF(PIND)110,70,40 C2100211C C2100212C PROMPTING LEVEL = 1 FULL PARAMETERS WILL BE DISPLAYED C2100213C C2100214 40 KI=IP C2100215 I=(IP-1)*6+1 C2100216 IF(IPNAM(IP))50,100,50 C2100217C C2100218 50 J=I+5 C2100219 K=1 C2100220 CODE(K)=$0A0D C2100221+ SET CR/LF C2100222 DO 60 I=I,J C2100223 K=K+1 C2100224 CODE(K)=NAME(I) C2100225 60 CONTINUE C2100226C C2100227 I=KI C2100228 LNGO=7 C2100229 GO TO 90 C2100230. C2100231C C2100232ÐÐC PROMPTING LEVEL = 0 PARAMETER ABBREVIATIONS WILL BE DISPLAYED C2100233C C2100234 70 I=IP C2100235 K=IPNAM(IP) C2100236+ INDEX TO PARAM.MNEM.TABLE C2100237 IF(K)80,100,80 C2100238 80 K=(K-1)*3+1 C2100239C C2100240 CODE(1)=$0A0D C2100241 CODE(2)=PARNAM(K) C2100242 CODE(3)=$3D20 C2100243 LNGO=3 C2100244C C2100245C DISPLAY NEXT PARAMETER-IDENT C2100246C C2100247 90 CALL WTREAD (LUNIT,NOCUR,CODE,LNGO,NOCUR,DUMMY,ZRO,TC) C2100248C C2100249 PARID=IP C2100250+ INDEX IN PARNAM-TABLE C2100251 IFND(I)=1 C2100252+ SET FOUND FLAG C2100253 IP=IP+1 C2100254+ INCR. INDEX TO PPTEMP C2100255 MORPAR=1 C2100256+ SET INDICATOR FOR MORE PARAMETERS NEEDED C2100257ÐÐ GO TO 120 C2100258C C2100259C END OF PARAMETER LIST, ISSUE FM-REQUEST C2100260C C2100261 100 MORPAR=0 C2100262 GO TO 320 C2100263C C2100264C PROMPTING LEVEL = -1, NO PROMPTING DONE C2100265C C2100266 110 IF(MORLIN)115,130,130 C2100267+ DO WE NEED TO READ MORE LINES C2100268 115 MORLIN=0 C2100269C C2100270C READ NEXT LINE C2100271C C2100272 120 CALL WTREAD (LUNIT,NOCUR,DUMMY,ZRO,NOCUR,INBUF,BUFLEN,TC) C2100273C C2100274C RESET SWORD AND SBYTE C2100275C C2100276 SBYTE=0 C2100277 SWORD=0 C2100278C C2100279 130 CALL GETFLD (INBUF,CODE,SWORD,SBYTE,STAT) C2100280C C2100281 140 IF (STAT-2)150,160,200 C2100282ÐÐ 150 IF (STAT-1)260,250,250 C2100283C C2100284C EOL DETECTED,COUNT NO OF REQUIRED AND NOT FOUND PARAMETERS (STATUS=1)C2100285C C2100286 160 IF(PIND)161,162,162 C2100287 161 MORPAR=0 C2100288C C2100289C CHECK IF FULL NAME DESIRED C2100290C C2100291 162 IF (CODE(1)-QUEST)164,163,164 C2100292C C2100293C YES,FULL NAME FOR THIS PARAMETER ONLY C2100294C C2100295 163 IF (PIND .NE. -1) IP=IP-1 C2100296 GO TO 40 C2100297C C2100298C CHECK IF PARAMETER ENTERED C2100299C C2100300 164 IF(CODE(1)-BLANK)270,165,270 C2100301 165 IFND(IP-1)=0 C2100302 IF (PIND .EQ. -1) GO TO 320 C2100303 GO TO 35 C2100304C C2100305C PARAMETER-ID FOUND (STATUS=3) C2100306C C2100307ÐÐ 200 I=1 C2100308 210 K=IPNAM(I) C2100309 K=(K-1)*3+1 C2100310C C2100311 IF (CODE(1)-PARNAM(K))230,220,230 C2100312C C2100313C PARAMETER-ID CORRESPONDS WITH PARAM.MNEMONIC TABLE C2100314C C2100315 220 PARID=I C2100316 IFND(I)=1 C2100317 GO TO 130 C2100318C C2100319 230 I=I+1 C2100320+ NO MATCH,CONTINUE C2100321 IF(IPNAM(I))210,240,210 C2100322C C2100323 240 INDEX=39 C2100324+ PARAMETER ILLEGAL C2100325 GO TO 9999 C2100326C C2100327C FIELD TERMINATED ON A SEMI-COLON (STATUS=1) C2100328C C2100329 250 MORLIN=-1 C2100330+ SET INDICATOR TO READ MORE LINES C2100331C C2100332ÐÐC FIELD TERMINATED ON A COMMA (STATUS=0) C2100333C C2100334 260 MORPAR=1 C2100335+ SET INDICATOR FOR MORE PARAMETERS C2100336 IF(CODE(1) .NE. BLANK)GO TO 270 C2100337 IFND(IP)=0 C2100338 IP=IP+1 C2100339 GO TO 35 C2100340C C2100341C STORE PARAMETER VALUES INTO REQUIRED LOCATIONS C2100342C C2100343 270 IF (PARID)290,290,280 C2100344+ PARAMETER-ID FOUND C2100345 280 I=PARID C2100346+ YES C2100347 GO TO 300 C2100348C C2100349 290 I=IP C2100350 IF (CODE(1) .NE. BLANK) IFND(I)=1 C2100351 IP=IP+1 C2100352C C2100353 300 I=(IPNAM(I)-1)*3+1 C2100354C C2100355 LNGO=PARNAM(I+1) C2100356 OUTP=PARNAM(I+2) C2100357ÐÐC C2100358C STORE INTO DESIGNATED OUTPUT FIELD C2100359C C2100360 CALL MOVEL (CODE,OUTP,LNGO) C2100361C C2100362 PARID=0 C2100363 IF(MORPAR)310,320,310 C2100364+ ARE THERE MORE PARAM TO BE PROCESSED C2100365 310 IF(PIND)110,70,40 C2100366+ YES C2100367C C2100368C C2100369C ARE ALL REQUIRED PARAMETERS FOUND ? C2100370C C2100371 320 I=0 C2100372 330 I=I+1 C2100373 IF(PPTEMP(I))330,360,340 C2100374C C2100375C PARAMETER NOT FOUND,IS IT REQUIRED ? C2100376C C2100377 340 IF(IREQ(I))330,350,330 C2100378C C2100379C YES IT IS REQUIRED C2100380C C2100381 350 PARNUM=PARNUM+1 C2100382ÐÐ GO TO 330 C2100383C C2100384C END OF PPTAB C2100385C C2100386 360 IF(PARNUM)240,400,240 C2100387+ ARE ALL REQUIRED PARAMETERS FOUND C2100388C C2100389 C2100390C C2100391C C2100392C------------------------------------------------------------------- C2100393C C2100394C C2100395C CHECK FOR MODE CHARACTER ENTRY C2100396C (SPECIAL ENTRIES ARE 3-7 FOR ORDERED INDEX INDEXED C2100397C C2100398C C2100399 400 CONTINUE C2100400 NOFRCD = 0 C2100401 IOVRFL = 0 C2100402 ITALR1 = 0 C2100403 ITALR2 = 0 C2100404 IP = 1 C2100405C CHECK FOR BLANK, DEFAULT TO 'A' C2100406 IF (CODE( 1) .EQ. BLANK) GO TO 402 C2100407ÐÐ DO 401 IP = 1 , 7 C2100408C C2100409 IF (CODE( 1) .EQ. KARAEO(IP) ) GO TO 402 C2100410 401 CONTINUE C2100411C C2100412C CHECK IF 'CARDPRO' AND DEFAULT C2100413C C2100414 IP = 1 C2100415 IF ((MODE .NE. 0) .AND. (DUMMY( 6) .EQ. $4120) ) GO TO 402 C2100416C C2100417C MODE INPUT ERROR C2100418 INDEX = 69 C2100419 IP = 4 C2100420C C2100421 CALL SYSMSG( INDEX, ERBUF) C2100422 MORPAR = 1 C2100423 GO TO 35 C2100424C C2100425C******** SAVE MODE ENTRY TYPE CODE C2100426C C2100427 402 CONTINUE C2100428 ASEBSW = 0 C2100429 IF ( AND(1,IP) .EQ. 0) ASEBSW = 1 C2100430C ***** 15 CARDS DELETED 138*A029C2100431C C2100432ÐÐC GET LOGICAL UNIT NO C2100433C C2100434 5010 CALL LUNEQ (DUMMY,LOGUNT) C2100435 IF ( AND($8000,LOGUNT) .EQ. $8000) GO TO 8200 C2100436C ***** 138*A029C2100437C C2100438C CHECK IF INPUT TO TERMINAL C2100439C C2100440 IF (DUMMY(1).EQ.2HTE .AND. DUMMY(2).EQ.2HRM) GO TO 403 C2100441C C2100442C NOT TERMINAL, GET CLASS CODE FOR THIS DEVICE C2100443C C2100444C C2100445 ASSEM $E000,+LOG1A C2100446+ LDQ =XLOG1A C2100447 ASSEM $F400,+LOGUNT C2100448+ ADQ+ LOGUNT C2100449 ASSEM $E622 C2100450+ LDQ- (ZERO),Q C2100451 ASSEM $C208 C2100452+ LDA- 8,Q C2100453 ASSEM $0F4B C2100454+ ARS 11 C2100455 ASSEM $A005 C2100456+ AND- ONEMSK+2 C2100457ÐÐ ASSEM $6400,+ICLASS C2100458+ STA+ ICLASS C2100459C C2100460C CHECK IF CARD DEVICE. IF YES, GO TO 404 C2100461C C2100462 IF (ICLASS.EQ.3) GO TO 404 C2100463C C2100464C OTHER TYPE OF DEVICE, MAYBE TAPE. USE I/O BUFFER LENGTH C2100465C C2100466 MAXLEN = OBL000(0) C2100467 GO TO 405 C2100468C C2100469C TERMINAL INPUT. USE 68 AS MAX INPUT LENGTH. C2100470C C2100471 403 MAXLEN = 68 C2100472 GO TO 405 C2100473C C2100474C CARD INPUT . USE 40 AS MAX INPUT LENGTH C2100475C C2100476 404 MAXLEN = 40 C2100477 405 CONTINUE C2100478C ***** 138*A029C2100479C C2100480C----------------------------------------------------------------- C2100481C C2100482ÐÐC C2100483C STORE FCB-ADDR IN REQBUF C2100484C C2100485 ASSEM $C000,+FCBHDR C2100486+ LDA =XFCBHDR C2100487 ASSEM $6400,+REQBUF(10) C2100488+ STA REQBUF+9 C2100489C C2100490 REQBUF(13)=96 C2100491+ SET TO READ FULL LENGTH FCB C2100492C C2100493 IDATA(13)=0 C2100494+ THESE SETTINGS ARE REQUIRED BY OPENFL C2100495 IDATA(14)=1 C2100496 IDATA(15)=-1 C2100497. C2100498 CALL OPENFL (REQBUF,IDATA,ISTAT) C2100499C C2100500 IF (ISTAT .LT. 0) GO TO 8000 C2100501C C2100502C ***** 138*A029C2100503C C2100504C EXTRANEOUS CODE DELETED C2100505C C2100506C ***** 138*A029C2100507ÐÐC C2100508C GET SECTOR SIZE C2100509C C2100510 CALL GETSSZ (FCBHDR,SECLEN) C2100511 CALL CLOSFL (REQBUF,ISTAT) C2100512C C2100513 IF (ISTAT .LT. 0) GO TO 8000 C2100514C C2100515C ***** 138*A029C2100516C C2100517C COMPUTE LENGTH TO USE FOR INPUT C2100518C C2100519 INPLEN = RECLEN C2100520 IF (INPLEN.GT.BUFSIZ) GO TO 8210 C2100521 IF (RECLEN.GT.MAXLEN) INPLEN = MAXLEN C2100522C C2100523C CHECK IF FILE IS ALREADY FULL C2100524C C2100525 IF (FCBBUF(2).EQ.FCBBUF(7).AND.FCBBUF(3).EQ.FCBBUF(8)) GO TO 5060 C2100526C ***** 138*A029C2100527C C2100528 IPWIND=AND(FCBIND,$1) C2100529C C2100530C C2100531C** CHECK IF INDEXED FILE C2100532ÐÐC C2100533C C2100534C C2100535C C2100536C 'IP' SETTING IS BETWEEN 1 THROUGH 7 C2100537C INDEX VALUE IS SAME AS ARRAY 'KARAEF' SET-UP C2100538C (1 AND 2 ARE FOR 'A' AND 'E' ONLY) C2100539C C2100540 IF (IPWIND .EQ. 1) GO TO 7500 C2100541 IF (IP .LT. 3) GO TO 470 C2100542 450 CONTINUE C2100543 INDEX = 66 C2100544 GO TO 9999 C2100545C C2100546C C2100547C C2100548C C2100549C------- ---------- ---------- ------------- C2100550C C2100551C C2100552C*** SET UP BLOCKING FOR RECORD LOADING C2100553C C2100554C (BLOCKING IS USED TO SAVE THE NO. OF PUT CALL) C2100555C C2100556C C2100557ÐÐC CALCULATE BLOCKING SIZE = MAX. NO. OF RECORDS CAN BE C2100558C BUFFERED IN THE LOCAL BUFFER C2100559C C2100560C ---- SEQUENTIAL FILE : C2100561C C2100562C (A) SECTOR ALIGNED C2100563C NO. OF RECORD/BLOCK = (BUFFER SIZE) / C2100564C ( (NO. OF SECTOR) * (SECTOR SIZE) ) C2100565C C2100566C NO. OF SECTOR = (RECORD LENGTH)/(SECTOR SIZE) C2100567C C2100568C (B) NON-SECTOR ALIGNED C2100569C NO. OF RECORDS/BLOCK = (BUFFER SIZE)/(RECORD LENGTH) C2100570C C2100571C C2100572C CALCULATE DEFAULT VALUE (NON-SECTOR ALIGNED) C2100573C C2100574C C2100575 470 CONTINUE C2100576C ***** 138*A029C2100577 INCRBF = RECLEN C2100578C ***** 138*A029C2100579 MAXRED = BUFSIZ / RECLEN C2100580 IF ( AND(FCBIND , $8000) .EQ. 0) GO TO 501 C2100581 NUMSEC = RECLEN / SECLEN C2100582ÐÐ IF ((NUMSEC * SECLEN) .LT. RECLEN) NUMSEC = NUMSEC + 1 C2100583C ***** 138*A029C2100584 INCRBF = SECLEN * NUMSEC C2100585 MAXRED = BUFSIZ / INCRBF C2100586C ***** 138*A029C2100587C C2100588 501 CONTINUE C2100589C C2100590 REQBUF(13)=96 C2100591 IDATA(13)=0 C2100592 IDATA(14) = MAXRED C2100593C ***** 138*A029C2100594C C2100595C STORE FCB ADDRESS IN REQBUF C2100596C C2100597 ASSEM $C000,+FCBHDR C2100598+ LDA =XFCBHDR C2100599 ASSEM $6400,+REQBUF(10) C2100600+ STA+ REQBUF+9 C2100601C ***** 138*A029C2100602 CALL OPENFL (REQBUF,IDATA,ISTAT) C2100603C C2100604 IF (ISTAT .LT. 0) GO TO 8000 C2100605C C2100606 550 CONTINUE C2100607ÐÐ ISTORE = 1 C2100608 NOFRCD = 0 C2100609C ***** 138*A029C2100610C C2100611C PRESET TOTREC TO NUMBER OF EXISTING RECORDS C2100612C C2100613 TOTREC(1) = NEDATM C2100614 TOTREC(2) = NEDATL C2100615C ***** 138*A029C2100616C C2100617C** FILL INPUT BUFFER WITH SPACE CODES C2100618C C2100619 DO 560 ISTAT = 1 , BUFSIZ C2100620 RECBUF(ISTAT) = $2020 C2100621 560 CONTINUE C2100622C C2100623C READ ONE RECORD FROM THE SPECIFIED INPUT DEVICE C2100624C C2100625 5020 CONTINUE C2100626C ***** 138*A029C2100627C RESET NO OF CHARACTERS RECEIVED IN RECBUF(RECLEN+1) (SET BY THE C2100628C ITOS EXEC) TO BLANKS. THIS IS NOT MEANINGFUL THE FIRST TIME THRU C2100629C THIS LOGIC. C2100630 RECBUF(ISTORE) = $2020 C2100631 CALL REDREC (LOGUNT,INPLEN,RECBUF(ISTORE),ISTAT) C2100632ÐÐC C2100633C REBLANK 1ST WORD BEYOND LAST RECORD INPUT (MAY HAVE BEEN RESET BY C2100634C THE EXEC) C2100635C C2100636 IDX = ISTORE + INPLEN C2100637 RECBUF(IDX) = $2020 C2100638C ***** 138*A029C2100639C C2100640C CHECK FOR EOF C2100641C C2100642 IF (ISTAT .LT. 0) GO TO 9998 C2100643C C2100644C CHECK IF CONVERSION IS REQUIRED C2100645C C2100646C C2100647C 1 FOR EBCDIC CONVERSION C2100648C C2100649 IF (ASEBSW .EQ. 1) CALL ASCEBC(RECBUF(ISTORE),ASEBSW,RECLEN) C2100650C C2100651C INCREMENT NO. OF RECORD BY 1 AND CHECK IF REACH MAX. NO. OF RECORDS C2100652C IN THE BUFER. IF SO, SAVE DATA, OTHERWISE GO TO READ OTHER C2100653C RECORD. C2100654C C2100655C ***** 138*A029C2100656 ISTORE = ISTORE + INCRBF C2100657ÐÐC ***** 138*A029C2100658 NOFRCD = NOFRCD + 1 C2100659 IF (IOVRFL .NE. 0) GO TO 5035 C2100660C C2100661C INCREMENT NO. OF RECORD BY 1 AND CHECK IF REACH MAX. C2100662C ***** 138*A029C2100663 CALL BMPRRN (TOTREC) C2100664 IF (TOTREC(1).EQ.FCBBUF(2).AND.TOTREC(2).EQ.FCBBUF(3)) C2100665 1 IOVRFL = 1 C2100666C ***** 138*A029C2100667 IF (NOFRCD .LT. MAXRED) GO TO 5020 C2100668C C2100669C** FILE IS A SEQUENTIAL FILE, SAVE ALL RECORDS IN BUFFER C2100670C C2100671 5035 CONTINUE C2100672 CALL PUTS (REQBUF,RECBUF,NOFRCD,ISTAT) C2100673C C2100674 5040 CONTINUE C2100675 IF (ISTAT .LT. 0) GO TO 8000 C2100676 IF (IOUT .EQ. 1) GO TO 5060 C2100677 IF (IOVRFL .NE. 0) GO TO 9000 C2100678 GO TO 550 C2100679 5060 CONTINUE C2100680C C2100681 INDEX=55 C2100682ÐÐ+ 55 INSUFFICIENT MM FILE SPACE C2100683 CALL SYSMSG(INDEX, ERBUF) C2100684 GO TO 9000 C2100685C C2100686C C2100687C------------------------------------------------------------------ C2100688C C2100689C C2100690C FM-REQUEST TERMINATED WITH AN ERROR C2100691C C2100692 8000 CONTINUE C2100693 8010 CONTINUE C2100694 CALL ERCHK(ISTAT,REQBUF(4)) C2100695 GO TO 9994 C2100696C C2100697 8200 INDEX=63 C2100698+ 63 INVALID SYSTEM PERIPHERAL NAME C2100699 GO TO 9999 C2100700C C2100701 8210 INDEX=64 C2100702+ 64 RECORD LENGTH TOO LARGE FOR THIS COMMAC2100703 GO TO 9999 C2100704C C2100705C C2100706C ERROR ROUTINE C2100707ÐÐC C2100708 9999 CALL SYSMSG (INDEX,ERBUF) C2100709C C2100710 9994 IF (PIND) 9995,9995,11 C2100711 9995 IF (MODE) 9996,9998,9996 C2100712 9996 ASSEM $E400,+MODE C2100713 ASSEM $D622 C2100714C C2100715C********* END OF FILE DETECTED C2100716C C2100717C SAVE RECORDS, IF ANY, STILL IN BUFFER C2100718C C2100719 9998 CONTINUE C2100720 IF (NOFRCD .EQ. 0) GO TO 9000 C2100721 CALL PUTS(REQBUF, RECBUF, NOFRCD, ISTAT) C2100722 NOFRCD = 0 C2100723 IF (ISTAT .LT. 0) GO TO 8000 C2100724 9000 CONTINUE C2100725C C2100726 IF(FTYPE .EQ. 3) FTYPE=0 C2100727 CALL UPDFCB(REQBUF,0,INDEX,FCBBUF,ISTAT) C2100728 CALL CLOSFL(REQBUF,ISTAT) C2100729C C2100730 9997 RETURN C2100731C C2100732ÐÐC C2100733C--------------- INDEXED FILE OVERLAY INDEXED FILE C2100734C--------------- INDEXED FILE OVERLAY INDEXED FILE C2100735C--------------- INDEXED FILE OVERLAY INDEXED FILE C2100736C C2100737C C2100738C 'IP' CONTAINS ORDERED OR NON-ORDERED REQUEST C2100739C 'IP' IS EQUAL TO OR GREATWR THAN 3 IS FOR ORDERED C2100740C C2100741C C2100742C SET UP INPUT LOGICAL UNIT AND EBCDIC CONVERSION SWITCH C2100743C C2100744C C2100745C C2100746 7500 CONTINUE C2100747 IDATA(13) = 1 C2100748 IDATA(14) = LOGUNT C2100749 IDATA(15) = ASEBSW C2100750C ***** 138*A029C2100751 IDATA(16) = INPLEN C2100752C ***** 138*A029C2100753 LOADQ = 2 C2100754 IF (IP .LE. 2) RETURN C2100755C C2100756C IT IS ORDERED INDEX FILE, BUT MUST CHECK C2100757ÐÐC C2100758C C2100759C**** CHECK IF RECORD NUMBER IN FILE IS NON-ZERO C2100760C C2100761 IF ((FCBBUF(7) .EQ. 0) .AND. (FCBBUF(8) .EQ. 0)) LOADQ = 1 C2100762 RETURN C2100763 END C2100764 INTEGER FUNCTION BLDIDQ(IDUM) C3900001 1 /Q16 F ITOS CCS 3.0 SL-149C3900002C BUILD INDEX FOR RANDOMLY ORDERED RECORDS C3900003C CREDIT COLLECTION SYSTEM VERSION 3.0ED SYSTEM VERSION 1.0 C3900004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C3900005C COPYRIGHT CONTROL DATA CORPORATION 1979 C3900006C*** C3900007C C3900008C THIS PROCESSOR IS USED TO BUILD ONE OR MORE INDEXES FOR A FILE IN C3900009C WATCH IT IS ASSUMED THAT THE RECORDS ARE RAMDOMLY ORDERED WITH C3900010C RESPECT TO COLATING SEQUENCE OF THE KEYS. WHEN BLDIDR IS CALLED, C3900011C IT IS NOTIFIED WHICH KEY IS THE FIRST ONE FOR WHICH IT IS TO C3900012C BUILD AN INDEX. IF THE PRIMARY KEY IS THE FIRST, BLDIDR WILL READC3900013C IN THE RECORDS FROM THE INPUT DEVICE AND STORE THEM INTO THE DATA C3900014C FILE. FOR EACH KEY OTHER THAN THE PRIMARY, BLDIDR WILL READ IN C3900015C THE RECORDS FROM THE FILE. BLDIDR WILL BUILD INDEXES FOR ALL C3900016C NEEDED KEYS PRIOR TO RETURNING TO THE CALLER. C3900017C C3900018ÐÐC BLDIDR IS EXECUTED AS AN INTEGER FUNCTION. THE SINGLE PARAMETER C3900019C IDUM IS A DUMMY. BLDIDR SHOULD BE SET TO 0 (ZERO) UPON THE C3900020C RETURN. C3900021C C3900022C WHEN BLDIDR IS CALLED, THE FILE FOR WHICH THE INDEX IS TO BE BUILTC3900023C MUST BE DEFINED VIA THE FIRST 12 WORDS OF IDATA (USING IDATA FROM C3900024C THE LABELLED COMMON OF THE CALLING PROGRAM). IDATA(13) MUST C3900025C SPECIFY THE FIRST KEY (INTEGER 1 THRU 4) FOR WHICH BLDIDR IS TO C3900026C BUILD AN INDEX. IDATA(14) MUST SPECIFY THE LOGICAL UNIT TO BE C3900027C USED TO READ THE INPUT RECORDS. IDATA(15) MUST CONTAIN AN ENTRY C3900028C MODE SWITCH INDICATING WHETHER OR NOT THE INPUT RECORDS ARE TO C3900029C BE CONVERTED FROM EBCDIC TO ASCII WHERE 1 SIGNIFIES YES AND C3900030C 0 SIGNIFIES NO. THE FILE MUST BE CLOSED. C3900031C C3900032C C3900033C*** C3900034C C3900035M FMUCOQ C3900036 INTEGER ICOMON(700) C3900037 EQUIVALENCE (COMCOD,ICOMON) C3900038C C3900039C THIS IS THE LOCAL BUFFER USED TO SAVE THE PORTION OF C3900040C LABELED COMMON USED BY ALL NON-INDEX LOAD RELATED UTILITIES. C3900041C C3900042 INTEGER BUFFER(528) C3900043ÐÐC LENGTH OF COMMON C3900044 DATA LENCOM/528/ C3900045C C3900046C C3900047C THESE WORDS ARE DEFINED BY UPDIDX COMMON (MACRO FMCOM) SO THEY C3900048C MUST BE EQUATED INTO ORIGINAL COMMON. C3900049C C3900050 INTEGER RQBADR, FCBADR, KEYLNG, KEYLWD, KEYTYP, KIBHRL, KIBLEN, C3900051 1 KIBTYP, KLIDX(4) , MAXKIS, NOROOT, NKIBNL, NKIBNM, C3900052 2 NUMKIS, PKIBNL, PKIBNM, RECLNG, REQSTA, ROOT , SSET , C3900053 3 WPS , ZERO2(2),RRDATA(2),KISLNG C3900054 EQUIVALENCE (ICOMON( 1),RQBADR),(ICOMON( 2),FCBADR), C3900055 1 (ICOMON( 8),KEYLNG),(ICOMON( 9),KEYLWD),(ICOMON( 10),KEYTYP), C3900056 2 (ICOMON(598),KIBHRL),(ICOMON(599),KIBLEN),(ICOMON(600),KIBTYP), C3900057 3 (ICOMON(672),KLIDX ),(ICOMON(679),MAXKIS),(ICOMON(683),NOROOT), C3900058 4 (ICOMON(684),NKIBNL),(ICOMON(685),NKIBNM),(ICOMON(686),NUMKIS), C3900059 5 (ICOMON(687),PKIBNL),(ICOMON(688),PKIBNM),(ICOMON(689),RECLNG), C3900060 EQUIVALENCE C3900061 1 (ICOMON(690),REQSTA),(ICOMON(693),ROOT ),(ICOMON(696),SSET ), C3900062 2 (ICOMON(697),WPS ),(ICOMON(698),ZERO2 ),(ICOMON(694),RRDATA), C3900063 3 (ICOMON(671),KISLNG) C3900064 EQUIVALENCE (REQSTA,ISTAT) C3900065C C3900066 INTEGER REQBFF(24),JDATA(24),FCBHDD(5),FCBBFF(96) C3900067C C3900068ÐÐC RECBUF IS USED AS THE INPUT RECORD BUFFER. RBLEN IS THE LENGTH C3900069C OF THE BUFFER. NO2RED IS THE NUMBER OF RECORDS TO READ PER GETS C3900070C CALL (DEPENDENT UPON RECORD SIZE AND RBLEN). C3900071C C3900072 INTEGER RECBUF(1802),RBLEN C3900073C ALL RECORDS READ FLAG C3900074 DATA RBLEN/1800/,NO2RED/0/ , IDONE/0/ C3900075C DEFERRED ERROR FLAG MAXIMUN READ FLAG C3900076 DATA IDEFER/0/ , MAXRED/0/ C3900077C C3900078C C3900079 INTEGER NUMPRO(2),NUMRED(2),IDUMMY(2),WRTCOD C3900080C ***** 138*A031C3900081 INTEGER ISAVE(2),LSAVE(2) C3900082 DATA ISAVE /0,1/ C3900083C ***** 138*A031C3900084C C3900085C NUMBER OF RECORDS READ WRITE INDEXED RECORD CODE C3900086 DATA NUMRED/0,0/, WRTCOD/$C/ C3900087C C3900088 EXTERNAL MMLUTB C3900089+ FILE MANAGER LOGICAL UNIT TABLE C3900090 EXTERNAL WRTKIB C3900091+ WRITE ALL CHANGED KIBS TO MASS MEMORY C3900092 INTEGER WRTKIB C3900093ÐÐ+ INTEGER FUNCTION C3900094C C3900095C ******************************************************************C3900096C C3900097C SAVE IDATA CONTENTS LOCALLY C3900098C C3900099 DO 5 I = 1,24 C3900100 5 JDATA(I) = IDATA(I) C3900101C C3900102C SAVE CURRENT COMMON CONTENTS THEN ZERO IT OUT C3900103 DO 10 I = 1, LENCOM C3900104 BUFFER(I) = ICOMON(I) C3900105 10 ICOMON(I) = 0 C3900106C C3900107C PROGRAM ABORT REQUEST SETUP C3900108 JJJ = 0 C3900109 ASSIGN 120 TO INTLOC C3900110+ 127*5166C3900111 CALL PGMINT (INTLOC,JJJ) C3900112C C3900113C SET UP FIRST 2 WORDS OF UPDIDX COMMON C3900114C C3900115 ASSEM $C000,+FCBHDD C3900116+ LDA =XFCBHDR C3900117 ASSEM $6400,+FCBADR C3900118ÐÐ+ STA FCBADR C3900119 ASSEM $C000,+REQBFF C3900120+ LDA =XREQBUF C3900121 ASSEM $6400,+RQBADR C3900122+ STA RQBADR C3900123C C3900124C SAVE 1ST KEY NEEDING AN INDEX. (DECREMENTED BY 1) C3900125 KEYTYP = JDATA(13) - 1 C3900126C C3900127C SAVE LOGICAL UNIT TO BE USED FOR RECORD INPUT C3900128 LOGUNT = JDATA(14) C3900129C C3900130C SAVE ENTRY MODE SWITCH C3900131 MODESW = JDATA(15) C3900132C ***** 138*A031C3900133 IS1 = 0 C3900134+ CLEAR INITIAL SET FLAG C3900135C C3900136C SAVE INPUT LENGTH FOR RECORD READS C3900137 INPLEN = JDATA(16) C3900138 NOLOAD = 0 C3900139+ SET NO RECORDS LOADED FLAG C3900140C ***** 138*A031C3900141C C3900142 JDATA(13) = -2 C3900143ÐÐ+ SPECIAL PROCESSING CODE C3900144 JDATA(14) = 1 C3900145+ NO. OF RECORDS - TO BE CHANGED C3900146C C3900147C SET UP REQBFF TO CAUSE FCB TO BE IN USER SPACE. C3900148C C3900149 ASSEM $C000,+FCBHDD C3900150+ LDA =XFCBHDD C3900151 ASSEM $6400,+REQBFF(10) C3900152+ STA REQBFF+9 C3900153 ASSEM $0A60 C3900154+ ENA 96 C3900155 ASSEM $6400,+REQBFF(13) C3900156+ STA REQBFF+12 C3900157C C3900158C ************************************************** C3900159C C3900160C OPEN THE FILE C3900161C C3900162 CALL OPENFL (REQBFF,JDATA,ISTAT) C3900163 IF (ISTAT.LT.0) GO TO 900 C3900164C C3900165C SAVE FCB WORD 6 C3900166 IWORD6 = FCBBFF(6) C3900167C C3900168ÐÐC CHANGE FILE TYPE TO SEQUENTIAL C3900169 FCBBFF(6) = AND(FCBBFF(6),$FFFE) C3900170C C3900171C --SET UP WORDS PER SECTOR AND KIB LENGTH C3900172C C3900173 ASSEM $C400,+FCBHDD C3900174+ LDA FCBHDD EXTRACT MM C3900175 ASSEM $0F4B C3900176+ ARS 11 LU PORTION C3900177 ASSEM $A007 C3900178+ AND- ONEMSK+4 OF FILEID. C3900179 ASSEM $0822 C3900180+ TRA Q C3900181 ASSEM $E600,+MMLUTB C3900182+ LDQ MMLUTB,Q C3900183 ASSEM $C20D C3900184+ LDA- VIWPS,Q GET WPS FOR C3900185 ASSEM $6400,+WPS C3900186+ STA WPS VOLUME. C3900187 ASSEM $6400,+IWPS C3900188+ STA+ IWPS (SECTOR LENGTH) C3900189C C3900190C GET KIB LENGTH IN WORDS C3900191C C3900192 CALL UTCKLN (WPS,KIBLEN) C3900193ÐÐ2 C3900194 RECLNG = FCBBUF(1) C39001952 C3900196 KLIDX(1) = 20 C3900197 KLIDX(2) = 22 C3900198 KLIDX(3) =24 C3900199 KLIDX(4) = 26 C39002001 C3900201 KIBHRL = 6 C3900202 NUMKIS = 1 C3900203 NKIBNM = 2 C3900204 NKIBNL = 3 C3900205 PKIBNM = 4 C3900206 PKIBNL = 5 C3900207 KIBTYP = 6 C39002081 C3900209 ROOT = 0 C3900210 NOROOT = 1 C3900211 SSET = 2 C39002121 C3900213 ZERO2(1) = 0 C3900214 ZERO2(2) = 0 C3900215C ***** 138*A031C3900216C SAVE CURRENT NUMBER OF RECORDS IN THE FILE C3900217C C3900218ÐÐ LSAVE(1) = FCBBFF(7) C3900219 LSAVE(2) = FCBBFF(8) C3900220C ***** 138*A031C3900221C C3900222C SET RECORD LENGTH FOR I/O AND INDEXING C3900223 IRLEN = FCBBFF(1) C3900224C C3900225C IF RECORDS ARE SECTOR ALIGNED, RECOMPUTE RECORD LENGTH TO BE AN C3900226C INTEGRAL NUMBER OF WORDS PER SECTOR C3900227C C3900228 IF (FCBBFF(6) .GT. 0) GO TO 20 C3900229C C3900230C COMPUTE NEW RECORD LENGTH C3900231C C3900232 II = IRLEN/IWPS C3900233 III = II * IWPS C3900234 IF (IRLEN.NE.III) II = II + 1 C3900235 IRLEN = II * IWPS C3900236C C3900237C COMPUTE NUMBER OF RECORDS THAT WILL FIT IN RECORD BUFFER. C3900238C C3900239 20 NO2RED = RBLEN / IRLEN C3900240 REQBFF(13) = NO2RED C3900241C C3900242C INITIALIZE THE KIB BUFFER TABLES C3900243ÐÐC C3900244 40 CALL INIKIB C3900245C ***** 138*A031C3900246 IF (ISAVE(1).EQ.0 .AND. ISAVE(2).EQ.1) GO TO 45 C3900247C C3900248C INITIALIZE NO. OF RECORDS PROCESSED TO SAVE INIT. NO. C3900249C C3900250 NUMPRO(1) = LSAVE(1) C3900251 NUMPRO(2) = LSAVE(2) C3900252 GO TO 48 C3900253C C3900254C DO THIS IF FIRST LOAD WAS FROM THE ORDERED LOAD MODULE C3900255C C3900256 45 NUMPRO(1) = 0 C3900257 NUMPRO(2) = 0 C3900258 48 CONTINUE C3900259C ***** 138*A031C3900260C C3900261C CLEAR WORDS 18-20 OF REQUEST BUFFER C3900262C C3900263 REQBFF(18) = 0 C3900264 REQBFF(19) = 0 C3900265 REQBFF(20) = 0 C3900266C ***** 138*A031C3900267C IF KEYTYP=0, RESET NUMRED TO NO. OF EXIST. RCRDS IN FILE C3900268ÐÐC C3900269 IF (KEYTYP.NE.0) GO TO 50 C3900270C C3900271 NUMRED(1) = FCBBFF(7) C3900272 NUMRED(2) = FCBBFF(8) C3900273C ***** 138*A031C3900274C C3900275C CLEAR DONE FLAG C3900276C C3900277 50 IDONE = 0 C3900278C ***** 138*A031C3900279 ISTART = 0 C3900280+ CLEAR START FLAG C3900281C ***** 138*A031C3900282C C3900283C ************************************************** C3900284C C3900285C BUMP KEYTYP AND CHECK IF KEY EXISTS FOR THAT KEY TYPE C3900286C C3900287 KEYTYP = KEYTYP + 1 C3900288 IF (KEYTYP.EQ.5) GO TO 200 C3900289 IND = (KEYTYP*2) + 13 C3900290 IF (FCBBFF(IND).EQ.0) GO TO 200 C3900291C C3900292C SET KEY LENGTH IN CHARACTERS AND WORDS C3900293ÐÐC C3900294 I = KLIDX(KEYTYP) C3900295 KEYLNG = FCBHDD(I) C3900296 KEYLWD = (KEYLNG+1)/2 C3900297 KISLNG = KEYLWD + 2 C3900298 MAXKIS = (KIBLEN-KIBHRL) / KISLNG C3900299C C3900300C CHECK IF KEYTYP = 1. IF SO, READ FILE RECORDS FROM INPUT LOGICAL C3900301C UNIT AND STORE IN FILE VIA PUTS REQUEST. C3900302C C3900303 75 IF (KEYTYP.NE.1) GO TO 130 C3900304C C3900305C** FILL INPUT BUFFER WITH SPACE CODE C3900306C C3900307 DO 85 LFL = 1 , RBLEN C3900308 RECBUF(LFL) = $2020 C3900309 85 CONTINUE C3900310 100 NRREAD = 0 C3900311 DO 110 I = 1,NO2RED C3900312C C3900313C COMPUTE BUFFER INDEX FOR CURRENT RECORD C3900314C C3900315 IDX = NRREAD* IRLEN + 1 C3900316C ***** 138*A031C3900317C C3900318ÐÐC RESET NO. OF CHAR REC. IN RECBUF(RECLEN+1) (SET BY THE C3900319C ITOS EXEC) TO BLANKS. THIS IS NOT MEANINGFUL THE 1ST TIME C3900320 RECBUF(IDX) = $2020 C3900321C ***** 138*A031C3900322C C3900323C READ IN THE RECORD AND CHECK STATUS C3900324C C3900325C ***** 138*A031C3900326 CALL REDREC (LOGUNT, INPLEN, RECBUF(IDX), ISTAT) C3900327C C3900328C REBLANK THE 1ST WORD AFTER THE LAST RECORD INPUT (MAY HAVE BEEN C3900329C RESET BY THE EXEC) C3900330C C3900331 IDD = IDX + INPLEN C3900332 RECBUF(IDD) = $2020 C3900333C C3900334C CHECK IF 1ST RECORD READ IS AN EOF C3900335C C3900336 IF (ISTAT.GE.0) GO TO 101 C3900337 IF (NRREAD.EQ.0 .AND. IS1.EQ.0) GO TO 200 C3900338 GO TO 120 C3900339 101 CONTINUE C3900340C C3900341C SET NOLOAD FLAG TO INDICATE RECORD READ C3900342C C3900343ÐÐ NOLOAD = 1 C3900344C ***** 138*A031C3900345C C3900346C CHECK IF THIS RECORD IS ONE TOO MANY, IF YES GO TO 103 C3900347C C3900348 IF (MAXRED.EQ.1) GO TO 103 C3900349C C3900350C BUMP NUMBER OF RECORDS PROCESSED BY 1 AND CHECK IF TOTAL NUMBER C3900351C PERMITTED HAS BEEN REACHED. C3900352C C3900353 CALL BMPRRN (NUMRED) C3900354 IF (FCBBFF(2).EQ.NUMRED(1) .AND. FCBBFF(3).EQ.NUMRED(2)) MAXRED =1C3900355 GO TO 105 C3900356C C3900357C TOO MANY RECORDS, SET DEFERRED ERROR FLAG. C3900358 103 IDEFER = 1 C3900359 GO TO 120 C3900360C C3900361C CONVERT FROM EBCDIC TO ASCII IF REQUIRED C3900362C C3900363 105 IF (MODESW.EQ.1) CALL ASCEBC (RECBUF(IDX),MODESW,FCBBFF(1)) C3900364C 127*5166C3900365C EXTRACT KEY FOR USE BY UPDIDX 127*5166C3900366C 127*5166C3900367 CALL XTKEY (FCBHDD,RECBUF(IDX)) C3900368ÐÐ+ 127*5166C3900369C 127*5166C3900370C STORE RRN FOR UPDIDX 127*5166C3900371C 127*5166C3900372 RRDATA(1) = NUMRED(1) C3900373+ 127*5166C3900374 RRDATA(2) = NUMRED(2) C3900375+ 127*5166C3900376C 127*5166C3900377C UPDATE INDEX TO REFLECT ADDITION OF CURRENT RECORD 127*5166C3900378C 127*5166C3900379 CALL UPDIDX C3900380+ 127*5166C3900381 IF (ISTAT .LT. 0) GO TO 108 C3900382+ 127*5166C3900383C C3900384C BUMP COUNT OF RECORDS C3900385C C3900386 NRREAD = NRREAD + 1 C3900387 GO TO 110 C3900388+ 127*5166C3900389 108 IDEFER = 2 C3900390+ 127*5166C3900391 ISAVST = ISTAT C3900392+ 127*5166C3900393ÐÐ GO TO 120 C3900394+ 127*5166C3900395 110 CONTINUE C3900396 GO TO 125 C3900397C C3900398C SET DONE FLAG C3900399C C3900400 120 IDONE = 1 C3900401 125 IF (NRREAD .EQ. 0) GO TO 170 C3900402+ 127*5166C3900403C C3900404C STORE THE NRREAD RECORDS INTO THE FILE. C3900405C C3900406 CALL PUTS (REQBFF,RECBUF,NRREAD,ISTAT) C3900407 IF (ISTAT.LT.0) GO TO 905 C3900408C ***** 138*A031C3900409C C3900410C IF INIT SET FLAG=0, SET IT AND SET ISAVE TO REL REC NO OF C3900411C 1ST RECORD STORED. C3900412C C3900413 IF (IS1.NE.0) GO TO 128 C3900414 IS1 = 1 C3900415 ISAVE(1) = REQBFF(16) C3900416 ISAVE(2) = REQBFF(17) C3900417 128 CONTINUE C3900418ÐÐC ***** 138*A031C3900419C 127*5166C3900420C CHECK IF WE ARE DONE 127*5166C3900421C 127*5166C3900422 IF (IDONE .EQ. 1) GO TO 170 C3900423+ 127*5166C3900424 GO TO 75 C3900425+ 127*5166C3900426C C3900427C READ IN A BLOCK OF NO2RED RECORDS FROM THE FILE. SET NRREAD TO C3900428C NUMBER OF RECORDS ACTUALLY READ. C3900429C C3900430C C3900431C ***** 138*A031C3900432C C3900433C DO INITIAL READ VIA READR RATHER THAN GETS C3900434C C3900435 130 IF (ISTART.NE.0) GO TO 134 C3900436 ISTART = 1 C3900437 CALL READR (REQBFF,RECBUF,ISAVE,ISTAT) C3900438 GO TO 136 C3900439C C3900440 134 CALL GETS (REQBFF,RECBUF,IDUMMY,ISTAT) C3900441 136 NRREAD = REQBFF(15) C3900442C ***** 138*A031C3900443ÐÐ IF (ISTAT.LT.0) GO TO 910 C3900444C C3900445C PROCESS EACH RECORD FROM THE INPUT BUFFER C3900446C C3900447 140 IRECD = 1 C3900448C 6 CARDS REMOVED 127*5166C3900449C C3900450C COMPUTE INDEX TO REFERENCE CURRENT RECORD C3900451C C3900452 160 IDX = (IRECD-1) * IRLEN + 1 C3900453C C3900454C EXTRACT KEY FOR USE BY UPDIDX C3900455C C3900456 CALL XTKEY (FCBHDD,RECBUF(IDX)) C3900457C C3900458C C3900459C BUMP NUMBER OF RECORDS PROCESSED BY 1 TO GET REL. REC. NO. C3900460C C3900461 CALL BMPRRN (NUMPRO) C3900462C C3900463C STORE RRN FOR UPDIDX C3900464C C3900465 RRDATA(1) = NUMPRO(1) C3900466 RRDATA(2) = NUMPRO(2) C3900467C C3900468ÐÐC UPDATE INDEX TO REFLECT ADDITION OF CURRENT RECORD C3900469C C3900470 CALL UPDIDX C3900471 IF (ISTAT .LT. 0) GO TO 920 C3900472 IRECD = IRECD + 1 C3900473C 3 CARDS REMOVED 127*5166C3900474 IF (IRECD .LE. NRREAD) GO TO 160 C3900475C C3900476C CHECK IF ALL RECORDS HAVE BEEN PROCESSED C3900477C C3900478 IF (NUMPRO(1).EQ.FCBBFF(7) .AND. NUMPRO(2).EQ.FCBBFF(8)) GO TO 170C3900479 GO TO 130 C3900480C C3900481C C3900482C ************************************************** C3900483C C3900484C C3900485C WRITE ALL CHANGED KIBS TO MASS MEMORY C3900486C C3900487 170 CALL WRTKIB C3900488 IF (REQSTA.LT.0) GO TO 930 C3900489C C3900490C GO BACK TO 40 AND PREPARE TO PROCESS NEXT KEY IF IT EXISTS. C3900491C C3900492 GO TO 40 C3900493ÐÐC C3900494C C3900495C C3900496C RESTORE FCB WORD 6 C3900497 200 FCBBFF(6) = IWORD6 C3900498C C3900499C CLOSE FILE C3900500C C3900501 CALL CLOSFL (REQBFF,ISTAT) C3900502C C3900503C RESTORE SAVED COMMON C3900504C C3900505 DO 210 I = 1, LENCOM C3900506 210 ICOMON(I) = BUFFER(I) C3900507C C3900508C IF DEFERRED ERROR FLAG SET, GENERATE ERROR MESSAGE C3900509 IF (IDEFER.EQ.0) GO TO 220 C3900510 IF (IDEFER .EQ. 1) GO TO 215 C3900511+ 127*5166C3900512 CALL ERCHK (ISAVST,WRTCOD) C3900513+ 127*5166C3900514 GO TO 220 C3900515+ 127*5166C3900516 215 CONTINUE C3900517+ 127*5166C3900518ÐÐC C3900519C SIMULATE WRITER CALL WITH APPROPRIATE ERROR STATUS C3900520 CALL ERCHK ($9000,WRTCOD) C3900521C C3900522C SET BLDIDQ TO SIGNAL ALL DONE. C3900523 220 BLDIDQ = 0 C3900524C C3900525 RETURN C3900526C ************************************************** C3900527C ERROR PROCESSING C3900528 900 CONTINUE C3900529 905 CONTINUE C3900530 910 CONTINUE C3900531 920 CONTINUE C3900532 930 CONTINUE C3900533 CALL ERCHK (REQSTA, REQBFF(4)) C3900534 GO TO 200 C3900535C ***** 138*A031C3900536C C3900537C ABORT ENTRY C3900538C C3900539C CHECK IF ANY RECORDS PROCESSED YET. IF YES, GO TO 120 C3900540 1000 IF (NOLOAD.EQ.1) GO TO 120 C3900541 GO TO 200 C3900542C ***** 138*A031C3900543ÐÐ END C3900544 INTEGER FUNCTION LDIXOQ(IDUMMY) C4000001 1 /Q17 F ITOS CCS 3.0 SL-149C4000002C BUILD KEY INDEX ROUTINE C4000003C CREDIT COLLECTION SYSTEM VERSION 3.0ED SYSTEM VERSION 1.0 C4000004C DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C4000005C COPYRIGHT CONTROL DATA CORPORATION 1979 C4000006C C4000007C LDIXOD LOADS AN ORDERED INDEXED FILE AND BUILDS ITS INDEX. C4000008C C4000009C LDIXOD READS THE SOURCE RECORDS FROM THE APPROPRIATE INPUT C4000010C LOGICAL UNIT. IT STORES THE RECORDS INTO A RECORD RECEIVING C4000011C BUFFER UNTIL THE BUFFER BECOMES FULL. AFTER THE BUFFER IS C4000012C FULL, THE RECORDS ARE STORED INTO THE FILE USING A PUTS C4000013C REQUEST. C4000014C C4000015C AS EACH RECORD IS INPUT, A KIS IN INSERTED INTO A SEQUENCE SETC4000016C KIB FOR THE RECORD. KIBS (OTHER THAN ROOT KIBS) ARE ONLY C4000017C FILLED 3/4 FULL SO AS TO PERMIT ADDITIONS TO THE FILE WITHOUT C4000018C INCURRING EXCESSIVE PENALTY. AFTER A KIB BECOMES 3/4 FULL ANDC4000019C DOES NOT HAVE ROOM FOR A KIS FOR THE LAST RECORD LOADED, THE C4000020C NEXT SEQUENCE SET KIB IS ALLOCATED (KIB RKN-WISE), THE CURRENTC4000021C KIB IS LINKED TO THE NEW (NEXT) SEQUENCE SET KIB AND THE C4000022C CURRENT KIB IS WRITTEN TO THE FILE USING AN UPDATE RECORD RE- C4000023C QUEST. AN ENTRY FOR EACH SEQUENCE KIB IS INSERTED INTO AN C4000024ÐÐC APPROPRIATE FATHER KIB. KIBS HIGHER THAT LOWEST LEVEL WILL C4000025C BE WRITTEN TO MM AS APPROPRIATE AND NEW LEVELS CREATED AS C4000026C NEEDED. AFTER THE ORIGINAL SET OF RECORDS HAVE BEEN READ AND C4000027C THE FIRST TWO KIBS HAVE BEEN CREATED, THE HIGHEST LEVEL KIB C4000028C (THE ROOT) WILL ALWAYS BE IN CORE. THE ROOT WILL NOT BE C4000029C WRITTEN OUT TILL ALL DATA RECORDS HAVE BEEN INPUT. C4000030C C4000031C NON-OREDERED KEY INDEXES AND SECONDARY KEY INDEXES ARE BUILT C4000032C BY THE BLDIDR MODULE. C4000033C C4000034C THE CURRENT SIZE OF KIBBUF WILL SUFFICE FOR A 12 LEVEL C4000035C KEY INDEX GIVEN A SECTOR SIZE OF 96 WORDS. IF C4000036C OTHER THAN 96 WORD SECTORS ARE USED, 'LDIXOD' COMPUTES THE C4000037C NUMBER OF LEVELS POSSIBLE. C4000038M FMUCOQ C4000039C C4000040C C4000041C C4000042C C4000043 EQUIVALENCE (LENKY1,FCBBUF( 15)) C4000044 EQUIVALENCE (FTYPE ,FCBBUF( 95)) C4000045 EQUIVALENCE (RECLEN,FCBBUF( 1)) C4000046 EQUIVALENCE (FCBIND,FCBBUF( 6)) C4000047C C4000048 INTEGER FTYPE C4000049ÐÐ INTEGER RECLEN,FCBIND,SECLEN C4000050C C4000051 INTEGER RECBUF(3502),KIBBUF(3458),FRSTBY,NXTKIB(2),KISBUF(17), C4000052 1 KISSAV(17),TOTREC(2),ITEMP1(2),KIBM(12),KIBL(12), C4000053 1 IRRN(2),ISAVE(6) C4000054 DIMENSION KSHIFT( 2),KMSKBT( 2) C4000055 DIMENSION LRELRD( 2) C4000056C C4000057C C4000058C RECORD BFR LENGTH KIB BFR LENGTH ALL RECORDS READ FLAG C4000059 DATA IRBLEN/3500/, IKBLEN/3256/, IDONE/0/ C4000060C NEXT AVAILABLE KIB NUMBER NUMBER OF PYRAMID LEVELS C4000061 DATA NXTKIB/0,3/, NUMLEV/1/ C4000062C TOTAL RECORDS PROCESSED KIB ADDRESSES C4000063 DATA TOTREC/0,0/, KIBM/12*0/, KIBL/2,11*0/ C4000064C MAX. NO. OF LEVELS C4000065 DATA MAXLEV/ 12/ C4000066C MAXIMUM SIZE OF KIBS IF NOT 96 WDS. PER SECTOR C4000067 DATA MAXSIZ/ 572/ C4000068 INTEGER SAVBUF(8) C4000069 DATA LDIXOQ/0/ C4000070 DATA KSHIFT/ 1, $100/, KMSKBT/ $FF00, 0/ C4000071C WRITE INDEXED CODE C4000072 INTEGER WRTCOD C4000073 DATA WRTCOD/$C/ C4000074ÐÐ DATA MAXRED/0/ C4000075 DATA K3SRWD/ 288/ C4000076 DATA SECLEN/ 96/ C4000077 DATA KISSAV/ 17*0/ C4000078C PRE-SET REL. RECORD NO. TO 1 C4000079 DATA IRRN/ 0, 1/ C4000080 DATA IEXIT/0/ C4000081+ 127*5124C4000082C ***** 138*A030C4000083 DATA IDEFER/0/ C4000084C ***** 138*A030C4000085C C4000086C C4000087C FIRST, CLEAR OUT RECBUF AND KIBBUF C4000088C C4000089 DO 100 I = 1, IRBLEN C4000090 100 RECBUF(I) = 0 C4000091 DO 110 I = 1, IKBLEN C4000092 110 KIBBUF(I) = 0 C4000093C C4000094C*** PROGRAM ABORT REQUEST SET-UP C4000095C C4000096 LDIXOQ = 0 C4000097 IDONE = 0 C4000098 IRECD = 0 C4000099ÐÐ I = 0 C4000100 ASSIGN 3000 TO INTLOC C4000101 CALL PGMINT( INTLOC, I) C4000102C C4000103C**** SAVE LOGICAL UNIT AND DATA TYPE C4000104C C4000105 LOGUNT = IDATA( 14) C4000106 IDATYP = IDATA( 15) C4000107C ***** 138*A030C4000108C C4000109C SAVE INPUT LENGTH FOR RECORD READS C4000110C C4000111 INPLEN = IDATA(16) C4000112C ***** 138*A030C4000113C C4000114C C4000115C OPEN FILE C4000116C C4000117 IDATA(13) = -2 C4000118 IDATA(15) = 0 C4000119 IDATA(14) = 1 C4000120 REQBUF(13) = 96 C4000121 ASSEM $C000,+FCBHDR C4000122+ LDA =XFCBHDR C4000123 ASSEM $6400,+REQBUF(10) C4000124ÐÐ+ STA* REQBUF+9 C4000125 CALL OPENFL(REQBUF(1), IDATA( 1), ISTAT) C4000126 IF (ISTAT .LT. 0) GO TO 8000 C4000127C C4000128C SET UP WORDS PER SECTOR AND LENGTH C4000129C C4000130 CALL GETSSZ (FCBHDR, SECLEN) C4000131C C4000132C C4000133 IF (SECLEN .EQ. 96) GO TO 111 C4000134C C4000135C SECTOR LENGTH NOT 96 SO COMPUTE KIB C4000136C LENGTH AND NUMBER OF LEVELS POSSIBLE. C4000137C C4000138 KIBSEC = MAXSIZ / SECLEN C4000139 K3SRWD = KIBSEC * SECLEN C4000140 MAXLEV = IKBLEN / K3SRWD C4000141C C4000142 111 CONTINUE C4000143 ISPECL = FCBBUF(6) C4000144 FCBBUF(6) = AND($7FFE, FCBBUF(6)) C4000145C C4000146C ** SET NUMBER OF 'KIB' LEVEL STUFF C4000147C C4000148 KIBL = 2 C4000149ÐÐ DO 112 I = 17, 22 , 2 C4000150 IF ( FCBBUF(I) .EQ. 0) GO TO 113 C4000151 KIBL = KIBL + 1 C4000152 112 CONTINUE C4000153 113 CONTINUE C4000154 NXTKIB( 2) = KIBL + 1 C4000155C C4000156C COMPUTE NUMBER OF RECORDS PER READ OF DATA FILE AND RESET C4000157C NUMBER IN REQBUF C4000158C C4000159 ISECLN = RECLEN C4000160 NRECS = IRBLEN / RECLEN C4000161 IF ( AND( ISPECL , $8000) .EQ. 0) GO TO 115 C4000162 NUMSEC = RECLEN / SECLEN C4000163 IF ( (NUMSEC * SECLEN) .LT. RECLEN) NUMSEC = NUMSEC + 1 C4000164 NRECS = IRBLEN / (SECLEN * NUMSEC) C4000165 ISECLN = SECLEN * NUMSEC C4000166 115 CONTINUE C4000167 IDATA(14) = NRECS C4000168 REQBUF(13) = NRECS C4000169 IDASAV = 1 C4000170C C4000171C COMPUTE NUMBER OF KISES PER KIB C4000172C C4000173 KISLEN = (LENKY1 + 1) / 2 + 2 C4000174ÐÐ MAXKIS = (K3SRWD - 6) / KISLEN C4000175C PACK 3/4 FULL SO READJUST NUMBER OF KIBS C4000176C C4000177 NUMKIS = (MAXKIS*3)/4 C4000178C C4000179C ************************************************** C4000180C C4000181C SAVE FIRST 8 FCB WORDS FOR RESTORE AND ONGOING USE C4000182C C4000183 DO 140 I = 1 , 6 C4000184 140 SAVBUF(I) = FCBBUF(I) C4000185C C4000186C SET UP KIB TYPE FOR FIRST KIB C4000187C C4000188 KIBBUF(6) = 2 C4000189C C4000190C SET UP KIB TYPE FOR INTERMIDIATE LEVEL KIBS. HIGHEST LEVEL C4000191C KIB TYPE WORD WILL BE RESET LATER. C4000192C C4000193 DO 150 I = 2, MAXLEV C4000194 IDX = (I-1) * K3SRWD + 6 C4000195 150 KIBBUF(IDX) = 1 C4000196 LRELRD( 1) = 0 C4000197 LRELRD( 2) = 0 C4000198C INSERT FIRST KIS IN KIB AND SET NO. OF KIBS TO 1 127*5124C4000199ÐÐC ALL 0,S KEY / RRN = -1,0 127*5124C4000200 KIBBUF(KISLEN+5) = -1 C4000201+ 127*5124C4000202 KIBBUF(1) = 1 C4000203+ 127*5124C4000204C C4000205C** FILL INPUT BUFFER WITH SPACE CODES C4000206C C4000207 180 CONTINUE C4000208 DO 185 LFL = 1 , IRBLEN C4000209 RECBUF(LFL) = $2020 C4000210 185 CONTINUE C4000211C C4000212C ************************************************** C4000213C C4000214C C4000215C C4000216C READ UNIT RECORD AND DO BLOCKING OF DATA C4000217C C4000218C C4000219 200 CONTINUE C4000220C ***** 138*A030C4000221C RESET NO. OF CHARACTERS RECEIVED IN RECBUF(RECLEN+1) (SET BY C4000222C THE ITOS EXEC) TO BLANKS. THIS IS NOT MEANINGFUL THE FIRST C4000223C TIME THRU. 136*A037C4000224ÐÐ RECBUF(IDASAV) = $2020 C4000225 CALL REDREC (LOGUNT,INPLEN, RECBUF(IDASAV), ISTAT) C4000226C C4000227C REBLANK 1ST WORD BEYOND LAST RECORD INPUT (MAY HAVE BEEN RESETC4000228C BY THE EXEC) C4000229C C4000230 IDD = IDASAV + INPLEN C4000231 RECBUF(IDD) = $2020 C4000232C ***** 138*A030C4000233 IF (ISTAT .GE. 0) GO TO 210 C4000234C ***** 138*A030C4000235C IF NO RECORDS READ, GO TO 9150 136*A056C4000236C 136*A056C4000237 IF (IRRN(1).EQ.0 .AND. IRRN(2).EQ.1) GO TO 9150 C4000238C ***** 138*A030C4000239 205 CONTINUE C4000240 IDONE = 1 C4000241 IF (IRECD .NE. 0) GO TO 304 C4000242 GO TO 307 C4000243+ 127*5124C4000244C C4000245C CHECK IF EBCDIC CONVERSION REQUIRED C4000246C C4000247 210 CONTINUE C4000248 IF (MAXRED.EQ.0) GO TO 220 C4000249ÐÐ MAXRED = 2 C4000250 GO TO 205 C4000251 220 IF (IDATYP .EQ. 1) CALL ASCEBC(RECBUF(IDASAV), IDATYP, RECLEN) C4000252C C4000253C PROCESS EACH RECORD FROM THE INPUT BUFFER C4000254C C4000255C C4000256 230 CONTINUE C4000257 ISTART = IDASAV C4000258C C4000259C EXTRACT KEY FROM RECORD AND STORE IN KISBUF C4000260C (CODE FROM XTKEY PGM OF FM) C4000261C C4000262 FRSTBY = FCBBUF(16) C4000263 LASTBY = FRSTBY + FCBBUF(15) - 1 C4000264 I1 = 0 C4000265 DO 280 I = FRSTBY, LASTBY C4000266 J = (I+1)/2 C4000267 IDX = J + ISTART - 1 C4000268 I1 = I1 + 1 C4000269 J1 = (I1+1) / 2 C4000270 LSHIFT = 1 + AND(I , 1) C4000271 IBYTE = AND( (RECBUF(IDX) / KSHIFT(LSHIFT)) , $FF) C4000272 LSHIFT = 1 + AND(I1 , 1) C4000273 KISBUF(J1) = AND (KISBUF(J1) , KMSKBT(LSHIFT) ) + IBYTE * C4000274ÐÐ 1 KSHIFT(LSHIFT) C4000275 280 CONTINUE C4000276C C4000277C CHECK TO ASSURE CURRENT KIS HAS GREATER KEY THAN PREVIOUS C4000278C C4000279 IEND = KISLEN - 2 C4000280 DO 285 I = 1, IEND C4000281C ***** 138*A030C4000282 IF (KISBUF(I)-KISSAV(I)) 287,285,290 C4000283 285 CONTINUE C4000284C C4000285C DUPLICATE OR SMALLER KEY NOTED. SET DEFERED ERROR FLAG. C4000286C C4000287 287 IDEFER = 1 C4000288 GO TO 205 C4000289C ***** 138*A030C4000290C C4000291C SET KIB LEVEL TO 1 C4000292C C4000293 290 ILEV = 1 C4000294C C4000295C CHECK IF SEQ SET KIB HAS ROOM FOR KIS. IF NO, GO TO 400 C4000296C C4000297 IF (KIBBUF(1).EQ.NUMKIS) GO TO 400 C4000298C C4000299ÐÐC INSERT RRN CURRENT RECORD INTO KISBUF C4000300C C4000301 295 KISBUF(KISLEN-1) = IRRN(1) C4000302 KISBUF(KISLEN) = IRRN(2) C4000303C C4000304C INSERT KIS INTO LOWEST LEVEL KIB AND BUMP NO. OF KISES IN KIB C4000305C C4000306 IDX = KIBBUF(1) * KISLEN + 6 C4000307 DO 300 I = 1, KISLEN C4000308 IWORD = I + IDX C4000309 KIBBUF(IWORD) = KISBUF(I) C4000310C C4000311C ALSO SAVE THIS KIS C4000312C C4000313 KISSAV(I) = KISBUF(I) C4000314 300 CONTINUE C4000315 KIBBUF(1) = KIBBUF(1) + 1 C4000316C C4000317C BUMP RRN BY 1 C4000318C C4000319 CALL BMPRRN (IRRN) C4000320C C4000321C CHECK IF ALL DONE. IF NOT, GO PROCESS NEXT RECORD. C4000322C C4000323 IF (IDONE .NE. 0) GO TO 307 C4000324ÐÐ+ 127*5124C4000325C C4000326C***** UPDATE STORAGE, RECORD COUNT C4000327C C4000328 CALL BMPRRN (TOTREC) C4000329 IDASAV = IDASAV + ISECLN C4000330 IRECD = IRECD + 1 C4000331C C4000332C CHECK IF ALL RECORDS BEEN READ C4000333C C4000334 IF(TOTREC(1).EQ.FCBBUF(2).AND.TOTREC(2).EQ.FCBBUF(3)) MAXRED=1 C4000335C C4000336C CHECK IF BUFFER IS FULL C4000337C C4000338 IF (IRECD .LT. NRECS) GO TO 200 C4000339 304 CONTINUE C4000340 FCBBUF(6) = AND($FFFE , ISPECL) C4000341 CALL PUTS( REQBUF( 1), RECBUF( 1), IRECD, ISTAT) C4000342 FCBBUF(6) = AND($7FFE , ISPECL) C4000343 IRECD = 0 C4000344 IDASAV = 1 C4000345 IF (ISTAT .GE. 0) GO TO 306 C4000346 CALL ERCHK( ISTAT, REQBUF( 4) ) C4000347 GO TO 3000 C4000348 306 CONTINUE C4000349ÐÐ IF (IDONE .EQ. 0) GO TO 180 C4000350 307 CONTINUE C4000351+ 127*5124C4000352C 127*5124C4000353C NEW LAST KIS MUST BE ADDED (TO BE CONSISTANT WITH FM 127*5124C4000354C BUILD INDEX) - ALL F,S KEY / RRN = -2,0 127*5124C4000355C 127*5124C4000356C CHECK IF SUFFICIENT ROOM IN SEQ SET KIB 127*5124C4000357C 127*5124C4000358 IF (KIBBUF(1) .LT. NUMKIS) GO TO 308 C4000359+ 127*5124C4000360 IEXIT = 1 C4000361+ 127*5124C4000362 GO TO 400 C4000363+ 127*5124C4000364C 127*5124C4000365C INSERT THE KIS AND BUMP NUMBER OF KISES 127*5124C4000366C 127*5124C4000367 308 IDX = KIBBUF(1) *KISLEN + 6 C4000368+ 127*5124C4000369 DO 309 I = 1, KISLEN C4000370+ 127*5124C4000371 IWORD = I + IDX C4000372+ 127*5124C4000373 309 KIBBUF(IWORD) = $FFFF C4000374ÐÐC ***** 138*A030C4000375 KIBBUF(IWORD) = 0 C4000376 KIBBUF(IWORD-1) = -2 C4000377C ***** 138*A030C4000378 KIBBUF(1) = KIBBUF(1) + 1 C4000379+ 127*5124C4000380C C4000381C SET NEXT SEQ SET POINTER TO 0,0 C4000382C C4000383 KIBBUF(2) = 0 C4000384 KIBBUF(3) = 0 C4000385C C4000386C DETERMINE HIGHEST LEVEL USED C4000387C C4000388 DO 310 I = 2,6 C4000389 NUMLEV = I C4000390 IDX = (I-1) * K3SRWD C4000391 IF (KIBBUF(IDX+1).NE.0) GO TO 310 C4000392 NUMLEV = NUMLEV-1 C4000393 GO TO 320 C4000394 310 CONTINUE C4000395C C4000396C IF ONLY ONE LEVEL OF KIBS, GO TO 500 FOR SPECIAL PROCESSING C4000397 320 CONTINUE C4000398 IF (NUMLEV.EQ.1) GO TO 500 C4000399ÐÐC C4000400C SET KIB TYPE OF TOP KIB TO 0 (FOR ROOT) C4000401C C4000402 IDX = (NUMLEV-1) * K3SRWD C4000403 KIBBUF(IDX+6) = 0 C4000404C C4000405C UPDATE EACH KIB FROM LEVEL 2 THRU NUMLEV TO POINT TO LOWER C4000406C LEVEL KIB C4000407C C4000408 DO 340 I = 2, NUMLEV C4000409C C4000410C UPDATE KISBUF TO POINT TO LOWER LEVEL KIB C4000411C C4000412 KISBUF(KISLEN-1) = KIBM(I-1) C4000413 KISBUF(KISLEN) = KIBL(I-1) C4000414C C4000415C STORE KIS IN KIB AND BUMP NO. OF KISES IN KIB C4000416C C4000417 IDX = (I-1) * K3SRWD C4000418 IDXX = (KIBBUF(IDX+1)*KISLEN) + 6 + IDX C4000419 DO 330 J = 1, KISLEN C4000420 K = IDXX + J C4000421 330 KIBBUF(K) = KISBUF(J) C4000422 KIBBUF(IDX+1) = KIBBUF(IDX+1) + 1 C4000423 340 CONTINUE C4000424ÐÐC C4000425C SET KIB ADDRESS FOR ROOT KIB C4000426C C4000427 KIBM(NUMLEV) = 0 C4000428 KIBL(NUMLEV) = 1 C4000429C C4000430C ASSURE SUPERIOR KIB POINTER FOR ROOT IS CLEAR C4000431 IDX = (NUMLEV-1) * K3SRWD C4000432 KIBBUF(IDX+4) = 0 C4000433 KIBBUF(IDX+5) = 0 C4000434C C4000435C WRITE OUT EACH OF THE NUMLEV KIBS C4000436C C4000437 ASSIGN 350 TO IRETRN C4000438 DO 350 I = 1, NUMLEV C4000439 ILEV = I C4000440 GO TO 1000 C4000441 350 CONTINUE C4000442C C4000443C ALL SECOND LEVEL (DOWN FROM TOP) KIBS MUST BE UPDATED TO C4000444C POINT TO ROOT IN FIRST KIB POSITION. C4000445C C4000446 IDX = (NUMLEV-1) * K3SRWD C4000447 IEND = KIBBUF(IDX+1) C4000448 DO 370 I = 1, IEND C4000449ÐÐC C4000450C SET KIB RKN THEN READ IN THE KIB (INTO KIB 1 POSITION) C4000451C C4000452 IOFSET = IDX + 5 + (I-1) * KISLEN + KISLEN C4000453 KIBM(1) = KIBBUF(IOFSET) C4000454 KIBL(1) = KIBBUF(IOFSET+1) C4000455 ILEV = 1 C4000456 ASSIGN 360 TO IRETRN C4000457 GO TO 1500 C4000458C C4000459C UPDATE THE SUPERIOR KIB POINTER TO POINT TO ROOT - THEN C4000460C WRITE KIB BACK TO FILE C4000461C C4000462 360 KIBBUF(4) = 0 C4000463 KIBBUF(5) = 1 C4000464 ASSIGN 370 TO IRETRN C4000465 GO TO 1000 C4000466 370 CONTINUE C4000467C C4000468C RESTORE 1ST 8 WORDS OF FCB FROM SAVBUF AND SET NEXT KIB C4000469C POINTER TO NXTKIB C4000470C C4000471 375 DO 380 I = 1,8 C4000472 380 FCBBUF(I) = SAVBUF(I) C4000473 FCBBUF(9) = NXTKIB(1) C4000474ÐÐ FCBBUF(10) = NXTKIB(2) C4000475 FCBBUF(6) = ISPECL C4000476C C4000477C IF MAXED=2, OUTPUT ERROR MESSAGE C4000478 IF (MAXRED.EQ.2) CALL ERCHK ($9000,WRTCOD) C4000479 CALL CLOSFL( REQBUF(1), ISTAT) C4000480 IF (ISTAT .LT. 0) GO TO 8000 C4000481C ***** 138*A030C4000482C C4000483C CHECK IF DEFERED ERROR FLAG SET C4000484C C4000485 IF (IDEFER.EQ.1) CALL SYSMSG (83,0) C4000486C ***** 138*A030C4000487C C4000488C******* CALL RANDOM INDEXED FILE PROCESSOR TO FINISH THE JOB C4000489C IF THERE ARE 2 KEYS C4000490C C4000491 LDIXOQ = 2 C4000492 IDATA(13) = 2 C4000493 IDATA(14) = LOGUNT C4000494 IDATA(15) = IDATYP C4000495 IF (FCBBUF(17) .EQ. 0) LDIXOQ = 0 C4000496 RETURN C4000497C C4000498C ****************************************************** C4000499ÐÐC C4000500C C4000501C KIB WAS FULL (AS MUCH AS PERMITTED). C4000502C BUMP TO NEXT LEVEL AND MAKE ENTRY FOR LOWER LEVEL C4000503C C4000504 400 ILEV = ILEV + 1 C4000505C C4000506C ASSURE LEVEL NOT TOO HIGH C4000507C C4000508 IF (ILEV .LE. MAXLEV) GO TO 405 C4000509 INDEX = 82 C4000510 GO TO 9100 C4000511C C4000512C COMPUTE INDEX TO THIS LEVELS KIB C4000513C C4000514 405 IOFSET = (ILEV-1) * K3SRWD C4000515C C4000516C CHECK IF KIB SPACE HAS BEEN ASSIGNED YET C4000517C C4000518 IF (KIBBUF(IOFSET+1) .NE. 0) GO TO 408 C4000519C C4000520C ASSIGN SPACE AND BUMP NXTKIB C4000521C C4000522 KIBM(ILEV) = NXTKIB(1) C4000523 KIBL(ILEV) = NXTKIB(2) C4000524ÐÐ CALL BMPRRN (NXTKIB) C4000525C C4000526C CHECK IF ROOM EXISTS IN KIB FOR ANOTHER KIS C4000527C C4000528 408 IF (KIBBUF(IOFSET+1).LT.NUMKIS) GO TO 410 C4000529C C4000530C CHECK IF THIS IS THE HIGHEST LEVEL KIB C4000531C C4000532 IF (ILEV .NE. MAXLEV) GO TO 400 C4000533C C4000534C IS THERE ROOM IN ROOT KIB - IF SO, USE IT. C4000535C C4000536C C4000537 IF (KIBBUF(IOFSET+1).LE.MAXKIS) GO TO 410 C4000538C C4000539C INDEX TOO BIG FOR UTILITY (ORDERED LOAD) C4000540C C4000541 INDEX = 82 C4000542 GO TO 9100 C4000543C C4000544C COMPUTE NEW OFFSET FOR STORE OF KIS C4000545C C4000546 410 NEWOST = IOFSET + 6 + KIBBUF(IOFSET+1) * KISLEN C4000547C C4000548C USE KIS KEY FROM LAST KIS IN NEXT LOWER LEVEL KIB C4000549ÐÐC C4000550 IDX = (ILEV-2) * K3SRWD C4000551 IDXX = IDX + 6 + (KIBBUF(IDX+1)-1) * KISLEN C4000552 DO 420 I = 1,KISLEN C4000553 ISTOR = NEWOST + I C4000554 ILOAD = IDXX + I C4000555 KIBBUF(ISTOR) = KIBBUF(ILOAD) C4000556 420 CONTINUE C4000557C C4000558C BUMP NO. OF KISES IN KIB C4000559C C4000560 KIBBUF(IOFSET+1) = KIBBUF(IOFSET+1) + 1 C4000561C C4000562C STORE LOWER LEVEL KIB POINTER INTO KIS C4000563C C4000564 KIBBUF(ISTOR-1) = KIBM(ILEV-1) C4000565 KIBBUF(ISTOR) = KIBL(ILEV-1) C4000566C C4000567C THIS LEVEL IS FINISHED FOR NOW. DROP LEVELS. C4000568C C4000569 ILEV = ILEV - 1 C4000570C C4000571C STORE SUPERIOR KIB POINTER INTO KIB C4000572C C4000573 NEWOST = (ILEV-1) * K3SRWD C4000574ÐÐ KIBBUF(NEWOST+4) = KIBM(ILEV+1) C4000575 KIBBUF(NEWOST+5) = KIBL(ILEV+1) C4000576C C4000577C IF THIS IS SEQ SET KIB, SET BROTHER KIB POINTER C4000578C C4000579 IF (ILEV.NE.1) GO TO 430 C4000580 KIBBUF(2) = NXTKIB(1) C4000581 KIBBUF(3) = NXTKIB(2) C4000582C C4000583C GO STORE THIS LEVELS KIB C4000584C C4000585 430 ASSIGN 440 TO IRETRN C4000586 GO TO 1000 C4000587C C4000588CC IF THIS IS SEQ SET KIB, BUMP NXTKIB AND SET KIB ADDRESS TO C4000589C LAST BROTHER POINTER C4000590C C4000591 440 IF (ILEV.NE.1) GO TO 445 C4000592 CALL BMPRRN (NXTKIB) C4000593 KIBM(1) = KIBBUF(2) C4000594 KIBL(1) = KIBBUF(3) C4000595C C4000596C CLEAR NO. OF KISES AND KIS PART OF KIB C4000597C C4000598 445 KIBBUF(NEWOST+1) = 0 C4000599ÐÐ DO 450 I = 1, 282 C4000600 IDX = NEWOST + 6 + I C4000601 450 KIBBUF(IDX) = 0 C4000602C C4000603C IF WE ARE NOW AT SEQ SET LEVEL, GO TO 295, ELSE GO TO 405 C4000604C C4000605C IF WE ARE NOT AT SEQ SET LEVEL, GO TO 405. ELSE 127*5124C4000606C GO TO 295 OR 308 (308 IF IEXIT .NE. 0) 127*5124C4000607C 127*5124C4000608 IF (ILEV.NE.1) GO TO 405 C4000609+ 127*5124C4000610 IF (IEXIT.EQ.0) GO TO 295 C4000611+ 127*5124C4000612 GO TO 308 C4000613+ 127*5124C4000614C C4000615C ************************************************** C4000616C C4000617C ONLY ONE KIB HAS BEEN GENERATED. MAKE THE APPROPRIATE ROOT C4000618C KIB AND UPDATE THE SEQUENCE SET KIB APPROPRIATELY. C4000619C C4000620C FIRST, SET UP THE HEADER FOR THE ROOT KIB. WORDS 2-6 ALL 0. C4000621C C4000622 500 KIBBUF(K3SRWD + 1) = 1 C4000623C ***** 1 CARD DELETED 138*A030C4000624ÐÐC C4000625C SET UP THE HEADER OF THE SEQUENCE SET KIB. C4000626C C4000627 KIBBUF(5) = 1 C4000628C C4000629C PUT ONE KIS INTO THE SEQUENCE SET KIB C4000630C C4000631 IDX = 6 + (KIBBUF(1)-1) * KISLEN C4000632 DO 510 I = 1, KISLEN C4000633 ILOAD = IDX + I C4000634 ISTORE = K3SRWD + 6 + I C4000635 510 KIBBUF(ISTORE) = KIBBUF(ILOAD) C4000636 KIBBUF(ISTORE-1) = KIBM(1) C4000637 KIBBUF(ISTORE) = KIBL(1) C4000638C C4000639C SET KIBM/KIBL TO DEFINE THE ROOT KIB C4000640C C4000641 KIBL(2) = 1 C4000642C C4000643C WRITE OUT THE TWO KIBS C4000644C C4000645 ASSIGN 520 TO IRETRN C4000646 DO 520 ILEV = 1,2 C4000647 GO TO 1000 C4000648 520 CONTINUE C4000649ÐÐ GO TO 375 C4000650C C4000651C C4000652C-------------------------------------------------------------------- C4000653C C4000654C PROGRAM ABORT PROGRAM ABORT C4000655C PROGRAM ABORT PROGRAM ABORT C4000656C C4000657C C4000658 3000 CONTINUE C4000659C ***** 1 RECORD DELETED 138*A030C4000660C C4000661C** CHECK IF ANY RECORD EVER READ C4000662C C4000663 IF ( (TOTREC( 1) .EQ. 0) .AND. (TOTREC( 2) .EQ. 0)) GO TO 9150 C4000664C ***** 138*A030C4000665 GO TO 205 C4000666C ***** 138*A030C4000667C C4000668C ************************************************** C4000669C C4000670C ERROR MESSAGES C4000671C C4000672C C4000673C F-M REQUEST ERROR C4000674ÐÐC C4000675 8000 CONTINUE C4000676 CALL ERCHK( ISTAT, REQBUF( 4) ) C4000677 GO TO 9150 C4000678C ***** 4 RECORDS DELETED 138*A030C4000679 9100 CONTINUE C4000680 CALL SYSMSG( INDEX, 0) C4000681C ***** 138*A030C4000682 GO TO 9160 C4000683C C4000684C ALSO USED FOR EXIT IF NO RECORDS READ 136*A056C4000685C C4000686C ***** 138*A030C4000687 9150 CONTINUE C4000688 FCBBUF(6) = ISPECL C4000689 CALL CLOSFL( REQBUF, ISTAT) C4000690 9160 LDIXOQ = 0 C4000691 RETURN C4000692C C4000693C ************************************************** C4000694C C4000695C INTERNAL SUBROUTINE C4000696C C4000697C THIS ROUTINE CHANGES THE FCB SO THAT A KIB CAN BE STORED C4000698C INTO THE KIB SPACE FOR THE FILE, STORES THE KIB AND THEN C4000699ÐÐC RESETS THE FCB BACK TO THE ORIGINAL STATE. C4000700C THE KIB TO BE WRITTEN OUT IS IN POSITION ILEV IN KIBBUF. C4000701C C4000702 1000 CONTINUE C4000703 SAVBUF(7) = FCBBUF(7) C4000704 SAVBUF(8) = FCBBUF(8) C4000705 FCBBUF(1) = K3SRWD C4000706 FCBBUF(2) = FCBBUF(11) C4000707 FCBBUF(3) = FCBBUF(12) C4000708 FCBBUF(4) = FCBBUF(13) C4000709 FCBBUF(5) = FCBBUF(14) C4000710 FCBBUF(7) = FCBBUF(11) C4000711 FCBBUF(8) = FCBBUF(12) C4000712C C4000713C SAVE REQBUF WORDS 15-20 C4000714C C4000715 DO 1005 N = 1,6 C4000716 1005 ISAVE(N) = REQBUF(N+14) C4000717C C4000718C CHANGE THE REQBUF TO REFLECT RETRIEVAL OF THE KIB AS A RECORD.C4000719C C4000720 REQBUF(15) = 1 C4000721 REQBUF(16) = KIBM(ILEV) C4000722 REQBUF(17) = KIBL(ILEV) C4000723C C4000724ÐÐC STORE THE KIB VIA AN UPDATE RECORD REQUEST C4000725C C4000726 IDDX = 1 + (ILEV-1) * K3SRWD C4000727 CALL UPDREC (REQBUF,KIBBUF(IDDX),ISTAT) C4000728C C4000729C RESTORE REQBUF WORDS 15-20 C4000730C C4000731 DO 1015 N = 1,6 C4000732 1015 REQBUF(N+14) = ISAVE(N) C4000733C C4000734C RESTORE THE FCB AND RETURN C4000735C C4000736 DO 1010 N = 1 , 8 C4000737 1010 FCBBUF(N) = SAVBUF(N) C4000738 IF (ISTAT.LT.0) GO TO 8000 C4000739 GO TO IRETRN C4000740C C4000741C ************************************************** C4000742C C4000743C INTERNAL SUBROUTINE C4000744C C4000745C C4000746C THIS ROUTINE CHANGES THE FCB SO THAT A KIB CAN BE READ VIA C4000747C A READR REQUEST, READS THE KIB AND THEN RESETS THE FCB BACK C4000748C TO THE ORIGINAL STATE. C4000749ÐÐC THE KIB TO BE READ WILL BE IN POSITION ILEV IN KIBBUF. C4000750C C4000751 1500 CONTINUE C4000752 SAVBUF(7) = FCBBUF(7) C4000753 SAVBUF(8) = FCBBUF(8) C4000754 FCBBUF(1) = K3SRWD C4000755 FCBBUF(2) = FCBBUF(11) C4000756 FCBBUF(3) = FCBBUF(12) C4000757 FCBBUF(4) = FCBBUF(13) C4000758 FCBBUF(5) = FCBBUF(14) C4000759 FCBBUF(7) = FCBBUF(11) C4000760 FCBBUF(8) = FCBBUF(12) C4000761C C4000762C SAVE CURRENT WORDS 15-20 OF REQBUF, THEN RESET REQBUF(13) TO 1C4000763C C4000764C C4000765 DO 1505 N = 1,6 C4000766 1505 ISAVE(N) = REQBUF(N+14) C4000767 REQBUF(13) =1 C4000768C C4000769C STORE KIB NUMBER FOR THE READ C4000770C C4000771 ITEMP1(1) = KIBM(ILEV) C4000772 ITEMP1(2) = KIBL(ILEV) C4000773C C4000774ÐÐC READ THE RECORD C4000775C C4000776 IDXX = 1 + (ILEV-1) * K3SRWD C4000777 CALL READR (REQBUF,KIBBUF(IDXX),ITEMP1,ISTAT) C4000778C C4000779C RESTORE THE FCB AND REQBUF C4000780C C4000781 DO 1510 N = 1 , 8 C4000782 1510 FCBBUF(N) = SAVBUF(N) C4000783 DO 1515 N = 1,6 C4000784 1515 REQBUF(N+14) = ISAVE(N) C4000785 REQBUF(13) = NRECS C4000786 IF (ISTAT.LT.0) GO TO 8000 C4000787 GO TO IRETRN C4000788 END C4000789 MON 00001 NAM ADDECT K01 A ITOS CCS 3.0 SL-149 00001* 00002* COPYRIGHT CONTROL DATA CORPORATION, 1979 00003* DATA SYSTEMS, LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00004* CREDIT COLLECTION SYSTEM, VERSION 3.0 00005* 00006* THIS SUBROUTINE GETS ADDRESSES FOUND IN THE EXT COMMINICATION 00007* TABLE. FORM THIS ROUTINE ANY WORD FROM THIS TABLE CAN BE 00008* RETURNED TO THE CALLING PROGRAM. 00009ÐÐ* 00010* THE CALLING SEQUENCE IS CALL ADDECT(NWORD,ECTADD) 00011* NWORD IS THE NTH WORD IN THE ECT TABLE 00012* ECTADD IS THE ADDRESS FOUND AT THE NWORD POSITION IN 00013* THE ECT TABLE. THIS IS THE VALUE RETURNED TO THE 00014* CALLING SUBROUTINE. 00015* 00016 ENT ADDECT 00017 EQU ZERO($2) SYSTEM ZERO 00018 EQU ADRECT($E9) ADDRESS OF EXT COMMUNICATIONS TABLE 00019* 00020ADDECT 0 0 00021* 00022 STQ* SAVEQ SAVE THE Q REGISTER. 00023 LDA- I 00024 STA* SAVEI SAVE THE I REGISTER. 00025* 00026 LDQ* ADDECT ADDRESS OF CALLER 00027 INQ 2 MOVE TO THE NEXT EXEC INSTRUCTION 00028 STQ* ADDECT SAVE NEW RETURN VALUE ADDECT+2 00029 RTJ* PARGET PICK UP PARAMETER ADDRESSES 00030* 00031 LDQ* (PAR) A HAS THE CONTENTS OF NWORD 00032 LDQ- (ADRECT),Q ADDRESS FOUND IN THE NWORD IN ECT 00033 STQ* (PAR+1) STORE ADDRESS TO PASS BACK TO SUBROUTINE 00034ÐÐ* 00035 LDA* SAVEI RESTORE THE I REGISTER 00036 STA- I 00037 LDQ* SAVEQ RESTORE THE Q REGISTER 00038 JMP* (ADDECT) RETURN 00039* PARAMETER TABLE 00040PAR BZS PAR(2) NTH WORD IN THE TABLE 00041* RETURN ADDRESS FROM ECT TABLE 00042SAVEQ NUM 0 00043SAVEI NUM 0 00044PARGET 0 0 ROUTINE TO PICK UP ADDRESSES OF PARAMETERS 00045 LDQ* ADDECT PICK UP ADDRESS OF CALLER+2S 00046 INQ -1 MOVE TO END OF PARAMETER LIST 00047 ENA 1 SET UP INEDEX TO PARAMETERS 00048 STA- I STORE INDEX 00049PAR100 LDA- (ZERO),Q PICK UP ADDRESS OF NEXT PARAMETER 00050 STA* PAR,I SAVE PARAMETER 00051 INQ -1 DECREMENT INDEX TP PARAMETER LIST 00052 DIP *-PAR100 SKIP ON NEG. ALL PARAMETERS ARE RETRIEVED 00053 JMP* (PARGET) RETURN 00054 END 00055 NAM CHEKSM K02 A ITOS CCS 3.0 SL-149 00001* CREDIT COLLECTION SYSTEM VERSION 3.0 00002* DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00003* COPYRIGHT CONTROL DATA CORPORATION 1979 00004ÐÐ* 00005* CONTROL DATA CORPORATION, 1979 00006* DATA SYSTEMS, LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00007* CREDIT COLLECTION SYSTEM, VERSION 3.0 00008* 00009* THIS SUBROUTINE IS USED TO COMPUTE A CHECKSUM FOR A GIVEN NUMBER 00010* OF WORDS FOR A GIVEN INPUT BUFFER. 00011* 00012* THE CALLING SEQUENCE IS CHEKSM(IBUFF,LENGTH,CHECK) 00013* 00014* IBUFF IS THE ADDRESS OF THE BUFFER THAT IS TO BE CHECKSUMMED. 00015* LENGTH IS THE ADDRESS OF THE LENGTH OF IBUFF IN WORDS. 00016* CHECK IS THE ADDRESS OF THE CHECKSUM WHICH IS RETURNED TO THE 00017* CALLING PROGRAM. 00018* 00019 ENT CHEKSM 00020 EQU ZERO($2) SYSTEM ZERO 00021* 00022CHEKSM 0 0 00023 STQ* SAVEQ SAVE THE Q REGISTER 00024 SRI* SAVEI SAVE THE I REGISTER 00025* 00026 LDQ* CHEKSM RETURN ADDRESS OF THE CALLING PROGRAM 00027 INQ 3 BYPASS PARAMETERS TO NEXT EXECUTABLE INSTR. 00028 STQ* CHEKSM STORE RETURN ADDRESS+3 00029ÐÐ RTJ* PARGET PICK UP PARAMETER ADDRESSES 00030* 00031* THIS ROUTINE ADDS ALL WORDS IN IBUFF GIVING A CHECKSUM. 00032* THE ADDING BEGINS AT THE LAST WORD IN IBUFF AND CONTINUES 00033* ADDING A WORD AT A TIME UNTIL THE STARTING ADDRESS IS 00034* ADDED. 00035* 00036 ENA 0 INITIALIZE A 00037 LDQ* (PAR+1) LOAD THE LENGTH OF IBUFF IN Q 00038 INQ -1 SUBTRACT 1 FROM THE LENGTH 00039* 00040CHEK10 ADD (PAR),Q A=A+IBUFF(Q) 00041 DQP *-CHEK10 DECREMENT Q-SKIP ON NEGATIVE Q 00042 TCA A COMPLEMENT CHECKSUM 00043 STA* (PAR+2) STORE CHECKSUM INTO CHECK 00044* 00045* 00046 LDQ* SAVEQ RESTORE Q 00047 LRI* SAVEI RESTORE I 00048 JMP* (CHEKSM) RETURN TO CALLING PROGRAM 00049* 00050* PARAMETER ADDRESS STORAGE 00051* 00052PAR BZS PAR(3) (0) ADDRESS OF FIRST WORD IN IBUFF 00053* (1) ADDRESS OF THE LENGTH OF IBUFF 00054ÐÐ* (2) ADDRESS OF THE RETURN VALUE CHECK 00055* 00056SAVEQ NUM 0 Q REGISTER 00057SAVEI NUM 0 I REGISTER 00058* 00059* PICK UP PARAMETER ADDRESSES 00060PARGET LDQ* CHEKSM PICK UP RETURN ADDRESS+3 00061 INQ -1 DECREMENT TO PICK UP ADDRESS OF CHECK 00062 ENA 2 SET UP INDEX TO PICK UP PARAMTERS 00063 STA- I STORE INDEX IN I 00064* 00065PAR100 LDA- (ZERO),Q PICK UP ADDRESS OF NEXT PARAMETER 00066 STA* PAR,I STORE ADDRESS IN PARAMETER TABLE 00067 INQ -1 DECREMENT INDEX TO PARAMETER TABLE 00068 DIP *-PAR100 DECREMENT -1,SKIP ON NEGATIVE 00069* 00070 JMP* (PARGET) RETURN 00071 END 00072 NAM DBLMTH K03 A ITOS CCS 3.0 SL-149 00001* 00002* COPYRIGHT CONTROL DATA CORPORATION, 1979 00003* DATA SYSTEMS - LA JOLLA DIVISON, LA JOLLA, CALIFORAIA 00004* CREDIT COLLECTION SYSTEM,VERSION 3.0 00005* 00006* SAME AS DWMATH DIALOG 1.0 PROGRAM 00007ÐÐ* 00008* THIS PACKAGE PROVIDES SUBROUTINES TO PERFORM 00009* THREE DOUBLE WORD ARITHMETIC OPERATIONS. 00010* THE DOUBLE WORD FORMAT IS THE SAME AS THE 00011* MSB/LSB FORMAT USED FOR SECTOR AND WORD 00012* ADDRESSING: WORD 1 OF A DOUBLE WORD VALUE 00013* CONTAINS THE UPPER 15 BITS OF THE VALUE - AN 00014* INTEGRAL MULTIPLE OF 32767, WORD 2 CONTAINS 00015* THE LOWER 15 BITS OF THE VALUE (BIT 15 = 0). 00016* IN THE FOLLOWING DESCRIPTIONS 'DWV' REFERS TO 00017* 'DOUBLE WORD VALUE'. 00018* 00019* THE FOLLOWING OPERATIONS ARE IMPLEMENTED: 00020* ADD A DWV TO A 2ND DWV 00021* SUBTRACT A DWV FROM ANOTHER DWV 00022* MULTIPLE A DWV BY A SINGLE WORD VALUE 00023* 00024* TO UTILIZE ONE OF THESE ROUITNES, THE CALLER 00025* STORES THE VALUES TO BE OPERATED ON IN AN 00026* ARRAY, SETS THE Q-REGISTER TO THE ADDRESS OF 00027* THE ARRAY AND EXECUTES A RTJ TO THE APPROPRI- 00028* ATE ROUTINE. THE I REGISTER CONTENTS WILL BE 00029* SAVED AND RESTORED PRIOR TO RETURN TO THE 00030* CALLER. THE COMPLETION STATUS WILL BE 0 IF 00031* GOOD, ELSE IT WILL BE NON-ZERO. 00032ÐÐ* 00033* THE ENTRY POINT NAMES ARE AS FOLLOWS: 00034 ENT DBLADD DOUBLE WORD ADD 00035 ENT DBLSUB DOUBLE WORD SUBTRACT 00036 ENT DBLMUL DOUBLE WORD MULTIPLY 00037* 00038 EQU ZERO($22) 00039 EQU ONEMSK(3) 00040 EQU ONEBIT($23) 00041 EJT 00042* THE ARRAY PARAMETER LISTS ARE AS FOLLOWS: 00043* FOR DBLADD 00044* WORD DESCRIPTION 00045* 1 MSB OF 1ST DWV 00046* 2 LSB OF 1ST DMV 00047* 3 MSB OF 2ND DMV 00048* 4 LSB OF 2ND DMV 00049* 5 MSB OF RESULT DMV 00050* 6 LSB OF RESULT DMV 00051* 7 COMPLETION STATUS 00052* 00053* FOR DBLSUB 00054* WORD DESCRIPTION 00055* 1 MSB OF MINUEND 00056* 2 LSB OF MINUEND 00057ÐÐ* 3 MSB OF SUBTRAHEND 00058* 4 LSB OF SUBTRAHEND 00059* 5 MSB OF RESULT 00060* 6 LSB OF RESULT 00061* 7 COMPLETION STATUS 00062* FOR DBLMUL 00063* WORD DESCRIPTION 00064* 1 MSB OF DWV 00065* 2 LSB OF DMV 00066* 3 SINGLE WORD VALUE 00067* 4 MSB OF RESULT 00068* 5 LSB OF RESULT 00069* 6 COMPLETION STATUS 00070* 00071 EJT 00072DBLADD 000 000 DOUBLE WORD ADD ROUTINE 00073A1 LDA- I SAVE I-REG CONTENTS 00074 STA* ISAVE 00075 STQ- I SET I TO ARRAY ADDRESS 00076 LDA- 1,I SET A TO LSB 00077 ENQ 0 CLEAR Q FOR USE AS MSB OFFSET 00078 SOV 0 CLEAR OVERFLOW STATUS 00079 ADD- 3,I ADD LSB 00080 SNO A2 SKIP TO A3 IF NO OVERFLOW 00081 AND- ONEMSK+14 MASK OUT BIT 15 00082ÐÐ INQ 1 BUMP Q TO PUT OVERFLOW IN MSB 00083A2 SAP A3 SKIP IF RESULT POSITIVE 00084 INQ -1 SUBTRACT 1 FROM Q FOR MSB OFFSET 00085 ADD- ONEBIT+15 MAKE LSW POSITIVE 00086A3 STA- 5,I STORE LSB 00087 TRQ A TRANSFER MSB OFFSET TO A 00088 SOV 0 CLEAR OVERFLOW 00089 ADD- (ZERO),I ADD THE TWO MSBS TO THE OFFSET 00090 ADD- 2,I 00091 STA- 4,I STORE MSB 00092 ENQ 0 CLEAR Q FOR COMPLETION STATUS 00093 SOV A4 SET TO BAD COMPLETION IF OVERFLOW OR A-REG NEG 00094 SAP A5 00095A4 ENQ 1 00096A5 STQ- 6,I 00097 LDA- 2,I COMPLEMENT 2ND DWV IF COMPLEMENTED BY US 00098 SAP A6 SKIP IF NOT COMPLEMENTED 00099 TCA A 00100 STA- 2,I 00101 LDA- 3,I 00102 TCA A 00103 STA- 3,I 00104A6 LDA* ISAVE RESTORE I-REG 00105 STA- I 00106 JMP* (DBLADD) 00107ÐÐ SPC 4 00108ISAVE NUM 0 00109 EJT 00110DBLSUB 000 0 DOUBLE WORD SUBTRACT ROUTINE 00111 LDA* DBLSUB 00112 STA* DBLADD STORE RETURN ADDRESS IN DBLADD'S ENTRY PT 00113 LDA- 2,Q COMPLEMENT SUBTRAHEND AND USE DBLADDTO ADD 00114 TCA A 00115 STA- 2,Q 00116 LDA- 3,Q 00117 TCA A 00118 STA- 3,Q 00119 JMP* A1 00120 EJT 00121DBLMUL 000 000 DOUBLE WORD MULTIPLY 00122 LDA- I 00123 STA* ISAVE SAVE I-REG 00124 STQ- I SET I TO ARRAY ADDRESS 00125 LDA- 1,I SET A TO LSB OF DOUBLE WORD VALUE 00126 MUI- 2,I MULTIPLY BY SINGLE WORD VALUE 00127 LLS 1 00128 ALS 15 CONVERT TO DOUBLE PRECISION FORMAT 00129 STQ* SAVE SAVE MSB 00130 STA- 4,I STORE LSB IN RESULT 00131 LDA- (ZERO),I 00132ÐÐ MUI- 2,I MULTIPLY MSB BY SINGLE WORD 00133 LLS 1 00134 ALS 15 DOUBLE PRECISION FORMAT 00135 SOV 0 CLEAR OVERFLOW 00136 INQ 0 CHECK FOR OVERFLOW 00137 SQZ 2 00138 LDQ- $11 SET OVERFLOW IND 00139 INQ 1 00140 LDQ* SAVE ADD MSB THAT WAS SAVED 00141 AAQ Q ADD IN RESULT FROM MSB MULTIPLY 00142 STQ- 3,I STORE IN RESULT 00143 CLR A 00144 SOV M0 SKIP IF OVERFLOW 00145 SQP M1 00146M0 INA 1 00147M1 STA- 5,I SET STATUS WORD, 0 IF GOOD, 1 IF BAD 00148 LDA* ISAVE RESTORE I-REG 00149 STA- I 00150 JMP* (DBLMUL) RETURN TO CALLER 00151 SPC 2 00152SAVE NUM 0 00153 END 00154 NAM DBLDIV K04 A ITOS CCS 3.0 SL-149 00001* 00002* COPYRIGHT CONTROL DATA CORPORATION, 1979 00003ÐÐ* DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00004* CREDIT COLLECTION SYSTEM, VERSION 3.0 00005* 00006* DOUBLE WORD DIVIDE ROUTINE 00007* SAME AS DWDIV PROGRAM FOR FILE MANAGER 2.0 00008* DOUBLE WORD DIVIDE 00009* 00010* CALL SEQUENCE IS: 00011* 00012* CALL DBLDIV(DWV,SWV,DWRES,ISTAT) 00013* 00014* WHERE DWV IS A DOUBLE WORD VALUE 00015* SWV IS A SINGLE WORD VALUE (DIVISOR) 00016* DWRES IS THE DOUBLE WORD RESULT 00017* ISTAT IS THE COMPLETION STATUS 00018* 0 IF GOOD, ELSE NON-ZERO 00019* 00020 ENT DBLDIV SUBROUTINE ENTRY POINT 00021* 00022 EXT Q8PREP,Q8PKUP USED FOR PARAMETER STRING PROCESSING 00023* 00024 EQU ZERO($22) SYSTEM ZERO 00025 EQU LPMSK(2) MASK TABLE 00026 SPC 2 00027DBLDIV 000 000 00028ÐÐ STQ* QSAVE SAVE Q-REG 00029* 00030 RTJ Q8PREP PREPARE TO PICKUP PARAMS 00031 ADC* DBLDIV 00032DWD10 RTJ Q8PKUP PICKUP DWV AND SAVE BOTH WORDS 00033 TRA Q 00034 LDA- (ZERO),Q 00035 STA* DWVMSB MSB 00036 LDA- 1,Q 00037 STA* DWVLSB LSB 00038 RTJ* (DWD10+1) PICKUP SWV AND SAVE IT 00039 TRA Q 00040 LDA- (ZERO),Q 00041 STA* SWV 00042 RTJ* (DWD10+1) PICKUP DWRES AND SAVE IT 00043 STA* DWRES 00044 RTJ* (DWD10+1) PICKUP ISTAT ADDRESS AND SAVE IT 00045 STA* ISTAT 00046 CLR A CLEAR STATUS TO 'GOOD' STATUS 00047 STA* (ISTAT) 00048* 00049 LDA* LRSINS PICK-UP LRS 1 INSTRUCTION 00050 STA* LRS1 STORE IT IN LOGIC 00051 EJT 00052 LDA* SWV FIRST, ASSURE THE SWV IS NON-ZERO POSITIVE 00053ÐÐ SAZ ERROR ELSE ERROR 00054 SAM ERROR 00055 LDQ* DWVMSB CHECK MSB - MUST BE POSITIVE 00056 SQM ERROR ELSE ERROR 00057 LDA* DWVLSB CHECK LSB - MUST BE POSITIVE 00058 SAM ERROR ELSE ERROR 00059 SQN PROCED ASSURE THAT MSB AND LSB ARE NOT BOTH ZERO 00060 SAN PROCED ELSE ERROR 00061ERROR RAO* (ISTAT) SET COMP STATUS TO 1 AND EXIT 00062 JMP* EXIT 00063* 00064PROCED ALS 1 MAKE DIVIDEND INTO A 30 BIT NUMBER 00065 LRS 1 00066 STA* TEMP+1 SAVE IN CASE OF OVERFLOW 00067 STQ* TEMP 00068DVI SOV 0 CLEAR OVERFLOW INDICATOR 00069 DVI* SWV DIVIDE BY DIVISOR 00070 SNO OUT IF NO OVERFLOW ON DIVIDE, WE'RE OK 00071 LDQ* TEMP 00072 LDA* TEMP+1 IF SO, DIVIDE NO. BY FACTOR OF 2, TRY AGAIN 00073LRS1 ADC 0 00074 RAO* LRS1 READY FOR NEXT PASS 00075 JMP* DVI 00076OUT STQ* TEMP+2 SAVE REMAINDER AND DIVIDEND 00077 STA* TEMP+3 00078ÐÐ LDA* LRS1 CK NO TIMES SHIFTED 00079 SUB* LRSINS 00080 TRA Q PUT INTO Q 00081 INA -16 00082 SAM OK CK FOR LESS THAN 16 00083 JMP* ERROR NO, GO SET ERROR STATUS AND EXIT 00084OK TCA A 00085 ADD* ALS GET 15-CNT AND SET UP SHIFT INSTRUCTIONS 00086 STA* ALS1 TO PACK ANSWER BEFORE LEAVING 00087 STA* ALS2 00088 EOR* SWITCH SWITCH TO A LRS 00089 STA* LRS2 00090 STA* LRS3 00091 LDA* DWVLSB 00092 SAP 1 00093 TCA A 00094 AND- LPMSK,Q WORK WITH REMAINING LSB'S 00095 LDQ* TEMP+2 GET REMAINDER FROM FIRST PART 00096 SQP 1 00097 TCQ Q MAKE SIGNS BOTH POSITIVE 00098ALS2 ADC 0 00099 EJT 00100LRS3 ADC 0 00101 DVI* SWV DO DIVIDE 00102 LDQ* TEMP+3 PICK MSB OF NUM FROM FIRST PART 00103ÐÐ SQM B1 00104 SAP ALS1 MAKE SIGN OF A AGREE WITH Q 00105 TCA A 00106 JMP* ALS1 00107B1 SAM ALS1 00108 TCA A 00109ALS1 ADC 0 PACK ANSWER 00110LRS2 ADC 0 00111 LLS 1 CONVERT TO SPECIAL DOUBLE PRECISION FORMAT 00112 ALS 15 00113 STQ* (DWRES) STORE RESULT FOR USER 00114 RAO* DWRES 00115 STA* (DWRES) 00116EXIT LDQ* QSAVE RESTORE Q-REG AND RETURN 00117 JMP* (DBLDIV) RETURN TO CALLER 00118 SPC 4 00119* PROGRAM CONSTANTS AND BUFFERS 00120DWVLSB NUM 0 00121DWVMSB NUM 0 00122QSAVE NUM 0 00123ISTAT NUM 0 00124SWV NUM 0 00125DWRES NUM 0 00126LRSINS LRS 1 LONG RIGHT SHIFT 1 INSTRUCTION 00127ALS ALS 0 00128ÐÐCNT ADC 0 COUNTING CELL 00129SWITCH NUM $00A0 SWITCH AN (ALS) TO A (LRS) 00130 BSS TEMP(4) TEMP STORAGE 00131ASAVE ADC 0 00132 END 00133 NAM EDTLP K05 A ITOS CCS 3.0 . SL-149 00001* CREDIT COLLECTION SYSTEM VERSION 3.0 00002* DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00003* COPYRIGHT CONTROL DATA CORPORATION 1979 00004* 00005 ENT EDTLP1 00006 ENT EDTLP 00007 EQU COMSIZ($0) LENGTH OF COMMON 00008* 00009EDTLP RTJ- ($F4) 00010EDT050 NUM $5A01 GET FILE 00011 ADC EDT100 COMPLETION ADDRESS 00012 NUM 0 00013 NUM $08C2 00014 NUM 0 W1 00015 ADC EDTLP1 BUFFER ADDRESS 00016 NUM 0 W2 00017 ADC EDT150-EDT050 POINTER TO FILE NAME 00018 NUM 0 MSB-ADDRESS OF FILE RETURNED AFTER CALL COMPL 00019 NUM 0 LSB 00020ÐÐ NUM $18FF HANG(REQUIRES MI,*Z TO EXIT.) 00021* HANG TO PREVENT JOB PROCESSOR GAINING 00022* CONTROL AT PRIORITY LEVEL 0. 00023* GAINING CONTROL AT PRIORITY LEVEL 0. 00024* 00025* THE GET FILE REQUEST WILL COMPLETE AT 00026* PRIORITY LEVEL 1. 00027EDT100 SQP EDT110 CHECK FOR ERROR 00028 NUM $18FF HANG ON ERROR 00029* 00030EDT110 JMP+ SAVRLD GO TO THE EDTK TO TAPE SAVE ROUTINE 00031EDT150 ALF 6,EDTLPF NAME OF SAVE FILE 00032* 00033EDTLP1 EQU EDTLP1(*) FIND LENGTH OF THIS PROGRAM 00034SAVRLD EQU SAVRLD(EDTLP1+COMSIZ) START OF SAVRLD PROGRAM 00035 END EDTLP 00036 NAM FDWMTH K06 A ITOS CCS 3.0 SL-149 00001* 00002* COPYRIGHT CONTROL DATA CORPORATION 00003* DATA SYSTEMS - LA JOLLA DIVISON, LA JOLLA, CALIFORNIA 00004* CREDIT COLLECTION SYSTEM, VERSION 3.0 00005* 00006* FORTRAN INTERFACE TO DOUBLE WORD ADD/SUBTRACT/MULTIPLY 00007* * * * SAME AS FILE MANAGER 2.0 PROGRAM 00008* 00009ÐÐ* THIS ROUTINE PROVIDES A FORTRAN INTERFACE TO THE FILE MANAGER 00010* DOUBLE WORD MATH ROUTINES. 00011* 00012* CALLING SEQUENCES: 00013* CALL FDWADD (OP1, OP2, RESULT, OV) 00014* CALL FDWSUB (OP1, OP2, RESULT, OV) 00015* CALL FDWMUI (OP1, OP3, RESULT, OV) 00016* 00017* PARAMETERS: 00018* OP1 - FIRST OPERAND (MSB/LSB) 00019* OP2 - SECOND OPERAND (MSB/LSB) (SUBTRAHEND) 00020* OP3 - SINGLE WORD OPERAND 00021* RESULT - COMPUTATION RESULT (MSB/LSB) 00022* OV - OVERFLOW INDICATOR: 00023* =0 IF NONE OCCURRED 00024* =1 IF ONE DID OCCUR 00025* 00026* ENTRY POINTS 00027* 00028 ENT FDWADD 00029 ENT FDWSUB 00030 ENT FDWMUI 00031* 00032* EXTERNALS 00033* 00034ÐÐ EXT Q8PREP 00035 EXT Q8PKUP 00036 EXT DBLADD 00037 EXT DBLSUB 00038 EXT DBLMUL 00039* 00040* EQUIVALENCES 00041* 00042 EQU ZERO(2) 00043* * * * 00044 EJT 00045FDWADD ADC 0 ENTRY FOR ADD 00046 LDA* FDWADD 00047 STA* FDWMUI TRANSFER PARAMETER ADDRESS 00048 ENA 0 00049 STA* OPTYPE SET OPERATOR CODE TO ADD 00050 JMP* CONTIN 00051* 00052FDWSUB ADC 0 ENTRY FOR SUBTRACT 00053 LDA* FDWSUB 00054 STA* FDWMUI TRANSFER PARAMETER ADDRESS 00055 ENA 3 00056 STA* OPTYPE SET OPERATOR CODE TO SUBTRACT 00057 JMP* CONTIN 00058* 00059ÐÐFDWMUI ADC 0 ENTRY FOR MULTIPLY 00060 ENA 6 00061 STA* OPTYPE SET OPERATOR CODE TO MULTIPLY 00062 EJT 00063CONTIN STQ* QSAVE SAVE Q-REG 00064 LDA- I SAVE I-REG 00065 STA* ISAVE 00066* 00067 RTJ Q8PREP ABSOLUTIZE PARAMETERS FOR F.M. ROUTINES 00068 ADC* FDWMUI 00069ADR RTJ Q8PKUP 00070 TRA Q 00071 LDA- (ZERO),Q 00072 STA* PLIST OP1 MSB 00073 LDA- 1,Q 00074 STA* PLIST+1 OP1 LSB 00075 RTJ* (ADR+1) 00076 TRA Q 00077 LDA- (ZERO),Q 00078 STA* PLIST+2 OP2 (MSB) OR OP3 00079 LDA* OPTYPE LIST FORMAT DIFFERS FOR ADD/SUB AND MUI 00080 INA -6 00081 SAM ADDSUB 00082 RTJ* (ADR+1) 00083 STA* RESULT ADDRESS OF RESULT 00084ÐÐ RTJ* (ADR+1) 00085 STA* OVADR OVERFLOW STATUS ADDRESS 00086 JMP* COMPUT 00087* 00088ADDSUB LDA- 1,Q 00089 STA* PLIST+3 OP2 (LSB) 00090 RTJ* (ADR+1) 00091 STA* RESULT ADDRESS OF RESULT 00092 RTJ* (ADR+1) 00093 STA* OVADR OVERFLOW STATUS ADDRESS 00094 EJT 00095COMPUT LDQ =XPLIST GO CALL APPROPRIATE ROUTINE 00096 LDA* OPTYPE 00097 STA- I 00098 NUM $1901 00099* 00100 RTJ DBLADD ADD 00101 JMP* RET 00102 RTJ DBLSUB SUBTRACT 00103 JMP* RET 00104 RTJ DBLMUL MULTIPLY 00105 EJT 00106RET LDQ* RESULT RETURN RESULT TO CALLER 00107 LDA* OPTYPE 00108 INA -6 00109ÐÐ SAM AS 00110 LDA* PLIST+3 00111 STA- (ZERO),Q 00112 LDA* PLIST+4 00113 STA- 1,Q 00114 LDA* PLIST+5 00115 JMP* EXIT 00116* 00117AS LDA* PLIST+4 00118 STA- (ZERO),Q 00119 LDA* PLIST+5 00120 STA- 1,Q 00121 LDA* PLIST+6 00122 SPC 3 00123EXIT STA* (OVADR) RETURN OVERFLOW STATUS 00124 LDQ* QSAVE RESTORE Q AND I REGISTERS 00125 LDA* ISAVE 00126 STA- I 00127 JMP* (FDWMUI) RETURN TO CALLER 00128 SPC 3 00129PLIST BZS PLIST(7) 00130QSAVE NUM 0 00131ISAVE NUM 0 00132RESULT NUM 0 00133OVADR NUM 0 OVERFLOW STATUS ADDRESS 00134ÐÐOPTYPE NUM 0 00135 END 00136 NAM GETWRD K07 A ITOS CCS 3.0 SL-149 00001* 00002* COPYRIGHT CONTROL DATA CORPORATION, 1979 00003* DATA SYSTEMS, LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00004* CREDIT COLLECTION SYSTEM, VERSION 3.0 00005* 00006* THIS SUBROUTINE TAKES A GIVEN ADDRESS AND RETRIEVES A GIVEN 00007* NUMBER OF WORDS BACK TO THE CALLING SUBROUTINE. 00008* 00009* THE CALLING SEQUENCE IS GETWRD(STADD,NUMWRD,BUFF) 00010* STADD IS THE STARTING ADDRESS FOR RETRIEVAL 00011* NUMWRD IS THE NUMBER OF WORDS TO BE RETRIEVED AND MOVED TO 00012* BUFF. 00013* BUFF IS THE RETURN VALUE BUFFER. 00014* 00015 ENT GETWRD 00016 EQU ZERO($2) SYSTEM ZERO 00017* 00018GETWRD 0 0 00019* 00020 STQ* SAVEQ SAVE THE Q REGISTER 00021 SRI* SAVEI 00022* 00023ÐÐ LDQ* GETWRD RETURN ADDRESS TO CALLING PROGRAM 00024 INQ 3 BYPASS PARAMETERS TO NEXT EXECUTABLE INSTR. 00025 STQ* GETWRD STORE RETURN ADDRESS+3 00026 RTJ* PARGET PICK UP PARAMETERS 00027* 00028* ROUTINE THAT MOVES A WORD AT A TIME TO THE 00029* RETURN BUFFER BUFF. THE MOVE STARTS FROM THE 00030* LAST WORD AND MOVES A WORD AT A TIME UNTIL 00031* THE STARTING ADDRESS IS REACHED. 00032* 00033 LDQ* (PAR+1) Q EQUALS NUMWRD-USED AS COUNTER FOR LOOP 00034 INQ -1 SUBTRACT 1 FROM NUMWRDS 00035 LRI* (PAR) I EQUALS THE ADDRESS OF STARTING WORD TO MOVE 00036GET200 LDA- (I),Q A EQUALS THE STADD + NUMWRDS 00037 STA* (PAR+2),Q STORE WORD(Q) INTO BUFF(Q) 00038 DQP *-GET200 SKIP ON NEGETIVE Q-ALL WORDS ARE MOVED 00039* 00040 LRI* SAVEI RESTORE THE I REGISTER 00041 LDQ* SAVEQ RESTORE THE Q REGISTER 00042* 00043 JMP* (GETWRD) 00044* 00045* PARAMETER ADDRESS STORAGE 00046* 00047PAR BZS PAR(3) (0) ADDRESS OF THE FIRST WORD TO BE MOVED 00048ÐÐ* (1) ADDRESS OF THE NUMBER OF WORDS TO MOVE 00049* (2) ADDRESS OF THE BEGINNING OF THE RETURN BUF 00050SAVEI NUM 0 I REGISTER 00051SAVEQ NUM 0 Q REGISTER 00052* 00053* 00054* ROUTINE TO PICK UP PARAMETER ADDRESSES 00055PARGET LDQ* GETWRD PICK UP RETURN ADDRESS+3 00056 INQ -1 MOVE THE BEGINNING ADDRESS OF BUFF 00057 ENA 2 SET UP INDEX TO PICK UP PARAMETERS (#PAR-1) 00058 STA- I STORE INDEX IN I 00059* 00060PAR100 LDA- (ZERO),Q PICK UP ADDRESS OF NEXT PARAMETER 00061 STA* PAR,I SAVE PARAMETER ADDRESS 00062 INQ -1 DECREMENT INDEX TO PARAMETER TABLE 00063 DIP *-PAR100 DKIP ON NEGETIVE I- ALL PARAMETER ADDR RETRIEV 00064* 00065 JMP* (PARGET) RETURN 00066 END 00067 NAM PHANT K08 A ITOS CCS 3.0 . SL-149 00001* 00002* COPYRIGHT CONTROL DATA CORPORATION, 1979 00003* DATA SYSTEMS, LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00004* CREDIT COLLECTION SYSTEM, VERSION 3.0 00005* 00006ÐÐ EXT SAVRLD 00007 ENT EDTLP1 00008 JMP+ SAVRLD DUMMY CALL. 00009 BZS ($14) 00010EDTLP1 EQU EDTLP1(*) 00011 END 00012 NAM SDSABL K09 A ITOS CCS 3.0 SL-149 00001* 00002* COPYRIGHT CONTROL DATA CORPORATION, 1979 00003* DATA SYSTEMS, LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00004* CREDIT COLLECTION SYSTEM, VERSION 3.0 00005* 00006* THIS SUBROUTINE SDSABLES THE PROTECT SWITCH, THE SYSTEM TIMER, 00007* THE MANUAL INTERRUPT, AND DEVICE ERROR LOGGING. 00008* 00009* CALLING SEQUENCE 00010* CALL SDSABL 00011* 00012* NO PARAMETERS 00013* 00014* 00015* ENTRY POINTS 00016 ENT SDSABL 00017* 00018* EXTERNALS 00019ÐÐ* 00020 EXT EMPSTP 00021 EXT DMICOD 00022 EXT TBLADR 00023 EXT MIBX 00024 EXT EFSTOR 00025 EXT TSNABL 00026 EXT SYFAIL 00027* 00028* EQUATES 00029 EQU DISP($EA) 00030 EQU ZERO($22) SYSTEM ZERO 00031 EQU LPMASK($2) 00032* 00033* 00034SDSABL NOP 0 00035* 00036 STQ* SAVEQ SAVE THE Q REGISTER 00037 SRI* SAVEI SAVE THE I REGISTER 00038 JMP* BEGIN JUMP TO BEGIN 00039* 00040* Q AND I REGISTER STORAGE 00041SAVEQ NUM 0 00042SAVEI NUM 0 00043* 00044ÐÐBEGIN LDQ =XTSNABL CHECK IF ITOS DISABLED 00045 LDA- (ZERO),Q 00046 SAZ PROTCT SKIP IF DISABLED 00047 ENQ 0 INITIALIZE Q WITH ZERO 00048 RTJ* MESAGE DISPLAY ITOS NOT DISABLED MESSAGE 00049 ENQ -1 PUT STATUS IN Q 00050 JMP* RETURN RETURN TO CALLING SUBROUTINE 00051* 00052* 00053PROTCT ENQ 1 MESSAGE 0 00054 RTJ* MESAGE REQUEST PROTECT SWITCH TURNED OFF 00055 RTJ* INPUT WAIT FOR CARRIAGE RETURN TO CONTINUE 00056* 00057 LDQ+ EMPSTP 00058TIMER ENA 0 DISABLE TIMER 00059 OUT TIMREJ-* BRANCH ON REJECT 00060 LDA+ DMICOD BIT 15 ENABLES/DISABLES MICRO INTERRUPT 00061 AND- LPMASK+15 1 ENABLES/0 DISABLES 00062 TRA Q DMI LOOKS AT Q REGISTER TO DISABLE 00063 LDA+ TBLADR 00064 DMI DISABLE THE MICRO INTERRUPT 00065* 00066 RTJ- ($F4) DISABLE ERROR LOGGING ROUTINE 00067 ADC $26FF DO A DISCHD REQUEST CODE 19 00068 ADC EFSTOR 00069ÐÐ RAO+ MIBX DISABLE MANUAL INTERRUPT 00070* 00071 LDQ* SAVEQ RESTORE A AND I REGISTERS 00072RETURN LRI* SAVEI 00073* 00074 JMP* (SDSABL) RETURN TO CALLING PROGRAM 00075* 00076TIMREJ JMP* TIMRJI 00077 ENQ 2 EXTERNAL REJECT DISPLAY MESSAGE 00078 JMP* TIMMSG 00079TIMRJI ENQ 3 INTERNAL REJECT DISPLAY MESSAGE 00080TIMMSG RTJ* MESAGE 00081 ENQ -1 00082 RTJ+ SYFAIL FATAL ERROR TIMER NOT WORKING 00083* 00084* 00085INPUT NOP 0 00086 RTJ- ($F4) 00087 ADC $4801 REQUEST 00088 ADC INP100 COMPL ADDRESS 00089 ADC 0 THREAD 00090 ADC $1004 LU 00091 ADC 1 LENGTH 00092 ADC INPBUF BUFFER 00093 JMP- (DISP) CONT ADDRESS 00094ÐÐINP100 JMP* (INPUT) RETURN 00095* 00096INPBUF NUM 0 BUFFER FOR REPLY 00097* 00098MESAGE NOP 0 00099 LDA* MESADD,Q 00100 STA* MESA1 00101 LDA* MESSLN,Q 00102 STA* MESL1 00103* 00104MES10 RTJ- ($F4) OUTPUT MESSAGE 00105 ADC $4C01 REQUEST 00106 ADC MES20 COMPL ADDRESS 00107 ADC 0 THREAD 00108 ADC $1004 LU 00109MESL1 ADC 0 LENGTH 00110MESA1 ADC 0 BUFFER 00111 JMP- (DISP) CONTINUATION ADDRESS 00112MES20 SQP MES30 SKIP IF NO ERRORS ON OUTPUT 00113 JMP* MES10 ERRORS DETECTED,REPEAT THE OUTPUT 00114MES30 JMP* (MESAGE) RETURN 00115* 00116* 00117MESADD ADC MESS00 00118 ADC MESS01 00119ÐÐ ADC MESS02 00120 ADC MESS03 00121* 00122MESSLN ADC MESLN0 00123 ADC MESLN1 00124 ADC MESLN2 00125 ADC MESLN3 00126* 00127MESS00 ALF $,ILLEGAL: CCS HAS NOT BEEN DISABLED$ 00128 EQU MESLN0(*-MESS00) 00129* 00130MESS01 ALF $,TURN OFF PROTECT SWITCH(ESC J20@):R$ 00131 ALF $,AND TYPE CARRIAGE RETURN $ 00132 EQU MESLN1(*-MESS01) 00133* 00134MESS02 ALF $,EXTERNAL TIMER REJECT$ 00135 EQU MESLN2(*-MESS02) 00136* 00137MESS03 ALF $,INTERNAL TIMER REJECT$ 00138 EQU MESLN3(*-MESS03) 00139* 00140* 00141 END 00142 NAM DTLP50 K10 A ITOS CCS 3.0 SL-149O6300001* CREDIT COLLECTION SYSTEM VERSION 3.0 O6300002ÐÐ* DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA O6300003* COPYRIGHT CONTROL DATA CORPORATION 1979 O6300004 SPC 2 O6300005* O6300006* THIS PROGRAM IS USED TO BRING IN THE UTILITY O6300007* PROGRAM DSKTAP. O6300008* O6300009* SINCE DSKTAP ONLY RUNS IN THE LOWER 32K THIS O6300010* PROGRAM MUST BRING IN DSKTAP AND CHECK TO SEE O6300011* WHAT THE START OF UNPROTECTED IS. O6300012* O6300013* DTLP READS THE DSKTAP FILE INTO UNPROTECTED O6300014* MEMORY, MOVES THE FILE TO THE HIGHEST LOCATION O6300015* AVAILABLE IN BANK 0, INHIBITS INTERRUPTS, AND O6300016* EXECTES DSKTAP. O6300017* O6300018* 4 CARDS DELETED 122*4810O6300019 ENT DTLP50 O6300020 EQU MICINT(11) MAX NUMBER MICRO-INTRPT TO CLEAR O6300021DTLP50 GTFILE G0,NAME-DTLP50-1,FWA,,,,0,1,1 122*O6300022 NUM 0,0 O6300023 JMP- ($EA) O6300024G0 LDA* DTLP50+7 122*48O6300025 STA* LENGTH SAVE LENGTH OF DSKTAP 122*4810O6300026 JMP* START 122*4810O6300027ÐÐG1 RTJ- ($F4) O6300028 NUM $4C00 FWRITE O6300029COMPA ADC COMP,0 117*4335O6300030 NUM $18FC O6300031LENM1 ADC MSEND1-MESS1 O6300032 ADC MESS1 O6300033 JMP- ($EA) O6300034MESS1 ALF *,TURN OFF PROTEC SWITCH,TYPE CARRIAGE RETURN* O6300035 ALF *, (J20@)* 122*4810O6300036MSEND1 EQU MSEND1(*) O6300037COMP RTJ- ($F4) O6300038 NUM $4800 FREAD O6300039 ADC 0,0 O6300040 NUM $18FD,1 O6300041BUFAD ADC MESS1 117*4335O6300042COMP0 LDA* COMP+3 O6300043 SAZ 1 WAIT FOR COMPLETION O6300044 JMP* COMP0 O6300045 LDQ* COMP+4 O6300046 SQP COMP1 CHECK FOR ERROR O6300047 JMP* G1 REPEAT MESSAGE O6300048COMP1 IIN 0 INHIBIT INTERRUPTS O6300049 ENQ MICINT MAX MICRO INT TO BE CLEARED O6300050CLRMIC DMI CLEAR MICRO-INT O6300051 INQ -1 NEXT 1 TO CLEAR O6300052ÐÐ SQM MOVCHK SKIP IF DONE O6300053 JMP* CLRMIC CLEAR THRU ZERO O6300054MOVCHK LDA* LENGTH GET LENGTH OF DSKTAP 122*4810O6300055 ADD* WORDB1 122*4810O6300056 STA* WORDB0 SAVE LWA OF DSKTAP 122*4810O6300057 CLR Q O6300058 SAM BANK1 122*4810O6300059 JMP* BANK0 JUMP IF FILE IS ALL IN BANK0 122*4810O6300060* O6300061* PART OR ALL IN BANK 1 - START MOVE FROM FWA O6300062* O6300063BANK1 LDA- $11 7FFF O6300064 SUB* LENGTH FORM NEW FWA 122*4810O6300065 STA- I NEW FWA IN I-REG 122*4810O6300066 ENQ $20 122*4810O6300067MMOVE LDA* MOVEDN,Q MOVE THE MOVE ROUTINE TO LOW CORE 122*4810O6300068 STA- ($22),Q 122*4810O6300069 INQ -1 122*4810O6300070 SQM MOVEM 122*4810O6300071 JMP* MMOVE 122*4810O6300072MOVEM JMP- ($22) 122*4810O6300073MOVEDN LDA* (WORDB1) MOVE FROM BANK 1 TO BANK 0 O6300074 STA- ($22),B START MOVE FROM 1ST WORD OF DSKTAP O6300075 LDA* LENGTH 122*4810O6300076 EAQ A O6300077ÐÐ SAZ DONEDN O6300078 INQ 1 INCREMENT 'Q' AND O6300079 RAO WORDB1 CURRENT WORD ADDRESS O6300080 JMP* MOVEDN O6300081DONEDN JMP- ($22),I EXECUTE DSKTAP AT NEW FWA O6300082* O6300083* ALL IN BANK 0 - START MOVE FROM LWA O6300084* O6300085BANK0 LDA $F5 TOP OF MEMORY O6300086 SAP 1 SKIP IF 32K OR LESS O6300087 LDA- $11 7FFF O6300088 STA- I NEW LWA IN 'I' O6300089MOVEUP LDA* (WORDB0) MOVE FROM BANK 0 TO TOP OF BANK 0 O6300090 STA- ($22),B START MOVE FROM LAST WORD OF DSKTAP O6300091 LDA* LENGTH 122*4810O6300092 AAQ A O6300093 SAZ DONEUP O6300094 INQ -1 DECREMENT 'Q' AND O6300095 LDA* WORDB0 CURRENR WORD ADDRESS O6300096 INA -1 O6300097 STA* WORDB0 O6300098 JMP* MOVEUP O6300099DONEUP JMP- ($22),B EXECUTE DSKTAP O6300100WORDB0 ADC 0 LAST WORD ADDRESS OF DSKTAP FILE 122*4810O6300101LENGTH NUM 0 LENGTH OF DSKTAP FILE 122*4810O6300102ÐÐWORDB1 ADC FWA FIRST WORD ADDRESS OF DSKTAP FILE O6300103* 1 CARD DELETED 122*4810O6300104NAME ALF 3,DSKT50 O6300105START LDA- $F5 TOP OF MEMORY O6300106 SAP S2 SKIP IF 32K OR LESS O6300107 LDA- $11 7FFF O6300108S2 SUB* LENGTH 122*4810O6300109 CLR Q O6300110 STQ- I CONVERT STARTING ADDRESS O6300111M1 LLS 4 TO ASCII O6300112 INQ -10 O6300113 SQM M2 O6300114 INQ 7 O6300115M2 INQ $3A O6300116 STQ* M4,I O6300117 RAO- I O6300118 LDQ- I O6300119 INQ -4 O6300120 SQZ M3 O6300121 CLR Q O6300122 JMP* M1 O6300123M3 LDA* M4 O6300124 ALS 8 O6300125 ADD* M4+1 O6300126 STA* ADR O6300127ÐÐ LDA* M4+2 O6300128 ALS 8 O6300129 ADD* M4+3 O6300130 STA* ADR+1 O6300131 RTJ- ($F4) O6300132 NUM $4C00 O6300133 ADC G1 122*4810O6300134 NUM 0,$18FC O6300135LENM ADC MSEND-MESS O6300136MESAD ADC MESS 117*4335O6300137 JMP- ($EA) O6300138M4 BZS M4(4) O6300139MESS ALF *,DTLP50 FIRST WORD ADDRESS WILL BE * O6300140ADR ALF 2, O6300141 NUM $0A0A O6300142MSEND EQU MSEND(*) O6300143FWA EQU FWA(*) 122*4810O6300144 END DTLP50 O6300145 NAM CUDDLY K11 A ITOS CCS 3.0 SL-149 00001* CREDIT COLLECTION SYSTEM VERSION 3.0 00002* DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00003* COPYRIGHT CONTROL DATA CORPORATION 1979 00004 SPC 2 00005* COSY (COMPRESSED SYMBOLIC) VERSION 2.0. 00006* MODIFIED FOR CREDIT COLLECTION SYSTEMS VERSIONS 1.0, 1.1, AND 00007ÐÐ* 2.0 . MODIFICATIONS INCLUDE: 00008* 1. COSY ALL 80 COLUMNS OF INPUT RECORDS. 00009* 2. ALLOW SIX CHARACTER DECK ID. ON OUTPUT, THIS ID APPEARS IN 00010* COLS 81-86, AND THE SEQUENCE NUMBER IN COLS 88-92 . 00011* 3. CHECKSUM AND SEQUENCE EACH COSY RECORD BLOCK. REPORT ERRORS 00012* ON INPUT FOR SEQUENCE (C24) OR CHECKSUM (C25) ERRORS. 00013* 4. EXPAND THE COSY INPUT AND OUTPUT BLOCK SIZE TO 1536 WORDS. 00014 ENT CUDDLY 00015* 00016* THE FOLLOWING INSTRUCTIONS ASSIGN LABELS TO ALL LOCATIONS 00017* IN THE COMMUNICATIONS REGION THAT ARE REFERENCED BY COSY. 00018* ALL REFERENCES TO THE COMMUNICATIONS REGION ARE MADE USING 00019* THESE LABELS. 00020* 00021LPMASK EQU LPMASK($2) 00022NZERO EQU NZERO($12) 00023ZERO EQU ZERO($22) 00024ONEBIT EQU ONEBIT($23) 00025MODBIT EQU MODBIT($2F) ASCII MODE BIT. 00026CLRMOD EQU CLRMOD($3F) CLEAR ASCII MODE BIT 00027TEN EQU TEN($46) 00028STDSCR EQU STDSCR($B3) 00029DISP EQU DISP($EA) 00030REQPRO EQU REQPRO($F4) 00031STDINP EQU STDINP($F9) 00032ÐÐSTDTBL EQU STDTBL($E9) 00033STDOCD EQU STDOCD($FC) 00034STDICD EQU STDICD($FD) 00035 SPC 5 00036* THE FOLLOWING VALUES ARE SEQUENTIALLY ADDED TO 00037* THE ADDRESS CONTAINED AT $E9(EXTRV4) TO GET THE 00038* COSY STANDARD LOGICAL UNITS. 00039 SPC 2 00040CSYINP EQU CSYINP(1) COSY STANDARD INPUT DEVICE. 00041CSYOUT EQU CSYOUT(1) COSY STANDARD OUTPUT DEVICE. 00042CSYPRT EQU CSYPRT(1) COSY STANDARD PRINT DEVICE. 00043 EJT 00044* COSY STANDARD LOGICAL UNIT ADDRESS TABLE 00045* 00046CSTDIN NUM 0 ADDRESS OF COSY STD INPUT LUN. 00047CSTDOT NUM 0 ADDRESS OF COSY STD OUTPUT LUN. 00048CSTDPT NUM 0 ADDRESS OF COSY STD PRINT LUN. 00049 SPC 4 00050* COSY INITIALIZATION ROUTINE 00051* 00052CUDDLY RTJ* COSY1 00053 ADC ADDRES-CUDDLY-1 ADRADR 00054 ADC TABLE-ADDRES TABADR 00055 ADC REVBUF-TABLE ADDRES 00056 ADC HOL-CUDDLY-1 ADRDCK 00057ÐÐCOSY1 0 0 00058 LDA- STDTBL FWA OF LOGICAL UNIT AREA. 00059 INA CSYINP 00060 STA* CSTDIN COSY STANDARD INPUT DEVICE. 00061 INA CSYOUT 00062 STA* CSTDOT COSY STANDARD OUTPUT DEVICE. 00063 INA CSYPRT 00064 STA* CSTDPT COSY STANDARD PRINT DEVICE. 00065 LDA- STDSCR SET SYSTEM STANDARD UNITS USED 00066 ADD- MODBIT BY COSY. SET ASCII MODE. 00067 STA UPD175 * 00068 STA CPY020 00069 LDA- STDOCD * 00070 ADD- MODBIT * 00071 STA CSH065 * 00072 LDA- STDICD * 00073 ADD- MODBIT * 00074 STA CSH075 * 00075 LDA* COSY1 FORM ALL ABSOLUTE ADDRESSES. 00076 ADD* CUDDLY+1 00077 STA ADRADR 00078 ADD* CUDDLY+2 00079 STA TABADR 00080 ADD* CUDDLY+3 00081 STA ADDRES 00082ÐÐ ENQ 8 00083 LDA* COSY1 GET ADDRESSES OF DCK, MRG, CPY, END 00084 ADD* CUDDLY+4 , DEL, INS, REM, CSY AND HOL. 00085COSY11 STA ADRDCK,Q 00086 INA -2 00087 INQ -1 00088 SQM 1 00089 JMP* COSY11 00090* 00091 ENA 0 00092 STA CPYID CLEAR COPY IDENTIFIER. 00093 STA ERRCNT CLEAR TOTAL ERROR COUNT AND OUTPUT TABLE. 00094 LDQ TABSIZ 00095COSY15 STA TABLE-1,Q 00096 INQ -1 00097 SQZ 1 00098 JMP* COSY15 00099* 00100* READ A REVISION CARD FROM THE STANDARD INPUT UNIT. 00101* JUMP TO UPDATE ROUTINE, MERGE ROUTINE, COPY ROUTINE 00102* OR THE DISP. 00103* 00104COSY2 ENA 0 00105 STA E01MRK 00106 ENA 1 00107ÐÐ STA SECNUM 00108 LDA- STDINP 00109 ADD- MODBIT SET ASCII MODE. 00110 STA REVLUN 00111 LDA* (CSTDPT) USE COSY STANDARD LIST DEVICE FOR 00112 EOR- MODBIT ANY ERROR OCCURRING ON THE FIRST 00113 STA LOUTER CONTROL CARD. 00114 STA LOUTRV 00115COSY21 RTJ DMECHK READ CARD AND CHECK FOR DCK/, MRG/, 00116* CPY/ AND END/. 00117 JMP UPDATE DCK/. START UPDATE. 00118 JMP MERGE MRG/. START MERGE. 00119 JMP COPY CPY/, START COPY. 00120COSY5 ENA 0 END/. END OF COSY. 00121 STA ERRMRK 00122 RTJ PRINTR OUTPUT THE END/ CARD. 00123COSY6 LDA ERRCNT OUTPUT THE TOTAL ERROR COUNT. 00124 SAZ COSY65 NO ERRORS. 00125 RTJ HEXDEC 00126 STA* TEMESS+1 00127 LDA LOUTER 00128 STA* COSY64 SET THE LOGICAL UNIT. 00129 RTJ- (REQPRO) 00130* 00131* FWRITE LOUTER,COSY65,TEMESS,6,A,0,1,0,0,D 00132ÐÐ* 00133 VFD N1/0,N1/1,N5/6,N1/0,N4/0,N4/1 00134 ADC COSY65 00135 NUM 0 00136COSY64 VFD N3/0,N1/1,N2/0,N10/0 00137 NUM 6 00138 ADC TEMESS 00139* 00140 JMP- (DISP) 00141* 00142COSY65 LDA* TABADR 00143 ADD* TABSIZ 00144 STA ADDRES ADDRESS OF THE END OF THE OUTPUT TABLE +1. 00145COSY7 LDA* (TABADR) GET AN ENTRY FROM THE TABLE. 00146 SAZ COSY7A CHECK IF LIBRARY IS ON CARDS. 00147 JMP* COSY7G 00148COSY7A LDA =XADINPB SET THE WORKING BUFFER 00149 STA WORKUN 00150 LDA INPLU CHECK THE LOGICAL UNIT FOR COSY 00151 AND- CLRMOD INPUT DEVICE. 00152 STA* COSY7D 00153 LDQ* SLEWMK CHECK TO SEE IF INPUT HOPPER SHOULD 00154 SQM 1 BE CLEARED OF COSY CARD LIBRARY. 00155 JMP* COSY7E+1 HOLLERITH TO COSY DO NOT SLEW. 00156 RTJ CSYLUN 00157ÐÐ SQN COSY7C 00158 JMP- (DISP) INPUT DEVICE. 00159COSY7C RTJ- (REQPRO) 00160* 00161* SLEW THE BALANCE OF CARD LIBRARY OUT OF INPUT HOPPER 00162* 00163* FREAD INPLU,COSY7F,INPBUF,40,B,0,1,0,0,D 00164* 00165 VFD N1/0,N1/1,N5/4,N1/0,N4/0,N4/1 00166 ADC COSY7F 00167 NUM 0 00168COSY7D VFD N3/0,N1/0,N2/0,N10/0 00169 NUM 40 00170COSY7E ADC INPBUF 00171 JMP- (DISP) 00172COSY7F RTJ* CHKEND CHECK FOR END/ CARD. 00173 JMP* COSY7C NOT A END/ CARD. 00174 JMP- (DISP) END/ CARD, ALL CARDS SLEWED. 00175COSY7G SAP 1 00176 JMP* COSY9 MINUS ENTRY INDICATING A COSY UNIT. 00177 STA TABLU 00178 STA* COSY76 SET HOLLERITH OUTPUT LUN 00179 SUB LOUT DO NOT WRITE MON CARD 00180 JMP* COSY8 TO LIST DEVICE. 00181 RTJ- (REQPRO) OUTPUT MON CARD TO HOLLERITH UNIT. 00182ÐÐ* 00183* FWRITE HOUT,COSY8,MON,3,A,0,1,0,0,D 00184* 00185COSY75 VFD N1/0,N1/1,N5/6,N1/0,N4/0,N4/1 00186 ADC COSY8 00187 NUM 0 00188COSY76 VFD N3/0,N1/1,N2/0,N10/0 00189 NUM 3 00190 ADC MON 00191* 00192 JMP- (DISP) 00193* 00194COSY8 RTJ WEOF WRITE END OF FILE ON OUTPUT UNIT. 00195 LDA* MONWRT 00196COSY81 RTJ MTSTAT CHECK STATUS. REWIND IF MAG. TAPE. 00197 NOP 0 NO P+1 RETURN WHEN CHECKED HERE. 00198 RAO* TABADR INCREMENT TO NEXT TABLE ENTRY. 00199 LDA* TABADR 00200 SUB ADDRES 00201 SAZ 1 END OF TABLE. 00202 JMP* COSY7 00203 JMP- (DISP) 00204* 00205COSY9 AND- LPMASK+15 00206 STA TABLU 00207ÐÐ AND- CLRMOD CLEAR MODE BIT BEFORE CHECK 00208 RTJ CSYLUN 00209 LDA TABLU 00210 EOR MODTAB,Q 00211 STA* COSY96 00212 RTJ- (REQPRO) OUTPUT AN END/ CARD ON THE COSY UNIT. 00213* 00214* FWRITE COUT,COSY10,ENDCD,6,AORB,0,1,0,0,D 00215* 00216COSY95 VFD N1/0,N1/1,N5/6,N1/0,N4/0,N4/1 00217 ADC COSY10 00218 NUM 0 00219COSY96 VFD N3/0,N1/1,N2/0,N10/0 00220 NUM 6 00221 ADC ENDCD 00222* 00223 JMP- (DISP) 00224* 00225COSY10 RTJ WEOF WRITE EOF ON THE OUTPUT UNIT. 00226 LDA* ENDWRT 00227 JMP* COSY81 00228* 00229TEMESS ALF 6, 00 ERRORS. 00230* 00231************************** 00232ÐÐ* 00233ADRADR ADC ADDRES ABSOLUTE ADDRESS OF ADDRES. 00234TABADR ADC TABLE ABSOLUTE ADDRESS OF TABLE. 00235REVLUN NUM 0 00236E01MRK BSS E01MRK(1) FIRST TIME SWITCH FOR E01 MESSAGE. 00237TABSIZ NUM 8 SIZE OF THE OUTPUT TABLE. 00238MONWRT ADC COSY75 00239ENDWRT ADC COSY95 00240SLEWMK NUM 0 MARKER= + SLEW IS NOT PEROFRMED 00241* MARKER= - SLEW IS PERFORMED. 00242MON ALF 3, MON 00243ENDCD ALF 6, END/ 00244 EJT 00245* CHKXXX SUBROUTINES 00246* 00247* THESE SUBROUTINES CHECK THE WORKING BUFFER FOR THE 00248* CONTROL CARD XXX/. 00249* THEY EXIT TO THE RETURN ADDRESS IF THE CONTROL CARD IS NOT 00250* FOUND OR TO THE RETURN ADDRESS +1 IF THE CONTROL CARD IS 00251* FOUND. 00252* Q WILL CONTAIN THE ADDRESS OF THE WORKING BUFFER. 00253* I WILL CONTAIN THE ADDRESS OF THE WORKING UNITS PARAMETER 00254* STRING. 00255 SPC 4 00256* CHKDCK SUBROUTINE 00257ÐÐ* 00258* CHECKS FOR A DCK/ CONTROL CARD. 00259* 00260CHKDCK 0 0 00261 LDA* ADRDCK ADDRESS OF ASCII CHARACTERS FOR DCK/. 00262 LDQ* CHKDCK RETURN ADDRESS. 00263 JMP* CHKCRD+1 00264 SPC 4 00265* CHKMRG SUBROUTINE 00266* 00267* CHECKS FOR A MRG/ CONTROL CARD. 00268* 00269CHKMRG 0 0 00270 LDA* ADRMRG ADDRESS OF ASCII CHARACTERS FOR MRG/. 00271 LDQ* CHKMRG RETURN ADDRESS. 00272 JMP* CHKCRD+1 00273 SPC 4 00274* CHKDEL SUBROUTINE 00275* 00276* CHECKS FOR A DEL/ CONTROL CARD. 00277* 00278CHKDEL 0 0 00279 LDA* ADRDEL ADDRESS OF ASCII CHARACTERS FOR DEL/. 00280 LDQ* CHKDEL RETURN ADDRESS. 00281 JMP* CHKCRD+1 00282ÐÐ SPC 4 00283* CHKINS SUBROUTINE 00284* 00285* CHECKS FOR A INS/ CONTROL CARD. 00286* 00287CHKINS 0 0 00288 LDA* ADRINS ADDRESS OF ASCII CHARACTERS FOR INS/. 00289 LDQ* CHKINS RETURN ADDRESS. 00290 JMP* CHKCRD+1 00291 SPC 4 00292* CHKREM SUBROUTINE 00293* 00294* CHECKS FOR A REM/ CONTROL CARD. 00295* 00296CHKREM 0 0 00297 LDA* ADRREM ADDRESS OF ASCII CHARACTERS FOR REM/. 00298 LDQ* CHKREM RETURN ADDRESS. 00299 JMP* CHKCRD+1 00300 SPC 4 00301* CHKEND SUBROUTINE 00302* 00303* CHECKS FO A END/ CONTROL CARD. 00304* 00305CHKEND 0 0 00306 LDA* ADREND ADDRESS OF ASCII CHARACTERS END/. 00307ÐÐ LDQ* CHKEND RETURN ADDRESS. 00308 JMP* CHKCRD+1 00309 SPC 4 00310* CHKCPY SUBROUTINE 00311* 00312* CHECKS FOR A CPY/ CONTROL CARD. 00313* 00314CHKCPY NOP 0 00315 LDA* ADRCPY ADDRESS OF ASCII IMAGE OF CPY/. 00316 LDQ* CHKCPY RETURN ADDRESS. 00317 JMP* CHKCRD+1 00318 SPC 4 00319* CHKCSY SUBROUTINE 00320* 00321* CHECKS FOR A CSY/ CONTROL CARD. 00322* 00323CHKCSY 0 0 00324 LDA* ADRCSY 00325 LDQ* CHKCSY 00326 JMP* CHKCRD+1 00327 SPC 4 00328* CHKHOL SUBROUTINE 00329* 00330* CHECKS FOR A HOL/ CONTROL CARD. 00331* 00332ÐÐCHKHOL 0 0 00333 LDA* ADRHOL 00334 LDQ* CHKHOL 00335 JMP* CHKCRD+1 00336 SPC 4 00337* THIS ROUTINE DOES THE ACTUAL CONTROL CARD CHECKING. 00338* 00339CHKCRD 0 0 00340 STA- I 00341 STQ* CHKCRD SET RETURN ADDRESS. 00342 LDQ* (WORKUN) ADDRESS OF WORKING BUFFER 00343 LDA- 5,Q 00344 SUB* SLASH 00345 SAN CHKBAD 00346 LDA- 4,Q 00347 SUB- 1,I 00348 SAN CHKBAD 00349 LDA- 3,Q 00350 SUB- (ZERO),I 00351 SAN CHKBAD 00352 RAO* CHKCRD FOUND THE CONTROL CARD. INCREMENT RETURN 00353* ADDRESS. 00354CHKBAD LDA* WORKUN 00355 STA- I ADDRESS OF THE WORKING PARAMETER STRING. 00356 JMP* (CHKCRD) 00357ÐÐ* 00358************************** 00359* 00360ADRDCK ADC DCK ABSOLUTE ADDRESS OF DCK. 00361ADRMRG ADC MRG ABSOLUTE ADDRESS OF MRG. 00362ADRCPY ADC CPY ABSOLUTE ADDRESS OF CPY. 00363ADREND ADC END ABSOLUTE ADDRESS OF END. 00364ADRDEL ADC DEL ABSOLUTE ADDRESS OF DEL. 00365ADRINS ADC INS ABSOLUTE ADDRESS OF INS. 00366ADRREM ADC REM ABSOLUTE ADDRESS OF REM. 00367ADRCSY ADC CSY ABSOLUTE ADDRESS OF CSY. 00368ADRHOL ADC HOL ABSOLUTE ADDRESS OF HOL. 00369* 00370DCK ALF 2, DCK 00371MRG ALF 2, MRG 00372CPY ALF 2, CPY 00373END ALF 2, END 00374DEL ALF 2, DEL 00375INS ALF 2, INS 00376REM ALF 2, REM 00377CSY ALF 2, CSY 00378HOL ALF 2, HOL 00379* 00380SLASH ALF 1,/ 00381* 00382ÐÐ************************** 00383* 00384WORKUN ADC ADDRES ADDRESS OF THE WORKING UNITS PARAMETER STRING. 00385ADDRES ADC REVBUF ABSOLUTE ADDRESS OF REVBUF. 00386ERRCNT NUM 0 TOTAL ERROR COUNT. 00387* 00388E01 LDA* E01MRK 00389 SAN E0105 NZ IF A MESSAGE WAS ALREADY OUTPUT. 00390 RAO* E01MRK 00391 ENA 1 **COSY E01**** THE FIRST CARD OF REVISIONS 00392 RTJ ERRPRO DECK WAS NOT A DCK/, MRG/, OR END/. 00393E0105 RTJ PRINTR PRINT THE BAD CARD. 00394 JMP* DMECHK+1 00395 EJT 00396* DMECHK SUBROUTINE 00397* 00398* READS A CARD INTO REVBUF AND CHECKS FOR A DCK/, MRG/, OR 00399* END/ CONTROL CARD. 00400* EXITS THRU THE RETURN ADDRESS ON A DCK/ CARD. 00401* EXITS THRU THE RETURN ADDRESS +2 ON A MRG/ CARD. 00402* EXITS THRU THE RETURN ADDRESS +4 ON AN CPY/ CARD. 00403* EXITS THRU THE RETURN ADDRESS +6 ON AN END/ CARD. 00404* 00405DMECHK 0 0 00406 LDA ADRADR 67*1495 00407ÐÐ STA* WORKUN SET WORKING UNIT. 00408 LDA =XDMEC23 00409 STA* REVCMP 00410 LDA REVLUN PICK UP LOGICAL UNIT NO.. 00411 STA* DME4 PUT INTO REQUESTS. 00412 STA* DME5 00413 AND- CLRMOD CLEAR MODE BIT FOR STATUS REQUEST. 00414 RTJ CKDEV CHECK TYPE OF DEVICE 00415 JMP* DME3 MASS STORAGE DEVICE. 00416DME1 RTJ- (REQPRO) NON MASS STORAGE DEVICE. 00417* 00418* FREAD REVLUN,DMECK2,REVBUF,46,A,0,1,0,0,D 00419* 00420* THIS PARAMETER LIST IS USED FOR ALL READS INTO REVBU 00421* 00422REVREQ VFD N1/0,N1/1,N5/4,N1/0,N4/0,N4/1 00423 ADC DMEC22 00424 NUM 0 00425DME4 VFD N3/0,N1/1,N2/0,N10/0 00426 NUM 46 00427 ADC REVBUF 00428* 00429 JMP- (DISP) 00430* 00431DME3 RTJ- (REQPRO) 00432ÐÐ* 00433* FREAD REVLUN,DMECK2,REVBUF,46,A,0,1,0,0,D 00434* 00435 VFD N1/0,N1/1,N5/4,N1/0,N4/0,N4/1 00436 ADC DMECK2 00437 NUM 0 00438DME5 VFD N3/0,N1/1,N2/0,N10/0 00439 NUM 46 00440 ADC REVBUF 00441 NUM 0 00442SECNUM NUM 1 00443* 00444 JMP- (DISP) 00445* 00446DMEC22 LDA* DME4 CHECK FOR SHORT READ 00447 ALS 1 00448 SAM DMEC26 00449 JMP* DMEC24 POS. NOT A SHORT READ 00450DMEC26 LDA =XREVBUF+45 PICK UP LAST WORD ADDRESS 00451 STA- I 00452 TCA Q 00453 ADQ REVBUF+45 DISTANCE TO LAST WORD READ 00454 INQ -1 00455 LDA- (ZERO),B IF SHORT READ REPLACE $FF WITH $20 00456 ALS 8 00457ÐÐ SAP DMEC25 IF POS. BLANK REST OF BUFFER 00458 ALS 8 00459 AND =N$FF20 00460 STA- (ZERO),B 00461DMEC25 LDA =A BLANK REST OF BUFFER IN CASE 00462BLKNXT INQ 1 OF RUBOUT ON TTY 00463 STA- (ZERO),B 00464 SQP DMEC24 00465 JMP* BLKNXT 00466DMEC24 JMP+ 0 00467 EQU REVCMP(*-1) 00468DMECK2 RAO* SECNUM 00469DMEC23 RTJ CHKDCK CHECK FOR A DCK/ CONTROL CARD 00470 JMP* DMECK3 00471 LDA CPYID 00472 SAN DMEC21 HAS THE COPY ROUTINE BEEN ENTERED. 00473 JMP* (DMECHK) FOUND DCK/. EXIT THRU RETURN ADDRESS. 00474DMEC21 JMP* C23 YES. 00475DMECK3 RTJ CHKMRG CHECK FOR MRG/ CONTROL CARD 67*1495 00476 JMP* DMCK31 00477 LDA CPYID 00478 SAN C23 HAS THE COPY ROUTINE BEEN ENTERED. 00479 ENA 2 00480 JMP* DMEC41 00481DMCK31 RTJ CHKCPY CHECK FOR CPY/ CONTROL CARD 67*1495 00482ÐÐ JMP* DMECK4 00483 ENA 4 FOUND CPY/. EXIT RETURN ADDRESS+4. 00484 JMP* DMEC41 00485DMECK4 RTJ CHKEND CHECK FOR END/ CONTROL CARD 67*1495 00486 JMP* E01 00487 ENA 6 FOUND END/. EXIT RETURN ADDRESS+6. 00488DMEC41 ADD* DMECHK 00489 STA* DMECHK 00490 JMP* (DMECHK) 00491* 00492C23 ENA 23 ****COSY 23**** CPY/ CARD MUST BE 00493 JMP E09+1 FOLLOWED BY A CPY/ OR END/ CARD. 00494 EJT 00495* BLKREV SUBROUTINE 00496* 00497* FILLS REVBUF WITH BLANKS TO ALLOW SHORT TELETYPE RECORDS. 00498* 00499BLKREV 0 0 00500 ENQ 45 00501 LDA ENDCD 2 BLANKS. 00502BLKRV1 STA REVBUF,Q 00503 INQ -1 00504 SQM 1 00505 JMP* BLKRV1 00506 JMP* (BLKREV) 00507ÐÐ EJT 00508* MTSTAT SUBROUTINE 00509* 00510* CHECK STATUS OF UNIT IN TABLU. IF UNIT IS MAGNETIC TAPE, 00511* REWIND AND EXIT THROUGH THE RETURN ADDRESS. IF NOT MAG 00512* TAPE, EXIT THROUGH THE RETURN ADDRESS +1. 00513* ON ENTRY A CONTAINS THE ABSOLUTE ADDRESS COSY75 00514* OR COSY95. 00515* 00516MTSTAT 0 0 00517 STA* MTST2 00518 LDA* TABLU 00519 AND- LPMASK+11 00520 STA* MTST11 00521 STA* MTST34 00522 RTJ- (REQPRO) 00523* 00524* STATUS TABLU,,0,D 00525* 00526 VFD N1/0,N1/1,N5/3,N1/0,N4/0,N4/0 00527MTST11 VFD N4/0,N2/0,N10/0 00528MTST2 NUM 0 00529* 00530 LLS 5 00531 AND- LPMASK+3 00532ÐÐ INA -1 00533 SAN MTST4 NOT MAGNETIC TAPE UNIT. 00534 RTJ- (REQPRO) 00535* 00536* REWIND THE MAGNETIC TAPE. 00537* 00538 VFD N1/0,N1/1,N5/14,N1/0,N4/0,N4/1 00539 ADC MTST4+1 00540 NUM 0 00541MTST34 NUM 0 00542 VFD N1/0,N3/3,N12/0 00543* 00544 JMP- (DISP) 00545* 00546MTST4 RAO* MTSTAT 00547 JMP* (MTSTAT) 00548 EJT 00549* HEXDEC SUBROUTINE 00550* 00551* CONVERTS THE HEXIDECIMAL NUMBER IN A INTO TWO DECIMAL, 00552* ASCII CHARACTERS AND STORES THEM IN A. 00553* 00554HEXDEC 0 0 00555 ENQ 0 00556 DVI- TEN 00557ÐÐ INA $30 00558 INQ $30 00559 ALS 8 00560 AAQ A 00561 JMP* (HEXDEC) 00562 EJT 00563* WEOF SUBROUTINE 00564* 00565* WRITES AN END OF FILE MARK TO OUTPUT DEVICES. 00566* WHEN MAGNETIC TAPE, AN EOF IS WRITTEN. 00567* WHEN PAPER TAPE PUNCH, TRAILER IS OUTPUT. 00568* WHEN CARD PUNCH, AN EOF CARD IS PUNCHED. 00569* 00570WEOF NOP 0 00571 RTJ- (REQPRO) 00572* 00573* WRITE AN END OF FILE MARK TO OUPUT UNIT. 00574* 00575 VFD N1/0,N1/1,N5/14,N1/0,N4/0,N4/1 00576 ADC WEOF5 00577 NUM 0 00578TABLU NUM 0 00579 VFD N1/0,N3/2,N12/0 00580* 00581 JMP- (DISP) 00582ÐÐ* 00583WEOF5 JMP* (WEOF) 00584 EJT 00585* GETMN SUBROUTINE 00586* 00587* THIS SUBROUTINE PICKS UP THE VALUES OF M AND N FROM THE 00588* DEL/, INS/, OR REM/ CARD IN THE WORKING BUFFER AND UPDATES 00589* THE PARAMETER STRING. 00590* EXIT THRU THE RETURN ADDRESS IF COSY E05, E06, OR E07 IS 00591* DETECTED. IF NO ERRORS ARE FOUND, EXIT THRU THE RETURN 00592* ADDRESS +2. 00593* 00594GETMN 0 0 00595 LDQ WORKUN 00596 LDA- 1,Q SAVE THE CURRENT VALUES OF M AND N. 00597 STA- 3,Q 00598 LDA- 2,Q 00599 STA- 4,Q 00600 LDA- (ZERO),Q 00601 STA- I ADDRESS OF THE BUFFER. 00602 ENA 0 00603 STA* MNCCNT COMMA COUNTER 00604 STA* VAL1 00605GETMN1 LDA- 6,I 00606 ALS 8 00607ÐÐ RTJ* GETMN2 EXAMINE THE LEFT CHARACTER. 00608 LDA- 6,I 00609 RTJ* GETMN2 EXAMINE THE RIGHT CHARACTER. 00610 RAO- I INCREMENT TO THE NEXT WORD. 00611 JMP* GETMN1 00612* 00613************************** 00614* 00615GETMN2 0 0 00616 AND- LPMASK+8 00FF. MASK TO GET THE CHARACTER. 00617 SUB- ONEBIT+5 0020. ASCII BLANK. 00618 SAN 1 00619 JMP* GETMN5 FOUND A BLANK. END OF CARD INFORMATION. 00620 INA -$C 00621 SAN GETMN3 00622 LDA* MNCCNT FOUND A COMMA. TEST FOR TWO COMMAS. 00623 SAZ 1 00624 JMP* E05 MORE THAN ONE COMMA ON A DEL/, INS/, OR REM/. 00625* 00626 RAO* MNCCNT 00627 LDA* VAL1 00628 STA* VAL2 SAVE VALUE OF M. 00629 ENA 0 00630 STA* VAL1 00631 JMP* (GETMN2) 00632ÐÐ* 00633GETMN3 INA -4 00634 SAM E05 ILLEGAL CHARACTER IN M / N FIELD. 00635 INA -10 00636 SAP E05 00637* 00638GETMN4 INA 10 A CONTAINS THE NEW DIGIT (0 TO 9). 00639 STA* MNDIG SAVE DIGIT 00640 LDA* VAL1 00641 MUI- TEN 000A. CONVERT DECIMAL TO BINARY. 00642 ADD* MNDIG 00643 STA* VAL1 00644 JMP* (GETMN2) 00645* 00646************************** 00647* 00648GETMN5 LDA* MNCCNT COMMA COUNTER. 00649 SAN GETMN9 00650 LDA* VAL1 ONLY ONE VALUE SO SET VAL2 = VAL1. 00651 STA* VAL2 00652 SAN GETMN6 00653* 00654E05 ENA 5 M IS EQUAL TO ZERO. 00655 JMP* (GETMN) 00656* 00657ÐÐGETMN9 RTJ CHKINS FOUND VALUE FOR M AND N. CHECK FOR AN INS/. 00658 JMP* GETMN8 00659* 00660E07 ENA 7 VALUES FOR M AND N ON AN INS/ CARD. 00661 JMP* (GETMN) 00662* 00663GETMN8 LDA* VAL1 N. 00664 SUB* VAL2 M. 00665 SAM E06 N IS LESS THAN M. 00666GETMN6 LDA WORKUN ADDRESS OF WORKING PARAMETER STRING. 00667 STA- I 00668 LDA- 4,I 00669 SUB* VAL2 M. 00670 SAM GETMN7 00671* 00672E06 ENA 6 THE SEQUENCE NUMBERS ARE OUT OF ORDER. 00673 JMP* (GETMN) 00674* 00675GETMN7 LDA* VAL1 SET VALUES OF M AND N IN PARAMETER STRING. 00676 STA- 2,I 00677 LDA* VAL2 00678 STA- 1,I 00679 RAO* GETMN EXIT THROUGH THE RETURN ADDRESS +2. 00680 RAO* GETMN 00681 JMP* (GETMN) 00682ÐÐ* 00683************************** 00684* 00685MNCCNT BSS MNCCNT(1) TEMPORARY. M/N COMMA COUNTER. 00686VAL1 BSS VAL1(1) TEMPORARY STORAGE USED BY GETMN. 00687VAL2 BSS VAL2(1) TEMPORARY STORAGE USED BY GETMN. 00688MNDIG BSS MNDIG(1) TEMPORARY STORAGE USED BY GETMN. 00689 SPC 4 00690* PRINTR SUBROUTINE 00691* 00692* PRINTS THE REVISION CARD CONTAINED IN REVBUF. 00693* 00694PRINTR 0 0 00695 LDA* ASTKS 00696 LDQ* ERRMRK 00697 SQN 1 00698 LDA* BLNKS NO ERROR. 00699 STA* REVBUF-2 STORE BLANKS OR ASTERISKS IN PRINT BUFFER. 00700 STA* REVBUF-1 00701 LDA* LOUTRV IF THE LOGICAL UNIT EQUALS ZERO 00702 STA* PRNT11 SET THE LOGICAL UNIT. 00703 AND- LPMASK+10 00704 SAZ PRINT2 NO REVISION LIST IS PRODUCED. 00705 RTJ- (REQPRO) 00706* 00707ÐÐ* FWRITE LOUTRV,PRINT2,REVBUF,49,A,0,1,0,0,D 00708* 00709 VFD N1/0,N1/1,N5/6,N1/0,N4/0,N4/1 00710 ADC PRINT2 00711 NUM 0 00712PRNT11 VFD N3/0,N1/1,N2/0,N10/0 00713 NUM 49 00714 ADC REVBUF-3 00715* 00716 JMP- (DISP) 00717* 00718PRINT2 JMP* (PRINTR) 00719 EJT 00720* ERRPRO SUBROUTINE 00721* 00722* ENTER WITH THE HEXIDECIMAL ERROR CODE IN THE ACCUMULATOR. 00723* THE ROUTINE WILL CONVERT THE ERROR CODE TO DECIMAL, 00724* STORE IT IN THE MESSAGE, AND PRINT THE MESSAGE. 00725* 00726ERRPRO 0 0 00727 LDQ- I 00728 STQ* ERRMRK SET THE ERROR MARKER AND INCREMENT THE TOTAL 00729 RAO ERRCNT ERROR COUNT. 00730 RTJ* HEXDEC CONVERT THE ERROR CODE TO DECIMAL. 00731 STA* ERRMES+6 00732ÐÐ LDA* LOUTER 00733 STA* ERRP01 SET THE LOGICAL UNIT. 00734 RTJ- (REQPRO) 00735* 00736* FWRITE LOUTER,ERRPR1,ERRMES,9,A,0,1,0,0,D 00737* 00738 VFD N1/0,N1/1,N5/6,N1/0,N4/0,N4/1 00739 ADC ERRPR1 00740 NUM 0 00741ERRP01 VFD N3/0,N1/1,N2/0,N10/0 00742 NUM 9 00743 ADC ERRMES 00744* 00745 JMP- (DISP) 00746* 00747ERRPR1 LDA* ERRMRK 00748 STA- I RESET I. 00749 JMP* (ERRPRO) 00750* 00751ERRMES ALF 9, ****COSY C00**** 00752* 00753************************** 00754* 00755ERRMRK NUM 0 ERROR MARKER. 00756ASTKS ALF 1,** 00757ÐÐBLNKS ALF 1, 00758LOUTER NUM 0 ERROR MESSAGE LOGICAL UNIT. 00759LOUTRV NUM 0 REVISION OUTPUT LOGICAL UNIT. 00760 EJT 00761TABLE BZS TABLE(8) OUTPUT UNIT TABLE. 00762 ALF 3, 00763REVBUF BSS REVBUF(46) REVISIONS CARD BUFFER. CALLED REVBUF IN 00764BUF1 EQU BUF1(REVBUF) UPDATE AND BUF1 IN MERGE PORTIONS OF COSY. 00765 EJT 00766* UPDATE INITIALIZATION ROUTINE 00767* 00768UPDATE RTJ* UPD00 00769 ADC ADREVB-UPDATE-1 ADRINP 00770 ADC INPLU-ADREVB ADINLU 00771 ADC HOUT-INPLU ADHOUT 00772 ADC COUT-HOUT ADCOUT 00773 ADC LOUT-COUT ADLOUT 00774 ADC ADHOLB-LOUT ADINPT 00775 ADC HOLBUF-ADHOLB ADHOLB 00776 ADC INPBUF-HOLBUF ADINPB 00777 ADC CSYBUF-INPBUF ADCSYB 00778UPD00 0 0 00779 LDA* UPD00 FORM ALL ABSOLUTE ADDRESSES. 00780 ADD* UPDATE+1 00781 STA ADRINP 00782ÐÐ ADD* UPDATE+2 00783 STA ADINLU 00784 ADD* UPDATE+3 00785 STA ADHOUT 00786 ADD* UPDATE+4 00787 STA ADCOUT 00788 ADD* UPDATE+5 00789 STA ADLOUT 00790 ADD* UPDATE+6 00791 STA ADINPT 00792 ADD* UPDATE+7 00793 STA ADHOLB 00794 ADD* UPDATE+8 00795 STA ADINPB 00796 ADD* UPDATE+9 00797 STA ADCSYB 00798 LDA REVLUN INITIALIZE POINTERS, L/R MARKERS, ETC. 00799 STA REVLU 00800 LDA ADDRES 00801 STA ADREVB 00802 LDA SECNUM 00803 STA SECTOR 00804UPD005 ENA 46 00805 STA BUFSIZ 00806 LDA ADCSYB 00807ÐÐ STA CSYPTR 00808 LDA LRSET 00809 STA CSYLR 00810 STA REVLR 00811 ENA 0 00812 STA* ERRMRK 00813 STA NEWID 00814 STA DECK1 00815 STA ENDDCK 00816 STA HOUT 00817 STA COUT 00818 STA LOUT 00819 STA* M 00820 STA* N 00821 STA INPLU 00822 STA* DCKNAM 00823 LDA* ADREVB 00824 STA- I ADDRESS OF THE REVISIONS BUFFER. 00825 LDA (CSTDPT) RESET REVISION LOGICAL UNIT 00826 EOR- MODBIT TO PROCESS NEXT CONTROL CARD. 00827 STA LOUTRV 00828 EJT 00829* DCK/ CARD PROCESSOR 00830* 00831* THIS ROUTINE PROCESSES THE DCK/ CARD FOUND IN REVBUF. 00832ÐÐ* 00833PRODCK RTJ GETCHR GET A CHARACTER FROM REVBUF. 00834 INA -$49 00835 SAN PRD01 00836 LDQ* ADINLU FOUND AN I. INITIAL UNIT WILL BE STANDARD 00837 LDA (CSTDIN) COSY INPUT. 00838 JMP* PRD03+2 00839PRD01 INA 1 00840 SAN PRD02 00841 LDQ* ADHOUT FOUND AN H. 00842 JMP* PRD03 00843PRD02 INA -4 00844 SAN PRD025 00845 LDQ* ADLOUT FOUND AN L. 00846 LDA (CSTDPT) 00847 JMP* PRD03+2 00848PRD025 INA 9 00849 SAZ 2 00850 JMP PRD17 00851 LDQ* ADCOUT FOUND A C. 00852PRD03 LDA (CSTDOT) INITIAL UNIT WILL BE COSY STD OUTP 00853 STA* LOGUN 00854 STQ* ADRLU ADDRESS OF LOGICAL UNIT FOR THE PARAMETER. 00855 LDA* (ADRLU) 00856 SAZ PRD04 00857ÐÐ* 00858E15A ENA 15 ****COSY E15**** PARAMETER HAS BEEN USED. 00859 RTJ ERRPRO 00860 ENA 0 00861 STA* (ADRLU) CLEAR THE PARAMETER AND THE ERROR MARKER. 00862 STA ERRMRK 00863* 00864PRD04 RTJ GETCHR GET A CHARACTER FROM REVBUF. 00865 INA -$3D 00866 SAN PRD05 00867 JMP PRD14 FOUND AN EQUAL SIGN. 00868PRD05 LDA* REVCHR 00869 INA -$2C 00870 SAN PRD06 00871 LDA* LOGUN FOUND A COMMA. 00872 SAZ 1 DO NOT SET MODE BIT IF UNIT N/ASGND 00873 EOR- MODBIT SET ASCII MODE BIT ON TABLE LUNS. 00874 STA* (ADRLU) SET THE LOGICAL UNIT NUMBER FOR THE PARAMETER. 00875 JMP* PRODCK 00876PRD06 INA $C 00877 SAZ 2 00878 JMP E14 ILLEGAL CHARACTER. 00879 LDA* LOGUN FOUND A BLANK. SET THE LOGICAL UNIT NUMBER 00880 SAZ 1 DO NOT SET MODE BIT IF UNIT N/ASGND 00881 EOR- MODBIT SET ASCII MODE BIT ON TABLE LUNS. 00882ÐÐ STA* (ADRLU) FOR THE PARAMETER. 00883PRD07 LDA HOUT 00884 SAZ PRD072 NO H OUTPUT REQUESTED. 00885 SUB COUT 00886 SAN PRD071 00887 LDQ* ADCOUT GET ADDRESS OF COUT. 00888 RTJ* E16 00889PRD071 LDA HOUT 00890 SUB LOUT 00891 SAN PRD072 00892 LDQ* ADLOUT 00893 RTJ* E16 00894PRD072 LDA COUT 00895 SAZ PRD073 NO C OUTPUT REQUESTED. 00896 SUB LOUT 00897 SAN PRD073 00898* 00899E21 ENA 21 ****COSY E21**** C AND L OUTPUT 00900 RTJ ERRPRO ON THE SAME UNIT. 00901 ENA 0 00902 STA ERRMRK CLEAR THE ERROR MARKER AND CANCEL 00903 STA LOUT THE REQUEST FOR LIST OUTPUT. 00904PRD073 JMP* PRD075 00905* 00906 EJT 00907ÐÐ************************** 00908ADRINP ADC ADREVB ABSOLUTE ADDRESS OF ADREVB. 00909ADREVB ADC REVBUF ABSOLUTE ADDRESS OF REVBUF. 00910M NUM 0 CURRENT VALUE OF M. 00911N NUM 0 CURRENT VALUE OF N. 00912LASTM NUM 0 LAST VALUE OF M. 00913LASTN NUM 0 LAST VALUE OF N. 00914ADRLU NUM 0 TEMPORARY. ADDRESS OF INPLU, HOUT, 00915* COUT OR LOUT. 00916ADINLU ADC INPLU ABSOLUTE ADDRESS OF INPLU. 00917ADCOUT ADC COUT ABSOLUTE ADDRESS OF COUT. 00918ADHOUT ADC HOUT ABSOLUTE ADDRESS OF HOUT. 00919ADLOUT ADC LOUT ABSOLUTE ADDRESS OF LOUT. 00920LOGUN NUM 0 TEMPORARY. LOGICAL UNIT NUMBER. 00921DCKNAM NUM 0 DECKNAME OF THE DECK BEING OUTPUT. 00922 NUM 0 00923 NUM 0 00924 EJT 00925E16 NOP 0 00926 STQ* EQULUN SET ADDRESS OF LUN TO BE CLEARED. 00927 ENA 16 ****COSY E16**** C AND H OUTPUT 00928 RTJ ERRPRO ON THE SAME UNIT. 00929 ENA 0 00930 STA ERRMRK CLEAR THE ERROR MARKER AND CANCEL THE REQUEST 00931 STA* (EQULUN) 00932ÐÐ JMP* (E16) 00933* 00934EQULUN NUM 0 00935* 00936PRD075 LDA* DCKNAM 00937 SAN PRD08 00938 LDA REVBUF THE D PARAMETER WAS NOT USED. SAVE THE 00939 STA* DCKNAM DECKNAME. 00940 LDA REVBUF+1 00941 STA* DCKNAM+1 00942 LDA REVBUF+2 00943 STA* DCKNAM+2 00944PRD08 LDA* INPLU 00945 SAN PRD081 00946 LDA (CSTDIN) THE I PARAMETER WAS NOT USED. 00947 EOR- MODBIT SET ASCII MODE BIT ON INPUT LUN 00948PRD081 STA* INPLU 00949 RTJ SEARCH SEARCH OUTPUT TABLE FOR INPUT UNIT. 00950 JMP* E17 UNIT IS IN THE TABLE. 00951 NOP 0 FOUND AN EMPTY SLOT. 00952 LDA HOUT TABLE WAS FULL. 00953 SAN 1 00954 JMP* PRD11 00955 SUB REVLU 00956 SAZ E20A REQUESTED H OUTPUT ON REVISIONS UNIT. 00957ÐÐ LDA HOUT 00958 SUB* INPLU 00959 SAN PRD085 00960E20A STA HOUT REQUESTED H OUTPUT ON INPUT UNIT. 00961 ENA 20 00962 RTJ ERRPRO ****COSY E20**** OUTPUTTING ON AN INPUT UNIT. 00963 ENA 0 00964 STA ERRMRK 00965 JMP* PRD11 00966PRD085 LDA HOUT 00967 RTJ* SEARCH SEARCH OUTPUT TABLE FOR HOLLERITH OUTPUT UNIT. 00968 JMP* PRD09 FOUND UNIT IN TABLE. 00969 JMP* PRD10 FOUND EMPTY SLOT. 00970* 00971E19A STA HOUT TABLE WAS FULL. CLEAR H OUTPUT 00972 ENA 19 ****COSY E19**** OUTPUT TABLE FULL. 00973 JMP* E19C 00974* 00975************************** 00976* 00977REVLR NUM $5555 REVISIONS BUFFER L/R MARKER. 00978LUDIG NUM 0 TEMPORARY. 00979INPLU NUM 0 LOGICAL UNIT NUMBER. 00980REVCHR NUM 0 TEMPORARY. CHARACTER WORKING ON 00981* FROM BUFFER. 00982ÐÐ EJT 00983E17 ENA 17 ****COSY E17**** INPUT UNIT ALREADY USED AS 00984 JMP E1014 AN OUTPUT UNIT. 00985* 00986PRD09 SAP PRD11 00987* 00988E18A ENA 0 UNIT PREVIOUSLY USED FOR C OUTPUT. CLEAR 00989 STA HOUT H OUTPUT. 00990 ENA 18 ****COSY E18**** ATTEMPTED TO USE UNIT FOR 00991E19C RTJ ERRPRO BOTH C AND H OUTPUT. 00992 ENA 0 00993 STA ERRMRK CLEAR THE ERROR MARKER. 00994 JMP* PRD11 00995* 00996PRD10 STA- (ZERO),Q STORE LOGICAL UNIT IN OUTPUT TABLE. 00997PRD11 LDA* LOUT 00998 SAN PRD11A 00999 JMP* PRD115 01000PRD11A SUB REVLU 01001 SAN 1 01002 JMP* E20B REQUESTED L OUTPUT ON 01003* REVISIONS UNIT. 01004 LDA* LOUT 01005 SUB* INPLU 01006 SAN PRD110 01007ÐÐE20B STA* LOUT REQUESTED L OUTPUT ON INPUT UNIT. 01008 ENA 20 01009 RTJ ERRPRO ****COSY E20**** OUTPUTTING ON AN 01010 ENA 0 INPUT UNIT. 01011 STA ERRMRK 01012 JMP* PRD115 01013PRD110 LDA* LOUT 01014 RTJ* SEARCH SEARCH TABLE FOR COSY OUTPUT UNIT. 01015 JMP* PRD111 FOUND UNIT IN TABLE. 01016 JMP* PRD113 FOUND AN EMPTY SLOT. 01017E19B STA* LOUT TABLE WAS FULL. CLEAR L OUTPUT. 01018 ENA 19 ****COSY E19**** OUTPUT TABLE FULL. 01019 JMP* E19E 01020PRD111 SAP PRD115 01021* 01022E18B ENA 0 UNIT PREVIOUSLY USED FOR C OUTPUT. 01023 STA* LOUT CLEAR L OUTPUT UNIT. 01024 ENA 18 ****COSY E18**** ATTEMPT TO USE 01025E19E RTJ ERRPRO UNIT FOR L AND C OUTPUT. 01026 ENA 0 01027 STA ERRMRK CLEAR ERROR MARKER. 01028 JMP* PRD115 01029PRD113 STA- (ZERO),Q STORE LOGICAL UNIT IN OUTPUT TABLE. 01030 STA LOUTER SET ERROR MESSAGE LOGICAL UNIT. 01031PRD115 LDA* COUT 01032ÐÐ SAN 2 01033 JMP PRD22+1 01034 SUB REVLU 01035 SAZ E20C REQUESTED C OUTPUT ON REVISION UNIT 01036 LDA* COUT 01037 SUB* INPLU 01038 SAN PRD116 01039E20C STA* COUT REQUESTED C OUTPUT ON INPUT UNIT. 01040 ENA 20 01041 RTJ ERRPRO ****COSY E20**** OUTPUTTING ON AN INPUT UNIT. 01042 ENA 0 01043 STA ERRMRK 01044 JMP PRD22+1 01045PRD116 LDA* COUT 01046 RTJ* SEARCH SEARCH OUTPUT TABLE FOR THE COSY OUTPUT UNIT. 01047 JMP* DMJMP1 01048 JMP* DMJMP2 01049* 01050 STA* COUT TABLE WAS FULL. CLEAR C OUTPUT. 01051 ENA 19 ****COSY E19**** OUTPUT TABLE FULL. 01052 JMP E19D 01053 EJT 01054* GETCHR AND SEARCH SUBROUTINES 01055* (USED BY DCK/ CARD PROCESSOR) 01056* 01057ÐÐGETCHR 0 0 01058 STQ* GETCH2 01059 LDA- 6,I GET A WORD FROM REVBUF. 01060 LDQ* REVLR SWITCH REVISIONS BUFFER L/R MARKER. 01061 QLS 1 01062 STQ* REVLR 01063 SQM GETCH1 01064 RAO- I WAS RIGHT CHARACTER. INCREMENT TO NEXT WORD. 01065 JMP* GETCH1+1 01066GETCH1 ALS 8 SHIFT TO GET THE LEFT CHARACTER. 01067 AND- LPMASK+8 01068 STA* REVCHR SAVE THE CHARACTER. 01069 LDQ* GETCH2 01070 JMP* (GETCHR) 01071* 01072GETCH2 NUM 0 01073 SPC 4 01074SEARCH 0 0 01075 STA* LUDIG LOGICAL UNIT NUMBER BEING SEARCHED FOR. 01076 LDQ TABADR 01077SRCH1 LDA- (ZERO),Q GET TABLE ENTRY. 01078 SAN SRCH2 01079SRCH15 LDA* LUDIG FOUND A BLANK - EMPTY SLOT. 01080 RAO* SEARCH EXIT TO RETURN ADDRESS +1. 01081 JMP* (SEARCH) 01082ÐÐSRCH2 AND- LPMASK+15 =7FFF 01083 SUB* LUDIG 01084 SAN SRCH3 01085 LDA- (ZERO),Q FOUND THE UNIT IN THE TABLE. 01086 JMP* (SEARCH) EXIT THRU THE RETURN ADDRESS. 01087SRCH3 INQ 1 INCREMENT TO THE NEXT ENTRY. 01088 TRQ A 01089 SUB TABADR 01090 SUB TABSIZ 01091 SAZ 1 END OF TABLE. 01092 JMP* SRCH1 01093 RAO* SEARCH EXIT TO RETURN ADDRESS +2. 01094 JMP* SRCH15 01095* 01096************************** 01097* 01098HOUT NUM 0 UNIT TO RECEIVE HOLLERITH OUTPUT. 01099COUT NUM 0 UNIT TO RECEIVE COSY OUTPUT. 01100LOUT NUM 0 UNIT TO RECEIVE LIST OUTPUT. 01101 SPC 5 01102CSYLUN NOP 0 01103 STA* CLUN SET LOGICAL UNIT TO STATUS 01104 RTJ- (REQPRO) REQUEST STATUS 01105* 01106* STATUS (A),0,0,D 01107ÐÐ* 01108 VFD N1/0,N1/1,N5/3,N1/0,N8/0 01109CLUN NUM 0 01110 NUM 0 01111 LLS 5 01112 AND- LPMASK+3 SAVE UPPER 4 OF WORD8 OF PHYSTB 01113 INA -1 01114 SAZ CLUN2 SKIP IF MAG TAPE 01115 INA -2 01116 SAZ CLUN1 SKIP IF CARD PUNCH 01117 INA -1 01118 SAZ CLUN2 SKIP IF PAPER TAPE 01119CLUN1 ENA 1 SET BUFFER INDEX TO 46 WORDS 01120CLUN2 TRA Q 01121 JMP* (CSYLUN) 01122 SPC 2 01123CKDEV NOP 0 01124 STA* CKDEV1 SET LOGICAL UNIT FOR STATUS REQ. 01125 SPC 1 01126 RTJ- (REQPRO) 01127* 01128* STATUS (A),0,0,D 01129* 01130 VFD N1/0,N1/1,N5/3,N1/0,N8/0 01131CKDEV1 NUM 0 01132ÐÐ NUM 0 01133 LLS 5 01134 AND- LPMASK+3 01135 INA -2 CHECK FOR MASS STORAGE DEVICE. 01136 SAZ CKDEV2 P+1 RETURN FOR MASS STORAGE. 01137 RAO* CKDEV P+2 RETURN FOR NON MASS STORAGE. 01138CKDEV2 JMP* (CKDEV) 01139 SPC 4 01140* 01141******** 01142* 01143DMJMP1 JMP* PRD20 MUST USE TO AVOID TWO WORD JUMPS **MSOS4,0** 01144DMJMP2 JMP* PRD21 FOLLOWING RETURN FROM SEARCH. 01145 EJT 01146PRD14 RTJ* GETCHR GET A CHARACTER FROM THE REVISIONS BUFFER. 01147 INA -$30 01148 SAM E14 CHARACTER IS NOT NUMERIC 01149 INA -10 01150 SAM PRD15 01151* 01152E14 ENA 14 ****COSY E14**** ILLEGAL PARAMETER ON 01153 JMP E1014 DCK/ CARD. 01154* 01155PRD15 INA 10 CHARACTER IS NUMERIC (0 - 9). 01156 STA LOGUN 01157ÐÐ RTJ* GETCHR GET A CHARACTER FROM THE REVISIONS BUFFER. 01158 INA -$30 01159 SAM PRD16 NON-NUMERIC CHARACTER. 01160 INA -10 01161 SAP PRD16 NON NUMERIC. 01162 STA LUDIG 01163 LDA LOGUN 01164 MUI- TEN 01165 ADD LUDIG 01166 JMP* PRD15 01167PRD16 JMP PRD05 01168PRD17 INA -1 01169 SAZ 1 01170 JMP* E14 CHARACTER WAS NOT AN I, C, H, OR D. 01171 LDA DCKNAM FOUND A D. 01172 SAZ PRD18 01173* 01174E15B ENA 15 ****COSY E15**** PARAMETER HAS BEEN USED. 01175 RTJ ERRPRO 01176 ENA 0 01177 STA ERRMRK CLEAR THE ERROR MARKER. 01178* 01179PRD18 RTJ* GETCHR GET A CHARACTER FROM THE REVISIONS BUFFER. 01180 INA -$3D 01181 SAZ 1 01182ÐÐ JMP* E14 CHARACTER WAS NOT AN EQUAL SIGN. 01183 ENQ 0 01184PRD19 RTJ* GETCHR STORE SIX CHARACTERS FOLLOWING THE = INTO 01185 ALS 8 THE NEW DECKNAME. 01186 STA DCKNAM,Q 01187 RTJ* GETCHR 01188 ADD DCKNAM,Q 01189 STA DCKNAM,Q 01190 INQ -2 01191 SQP 2 01192 INQ 3 01193 JMP* PRD19 01194 RTJ GETCHR GET CHAR. FROM REVISIONS BUFFER. 01195 INA -$20 01196 SAN 1 01197 JMP PRD07 FOUND A BLANK. 01198 INA -$C 01199 SAZ 1 FOUND A COMMA 01200 JMP* E14 THE CHARACTER WAS NOT A COMMA OR A BLANK. 01201 JMP PRODCK 01202* 01203PRD20 SAM PRD22 01204* 01205E18C ENA 0 UNIT PREVIOUSLY USED FOR H OUTPUT. 01206 STA* COUT CLEAR C OUTPUT. 01207ÐÐ ENA 18 ****COSY E18**** ATTEMPTED TO USE UNIT FOR 01208E19D RTJ ERRPRO BOTH C AND H OUTPUT. 01209 ENA 0 01210 STA ERRMRK CLEAR THE ERROR MARKER. 01211 JMP* PRD22 01212* 01213PRD21 ADD- ONEBIT+15 STORE UNIT IN LU TABLE. P15 = 1 TO INDICATE 01214 STA- (ZERO),Q C OUTPUT. 01215* 01216PRD22 LDA* COUT 01217 STA COUTLU 01218 SAN 1 01219 JMP* PRD221 DO NOT STATUS IF ZERO. 01220 AND- CLRMOD CLEAR MODE BIT BEFORE CHECK. 01221 RTJ* CSYLUN CHECK FOR COSY OUTPUT DEVICE TYPE. 01222 STQ CBFIDX FLAG LAST WRITE BUFFER SIZE. 01223 LDA COUT SET THE MODE BIT TO ASCII FOR 01224 EOR MODTAB,Q TAPE, BINARY FOR CARDS. 01225 STA PAK085 SET INTO THE REQUESTS. 01226 STA CLER15 01227 STA NEWD35 01228 STA CPY057 01229 ENA 0 01230PRD221 STA FSTRD 01231 STA CSHOMK 01232ÐÐ STA DECK1 01233 LDQ LOUT CLEAR THE LOGICAL UNIT USED FOR 01234 SQZ UPD01 REVISIONS WHEN USING THE LIST 01235 STA LOUTRV OPTION. 01236 EJT 01237* START OF UPDATE 01238* 01239UPD01 LDA INPLU 01240 AND- CLRMOD CLEAR MODE BIT BEFORE CHECK. 01241 RTJ CSYLUN CHECK COSY INPUT DEVICE TYPE. 01242 LDA INPLU SET THE MODE BIT TO ASCII FOR 01243 EOR MODTAB,Q TAPE, BINARY FOR CARDS. 01244 STA RDI065 SET INTO REQUEST. 01245 STA RDI015 01246 LDA CPYID 01247 SAZ 2 CPY/ CARD BEING PROCESSED. 01248 JMP CPY005 YES. 01249UPD02 LDA INPLU COSY INPUT LUN 01250 AND- CLRMOD CLEAR MODE BIT BEFORE CHECK. 01251 SUB- STDINP IS THE COSY LIBRARY ON STDINP. 01252 SAN 2 SKIP IF NOT ON STDINP. 01253 JMP UPD13 INPUT FROM THE STANDARD INPUT UNIT. 01254UPD021 RTJ CSYHOL READ I AND CHECK FOR CSY/ OR HOL/. 01255 JMP* UPD085 NOT CSY/ OR HOL/. 01256UPD03 RAO FSTRD 01257ÐÐ RTJ CHKNAM DO DECKNAMES MATCH. 01258 JMP* *+2 01259 JMP* UPD021 NO. 01260 RTJ NEWDCK PROCESS THE DCK/ CARD. 01261 RTJ REVPRO PROCESS REVISIONS. 01262 JMP* UPD07 01263* 01264E12 ENA 12 ****COSY E12**** A DCK/ CARD WAS NOT 01265 RTJ ERRPRO FOLLOWED BY A CONTROL CARD. 01266 RTJ REVPRO PROCESS REVISIONS UNTIL FIND A CONTROL CARD. 01267* NOTE - SINCE ERRMRK IS SET, THERE IS NO - 01268* NOT A CONTROL CARD - RETURN. 01269UPD07 RTJ GETMN 01270 JMP E0765 GETMN ERROR RETURN. 01271UPD08 RTJ READI READ FROM THE INPUT UNIT. 01272 LDA ENDDCK 01273 SAN 1 01274 JMP* UPD09 01275* 01276E13 ENA 13 ****COSY E13**** FOUND END OF INPUT DECK 01277 RTJ ERRPRO BEFORE END OF REVISIONS. 01278 LDA COUT 01279 SAZ E13A SKIP IF COSY OUTPUT NOT SELECTED 01280 RTJ CLEARI CLEAR THE COSY OUTPUT BUFFER 01281E13A EQU E13A(*) 01282ÐÐ LDA SEQNUM 01283 INA -1 01284 SUB M 01285 SAP E13B WAS M SEQUENCE NUMBER WITHIN BOUNDS 01286 JMP* ERRS 01287E13B EQU E13B(*) 01288 ENA 0 YES. DELETE FROM M TO END OF INPUT DECK. 01289 STA ERRMRK 01290 JMP* UPD12 01291* 01292UPD085 LDA FSTRD 01293 SAZ 1 01294 JMP* UPD021 01295 JMP E09 01296* 01297UPD09 LDA SEQNUM 01298 SUB M 01299 SAP UPD10 INPUT SEQ NUMBER G.E. REVISIONS SEQ NUMBER. 01300 RTJ WRITEI OUTPUT HOLBUF. 01301 JMP* UPD08 01302* 01303UPD10 LDA ADRINP 01304 STA WORKUN 01305 RTJ CHKDEL CHECK THE REVISIONS BUFFER FOR A DEL/ CARD. 01306 JMP* UPD11 01307ÐÐ LDA SEQNUM FOUND DEL/. GO TO UPD08 UNTIL INPUT SEQUENCE 01308 SUB N NUMBER EQUALS SECOND REVISIONS SEQENCE NO. 01309 SAZ UPD12 01310 JMP* UPD08 01311UPD11 RTJ WRITEI OUTPUT HOLBUF. 01312UPD12 STA PRGID 01313 ENQ 0 01314 LDA REVBUF+32 SAVE PROGRAMMER INFORMATION. 01315 AND- NZERO-8 CLEAR OFF COMMENT CHARACTER. 01316 INA -$20 01317 SAN UPD112 FIRST CHARACTER OF PROG INFO. BLNK. 01318 LDA* UPD12A+1 YES. 01319 JMP* UPD122 01320UPD112 LDA REVBUF+32 NO. 01321 AND- NZERO-8 01322 ADD- $30 $2000 01323 ENQ 0 USE Q AS AN INDEX. 01324 JMP* UPD122 01325UPD121 LDA REVBUF+32,Q 01326UPD122 STA PRGINF,Q 01327UPD12A SUB =N$2020 CHECK IF PROGRAMMER AREA IS BLANK. **MSOS4.0* 01328 SAZ UPD123 01329 RAO PRGID 01330UPD123 INQ -3 01331 SQZ UPD124 EXIT WHEN COMPLETE. 01332ÐÐ INQ 4 01333 JMP* UPD121 CONTINUE MOVING INFORMATION. 01334UPD124 LDA PRGID 01335 SAZ UPD12B 01336 LDA PRGINF 01337 ADD =N$0A00 01338 STA PRGINF 01339UPD12B RTJ PRINTR 01340UPD125 RTJ REVPRO READ FROM R UNIT. 01341 JMP* UPD127 FOUND DEL/, INS/, OR REM/. 01342 RTJ PRINTR NOT A CONTROL CARD. 01343 RTJ WRITER OUTPUT REVBUF. 01344 JMP* UPD125 01345* 01346UPD127 ENA 0 CLEAR PROGRAMMER INFORMATION MARK. 01347 STA* PRGID 01348 LDA ENDDCK 01349 SAN 1 01350 JMP* UPD07 01351 LDA- LPMASK+15 01352 STA M SET M TO MAX VALUE 01353 JMP* E13 END OF INPUT DECK. 01354* 01355E1014 RTJ ERRPRO PRINTS COSY E10, E14, AND E17. 01356ERRS RTJ PRINTR PRINTS BAD CARD. 01357ÐÐ RAO E01MRK PROHIBIT E01. 01358 RTJ DMECHK READ CARD AND CHECK FOR DCK/, MRG/, OR END/. 01359 JMP UPD005 DCK/. START A NEW UPDATE. 01360E04A ENA 4 ****COSY E04**** MRG/ CARD WITHIN A REVISIONS 01361 JMP* E09+1 DECK. 01362 NOP 0 POSITION END/ RETURN FROM DMECHK. 01363 NOP 0 01364 JMP COSY5 END/. END OF COSY. 01365UPD13 RTJ* CSYHOL CHECK FOR A CSY/ OR HOL/ CARD. 01366 JMP* UPD15 01367 LDA* REVLU FOUND CSY/ OR HOL/. 01368 AND- CLRMOD CLEAR THE ASCII MODE BIT. 01369 SUB- STDSCR 01370 SAN 2 REVISIONS ON STDINP. MUST BE 01371 JMP UPD03 NEW DECK. 01372 RTJ CHKNAM DO DECKNAMES MATCH. 01373 JMP* UPD14 YES 01374* 01375E11 ENA 11 ****COSY E11**** ADDING A NEW DECK AND THE 01376 JMP* E09+1 DECKNAMES DO NOT MATCH. 01377* 01378UPD14 RTJ NEWDCK PROCESS THE DCK/ CARD. 01379 RTJ GETEND PROCESS UNTIL THE END OF THE INPUT DECK. 01380 JMP COSY2 01381* 01382ÐÐUPD15 LDA* REVLU 01383 SUB INPLU 01384 SAZ UPD155 REVISIONS ARE ON COSY STD INPUT. 01385* 01386 JMP* UPD13+2 01387* 01388UPD155 LDA ADINPT SET WORKING UNIT TO HOLBUF. 01389 STA WORKUN 01390 ENA 1 01391 STA* UPD165 INITIALIZE MASS STORAGE SECTOR NUMBERS. 01392 STA SECTOR 01393 STA SECNUM 01394 RTJ- (REQPRO) OUTPUT REVISIONS ON MASS STORAGE SCRATCH. 01395* 01396* FWRITE STDSCR,UPD17,HOLBUF,46,A,0,1,0,0,D 01397* 01398UPD16 VFD N1/0,N1/1,N5/6,N1/0,N4/0,N4/1 01399 ADC UPD17 01400 NUM 0 01401UPD175 VFD N3/0,N1/1,N2/0,N10/0 01402 NUM 46 01403 ADC HOLBUF 01404 NUM 0 01405UPD165 NUM 1 SECTOR NUMBER. 01406* 01407ÐÐ JMP- (DISP) 01408* 01409UPD17 RTJ CHKEND CHECK FOR AN END/ CARD IN HOLBUF. 01410 JMP* UPD18 01411 LDA- STDSCR FOUND END/. SET REVISIONS UNIT TO MASS 01412 EOR- MODBIT SET ASCII MODE. 01413 STA REVLUN 01414 STA* REVLU STORAGE SCRATCH. 01415 RTJ* CSYHOL READ I AND CHECK FOR CSY/ OR HOL/. 01416 JMP* E09 NOT CSY/ OR HOL/. 01417 JMP UPD03 01418* 01419UPD18 RTJ READI READ REVISION INTO HOLBUF. 01420 RAO* UPD165 INCREMENT SECTOR NUMBER. 01421 JMP* UPD16-1 01422* 01423E0765 RTJ ERRPRO ****COSY E05, E06, OR E07****. 01424 LDA LASTM 01425 STA M RESET M AND N. 01426 LDA LASTN 01427 STA N 01428E07655 RTJ PRINTR 01429 RTJ REVPRO READ REVISIONS UNTIL GET A CONTROL CARD. 01430 JMP UPD07 FOUND DEL/ OR INS/. 01431 JMP* E07655 NOT A CONTROL CARD. 01432ÐÐ* 01433E09 ENA 9 ****COSY E09**** NOT A CSY/ OR HOL/ CARD. 01434 RTJ ERRPRO 01435 RTJ PRINTR 01436 JMP COSY6 01437* 01438************************** 01439* 01440REVLU NUM 0 UNIT THAT REVISION CARDS ARE READ FROM. 01441FSTRD NUM 0 FIRST READ ON INPUT LIBRARY MARKER. 01442 SPC 2 01443* 01444PRGID NUM 0 PROGRAMMER ID USED FOR DEL/ 01445* AND INS/ CARDS. 01446 EJT 01447* CSYHOL SUBROUTINE 01448* 01449* READ A 46 WORD RECORD FROM THE INPUT UNIT AND CHECK FOR A 01450* CSY/, HOL/, OR END/ CONTROL CARD. 01451* IF A CSY/ CARD IS FOUND, SET THE INPUT BUFFER SIZE TO 1536 01452* WORDS AND EXIT THRU THE RETURN ADDRESS +1. 01453* IF A HOL/ CARD IS FOUND, SET THE INPUT BUFFER SIZE TO 46 01454* WORDS AND EXIT THRU THE RETURN ADDRESS +1. 01455* IF AN END/ CARD IS FOUND, REWIND THE INPUT UNIT AND READ. 01456* IF THE CARD IS NOT A CSY/, HOL/, OR END/ CARD, EXIT THRU 01457ÐÐ* THE RETURN ADDRESS. 01458* 01459CSYHOL 0 0 01460 ENA 46 01461 STA BUFSIZ 01462 LDA* ADINPT 01463 STA WORKUN 01464CSH00 RTJ READI READ 46 WORDS FROM THE INPUT UNIT INTO HOLBUF. 01465 RTJ CHKCSY CHECK HOLBUF FOR A CSY/ CONTROL CARD. 01466 JMP* CSH01 01467 ENA 0 ZERO INTERNAL COSY INPUT SEQUENCE COUNTER. 01468 STA SEQINP 01469 ENA -1 FOUND A CSY/ CONTROL CARD. 01470 STA SLEWMK SET SLEW MARKER TO SLEW COSY LIBRARY*MSOS4.0** 01471 JMP* CSH02 01472CSH01 RTJ CHKHOL CHECK HOLBUF FOR A HOL/ CONTROL CARD. 01473 JMP* CSH04 01474 ENA 1 FOUND A HOL/ CONTROL CARD. 01475 STA SLEWMK SET SLEW MARKER NOT TO SLEW CARDS. 01476CSH02 STA* CSHOMK SET MARKER. + = HOL/. - = CSY/. 01477 ENA 0 01478 STA* SEQNUM CLEAR SEQUENCE NUMBER. 01479 LDA* CSHOMK 01480 SAP CSH03 HOLLERITH LIBRARY. 01481 LDA* SIZBUF 01482ÐÐ STA BUFSIZ SET BUFFER SIZE TO 1536 WORDS. RPG 01483 ADD ADINPB 01484 STA INPPTR SET INPUT BUFFER POINTER TO END OF BUFFER. 01485CSH03 RAO* CSYHOL 01486 JMP* (CSYHOL) EXIT TO RETURN ADDRESS +1. 01487CSH04 LDA* CSHOMK 01488 SAZ 1 0 = FIRST TIME. 01489 JMP* CSH08 01490 RTJ CHKEND CHECK HOLBUF FOR AN END/ CONTROL CARD. 01491 JMP* (CSYHOL) NOT CSY/ HOL/ OR END/. 01492CSH05 LDA INPLU 01493 STA TABLU SET LOGICAL UNIT. 01494 SUB* REVLU 01495 SAN 1 IGNORE THE END/. IT INDICATES THE END OF 01496 JMP* (CSYHOL) THE REVISIONS DECK. 01497 LDA* CSHRET SET CSYHOL COMPLETION ADDRESS. 01498 JMP* CSH054+1 CROSS COPY ENTRY LOCATION. 01499CSH054 NOP 0 01500 STA* CSH071 (A( EQUQLS COMPLETION ADDRESS. 01501 LDA* INPWRT ABSOLUTE ADDRESS OF DRI01. 01502 RTJ MTSTAT CHECK STATUS. REWIND IF MAGNETIC TAPE. 01503 JMP* (CSH071) EXIT THROUGH COMPLETION ADDRESS. 01504CSH06 LDA INPLU NOT MAG TAPE. PRINT REWIND MESSAGE. 01505 AND- CLRMOD CLEAR THE MODE BIT. 01506 RTJ HEXDEC 01507ÐÐ STA* REWMES+6 01508 RTJ- (REQPRO) 01509* 01510* FWRITE STDOCD,CHS07,REWMS,7,A,0,1,0,0,D 01511* 01512 VFD N1/0,N1/1,N5/6,N1/0,N4/0,N4/1 01513 ADC CSH07 01514 NUM 0 01515CSH065 VFD N3/0,N1/1,N2/0,N10/0 01516 NUM 7 01517 ADC REWMES 01518* 01519 JMP- (DISP) 01520* 01521* OPERATOR MUST INPUT FROM THE COMMENT DEVICE WHEN THE INPUT 01522* UNIT IS REWOUND 01523* 01524CSH07 RTJ- (REQPRO) 01525* 01526* FREAD STDICD,CSH00,INPBUF,1,A,0,1,0,0,D 01527* 01528 VFD N1/0,N1/1,N5/4,N1/0,N4/0,N4/1 01529CSH071 ADC 0 COMPLETION ADDRESS SET ON ENTRY. 01530 NUM 0 01531CSH075 VFD N3/0,N1/1,N2/0,N10/0 01532ÐÐ NUM 1 01533 ADC INPBUF 01534* 01535 JMP- (DISP) 01536CSH08 RTJ CHKEND CHECK HOLBUF FOR AN END/ CONTROL CARD. 01537 JMP* CSH00 NOT AN END/ CARD. 01538 LDA* CSHOMK 01539 SAP 1 01540 JMP* CSH05 CSY/ LIBRARY. REWIND. 01541 INA -1 01542 SAZ 1 01543 JMP* CSH05 TWO END/ CARDS. REWIND THE HOL/ LIBRARY. 01544 RAO* CSHOMK 01545 JMP* CSH00 01546* 01547*************************** 01548* 01549REWMES ALF 7, REWIND LU 00 01550INPWRT ADC RDI01 ABSOLUTE ADDRESS OF RDI01. 01551CSHOMK NUM 0 CSY/ OR HOL/ LIBRARY MARKER. 01552ADINPT ADC ADHOLB ABSOLUTE ADDRESS OF HOLBUF. 01553CSHRET ADC CSH00 CSYHOL COMPLETION ADDRESS. 01554SIZBUF NUM 1536 SIZE OF CSYBUF AND INPBUF. MUST BE G.T. 40. 01555SEQNUM NUM 0 INPUT RECORD COUNT. 01556* 01557ÐÐMODTAB VFD N3/0,N1/0,N2/0,N10/0 ASCII MODE. 01558 VFD N3/0,N1/1,N2/0,N10/0 BINARY MODE. 01559 EJT 01560* WRITER SUBROUTINE 01561* 01562* OUTPUTS THE CARD IN THE REVISIONS BUFFER. 01563* 01564WRITER 0 0 01565 LDQ* ASTRKS STORE ASTERISKS IN THE SEQUENCE 01566 STQ REVBUF+45 NUMBER FIELD (COLUMNS 88-92). 01567 STQ REVBUF+44 01568 LDA REVBUF+37 01569 ALS 8 01570 LLS 8 01571 STA REVBUF+43 01572 ENA 0 01573 STA* IDOUT SET MARKER TO NO I.D. ON CARD. 01574 STA IDINP 01575 LDQ ADREVB OUTPUT REVISIONS BUFFER ON THE 01576 RTJ* WRITE COSY AND HOLLERITH OUTPUT UNITS. 01577 JMP* (WRITER) 01578 EJT 01579* WRITEI SUBROUTINE 01580* 01581* OUTPUTS THE CARD IN THE HOLLERITH INPUT BUFFER. 01582ÐÐ* 01583WRITEI 0 0 01584 LDA* SEQNUM CONVERT INPUT RECORD COUNT TO DECIMAL. STORE 01585 RTJ* WRITI1 IN SEQUENCE NUMBER FIELD (COLUMNS 88-92). 01586 STQ HOLBUF+45 01587 RTJ* WRITI1 01588 STQ HOLBUF+44 01589 ENQ 0 01590 DVI- TEN 01591 INQ $30 01592 STQ* WRTMP1 01593 LDA HOLBUF+43 01594 AND- NZERO+8 01595 ADD* WRTMP1 01596 STA HOLBUF+43 01597 STA* IDOUT SET NON-ZERO FOR I.D. ON CARD. 01598 LDQ* ADHOLB OUTPUT THE HOLLERITH INPUT BUFFER 01599 RTJ* WRITE ON THE COSY AND HOLLERITH UNITS. 01600 JMP* (WRITEI) 01601* 01602WRITI1 0 0 01603 ENQ 0 CONVERT HEXIDECIMAL VALUE IN A TO A DECIMAL 01604 DVI- TEN WORD (TWO CHARACTERS). 01605 INQ $30 01606 STQ* WRTMP 01607ÐÐ ENQ 0 01608 DVI- TEN 01609 INQ $30 01610 QLS 8 01611 ADQ* WRTMP 01612 JMP* (WRITI1) 01613* 01614************************** 01615* 01616ASTRKS ALF 1,** 01617WRTMP NUM 0 TEMPORARY STORAGE USED BY WRITEI AND WRITE. 01618WRTMP1 NUM 0 TEMPORARY STORAGE USED BY WRITEI 01619IDOUT NUM 0 ID OUTPUT MARKER. NZ = PUT ID ON COSY OUTPUT. 01620 EJT 01621* WRITE SUBROUTINE 01622* 01623* OUTPUTS CARDS FROM THE REVISIONS BUFFER OR THE HOLLERITH 01624* INPUT BUFFER ON THE COSY AND/OR HOLLERITH OUTPUT UNITS. 01625* ON ENTRY, Q CONTAINS THE ABSOLUTE ADDRESS OF THE BUFFER TO 01626* BE OUTPUT. 01627* 01628WRITE 0 0 01629 STQ* WRTMP1 01630 STQ* WRITE5 01631 LDA COUT COSY OUTPUT MARKER. 01632ÐÐ SAZ 1 01633 JMP* WRITEC COSY OUTPUT WAS REQUESTED. 01634WRITE1 LDA HOUT HOLLERITH OUTPUT MARKER. 01635 SAN WRIT11 IS H OUTPUT REQUESTED. 01636 JMP* WRITE6 NO. CHECK FOR L OUTPUT. 01637WRIT11 STA* WRIT45 SET LOGICAL UNIT. 01638 LDA PRGID 01639 SAZ WRIT13 PROGRAMMER INFORMATION PRESENT. 01640 ENQ 0 YES. 01641WRIT12 LDA* PRGINF,Q PUT PROG INFO ON UPDATE CARDS. 01642 INQ 42 01643 STA* (WRITE5),Q 01644 INQ -45 01645 SQN 1 01646 JMP* WRIT31 01647 INQ 4 INCREASE INDEX BY ONE. 01648 JMP* WRIT12 01649WRIT13 LDQ* WRTMP1 ADDRESS OF THE BUFFER. 01650 LDA IDINP ID INPUT MARKER. IF ZERO, THE CARD DID NOT 01651 SAN WRITE2 HAVE AN ID WHEN INPUT. 01652 LDA* ASTRKS USE ASTERISKS FOR DECK IDENTIFIER. 01653 JMP* WRITE3 01654WRITE2 LDA* NEWID STORE ID IN ID FIELD (COLUMNS 81-86). 01655 STA- 40,Q 01656 LDA* NEWID+1 01657ÐÐ STA- 41,Q 01658 LDA* NEWID+2 01659 STA- 42,Q 01660 JMP* WRIT31 01661WRITE3 STA- 40,Q NO DECK ID, STORE ASTERISKS IN ID FIELD. 01662 STA- 41,Q 01663 STA- 42,Q 01664WRIT31 RTJ- (REQPRO) OUTPUT CARD TP THE HOLLERITH UNIT. 01665* 01666* FWRITE HOUT,WRITE6,,46,A,0,1,0,0,D 01667* 01668 VFD N1/0,N1/1,N5/6,N1/0,N4/0,N4/1 01669 ADC WRITE6 01670 NUM 0 01671WRIT45 VFD N3/0,N1/1,N2/0,N10/0 01672 NUM 46 01673WRITE5 NUM 0 01674* 01675 JMP- (DISP) 01676* 01677WRITE6 LDA* LMRKR 01678 SAN WRIT61-1 L OUTPUT BEEN PROCESSED. 01679 LDA LOUT NO. 01680 SAZ WRIT61 L OUTPUT REQUESTED. 01681 RAO* LMRKR YES. SET L MARKER. 01682ÐÐ JMP* WRIT11 01683 ENA 0 01684WRIT61 STA* LMRKR CLEAR L OUTPUT MARKER. 01685 JMP* (WRITE) 01686* 01687WRITEC LDA* IDOUT I.D. OUTPUT MARKER. IF ZERO, THE CARD DOES 01688 SAZ 1 NOT HAVE AN I.D. 01689 ENA 1 01690 INA $30 01691 RTJ* PACK PACK THE ID MARKER IN CSYBUF. 01692WRITE7 LDA- (ZERO),Q GET THE HOLLERITH WORD. 01693 ALS 8 01694 RTJ* PACK PACK LEFT CHARACTER IN CSYBUF. 01695 LDA- (ZERO),Q 01696 RTJ* PACK PACK RIGHT CHARACTER IN CSYBUF. 01697 INQ 1 01698 TRQ A 01699 SUB* WRTMP1 01700 INA -40 01701 SAZ 1 DONE WHEN 40 WORDS HAVE BEEN OUTPUT. 01702 JMP* WRITE7 01703 STA* BLKCTR CLEAR BLANK CHARACTER COUNTER. 01704 ENA $5F 01705 RTJ* PAK06 OUTPUT END OF CARD CHARACTERS ($5F5E). 01706 ENA $5E 01707ÐÐ RTJ* PAK06 01708 JMP* WRITE1 01709* 01710************************** 01711* 01712NEWID NUM 0 DECK IDENTIFIER CHARACTERS. 01713 NUM 0 01714 NUM 0 01715ADHOLB ADC HOLBUF ABSOLUTE ADDRESS OF HOLBUF. 01716LMRKR NUM 0 L OUTPUT MARKER. 01717 SPC 2 01718* THIS AREA IS USED TO SAVE PROGRAMMER 01719* INFORMATION TAKEN FROM COLUMNS 66 THRU 01720* 72 OF ALL DEL/ AND INS/ CARDS. 01721* 01722PRGINF NUM 0 01723 NUM 0 01724 NUM 0 01725 NUM 0 01726 EJT 01727* PACK SUBROUTINE 01728* 01729* PACKS CHARACTERS INTO THE COSY OUTPUT BUFFER AND WRITES 01730* THE BUFFER WHEN IT IS FULL. 01731* ENTER WITH THE CHARACTER TO BE PACKED IN THE ACCUMULATOR. 01732ÐÐ* Q IS RESTORED BEFORE EXITING THE ROUTINE. 01733* 01734PACK 0 0 01735 STQ* SAVEQ 01736 AND- LPMASK+8 01737 STA* CHAR SAVE THE CHARACTER TO BE PACKED. 01738 INA -$20 01739 SAN PAK01 NOT A BLANK. 01740 RAO* BLKCTR INCREMENT BLANK COUNTER. 01741 LDA* BLKCTR 01742 INA -62 01743 SAP PAK00 01744 JMP* (PACK) 01745PAK00 ENA $5F 62 BLANKS OR END OF DECK OR END OF LIBRARY. 01746 RTJ* PAK06 OUTPUT $5F. 01747 LDA* BLKCTR 01748 INA $1F 01749 RTJ* PAK06 OUTPUT $5D OR $5E OR $5F. 01750 JMP* PAK05 01751PAK01 LDA* BLKCTR 01752 SAN 1 01753 JMP* PAK03 NO MORE BLANKS. OUTPUT CHARACTER. 01754 INA -3 01755 SAP PAK02 OVER 2 BLANKS. 01756 INA 2 01757ÐÐ STA* BLKCTR DECREMENTS BLANK COUNTER BY ONE. 01758 ENA $20 01759 RTJ* PAK06 OUTPUT A BLANK. 01760 JMP* PAK01 01761PAK02 ENA $5F 01762 RTJ* PAK06 OUTPUT $5F. 01763 LDA* BLKCTR 01764 INA -8 01765 SAM 1 01766 INA 1 01767 INA $26 01768 RTJ* PAK06 OUTPUT NUMBER OF BLANKS ($21 - $5C (NOT $26)) 01769PAK03 LDA* CHAR GET THE CHARACTER TO BE PACKED. 01770 INA -$5F 01771 SAN PAK04 01772 ENA 1 TRUE $5F. SET TO OUTPUT $5F THEN $20. 01773 STA* BLKCTR 01774 JMP* PAK00 01775PAK04 LDA* CHAR 01776 RTJ* PAK06 OUTPUT THE CHARACTER. 01777PAK05 ENA 0 01778 STA* BLKCTR CLEAR THE BLANK COUNTER. 01779 LDQ* SAVEQ 01780 JMP* (PACK) 01781* 01782ÐÐPAK06 0 0 01783 LDQ* CSYLR SWITCH COSY L/R MARKER. 01784 QLS 1 01785 STQ* CSYLR 01786 SQP PAK07 + MEANS FILL RIGHT CHARACTER. 01787 ALS 8 01788 STA* (CSYPTR) STORE THE LEFT CHARACTER IN THE BUFFER. 01789 JMP* (PAK06) 01790PAK07 ADD* (CSYPTR) 01791 STA* (CSYPTR) STORE THE RIGHT CHARACTER IN THE BUFFER. 01792 RAO* CSYPTR INCREMENT THE BUFFER POINTER AND SEE IF THE 01793 LDA* CSYPTR BUFFER IS FULL. 01794 SUB SIZBUF 01795 SUB* ADCSYB 01796 SAZ 1 01797 JMP* PAK09 01798 LDA* ADCSYB BUFFER IS FULL. RESET THE BUFFER POINTER 01799 STA* CSYPTR AND WRITE THE BUFFER. 01800 RAO* SEQCSY INCREMENT OUTPUT SEQUENCE COUNT. 01801 LDA* SEQCSY 01802 STA CSYSEQ STORE IN OUTPUT RECORD. 01803 LDQ =N1537 RECORD LENGTH-1 FOR CHECKSUMMING. 01804 RTJ* CKSUM CHECKSUM RECORD FOR OUTPUT. 01805 RTJ- (REQPRO) 01806* 01807ÐÐ* FWRITE COUT,PAK09,CSYSEQ,1538,AORB,0,1,0,0,D 01808* 01809 VFD N1/0,N1/1,N5/6,N1/0,N4/0,N4/1 01810 ADC PAK09 01811 NUM 0 01812PAK085 VFD N3/0,N1/1,N2/0,N10/0 01813 NUM 1538 01814 ADC CSYSEQ 01815* 01816 JMP- (DISP) 01817* 01818PAK09 JMP* (PAK06) 01819* 01820************************** 01821* 01822BLKCTR NUM 0 BLANK CHARACTER COUNTER FOR PACK SUBROUTINE. 01823CSYPTR ADC CSYBUF POINTS TO THE NEXT AVAILABLE WORD IN CSYBUF. 01824CSYLR NUM $5555 LEFT (+) OR RIGHT (-) CHARACTER IN CSYBUF. 01825IDINP NUM 0 NZ IF THE CARD HAD AN ID WHEN INPUT. 01826BUFSIZ NUM 1536 INPUT BUFFER SIZE. 01827SAVEQ NUM 0 VALUE OF Q WHEN PACK SUBROUTINE WAS ENTERED. 01828ADCSYB ADC CSYBUF ABSOLUTE ADDRESS OF CSYBUF. 01829CHAR NUM 0 THE CHARACTER TO BE PACKED OR UNPACKED. 01830CBFIDX NUM 0 TEMPORARY FOR TAPE OR CARD. 01831BLNK ALF 1, 01832ÐÐSEQCSY NUM 0 SEQUENCE COUNTER FOR OUTPUT RECORDS. 01833 EJT 01834* CLEARI SUBROUTINE 01835* 01836* PACKS END-OF-LIBRARY CHARACTERS INTO THE COSY OUTPUT BUFFER 01837* AND WRITES THE BUFFER. 01838* 01839CLEARI 0 0 01840 ENA $5F 01841 RTJ* PAK06 01842 ENA $5F OUTPUT END OF LIBRARY MARKER. 01843 RTJ* PAK06 01844 LDA* CSYLR 01845 SAP CLEAR1 SKIP IF WORD FILLED 01846 ENA $20 01847 RTJ* PAK06 FILL RIGHT CHARACTER WITH BLANK 01848CLEAR1 EQU CLEAR1(*) 01849 LDA* CBFIDX 01850 SAZ CLEAR5 SKIP IF TAPE TO CALCULATE BUFFER. 01851 LDA SIZBUF SET BUFFER TO MAXIMUM SIZE SO 01852* ALL BUFFERS ARE SAME SIZE FOR CARDS 01853 JMP* CLEAR3 PUT BUFFER SIZE INTO REQUEST. 01854CLEAR5 LDA* CSYPTR CALCULATE THE NUMBER OF WORDS 01855* THAT WERE USED 01856 SUB* ADCSYB IN THE BUFFER. 01857ÐÐ* 3 CARDS DELETED 01858CLEAR3 STA* CLEAR4 SET REQST TO DESIGNATE BUFFER SIZE 01859 SAN 1 01860 JMP* CLEAR2 01861 INA -10 ALLOW A MINIMUN RECORD OF 10 **MOSO4.0** 01862 SAP CLER31 WORDS FOR TAPE DRIVER NOISE LENGTH.**MOSO4.0** 01863 LDQ* BLNK 01864 STQ* (CSYPTR) ALLOW A MINIMUM RECORD OF 10 WORDS 01865 RAO* CSYPTR FOR TAPE DRIVER NOISE LENGTH 01866 INA 11 01867 JMP* CLEAR3 01868CLER31 RAO* SEQCSY INCREMENT OUTPUT RECORD COUNTER. 01869 LDA* SEQCSY 01870 STA CSYSEQ STORE IN OUTPUT RECORD. 01871 LDQ* CLEAR4 INCREASE BY TWO THE NUMBER OF WORDS TO BE READ. 01872 INQ 2 OUTPUT. THIS ALLOWS FOR THE SEQUENCE AND CHECK- 01873 STQ* CLEAR4 SUMMING WORDS. 01874 INQ -1 SET Q=RECORD LENGTH-1 FOR CHECKSUMMING. 01875 RTJ* CKSUM CHECKSUM RECORD FOR OUTPUT. 01876 RTJ- (REQPRO) 01877* 01878* FWRITE COUT,CLEAR2,CSYSEQ,CLEAR4,AORB,0,1,0,0,D 01879* 01880 VFD N1/0,N1/1,N5/6,N1/0,N4/0,N4/1 01881 ADC CLEAR2 01882ÐÐ NUM 0 01883CLER15 VFD N3/0,N1/1,N2/0,N10/0 01884CLEAR4 NUM 0 01885 ADC CSYSEQ 01886* 01887 JMP- (DISP) 01888* 01889CLEAR2 LDA* ADCSYB 01890 STA* CSYPTR RESET THE COSY BUFFER POINTER AND THE 01891 LDA LRSET LEFT/RIGHT CHARACTER POINTER. 01892 STA* CSYLR 01893 JMP* (CLEARI) 01894 EJT 01895* 01896* ROUTINE CKSUM - CALCULATES THE CHECKSUM OF OUTPUT COSY RECORD 01897* AND PLACES THE COMPLEMENT IN WORD 2 OF THE OUTPUT BUFFER. Q ON 01898* ENTRY CONTAINS THE LENGTH-1 OF THE OUTPUT RECORD. 01899* 01900 SPC 2 01901CKSUM 0 0 01902 ENA 0 01903 STA CSYSUM 01904SUMUP ADD CSYSEQ,Q 01905 DQP *-SUMUP 01906 TCA A STORE THE COMPLEMENT 01907ÐÐ STA CSYSUM 01908 JMP* (CKSUM) 01909 EJT 01910* READI SUBROUTINE 01911* 01912* INPUTS CARDS INTO THE HOLLERITH INPUT BUFFER. IF HOLLERITH 01913* INPUT, CARDS ARE READ DIRECTLY INTO HOLBUF. IF COSY 01914* INPUT, CARDS ARE UNPACKED FROM INPBUF INTO HOLBUF. A NEW 01915* COSY BLOCK IS READ INTO INPBUF WHEN REQUIRED. 01916* 01917READI 0 0 01918 ENA 1 01919 STA* IDINP SET MARKER TO ID ON INPUT. 01920 RAO SEQNUM INCREMENT INPUT RECORD COUNT. 01921 LDA* BUFSIZ 01922 INA -46 01923 SAZ 1 01924 JMP* RDI03 READING COSY INPUT. 01925 STA ENDDCK CLEAR END OF DECK MARKER. 01926* 6 CARDS DELETED 01927 RTJ- (REQPRO) READ A CARD INTO HOLBUF. 01928* 01929* FREAD INPLU,RDI135,HOLBUF,46,AORB,0,1,0,0,D 01930* 01931RDI01 VFD N1/0,N1/1,N5/4,N1/0,N4/0,N4/1 01932ÐÐ ADC RDI135 01933 NUM 0 01934RDI015 VFD N3/0,N1/1,N2/0,N10/0 01935 NUM 46 01936 ADC HOLBUF 01937* 01938 JMP- (DISP) 01939************************** 01940* 01941RDI03 LDA ADHOLB 01942 STA HOLPTR 01943 ENQ 45 01944 LDA BLANK 01945RDI04 STA (HOLPTR),Q STORE 46 WORDS OF BLANKS IN HOLBUF 01946 INQ -1 01947 SQM 1 01948 JMP* RDI04 01949 ENA 0 01950 STA ENDDCK CLEAR THE END OF DECK MARKER AND SET 01951 STA FSTCHR THE FIRST CHARACTER MARKER 01952 LDA LRSET 01953 STA HOLLR SET HOLLERITH BUFFER L/R MARKER TO LEFT. 01954RDI05 LDA INPPTR 01955 SUB* BUFSIZ TEST FOR INPUT BUFFER EMPTY. 01956 SUB ADINPB 01957ÐÐ SAZ 1 01958 JMP* RDI075 01959 LDA ADINPB BUFFER EMPTY. RESET THE BUFFER POINTER TO 01960 STA INPPTR THE START OF THE BUFFER. 01961 LDA LRSET 01962 STA INPLR SET INPUT BUFFER L/R MARKER TO LEFT. 01963 RTJ- (REQPRO) READ 1536 WORD COSY INPUT BLOCK INTO INPBUF. 01964* 01965* FREAD INPLU,RDI07,INPSEQ,1538,AORB,0,1,0,0,D 01966* 01967 VFD N1/0,N1/1,N5/4,N1/0,N4/0,N4/1 01968 ADC RDI07 01969 NUM 0 01970RDI065 VFD N3/0,N1/1,N2/0,N10/0 01971 NUM 1538 01972 ADC INPSEQ 01973* 01974 JMP- (DISP) 01975* 01976* UNPACKING ROUTINE 01977* 01978RDI07 TRQ A CHECK IF SHORT READ. 01979 AND- ONEBIT+14 01980 SAN RDI071 SKIP IF SHORT READ 01981 LDQ =N1537 NOT A SHORT READ - SET LENGTH-1 TO 1537. 01982ÐÐ JMP* RDI072 01983RDI071 LDA INPBUF+1535 SHORT READ - CALCULATE NUMBER OF WORDS READ. 01984 SUB =XINPSEQ 01985 TRA Q 01986 INQ -1 Q = LENGTH-1 OF DATA READ. 01987* CHECK SEQUENCE AND CHECKSUM OF COSY RECORD JUST READ. 01988RDI072 RAO SEQINP 01989 LDA INPSEQ 01990 SUB SEQINP 01991 SAZ RDI073 SKIP IF NO SEQUENCE ERROR 01992 ENA 24 SEQUENCE NOT OK - ERROR. 01993 RTJ ERRPRO ****COSY E24**** SEQUENCE ERROR ON INPUT. 01994 JMP COSY6 JMUP TO EXIT ROUTINE. FATAL ERROR. 01995RDI073 ENA 0 PERFORM CHECKSUMMING 01996SUMIT ADD INPSEQ,Q 01997 DQP *-SUMIT 01998 SAZ RDI075 SKIP IF NO CHECKSUM ERROR. 01999 ENA 25 ****COSY E25***** CHECKSUM ERROR ON INPUT. 02000 RTJ ERRPRO FATAL ERROR. 02001 JMP COSY6 EXIT ROUTINE. 02002RDI075 LDA* (INPPTR) 02003 LDQ* INPLR SWITCH INPUT L/R MARKER. 02004 QLS 1 02005 STQ* INPLR 02006 SQM 2 02007ÐÐ RAO* INPPTR RIGHT CHARACTER. INCREMENT BUFFER POINTER. 02008 JMP* *+2 02009 ARS 8 LEFT CHARACTER. SHIFT TO RIGHT HALF. 02010 AND- LPMASK+8 02011 LDQ* FSTCHR 02012 SQN RDI08 02013 INA -$30 FIRST CHARACTER IS THE ID CHARACTER. 02014 STA IDINP DECREMENT TO GET A 0 OR A 1. 02015 RAO* FSTCHR 02016 INA -$2F IF CHARACTER WAS $5F, HANDLE SPECIAL. SHOULD 02017 SAZ 1 BE AN END-OF-DECK CHARACTER. 02018 JMP* RDI05 02019 ENA $5F 02020RDI08 STA CHAR SAVE THE CHARACTER BEING UNPACKED. 02021 LDA* PCN5F 02022 SAN 1 THE PREVIOUS CHARACTER WAS NOT $5F. 02023 JMP* RDI11 02024 LDA CHAR 02025 INA -$5F 02026 SAN RDI09 THIS CHARACTER NOT $5F. 02027 STA* PCN5F SET PREVIOUS CHARACTER = $5F. 02028 JMP* RDI05 02029RDI09 LDA CHAR 02030 LDQ* HOLLR SWITCH HOLLERITH BUFFER L/R MARKER. 02031 QLS 1 02032ÐÐ STQ* HOLLR 02033 SQP RDI10 02034 ALS 8 STORE THE CHARACTER IN THE LEFT HALF OF THE 02035 INA $20 WORD WITH A BLANK IN THE RIGHT HALF. 02036 STA* (HOLPTR) 02037 JMP* RDI05 02038RDI10 ADD* (HOLPTR) STORE THE CHARACTER IN THE RIGHT HALF OF THE 02039 INA -$20 WORD (REMOVING THE BLANK). 02040 STA* (HOLPTR) 02041 RAO* HOLPTR INCREMENT HOLBUF POINTER. 02042 JMP* RDI05 02043RDI11 LDA CHAR 02044 STA* PCN5F SET PREVIOUS CHARACTER NOT $5F. 02045 INA -$20 02046 SAN 2 02047 ENA $5F HAD $5F20, A TRUE $5F CHARACTER. 02048 JMP* RDI09+1 02049 INA -$3E 02050 SAZ 2 HAD $5F5E - END OF CARD. 02051 SAM RDI12 HAD $5FXX, A STRING OF BLANKS. 02052 RAO* ENDDCK HAD $5F5F. SET END OF DECK MARKER. 02053 JMP (READI) 02054RDI12 INA $38 02055 SAM 1 02056 INA -1 CHARACTER WAS 26 OR GREATER. DECREMENT BY 1. 02057ÐÐ INA 8 NUMBER OF BLANKS = CHARACTER - $20 + 2. 02058 ENQ 0 02059 LLS 15 02060 ADQ* HOLPTR INCREMENT HOLLERITH POINTER BY 02061 STQ* HOLPTR HALF THE NUMBER OF BLANKS. 02062 SAP RDI13 HAD AN EVEN NUMBER OF BLANKS. 02063 LDA* HOLLR 02064 SAP 1 02065 RAO* HOLPTR WAS A RIGHT CHARACTER. INCREMENT POINTER. 02066 ALS 1 SWITCH THE HOLLERITH L/R MARKER. 02067 STA* HOLLR 02068RDI13 JMP RDI05 02069* 02070RDI135 LDA ADINPT 02071 STA WORKUN 02072 LDA RDI015 CHECK FOR SHORT READ 02073 ALS 1 02074 SAM RDI139 02075 JMP* RDI136 POS. NOT A SHORT READ 02076RDI139 LDA =XHOLBUF+45 PICK UP LAST WORD ADDRESS 02077 STA- I 02078 TCA Q 02079 ADQ HOLBUF+45 DISTANCE TO LAST WORD READ 02080 INQ -1 02081 LDA- (ZERO),B IF SHORT READ REPLACE $FF WITH $20 02082ÐÐ ALS 8 02083 SAP RDI137 IF POS. BLANK REST OF BUFFER 02084 ALS 8 02085 AND =N$FF20 02086 STA- (ZERO),B 02087RDI137 LDA BLANK BLANK REST OF BUFFER IN CASE 02088RDI138 INQ 1 OF RUBOUT ON TTY 02089 STA- (ZERO),B 02090 SQP RDI136 02091 JMP* RDI138 02092RDI136 RTJ CHKEND CHECK FOR AN END/ CARD 02093 JMP* *+2 02094 RAO* ENDDCK FOUND END/. SET THE END OF DECK MARKER. 02095 JMP (READI) 02096* 02097* 02098************************** 02099* 02100BLANK ALF 1, 02101LRSET NUM $5555 02102ADINPB ADC INPBUF ABSOLUTE ADDRESS OF INPBUF. 02103HOLPTR ADC HOLBUF POINTS TO NEXT AVAILABLE WORD IN HOLBUF. 02104HOLLR NUM $5555 LEFT (+) OR RIGHT (-) CHARACTER IN HOLBUF. 02105INPPTR ADC INPBUF POINTS TO NEXT AVAILABLE WORD IN INPBUF. 02106INPLR NUM $5555 LEFT (+) OR RIGHT (-) CHARACTER IN INPBUF. 02107ÐÐPCN5F NUM 1 NZ IF PREVIOUS CHARACTER WAS NOT $5F. 02108FSTCHR NUM 0 0 = FIRST CHARACTER OF COMPRESSED CARD. 02109ENDDCK NUM 0 END OF DECK MARKER. NZ MEANS END OF DECK. 02110 EJT 02111* GETEND SUBROUTINE 02112* 02113* READS CARDS FROM THE INPUT UNIT AND OUTPUTS THEM ON THE 02114* COSY AND/OR HOLLERITH OUTPUT UNITS UNTIL AN END OF DECK 02115* INDICATOR IS FOUND. 02116* 02117GETEND 0 0 02118 LDA* ENDDCK 02119 SAN GETED1 ALREADY AT END OF INPUT DECK. 02120 STA PRGID CLEAR PROGRAMMER INFORMATION MARK. 02121 RTJ READI READ FROM THE INPUT UNIT. 02122 LDA* ENDDCK 02123 SAN GETED1 FOUND THE END OF DECK. 02124 RTJ WRITEI OUTPUT FROM THE INPUT BUFFER. 02125 JMP* GETEND+1 02126GETED1 LDA CPYID IS COPY ROUTINE IN PROCESS. 02127 SAZ GETED2 02128 JMP* (GETEND) YES. 02129GETED2 LDA COUT NO. 02130 SAZ 2 02131 RTJ CLEARI CLEAR THE COSY OUTPUT BUFFER. 02132ÐÐ LDA ADRINP 02133 STA WORKUN SET WORKING UNIT TO REVBUF. 02134 JMP* (GETEND) 02135 EJT 02136* REVPRO SUBROUTINE 02137* 02138* READS CARDS INTO THE REVISIONS BUFFER AND CHECKS FOR A 02139* CONTROL CARD. 02140* A DCK/ CARD WILL START A NEW UPDATE. 02141* A MRG/ CARD WILL START A MERGE. 02142* AN END/ CARD TERMINATES COSY. 02143* A REM/ CARD IS PRINTED WITH ASTERISKS AND ANOTHER CARD IS 02144* READ. 02145* A DEL/ OR INS/ CARD CLEARS THE ERROR MARKER AND EXITS THRU 02146* THE RETURN ADDRESS. 02147* IF THE ERROR MARKER IS SET, CARDS ARE READ AND LISTED WITH 02148* ASTERISKS UNTIL A CONTROL CARD IS FOUND. 02149* IF THE ERROR MARKER IS NOT SET, THE ROUTINE EXITS THRU THE 02150* RETURN ADDRESS +1 WHEN THE CARD IS NOT A CONTROL CARD. 02151* 02152REVPRO 0 0 02153 LDA =XREVPR2 SET RETURN AFTER SHORT READ CHECK 02154 STA REVCMP 02155 LDA REVLUN 02156 STA DME4 SET REVISION LU INTO READ REQS. 02157ÐÐ STA* REVP04 02158 AND- CLRMOD CLEAR ASCII BIT TO CHECK DEVICE. 02159 RTJ CKDEV 02160 JMP* REVP03 MASS STORAGE DEVICE. 02161REVP01 RTJ- (REQPRO) 02162* 02163* FREAD REVLU,REVPR2,REVBUF,46,A,0,1,0,0,D 02164* 02165* INDIRECT THRU PARAMETER LIST AT REVREQ 02166* 02167 VFD N1/0,N1/1,N5/16,N1/0,N8/0 02168 ADC REVREQ 02169* 02170 JMP- (DISP) 02171* 02172REVP03 RTJ- (REQPRO) 02173* 02174* FREAD REVLU,REVPR2,REVBUF,46,A,0,1,0,0,D 02175* 02176 VFD N1/0,N1/1,N5/4,N1/0,N4/0,N4/1 02177 ADC REVPR2 02178 NUM 0 02179REVP04 VFD N3/0,N1/1,N2/0,N10/0 02180 NUM 46 02181 ADC REVBUF 02182ÐÐ NUM 0 02183SECTOR NUM 1 02184* 02185 JMP- (DISP) 02186* 02187REVPR2 RAO* SECTOR 02188 RAO SECNUM 02189 LDA ADRINP 02190 STA WORKUN 02191 RTJ CHKDCK 02192 JMP* REVPR3 NOT A DCK/ CONTROL CARD. 02193 RTJ* GETEND PROCESS TO THE END OF THE INPUT DECK. 02194 JMP UPD005 02195REVPR3 RTJ CHKMRG 02196 JMP* REVPR4 NOT A MRG/ CONTROL CARD. 02197 RTJ* GETEND PROCESS TO THE END OF THE INPUT DECK. 02198 JMP E04A 02199REVPR4 RTJ CHKEND 02200 JMP* REVPR5 NOT AN END/ CONTROL CARD. 02201 RTJ* GETEND PROCESS TO THE END OF THE INPUT DECK. 02202 ENA 0 02203 STA ERRMRK CLEAR THE ERROR MARKER. 02204 RTJ PRINTR PRINT THE END/ CARD. 02205 JMP COSY6 END OF COSY. 02206REVPR5 RTJ CHKDEL 02207ÐÐ JMP* REVPR6 NOT A DEL/ CONTROL CARD. 02208 JMP* REVPR7 02209REVPR6 RTJ CHKINS 02210 JMP* REVPR8 NOT AN INS/ CONTROL CARD. 02211REVPR7 ENA 0 02212 STA ERRMRK CLEAR THE ERROR MARKER AND EXIT THRU THE 02213 JMP* (REVPRO) RETURN ADDRESS. 02214REVPR8 RTJ CHKREM 02215 JMP* REVPR9 NOT A REM/ CONTROL CARD. 02216 RAO ERRMRK SET THE ERROR MARKER. 02217 JMP* REVPRA 02218REVPR9 RTJ CHKCPY CHECK IF CPY/ CARD FOLLOWS DCK/. 02219 JMP* *+2 NO. 02220 JMP* REVPRB YES. ILLEGAL POSITION IN DECK. 02221 LDA ERRMRK NOT CONTROL CARD IF ERROR MRKR NOT 02222 SAN REVPRA SET, EXIT THRU THE RETURN ADDRESS +1. 02223 RAO* REVPRO 02224 JMP* (REVPRO) 02225REVPRA RTJ PRINTR PRINT THE CARD AND GO READ AGAIN. 02226 JMP* REVPRO+1 02227* 02228REVPRB ENA 22 ****COSY 22**** CPY/ CARD NOT 02229 RTJ ERRPRO FIRST CONTROL CARD IN REV. DECK. 02230 RTJ PRINTR 02231 JMP* REVPRO+1 GO READ NEXT CARD. 02232ÐÐ EJT 02233* CHKNAM SUBROUTINE 02234* 02235* COMPARES THE DECKNAME IN HOLBUF WITH THE DECKNAME IN REVBUF. 02236* EXIT TO THE RETURN ADDRESS IF THE DECKNAMES MATCH OR TO THE 02237* RETURN ADDRESS +1 IF THEY DO NOT MATCH. 02238* 02239CHKNAM 0 0 02240 LDA REVBUF 02241 SUB* HOLBUF 02242 SAN CHKNM1 02243 LDA REVBUF+1 02244 SUB* HOLBUF+1 02245 SAN CHKNM1 02246 LDA REVBUF+2 02247 SUB* HOLBUF+2 02248 SAN CHKNM1 02249 JMP* (CHKNAM) DECKNAMES MATCHED. 02250CHKNM1 LDA* DECK1 FIRST DECK CHECKED MARKER. 02251 SAZ 1 02252 JMP* CHKNM2 02253 LDA* HOLBUF 02254 STA* DECK1 02255 LDA* HOLBUF+1 02256 STA* DECK1+1 02257ÐÐ LDA* HOLBUF+2 02258 STA* DECK1+2 02259 RAO* CHKNAM NAMES DO NOT MATCH. 02260 JMP* (CHKNAM) 02261CHKNM2 LDA* HOLBUF 02262 SUB* DECK1 SEE IF ENTIRE LIBRARY WAS CHECKED. 02263 SAN CHKNM3 02264 LDA* HOLBUF+1 02265 SUB* DECK1+1 02266 SAN CHKNM3 02267 LDA* HOLBUF+2 02268 SUB* DECK1+2 02269 SAZ E10 02270CHKNM3 RAO* CHKNAM DECKNAMES DO NOT MATCH. 02271 JMP* (CHKNAM) 02272* 02273E10 RTJ READI READ FROM INPUT UNIT UNTIL END OF DECK. 02274 LDA ENDDCK 02275 SAN 1 02276 JMP* E10 02277 ENA 10 ****COSY E10**** NO SUCH DECK ON THE 02278 JMP E1014 INPUT LIBRARY. 02279* 02280******************** 02281* 02282ÐÐDECK1 NUM 0 DECKNAME OF THE FIRST DECK CHECKED ON THE 02283 NUM 0 INPUT LIBRARY. 02284 NUM 0 02285 EJT 02286* NEWDCK SUBROUTINE 02287* 02288* PRINTS THE DCK/ CARD IN REVBUF, PLACES THE PROPER DECK 02289* IDENTIFIER IN NEWID, AND (IF COSY OUTPUT WAS REQUESTED) 02290* OUTPUTS A CSY/ CARD ON THE COSY OUTPUT UNIT. 02291* 02292NEWDCK 0 0 02293 RTJ PRINTR PRINT THE DCK/ CONTROL CARD. 02294 LDA REVBUF+36 02295 SUB BLANK 02296 SAN NEWD1 02297 LDA REVBUF+37 02298 SUB BLANK 02299 SAN NEWD1 02300 LDA REVBUF+38 02301 SUB BLANK 02302 SAZ NEWD2 02303NEWD1 LDA REVBUF+36 HAVE A NEW I.D. SAVE IT ON THE CSY/ OR HOL/ 02304 STA* HOLBUF+40 CARD. 02305 LDA REVBUF+37 02306 STA HOLBUF+41 02307ÐÐ LDA REVBUF+38 02308STA STA HOLBUF+42 02309NEWD2 LDA* HOLBUF+40 GET THE I.D. AND SAVE IN NEWID. 02310 STA NEWID 02311 LDA* HOLBUF+41 02312 STA NEWID+1 02313 LDA HOLBUF+42 02314 STA NEWID+2 02315 LDA COUT 02316 SAN 1 IF COSY OUTPUT, OUTPUT A CSY/ CARD. 02317 JMP* (NEWDCK) 02318 LDA DCKNAM PLACE THE DECKNAME ON THE CSY/ CARD. 02319 STA* HOLBUF 02320 LDA DCKNAM+1 02321 STA* HOLBUF+1 02322 LDA DCKNAM+2 02323 STA* HOLBUF+2 02324 LDA CSY PLACE THE CHARACTERS CSY/ ON THE CSY/ CARD. 02325 STA* HOLBUF+3 02326 LDA CSY+1 02327 STA* HOLBUF+4 02328 LDA SLASH 02329 STA* HOLBUF+5 02330 ENA 0 ZERO COSY OUTPUT BLOCK SEQUENCE NUMBER. 02331 STA SEQCSY 02332ÐÐ RTJ- (REQPRO) WRITE THE CSY/ CARD ON THE COSY OUTPUT UNIT. 02333* 02334* FWRITE COUT,NEWD4,HOLBUF,46,AORB,0,1,0,0,D 02335* 02336 VFD N1/0,N1/1,N5/6,N1/0,N4/0,N4/1 02337 ADC NEWD4 02338 NUM 0 02339NEWD35 VFD N3/0,N1/1,N2/0,N10/0 02340 NUM 46 02341 ADC HOLBUF 02342* 02343 JMP- (DISP) 02344* 02345NEWD4 JMP* (NEWDCK) 02346* 02347************************** 02348* 02349COUTLU NUM 0 LOGICAL UNIT FOR COSY OUTPUT. SAME AS COUT. 02350 EJT 02351HOLBUF BSS HOLBUF(46) HOLLERITH INPUT BUFFER. 02352SEQINP BZS SEQINP(1) SEQUENCE COUNTER FOR INPUT. 02353INPSEQ NUM 0 INPUT SEQUENCE NUMBER FROM COSY RECORD. 02354INPSUM NUM 0 INPUT CHECKSUM FROM COSY RECORD. 02355INPBUF BSS INPBUF(1536) COSY INPUT BUFFER. 02356CSYSEQ NUM 0 SEQUENCE NUMBER OF COSY RECORD OUTPUT. 02357ÐÐCSYSUM NUM 0 CHECKSUM OF COSY RECORD OUTPUT. 02358CSYBUF BSS CSYBUF(1536) COSY OUTPUT BUFFER. 02359 EJT 02360* 02361* COPY ROUTINE 02362* 02363COPY RAO* CPYID SET MARKER TO ALLOW DCK/ PROCESSOR 02364 JMP UPDATE TO PROCESS CPY/ CARD. 02365* 02366* 02367* START COPY 02368* 02369CPY005 ENA -1 SET THE SLEW SWITCH. 02370 STA SLEWMK 02371 LDA REVLUN CHECK IF REVISIONS ALREADY ON 02372 AND- CLRMOD STANDARD SCRATCH. 02373 SUB- STDSCR 02374 SAN CPY010 02375 JMP* CPY036 YES THEY ARE ON SCRATCH. 02376CPY010 LDA INPLU COSY INPUT AND 02377 SUB REVLUN REVISIONS ON SAME LOGICAL UNIT. 02378 SAZ CPY015 02379 JMP* CPY036 NO. 02380CPY015 ENA 1 02381 STA* CPY025 SET SECTOR NUMBER. 02382ÐÐCPY016 RTJ READI READ REVISIONS. 02383 RTJ- (REQPRO) WRITE REVISIONS TO SCATCH. 02384* 02385* FWRITE STDSCR,CPY030,HOLBUF,46,A,0,1,0,0,D 02386* 02387 VFD N1/0,N1/1,N5/6,N1/0,N4/0,N4/1 02388 ADC CPY030 02389 NUM 0 02390CPY020 VFD N3/0,N1/1,N2/0,N10/0 02391 NUM 46 02392 ADC HOLBUF 02393 NUM 0 02394CPY025 NUM 1 SECTOR NUMBER. 02395* 02396 JMP- (DISP) 02397* 02398CPY030 LDA ENDDCK 02399 SAN CPY035 END/ FOUND. 02400 RAO* CPY025 UPDATE SECTOR NUMBER. 02401 JMP* CPY016 02402* 02403************************** 02404* 02405 SPC 4 02406* TEMPORARY WORDS AND MARKERS USED BY COPY. 02407ÐÐ* 02408FSREAD NUM 0 FIRST READ MARKER. 02409CPYID NUM 0 COPY OPERATION MARKER. 02410LSTDCK NUM 0 LAST DECK TO COPY MARKER. 02411CPYRET ADC CPY055 COPY REWIND REQUEST COMP. ADDRESS. 02412* 02413 SPC 4 02414CPY035 LDA* CPY020 SET REVLUN TO STDSCR. 02415 STA REVLUN 02416CPY036 ENA 46 SET BUFFER TO HOLLERITH SIZE. 02417 STA BUFSIZ 02418 RTJ READI READ CSY/ CARD. 02419 RTJ CHKCSY CSY/ FOUND. 02420 JMP* CPY040 NO. 02421 RAO* FSREAD SET THE FIRST READ MARKER. 02422 JMP* CPY056 YES. 02423CPY040 LDA* FSREAD 02424 SAN CPY045 FIRST READ. 02425 JMP E09 YES. CSY/ NOT FIRST COSY INPUT. 02426CPY045 LDA REVBUF NO. CHECK IF DECK NAME IS ON THE 02427 SUB =N$2020 CPY/ CARD. 02428 SAN CPY050 02429 JMP* CPY080 02430CPY050 LDA INPLU 02431 STA TABLU SET LOGICAL UNIT. 02432ÐÐ LDA* CPYRET SET REQUEST COMPLETION TO COPY. 02433 RTJ CSH054 CHECK UNIT AND REWIND. 02434CPY055 JMP* CPY036 DO NEXT READ. 02435CPY056 RTJ CHKNAM CHECK DECK NAMES. 02436 RAO* LSTDCK DECKNAMES MATCH. SET LAST DECK MKR. 02437 LDA COUT DECKNAMES DO NOT MATCH 02438 SAZ CPY060 COSY OUTPUT SPECIFIED. 02439 RTJ- (REQPRO) WRITE CSY/ CARD TO COUT. 02440* 02441* FWRITE COUT,CPY060,HOLBUF,46,AORB,0,1,0,0,D 02442* 02443 VFD N1/0,N1/1,N5/6,N1/0,N4/0,N4/1 02444 ADC CPY060 02445 NUM 0 02446CPY057 VFD N3/0,N1/1,N2/0,N10/0 02447 NUM 46 02448 ADC HOLBUF 02449* 02450 JMP- (DISP) 02451* 02452CPY060 LDA COUT 02453 SAN CPY062 DECK BEING COPIED. 02454 JMP* CPY063 NO. 02455CPY062 ENQ 0 YES. 02456 LDA* COPIED,Q PUT THE COPIED IDENTIFIER INTO 02457ÐÐ INQ 10 THE DECKNAME OUTPUT BUFFER. 02458 STA HOLBUF,Q 02459 INQ -13 02460 SQN 1 02461 JMP* CPY063 YES, MOVE COMPLETE. 02462 INQ 4 NO. 02463 JMP* CPY062+1 CONTINUE MOVE. 02464CPY063 LDA LOUTRV DECKNAMES TO BE LISTED. 02465 SAZ CPY065 02466 STA* CPY061 YES. SET LOGICAL UNIT. 02467 RTJ- (REQPRO) 02468* 02469* FWRITE LOUTRV,CPY065,HOLBUF,46,A,0,1,0,0,D 02470* 02471 VFD N1/0,N1/1,N5/6,N1/0,N4/0,N4/1 02472 ADC CPY065 02473 NUM 0 02474CPY061 VFD N3/0,N1/1,N2/0,N10/0 02475 NUM 46 02476 ADC HOLBUF 02477* 02478 JMP- (DISP) 02479* 02480CPY065 LDA SIZBUF SET BUFFER SIZE TO COSY INPUT. 02481 STA BUFSIZ 02482ÐÐ ADD ADINPB 02483 STA INPPTR SET POINTER TO END OF INPUT BUFFER. 02484CPY066 RTJ GETEND COPY TO THE END OF THE DECK. 02485CPY070 LDA COUT 02486 SAZ CPY075 COSY OUTPUT REQUESTED. 02487 RTJ CLEARI YES. WRITE LAST BUFFER. 02488CPY075 LDA* LSTDCK THIS THE LAST DECK TO COPY. 02489 SAN CPY080 THIS LAST DECK TO COPY. 02490 ENA 0 NO. ZERO INPUT SEQUENCE NUMBER COUNTER. 02491 STA SEQINP 02492 JMP* CPY036 02493CPY080 ENA 0 YES. CLEAR LAST DECK MARKER. 02494 STA* LSTDCK 02495 STA DECK1 FIRST DECKNAME WORD. 02496 JMP COSY21 CHECK FOR NEXT CONTROL CARD. 02497COPIED ALF 4,*COPIED* 02498 EJT 02499* MERGE INITIALIZATION ROUTINE 02500* 02501MERGE RTJ* MRG00 02502 ADC ADBUF1-MERGE-1 ADRIU1 02503 ADC ADBUF2-ADBUF1+1 ADRIU2 02504 ADC BUF2-ADBUF2 ADBUF2 02505MRG00 0 0 02506 LDA* MRG00 FORM ALL ABSOLUTE ADDRESSES. 02507ÐÐ ADD* MERGE+1 02508 STA ADRIU1 02509 STA WORKUN 02510 INA -1 02511 STA ALTUN ABSOLUTE ADDRESS OF MRGIU1. 02512 ADD* MERGE+2 02513 STA ADRIU2 02514 ADD* MERGE+3 02515 STA ADBUF2 02516 LDA ADDRES INITIALIZE POINTERS AND MARKERS. 02517 STA ADBUF1 02518 LDA (CSTDPT) USE COSY STANDARD PRINT LUN. 02519 EOR- MODBIT SET ASCII MODE BIT. 02520 STA MRGT15 * 02521 LDA- STDSCR SET STANDARD SCRATCH LOGICAL UNIT 02522 ADD- MODBIT SET ASCII BIT. 02523 STA XFER17 * 02524 ENA 0 02525 STA SLEWMK SLEWMK CLEARED SO SLEW IS NOT DONE 02526 STA- I 02527 STA ERRMRK 02528 STA REMMRK 02529 STA* COMCNT 02530 STA* E03MRK 02531 STA ENDCNT 02532ÐÐ STA PEMARK 02533 STA MRGIU1 02534 STA M2 02535 STA N2 02536 STA M1 02537 STA N1 02538 EJT 02539* PICK UP MERGE LOGICAL UNIT NUMBERS AND STORE IN MRGIU1, 02540* MRGIU2, AND MRGOU. 02541* 02542MRG01 LDA BUF1+6,I 02543 ALS 8 02544 RTJ* MRG02 02545 LDA BUF1+6,I 02546 RTJ* MRG02 02547 RAO- I 02548 JMP* MRG01 02549* 02550MRG02 0 0 02551 AND- LPMASK+8 MASK WITH 00FF TO GET A CHARACTER. 02552 SUB- ONEBIT+5 0020. ASCII BLANK. 02553 SAN 1 02554 JMP* MRG04 FOUND BLANK. END OF CARD INFORMATION. 02555 INA -$C 02556 SAN MRG03 02557ÐÐ LDA* COMCNT FOUND A COMMA. TEST FOR 3 COMMAS. 02558 INA -2 02559 SAZ MRG035 ZERO IF TOO MANY COMMAS. 02560 RAO* COMCNT INCREMENT COMMA COUNTER. 02561 ENA 9 02562 ADD* ALTUN INCREMENT TO THE NEXT PARAMETER STRING. 02563 STA* ALTUN 02564 ENA 0 02565 STA* (ALTUN) ZERO THE LOGICAL UNIT NUMBER. 02566 JMP* (MRG02) 02567* 02568MRG03 INA -4 02569 SAM MRG035 ILLEGAL CHARACTER ON MRG/ CARD. 02570 INA -10 02571 SAM 1 02572MRG035 JMP* E02 ILLEGAL PARAMETER ON MRG/ CARD. 02573 INA 10 02574 STA* DIGIT SAVE THE CHARACTER (0 THRU 9). 02575 LDA* (ALTUN) 02576 MUI- TEN 000A. CONVERT DIGITS FROM DECIMAL TO BINARY. 02577 ADD* DIGIT 02578 STA* (ALTUN) 02579 JMP* (MRG02) 02580* 02581************************** 02582ÐÐ* 02583E03MRK BSS E03MRK(1) FIRST TIME MARKER FOR COSY E03. 02584DIGIT BSS DIGIT(1) TEMPORARY. 02585COMCNT BSS COMCNT(1) COMMA COUNTER. 02586 EJT 02587* CHECK FOR VALID MERGE UNITS. 02588* 02589MRG04 LDQ (CSTDOT) IF OUTPUT UNIT NOT SET, SET IT 02590 LDA* MRGOU TO COSY STANDARD OUTPUT. 02591 SAN MRG045 02592 TRQ A 02593MRG045 ADD- MODBIT SET ASCII MODE BIT. 02594 STA* MRGOU 02595 LDQ (CSTDIN) IF INPUT UNIT WAS NOT SET, SET 02596 LDA* MRGIU1 IT TO COSY STANDARD INPUT. 02597 SAN MRG046 02598 TRQ A 02599MRG046 ADD- MODBIT SET ASCII MODE BIT. 02600 STA* MRGIU1 02601 TRA Q SAVE INPUT ONE LOGICAL UNIT NBR.. 02602 LDA* MRGIU2 02603 SAZ MRG047 02604 ADD- MODBIT SET ASCII MODE BIT. 02605 TRA Q 02606MRG047 STQ* MRGIU2 02607ÐÐ LDA* COMCNT THE COMMA COUNTER MUST EQUAL 2. 02608 INA -2 02609 SAN E02 NOT THREE MERGE UNITS. 02610 LDA* MRGOU 02611 SUB* MRGIU1 02612 SAZ E02 INPUT UNIT SAME AS OUTPUT UNIT. 02613 LDA* MRGOU 02614 SUB* MRGIU2 02615 SAN MRG05 02616* 02617E02 ENA 2 ****COSY E02**** ILLEGAL PARAMETER ON 02618 JMP E0402 A MRG/ CARD. 02619* 02620MRG05 RTJ PRINTR PRINT THE MRG/ CARD. 02621 LDA* MRGIU1 02622 SUB* MRGIU2 02623 SAN MRG06 02624 JMP XFER BOTH REVISION DECKS FROM SAME INPUT UNIT. 02625 EJT 02626* READ FROM BOTH REVISION SETS AND CHECK FOR DCK/ CARDS. 02627* 02628MRG06 RTJ MRGINP READ FROM INPUT UNIT 1. 02629 RTJ* DCKCHK 02630 RTJ* SETIU2 SET WORKING UNIT TO INPUT UNIT 2. 02631MRG07 RTJ MRGINP READ FROM INPUT UNIT 2. 02632ÐÐ RTJ* DCKCHK 02633 JMP* MRG08 02634* 02635DCKCHK 0 0 02636DCKCK1 RTJ CHKDCK CHECK FOR A DCK/ CARD. 02637 JMP* E03 02638 ENA 0 FOUND DCK/ CARD. CLEAR ANY ERROR MARKERS. 02639 STA ERRMRK 02640 STA* E03MRK 02641 LDA WORKUN 02642 STA- I ADDRESS OF THE WORKING UNITS PARAMETER STRING. 02643 LDQ (WORKUN) ADDRESS OF THE WORKING BUFFER. 02644 LDA- (ZERO),Q SAVE DECKNAME IN THE PARAMETER STRING. 02645 STA- 5,I 02646 LDA- 1,Q 02647 STA- 6,I 02648 LDA- 2,Q 02649 STA- 7,I 02650 JMP* (DCKCHK) 02651* 02652E03 LDA* E03MRK 02653 SAN E0305 NON-ZERO IF MESSAGE HAS BEEN OUTPUT. 02654 ENA 3 ****COSY E03**** THE FIRST CARD OF A MERGE 02655 RTJ ERRPRO INPUT DECK WAS NOT A DCK/ CARD. 02656 RAO* E03MRK 02657ÐÐE0305 RTJ MRGOUT OUTPUT THE BAD CARD. 02658 RTJ CHKEND CHECK FOR AN END/ CARD. 02659 JMP* E0307 02660 LDA WORKUN FOUND AN END/ CARD. 02661 SUB* ADRIU1 02662 SAN E0306 BAD DCK/ CARD WAS ON INPUT UNIT 2. 02663 RTJ* SETIU2 02664 RTJ MRGINP READ FROM INPUT UNIT 2. 02665 RTJ* SETIU1 02666E0306 JMP GETC32 02667E0307 RTJ MRGINP READ NEXT CARD. 02668 JMP* DCKCK1 02669 EJT 02670PEMARK BSS PEMARK(1) POSSIBLE ERROR MARKER. 02671ALTUN BSS ALTUN(1) ADDRESS OF ALTERNATE UNIT PARAMETER STRING. 02672* 02673ADRIU1 ADC ADBUF1 ABSOLUTE ADDRESS OF ADBUF1. 02674ADRIU2 ADC ADBUF2 ABSOLUTE ADDRESS OF ADBUF2. 02675* 02676* MERGE INPUT UNIT 1 PARAMETER STRING. 02677* 02678MRGIU1 BSS MRGIU1(1) LOGICAL UNIT NUMBER. 02679ADBUF1 ADC BUF1 ABSOLUTE ADDRESS OF BUF1. 02680M1 BSS M1(1) CURRENT VALUE OF 1ST SEQUENCE NUMBER. 02681N1 BSS N1(1) CURRENT VALUE OF 2ND SEQUENCE NUMBER. 02682ÐÐLASTM1 BSS LASTM1(1) PREVIOUS VALUE OF 1ST SEQUENCE NUMBER. 02683LASTN1 BSS LASTN1(1) PREVIOUS VALUE OF 2ND SEQUENCE NUMBER. 02684NAME1 BSS NAME1(3) CURRENT DECKNAME. 02685* 02686* MERGE INPUT UNIT 2 PARAMETER STRING. 02687* 02688MRGIU2 BSS MRGIU2(1) LOGICAL UNIT NUMBER. 02689ADBUF2 ADC BUF2 ABSOLUTE ADDRESS OF BUF2. 02690M2 BSS M2(1) CURRENT VALUE OF 1ST SEQUENCE NUMBER. 02691N2 BSS N2(1) CURRENT VALUE OF 2ND SEQUENCE NUMBER. 02692LASTM2 BSS LASTM2(1) PREVIOUS VALUE OF 1ST SEQUENCE NUMBER. 02693LASTN2 BSS LASTN2(1) PREVIOUS VALUE OF 2ND SEQUENCE NUMBER. 02694NAME2 BSS NAME2(3) CURRENT DECKNAME. 02695* 02696MRGOU BSS MRGOU(1) LOGICAL UNIT NUMBER OF MERGE OUTPUT UNIT. 02697* 02698AGREE NUM 0 ZERO WHEN DECKNAMES AGREE. 02699CKMNMK NUM 0 NZ WHEN M AND N VALUES HAVE NOT BEEN CHECKED. 02700 EJT 02701* SETIU1 SUBROUTINE 02702* 02703* SET WORKING UNIT AND I TO INPUT UNIT 1 PARAMETER STRING. 02704* SET ALTERNATE UNIT AND Q TO INPUT UNIT 2 PARAMETER STRING. 02705* 02706SETIU1 0 0 02707ÐÐ LDA* ADRIU1 02708 STA WORKUN 02709 STA- I 02710 LDQ* ADRIU2 02711 STQ* ALTUN 02712 JMP* (SETIU1) 02713 SPC 3 02714* SETIU2 SUBROUTINE 02715* 02716* SET WORKING UNIT AND I TO INPUT UNIT 2 PARAMETER STRING. 02717* SET ALTERNATE UNIT AND Q TO INPUT UNIT 1 PARAMETER STRING. 02718* 02719SETIU2 0 0 02720 LDA* ADRIU2 02721 STA WORKUN 02722 STA- I 02723 LDQ* ADRIU1 02724 STQ* ALTUN 02725 JMP* (SETIU2) 02726 SPC 3 02727* SWITCH SUBROUTINE 02728* 02729* SWITCH THE ALTERNATE UNIT WITH THE WORKING UNIT. 02730* 02731SWITCH 0 0 02732ÐÐ LDA WORKUN 02733 LDQ* ALTUN 02734 STA* ALTUN 02735 STQ WORKUN 02736 JMP* (SWITCH) 02737* 02738E08 0 0 02739 ENA 8 ****COSY E08**** DECKNAMES MATCH WHEN MERGING 02740 RTJ ERRPRO 02741 RTJ* REVIS OUTPUT THE REVISION. 02742 JMP* (E08) 02743 EJT 02744* START OF MERGE 02745* 02746MRG08 RTJ* SETIU2 SET WORKING UNIT TO INPUT UNIT 2. 02747 LDA- 5,Q 02748 SUB- 5,I CHECK FOR IDENTICAL DECKNAMES. 02749 SAN MRG09 02750 LDA- 6,Q 02751 SUB- 6,I 02752 SAN MRG09 02753 LDA- 7,Q 02754 SUB- 7,I 02755 SAN MRG09 02756 JMP* MRG10 02757ÐÐ* 02758MRG09 RAO* AGREE DECKNAMES DISAGREE. SET MARKER NON-ZERO. 02759 LDA* CKMNMK WAS GETMN CALLED FOR THE LAST DEL/, INS/, REM/ 02760 SAZ MRG095 02761 ENA 0 NO. CALL GETMN. 02762 STA* CKMNMK 02763 RTJ GETMN 02764 JMP E0567 GETMN ERROR RETURN. 02765MRG095 RTJ* REVIS OUTPUT REVISIONS UNTIL FIND A CONTROL CARD. 02766 RTJ GETMN DEL/, INS/, REM/ RETURN. CHECK SEQUENCE. 02767 JMP E0567 GETMN ERROR RETURN. 02768 JMP* MRG09+1 SEE GETCC FOR DCK/, END/, AND MRG/ RETURNS. 02769* 02770MRG10 STA* AGREE DECKNAMES AGREE. SET MARKER TO ZERO. 02771 RTJ MRGINP READ FROM INPUT UNIT 2. 02772 RTJ* GETCC LOOK FOR A CONTROL CARD IN BUF2. 02773 RTJ* E08 DCK/ CARD NOT FOLLOWED BY A CONTROL CARD. 02774 RTJ GETMN DEL/, INS/, REM/ RETURN. CHECK SEQUENCE. 02775 JMP E0567 GETMN ERROR RETURN. 02776 RTJ* SETIU1 SET WORKING UNIT TO INPUT UNIT 1. 02777 RTJ MRGOUT OUTPUT DCK/ CARD. 02778MRG11 RTJ MRGINP READ FROM INPUT UNIT 1. 02779* 02780MRG13 RTJ* GETCC LOOK FOR A CONTROL CARD IN BUF1. 02781 RTJ* E08 DCK/ CARD NOT FOLLOWED BY A CONTROL CARD. 02782ÐÐ RTJ GETMN DEL/, INS/, REM/ RETURN. CHECK SEQUENCE. 02783 JMP E0567 GETMN ERROR RETURN. 02784 RTJ* SETIU2 SET WORKING UNIT TO INPUT UNIT 2. 02785MRG14 LDA* M2 02786 SUB* M1 02787 SAP 1 02788 JMP* MRG16 M FROM UNIT 2 IS LESS THAN M FROM UNIT 1. 02789 SAZ 1 02790 JMP* MRG17 M FROM UNIT 1 IS LESS THAN M FROM UNIT 2. 02791 LDA* N2 02792 SUB* N1 02793 SAZ 1 02794 JMP* MRG20 M VALUES ARE EQUAL BUT N VALUES DISAGREE. 02795* 02796* M AND N VALUES FOR BOTH UNITS ARE EQUAL. 02797* 02798 RTJ* SETIU2 02799 RTJ CHKREM CHECK FOR A REM/ CONTROL CARD ON UNIT 2. 02800 JMP* MRG145 02801 JMP* MRG15 02802* 02803* M FROM UNIT 2 LESS THAN M FROM UNIT 1. 02804* 02805MRG16 LDA* N2 02806 SUB* M1 02807ÐÐ SAM 1 02808 JMP* MRG20 M FROM UNIT 1 IS GREATER THAN M FROM UNIT 2 02809* BUT NOT GREATER THAN N FROM UNIT 2. 02810 RTJ* SETIU2 02811 JMP* MRG21 02812* 02813* M FROM UNIT 1 LESS THAN M FROM UNIT 2. 02814* 02815MRG17 LDA* N1 02816 SUB* M2 02817 SAM 1 02818 JMP* MRG20 02819* BUT NOT GREATER THAN N FROM UNIT 1. 02820MRG18 RTJ* SETIU1 02821* 02822* M AND N FROM WORKING UNIT LESS THAN M FROM ALTERNATE UNIT. 02823* 02824 JMP* MRG21 02825* 02826* M FROM ONE UNIT FALLS BETWEEN M AND N OF THE OTHER UNIT. 02827* 02828MRG20 RAO PEMARK SET POSSIBLE ERROR MARKER. 02829 RTJ* SETIU2 02830 LDA* LASTM2 RESET THE VALUES OF M AND N. 02831 STA* M2 02832ÐÐ LDA* LASTN2 02833 STA* N2 02834* 02835MRG21 RTJ* REVIS OUTPUT THE REVISION. 02836 JMP* MRG155 02837* 02838MRG145 RTJ* SETIU1 02839 RTJ CHKREM CHECK FOR A REM/ CONTROL CARD ON UNIT 1. 02840 JMP* MRG20 02841* 02842MRG15 RAO PEMARK 02843 RAO REMMRK 02844 RTJ* REVIS OUTPUT THE REM/ CARD. 02845 RTJ* SWITCH 02846 RAO* CKMNMK SET MARKER TO CHECK M AND N VALUES LATER. 02847 RTJ* REVIS OUTPUT THE REMOVED REVISION. 02848 RTJ GETMN GET M AND N AND CHECK SEQUENCE. 02849 JMP E0567 GETMN ERROR RETURN. 02850 RTJ* SWITCH 02851 ENA 0 CLEAR MARKER AND CHECK M AND N FOR SEQUENCE 02852 STA CKMNMK ERRORS. 02853MRG155 RTJ GETMN 02854 JMP E0567 GETMN ERROR RETURN. 02855 JMP* MRG14 02856 EJT 02857ÐÐ* REVIS SUBROUTINE 02858* 02859* THIS SUBROUTINE OUTPUTS THE CARD CONTAINED IN THE WORKING 02860* BUFFER, THEN READS AND OUTPUTS REVISIONS FROM THE WORKING 02861* UNIT UNTIL A CONTROL CARD IS FOUND. 02862* ENTER WITH A CARD IMAGE IN THE WORKING BUFFER (GENERALLY A 02863* CONTROL CARD). 02864* EXIT WITH THE NEXT CONTROL CARD TO BE READ FROM THE WORKING 02865* UNIT IN THE BUFFER. 02866* EXIT TO THE RETURN ADDRESS IF THE NEW CONTROL CARD IS A 02867* DEL/, INS/, OR REM/ CARD. 02868* SEE GETCC SUBROUTINE FOR DCK/, MRG/, AND END/ CARD EXITS. 02869* 02870REVIS 0 0 02871 RTJ* MRGOUT 02872 RTJ MRGINP 02873 RTJ* GETCC 02874 JMP* REVIS+1 02875 LDA* REMMRK 02876 SAN REVIS1 02877 STA PEMARK 02878 STA ERRMRK 02879REVIS1 ENA 0 02880 STA* REMMRK 02881 JMP* (REVIS) 02882ÐÐ EJT 02883* GETCC SUBROUTINE 02884* 02885* DETERMINE THE TYPE OF CARD THAT WAS READ FROM THE WORKING 02886* UNIT. 02887* EXIT TO THE RETURN ADDRESS IF THE CARD IS NOT A CONTROL 02888* CARD OR TO THE RETURN ADDRESS +1 IF THE CARD IS A DEL/, 02889* INS/, OR REM/ CONTROL CARD. 02890* A MRG/ CONTROL CARD IS ILLEGAL AND TERMINATES THE JOB. 02891* IF A DCK/ CONTROL CARD IS FOUND, GETCC CHECKS FOR AN END/ 02892* CARD IN THE ALTERNATE UNITS BUFFER. IF AN END/ IS FOUND, 02893* GETCC EXITS TO MRG09. IF NO END/, THE EXIT IS TO MRG08. 02894* IF AN END/ CONTROL CARD IS FOUND, GETCC CHECKS FOR AN END/ 02895* CARD IN THE ALTERNATE UNITS BUFFER. IF AN END/ IS FOUND, 02896* THE MERGE IS COMPLETE AND GETCC EXITS TO COSY2. IF NO 02897* END/, THE EXIT IS TO MRG09. 02898* 02899GETCC 0 0 02900 LDQ WORKUN 02901 STQ- I ADDRESS OF WORKING UNITS PARAMETER STRING. 02902 LDQ- (ZERO),Q 02903 LDA- 5,Q 02904 SUB SLASH 02905 SAZ 1 02906 JMP* (GETCC) NOT A CONTROL CARD. 02907ÐÐ RTJ CHKDEL CHECK FOR A DEL/ CONTROL CARD. 02908 JMP* *+2 02909 JMP* GETCC1 FOUND A DEL/. 02910 RTJ CHKINS CHECK FOR AN INS/ CONTROL CARD. 02911 JMP* *+2 02912 JMP* GETCC1 FOUND AN INS/. 02913 RTJ CHKREM CHECK FOR A REM/ CONTROL CARD. 02914 JMP* GETCC2 02915* 02916GETCC1 RAO* GETCC FOUND DEL/, INS/, OR REM/. 02917 JMP* (GETCC) 02918* 02919GETCC2 RTJ CHKDCK CHECK FOR A DCK/ CARD. 02920 JMP* GETCC3 02921* 02922 LDA* REMMRK 02923 SAN 4 02924 STA PEMARK 02925 STA ERRMRK 02926 ENA 0 02927 STA* REMMRK 02928 STA- 1,I 02929 STA- 2,I 02930 LDA- (ZERO),Q 02931 STA- 5,I 02932ÐÐ LDA- 1,Q 02933 STA- 6,I 02934 LDA- 2,Q 02935 STA- 7,I 02936* 02937 LDA AGREE 02938 SAN 1 02939 JMP* GETCC4 LAST DECKNAMES MATCHED. 02940 LDA* ENDCNT WILL BE NON-ZERO IF AN END/ HAS BEEN 02941 SAN 2 DETECTED ON THE OTHER INPUT UNIT. 02942 JMP MRG08 NO END/. 02943 JMP MRG09 02944* 02945GETCC3 RTJ CHKEND CHECK FOR AN END/ CARD. 02946 JMP* GETCC5 02947* 02948GETC32 LDA* REMMRK 02949 SAN 4 02950 STA PEMARK 02951 STA ERRMRK 02952 ENA 0 02953 STA* REMMRK 02954 STA- 1,I 02955 STA- 2,I 02956 LDA* ENDCNT ENDCNT WILL BE NON-ZERO IF AN END/ HAS BEEN 02957ÐÐ SAZ GETC35 DETECTED ON OTHER UNIT. 02958 RTJ* MRGOUT OUTPUT AN END/ CARD. 02959 LDA MRGOU 02960 STA TABLU 02961 RTJ WEOF IF MAG TAPE WRITE AN EOF, NOT MAG 02962* TAPE OUTPUT BLANK LEADER OR WRITE 02963* END OF FILE CARD. 02964 LDA* ENDOUT IF MAG TAPE, REWIND. 02965 RTJ MTSTAT 02966 NOP 0 NO P+1 RETURN NEEDED. 02967 JMP COSY2 END OF MERGE. 02968* 02969GETC35 STA- 5,I 02970 STA- 6,I 02971 STA- 7,I 02972 RAO* ENDCNT 02973GETCC4 RTJ SWITCH 02974 JMP MRG09 02975* 02976GETCC5 RTJ CHKMRG CHECK FOR A MRG/ CARD. 02977 JMP* (GETCC) NOT A CONTROL CARD. 02978* 02979E04 LDA MRGOU SET THE LOGICAL UNIT NUMBER AND ASCII BIT IN 02980 STA* E0407 02981 RTJ- (REQPRO) OUTPUT AN END/ CARD ON THE MRG OUTPUT UNIT. 02982ÐÐ* 02983* FWRITE MRGOU,E0408,ENDCD,6,A,0,1,0,0,D 02984* 02985 VFD N1/0,N1/1,N5/6,N1/0,N4/0,N4/1 02986 ADC E0408 02987 NUM 0 02988E0407 NUM 0 02989 NUM 6 02990 ADC ENDCD 02991* 02992 JMP- (DISP) 02993* 02994E0408 ENA 4 ****COSY E04**** FOUND A MRG/ CARD WITHIN 02995E0402 RTJ ERRPRO A REVISIONS DECK. 02996 RTJ* MRGOUT OUTPUT THE MRG/ CARD. 02997 JMP COSY6 02998* 02999************************** 03000* 03001REMMRK BSS REMMRK(1) 03002ENDCNT BSS ENDCNT(1) END/ CARD COUNTER. 03003ENDOUT ADC MRGWRT+1 03004 EJT 03005* MRGOUT SUBROUTINE 03006* 03007ÐÐ* WRITE A REVISION FROM THE WORKING BUFFER ON THE MERGE 03008* OUTPUT UNIT AND STDPRT. 03009* 03010MRGOUT 0 0 03011 LDQ =XBUF2 03012 LDA WORKUN 03013 SUB ADRIU1 03014 SAN 2 03015 LDQ =XBUF1 03016 STQ* MRGWRT+6 03017 INQ -3 03018 STQ* MRGLST+6 03019 LDA ERRMRK 03020 SAN 3 03021 LDA PEMARK 03022 SAZ 1 03023 JMP* MRGOT1 03024 LDQ (WORKUN) 03025 INQ -3 03026 LDA* BLANKS 03027 STA- 1,Q 03028 STA- 2,Q 03029 LDA MRGOU 03030 STA* MRGOT0 03031* 03032ÐÐ* WRITE REVISION ON MERGE OUTPUT UNIT. 03033* 03034MRGWRT RTJ- (REQPRO) 03035* 03036* FWRITE MRGOU,MRGLST,BUF1 OR BUF2,46,A,0,1,0,0,D 03037* 03038 VFD N1/0,N1/1,N5/6,N1/0,N4/0,N4/1 03039 ADC MRGLST 03040 NUM 0 03041MRGOT0 VFD N3/0,N1/1,N2/0,N10/0 03042 NUM 46 03043 0 0 03044* 03045 JMP- (DISP) 03046* 03047MRGOT1 LDQ (WORKUN) 03048 INQ -3 03049 LDA* STARS 03050 STA- 1,Q PRINTER BUFFER. 03051 STA- 2,Q 03052MRGLST RTJ- (REQPRO) 03053* 03054* FWRITE CSTDPT,MRGOT2,BUF1ORBUF2,46,A,0,1,0,0,D 03055* 03056 VFD N1/0,N1/1,N5/6,N1/0,N4/0,N4/1 03057ÐÐ ADC MRGOT2 03058 NUM 0 03059MRGT15 VFD N3/0,N1/1,N2/0,N10/0 03060 NUM 49 03061 0 0 03062* 03063 JMP- (DISP) 03064* 03065MRGOT2 JMP* (MRGOUT) 03066* 03067BLANKS ALF 1, 03068STARS ALF 1,** 03069 EJT 03070* MRGINP SUBROUTINE 03071* 03072* READ A REVISION FROM THE WORKING UNIT INTO THE WORKING BUF. 03073* 03074MRGINP 0 0 03075 LDA WORKUN 03076 SUB ADRIU1 03077 SAZ MRGI01 03078 JMP* MRGIN3 03079MRGI01 RAO* MSADDR 03080 LDA* MRGINP SET RETURN AFTER SHORT READ CHECK 03081 STA REVCMP 03082ÐÐ LDA MRGIU1 03083 STA DME4 SET REVISION LU INTO READ REQS. 03084 STA* MRGI26 03085 AND- CLRMOD CLEAR MODE BIT FOR STATUS REQUEST. 03086 RTJ CKDEV CHECK TYPE OF DEVICE. 03087 JMP* MRGI25 MASS STORAGE DEVICE. 03088 RTJ- (REQPRO) NON MASS STORAGE DEVICE. 03089* 03090* FREAD MRGIU1,MRGIN5,BUF1,46,A,0,1,0,0,D 03091* 03092* INDIRECT THRU PARAMETER LIST AT REVREQ 03093* 03094 VFD N1/0,N1/1,N5/16,N1/0,N8/0 03095 ADC REVREQ 03096* 03097 JMP- (DISP) 03098* 03099MRGI25 RTJ- (REQPRO) 03100* 03101* FREAD MRGIU1,MRGIN5,BUF1,46,A,0,1,0,0,D 03102* 03103 VFD N1/0,N1/1,N5/4,N1/0,N4/0,N4/1 03104 ADC MRGIN5 03105 NUM 0 03106MRGI26 VFD N3/0,N1/1,N2/0,N10/0 03107ÐÐ NUM 46 03108 ADC BUF1 03109 NUM 0 03110MSADDR NUM 0 03111* 03112 JMP- (DISP) 03113* 03114MRGIN3 LDA MRGIU2 03115 STA* MRGIN4 03116MRGI37 RTJ- (REQPRO) 03117* 03118* FREAD MRGIN2,MRGIN5,BUF2,46,A,0,1,0,0,D 03119* 03120 VFD N1/0,N1/1,N5/4,N1/0,N4/0,N4/1 03121 ADC MRGIN6 03122 NUM 0 03123MRGIN4 VFD N3/0,N1/1,N2/0,N10/0 03124 NUM 46 03125 ADC BUF2 03126* 03127 JMP- (DISP) 03128* 03129MRGIN6 LDA* MRGIN4 CHECK FOR SHORT READ 03130 ALS 1 03131 SAM MRGIN9 03132ÐÐ JMP* MRGIN5 POS. NOT A SHORT READ 03133MRGIN9 LDA =XBUF2+45 PICK UP LAST WORD ADDRESS 03134 STA- I 03135 TCA Q 03136 ADQ BUF2+45 DISTANCE TO LAST WORD READ 03137 INQ -1 03138 LDA- (ZERO),B IF SHORT READ REPLACE $FF WITH $20 03139 ALS 8 03140 SAP MRGIN7 IF POS. BLANK REST OF BUFFER 03141 ALS 8 03142 AND =N$FF20 03143 STA- (ZERO),B 03144MRGIN7 LDA* BLANKS BLANK REST OF BUFFER IN CASE 03145MRGIN8 INQ 1 OF RUBOUT ON TTY 03146 STA- (ZERO),B 03147 SQP MRGIN5 03148 JMP* MRGIN8 03149MRGIN5 JMP* (MRGINP) 03150 EJT 03151* XFER ROUTINE 03152* 03153* THIS SUBROUTINE READS CARD IMAGES FROM INPUT UNIT 1 AND 03154* WRITES THEM ON MASS STORAGE SCRATCH. THE TRANSFER IS 03155* COMPLETE WHEN AND END/ CARD IS READ AND WRITTEN. 03156* 03157ÐÐXFER STA* MSADDR 03158 STA* SECTNO 03159XFER1 RAO* SECTNO INCREMENT THE MASS STORAGE SECTOR NUMBER. 03160 RTJ BLKREV 03161 LDA MRGIU1 03162 STA* XFER16 03163XFER15 RTJ- (REQPRO) 03164* 03165* FREAD MRGIU1,XFER2,BUF1,46,A,0,1,0,0,D 03166* 03167 VFD N1/0,N1/1,N5/4,N1/0,N4/0,N4/1 03168 ADC XFER2 03169 NUM 0 03170XFER16 VFD N3/0,N1/1,N2/0,N10/0 03171 NUM 46 03172 ADC BUF1 03173* 03174 JMP- (DISP) 03175* 03176XFER2 RTJ- (REQPRO) 03177* 03178* FWRITE STDSCR,XFER3,BUF1,46,A,0,1,0,0,D 03179* 03180 VFD N1/0,N1/1,N5/6,N1/0,N4/0,N4/1 03181 ADC XFER3 03182ÐÐ NUM 0 03183XFER17 VFD N3/0,N1/1,N2/0,N10/0 03184 NUM 46 03185 ADC BUF1 03186 NUM 0 03187SECTNO NUM 0 03188* 03189 JMP- (DISP) 03190* 03191XFER3 RTJ CHKEND 03192 JMP* XFER1 03193 LDA* XFER17 03194 STA MRGIU1 03195 JMP MRG06 03196 EJT 03197E0567 RTJ ERRPRO ****COSY E05, E06, OR E07**** 03198 LDQ WORKUN 03199 LDA- 3,Q 03200 STA- 1,Q RESET VALUES OF M AND N. 03201 LDA- 4,Q 03202 STA- 2,Q 03203 RTJ REVIS OUTPUT BAD REVISION. 03204 JMP GETMN+1 03205 EJT 03206 ALF 3, 03207ÐÐBUF2 BSS BUF2(40) INPUT BUFFER FOR MERGE INPUT UNIT 2. 03208 END CUDDLY 03209 NAM REBFDD K12 A ITOS CCS 3.0 SL-149 00001* REBUILD FILE DEFINITION DIRECTORY ROUTINE 00002* CREDIT COLLECTION SYSTEM VERSION 3.0 00003* DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00004* COPYRIGHT CONTROL DATA CORPORTION 1979 00005 SPC 2 00006**** FUNCTION 00007* 00008* THIS ROUTINE REBUILDS THE FILE DEFINITION DIRECTORY. UPON 00009* EXECUTION RBUILD CHECKS WHETHER OR NOT ITOS HAS BEEN DISABLED AND 00010* IF THE PROGRAM IS BEING EXECUTED FROM THE MASTER CONSOLE. IF 00011* YES, EXECUTION COMTINUES, IF NO, EXECUTION IS ABORTED. NEXT, 00012* RBUILD REQUESTS THE OPERATOR TO ENTER THE DISK UNIT NUMBER. 00013* THE NUMBER IS INPUT AND VALIDATED. NEXT, THE OPERATOR IS 00014* REQUESTED TO TURN OFF THE PROTECT SWICH. FOLLOWING THE SWITCH 00015* TURNOFF, THE FDD IS REBUILT. UPON COMPLETION, A MESSAGE IS OUT- 00016* PUT TO NOTIFY THE OPERATOR. THE SYSTEM MUST BE AUTOLOADED TO 00017* CONTINUE. 00018* 00019* THE REASON THAT THE PROTECT SWITCH MUST BE TURNED OFF IS TO 00020* PERMIT RBUILD TO PEFORM DIRECT DISK I/O WITHOUT BEING TRAPPED 00021* OUT BY THE ITOS EXEC. 00022* 00023ÐÐ* IF A DUPLICATE NAME/OWNER IS NOTED, THE OPERATOR IS NOTIFIED AND 00024* REQUESTED TO ENTER A NEW NAME/OWNER FOR THE FILE. THE OLD NAME/ 00025* OWNER AND NEW NAME/OWNER STRINGS ARE LOGGED ONTO THE SYSTEM 00026* OUTPUT PRINT UNIT. 00027* 00028 ENT REBFDD 00029* 00030* EXTERNALS 00031* 00032 EXT PGMOUT PROGRAM OUT ROUTINE 00033 EXT PGMIN PROGRAM IN ROUTINE 00034 EXT JOBIND JOB PROCESSOR ACTIVE FLAG 00035 EXT SWTCH LIBEDT ACTIVE FLAG 00036 EXT EMPSTP 00037 EXT DMICOD 00038 EXT TBLADR 00039 EXT MIBX 00040 EXT EFSTOR 00041 EXT PARTBL 00042 EXT TSNABL 00043 EJT 00044* EQUIVALENCES 00045 EQU DISP($EA) 00046 EQU NUMFDB(10) NUMBER OF FDS'S/FDB 00047* 00048ÐÐ EQU ZERO($2) SYSTEM ZERO 00049 EQU ONEMSK(3) ONE MASK TABLE 00050 EQU ADRECT($E9) ADDRESS OF EXTENDED COMMUNICATION TABLE 00051 EQU LOG1A(28) ADDRESS OF LOG1A TABLE (IN EXT COM TABLE) 00052 EQU MMLUTB(29) FWA OF FM LOGICAL UNIT TABLE (IN EXT COM TBL) 00053 EQU TERMLU($1005) TERMINAL LOGICAL UNIT 00054* 00055 EQU LABMSB(21) LABEL SECTOR MSB 00056 EQU LABLSB(22) LABEL SECTOR LSB 00057* VOLUME LABEL EQUATES 00058* 00059 EQU VLFDD1(28) FILE DEFINITION DIR. SECTOR ADDRESS - MSB 00060 EQU VLFDD2(29) FILE DEFINITION DIR. SECTOR ADDRESS - LSB 00061 EQU VLNFDB(32) NO. OF BLOCKS IN FDD 00062 EQU VLMAXF(30) MAX NUMBER OF FILES PERMITTED FOR VOLUME 00063 EQU VLCURF(31) CURRENT NUMBER OF FILES ON VOLUME 00064 EQU VLNXTB(33) NEXT AVAILABLE FDD BLOCK 00065 EJT 00066REBFDD RTJ PGMIN CHECK IF USER IS RUNNING FROM MASTER CONSOLE 00067 ADC IDUSER IN INTERACTIVE MODE. 00068 ADC LUNIT 00069 ADC MODE 00070 ADC NOPORT 00071* 00072 LDA LUNIT STORE LOG UNIT FOR MESSAGE I/O 00073ÐÐ ADD =N$1000 00074 STA MESLU 00075 LDA NOPORT 00076 SAZ RB10 SKIP IF RUNNING FROM MASTER TERMINAL 00077 ENQ 1 00078 JMP EXIT1 GO OUTPUT ERROR MESSAGE 00079RB10 LDQ =XTSNABL NEXT, CHECK IF ITOS HAS BEEN DISABLED 00080 LDA- (ZERO),Q 00081 SAZ RB20 SKIP IF DISABLED 00082 ENQ 0 GO OUTPUT ERROR MESSAGE 00083 JMP EXIT1 00084RB20 LDA MODE CHECK IF IN INTERACTIVE MODE 00085 SAZ RB25 SKIP IF YES 00086 ENQ 2 00087 JMP EXIT1 GO OUTPUT ERROR MESSAGE 00088RB25 RTJ- ($F4) ASSURE SYSTEM PRINT UNIT IS AVAILABLE 00089 ADC $4C44 00090 ADC RB30 00091 ADC 0 00092 ADC $8FB 00093 ADC 4 00094 ADC SBUFFR 00095 JMP- (DISP) 00096SBUFFR NUM $2020,$A0D 00097RB30 LDA JOBIND CHECK IF JOB PROCESSOR ACTIVE 00098ÐÐ SAN RB32 SKIP IF YES 00099 LDA SWTCH CHECK IF LIBEDT ACTIVE 00100 SAZ RB34 SKIP IF NO 00101RB32 ENQ 8 GO OUTPUT ERROR MESSAGE 00102 JMP EXIT1 00103 EJT 00104RB34 ENQ 4 00105 RTJ MESSAG OUTPUT MESSAGE TO REQUEST DISK UNIT NUMBER 00106 RTJ INPUT INPUT THE RESPONSE 00107 LDA INPBUF GET THE UNIT NUMBER 00108 ARS 8 00109 AND- ONEMSK+3 CONVERT TO RIGHT ADJUSTED BINARY NUMBER 00110 ENQ MMLUTB GET ACTUAL LOGICAL UNIT NUMBER 00111 LDQ- (ADRECT),Q 00112 AAQ Q 00113 INQ 1 00114 LDA- (ZERO),Q 00115 STA- I 00116 LDA- (I) 00117 AND- ONEMSK+7 STORE INTO REQUEST PARAMETER LIST 00118 STA LU 00119 ENQ LOG1A 00120 LDQ- (ADRECT),Q 00121 ADQ LU 00122 LDQ- (ZERO),Q GET PDT ADDRESS OF THE DISK 00123ÐÐ INQ 8 00124 LDA- (ZERO),Q 00125 ARS 11 00126 AND- ONEMSK+2 7 00127 INA -2 CHECK CLASS CODE 00128 SAZ RB40 OK 00129 ENQ 5 GO OUTPUT ERROR MESSAGE 00130 JMP EXIT1 00131RB40 LDA- LABMSB,I GET ADDRESS OF LABEL SECTOR ADDRESS 00132 STA* MSBA STORE IN I/O REQUESTS 00133 STA MSBD 00134 LDA- LABLSB,I 00135 STA* LSBA 00136 STA LSBD 00137 EJT 00138 RTJ MMREAD READ IN VOLUME LABEL 00139BAA ADC VLBUFR 1. BUFFER ADDRESS 00140MSBA ADC 0 2. MSB SECTOR ADDRESS 00141LSBA ADC 0 3. LSB SECTOR ADDRESS 00142 SQP RB50 SKIP IF NO I/O ERROR 00143 ENQ 3 00144 JMP EXIT1 GO NOTE I/O ERROR 00145* 00146RB50 LDQ* BAA CHECK IF FDD HAS BEEN GENERATED 00147 LDA- VLNFDB,Q 00148ÐÐ SAN RB60 SKIP IF YES 00149 ENQ 6 00150 JMP EXIT1 GO NOTE ERROR AND ABORT 00151* 00152RB60 ENQ 7 00153 RTJ MESSAG REQUEST PROTECT SWITCH TURN OFF 00154 RTJ INPUT WAIT ON CR TO CONTINUE 00155 EJT 00156 LDQ EMPSTP 00157REJ ENA 0 DISABLE THE TIMER 00158 OUT REJ-* 00159 LDA DMICOD 00160 AND- ONEMSK+14 00161 TRA Q 00162 LDA TBLADR 00163 DMI DISABLE THE MICRO-INTERRUPT 00164 LDQ =XPARTBL 00165 LDA- (ZERO),Q SET UP TO MOVE ALL CODE FROM LABEL 'RB90' 00166 STA* STORE TO END OF RBUILD TO FILE MANAGER 00167 LDA =XRB90 PARTITION 00168 STA* LOAD DEFINE LOAD AND STORE ADDRESSES 00169* 00170 LDQ =XENDADR-RB90 SET NO. OF WORDS TO MOVE 00171 INQ -1 00172RB70 LDA* (LOAD),Q MOVE ONE WORD 00173ÐÐ STA* (STORE),Q 00174 INQ -1 DECREMENT 00175 SQM RB80 SKIP IF DONE 00176 JMP* RB70 GO MOVE NEXT WORD 00177 SPC 2 00178STORE NUM 0 00179LOAD NUM 0 00180 SPC 2 00181RB80 JMP* (STORE) EXECUTE MOVED PROGRAM 00182 EJT 00183* SET UP ABSOLUTE BUFFER ADDRESSES 00184RB90 RTJ- ($F4) DISABLE ERROR LOGGING ROUTINE 00185 ADC $26FF 00186 ADC EFSTOR 00187 RAO MIBX DISABLE THE MANUAL INTERRUPT 00188 SPC 2 00189 RTJ* HERE 00190HERE NUM 0 00191 LDA* HERE 00192 ADD =XVLBUFR-HERE 00193 STA BAD FIRST, SET ADDRESS OF VOLUME LABEL BUFFER 00194 INA 96 NEXT, SET ADDRESS OF FDD BLOCK BUFFER 00195 STA BAB 00196 STA BAE 00197 STA BAF 00198ÐÐ STA BAG 00199 INA 96 NEXT, SET ADDRESS OF FCB BUFFER 00200 STA BAC 00201 LDA* HERE 00202 ADD =XNAMBUF-HERE 00203 STA BA1 SET UP MESSAGE MONITOR REQUESTS 00204 ADD =XRB370-NAMBUF 00205 STA CPA1 00206 ADD =XRB371-RB370 RETURN ADDRESS FOR 'OWNER' INPUT 00207 STA CPA11 00208 ADD =XRB390-RB371 00209 STA CPA2 00210 ADD =XMESS0F-RB390 00211 STA BA2 00212 LDA BA1 BUFFER ADDRESS FOR 'OWNER' INPUT 00213 INA 4 00214 STA BA11 00215 LDA* HERE 00216 ADD =XMSG10-HERE 00217 STA CPA3 00218 EJT 00219* CLEAR ALL FDD BLOCKS TO 0 00220* 00221RB100 LDQ* BAD COMPUTE ADDRESS OF NEXT FDD BLOCK 00222 LDA- VLFDD2,Q 00223ÐÐ LDQ- VLFDD1,Q 00224 ADD* FDDIND 00225 SAP RB110 00226 INQ 1 00227 AND- ONEMSK+14 00228RB110 STQ* MSBB STORE ADDRESS 00229 STA* LSBB 00230* 00231 RTJ MMWRIT WRITE OUT ZEROED FDB 00232BAB ADC 0 1. BUFFER ADDRESS 00233MSBB ADC 0 2. MSB SECTOR ADDRESS 00234LSBB ADC 0 3. LSB SECTOR ADDRESS 00235* 00236 SQP RB120 SKIP IF NO I/O ERROR 00237 ENQ 3 00238 JMP EXIT2 GO NOTE I/O ERROR 00239* 00240RB120 RAO* FDDIND BUMP FDD INDEX 00241 LDQ* BAD 00242 LDA- VLNFDB,Q 00243 SUB* FDDIND CHECK IF ALL BLOCKS HAVE BEEN CLEARED 00244 SAZ RB130 SKIP IF YES 00245 JMP* RB100 00246* 00247RB130 LDA- VLNFDB,Q COMPUTE NO. OF PRIMARY FDD BLOCKS FOR 00248ÐÐ ARS 1 00249 STA* NBLOCK 00250 LDQ* BAD 00251 INA +1 00252 STA- VLNXTB,Q SET NEXT AVAILABLE FDD INDEX 00253 SPC 2 00254* PREPARE TO READ AND CHECK ALL FCBS 00255RB140 LDQ* MSBB COMPUTE MM ADDRESS OF NEXT FCB 00256 LDA* LSBB (USE END OF FDD AS BASE ADDRESS) 00257 ADD* FCBTIN 00258 SAP RB150 00259 INQ 1 00260 AND- ONEMSK+14 00261RB150 STQ* MSBC 00262 STA* LSBC 00263 EJT 00264 RTJ MMREAD READ IN THE FCB 00265BAC ADC 0 1. BUFFER ADDRESS 00266MSBC ADC 0 2. MSB SECTOR ADDRESS 00267LSBC ADC 0 3. LSB SECTOR ADDRESS 00268* 00269 SQP RB160 SKIP IF NO I/O ERROR 00270 ENQ 3 00271 JMP EXIT2 GO NOTE I/O ERROR 00272* 00273ÐÐRB160 LDQ* BAC CHECK IF FCB DEFINES A FILE 00274 LDA- 24,Q IF ALL OF NAME FIELD IS 0, NO FILE IS 00275 SAN RB170 DEFINED 00276 LDA- 25,Q 00277 SAN RB170 00278 LDA- 26,Q 00279 SAN RB170 00280 LDA- 27,Q 00281 SAZ RB180 00282RB170 JMP* RB200 FILE IS DEFINED 00283* 00284RB180 LDQ BAD CHECK IF ALL OF FCB HAS BEEN CHECKED 00285 LDA- VLMAXF,Q 00286 SUB* FCBTIN 00287 SAZ RB185 SKIP IF DONE 00288 RAO* FCBTIN BUMP FCBT INDEX 00289 JMP* RB140 GO READ NEXT FCB 00290 SPC 2 00291* ALL FCBS HAVE BEEN CHECKED 00292RB185 LDA* NUMFIL RESET NO. OF FILES IN LABEL 00293 STA- VLCURF,Q 00294* 00295RB190 RTJ MMWRIT WRITE OUT UPDATED VOLUME LABEL 00296BAD ADC 0 1. BUFFER ADDRESS 00297MSBD ADC 0 2. MSB SECTOR ADDRESS 00298ÐÐLSBD ADC 0 3. LSB SECTOR ADDRESS 00299* 00300 SQP RB192 SKIP IF NO I/O ERROR 00301 ENQ 3 00302 JMP EXIT2 GO NOTE ERROR 00303 EJT 00304RB192 RTJ MMWRIT WRITE OUT RESIDENT FDD BLOCK 00305BAE ADC 0 00306MSBE ADC 0 00307LSBE ADC 0 00308* 00309 SQP RB194 SKIP IF NO I/O ERROR 00310 ENQ 3 00311 JMP EXIT2 GO NOTE ERROR 00312* 00313RB194 ENQ 1 00314 JMP EXIT2 GO OUTPUT COMPLETION MESSAGE 00315 EJT 00316IDUSER BZS IDUSER(4) USER ID 00317LUNIT NUM 0 MSOS LU OF TERMINAL 00318MODE NUM 0 MODE OF OPERATION 00319NOPORT NUM 0 USER TERMINAL PORT NUMBER 00320* 00321FDDIND NUM 0 INDEX TO THE FDD 00322FCBTIN NUM 1 INDEX TO THE FCBT 00323ÐÐNUMFIL NUM 0 NUMBER OF FILES FOUND 00324TEMP1 NUM 0 TEMPORARY STORAGE 00325TEMP2 NUM 0 TEMPORARY STORAGE 00326TEMP3 NUM 0 00327SAVIND NUM 0 SAVED FDD INDEX 00328RESBIN NUM $7FF RESIDENT FDD BLOCK INDEX 00329FDSIND NUM 0 FDS INDEX 00330NBLOCK NUM 0 NO. OF PRIMARY FDD BLOCKS 00331 EJT 00332RB200 LDA- 24,Q FCB DEFINES A FILE, HASH INTO THE FDD 00333 ADD- 25,Q 00334 AND- ONEMSK+14 00335 ADD- 26,Q 00336 AND- ONEMSK+14 00337 ADD- 27,Q 00338 AND- ONEMSK+14 00339 ADD- 28,Q 00340 AND- ONEMSK+14 00341 ADD- 29,Q 00342 AND- ONEMSK+14 00343 ADD- 30,Q 00344 AND- ONEMSK+14 00345 ADD- 31,Q 00346 AND- ONEMSK+14 00347 CLR Q 00348ÐÐ DVI* NBLOCK DIVIDE SUM BY NO. OF BLOCKS 00349 TRQ A USE REMAINDER+1 AS FDD INDEX 00350 INA 1 00351 LDQ* BAD 00352 STQ- I 00353 SPC 2 00354RB210 STA* SAVIND SAVE THIS INDEX 00355 INA -1 00356 ADD- VLFDD2,I ADD TO ADDRESS OF FDD 00357 LDQ- VLFDD1,I 00358 SAP RB220 00359 INQ 1 00360 AND- ONEMSK+14 00361RB220 STQ* TEMP1 SAVE ADDRESS OF NEEDED FDD BLOCK 00362 STA* TEMP2 00363* 00364 LDA* SAVIND CHECK IF NEEDED BLOCK IS CURRENTLY RESIDENT 00365 SUB* RESBIN 00366 SAN RB230 SKIP IF NO 00367 JMP* RB250 00368* 00369RB230 LDA* RESBIN CHECK IF BLOCK IN CORE NOW 00370 SUB =N$7FF 00371 SAZ RB240 SKIP IF NO 00372 EJT 00373ÐÐ RTJ MMWRIT WRITE OUT THE BLOCK 00374BAF ADC 0 1. FDB BUFFER ADDRESS 00375MSBF ADC 0 2. MSB SECTOR ADDRESS 00376LSBF ADC 0 3. LSB SECTOR ADDRESS 00377* 00378 SQP RB240 SKIP IF NO I/O ERROR 00379 ENQ 3 00380 JMP EXIT2 GO NOTE I/O ERROR 00381* 00382RB240 LDA* SAVIND SET RESIDENT BLOCK INDEX 00383 STA* RESBIN 00384 LDQ* TEMP1 00385 LDA* TEMP2 00386 STQ* MSBG SET MSB/LSB FOR READ 00387 STA* LSBG 00388 STQ* MSBF ALSO SET IT FOR WRITE OUT 00389 STA* LSBF 00390 STQ* MSBE ALSO, SET IT FOR LAST WRITE 00391 STA* LSBE 00392* 00393 RTJ MMREAD READ IN THE REQUIRED BLOCK 00394BAG ADC 0 00395MSBG ADC 0 00396LSBG ADC 0 00397* 00398ÐÐ SQP RB250 SKIP IF NO I/O ERROR 00399 ENQ 3 00400 JMP EXIT2 GO NOTE ERROR 00401* 00402RB250 CLR A CLEAR FDS INDEX 00403 STA* FDSIND 00404* 00405* CHECK IF FDSINDTH FDS DEFINES A FILE 00406RB260 LDA* FDSIND 00407 MUI =N9 00408 ADD* BAG 00409 INA 1 00410 STA* TEMP3 SET ABSOLUTE ADDRESS OF THIS ENTRY, SAVE IT 00411 STA- I 00412 LDA- (I) CHECK IF NAME FIELD IS ZERO 00413 SAN RB270 00414 LDA- 1,I 00415 SAN RB270 00416 LDA- 2,I 00417 SAN RB270 00418 LDA- 3,I 00419 SAN RB270 00420 JMP* RB320 FIELD IS ZERO. USE IT FOR NEW FDS 00421RB270 LDQ BAC FDS HAS NAME. CHECK FOR DUPLICATE NAME 00422 LDA- 24,Q 00423ÐÐ SUB- (I) 00424 SAN RB275 00425 LDA- 25,Q 00426 SUB- 1,I 00427 SAN RB275 00428 LDA- 26,Q 00429 SUB- 2,I 00430 SAN RB275 00431 LDA- 27,Q 00432 SUB- 3,I 00433 SAN RB275 00434 LDA- 28,Q 00435 SUB- 4,I 00436RB275 SAN RB280 00437 LDA- 29,Q 00438 SUB- 5,I 00439 SAN RB280 00440 LDA- 30,Q 00441 SUB- 6,I 00442 SAN RB280 00443 LDA- 31,Q 00444 SUB- 7,I 00445 SAN RB280 00446 JMP* RB350 NAME WAS DUPLICATE - REPORT IT AND GET NEW 00447 SPC 2 00448ÐÐ* FDS WAS IN USE. 00449RB280 RAO* FDSIND BUMP FSD INDEX 00450 LDA* FDSIND CHECK IF LAST FSD IN FDB 00451 INA -NUMFDB 00452 SAZ RB290 SKIP IF YES 00453 JMP* RB260 GO CHECK NEXT FDS 00454* 00455RB290 LDA* (BAG) CHECK IF THIS FDB POINTS TO AN OVERFLOW FDB 00456 LDQ BAD SET I TO VOLUME LABEL BUFFER ADDRESS 00457 STQ- I 00458 SAZ RB300 SKIP IF NO 00459 JMP* RB210 GO READ IN THAT BLOCK OF THE FDD 00460 EJT 00461RB300 LDA- VLNXTB,I SAVE NEXT FDB BLOCK INDEX 00462 STA TEMP3 00463 RAO- VLNXTB,I BUMP NEXT BLOCK NUMBER IN LABEL 00464 INA 1 00465 LDA- VLNFDB,I 00466 INA 1 00467 SUB- VLNXTB,I CHECK IF CURRENT NEW FDB EXISTS 00468 SAP RB310 SKIP IF YES 00469 ENQ 4 00470 JMP EXIT2 GO NOTE ERROR - OUT OF SPACE 00471* 00472RB310 LDA TEMP3 RESET A TO BLOCK INDEX 00473ÐÐ STA* (BAG) STORE IT INTO CURRENT BLOCK AS OVERFLOW 00474* POINTER 00475 JMP* RB210 GO READ IN THAT BLOCK OF THE FDD 00476 SPC 2 00477* FDS WAS CLEAR - USE IT FOR CURRENT FILE 00478RB320 LDQ BAC 00479 LDA- 24,Q STORE NAME/OWNER STRING IN FDS 00480 STA- (I) 00481 LDA- 25,Q 00482 STA- 1,I 00483 LDA- 26,Q 00484 STA- 2,I 00485 LDA- 27,Q 00486 STA- 3,I 00487 LDA- 28,Q 00488 STA- 4,I 00489 LDA- 29,Q 00490 STA- 5,I 00491 LDA- 30,Q 00492 STA- 6,I 00493 LDA- 31,Q 00494 STA- 7,I 00495 LDA FCBTIN STORE FCBT INDEX 00496 INA -1 00497 STA- 8,I 00498ÐÐ RAO NUMFIL BUMP NUMBER OF FILES FOUND 00499 JMP RB180 GO CHECK FOR NEXT FCB 00500 EJT 00501* CURRENT FILE NAME WAS A DUPLICATE OF PREVIOUS 00502* NAME/OWNER. 00503* 00504RB350 STQ* BAH 00505 INQ 24 OUTPUT MESSAGE TO NOTIFY OPERATOR OF PROBLEM 00506 STQ- I AND TO REQUEST ENTRY OF NEW NAME/ OWNER 00507 STQ* TEMP4 00508 ENQ 7 00509RB355 LDA- (ZERO),B MOVE 8 WORDS TO OUTPUT MESSAGE 00510 STA FNAME,Q 00511 STA ONAME,Q MOVE ALSO TO PRINTER BUFFER 00512 LDA =N$2020 BLANK OUT INPUT BUFFER 00513 STA* NAMBUF,Q 00514 INQ -1 00515 SQM RB360 SKIP IF 8 WORDS MOVED 00516 JMP* RB355 00517* 00518RB360 ENQ 2 00519 RTJ* MESAGE REPORT ERROR AND REQUEST NEW NAME 00520* 00521 RTJ- ($F4) INPUT USER RESPONSE 00522 ADC $4844 00523ÐÐCPA1 ADC 0 00524 ADC 0 00525 ADC 4 00526 ADC 5 00527BA1 ADC 0 00528 JMP- (DISP) 00529 SPC 2 00530NAMBUF BZS NAMBUF(9) NAME/OWNER INPUT BUFFER 00531TEMP4 NUM 0 00532 SPC 2 00533RB370 LDQ* BA1 CHECK FOR SHORT READ / ODD NO OF CHARS ENTERED 00534 RTJ OUTFF ('FF' PLACED IN BUFFER) 00535 ENQ 0 NOTE NEW OWNER-INPUT NEEDED 00536 RTJ* MESAGE 00537 LDA =N$0020 RESET 1ST WORD OF OWNER FOR BLANK, N--N , CR 00538 STA* NAMBUF+4 OWNER ENTRY DETECTION 00539 RTJ- ($F4) GET NEW OWNER 00540 ADC $4844 00541CPA11 ADC 0 00542 ADC 0 00543 ADC 4 00544 ADC 5 00545BA11 ADC 0 00546 JMP- (DISP) 00547RB371 LDA* NAMBUF+4 CHECK FOR CURRENT OWNER TO BE USED 00548ÐÐ AND =N$FF00 00549 SAN RB373 SKIP = BLANK OR N--N OWNER ENTRY 00550 ENQ 3 NEED TO USE CURRENT OWNER OF FILE 00551 LDA* TEMP4 GET CURRENT OWNER FROM FCB 00552 INA 4 00553 STA- I 00554RB372 LDA- (ZERO),B MOVE OWNER 00555 STA* NAMBUF+4,Q 00556 INQ -1 00557 SQM RB374 ALL THRU 00558 JMP* RB372 00559RB373 LDQ* BA11 CHECK FOR SHORT READ / ODD NO OF CHARS ENTERED 00560 RTJ OUTFF ('FF' ENTERED INTO BUFFER) 00561RB374 ENQ 7 MOVE 8 WORDS TO FCB AND TO OUTPUT MSG FOR 00562 LDA* TEMP4 THE PRINTER 00563 STA- I SET I TO ABSOLUTE ADDRESS OF NAME IN FCB 00564RB375 LDA* NAMBUF,Q 00565 STA- (ZERO),B 00566 STA NNAME,Q 00567 INQ -1 00568 SQM RB380 SKIP WHEN FINISHED 00569 JMP* RB375 00570 EJT 00571RB380 RTJ- ($F4) LOG THE CHANGE TO SYSTEM PRINT DEVICE 00572 ADC $4C44 00573ÐÐCPA2 ADC 0 00574 ADC 0 00575 ADC $8FB 00576 ADC MESLNF 00577BA2 ADC 0 00578 JMP- (DISP) 00579* 00580RB390 LDA MSBC SET UP MSB/LSB FOR FCB UPDATE 00581 STA* MSBH 00582 LDA LSBC 00583 STA* LSBH 00584* 00585 RTJ* MMWRIT WRITE OUT UPDATED FCB 00586BAH ADC 0 00587MSBH ADC 0 00588LSBH ADC 0 00589* 00590 SQP RB400 SKIP IF NO I/O ERROR 00591 ENQ 3 00592 JMP* EXIT2 GO NOTE I/O ERROR 00593* 00594RB400 LDQ* BAH RESET Q TO POINT TO FCB 00595 JMP RB200 REPEAT CHECK OF FDD STRUCTURE 00596 EJT 00597* O U T P U T M E S S A G E R O U T I N E S 00598ÐÐ SPC 2 00599MESSAG 000 000 MESSAG IS USED FROM ITOS USER SPACE 00600 LDA* MESAD1,Q SET UP BUFFER ADDRESS 00601 STA* MESA1 00602 LDA* MESL1,Q AND THE LENGTH 00603 STA* MESL1X 00604* 00605 RTJ- ($F4) OUTPUT THE MESSAGE 00606 ADC $4C44 00607 ADC MES10 00608 ADC 0 00609MESLU ADC 0 00610MESL1X ADC 0 00611MESA1 ADC 0 00612 JMP- (DISP) 00613* 00614MES10 JMP* (MESSAG) 00615 SPC 3 00616MESAGE 000 000 MESAGE IS USED FROM FM'S PARTITION 00617 LDA HERE 00618 ADD* MESAD2,Q 00619 STA* MESA2 SET UP BUFFER ADDRESS 00620 LDA* MESL2,Q 00621 STA* MESL2X AND THE LENGTH 00622* 00623ÐÐ RTJ- ($F4) OUTPUT THE MESSAGE 00624 ADC $4C44 00625CPA3 ADC 0 00626 ADC 0 00627 ADC $1004 00628MESL2X ADC 0 00629MESA2 ADC 0 00630 JMP- (DISP) 00631* 00632MSG10 JMP* (MESAGE) 00633 EJT 00634* E X I T L O G I C P A T H S 00635 SPC 2 00636* EXIT1 IS USED TO EXIT IF PROTECT SWITCH STILL 00637* SET 00638EXIT1 RTJ MESSAG OUTPUT APPROPRIATE MESSAGE 00639 RTJ PGMOUT DO AN EXIT 00640 SPC 3 00641* EXIT2 IS USED TO EXIT IF PROTECT SWITCH HAS 00642* BEEN SET 00643EXIT2 RTJ MESAGE OUTPUT APRROPRIATE MESSAGE 00644FINI IIN 0 00645 JMP* FINI WAIT FOR CLEAR/AUTO-LOAD 00646 EJT 00647* MASS MEMORY READ/WRITE ROUTINES 00648ÐÐ* 00649* CALL SEQUENCES ARE& 00650* 00651* RTJ MMREAD/MMWRIT 00652* ADC --- 1. BUFFER ADDRESS 00653* ADC --- 2. MSB SECTOR ADDRESS 00654* ADC --- 3. LSB SECTOR ADDRESS 00655* NOTE THAT WORDS 2-3 ARE VALUES - NOT ADDRESSES OF WORDS 00656* CONTAINING THE VALUES 00657* SPC 2 00658* M A S S M E M O R Y R E A D R O U T I N E 00659MMREAD 000 000 00660 LDQ* MMREAD 00661 LDA =N$480 SET A TO FREAD CODE + D BIT 00662 JMP* REDWRT 00663 SPC 2 00664* M A S S M E M O R Y W R I T E R O U T I N E 00665* 00666MMWRIT 000 000 00667 LDQ* MMWRIT 00668 LDA =N$4C0 SET A TO FWRITE CODE + D BIT 00669 SPC 2 00670REDWRT EOR- $EF USE CURRENT PRIORITY FOR RP AND CP 00671 ALS 4 00672 EOR- $EF 00673ÐÐ STA* DICODE STORE IN I/O REQUEST 00674 STQ- I Q= ADDRESS OF PARAMETER 00675 INQ 3 00676 STQ* MMWRIT SET UP RETURN 00677* 00678 LDA- (ZERO),I 00679 STA* DIBADR SET STARTING ADDRESS 00680 LDA- 1,I 00681 STA* DIOMSB SET MSB/LSB FOR I/O 00682 LDA- 2,I 00683 STA* DIOLSB 00684 RTJ* IMHERE GET ABSOLUTE ADDRESS OF DICOMP 00685IMHERE 000 000 00686 LDA* IMHERE 00687 ADD =XDICOMP-IMHERE 00688 STA* DICADR STORE COMPLETION ADDRESS 00689 EJT 00690 RTJ- ($F4) PLACE I/O REQUEST 00691DICODE NUM 0 1. I/O CODE, RP, CP 00692DICADR NUM 0 2. COMPLETION ADDRESS 00693 NUM 0 3. THREAD WORD 00694LU NUM 0 4. LOGICAL UNIT NUMBER 00695 NUM 96 5. BUFFER LENGTH 00696DIBADR NUM 0 6. BUFFER ADDRESS 00697DIOMSB NUM 0 7. MSB FOR I/O 00698ÐÐDIOLSB NUM 0 8. LSB FOR I/O 00699 JMP- (DISP) 00700* 00701DICOMP JMP* (MMWRIT) RETURN WITH COMPLETION ADDRESS IN Q-REG 00702 EJT 00703INPUT 000 000 INPUT A REPLY 00704 RTJ- ($F4) 00705 ADC $4844 00706 ADC 0 00707 ADC 0 00708 ADC TERMLU 00709 ADC 2 00710 ADC INPBUF 00711 JMP* (INPUT) RETURN 00712* 00713INPBUF BZS INPBUF(3) 00714 EJT 00715CFF00 NUM $FF00 MASK = $FF00 00716C00FF NUM $00FF MASK = $00FF 00717C0020 NUM $0020 MASK = $0020 00718BLANK NUM $2020 MASK = $2020 00719TEMPAD NUM 0 ADDRESS OF BUFFER TO LOOK THRU 00720OUTFF ADC 0 00721 STQ* TEMPAD SAVE WORKING ADDRESS 00722 ENQ 3 LOOP COUNT - 1 00723ÐÐOUTFF1 LDA* (TEMPAD),Q GET WORD TO LOOK AT 00724 AND* CFF00 1ST BYTE ONLY 00725 EOR* CFF00 00726 SAN OUTFF2 00727 JMP* OUTFF4 WHOLE WORD SHOULD BE BLANKS 00728OUTFF2 LDA* (TEMPAD),Q 2ND BYTE ONLY 00729 AND* C00FF 00730 EOR* C00FF 00731 SAZ OUTFF3 NEED BLANK IN RIGHT BYTE 00732 JMP* OUTFF6 LOOK AT NEXT WORD 00733OUTFF3 LDA* (TEMPAD),Q PLACE BLANKS INTO RIGHT BYTE 00734 AND* CFF00 00735 EOR* C0020 00736 JMP* OUTFF5 STORE RESULT AND LEAVE 00737OUTFF4 LDA* BLANK STORE A FULL WORD OF BLANKS 00738OUTFF5 STA* (TEMPAD),Q STORE RESULT 00739 JMP* (OUTFF) RETURN 00740OUTFF6 INQ -1 LOOK AT NEXT WORD IF NOT THRU 00741 SQP OUTFF7 SKIP = MORE TO LOOK AT 00742 JMP* (OUTFF) RETURN 00743OUTFF7 JMP* OUTFF1 LOOK AT NEXT WORD 00744 EJT 00745* MESAD1 HAS ABSOLUTE ADDRESSES OF MSSAGES 0-7 00746* 00747MESAD1 ADC MESS00 00748ÐÐ ADC MESS01 00749 ADC MESS02 00750 ADC MESS03 00751 ADC MESS04 00752 ADC MESS05 00753 ADC MESS06 00754 ADC MESS07 00755 ADC MESS08 00756 SPC 2 00757* MESLN1 HAS LENGTHS OF MESSAGES 0-7 00758* 00759MESL1 ADC MESLN0 00760 ADC MESLN1 00761 ADC MESLN2 00762 ADC MESLN3 00763 ADC MESLN4 00764 ADC MESLN5 00765 ADC MESLN6 00766 ADC MESLN7 00767 ADC MESLN8 00768 SPC 3 00769* MESAD2 HAS RELATIVE ADDRESSES OF MESSAGES 00770* (USED BY MESAGE ROUTINE) 00771* 00772MESAD2 ADC MESS0A-HERE 00773ÐÐ ADC MESS0B-HERE 00774 ADC MESS0C-HERE 00775 ADC MESS0D-HERE 00776 ADC MESS0E-HERE 00777 ADC MESS0F-HERE 00778 SPC 2 00779MESL2 ADC MESLNA 00780 ADC MESLNB 00781 ADC MESLNC 00782 ADC MESLND 00783 ADC MESLNE 00784 ADC MESLNF 00785 EJT 00786MESS00 ALF $,ILLEGAL: ITOS HAS NOT BEEN DISABLED$ 00787 EQU MESLN0(*-MESS00) 00788MESS01 ALF $,ILLEGAL: NOT RUNNING FROM MASTER CONSOLE$ 00789 EQU MESLN1(*-MESS01) 00790MESS02 ALF $,ILLEGAL: NOT RUNNING IN INTERACTIVE MODE$ 00791 EQU MESLN2(*-MESS02) 00792MESS03 ALF $,DISK I/O ERROR NOTED$ 00793 EQU MESLN3(*-MESS03) 00794MESS04 ALF $,ENTER DISK UNIT NUMBER (0-7):R$ 00795 ALF $,AND TYPE CARRIAGE RETURN:R$ 00796 EQU MESLN4(*-MESS04) 00797MESS05 ALF $,ILLEGAL: NOT DEFINED AS DISK$ 00798ÐÐ EQU MESLN5(*-MESS05) 00799MESS06 ALF $,ILLEGAL: NO FDD EXISTS ON PACK$ 00800 EQU MESLN6(*-MESS06) 00801MESS07 ALF $,TURN OFF PROTECT SWITCH (ESC J20@):R$ 00802 ALF $,AND TYPE CARRIAGE RETURN:R$ 00803 EQU MESLN7(*-MESS07) 00804MESS08 ALF $,ILLEGAL: JOB PROCESSOR OR LIBEDT ACTIVE$ 00805 EQU MESLN8(*-MESS08) 00806MESS0A ALF $,OWNER-NAME = $ 00807 EQU MESLNA(*-MESS0A) 00808MESS0B ALF $,FDD REBUILD COMPLETE. AUTOLOAD TO CONTINUE:R$ 00809 EQU MESLNB(*-MESS0B) 00810MESS0C NUM $1800 00811 ALF $,DUPLICATE NAME/OWNER STRING NOTED:R$ 00812 ALF $,NAME OWNER IS $ 00813FNAME BZS FNAME(8) 00814 NUM $0D20 00815 ALF $,ENTER NEW NAME AND OWNER:R$ 00816 ALF $,FILE-NAME = $ 00817 EQU MESLNC(*-MESS0C) 00818MESS0D ALF $,DISK I/O ERROR NOTED.:R$ 00819 ALF $,AUTOLOAD TO CONTINUE:R$ 00820 EQU MESLND(*-MESS0D) 00821MESS0E ALF $,RAN OUT OF FDD SPACE - FATAL ERROR:R$ 00822 ALF $,AUTOLOAD TO CONTINUE:R$ 00823ÐÐ EQU MESLNE(*-MESS0E) 00824MESS0F ALF $,FILE NAME CHANGED. OLD NAME/OWNER IS $ 00825ONAME BZS ONAME(8) 00826 ALF $, NEW NAME IS $ 00827NNAME BZS NNAME(8) 00828 NUM $0A0D 00829 EQU MESLNF(*-MESS0F) 00830 EJT 00831* DATA BUFFERS 00832 SPC 2 00833VLBUFR BZS VLBUFR(96) VOLUME LABEL BUFFER 00834FDDBUF BZS FDBBUF(96) FDD BLOCK BUFFER 00835FCBBUF BZS FCBBUF(96) FCB BUFFER 00836 EQU ENDADR(*) 00837 END REBFDD 00838 NAM RBDPCH K13 A ITOS CCS 3.0 SL-149S7800001* RPG UTILITIES- GET FILE ROUTINE FOR RBDPCH/RBDFIL S7800002* CREDIT COLLECTION SYSTEM VERSION 3.0 S7800003* DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CLAIFORNIA S7800004* COPYRIGHT CONTROL DATA CORPORATION 1979 S7800005* S7800006 ENT RBDPCH ENTRY NAME TO CALL FROM PROG LIBRARY S7800007 ENT RBDSEG START OF MAIN FILE S7800008* S7800009RBDPCH RTJ- ($F4) GTFILE REQUEST S7800010ÐÐX ADC $5A01 S7800011 ADC 0 S7800012T ADC 0 S7800013E NUM $8C2 SYSTEM LIBRARY UNIT S7800014 ADC 1 START AT WORD 1 S7800015FILADR ADC RBDSEG S7800016 ADC 0 READ ENTIRE FILE S7800017 ADC NAME-X ADR OF FILE NAME S7800018 NUM 0 MSB S7800019 NUM 0 LSB S7800020* S7800021BUSYCK LDA* T CHECK THREAD S7800022 SAZ RBDSEG SKIP IF COMPLETE S7800023 JMP* BUSYCK OTHERWISE WAIT S7800024* S7800025* S7800026NAME ALF 3,PBDFIL NAME OF RBDPCH FILE S7800027* S7800028RBDSEG EQU RBDSEG(*) START OF MAIN FILE S7800029 END RBDPCH S7800030 MON 00001 SUBROUTINE FCBERR(FILNAM,REQUES,ISTAT,LU) 00001 1 /L01 F ITOS CCS 3.0 SL-149 00002C 00003C COPYRIGHT CONTROL DATA CORPORATION, 1979 00004ÐÐC DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00005C CREDIT COLLECTION SYSTEM VERSION 3.0 00006C 00007C 00008C PROCESS FILE ERROR OUTPUTTING MESSAGES TO TERMINAL AND CONSOLE. 00009C 00010C ROUTINE TO REPORT FILE ERRORS TO THE TERMINAL AND THE MASTER CONSO 00011C UPON COMPLETION, CONTROL IS RETURNED TO THE REQUESTING PROGRAM. TH 00012C ATTRACTIVE FEATURE OF THIS ROUTINE IS STANDARDIZATION OF ERROR 00013C REPORTING. 00014C CALLING SEQUENCE: 00015C CALL FCBERR(FILNAM,REQUES,ISTAT,LU) 00016C WHERE THE PARAMETERS HAVE THE FOLLOWING DEFINTIONS: 00017C FILNAM - FOUR WORD ARRAY CONTAINING THE FILE NAME OF THE FILE THE 00018C ERROR OCCURRED IN. THIS CAN TYPICALLY BE FROM THE IDATA BUFF 00019C USED TO OPEN THE FILE. 00020C REQUES - A NUMERIC CODE TO INDICATE THE REQUEST CAUSING THE FILE 00021C ERROR. NUMERIC VALUES USED ARE: 00022C 0 = CREATE 9 = RENAME 00023C 1 = CLEAR 10 = VOLUSE 00024C 2 = DELETE 11 = PUTS 00025C 3 = OPENFL 12 = WRITER 00026C 4 = CLOSFL 13 = READR 00027C 5 = LOKFIL 14 = GETS 00028C 6 = UNLFIL 15 = UPDREC 00029ÐÐC 7 = GETFCB 16 = DELREC 00030C 8 = UPDFCB 17 = COMFIL 00031C ANY OTHER VALUE WILL OMIT THE REQUEST CAUSING THE ERROR FROM 00032C THE ERROR MESSAGE OUTPUT. 00033C ISTAT - THE FILE MANAGER STATUS WORD INDICATING THE ERROR. 00034C LU - TERMINAL LOGICAL UNIT FROM LOGIN. IF TERMINAL IS THE MAST 00035C CONSOLE, ONLY ONE MESSAGE IS OUTPUT. 00036C 00037C THE ERROR MESSAGE OUTPUT IS: 00038C FILE MANAGER ERROR: FILE NAME = XXXXXXXX, REQUEST = XXXXXX, ISTAT = 99 00039C OR, OMITTING THE REQUEST: 00040C FILE MANAGER ERROR: FILE NAME = XXXXXXXX, ISTAT = 9999. 00041C 00042 INTEGER FILNAM(1),REQUES,ISTAT,LU,ONE,EIGHT,ERRMSG(38),FNPOS 00043 INTEGER FILREQ(54),SIX,FRPOS,LENGTH,LEFTST,LEFTDS,LEFTLN,CONSOL 00044 INTEGER XYN,ZERO,COMP,FLAG,TEMP(8) 000451 00046 DATA ONE/1/,EIGHT/8/,FNPOS/35/,SIX/6/,FRPOS/55/,LEFTST/63/, 00047 1 LEFTDS/45/,LEFTLN/13/,CONSOL/4/,XYN/-1/,ZERO/0/ 00048 DATA ERRMSG/$D0A,'FILE MANAGER ERROR: FILE NAME = , REQUES 00049 1T = , ISTAT = . '/ 00050 DATA FILREQ/'CREATECLEAR DELETEOPENFLCLOSFLLOKFILUNLFILGETFCBUPDFC 00051 1BRENAMEVOLUSEPUTS WRITERREADR GETS UPDRECDELRECCOMFIL'/ 000522 00053C 00054ÐÐC MOVE FILE NAME INTO ERROR MESSAGE. 00055 CALL CCSMVA(FILNAM,ONE,EIGHT,ERRMSG,FNPOS,EIGHT) 00056C CONVERT THE FILE MANAGER STATUS WORD AND STORE IN ERROR MESSAGE. 00057 CALL CCSHXA(ISTAT,ERRMSG(36)) 00058C SKIP IF REQUEST TO BE OMITTED FROM ERROR MESSAGE. 00059 IF(REQUES.LT.0.OR.REQUES.GT.17) GO TO 10 00060C MOVE REQUEST INTO ERROR MESSAGE. 00061 J = 6*REQUES + 1 00062 CALL CCSMVA(FILREQ,J,SIX,ERRMSG,FRPOS,SIX) 00063 LENGTH = 75 00064C PROCEED TO OUTPUT SECTION. 00065 GO TO 20 000661 00067C REQUEST TO BE OMMITTED FROM ERROR MESSAGE. MOVE STATUS WORD OUTPUT 00068C NEXT TO FILE NAME OUTPUT IN ERROR MESSAGE. 00069 10 CALL CCSMVA(ERRMSG,LEFTST,LEFTLN,ERRMSG,LEFTDS,LEFTLN) 00070 LENGTH = 57 000712 00072C OUTPUT ERROR MESSAGE TO TERMINAL AND MASTER CONSOLE. 00073 20 CALL FWRITE(LUNIT,ERRMSG,38,COMP,FLAG,TEMP) 00074CTEMP CALL WTREAD(CONSOL,XYN,ERRMSG,LENGTH,ZERO,ZERO,ZERO,J) 000752 00076C OUTPUT COMPLETE. RETURN. 00077 30 RETURN 00078 END 00079ÐÐ SUBROUTINE RLDDSK 00001 1 /L02 F ITOS CCS 3.0 SL-149 00002C 00003C COPYRIGHT CONTROL DATA CORPORATION, 1979 00004C DATA SYSTEMS, LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00005C CREDIT COLLECTION SYSTEM, VERSION 3.0 00006C 00007C THIS SUBROUTINE INTERFACES WITH THE OPERATOR ON RELOADING 00008C OF A SAVE. THE OPERATOR IS GIVEN A CHOICE IN USING ONE 00009C TAPE DRIVE OR ALTERNATING TWO TAPE DRIVES. THE SAVE HEADER IS 00010C READ AND DISPLAYED TO THE CONSOLE. THE OPERATOR RESPONDS AS 00011C WHETHER THIS IS THE CORRECT SAVE TAPE. THE OPERATOR IS THEN 00012C INSTRUCTED AS HOW TO MOUNT THE DISK PACKS ON THE DISK DRIVES. 00013C AFTER THE TAPE DRIVES ARE READY AND THE DISK PACKS ARE READY, 00014C SDSABL IS CALLED AND THE SYSTEM IS DIABLED. AS EACH VOLUME 00015C IS RELOADED, THE NAME OF THE VOLUME IS DISPLAYED TO THE 00016C CONSOLE. THE TAPE IS READ AND THE DISKS ARE RESTORES BY 00017C CALLING SUBROUTINE RLREAD. RLREAD PASSES TAPE AND DISK ERROR 00018C STATUS BACK TO RLDDSK. IF A TAPE ERROR OCCURS, THE TAPE IS 00019C RESTARTED. IF A MASS MEMORY ERROR OCCURS, THE PROGRAM IS 00020C STOPPED. WHEN THE RELOAD IS COMPLETE THE PROGRAM JUMPS TO SYFAI 00021C AND THE OPERATOR MUST AUTOLOAD. 00022C 00023. 00024C COMMON INTEGERS 00025ÐÐ INTEGER COMP,DATTYP,EX,FCBIND,FLAG,GO,IDUSER(4) 00026 INTEGER IBUF(3),LEN(40),LUNIT,MMERR,OPP1(2),OPP2(2) 00027 INTEGER OV,READIN(2),REELNM,RESTRT(8),RESULT(2),SEQNUM 00028 INTEGER SECSIZ,SH(50),STADD(2),SVALL,SLEN(2) 00029 INTEGER TAPERR,TEMP(8),TH(8),TPALT,TPDR,TYPERR,VH(10),VIT(184) 00030C 00031C COMMON 00032 COMMON/A/COMP,DATTYP,EX,FCBIND,FLAG,GO,IDUSER 00033 COMMON/A/IBUF,LEN,LUNIT,MMERR,OPP1,OPP2 00034 COMMON/A/OV,READIN,REELNM,RESTRT,RESULT,SEQNUM 00035 COMMON/A/SECSIZ,SH,STADD,SVALL,SLEN 00036 COMMON/A/TAPERR,TEMP,TH,TPALT,TPDR,TYPERR,VH,VIT 00037C 00038 DATA COMP/0/,FLAG/1/,TEMP/8*0/,TAPERR/0/,MMERR/0/,SEQNUM/0/ 00039 DATA LUNIT/$1004/,REELNM/1/,RESTRT/8*0/ 00040 DATA LEN/1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20, 00041 121,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40/ 00042C INTEGERS 00043 INTEGER DSPLY(40),DISKLU,WRTIND,BUFF(3),MMLEN(3),RLDNUM 00044 INTEGER RECLEN,DISERR,DATREC(1926),MMREC(1921),TAPLEN 00045 INTEGER RLDVOL,TIME(3),RLDFIN,DISFLG,N,Y,TAPE,SECLEN 00046 INTEGER DSKSIZ,HEADS,LOG1A,PHSTAB,WRDSEC,WORD50,WORD71 00047C DISPLAY INTEGERS 00048 INTEGER DSP100(11),DSP110(22),DSP120(23),DSP130(19) 00049 INTEGER DSP140(19),DSP150(19),DSP160(38),DSP170(38) 00050ÐÐ INTEGER DSP180(13),DSP190(15),DSP200(15),DSP210(36),DSP215(4) 00051 INTEGER DSP220(17),DSP230(24),DSP240(20),DSP250(25) 00052 INTEGER DSP260(16),DSP270(22),DSP280(36),DSP290(18) 00053 INTEGER DSP300(20),DSP310(9),DSP320(30),DSP330(9),DSP340(22) 00054 INTEGER DSP350(16),DSP360(18),DSP370(30),DSP380(34) 00055 INTEGER DSP390(38),DSP400(31) 00056 INTEGER DSPBLK 00057C 00058 EQUIVALENCE(DATREC(1926),MMREC(1921)) 00059C 00060C DATA STATEMENTS 00061 DATA GO/$474F/,EX/$4558/,RLDVOL/0/,RLDFIN/0/,DISFLG/0/ 00062 DATA Y/$59FF/,N/$4EFF/ 00063C DISPLAY DATA STATEMENTS 00064 DATA DSP100/$1820,'TAPE TO DISK RELOAD '/ 00065 DATA DSP110/$000D,' ALTERNATING TAPE DRIVES FOR MULTI TAPES '/ 00066 DATA DSP120/' REEL# LOGICAL UNIT# TAPE DRIVE# '/ 00067 DATA DSP130/' 1 6 0'/ 00068 DATA DSP140/' 2 16 1'/ 00069 DATA DSP150/' 3 6 0'/ 00070 DATA DSP160/$000D,' YOU MAY CHOOSE TO USE ALTERNATING TAPE', 00071 1' DRIVES OR ONLY ONE TAPE DRIVE. IF'/ 00072 DATA DSP170/' YOU WISH TO USE ONLY ONE TAPE DRIVE,', 00073 1' SPECIFY THE TAPE DRIVE NUMBER OF THE '/ 00074 DATA DSP180/' DRIVE YOU WISH TO USE.',$000D/ 00075ÐÐ DATA DSP190/' ALTERNATING DRIVES(Y OR N) '/ 00076 DATA DSP200/' SELECT A TAPE DRIVE(0 OR 1)'/ 00077 DATA DSP210/$000D,' ****',$000D,' ****OPERATOR-MOUNT SAVE ', 00078 1'TAPE REEL 1 ON UNIT XX WITHOUT RING'/ 00079 DATA DSP215/' ****',$000D/ 00080 DATA DSP220/' TYPE GO TO CONTINUE, EX TO EXIT '/ 00081 DATA DSP230/$000D,' ****OPERATOR-THE WRONG TAPE HAS BEEN', 00082 1' MOUNTED'/ 00083 DATA DSP240/$000D,' ****TAPE WAS MADE XX-XX-XX AT XX:XX '/ 00084 DATA DSP250/$000D,' THE FOLLOWING VOLUMES WILL BE RELOADED', 00085 1' TO DISK'/ 00086 DATA DSP260/' VOLUME NAME DISK NUMBER'/ 00087 DATA DSP270/$000D,' IS THIS THE CORRECT SAVE TAPE (Y OR N) '/ 00088 DATA DSP280/$1800,' ****',$000D,' ****OPERATOR-BE SURE YOU', 00089 1' HAVE THE CORRECT DISK PACKS MOUNTED'/ 00090 DATA DSP290/' ****AND THE DISK DRIVES ARE READY '/ 00091 DATA DSP300/$000D,' IS BEING RELOADED TO DISK '/ 00092 DATA DSP320/' WRONG REEL MOUNTED MOUNT REEL NUMBER XX ON TAPE', 00093 1' DRIVE XX'/ 00094 DATA DSP330/' TAPE TYPE WRONG '/ 00095 DATA DSP340/$000D,'MASS MEMORY ERROR XXXX ON LOGICAL UNIT XX'/ 00096 DATA DSP350/$1800,' TAPE TO DISK RELOAD COMPLETE'/ 00097 DATA DSP360/$000D,' ****OPERATOR-AUTOLOAD THE SYSTEM'/ 00098 DATA DSP370/$000D,' ****OPERATOR-RELOAD ABORTED-PACKS HAVE', 00099 1' NOT BEEN RESTORED'/ 00100ÐÐ DATA DSP380/$000D,' ****',$000D,' ****OPERATOR-DO NOT TYPE', 00101 1' GO UNTIL DISK DRIVES ARE READY '/ 00102 DATA DSP390/$000D,'SECTOR SIZES ON TAPE AND VOLUME TO BE ', 00103 1'RELOADED ARE DIFFERENT - FATAL ERROR'/ 00104 DATA DSP400/$000D,'DRIVE SIZES ON TAPE AND VOLUME TO BE', 00105 1' RELOADED ARE DIFFERENT '/ 00106 DATA DSPBLK/$000D/ 00107C 00108. 00109C 00110C DISPLAY TAPE ALTERNATING INSTR. 00111 CALL SFWRIT(LUNIT,DSP100,LEN(12),COMP,FLAG,TEMP) 00112 CALL SFWRIT(LUNIT,DSP110,LEN(22),COMP,FLAG,TEMP) 00113 CALL SFWRIT(LUNIT,DSP120,LEN(23),COMP,FLAG,TEMP) 00114 CALL SFWRIT(LUNIT,DSP130,LEN(19),COMP,FLAG,TEMP) 00115 CALL SFWRIT(LUNIT,DSP140,LEN(19),COMP,FLAG,TEMP) 00116 CALL SFWRIT(LUNIT,DSP150,LEN(19),COMP,FLAG,TEMP) 00117 CALL SFWRIT(LUNIT,DSP160,LEN(38),COMP,FLAG,TEMP) 00118 CALL SFWRIT(LUNIT,DSP170,LEN(38),COMP,FLAG,TEMP) 00119 CALL SFWRIT(LUNIT,DSP180,LEN(13),COMP,FLAG,TEMP) 00120 100 CALL SFWRIT(LUNIT,DSP190,LEN(15),COMP,FLAG,TEMP) 00121C READ REPLY 00122 IBUF(1)=0 00123 ASSIGN 110 TO COMP 00124 CALL READ(LUNIT,IBUF,LEN(1),COMP,FLAG,TEMP) 00125ÐÐ CALL DISP 00126C CHECK FOR Y OR N 00127 110 IF(IBUF(1).EQ.N) GO TO 115 00128 IF(IBUF(1).NE.Y) GO TO 100 00129 TPALT=1 00130 GO TO 130 00131 115 CALL SFWRIT(LUNIT,DSP200,LEN(15),COMP,FLAG,TEMP) 00132 IBUF(1)=$0000 00133 ASSIGN 120 TO COMP 00134 CALL READ(LUNIT,IBUF,LEN(1),COMP,FLAG,TEMP) 00135 CALL DISP 00136C CHECK WHICH DRIVE WAS SELECTED 00137 120 IF(IBUF(1).EQ.$30FF) GO TO 130 00138 IF(IBUF(1).NE.$31FF) GO TO 115 00139C SET UP THE TAPE DRIVES 00140 TPDR=$0031 00141 TAPE=16 00142 GO TO 140 00143 130 TPDR=$0030 00144 TAPE=6 00145C DISPLAY TAPE MOUNTING INSTR. 00146 140 DSP210(29)=TPDR 00147 CALL SFWRIT(LUNIT,DSP210,LEN(36),COMP,FLAG,TEMP) 00148 CALL SFWRIT(LUNIT,DSP215,LEN(5),COMP,FLAG,TEMP) 00149 150 CALL SFWRIT(LUNIT,DSP220,LEN(17),COMP,FLAG,TEMP) 00150ÐÐ IBUF(1)=0 00151 ASSIGN 160 TO COMP 00152 CALL READ(LUNIT,IBUF,LEN(1),COMP,FLAG,TEMP) 00153 CALL DISP 00154C CHECK FOR GO OR EX 00155 160 IF(IBUF(1).EQ.EX) GO TO 9990 00156 IF(IBUF(1).NE.GO) GO TO 140 00157. 00158C READ SAVE HEADER 00159 165 TAPLEN=50 00160 CALL RLREAD(SH,TAPLEN,TAPE) 00161C CHECK FOR TAPE ERROR 00162 IF(TAPERR.LT.0) GO TO 9000 00163C NO TAPE ERROR, CHECK FOR RECORD TYPE 0 00164C SAVE HEADER 00165 IF(SH(1).EQ.$0030) GO TO 170 00166C ERROR, WRONG TAPE IS MOUNTED 00167 CALL SFWRIT(LUNIT,DSP230,LEN(24),COMP,FLAG,TEMP) 00168C DISPLAY TAPE MOUNTING INSTR. AGAIN 00169 GO TO 140 00170C DISPLAY WHAT WAS SAVED 00171 170 CALL SFWRIT(LUNIT,DSP100,LEN(12),COMP,FLAG,TEMP) 00172C SET UP DATE AND TIME 00173 DSP240(12)=SH(3) 00174 DSP240(15)=SH(5) 00175ÐÐ CALL CCSMVA(SH,7,1,DSP240,26,1) 00176 CALL CCSMVA(SH,8,1,DSP240,27,1) 00177C SET UP TIME 00178 DSP240(18)=SH(6) 00179 CALL CCSMVA(SH,13,1,DSP240,38,1) 00180 CALL CCSMVA(SH,14,1,DSP240,39,1) 00181C 00182 SECSIZ=SH(49) 00183 CALL SFWRIT(LUNIT,DSP240,LEN(20),COMP,FLAG,TEMP) 00184 CALL SFWRIT(LUNIT,DSP250,LEN(25),COMP,FLAG,TEMP) 00185 CALL SFWRIT(LUNIT,DSP260,LEN(16),COMP,FLAG,TEMP) 00186 RLDNUM=SH(8) 00187C DISPLAY VOLUME NAMES AND NUMBERS 00188 DO 190 I=1,8 00189 CALL CCSBLK(DSPLY,80) 00190 DO 180 J=1,4 00191 K=8+(4*(I-1))+J 00192 IF(SH(K).EQ.0) GO TO 190 00193 180 DSPLY(J+3)=SH(K) 00194 DSPLY(14)=SH(I+40) 00195 IF(RLDNUM.EQ.1)RLDVOL=SH(I+40)-$0030 00196 CALL SFWRIT(LUNIT,DSPLY,LEN(40),COMP,FLAG,TEMP) 00197 190 CONTINUE 00198C IS THIS CORRECT TAPE 00199 200 CALL SFWRIT(LUNIT,DSP270,LEN(22),COMP,FLAG,TEMP) 00200ÐÐC READ ANSWER 00201 IBUF(1)=0 00202 ASSIGN 210 TO COMP 00203 CALL READ(LUNIT,IBUF,LEN(1),COMP,FLAG,TEMP) 00204 CALL DISP 00205C CHECK FOR Y OR N 00206 210 IF(IBUF(1).EQ.N) GO TO 140 00207 IF(IBUF(1).NE.Y) GO TO 200 00208 CALL SFWRIT(LUNIT,DSPBLK,LEN(1),COMP,FLAG,TEMP) 00209C DISABLE TIMER,MI,MICRO INT.,ECT. 00210C 00211 IF(DISFLG.EQ.1) GO TO 215 00212 DISFLG=1 00213 CALL SDSABL 00214 DISERR=LINK(0) 00215 IF(DISERR.LT.0) GO TO 9800 00216C 00217C DISPLAY DISK PACK MOUNTING INSTR. 00218 215 CALL SFWRIT(LUNIT,DSP280,LEN(36),COMP,FLAG,TEMP) 00219 CALL SFWRIT(LUNIT,DSP290,LEN(18),COMP,FLAG,TEMP) 00220 CALL SFWRIT(LUNIT,DSP215,LEN(4),COMP,FLAG,TEMP) 00221 CALL SFWRIT(LUNIT,DSP380,LEN(34),COMP,FLAG,TEMP) 00222 CALL SFWRIT(LUNIT,DSP215,LEN(4),COMP,FLAG,TEMP) 00223C TYPE GO TO CONTINUE 00224 220 CALL SFWRIT(LUNIT,DSP220,LEN(17),COMP,FLAG,TEMP) 00225ÐÐC READ GO OR EX 00226 IBUF(1)=0 00227 ASSIGN 230 TO COMP 00228 CALL READ(LUNIT,IBUF(1),LEN(1),COMP,FLAG,TEMP) 00229 CALL DISP 00230C CHECK ANSWER FOR EX OR GO 00231 230 IF(IBUF(1).EQ.EX) GO TO 9970 00232 IF(IBUF(1).NE.GO) GO TO 220 00233. 00234C READ THE TAPE HEADER 00235C 00236 235 TAPLEN=8 00237 CALL RLREAD(TH,TAPLEN,TAPE) 00238C CHECK TAPE TYPE 1-TAPE HEADER 00239 IF(TAPERR.LT.0) GO TO 9000 00240C CHECK FOR CORRECT TYPE -TAPE HEADER 00241 IF(TH(1).NE.$0031) GO TO 9100 00242C CHECK FOR BAD REEL NUMBER 00243 240 IF(TH(3).NE.REELNM) GO TO 250 00244C IF FIRST REEL, READ VOLUME HEADER 00245 IF(REELNM.EQ.1) GO TO 270 00246C ELSE READ DATA RECORDS 00247 GO TO 300 00248C TAPE REEL NUMBER WRONG 00249 250 DSP320(21)=$0031 00250ÐÐ DSP320(30)=TPDR 00251 CALL SFWRIT(LUNIT,DSP320,LEN(30),COMP,FLAG,TEMP) 00252C TYPE GO TO CONTINUE 00253 CALL SFWRIT(LUNIT,DSP220,LEN(17),COMP,FLAG,TEMP) 00254C READ ANSWER 00255 IBUF(1)=0 00256 ASSIGN 260 TO COMP 00257 CALL READ(LUNIT,IBUF(1),LEN(1),COMP,FLAG,TEMP) 00258 CALL DISP 00259C CHECK FOR EX OR GO 00260 260 IF(IBUF(1).EQ.EX) GO TO 9970 00261 IF(IBUF(1).NE.GO) GO TO 250 00262. 00263C READ VOLUME HEADER 00264 270 TAPLEN=10 00265 CALL RLREAD(VH,TAPLEN,TAPE) 00266C CHECK FOR TAPE ERROR 00267 IF(TAPERR.LT.0) GO TO 9000 00268C CHECK FOR TYPE 2-VOLUME HEADER 00269 IF(VH(1).EQ.$0032) GO TO 280 00270C CHECK FOR END OF SAVE TRAILER 00271C AT END SET FINSIH SWITCH 00272 IF(VH(1).NE.$0036) GO TO 285 00273 RLDFIN=1 00274 GO TO 9800 00275ÐÐC INCORRECT TAPE 00276 285 CALL SFWRIT(LUNIT,DSP330,LEN(9),COMP,FLAG,TEMP) 00277 GO TO 140 00278C DISPLAY WHICH VOLUME IS BEING RELOADED 00279 280 DO 290 I=1,4 00280 J=8+(4*RLDVOL)+I 00281 290 DSP300(I+2)=SH(J) 00282 CALL SFWRIT(LUNIT,DSP300,LEN(20),COMP,FLAG,TEMP) 00283 DISKLU=VH(7) 00284 SECSIZ=VH(8) 00285 DSKSIZ=VH(9) 00286. 00287C MUST VERIFY THAT SECTOR SIZE AND DRIVE 00288C SIZE ON TAPE AND VOLUME TO BE RELOADED 00289C ARE SAME. TO DO THIS MUST GET SYSTEM 00290C VALUES FOR SECTOR SIZE AND DRIVE SIZE 00291C OUT OF PHYSTAB. SECTOR SIZE IS WORD 71 00292C OF PHYSTAB. DRIVE SIZE CORRESPONDS TO 00293C # OF HEADS/DRIVE, WORD 50. IF WORD 50 00294C IS 5 THE DRIVE IS 50MB. IF WORD 50 IS 00295C 19 THE DRIVE IS 300MB. 00296C 00297C GET ADDRESS OF LOG1A TABLE - 28TH 00298C WORD OF EXT. COMMUNICATIONS TABLE. 00299 CALL ADDECT(28,LOG1A) 00300ÐÐC GET ADDRESS OF PHYSTAB FROM LOG1A TABLE. 00301C PHYSTAB ADDR = LOG1A ADDR + DISK LU# 00302 LOG1A=LOG1A+DISKLU 00303 CALL GETWRD(LOG1A,1,PHSTAB) 00304C GET SECTOR SIZE (WORD 71) AND 00305C #HEADS/DRIVE (WORD 50) 00306 WORD71=PHSTAB+70 00307 WORD50=PHSTAB+49 00308 CALL GETWRD(WORD71,1,WRDSEC) 00309 CALL GETWRD(WORD50,1,HEADS) 00310C VERIFY SECTOR SIZE 00311 IF(SECSIZ .EQ. WRDSEC) GO TO 295 00312C SECTOR SIZES DO NOT MATCH 00313C WRITE ERROR MESSAGE AND EXIT TO SYFAIL 00314 CALL SFWRIT(LUNIT,DSP390,LEN(38),COMP,FLAG,TEMP) 00315 GO TO 9990 00316C VERIFY DRIVE SIZE 00317 295 IF(DSKSIZ .EQ. HEADS) GO TO 300 00318C DRIVE SIZES DO NOT MATCH 00319C WRITE WARNING MESSAGE & WAIT FOR RESPONSE 00320 296 CALL SFWRIT(LUNIT,DSP400,LEN(31),COMP,FLAG,TEMP) 00321 CALL SFWRIT(LUNIT,DSP220,LEN(17),COMP,FLAG,TEMP) 00322 IBUF(1)=0 00323 ASSIGN 298 TO COMP 00324 CALL READ(LUNIT,IBUF,LEN(1),COMP,FLAG,TEMP) 00325ÐÐ CALL DISP 00326C CHECK FOR GO OR EX 00327 298 IF(IBUF(1) .EQ. EX) GO TO 9970 00328 IF(IBUF(1) .NE. GO) GO TO 296 003291 00330. 00331C RELOAD THE DISK 00332 300 TAPLEN=1926 00333 CALL RLREAD(DATREC,TAPLEN,TAPE) 00334C CHECK FOR TAPE ERROR 00335 IF(TAPERR.LT.0) GO TO 9000 00336C CHECK FOR TYPE 3 DATA RECORD 00337 IF(DATREC(1).EQ.$0033) GO TO 310 00338C CHECK IF TAPE HEADER WAS READ IN RLREAD 00339C IF SO READ NEXT RECORD 00340 IF(DATREC(1).EQ.$0031) GO TO 300 00341C CHECK FOR TYPE 4 VOLUME TRAILER 00342 IF(DATREC(1).NE.$0034) GO TO 9100 00343C VOLUME TRAILER ENCOUNTERED READ NEXT 00344C VOLUME HEADER 00345 RLDVOL=RLDVOL+1 00346 GO TO 270 00347C COMPUTE SECTORS FROM RECORD LENTGH 00348 310 RECLEN=DATREC(5) 00349 SECLEN=(RECLEN-6)/SECSIZ 00350ÐÐC SET UP LENGTH 00351 MMLEN(1)=RECLEN-6 00352 MMLEN(2)=DATREC(3) 00353 MMLEN(3)=DATREC(4) 00354 DATREC(RECLEN)=0 00355C INTIALIZE WRITE INDEX 00356 DO 430 I=1,100 00357C FWRITE RECORD TO DISK 00358 400 ASSIGN 410 TO COMP 00359 CALL FWRITE(DISKLU,MMREC,MMLEN,COMP,FLAG,TEMP) 00360 CALL DISP 00361C CHECK FOR MASS MEMORY ERROR 00362 410 MMERR=LINK(0) 00363 IF(MMERR.GE.0) GO TO 300 00364C MASS MEMORY ERROR OCURRED 00365C REWRITE RECORD 00366C CHECK FOR 100 REWRITES 00367 430 CONTINUE 00368C MAS MEMORY ERROR HAS OCCURED DISPLAY 00369C MESSAGE 00370C 00371 450 CALL CCSHXA(MMERR,BUFF) 00372 DSP340(11)=BUFF(1) 00373 DSP340(12)=BUFF(2) 00374 CALL CCSHXA(DISKLU,BUFF) 00375ÐÐ DSP340(22)=BUFF(2) 00376 CALL SFWRIT(LUNIT,DSP340,LEN(22),COMP,FLAG,TEMP) 00377 GO TO 9800 00378. 00379C TAPE ERROR OCURRED RESTART TAPE 00380C CHECK TO SEE IF FIRST REEL 00381C IF FIRST READ SAVE HEADER 00382 9000 TAPERR=0 00383 IF(RESTRT.LT.0) GO TO 9800 00384 IF(RESTRT.EQ.0) GO TO 165 00385C NOT FIRST REEL READ TAPE HEADER 00386 GO TO 235 00387C WRONG RECORD TYPE 00388 9100 CALL SFWRIT(LUNIT,DSP330,LEN(9),COMP,FLAG,TEMP) 00389C 00390C CHECK IF RELOAD FINSIHED 00391 9800 IF(RLDFIN.EQ.1) GO TO 9900 00392C RELOAD WAS ABORTED PRINT MESSAGE 00393 9970 CALL SFWRIT(LUNIT,DSP370,LEN(30),COMP,FLAG,TEMP) 00394 GO TO 9980 00395 9900 CALL SFWRIT(LUNIT,DSP350,LEN(16),COMP,FLAG,TEMP) 00396 CALL SFWRIT(LUNIT,DSP360,LEN(18),COMP,FLAG,TEMP) 00397 9980 CALL SYFAIL 00398 9990 CONTINUE 00399 STOP 0003 00400ÐÐ END 00401 SUBROUTINE RLREAD(DATREC,TAPLEN,TAPE) 00001 1 /L03 F ITOS CCS 3.0 SL-149 00002C 00003C COPYRIGHT CONTROL DATA CORPORATION, 1979 00004C DATA SYSTEMS, LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00005C CREDIT COLLECTION SYSTEM, VERSION 3.0 00006C 00007C THIS SUBROUTINE HANDLES THE READING OF THE TAPES AND THE 00008C WRITING TO DISK. IF A TAPE ERROR OCCURS WHEN READING A RECORD 00009C FROM TAPE, THE OPERATOR IS GIVEN INSTRUCTIONS FOR TAPE 00010C RESTARTING. THE OPERATOR IS GIVEN INSTRUCTIONS FOR TAPE 00011C MOUNTING OR REWINDING DEPENDING ON WHICH OPTION THE OPERATOR 00012C CHOSE. AT END OF TAPE, THE OPERATOR IS GIVEN INSTRUCTIONS 00013C ON MOUNTING AND STARTING THE NEXT TAPE. EACH RECORD THAT IS 00014C READ IS CHECK FOR A CORRECT CHECKSUM AND A CORRECT SEQUENCE 00015C NUMBER. THE OPERATOR IS GIVEN RESTART INSRUCTIONS FOR BOTH 00016C ERRORS. IF AN UNRECOVERABLE ERROR OCCURS, THE OPERATOR CAN 00017C ABORT THE PROGRAM BY USING OPTION 4. IF A TAPE ERROR OCCURED, 00018C A NEGATIVE STATUS IS PASSED BACK TO THE CALLING SUBROUTINE 00019C RLDDSK FOR RESTART. IF A MASS MEMORY ERROR OCCURS, THE REQUEST 00020C IS RETRIED 100 TIMES OR UNTIL A GOOD STATUS IS RETURNED. IF 00021C THE REQUEST DOES NOT GET A GOOD STATUS, A NEGATIVE STATUS IS 00022C RETURNED TO RLDDSK. 00023C 00024ÐÐC 00025. 00026C COMMON INTEGERS 00027 INTEGER COMP,DATTYP,EX,FCBIND,FLAG,GO,IDUSER(4) 00028 INTEGER IBUF(3),LEN(40),LUNIT,MMERR,OPP1(2),OPP2(2) 00029 INTEGER OV,READIN(2),REELNM,RESTRT(8),RESULT(2),SEQNUM 00030 INTEGER SECSIZ,SH(50),STADD(2),SVALL,SLEN(2) 00031 INTEGER TAPERR,TEMP(8),TH(8),TPALT,TPDR,TYPERR,VH(10),VIT(184) 00032C 00033C COMMON 00034 COMMON/A/COMP,DATTYP,EX,FCBIND,FLAG,GO,IDUSER 00035 COMMON/A/IBUF,LEN,LUNIT,MMERR,OPP1,OPP2 00036 COMMON/A/OV,READIN,REELNM,RESTRT,RESULT,SEQNUM 00037 COMMON/A/SECSIZ,SH,STADD,SVALL,SLEN 00038 COMMON/A/TAPERR,TEMP,TH,TPALT,TPDR,TYPERR,VH,VIT 00039C 00040C INTEGERS 00041 INTEGER RECLEN,CHKTOT,CHECK,TAPLEN,OPT(3),DATREC(1926) 00042 INTEGER Y,N,TAPE 00043C DISPLAY INTEGERS 00044 INTEGER DSP100(19),DSP110(4),DSP120(3), DSP130(20),DSP140(9) 00045 INTEGER DSP150(36),DSP170(13),DSP180(18),DSP190(18),DSP200(14) 00046 INTEGER DSP210(29),DSP220(24),DSP230(28),DSP235(16),DSP240(14) 00047 INTEGER DSP250(34),DSP260(16) 00048C DATA STATEMENTS 00049ÐÐ DATA Y/$59FF/,N/$4EFF/ 00050C 00051 DATA DSP100/' ****OPERATOR-REWIND TAPE ON UNIT XX'/ 00052 DATA DSP110/$000D,' ****'/ 00053 DATA DSP120/' ****'/ 00054 DATA DSP130/' ****OPERATOR-MOUNT REEL XX ON UNIT XX'/ 00055 DATA DSP140/$000D,' READY?(Y OR N)'/ 00056 DATA DSP150/$1800,' ****OPERATOR-WRONG REEL NUMBER WAS MOUNTED', 00057 1' ON UNIT XX MOUNT REEL XX'/ 00058 DATA DSP170/$1800,' TAPE ERROR HAS OCCURED'/ 00059 DATA DSP180/$1800,' TAPE CHECKSUM ERROR HAS OCCURRED'/ 00060 DATA DSP190/$1800,' TAPE SEQUENCE ERROR HAS OCCURRED'/ 00061 DATA DSP200/$000D,' TAPE ERROR HAS OCCURRED '/ 00062 DATA DSP210/$000D,' OPTIONS:',$000D,' (1)RESTART TAPE ON ', 00063 1'THE SAME TAPE DRIVE '/ 00064 DATA DSP220/' (2)RESTART TAPE ALTERNATING THE TAPE DRIVES'/ 00065 DATA DSP230/' (3)RESTART TAPE CHANGING TO USE TAPE DRIVE ', 00066 1'XX ONLY '/ 00067 DATA DSP235/' (4)END TAPE TO DISK RELOAD '/ 00068 DATA DSP240/' PICK AN OPTION FROM ABOVE '/ 00069 DATA DSP250/$000D,' ****',$000D,' ****OPERATOR-MOUNT', 00070 1' THE NEXT REEL# XX ON UNIT XX',$000D,' ****'/ 00071 DATA DSP260/$1800,' END OF TAPE HAS BEEN REACHED'/ 00072. 00073C 00074ÐÐC READ A RECORD FROM TAPE 00075 100 ASSIGN 110 TO COMP 00076 CALL FREAD(TAPE,DATREC,TAPLEN,COMP,FLAG,TEMP) 00077 CALL DISP 00078C CHECK FOR TAPE ERROR 00079 110 TAPERR=LINK(0) 00080 IF(TAPERR.LT.0) GO TO 600 00081C GET TAPE LENGTH FROM TYPE 00082 IF(DATREC(1).EQ.$0030) TAPLEN=50 00083 IF(DATREC(1).EQ.$0031) TAPLEN=8 00084 IF(DATREC(1).EQ.$0032) TAPLEN=10 00085 IF(DATREC(1).EQ.$0033) TAPLEN=DATREC(5) 00086 IF(DATREC(1).EQ.$0034) TAPLEN=8 00087 IF(DATREC(1).EQ.$0035) TAPLEN=8 00088 IF(DATREC(1).EQ.$0036) TAPLEN=8 00089C 00090C CHECK FOR CHECKSUM ERROR 00091 120 CALL CHEKSM(DATREC,TAPLEN,CHECK) 00092C IS CHECKSUM BAD 00093 IF(CHECK.NE.0) GO TO 9000 00094C CHECK SEQUENCE NUMBER 00095 130 SEQNUM=SEQNUM+1 00096 IF(SEQNUM.NE.DATREC(2)) GO TO 9100 00097C NO SEQUENCE ERROR # ARE EQUAL 00098C CHECK FOR END OF TAPE 00099ÐÐ IF(DATREC(1).EQ.$0035) GO TO 300 00100C RETURN TO RLDDSK TO GET NEXT RECORD 00101 GO TO 9999 00102. 00103C 00104C END OF TAPE 00105C CHECK FOR ALTERNATING TAPES 00106 300 CALL SFWRIT(LUNIT,DSP260,LEN(16),COMP,FLAG,TEMP) 00107 IF(TPALT.EQ.1) GO TO 400 00108C ALTERNATING DRIVES NOT USED 00109C REWIND TAPE AND MOUNT NEXT TAPE 00110 310 CALL SFWRIT(LUNIT,DSP110,LEN(4),COMP,FLAG,TEMP) 00111 DSP100(19)=TPDR 00112 CALL SFWRIT(LUNIT,DSP100,LEN(19),COMP,FLAG,TEMP) 00113 CALL SFWRIT(LUNIT,DSP120,LEN(3),COMP,FLAG,TEMP) 00114 DSP130(14)=TH(3)+$31 00115 DSP130(20)=TPDR 00116 CALL SFWRIT(LUNIT,DSP110,LEN(4),COMP,FLAG,TEMP) 00117 CALL SFWRIT(LUNIT,DSP130,LEN(20),COMP,FLAG,TEMP) 00118 CALL SFWRIT(LUNIT,DSP120,LEN(3),COMP,FLAG,TEMP) 00119C IS TAPE DRIVE READY 00120 CALL SFWRIT(LUNIT,DSP140,LEN(9),COMP,FLAG,TEMP) 00121 IBUF(1)=0 00122 ASSIGN 320 TO COMP 00123 CALL READ(LUNIT,IBUF,LEN(1),COMP,FLAG,TEMP) 00124ÐÐ CALL DISP 00125C ANSWER Y OR N 00126 320 IF(IBUF(1).EQ.N) GO TO 310 00127 IF(IBUF(1).NE.Y) GO TO 310 00128 GO TO 490 00129C 00130C ALTERNATING DRIVES 00131 400 DSP130(14)=TH(3)+$31 00132 IF(TPDR.EQ.$0030) GO TO 410 00133 TPDR=$0030 00134 TAPE=6 00135 GO TO 420 00136 410 TPDR=$0031 00137 TAPE=16 00138C DISPLAY ALT TAPE MOUNTING INSTR. 00139 420 CALL SFWRIT(LUNIT,DSP110,LEN(4),COMP,FLAG,TEMP) 00140 DSP130(20)=TPDR 00141 CALL SFWRIT(LUNIT,DSP130,LEN(20),COMP,FLAG,TEMP) 00142 CALL SFWRIT(LUNIT,DSP120,LEN(3),COMP,FLAG,TEMP) 00143C IS TAPE DRIVE READY 00144 CALL SFWRIT(LUNIT,DSP140,LEN(9),COMP,FLAG,TEMP) 00145 IBUF(1)=0 00146 ASSIGN 440 TO COMP 00147 CALL READ(LUNIT,IBUF,LEN(1),COMP,FLAG,TEMP) 00148 CALL DISP 00149ÐÐC ANSWER Y OR N 00150 440 IF(IBUF(1).EQ.N) GO TO 420 00151 IF(IBUF(1).NE.Y) GO TO 420 00152C REWIND LAST TAPE 00153C MOUNT NEXT REEL 00154 450 IF(TPDR.EQ.$0030)DSP100(19)=$0031 00155 IF(TPDR.EQ.$0031)DSP100(19)=$0030 00156 CALL SFWRIT(LUNIT,DSP110,LEN(4),COMP,FLAG,TEMP) 00157 CALL SFWRIT(LUNIT,DSP100,LEN(19),COMP,FLAG,TEMP) 00158 CALL SFWRIT(LUNIT,DSP120,LEN(3),COMP,FLAG,TEMP) 00159 DSP250(24)=REELNM+$0032 00160 DSP250(30)=DSP100(19) 00161 CALL SFWRIT(LUNIT,DSP250,LEN(34),COMP,FLAG,TEMP) 00162C 00163C SAVE SEQUENCE NUMBER FOR RESTART 00164 490 RESTRT=SEQNUM 00165C 00166C READ TAPE HEADER 00167 ASSIGN 495 TO COMP 00168 CALL FREAD(TAPE,TH,8,COMP,FLAG,TEMP) 00169 CALL DISP 00170C CHECK FOR TAPE ERROR 00171 495 TAPERR=LINK(0) 00172 IF(TAPERR.LT.0) GO TO 600 00173C CHECK CHECKSUM 00174ÐÐ CALL CHEKSM(TH,8,CHECK) 00175 IF(CHECK.NE.0) GO TO 9000 00176C CHECK REEL NUMBER,OK INCREMENT COUNTER 00177 IF(TH(3).NE.(REELNM+1)) GO TO 500 00178 REELNM=REELNM+1 00179C CHECK SEQUENCE NUMBER 00180 SEQNUM=SEQNUM+1 00181 IF(SEQNUM.NE.TH(2)) GO TO 9100 00182C 00183C CHECK FOR TAPE HEADER TYPE 1 00184 IF(TH(1).NE.$0031) GO TO 500 00185 DATREC(1)=$0031 00186 GO TO 9999 00187C 00188C WRONG TAPE MOUNTED 00189 500 DSP150(29)=TPDR 00190 DSP150(36)=REELNM+$0030 00191 CALL SFWRIT(LUNIT,DSP150,LEN(36),COMP,FLAG,TEMP) 00192 IF(TPALT.EQ.1) GO TO 420 00193 GO TO 310 00194. 00195C TAPE ERROR HAS OCCURED 00196 600 SEQNUM=RESTRT 00197 CALL SFWRIT(LUNIT,DSP200,LEN(14),COMP,FLAG,TEMP) 00198 610 CALL SFWRIT(LUNIT,DSP210,LEN(29),COMP,FLAG,TEMP) 00199ÐÐ CALL SFWRIT(LUNIT,DSP220,LEN(24),COMP,FLAG,TEMP) 00200 IF(TPDR.EQ.$0030) GO TO 640 00201 DSP230(25)=$0030 00202 GO TO 650 00203 640 DSP230(25)=$0031 00204 650 CALL SFWRIT(LUNIT,DSP230,LEN(28),COMP,FLAG,TEMP) 00205 CALL SFWRIT(LUNIT,DSP235,LEN(16),COMP,FLAG,TEMP) 00206 CALL SFWRIT(LUNIT,DSP240,LEN(14),COMP,FLAG,TEMP) 00207C 00208C PICK AN OPTION 00209 670 OPT(1)=0 00210 ASSIGN 680 TO COMP 00211 CALL READ(LUNIT,OPT,LEN(1),COMP,FLAG,TEMP) 00212 CALL DISP 00213C 00214C BRANCH TO OPTION 00215 680 IF(OPT(1).EQ.$31FF) GO TO 700 00216 IF(OPT(1).EQ.$32FF) GO TO 710 00217 IF(OPT(1).EQ.$33FF) GO TO 740 00218 IF(OPT(1).EQ.$34FF) GO TO 9200 00219 GO TO 610 00220C OPTION 1 00221 700 DSP100(19)=TPDR 00222 CALL SFWRIT(LUNIT,DSP110,LEN(4),COMP,FLAG,TEMP) 00223 CALL SFWRIT(LUNIT,DSP100,LEN(19),COMP,FLAG,TEMP) 00224ÐÐ CALL SFWRIT(LUNIT,DSP120,LEN(3),COMP,FLAG,TEMP) 00225 GO TO 800 00226C OPTION 2 00227 710 DSP100(19)=TPDR 00228 CALL SFWRIT(LUNIT,DSP110,LEN(4),COMP,FLAG,TEMP) 00229 CALL SFWRIT(LUNIT,DSP100,LEN(19),COMP,FLAG,TEMP) 00230 CALL SFWRIT(LUNIT,DSP120,LEN(3),COMP,FLAG,TEMP) 00231 IF(TPDR.EQ.$0030) GO TO 720 00232 DSP130(14)=TH(3)+$30 00233 DSP130(20)=$0030 00234 GO TO 730 00235 720 DSP130(14)=TH(3)+$30 00236 DSP130(20)=$0031 00237 730 CALL SFWRIT(LUNIT,DSP110,LEN(4),COMP,FLAG,TEMP) 00238 CALL SFWRIT(LUNIT,DSP130,LEN(20),COMP,FLAG,TEMP) 00239 CALL SFWRIT(LUNIT,DSP120,LEN(3),COMP,FLAG,TEMP) 00240 GO TO 800 00241C OPTION 3 00242 740 DSP100(19)=TPDR 00243 CALL SFWRIT(LUNIT,DSP110,LEN(4),COMP,FLAG,TEMP) 00244 CALL SFWRIT(LUNIT,DSP100,LEN(19),COMP,FLAG,TEMP) 00245 CALL SFWRIT(LUNIT,DSP120,LEN(3),COMP,FLAG,TEMP) 00246 IF(TPDR.EQ.$0030) GO TO 750 00247 DSP130(14)=TH(3)+$30 00248 DSP130(20)=$0030 00249ÐÐ GO TO 760 00250 750 DSP130(14)=TH(3)+$30 00251 DSP130(20)=$0031 00252 760 CALL SFWRIT(LUNIT,DSP110,LEN(4),COMP,FLAG,TEMP) 00253 CALL SFWRIT(LUNIT,DSP130,LEN(20),COMP,FLAG,TEMP) 00254 CALL SFWRIT(LUNIT,DSP120,LEN(3),COMP,FLAG,TEMP) 00255C IS TAPE READY 00256 800 CALL SFWRIT(LUNIT,DSP140,LEN(9),COMP,FLAG,TEMP) 00257C READY Y OR N 00258 IBUF(1)=0 00259 ASSIGN 820 TO COMP 00260 CALL READ(LUNIT,IBUF(1),LEN(1),COMP,FLAG,TEMP) 00261 CALL DISP 00262C CHECK FOR Y OR N 00263 820 IF(IBUF(1).EQ.N) GO TO 610 00264 IF(IBUF(1).NE.Y) GO TO 610 00265 IF(OPT(1).EQ.$31FF) GO TO 9999 00266 IF(DSP130(20).EQ.$0030) GO TO 830 00267 TPDR=$0031 00268 TAPE=16 00269 GO TO 840 00270 830 TPDR=$0030 00271 TAPE=6 00272C WAS TAPE ALT CHANGED 00273 840 IF(OPT(1).EQ.$32FF)GO TO 850 00274ÐÐ IF(OPT(1).EQ.$33FF)GO TO 860 00275 GO TO 9999 00276 850 TPALT=1 00277 DSP250(24)=REELNM+$0031 00278 IF(TPDR.EQ.$0030)DSP250(30)=$0031 00279 IF(TPDR.EQ.$0031)DSP250(30)=$0030 00280 CALL SFWRIT(LUNIT,DSP250,LEN(34),COMP,FLAG,TEMP) 00281 GO TO 9999 00282 860 TPALT=0 00283 GO TO 9999 00284C CHECKSUM ERROR 00285 9000 CALL SFWRIT(LUNIT,DSP180,LEN(18),COMP,FLAG,TEMP) 00286 TAPERR=$8000 00287 GO TO 600 00288C SEQUENCE ERROR 00289 9100 CALL SFWRIT(LUNIT,DSP190,LEN(18),COMP,FLAG,TEMP) 00290 TAPERR=$8000 00291 GO TO 600 00292C 00293 9200 RESTRT=$8000 00294 GO TO 9999 00295C 00296 9999 RETURN 00297 END 00298 SUBROUTINE SAVDSK(SAVVOL) 00001ÐÐ 1 /L04 F ITOS CCS 3.0 SL-149 00002C CREDIT COLLECTION SYSTEM 3.0 00003C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00004C COPYRIGHT CONTROL DATA CORPORATION 1979 00005C 00006C THIS PROGRAM FINDS THE ALL THE DATA WHICH IS TO BE SAVED. 00007C THE FIRST THING TO BE SAVED IS THE FILE MANAGER 2.0 INFORMATION 00008C THIS INCLUDES THE FOLLOWING THINGS: 00009C 1. THE VOLUME LABEL 00010C 2. THE FSD 00011C 3. THE FCBT 00012C 4. THE FIAT 00013C 5. THE KEYS AND FILES 00014C 00015C IF SYSVOL IS TO BE SAVED, THE END OF THE OPERATING SYSTEM IS 00016C FOUND AND THE OPERATING SYSTEM IS SAVED. 00017C AT THE START OF EACH VOLUME TO BE SAVED TO TAPE, A VOLUME HEADE 00018C IS WRITTEN TO TAPE. AT THE END OF EACH VOLUME, A VOLUME TRAILER 00019C RECORD IS WRITTEN TO TAPE. IF A TAPE ERROR OCCURED WHEN 00020C WRITTING THE LAST RECORD TO TAPE, THE PROGRAM BRANCHES TO THE 00021C RESTART THE TAPE. AT THE BEGINNING OF EACH TAPE, THE TYPE OF 00022C DATA THAT IS TO BE WRITTEN TO TAPE IS SAVED, SO IF A TAPE ERROR 00023C OCCURS THE PROGRAM CAN BRANCH TO THE SAME DATA FOR RESTART. 00024. 00025C INTEGERS 00026ÐÐ INTEGER CHECK,C0,C1,DISKLU 00027 INTEGER EOFCB,FCBBUF(96),FTLERR(3),FILNAM(4),LOG1A 00028 INTEGER MSBLSB(2),PHSTAB 00029 INTEGER REQBUF(24),REQUES,SAVVOL 00030 INTEGER SECREC,TAPBUF(50),VOLNAM(4),VT(8),WORD50 00031C DATA STATEMENTS 00032 DATA EOFCB/$9000/,FTLERR/$8020,$C000,$A000/,FILNAM/4*$20/ 00033 DATA REQBUF/24*0/,REQUES/7/,SECREC/1/,VT/8*0/ 00034C COMMON INTEGERS 00035 INTEGER COMP,DATTYP,EX,FCBIND,FLAG,GO,IDUSER(4) 00036 INTEGER IBUF(3),LEN(40),LUNIT,MMERR,OPP1(2),OPP2(2) 00037 INTEGER OV,READIN(2),REELNM,RESTRT(8),RESULT(2),SEQNUM 00038 INTEGER SECSIZ,SH(50),STADD(2),SVALL,SLEN(2) 00039 INTEGER TAPERR,TEMP(8),TH(8),TPALT,TPDR,TYPERR,VH(10),VIT(184) 00040C COMMON 00041 COMMON/A/COMP,DATTYP,EX,FCBIND,FLAG,GO,IDUSER 00042 COMMON/A/IBUF,LEN,LUNIT,MMERR,OPP1,OPP2 00043 COMMON/A/OV,READIN,REELNM,RESTRT,RESULT,SEQNUM 00044 COMMON/A/SECSIZ,SH,STADD,SVALL,SLEN 00045 COMMON/A/TAPERR,TEMP,TH,TPALT,TPDR,TYPERR,VH,VIT 00046. 00047C 00048C SAVE A DISK SUBROUTINE 00049C WAS THERE A TAPE ERROR 00050 10 IF(TAPERR.GE.0) GO TO 200 00051ÐÐC DATTYP VALUES INDICATE WHAT TYPE OF 00052C DATA WAS PUT ON THE BEGINNING OF THE 00053C TAPE. THESE VALUES ARE USED TO RESTART 00054C TAPE AFTER A TAPE FAILURE HAS OCCURED. 00055C 00056C DATTYP VALUES 1=VOLUME HEADER 00057C 2=VOLUME LABEL 00058C 3=SYSVOL 00059C 4=FSD 00060C 5=FDD 00061C 6=FCBT 00062C 7=FIAT 00063C 8=FILES 00064C 9=END OF VOLUME TRAILER 00065C 00066 TAPERR=0 00067 GO TO(200,220,240,270,300,330,360,400,600),DATTYP 00068. 00069C SET UP VOLUME HEADER 00070C WORD DESCRIPTION 00071C 1 RECORD TYPE '2' 00072C 2 SEQUENCE NUMBER 00073C 3-6 VOLUME NAME 00074C 7 DISK LU NUMBER 00075C 8 VOLUME SECTOR SIZE 00076ÐÐC 9 DRIVE SIZE 00077C 10 CHECKSUM 00078C 00079 200 VH(1)=$0032 00080 SEQNUM=SEQNUM+1 00081 VH(2)=SEQNUM 00082 DO 210 I=1,4 00083 J=8+(4*SAVVOL)+I 00084 VOLNAM(I)=SH(J) 00085 210 VH(I+2)=SH(J) 00086 J=SAVVOL*23 00087 VH(7)=VIT(J+1) 00088 VH(8)=VIT(J+14) 00089C INITIALIZE SECTOR SIZE FOR THIS VOLUME 00090 SECSIZ=VIT(J+14) 00091C GET DRIVE SIZE OUT OF PHYSTAB(WORD 50) 00092C AND STORE IN WORD 9 OF VH. 00093C WORD 50 = #HEADS/DRIVE (5=50MB, 19=300MB) 00094C 00095C GET ADDRESS OF LOG1A TABLE - 28TH 00096C WORD OF EXT. COMMUNICATIONS TABLE. 00097 DISKLU=VH(7) 00098 CALL ADDECT(28,LOG1A) 00099C GET ADDRESS OF PHYSTAB FROM LOGIA TABLE 00100C PHYSTAB ADDR = LOG1A ADDR + DISK LU# 00101ÐÐ LOG1A=LOG1A+DISKLU 00102 CALL GETWRD(LOG1A,1,PHSTAB) 00103C GET #HEADS/DRIVE FROM THE 50TH WORD 00104C IN THE PHYSTAB. 00105 WORD50=PHSTAB+49 00106 CALL GETWRD(WORD50,1,VH(9)) 00107C 00108C COMPUTE CHECKSUM 00109 CALL CHEKSM(VH,9,CHECK) 00110 VH(10)=CHECK 00111 DATTYP=1 00112C WRITE VOLUME HEADER TO TAPE 00113 CALL SAVTAP(SAVVOL,VH,10) 00114 IF(TAPERR.LT.0) GO TO 10 00115C GET VOLUME LABEL 00116 220 J=SAVVOL*23 00117 STADD(1)=VIT(J+22) 00118 STADD(2)=VIT(J+23) 00119 SLEN(1)=$0000 00120 SLEN(2)=$0001 00121 DATTYP=2 00122C SAVE THE VOLUME LABLE 00123 CALL SAVHNK(SAVVOL) 00124 IF(MMERR.LT.0) GO TO 9999 00125 230 IF(TAPERR.LT.0) GO TO 10 00126ÐÐC CHECK IF VOLUME IS SYSVOL 00127 240 IF(SH(41).NE.$0030)GO TO 270 00128C VOLUME IS SYSVOL,GET C0 & C1 FROM 00129C COMMUNICATIONS TABLE,END OF OPERATING STS. 00130 250 CALL GETWRD($C0,1,C0) 00131 CALL GETWRD($C1,1,C1) 00132 STADD(1)=$0000 00133 STADD(2)=$0000 00134 SLEN(1)=C0 00135 SLEN(2)=C1 00136 DATTYP=3 00137C SAVE THE OPERATING SYSTEM 00138 CALL SAVHNK(SAVVOL) 00139 IF(MMERR.LT.0) GO TO 9999 00140 260 IF(TAPERR.LT.0) GO TO 10 00141C GET FSD 00142 270 STADD(1)=VIT(J+9) 00143 STADD(2)=VIT(J+10) 00144 SLEN(1)=$0000 00145 SLEN(2)=VIT(J+11) 00146 DATTYP=4 00147C SAVE FSD 00148 CALL SAVHNK(SAVVOL) 00149 IF(MMERR.LT.0) GO TO 9999 00150 280 IF(TAPERR.LT.0) GO TO 10 00151ÐÐC GET FDD 00152 300 STADD(1)=VIT(J+15) 00153 STADD(2)=VIT(J+16) 00154 SLEN(1)=$0000 00155 SLEN(2)=VIT(J+19) 00156 DATTYP=5 00157C SAVE FDD 00158 CALL SAVHNK(SAVVOL) 00159 IF(MMERR.LT.0) GO TO 9999 00160 310 IF(TAPERR.LT.0) GO TO 10 00161C GET FCBT 00162 330 OPP1(1)=$0000 00163 OPP1(2)=VIT(J+19) 00164 OPP2(1)=VIT(J+15) 00165 OPP2(2)=VIT(J+16) 00166 CALL FDWADD(OPP1,OPP2,STADD,OV) 00167 SLEN(1)=$0000 00168 SLEN(2)=VIT(J+17) 00169 DATTYP=6 00170C SAVE FCBT 00171 CALL SAVHNK(SAVVOL) 00172 IF(MMERR.LT.0) GO TO 9999 00173 340 IF(TAPERR.LT.0) GO TO 10 00174C GET FIAT 00175 360 OPP1(1)=$0000 00176ÐÐ OPP1(2)=VIT(J+17) 00177 OPP2(1)=$0000 00178 OPP2(2)=VIT(J+19) 00179 CALL FDWADD(OPP1,OPP2,RESULT,OV) 00180 OPP2(1)=VIT(J+15) 00181 OPP2(2)=VIT(J+16) 00182 CALL FDWADD(RESULT,OPP2,STADD,OV) 00183 SLEN(1)=$0000 00184 SLEN(2)=$0002 00185 DATTYP=7 00186C SAVE FIAT 00187 CALL SAVHNK(SAVVOL) 00188 IF(MMERR.LT.0) GO TO 9999 00189 370 IF(TAPERR.LT.0) GO TO 10 00190C SET UP INDEX FOR GETFCB 00191 390 FCBIND=1 00192. 00193C 00194C GET FILES 00195 400 CALL GETFCB(REQBUF,VOLNAM,FCBIND,FCBBUF,ISTAT) 00196 IF(ISTAT.EQ.0) GO TO 430 00197C CHECK FOR END OF FCB'S 00198 410 J=AND(ISTAT,EOFCB) 00199 IF(J.EQ.EOFCB)GO TO 600 00200C CHECK FOR ERRORS 00201ÐÐ DO 420 I=1,3 00202 J=AND(ISTAT,FTLERR(I)) 00203 IF(J.NE.FTLERR(I)) GO TO 420 00204 MMERR=$8000 00205 GO TO 9000 00206 420 CONTINUE 00207C IS FILE DELETED 00208 430 IF(FCBBUF(25).EQ.$0000) GO TO 490 00209C IS FILE INDEXED 00210 J=AND(FCBBUF(6),$0001) 00211 IF(J.NE.$0001) GO TO 450 00212C FILE IS INDEXED SAVE KEYS 00213 435 STADD(1)=FCBBUF(13) 00214 STADD(2)=FCBBUF(14) 00215C COMPUTE LENGTH OF KEYS 00216C LINKFM,LINKFL ARE NOT IN MSBLSB FORMAT 00217C CONVERT TO MSBLSB(NEXT FREE KEY BLOCK) 00218C MOVE BITS 0-14 OF LINKFL TO LSB 00219 MSBLSB(2)=AND(FCBBUF(10),$7FFF) 00220C SHIFT LINKFM LEFT 1 POSITION-STORE IN MSB 00221 MSBLSB(1)=FCBBUF(9)*2 00222C RETRIEVE BIT 15 OF LINKFL AND MOVE IT TO 00223C BIT 0 OF MSB 00224 MSBLSB(1)=MSBLSB(1)+(AND(FCBBUF(10),$8000)/$8000) 00225C TURN BLOCKS INTO SECTORS MULT BY 3 00226ÐÐ OPP2(1)=$0003 00227 CALL FDWMUI(MSBLSB,OPP2,SLEN,OV) 00228 DATTYP=8 00229C SAVE THE KEYS 00230 CALL SAVHNK(SAVVOL) 00231 IF(MMERR.LT.0) GO TO 9999 00232 440 IF(TAPERR.LT.0) GO TO 10 00233. 00234C 00235C GET FILES 00236 450 STADD(1)=FCBBUF(4) 00237 STADD(2)=FCBBUF(5) 00238C SUBTRACT 1 SECTOR FROM THE FIRST RECORD 00239C ADDRESS TO GET FILE HEADER 00240 OPP2(1)=$0000 00241 OPP2(2)=1 00242 CALL FDWSUB(STADD,OPP2,STADD,OV) 00243 DATTYP=8 00244C COMPUTE LENGTH 00245C NEDATM,NEDATL ARE NOT IN MSBLSB FORMAT 00246C CONVERT NEDATM,NEDATL(# OF RECS) 00247C 00248C MOVE BITS 0-14 OF NEDATL TO LSB 00249 MSBLSB(2)=AND(FCBBUF(8),$7FFF) 00250C SHIFT NEDATM TO THE LEFT 1 POSITION 00251ÐÐC AND STORE IN MSB 00252 MSBLSB(1)=FCBBUF(7)*2 00253C RETRIEVE BIT 15 OF NEDATL AND STORE 00254C IN BIT 0 OF MSB 00255 MSBLSB(1)=MSBLSB(1)+(AND(FCBBUF(8),$8000)/$8000) 00256C 00257C COMPUTE FILE LENGTH 00258C SLEN=(# OF RECS * SECTORS PER REC)+1 00259C SECTORS PER REC=(RECLEN/SECTOR SIZE)+1 00260C 00261C COMPUTE SECTORS PER RECORD 00262 SECREC=(FCBBUF(1)/SECSIZ)+1 00263C COMPUTE LENGHT OF FILE 00264 CALL FDWMUI(MSBLSB,SECREC,SLEN,OV) 00265C ADD 1 SECTOR TO ALLOW FOR FILE HEADER 00266C ADD 1 FOR FUDGE FACTOR 00267 480 OPP2(1)=$0000 00268 OPP2(2)=$0002 00269 CALL FDWADD(SLEN,OPP2,SLEN,OV) 00270C SAVE THE FILE 00271 CALL SAVHNK(SAVVOL) 00272 IF(MMERR.LT.0) GO TO 9999 00273 IF(TAPERR.LT.0) GO TO 10 00274C INCREMENT INDEX AND GET NEXT FCB 00275 490 FCBIND=FCBIND+1 00276ÐÐ GO TO 400 00277. 00278C SET UP END OF VOLUME TRAILER 00279C WORD DESCRIPTION 00280C 1 RECORD TYPE '4' 00281C 2 SEQUENCE NUMBER 00282C 3-6 VOLUME NAME 00283C 7 DISK LU NUMBER 00284C 8 CHECKSUM 00285 600 DO 610 I=3,7 00286 610 VT(I)=VH(I) 00287 VT(1)=$0034 00288 SEQNUM=SEQNUM+1 00289 VT(2)=SEQNUM 00290C COMPUTE CHECKSUM 00291 CALL CHEKSM(VT,7,CHECK) 00292 VT(8)=CHECK 00293 DATTYP=9 00294C WRITE VOLUME TRAILER TO TAPE 00295 CALL SAVTAP(SAVVOL,VT,8) 00296 IF(TAPERR.LT.0) GO TO 10 00297 630 GO TO 9999 00298C FATAL ERRORS HAVE OCCURED 00299 9000 CALL FCBERR(FCBBUF(25),REQUES,ISTAT,LUNIT) 00300 9999 RETURN 00301ÐÐ END 00302 SUBROUTINE SAVDSP 00001 1 /L05 F ITOS CCS 3.0 SL-149 00002C 00003C COPYRIGHT CONTROL DATA CORPORATION, 1979 00004C DATA SYSTEMS, LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00005C CREDIT COLLECTION SYSTEM, VERSION 3.0 00006C 00007C THIS SUBROUTINE INTERFACES WITH THE OPERATOR ON WHAT IS TO 00008C BE SAVED AND WHICH TAPE DRIVES ARE TO BE USED. ALL VOLUMES 00009C WHICH ARE MOUNTED AND READY ARE DISPLAYED TO THE CONSOLE. FROM 00010C THIS LIST THE OPERATOR MAY CHOOSE ONE OR DEFAULT TO SAVE ALL 00011C MOUNTED AND READY VOLUMES. VALIDITY CHECKS ARE DONE ON THE 00012C OPERATORS ANSWERS. THE OPERATOR MAY ALSO SELECT A TAPE DRIVE 00013C OR ALTERNATING TAPE DRIVES. THIS GIVES THE OPERATOR FLEXIBILIT 00014C IF ONE DRIVE IS DOWN. TAPE MOUNTING INSTRUCTIONS ARE DISPLAYED 00015C TO THE CONSOLE AND THE OPERATOR RESPONDS WHEN READY. THE FIRST 00016C RECORD WRITTEN TO TAPE IS A SAVE HEADER. THIS RECORD WILL 00017C ALWAYS BE THE FIRST RECORD ON THE FIRST TAPE OF ANY SAVE. THIS 00018C RECORD CONTAINS INFORMATION ON WHEN AND WHAT IS TO BE SAVED. 00019C THE SECOND RECORD IS A TAPE HEADER. THE TAPE HEADER WILL BE 00020C THE FIRST RECORD ON ALL TAPES BUT THE FIRST TAPE. THE TAPE 00021C HEADER CONTAINS THE FIRST VOLUME ON THAT REEL AND THE REEL NUMB 00022C ALL HEADERS AND TRAILERS WILL CONTAIN SEQUENCE NUMBERS AND 00023C CHECKSUMS. AS EACH VOLUME IS SAVED, THE NAME OF THE VOLUME IS 00024ÐÐC DISPLAYED TO THE CONSOLE. SAVDSK IS CALLED TO SAVE EACH 00025C VOLUME. WHEN THE SAVE IS FINISHED, THE 00026C OPERATOR MUST AUTOLOAD SINCE THE PROGRAM JUMPS TO SYFAIL ON 00027C COMPLETION. THIS PROGRAM CALLS SDSABL, WHICH DISABLES MANY 00028C OF THE SYSTEM FUCTIONS, THEREFORE THE SYSTEM MUST BE AUTOLOADED 00029C BEFORE ANY FURTHER PROCESSING CAN BE DONE. 00030C IF A MASS MEMORY ERROR OCCURED THE SAVE IS FINISHED. 00031C 00032. 00033C INTEGERS 00034 INTEGER ADAYTO,AMONTO,AMMLUT,AYERTO,CHECK 00035 INTEGER COMPIN,DSPLY(40),DISERR,EST(8),EOT 00036 INTEGER EXT29,FFFF,HORMIN,DISKNM 00037 INTEGER MAXVOL,MMLUTB(9),MNTRDY(8),NAVOL(8) 00038 INTEGER NAVOLL(8) 00039 INTEGER SAVNUM,SAVVOL,TAPBUF(50),VOLNUM 00040 INTEGER DS1000(10),DS1010(36),DS1020(20),DS1030(22),DS1031(26) 00041 INTEGER DS1032(24),DS1033(18),DS1040(27),DS1050(8),DS1060(12) 00042 INTEGER DS1070(31),DS1071(16),DS1080(22),DS1090(32),DS1100(17) 00043 INTEGER DS1110(22),DS1111(23),DS1112(19),DS1113(19),DS1114(19) 00044 INTEGER DS1120(38),DS1121(38),DS1122(13),DS1130(15),DS1140(15) 00045 INTEGER DS1150(37),DS1160(17),DS1170(16),DS1180(18),DS1190(40) 00046 INTEGER DSPBLK 00047C EXTERNALS 00048 EXTERNAL HORMIN,AMONTO,ADAYTO,AYERTO 00049ÐÐC EQUIVALENCES 00050 EQUIVALENCE (MMLUTB(1),NUMVOL) 00051C DATA STATEMENTS 00052 DATA EXT29/29/,MMLUTB/9*0/,NAVOL/8*$0000/,MNTRDY/8*0/ 00053 DATA MAXVOL/$0000/,NAVOLL/8*0000/,DISERR/0/,FFFF/$FFFF/ 00054 DATA EST/8*0/,SAVNUM/0/ 00055C CONSOLE DISPLAYS 00056 DATA DS1000/$1800,'DISK TO TAPE SAVE '/ 00057 DATA DS1010/$000D,' THE FOLLOWING VOLUMES ARE MOUNTED:',$000D, 00058 1' VOLUME NAME DISK NUMBER'/ 00059 DATA DS1020/$000D,' ENTER DISK NUMBER OR CARRIAGE RETURN'/ 00060 DATA DS1030/$000D,' ENTERING A DISK NUMBER WILL SAVE ONLY'/ 00061 DATA DS1031/' THE SPECIFIED DISK, IF IT IS MOUNTED AND ', 00062 1'READY.'/ 00063 DATA DS1032/$000D,' ENTERING A CARRIAGE RETURN WILL SAVE ', 00064 1'ALL '/ 00065 DATA DS1033/' MOUNTED AND READY DISK DRIVES. '/ 00066 DATA DS1040/$000D,' VALID NUMBERS FOR DISK DRIVES ARE DISPLA', 00067 1'YED ABOVE '/ 00068 DATA DS1050/' DISK NUMBER = '/ 00069 DATA DS1060/$000D,' INVALID DISK NUMBER '/ 00070 DATA DS1070/$000D,' THE FOLLOWING VOLUME IS MOUNTED AND WILL', 00071 1' BE SAVED TO TAPE '/ 00072 DATA DS1071/' VOLUME NAME DISK NUMBER'/ 00073 DATA DS1080/$000D,' DISK NUMBER IS NOT MOUNTED AND READY '/ 00074ÐÐ DATA DS1090/$000D,' THE FOLLOWING VOLUMES ARE MOUNTED AND WILL', 00075 1' BE SAVED TO TAPE '/ 00076 DATA DS1100/$000D,'TYPE GO TO CONTINUE, EX TO EXIT '/ 00077 DATA DS1110/$1800,' ALTERNATING TAPE DRIVES FOR MULTI TAPES '/ 00078 DATA DS1111/' REEL# LOGICAL UNIT# TAPE DRIVE# '/ 00079 DATA DS1112/' 1 6 0'/ 00080 DATA DS1113/' 2 16 1'/ 00081 DATA DS1114/' 3 6 0'/ 00082 DATA DS1120/$000D,' YOU MAY CHOOSE TO USE ALTERNATING TAPE', 00083 1' DRIVES OR ONLY ONE TAPE DRIVE. IF'/ 00084 DATA DS1121/' YOU WISH TO USE ONLY ONE TAPE DRIVE, SPECIFY', 00085 1' THE TAPE DRIVE NUMBER OF THE '/ 00086 DATA DS1122/' DRIVE YOU WISH TO USE.',$000D/ 00087 DATA DS1130/' ALTERNATING DRIVES (Y OR N) '/ 00088 DATA DS1140/' SELECT A TAPE DRIVE (0 OR 1)'/ 00089 DATA DS1150/$000D,' ****',$000D,' ****OPERATOR-MOUNT OUTPUT ', 00090 1' TAPE ON UNIT WITH RING ',$000D,' ****'/ 00091 DATA DS1160/$000D,' IS BEING SAVED TO TAPE '/ 00092 DATA DS1170/$1800,' DISK TO TAPE SAVE COMPLETE '/ 00093 DATA DS1180/$000D,' ****OPERATOR-AUTOLOAD THE SYSTEM'/ 00094 DATA DS1190/$000D,' ****',$000D,' ****OPERATOR-MOUNT NEXT ', 00095 1'OUTPUT TAPE ON UNIT WITH RING',$000D,' ****',$000D/ 00096 DATA DSPBLK/$000D/ 00097C 00098C COMMON INTEGERS 00099ÐÐ INTEGER COMP,DATTYP,EX,FCBIND,FLAG,GO,IDUSER(4) 00100 INTEGER IBUF(3),LEN(40),LUNIT,MMERR,OPP1(2),OPP2(2) 00101 INTEGER OV,READIN(2),REELNM,RESTRT(8),RESULT(2),SEQNUM 00102 INTEGER SECSIZ,SH(50),STADD(2),SVALL,SLEN(2) 00103 INTEGER TAPERR,TEMP(8),TH(8),TPALT,TPDR,TYPERR,VH(10),VIT(184) 00104C COMMON 00105 COMMON/A/COMP,DATTYP,EX,FCBIND,FLAG,GO,IDUSER 00106 COMMON/A/IBUF,LEN,LUNIT,MMERR,OPP1,OPP2 00107 COMMON/A/OV,READIN,REELNM,RESTRT,RESULT,SEQNUM 00108 COMMON/A/SECSIZ,SH,STADD,SVALL,SLEN 00109 COMMON/A/TAPERR,TEMP,TH,TPALT,TPDR,TYPERR,VH,VIT 00110C COMMON DATA STATEMENTS 00111 DATA VIT/184*0/,GO/$474F/,EX/$4558/,SVALL/0/,SH/50*0/,TAPERR/0/ 00112 DATA TH/8*0/,TPALT/0/,VH/10*0/,FLAG/1/,RESTRT/8*0/,MMERR/0/ 00113 DATA SEQNUM/0/,FCBIND/0/ 00114 DATA LEN/1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20, 00115 121,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40/ 00116. 00117C 00118C MAIN MODULE OF DISK TO TAPE PROGRAM 00119C 00120 LUNIT=$1004 00121C DISPLAY PROGRAM NAME 00122 CALL SFWRIT(LUNIT,DS1000,LEN(10),COMP,FLAG,TEMP) 00123 CALL SFWRIT(LUNIT,DS1010,LEN(36),COMP,FLAG,TEMP) 00124ÐÐC GET ADDRESS OF MMLUTB 00125 20 CALL ADDECT(EXT29,AMMLUT) 00126C GET NINE WORDS STARTING FROM AMMULT 00127 CALL GETWRD(AMMLUT,9,MMLUTB) 00128C GET VITS FOR VOLUMES 1-8 00129C WORD 2 IN MMLUTB IS THE LOCATION OF THE 00130C VITS,EACH VIT IS 23 WORDS LONG 00131 CALL GETWRD(MMLUTB(2),184,VIT) 00132C INTIALIZE SECTOR SIZE 00133 SECSIZ=VIT(14) 00134C DISPLAY ALL VOLUMES THAT ARE MOUNTED 00135 DO 40 I=1,NUMVOL 00136 J=(I-1)*23 00137C SEE IF VOLUME IS MOUNTED 00138 IF(VIT(J+1).LT.0.OR.VIT(J+19).EQ.0) GO TO 40 00139C DISPLAY VOLUME NAME AND NUMBER 00140 CALL CCSBLK(DSPLY,80) 00141 DO 45 K=1,4 00142 L=K+J+1 00143 45 DSPLY(K+3)=VIT(L) 00144 DSPLY(14)=I+$2F 00145 MNTRDY(I)=1 00146 CALL SFWRIT(LUNIT,DSPLY,LEN(40),COMP,FLAG,TEMP) 00147 40 CONTINUE 00148C DISPLAY OPERATOR INSTRUCTIONS 00149ÐÐ CALL SFWRIT(LUNIT,DS1020,LEN(20),COMP,FLAG,TEMP) 00150 CALL SFWRIT(LUNIT,DS1030,LEN(22),COMP,FLAG,TEMP) 00151 CALL SFWRIT(LUNIT,DS1031,LEN(26),COMP,FLAG,TEMP) 00152 CALL SFWRIT(LUNIT,DS1032,LEN(24),COMP,FLAG,TEMP) 00153 CALL SFWRIT(LUNIT,DS1033,LEN(18),COMP,FLAG,TEMP) 00154 100 CALL SFWRIT(LUNIT,DS1040,LEN(27),COMP,FLAG,TEMP) 00155 CALL SFWRIT(LUNIT,DS1050,LEN(8),COMP,FLAG,TEMP) 00156C ENTER DISK NUMBER TO BE SAVED 00157 120 IBUF(1)=$0000 00158 SAVVOL=0 00159 ASSIGN 130 TO COMP 00160 CALL READ(LUNIT,IBUF,LEN(1),COMP,FLAG,TEMP) 00161 CALL DISP 00162C WAS INPUT A CARRIAGE RETURN IBUF=$FFFF 00163 130 IF(IBUF(1).LT.0) GO TO 160 00164C INPUT SHOULD ONLY BE ONE CHARACTER 00165C CHECK FOR $FF IN SECOND BYTE 00166 CALL CCSCST(IBUF(1),2,1,FFFF,2,1,COMPIN) 00167 IF(COMPIN)150,140,150 00168C ONLY ONE CHARACTER FOUND-CONVERT TO NUMBER 00169C BY LEFT JUSTIFING IBUF(1),THEN SUBTRACT 00170 140 CALL CCSMVA(IBUF(1),1,1,SAVVOL,2,1) 00171 SAVVOL=SAVVOL-$30 00172C CHECK IF VALID DISK NUMBER 00173 IF(SAVVOL.LE.(NUMVOL-1)) GO TO 170 00174ÐÐC INVALID DISK NUMBER DISPLAY MESSAGE 00175 150 CALL SFWRIT(LUNIT,DS1060,LEN(12),COMP,FLAG,TEMP) 00176 GO TO 100 00177C SET SAVE ALL STITCH TO 1 00178 160 SVALL=1 00179 170 IF(SVALL.EQ.1) GO TO 250 00180. 00181C SAVE ONLY ONE VOLUME 00182C SEARCH TO SEE IF VOLUME IS MOUNTED 00183 180 SAVNUM=1 00184 J=SAVVOL*23 00185C IS VOLUME MOUNTED 00186 IF(VIT(J+1).LT.0.OR.VIT(J+19).EQ.0) GO TO 230 00187C DISPLAY VOLUME TO BE SAVED 00188 CALL CCSBLK(DSPLY,80) 00189 DO 205 K=1,4 00190 L=K+J+1 00191 205 DSPLY(K+3)=VIT(L) 00192 DSPLY(14)=SAVVOL+$30 00193 CALL SFWRIT(LUNIT,DS1070,LEN(31),COMP,FLAG,TEMP) 00194 CALL SFWRIT(LUNIT,DS1071,LEN(17),COMP,FLAG,TEMP) 00195 CALL SFWRIT(LUNIT,DSPLY,LEN(40),COMP,FLAG,TEMP) 00196C SET UP SAVE HEADER 00197C WORD DESCRIPTION 00198C 9-12 VOLUME NAME 00199ÐÐC 41 VOLUME NUMBER 00200C 00201 DO 206 M=1,4 00202 L=8+(4*SAVVOL)+M 00203 K=J+M+1 00204 206 SH(L)=VIT(K) 00205 SH(SAVVOL+41)=$0030+SAVVOL 00206C FOUND VOLUME SET SWITCH TO 1 00207 IFND=1 00208 GO TO 300 00209 220 CONTINUE 00210C VOLUME FOUND CONTINUE ELSE PRINT MESSAGE 00211 IF(IFND.EQ.1) GO TO 300 00212C VOLUME NOT FOUND 00213 230 DS1080(9)=IBUF(1) 00214 CALL SFWRIT(LUNIT,DS1060,LEN(12),COMP,FLAG,TEMP) 00215 CALL SFWRIT(LUNIT,DS1080,LEN(22),COMP,FLAG,TEMP) 00216 GO TO 100 00217. 00218C 00219C SAVE ALL MOUNTED VOLUMES 00220 250 CALL SFWRIT(LUNIT,DS1090,LEN(32),COMP,FLAG,TEMP) 00221 CALL SFWRIT(LUNIT,DS1071,LEN(16),COMP,FLAG,TEMP) 00222 SAVVOL=0 00223 DO 290 I=1,NUMVOL 00224ÐÐ J=(I-1)*23 00225 IF(VIT(J+1).LT.0.OR.VIT(J+19).EQ.0) GO TO 290 00226 CALL CCSBLK(DSPLY,80) 00227 DO 275 K=1,4 00228 L=K+J+1 00229 275 DSPLY(K+3)=VIT(L) 00230 DSPLY(14)=I+$2F 00231 SAVNUM=SAVNUM+1 00232C SET UP SAVE HEADER VOLUME NUMBER AND 00233C VOLUME NAMES 00234C WORD DESCRIPTION 00235C 9-40 VOLUME NAMES OF ALL VOLUMES TO 00236C BE SAVED 00237C 41-48 CORRESPONDING VOLUME NUMBERS 00238 DO 280 M=1,4 00239 L=8+(4*(I-1))+M 00240 K=J+M+1 00241 280 SH(L)=VIT(K) 00242 SH(I+40)=$002F+I 00243 CALL SFWRIT(LUNIT,DSPLY,LEN(40),COMP,FLAG,TEMP) 00244 290 CONTINUE 00245. 00246C 00247C TYPE GO TO CONTINUE 00248 300 IBUF(1)=$0000 00249ÐÐ CALL SFWRIT(LUNIT,DS1100,LEN(17),COMP,FLAG,TEMP) 00250 ASSIGN 320 TO COMP 00251 CALL READ(LUNIT,IBUF,LEN(1),COMP,FLAG,TEMP) 00252 CALL DISP 00253 320 IF(IBUF(1).EQ.GO) GO TO 330 00254 IF(IBUF(1).EQ.EX) GO TO 9997 00255 GO TO 300 00256C DISPLAY TAPE MOUNTING INSTRUCTIONS 00257 330 CALL SFWRIT(LUNIT,DS1110,LEN(22),COMP,FLAG,TEMP) 00258 CALL SFWRIT(LUNIT,DS1111,LEN(23),COMP,FLAG,TEMP) 00259 CALL SFWRIT(LUNIT,DS1112,LEN(19),COMP,FLAG,TEMP) 00260 CALL SFWRIT(LUNIT,DS1113,LEN(19),COMP,FLAG,TEMP) 00261 CALL SFWRIT(LUNIT,DS1114,LEN(19),COMP,FLAG,TEMP) 00262 CALL SFWRIT(LUNIT,DS1120,LEN(38),COMP,FLAG,TEMP) 00263 CALL SFWRIT(LUNIT,DS1121,LEN(38),COMP,FLAG,TEMP) 00264 CALL SFWRIT(LUNIT,DS1122,LEN(13),COMP,FLAG,TEMP) 00265C CHECK FOR ALT TAPE DRIVES 00266 420 IBUF(1)=$0000 00267 CALL SFWRIT(LUNIT,DS1130,LEN(15),COMP,FLAG,TEMP) 00268C ENTER IF ALTERNATE DRIVES ARE TO BE USED 00269 ASSIGN 440 TO COMP 00270 CALL READ(LUNIT,IBUF,LEN(1),COMP,FLAG,TEMP) 00271 CALL DISP 00272 440 IF(IBUF(1).EQ.$4EFF) GO TO 450 00273 IF(IBUF(1).NE.$59FF) GO TO 420 00274ÐÐ TPALT=1 00275 GO TO 480 00276C SELECT A DRIVE 00277 450 IBUF(1)=$0000 00278 CALL SFWRIT(LUNIT,DS1140,LEN(15),COMP,FLAG,TEMP) 00279 460 ASSIGN 470 TO COMP 00280 CALL READ(LUNIT,IBUF,LEN(1),COMP,FLAG,TEMP) 00281 CALL DISP 00282 470 IF(IBUF(1).EQ.$30FF) GO TO 480 00283 IF(IBUF(1).NE.$31FF) GO TO 450 00284 TPDR=$0031 00285 GO TO 490 00286C SET TAPE SWITCHES 00287 480 TPDR=$0030 00288 490 DS1150(27)=TPDR 00289 CALL SFWRIT(LUNIT,DS1150,LEN(37),COMP,FLAG,TEMP) 00290C TYPE GO TO CONTINUE 00291 510 IBUF(1)=$0000 00292 CALL SFWRIT(LUNIT,DS1100,LEN(17),COMP,FLAG,TEMP) 00293 ASSIGN 530 TO COMP 00294 CALL READ(LUNIT,IBUF,LEN(1),COMP,FLAG,TEMP) 00295 CALL DISP 00296 530 IF(IBUF(1).EQ.GO) GO TO 540 00297 IF(IBUF(1).EQ.EX) GO TO 9997 00298 GO TO 510 00299ÐÐC SET UP BEGINNING OF TAPE VALUES 00300 540 RESTRT(1)=1 00301 RESTRT(2)=0 00302 RESTRT(3)=0 00303 RESTRT(4)=0 00304 RESTRT(5)=2 00305 RESTRT(6)=SAVVOL 00306 RESTRT(7)=0 00307C DISPLAY BLANK ON CONSOLE 00308 CALL SFWRIT(LUNIT,DSPBLK,LEN(1),COMP,FLAG,TEMP) 00309C 00310C IF ALT TAPES DISPLAY NEXT TAPE INSTRESTRT( 00311 550 IF(TPALT.EQ.0) GO TO 560 00312 IF(TPDR.EQ.$0030)DS1190(30)=$0031 00313 IF(TPDR.EQ.$0031)DS1190(30)=$0030 00314 CALL SFWRIT(LUNIT,DS1190,LEN(40),COMP,FLAG,TEMP) 00315C 00316C SET UP BEGINNING OF SAVE HEADER 00317C WORD DESCRIPTION 00318C 1 RECORD TYPE '0' 00319C 2 SEQUENCE NUMBER 00320C 3 CURRENT MONTH 00321C 4 CURRENT DAY 00322C 5 CURRENT YEAR 00323C 6 CURRENT HOUR 00324ÐÐC 7 CURRENT MINUTES 00325C 8 NUMBER OF VOLUMES ON SAVE TAPE 00326C 9-48 SET UP EARLIER 00327C 49 SECTOR SIZE 00328C 50 CHECKSUM 00329 560 SH(1)=$0030 00330 SEQNUM=SEQNUM+1 00331 SH(2)=SEQNUM 00332 SH(3)=AND($FFFF,AMONTO) 00333 SH(4)=AND($FFFF,ADAYTO) 00334 SH(5)=AND($FFFF,AYERTO) 00335 CALL CCSTIM(SH(6)) 00336 SH(49)=SECSIZ 00337 SH(8)=SAVNUM 00338 CALL CHEKSM(SH,49,CHECK) 00339 SH(50)=CHECK 00340 DATTYP=1 00341C 00342C SET UP BEGINNING OF TAPE LABEL 00343C WORD DESCRIPTION 00344C 1 RECORD TYPE '1' 00345C 2 SEQUENCE NUMBER 00346C 3 REEL NUMBER 00347C 4-7 VOLUME NAME OF FIRST VOLUME ON 00348C REEL 00349ÐÐC 8 CHECKSUM 00350 TH(1)=$0031 00351 SEQNUM=SEQNUM+1 00352 TH(2)=SEQNUM 00353 TH(3)=TH(3)+$0001 00354 DO 600 I=1,4 00355 J=8+(4*SAVVOL)+I 00356 600 TH(I+3)=SH(J) 00357 CALL CHEKSM(TH,7,CHECK) 00358 TH(8)=CHECK 00359C MOVE SAVE HEADER TO TAPE BUFFER 00360C WRITE SAVE HEADER TO TAPE 00361 CALL SAVTAP(SAVVOL,SH,50) 00362C IF TAPERR OCCURS SAVE AND TAPE HEADERS ARE 00363C BOTH WRITTEN TO TAPE IN SAVTAP SUBROUTINE 00364C SKIP TAPE HEADER ON TAPERR 00365 IF(TAPERR.LT.0) GO TO 700 00366C MOVE TAPE HEADER TO TAPE BUFFER 00367C WRITE TAPE HEADER TO TAPE 00368 CALL SAVTAP(SAVVOL,TH,8) 00369C SAVE HEADER AND TAPE HEADER BEEN REWRITTEN 00370C IF ERROR OCCURED. RESET TAPERR 00371 700 TAPERR=0 00372C DISABLE TIMER,MI,PROTECT SWITCH,ERROR 00373C LOGGING,CHECK FOR ITOS DISABLE 00374ÐÐ 705 CALL SDSABL 00375C CHECK FOR ERROR IN DISABLE ROUTINE 00376 DISERR=LINK(0) 00377 IF(DISERR.LT.0) GO TO 9800 00378C NO ERROR,CONTINUE 00379. 00380C 00381C ARE THERE MORE DISKS TO SAVE 00382 DO 750 I=1,8 00383 IF(SVALL.EQ.0) GO TO 706 00384 IF(MNTRDY(I).EQ.0) GO TO 740 00385 GO TO 710 00386 706 IF(I.LE.SAVVOL) GO TO 750 00387 710 DO 720 J=1,4 00388 K=8+(4*(I-1))+J 00389 720 DS1160(J+1)=SH(K) 00390C SAVE THE DISK 00391 CALL SFWRIT(LUNIT,DS1160,LEN(17),COMP,FLAG,TEMP) 00392 730 CALL SAVDSK(SAVVOL) 00393 IF(MMERR.LT.0) GO TO 9500 00394 IF(SVALL.EQ.0) GO TO 9000 00395 740 SAVVOL=SAVVOL+1 00396 750 CONTINUE 00397C ALL DISKS ARE SAVED 00398C SET UP END OF SAVE TRIALER 00399ÐÐC WORD DESCRIPTION 00400C 1 RECORD TYPE '6' 00401C 2 SEQUENCE NUMBER 00402C 3-7 NOT USED 00403C 8 CHECKSUM 00404 9000 EST(1)=$0036 00405 EST(2)=SEQNUM+1 00406 CALL CHEKSM(EST,7,CHECK) 00407 EST(8)=CHECK 00408 CALL SAVTAP(SAVVOL,EST,8) 00409 GO TO 9600 00410C MASS MEMORY ERROR HAS OCCURED PRINT 00411C MESSAGE AND DISCONTINUE RUNNING PROGRAM 00412 9500 GO TO 9800 00413C WRITE END OF SAVE TRAILER 00414 9600 CALL SFWRIT(LUNIT,DS1170,LEN(16),COMP,FLAG,TEMP) 00415 9700 CALL SFWRIT(LUNIT,DS1180,LEN(18),COMP,FLAG,TEMP) 00416 9800 CALL SYFAIL 00417 9997 CONTINUE 00418 STOP 0002 00419 END 00420 SUBROUTINE SAVHNK(SAVVOL) 00001 1 /L06 F ITOS CCS 3.0 . SL-149 00002C 00003C COPYRIGHT CONTROL DATA CORPORATION,1979 00004ÐÐC DATA SYSTEMS - LA JOLLA DIVISON, LA JOLLA, CALIFORNIA 00005C CREDIT COLLECTION SYSTEM VERSION 3.0 00006C 00007C THIS SUBROUTINE COMPUTES HOW MANY SECTORS WILL BE READ FROM 00008C MASS MEMORY. IT CALLS THE SVREAD SUBROUTINE WHICH READS THE 00009C DISK. THE STARTING ADDRESS AND THE TOTAL NUMBER OF SECTORS TO 00010C BE READ FROM MASS MEMORY IS PASSED FROM THE SAVDSK PROGRAM TO 00011C THE SAVHNK PROGRAM. IF THE TOTAL NUMBER OF SECTORS IS GREATER 00012C THAN 20, THE NUMBER OF READS IT WILL TAKE TO READ THE TOTAL 00013C NUMBER OF SECTORS IS COMPUTED. IF THE TOTAL NUMBER OF SECTORS 00014C IS LESS THAN 20, THEN THE NUMBER OF READS IS 1 AND THE NUMBER 00015C OF SECTORS TO READ IS EQUAL TO THE LENGTH PASSED FROM SAVDSK. 00016C IF A NEGATIVE MASS MEMORY STATUS WAS PASSED BACK FROM THE 00017C SVREAD SUBROUTINE, THEN SAVHNK RETURNS THIS STATUS TO THE 00018C SAVDSK PROGRAM. IF A POSITIVE OR 0 MASS MEMORY STATUS IS 00019C RETURNED, THEN A DATA RECORD IS CREATED AND THE SAVTAP 00020C SUBROUTINE IS CALLED TO WRITE THIS RECORD TO TAPE. WHEN 00021C CREATING A DATA RECORD, A CHECKSUM IS DONE ON THE RECORD. 00022C A SEQUENCE NUMBER, STARTING ADDRESS AND RECORD LENGTH IS 00023C STORED IN THE DATA RECORD, BESIDES THE DATA RETRIEVED FROM 00024C MASS MEMORY. IF A TAPE ERROR STATUS THAT IS RETURNED FROM 00025C SAVTAP IS NEGATIVE, THEN THE PROGRAM PASSES THIS STATUS 00026C BACK TO THE SAVDSK PROGRAM FOR RESTARTING THE TAPE. 00027. 00028. 00029ÐÐC COMMON INTEGERS 00030 INTEGER COMP,DATTYP,EX,FCBIND,FLAG,GO,IDUSER(4) 00031 INTEGER IBUF(3),LEN(40),LUNIT,MMERR,OPP1(2),OPP2(2) 00032 INTEGER OV,READIN(2),REELNM,RESTRT(8),RESULT(2),SEQNUM 00033 INTEGER SECSIZ,SH(50),STADD(2),SVALL,SLEN(2) 00034 INTEGER TAPERR,TEMP(8),TH(8),TPALT,TPDR,TYPERR,VH(10),VIT(184) 00035C COMMON 00036 COMMON/A/COMP,DATTYP,EX,FCBIND,FLAG,GO,IDUSER 00037 COMMON/A/IBUF,LEN,LUNIT,MMERR,OPP1,OPP2 00038 COMMON/A/OV,READIN,REELNM,RESTRT,RESULT,SEQNUM 00039 COMMON/A/SECSIZ,SH,STADD,SVALL,SLEN 00040 COMMON/A/TAPERR,TEMP,TH,TPALT,TPDR,TYPERR,VH,VIT 00041C 00042 INTEGER BUFF(2),CHECK,DATREC(1926),ERMSG1(31),ERMSG2(26) 00043 INTEGER READNM(2),READSC,RECLEN,SAVVOL,WDSRED,CHEKNM 00044C DATA STATEMENTS 00045 DATA DATREC/1926*0/,MMERR/0/,READSC/20/ 00046C DISPLAYED ERROR MESSAGES 00047 DATA ERMSG1/$000D,' DIVISION ERROR-DIVISOR IS ZERO OR ', 00048 1'DIVIDEND IS NOT POSITIVE'/ 00049 DATA ERMSG2/'DIVISOR= DIVIDEND= STADD= ', 00050 1'XXXX XXXX'/ 00051. 00052C INITIALIZE NUMBER OF SECTORS PER READ 00053C 00054ÐÐ READSC=20 00055 IF (SECSIZ .EQ. 569) READSC = 3 00056C 00057C COMPUTE NUMBER OF SECTORS PER READ 00058C THE NUMBER OF SECTORS PER READ WILL BE 00059C READSC UNLESS THE NUMBER OF SECTORS IS 00060C LESS THAN READSC, THEN THE NUMBER OF SECTO 00061C PER READ IS EQUAL TO THE NUMBER OF SECTORS 00062 IF(SLEN(1).GT.0.OR.SLEN(2).GE.READSC) GO TO 110 00063C LESS THAN READSC SET READSC AND READNM 00064 READSC=SLEN(2) 00065 RECLEN=(READSC*SECSIZ)+6 00066 READNM(1)=0 00067 READNM(2)=1 00068 GO TO 120 00069C COMPUTE THE NUMBER OF READS 00070C DIVIDE # OF SECTORS BY READS PER SECTOR+1 00071 110 CALL DBLDIV(SLEN,READSC,READNM,ISTAT) 00072C CHECK FOR DIVISION ERROR 00073 IF(ISTAT.NE.$0000) GO TO 9000 00074C ADD ONE TO ADJUST FOR REMAINDER 00075 OPP2(1)=$0000 00076 OPP2(2)=$0001 00077 CALL FDWADD(READNM,OPP2,READNM,OV) 00078 RECLEN=(READSC*SECSIZ)+6 00079ÐÐC INITIALIZE READ INDEX 00080 120 READIN(1)=$0000 00081 READIN(2)=$0001 00082. 00083C 00084C CHECK IF ALL OF HUNK HAS BEEN READ 00085 140 IF(READIN(1).EQ.READNM(1).AND.READIN(2).GT.READNM(2)) GO TO 9999 00086C GET DISK LU FORM VITS 00087 J=SAVVOL*23 00088 MMLU=VIT(J+1) 00089C NOT ALL OF HUNK HAS BEEN READ CONTINUE 00090C READ MASS MEMORY 00091 CALL SVREAD(SAVVOL,DATREC,MMLU,READSC) 00092C CHECK FOR MASS MEMORY ERROR 00093 IF(MMERR.LT.0)GO TO 9999 00094C 00095C FORMAT THE DATA RECORD 00096C WORD DESCRIPTION 00097C 1 RECORD TYPE '3' 00098C 2 SEQUENCE NUMBER 00099C 3-4 STARTING ADDRESS MSB/LSB 00100C 5 RECORD LENGTH IN WORDS 00101C 00102 150 DATREC(1)=$0033 00103 DATREC(3)=STADD(1) 00104ÐÐ DATREC(4)=STADD(2) 00105 DATREC(5)=RECLEN 00106 SEQNUM=SEQNUM+1 00107 DATREC(2)=SEQNUM 00108C 00109C REST OF RECORD IS ALREADY IN DATREC 00110C BY THE MASS MEMORY READ ROUTINE 00111C 00112C COMPUTE CHECKSUM 00113 CHEKNM=RECLEN-1 00114 CALL CHEKSM(DATREC,CHEKNM,CHECK) 00115 DATREC(RECLEN)=CHECK 00116C WRITE DATA RECORD TO TAPE 00117 CALL SAVTAP(SAVVOL,DATREC,RECLEN) 00118 IF(TAPERR.LT.0) GO TO 9999 00119C INCREMENT STARTING ADDRESS BY NUMBER OF 00120C SECTORES PER READ 00121 200 OPP1(1)=STADD(1) 00122 OPP1(2)=STADD(2) 00123 OPP2(1)=$0000 00124 OPP2(2)=READSC 00125 CALL FDWADD(OPP1,OPP2,STADD,OV) 00126C 00127C INCREMENT READ INDEX 00128 OPP2(1)=0 00129ÐÐ OPP2(2)=$0001 00130 CALL FDWADD(READIN,OPP2,READIN,OV) 00131C GO BACK TO READ MORE 001321 00133 GO TO 140 00134. 00135C 00136C 00137C DIVISION ERROR PRINT VALUES 00138C SET FATAL ERROR SWICH 00139 9000 MMERR=$8000 00140 CALL SFWRIT(LUNIT,ERMSG1,LEN(31),COMP,FLAG,TEMP) 00141 9010 CALL CCSHXA(RESULT(1),BUFF) 00142 ERMSG2(13)=BUFF(1) 00143 ERMSG2(14)=BUFF(2) 00144 CALL CCSHXA(RESULT(2),BUFF) 00145 ERMSG2(16)=BUFF(1) 00146 ERMSG2(17)=BUFF(2) 00147 CALL CCSHXA(READSC,BUFF) 00148 ERMSG2(5)=BUFF(1) 00149 ERMSG2(6)=BUFF(2) 00150 CALL CCSHXA(STADD(1),BUFF) 00151 ERMSG2(22)=BUFF(1) 00152 ERMSG2(23)=BUFF(2) 00153 CALL CCSHXA(STADD(2),BUFF) 00154ÐÐ ERMSG2(25)=BUFF(1) 00155 ERMSG2(26)=BUFF(2) 00156 CALL SFWRIT(LUNIT,ERMSG2,LEN(26),COMP,FLAG,TEMP) 00157 9999 RETURN 00158 END 00159 PROGRAM SAVRLD 00001 1 /L07 F ITOS CCS 3.0 SL-149 00002C 00003C COPYRIGHT CONTROL DATA CORPORATION, 1979 00004C DATA SYSTEMS, LA JOLLA DIVISION, LA JOLLA CALIFORNIA 00005C CREDIT COLLECTION SYSTEM, VERSION 3.0 00006C 00007C THIS PROGRAM ASKS THE OPERATOR WHICH 00008C OPTION TO TAKE, SAVE OR LOAD OF THE 00009C SYSTEM. IF THE OPERATOR CHOOSES TO SAVE, 00010C THEN A SAVE IS DONE FROM DISK TO TAPE. IF 00011C THE OPERATOR CHOOSES TO LOAD, THE A LOAD 00012C IS DONE FROM TAPE TO DISK. 00013C LOAD CALLS RLDDSK AND SAVE CALLS SAVDSP. 00014. 00015C 00016C INTEGERS 00017 INTEGER DSP100(5),DSP110(21),DSP120(22),ANS(3),COMP,FLAG,TEMP(8) 00018 INTEGER LO,AD,SA,VE,DSP130(18),ITOSON,TSNABL 00019C 00020ÐÐC DATA STATEMENTS 00021 DATA LUNIT/$1004/,FLAG/1/,LO/$4C4F/,AD/$4144/,SA/$5341/ 00022 DATA VE/$5645/,TEMP/8*0/,COMP/0/,ITOSON/1/ 00023C DISPLAY STATEMENTS 00024 DATA DSP100/$1800,' EDTLP '/ 00025 DATA DSP110/$000D,' TYPE SAVE FOR DISK-TO-TAPE SAVE'/ 00026 DATA DSP120/' TYPE LOAD FOR TAPE-TO-DISK RELOAD',$0A0D/ 00027 DATA DSP130/$000D,'ILLEGAL, CCS HAS NOT BEEN DISABLED'/ 00028 00029 EXTERNAL TSNABL 00030C 00031C SEE IF CCS IS DISABLED 00032 ASSEM $C400,+TSNABL,$6800,ITOSON 00033 40 IF(ITOSON.NE.0) GO TO 400 00034C 00035C DISPLAY OPERATOR INSTRUCTIONS 00036 100 CALL SFWRIT(LUNIT,DSP100,5,COMP,FLAG,TEMP) 00037 CALL SFWRIT(LUNIT,DSP110,21,COMP,FLAG,TEMP) 00038 CALL SFWRIT(LUNIT,DSP120,22,COMP,FLAG,TEMP) 00039C 00040C READ ANSWER 00041 ASSIGN 110 TO COMP 00042 CALL READ(LUNIT,ANS,2,COMP,FLAG,TEMP) 00043 CALL DISP 00044C CHECK ANSWER FOR SAVE 00045ÐÐ 110 IF(ANS(1).NE.SA) GO TO 120 00046 IF(ANS(2).NE.VE) GO TO 100 00047C ANSWER WAS SAVE 00048 GO TO 300 00049C CHECK ANSWER FOR LOAD 00050 120 IF(ANS(1).NE.LO) GO TO 100 00051 IF(ANS(2).NE.AD) GO TO 100 00052C ANSWER WAS LOAD 00053 GO TO 200 00054C 00055C GO TO RELOAD SUBROUTINES 00056 200 CALL RLDDSK 00057 CALL SYFAIL 00058C GO TO SAVE SUBROUTINES 00059 300 CALL SAVDSP 00060 CALL SYFAIL 00061C 00062 400 CALL SFWRIT(LUNIT,DSP130,18,COMP,FLAG,TEMP) 00063 STOP 0001 00064 END 00065 SUBROUTINE SAVTAP(SAVVOL,DATREC,RECLEN) 00001 1 /L08 F ITOS CCS 3.0 SL-149 00002C 00003C COPYRIGHT CONTROL DATA CORPORATION, 1979 00004C DATA SYSTEMS, LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00005ÐÐC CREDIT COLLECTION SYSTEM, VERSION 3.0 00006C 00007C THIS SUBROUTINE HANDLES THE TAPES. IT CALLS THE SVWRIT 00008C SUBROUTINE WHICH WRITES TO TAPE. IT CHECKS FOR END OF TAPE. 00009C IF END OF TAPE IS FOUND, A END OF TAPE TRAILER IS WRITTEN TO 00010C TAPE, THE NEXT TAPE MOUNTING INSTRUCTIONS ARE DISPLAYED TO THE 00011C SCREEN AND A TAPE HEADER IS WRITTEN TO THE NEXT TAPE. IT ALSO 00012C CHECKS TO SEE IF A TAPE ERROR OCCURED. IF A TAPE ERROR OCCURED 00013C A MESSAGE IS DISPLAYED TO THE CONSOLE AND A LIST OF 3 OPTIONS 00014C FOR RECOVERY ARE DISPLAYED TO THE SCREEN. AFTER THE OPERATOR 00015C PICKS AN OPTION, TAPE MOUNTING OR REWIND INSTRUCTIONS ARE 00016C DISPLAYED TO THE SCREEN. THE TAPE IS THEN RESTARTED. THE 00017C OPTIONS GIVE THE OPERATOR A CHANCE TO CHANGE TAPE DRIVES OR 00018C DICONTINUE USING THE DRIVE WHICH FAILED DEPENDING ON THE 00019C WHAT CAUSED THE TAPE ERROR. 00020C 00021. 00022C COMMON INTEGERS 00023 INTEGER COMP,DATTYP,EX,FCBIND,FLAG,GO,IDUSER(4) 00024 INTEGER IBUF(3),LEN(40),LUNIT,MMERR,OPP1(2),OPP2(2) 00025 INTEGER OV,READIN(2),REELNM,RESTRT(8),RESULT(2),SEQNUM 00026 INTEGER SECSIZ,SH(50),STADD(2),SVALL,SLEN(2) 00027 INTEGER TAPERR,TEMP(8),TH(8),TPALT,TPDR,TYPERR,VH(10),VIT(184) 00028C COMMON 00029 COMMON/A/COMP,DATTYP,EX,FCBIND,FLAG,GO,IDUSER 00030ÐÐ COMMON/A/IBUF,LEN,LUNIT,MMERR,OPP1,OPP2 00031 COMMON/A/OV,READIN,REELNM,RESTRT,RESULT,SEQNUM 00032 COMMON/A/SECSIZ,SH,STADD,SVALL,SLEN 00033 COMMON/A/TAPERR,TEMP,TH,TPALT,TPDR,TYPERR,VH,VIT 00034C 00035C 00036C INTEGERS 00037 INTEGER CHECK,DATREC(1926),DTSTRT,EOT,ETT(8),OPT(2) 00038 INTEGER SAVVOL,TAPERR,TAPBUF(50),RECLEN 00039 INTEGER DSP100(34),DSP110(9),DSP120(28),DSP125(33) 00040 INTEGER DSP130(36),DSP140(14) 00041 INTEGER DSP150(31),DSP160(29),DSP170(31),DSP180(14) 00042 INTEGER DSP190(39),DSP200(16) 00043C 00044 DATA DTSTRT/6/,ETT/8*0/,EOT/0/ 00045C 00046 DATA DSP100/$000D,' ****OPERATOR-REWIND TAPE-MOUNT OUTPUT ', 00047 1' TAPE WITH RING ON UNIT '/ 00048 DATA DSP110/$000D,' READY?(Y OR N)'/ 00049 DATA DSP120/$000D,' ****',$000D,' ****OPERATOR-REWIND TAPE', 00050 1' ON UNIT XX',$000D,' ****'/ 00051 DATA DSP125/$000D,' ****',$000D,' ****OPERATOR-REWIND TAPE', 00052 1' ON UNIT XX AND LABEL',$000D,' ****'/ 00053 DATA DSP130/$000D,' ****',$000D,' ****OPERATOR-MOUNT OUTPUT ', 00054 1' TAPE ON UNIT WITH RING',$000D,' ****'/ 00055ÐÐ DATA DSP140/$1800,' TAPE ERROR HAS OCCURRED '/ 00056 DATA DSP150/$000D,' OPTIONS:',$000D,' (1)MOUNT NEW ', 00057 1'OUTPUT TAPE ON TAPE DRIVE '/ 00058 DATA DSP160/' (2)MOUNT NEW OUTPUT TAPE ALTERNATING THE', 00059 1' TAPE DRIVES'/ 00060 DATA DSP170/' (3)MOUNT NEW OUTPUT TAPE CHANGING TO USE', 00061 1' DRIVE ONLY '/ 00062 DATA DSP180/' PICK AN OPTION FROM ABOVE '/ 00063 DATA DSP190/$000D,' ****',$000D,' ****OPERATOR-MOUNT NEXT ', 00064 1'OUTPUT TAPE ON UNIT XX WITH RING',$000D,' ****'/ 00065 DATA DSP200/$1800,' END OF TAPE HAS BEEN REACHED'/ 00066. 00067C 00068C 00069C TAPE HANDLING SUBROUTINE 00070C 00071C WRITE RECORD TO TAPE 00072 CALL SVWRIT(SAVVOL,DATREC,RECLEN,EOT) 00073C 00074C CHECK FOR TAPE ERROR 00075 100 IF(TAPERR.LT.0) GO TO 500 00076C CHECK FOR END OF TAPE 00077 IF(EOT.NE.$0200) GO TO 9999 00078C SET UP END OF TAPE TRAILER 00079C WORD DESCRIPTION 00080ÐÐC 1 RECORD TYPE'5' 00081C 2 SEQUENCE NUMBER 00082C 3 REEL NUMBER 00083C 4-7 NOT USED 00084C 8 CHECKSUM 00085C 00086 ETT(1)=$0035 00087 SEQNUM=SEQNUM+1 00088 ETT(2)=SEQNUM 00089 ETT(3)=TH(3) 00090C CALL CHECKSUM 00091 CALL CHEKSM(ETT,7,CHECK) 00092 ETT(8)=CHECK 00093C WRITE END OF TAPE TRAILER TO TAPE 00094 CALL SVWRIT(SAVVOL,ETT,8,EOT) 00095C CHECK FOR TAPE ERROR 00096 IF(TAPERR.LT.0) GO TO 500 00097 EOT=0 00098C DISPLAY OPERATOR INSTRUCTIONS FOR 00099C MOUNTING NEXT TAPE ON CONSOLE 00100C CHECK IF ALTERNATING DRIVES 00101 CALL SFWRIT(LUNIT,DSP200,LEN(16),COMP,FLAG,TEMP) 00102 IF(TPALT.EQ.1) GO TO 210 00103C ALT DRIVES NOT USED REWIND AND CONTINUE 00104C USING SAME DRIVE 00105ÐÐC 00106C DISPLAY REWIND AND MOUNTING INSTRUCTIONS 00107 DSP125(24)=TPDR 00108 130 CALL SFWRIT(LUNIT,DSP125,LEN(33),COMP,FLAG,TEMP) 00109 DSP130(27)=TPDR 00110 CALL SFWRIT(LUNIT,DSP130,LEN(36),COMP,FLAG,TEMP) 00111C DISPLAY READY MESSAGE 00112 CALL SFWRIT(LUNIT,DSP110,LEN(9),COMP,FLAG,TEMP) 00113C REPLY 00114 140 IBUF(1)=$0000 00115 ASSIGN 150 TO COMP 00116 CALL READ(LUNIT,IBUF,LEN(1),COMP,FLAG,TEMP) 00117 CALL DISP 00118 150 IF(IBUF(1).EQ.$4EFF) GO TO 130 00119 IF(IBUF(1).NE.$59FF) GO TO 130 00120 GO TO 300 00121C ALTERNATING TAPE DRIVES ARE USED TO 00122C SWITCH TAPE DRIVES 00123C SET UP FOR REWIND INSTRUCTION 00124 210 DSP125(24)=TPDR 00125C CHANGE TAPE DRIVE 00126 IF(TPDR.EQ.$0030) GO TO 220 00127 TPDR=$0030 00128 GO TO 230 00129 220 TPDR=$0031 00130ÐÐC DISPLAY TAPE MOUNTIN INSTR. 00131 230 DSP130(27)=TPDR 00132 CALL SFWRIT(LUNIT,DSP130,LEN(36),COMP,FLAG,TEMP) 00133C IS TAPE READY 00134 240 CALL SFWRIT(LUNIT,DSP110,LEN(9),COMP,FLAG,TEMP) 00135C REPLY 00136 250 IBUF(1)=$0000 00137 ASSIGN 260 TO COMP 00138 CALL READ(LUNIT,IBUF,LEN(1),COMP,FLAG,TEMP) 00139 CALL DISP 00140 260 IF(IBUF(1).EQ.$4EFF) GO TO 230 00141 IF(IBUF(1).NE.$59FF) GO TO 230 00142C DISPLAY NEXT TAPE MOUNTING INSTR. 00143 CALL SFWRIT(LUNIT,DSP125,LEN(33),COMP,FLAG,TEMP) 00144 IF(TPDR.EQ.$0030)DSP190(30)=$0031 00145 IF(TPDR.EQ.$0031)DSP190(30)=$0030 00146 CALL SFWRIT(LUNIT,DSP190,LEN(39),COMP,FLAG,TEMP) 00147C SAVE INFO FOR RESTART ON TAPERR 00148 300 RESTRT(1)=DATTYP 00149 RESTRT(2)=0 00150 RESTRT(3)=0 00151 RESTRT(4)=FCBIND 00152 RESTRT(5)=SEQNUM+1 00153 RESTRT(6)=SAVVOL 00154C SET UP TAPE HEADER 00155ÐÐ TH(1)=$0031 00156 SEQNUM=SEQNUM+1 00157 TH(2)=SEQNUM 00158 TH(3)=TH(3)+1 00159 DO 310 I=1,4 00160 J=8+(4*SAVVOL)+I 00161 310 TH(I+3)=SH(J) 00162 CALL CHEKSM(TH,7,CHECK) 00163 TH(8)=CHECK 00164C WRITE TAPE HEADER TO TAPE 00165 CALL SVWRIT(SAVVOL,TH,8,EOT) 00166C CHECK FOR TAPE ERROR 00167 IF(TAPERR.GE.0) GO TO 9999 00168 DATTYP=1 00169 GO TO 500 00170. 00171C 00172C TAPE ERROR HAS OCCURED RESTART TAPE 00173 500 RESTRT(7)=TAPERR 00174 TAPERR=0 00175 CALL SFWRIT(LUNIT,DSP140,LEN(14),COMP,FLAG,TEMP) 00176 510 DSP150(31)=TPDR 00177 CALL SFWRIT(LUNIT,DSP150,LEN(31),COMP,FLAG,TEMP) 00178 CALL SFWRIT(LUNIT,DSP160,LEN(29),COMP,FLAG,TEMP) 00179 IF(TPDR.EQ.$0030) GO TO 540 00180ÐÐ DSP170(28)=$0030 00181 GO TO 550 00182 540 DSP170(28)=$0031 00183 550 CALL SFWRIT(LUNIT,DSP170,LEN(31),COMP,FLAG,TEMP) 00184 CALL SFWRIT(LUNIT,DSP180,LEN(14),COMP,FLAG,TEMP) 00185C REPLY 00186 570 OPT(1)=$0000 00187 ASSIGN 580 TO COMP 00188 CALL READ(LUNIT,OPT,LEN(1),COMP,FLAG,TEMP) 00189 CALL DISP 00190. 00191C 00192C BRANCH TO OPTION 00193 580 IF(OPT(1).EQ.$31FF) GO TO 600 00194 IF(OPT(1).EQ.$32FF) GO TO 610 00195 IF(OPT(1).NE.$33FF) GO TO 510 00196 GO TO 640 00197C DISPLAY OPERATOR INST, OPTION 1 00198 600 DSP120(24)=TPDR 00199 CALL SFWRIT(LUNIT,DSP120,LEN(28),COMP,FLAG,TEMP) 00200 DSP130(27)=TPDR 00201 CALL SFWRIT(LUNIT,DSP130,LEN(36),COMP,FLAG,TEMP) 00202 GO TO 700 00203 00204 610 IF(TPDR.EQ.$0030) GO TO 620 00205ÐÐ DSP120(24)=$0031 00206 DSP130(27)=$0030 00207 GO TO 630 00208 620 DSP130(27)=$0031 00209 DSP120(24)=$0030 00210 630 CALL SFWRIT(LUNIT,DSP130,LEN(36),COMP,FLAG,TEMP) 00211 GO TO 700 00212C OPTION 3 00213 640 IF(TPDR.EQ.$0030) GO TO 650 00214 DSP130(27)=$0030 00215 DSP120(24)=$0031 00216 GO TO 660 00217 650 DSP130(27)=$0031 00218 DSP120(24)=$0030 00219 660 CALL SFWRIT(LUNIT,DSP130,LEN(36),COMP,FLAG,TEMP) 00220C READY 00221 700 CALL SFWRIT(LUNIT,DSP110,LEN(9),COMP,FLAG,TEMP) 00222C REPLY 00223 710 IBUF(1)=$0000 00224 ASSIGN 720 TO COMP 00225 CALL READ(LUNIT,IBUF,LEN(1),COMP,FLAG,TEMP) 00226 CALL DISP 00227 720 IF(IBUF(1).EQ.$4EFF) GO TO 510 00228 IF(IBUF(1).NE.$59FF) GO TO 510 00229 TPDR=DSP130(27) 00230ÐÐ IF(OPT(1).EQ.$32FF)TPALT=1 00231 IF(OPT(1).EQ.$33FF)TPALT=0 00232 IF(OPT(1).NE.$3200) GO TO 730 00233 CALL SFWRIT(LUNIT,DSP120,LEN(28),COMP,FLAG,TEMP) 00234 IF(TPDR.EQ.$0030)DSP190(30)=$0031 00235 IF(TPDR.EQ.$0031)DSP190(30)=$0030 00236 CALL SFWRIT(LUNIT,DSP190,LEN(39),COMP,FLAG,TEMP) 00237C RESTORE TO BEGINNING OF TAPE VALUES 00238 730 DATTYP=RESTRT(1) 00239 READIN(1)=RESTRT(2) 00240 READIN(2)=RESTRT(3) 00241 FCBIND=RESTRT(4) 00242 SEQNUM=RESTRT(5) 00243 SAVVOL=RESTRT(6) 00244C CHECK IF FIRST REEL IF SO WRITE SAVE HEADE 00245 IF(TH(3).NE.1) GO TO 750 00246C WRITE SAVE HEADER 00247 CALL SVWRIT(SAVVOL,SH,50,EOT) 00248 IF(TAPERR.LT.0) GO TO 500 00249C WRITE TAPE HEADER TO TAPE 00250 750 CALL SVWRIT(SAVVOL,TH,8,EOT) 00251C CHECK FOR TAPE ERROR 00252 IF(TAPERR.LT.0) GO TO 500 00253C RETURN TO CALLER 00254 TAPERR=RESTRT(7) 00255ÐÐ 9999 RETURN 00256 END 00257 SUBROUTINE SFWRIT(LUNIT,BUFFER,LEN,COMP,FLAG,TEMP) 00001 1 /L09 F ITOS CCS 3.0 SL-149 00002C 00003C COPYRIGHT CONTROL DATA CORPORATION, 1979 00004C DATA SYSTEMS, LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00005C CREDIT COLLECTION SYSTEM, VERSION 3.0 00006C 00007C THIS SUBROUTINE DOES A FWRITE. 00008C 00009C 00010C INTEGERS 00011 INTEGER LUNIT,BUFFER,LEN(3),COMP,FLAG,TEMP(8) 00012C 00013 10 ASSIGN 100 TO COMP 00014 CALL FWRITE(LUNIT,BUFFER,LEN,COMP,FLAG,TEMP) 00015 CALL DISP 00016 100 RETURN 00017 END 00018 SUBROUTINE SVREAD(SAVVOL,DATREC,MMLU,READSC) 00001 1 /L10 F ITOS CCS 3.0 SL-149 00002C CREDIT COLLECTION SYSTEM VERSION 3.0 00003C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00004C COPYRIGHT CONTROL DATA CORPORATION 1979 00005ÐÐC 00006C CONTROL DATA CORPORATION, 1979 00007C DATA SYSTEMS - LA JOLLA DIVISON, LA JOLLA, CALIFORNIA 00008C CREDIT COLLECTION SYSTEM, VERSION 3.0 00009C 00010C THIS SUBROUTINE DOES A FREAD FROM A SPECIFIED MASS MEMORY 00011C UNIT. IF A MASS MEMORY ERROR OCCURS, THE PROGRAM WILL REREAD 00012C THE THE MASS MEMORY REQUEST 100 TIMES OR UNTIL THE MASS MEMORY 00013C ERROR STOPS OCCURRING. THE MASS MEMORY STATUS IS RETURNED 00014C TO THE CALLING PROGRAM SAVHNK. A POSITIVE OR 0 STATUS MEANS 00015C THAT NO MASS MEMORY ERROR OCCURED AND A NEGATIVE STATUS MEANS 00016C THAT UNRECOVERABLE MASS MEMORY ERROR OCCURED. 00017. 00018C COMMON INTEGERS 00019 INTEGER COMP,DATTYP,EX,FCBIND,FLAG,GO,IDUSER(4) 00020 INTEGER IBUF(3),LEN(40),LUNIT,MMERR,OPP1(2),OPP2(2) 00021 INTEGER OV,READIN(2),REELNM,RESTRT(8),RESULT(2),SEQNUM 00022 INTEGER SECSIZ,SH(50),STADD(2),SVALL,SLEN(2) 00023 INTEGER TAPERR,TEMP(8),TH(8),TPALT,TPDR,TYPERR,VH(10),VIT(184) 00024C COMMON 00025 COMMON/A/COMP,DATTYP,EX,FCBIND,FLAG,GO,IDUSER 00026 COMMON/A/IBUF,LEN,LUNIT,MMERR,OPP1,OPP2 00027 COMMON/A/OV,READIN,REELNM,RESTRT,RESULT,SEQNUM 00028 COMMON/A/SECSIZ,SH,STADD,SVALL,SLEN 00029 COMMON/A/TAPERR,TEMP,TH,TPALT,TPDR,TYPERR,VH,VIT 00030ÐÐC 00031C INTEGERS 00032 INTEGER BUFF(2),MMLEN(3),DSP100(25),DATREC(1926),MMBUF(1921) 00033 INTEGER READSC 00034 DATA DSP100/$0A0D,' MASS MEMORY ERROR HAS OCCURRED ON LU', 00035 1' '/ 00036C 00037 EQUIVALENCE(DATREC(1926),MMBUF(1921)) 00038. 00039C 00040C SETUP LENGTH FOR MASS MEMORY READ 00041 MMLEN(1)=READSC*SECSIZ 00042 MMLEN(2)=STADD(1) 00043 MMLEN(3)=STADD(2) 00044C READ TILL NO ERROR OR LOOP FINISHES 00045 DO 210 I=1,100 00046C READ MASS MEMORY 00047 100 ASSIGN 200 TO COMP 00048 CALL FREAD(MMLU,MMBUF,MMLEN,COMP,FLAG,TEMP) 00049 CALL DISP 00050C GET MASS MEMORY STATUS 00051 200 MMERR=LINK(0) 00052C CHECK FOR MASS MEMORY ERROR 00053 IF(MMERR.GE.0) GO TO 9999 00054C ERROR OCCURED 00055ÐÐC REREAD UNTIL LOOP FINISHES OR ERROR 00056C DISAPPERS 00057 210 CONTINUE 00058C READ FAILED 100 TIMES DISPLAY ERROR 00059 9000 CALL CCSHXA(MMERR,BUFF) 00060 DSP100(12)=BUFF(1) 00061 DSP100(13)=BUFF(2) 00062 CALL CCSHXA(MMLU,BUFF) 00063 DSP100(24)=BUFF(1) 00064 DSP100(25)=BUFF(2) 00065 CALL SFWRIT(LUNIT,DSP100,LEN(24),COMP,FLAG,TEMP) 00066C 00067 9999 RETURN 00068 END 00069 SUBROUTINE SVWRIT(SAVVOL,TAPREC,RECLEN,EOT) 00001 1 /L11 F ITOS CCS 3.0 SL-149 00002C 00003C COPYRIGHT CONTROL DATA CORPORATION, 1979 00004C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00005C CREDIT COLLECTION SYSTEM, VERSION 3.0 00006C 00007C THIS PROGRAM WRITES A RECORD TO TAPE. END OF TAPE STATUS IS 00008C TAKEN FROM THE PHYSTABS, AND IS PASSES BACK TO SAVTAP, THE 00009C CALLING PROGRAM. TAPE ERROR STATUS IS ALSO CHECKED AND PASSED 00010C BACK TO SAVTAP. IF A TAPE ERROR OCCURS A NEGATIVE STATUS IS 00011ÐÐC RETURNED. IF THERE IS NO TAPE ERROR A 0 OR POSITIVE STATUS 00012C IS RETURNED. 00013. 00014C 00015C COMMON INTEGERS 00016 INTEGER COMP,DATTYP,EX,FCBIND,FLAG,GO,IDUSER(4) 00017 INTEGER IBUF(3),LEN(40),LUNIT,MMERR,OPP1(2),OPP2(2) 00018 INTEGER OV,READIN(2),REELNM,RESTRT(8),RESULT(2),SEQNUM 00019 INTEGER SECSIZ,SH(50),STADD(2),SVALL,SLEN(2) 00020 INTEGER TAPERR,TEMP(8),TH(8),TPALT,TPDR,TYPERR,VH(10),VIT(184) 00021C COMMON 00022 COMMON/A/COMP,DATTYP,EX,FCBIND,FLAG,GO,IDUSER 00023 COMMON/A/IBUF,LEN,LUNIT,MMERR,OPP1,OPP2 00024 COMMON/A/OV,READIN,REELNM,RESTRT,RESULT,SEQNUM 00025 COMMON/A/SECSIZ,SH,STADD,SVALL,SLEN 00026 COMMON/A/TAPERR,TEMP,TH,TPALT,TPDR,TYPERR,VH,VIT 00027C 00028C INTEGERS 00029 INTEGER LOGIA,PHSTAB,SAVVOL,STATAD,STATUS,TAPE,TAPREC(1926) 00030 INTEGER EOT,RECLEN 00031. 00032C 00033C SET UP TAPE DRIVES 00034 EOT=0 00035 TAPERR=0 00036ÐÐ IF(TPDR.EQ.$0031) GO TO 100 00037 TAPE=6 00038 GO TO 200 00039 100 TAPE=16 00040C 00041C WRITE A RECORD TO TAPE 00042 200 ASSIGN 210 TO COMP 00043 CALL FWRITE(TAPE,TAPREC,RECLEN,COMP,FLAG,TEMP) 00044 CALL DISP 00045. 00046C BRING IN THE TAPE STATUS 00047 210 TAPERR=LINK(0) 00048C GET END OF TAPE STATUS FROM PHYSTABS 00049C GET ADDRESS OF THE LOGIA TABLE-28TH 00050C WORD OF THE EXT. COMMUNICATIONS TABLE 00051 CALL ADDECT(28,LOGIA) 00052C GET ADDRESS OF PHYSTAB FROM LOGIA TABLE 00053C PHYSTAB ADDRESS=LOGIA ADDRESS+TAPE LU# 00054 LOGIA=LOGIA+TAPE 00055 CALL GETWRD(LOGIA,1,PHSTAB) 00056C GET STATUS FROM THE 12TH WORD IN PHYSTAB 00057 STATAD=PHSTAB+12 00058 CALL GETWRD(STATAD,1,STATUS) 00059C CHECK IF STATUS IS EOT 00060 EOT=AND($0200,STATUS) 00061ÐÐC 00062 9999 RETURN 00063 END 00064 PROGRAM RBDFIL S8700001 1 /L12 F ITOS CCS 3.0 SL-149S8700002C*** RPG UTILITIES- MAIN PROGRAM FOR PUNCH OBJECT UTILITY S8700003C CREDIT COLLECTION SYSTEM VERSION 3.0 S8700004C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA S8700005C COPYRIGHT CONTROL DATA CORPORATION 1979 S8700006C S8700007C S8700008C S8700009C*** RPG NON-LINKING RBD DUMP ROUTINE S8700010C S8700011C S8700012C FUNCTION S8700013C -------- S8700014C THIS PROGRAM COPIES RELOCATABLE BINARY OUTPUT DIRECTLY FROM S8700015C THE SCRATCH UNIT TO THE PUNCH UNIT. S8700016C S8700017C S8700018C COMMON S8700019C ------ S8700020 COMMON ENTABL(4000) S8700021C S8700022ÐÐC S8700023C INTEGERS S8700024C -------- S8700025 INTEGER TEMP,TEMPX,TEMPY,ENTABL,FOUND S8700026 INTEGER E10,ASTERT,CLU,PLU,ASTOUT S8700027 INTEGER ENTBLK,EXTBLK,XFRBLK,ENTPTR,ENTCRD,EXTCRD S8700028 INTEGER SECNUM,XFRFLG,HEADER,TWTW S8700029C S8700030C S8700031C ARRAYS S8700032C ------ S8700033 DIMENSION LEN(3),TEMP(8),TEMPX(8),TEMPY(8) S8700034 DIMENSION IBUF(96),E10(9),MSG(31) S8700035 DIMENSION ENTCRD(1),EXTCRD(1),NAME(3) S8700036 DIMENSION MSGDUP(15) S8700037 DIMENSION MDUP(12) S8700038 DIMENSION HEADER(23),ASTOUT(10) S8700039C S8700040C S8700041C EQUIVALENCE STATEMENTS S8700042C ----------- ---------- S8700043 EQUIVALENCE (MSB, LEN(2)),(LSB, LEN(3)) S8700044 EQUIVALENCE (ENTCRD(1), IBUF(2)),(EXTCRD(1), IBUF(2)) S8700045 EQUIVALENCE (MDUP(1),MSGDUP(1)) S8700046C S8700047ÐÐC S8700048C DATA STATEMENTS S8700049C ---- ---------- S8700050C S8700051C S8700052 DATA ASTERT / '*T' / S8700053 DATA ASTOUT /'*T '/ S8700054 DATA HEADER /' *RBDPCH* O/P UNLINKED RBD PROG AND SUBPROGS '/ S8700055 DATA XFRFLG /0/ S8700056 DATA TWTW /$2020/ S8700057 DATA CLU,PLU,ILU,MLU,LLU /$18FC,$8FA,$8F9,$8B3,$18FB/ S8700058 DATA LEN / 96, 0, 0 / S8700059 DATA NAMBLK,ENTBLK,EXTBLK,XFRBLK / $2050, $8050, $A050, $C050 / S8700060 DATA ENTPTR / 1 / S8700061 DATA MSG(1)/' '/ S8700062 DATA MDUP /' DUPLICATE ENTRY POINT '/ S8700063 DATA E10 /' E10 '/ S8700064C GENERAL DESCRIPTION S8700065C ------- ----------- S8700066C THE DUMP OPERATES AS FOLLOWS: S8700067C * PRINT HEADER LINE. S8700068C * SEARCH LGO SCRATCH FOR ALL PROGRAMS, PRINT ALL NAM S8700069C BLOCKS, SAVE ALL ENTRY POINTS AND EXTERNALS AND S8700070C PUNCH EACH RBD RECORD. S8700071C S8700072ÐÐC S8700073C ENTRY/EXIT S8700074C ---------- S8700075C THE RBD DUMP IS A PROGRAM LIBRARY ROUTINE. TO CALL: S8700076C *JOB S8700077C *K,PN WHERE N IS THE PUNCH LU S8700078C *RBDPCH S8700079C THE DUMP TERMINATES WITH A 'J' (THRU THE SUBROUTINE S8700080C RBPERR) S8700081C NOTE --- THE PROGRAM TO BE DUMPED MUST BE IN THE LGO S8700082C FILE ON DISK SCRATCH S8700083C S8700084C BEGIN S8700085C ----- S8700086C S8700087C*** S8700088C S8700089 FOUND = 0 S8700090C S8700091C OUTPUT HEADER S8700092 CALL FWRITE (LLU,HEADER,23,0,1,TEMPY) S8700093C S8700094C S8700095C ZERO COMMON S8700096 DO 5 I = 1,4000 S8700097ÐÐ ENTABL(I) = 0 S8700098 5 CONTINUE S8700099C S8700100C PICK UP STANDARD PUNCH LU (PLU) FROM MSOS LO-CORE S8700101 ASSEM $C0FA,$6800,PLU S8700102C S8700103C GET NEXT AVAILABLE SCRATCH SECTOR FROM LOCATION $E4 S8700104C AND PUT IN LGO S8700105 ASSEM $C0E4,$6800,LGO S8700106C CHECK IF THERE IS ANY PROGRAM ON SCRATCH S8700107 IF(LGO.NE.1) GO TO 100 S8700108C S8700109C SEARCH FOR END OF LGO ON SCRATCH (*T) S8700110 DO 50 LSB = 1,$400 S8700111 LGO = LSB S8700112C READ LGO RECORD S8700113 ASSIGN 25 TO IRETN S8700114 GO TO 5000 S8700115 25 IF(IBUF(1) .EQ. ASTERT) GO TO 100 S8700116 50 CONTINUE S8700117C *T NOT FOUND AFTER MAX NO. OF RECORDS ALLOWED ON LGO S8700118 CALL RBPERR(1) S8700119C S8700120C SCAN THROUGH PROGRAMS ON SCRATCH, PRINT 1ST NAM BLOCK, SAVE S8700121C ENTRY POINTS AND EXTERNALS AND PUNCH RECORD. S8700122ÐÐC S8700123 100 NAMFLG = 1 S8700124C S8700125 SECNUM = LGO - 1 S8700126 DO 190 LSB = 1,SECNUM S8700127 ASSIGN 120 TO IRETN S8700128C PICK UP NEXT RECORD (SECTOR) S8700129 GO TO 5000 S8700130 120 CONTINUE S8700131C IS THIS RECORD A NAM BLOCK S8700132 IF (IBUF(1) .NE. NAMBLK) GO TO 125 S8700133 NAMFLG = 0 S8700134 GO TO 150 S8700135C IF THIS IS THE FIRST BLOCK, OR FIRST BLOCK AFTER A XFR, S8700136C IT MUST BE A NAM BLOCK S8700137 125 IF (NAMFLG .EQ. 1) CALL RBPERR(3) S8700138C CHECK FOR A XFR BLOCK S8700139 IF (IBUF(1) .EQ. XFRBLK) NAMFLG = 1 S8700140 150 CONTINUE S8700141C PROCESS CARD S8700142 ASSIGN 160 TO IRETRN S8700143 GO TO 6000 S8700144 160 CONTINUE S8700145 190 CONTINUE S8700146C S8700147ÐÐC S8700148C S8700149C FINISHED - WRITE *T ON PUNCH DEVICE S8700150 ASSIGN 650 TO ICOMP S8700151 CALL FWRITE (PLU,ASTOUT,10,ICOMP,1,TEMP) S8700152 CALL DISP S8700153C PRINT 'FINISHED' MESSAGE AND EXIT S8700154 650 CALL RBPERR(7) S8700155C S8700156C S8700157C PSEUDO SUBROUTINE TO READ LGO SCRATCH MM S8700158C S8700159 5000 ASSIGN 5030 TO ICOMP S8700160 CALL FREAD (MLU,IBUF,LEN,ICOMP,1,TEMP) S8700161 CALL DISP S8700162C S8700163C PSEUDO SUBROUTINE TO WRITE IBUF TO PUNCH LU (BINARY MODE) S8700164 5020 ASSIGN 5030 TO ICOMP S8700165 LEN = 57 S8700166 IF (IBUF(1).EQ.XFRBLK) LEN = 4 S8700167 CALL FWRITE(PLU,IBUF,LEN,ICOMP,1,TEMP) S8700168 CALL DISP S8700169C S8700170C COMPLETION - CHECK FOR ERROR S8700171 5030 IF (LINK(0) .LT. 0) CALL RBPERR(2) S8700172ÐÐ LEN = 96 S8700173 GO TO IRETN S8700174C S8700175C S8700176C PSEUDO SUBROUTINE TO PROCESS AND PUNCH RECORDS (CARDS) S8700177C S8700178C IS THIS RECORD A NAM BLOCK S8700179 6000 IF (IBUF(1) .NE. NAMBLK) GO TO 6100 S8700180C PRINT NAM BLOCK S8700181 DO 6010 MM = 1,30 S8700182 MM1 = MM+1 S8700183 MM4 = MM+4 S8700184 MSG(MM1) = IBUF(MM4) S8700185 6010 CONTINUE S8700186 MSG(5) = TWTW S8700187 MSG(6) = TWTW S8700188 MSG(7) = TWTW S8700189 CALL FWRITE (LLU,MSG,31,0,1,TEMPX) S8700190 GO TO 6900 S8700191C S8700192C IS THIS RECORD AN ENT BLOCK S8700193 6100 IF (IBUF(1) .NE. ENTBLK) GO TO 6200 S8700194C THERE ARE POSSIBLY 14 NAMES IN ENT BLOCK S8700195 DO 6160 I = 1,56,4 S8700196C IF NEXT SLOT IS ZERO, BLOCK IS FINISHED S8700197ÐÐ IF (ENTCRD(I).EQ.0) GO TO 6900 S8700198C CHECK FOR ENTABL OVERFLOW S8700199 IF (ENTPTR .GT. 1000) CALL RBPERR(5) S8700200C PICKUP NEXT ENTRY POINT NAME - CHECK TABLE FOR DUPLICATE. S8700201C IF NONE FOUND, STORE IN NEXT AVAILABLE LOCATION. S8700202 IF (ENTPTR.EQ. 1) GO TO 6153 S8700203 J1 = (ENTPTR - 1) * 4 S8700204 DO 6150 J = 1,J1,4 S8700205 M = J S8700206 L = I S8700207 DO 6140 K = 1,3 S8700208 IF (ENTCRD(L).NE.ENTABL(M)) GO TO 6150 S8700209 M = M + 1 S8700210 L = L + 1 S8700211 6140 CONTINUE S8700212C S8700213C TABLE ENTRY FOUND S8700214C IF AN ENTRY POINT, ITS AN ERROR S8700215 IF (ENTABL(M).EQ.1) GO TO 6148 S8700216C IF UNFOUND EXTERNAL, MARK FOUND S8700217 IF (ENTABL(M).EQ.0) ENTABL(M) = 2 S8700218 GO TO 6160 S8700219C DUPLICATE ENTRY POINT FOUND - ILLEGAL S8700220C PRINT DUPLICATE ENTRY POINT S8700221 6148 L = I S8700222ÐÐ MSGDUP(13) = ENTCRD(L) S8700223 MSGDUP(14) = ENTCRD(L+1) S8700224 MSGDUP(15) = ENTCRD(L+2) S8700225 CALL FWRITE (LLU,MSGDUP,15,0,1,TEMPX) S8700226 CALL RBPERR(4) S8700227C S8700228C COMPARE NEXT ENTRY IN ENTABL S8700229 6150 CONTINUE S8700230C NO DUPLICATE ENTRY POINT - ENTER THIS ENTRY POINT S8700231C INTO TABLE S8700232 6153 J2 = (ENTPTR * 4) - 3 S8700233 J3 = I S8700234 DO 6155 N = 1,3 S8700235 ENTABL(J2) = ENTCRD(J3) S8700236 J2 = J2 + 1 S8700237 J3 = J3 + 1 S8700238 6155 CONTINUE S8700239C SET 'FOUND' BIT AND BUMP ENT TABLE POINTER S8700240 ENTABL(J2) = 1 S8700241 ENTPTR = ENTPTR + 1 S8700242C GET NEXT ENT IN BLOCK S8700243 6160 CONTINUE S8700244C ENT BLOCK FINISHED - PUNCH CARD S8700245 GO TO 6900 S8700246C S8700247ÐÐC IS THIS RECORD AN EXT BLOCK - IF NOT, PUNCH CARD S8700248C AND RETURN S8700249 6200 IF (IBUF(1) .NE. EXTBLK) GO TO 6900 S8700250C THERE ARE POSSIBLY 14 NAMES IN EXT BLOCK S8700251 DO 6260 I = 1,56,4 S8700252C IF NEXT SLOT IS ZERO, BLOCK IS FINISHED S8700253 IF (EXTCRD(I).EQ.0) GO TO 6900 S8700254C CHECK FOR ENTABL OVERFLOW S8700255 IF (ENTPTR .GT. 1000) CALL RBPERR(5) S8700256C PICKUP NEXT EXTERNAL NAME - CHECK TABLE FOR DUPLICATE. S8700257C IF ONE FOUND GO ON TO NEXT EXT NAME. IF NONE FOUND, S8700258C STORE IN NEXT AVAILABLE LOCATION. S8700259 IF (ENTPTR.EQ.1) GO TO 6253 S8700260 J1 = (ENTPTR - 1) * 4 S8700261 DO 6250 J = 1,J1,4 S8700262 M = J S8700263 L = I S8700264 DO 6240 K = 1,3 S8700265C IF THIS TABLE ENTRY NOT SAME AS PRESENT EXT, GET NEXT EXT S8700266 IF (EXTCRD(L).NE.ENTABL(M)) GO TO 6250 S8700267 M = M + 1 S8700268 L = L + 1 S8700269 6240 CONTINUE S8700270C EXT IS IN TABLE - GET NEXT EXT FROM BLOCK S8700271 GO TO 6260 S8700272ÐÐC THIS TABLE ENTRY NOT THE SAME AS PRESENT EXT - GET NEXT EXT S8700273 6250 CONTINUE S8700274C NO DUPLICATE FOR EXT FOUND - ENTER THIS EXT INTO TABLE S8700275 6253 J2 = (ENTPTR * 4) - 3 S8700276 J3 = I S8700277 DO 6255 N = 1,3 S8700278 ENTABL(J2) = EXTCRD(J3) S8700279 J2 = J2 + 1 S8700280 J3 = J3 + 1 S8700281 6255 CONTINUE S8700282C BUMP THE EXTERNAL TABLE POINTER S8700283 ENTPTR = ENTPTR + 1 S8700284C GET NEXT EXT IN BLOCK S8700285 6260 CONTINUE S8700286C S8700287C PUNCH BLOCK RECORD S8700288 6900 ASSIGN 6910 TO IRETN S8700289C S8700290C CHECK FOR XFR CARD S8700291 IF (IBUF(1).NE.XFRBLK) GO TO 6905 S8700292 IF (XFRFLG.EQ.0) GO TO 6905 S8700293 IBUF(2) = TWTW S8700294 IBUF(3) = TWTW S8700295 IBUF(4) = TWTW S8700296 6905 GO TO 5020 S8700297ÐÐC RETURN TO USER S8700298 6910 GO TO IRETRN S8700299 END S8700300 SUBROUTINE RBPERR(N) S8800001 1 /L13 F ITOS CCS 3.0 SL-149S8800002C*** RPG UTILITIES- ERROR MESSAGE ROUTINE FOR RBDPCH S8800003C CREDIT COLLECTION SYSTEM VERSION 3.0 S8800004C DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA S8800005C COPYRIGHT CONTROL DATA CORPORATION 1979 S8800006C S8800007C S8800008C S8800009C*** RPG MESSAGE SUBROUTINE FOR THE RPG NON-LINKING RBD S8800010C DUMP ROUTINE S8800011C S8800012C S8800013C FUNCTION S8800014C -------- S8800015C RBPERR PRINTS MESSAGE (N) FOR THE PROGRAM RBDPCH. S8800016C THE MESSAGES SIGNAL FATAL OR END CONDITIONS AND S8800017C CONTROL RETURNS TO THE JOB PROCESSOR. S8800018C S8800019C S8800020C INTEGER ARRAYS S8800021C ------- ------ S8800022ÐÐ INTEGER E(14,7),ER(14) S8800023 INTEGER E1(14),E2(14),E5(14),E6(14),E7(14) S8800024 INTEGER E3(14),E4(14) S8800025 INTEGER TEMP(8),TEMPX(8) S8800026C S8800027C S8800028C EQUIVALENCE STATEMENTS S8800029C ----------- ---------- S8800030 EQUIVALENCE (E(1,1),E1(1)) S8800031 EQUIVALENCE (E(1,2),E2(1)) S8800032 EQUIVALENCE (E(1,3),E3(1)) S8800033 EQUIVALENCE (E(1,4),E4(1)) S8800034 EQUIVALENCE (E(1,5),E5(1)) S8800035 EQUIVALENCE (E(1,6),E6(1)) S8800036 EQUIVALENCE (E(1,7),E7(1)) S8800037C S8800038C S8800039C DATA STATEMENTS S8800040C ---- ---------- S8800041C S8800042C THE ERROR MESSAGES FOLLOW IN NUMERIC ORDER S8800043C E1 CORRESPONS TO N=1 S8800044C E2 CORRESPONDS TO N=2 ETC... S8800045C S8800046 DATA ER /' *RBDPCH* **** ERROR **** '/ S8800047ÐÐ DATA E1 /' *T NOT FOUND IN LGO FILE '/ S8800048 DATA E2 /' BINARY OUTPUT STATUS ERROR '/ S8800049 DATA E3 /' NAM BLOCK MISSING '/ S8800050 DATA E4 /' DUPLICATE ENTRY POINTS '/ S8800051 DATA E5 /' ENT/EXT TABLE OVERFLOW '/ S8800052 DATA E6 /' PROGRAM NOT FOUND IN LIB '/ S8800053 DATA E7 /' *RBDPCH* OUTPUT COMPLETED '/ S8800054 DATA LN / 14 / S8800055 DATA LU / $18FC / S8800056 DATA LLU /$18FB/ S8800057C S8800058C S8800059C GENERAL DESCRIPTION S8800060C ------- ----------- S8800061C THE DESIRED MESSAGE NUMBER IS PASSED AS PARAMETER (N). S8800062C IF THE PRINTOUT IS AN ERROR MESSAGE, TWO LINES ARE S8800063C PRINTED, THE FIRST BEING ' *RBDPCH* **** ERROR **** ' S8800064C AND THE SECOND BEING THE ERROR MESSAGE ITSELF. S8800065C S8800066C S8800067C ENTRY/EXIT S8800068C ---------- S8800069C RBPERR IS CALLED FROM THE PROGRAM RBDPCH OR ITS S8800070C SUBROUTINE GETLPG. EXIT IS MADE TO THE JOB PROCESSOR. S8800071C THE FINAL MESSAGE IS 'RBD FILE FINISHED' S8800072ÐÐC S8800073C S8800074C BEGIN S8800075C ----- S8800076C S8800077C*** S8800078C S8800079 IF (N.EQ.7) GO TO 100 S8800080 ASSIGN 20 TO ICOMP S8800081 CALL FWRITE (LU,ER,LN,ICOMP,1,TEMP) S8800082 CALL DISP S8800083 20 ASSIGN 100 TO ICOMP S8800084 CALL FWRITE (LLU,ER,LN,ICOMP,1,TEMP) S8800085 CALL DISP S8800086 100 ASSIGN 150 TO ICOMP S8800087 CALL FWRITE (LU,E(1,N),LN,ICOMP,1,TEMPX) S8800088 CALL DISP S8800089 150 ASSIGN 200 TO ICOMP S8800090 CALL FWRITE (LLU,E(1,N),LN,ICOMP,1,TEMPX) S8800091 CALL DISP S8800092 200 ASSEM $54F4,$0A00 S8800093 END S8800094 MON _‚_‚ THE FINAL MESSAGE IS 'RBD FILE FINISHED' S8800072ÐR STA* ASCDAT+1 SET =ZERO A2201195 RR LDA* ASCDAT+2 GET TENS AND UNITS DIGITS. A2201196 RR ALS 8 A2201197 RR AND- ONE+7 A2201198 RR INA -$20 A2201199 RR SAN BAT30 A2201200 RR LDA* ASCDAT+2 A2201201 RR AND- ONE+7 A2201202 RR ADD =N$3000 INSERT ZERO IN TENS DIGIT A2201203 RR STA* ASCDAT+2 A2201204 RRBAT30 LDA* ASCDAT+1 IF HUNDREDS DIGIT WAS NOT A BLANK,THE ASCII A2201205 RR AND- ONE+7 NUMBER LIES IN ASCDAT+1,+2 IMMEDIATELY. A2201206 RR ADD* J0 A2201207 RR STA* RECBUF A2201208 RR LDA* ASCDAT+2 A2201209 RR STA* RECBUF+1 A2201210 RR EJT A2201211 RR RTJ+ WRITER MAKE FM CALL TO STORE RECORD FOR THIS KEY. A2201212 RR ADC REQBUF A2201213 RR ADC RECBUF RECORD IS WRITTEN FROM RECBUF. A2201214 RR ADC RECBUF KEY IS BYTES 1-4 OF THE RECORD. A2201215 RR ADC ISTAT A2201216 RR RTJ CKSTAT A2201217 RR SPC 1 A2201218 RR RAO* WROTE A2201219 RR LDA* WROTE A2201220 RR SUB* RPERHO A2201221 RR SAZ BAT60 SKIP IF ALL RECORDS FOR A HOST HAVE BEEN DONE.A2201222 RR RAO* NN A2201223 RR JMP* BAT20 BUILD NEXT KEY. A2201224 RR SPC 1 A2201225 RRBAT60 LDA* HOSTNO A2201226 RR SUB =XNUMHST A2201227 RR SAZ BAT100 SKIP IF ALL HOSTS HAVE THEIR RECORDS. A2201228 RR LDA* HOSTNO INITIALIZE TO NEXT KEY FOR NEXT HOST. A2201229 RR MUI =N100 A2201230 RR INA 1 A2201231 RR STA* NN A2201232 RR RAO* HOSTNO A2201233 RR CLR A A2201234 RR STA* WROTE A2201235 RR JMP* BAT20 A2201236 RR SPC 1 A2201237 RRBAT100 RTJ+ CLOSFL THE $$BATCH FILE IS INITIALIZED. A2201238 RR ADC REQBUF A2201239 RR ADC ISTAT A2201240 RR RTJ CKSTAT A2201241 RR JMP* (BATBLD) A2201242 RR SPC 2 A2201243 RRBATFIL ALF 4,$$BATCH BATCH FILE NAME A2201244 RR* BATCH FILE IDATA ENTRIES A2201245 RRBATDAT NUM 64 13 - RECORD LENGTH-BYTES A2201246 RR NUM 0 14 - NUMBER OF RECORDS A2201247 RRRECSB NUM $FFFF 15 - NUMBER OF RECORDS A2201248 RR NUM $4001 16 - FILE TYPE-INDEXED ORDERED A2201249 RR NUM 4 17 - KEY1 LENGTH-BYTES A2201250 RR NUM 1 18 - KEY1 POSITION-BYTE A2201251 RR EJT A2201252 RR SPC 4 A2201253 RRHOSTNO NUM 1 NUMBER OF HOSTS PROCESSED. A2201254 RRRPERHO NUM 0 A2201255 RRWROTE NUM 0 NUMBER OF JOBS WRITTEN FOR A HOST. A2201256 RRJ0 NUM $4A00 J0 A2201257 RRASCDAT ALF 3, A2201258 RRNN NUM 1 A2201259 RRRECBUF ALF 1,J0 A2201260 RR ALF 1,01 A2201261 RR ALF 15, A2201262 RR ALF 15, A2201263 RR BZS FMWDS(2) FILE MANAGER WORDS FOR WRITER REQUEST. A2201264 RR EJT A2201265 RR* BUILD PRINT FILE A2201266 RR* A2201267 RR* THE KEY FOR THE $$PRINT FILE WILL BE OF THE A2201268 RR* FORM PRXX WHERE XX WILL RANGE FROM 01 TO 50. A2201269 RR* A2201270 RR* THE NUMBER OF RECORDS IN ANY PRXX FILE IS A2201271 RR* FOUND IN WORDS 16 AND 17 OF THE $$PRINT A2201272 RR* RECORDS. A2201273 RR SPC 2 A2201274 RRPRTBLD NOP 0 A2201275 RR SPC 1 A2201276 RR RTJ CLRQBF CLEAR FM BUFFER. A2201277 RR ADC REQBUF A2201278 RR RTJ FILNAM SPECIFY FILE A2201279 RR ADC PRTFIL A2201280 RR RTJ FILDAT SET UP IDATA (13-18) A2201281 RR ADC PRTDAT A2201282 RR SPC 1 A2201283 RR RTJ+ CREATE CREATE $$PRINT FILE. A2201284 RR ADC REQBUF A2201285 RR ADC IDATA A2201286 RR ADC ISTAT A2201287 RR RTJ CKSTAT A2201288 RR SPC 1 A2201289 RR RTJ FLDATE SET UP THE FILE TYPE AND DATES A2201290 RR ADC 1 A2201291 RR SPC 1 A2201292 RR RTJ CLRQBF NOW OPEN $$PRINT FILE AND INITIALIZE KEYS. A2201293 RR ADC REQBUF A2201294 RR RTJ FILDAT A2201295 RR ADC IDXDAT A2201296 RR SPC 1 A2201297 RR RTJ+ OPENFL OPEN $$PRINT FILE. A2201298 RR ADC REQBUF A2201299 RR ADC IDATA A2201300 RR ADC ISTAT A2201301 RR RTJ CKSTAT A2201302 RR EJT A2201303 RR SPC 4 A2201304 RRPRT20 RTJ BINASC A2201305 RR ADC PP A2201306 RR ADC ENDASC A2201307 RR SPC 1 A2201308 RR LDA* ENDASC+2 A2201309 RR ALS 8 A2201310 RR AND- ONE+7 A2201311 RR INA -$20 A2201312 RR SAN PRT30 SKIP IF TENS DIGIT IS NOT A $20. A2201313 RR LDA* ENDASC+2 A2201314 RR AND- ONE+7 A2201315 RR ADD =N$3000 INSERT ASCII ZERO. A2201316 RR JMP* PRT40 A2201317 RR SPC 1 A2201318 RRPRT30 LDA* ENDASC+2 A2201319 RRPRT40 STA* PRTKEY+1 PUT KEY IN RECORD WITH PR AS FIRST 2 CHAR. A2201320 RR SPC 1 A2201321 RR RTJ WRITER MAKE FM CALL TO STORE RECORD FOR THIS KEY. A2201322 RR ADC REQBUF A2201323 RR ADC PRTKEY WRITE FROM HERE. A2201324 RR ADC PRTKEY KEY IS IN FIRST 2 WORDS. A2201325 RR ADC ISTAT A2201326 RR RTJ CKSTAT A2201327 RR SPC 1 A2201328 RR LDA* PP A2201329 RR INA -50 A2201330 RR SAZ PRT50 SKIP IF 50 RECORDS ARE DONE. A2201331 RR RAO* PP A2201332 RR JMP* PRT20 A2201333 RR SPC 1 A2201334 RRPRT50 RTJ+ CLOSFL THE $$PRINT FILE IS INITIALIZED. A2201335 RR ADC REQBUF A2201336 RR ADC ISTAT A2201337 RR RTJ CKSTAT A2201338 RR JMP* (PRTBLD) A2201339 RR EJT A2201340 RR SPC 4 A2201341 RRPRTFIL ALF 4,$$PRINT PRINT FILE NAME A2201342 RR* PRINT FILE IDATA ENTRIES A2201343 RRPRTDAT NUM 34 13 - RECORD LENGTH-BYTES A2201344 RR NUM 0 14 - NUMBER OF RECORDS A2201345 RR NUM 50 15 - NUMBER OF RECORDS A2201346 RR NUM $4001 16 - FILE TYPE-INDEXED ORDERED A2201347 RR NUM 4 17 - KEY1 LENGTH-BYTES A2201348 RR NUM 1 18 - KEY1 POSITION-BYTE A2201349 RR SPC 2 A2201350 RRPRTKEY ALF 19,PR A2201351 RRPP NUM 1 A2201352 RRENDASC ALF 3, A2201353 RR EJT A2201354 RR SPC 4 A2201355 RRFILCLN NOP 0 A2201356 RR SPC 1 A2201357 RR LDQ =XNUMLU A2201358 RRFIL010 LR1+ LOG1A,Q R1 = P.D.T. ADDRESS A2201359 RR LRA- 8,1 A2201360 RR EOR TY1 IS THIS THE BATCH OUTPUT DRIVER A2201361 RR SAZ FIL020 YES A2201362 RR INQ -1 NO, CONTINUE A2201363 RR SQZ FIL030 A2201364 RR JMP* FIL010 A2201365 RR SPC 1 A2201366 RRFIL020 LRA- BDINIT,1 HAS THE DRIVER EVER EXECUTED A2201367 RR SAZ FIL040 NO, CLEAN UP ANY ACTIVE FILES A2201368 RRFIL030 JMP* (FILCLN) OTHERWISE, RETURN A2201369 RR SPC 1 A2201370 RRFIL040 RTJ CLRQBF HOST FILE CLEANUP A2201371 RR ADC REQBUF A2201372 RR RTJ FILNAM MOVE HOST NAME TO IDATA A2201373 RR ADC HOSFIL A2201374 RR RTJ FILDAT MOVE FILE DATA TO IDATA A2201375 RR ADC SEQDAT A2201376 RR SPC 1 A2201377 RR RTJ+ OPENFL OPEN HOST FILE A2201378 RR ADC REQBUF A2201379 RR ADC IDATA A2201380 RR ADC ISTAT A2201381 RR RTJ CKSTAT CHECK FOR F.M. ERROR A2201382 RR SPC 1 A2201383 RR RTJ+ GETS READ IN HOST FILE A2201384 RR ADC REQBUF A2201385 RR ADC HOBUF BUFFER A2201386 RR ADC KEYVAL A2201387 RR ADC ISTAT A2201388 RR RTJ CKSTAT CHECK FOR F.M. ERROR A2201389 RR EJT A2201390 RR LDQ =N126 A2201391 RRHSCL1 XFQ 1 NUMBER OF HOST STATUS WORDS TO CHECK A2201392 RR AR1 =N14 A2201393 RR LR2 =N14 A2201394 RR LFA HOBUF+2,11,2,Q CHECK IF IA AND JA (BITS 11 - 10) ARE ZERO A2201395 RR SAZ HSCL2 A2201396 RR CLF HOBUF+2,11,2,Q NOT ZERO, CLEAR THESE BITS A2201397 RRHSCL2 LFA HOBUF+3,3,4,1 CHECK IF BITS 3-0 = 2 (BEING SENT) A2201398 RR INA -2 A2201399 RR SAN HSCL3 NOT BEING SENT A2201400 RR CLF HOBUF+3,3,4,1 STATUS=2. CLEAR BITS 3-0 A2201401 RRHSCL3 LFA HOBUF+3,7,4,1 CHECK IF BITS 7-4 = 2 (BEING SENT) A2201402 RR INA -2 A2201403 RR SAN HSCL4 NOT BEING SENT A2201404 RR CLF HOBUF+3,7,4,1 STATUS=2. CLEAR BITS 7-4 A2201405 RRHSCL4 LFA HOBUF+3,11,4,1 CHECK IF BITS 11-8 = 2 (BEING SENT) A2201406 RR INA -2 A2201407 RR SAN HSCL5 NOT BEING SENT A2201408 RR CLF HOBUF+3,11,4,1 STATUS=2. CLEAR BITS 11-8 A2201409 RR EJT A2201410 RR SPC 4 A2201411 RRHSCL5 LFA HOBUF+3,15,4,1 CHECK IF BITS 15-12 = 2 (BEING SENT) A2201412 RR INA -2 A2201413 RR SAN HSCL6 NOT BEING SENT A2201414 RR CLF HOBUF+3,15,4,1 STATUS=2. CLEAR BITS 15-12 A2201415 RR SPC 1 A2201416 RRHSCL6 AR1 =N-1 A2201417 RR JMP* HSCL8 A2201418 RR SPC 1 A2201419 RRHSCL7 JMP* HSCL2 A2201420 RRHSCL8 D2P *-HSCL7 A2201421 RR INQ -18 A2201422 RR SQM HSCL9 CHECK IF DONE WITH HOST FILE A2201423 RR JMP* HSCL1 NOT DONE A2201424 RR SPC 1 A2201425 RRHSCL9 RTJ+ UPDREC DONE. UPDATE HOST FILE A2201426 RR ADC REQBUF A2201427 RR ADC HOBUF A2201428 RR ADC ISTAT A2201429 RR RTJ CKSTAT A2201430 RR SPC 1 A2201431 RR RTJ+ CLOSFL CLOSE HOST FILE A2201432 RR ADC REQBUF A2201433 RR ADC ISTAT A2201434 RR RTJ CKSTAT A2201435 RR EJT A2201436 RR SPC 4 A2201437 RR LDQ =XNUMLU CLEAN UP THE BATCH DRIVER FILES A2201438 RRBDCL2 LR1+ LOG1A,Q A2201439 RR LRA- 8,1 GET WORD 8 OF EACH LU PHYSTB A2201440 RR EOR* TY1 CHECK IF TYPE=$28A4 A2201441 RR SAZ BDCL4 YES A2201442 RR LRA- 8,1 A2201443 RR EOR* TY2 CHECK IF TYPE=$8A2 A2201444 RR SAZ BDCL4 YES A2201445 RR INQ -1 CHECK IF DONE WITH LU TABLE A2201446 RR SQN BDCL3 NOT DONE A2201447 RR JMP* (FILCLN) DONE. RETURN A2201448 RR SPC 1 A2201449 RRBDCL3 JMP* BDCL2 A2201450 RR SPC 1 A2201451 RRBDCL4 STQ* QSAVE A2201452 RR TRQ A CONVERT LU TO ASCII A2201453 RR CLR Q A2201454 RR DVI- TEN A2201455 RR INA $30 A2201456 RR INQ $30 A2201457 RR ALS 8 A2201458 RR EAQ A A2201459 RR STA BDFIL+2 STORE LU IN IDATA BUFFER A2201460 RR SPC 1 A2201461 RR RTJ CLRQBF SET F.M. BUFFER TO ZEROS A2201462 RR ADC REQBUF A2201463 RR RTJ FILNAM MOVE $$BDXX TO IDATA A2201464 RR ADC BDFIL A2201465 RR RTJ FILDAT A2201466 RR ADC SEQDAT A2201467 RR EJT A2201468 RR SPC 4 A2201469 RR RTJ+ OPENFL OPEN $$BDXX FILE A2201470 RR ADC REQBUF A2201471 RR ADC IDATA A2201472 RR ADC ISTAT A2201473 RR SPC 1 A2201474 RR LDA ISTAT CHECK FOR F.M. ERROR A2201475 RR SAP BDCL7 A2201476 RR ALS 14 IF BIT 1 SET, F.M. COULD NOT LOCATE A2201477 RR SAP BDCL5 FILE. ASSUME ALREADY DELETED. A2201478 RR JMP* BDCL6 A2201479 RR SPC 1 A2201480 RRBDCL5 RTJ CKSTAT A2201481 RR SPC 1 A2201482 RRBDCL7 RTJ+ CLOSFL CLOSE $$BDXX FILE A2201483 RR ADC REQBUF A2201484 RR ADC ISTAT A2201485 RR RTJ CKSTAT CHECK FOR F.M. ERROR A2201486 RR SPC 1 A2201487 RR RTJ+ DELETE DELETE $$BDXX FILE A2201488 RR ADC REQBUF A2201489 RR ADC IDATA A2201490 RR ADC ISTAT A2201491 RR RTJ CKSTAT CHECK FOR F.M. ERROR A2201492 RR SPC 1 A2201493 RRBDCL6 LDQ* QSAVE RETRIEVE Q A2201494 RR INQ -1 A2201495 RR SQZ BDCL8 CHECK IF THIS THE LAST LU A2201496 RR JMP* BDCL2 NO, GO CHECK MORE A2201497 RR SPC 1 A2201498 RRBDCL8 JMP (FILCLN) DONE. RETURN A2201499 RR SPC 2 A2201500 RRBDFIL ALF 4,$$BD BATCH DRIVER FILE NAME SKELETON A2201501 RRTY1 NUM $28A4 A2201502 RRTY2 NUM $08A2 A2201503 RRQSAVE NUM 0 A2201504 RRKEYVAL NUM 0 A2201505 RRHOBUF BZS HOBUF(144) A2201506 RR EJT A2201507 RR EJT A2201508 RR SPC 4 A2201509 RRFNDFIL NOP 0 A2201510 RR SPC 1 A2201511 RR LDA* FNDSEC IS THIS THE INITIAL ENTRY A2201512 RR SAZ FND010 YES A2201513 RR JMP* FND050 NO, CONTINUE A2201514 RR SPC 1 A2201515 RRFND010 LDA- $C4 INITIALIZE THE PROGRAM LIBRARY SECTOR A2201516 RR SPC 1 A2201517 RRFND020 STA* FNDSEC A2201518 RR SPC 1 A2201519 RR RTJ- (AMONI) PERFORM THE TRANSFER A2201520 RR ADC $4800+RPCP A2201521 RR ADC FND030 A2201522 RR ADC 0 A2201523 RR ADC $08C2 A2201524 RR ADC 96 A2201525 RR ADC GTFILE A2201526 RR ADC 0 A2201527 RRFNDSEC ADC 0 A2201528 RR JMP- (ADISP) A2201529 RR SPC 1 A2201530 RRFND030 ENA 85 A2201531 RR STA- I INITIALIZE THE SEARCH A2201532 RR SPC 1 A2201533 RRFND040 LDA GTFILE+3,I IS THIS LIBRARY ENTRY IN FILE FORMAT A2201534 RR SAP FND050 NO A2201535 RR JMP* (FNDFIL) YES, RETURN A2201536 RR SPC 1 A2201537 RRFND050 LDA- I A2201538 RR INA -5 IS THIS THE END OF THE FILE BUFFER A2201539 RR SAM FND060 YES A2201540 RR STA- I NO A2201541 RR JMP* FND040 CONTINUE A2201542 RR SPC 1 A2201543 RRFND060 LDA GTFILE+95 OBTAIN THE NEXT DIRECTORY SECTOR A2201544 RR SAZ FND070 SKIP IF THE END HAS BEEN REACHED A2201545 RR JMP* FND020 GET THE NEXT SECTOR A2201546 RR SPC 1 A2201547 RRFND070 STA* FNDSEC SET UP FOR ANOTHER ENTRY A2201548 RR JMP* (FNDFIL) RETURN A2201549 RR EJT A2201550 RR SPC 4 A2201551 RRFNDPGM NOP 0 A2201552 RR SPC 1 A2201553 RR LDA* (ATSMSB) HAS TSLOG BEEN FOUND A2201554 RR SAZ FNP000 NO A2201555 RR JMP* FNP010 YES, CONTINUE A2201556 RR SPC 1 A2201557 RRFNP000 LDQ =XTSLNAM A2201558 RR RTJ* NAMECK IS THIS ENTRY TSLOG A2201559 RR SAN FNP010 NO A2201560 RR SPC 1 A2201561 RR LDQ* ATSMSB YES A2201562 RR LDA- ONEBIT+15 INDICATE CONTROL POINT TRANSFER A2201563 RR STA- (ZERO),Q A2201564 RR LDA GTFILE+4,I A2201565 RR STA- 1,Q SET UP THE SECTOR ADDRESS A2201566 RR LDA GTFILE+3,I A2201567 RR TCA A A2201568 RR MUI =N96 SET UP THE LENGTH A2201569 RR STA+ TSLSIZ A2201570 RR JMP* (FNDPGM) RETURN A2201571 RR SPC 1 A2201572 RRFNP010 LDA* (ATSULB) HAS THE ULB SECTOR BEEN FOUND A2201573 RR SAZ FNP020 NO A2201574 RR JMP* FNP040 YES A2201575 RR SPC 1 A2201576 RRFNP020 LDQ =XULBNAM A2201577 RR RTJ* NAMECK IS THIS ENTRY ULBUFF A2201578 RR SAN FNP040 NO A2201579 RR LDA GTFILE+3,I YES A2201580 RR TCA A A = BUFFER SIZE IN SECTORS A2201581 RR CLR Q A2201582 RR DVI- THREE A = NUMBER OF ENTRIES ALLOWED A2201583 RR SUB NOPORT IS THE BUFFER LARGE ENOUGH A2201584 RR SAM FNP030 NO, DO NOT SPECIFY ITS SECTOR A2201585 RR LDA GTFILE+4,I YES A2201586 RR STA* (ATSULB) SET UP THE SECTOR ADDRSSS A2201587 RRFNP030 JMP* (FNDPGM) RETURN A2201588 RR EJT A2201589 RRFNP040 LDQ =XTSMUSR Q = MULTI-USER TABLE ADDRESS A2201590 RR SPC 1 A2201591 RRFNP050 STQ* FNPIDX A2201592 RR LDA- MUSIZE,Q HAS THIS ENTRY BEEN SET UP A2201593 RR SAZ FNP060 NO A2201594 RR JMP* FNP070 YES, CONTINUE A2201595 RR SPC 1 A2201596 RRFNP060 INQ 1 Q = ADDRESS OF THE MULTI-USER NAME A2201597 RR RTJ* NAMECK DOES THE ENTRY MATCH A2201598 RR SAN FNP070 NO A2201599 RR SPC 1 A2201600 RR INQ -1 YES A2201601 RR LDA GTFILE+3,I A2201602 RR TCA A A2201603 RR MUI =N96 OBTAIN THE PROGRAM LENGTH A2201604 RR LDQ* FNPIDX A2201605 RR STA- MUSIZE,Q A2201606 RR STA- MURSIZ,Q A2201607 RR LDA- ONEBIT+15 SPECIFY CONTROL POINT ACCESS A2201608 RR STA- MUSECT,Q A2201609 RR LDA GTFILE+4,I A2201610 RR STA- MUSECT+1,Q SET UP THE SECTOR ADDRESS A2201611 RR JMP* (FNDPGM) RETURN A2201612 RR SPC 1 A2201613 RRFNP070 LDQ* FNPIDX A2201614 RR INQ MUITEM A2201615 RR TRQ A A2201616 RR SUB =XTSMEND HAVE ALL ENTRIES BEEN SEARCHED A2201617 RR SAP FNP080 YES A2201618 RR JMP* FNP050 NO, CONTINUE A2201619 RR SPC 1 A2201620 RRFNP080 JMP* (FNDPGM) RETURN A2201621 RR SPC 2 A2201622 RRTSLNAM ALF 3,TSLOG NAME OF THE LOG-IN PROCESSOR A2201623 RRATSMSB ADC TSLMSB SECTOR ADDRESS OF THE LOG-IN PROCESSOR A2201624 RRULBNAM ALF 3,ULBUFF NAME OF THE ULB BUFFER A2201625 RRATSULB ADC TSULBF SECTOR ADDRESS OF THE ULB BUFFER A2201626 RRFNPIDX NUM 0 A2201627 RR EJT A2201628 RR SPC 4 A2201629 RRNAMECK NOP 0 A2201630 RR SPC 1 A2201631 RR LDA GTFILE+0,I A2201632 RR SUB- (ZERO),Q DOES THE FIRST WORD MATCH A2201633 RR SAN NAM010 NO A2201634 RR LDA GTFILE+1,I A2201635 RR SUB- 1,Q DOES THE SECOND WORD MATCH A2201636 RR SAN NAM010 NO A2201637 RR LDA GTFILE+2,I A2201638 RR SUB- 2,Q DOES THE THIRD WORD MATCH A2201639 RR SPC 1 A2201640 RRNAM010 JMP* (NAMECK) A = 0 IF THE NAME MATCHES A2201641 RR EJT A2201642 RR SPC 4 A2201643 RRCLRQBF NOP 0 A2201644 RR SPC 1 A2201645 RR LDA* (CLRQBF) CALCULATE THE PARAMETER ADDRESS A2201646 RR STA* CLRXFR A2201647 RR ENQ 23 A2201648 RR ENA 0 A2201649 RR SPC 1 A2201650 RRCLR010 STA* (CLRXFR),Q CLEAR THE REQUEST BUFFER A2201651 RR DQP *-CLR010 A2201652 RR SPC 1 A2201653 RR RAO* CLRQBF A2201654 RR JMP* (CLRQBF) RETURN A2201655 RR SPC 2 A2201656 RRCLRXFR NUM 0 TEMPORARY STORAGE - TRANSFER ADDRESS A2201657 RR EJT A2201658 RR SPC 4 A2201659 RRMOVKEY NOP 0 A2201660 RR SPC 1 A2201661 RR LDA* (MOVKEY) OBTAIN THE SOURCE ADDRESS A2201662 RR STA* MOVXFR A2201663 RR ENQ 2 A2201664 RR SPC 1 A2201665 RRMOV010 LDA* (MOVXFR),Q MOVE THE RECORD KEY A2201666 RR STA FILKEY,Q TO THE KEY ARRAY A2201667 RR INQ -1 A2201668 RR SQM MOV020 A2201669 RR JMP* MOV010 A2201670 RR SPC 1 A2201671 RRMOV020 RAO* MOVKEY A2201672 RR JMP* (MOVKEY) RETURN A2201673 RR SPC 2 A2201674 RRMOVXFR NUM 0 TEMPORARY STORAGE - TRANSFER ADDRESS A2201675 RR EJT A2201676 RR SPC 4 A2201677 RRFILNAM NOP 0 A2201678 RR SPC 1 A2201679 RR LDA* (FILNAM) CALCULATE THE PARAMETER ADDRESS A2201680 RR STA* FINXFR A2201681 RR ENQ 3 A2201682 RR SPC 1 A2201683 RRFIN010 LDA* (FINXFR),Q MOVE THE FILE NAME A2201684 RR STA IDATA,Q TO THE IDATA ARRAY A2201685 RR DQP *-FIN010 A2201686 RR SPC 1 A2201687 RR RAO* FILNAM A2201688 RR JMP* (FILNAM) RETURN A2201689 RR SPC 2 A2201690 RRFINXFR NUM 0 TEMPORARY STORAGE - TRANSFER ADDRESS A2201691 RR EJT A2201692 RR SPC 4 A2201693 RRFILDAT NOP 0 A2201694 RR SPC 1 A2201695 RR LDA* (FILDAT) CALCULATE THE PARAMETER ADDRESS A2201696 RR STA* FIDXFR A2201697 RR ENQ 5 A2201698 RR SPC 1 A2201699 RRFID010 LDA* (FIDXFR),Q MOVE THE FILE DATA A2201700 RR STA IDATA+12,Q TO THE IDATA ARRAY A2201701 RR DQP *-FID010 A2201702 RR SPC 1 A2201703 RR RAO* FILDAT A2201704 RR JMP* (FILDAT) RETURN A2201705 RR SPC 2 A2201706 RRFIDXFR NUM 0 TEMPORARY STORAGE - TRANSFER ADDRESS A2201707 RR EJT A2201708 RR SPC 4 A2201709 RRFLDATE NOP 0 A2201710 RR LDA* (FLDATE) A2201711 RR STA* FILTYP SAVE THE TYPE INDEX A2201712 RR SPC 1 A2201713 RR RTJ CLRQBF INITIALIZE THE FILE REQUEST BUFFER A2201714 RR ADC REQBUF A2201715 RR RTJ FILDAT SPECIFY A SEQUENTIAL FILE A2201716 RR ADC SEQDAT A2201717 RR SPC 1 A2201718 RR RTJ+ OPENFL OPEN THE FILE A2201719 RR ADC REQBUF A2201720 RR ADC IDATA A2201721 RR ADC ISTAT A2201722 RR RTJ CKSTAT CHECK FOR FILE ERRORS A2201723 RR SPC 1 A2201724 RR RTJ+ GETFCB READ IN THE FILE'S FCB A2201725 RR ADC REQBUF A2201726 RR ADC ZERO A2201727 RR ADC ZERO A2201728 RR ADC GTFILE A2201729 RR ADC ISTAT A2201730 RR RTJ CKSTAT CHECK FOR FILE ERRORS A2201731 RR EJT A2201732 RR SPC 4 A2201733 RR LDA =A99 SPECIFY AN UNLIMITED EXPIRATION DATE A2201734 RR STA GTFILE+88 A2201735 RR STA GTFILE+89 A2201736 RR STA GTFILE+90 A2201737 RR LDA+ AMONTO SPECIFY THE CREATION DATE A2201738 RR STA GTFILE+91 A2201739 RR LDA+ ADAYTO A2201740 RR STA GTFILE+92 A2201741 RR LDA+ AYERTO A2201742 RR STA GTFILE+93 A2201743 RR LDA* FILTYP A2201744 RR STA GTFILE+94 SPECIFY THE FILE TYPE A2201745 RR SPC 1 A2201746 RR RTJ+ UPDFCB UPDATE THE FCB A2201747 RR ADC REQBUF A2201748 RR ADC ZERO A2201749 RR ADC ZERO A2201750 RR ADC GTFILE A2201751 RR ADC ISTAT A2201752 RR RTJ CKSTAT CHECK FOR FILE ERRORS A2201753 RR SPC 1 A2201754 RR RTJ+ CLOSFL CLOSE THE FILE A2201755 RR ADC REQBUF A2201756 RR ADC ISTAT A2201757 RR RTJ CKSTAT CHECK FOR FILE ERRORS A2201758 RR SPC 1 A2201759 RR RAO* FLDATE A2201760 RR JMP* (FLDATE) RETURN A2201761 RR SPC 2 A2201762 RRFILTYP NUM 0 FILE TYPE INDEX A2201763 RR EJT A2201764 RR SPC 4 A2201765 RRREADPL NOP 0 A2201766 RR SPC 1 A2201767 RR LDQ* REASEC IS THIS THE INITIAL ENTRY A2201768 RR SQN REA010 NO, CONTINUE A2201769 RR SPC 1 A2201770 RR STQ* REACNT INITIALIZE THE RECORD COUNT A2201771 RR STA* REAMAX INITIALIZE THE NUMBER OF RECORDS A2201772 RR LDA PNFREC+4 A2201773 RR STA* REASEC AND THE BASE SECTOR ADDRESS A2201774 RR SPC 1 A2201775 RRREA010 LDA* REACNT YES A2201776 RR SUB* REAMAX HAVE ALL RECORDS BEEN READ A2201777 RR SAM REA020 NO, CONTINUE A2201778 RR ENA 0 A2201779 RR STA* REASEC SET UP FOR ANOTHER ENTRY A2201780 RR JMP* (READPL) RETURN A2201781 RR SPC 1 A2201782 RRREA020 RTJ- (AMONI) READ THE PROGRAM LIBRARY DATA A2201783 RR ADC $4800+RPCP A2201784 RR ADC REA030 A2201785 RR ADC 0 A2201786 RR ADC $08C2 A2201787 RR ADC 96 A2201788 RR ADC GTFILE A2201789 RR ADC 0 A2201790 RRREASEC ADC 0 A2201791 RR JMP- (ADISP) A2201792 RR SPC 1 A2201793 RRREA030 RAO* REACNT INCREMENT THE RECORD COUNT A2201794 RR RAO* REASEC AND THE SECTOR A2201795 RR SET A INDICATE A NON-TERMINATION A2201796 RR SPC 1 A2201797 RR JMP* (READPL) RETURN A2201798 RR SPC 2 A2201799 RRREACNT NUM 0 DATA RECORD COUNT A2201800 RRREAMAX NUM 0 DATA RECORD COUNT LIMIT A2201801 RR EJT A2201802 RR SPC 4 A2201803 RRCKSTAT NOP 0 A2201804 RR SPC 1 A2201805 RR LDA ISTAT DID A FILE ERROR OCCUR A2201806 RR SAM CKS010 YES, REPORT IT A2201807 RR JMP* (CKSTAT) NO, RETURN A2201808 RR SPC 1 A2201809 RRCKS010 ENQ 7 A2201810 RR SPC 1 A2201811 RRCKS020 LDA IDATA,Q MOVE THE FILE NAME AND OWNER A2201812 RR STA MESG01+6,Q TO THE ERROR MESSAGE A2201813 RR INQ -1 A2201814 RR SQM CKS030 A2201815 RR JMP* CKS020 A2201816 RR SPC 1 A2201817 RRCKS030 RTJ BINHEX CONVERT THE ERROR STATUS TO ASCII A2201818 RR ADC ISTAT A2201819 RR ADC MESG01+22 A2201820 RR SPC 1 A2201821 RR ENQ 1 A2201822 RR RTJ MESSAG OUTPUT THE ERROR MESSAGE A2201823 RR SPC 1 A2201824 RR RTJ+ CLOSFL CLOSE THE PROGRAM NAME FILE A2201825 RR ADC REQBFN A2201826 RR ADC ISTAT A2201827 RR RTJ+ CLOSFL CLOSE THE PROCEDURE DIRECTORY A2201828 RR ADC REQBFP A2201829 RR ADC ISTAT A2201830 RR RTJ+ CLOSFL CLOSE THE MASTER MENU FILE A2201831 RR ADC REQBFM A2201832 RR ADC ISTAT A2201833 RR RTJ+ CLOSFL CLOSE THE CURRENT DATA FILE A2201834 RR ADC REQBUF A2201835 RR ADC ISTAT A2201836 RR SPC 1 A2201837 RR JMP STAXIT EXIT A2201838 RR EJT A2201839 RR SPC 4 A2201840 RRMESSAG NOP 0 A2201841 RR SPC 1 A2201842 RR LDA* MESSAD,Q A2201843 RR STA* MESAD SET UP THE MESSAGE ADDRESS A2201844 RR LDA* MESLEN,Q A2201845 RR STA* MESLN AND THE MESSAGE LENGTH A2201846 RR SPC 1 A2201847 RR RTJ- (AMONI) A2201848 RR ADC $4C00+RPCP FORMATTED WRITE A2201849 RR ADC MES010 A2201850 RR ADC 0 A2201851 RR ADC $18FC A2201852 RRMESLN ADC 0 A2201853 RRMESAD ADC 0 A2201854 RR JMP- (ADISP) A2201855 RR SPC 1 A2201856 RRMES010 JMP* (MESSAG) RETURN A2201857 RR SPC 4 A2201858 RRMESSAD ADC MESG00 0 A2201859 RR ADC MESG01 1 A2201860 RR ADC MESG02 2 A2201861 RR ADC MESG03 3 A2201862 RR SPC 2 A2201863 RRMESLEN ADC LMSG00 0 A2201864 RR ADC LMSG01 1 A2201865 RR ADC LMSG02 2 A2201866 RR ADC LMSG03 3 A2201867 RR EJT A2201868 RR SPC 2 A2201869 RRREQBUF BZS REQBUF(24) FILE REQUEST BUFFER A2201870 RRIDATA ALF 4, FILE REQUESTS IDATA ARRAY A2201871 RR ALF 4,$$ A2201872 RR ALF 4,SYSVOL A2201873 RR BZS DATA(12) A2201874 RRFILKEY NUM 0,0,0 FILE RECORD KEY ARRAY A2201875 RRISTAT NUM 0 FILE REQUEST RETURN STATUS A2201876 RR* SEQUENTIAL FILE ACCESS IDATA ENTRIES A2201877 RRSEQDAT NUM 0 13 - SEQUENTIAL RETRIEVAL A2201878 RR NUM 1 14 - NUMBER OF RECORDS A2201879 RR NUM 0 15 - RECORD LOCK INDICATOR A2201880 RR NUM 0 16 A2201881 RR NUM 0 17 A2201882 RR NUM 0 18 A2201883 RR* INDEXED FILE ACCESS IDATA ENTRIES A2201884 RRIDXDAT NUM 1 13 - INDEXED RETRIEVAL A2201885 RR NUM 1 14 - NUMBER OF RECORDS A2201886 RR NUM 0 15 - RECORD LOCK INDICATOR A2201887 RR NUM 0 16 A2201888 RR NUM 0 17 A2201889 RR NUM 0 18 A2201890 RRGTFILE BZS GTFILE(96) FILE DATA BUFFER A2201891 RR EJT A2201892 RRMESG00 ALF $,EXECUTIVE PROGRAM NOT LOADED -REQUEST REJECTED$ A2201893 RR EQU LMSG00(*-MESG00) A2201894 RRMESG01 ALF $,FILE NAME: $ A2201895 RR ALF Z,:RERROR STATUS= $ Z A2201896 RR ALF $,:R-REQUEST REJECTED$ A2201897 RR EQU LMSG01(*-MESG01) A2201898 RRMESG02 ALF $,C C S ACTIVE AT $ A2201899 RR EQU LMSG02(*-MESG02) A2201900 RRMESG03 ALF $,BUILDING SYSTEM FILES$ A2201901 RR EQU LMSG03(*-MESG03) A2201902 RR SPC 2 A2201903 RR END START A2201904 RR NAM BINHEX A23 A ITOS CCS 3.0 SL-149A2300001 RR* ITOS STARTUP BINARY-ASCII CONVERSION A2300002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 A2300003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A2300004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 A2300005 RR* A2300006 RR SPC 2 A2300007 RR* CALLING SEQUENCE - CALL BINHEX (IVAL,CHAR) A2300008 RR* WHERE IVAL IS THE INTEGER VALUE A2300009 RR* CHAR IS THE TWO WORD ARRAY FOR ASCII CHARSA2300010 RR* A2300011 RR* CONVERTS THE BINARY VALUE TO A TWO WORD ASCII ARRAY CHAR A2300012 RR* THE REPRESENTATION IS EXTERNAL HEXADECIMAL A2300013 RR* A2300014 RR* A2300015 RR EQU LPMSK(2) A2300016 RR EQU ONEMSK($3) A2300017 RR EQU ZERO($22) A2300018 RR ENT BINHEX A2300019 RR EXT* Q8PREP A2300020 RR EXT* Q8PKUP A2300021 RR SPC 2 A2300022 RRBINHEX NUM 0 A2300023 RR STQ* QSAVE SAVE CONTENTS OF Q-REG AT ENTRY A2300024 RR RTJ Q8PREP SET UP THE PARAMETER LOCATIONS A2300025 RR ADC* BINHEX A2300026 RR RTJ Q8PKUP A2300027 RR TRA Q A2300028 RR LDA- (ZERO),Q OBTAIN THE VALUE A2300029 RR STA* VAL A2300030 RR RTJ Q8PKUP A2300031 RR STA* CHRADR SAVE ADR OF BUFFER A2300032 RR LDA* VAL CONVERT VALUE TO 4 CHARACTERS A2300033 RR AND- ONEMSK+3 GET BINARY VALUE OF NEXT HEX DIGIT A2300034 RR STA* BUFFER+3 A2300035 RR LDA* VAL A2300036 RR ARS 4 A2300037 RR AND- ONEMSK+3 A2300038 RR STA* BUFFER+2 A2300039 RR LDA* VAL A2300040 RR ARS 8 A2300041 RR AND- ONEMSK+3 A2300042 RR STA* BUFFER+1 A2300043 RR LDA* VAL A2300044 RR ARS 12 A2300045 RR AND- ONEMSK+3 A2300046 RR STA* BUFFER+0 A2300047 RR EJT A2300048 RR ENQ 0 A2300049 RRLOOP LDA* BUFFER,Q CONVERT DIGIT TO ASCII CHARACTER A2300050 RR INA -10 A2300051 RR SAP Y A2300052 RR INA $30-$41+10 A2300053 RRY INA $41 A2300054 RR STA* BUFFER,Q A2300055 RR INQ -3 A2300056 RR SQZ DONE A2300057 RR INQ 4 A2300058 RR JMP* LOOP A2300059 RRDONE CLR Q BUILD FINAL BUFFER FOR USER A2300060 RR LDQ* BUFFER+0 A2300061 RR QLS 8 A2300062 RR ADQ* BUFFER+1 A2300063 RR LDA* BUFFER+2 A2300064 RR ALS 8 A2300065 RR ADD* BUFFER+3 A2300066 RR STQ* (CHRADR) A2300067 RR RAO* CHRADR A2300068 RR STA* (CHRADR) A2300069 RR LDQ* QSAVE A2300070 RR JMP* (BINHEX) A2300071 RRQSAVE NUM 0 A2300072 RRCHRADR ADC 0 ADDRESS OF ASCII CHARACTER BUFFER A2300073 RR BSS VAL(1) PASSED BINARY VALUE A2300074 RR BZS BUFFER(4) A2300075 RR END A2300076 RR NAM BINASC A24 A ITOS CCS 3.0 SL-149A2400001 RR* ITOS STARTUP BINARY-DECIMAL CONVERSION A2400002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 A2400003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A2400004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 A2400005 RR* A2400006 RR SPC 2 A2400007 RR**** A2400008 RR* CONVERTS BINARY TO DECIMAL CODED ASCII . A2400009 RR* LEADING ZEROS ARE SUPRESSED. A2400010 RR* A2400011 RR* ENTRY POINTS- A2400012 RR* ----- ------ A2400013 RR ENT BINASC A2400014 RR* A2400015 RR* A2400016 RR* EXTERNALS- A2400017 RR* --------- A2400018 RR EXT* Q8PREP A2400019 RR EXT* Q8PKUP A2400020 RR* A2400021 RR* A2400022 RR* EQUIVALENCES- A2400023 RR* ------------ A2400024 RR EQU ONEMSK(3) A2400025 RR EQU ONEBIT($23) A2400026 RR EQU ZROMSK($13) A2400027 RR* A2400028 RR* A2400029 RR* ENTRY/EXIT A2400030 RR* ----- ---- A2400031 RR* ENTRY A2400032 RR* CALL BINASC(IVAL,IBUF) A2400033 RR* IVAL IS POSITIVE BINARY NBR A2400034 RR* IBUF IS THREE WORD BUFFER A2400035 RR* EXIT A2400036 RR* IBUF CONTAINS RIGHT JUSTIFIED DECIMAL A2400037 RR* CODED ASCII WITH LEADING SPACES. A2400038 RR**** A2400039 RR SPC 4 A2400040 RRBINASC NUM 0 A2400041 RR STQ* QSAVE SAVE Q,I A2400042 RR LDA- I A2400043 RR STA* ISAVE A2400044 RR RTJ Q8PREP PICK UP PARAMETER LOCATIONS A2400045 RR ADC* BINASC A2400046 RR RTJ Q8PKUP A2400047 RR STA* IVAL A2400048 RR RTJ Q8PKUP A2400049 RR STA* IBUF A2400050 RR ENA 2 SET OUTPUT BUFFER POINTERS TO A2400051 RR STA- I LAST WORD A2400052 RR ENA 1 A2400053 RR STA* SCHAR LS CHAR A2400054 RR LDA* (IVAL) A2400055 RR STA* VALUE A2400056 RRBIN2 LDA* VALUE LOAD BINARY VALUE A2400057 RR CLR Q A2400058 RR DVI =N10 DIVIDE BY 10 A2400059 RR STA* VALUE SAVE ANSWER A2400060 RR ADQ =N$30 CONV REMAINDER TO ASCII A2400061 RR STQ* TMPCHR SAVE A2400062 RR LDA* (IBUF),I LOAD OUTPUT WORD A2400063 RR LDQ* SCHAR IS LS NEXT A2400064 RR SQN BIN4 YES A2400065 RR AND- ONEMSK+7 NO,MS NEXT A2400066 RR LDQ* TMPCHR A2400067 RR QLS 8 A2400068 RR EAQ A MERGE WITH NEW MS CHAR A2400069 RR STA* (IBUF),I A2400070 RR JMP* BIN8 A2400071 RRBIN4 AND- ZROMSK+7 A2400072 RR EOR* TMPCHR MERGE WITH NEW LS CHAR A2400073 RR STA* (IBUF),I A2400074 RRBIN8 LDA- I IS END (FIRST) WORD IN BUFFER A2400075 RR SAZ BIN12 YES A2400076 RR JMP* BIN16 NO A2400077 RRBIN12 LDA* SCHAR IS END (MS) CHAR IN BUFFER A2400078 RR SAN BIN16 NO A2400079 RR JMP* BIN24 DONE CODING A2400080 RRBIN16 LDA* SCHAR BUMP POINTERS TO NEXT OUTPUT CHAR A2400081 RR EOR- ONEBIT SWITCH CHAR IDX A2400082 RR STA* SCHAR A2400083 RR SAZ BIN20 MS NEXT, SAME WORD A2400084 RR LDA- I LS NEXT, NEXT WORD A2400085 RR INA -1 BUMP WORD INDEX A2400086 RR STA- I A2400087 RRBIN20 JMP* BIN2 A2400088 RRBIN24 LDA* (IBUF),I SUPRESS LEADING ZEROS A2400089 RR LDQ* SCHAR A2400090 RR SQN BIN32 LS NEXT A2400091 RR AND- ZROMSK+7 IS MS A ZERO A2400092 RR SUB =N$3000 A2400093 RR SAZ BIN28 YES A2400094 RR JMP* BIN42 NO, FINISHED A2400095 RRBIN28 LDA* (IBUF),I REPLACE MS ZERO CHAR WITH SPACE A2400096 RR AND- ONEMSK+7 A2400097 RR EOR =N$2000 A2400098 RR STA* (IBUF),I A2400099 RR JMP* BIN40 A2400100 RRBIN32 AND- ONEMSK+7 IS LS A ZERO A2400101 RR SUB =N$30 A2400102 RR SAZ BIN36 YES A2400103 RR JMP* BIN42 NO, FINISHED A2400104 RRBIN36 LDA* (IBUF),I REPLACE LS ZERO CHAR WITH SPACE A2400105 RR AND- ZROMSK+7 A2400106 RR EOR =N$20 A2400107 RR STA* (IBUF),I A2400108 RRBIN40 LDA- I IS DONE A2400109 RR INA -2 A2400110 RR SAN BIN44 NO A2400111 RRBIN42 LDA* ISAVE YES, LEAVE ONE ZERO UNCHECKED A2400112 RR STA- I A2400113 RR LDQ* QSAVE A2400114 RR JMP* (BINASC) A2400115 RRBIN44 LDA* SCHAR BUMP OUTPUT BUFFER POINTERS A2400116 RR EOR- ONEBIT A2400117 RR STA* SCHAR A2400118 RR SAN BIN48 LS NEXT ,SAME WORD A2400119 RR RAO- I MS NEXT, BUMP WORD A2400120 RRBIN48 JMP* BIN24 A2400121 RR SPC 2 A2400122 RRQSAVE NUM 0 A2400123 RRISAVE NUM 0 A2400124 RRIVAL NUM 0 A2400125 RRIBUF NUM 0 A2400126 RRVALUE NUM 0 A2400127 RRSCHAR NUM 0 A2400128 RRTMPCHR NUM 0 A2400129 RR END A2400130 RR NAM Q8PRMA A25 A ITOS CCS 3.0 SL-149A2500001 RR* ITOS STARTUP PARAMETER PICKUP ROUTINE A2500002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 A2500003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A2500004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 A2500005 RR* A2500006 RR SPC 2 A2500007 RR SPC 2 A2500008 RR ENT Q8PREP A2500009 RR ENT Q8PKUP A2500010 RR SPC 1 A2500011 RR EQU LPMSK(2) A2500012 RR EQU ENTAD($DC),PAD($DD) A2500013 RR SPC 2 A2500014 RRQ8PREP NOP 0 A2500015 RR* A2500016 RR LDA* (Q8PREP) OBTAIN THE PARAMETER A2500017 RR ADD* Q8PREP ABSOLUTIZE IT A2500018 RR STA- ENTAD A2500019 RR RAO* Q8PREP A2500020 RR JMP* (Q8PREP) RETURN A2500021 RR SPC 2 A2500022 RRQ8PKUP NOP 0 A2500023 RR LDA- (ENTAD) PICK UP PARAMETER A2500024 RR STA- PAD A2500025 RR LDA- (PAD) A = PARAMETER ADDRESS A2500026 RRABS RAO- (ENTAD) SET UP FOR NEXT PARAMETER A2500027 RR JMP* (Q8PKUP) RETURN A2500028 RR END A2500029 RR NAM TSLOG A30 A ITOS CCS 3.0 SL-149A3000001 RR* USER PROGRAM LOG-IN PROCESSOR A3000002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 A3000003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A3000004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 A3000005 RR* A3000006 RR SPC 2 A3000007 RR* E X T E R N A L S A3000008 RR SPC 1 A3000009 RR EXT SYSMSG SYSTEM MESSAGE PROCESSOR A3000010 RR EXT QPASWD PASSWORD FOR TERMINAL USERS A3000011 RR EXT PGMINT USER FUNCTION MANUAL INTERRUPT ROUTINE A3000012 RR EXT PGMOUT USER FUNCTION EXIT ROUTINE A3000013 RR EXT WTREAD TIMESHARE WRITE-READ SUBROUTINE A3000014 RR EXT TSAREA TIMESHARE USER AREA STARTING ADDRESS A3000015 RR EXT TSNABL TIMESHARE ACTIVE INDICATOR A3000016 RR EXT TSOFFM ADDRESS OF THE 'OFF UNTIL' MESSAGE A3000017 RR EXT TSLOFF LENGTH OF THE 'OFF UNTIL' MESSAGE A3000018 RR EXT SYSID LOCATION OF THE SYSTEM NAME A3000019 RR EXT PARTBL SYSTEM PARTITIONED MEMORY TABLE A3000020 RR EXT TERMLU COMMUNICATIONS CONTROLLER LOGICAL UNIT A3000021 RR EXT YERTO TIME AND DATE YEAR A3000022 RR EXT MONTO TIME AND DATE MONTH A3000023 RR EXT DAYTO TIME AND DATE DAY A3000024 RR EXT HORTO TIME AND DATE HOUR A3000025 RR EXT MINTO TIME AND DATE MINUTE A3000026 RR EXT SECON TIME AND DATE SECOND A3000027 RR EXT OPENFL OPEN FILE REQUEST A3000028 RR EXT CLOSFL CLOSE FILE FILE REQUEST A3000029 RR EXT READR READ INDEXED RECORD FILE REQUEST A3000030 RR EXT GETS READ SEQUENTIAL RECORD FILE REQUEST A3000031 RR EXT PUTS STORE SEQUENTIAL RECORD FILE REQUEST A3000032 RR EXT FCLOSE FORCE CLOSE FILE REQUEST A3000033 RR EXT FMEOFC FILE MAMAGER END-OF-FILE CODE A3000034 RR EXT LUNEQ DEVICE NAME - LOGICAL UNIT CONVERSION A3000035 RR EXT INPEQ USER INPUT DEVICE SPECIFICATION A3000036 RR EXT OUTEQ USER OUTPUT DEVICE SPECIFICATION A3000037 RR EXT PGLUNT INPUT / OUTPUT LOGICAL UNIT SPECIFICATION A3000038 RR EJT A3000039 RR SPC 4 A3000040 RR* E Q U I V A L E N C E S A3000041 RR SPC 1 A3000042 RR EQU LPMASK($2) BIT MASK TABLE A3000043 RR EQU NZERO($12) NEGATIVE ZERO TABLE A3000044 RR EQU ONEBIT($23) SINGLE BIT TABLE A3000045 RR EQU ZERO($22) LOCATION CONTAINING ZERO A3000046 RR EQU ONE(3) LOCATION CONTAINING ONE A3000047 RR EQU THREE(4) LOCATION CONTAINING THREE A3000048 RR EQU SIX($44) LOCATION CONTAINING SIX A3000049 RR EQU EIGHT($26) LOCATION CONTAINING EIGHT A3000050 RR EQU TEN($46) LOCATION CONTAINING TEN A3000051 RR EQU MINONE($33) LOCATION CONTAINING MINUS ONE A3000052 RR EQU ADISP($EA) ADDRESS OF THE DISPATCHER A3000053 RR EQU AMONI($F4) ADDRESS OF MONITOR REQUEST ENTRY A3000054 RR EQU SPACE($20) SPACE CHARACTER A3000055 RR EQU EQUAL($3D) EQUAL CHARACTER A3000056 RR EQU EF(08) END-OF-FILE INDICATOR A3000057 RR EQU NF(09) RECORD KEY NOT FOUND INDICATOR A3000058 RR EQU M13(13) SYSTEM MESSAGE - DATE/TIME A3000059 RR EQU M14(14) SYSTEM MESSAGE - TERMINAL NUMBER A3000060 RR EQU M15(15) SYSTEM MESSAGE - LOG-OFF A3000061 RR EQU E16(16) ILLEGAL LOG-IN A3000062 RR EQU E17(17) INVALID REQUEST NAME A3000063 RR EQU E18(18) PROGRAM TOO LARGE A3000064 RR EQU E19(19) ERROR DURING OPENFL A3000065 RR EQU E20(20) ERROR DURING CLOSFL A3000066 RR EQU E21(21) ERROR DURING READR A3000067 RR EQU E22(22) ERROR DURING GETS A3000068 RR EQU E23(23) ERROR DURING FFCLOSE A3000069 RR EQU E24(24) PROCEDURE FILE ERROR A3000070 RR EJT A3000071 RR SPC 4 A3000072 RR* M U L T I - U S E R P R O G R A M T A B L E E N T R I E S A3000073 RR SPC 1 A3000074 RR EQU MUROOT(ZERO) ASSOCIATED ROOT TABLE ADDRESS A3000075 RR EQU MUSRID(01) PROGRAM IDENTIFICATION - 4 WORDS ASCII A3000076 RR EQU MUSIZE(05) PROGRAM LENGTH (WORDS) A3000077 RR EQU MUSECT(06) PROGRAM SECTOR ADDRESS - 2 WORDS A3000078 RR EQU MUPAGE(08) PROGRAM BASE MEMORY PAGE NUMBER A3000079 RR EQU ACROOT(09) PROGRAM ACTIVE ROOT COUNT A3000080 RR EQU MURSIZ(10) PROGRAM TRUE LENGTH (WORDS) A3000081 RR EQU MUEXTH(11) PROGRAM EXECUTION THREAD A3000082 RR EQU MURSTX(13) PROGRAM STATE INDEX A3000083 RR EQU MURCLK(15) PROGRAM CLOCK VALUE A3000084 RR EQU MUITEM(MURCLK+1) A3000085 RR SPC 2 A3000086 RR* U S E R P R O G R A M U S E R T A B L E E N T R I E S A3000087 RR SPC 1 A3000088 RR EQU TSIOTB(ZERO) ASSOCIATED I/O TABLE ADDRESS A3000089 RR EQU USERID(01) USER IDENTIFICATION - 4 WORDS ASCII A3000090 RR EQU PGMSIZ(05) USER PROGRAM LENGTH (WORDS) A3000091 RR EQU PGMSEC(06) USER PROGRAM SECTOR - 2 WORDS A3000092 RR EQU TWNSEC(08) SWAP TWIN SECTOR - 2 WORDS A3000093 RR EQU SWPBLK(10) USER SWAP BLOCK BYTES A3000094 RR EQU NEXETH(11) USER EXECUTION THREAD A3000095 RR EQU NSWPTH(12) USER SWAP THREAD A3000096 RR EQU USRSTX(13) USER STATE INDEX A3000097 RR EQU TSMUTB(14) MULTI USER TABLE ADDRESS A3000098 RR EQU NUMREQ(15) USER REQUEST COUNT A3000099 RR EQU USRITM(NUMREQ+1) A3000100 RR EJT A3000101 RR SPC 4 A3000102 RR* U S E R P R O G R A M S T A T E I N D I C E S A3000103 RR SPC 1 A3000104 RR EQU SXCACT(01) EXECUTING IN MAIN MEMORY A3000105 RR EQU SXCTSL(02) SUSPENDED IN MAIN MEMORY-TIMESLICE COMPLETE A3000106 RR EQU SXCMMA(03) SUSPENDED IN MAIN MEMORY-M.M. I/O ACTIVE A3000107 RR EQU SXCMMC(04) SUSPENDED IN MAIN MEMORY-M.M. I/O COMPLETE A3000108 RR EQU SXCFMA(05) SUSPENDED IN MAIN MEMORY-FILE I/O ACTIVE A3000109 RR EQU SXCFMC(06) SUSPENDED IN MAIN MEMORY-FILE I/O COMPLETE A3000110 RR EQU SXCTMA(07) SUSPENDED IN MAIN MEMORY-TMNL I/O ACTIVE A3000111 RR EQU SXCTMC(08) SUSPENDED IN MAIN MEMORY-TMNL I/O COMPLETE A3000112 RR EQU SXCDTA(09) SUSPENDED IN MAIN MEMORY-DATA I/O ACTIVE A3000113 RR EQU SXCDTC(10) SUSPENDED IN MAIN MEMORY-DATA I/O COMPLETE A3000114 RR EQU SXCATA(11) SUSPENDED IN MAIN MEMORY-ATTACH ACTIVE A3000115 RR EQU SXCATC(12) SUSPENDED IN MAIN MEMORY-ATTACH COMPLETE A3000116 RR* A3000117 RR EQU SXMASS(13) RESERVED A3000118 RR EQU SXMTSL(14) SWAPPED ON MASS MEMORY-TIMESLICE COMPLETE A3000119 RR EQU SXM015(15) RESERVED A3000120 RR EQU SXMMMC(16) SWAPPED ON MASS MEMORY-M.M. I/O COMPLETE A3000121 RR EQU SXM017(17) RESERVED A3000122 RR EQU SXMFMC(18) SWAPPED ON MASS MEMORY-FILE I/O COMPLETE A3000123 RR EQU SXMTMA(19) SWAPPED ON MASS MEMORY-TMNL I/O ACTIVE A3000124 RR EQU SXMTMC(20) SWAPPED ON MASS MEMORY-TMNL I/O COMPLETE A3000125 RR EQU SXMDTA(21) SWAPPED ON MASS MEMORY-DATA I/O ACTIVE A3000126 RR EQU SXMDTC(22) SWAPPED ON MASS MEMORY-DATA I/O COMPLETE A3000127 RR EQU SXMATA(23) SWAPPED ON MASS MEMORY-ATTACH ACTIVE A3000128 RR EQU SXM024(24) RESERVED A3000129 RR* A3000130 RR EQU SXMUSA(25) SUSPENDED ON MASS MEMORY-UNSWAP ACTIVE A3000131 RR EQU SXCUSC(26) SUSPENDED IN MAIN MEMORY-UNSWAP COMPLETE A3000132 RR EQU SXMMUR(27) SUSPENDED ON MASS MEMORY-MULTIUSER READ A3000133 RR EQU SXMLOG(28) SUSPENDED ON MASS MEMORY-INITIAL LOGIN A3000134 RR EQU SXMJOB(29) SUSPENDED ON MASS MEMORY-JOB STEP A3000135 RR SPC 2 A3000136 RR* NOTE - BIT 15 = 1 WHILE THE USER IS BEING SWAPPED A3000137 RR EJT A3000138 RR SPC 4 A3000139 RR* U S E R P R O G R A M I / O T A B L E E N T R I E S A3000140 RR SPC 1 A3000141 RR EQU TSUSTB(ZERO) ASSOCIATED USER TABLE ADDRESS A3000142 RR EQU FRQBUF(01) FILE REQUEST BUFFER HEADER (4 WORDS) A3000143 RR EQU IORQCD(05) INPUT/OUTPUT REQUEST CODE A3000144 RR EQU IORQCA(06) INPUT/OUTPUT COMPLETION ADDRESS A3000145 RR EQU IORQTH(07) INPUT/OUTPUT THREAD WORD A3000146 RR EQU IORQLU(08) INPUT/OUTPUT LOGICAL UNIT A3000147 RR EQU IOMSLN(09) INPUT/OUTPUT MESSAGE LENGTH A3000148 RR EQU IOBFAD(10) INPUT/OUTPUT MESSAGE BUFFER ADDRESS A3000149 RR EQU IOMMSB(11) INPUT/OUTPUT MASS MEMORY ADDRESS A3000150 RR EQU IOMLSB(12) INPUT/OUTPUT MASS MEMORY ADDRESS A3000151 RR EQU IOCNPT(13) INPUT/OUTPUT CONTROL POINT A3000152 RR EQU IOSTAT(14) INPUT/OUTPUT STATUS WORD A3000153 RR EQU TERMBF(15) TERMINAL MESSAGE BUFFER ADDRESS A3000154 RR EQU IOITEM(TERMBF+1) A3000155 RR SPC 2 A3000156 RR* USER PROGRAM I/O STATUS INDICATORS A3000157 RR SPC 1 A3000158 RR* UNSOLICITED INPUT GROUP A3000159 RR EQU LI(00) TERMINAL LOG-IN A3000160 RR EQU MN(01) TERMINAL MANUAL INTERRUPT A3000161 RR EQU ES(02) TERMINAL ESCAPE A3000162 RR* INPUT-OUTPUT ERROR GROUP A3000163 RR EQU DS(04) TERMINAL DISCONNECT A3000164 RR EQU ME(05) MASS MEMORY ERROR A3000165 RR EQU FE(06) FILE REQUEST ERROR A3000166 RR* REQUEST TYPE GROUP A3000167 RR EQU IN(08) DATA INPUT REQUEST A3000168 RR EQU IA(09) INPUT / OUTPUT ACTIVE A3000169 RR EQU IC(10) INPUT / OUTPUT COMPLETE A3000170 RR EQU MM(11) MASS MEMORY I/O REQUEST A3000171 RR EQU TI(12) TERMINAL I/O REQUEST A3000172 RR* TERMINAL CHARACTERISTIC GROUP A3000173 RR* A3000174 RR EQU DY(TI+1) END OF THE DYNAMIC STATUS GROUP A3000175 RR EJT A3000176 RR* U S E R L I N K A G E B U F F E R E N T R I E S A3000177 RR* A3000178 RR* THE USER LINKAGE BUFFER IMMEDIATELY PRECEEDS THE USER PROGRAM A3000179 RR SPC 2 A3000180 RR EQU LASTEP(ZERO) LAST ENTRY TO THE USER PROGRAM A3000181 RR EQU ULIOTB(001) USERS I/O TABLE ADDRESS A3000182 RR EQU ULUSTB(002) USERS USER TABLE ADDRESS A3000183 RR EQU RSCLOK(003) USERS REMAINING TIMESLICE A3000184 RR EQU FALADD(004) PROTECT FAULT ADDRESS A3000185 RR EQU PARADD(005) CURRENT PARAMETER ADDRESS A3000186 RR EQU RSP(006) P-REGISTER STORAGE A3000187 RR EQU RSA(007) A-REGISTER STORAGE A3000188 RR EQU RSQ(008) Q-REGISTER STORAGE A3000189 RR EQU RSI(009) I-REGISTER STORAGE A3000190 RR EQU RSL(010) OVERFLOW STORAGE A3000191 RR EQU RS1(011) 1-REGISTER STORAGE A3000192 RR EQU RS2(012) 2-REGISTER STORAGE A3000193 RR EQU RS3(013) 3-REGISTER STORAGE A3000194 RR EQU RS4(014) 4-REGISTER STORAGE A3000195 RR EQU RSUB(015) UPPER BOUNDS REGISTER STORAGE A3000196 RR EQU RSIORC(016) MONITOR I/O REQUEST CODE A3000197 RR EQU RSIOCA(017) COMPLETION ADDRESS A3000198 RR EQU RSIOTH(018) REQUEST THREAD A3000199 RR EQU RSIOLU(019) MODE + LOGICAL UNIT A3000200 RR EQU RSIOLN(020) LENGTH A3000201 RR EQU RSIOSA(021) STARTING ADDRESS A3000202 RR EQU RSIOMS(022) MASS MEMORY ADDRESS - MSB A3000203 RR EQU RSIOLS(023) MASS MEMORY ADDRESS - LSB A3000204 RR EQU RSIOCP(024) MONITOR REQUEST CONTROL POINT A3000205 RR EQU RQTYPE(025) MONITOR REQUEST TYPE INDEX A3000206 RR EQU RQCLAS(026) MONITOR REQUEST DEVICE CLASS CODE A3000207 RR EQU RQMODE(027) MONITOR REQUEST CHARACTER MODE INDICATOR A3000208 RR EQU REQLUN(028) MONITOR REQUEST LOGICAL UNIT A3000209 RR EQU RSCPAD(029) USERS MONITOR REQUEST COMPLETION ADDRESS A3000210 RR EQU RSUSLN(030) USERS MONITOR REQUEST MESSAGE LENGTH A3000211 RR EQU RSUSBF(031) USERS MONITOR REQUEST MESSAGE ADDRESS A3000212 RR EQU PORTNO(032) MONITOR REQUEST COMMUNICATIONS PORT NUMBER A3000213 RR EQU RSBHDR(032) MONITOR REQUEST MESSAGE HEADER - 6 WORDS A3000214 RR EQU WROUTP(038) WRITE-READ USERS OUTPUT LOGICAL UNIT A3000215 RR EQU WRILEN(039) WRITE-READ INPUT BUFFER LENGTH A3000216 RR EQU WRIBUF(040) WRITE-READ INPUT BUFFER ADDRESS A3000217 RR EQU WRTCAD(041) WRITE-READ TERMINATION CODE ADDRESS A3000218 RR EQU PMCNTR(042) REQUEST PARAMETER COUNT A3000219 RR EQU RSCARG(043) USERS MONITOR REQUEST COMPLETION A-REGISTER A3000220 RR EQU RQINPT(044) USERS INPUT LOGICAL UNIT A3000221 RR EQU RQOUTP(045) USERS OUTPUT LOGICAL UNIT A3000222 RR EQU RQUN01(046) USERS SPARE LOGICAL UNIT A3000223 RR EQU RQUN02(047) USERS SPARE LOGICAL UNIT A3000224 RR EJT A3000225 RR SPC 4 A3000226 RR* U S E R L I N K A G E B U F F E R E N T R I E S A3000227 RR SPC 2 A3000228 RR EQU ERRIDX(048) ERROR MESSAGE INDEX A3000229 RR EQU ERRADD(049) ERROR MESSAGE ADDRESS A3000230 RR EQU USRPGM(050) CURRENT USER PROGRAM INDEX A3000231 RR EQU PGMIDX(051) LOG-IN PROCESSOR PROGRAM INDEX A3000232 RR EQU INTADD(052) PGMINT REQUEST INTERRUPT ADDRESS A3000233 RR EQU INTFLG(053) PGMINT REQUEST INTERRUPT FLAG ADDRESS A3000234 RR EQU ATTADR(054) ATTACH REQUEST COMPLETION ADDRESS A3000235 RR EQU LUNERR(055) ILLEGAL LOGICAL UNIT ERROR ADDRESS A3000236 RR EQU FMINDX(056) FILE REQUEST TYPE INDEX A3000237 RR EQU SPARE0(057) SPARE ENTRY A3000238 RR EQU DATIME(058) DATE AND TIME FOR DAYFILE ENTRY - 6 WORDS A3000239 RR EQU FRQBFA(064) FILE REQUEST BUFFER ADDRESS A3000240 RR EQU FILREQ(065) USER DECLARED FILE REQUEST INDICATOR A3000241 RR EQU FMPMTR(066) FILE REQUEST PARAMETER LIST - 5 WORDS A3000242 RR EQU CHNAME(071) CHAIN REQUEST PROGRAM NAME - 4 WORDS A3000243 RR EQU MUFWAD(075) FIRST WORD ADDRESS OF THE MULTI-USER PROGRAM A3000244 RR EQU TEMPQR(076) TEMPORARY STORAGE - Q REGISTER A3000245 RR EQU TEMPAR(077) TEMPORARY STORAGE - A REGISTER A3000246 RR EQU RSC5E5(078) FORTRAN SCRATCH AREA STORAGE - 33 WORDS A3000247 RR EQU SPARE1(111) SPARE ENTRY A3000248 RR EQU ENDPRO(111) END OF THE PROTECTED LINKAGE BUFFER AREA A3000249 RR* A3000250 RR EQU UFPARM(112) USER DECLARED FILE REQUEST PARAMETERS A3000251 RR EQU FISTAT(128) USER DECLARED FILE REQUEST STATUS A3000252 RR EQU PFNAME(129) CURRENT PROCEDURE FILE NAME - 4 WORDS A3000253 RR EQU MENUKY(133) REQUESTED FUNCTION MENU KEY A3000254 RR EQU USABRT(134) USER PROGRAM ABORT INDICATOR A3000255 RR EQU USMODE(135) USER EXECUTION MODE INDICATOR A3000256 RR EQU TMPGMX(136) TEMPORARY - PROGRAM INDEX A3000257 RR EQU TMSECT(137) TEMPORARY - PROGRAM SECTOR - 2 WORDS A3000258 RR EQU TMPLEN(139) TEMPORARY - PROGRAM LENGTH A3000259 RR EQU TMUSID(140) TEMPORARY - USER IDENTIFICATION - 4 WORDS A3000260 RR EQU IREQBF(144) INPUT FILE REQUEST BUFFER AND FCB A3000261 RR EQU FINAME(188) INPUT FILE NAME - 4 WORDS A3000262 RR EQU OREQBF(192) OUTPUT FILE REQUEST BUFFER AND FCB A3000263 RR EQU FONAME(236) OUTPUT FILE NAME - 4 WORDS A3000264 RR EQU FIRCNO(240) INPUT FILE RECORD NUMBER - 2 WORDS A3000265 RR EQU LULBUF(256) LENGTH OF THE LINKAGE BUFFER A3000266 RR EQU LOKNAM(242) 8 CHARACTER NAME OF FORCED ANSWER TO A3000267 RR* REQUEST = QUERY. A3000268 RR EQU LOKLEN(246) NUMBER OF NON-BLANK CHARACTERS IN LOKNAM. A3000269 RR EJT A3000270 RR SPC 4 A3000271 RR* T S L O G I N I T I A L I Z A T I O N R O U T I N E A3000272 RR SPC 2 A3000273 RRTSLOG STQ* FUNIDX SAVE THE TSLOG FUNCTION INDEX A3000274 RR SPC 1 A3000275 RR RTJ+ PGMINT SET UP AN ABORT REQUEST ENTRY A3000276 RR ADC AEXIT A3000277 RR ADC FLAG A3000278 RR SPC 1 A3000279 RR ENA 0 A3000280 RR STA* MNUTMP INITIALIZE THE MENU KEY VALUE A3000281 RR SPC 1 A3000282 RR LDA+ TSAREA OBTAIN THE ADDRESS OF THE LINKAGE BUFFER A3000283 RR STA- I A3000284 RR SPC 1 A3000285 RR LDQ* FUNIDX A3000286 RR LDQ* FUNTAB,Q OBTAIN THE REQUIRED FUNCTION ADDRESS A3000287 RR JMP- (ZERO),Q PERFORM THE FUNCTION A3000288 RR SPC 2 A3000289 RR* T S L O G F U N C T I O N T A B L E A3000290 RR SPC 1 A3000291 RRFUNTAB ADC LOGIN 00 - PROCESS USER LOG-IN A3000292 RR ADC SYSTEM 01 - PROCESS USER SYSTEM COMPLETION A3000293 RR ADC ERROR 02 - PROCESS EXECUTIVE ERROR MESSAGE A3000294 RR ADC CHAIN 03 - PROCESS A PROGRAM CHAIN A3000295 RR SPC 2 A3000296 RRFUNIDX ADC 0 LOG-IN FUNCTION INDEX A3000297 RR EJT A3000298 RR* L O G - I N P R O C E S S O R A3000299 RR SPC 2 A3000300 RRLOGIN LDA- PORTNO,I OBTAIN AND SAVE THE TERMINAL NUMBER A3000301 RR CLR Q A3000302 RR DVI- TEN A3000303 RR QLS 8 CONVERT THE TERMINAL NUMBER TO ASCII A3000304 RR LLS 8 A3000305 RR ADD =A00 A3000306 RR STA MESG03+6 PLACE IT IN THE MESSAGE A3000307 RR SPC 1 A3000308 RR RTJ GETTOD OBTAIN AND SAVE THE CURRENT DATE AND TIME A3000309 RR SPC 1 A3000310 RR ENQ 0 CLEAR THE SCREEN A3000311 RR RTJ MESSAG A3000312 RR SPC 1 A3000313 RR RTJ SYSMSG OUTPUT THAT DATE AND TIME A3000314 RR ADC MSG13 A3000315 RR ADC DATIM A3000316 RR SPC 1 A3000317 RR ENQ 1 OUTPUT THE HEADER A3000318 RR RTJ MESSAG A3000319 RR SPC 1 A3000320 RR ENQ 2 OUTPUT THE SYSTEM NAME A3000321 RR RTJ MESSAG A3000322 RR SPC 1 A3000323 RR ENQ 3 OUTPUT THE TERMINAL NUMBER A3000324 RR RTJ MESSAG A3000325 RR EJT A3000326 RR SPC 4 A3000327 RR LDA+ QPASWD A3000328 RR SUB =A IS THERE A PASSWORD DEFINED A3000329 RR SAN LOG010 YES, PROCESS IT A3000330 RR JMP* LOG020 NO, BYPASS THE PASSWORD INPUT AND CHECK A3000331 RR SPC 1 A3000332 RRLOG010 RTJ+ WTREAD REQUEST THE PASSWORD A3000333 RR ADC WTRDLU LOGICAL UNIT A3000334 RR ADC MINONE X-Y POSITION (NULL) A3000335 RR ADC WTRD01 OUTPUT MESSAGE A3000336 RR ADC WTRDL1 OUTPUT MESSAGE LENGTH A3000337 RR ADC MINONE X-Y POSITION (NULL) A3000338 RR ADC TEMPBF INPUT BUFFER A3000339 RR ADC N18 INPUT LENGTH - CHARACTERS A3000340 RR ADC TCODE TERMINATION CODE A3000341 RR SPC 1 A3000342 RR RTJ INPUT FORMAT THE INPUT A3000343 RR SPC 1 A3000344 RR RTJ COMPAR DOES THE PASSWORD MATCH A3000345 RR ADC QPASWD A3000346 RR SAZ LOG020 YES A3000347 RR SPC 1 A3000348 RR JMP LOGOFF NO, PASSWORD ERROR, LOG THE USER OFF. A3000349 RR EJT A3000350 RR SPC 4 A3000351 RRLOG020 RTJ+ WTREAD REQUEST THE USER IDENTIFICATION A3000352 RR ADC WTRDLU LOGICAL UNIT A3000353 RR ADC MINONE X-Y POSITION (NULL) A3000354 RR ADC WTRD02 OUTPUT MESSAGE A3000355 RR ADC WTRDL2 OUTPUT MESSAGE LENGTH A3000356 RR ADC MINONE X-Y POSITION (NULL) A3000357 RR ADC TEMPBF INPUT BUFFER A3000358 RR ADC N18 INPUT LENGTH - CHARACTERS A3000359 RR ADC TCODE TERMINATION CODE A3000360 RR SPC 1 A3000361 RR ENA 0 A3000362 RR STA- LOKLEN,I A3000363 RR RTJ INPUT FORMAT THE INPUT A3000364 RR SPC 1 A3000365 RR SPC 1 A3000366 RR RTJ COMPAR IS THE IDENTIFICATION THE SYSTEM OPERATOR A3000367 RR ADC OPID A3000368 RR ADD- PORTNO,I IT IS LEGAL ONLY FROM THE MASTER TERMINAL A3000369 RR SAZ LOG030 YES A3000370 RR SPC 1 A3000371 RR RTJ USRFIL IS THE IDENTIFICATION IN THE USER ID FILE A3000372 RR SAZ LOG030 YES A3000373 RR SPC 1 A3000374 RR JMP LOGOFF NO, INDICATE ILLEGAL LOG-IN. A3000375 RR SPC 1 A3000376 RRLOG030 ENQ 3 A3000377 RR SPC 1 A3000378 RRLOG040 LDA TEMPBF,Q MOVE THE USER IDENTIFICATION A3000379 RR STA- TMUSID,B TO THE LINKAGE BUFFER A3000380 RR DQP *-LOG040 A3000381 RR SPC 1 A3000382 RRLOG050 JMP* SYSNXT REQUEST THE USER PROGRAM A3000383 RR EJT A3000384 RR SPC 4 A3000385 RR* D A T A A N D S T O R A G E A3000386 RR SPC 1 A3000387 RRERRFLG NUM 0 LOG-IN ERROR INDICATOR A3000388 RRFLAG NUM 0 MANUAL INTERRUPT INDICATOR A3000389 RRCOMMNT NUM 0 PROCEDURE COMMENT INDICATOR A3000390 RRAEXIT ADC EXIT EXIT FUNCTION ADDRESS A3000391 RRWTRDLU ADC TERMLU WRITE-READ LOGICAL UNIT A3000392 RRWTRDL1 ADC 2*LWTR01 WRITE-READ MESSAGE LENGTH 1 A3000393 RRWTRDL2 ADC 2*LWTR02 WRITE-READ MESSAGE LENGTH 2 A3000394 RRWTRDL3 ADC 2*LWTR03 WRITE-READ MESSAGE LENGTH 3 A3000395 RRN18 NUM 18 WRITE-READ INPUT LENGTH 3 A3000396 RRMSG13 ADC M13 SYSTEM MESSAGE INDEX 13 A3000397 RRMSG14 ADC M14 SYSTEM MESSAGE INDEX 14 A3000398 RRMSG24 ADC E24 SYSTEM ERROR INDEX 24 A3000399 RRTCODE NUM 0 WRITE-READ TERMINATION CODE A3000400 RRLOGUNT NUM 0 PROCEDURE LOGICAL UNIT A3000401 RRISTAT1 NUM 0 FILE MANAGER RETURN STATUS A3000402 RRISTAT2 NUM 0 FILE MANAGER RETURN STATUS A3000403 RRWRDINP NUM 0 NUMBER OF WORDS INPUT A3000404 RRMNUTMP NUM 0 TEMPORARY STORAGE - MENU KEY MNEMONIC A3000405 RR SPC 1 A3000406 RRNOID ALF 4, A3000407 RROPID ALF 4,$$ A3000408 RREXRQ ALF 4,EX A3000409 RRLSRQ ALF 4,? A3000410 RR EJT A3000411 RR SPC 4 A3000412 RR* U S E R P R O G R A M C O M P L E T I O N A3000413 RR SPC 2 A3000414 RRSYSTEM RTJ CLOSE CLOSE ANY OPEN USER FILES A3000415 RRSYSERR RTJ IOFILE OPEN/POSITION ANY DECLARED I/O FILES A3000416 RR LDA- PGMIDX,I IS THE USER PROGRAM THE LOG-IN PROCESSOR A3000417 RR SAN SYSMOD NO A3000418 RR JMP EXIT YES, EXIT A3000419 RR SPC 1 A3000420 RRSYSMOD LDA- USMODE,I IS THE PROGRAM IN STREAM MODE A3000421 RR SAN SYS020 YES A3000422 RR JMP* SYSNXT NO, REQUEST THE NEXT PROGRAM A3000423 RR SPC 1 A3000424 RRSYS020 LDA- MENUKY,I SAVE THE FUNCTION MENU KEY A3000425 RR STA* MNUTMP A3000426 RR SPC 1 A3000427 RRSYSTRM LDA =XPFNAME A3000428 RR ADD- I A = ADDRESS OF THE PROCEDURE NAME A3000429 RR STA* SYSPR1 A3000430 RR RTJ+ LUNEQ OBTAIN THE EQUIVALENT LOGICAL UNIT A3000431 RRSYSPR1 ADC 0 A3000432 RR ADC LOGUNT A3000433 RR SPC 1 A3000434 RRSYS030 LDA* LOGUNT A3000435 RR RTJ GETREC OBTAIN THE NEXT PROCEDURE RECORD A3000436 RR SPC 1 A3000437 RR SAZ SYS035 SKIP IF THE PROCESURE IS EMPTY A3000438 RR LDA BUFFER A3000439 RR SUB =XFMEOFC IS THE RECORD AN END-OF-FILE A3000440 RR SAN SYS040 NO, CONTINUE A3000441 RRSYS035 STA- USMODE,I YES, RETURN TO INTERACTIVE MODE A3000442 RR JMP* SYSNXT THE PROCEDURE IS EMPTY A3000443 RR EJT A3000444 RR SPC 4 A3000445 RRSYS040 LDA BUFFER A3000446 RR SUB =A * IS THE RECORD A PROCEDURE COMMENT A3000447 RR SAN SYS060 NO A3000448 RR LDA* COMMNT YES, HAS A COMMENT ALREADY BEEN DISPLAYED A3000449 RR SAN SYS050 YES A3000450 RR ENQ 0 NO, CLEAR THE SCREEN A3000451 RR RTJ MESSAG A3000452 RRSYS050 ENQ 4 A3000453 RR STQ* COMMNT A3000454 RR RTJ MESSAG A3000455 RR JMP* SYS030 OBTAIN THE NEXT RECORD A3000456 RR SPC 1 A3000457 RRSYS060 ENQ TMBFSZ-1 A3000458 RRSYS070 LDA BUFFER,Q MOVE THE PROCEDURE RECORD A3000459 RR STA TEMPBF,Q TO THE INPUT BUFFER A3000460 RR INQ -1 A3000461 RR SQM SYS080 A3000462 RR JMP* SYS070 A3000463 RR SPC 1 A3000464 RRSYS080 JMP* SYSFND CONTINUE A3000465 RR EJT A3000466 RR SPC 4 A3000467 RR* O B T A I N T H E N E X T F U N C T I O N A3000468 RR SPC 2 A3000469 RRSYSNXT ENA 0 CLEAR THE MENU KEY. A3000470 RR STA- MENUKY,I A3000471 RR STA MNUTMP A3000472 RR LDA- LOKLEN,I A3000473 RR SAZ SYSNX5 SKIP IF NO FORCED PROGRAM EXECUTION A3000474 RR* IS SPECIFIED. A3000475 RR ENQ 3 A3000476 RRSYSNX3 LDA- LOKNAM,B MOVE THE SPECIFIED PROGRAM NAME A3000477 RR STA TEMPBF,Q TO THE INPUT BUFFER. A3000478 RR DQP *-SYSNX3 A3000479 RR LDA- LOKLEN,I FAKE THE NUMBER OF CHARACTERS INPUT. A3000480 RR STA INPLEN A3000481 RR JMP* SYSNX9 A3000482 RRSYSNX5 RTJ+ WTREAD REQUEST THE FUNCTION NAME. A3000483 RR ADC WTRDLU LOGICAL UNIT A3000484 RR ADC MINONE X-Y POSITION (NULL) A3000485 RR ADC WTRD03 OUTPUT MESSAGE A3000486 RR ADC WTRDL3 OUTPUT MESSAGE LENGTH A3000487 RR ADC MINONE X-Y POSITION (NULL) A3000488 RR ADC TEMPBF INPUT BUFFER A3000489 RR ADC N18 INPUT LENGTH - CHARACTERS A3000490 RR ADC TCODE TERMINATION CODE A3000491 RR SPC 1 A3000492 RRSYSNX9 RTJ INPUT FORMAT THE INPUT. A3000493 RR STQ* WRDINP SAVE THE NUMBER OF WORDS INPUT A3000494 RR SPC 1 A3000495 RRSYSFND RTJ COMPAR WAS AN EXIT REQUESTED A3000496 RR ADC EXRQ A3000497 RR SAN SYS110 NO A3000498 RR JMP EXIT YES A3000499 RR SPC 1 A3000500 RRSYS110 RTJ COMPAR WAS A FUNCTION MENU REQUESTED A3000501 RR ADC LSRQ A3000502 RR SAN SYS120 NO A3000503 RR JMP LIST YES A3000504 RR SPC 1 A3000505 RRSYS120 RTJ IOEQAL WAS INPUT OR OUTPUT EQUAL REQUESTED A3000506 RR SAN SYS130 NO A3000507 RR JMP* SYSMOD YES, CONTINUE A3000508 RR SPC 1 A3000509 RRSYS130 LDA* WRDINP A3000510 RR INA -1 WAS A 1-WORD REQUEST ENTERED A3000511 RR SAN SYS140 NO A3000512 RR RTJ PRMENU YES, USE THE SYSTEM MENU FOR THE REQUEST A3000513 RR EJT A3000514 RR SPC 4 A3000515 RRSYS140 RTJ OPEN OPEN THE PROGRAM NAME FILE A3000516 RR ADC PGMNAM A3000517 RR SPC 1 A3000518 RR RTJ+ READR LOOK FOR THE ENTRY IN THE PGM. NAME FILE A3000519 RR ADC REQBUF A3000520 RR ADC BUFFER A3000521 RR ADC KEYVAL A3000522 RR ADC ISTAT1 A3000523 RR SPC 1 A3000524 RR RTJ+ CLOSFL CLOSE THE PROGRAM NAME FILE A3000525 RR ADC REQBUF A3000526 RR ADC ISTAT2 A3000527 RR LDA ISTAT2 A3000528 RR RTJ CKSTAT CHECK FOR FILE ERRORS A3000529 RR NUM $FFFF A3000530 RR NUM 1 A3000531 RR SPC 1 A3000532 RR LDA ISTAT1 WAS THE PROGRAM FOUND A3000533 RR SAZ SYS150 YES A3000534 RR RTJ CKSTAT NO, CHECK FOR FILE ERRORS A3000535 RR NUM $60F4 A3000536 RR NUM 2 A3000537 RR JMP* SYS200 NO ERRORS, CONTINUE A3000538 RR SPC 1 A3000539 RRSYS150 ENA -1 A3000540 RR STA- TMPGMX,I SPECIFY THE PROGRAM INDEX A3000541 RR ENQ 2 A3000542 RRSYS160 LDA BUFFER+3,Q MOVE THE PROGRAM SECTOR AND LENGTH A3000543 RR STA- TMSECT,B TO THE LINKAGE BUFFER A3000544 RR INQ -1 A3000545 RR SQM SYS170 A3000546 RR JMP* SYS160 A3000547 RR SPC 1 A3000548 RRSYS170 LDA- TMPLEN,I A = PROGRAM LENGTH A3000549 RR RTJ SIZECK IS THE PROGRAM TOO LARGE A3000550 RR SAP SYS180 NO A3000551 RR ENQ E18 YES, INDICATE AN ERROR A3000552 RR RTJ* ERRPR2 A3000553 RR JMP* SYSNXT REQUEST ANOTHER FUNCTION A3000554 RR SPC 1 A3000555 RRSYS180 JMP* SYSXIT INITIATE THE REQUESTED PROGRAM A3000556 RR EJT A3000557 RR SPC 4 A3000558 RRSYS200 RTJ OPEN OPEN THE PROCEDURE DIRECTORY FILE A3000559 RR ADC PRODIR A3000560 RR SPC 1 A3000561 RR RTJ+ READR LOOK FOR THE ENTRY IN THE PROCEDURE DIR. FILE A3000562 RR ADC REQBUF A3000563 RR ADC BUFFER A3000564 RR ADC KEYVAL A3000565 RRSYSST1 ADC ISTAT1 A3000566 RR SPC 1 A3000567 RR RTJ+ CLOSFL CLOSE THE PROCEDURE DIRECTORY FILE A3000568 RR ADC REQBUF A3000569 RRSYSST2 ADC ISTAT2 A3000570 RR LDA* (SYSST2) A3000571 RR RTJ CKSTAT CHECK FOR FILE ERRORS A3000572 RR NUM $FFFF A3000573 RR NUM 1 A3000574 RR SPC 1 A3000575 RR LDA* (SYSST1) WAS THE PROCEDURE FOUND A3000576 RR SAZ SYS210 YES A3000577 RR RTJ CKSTAT NO, CHECK FOR FILE ERRORS A3000578 RR NUM $60F4 A3000579 RR NUM 2 A3000580 RR JMP* SYS300 NO ERRORS, CONTINUE A3000581 RR SPC 1 A3000582 RRSYS210 ENQ 3 A3000583 RR SPC 1 A3000584 RRSYS220 LDA BUFFER+5,Q MOVE THE PROCEDURE NAME A3000585 RR STA- PFNAME,B TO THE LINKAGE BUFFER A3000586 RR INQ -1 A3000587 RR SQM SYS230 A3000588 RR JMP* SYS220 A3000589 RR EJT A3000590 RR SPC 4 A3000591 RRSYS230 LDA =XUSABRT A3000592 RR ADD- I A3000593 RR STA- USMODE,I SPECIFY PROCEDURE STREAM MODE A3000594 RR SPC 1 A3000595 RR RTJ+ INPEQ SPECIFY THE PROCEDURE FILE A3000596 RR ADC BUFFER+5 A3000597 RR ADC ISTAT1 A3000598 RR SPC 1 A3000599 RR LDA* (SYSST1) IS THE FILE LEGAL A3000600 RR SAZ SYS240 YES A3000601 RR SPC 1 A3000602 RR RTJ+ SYSMSG NO, INDICATE AN ERROR A3000603 RR ADC MSG24 A3000604 RR ADC BUFFER+5 A3000605 RR SPC 1 A3000606 RR ENA 0 RETURN TO INTERACTIVE MODE A3000607 RR STA- USMODE,I A3000608 RR JMP SYSNXT A3000609 RR SPC 1 A3000610 RRSYS240 ENA 0 A3000611 RR STA- FIRCNO+1,I INITIALIZE THE FILES RECORD NUMBER A3000612 RR ENQ 0 A3000613 RR RTJ+ PGLUNT RETURN INPUT TO THE TERMINAL A3000614 RR SPC 1 A3000615 RR JMP SYSTRM PROCESS THE PROCEDURE STREAM A3000616 RR EJT A3000617 RR SPC 4 A3000618 RRSYS300 RTJ LIBSCH SEARCH THE PROGRAM LIBRARY FOR THE PROGRAM A3000619 RR SAN SYS310 PROGRAM FOUND A3000620 RR SPC 1 A3000621 RR ENQ E17 INDICATE THE REQUEST CANNOT BE FOUND A3000622 RR RTJ* ERRPR2 A3000623 RR JMP SYSNXT REQUEST ANOTHER FUNCTION A3000624 RR SPC 1 A3000625 RRSYS310 LDA- TMPLEN,I A = PROGRAM LENGTH A3000626 RR RTJ SIZECK IS THE PROGRAM TOO LARGE A3000627 RR SAP SYSXIT NO A3000628 RR SPC 1 A3000629 RR ENQ E18 YES, INDICATE AN ERROR A3000630 RR RTJ* ERRPR2 A3000631 RR JMP SYSNXT REQUEST ANOTHER FUNCTION A3000632 RR SPC 1 A3000633 RR SPC 1 A3000634 RRLOGOFF ENQ E16 INDICATE ILLEGAL LOGIN. A3000635 RR ENA 0 A3000636 RR RTJ* ERRPR1 A3000637 RR JMP* EXIT GO LOG THE USER OFF A3000638 RR SPC 1 A3000639 RRSYSXIT RTJ+ PGMINT DISABLE THE PROGRAM INTERRUPT. A3000640 RR ADC ZERO A3000641 RR ADC 0 A3000642 RR SPC 1 A3000643 RR LDA MNUTMP A3000644 RR STA- MENUKY,I SET UP THE FUNCTION MENU KEY A3000645 RR SPC 1 A3000646 RR ENQ 1 SET UP THE PGMOUT REQUEST INDEX A3000647 RR RTJ+ PGMOUT RETURN CONTROL TO THE EXECUTIVE A3000648 RR EJT A3000649 RR SPC 4 A3000650 RR* E R R O R M E S S A G E P R O C E S S O R A3000651 RR SPC 2 A3000652 RRERROR RTJ CLOSE CLOSE ANY OPEN USER FILES A3000653 RR SPC 1 A3000654 RR LDQ- ERRIDX,I OBTAIN THE ERROR MESSAGE INDEX A3000655 RR LDA- ERRADD,I AND THE ADDRESS FROM THE LINKAGE BUFFER A3000656 RR RTJ* ERRPR1 PROCESS THE MESSAGE A3000657 RR SPC 1 A3000658 RR LDA+ TSNABL IS THE SYSTEM ENABLED A3000659 RR SAP ERR010 YES A3000660 RR LDA- PORTNO,I NO, IS THIS THE MASTER TERMINAL A3000661 RR SAZ ERR010 YES, CONTINUE A3000662 RR SPC 1 A3000663 RR ENQ 6 NO, DISPLAY THE 'OFF UNTIL' MESSAGE A3000664 RR RTJ MESSAG A3000665 RR JMP* EXIOFF AND LOG OFF A3000666 RR SPC 1 A3000667 RRERR010 JMP SYSERR REQUEST ANOTHER SYSTEM A3000668 RR EJT A3000669 RR SPC 4 A3000670 RR* T S L O G E R R O R M E S S A G E S U B R O U T I N E S A3000671 RR SPC 2 A3000672 RRERRPR1 NOP 0 A3000673 RR STQ* MSGNUM SAVE THE MESSAGE NUMBER A3000674 RR STA* ERRLOC AND THE MESSAGE DATA A3000675 RR SPC 1 A3000676 RR RTJ+ SYSMSG OUTPUT THE ERROR MESSAGE A3000677 RR ADC MSGNUM A3000678 RR ADC ERRLOC A3000679 RR SPC 1 A3000680 RR ENA 0 RETURN TO INTERACTIVE MODE A3000681 RR STA- USMODE,I A3000682 RR RAO- USABRT,I INDICATE A JOB ABORT A3000683 RR SPC 1 A3000684 RR JMP* (ERRPR1) RETURN A3000685 RR SPC 2 A3000686 RRERRPR2 NOP 0 A3000687 RR STQ* MSGNUM SAVE THE MESSAGE NUMBER A3000688 RR SPC 1 A3000689 RR RTJ+ SYSMSG OUTPUT THE ERROR MESSAGE A3000690 RR ADC MSGNUM A3000691 RR ADC TEMPBF A3000692 RR SPC 1 A3000693 RR ENA 0 A3000694 RR STA- USMODE,I RETURN TO INTERACTIVE MODE A3000695 RR RAO- USABRT,I INDICATE A JOB ABORT A3000696 RR SPC 1 A3000697 RR JMP* (ERRPR2) RETURN A3000698 RR SPC 2 A3000699 RRMSGNUM NUM 0 ERROR MESSAGE INDEX A3000700 RRERRLOC NUM 0 ERROR LOCATION A3000701 RR EJT A3000702 RR SPC 4 A3000703 RR* L O G - O U T P R O C E S S O R A3000704 RR SPC 2 A3000705 RREXIT RTJ ENTDAY ENTER THE USER IN THE DAY FILE A3000706 RR SPC 1 A3000707 RREXIERR RTJ GETTOD OBTAIN AND SAVE THE DATE AND TIME A3000708 RR RTJ SYSMSG OUTPUT THE LOG-OFF MESSAGE A3000709 RR ADC MSG14 A3000710 RR ADC DATIM+6 A3000711 RR SPC 1 A3000712 RREXIOFF RTJ CLOSE CLOSE ALL USER FILES A3000713 RR SPC 1 A3000714 RR ENQ 0 INDICATE A FINAL EXIT A3000715 RR RTJ+ PGMOUT RETURN CONTROL TO THE EXECUTIVE A3000716 RR EJT A3000717 RR SPC 4 A3000718 RR* L I S T A L L S T A N D A R D F U N C T I O N S A3000719 RR SPC 2 A3000720 RRLIST RTJ OPEN OPEN THE SYSTEM MENU FILE A3000721 RR ADC SYMENU A3000722 RR SPC 1 A3000723 RR ENQ 0 CLEAR THE SCREEN A3000724 RR RTJ MESSAG A3000725 RR SPC 1 A3000726 RRLIS010 RTJ+ GETS OBTAIN THE NEXT MENU RECORD A3000727 RR ADC REQBUF A3000728 RR ADC RECBUF A3000729 RR ADC ZERO A3000730 RRLISST1 ADC ISTAT1 A3000731 RR SPC 1 A3000732 RR LDA* (LISST1) IS THE FILE EMPTY A3000733 RR SAZ LIS020 NO, DISPLAY THE RECORD A3000734 RR RTJ CKSTAT YES, CHECK FOR FILE ERRORS A3000735 RR NUM $60F1 A3000736 RR NUM 3 A3000737 RR JMP* LIS030 NO ERRORS, RETURN A3000738 RR SPC 1 A3000739 RRLIS020 ENQ 5 DISPLAY THE MENU RECORD A3000740 RR RTJ MESSAG A3000741 RR JMP* LIS010 CONTINUE A3000742 RR SPC 1 A3000743 RRLIS030 RTJ+ CLOSFL CLOSE THE SYSTEM MENU FILE A3000744 RR ADC REQBUF A3000745 RR ADC ISTAT1 A3000746 RR LDA* (LISST1) A3000747 RR RTJ CKSTAT CHECK FOR FILE ERRORS A3000748 RR NUM $FFFF A3000749 RR NUM 1 A3000750 RR SPC 1 A3000751 RR JMP SYSMOD REQUEST ANOTHER FUNCTION A3000752 RR EJT A3000753 RR SPC 4 A3000754 RR* P R O C E S S A P R O G R A M C H A I N R E Q U E S T A3000755 RR SPC 2 A3000756 RRCHAIN RTJ CLOSE CLOSE ANY OPEN USER FILES A3000757 RR SPC 1 A3000758 RR ENQ 3 A3000759 RR SPC 1 A3000760 RRCHA010 LDA- CHNAME,B MOVE THE REQUESTED PROGRAM NAME A3000761 RR STA TEMPBF,Q TO THE INPUT BUFFER A3000762 RR INQ -1 A3000763 RR SQM CHA020 A3000764 RR JMP* CHA010 A3000765 RR SPC 1 A3000766 RRCHA020 LDA- MENUKY,I SET UP THE FUNCTION MENU KEY A3000767 RR STA MNUTMP A3000768 RR SPC 1 A3000769 RR JMP SYSFND CONTINUE A3000770 RR EJT A3000771 RR SPC 4 A3000772 RR* R E T R I E V E T H E P R O G R A M A3000773 RR SPC 2 A3000774 RRLIBSCH NOP 0 A3000775 RR SPC 1 A3000776 RR LDA- $C4 INITIALIZE THE PROGRAM LIBRARY SECTOR A3000777 RR SPC 1 A3000778 RRLIB010 STA* SECADD SET UP THE DIRECTORY SECTOR A3000779 RR SPC 1 A3000780 RR RTJ- (AMONI) PERFORM THE TRANSFER A3000781 RR ADC $4844 FORMATTED READ A3000782 RR ADC 0 A3000783 RR ADC 0 A3000784 RR ADC $08C2 A3000785 RRN96 ADC 96 A3000786 RR ADC BUFFER A3000787 RR ADC 0 A3000788 RRSECADD ADC 0 A3000789 RR SPC 1 A3000790 RR ENQ 85 A3000791 RRLIB020 LDA BUFFER,Q A3000792 RR SUB* TEMPBF DOES THE NAME MATCH A3000793 RR SAN LIB030 NO A3000794 RR LDA BUFFER+1,Q A3000795 RR SUB* TEMPBF+1 A3000796 RR SAN LIB030 NO A3000797 RR LDA BUFFER+2,Q A3000798 RR SUB* TEMPBF+2 A3000799 RR SAZ LIB060 YES A3000800 RR SPC 1 A3000801 RRLIB030 INQ -5 IS THE SEARCH OF THIS SECTOR COMPLETE A3000802 RR SQM LIB040 YES A3000803 RR JMP* LIB020 NO, CONTINUE A3000804 RR SPC 1 A3000805 RRLIB040 LDA BUFFER+95 OBTAIN THE NEXT DIRECTORY SECTOR A3000806 RR INA 0 IS THIS THE END A3000807 RR SAZ LIB050 YES A3000808 RR JMP* LIB010 NO, GET THE NEXT SECTOR A3000809 RR SPC 1 A3000810 RRLIB050 JMP* (LIBSCH) PROGRAM NOT FOUND, RETURN A3000811 RR EJT A3000812 RR SPC 4 A3000813 RRLIB060 LDA BUFFER+3,Q IS THE PROGRAM IN FILE FORMAT A3000814 RR SAM LIB070 YES A3000815 RR JMP* LIB030 NO, CONTINUE A3000816 RR SPC 1 A3000817 RRLIB070 LDA BUFFER+4,Q A3000818 RR STA- TMSECT+1,I SAVE THE PROGRAM SECTOR LSB A3000819 RR SPC 1 A3000820 RR LDA- ONEBIT+15 A3000821 RR STA- TMSECT+0,I SPECIFY CONTROL POINT ACCESS A3000822 RR SPC 1 A3000823 RR LDA BUFFER+3,Q A3000824 RR TCA A A3000825 RR MUI* N96 CALCULATE THE PROGRAM LENGTH A3000826 RR STA- TMPLEN,I AND SAVE A3000827 RR SPC 1 A3000828 RR ENA -1 A3000829 RR STA- TMPGMX,I SPECIFY THE PROGRAM INDEX A3000830 RR SPC 1 A3000831 RR JMP* (LIBSCH) RETURN A3000832 RR EJT A3000833 RR SPC 4 A3000834 RR* A3000835 RR* GETTOD SUBROUTINE USED TO OBTAIN THE CURRENT DATE A3000836 RR* ------ AND TIME A3000837 RR* A3000838 RR SPC 2 A3000839 RRGETTOD NOP 0 A3000840 RR SPC 1 A3000841 RR LDQ+ MONTO OBTAIN THE CURRENT MONTH A3000842 RR INQ -1 A3000843 RR QLS 1 CALCULATE THE INDEX INTO THE MONTHS TABLE A3000844 RR LDA* MONTHS,Q A3000845 RR STA* DATIM SPECIFY THE MONTH A3000846 RR LDA* MONTHS+1,Q A3000847 RR STA* DATIM+1 A3000848 RR LDQ =XYERTO A3000849 RR LDA- 2,Q A3000850 RR STA* DATIM+3 SPECIFY THE DAY A3000851 RR LDA- (ZERO),Q A3000852 RR STA* DATIM+5 SPECIFY THE YEAR A3000853 RR LDA- 3,Q A3000854 RR STA* DATIM+7 SPECIFY THE HOUR A3000855 RR LDA- 4,Q A3000856 RR STA* DATIM+9 SPECIFY THE MINUTE A3000857 RR LDA- 5,Q A3000858 RR STA* DATIM+11 SPECIFY THE SECOND A3000859 RR SPC 1 A3000860 RR JMP* (GETTOD) RETURN A3000861 RR EJT A3000862 RR SPC 4 A3000863 RR* M O N T H N A M E T A B L E A3000864 RR SPC 2 A3000865 RRMONTHS ALF $,JAN FEB MAR APR MAY JUN $ A3000866 RR ALF $,JUL AUG SEP OCT NOV DEC $ A3000867 RR EJT A3000868 RR SPC 4 A3000869 RR* D A T A C O M P A R E R O U T I N E A3000870 RR* A3000871 RR* EXIT CONDITIONS: A3000872 RR* A = 0 IF A MATCH IS FOUND. A3000873 RR* A NOT = 0 IF A MATCH IS NOT FOUND. A3000874 RR SPC 2 A3000875 RRCOMPAR NOP 0 A3000876 RR SPC 1 A3000877 RR LDQ* (COMPAR) Q = ADDRESS OF COMPARISON DATA A3000878 RR LDA* TEMPBF A3000879 RR SPC 1 A3000880 RR SUB- (ZERO),Q DOES THE 1ST WORD MATCH A3000881 RR SAN COM010 NO A3000882 RR LDA* TEMPBF+1 A3000883 RR SUB- 1,Q DOES THE 2ND WORD MATCH A3000884 RR SAN COM010 NO A3000885 RR LDA* TEMPBF+2 A3000886 RR SUB- 2,Q DOES THE 3RD WORD MATCH A3000887 RR SAN COM010 NO A3000888 RR LDA* TEMPBF+3 A3000889 RR SUB- 3,Q DOES THE 4TH WORD MATCH A3000890 RR SPC 1 A3000891 RRCOM010 RAO* COMPAR A3000892 RR JMP* (COMPAR) RETURN A3000893 RR EJT A3000894 RR SPC 4 A3000895 RR* I N P U T F O R M A T S U B R O U T I N E A3000896 RR SPC 2 A3000897 RRINPUT NOP 0 A3000898 RR SPC 1 A3000899 RR ENA 0 A3000900 RR STA* INPTMP INITIALIZE THE RETURN PARAMETER A3000901 RR SPC 1 A3000902 RR LDQ* INPLEN OBTAIN THE NUMBER OF CHARACTERS A3000903 RR LRS 1 WERE AN EVEN NUMBER ENTERED A3000904 RR SAP INP010 YES A3000905 RR SPC 1 A3000906 RR LDA* TEMPBF,Q NO A3000907 RR AND- NZERO+8 A3000908 RR INA SPACE MERGE A BLANK A3000909 RR STA* TEMPBF,Q A3000910 RR INQ 1 A3000911 RR SPC 1 A3000912 RRINP010 STQ* INPTMP Q = NUMBER OF WORDS INPUT A3000913 RR SPC 1 A3000914 RRINP020 LDA =A BLANK FILL THE REMAINDER OF THE INPUT A3000915 RR STA* TEMPBF,Q A3000916 RR INQ 1 A3000917 RR TRQ A A3000918 RR INA -TMBFSZ A3000919 RR SAP INP040 A3000920 RR JMP* INP020 A3000921 RR SPC 1 A3000922 RRINP040 LDQ* INPTMP Q = NUMBER OF WORDS ENTERED A3000923 RR JMP* (INPUT) RETURN A3000924 RR SPC 2 A3000925 RRINPTMP NUM 0 TEMPORARY STORAGE - NUMBER OF INPUT WORDS A3000926 RR EJT A3000927 RR SPC 4 A3000928 RR* D A T A A N D S T O R A G E A3000929 RR SPC 2 A3000930 RRTEMPBF BZS TEMPBF(9) TEMPORARY STORAGE OF INPUT DATA A3000931 RR EQU TMBFSZ(*-TEMPBF) A3000932 RRINPLEN NUM 0 NUMBER OF INPUT CHARACTERS A3000933 RR SPC 2 A3000934 RRDATIM BZS DATIM(12) TEMPORARY STORAGE OF DATE AND TIME A3000935 RR SPC 4 A3000936 RR* S Y S T E M F I L E P A R A M E T E R S A3000937 RR SPC 2 A3000938 RRPGMNAM ALF 4,$$PGMNAM OPEN FILE DATA - PROGRAM NAME FILE A3000939 RR ADC 1 INDEXED FILE A3000940 RRPRODIR ALF 4,$$PROCED OPEN FILE DATA - PROCEDURE DIRECTORY FILE A3000941 RR ADC 1 INDEXED FILE A3000942 RRSYMENU ALF 4,$$SYMENU OPEN FILE DATA - SYSTEM MENU FILE A3000943 RR ADC 0 SEQUENTIAL FILE A3000944 RRDAYFIL ALF 4,$$DAYFIL OPEN FILE DATA - DAY FILE A3000945 RR ADC 0 SEQUENTIAL FILE A3000946 RRUSRIDN ALF 4,$$USERID OPEN FILE DATA - USER IDENTIFICATION FILE A3000947 RR ADC 1 INDEXED FILE. A3000948 RR EJT A3000949 RR SPC 4 A3000950 RR* A3000951 RR* ENTDAY SUBROUTINE USED TO PLACE AN ENTRY IN THE A3000952 RR* ------ DAYFILE A3000953 RR* A3000954 RR SPC 2 A3000955 RRENTDAY NOP 0 A3000956 RR SPC 1 A3000957 RR LDA* DAYFLG HAS THE DAYFILE ALREADY BEEN UPDATED A3000958 RR SAN ENT010 YES A3000959 RR LDQ- ULUSTB,I NO A3000960 RR LDA- USERID,Q HAS THE USER LOGGED IN YET A3000961 RR SAZ ENT010 NO, RETURN A3000962 RR LDA- PGMIDX,I WAS TSLOG ABORTED A3000963 RR SAN ENT015 NO, CONTINUE A3000964 RR SPC 1 A3000965 RRENT010 JMP* (ENTDAY) YES, RETURN A3000966 RR SPC 1 A3000967 RRENT015 RAO* DAYFLG A3000968 RR SPC 1 A3000969 RR ENQ DATIME OBTAIN THE ADDRESS OF THE DATE-TIME A3000970 RR LDA- 1,B A3000971 RR SAN ENT020 A3000972 RR JMP* ENT070 NO TIME HAS BEEN SET UP A3000973 RR SPC 1 A3000974 RRENT020 STA* RECBUF+4 SAVE THE MONTH OF LOG-IN A3000975 RR LDA- 2,B A3000976 RR STA* RECBUF+5 SAVE THE DAY OF LOG-IN A3000977 RR LDA- (ZERO),B A3000978 RR STA* RECBUF+6 SAVE THE YEAR OF LOG-IN A3000979 RR LDA- 3,B A3000980 RR STA* RECBUF+7 SAVE THE HOUR OF LOG-IN A3000981 RR LDA- 4,B A3000982 RR STA* RECBUF+8 SAVE THE MINUTE OF LOG-IN A3000983 RR LDA- 5,B A3000984 RR STA* RECBUF+9 SAVE THE SECOND OF LOG-IN A3000985 RR SPC 1 A3000986 RR LDA* RECBUF+6 A3000987 RR ARS 2 CHECK FOR LEAP YEAR A3000988 RR ALS 2 A3000989 RR TCA A A3000990 RR ADD* RECBUF+6 A3000991 RR SAZ ENT030 A3000992 RR RAO* MONTAB+1 LEAP YEAR, CHANGE FEBRUARY TO 29 A3000993 RR EJT A3000994 RRENT030 LDA+ YERTO A3000995 RR SUB* RECBUF+6 CALCULATE THE YEAR INCREMENT A3000996 RR MUI* N12 CONVERT TO MONTHS A3000997 RR ADD+ MONTO A3000998 RR SUB* RECBUF+4 CALCULATE THE MONTH INCREMENT A3000999 RR LDQ* RECBUF+4 A3001000 RR MUI* MONTAB-1,Q CONVERT TO DAYS A3001001 RR ADD+ DAYTO A3001002 RR SUB* RECBUF+5 CALCULATE THE DAY INCREMENT A3001003 RR MUI* N24 CONVERT TO HOURS A3001004 RR ADD+ HORTO A3001005 RR SUB* RECBUF+7 CALCULATE THE HOUR INCREMENT A3001006 RR MUI* N60 CONVERT TO MINUTES A3001007 RR ADD+ MINTO A3001008 RR SUB* RECBUF+8 CALCULATE THE MINUTES INCREMENT A3001009 RR MUI- TEN CONVERT TO TENTHS OF MINUTES A3001010 RR STA* RECBUF+10 SAVE THE CONNECT TIME A3001011 RR SPC 1 A3001012 RR LDA+ SECON A3001013 RR SUB* RECBUF+9 IS THE SECONDS DIFFERENTIAL NEGATIVE A3001014 RR SAP ENT040 NO A3001015 RR STA* NEGSEC YES, SET INDICATOR A3001016 RR TCA A A3001017 RR SPC 1 A3001018 RRENT040 CLR Q A3001019 RR DVI- SIX CONVERT TO TENTHS OF MINUTES A3001020 RR INQ -3 IS ROUNDING REQUIRED A3001021 RR SQM ENT050 NO A3001022 RR SPC 1 A3001023 RR INA 1 YES A3001024 RRENT050 LDQ* NEGSEC WAS THE DIFFERENTIAL NEGATIVE A3001025 RR SQP ENT060 NO A3001026 RR SPC 1 A3001027 RR TCA A YES A3001028 RRENT060 ADD* RECBUF+10 INCLUDE SECONDS IN THE CONNECT TIME A3001029 RR SAP ENT070 A3001030 RR LDA- LPMASK+15 INVALID TIME, SET IT TO THE MAXIMUM A3001031 RR SPC 1 A3001032 RRENT070 STA* RECBUF+10 SAVE THE CONNECT TIME IN THE DAYFILE A3001033 RR EJT A3001034 RR SPC 4 A3001035 RR LDQ- ULUSTB,I OBTAIN THE USER TABLE ADDRESS A3001036 RR LDA- USERID,Q A3001037 RR STA* RECBUF+0 A3001038 RR LDA- USERID+1,Q A3001039 RR STA* RECBUF+1 SAVE THE USER NUMBER IN THE DAYFILE A3001040 RR LDA- USERID+2,Q A3001041 RR STA* RECBUF+2 A3001042 RR LDA- USERID+3,Q A3001043 RR STA* RECBUF+3 A3001044 RR SPC 1 A3001045 RR LDA- PORTNO,I A3001046 RR STA* RECBUF+11 SAVE THE TERMINAL NUMBER IN THE DAYFILE A3001047 RR SPC 1 A3001048 RR LDA- PGMIDX,I A3001049 RR STA* RECBUF+12 SAVE THE PROGRAM NUMBER IN THE DAYFILE A3001050 RR SPC 1 A3001051 RR RTJ OPEN OPEN THE DAYFILE A3001052 RR ADC DAYFIL A3001053 RR SPC 1 A3001054 RR RTJ+ PUTS ENTER THE USER'S RECORD IN THE DAYFILE A3001055 RR ADC REQBUF A3001056 RR ADC RECBUF A3001057 RR ADC ONE A3001058 RR ADC ISTAT1 A3001059 RR SPC 1 A3001060 RR RTJ+ CLOSFL CLOSE THE DAY FILE A3001061 RR ADC REQBUF A3001062 RR ADC ISTAT1 A3001063 RR SPC 1 A3001064 RR JMP* (ENTDAY) RETURN A3001065 RR EJT A3001066 RR SPC 4 A3001067 RR* D A Y F I L E U P D A T E D A T A A N D S T O R A G E A3001068 RR SPC 2 A3001069 RRN12 NUM 12 A3001070 RRN24 NUM 24 A3001071 RRN60 NUM 60 A3001072 RRNEGSEC NUM 0 SECONDS DIFFERENTIAL INDICATOR A3001073 RRDAYFLG NUM 0 DAYFILE UPDATE FLAG A3001074 RR SPC 1 A3001075 RRMONTAB NUM 31 JANUARY A3001076 RR NUM 28 FEBRUARY A3001077 RR NUM 31 MARCH A3001078 RR NUM 30 APRIL A3001079 RR NUM 31 MAY A3001080 RR NUM 30 JUNE A3001081 RR NUM 31 JULY A3001082 RR NUM 31 AUGUST A3001083 RR NUM 30 SEPTEMBER A3001084 RR NUM 31 OCTOBER A3001085 RR NUM 30 NOVEMBER A3001086 RR NUM 31 DECEMBER A3001087 RR SPC 4 A3001088 RR* G E N E R A L D A T A B U F F E R A3001089 RR SPC 2 A3001090 RRBUFFER BZS BUFFER(96) A3001091 RR EQU RECBUF(BUFFER+00) A3001092 RR EQU REQBUF(BUFFER+42) A3001093 RR EQU FCBUFF(BUFFER+66) A3001094 RR EJT A3001095 RR SPC 4 A3001096 RR* A3001097 RR* SIZECK SUBROUTINE USED TO DETERMINE THAT THE A3001098 RR* ------ REQUESTED PROGRAM WILL FIT IN A3001099 RR* THE USER AREA A3001100 RR* A3001101 RR SPC 2 A3001102 RRSIZECK NOP 0 A3001103 RR SPC 1 A3001104 RR ADD =XLULBUF INCLUDE THE SIZE OF THE LINKAGE BUFFER A3001105 RR STA* SIZELN SAVE THE LENGTH A3001106 RR SPC 1 A3001107 RR LDQ =XPARTBL A3001108 RR LDA- 3,Q A3001109 RR SUB- 1,Q CALCULATE THE SIZE OF THE USER AREA A3001110 RR SPC 1 A3001111 RR EOR* SIZELN ARE THE SIGNS ALIKE A3001112 RR SAP SIZ010 YES A3001113 RR SPC 1 A3001114 RR LDA* SIZELN NO, THE SIGN OF SIZELN GIVES THE RELATIONSHIP A3001115 RR JMP* (SIZECK) A3001116 RR SPC 1 A3001117 RRSIZ010 EOR* SIZELN RESTORE THE AREA SIZE A3001118 RR SUB* SIZELN CALCULATE THE DIFFERENCE A3001119 RR JMP* (SIZECK) RETURN A3001120 RR SPC 2 A3001121 RRSIZELN ADC 0 PROGRAM LENGTH A3001122 RR EJT A3001123 RR* O P E N F I L E S U B R O U T I N E A3001124 RR SPC 2 A3001125 RROPEN NOP 0 A3001126 RR LDA* (OPEN) A3001127 RR STA* OPNXFR SET UP THE FILE DATA ADDRESS A3001128 RR SPC 1 A3001129 RR ENQ 23 A3001130 RR ENA 0 A3001131 RROPN010 STA* REQBUF,Q INITIALIZE THE REQUEST BUFFER A3001132 RR DQP *-OPN010 A3001133 RR SPC 1 A3001134 RROPN020 LDA =XFCBUFF A3001135 RR STA* REQBUF+9 SPECIFY THE FCB ADDRESS A3001136 RR SPC 1 A3001137 RR ENQ 3 A3001138 RROPN030 LDA* (OPNXFR),Q MOVE THE FILE INFORMATION INTO IDATA A3001139 RR STA* IDATA,Q A3001140 RR DQP *-OPN030 A3001141 RR SPC 1 A3001142 RROPN040 LDQ* OPNXFR A3001143 RR LDA- 4,Q A3001144 RR STA* IDATA+12 SPECIFY THE ACCESS TYPE A3001145 RR SAZ OPN060 SKIP IF THIS IS A SEQUENTIAL FILE A3001146 RR ENQ 3 A3001147 RROPN050 LDA TEMPBF,Q MOVE THE KEYVALUE A3001148 RR STA* KEYVAL,Q A3001149 RR DQP *-OPN050 A3001150 RR SPC 1 A3001151 RROPN060 RTJ+ OPENFL OPEN THE REQUESTED FILE A3001152 RR ADC REQBUF A3001153 RR ADC IDATA A3001154 RROPNST1 ADC ISTAT1 A3001155 RR LDA* (OPNST1) A3001156 RR RTJ CKSTAT CHECK FOR FILE ERRORS A3001157 RR NUM $FC27 A3001158 RR NUM 0 A3001159 RR SPC 1 A3001160 RR RAO* OPEN A3001161 RR JMP* (OPEN) RETURN A3001162 RR SPC 2 A3001163 RROPNXFR ADC 0 FILE DATA SOURCE ADDRESS A3001164 RR EJT A3001165 RR SPC 4 A3001166 RR* F I L E R E Q U E S T I D A T A A R R A Y A3001167 RR SPC 2 A3001168 RRERSTAT ADC 0 FILE ERROR MESSAGE STATUS A3001169 RRIDATA ALF 4, FILE NAME A3001170 RR ALF 4,$$ OWNER NAME A3001171 RR ALF 4,SYSVOL VOLUME NAME A3001172 RR ADC 0 ACCESS TYPE A3001173 RR ADC 1 NUMBER OF RECORDS A3001174 RR ADC 0 RECORD LOCK INDICATOR A3001175 RR SPC 1 A3001176 RRKEYVAL NUM 0,0,0,0 INDEXED FILE KEY VALUE A3001177 RR EJT A3001178 RR SPC 4 A3001179 RR* F O R C E F I L E C L O S E S U B R O U T I N E A3001180 RR SPC 2 A3001181 RRCLOSE NOP 0 A3001182 RR SPC 1 A3001183 RR ENQ 23 A3001184 RR ENA 0 A3001185 RRCLO010 STA REQBUF,Q INITIALIZE THE REQUEST BUFFER A3001186 RR INQ -1 A3001187 RR SQM CLO020 A3001188 RR JMP* CLO010 A3001189 RR SPC 1 A3001190 RRCLO020 LDA- ULUSTB,I A3001191 RR STA REQBUF+14 SPECIFY THE USER IDENTIFICATION A3001192 RR SPC 1 A3001193 RR RTJ+ FCLOSE PERFORM THE FORCE CLOSE A3001194 RR ADC REQBUF A3001195 RRCLOST1 ADC ISTAT1 A3001196 RR LDA* (CLOST1) A3001197 RR RTJ CKSTAT CHECK FOR FILE ERRORS A3001198 RR NUM $FFFF A3001199 RR NUM 4 A3001200 RR SPC 1 A3001201 RR JMP* (CLOSE) RETURN A3001202 RR EJT A3001203 RR SPC 4 A3001204 RR* U S E R I D F I L E P R O C E S S O R A3001205 RR* A3001206 RR* EXIT CONDITIONS: A3001207 RR* A = 0 IF USER ID IS VALID FOR THIS TERMINAL NUMBER. A3001208 RR* LOKNAM IN THE LINKAGE BUFFER GETS PLUGGED A3001209 RR* WITH THE FORCED NAME FROM THE $$USERID FILE A3001210 RR* RECORD FOR THIS USER AND TERMINAL. LOKLEN GETS A3001211 RR* PLUGGED WITH THE NUMBER OF NON BLANK CHARACTERS IN A3001212 RR* THE NAME. A3001213 RR* A3001214 RR* A NOT =0 IF USER ID NOT VALID ON THIS TERMINAL. A3001215 RR* A3001216 RR SPC 2 A3001217 RRUSRFIL NOP 0 A3001218 RR SPC 1 A3001219 RR LDA MESG03+6 MOVE THE TERMINAL NUMBER IN ASCII TO A3001220 RR STA TEMPBF+4 THE INPUT BUFFER. A3001221 RR ENQ 4 A3001222 RRUSR002 LDA TEMPBF,Q A3001223 RR STA* USRNUM,Q MOVE THE USER ID AND THE TERMINAL NUMBER A3001224 RR DQP *-USR002 A3001225 RR SPC 1 A3001226 RR RTJ OPEN OPEN THE USER IDENTIFICATION FILE A3001227 RR ADC USRIDN A3001228 RR SPC 1 A3001229 RR SPC 1 A3001230 RR RTJ+ READR OBTAIN THIS TERMINAL'S RECORD A3001231 RR ADC REQBUF A3001232 RR ADC RECBUF A3001233 RR ADC USRNUM CONTAINS USER ID AND ASCII TERMINAL NUMBER. A3001234 RRUSRST1 ADC ISTAT1 A3001235 RR SPC 1 A3001236 RR LDA* (USRST1) A3001237 RR AND- ONEBIT+8 IS THIS THE END OF FILE. A3001238 RR SAZ USR015 NO A3001239 RR JMP* USR040 YES, INDICATE THE USER ID WAS NOT FOUND A3001240 RRUSR015 LDA* (USRST1) A = REQUEST STATUS. A3001241 RR AND- ONEBIT+9 A3001242 RR SAZ USR020 SKIP IF THE CORRECT RECORD WAS RETRIVED. A3001243 RR JMP* USR040 ILLEGAL USER ID FOR THIS TERMINAL. A3001244 RR SPC 1 A3001245 RRUSR020 LDA* (USRST1) A = REQUEST STATUS. A3001246 RR RTJ CKSTAT CHECK FOR FILE ERRORS A3001247 RR NUM $E0F4 A3001248 RR NUM 2 A3001249 RR SPC 1 A3001250 RR* A3001251 RR* THIS USER MAY LOG ONTO THIS TERMINAL. A3001252 RR* A3001253 RR ENQ 3 A3001254 RRUSR025 LDA RECBUF+6,Q A3001255 RR STA- LOKNAM,B MOVE THE FORCED PROGRAM REQUEST INTO THE A3001256 RR DQP *-USR025 LINKAGE BUFFER. A BLANK NAME MEANS THAT A3001257 RR* THIS TERMINAL WILL NOT BE FORCED TO A GIVEN A3001258 RR* PROGRAM. THE OPERATOR WILL BE GIVEN THE A3001259 RR* REQUEST = QUERY. A3001260 RR SPC 2 A3001261 RR ENQ 0 A3001262 RRUSR030 LCA RECBUF+6,Q COUNT THE NUMBER OF NON BLANK CHARACTERS A3001263 RR INA -$20 IN LOKNAM. THE NAME, IF IT EXISTS, IS A3001264 RR SAZ USR035 ASSUMED TO BE LEFT JUSTIFIED IN THE FIELD, A3001265 RR INQ -7 WITH BLANK FILL. THE NAME IS A MAXIMUM OF A3001266 RR SQZ USR034 8 CHARACTERS LONG. A3001267 RR INQ 8 A3001268 RR JMP* USR030 A3001269 RRUSR034 ENQ 8 A3001270 RRUSR035 STQ- LOKLEN,I A3001271 RR CLR A A3001272 RR SPC 1 A3001273 RRUSR040 STA* USRNUM SAVE THE EXIT PARAMETER. A3001274 RR SPC 1 A3001275 RR RTJ+ CLOSFL CLOSE THE USER IDENTIFICATION FILE A3001276 RR ADC REQBUF A3001277 RR ADC ISTAT1 A3001278 RR SPC 1 A3001279 RR LDA* (USRST1) A3001280 RR RTJ CKSTAT CHECK FOR FILE ERRORS A3001281 RR NUM $FFFF A3001282 RR NUM 1 A3001283 RR SPC 1 A3001284 RR LDA* USRNUM A = RETURN PARAMETER. A3001285 RR JMP* (USRFIL) RETURN A3001286 RR SPC 2 A3001287 RRUSRNUM BZS USRNUM(5) USER ID AND TERMINAL NUMBER IN ASCII. A3001288 RR EJT A3001289 RR SPC 4 A3001290 RR* I N P U T - O U T P U T E Q U A L P R O C E S S O R A3001291 RR SPC 2 A3001292 RRIOEQAL NOP 0 A3001293 RR SPC 1 A3001294 RR ENA 0 A3001295 RR STA* IOMODE INITIALIZE THE REQUEST MODE A3001296 RR SPC 1 A3001297 RR LDA TEMPBF A3001298 RR SUB =AIN WAS 'INPUT = ' REQUESTED A3001299 RR SAZ IOE010 YES A3001300 RR SPC 1 A3001301 RR RAO* IOMODE NO A3001302 RR LDA TEMPBF A3001303 RR SUB =AOU WAS 'OUTPUT = ' REQUESTED A3001304 RR SAZ IOE010 YES A3001305 RR JMP* (IOEQAL) NO, RETURN A3001306 RR SPC 1 A3001307 RRIOE010 ENQ 0 Q = CHARACTER PICKUP INDEX A3001308 RR ENA EQUAL A = DESIRED DELIMITER A3001309 RR RTJ* SCANBF SEARCH FOR THE CHARACTER A3001310 RR SAP IOE020 A3001311 RR SPC 1 A3001312 RR JMP* (IOEQAL) END OF BUFFER, RETURN A3001313 RR EJT A3001314 RR SPC 4 A3001315 RRIOE020 ENA 0 A3001316 RR STA- I A3001317 RR SPC 1 A3001318 RRIOE030 LCA* (IOEBUF),Q RE-POSITION THE DEVICE NAME A3001319 RR SCA* (IOEBUF),I A3001320 RR INQ 1 A3001321 RR RAO- I A3001322 RR LDA- I A3001323 RR INA -8 IS THE MOVE COMPLETE A3001324 RR SAP IOE040 YES A3001325 RR JMP* IOE030 NO, CONTINUE A3001326 RR SPC 1 A3001327 RRIOE040 LDA+ TSAREA RESTORE THE I-REGISTER A3001328 RR STA- I A3001329 RR LDA* IOMODE IS THE REQUEST FOR 'INPUT = ' A3001330 RR SAN IOE050 NO A3001331 RR SPC 1 A3001332 RR RTJ+ INPEQ PERFORM THE REQUEST A3001333 RRIOEBUF ADC TEMPBF A3001334 RRIOEST1 ADC ISTAT1 A3001335 RR JMP* IOE060 A3001336 RR SPC 1 A3001337 RRIOE050 RTJ+ OUTEQ PERFORM THE REQUEST A3001338 RR ADC TEMPBF A3001339 RR ADC ISTAT1 A3001340 RR SPC 1 A3001341 RRIOE060 LDA* (IOEST1) WAS THE REQUEST ACCEPTED A3001342 RR SAN IOE070 NO A3001343 RR JMP* (IOEQAL) YES, RETURN A3001344 RR SPC 1 A3001345 RRIOE070 ENQ E17 INDICATE THE NAME CANNOT BE FOUND A3001346 RR RTJ ERRPR2 A3001347 RR JMP SYSNXT REQUEST ANOTHER FUNCTION A3001348 RR SPC 2 A3001349 RRIOMODE NUM 0 TEMPORARY STORAGE - REQUEST MODE A3001350 RR EJT A3001351 RR SPC 4 A3001352 RRSCANBF NOP 0 A3001353 RR STA* DELIMT SAVE THE REQUESTED DELIMITER A3001354 RR SPC 1 A3001355 RRSCA010 LCA* (IOEBUF),Q A3001356 RR SUB* DELIMT A3001357 RR SPC 1 A3001358 RRSCA020 INQ 1 A3001359 RR SAZ SCA030 SKIP IF THE DELIMITER IS FOUND A3001360 RR TRQ A A3001361 RR INA -TMBFSZ*2 IS THE END OF BUFFER REACHED A3001362 RR SAP SCA040 YES, RETURN WITH ERROR A3001363 RR JMP* SCA010 CONTINUE A3001364 RR SPC 1 A3001365 RRSCA030 LCA* (IOEBUF),Q A3001366 RR INA -SPACE A3001367 RR SAN SCA050 SCAN COMPLETE, RETURN A3001368 RR JMP* SCA020 IGNORE BLANKS IN THE BUFFER A3001369 RR SPC 1 A3001370 RRSCA040 ENA -1 INDICATE THE DELIMITER WAS NOT FOUND A3001371 RRSCA050 JMP* (SCANBF) RETURN A3001372 RR SPC 2 A3001373 RRDELIMT NUM 0 TEMPORARY STORAGE - REQUESTED DELIMITER A3001374 RR EJT A3001375 RR SPC 4 A3001376 RR* F I L E E R R O R S T A T U S S U B R O U T I N E A3001377 RR SPC 2 A3001378 RRCKSTAT NOP 0 A3001379 RR SPC 1 A3001380 RR STA ERSTAT SAVE THE FILE STATUS IN CASE OF ERROR A3001381 RR AND* (CKSTAT) COMPARE THE STATUS TO THE ERROR MASK A3001382 RR RAO* CKSTAT A3001383 RR SAZ CKS010 NO FILE ERRORS A3001384 RR SPC 1 A3001385 RR LDQ* (CKSTAT) A3001386 RR LDA* MSGREC,Q OBTAIN THE SYSTEM MESSAGE RECORD A3001387 RR STA* CKSPAR SAVE A3001388 RR SPC 1 A3001389 RR RTJ+ SYSMSG DISPLAY THE FILE ERROR MESSAGE A3001390 RR ADC CKSPAR A3001391 RR ADC ERSTAT A3001392 RR SPC 1 A3001393 RR ENA 0 RETURN TO INTERACTIVE MODE A3001394 RR STA- USMODE,I A3001395 RR JMP EXIERR LOG THE USER OFF A3001396 RR SPC 1 A3001397 RRCKS010 RAO* CKSTAT A3001398 RR JMP* (CKSTAT) RETURN A3001399 RR SPC 2 A3001400 RRCKSPAR ADC 0 ERROR MESSAGE INDEX A3001401 RR SPC 1 A3001402 RRMSGREC ADC E19 00 - OPENFL ERROR A3001403 RR ADC E20 01 - CLOSFL ERROR A3001404 RR ADC E21 02 - READR ERROR A3001405 RR ADC E22 03 - GETS ERROR A3001406 RR ADC E23 04 - FFCLOS ERROR A3001407 RR EJT A3001408 RR* S Y S T E M M E N U F I L E P R O C E S S O R A3001409 RR SPC 2 A3001410 RRPRMENU NOP 0 A3001411 RR SPC 1 A3001412 RR RTJ OPEN OPEN THE SYSTEM MENU FILE A3001413 RR ADC SYMENU A3001414 RR SPC 1 A3001415 RRPRM010 RTJ+ GETS OBTAIN THE NEXT MENU RECORD A3001416 RR ADC REQBUF A3001417 RRPRECBF ADC RECBUF A3001418 RR ADC ZERO A3001419 RRPRMST1 ADC ISTAT1 A3001420 RR SPC 1 A3001421 RR LDA* (PRMST1) IS THE FILE EMPTY A3001422 RR SAZ PRM020 NO A3001423 RR RTJ CKSTAT CHECK FOR FILE ERRORS A3001424 RR NUM $60F1 A3001425 RR NUM 3 A3001426 RR JMP* PRM050 NO ERRORS, RETURN A3001427 RR SPC 1 A3001428 RRPRM020 ENQ 5 A3001429 RR LDA* (PRECBF),Q A3001430 RR SUB TEMPBF DOES THE MENU KEY MATCH A3001431 RR SAZ PRM030 YES A3001432 RR JMP* PRM010 NO, CONTINUE A3001433 RR SPC 1 A3001434 RRPRM030 LDA* (PRECBF),Q SAVE THE REQUESTED MENU KEY A3001435 RR STA MNUTMP SAVE THE REQUESTED MENU KEY A3001436 RR ENQ 3 A3001437 RRPRM040 LDA* (PRECBF),Q MOVE THE MENU PROGRAM NAME A3001438 RR STA TEMPBF,Q TO THE INPUT BUFFER A3001439 RR INQ -1 A3001440 RR SQM PRM050 A3001441 RR JMP* PRM040 A3001442 RR SPC 1 A3001443 RRPRM050 RTJ+ CLOSFL CLOSE THE SYSTEM MENU FILE A3001444 RR ADC REQBUF A3001445 RR ADC ISTAT1 A3001446 RR LDA* (PRMST1) A3001447 RR RTJ CKSTAT CHECK FOR FILE ERRORS A3001448 RR NUM $FFFF A3001449 RR NUM 1 A3001450 RR SPC 1 A3001451 RR JMP* (PRMENU) RETURN A3001452 RR EJT A3001453 RR SPC 4 A3001454 RR* G E T P R O C E D U R E R E C O R D S U B R O U T I N E A3001455 RR SPC 2 A3001456 RRGETREC NOP 0 A3001457 RR SPC 1 A3001458 RR LDQ- RQINPT,I A3001459 RR STQ* GERINP SAVE THE CURRENT INPUT DEVICE A3001460 RR SPC 1 A3001461 RR ENQ 0 SPECIFY THE PROCEDURE DEVICE A3001462 RR RTJ+ PGLUNT A3001463 RR SPC 1 A3001464 RR RTJ- (AMONI) READ THE NEXT PROCEDURE RECORD A3001465 RR ADC $4844 A3001466 RR ADC GER010 A3001467 RR ADC 0 A3001468 RR ADC $1000 A3001469 RR ADC 40 A3001470 RR ADC BUFFER A3001471 RR JMP- (ADISP) A3001472 RR SPC 1 A3001473 RRGER010 LDA* GERINP A3001474 RR STQ* GERINP SAVE THE COMPLETION PARAMETER A3001475 RR SPC 1 A3001476 RR SQP GER020 SKIP IF NO TERMINATION A3001477 RR ENA 0 RETURN TO INTERACTIVE INPUT A3001478 RR SPC 1 A3001479 RRGER020 ENQ 0 RESTORE THE INPUT DEVICE A3001480 RR RTJ+ PGLUNT A3001481 RR SPC 1 A3001482 RR ENA -1 A3001483 RR LDQ* GERINP A3001484 RR SQP GER030 NO END-OF-FILE OR ERROR A3001485 RR ENA 0 INDICATE A TERMINATION A3001486 RR SPC 1 A3001487 RRGER030 JMP* (GETREC) RETURN A3001488 RR SPC 2 A3001489 RRGERINP NUM 0 TEMPORARY STORAGE A3001490 RR EJT A3001491 RR SPC 4 A3001492 RRIOFILE NOP 0 A3001493 RR SPC 1 A3001494 RR LDA- RQINPT,I IS A FILE SPECIFIED AS THE INPUT DEVICE A3001495 RR SAM IOF010 YES A3001496 RR LDA- USMODE,I NO, IS PROCEDURE MODE IN EFFECT A3001497 RR SAZ IOF020 NO, CONTINUE A3001498 RR SPC 1 A3001499 RRIOF010 LDA =XFINAME A3001500 RR ADD- I SPECIFY THE FILE NAME A3001501 RR STA* IOFPR1 A3001502 RR SPC 1 A3001503 RR RTJ+ INPEQ OPEN AND POSITION THE FILE A3001504 RRIOFPR1 ADC 0 A3001505 RR ADC ISTAT1 A3001506 RR SPC 1 A3001507 RR LDA- USMODE,I IS PROCEDURE MODE IN EFFECT A3001508 RR SAZ IOF020 NO, CONTINUE A3001509 RR CLR A,Q YES, SPECIFY TERMINAL INPUT A3001510 RR RTJ+ PGLUNT A3001511 RR SPC 1 A3001512 RRIOF020 LDA- RQOUTP,I IS THE OUTPUT DEVICE A FILE A3001513 RR SAP IOF030 NO A3001514 RR SPC 1 A3001515 RR LDA =XFONAME A3001516 RR ADD- I SPECIFY THE FILE NAME A3001517 RR STA* IOFPR2 A3001518 RR SPC 1 A3001519 RR RTJ+ OUTEQ OPEN THE FILE A3001520 RRIOFPR2 ADC 0 A3001521 RR ADC ISTAT2 A3001522 RR SPC 1 A3001523 RRIOF030 JMP* (IOFILE) RETURN A3001524 RR EJT A3001525 RR SPC 4 A3001526 RR* O U T P U T M E S S A G E P R O C E S S O R A3001527 RR SPC 2 A3001528 RRMESSAG NOP 0 A3001529 RR SPC 1 A3001530 RR LDA* MESADD,Q A3001531 RR STA* MESA SAVE THE MESSAGE ADDRESS A3001532 RR LDQ* MESLEN,Q A3001533 RR SPC 1 A3001534 RRMES010 INQ -1 A3001535 RR SQM MES020 A3001536 RR LDA* (MESA),Q A3001537 RR SUB =A IS THIS THE END OF THE TEXT A3001538 RR SAN MES020 YES A3001539 RR JMP* MES010 NO, CONTINUE A3001540 RR SPC 1 A3001541 RRMES020 INQ 1 A3001542 RR QLS 1 A3001543 RR STQ* MESL SAVE THE MESSAGE LENGTH A3001544 RR SPC 1 A3001545 RR RTJ- (AMONI) A3001546 RR ADC $4C44 FORMATTED WRITE REQUEST A3001547 RR ADC 0 A3001548 RR ADC 0 A3001549 RR ADC TERMLU A3001550 RRMESL ADC 0 A3001551 RRMESA ADC 0 A3001552 RR SPC 1 A3001553 RR JMP* (MESSAG) RETURN A3001554 RR SPC 2 A3001555 RRMESADD ADC MESG00 00 A3001556 RR ADC MESG01 01 A3001557 RR ADC SYSID 02 A3001558 RR ADC MESG03 03 A3001559 RR ADC BUFFER 04 A3001560 RR ADC RECBUF+4 05 A3001561 RR ADC TSOFFM 06 A3001562 RR SPC 1 A3001563 RRMESLEN ADC LMES00 00 A3001564 RR ADC LMES01 01 A3001565 RR ADC 16 02 A3001566 RR ADC LMES03 03 A3001567 RR ADC 36 04 A3001568 RR ADC 32 05 A3001569 RR ADC TSLOFF 06 A3001570 RR EJT A3001571 RR SPC 4 A3001572 RR* M E S S A G E S A3001573 RR SPC 2 A3001574 RRMESG00 ADC $1800 A3001575 RR EQU LMES00(*-MESG00) A3001576 RR SPC 2 A3001577 RRMESG01 ALF $,CDC CYBER-18 C C S SYSTEM - VER 3.0$ A3001578 RR EQU LMES01(*-MESG01) A3001579 RR SPC 2 A3001580 RRMESG03 ALF $,TERMINAL = XX$ A3001581 RR EQU LMES03(*-MESG03) A3001582 RR EJT A3001583 RR SPC 4 A3001584 RRWTRD01 ALF $,:L:RPASSWORD = $ A3001585 RR NUM $8000 A3001586 RR EQU LWTR01(*-WTRD01) A3001587 RR SPC 2 A3001588 RRWTRD02 ALF $,:L:RUSER ID. = $ A3001589 RR NUM $8000 A3001590 RR EQU LWTR02(*-WTRD02) A3001591 RR SPC 2 A3001592 RRWTRD03 ALF $,:L:RREQUEST = $ A3001593 RR EQU LWTR03(*-WTRD03) A3001594 RR SPC 2 A3001595 RR END A3001596 RR NAM IOLUNT A31 A ITOS CCS 3.0 SL-149A3100001 RR* USER PROGRAM I/O DEVICE PROCESSOR A3100002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 A3100003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A3100004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 A3100005 RR* A3100006 RR SPC 2 A3100007 RR ENT INPEQ USER DEFINED INPUT DEVICE A3100008 RR ENT OUTEQ USER DEFINED OUTPUT DEVICE A3100009 RR ENT LUNEQ USER REQUESTED LOGICAL UNIT NUMBER A3100010 RR EXT LUNAME NAMED LOGICAL UNIT TABLE A3100011 RR EXT OPENFL FILE MANAGER OPEN FILE REQUEST A3100012 RR EXT CLOSFL FILE MANAGER CLOSE FILE REQUEST A3100013 RR EXT PGLUNT EXECUTIVE LOGICAL UNIT DEFINITION FUNCTION A3100014 RR EXT TSAREA START OF THE USER AREA A3100015 RR EQU ZERO($22) LOCATION CONTAINING ZERO A3100016 RR EQU ONE(3) LOCATION CONTAINING ONE A3100017 RR SPC 4 A3100018 RR* F I L E M A N A G E R E Q U I V A L E N C E S A3100019 RR* A3100020 RR* FILE REQUEST BUFFER A3100021 RR* A3100022 RR EQU CNTLPT(02) FILE REQUEST CONTROL POINT A3100023 RR EQU RQINFO(03) FILE REQUEST INFORMATION A3100024 RR EQU PARLST(06) FILE REQUEST PARAMETER LIST ADDRESS A3100025 RR EQU UCTADR(07) FILE REQUEST USER CONTROL ADDRESS A3100026 RR EQU FMUSER(08) FILE REQUEST USER IDENTIFICATION A3100027 RR EQU FCBADR(09) FILE CONTROL BLOCK ADDRESS A3100028 RR EQU USEFLG(13) FILE USE INDICATOR A3100029 RR EQU RRNMSB(17) RELATIVE RECORD NUMBER -MSB A3100030 RR EQU RRNLSB(18) RELATIVE RECORD NUMBER -LSB A3100031 RR EQU NUMREC(19) NUMBER OF RETRIEVED RECORDS A3100032 RR EQU FRQLEN(24) FILE REQUEST BUFFER LENGTH A3100033 RR* A3100034 RR* FILE CONTROL BLOCK A3100035 RR* A3100036 RR EQU FILEID(ZERO) FILE IDENTIFIER A3100037 RR EQU RECLEN(05) FILE RECORD LENGTH (WORDS) A3100038 RR EQU FCBIND(10) FILE CONTROL INDICATORS A3100039 RR EQU LENKY1(19) LENGTH OF KEY 1 A3100040 RR EQU LENKY2(21) LENGTH OF KEY 2 A3100041 RR EQU LENKY3(23) LENGTH OF KEY 3 A3100042 RR EQU LENKY4(25) LENGTH OF KEY 4 A3100043 RR EQU FCBLN1(13) FILE CONTROL BLOCK LENGTH (SEQUENTIAL FILE) A3100044 RR EQU FCBLN2(27) FILE CONTROL BLOCK LENGTH (INDEXED FILE) A3100045 RR* A3100046 RR* VOLUME INFORMATION TABLE A3100047 RR* A3100048 RR EQU VIWPS(13) WORDS / SECTOR FOR VOLUME A3100049 RR EJT A3100050 RR SPC 4 A3100051 RR* U S E R P R O G R A M U S E R T A B L E E N T R I E S A3100052 RR SPC 1 A3100053 RR EQU USERID(01) USER IDENTIFICATION - 4 WORDS ASCII A3100054 RR SPC 4 A3100055 RR* U S E R P R O G R A M I / O T A B L E E N T R I E S A3100056 RR SPC 1 A3100057 RR EQU TERMBF(15) TERMINAL MESSAGE BUFFER ADDRESS A3100058 RR SPC 4 A3100059 RR* U S E R L I N K A G E B U F F E R E N T R I E S A3100060 RR SPC 2 A3100061 RR EQU ULIOTB(001) USERS I/O TABLE ADDRESS A3100062 RR EQU ULUSTB(002) USERS USER TABLE ADDRESS A3100063 RR EQU RQINPT(044) USERS INPUT LOGICAL UNIT A3100064 RR EQU UFPARM(112) USER DECLARED FILE REQUEST PARAMETERS A3100065 RR EQU FISTAT(128) USER DECLARED FILE REQUEST STATUS A3100066 RR EQU PFNAME(129) CURRENT PROCEDURE FILE NAME - 4 WORDS A3100067 RR EQU MENUKY(133) REQUESTED FUNCTION MENU KEY A3100068 RR EQU USABRT(134) USER PROGRAM ABORT INDICATOR A3100069 RR EQU USMODE(135) USER EXECUTION MODE INDICATOR A3100070 RR EQU TMPGMX(136) TEMPORARY - PROGRAM INDEX A3100071 RR EQU TMSECT(137) TEMPORARY - PROGRAM SECTOR - 2 WORDS A3100072 RR EQU TMPLEN(139) TEMPORARY - PROGRAM LENGTH A3100073 RR EQU TMUSID(140) TEMPORARY - USER IDENTIFICATION - 4 WORDS A3100074 RR EQU IREQBF(144) INPUT FILE REQUEST BUFFER AND FCB A3100075 RR EQU FINAME(188) INPUT FILE NAME - 4 WORDS A3100076 RR EQU OREQBF(192) OUTPUT FILE REQUEST BUFFER AND FCB A3100077 RR EQU FONAME(236) OUTPUT FILE NAME - 4 WORDS A3100078 RR EQU FIRCNO(240) INPUT FILE RECORD NUMBER - 2 WORDS A3100079 RR EQU LULBUF(256) LENGTH OF THE LINKAGE BUFFER A3100080 RR EJT A3100081 RR SPC 4 A3100082 RRINPEQ NOP 0 A3100083 RR SPC 1 A3100084 RR ENA 0 SPECIFY AN INPUT REQUEST A3100085 RR RTJ* PROCES PROCESS THE REQUEST A3100086 RR ADC INPEQ A3100087 RR JMP* (INPEQ) RETURN A3100088 RR SPC 4 A3100089 RROUTEQ NOP 0 A3100090 RR SPC 1 A3100091 RR ENA 1 SPECIFY AN OUTPUT REQUEST A3100092 RR RTJ* PROCES PROCESS THE REQUEST A3100093 RR ADC OUTEQ A3100094 RR JMP* (OUTEQ) RETURN A3100095 RR SPC 4 A3100096 RRLUNEQ NOP 0 A3100097 RR ENA -1 SPECIFY A QUERY A3100098 RR RTJ* PROCES PROCESS THE REQUEST A3100099 RR ADC LUNEQ A3100100 RR JMP* (LUNEQ) RETURN A3100101 RR EJT A3100102 RRPROCES NOP 0 A3100103 RR SPC 1 A3100104 RR STA* INDEX SAVE THE REQUEST INDEX A3100105 RR STQ* SAVQ SAVE THE Q-REGISTER A3100106 RR LDQ- I A3100107 RR STQ* SAVI AND THE I-REGISTER A3100108 RR ENA 0 A3100109 RR STA* PGSTAT INITIALIZE THE RETURN STATUS A3100110 RR SPC 1 A3100111 RR LDQ* (PROCES) A3100112 RR STQ* PRETRN SAVE THE RETURN ADDRESS A3100113 RR LDQ- (ZERO),Q Q = ADDRESS OF PARAMETER 1 A3100114 RR LDA- (ZERO),Q A = ADDRESS OF THE NAME BUFFER A3100115 RR STA NAMADD SAVE A3100116 RR INQ 2 A3100117 RR STQ* (PRETRN) SET UP THE RETURN ADDRESS A3100118 RR SPC 1 A3100119 RR RTJ FNDNAM SEARCH FOR A MATCH OF THE NAME A3100120 RR SPC 1 A3100121 RRPRO010 LDQ* INDEX Q = REQUEST INDEX A3100122 RR SQM PRO030 LOGICAL UNIT QUERY, RETURN A3100123 RR SAP PRO020 A3100124 RR JMP* PRO100 NO MATCH, ASSUME A FILE WAS SPECIFIED A3100125 RR SPC 1 A3100126 RRPRO020 LDQ* INDEX A3100127 RR RTJ+ PGLUNT SPECIFY THE INPUT OR OUTPUT DEVICE A3100128 RR SPC 1 A3100129 RR LDA* PGSTAT OBTAIN THE RETURN STATUS A3100130 RRPRO030 LDQ* (PROCES) A3100131 RR LDQ- (ZERO),Q A3100132 RR INQ -1 A3100133 RR LDQ- (ZERO),Q A3100134 RR STA- (ZERO),Q RETURN THE STATUS A3100135 RR SPC 1 A3100136 RR LDQ* SAVI A3100137 RR STQ- I RESTORE THE I-REGISTER A3100138 RR LDQ* SAVQ AND THE Q-REGISTER A3100139 RR RAO* PROCES A3100140 RR JMP* (PROCES) RETURN A3100141 RR EJT A3100142 RRCOMPAR NOP 0 A3100143 RR SPC 1 A3100144 RR STQ* COMSVQ A3100145 RR STA* TEMP01 SAVE THE COMPARISON NAME ADDRESS A3100146 RR SPC 1 A3100147 RR ENQ 3 A3100148 RR SPC 1 A3100149 RRCOM010 LDA* (TEMP01),Q A3100150 RR SUB* (NAMADD),Q DO THE NAMES MATCH A3100151 RR SAN COM020 NO A3100152 RR INQ -1 A3100153 RR SQM COM020 THEY MATCH, RETURN WITH ERROR A3100154 RR JMP* COM010 CONTINUE A3100155 RR SPC 1 A3100156 RRCOM020 LDQ* COMSVQ A = 0 IF A MATCH WAS FOUND A3100157 RR JMP* (COMPAR) RETURN A3100158 RR SPC 4 A3100159 RRERRCHK NOP 0 A3100160 RR SAP ERR010 NO ERROR A3100161 RR SPC 1 A3100162 RR STA* PGSTAT SPECIFY THE ERROR CODE A3100163 RR ENA 0 FORCE A RETURN TO INTERACTIVE MODE A3100164 RR JMP* PRO010 RETURN TO THE ORIGINAL CALLER A3100165 RR SPC 1 A3100166 RRERR010 JMP* (ERRCHK) CONTINUE A3100167 RR SPC 4 A3100168 RR* D A T A A N D S T O R A G E A3100169 RR SPC 2 A3100170 RRSAVQ ADC 0 TEMPORARY STORAGE - Q-REGISTER A3100171 RRSAVI ADC 0 TEMPORARY STORAGE - I-REGISTER A3100172 RRPRETRN ADC 0 TEMPORARY STORAGE - RETURN ADDRESS A3100173 RRCOMSVQ ADC 0 TEMPORARY STORAGE - Q-REGISTER A3100174 RRPGSTAT ADC 0 PROGRAM RETURN STATUS A3100175 RRNAMADD ADC 0 ADDRESS OF THE NAME BUFFER A3100176 RRISTAT ADC 0 FILE REQUEST STATUS A3100177 RRTEMP01 ADC 0 TEMPORARY STORAGE A3100178 RRINDEX ADC 0 REQUEST TYPE INDEX A3100179 RR EJT A3100180 RRPRO100 LDA+ TSAREA A3100181 RR STA- I I = LINKAGE BUFFER ADDRESS A3100182 RR LDA PAR01,Q A3100183 RR ADD- I A = ADDRESS OF REQBUF FOR THIS FILE A3100184 RR STA* PRORQ1 SAVE IN THE FILE REQUESTS A3100185 RR STA* PRORQ2 A3100186 RR SPC 1 A3100187 RR LDA- RQINPT,B IS A FILE ALREADY DECLARED AS THIS DEVICE A3100188 RR SAP PRO110 NO A3100189 RR LDA FILNAM,Q A3100190 RR ADD- I A3100191 RR RTJ* COMPAR HAS THIS FILE ALREADY BEEN SPECIFIED A3100192 RR SAZ PRO110 YES A3100193 RR RTJ+ CLOSFL NO, CLOSE THE EXISTING FILE A3100194 RRPRORQ1 ADC 0 A3100195 RR ADC ISTAT A3100196 RR SPC 1 A3100197 RRPRO110 ENQ 1 A3100198 RRPRO120 LDA- RQINPT,B IS A FILE SPECIFIED FOR THIS DEVICE A3100199 RR SAP PRO130 NO A3100200 RR TRQ A YES A3100201 RR SUB* INDEX IS THIS THE REQUESTED DEVICE A3100202 RR SAZ PRO130 YES, CONTINUE A3100203 RR LDA* FILNAM,Q NO, OBTAIN THE FILE NAME ADDRESS A3100204 RR ADD- I A3100205 RR RTJ* COMPAR DOES THE REQUESTED FILE = THE OTHER FILE A3100206 RR SAN PRO130 NO A3100207 RR ENA -1 YES, INDICATE AN ERROR A3100208 RR RTJ* ERRCHK A3100209 RRPRO130 INQ -1 A3100210 RR SQM PRO140 A3100211 RR JMP* PRO120 CONTINUE THE SEARCH A3100212 RR SPC 1 A3100213 RRPRO140 LDA* INDEX IS THIS AN INPUT FILE REQUEST A3100214 RR SAN PRO160 NO A3100215 RR LDA- USMODE,I YES, IS PROCEDURE MODE ACTIVE A3100216 RR SAZ PRO160 NO A3100217 RR LDA =XPFNAME YES, OBTAIN THE ADDRESS OF THE PROCEDURE NAME A3100218 RR ADD- I A3100219 RR RTJ* COMPAR DOES THE INPUT FILE NAME = THE PROCEDURE NAME A3100220 RR SAZ PRO150 YES, CONTINUE A3100221 RR SPC 1 A3100222 RR ENA -1 NO, INDICATE AN ERROR A3100223 RR RTJ* ERRCHK A3100224 RR EJT A3100225 RRPRO150 RTJ* OPNCHK IS THE FILE ALREADY OPEN A3100226 RR SAN PRO160 NO, OPEN IT A3100227 RR JMP* PRO240 YES, CONTINUE A3100228 RR SPC 1 A3100229 RRPRO160 LDQ* INDEX A3100230 RR LDA* FILNAM,Q A3100231 RR ADD- I A3100232 RR STA* TEMP01 SAVE THE ADDRESS OF THE FILE NAME ARRAY A3100233 RR ENQ 3 A3100234 RR SPC 1 A3100235 RRPRO170 LDA* (NAMADD),Q A3100236 RR STA* IDATA,Q MOVE THE FILE NAME TO THE IDATA ARRAY A3100237 RR STA* (TEMP01),Q AND THE FILE NAME ARRAY A3100238 RR INQ -1 A3100239 RR SQM PRO180 A3100240 RR JMP* PRO170 A3100241 RR SPC 1 A3100242 RRPRO180 LDA =XTMUSID A3100243 RR ADD- I OBTAIN THE ADDRESS OF THE USER ID A3100244 RR STA* TEMP01 A3100245 RR ENQ 3 A3100246 RR SPC 1 A3100247 RRPRO190 LDA* (TEMP01),Q A3100248 RR STA* IDATA+4,Q MOVE THE OWNER NAME TO THE IDATA ARRAY A3100249 RR INQ -1 A3100250 RR SQM PRO200 A3100251 RR JMP* PRO190 A3100252 RR SPC 1 A3100253 RRPRO200 ENQ FRQLEN-1 A3100254 RR ENA 0 A3100255 RRPRO210 STA* (PRORQ2),Q INITIALIZE THE REQUEST BUFFER TO ZERO A3100256 RR INQ -1 A3100257 RR SQM PRO220 A3100258 RR JMP* PRO210 A3100259 RR SPC 1 A3100260 RRPRO220 ENQ FCBADR A3100261 RR LDA* PRORQ2 A3100262 RR INA FRQLEN A = ADDRESS OF THE FILES FCB A3100263 RR STA* (PRORQ2),Q SET UP THE FCB ADDRESS IN THE REQUEST BUFFER A3100264 RR STA* TEMP01 A3100265 RR SPC 1 A3100266 RR RTJ+ OPENFL OPEN THE REQUESTED FILE A3100267 RRPRORQ2 ADC 0 A3100268 RR ADC IDATA A3100269 RR ADC ISTAT A3100270 RR SPC 1 A3100271 RR LDA* ISTAT A3100272 RR RTJ* ERRCHK CHECK FOR FILE ERRORS A3100273 RR EJT A3100274 RR SPC 4 A3100275 RR LDQ- ULIOTB,I A3100276 RR LDQ- TERMBF,Q Q = I/O HEADER ADDRESS A3100277 RR INQ -1 A3100278 RR LDA- (ZERO),Q A = I/O BUFFER LENGTH A3100279 RR INA -2 ALLOW FOR END-OF-FILE CODES A3100280 RR LDQ* TEMP01 Q = FCB ADDRESS A3100281 RR SUB- RECLEN,Q WILL THE RECORD FIT IN THE BUFFER A3100282 RR SAM PRO230 NO, ERROR A3100283 RR LDA- FCBIND,Q YES, ARE THE RECORDS SECTOR ALIGNED A3100284 RR SAP PRO240 NO, CONTINUE A3100285 RRPRO230 ENA -1 INDICATE AN ERROR A3100286 RR RTJ* ERRCHK A3100287 RR SPC 1 A3100288 RRPRO240 LDQ- ULIOTB,I A3100289 RR LDQ- TERMBF,Q A3100290 RR LDA- 4,Q A = TERMINAL BUFFER ADDRESS A3100291 RR LDQ* INDEX A3100292 RR STA* PAR02,Q SPECIFY THE RECORD BUFFER A3100293 RR SQN PRO260 SKIP IF THIS IS AN 'OUTPUT' REQUEST A3100294 RR SPC 1 A3100295 RR LDA- USMODE,I IS PROCEDURE MODE IN EFFECT A3100296 RR SAN PRO250 YES A3100297 RR STA- FIRCNO+1,I NO, INITIALIZE THE RECORD COUNT A3100298 RR* 1 CARD DELETED 127*4978A3100299 RR SPC 1 A3100300 RRPRO250 LDA- FIRCNO+1,I IS THE FILE AT LOAD POINT 127*4978A3100301 RR SAZ PRO260 YES 127*4978A3100302 RR LDQ* PRORQ2 Q = REQUEST BUFFER ADDRESS 127*4978A3100303 RR ENA 1 A3100304 RR STA- NUMREC,Q A3100305 RR ENA 0 A3100306 RR STA- RRNMSB,Q POSITION THE FILE TO THE CORRECT RECORD A3100307 RR LDA- FIRCNO+1,I A3100308 RR STA- RRNLSB,Q A3100309 RR EJT A3100310 RR SPC 4 A3100311 RRPRO260 LDQ* INDEX A3100312 RR LDA- I A3100313 RR STA* TEMP01 SAVE THE LINKAGE BUFFER ADDRESS A3100314 RR ADD* PARLOC,Q A3100315 RR STA- I I = PARAMETER LOCATION FOR THIS REQUEST A3100316 RR SPC 1 A3100317 RR LDA* PAR01,Q A3100318 RR ADD* TEMP01 A3100319 RR STA- (I) SPECIFY REQBUF PARAMETER A3100320 RR LDA* PAR02,Q A3100321 RR STA- 1,I SPECIFY RECBUF PARAMETER A3100322 RR LDA* PAR03,Q A3100323 RR STA- 2,I SPECIFY NUMREC PARAMETER A3100324 RR LDA* PAR04,Q A3100325 RR ADD TEMP01 A3100326 RR STA- 3,I SPECIFY ISTAT PARAMETER A3100327 RR SPC 1 A3100328 RR LDA* REQIDX,Q A3100329 RR ENQ RQINFO A3100330 RR STA* (PRORQ2),Q SPECIFY THE REQUEST INDEX A3100331 RR LDA- I A3100332 RR INA 4 A3100333 RR ENQ PARLST A3100334 RR STA* (PRORQ2),Q SPECIFY THE PARAMETER LIST LOCATION A3100335 RR SPC 1 A3100336 RR ENA -1 INDICATE A FILE DEVICE A3100337 RR JMP PRO020 RETURN A3100338 RR EJT A3100339 RR SPC 4 A3100340 RR* D A T A A N D S T O R A G E A3100341 RR SPC 2 A3100342 RRPARLOC ADC UFPARM 0 - INPUT FILE PARAMETER LIST A3100343 RR ADC UFPARM+4 1 - OUTPUT FILE PARAMETER LIST A3100344 RR SPC 1 A3100345 RRREQIDX ADC 14 0 - INPUT FILE REQUEST INDEX A3100346 RR ADC 11 1 - OUTPUT FILE REQUEST INDEX A3100347 RR SPC 1 A3100348 RRFILNAM ADC FINAME 0 - INPUT FILE NAME A3100349 RR ADC FONAME 1 - OUTPUT FILE NAME A3100350 RR SPC 1 A3100351 RRPAR01 ADC IREQBF 0 - INPUT REQBUF PARAMETER A3100352 RR ADC OREQBF 1 - OUTPUT REQBUF PARAMETER A3100353 RR SPC 1 A3100354 RRPAR02 ADC 0 0 - INPUT RECBUF PARAMETER A3100355 RR ADC 0 1 - OUTPUT RECBUF PARAMETER A3100356 RR SPC 1 A3100357 RRPAR03 ADC ZERO 0 - INPUT KEYVAL PARAMETER A3100358 RR ADC ONE 1 - OUTPUT RECLEN PARAMETER A3100359 RR SPC 1 A3100360 RRPAR04 ADC FISTAT 0 - INPUT ISTAT PARAMETER A3100361 RR ADC FISTAT 1 - OUTPUT ISTAT PARAMETER A3100362 RR SPC 1 A3100363 RRIDATA ALF 4, FILE NAME A3100364 RR ALF 4, FILE OWNER A3100365 RR ALF 4, VOLUME NAME A3100366 RR ADC 0 INDEXED REQUEST INDICATOR (N/A) A3100367 RR ADC 1 NUMBER OF RECORDS A3100368 RR ADC 0 LOCK INDICATOR A3100369 RR EJT A3100370 RROPNCHK NOP 0 A3100371 RR SPC 1 A3100372 RR LDQ* PRORQ2 Q = REQBUF ADDRESS A3100373 RR LDQ- UCTADR,Q Q = UCT ADDRESS A3100374 RR LDA- (ZERO),Q A3100375 RR SUB- ULUSTB,I DOES THE USER ID MATCH A3100376 RR SAN OPN010 NO, RETURN A3100377 RR LDA- 2,Q YES A3100378 RR LDQ* PRORQ2 A3100379 RR SUB- FCBADR,Q DO THE FCB ADDRESSES MATCH A3100380 RR SPC 1 A3100381 RROPN010 JMP* (OPNCHK) A = 0 INDICATES THE FILE IS OPEN A3100382 RR SPC 4 A3100383 RRFNDNAM NOP 0 A3100384 RR SPC 1 A3100385 RR LDA =XLUNAME A = ADDRESS OF THE NAMED LOGICAL UNIT TABLE A3100386 RR STA- I A3100387 RR SPC 1 A3100388 RRFND010 ENQ 3 A3100389 RRFND020 LDA- (I),Q A3100390 RR SUB (NAMADD),Q DOES THIS ENTRY MATCH A3100391 RR SAN FND030 NO, TRY THE NEXT A3100392 RR INQ -1 YES, CONTINUE A3100393 RR SQM FND040 THE NAME MATCHES A3100394 RR JMP* FND020 A3100395 RR SPC 1 A3100396 RRFND030 LDA- I A3100397 RR INA 5 INCREMENT TO THE NEXT ENTRY IN THE TABLE A3100398 RR STA- I A3100399 RR LDA- (I) IS THIS THE END OF THE TABLE A3100400 RR SAM FND050 YES, NO MATCH CAN BE FOUND A3100401 RR JMP* FND010 NO, CONTINUE A3100402 RR SPC 1 A3100403 RRFND040 LDA- 4,I A = SPECIFIED LOGICAL UNIT A3100404 RR SPC 1 A3100405 RRFND050 JMP* (FNDNAM) RETURN A3100406 RR SPC 1 A3100407 RR END A3100408 RR NAM FMCALL A32 A ITOS CCS 3.0 SL-149A3200001 RR* LOG-IN FILE REQUEST INTERCEPTOR A3200002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 A3200003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A3200004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 A3200005 RR* A3200006 RR* A3200007 RR* FMCALL CONTAINS THE ENTRY POINTS FOR ALL FILE MANAGER A3200008 RR* REQUESTS REQUIRED BY THE ITOS LOG-IN PROCESSOR. A3200009 RR* FMCALL INTERCEPTS ALL REQUESTS, PERFORMS SOME INITIALIZATIONA3200010 RR* OF THE USER'S REQUEST BUFFER AND EXCUTES A RETURN JUMP TO A3200011 RR* THE CORE RESIDENT FILE MANAGER EXECUTIVE'S ENTRY POINT. THEA3200012 RR* FILE MANAGER EXECUTIVE RETURNS TO FMCALL UPON COMPLETING A3200013 RR* A REQUEST. FMCALL WILL RETURN TO THE CALLER. A3200014 RR SPC 2 A3200015 RR* A3200016 RR* FILE REQUESTS ENTRY POINTS A3200017 RR* A3200018 RR ENT OPENFL OPEN FILE A3200019 RR ENT CLOSFL CLOSE FILE A3200020 RR ENT PUTS PUT SEQUENTIAL RECORD A3200021 RR ENT READR READ RECORD RANDOMLY A3200022 RR ENT GETS GET NEXT SEQUENTIAL RECORD A3200023 RR ENT FCLOSE FORCE CLOSE ALL USER FILES A3200024 RR SPC 2 A3200025 RR* A3200026 RR* EXTERNALS A3200027 RR* A3200028 RR EXT CCP CONTROL POINT LOCATION A3200029 RR SPC 2 A3200030 RR* A3200031 RR* EQUIVALENCES A3200032 RR* COMMUNICATION REGION CONSTANTS A3200033 RR* A3200034 RR EQU ZERO(2) ZERO CONSTANT A3200035 RR EQU ADRECT($E9) ADDRESS OF EXTENDED CORE TABLE A3200036 RR EQU FMEIDX(30) INDEX INTO EXT EXT CORE TABLE TO FM EXEC ENTRYA3200037 RR* A3200038 RR* REQUEST BUFFER INDEXES A3200039 RR EQU RBATHR(0) REQUEST BUFFER ADDRESS THREAD A3200040 RR EQU BUFAMP(1) BUFFER ADDRESS MAIN PART A3200041 RR EQU CNTLPT(2) CONTROL POINT (OR SPARE) A3200042 RR EQU RQINFO(3) REQUEST INFORMATION (MULTI-FIELD) A3200043 RR EQU QREG(4) Q REGISTER A3200044 RR EQU IREG(5) I REGISTER A3200045 RR EQU RTNADR(6) RETURN ADDRESS (UPON RETURN FROM EXEC) A3200046 RR EQU PARLST(6) ADDRESS OF PARAMETER LIST A3200047 RR EQU UCTIND(7) UCT ENTRY INDEX A3200048 RR* A3200049 RR EQU OPNIDX(4) OPENFL REQUEST INDEX A3200050 RR EJT A3200051 RR SPC 4 A3200052 RR* A3200053 RRGETS NUM 0 GET NEXT SEQUENTIAL RECORD A3200054 RR ENA 14 REQUEST INDEX = 14 A3200055 RR RTJ* CONT A3200056 RR* A3200057 RRREADR NUM 0 READ RECORD RANDOMLY A3200058 RR ENA 13 REQUEST INDEX = 13 A3200059 RR RTJ* CONT A3200060 RR* A3200061 RRPUTS NUM 0 PUT SEQUENTIAL RECORD A3200062 RR ENA 11 REQUEST INDEX = 11 A3200063 RR RTJ* CONT A3200064 RR* A3200065 RRCLOSFL NUM 0 CLOSE FILE A3200066 RR ENA 5 REQUEST INDEX = 5 A3200067 RR RTJ* CONT A3200068 RR* A3200069 RROPENFL NUM 0 OPEN FILE A3200070 RR ENA 4 REQUEST INDEX = 4 A3200071 RR RTJ* CONT A3200072 RR* A3200073 RRFCLOSE NUM 0 FORCE CLOSE A3200074 RR ENA 0 REQUEST INDEX = 0 A3200075 RR RTJ* CONT A3200076 RR EJT A3200077 RR* INITIALIZE FIRST 6 WORDS OF REQUEST BUFFER A3200078 RRCONT NUM 0 A3200079 RR STQ* QTEMP SAVE Q TEMPORARILY A3200080 RR STA* ATEMP SAVE THE REQUEST INDEX A3200081 RR LDQ* CONT A3200082 RR INQ -3 A3200083 RR LDQ- (ZERO),Q PICKUP ADDRESS OF USER PARAMETER LIST A3200084 RR STQ* PLIST SAVE IT A3200085 RR LDA- (ZERO),Q A = ADDRESS OF REQBUF A3200086 RR LDQ- I PICK UP I-REG CONTENTS A3200087 RR STA- I SET I TO REQBUF ADDRESS A3200088 RR INA 4 A3200089 RR STA- BUFAMP,I SET REQBUF+4 ADDRESS A3200090 RR STQ- IREG,I SAVE ORIGINAL I-REG CONTENTS IN REQBUF A3200091 RR CLR A A3200092 RR STA- (ZERO),I CLEAR REQBUF(1) AND SAVE CONTROL POINT A3200093 RR LDA CCP A3200094 RR STA- CNTLPT,I A3200095 RR LDA* PLIST A3200096 RR STA- PARLST,I STORE USERS PARAM LIST ADDRESS IN REQBUF A3200097 RR LDQ* QTEMP RELOAD Q WITH SAVED VALUE A3200098 RR STQ- QREG,I STORE IN REQBUF A3200099 RR LDA* ATEMP A3200100 RR STA- RQINFO,I STORE REQUEST INDEX A3200101 RR INA -OPNIDX A3200102 RR SAN CONTIN SKIP IF NOT OPENFL CALL A3200103 RR STA- UCTIND,I CLEAR UCTIND WORD A3200104 RRCONTIN ENQ FMEIDX EXECUTE FILE MANAGER REQUEST EXECUTIVE A3200105 RR LDQ- (ADRECT),Q A3200106 RR RTJ- (ZERO),Q A3200107 RR* A3200108 RR* RETURN FROM EXECUTIVE A3200109 RR* A3200110 RR LDA- RTNADR,I GET RETURN ADDRESS A3200111 RR STA* QTEMP SAVE FOR RETURN A3200112 RR LDQ- QREG,I RESTORE SAVED Q-REG AND I-REG A3200113 RR LDA- IREG,I A3200114 RR STA- I A3200115 RR JMP* (QTEMP) RETURN TO CALLER A3200116 RR SPC 3 A3200117 RRPLIST NUM 0 SAVED USER PARAMETER LIST ADDRESS A3200118 RRQTEMP NUM 0 SAVED Q-REG A3200119 RRATEMP NUM 0 A3200120 RR END A3200121 RR NAM SYSMSG A33 A ITOS CCS 3.0 SL-149A3300001 RR* USER PROGRAM MESSAGE PROCESSOR A3300002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 A3300003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A3300004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 A3300005 RR* A3300006 RR SPC 2 A3300007 RR ENT SYSMSG A3300008 RR EXT OPENFL OPEN FILE FILE REQUEST A3300009 RR EXT CLOSFL CLOSE FILE FILE REQUEST A3300010 RR EXT READR READ RECORD RANDOMLY FILE REQUEST A3300011 RR EXT TERMLU LOGICAL UNIT OF THE COMMUNICATIONS CONTROLLER A3300012 RR EQU LPMASK(2) BIT MASK TABLE A3300013 RR EQU ZERO($22) LOCATION CONTAINING ZERO A3300014 RR EQU TEN($46) LOCATION CONTAINING TEN A3300015 RR EQU AMONI($F4) MONITOR REQUEST ENTRY A3300016 RR EQU ASC($40) ASCII SPECIFICATION CHARACTER (@) A3300017 RR EQU DEC($23) DECIMAL SPECIFICATION CHARACTER (#) A3300018 RR EQU HEX($24) HEXIDECIMAL SPECIFICATION CHARACTER ($) A3300019 RR SPC 2 A3300020 RRSYSMSG NOP 0 A3300021 RR SPC 1 A3300022 RR STQ* SAVQ SAVE THE Q-REGISTER A3300023 RR SPC 1 A3300024 RR LDA- $E3 IS THE SYSTEM HANG SWITCH SET A3300025 RRSYS000 SAP SYS005 NO, CONTINUE A3300026 RR JMP* SYS000 CLEAR THE A-REGISTER TO CONTINUE A3300027 RR SPC 1 A3300028 RRSYS005 LDQ* (SYSMSG) A3300029 RR RAO* SYSMSG A3300030 RR LDA- (ZERO),Q OBTAIN THE FIRST PARAMETER - MESSAGE INDEX A3300031 RR STA* MSGTYP SAVE THE DISPOSITION INDICATOR A3300032 RR SAP SYS010 A3300033 RR TCA A A3300034 RRSYS010 SAN SYS020 A3300035 RR JMP SYS450 INDEX = 0 (ILLEGAL) A3300036 RR EJT A3300037 RR SPC 4 A3300038 RRSYS020 STA* RECNUM+1 RECNUM = MESSAGE INDEX A3300039 RR SPC 1 A3300040 RR LDQ* (SYSMSG) A3300041 RR RAO* SYSMSG A3300042 RR STQ* DATBUF SAVE THE SECOND PARAMETER - DATA BUFFER A3300043 RR SPC 1 A3300044 RR ENQ 23 A3300045 RR ENA 0 A3300046 RRSYS030 STA REQBUF,Q INITIALIZE THE FILE REQUEST BUFFER A3300047 RR INQ -1 A3300048 RR SQM SYS040 A3300049 RR JMP* SYS030 A3300050 RR SPC 1 A3300051 RRSYS040 RTJ+ OPENFL OPEN THE SYSTEM MESSAGE FILE A3300052 RR ADC REQBUF A3300053 RR ADC IDATA A3300054 RR ADC ISTAT A3300055 RR SPC 1 A3300056 RR LDA* ISTAT WERE THERE ANY FILE ERRORS A3300057 RR SAP SYS050 NO A3300058 RR JMP SYS450 YES A3300059 RR EJT A3300060 RR SPC 4 A3300061 RRSYS050 RTJ+ READR READ THE MESSAGE RECORD A3300062 RR ADC REQBUF A3300063 RR ADC RECBUF A3300064 RR ADC RECNUM A3300065 RR ADC ISTAT A3300066 RR SPC 1 A3300067 RR LDA* ISTAT WERE THERE ANY FILE ERRORS A3300068 RR SAP SYS060 NO A3300069 RR JMP* SYS450 YES A3300070 RR SPC 1 A3300071 RR SPC 1 A3300072 RRSYS060 RTJ+ CLOSFL CLOSE THE MESSAGE FILE A3300073 RR ADC REQBUF A3300074 RR ADC ISTAT A3300075 RR SPC 1 A3300076 RR ENQ 0 A3300077 RR STQ* RECIDX INITIALIZE THE RECORD CHARACTER INDEX A3300078 RR STQ* BUFIDX INITIALIZE THE DATA CHARACTER INDEX A3300079 RR SPC 1 A3300080 RRSYS100 LDQ* RECIDX A3300081 RR TRQ A A3300082 RR INA -80 HAS THE ENTIRE RECORD BEEN SEARCHED A3300083 RR SAP SYS130 YES, DISPLAY THE MESSAGE A3300084 RR SPC 1 A3300085 RR RTJ* GETCHR NO, GET THE NEXT CHARACTER FROM RECBUF A3300086 RR ADC RECBUF A3300087 RR INQ 1 A3300088 RR STQ* RECIDX A3300089 RR SPC 1 A3300090 RR INA -ASC IS THIS AN ASCII SPECIFICATION A3300091 RR SAZ SYS140 YES A3300092 RR INA -DEC+ASC NO, IS A DECIMAL SPECIFICATION A3300093 RR SAZ SYS110 YES A3300094 RR INA -HEX+DEC NO, IS IT A HEXIDECIMAL SPECIFICATION A3300095 RR SAZ SYS120 YES A3300096 RR JMP* SYS100 NO, CONTINUE THE SCAN A3300097 RR SPC 1 A3300098 RRSYS110 JMP* SYS200 DECIMAL CONVERSION A3300099 RRSYS120 JMP* SYS300 HEXIDECIMAL CONVERSION A3300100 RRSYS130 JMP* SYS400 DISPLAY THE MESSAGE RECORD A3300101 RR EJT A3300102 RR SPC 4 A3300103 RRSYS140 LDQ* BUFIDX ASCII SPECIFICATION A3300104 RR RTJ* GETCHR GET THE NEXT CHARACTER FROM THE DATA BUFFER A3300105 RRDATBUF ADC 0 MESSAGE DATA BUFFER ADDRESS A3300106 RR INQ 1 A3300107 RR STQ* BUFIDX A3300108 RR SPC 1 A3300109 RR LDQ* RECIDX A3300110 RR INQ -1 A3300111 RR RTJ* PUTCHR PLACE THE CHARACTER IN THE MESSAGE RECORD A3300112 RR ADC RECBUF A3300113 RR JMP* SYS100 CONTINUE A3300114 RR SPC 4 A3300115 RR* D A T A A N D S T O R A G E A3300116 RR SPC 2 A3300117 RRSAVQ ADC 0 Q-REGISTER STORAGE A3300118 RRMSGTYP ADC 0 MESSAGE DISPOSITION TYPE A3300119 RRRECIDX ADC 0 MESSAGE RECORD CHARACTER INDEX A3300120 RRBUFIDX ADC 0 MESSAGE BUFFER CHARACTER INDEX A3300121 RRISTAT ADC 0 FILE REQUEST RETURN STATUS A3300122 RRRECNUM ADC 0,0 MESSAGE FILE RELATIVE RECORD NUMBER A3300123 RRIDATA ALF 4,$$SYMSGF FILE NAME A3300124 RR ALF 4,$$ FILE OWNER A3300125 RR ALF 4,SYSVOL FILE VOLUME A3300126 RR ADC 0 SEQUENTIAL FILE A3300127 RR ADC 1 RECORDS / REQUEST A3300128 RR ADC 0 RECORD LOCK INDICATOR A3300129 RR EJT A3300130 RR SPC 4 A3300131 RRSYS200 RTJ* (AGTVAL) OBTAIN THE DATA VALUE A3300132 RR RAO* BUFIDX A3300133 RR RAO* BUFIDX INCREMENT THE DATA BUFFER INDEX A3300134 RR RTJ* DECCON CONVERT THE VALUE TO DECIMAL ASCII A3300135 RR SPC 1 A3300136 RR ENQ 0 A3300137 RR STQ* CONIDX INITIALIZE THE CONVERSION CHARACTER INDEX A3300138 RR LDQ* RECIDX A3300139 RR INQ -1 A3300140 RR STQ* BASIDX SAVE THE INITIAL CHARACTER INDEX A3300141 RR SPC 1 A3300142 RRSYS210 RTJ* GETCHR OBTAIN THE NEXT MESSAGE CHARACTER A3300143 RR ADC RECBUF A3300144 RR INA -DEC IS IT A DECIMAL SPECIFICATION A3300145 RR SAN SYS220 NO A3300146 RR INQ 1 YES A3300147 RR JMP* SYS210 CONTINUE A3300148 RR SPC 1 A3300149 RRSYS220 RTJ* MOVDAT MOVE THE CONVERTED DATA INTO THE RECORD A3300150 RR JMP* SYS100 CONTINUE THE RECORD SCAN A3300151 RR SPC 4 A3300152 RRSYS300 RTJ* (AGTVAL) OBTAIN THE DATA VALUE A3300153 RR RTJ* HEXCON CONVERT THE VALUE TO HEXIDECIMAL ASCII A3300154 RR SPC 1 A3300155 RR ENQ 0 A3300156 RR STQ* CONIDX INITIALIZE THE CONVERSION CHARACTER INDEX A3300157 RR LDQ* RECIDX A3300158 RR INQ -1 A3300159 RR STQ* BASIDX SAVE THE INITIAL CHARACTER INDEX A3300160 RR SPC 1 A3300161 RRSYS310 RTJ* GETCHR OBTAIN THE NEXT MESSAGE CHARACTER A3300162 RR ADC RECBUF A3300163 RR INA -HEX IS IT A HEXIDECIMAL SPECIFICATION A3300164 RR SAN SYS320 NO A3300165 RR INQ 1 YES A3300166 RR JMP* SYS310 CONTINUE A3300167 RR SPC 1 A3300168 RRSYS320 RTJ* MOVDAT MOVE THE CONVERTED DATA INTO THE RECORD A3300169 RR JMP* SYS100 CONTINUE THE RECORD SCAN A3300170 RR SPC 2 A3300171 RRBASIDX ADC 0 TEMPORARY STORAGE - BASE RECORD INDEX A3300172 RRPUTIDX ADC 0 TEMPORARY STORAGE - DATA PLACEMENT INDEX A3300173 RRAGTVAL ADC GETVAL ADDRESS OF THE DATA VALUE PICKUP ROUTINE A3300174 RR EJT A3300175 RR SPC 4 A3300176 RRMOVDAT NOP 0 A3300177 RR SPC 1 A3300178 RRMOV010 INQ -1 A3300179 RR STQ* PUTIDX A3300180 RR SPC 1 A3300181 RR LDQ* CONIDX A3300182 RR RTJ* GETCHR OBTAIN THE NEXT CONVERTED CHARACTER A3300183 RR ADC CONBUF A3300184 RR SPC 1 A3300185 RR INQ 1 A3300186 RR STQ* CONIDX A3300187 RR SPC 1 A3300188 RR LDQ* PUTIDX A3300189 RR RTJ* PUTCHR PLACE THE DATA IN THE RECORD A3300190 RR ADC RECBUF A3300191 RR TRQ A A3300192 RR SUB* BASIDX HAS ALL THE DATA BEEN ENTERED A3300193 RR SAZ MOV020 YES A3300194 RR JMP* MOV010 NO, CONTINUE A3300195 RR SPC 1 A3300196 RRMOV020 JMP* (MOVDAT) RETURN A3300197 RR EJT A3300198 RR SPC 4 A3300199 RRSYS400 ENQ 0 DISPLAY THE MESSAGE ON THE USERS TERMINAL A3300200 RR RTJ* (AMESSG) A3300201 RR SPC 1 A3300202 RR LDA* MSGTYP IS IT ALSO REQUIRED AT THE MASTER TERMINAL A3300203 RR SAP SYS410 NO A3300204 RR SPC 1 A3300205 RR ENQ 1 YES, DISPLAY THE MESSAGE THERE ALSO A3300206 RR RTJ* (AMESSG) A3300207 RR SPC 1 A3300208 RRSYS410 LDQ* SAVQ RESTORE THE Q-REGISTER A3300209 RR JMP (SYSMSG) RETURN A3300210 RR SPC 2 A3300211 RRSYS450 ENQ 0 MESSAGE RECORD NOT AVAILABLE A3300212 RR LDA* RECNUM+1 A3300213 RR RTJ* DECCON CONVERT THE RECORD NUMBER A3300214 RR SPC 1 A3300215 RR LDA* CONBUF A3300216 RR ALS 8 EXCHANGE THE 2 LSD A3300217 RR STA MESG02+9 A3300218 RR LDA* CONBUF+1 A3300219 RR ALS 8 EXCHANGE THE NEXT 2 DIGITS A3300220 RR STA MESG02+8 A3300221 RR SPC 1 A3300222 RR ENQ 2 DISPLAY THE MESSAGE RECORD NUMBER A3300223 RR RTJ* (AMESSG) A3300224 RR JMP* SYS410 CONTINUE A3300225 RR SPC 2 A3300226 RRCONIDX ADC 0 MESSAGE DATA CHARACTER INDEX A3300227 RRAMESSG ADC MESSAG ADDRESS OF THE MASSAGE DISPLAY ROUTINE A3300228 RR EJT A3300229 RRGETCHR NOP 0 A3300230 RR LDA* (GETCHR) OBTAIN THE BUFFER ADDRESS A3300231 RR STA* CHRBUF AND SAVE A3300232 RR RAO* GETCHR A3300233 RR STQ* CHRTMP SAVE THE CHARACTER INDEX A3300234 RR SPC 1 A3300235 RR QRS 1 Q = WORD INDEX A3300236 RR LDA* (CHRBUF),Q OBTAIN THE WORD CONTAINING THE CHARACTER A3300237 RR LDQ* CHRTMP A3300238 RR QLS 15 IS THIS A RIGHT OR LEFT CHARACTER A3300239 RR SQM GET010 RIGHT A3300240 RR ARS 8 A3300241 RRGET010 QLS 1 RESTORE THE CHARACTER INDEX A3300242 RR AND- LPMASK+8 ISOLATE THE CHARACTER A3300243 RR JMP* (GETCHR) RETURN A3300244 RR SPC 2 A3300245 RRCHRTMP ADC 0 TEMPORARY STORAGE - CHARACTER INDEX A3300246 RRCHRBUF ADC 0 TEMPORARY STORAGE - BUFFER ADDRESS A3300247 RR SPC 4 A3300248 RRPUTCHR NOP 0 A3300249 RR STQ* CHRTMP SAVE THE CHARACTER INDEX A3300250 RR LDQ* (PUTCHR) OBTAIN THE BUFFER ADDRESS A3300251 RR STQ* CHRBUF AND SAVE A3300252 RR RAO* PUTCHR A3300253 RR SPC 1 A3300254 RR LDQ* CHRTMP A3300255 RR ALS 9 A3300256 RR LRS 1 BITS 8-14 OF A = CHARACTER, Q = WORD INDEX A3300257 RR LDQ* (CHRBUF),Q OBTAIN THE CURRENT BUFFER WORD A3300258 RR SAM PUT010 SKIP IF THE CHARACTER IS ON THE RIGHT A3300259 RR LLS 16 A3300260 RR ALS 8 POSITION THE CHARACTER A3300261 RRPUT010 AND- LPMASK+15 REMOVE THE LEFT / RIGHT INDICATOR A3300262 RR QRS 8 A3300263 RR LRS 8 FORM THE WORD A3300264 RR LDQ* CHRTMP A3300265 RR QRS 1 Q = WORD INDEX A3300266 RR STA* (CHRBUF),Q A3300267 RR LDQ* CHRTMP RESTORE THE CHARACTER INDEX A3300268 RR JMP* (PUTCHR) RETURN A3300269 RR EJT A3300270 RRDECCON NOP 0 A3300271 RR SPC 1 A3300272 RR DVI* TENKAY DIVIDE THE DATA INTO TWO PARTS A3300273 RR STQ* CONTMP SAVE THE LSD A3300274 RR SAZ DEC010 SKIP IF THE MSD IS ZERO A3300275 RR SPC 1 A3300276 RR ENQ 4 CONVERT THE MSD TO DECIMAL ASCII A3300277 RR RTJ* CONVRT A3300278 RR SPC 1 A3300279 RRDEC010 ENQ 0 CONVERT THE LSD TO DECIMAL ASCII A3300280 RR LDA* CONTMP A3300281 RR RTJ* CONVRT A3300282 RR SPC 1 A3300283 RR JMP* (DECCON) RETURN A3300284 RR SPC 2 A3300285 RRCONTMP ADC 0 TEMPORARY STORAGE A3300286 RRTENKAY ADC 10000 DATA DIVISOR A3300287 RR SPC 4 A3300288 RRHEXCON NOP 0 A3300289 RR SPC 1 A3300290 RR ENA 0 A3300291 RR STA* CONIDX INITIALIZE THE CONVERSION CHARACTER INDEX A3300292 RR SPC 1 A3300293 RRHEX010 LRS 4 A3300294 RR ARS 12 OBTAIN THE NEXT DIGIT A3300295 RR AND- LPMASK+4 A3300296 RR STQ* CONQUO SAVE THE QUOTIENT A3300297 RR INA -$A A3300298 RR SAM HEX020 CONVERT THE DIGIT TO ASCII A3300299 RR INA 7 A3300300 RRHEX020 INA $3A A3300301 RR LDQ* CONIDX A3300302 RR RTJ* PUTCHR PLACE THE DIGIT IN THE CONVERSION BUFFER A3300303 RR ADC CONBUF A3300304 RR SPC 1 A3300305 RR INQ 1 A3300306 RR STQ* CONIDX A3300307 RR LDA* CONQUO A3300308 RR AND- LPMASK+12 A3300309 RR TRA Q IS MORE CONVERSION REQUIRED A3300310 RR SQZ HEX030 NO A3300311 RR JMP* HEX010 YES, CONTINUE A3300312 RR SPC 1 A3300313 RRHEX030 JMP* (HEXCON) RETURN A3300314 RR EJT A3300315 RRCONVRT NOP 0 A3300316 RR SPC 1 A3300317 RRCON010 STQ* CONIDX SAVE THE STORAGE INDEX A3300318 RR CLR Q A3300319 RR DVI- TEN OBTAIN THE NEXT DIGIT A3300320 RR STA* CONQUO SAVE THE QUOTIENT A3300321 RR TRQ A A3300322 RR INA $30 CONVERT THE DIGIT TO ASCII A3300323 RR LDQ* CONIDX A3300324 RR RTJ* PUTCHR PLACE THE DIGIT IN THE CONVERSION BUFFER A3300325 RR ADC CONBUF A3300326 RR SPC 1 A3300327 RR INQ 1 INCREMENT THE STORAGE INDEX A3300328 RR LDA* CONQUO IS MORE CONVERSION REQUIRED A3300329 RR SAZ CON020 NO A3300330 RR JMP* CON010 YES, CONTINUE A3300331 RR SPC 1 A3300332 RRCON020 JMP* (CONVRT) RETURN A3300333 RR SPC 2 A3300334 RRCONQUO ADC 0 TEMPORARY STORAGE - DIVISION QUOTIENT A3300335 RRABFIDX ADC BUFIDX ADDRESS OF THE DATA BUFFER INDEX A3300336 RR SPC 4 A3300337 RRGETVAL NOP 0 A3300338 RR SPC 1 A3300339 RR ENQ 7 A3300340 RR LDA =A00 INITIALIZE THE CONVERSION BUFFER A3300341 RRGEV010 STA* CONBUF,Q A3300342 RR INQ -1 A3300343 RR SQM GEV020 A3300344 RR JMP* GEV010 A3300345 RR SPC 1 A3300346 RRGEV020 LDQ* (ABFIDX) Q = DATA BUFFER CHARACTER INDEX A3300347 RR LRS 1 A3300348 RR SAP GEV030 CONVERT TO WORD INDEX A3300349 RR INQ 1 A3300350 RRGEV030 ADQ DATBUF A3300351 RR LDA- 1,Q A = LSD OF THE VALUE A3300352 RR LDQ- (ZERO),Q Q = MSD OF THE VALUE A3300353 RR RAO* (ABFIDX) A3300354 RR RAO* (ABFIDX) INCREMENT THE DATA INDEX A3300355 RR JMP* (GETVAL) RETURN A3300356 RR SPC 2 A3300357 RRCONBUF BZS CONBUF(8) A3300358 RR EJT A3300359 RR SPC 4 A3300360 RRMESSAG NOP 0 A3300361 RR LDA* MESSAD,Q A3300362 RR STA* MESAD SPECIFY THE MESSAGE ADDRESS A3300363 RR LDA* MESLUN,Q A3300364 RR STA* MESLU SPECIFY THE MESSAGE LOGICAL UNIT A3300365 RR LDQ* MESLEN,Q A3300366 RR QRS 1 A3300367 RR SPC 1 A3300368 RRMES010 INQ -1 A3300369 RR SQM MES020 A3300370 RR LDA* (MESAD),Q A3300371 RR SUB =A IS THIS THE END OF THE SIGNIFICANT TEXT A3300372 RR SAN MES020 YES A3300373 RR JMP* MES010 NO, CONTINUE A3300374 RR SPC 1 A3300375 RRMES020 INQ 1 A3300376 RR QLS 1 A3300377 RR STQ* MESLN SPECIFY THE MESSAGE LENGTH A3300378 RR SPC 1 A3300379 RR RTJ- (AMONI) DISPLAY THE MESSAGE A3300380 RR ADC $4C44 A3300381 RR ADC 0 A3300382 RR ADC 0 A3300383 RRMESLU ADC 0 A3300384 RRMESLN ADC 0 A3300385 RRMESAD ADC 0 A3300386 RR SPC 1 A3300387 RR JMP* (MESSAG) RETURN A3300388 RR SPC 2 A3300389 RRMESSAD ADC RECBUF 0 A3300390 RR ADC RECBUF 1 A3300391 RR ADC MESG02 2 A3300392 RR SPC 1 A3300393 RRMESLEN ADC 72 0 A3300394 RR ADC 72 1 A3300395 RR ADC 2*LMSG02 2 A3300396 RR SPC 1 A3300397 RRMESLUN ADC TERMLU 0 A3300398 RR ADC $18FC 1 A3300399 RR ADC TERMLU 2 A3300400 RR EJT A3300401 RR SPC 4 A3300402 RRMESG02 ALF $,SYSTEM MESSAGE XXXX$ A3300403 RR EQU LMSG02(*-MESG02) A3300404 RRREQBUF BZS REQBUF(24) A3300405 RRRECBUF BZS RECBUF(40) A3300406 RR END A3300407 RR NAM ULBUFF A34 A ITOS CCS 3.0 . SL-149 00001 RR* LINKAGE BUFFER SWAP AREA 00002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 00003 RR* DATA SYSTEMS-LA JOLLA DIVISION,LA JOLLA,CALIFORNIA 00004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 00005 RR* 00006 RR SPC 2 00007 RR* NUMBER OF TERMINALS = 57 (56 + MASTER CONSOLE) 00008 RR* SECTORS / ENTRY = 3 00009 RR* WORDS / SECTOR = 96 00010 RR SPC 2 00011 RR BZS X(57*3*96) MASS MEMORY FOR LINKAGE BUFFERS 00012 RR END 00013 RR NAM FUNSEL A35 A ITOS CCS 3.0 . SL-149A3500001 RR* FUNCTION MENU PROCESSOR A3500002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 A3500003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A3500004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 A3500005 RR* A3500006 RR SPC 2 A3500007 RR EXT TSAREA START OF THE USER AREA A3500008 RR EXT TERMLU COMMUNICATIONS CONTROLLER LOGICAL UNIT A3500009 RR EXT SYSMSG SYSTEM MESSAGE PROCESSOR A3500010 RR EXT OPENFL OPEN FILE REQUEST A3500011 RR EXT GETS GET SEQUENTIAL RECORD REQUEST A3500012 RR EXT CLOSFL CLOSE FILE REQUEST A3500013 RR EXT WTREAD SYSTEM WRITE-READ REQUEST A3500014 RR EXT CHAIN PROGRAM CHAIN REQUEST A3500015 RR EXT PGMOUT PROGRAM EXIT A3500016 RR EQU TWO($24) LOCATION CONTAINING TWO A3500017 RR EQU HX00FF($A) A3500018 RR EQU ZERO($22) LOCATION CONTAINING ZERO A3500019 RR EQU USMODE(135) USER EXECUTION MODE INDICATOR A3500020 RR EQU FIRCNO(240) INPUT FILE RECORD NUMBER - 2 WORDS A3500021 RR EQU Z($5A) LETTER 'Z' A3500022 RR EQU AMONI($F4) MONITOR REQUEST ENTRY A3500023 RR EQU MENUKY(133) REQUESTED FUNCTION MENU KEY A3500024 RR SPC 2 A3500025 RRFUNSEL NOP 0 A3500026 RR SPC 1 A3500027 RR ENA 2 A3500028 RR STA* MSGIDX INITIALIZE THE DISPLAY INDEX A3500029 RR LDA+ TSAREA A3500030 RR STA- I SET I = START OF THE USER AREA A3500031 RR ENA 0 REWIND THE PROCEDURE FILE A3500032 RR STA- FIRCNO+1,I A3500033 RR SPC 1 A3500034 RR LDA- MENUKY,I IS A MENU KEY DEFINED A3500035 RR SAZ FUN005 NO A3500036 RR STA* IDATA+1 SPECIFY THE FILE NAME A3500037 RR SPC 1 A3500038 RR RTJ+ OPENFL OPEN THE FUNCTION MENU FILE A3500039 RR ADC REQBUF A3500040 RR ADC IDATA A3500041 RR ADC ISTAT A3500042 RR SPC 1 A3500043 RR LDA* ISTAT WERE THERE ANY FILE ERRORS A3500044 RR SAP FUN010 NO A3500045 RR RTJ+ SYSMSG YES, REPORT THE ERROR A3500046 RR ADC E19 A3500047 RR ADC ISTAT A3500048 RRFUN005 JMP* FUN060 EXIT A3500049 RR EJT A3500050 RR SPC 4 A3500051 RRFUN010 RTJ+ GETS READ THE MENU FILE A3500052 RR ADC REQBUF A3500053 RR ADC RECBUF A3500054 RR ADC ZERO A3500055 RR ADC ISTAT A3500056 RR SPC 1 A3500057 RR LDA* ISTAT WERE THERE ANY FILE ERRORS A3500058 RR SAP FUN020 NO A3500059 RR RTJ+ SYSMSG YES, REPORT THE ERROR A3500060 RR ADC E22 A3500061 RR ADC ISTAT A3500062 RR JMP* FUN060 EXIT A3500063 RR SPC 1 A3500064 RRFUN020 RTJ+ CLOSFL CLOSE THE FILE A3500065 RR ADC REQBUF A3500066 RR ADC ISTAT A3500067 RR SPC 1 A3500068 RR LDA* ISTAT WERE THERE ANY FILE ERRORS A3500069 RR SAP FUN030 NO A3500070 RR RTJ+ SYSMSG YES, REPORT THE ERROR A3500071 RR ADC E20 A3500072 RR ADC ISTAT A3500073 RR JMP* FUN060 EXIT A3500074 RR SPC 1 A3500075 RRFUN030 ENQ 0 CLEAR THE SCREEN A3500076 RR RTJ* MESSAG A3500077 RR SPC 1 A3500078 RRFUN040 LDQ* MSGIDX A3500079 RR RTJ* MESSAG DISPLAY THE FUNCTION MENU A3500080 RR LDA REQBUF+14 A3500081 RR INA -1 DECREMENT THE RECORD COUNT A3500082 RR STA REQBUF+14 A3500083 RR SAZ FUN050 SKIP IF THE ENTIRE MENU IS DISPLAYED A3500084 RR RAO* MSGIDX A3500085 RR JMP* FUN040 CONTINUE A3500086 RR EJT A3500087 RRFUN050 SET A INITIALIZE THE INPUT BUFFER A3500088 RR STA* INPUT A3500089 RR SPC 1 A3500090 RR RTJ+ WTREAD REQUEST THE SELECTION A3500091 RR ADC MSLU A3500092 RR ADC XYOUT A3500093 RR ADC REQMSG A3500094 RR ADC REQLEN A3500095 RR ADC XYINP A3500096 RR ADC INPUT A3500097 RR ADC TWO A3500098 RR ADC TCODE A3500099 RR SPC 1 A3500100 RR LDA* INPUT A3500101 RR ALS 8 A3500102 RR SAM FUN055 SENSE ONLY 1 CHAR. ENTERED A3500103 RR JMP* FUN100 INDICATE INVALID ENTRY A3500104 RRFUN055 AND- HX00FF A3500105 RR STA* INPUT A3500106 RR INA -Z WAS AN EXIT REQUESTED A3500107 RR SAN FUN070 NO A3500108 RR SPC 1 A3500109 RR ENQ 0 CLEAR THE SCREEN A3500110 RR RTJ* MESSAG A3500111 RR SPC 1 A3500112 RRFUN060 ENA 0 RETURN TO INTERACTIVE MODE A3500113 RR STA- USMODE,I A3500114 RR RTJ+ PGMOUT EXIT A3500115 RR EJT A3500116 RR SPC 4 A3500117 RRFUN070 LDQ =XRECBUF Q = RECORD BUFFER ADDRESS A3500118 RRFUN080 LDA- (ZERO),Q A3500119 RR SUB =A * IS THIS A COMMENT A3500120 RR SAZ FUN090 YES A3500121 RR LDA- 5,Q NO A3500122 RR ARS 8 A3500123 RR SUB* INPUT IS THIS THE REQUESTED FUNCTION A3500124 RR SAZ FUN110 YES A3500125 RR SPC 1 A3500126 RRFUN090 INQ 40 INCREMENT TO THE NEXT RECORD A3500127 RR TRQ A A3500128 RR SUB =XRECEND HAS THE ENTIRE FILE BEEN SEARCHED A3500129 RR SAP FUN100 YES A3500130 RR JMP* FUN080 NO, CONTINUE A3500131 RR SPC 1 A3500132 RRFUN100 ENQ 1 POSITION THE CURSOR A3500133 RR RTJ MESSAG A3500134 RR RTJ+ SYSMSG INDICATE AN INVALID ENTRY A3500135 RR ADC E15 A3500136 RR ADC INPUT A3500137 RR JMP* FUN050 REQUEST ANOTHER INPUT A3500138 RR SPC 1 A3500139 RRFUN110 STQ* FUNPAR SPECIFY THE FUNCTION NAME A3500140 RR SPC 1 A3500141 RR ENQ 0 CLEAR THE SCREEN A3500142 RR RTJ* MESSAG A3500143 RR SPC 1 A3500144 RR RTJ+ CHAIN INITIATE THE REQUESTED FUNCTION A3500145 RRFUNPAR ADC 0 A3500146 RR EJT A3500147 RR SPC 4 A3500148 RR* D A T A A N D S T O R A G E A3500149 RR SPC 2 A3500150 RRMSGIDX ADC 0 DISPLAY MESSAGE INDEX A3500151 RRXYOUT NUM -1 CURSOR POSITION PRIOR TO OUTPUT(15*$100+23) A3500152 RRXYINP NUM -1 CURSOR POSITION PRIOR TO INPUT(28*$100+23) A3500153 RRREQLEN ADC REQLN*2 A3500154 RRTCODE ADC 0 TERMINATION CODE A3500155 RRE15 ADC 15 MESSAGE INDEX A3500156 RRE19 ADC 19 MESSAGE INDEX A3500157 RRE20 ADC 20 MESSAGE INDEX A3500158 RRE22 ADC 22 MESSAGE INDEX A3500159 RRINPUT NUM 0,0 SELECTION INPUT BUFFER A3500160 RRISTAT ADC 0 FILE REQUEST STATUS A3500161 RRIDATA ALF 4,$$ MENU FILE NAME A3500162 RR ALF 4,$$ FILE OWNER A3500163 RR ALF 4, FILE VOLUME A3500164 RR ADC 0 SEQUENTIAL ACCESS A3500165 RR ADC 24 NUMBER OF RECORDS A3500166 RR ADC 0 LOCK INDICATOR A3500167 RR EJT A3500168 RR SPC 4 A3500169 RR* M E S S A G E D I S P L A Y R O U T I N E A3500170 RR SPC 2 A3500171 RRMESSAG NOP 0 A3500172 RR SPC 1 A3500173 RR LDA* MESADD,Q A3500174 RR STA* MESA SAVE THE MESSAGE ADDRESS A3500175 RR LDQ* MESLEN,Q A3500176 RR QRS 1 A3500177 RR SPC 1 A3500178 RRMES010 INQ -1 A3500179 RR SQZ MES020 SENSE END OF MESSAGE A3500180 RR LDA* (MESA),Q A3500181 RR SUB =A IS THIS THE END OF THE TEXT A3500182 RR SAN MES020 YES A3500183 RR JMP* MES010 NO, CONTINUE A3500184 RR SPC 1 A3500185 RRMES020 INQ 1 A3500186 RR QLS 1 A3500187 RR STQ* MESL SAVE THE MESSAGE LENGTH A3500188 RR SPC 1 A3500189 RR RTJ- (AMONI) A3500190 RR ADC $4C44 FORMATTED WRITE REQUEST A3500191 RR ADC 0 A3500192 RR ADC 0 A3500193 RRMSLU ADC TERMLU A3500194 RRMESL ADC 0 A3500195 RRMESA ADC 0 A3500196 RR SPC 1 A3500197 RR JMP* (MESSAG) RETURN A3500198 RR EJT A3500199 RRMESADD ADC MESG00 00 A3500200 RR ADC MESG01 01 A3500201 RR ADC RECBUF+004 02 A3500202 RR ADC RECBUF+044 03 A3500203 RR ADC RECBUF+084 04 A3500204 RR ADC RECBUF+124 05 A3500205 RR ADC RECBUF+164 06 A3500206 RR ADC RECBUF+204 07 A3500207 RR ADC RECBUF+244 08 A3500208 RR ADC RECBUF+284 09 A3500209 RR ADC RECBUF+324 10 A3500210 RR ADC RECBUF+364 11 A3500211 RR ADC RECBUF+404 12 A3500212 RR ADC RECBUF+444 13 A3500213 RR ADC RECBUF+484 14 A3500214 RR ADC RECBUF+524 15 A3500215 RR ADC RECBUF+564 16 A3500216 RR ADC RECBUF+604 17 A3500217 RR ADC RECBUF+644 18 A3500218 RR ADC RECBUF+684 19 A3500219 RR ADC RECBUF+724 20 A3500220 RR ADC RECBUF+764 21 A3500221 RR ADC RECBUF+804 22 A3500222 RR ADC RECBUF+844 23 A3500223 RR ADC RECBUF+884 24 A3500224 RR ADC RECBUF+924 25 A3500225 RR SPC 1 A3500226 RRMESLEN ADC 2*LMES00 00 A3500227 RR ADC 2*LMES01 01 A3500228 RR ADC 2*32 02 A3500229 RR ADC 2*32 03 A3500230 RR ADC 2*32 04 A3500231 RR ADC 2*32 05 A3500232 RR ADC 2*32 06 A3500233 RR ADC 2*32 07 A3500234 RR ADC 2*32 08 A3500235 RR ADC 2*32 09 A3500236 RR ADC 2*32 10 A3500237 RR ADC 2*32 11 A3500238 RR ADC 2*32 12 A3500239 RR ADC 2*32 13 A3500240 RR ADC 2*32 14 A3500241 RR ADC 2*32 15 A3500242 RR ADC 2*32 16 A3500243 RR ADC 2*32 17 A3500244 RR ADC 2*32 18 A3500245 RR ADC 2*32 19 A3500246 RR ADC 2*32 20 A3500247 RR ADC 2*32 21 A3500248 RR ADC 2*32 22 A3500249 RR ADC 2*32 23 A3500250 RR ADC 2*32 24 A3500251 RR ADC 2*32 25 A3500252 RR EJT A3500253 RR SPC 4 A3500254 RRMESG00 ADC $181A A3500255 RR EQU LMES00(*-MESG00) A3500256 RR SPC 1 A3500257 RRMESG01 ADC $1A1A A3500258 RR EQU LMES01(*-MESG01) A3500259 RR SPC 1 A3500260 RRREQMSG NUM $D0A A3500261 RR NUM $A53 (LF,'S') A3500262 RR ALF $,ELECTION = $ A3500263 RR EQU REQLN(*-REQMSG) A3500264 RR SPC 1 A3500265 RRREQBUF BZS REQBUF(9) FILE REQUEST BUFFER A3500266 RR ADC FCBUFF A3500267 RR BZS REQEND(14) A3500268 RR SPC 1 A3500269 RRRECBUF BZS RECBUF(24*40) FILE RECORD BUFFER A3500270 RR EQU RECEND(*) RECORD BUFFER ENDING ADDRESS A3500271 RR SPC 1 A3500272 RRFCBUFF BZS FCBUFF(15) A3500273 RR SPC 2 A3500274 RR END A3500275 RR NAM NDWMTH A36 A ITOS CCS 3.0 SL-149A3600001 RR* DOUBLE-WORD MATH SUBROUTINES - NONREETRANT VERSION A3600002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 A3600003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A3600004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 A3600005 RR* A3600006 RR* A3600007 RR* THIS PACKAGE PROVIDES SUBROUTINES TO PERFORM A3600008 RR* THREE DOUBLE WORD ARITHMETIC OPERATIONS. A3600009 RR* THE DOUBLE WORD FORMAT IS THE SAME AS THE A3600010 RR* MSB/LSB FORMAT USED FOR SECTOR AND WORD A3600011 RR* ADDRESSING: WORD 1 OF A DOUBLE WORD VALUE A3600012 RR* CONTAINS THE UPPER 15 BITS OF THE VALUE - AN A3600013 RR* INTEGRAL MULTIPLE OF 32767, WORD 2 CONTAINS A3600014 RR* THE LOWER 15 BITS OF THE VALUE (BIT 15 = 0). A3600015 RR* IN THE FOLLOWING DESCRIPTIONS 'DWV' REFERS TO A3600016 RR* 'DOUBLE WORD VALUE'. A3600017 RR* A3600018 RR* THE FOLLOWING OPERATIONS ARE IMPLEMENTED: A3600019 RR* ADD A DWV TO A 2ND DWV A3600020 RR* SUBTRACT A DWV FROM ANOTHER DWV A3600021 RR* MULTIPLE A DWV BY A SINGLE WORD VALUE A3600022 RR* A3600023 RR* TO UTILIZE ONE OF THESE ROUITNES, THE CALLER A3600024 RR* STORES THE VALUES TO BE OPERATED ON IN AN A3600025 RR* ARRAY, SETS THE Q-REGISTER TO THE ADDRESS OF A3600026 RR* THE ARRAY AND EXECUTES A RTJ TO THE APPROPRI- A3600027 RR* ATE ROUTINE. THE I REGISTER CONTENTS WILL BE A3600028 RR* SAVED AND RESTORED PRIOR TO RETURN TO THE A3600029 RR* CALLER. THE COMPLETION STATUS WILL BE 0 IF A3600030 RR* GOOD, ELSE IT WILL BE NON-ZERO. A3600031 RR* A3600032 RR* THE ENTRY POINT NAMES ARE AS FOLLOWS: A3600033 RR ENT DWADD DOUBLE WORD ADD A3600034 RR ENT DWSUB DOUBLE WORD SUBTRACT A3600035 RR ENT DWMUL DOUBLE WORD MULTIPLY A3600036 RR* A3600037 RR EQU ZERO($22) A3600038 RR EQU ONEMSK(3) A3600039 RR EQU ONEBIT($23) A3600040 RR EJT A3600041 RR* THE ARRAY PARAMETER LISTS ARE AS FOLLOWS: A3600042 RR* FOR DWADD A3600043 RR* WORD DESCRIPTION A3600044 RR* 1 MSB OF 1ST DWV A3600045 RR* 2 LSB OF 1ST DMV A3600046 RR* 3 MSB OF 2ND DMV A3600047 RR* 4 LSB OF 2ND DMV A3600048 RR* 5 MSB OF RESULT DMV A3600049 RR* 6 LSB OF RESULT DMV A3600050 RR* 7 COMPLETION STATUS A3600051 RR* A3600052 RR* FOR DWSUB A3600053 RR* WORD DESCRIPTION A3600054 RR* 1 MSB OF MINUEND A3600055 RR* 2 LSB OF MINUEND A3600056 RR* 3 MSB OF SUBTRAHEND A3600057 RR* 4 LSB OF SUBTRAHEND A3600058 RR* 5 MSB OF RESULT A3600059 RR* 6 LSB OF RESULT A3600060 RR* 7 COMPLETION STATUS A3600061 RR* FOR DWMUL A3600062 RR* WORD DESCRIPTION A3600063 RR* 1 MSB OF DWV A3600064 RR* 2 LSB OF DMV A3600065 RR* 3 SINGLE WORD VALUE A3600066 RR* 4 MSB OF RESULT A3600067 RR* 5 LSB OF RESULT A3600068 RR* 6 COMPLETION STATUS A3600069 RR* A3600070 RR EJT A3600071 RRDWADD 000 000 DOUBLE WORD ADD ROUTINE A3600072 RRA1 LDA- I SAVE I-REG CONTENTS A3600073 RR STA* ISAVE A3600074 RR STQ- I SET I TO ARRAY ADDRESS A3600075 RR LDA- 1,I SET A TO LSB A3600076 RR ENQ 0 CLEAR Q FOR USE AS MSB OFFSET A3600077 RR SOV 0 CLEAR OVERFLOW STATUS A3600078 RR ADD- 3,I ADD LSB A3600079 RR SNO A2 SKIP TO A3 IF NO OVERFLOW A3600080 RR AND- ONEMSK+14 MASK OUT BIT 15 A3600081 RR INQ 1 BUMP Q TO PUT OVERFLOW IN MSB A3600082 RRA2 SAP A3 SKIP IF RESULT POSITIVE A3600083 RR INQ -1 SUBTRACT 1 FROM Q FOR MSB OFFSET A3600084 RR ADD- ONEBIT+15 MAKE LSW POSITIVE A3600085 RRA3 STA- 5,I STORE LSB A3600086 RR TRQ A TRANSFER MSB OFFSET TO A A3600087 RR SOV 0 CLEAR OVERFLOW A3600088 RR ADD- (ZERO),I ADD THE TWO MSBS TO THE OFFSET A3600089 RR ADD- 2,I A3600090 RR STA- 4,I STORE MSB A3600091 RR ENQ 0 CLEAR Q FOR COMPLETION STATUS A3600092 RR SOV A4 SET TO BAD COMPLETION IF OVERFLOW OR A-REG NEGA3600093 RR SAP A5 A3600094 RRA4 ENQ 1 A3600095 RRA5 STQ- 6,I A3600096 RR LDA- 2,I COMPLEMENT 2ND DWV IF COMPLEMENTED BY US A3600097 RR SAP A6 SKIP IF NOT COMPLEMENTED A3600098 RR TCA A A3600099 RR STA- 2,I A3600100 RR LDA- 3,I A3600101 RR TCA A A3600102 RR STA- 3,I A3600103 RRA6 LDA* ISAVE RESTORE I-REG A3600104 RR STA- I A3600105 RR JMP* (DWADD) A3600106 RR SPC 4 A3600107 RRISAVE NUM 0 A3600108 RR EJT A3600109 RRDWSUB 000 0 DOUBLE WORD SUBTRACT ROUTINE A3600110 RR LDA* DWSUB A3600111 RR STA* DWADD STORE RETURN ADDRESS IN DWADD'S ENTRY POINT A3600112 RR LDA- 2,Q COMPLEMENT SUBTRAHEND AND USE DWADD TO ADD A3600113 RR TCA A A3600114 RR STA- 2,Q A3600115 RR LDA- 3,Q A3600116 RR TCA A A3600117 RR STA- 3,Q A3600118 RR JMP* A1 A3600119 RR EJT A3600120 RRDWMUL 000 000 DOUBLE WORD MULTIPLY A3600121 RR LDA- I A3600122 RR STA* ISAVE SAVE I-REG A3600123 RR STQ- I SET I TO ARRAY ADDRESS A3600124 RR LDA- 1,I SET A TO LSB OF DOUBLE WORD VALUE A3600125 RR MUI- 2,I MULTIPLY BY SINGLE WORD VALUE A3600126 RR LLS 1 A3600127 RR ALS 15 CONVERT TO DOUBLE PRECISION FORMAT A3600128 RR STQ* SAVE SAVE MSB A3600129 RR STA- 4,I STORE LSB IN RESULT A3600130 RR LDA- (ZERO),I A3600131 RR MUI- 2,I MULTIPLY MSB BY SINGLE WORD A3600132 RR LLS 1 A3600133 RR ALS 15 DOUBLE PRECISION FORMAT A3600134 RR SOV 0 CLEAR OVERFLOW A3600135 RR INQ 0 CHECK FOR OVERFLOW A3600136 RR SQZ 2 A3600137 RR LDQ- $11 SET OVERFLOW IND A3600138 RR INQ 1 A3600139 RR LDQ* SAVE ADD MSB THAT WAS SAVED A3600140 RR AAQ Q ADD IN RESULT FROM MSB MULTIPLY A3600141 RR STQ- 3,I STORE IN RESULT A3600142 RR CLR A A3600143 RR SOV M0 SKIP IF OVERFLOW A3600144 RR SQP M1 A3600145 RRM0 INA 1 A3600146 RRM1 STA- 5,I SET STATUS WORD, 0 IF GOOD, 1 IF BAD A3600147 RR LDA* ISAVE RESTORE I-REG A3600148 RR STA- I A3600149 RR JMP* (DWMUL) RETURN TO CALLER A3600150 RR SPC 2 A3600151 RRSAVE NUM 0 A3600152 RR END A3600153 RR NAM CHGTPT A37 A ITOS CCS 3.0 SL-149A3700001 RR* TERMINAL MANAGER CHARACTER ROUTINES A3700002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 A3700003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A3700004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 A3700005 RR* A3700006 RR* CHARACTER HANDLING ROUTINES FOR ITOS TERMINAL MANAGER A3700007 RR* INTEGER FUNCTION GETCHR(IARRAY,ICHAR) A3700008 RR* SUBROUTINE PUTCHR(IVAR,IARRAY,ICHAR) A3700009 RR SPC 3 A3700010 RR ENT GETCHR A3700011 RR ENT PUTCHR A3700012 RR SPC 1 A3700013 RR EXT Q8PREP A3700014 RR EXT Q8PKUP A3700015 RR SPC 1 A3700016 RR EQU ZERO($22) A3700017 RR SPC 3 A3700018 RRGETCHR NOP 0 A3700019 RR STQ* SAVEQ SAVE CALLER'S Q-REGISTER A3700020 RR RTJ* (APREP) A3700021 RR ADC* GETCHR A3700022 RR RTJ* (APKUP) GET ARRAY ADDRESS A3700023 RR STA* IARRAY SAVE A3700024 RR RTJ* (APKUP) GET ADDRESS OF CHARACTER POSITION A3700025 RR LRQ- (ZERO),A CHARACTER POSITION TO Q A3700026 RR INQ -1 FORM CHARACTER INDEX A3700027 RR LCA* (IARRAY),Q PICK UP CHARACTER A3700028 RR LDQ* SAVEQ RESTORE CALLER'S Q-REGISTER A3700029 RR JMP* (GETCHR) RETURN WITH CHARACTER IN A A3700030 RR SPC 2 A3700031 RRAPREP ADC Q8PREP A3700032 RRAPKUP ADC Q8PKUP A3700033 RRSAVEQ ADC 0 A3700034 RRIARRAY ADC 0 ADDRESS OF ARRAY A3700035 RRIVAR ADC 0 ADDRESS OF VARIABLE A3700036 RR SPC 2 A3700037 RRPUTCHR NOP 0 A3700038 RR STQ* SAVEQ SAVE CALLER'S Q-REGISTER A3700039 RR RTJ* (APREP) A3700040 RR ADC* PUTCHR A3700041 RR RTJ* (APKUP) PICK UP CHARACTER ADDRESS A3700042 RR STA* IVAR SAVE A3700043 RR RTJ* (APKUP) GET ARRAY ADDRESS A3700044 RR STA* IARRAY SAVE A3700045 RR RTJ* (APKUP) GET ADDRESS OF CHARACTER POSITION A3700046 RR LRQ- (ZERO),A PICK UP CHARACTER POSITION A3700047 RR INQ -1 FORM CHARACTER INDEX A3700048 RR LDA* (IVAR) CHARACTER TO A A3700049 RR SCA* (IARRAY),Q STORE CHARACTER IN ARRAY A3700050 RR LDQ* SAVEQ RESTORE CALLER'S Q-REGISTER A3700051 RR JMP* (PUTCHR) RETURN A3700052 RR END A3700053 RR NAM DBATOU A38 A ITOS CCS 3.0 SL-149A3800001 RR* DEFERRED BATCH OUTPUT DRIVER A3800002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 A3800003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A3800004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 A3800005 RR* A3800006 RR**** A3800007 RR*E A3800008 RR* FUNCTION A3800009 RR* -------- A3800010 RR* A3800011 RR* A3800012 RR* A3800013 RR* THIS PSEUDO DRIVER ROUTES THE OUTPUT FROM DEFERRED A3800014 RR* BATCH PROCESSING TO FILE MANAGER FILES FOR SUBSEQUENT A3800015 RR* LISTING OR REVIEW AT A PRINT DEVICE OR AN ITOS USER A3800016 RR* TERMINAL. A3800017 RR* A3800018 RR* A3800019 RR* A3800020 RR* A3800021 RR* A3800022 RR* GENERAL DESCRIPTION A3800023 RR* ------------------- A3800024 RR* A3800025 RR* A3800026 RR* A3800027 RR* A CHECK IS MADE ON ENTRY TO DETERMINE IF THE REQUEST A3800028 RR* IS A MOTION COMMAND. IF NOT THEN A SCRATCH FILE IS A3800029 RR* CREATED VIA THE FILE MANAGER IF ONE DOES NOT ALREADY A3800030 RR* EXIST FOR THIS LOGICAL UNIT. IN ORDER TO IDENTIFY THE A3800031 RR* JOB THE REQUESTOR'S BUFFER IS SEARCHED FOR THE FOL- A3800032 RR* LOWING CHARACTER STRING: *JOB,JMNN ; WHERE MNN ARE A3800033 RR* UNIQUE DIGITS. THE JOB ID, IF ANY, IS SAVED FOR LATTER A3800034 RR* USE. THE REQUESTOR'S RECORD AND EACH SUBSEQUENT RECORD A3800035 RR* IS PUT IN THE SCRATCH FILE. A3800036 RR* A3800037 RR* AN EOF MOTION REQUEST INDICATES END OF JOB FOR THIS A3800038 RR* LOGICAL UNIT. THE NUMBER OF RECORDS IN THE SCRATCH A3800039 RR* FILE IS THEN REDUCED TO THE ACTUAL NUMBER OF RECORDS A3800040 RR* STORED IN IT. IF THE JOB HAS BEEN IDENTIFIED, THE A3800041 RR* STATUS OF THE JOB IS UPDATED IN THE APPROPRIATE $$HOST A3800042 RR* FILE ENTRY. IF THE JOB STATUS WAS DISCARD PENDING A3800043 RR* THEN THE SCRATCH FILE IS DELETED. IF NOT, THE A3800044 RR* APPROPRIATE $$BATCH FILE ENTRY IS UPDATED WITH THE A3800045 RR* PRESENT DATE/TIME JOB RECEIVED AND THE SCRATCH FILE A3800046 RR* IS RENAMED WITH THE JOB ID (JMNN). A3800047 RR* A3800048 RR* IF THE JOB IS UNIDENTIFIED, THE $$PRINT FILE IS A3800049 RR* ACCESSED FOR AN AVAILABLE ENTRY AND UPDATED WITH FILE A3800050 RR* VOLUME NAME, DATE/TIME OF ENTRY, AND NUMBER OF RECORDS A3800051 RR* IN THE FILE. THE SCRATCH FILE IS THEN RENAMED PRXX A3800052 RR* WHERE XX IS BASED ON THE $$PRINT FILE ENTRY. A3800053 RR* A3800054 RR* THE ONLY OTHER MOTION REQUEST ALLOWED IS BACKSPACE A3800055 RR* ONE FILE. THIS CAUSES THE SCRATCH FILE TO BE DELETED A3800056 RR* AND ALL RECORDS THEREIN ARE LOST. A3800057 RR* A3800058 RR* A3800059 RR* A3800060 RR* A3800061 RR* A3800062 RR* ENTRY A3800063 RR* ----- A3800064 RR* A3800065 RR* A3800066 RR* A3800067 RR* ENTRY IS AT THE INITIATOR DBATOU VIA NORMAL FWRITE A3800068 RR* AND MOTION REQUESTS. THERE ARE NO CONTINUATOR OR A3800069 RR* ERROR ENTRIES. A3800070 RR* A3800071 RR* A3800072 RR* A3800073 RR* A3800074 RR* A3800075 RR* EXIT A3800076 RR* ---- A3800077 RR* A3800078 RR* A3800079 RR* A3800080 RR* NORMAL EXIT IS MADE TO THE DISPATCHER AFTER ALL A3800081 RR* REQUESTS ARE PROCESSED. A3800082 RR* A3800083 RR* EXIT ON ERROR IS TO THE ALTERNATE DEVICE HANDLER WITH A3800084 RR* THE SOFTWARE DUMMY DEVICE AS ALTERNATE. A3800085 RR* A3800086 RR* A3800087 RR* A3800088 RR* A3800089 RR* A3800090 RR* ENTRY POINTS A3800091 RR* ------------ A3800092 RR* A3800093 RR* A3800094 RR* A3800095 RR ENT DBATOU INITIATOR ENTRY A3800096 RR ENT ABSADD ADDRESS ABSOLUTIZING ROUTINE A3800097 RR* A3800098 RR* A3800099 RR* A3800100 RR* A3800101 RR* A3800102 RR* EXTERNAL REFERENCES A3800103 RR* ------------------- A3800104 RR* A3800105 RR* A3800106 RR* A3800107 RR EXT ALTDEV ALTERNATE DEVICE HANDLER A3800108 RR EXT MAS300 A3800109 RR EXT DAYTO CURRENT DAY (INTEGER) A3800110 RR EXT MONTO CURRENT MONTH (INTEGER) A3800111 RR EXT YERTO CURRENT YEAR (INTEGER) A3800112 RR EXT HORTO CURRENT HOUR (INTEGER) A3800113 RR EXT MINTO CURRENT MINUTE (INTEGER) A3800114 RR EXT SECON CURRENT SECOND (INTEGER) A3800115 RR EXT WKSPLU VOLUME UNIT FOR SCRATCH FILE DEFINITION A3800116 RR EXT MMLUTB FILE MANAGER VOLUME INFORMATION TABLE A3800117 RR EXT SYFAIL SYSTEM FAILURE PROCESSOR A3800118 RR EXT* CREAT FILE MANAGER CREATE FILE REQUEST. A3800119 RR EXT* DELET FILE MANAGER DELETE FILE REQUEST. A3800120 RR EXT* REDUC FILE MANAGER REDUCE FILE REQUEST. A3800121 RR EXT* PUTZ FILE MANAGER PUTS REQUEST. A3800122 RR EXT* RENAM FILE MANAGER RENAME FILE REQUEST. A3800123 RR EXT* BOPENF BATCH DRIVER OPEN FILE ROUTINE A3800124 RR EXT* OPHOST BATCH DRIVER OPEN $$HOST FILE ROUTINE A3800125 RR EXT* OPBATF BATCH DRIVER OPEN $$BATCH FILE ROUTINE A3800126 RR EXT* BCLOSF BATCH DRIVER CLOSE FILE ROUTINE A3800127 RR EXT* BREADR BATCH DRIVER READ SPECIFIC RECORD ROUTINE A3800128 RR EXT* BGETS BATCH DRIVER RETRIEVE NEXT RECORD ROUTINE A3800129 RR EXT* BUPREC BATCH DRIVER STORE UPDATED RECORD ROUTINE A3800130 RR EXT* BFWRIT BATCH DRIVER WRITE COMMENT DEVICE MSG A3800131 RR EXT* BTIMER BATCH DRIVER TIMER REQUEST ROUTINE A3800132 RR* A3800133 RR* A3800134 RR* A3800135 RR* A3800136 RR* A3800137 RR* EQUATES A3800138 RR* ------- A3800139 RR EQU LPMSK(2) LOGICAL PRODUCT MASK A3800140 RR EQU ONE($3) LOCATION 3 CONTAINS $1 A3800141 RR EQU NZERO($12) NEG-ZERO MASK ($FFFF) A3800142 RR EQU NONE($13) NEG-ONE IN LOCORE ($FFFE) A3800143 RR EQU ZERO($22) LOCATION $22 CONTAINS 0 A3800144 RR EQU TEN($46) DECIMAL TEN A3800145 RR EQU FNR($B5) ADDRESS OF FNR A3800146 RR EQU COMPRQ($B6) ADDRESS OF COMPRQ A3800147 RR EQU ECT($E9) ADDRESS OF EXTENDED CORE TABLE A3800148 RR EQU DISP($EA) LOCATION OF DISPATCHER A3800149 RR* A3800150 RR EQU MAXTRY($B) MAXIMUM NUMBER OF RETRY PERMITTED ($01FF) A3800151 RR EQU EOF(2) EOF MOTION CODE A3800152 RR EQU BSF(6) BACKSPACE FILE MOTION CODE A3800153 RR EQU MOT(14) MOTION REQUEST CODE A3800154 RR EQU ESC($1B) ESCAPE CODE USED BY HASP OUTPUT A3800155 RR EQU MAXWDS(72) MAX NUMBER WORDS PER USER REQUEST A3800156 RR EQU RECBFL(74) RECBUF LENGTH -1 A3800157 RR EQU RCLENG(146) RECORD LENGTH IN BYTES OF SCRATCH FILE A3800158 RR EQU NUMRC(9999) MAXIMUM NUMBER OF RECORDS SCRATCH FILE A3800159 RR EQU BCMSK($6420) CREATE FILE BUSY MASK, RETRY PERMITTED A3800160 RR EQU BOSMSK($6A27) OPEN SCRATCH FILE BUSY MASK A3800161 RR EQU HBMSKO($6A23) BUSY MASK FOR $$HOST OPEN REQUEST A3800162 RR EQU BGETSM($61B0) BUSY MASK FOR GETS REQUEST A3800163 RR EQU HBMSKR($6334) BUSY MASK FOR HOST READR RQST A3800164 RR* A3800165 RR* RELATIVE ADDRESSES INTO PHYSICAL DEVICE TABLE A3800166 RR* -------------- A3800167 RR* A3800168 RR* A3800169 RR* A3800170 RR EQU ELVL(0) PBATXX ADC $5200+LVL SCHDL CALL A3800171 RR EQU EDIN(1) ADC DBATIN INITIATOR A3800172 RR EQU EDCN(2) ADC 0 (NOT USED) A3800173 RR EQU EDPGM(3) ADC 0 (NOT USED) A3800174 RR EQU EDCLK(4) NUM -1 (NOT USED) A3800175 RR EQU ELU(5) NUM 0 LOGICAL UNIT A3800176 RR EQU EPTR(6) NUM 0 REQ LOCATION A3800177 RR EQU EWES(7) NUM 0 (NOT USED) A3800178 RR EQU EREQST(8) NUM $08A4 REQ. STATUS A3800179 RR EQU ESTAT1(9) NUM 0 DRIVER STATUS A3800180 RR EQU ECCOR(10) NUM 0 CURRENT LOC. A3800181 RR EQU ELSTWD(11) NUM 0 LWA+1 A3800182 RR EQU ESTAT2(12) NUM 0 DEVICE STATUS A3800183 RR EQU MASLGN(13) NUM 0 MM LENGTH A3800184 RR EQU MASSEC(14) NUM $7FFF MM SECTOR A3800185 RR EQU RETURN(15) NUM 0 RESERVED A3800186 RR EQU HSTRNO(16) NUM 0,0 $$HOST REL A3800187 RR* REC. NO. A3800188 RR EQU HSTNN(18) NUM 0 TERM/JOB ID A3800189 RR EQU ERSTAT(19) NUM 0 FM ERR STATUS A3800190 RR EQU TIMTRY(20) NUM $8000 ENABLE DIAG/ A3800191 RR* FM CODE/TRYS A3800192 RR EQU JOBKEY(21) ALF 2,J $$BATCH KEY A3800193 RR EQU MOTPAR(23) NUM 0 MOTION PARM. A3800194 RR EQU RTJCAL(24) BZS RTJBF(13) FM/MONI CALLS A3800195 RR EQU REQBUF(37) BZS REQBUF(24) FM 'REQBUF' A3800196 RR EQU IDATA(61) BZS IDATBF(24) FM 'IDATA' A3800197 RR EQU ISTAT(85) BZS ISTABF(1) FM 'ISTAT' A3800198 RR EQU RECBUF(86) BZS RECBF(75) FM 'RECBUF' A3800199 RR* A3800200 RR EQU NEWNAM(IDATA+15) A3800201 RR EQU NMBREC(IDATA+22) A3800202 RR EQU RELREC(IDATA+23) A3800203 RR**** A3800204 RR EJT A3800205 RRSTARTM STQ- I MASS MEMORY ENTRY TO DRIVER A3800206 RR LDQ =XDBATOU-STARTM A3800207 RR AAQ Q A3800208 RR STQ- 1,I SET UP INITIATOR ENTRY A3800209 RR JMP* DBO010 A3800210 RRMS300 ADC MAS300 A3800211 RRDBATOU EQU DBATOU(*) INITIATOR ENTRY A3800212 RR STQ- I PHYTAB ADR TO I-REG A3800213 RRDBO010 EQU DBO010(*) A3800214 RR RTJ- (FNR) FIND NEXT RQST A3800215 RR JMP* (MS300) NO RQST OUTSTANDING A3800216 RR* A3800217 RR* START PROCESSING REQUEST A3800218 RR* A3800219 RR ENA 0 INITIALIZE PHYTAB- A3800220 RR STA- ERSTAT,I REPORTED FM ERROR STATUS A3800221 RR SFA- TIMTRY,14,15,I FM RQST CODE/TIMER TRYS A3800222 RR STA- MOTPAR,I MOTION PARAMETER A3800223 RR* A3800224 RR* CHECK FOR MOTION REQUEST A3800225 RR* A3800226 RR LDQ- EPTR,I PARAMETER LOCATION IN Q-REG A3800227 RR LFA- (ZERO),13,5,Q A-REG = RQST CODE A3800228 RR INA -MOT SUBTRACT MOTION RQST CODE ($E) A3800229 RR SAN DBO020 SKIP IF NOT MOTION RQST A3800230 RR JMP DBO320 GO PROCESS MOTION RQST A3800231 RR* A3800232 RR* PROCESS FWRITE REQUEST A3800233 RR* A3800234 RRDBO020 EQU DBO020(*) A3800235 RR SFZ- HSTNN,13,1,I SKIP IF SCRATCH FILE NOT CREATED A3800236 RR JMP* DBO130 CONTINUE PROCESSING A3800237 RR* A3800238 RR* SETUP TO CREATE SCRATCH FILE A3800239 RRDBO030 EQU DBO030(*) A3800240 RR ENA 0 A3800241 RR STA- JOBKEY,I INIT JOBKEY A3800242 RR STA- JOBKEY+1,I A3800243 RR ENQ 23 CLEAR IDATA A3800244 RRDBO040 EQU DBO040(*) A3800245 RR STA- IDATA,B A3800246 RR DQP *-DBO040 A3800247 RR ENA 5 SET CODE FOR 'CREATE' A3800248 RR SFA- TIMTRY,12,4,I A3800249 RR RTJ DBO570 SETUP NAME, OWNER, VOLUME IN IDATA 1-12 A3800250 RR LDA* RECLEN RECORD LENGTH IN BYTES A3800251 RR STA- IDATA+12,I A3800252 RR LDA* NUMREC LSB NUMBER OF RECORDS A3800253 RR STA- IDATA+14,I A3800254 RR JMP* DBO045 GO SETUP 'CREATE' REQUEST A3800255 RRRECLEN ADC RCLENG RECORD LENGTH IN BYTES A3800256 RRNUMREC ADC NUMRC MAXIMUM NUMBER OF RECORDS TO BE STORED A3800257 RR EJT A3800258 RR* A3800259 RR* THE FOLLOWING CODE STARTING AT LABEL 'CENTRY' THRU A3800260 RR* LABEL 'CCALTH' IS NOT EXECUTED IN THE DRIVER, BUT IS A3800261 RR* BUILT AND MOVED TO THE PHYSTB. THE CODE IS THEN A3800262 RR* EXECUTED FROM THE PHYSTB WITH RETURN TO THE DRIVER. A3800263 RR* A3800264 RRCENTRY NUM 0 ENTRY A3800265 RRCEN010 RTJ+ SYFAIL CREATE FILE REQUEST A3800266 RR ADC (REQBUF-RTJCAL-3) REL ADR TO 'REQBUF' PARAMETER A3800267 RR ADC (IDATA-RTJCAL-4) A3800268 RR ADC (ISTAT-RTJCAL-5) A3800269 RR LDA- ISTAT,I PICKUP 'CREATE' REQUEST STATUS A3800270 RR STA- ERSTAT,I SAVE REQUEST STATUS A3800271 RR JMP* (CENTRY) RETURN TO CALLER A3800272 RRCCALTH EQU CCALTH(*-CENTRY-1) A3800273 RR* A3800274 RR* CALLER'S Q/I REGISTERS PRESERVED BY FM A3800275 RR* A3800276 RR EJT A3800277 RRDBO045 RTJ ABSADD ABSOLUTIZE THE FILE REQUEST ADDRESS A3800278 RR ADC* CREAT A3800279 RR STA* CEN010+1 STORE IN THE REQUEST A3800280 RR ENQ CCALTH MOVE 'CREATE' ROUTINE TO PHYSTB A3800281 RRDBO047 EQU DBO047(*) A3800282 RR LDA* CENTRY,Q A3800283 RR STA- RTJCAL,B A3800284 RR DQP *-DBO047 A3800285 RRDBO050 EQU DBO050(*) A3800286 RR RTJ- RTJCAL,I GO EXECUTE ROUTINE IN PHYSTB A3800287 RR* A3800288 RR* RETURN FROM 'CREATE' ROUTINE IN PHYSTB, A-REG = ISTAT A3800289 RR* A3800290 RR* A3800291 RR* CHECK FM STATUS A3800292 RR* A3800293 RR* REG A IS RQST STATUS A3800294 RR LR1- NZERO REG 1 IS NO REJECT MASK A3800295 RR LDQ =XBCMSK REG Q IS REJECT BUSY MASK A3800296 RR RTJ RETRY CHECK IF BUSY, RETRY PERMITTED A3800297 RR JMP* DBO050 BUSY, RETRY A3800298 RR* A3800299 RR* IF ERROR RETURN IS TO ERROR ROUTINE. A3800300 RR* RETURN HERE IF NO ERROR. A3800301 RR* A3800302 RR* A3800303 RR* OPEN SCRATCH FILE WITH FILE LOCK A3800304 RR* A3800305 RRDBO080 EQU DBO080(*) A3800306 RR SEF- HSTNN,13,1,I SET SCRATCH FILE CREATED FLAG A3800307 RR ENA 0 A3800308 RR STA- IDATA+12,I IDATA(13) ACCESS INDICATOR A3800309 RR INA 1 A3800310 RR STA- IDATA+13,I IDATA(14) NUMBER RECORDS PER RETRIEVE A3800311 RR INA -2 A3800312 RR STA- IDATA+14,I IDATA(15) LOCK ENTIRE FILE (<0) A3800313 RRDBO090 EQU DBO090(*) A3800314 RR RTJ BOPENF OPEN THE SCRATCH FILE A3800315 RR* A3800316 RR* CHECK FM STATUS, IF PERMITTED RETRY ON ERROR A3800317 RR* A3800318 RR* REG A IS RQST STATUS A3800319 RR ENQ -4 A3800320 RR XFQ 1 REG 1 IS NO REJECT MASK A3800321 RR LDQ =XBOSMSK REG Q IS REJECT BUSY MASK A3800322 RR RTJ RETRY CHECK IF BUSY, RETRY PERMITTED A3800323 RR JMP* DBO090 BUSY, RETRY A3800324 RR* A3800325 RR* IF ERROR RETURN IS TO ERROR ROUTINE. A3800326 RR* RETURN HERE IF NO ERROR. A3800327 RR* A3800328 RR* A3800329 RR* PROCESS REQUESTOR'S BUFFER A3800330 RR* A3800331 RRDBO130 EQU DBO130(*) A3800332 RR LDA =A PREPARE TO BLANK RECBUF A3800333 RRDBO135 EQU DBO135(*-1) A3800334 RR ENQ RECBFL RECBUF LENGTH -1 A3800335 RRDBO140 EQU DBO140(*) A3800336 RR STA- RECBUF,B BLANK RECBUF A3800337 RR DQP *-DBO140 A3800338 RR LDA- ELSTWD,I COMPUTE LENGTH OF RQST A3800339 RR SUB- ECCOR,I A3800340 RR STA- RELREC,I SAVE RQST LENGTH TEMPORARILY A3800341 RR INA -9 BYPASS CHARACTER CHECKING IF .LT. 9 A3800342 RR SAP DBO150 SKIP IF MORE THAN 8 A3800343 RR JMP* DBO220 BYPASS CHARACTER CHECK A3800344 RR* A3800345 RR* SETUP TO BYPASS ESCAPE, CARRIAGE CONTROL SEQUENCE A3800346 RR* IF HASP JOB A3800347 RR* A3800348 RRDBO150 EQU DBO150(*) A3800349 RR ENQ 0 Q-REG IS CHARACTER INDEX A3800350 RR LDA- ECCOR,I A3800351 RR STA* START START IS 1ST LOCATION IN RQST BFR A3800352 RRDBO160 EQU DBO160(*) A3800353 RR ENA ESC A-REG HAS ESCAPE CHAR A3800354 RR CCE* (START),Q A3800355 RR JMP* DBO170 NO COMPARE, NOT ESCAPE A3800356 RR INQ 2 ESCAPE, SET TO CHECK NEXT PAIR A3800357 RR TRQ A SEE IF RQST BFR EXHAUSTED A3800358 RR SUB- RELREC,I SUBTRACT BFR LENGTH A3800359 RR SAP DBO185 SKIP IF BFR EXHAUSTED A3800360 RR JMP* DBO160 A3800361 RRSTART NUM 0 A3800362 RR* A3800363 RR* SETUP TO CHECK FOR - *JOB,J - CHARACTERS A3800364 RR* A3800365 RRDBO170 EQU DBO170(*) A3800366 RR QRS 1 Q-REQ IS NOW WORD INDEX IN RQST BFR A3800367 RR ADQ* START A3800368 RR STQ* START START IS NOW 1ST WORD ADR TO SEARCH A3800369 RR ENQ 5 COMPARE NEXT 2-6 CHARACTERS A3800370 RR* JOB PROCESSOR CHANGES ASTERISK A3800371 RR* TO CONTROL CHARACTER A3800372 RR ENA 4 A3800373 RR XFA 1 A3800374 RRDBO180 EQU DBO180(*) A3800375 RR LCA* (START),Q A3800376 RR CCE* JOB,Q A3800377 RRDBO185 JMP* DBO200 NO COMPARE, NOT - *JOB,J - STRING A3800378 RR INQ -1 A3800379 RR D1P *-DBO180 COMPARED OK, CHECK NEXT WORD A3800380 RR* A3800381 RR* IT IS A *JOB RECORD, PICKUP AND SAVE JOB NUMBER A3800382 RR* A3800383 RR ENQ 5 Q-REG IS CHARACTER INDEX TO START A3800384 RR ENA 0 A3800385 RR XFA 2 REG-2 IS CHARACTER INDEX TO STORE A3800386 RR ENA 3 A3800387 RR XFA 1 REG-1 IS LOOP INDEX A3800388 RRDBO190 EQU DBO190(*) A3800389 RR LCA* (START),Q PICKUP JOB NAME (JMNN) A3800390 RR SCA- JOBKEY,2,I AND SAVE FOR JOBKEY A3800391 RR AR2- ONE A3800392 RR INQ 1 A3800393 RR D1P *-DBO190 A3800394 RR JMP* DBO220 JOBNAM SAVED, CONTINUE PROCESSING A3800395 RR SPC 2 A3800396 RRJOB ALF 3,*JOB,J JOB IDENTIFICATION RECORD A3800397 RR EJT A3800398 RR* A3800399 RR* SETUP TO CHECK FOR - END OF JOB - CHARACTERS A3800400 RR* IN POSITION 15-24 (ONLY USED FOR 200UT JOBS) A3800401 RR* **** N O T E **** A3800402 RR* THE TECHNIQUE USED FOR 200UT END-OF-JOB A3800403 RR* DETERMINATION IS SPECIFIC FOR THE A3800404 RR* SUNNYVALE HOST. OTHER 200UT HOSTS MAY A3800405 RR* OR MAY NOT MEET THESE REQUIREMENTS. A3800406 RR* ****************** A3800407 RR* A3800408 RRDBO200 EQU DBO200(*) A3800409 RR SFZ- HSTNN,12,1,I A3800410 RR JMP* DBO220 EOJ ALREADY FOUND, CONTINUE PROCESSING A3800411 RR ENQ 14 SETUP TO SEARCH AT CHARATER 15 A3800412 RR ENA 0 A3800413 RR XFA 1 REG-1 IS CHARACTER INDEX TO COMPARE A3800414 RR ENA 9 A3800415 RR XFA 2 REG-2 IS LOOP COUNTER (10 CHARACTERS) A3800416 RRDBO210 EQU DBO210(*) A3800417 RR LCA* (START),Q A3800418 RR CCE* EOJ,1 A3800419 RR JMP* DBO220 NOT EQUAL, CONTINUE PROCESSING A3800420 RR INQ 1 CHAR MATCH, CHECK NEXT ONE A3800421 RR AR1- ONE A3800422 RR D2P *-DBO210 A3800423 RR SEF- HSTNN,12,1,I SET 200UT END OF JOB FLAG A3800424 RR SEF- HSTNN,8,1,I THERE IS 1 MORE RECORD (ALL BLANKS) AFTER EOJ A3800425 RR JMP* DBO240 GO STORE THE RECORD A3800426 RR SPC 2 A3800427 RREOJ ALF 5,END OF JOB 200UT EOJ RECORD IN CHARACTERS 15-24 A3800428 RR EJT A3800429 RR* A3800430 RR* CHECK TO SEE IF AT END OF SCRATCH FILE A3800431 RR* A3800432 RRDBO220 EQU DBO220(*) A3800433 RR SFZ- HSTNN,11,1,I SKIP IF INSUFFIEIENT SPACE FLAG NOT SET A3800434 RR JMP* DBO310 OUT OF SPACE, IGNORE RECORD A3800435 RR SFN- TIMTRY,12,4,I SKIP IF LAST FM RQST NOT OPEN A3800436 RR JMP* DBO240 SCRATCH FILE JUST OPENED A3800437 RR LDA- REQBUF+16,I LSB RELATIVE RECORD LAST STORED A3800438 RR SUB NUMREC MAX NUMBER OF RECORDS DEFINED A3800439 RR INA 1 LOOKING FOR LAST RECORD MINUS ONE A3800440 RR SAP DBO225 SKIP IF SPACE NOT AVAILABLE A3800441 RR JMP* DBO240 SPACE AVAILABLE, GO SETUP TO STORE RECORD A3800442 RRDBO225 EQU DBO225(*) A3800443 RR SEF- HSTNN,11,1,I THIS IS THE LAST RECORD, SET FLAG A3800444 RR ENQ LNALRT LENGTH OF ALERT MSG A3800445 RR STQ- RECBUF,I A3800446 RR INQ -1 A3800447 RRDBO230 EQU DBO230(*) A3800448 RR LDA* ALRT,Q MOVE ALERT MSG TO RECBUF A3800449 RR STA- RECBUF+1,B A3800450 RR DQP *-DBO230 A3800451 RR SEF- HSTNN,10,1,I SET ALERT OPERATOR FLAG A3800452 RR JMP* DBO280 GO STORE THE RECORD IN SCRATCH FILE A3800453 RR* A3800454 RR* ALERT MESSAGE, SCRATCH FILE SPACE EXCEEDED A3800455 RR* A3800456 RRALRT EQU ALRT(*) A3800457 RR ALF ., WARNING: OUTPUT DATA EXCEEDED OUTPUT FILE SPACE. A3800458 RRLNALRT EQU LNALRT(*-ALRT) A3800459 RR EJT A3800460 RR* A3800461 RR* SETUP TO WRITE THE RECORD TO THE SCRATCH FILE A3800462 RR* A3800463 RRDBO240 EQU DBO240(*) A3800464 RR ENA MAXWDS MAKE SURE RQST .LE. MAX WORDS PERMITTED A3800465 RR SUB- RELREC,I A3800466 RR SAP DBO250 SKIP IF LENGTH OF RQST OK A3800467 RR ENQ MAXWDS OTHERWISE MAK LENGTH .EQ. MAX WORDS A3800468 RR JMP* DBO260 A3800469 RRDBO250 EQU DBO250(*) A3800470 RR LDQ- RELREC,I A3800471 RRDBO260 EQU DBO260(*) A3800472 RR STQ- RECBUF,I SAVE NUMBER OF WORDS A3800473 RR INQ -1 SETUP INDEX TO MOVE RECORD A3800474 RR LR1- ELSTWD,I A3800475 RRDBO270 EQU DBO270(*) A3800476 RR AR1- NONE MOVE RECORD TO RECBUF A3800477 RR LRA- (ZERO),1 A3800478 RR STA- RECBUF+1,B A3800479 RR DQP *-DBO270 A3800480 RR* A3800481 RR* STORE RECORD SEQUENTIALLY IN SCRATCH FILE A3800482 RR* A3800483 RRDBO280 EQU DBO280(*) A3800484 RR ENA 8 SET CODE FOR 'PUTS' A3800485 RR SFA- TIMTRY,12,4,I A3800486 RR ENA 1 ONE RECORD TO BE STORED A3800487 RR STA- NMBREC,I A3800488 RR RTJ* ABSADD ABSOLUTIZE THE FILE REQUEST ADDRESS A3800489 RR ADC* PUTZ A3800490 RR STA* PEN010+1 STORE IN THE REQUEST A3800491 RR ENQ PCALTH MOVE 'PUTS' ROUTINE TO PHYSTB A3800492 RRDBO285 EQU DBO285(*) A3800493 RR LDA* PENTRY,Q A3800494 RR STA- RTJCAL,B A3800495 RR DQP *-DBO285 A3800496 RR RTJ- RTJCAL,I GO EXECUTE ROUTINE IN PHYSTB A3800497 RR* A3800498 RR* RETURN FROM 'PUTS' ROUTINE IN PHYSTB, A-REG = ISTAT A3800499 RR* A3800500 RR SAP DBO286 SKIP IF RQST NOT REJECTED A3800501 RR JMP* DBO340 GO CLOSE AND DELETE SCRATCH FILE A3800502 RRDBO286 EQU DBO286(*) A3800503 RR AND- LPMSK+4 A3800504 RR SAZ DBO287 SKIP IF RECORD STORED A3800505 RR SEF- HSTNN,10,1,I SET ALERT OPERATOR FLAG A3800506 RRDBO287 EQU DBO287(*) A3800507 RR LDA- REQBUF+16,I SAVE RELATIVE RECORD NUMBER STORED A3800508 RR STA- RELREC,I A3800509 RR SFN- HSTNN,12,1,I SKIP IF 200UT END OF JOB RECORD A3800510 RR JMP* DBO290 GO CHECK FOR ALERT OPR A3800511 RR SFN- HSTNN,8,1,I SKIP, ONE MORE 200UT RECORD TO PROCESS A3800512 RR JMP* DBO288 LAST RECORD A3800513 RR CLF- HSTNN,8,1,I A3800514 RR JMP* DBO290 A3800515 RRDBO288 EQU DBO288(*) A3800516 RR ENA EOF EOF MOTION PARAMETER A3800517 RR STA- MOTPAR,I HANDLE 200UT END OF JOB AS IF EOF A3800518 RR JMP* DBO340 A3800519 RR EJT A3800520 RR* A3800521 RR* THE FOLLOWING CODE STARTING AT LABEL 'PENTRY' THRU A3800522 RR* LABEL 'PCALTH' IS NOT EXECUTED IN THE DRIVER, BUT IS A3800523 RR* BUILT AND MOVED TO THE PHYSTB. THE CODE IS THEN A3800524 RR* EXECUTED FROM THE PHYSTB WITH RETURN TO THE DRIVER. A3800525 RR* A3800526 RRPENTRY NUM 0 ENTRY A3800527 RRPEN010 RTJ+ SYFAIL PUTS FILE REQUEST A3800528 RR ADC (REQBUF-RTJCAL-3) REL ADR TO 'REQBUF' PARAMETER A3800529 RR ADC (RECBUF-RTJCAL-4) REL ADR TO 'RECBUF' PARAMETER A3800530 RR ADC (NMBREC-RTJCAL-5) REL ADR TO 'NUMREC' PARAMETER A3800531 RR ADC (ISTAT-RTJCAL-6) REL ADR TO 'ISTAT' PARAMETER A3800532 RR LDA- ISTAT,I A3800533 RR STA- ERSTAT,I A3800534 RR JMP* (PENTRY) A3800535 RRPCALTH EQU PCALTH(*-PENTRY-1) A3800536 RR* A3800537 RR* CALLER'S Q/I REGISTERS PRESERVED BY FM A3800538 RR* A3800539 RR EJT A3800540 RRDBO290 EQU DBO290(*) A3800541 RR SFN- HSTNN,10,1,I SKIP IF ALERT OPERATOR SET A3800542 RR JMP* DBO310 GO COMPLETE REQUEST A3800543 RR* A3800544 RR* MOVE ALERT MSG TO RECBUF, WRITE ON COMMENT DEVICE A3800545 RR* A3800546 RR ENQ LNALRT LENGTH OF MSG A3800547 RR INQ -1 A3800548 RRDBO300 EQU DBO300(*) A3800549 RR LDA* ALRT,Q MOVE MSG TO RECBUF A3800550 RR STA- RECBUF,B A3800551 RR DQP *-DBO300 A3800552 RR ENA LNALRT MSG LENGTH A3800553 RR RTJ BFWRIT WRITE THE MSG A3800554 RR ENA 2 A3800555 RR SFA- HSTNN,11,2,I SET INSUFFICIENT SPACE, RESET ALERT OPR A3800556 RR* A3800557 RR* COMPLETE THE REQUEST A3800558 RR* A3800559 RRDBO310 EQU DBO310(*) A3800560 RR RTJ- (COMPRQ) COMPLETE REQUEST A3800561 RR JMP DBO010 GO FIND NEXT RQST A3800562 RR EJT A3800563 RR* A3800564 RR* MOTION REQUEST HANDLING A3800565 RR* A3800566 RRDBO320 EQU DBO320(*) A3800567 RR LFA- 4,14,3,Q Q-REG IS PARAMETER ADR, GET CODE A3800568 RR STA- MOTPAR,I SAVE CODE, IGNORE REPEAT BIT A3800569 RR INA -2 CHECK FOR EOF A3800570 RR SAZ DBO330 SKIP IF EOF A3800571 RR INA -4 CHECK FOR BSF A3800572 RR SAZ DBO330 SKIP IF BSF A3800573 RR ENA 0 MOTION RQST NOT VALID A3800574 RR STA- MOTPAR,I CLEAR THE MOTION PARAMETER A3800575 RR JMP* DBO310 AND COMPLETE THE RQST A3800576 RRDBO330 EQU DBO330(*) A3800577 RR SFN- HSTNN,13,1,I SKIP IF SCRATCH FILE IS CREATED A3800578 RR JMP* DBO310 SCRATCH FILE DOES NOT EXIST, COMPLETE A3800579 RR* A3800580 RR* SETUP TO CLOSE THE SCRATCH FILE A3800581 RR* A3800582 RRDBO340 EQU DBO340(*) A3800583 RR RTJ BCLOSF CLOSE SCRATCH FILE A3800584 RR STA- ERSTAT,I A3800585 RR INA -4 A=ISTAT ON RETURN A3800586 RR SAZ DBO350 SKIP IF NO ERROR A3800587 RR ENA 1 'CLOSE' RQST CODE A3800588 RR SFA- TIMTRY,12,4,I A3800589 RR ENA 0 INDICATE CANNED MSG A3800590 RR RTJ BFWRIT POST DIAGNOSTIC MSG A3800591 RR LDA- ERSTAT,I GET STATUS A3800592 RR SAP DBO350 SKIP IF NO REJECT,BUT FILE NOT UNLOCKED A3800593 RR JMP* DBO387 GO HANDLE ERROR A3800594 RRDBO350 EQU DBO350(*) A3800595 RR LDA- MOTPAR,I A3800596 RR INA -2 SEE IF MOTION RQST FOR EOF A3800597 RR SAN DBO360 SKIP IF NOT EOF A3800598 RR JMP* DBO380 GO PROCESS EOF A3800599 RR* A3800600 RR* SETUP TO DELETE SCRATCH FILE A3800601 RR* A3800602 RRDBO360 EQU DBO360(*) A3800603 RR RTJ DBO570 SETUP IDATA A3800604 RR ENA 9 SET RQST CODE FOR 'DELETE' A3800605 RR SFA- TIMTRY,12,4,I A3800606 RR RTJ* ABSADD ABSOLUTIZE THE FILE REQUEST ADDRESS A3800607 RR ADC* DELET A3800608 RR STA* DEN010+1 STORE IN THE REQUEST A3800609 RR ENQ DCALTH MOVE 'DELETE' ROUTINE TO PHYSTB A3800610 RRDBO365 EQU DBO365(*) A3800611 RR LDA* DENTRY,Q A3800612 RR STA- RTJCAL,B A3800613 RR DQP *-DBO365 A3800614 RR RTJ- RTJCAL,I GO EXECUTE ROUTINE IN PHYSTB A3800615 RR* A3800616 RR* RETURN FROM 'DELETE' ROUTINE IN PHYSTB, A-REG = ISTAT. A3800617 RR* A3800618 RR SAZ DBO370 A=ISTAT ON RETURN, SKIP IF NO ERROR A3800619 RR JMP* DBO387 GO POST THE ERROR A3800620 RRDBO370 EQU DBO370(*) A3800621 RR LFA- MOTPAR,2,3,I PICKUP MOTION RQST A3800622 RR SAN DBO375 SKIP IF MOTION RQST A3800623 RR JMP DBO920 GO TO ERROR EXIT A3800624 RRDBO375 EQU DBO375(*) A3800625 RR CLF- HSTNN,13,5,I CLEAR STATUS BITS A3800626 RR JMP* DBO310 GO COMPLETE RQST A3800627 RR SPC 2 A3800628 RR* A3800629 RR* ADDRESS ABSOLUTIZING ROUTINE A3800630 RR* A3800631 RRABSADD NOP 0 A3800632 RR SPC 1 A3800633 RR LDA* (ABSADD) A = RELATIVE ADDRESS OF FILE REQUEST A3800634 RR ADD* ABSADD A = ABSOLUTE ADDRESS OF FILE REQUEST A3800635 RR RAO* ABSADD A3800636 RR SPC 1 A3800637 RR JMP* (ABSADD) RETURN A3800638 RR EJT A3800639 RR* A3800640 RR* THE FOLLOWING CODE STARTING AT LABEL 'DENTRY' THRU A3800641 RR* LABEL 'DCALTH' IS NOT EXECUTED IN THE DRIVER, BUT IS A3800642 RR* BUILT AND MOVED TO THE PHYSTB. THE CODE IS THEN A3800643 RR* EXECUTED FROM THE PHYSTB WITH RETURN TO THE DRIVER. A3800644 RR* A3800645 RRDENTRY NUM 0 ENTRY A3800646 RRDEN010 RTJ+ SYFAIL DELETE FILE REQUEST A3800647 RR ADC (REQBUF-RTJCAL-3) REL ADR TO 'REQBUF' PARAMETER A3800648 RR ADC (IDATA-RTJCAL-4) REL ADR TO 'IDATA' PARAMETER A3800649 RR ADC (ISTAT-RTJCAL-5) REL ADR TO 'ISTAT' PARAMETER A3800650 RR LDA- ISTAT,I PICKUP 'DELETE' REQUEST STATUS A3800651 RR STA- ERSTAT,I AND SAVE A3800652 RR JMP* (DENTRY) A3800653 RRDCALTH EQU DCALTH(*-DENTRY-1) A3800654 RR* A3800655 RR* CALLER'S Q/I REGISTERS PRESERVED BY FM A3800656 RR* A3800657 RR EJT A3800658 RR* A3800659 RR* END-OF-FILE MOTION REQUEST A3800660 RR* A3800661 RRDBO380 EQU DBO380(*) A3800662 RR SFZ- HSTNN,11,1,I SKIP IF SCRATCH FILE SPACE REMAINING A3800663 RR JMP* DBO390 INSUFFICIENT SPACE BYPASS REDUCE A3800664 RR RTJ DBO570 SET IDATA FOR SCRATCH FILE A3800665 RR ENA 0 A3800666 RR STA- IDATA+12,I MSB NEW NUMBER OF RECORDS A3800667 RR LDA- RELREC,I A3800668 RR STA- IDATA+13,I LSB NEW NUMBER OF RECORDS A3800669 RR ENA 7 SET RQST CODE FOR 'REDUCE' A3800670 RR SFA- TIMTRY,12,4,I A3800671 RR RTJ* ABSADD ABSOLUTIZE THE FILE REQUEST ADDRESS A3800672 RR ADC* REDUC A3800673 RR STA* REN010+1 STORE IN THE REQUEST A3800674 RR ENQ RCALTH MOVE 'REDUCE' ROUTINE TO PHYSTB A3800675 RRDBO385 EQU DBO385(*) A3800676 RR LDA* RENTRY,Q A3800677 RR STA- RTJCAL,B A3800678 RR DQP *-DBO385 A3800679 RR RTJ- RTJCAL,I GO EXECUTE ROUTINE IN PHYSTB A3800680 RR* A3800681 RR* RETURN FROM 'REDUCE' ROUTINE IN PHYSTB, A-REG = ISTAT. A3800682 RR* A3800683 RR SAZ DBO390 SKIP IF NO FM ERRORS A3800684 RRDBO387 EQU DBO387(*) A3800685 RR JMP* DBO495 GO POST THE ERROR A3800686 RR EJT A3800687 RR* A3800688 RR* THE FOLLOWING CODE STARTING AT LABEL 'RENTRY' THRU A3800689 RR* LABEL 'RCALTH' IS NOT EXECUTED IN THE DRIVER, BUT IS A3800690 RR* BUILT AND MOVED TO THE PHYSTB. THE CODE IS THEN A3800691 RR* EXECUTED FROM THE PHYSTB WITH RETURN TO THE DRIVER. A3800692 RR* A3800693 RRRENTRY NUM 0 ENTRY A3800694 RRREN010 RTJ+ SYFAIL REDUCE FILE REQUEST A3800695 RR ADC (REQBUF-RTJCAL-3) REL ADR TO 'REQBUF' PARAMETER A3800696 RR ADC (IDATA-RTJCAL-4) REL ADR TO 'IDATA' PARAMETER A3800697 RR ADC (ISTAT-RTJCAL-5) REL ADR TO 'ISTAT' PARAMETER A3800698 RR LDA- ISTAT,I PICKUP 'REDUCE' REQUEST STATUS A3800699 RR STA- ERSTAT,I AND SAVE A3800700 RR JMP* (RENTRY) A3800701 RRRCALTH EQU RCALTH(*-RENTRY-1) A3800702 RR* A3800703 RR* CALLER'S Q/I REGISTERS PRESERVED BY FM A3800704 RR* A3800705 RR EJT A3800706 RRDBO390 EQU DBO390(*) A3800707 RR LDA- JOBKEY,I A3800708 RR SAN DBO395 SKIP IF JOB HAS BEEN IDENTIFIED A3800709 RR JMP DBO610 UNIDENTIFIED JOB A3800710 RRDBO395 EQU DBO395(*) A3800711 RR CLF- TIMTRY,8,9,I A3800712 RRDBO400 EQU DBO400(*) A3800713 RR RTJ OPHOST OPEN THE $$HOST FILE A3800714 RR ENQ -1 A3800715 RR XFQ 1 REG 1 IS NO REJECT MASK A3800716 RR LDQ =XHBMSKO REG Q IS REJECT BUSY MASK A3800717 RRDBO410 EQU DBO410(*-1) A3800718 RR RTJ RETRY CHECK IF BUSY, RETRY PERMITTED A3800719 RR JMP* DBO400 BUSY, RETRY A3800720 RR* IF ERROR, MSG POSTED A3800721 RR* A3800722 RR* NO ERROR, SETUP TO READ $$HOST, RELATIVE RECORD A3800723 RR* NUMBER FROM JOBNAME A3800724 RR* A3800725 RR LFA- JOBKEY,3,4,I 4 LSB OF ASCII HOST NUMBER A3800726 RR SFZ- JOBKEY,7,2,I SKIP IF NUMBER IS 0-9 A3800727 RR INA 9 NUMBER IS A-F A3800728 RR INA 1 A3800729 RR STA- HSTRNO+1,I LSB REL RECORD NUMBER A3800730 RRDBO420 EQU DBO420(*) A3800731 RR ENQ HSTRNO PASS RELATIVE INDEX OF REL REC NO. A3800732 RR RTJ BREADR READ THE HOST ENTRY A3800733 RR LDQ- NZERO CHECK FOR ERROR, RETRY PERMITTED A3800734 RR XFQ 1 NO REJECT MASK A3800735 RR LDQ =XHBMSKR REJECT,BUSY MASK A3800736 RRDBO430 EQU DBO430(*-1) A3800737 RR RTJ RETRY IF ERROR, MSG POST AND ATTEMPT TO CLOSE A3800738 RR JMP* DBO420 BUSY, RETRY A3800739 RR LFA- JOBKEY+1,11,4,I NO ERROR, SETUP TO CHECK JOB STATUS A3800740 RR MUI- TEN MS DIGIT (N) OF JMNN *10 A3800741 RR TRA Q A3800742 RR LFA- JOBKEY+1,3,4,I LS DIGIT N A3800743 RR AAQ Q A3800744 RR INQ -1 Q-REG IS DECIMAL EQUIVALENT OF NN-1 A3800745 RR ENA 0 A3800746 RR LRS 2 DIVIDE BY 4, Q=WORD A3800747 RR INQ 3 PLUS 3 WORD OFFSET A3800748 RR XFQ 3 SAVE STATUS WORD INDEX IN REG 3 A3800749 RR ALS 2 A-REG IS 4 BIT STATUS INDICATOR A3800750 RR XFA 1 SAVE INDICATOR IN REG 1 AND 2 A3800751 RR XFA 2 A3800752 RR LDA- RECBUF,B PICKUP WORD CONTAINING STATUS A3800753 RRDBO440 EQU DBO440(*) A3800754 RR ALS 4 SHIFT STATUS CODE TO 4 LSB OF A-REG A3800755 RR D1P *-DBO440 A3800756 RR XFA 4 SAVE STATUS CODES A3800757 RR AND- LPMSK+4 ISOLATE THIS JOB STATUS CODE A3800758 RR SFZ- HSTNN,15,2,I CHECK IF LOCL HOST A3800759 RR JMP* DBO444 NO - GO CK REMOTE HOST STATUS A3800760 RR INA -2 YES- CK FOR SENDING , OR A3800761 RR SAN DBO442 SENT STATUS. A3800762 RR JMP* DBO460 STATUS IS SENDING. A3800763 RRDBO442 INA -1 A3800764 RR SAZ DBO460 SKIP IF STATUS IS SENT A3800765 RR SAP DBO446 SKIP IF STATUS VALID A3800766 RR JMP* DBO450 INVALID STATUS A3800767 RRDBO444 INA -3 A3800768 RR SAZ DBO460 SKIP IF STATUS IS SENT A3800769 RR SAM DBO450 SKIP IF INVALID STATUS A3800770 RRDBO446 INA -4 A3800771 RR SAZ DBO460 SKIP IF STATUS IS JOB ABORTED A3800772 RR SAM DBO450 SKIP IF INVALID STATUS A3800773 RR INA -2 A3800774 RR ENQ 0 JOB STATUS WILL BE SET TO ZERO A3800775 RR SEF- HSTNN,9,1,I SET DISCARD JOB FLAG A3800776 RR SAZ DBO470 SKIP IF STATUS IS SENT, DISCARD PENDING A3800777 RRDBO450 EQU DBO450(*) A3800778 RR JMP DBO725 JOB STATUS IS INVALID OR ILLEGAL A3800779 RRDBO460 EQU DBO460(*) A3800780 RR ENQ 4 A3800781 RRDBO470 EQU DBO470(*) A3800782 RR XF4 A REG A IS STATUS CODES A3800783 RR AND- NZERO+4 MASK OUT OLD STATUS THIS JOB A3800784 RR EAQ A PUT IN NEW STATUS CODE THIS JOB (0 OR 4) A3800785 RR XF2 Q REG Q IS STATUS CODE IN WORD INDICATOR A3800786 RR JMP* DBO480,Q REPOSITION THE STATUS WORD A3800787 RRDBO480 EQU DBO480(*) A3800788 RR ALS 4 A3800789 RR ALS 4 A3800790 RR ALS 4 A3800791 RR XF3 Q REG Q IS STATUS WORD INDEX A3800792 RR STA- RECBUF,B STORE THE NEW STATUS CODE A3800793 RR RTJ BUPREC UPDATE THE $$HOST RECORD A3800794 RR SAP DBO490 REG A IS ISTAT ON RETURN, SKIP NO ERR A3800795 RR JMP* DBO537 ERROR - CLOSE, POST MSG, EXIT A3800796 RRDBO490 EQU DBO490(*) A3800797 RR RTJ BCLOSF CLOSE THE $$HOST FILE A3800798 RR SAP DBO500 A = ISTAT, SKIP IF NO ERRORS A3800799 RR STA- ERSTAT,I A3800800 RR ENA 1 'CLOSE' RQST CODE A3800801 RR SFA- TIMTRY,12,4,I A3800802 RRDBO495 EQU DBO495(*) A3800803 RR JMP* DBO545 ERROR - POST MSG, EXIT A3800804 RRDBO500 EQU DBO500(*) A3800805 RR SFN- HSTNN,9,1,I SKIP IF JOB DISCARDED A3800806 RR JMP* DBO510 A3800807 RR ENA 6 A3800808 RR STA- MOTPAR,I MAKE MOTION PARAMETER LOOK LIKE BSF A3800809 RRDBO505 EQU DBO505(*) A3800810 RR JMP DBO360 GO DELETE THE SCRATCH FILE A3800811 RR* A3800812 RR* SETUP TO UPDATE THE $$BATCH FILE FOR THIS JOB A3800813 RR* A3800814 RRDBO510 EQU DBO510(*) A3800815 RR RTJ OPBATF OPEN THE $$BATCH FILE A3800816 RR ENQ -1 A3800817 RR XFQ 1 REG 1 IS NO REJECT MASK A3800818 RR LDQ* DBO410 REG Q IS REJECT BUSY MASK A3800819 RR RTJ RETRY CHECK FOR ERROR OR BUSY,RETRY A3800820 RR JMP* DBO510 BUSY, RETRY A3800821 RR* NO RETURN IF ERROR, MSG POSTED AND EXIT A3800822 RR* A3800823 RR* IF NO ERROR, RETURNS HERE A3800824 RR* A3800825 RRDBO520 EQU DBO520(*) A3800826 RR ENQ JOBKEY PASS RELATIVE INDEX OF JOBKEY A3800827 RR RTJ BREADR READ THIS JOB $$BATCH FILE RECORD A3800828 RR LDQ- NZERO A3800829 RR XFQ 1 REG 1 IS NO REJECT MASK A3800830 RR LDQ* DBO430 REQ Q IS REJECT BUSY MASK A3800831 RR RTJ RETRY CHECK FOR ERROR OR BUSY, RETRY A3800832 RR JMP* DBO520 BUSY, RETRY A3800833 RR* NO RETURN IF ERROR, MSG POSTED AND EXIT A3800834 RR LDA- JOBKEY,I MOVE JOBKEY TO NEWNAM A3800835 RR STA- NEWNAM,I A3800836 RR LDA- JOBKEY+1,I A3800837 RR STA- NEWNAM+1,I A3800838 RR LDA =A A3800839 RRDBO525 EQU DBO525(*-1) A3800840 RR STA- NEWNAM+2,I A3800841 RR STA- NEWNAM+3,I A3800842 RR* A3800843 RR* MOVE DATE/TIME TO RECORD A3800844 RR* A3800845 RR ENQ 5 A3800846 RR XFQ 1 A3800847 RRDBO530 EQU DBO530(*) A3800848 RR XF1 Q A3800849 RR LDQ* DAYTIM,Q GET DATE/TIME ADR A3800850 RR LDA- (ZERO),Q PICKUP THE INTEGER A3800851 RR RTJ* DECASC CONVERT TO ASCII A3800852 RR XF1 Q A3800853 RR STA- RECBUF+26,B PUT IT IN THE RECORD A3800854 RR D1P *-DBO530 A3800855 RR JMP* DBO535 A3800856 RR SPC 2 A3800857 RRDAYTIM ADC DAYTO A3800858 RR ADC MONTO A3800859 RR ADC YERTO A3800860 RR ADC HORTO A3800861 RR ADC MINTO A3800862 RR ADC SECON A3800863 RR SPC 2 A3800864 RRDECASC NUM 0 CONVERT DATE/TIME INTEGER TO ASCII A3800865 RR CLR Q A3800866 RR DVI- TEN A3800867 RR INA $30 A3800868 RR INQ $30 A3800869 RR ALS 8 A3800870 RR EAQ A A3800871 RR JMP* (DECASC) A3800872 RR SPC 2 A3800873 RRDBO535 EQU DBO535(*) A3800874 RR RTJ BUPREC UPDATE THE FILE RECORD A3800875 RR SAP DBO540 SKIP IF NO ERROR A3800876 RRDBO537 EQU DBO537(*) A3800877 RR JMP DBO900 ERROR, ATTEMPT TO CLOSE, POST MSG, EXIT A3800878 RRDBO540 EQU DBO540(*) A3800879 RR RTJ BCLOSF CLOSE THE FILE A3800880 RR SAP DBO550 SKIP IF NO ERROR A3800881 RR STA- ERSTAT,I A3800882 RR ENA 1 'CLOSE' RQST CODE A3800883 RR SFA- TIMTRY,12,4,I A3800884 RRDBO545 EQU DBO545(*) A3800885 RR JMP DBO910 ERROR - POST MSG, EXIT A3800886 RR* A3800887 RR* A3800888 RR* RENAME THE SCRATCH FILE TO THE JOBKEY A3800889 RR* A3800890 RRDBO550 EQU DBO550(*) A3800891 RR ENQ 3 MOVE OWNER TO NEWNAM A3800892 RRDBO560 EQU DBO560(*) A3800893 RR LDA* SNAM+4,Q A3800894 RR STA- NEWNAM+4,B A3800895 RR DQP *-DBO560 A3800896 RR RTJ* DBO570 A3800897 RR JMP* DBO590 GO SETUP RENAME REQUEST A3800898 RR EJT A3800899 RR* A3800900 RR* ROUTINE SETS UP SCRATCH FILE NAME, USER, VOLUMN A3800901 RR* A3800902 RRDBO570 EQU DBO570(*) A3800903 RR NUM 0 ENTRY, SETUP SCRATCH FILE NAME A3800904 RR LDA- ELU,I A3800905 RR ENQ 0 A3800906 RR DVI- TEN CONVERT BINARY LU TO ASCII A3800907 RR INA $30 FOR LU = 1, 99 A3800908 RR ALS 8 A3800909 RR INQ $30 A3800910 RR EAQ A A3800911 RR STA* SNAM+2 A3800912 RR LDQ+ WKSPLU A3800913 RR LDQ+ MMLUTB,Q Q = VOLUME TABLE FOR SCRATCH FILES A3800914 RR INQ 1 A3800915 RR STQ* VOLNAM A3800916 RR ENQ 3 A3800917 RRDBO575 LDA* (VOLNAM),Q MOVE THE VOLUME NAME A3800918 RR STA* SVOL,Q A3800919 RR DQP *-DBO575 A3800920 RR ENQ 11 A3800921 RRDBO580 EQU DBO580(*) A3800922 RR LDA* SNAM,Q MOVE OLD NAME, OWNER, VOLUME TO IDATA A3800923 RR STA- IDATA,B A3800924 RR DQP *-DBO580 A3800925 RR JMP* (DBO570) RETURN A3800926 RR SPC 2 A3800927 RRVOLNAM ADC 0 TEMPORARY STORAGE A3800928 RR EJT A3800929 RR* A3800930 RR* THE FOLLOWING CODE STARTING AT LABEL 'ENTRY' THRU A3800931 RR* LABEL 'CALTH' IS NOT EXECUTED IN THE DRIVER, BUT IS A3800932 RR* BUILT AND MOVED TO THE PHYSTB. THE CODE IS THEN A3800933 RR* EXECUTED FROM THE PHYSTB WITH RETURN TO THE DRIVER. A3800934 RR* A3800935 RRENTRY NUM 0 RTJ ENTRY A3800936 RRENT010 RTJ+ SYFAIL RENAME FILE REQUEST A3800937 RR ADC (REQBUF-RTJCAL-3) REL ADR TO 'REQBUF' PARAMETER A3800938 RR ADC (IDATA-RTJCAL-4) REL ADR TO 'IDATA' PARAMETER A3800939 RR ADC (NEWNAM-RTJCAL-5) REL ADR TO 'NEWNAM' PARAMETER A3800940 RR ADC (ISTAT-RTJCAL-6) REL ADR TO 'ISTAT' PARAMETER A3800941 RR LDA- ISTAT,I PICKUP 'RENAME' REQUST STATUS A3800942 RR STA- ERSTAT,I SAVE REQUEST STATUS A3800943 RR JMP* (ENTRY) RETURN TO CALLER A3800944 RRCALTH EQU CALTH(*-ENTRY-1) A3800945 RR* A3800946 RR* CALLER'S Q/I REGISTERS PRESERVED BY FM A3800947 RR* A3800948 RR EJT A3800949 RRDBO590 EQU DBO590(*) A3800950 RR ENA 6 SET RQST CODE FOR 'RENAME' A3800951 RR SFA- TIMTRY,12,4,I A3800952 RR RTJ ABSADD ABSOLUTIZE THE FILE REQUEST ADDRESS A3800953 RR ADC* RENAM A3800954 RR STA* ENT010+1 STORE IN THE REQUEST A3800955 RR ENQ CALTH MOVE 'RENAME' ROUTINE TO PHYSTAB A3800956 RRDBO600 EQU DBO600(*) A3800957 RR LDA* ENTRY,Q A3800958 RR STA- RTJCAL,B A3800959 RR DQP *-DBO600 A3800960 RR RTJ- RTJCAL,I GO EXECUTE ROUTINE IN PHYSTB A3800961 RR* A3800962 RR* RETURN FROM 'RENAME ROUTINE IN PHYSTB. A-REG = ISTAT. A3800963 RR* A3800964 RR SAM DBO605 SKIP IF REJECTED A3800965 RR CLF- HSTNN,13,6,I CLEAR DRIVER STATUS FLAGS A3800966 RR JMP DBO310 GO COMPLETE THE REQUEST A3800967 RRDBO605 EQU DBO605(*) A3800968 RR ENA 0 ERROR, POST DIAG MSG A3800969 RR STA- MOTPAR,I A3800970 RR RTJ BFWRIT A3800971 RRDBO607 EQU DBO607(*) A3800972 RR JMP* DBO505 GO DELETE THE SCRATCH FILE, EXIT A3800973 RR SPC 2 A3800974 RRPRTNAM ALF 4,$$PRINT PRINT FILE NAME A3800975 RR SPC 2 A3800976 RRSNAM ALF 4,$$BD SCRATCH FILE NAME A3800977 RRSOWN ALF 4,$$ FILE OWNER NAME A3800978 RRSVOL ALF 4,SYSVOL VOLUME NAME A3800979 RR EJT A3800980 RR* A3800981 RR* PROCESS UNIDENTIFIED FILE, I.E., NO '*JOB,JMNN,' A3800982 RR* RECORD WAS FOUND. FIND AN AVAILABLE ENTRY IN THE A3800983 RR* $$PRINT FILE, UPDATE IT, AND RENAME THE SCRATCH A3800984 RR* FILE ACCORDINGLY. A3800985 RR* A3800986 RRDBO610 EQU DBO610(*) A3800987 RR ENQ 3 MOVE $$PRINT FILE NAME TO IDATA 1-4 A3800988 RRDBO620 EQU DBO620(*) A3800989 RR LDA* PRTNAM,Q A3800990 RR STA- IDATA,B A3800991 RR DQP *-DBO620 A3800992 RR ENQ 7 MOVE OWNER NAME AND VOLUME A3800993 RRDBO630 EQU DBO630(*) NAME TO IDATA 5-12 A3800994 RR LDA* SOWN,Q A3800995 RR STA- IDATA+4,B A3800996 RR DQP *-DBO630 A3800997 RR ENA 0 ACCESS INDICATOR, RETRIEVAL BY A3800998 RR STA- IDATA+12,I RELATIVE RECORD NUMBER A3800999 RR ENA 1 NUMBER OF RECORDS PER RETRIEVAL A3801000 RR STA- IDATA+13,I A3801001 RR STA- IDATA+14,I RECORD LOCK ON RETRIEVAL A3801002 RRDBO640 EQU DBO640(*) A3801003 RR RTJ BOPENF OPEN PRINT FILE, A=ISTAT ON RETURN A3801004 RR ENQ -1 A3801005 RR XFQ 1 NO REJECT MASK A3801006 RR LDQ =XBOSMSK REJECT, BUSY MASK A3801007 RR RTJ RETRY CHECK FOR ERRORS, RETRY IF BUSY A3801008 RR* NO RETURN IF OTHER ERRORS A3801009 RR JMP* DBO640 BUSY, RETRY A3801010 RRDBO650 EQU DBO650(*) NO ERRORS A3801011 RR RTJ BGETS GET THE NEXT SEQUENTIAL RECORD A3801012 RR SFZ- ISTAT,8,1,I SKIP IF NOT EOF A3801013 RR JMP* DBO705 NO AVAILABLE ENTRIES IN PRINT FILE A3801014 RR LDQ- NZERO A3801015 RR XFQ 1 A3801016 RR LDQ =XBGETSM A3801017 RR RTJ RETRY A3801018 RR JMP* DBO650 BUSY, RETRY A3801019 RR* NO ERROR A3801020 RR LDA- RECBUF+15,I SEE IF THIS RECORD IS AN AVAILABLE ENTRY A3801021 RR EOR DBO525 ENTRY AVAILABLE IF NO. OF RECORDS=2 BLANKS A3801022 RR SAZ DBO660 SKIP IF AVAILABLE A3801023 RR JMP* DBO650 GO GET NEXT RECORD A3801024 RRDBO660 EQU DBO660(*) A3801025 RR ENQ 2 MOVE PRINT FILE NAME TO NEWNAM A3801026 RRDBO670 EQU DBO670(*) A3801027 RR LDA- RECBUF,B A3801028 RR STA- NEWNAM,B A3801029 RR DQP *-DBO670 A3801030 RR LDA- RECBUF+2,I COMPLETE FILE NAME WITH 2 MORE BLANKS A3801031 RR STA- NEWNAM+3,I A3801032 RR ENQ 5 MOVE DATE/TIME TO RECORD A3801033 RR XFQ 1 A3801034 RRDBO680 EQU DBO680(*) A3801035 RR XF1 Q A3801036 RR LDQ DAYTIM,Q GET DATE/TIME ADR A3801037 RR LDA- (ZERO),Q PICKUP THE INTEGER A3801038 RR RTJ DECASC CONVERT TO ASCII A3801039 RR XF1 Q A3801040 RR STA- RECBUF+8,B PUT IT IN THE RECORD A3801041 RR D1P *-DBO680 A3801042 RR ENA 0 SETUP TO GET NUMBER OF RECORDS IN A3801043 RR XFA 1 SCRATCH FILE (LAST RELATIVE RECORD A3801044 RR ENA 3 STORED), CONVERT TO ASCII AND A3801045 RR XFA 2 PUT IN PRINT FILE RECORD. A3801046 RR LDQ- RELREC,I Q = NUMBER RECORDS A3801047 RRDBO690 EQU DBO690(*) A3801048 RR ENA 0 A3801049 RR LLS 4 A = NEXT DIGIT (HEX) A3801050 RR INA -$A A3801051 RR SAM DBO700 SKIP IF DIGIT 0-9 A3801052 RR INA 7 BIAS FOR A-F A3801053 RRDBO700 EQU DBO700(*) A3801054 RR INA $3A = ASCII REPRESENTATION THIS DIGIT A3801055 RR SCA- RECBUF+15,1,I PUT IT IN THE PRINT FILE RECORD A3801056 RR AR1- ONE A3801057 RR D2P *-DBO690 A3801058 RR JMP DBO535 GO UPDATE PRINT FILE AND RENAME SCRATCH A3801059 RR EJT A3801060 RR* A3801061 RR* THE $$PRINT FILE IS FULL, NO AVAILABLE ENTRIES FOUND. A3801062 RR* ALERT THE OPERATOR AND DELETE THE SCRATCH FILE. A3801063 RR* A3801064 RRDBO705 EQU DBO705(*) A3801065 RR ENQ PMSGL MOVE WARNING MSG TO RECBUF A3801066 RRDBO710 EQU DBO710(*) A3801067 RR LDA* PMSG,Q A3801068 RR STA- RECBUF,B A3801069 RR DQP *-DBO710 A3801070 RR ENA PMSGL PASS MSG LENGTH IN A-REG A3801071 RR INA 1 A3801072 RR RTJ BFWRIT POST THE MSG A3801073 RR RTJ BCLOSF CLOSE THE $$PRINT FILE A3801074 RR SAP DBO720 SKIP IF NO ERROR A3801075 RR STA- ERSTAT,I A3801076 RR ENA 1 'CLOSE' RQST CODE A3801077 RR SFA- TIMTRY,12,4,I A3801078 RRDBO715 EQU DBO715(*) A3801079 RR JMP* DBO910 A3801080 RRDBO720 EQU DBO720(*) A3801081 RR ENA BSF MAKE MOTION PARAMETER LOOK LIKE BSF A3801082 RR STA- MOTPAR,I A3801083 RR JMP* DBO607 GO DELETE SCRATCH FILE A3801084 RR SPC 2 A3801085 RRPMSG ALF ., $$PRINT FILE FULL, FILES ARE BEING LOST. A3801086 RRPMSGL EQU PMSGL(*-PMSG-1) A3801087 RR EJT A3801088 RR* A3801089 RR* THE JOB HAS BEEN IDENTIFIED, HOWEVER, THE CORRESPONDING A3801090 RR* STATUS CODE IS INVALID. ALERT THE OPERATOR AND SAVE THE A3801091 RR* OUTPUT DATA AS A PRINT FILE. A3801092 RR* A3801093 RRDBO725 EQU DBO725(*) A3801094 RR RTJ BCLOSF CLOSE THE $$HOST FILE A3801095 RR SAP DBO730 SKIP IF NO ERROR A3801096 RR ENA 0 A3801097 RR STA- MOTPAR,I A3801098 RR JMP DBO607 GO DELETE THE SCRATCH FILE AND ERROR EXIT A3801099 RRDBO730 EQU DBO730(*) A3801100 RR ENQ IMSGL MOVE THE MSG TO RECBUF A3801101 RRDBO740 EQU DBO740(*) A3801102 RR LDA* IMSG,Q A3801103 RR STA- RECBUF,B A3801104 RR DQP *-DBO740 A3801105 RR LDA- JOBKEY,I PUT JOB NAME IN MSG A3801106 RR STA- RECBUF+1,I A3801107 RR LDA- JOBKEY+1,I A3801108 RR STA- RECBUF+2,I A3801109 RR ENA IMSGL PASS MSG LENGTH IN A-REG A3801110 RR INA 1 A3801111 RR RTJ BFWRIT POST THE MSG A3801112 RR JMP DBO610 GO SAVE THE OUTPUT DATA AS A PRINT FILE A3801113 RR SPC 2 A3801114 RRIMSG ALF ., *JMNN RECEIVED, STATUS INVALID. A3801115 RRIMSGL EQU IMSGL(*-IMSG-1) A3801116 RR EJT A3801117 RR* A3801118 RR* ERROR EXIT FOR FM REJECT ON CALLS WHEN THE FILE IS A3801119 RR* ACTUALLY OPEN TO THE DRIVER. A3801120 RR* A3801121 RRDBO900 EQU DBO900(*) A3801122 RR RTJ BCLOSF ATTEMPT TO CLOSE THE FILE, IGNORE REJECT A3801123 RR* A3801124 RR* ERROR EXIT FOR FM REJECT ON CALLS WHEN THE FILE IS A3801125 RR* NOT OPEN TO THE DRIVER AND DIAGNOSTIC MESSAGE POSTING A3801126 RR* IS REQUIRED. A3801127 RR* A3801128 RRDBO910 EQU DBO910(*) A3801129 RR SFN- ERSTAT,15,16,I SKIP IF THERE IS ERROR TO POST A3801130 RR JMP* DBO920 OTHERWISE, BYPASS A3801131 RR ENA 0 INDICATE CANNED MSG A3801132 RR RTJ BFWRIT POST THE DIAGNOSTIC MSG A3801133 RR* A3801134 RR* GENERAL ERROR EXIT FOR ALL DRIVER ERRORS. CLEAR THE A3801135 RR* DRIVER STATUS BITS AND SETUP TO GO TO ALTERNATE DEVICE A3801136 RR* HANDLER A3801137 RR* A3801138 RRDBO920 EQU DBO920(*) A3801139 RR CLF- HSTNN,13,6,I CLEAR DRIVER STATUS FLAGS A3801140 RR LDQ- ELU,I GET LU NUMBER A3801141 RR QLS 6 POSITION TO MERGE ERROR CODE A3801142 RR ENA 28 NO FILE ERROR CODE A3801143 RR EAQ Q LU/ERROR CODE A3801144 RR JMP+ ALTDEV GO TO ALTERNATE DEVICE HANDLER A3801145 RR EJT A3801146 RR* A3801147 RR* RETRY CHECKS THE REQUEST STATUS BASED ON THE INFORMATION A3801148 RR* PASSED IN REGISTERS Q, A AND 1. IF RETRY IS PERMITTED A3801149 RR* RETURN IS TO P, IF REQUEST ACCEPTED RETURN IS TO P+1. A3801150 RR* IF REQUEST REJECTED RETURN IS TO ERROR ROUTINE. A3801151 RR* ON ENTRY - Q = REJECT, BUSY MASK A3801152 RR* A = ISTAT A3801153 RR* 1 = NO REJECT MASK A3801154 RR* A3801155 RRRETRY NUM 0 ENTRY A3801156 RR SAM REJ SKIP IF REJECT A3801157 RR XF1 Q A3801158 RR LAQ A A3801159 RR SAN ERR SKIP IF ERROR A3801160 RR SFA- TIMTRY,8,9,I CLEAR RETRIES A3801161 RR RAO* RETRY A3801162 RR JMP* (RETRY) NO ERROR RETURN A3801163 RRREJ LAQ A A3801164 RR SAN ERR SKIP IF ERROR A3801165 RR LFA- TIMTRY,8,9,I GET NUMBER OF TRIES A3801166 RR SUB- MAXTRY A3801167 RR SAP ERR SKIP IF EXCEEDED MAX NUMBER OF TRIES A3801168 RR RTJ BTIMER DELAY A3801169 RR JMP* (RETRY) RETURN A3801170 RRERR LFA- TIMTRY,12,4,I GET REQUEST CODE A3801171 RR INA -2 A3801172 RR SAM ERR1 SKIP IF RQST WAS 'OPEN' OR 'CLOSE' A3801173 RR INA -3 A3801174 RR SAZ ERR1 SKIP IF RQST WAS 'CREATE' A3801175 RR JMP* DBO900 ATTEMPT TO CLOSE AND POST MSG A3801176 RRERR1 JMP* DBO910 POST MSG A3801177 RR END A3801178 RR NAM DBATIN A39 A ITOS CCS 3.0 SL-149A3900001 RR* DEFERRED BATCH INPUT DRIVER A3900002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 A3900003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A3900004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 A3900005 RR* A3900006 RR**** A3900007 RR*E A3900008 RR* FUNCTION A3900009 RR* -------- A3900010 RR* A3900011 RR* A3900012 RR* A3900013 RR* THIS PSEUDO DRIVER READS INPUT FROM FILE MANAGER A3900014 RR* FILES FOR JOBS SUBMITTED FOR DEFERRED BATCH PROCESSING A3900015 RR* FROM AN ITOS USER TERMINAL. A3900016 RR* A3900017 RR* A3900018 RR* A3900019 RR* A3900020 RR* A3900021 RR* GENERAL DESCRIPTION A3900022 RR* ------------------- A3900023 RR* A3900024 RR* A3900025 RR* A3900026 RR* IF THE REQUEST IS A MOTION REQUEST THEN, A3900027 RR* A3900028 RR* IF MOTION REQUEST IS VALID THEN, A3900029 RR* A3900030 RR* SLEW TO EOF - POINTERS TO THE CURRENT JOB A3900031 RR* IN THE $$HOST FILE ARE ADJUSTED A3900032 RR* TO POINT TO THE NEXT QUEUED JOB. A3900033 RR* (I.E., TERMINATE JOB) A3900034 RR* A3900035 RR* BACKSPACE - POINTERS TO THE CURRENT JOB A3900036 RR* FILE IN THE $$HOST FILE ARE ADJUSTED A3900037 RR* TO POINT TO THE CURRENT JOB AS A3900038 RR* THE NEXT QUEUED JOB. A3900039 RR* (I.E., RESTART JOB) A3900040 RR* A3900041 RR* OTHERWISE THE MOTION REQUEST IS IGNORED. A3900042 RR* A3900043 RR* A3900044 RR* OTHERWISE EACH REQUEST IS PROCESSED AS A FREAD REQUEST A3900045 RR* AS FOLLOWS: A3900046 RR* A3900047 RR* IF THE DRIVER IS NOT LOGICALLY CONNECTED TO A A3900048 RR* HOST (I.E., A RECORD IN $$HOST FILE) THEN, A3900049 RR* A3900050 RR* A SEARCH OF THE $$HOST FILE IS MADE TO FIND A3900051 RR* A HOST ASSIGNED TO THE SAME LOGICAL UNIT A3900052 RR* ASSOCIATED WITH THE REQUEST. WHEN FOUND A3900053 RR* THE DRIVER LOGICALLY CONNECTS TO THAT HOST A3900054 RR* AND ASCERTAINS THE NEXT QUEUED JOB 'NOT SENT' A3900055 RR* FOR THAT HOST AND MARKS THE JOB 'BEING SENT', A3900056 RR* AND LOGICALLY CONNECTS TO THAT JOB. A3900057 RR* A3900058 RR* LOGICAL CONNECTION TO A JOB ENTAILS: A3900059 RR* 1. CONSTRUCT A JOBKEY BASED ON HOST ID A3900060 RR* AND JOB ID TO ACESS THE $$BATCH FILE. A3900061 RR* 2. THE JOB STATUS IN $$HOST FILE IS A3900062 RR* UPDATED TO 'BEING SENT' FOR JMNN. A3900063 RR* 3. RETRIEVE FROM THE $$BATCH FILE THE A3900064 RR* RECORD FOR JOBKEY (JNMM) AND EXTRACT A3900065 RR* THE USER'S INPUT TEXT FILE NAME. A3900066 RR* 4. UPDATE DATE/TOD TEXT TRANSMITTED A3900067 RR* IN JMNN $BATCH RECORD. A3900068 RR* 5. RETRIEVE THE FIRST RECORD FROM THE A3900069 RR* USER'S INPUT AND RETURN IT TO THE A3900070 RR* REQUESTOR. A3900071 RR* A3900072 RR* OTHERWISE LOGICAL CONNECTION TO A HOST IS IMPLIED. A3900073 RR* A3900074 RR* A3900075 RR* IF THE DRIVER IS ALSO LOGICALLY CONNECTED A3900076 RR* TO A JOB FOR THIS HOST THEN, A3900077 RR* A3900078 RR* THE NEXT RECORD IS SEQUENTIALLY RETRIEVED A3900079 RR* FROM THE USER'S INPUT FILE. A3900080 RR* A3900081 RR* IF AN EOF IS DETECTED THEN, A3900082 RR* A3900083 RR* A EOF INDICATION IS RETURNED TO A3900084 RR* THE REQUESTOR AND THE A3900085 RR* BATCH WORKSTATION AND THE DRIVER A3900086 RR* IS LOGICALLY DISCONNECTED FROM THE A3900087 RR* JOB. A3900088 RR* THE STATUS OF THE JOB IS MARKED A3900089 RR* 'SENT' FOR JMNN IN THE $$HOST A3900090 RR* FILE. A3900091 RR* A3900092 RR* OTHERWISE THE RETRIEVED USER RECORD IS A3900093 RR* RETURNED TO THE CALLER. A3900094 RR* A3900095 RR* A3900096 RR* OTHERWISE THE DRIVER ATTEMPTS TO CONNECT TO A3900097 RR* THE NEXT QUEUED JOB FOR THE HOST. A3900098 RR* A3900099 RR* IF ALL QUEUED JOBS FOR THE HOST HAVE A3900100 RR* BEEN 'SENT' THEN, A3900101 RR* A3900102 RR* THE DRIVER LOGICALLY DISCONNECTS A3900103 RR* FROM THE HOST AND RETURNS AN A3900104 RR* END-OF-BATCH INDICATION TO THE A3900105 RR* REQUESTOR. A3900106 RR* A3900107 RR* A3900108 RR* OTHERWISE THE DRIVER LOGICALLY CONNECTS A3900109 RR* TO THE NEXT QUEUED JOB FOR THE HOST AND A3900110 RR* RETURNS THE FIRST USER'S INPUT RECORD A3900111 RR* FOR THAT JOB TO THE REQUESTOR. A3900112 RR* A3900113 RR* A3900114 RR* SUMMARIZING DATA RETURNED TO FREAD REQUESTORS BASED A3900115 RR* ON TYPE OF BATCH WORKSTATION: A3900116 RR* A3900117 RR* 200UT HASP MSOS 5 A3900118 RR* ----- ---- ------ A3900119 RR* A3900120 RR* 1-ST JOB 1-ST JOB 1-ST JOB A3900121 RR* EOF EOF EOF,EOF A3900122 RR* 2-ND JOB 2-ND JOB 2-ND JOB A3900123 RR* EOF EOF EOF,EOF A3900124 RR* . . . A3900125 RR* . . . A3900126 RR* LAST JOB LAST JOB LAST JOB A3900127 RR* EOF ( ) EOF ( ) EOF,EOF A3900128 RR* EOF (EOB) EOF (EOB) '*Z' (EOB) A3900129 RR* A3900130 RR* (EOF = $0200 (EOF = $0F00) (EOF = $0F00) A3900131 RR* A3900132 RR* 2-EOF = END- 2-EOF = END- *Z = END- A3900133 RR* OF- OF- OF- A3900134 RR* BATCH BATCH BATCH A3900135 RR* A3900136 RR* '**EOR' IS EDITED A3900137 RR* TO=$0400 A3900138 RR* A3900139 RR* A3900140 RR* A3900141 RR* A3900142 RR* A3900143 RR* ENTRY A3900144 RR* ----- A3900145 RR* A3900146 RR* A3900147 RR* A3900148 RR* THE DRIVER IS ENTERED AT THE INITIATOR VIA THE A3900149 RR* READ-WRITE REQUEST PROCESSOR WITH THE PHYSICAL DEVICE A3900150 RR* TABLE ADDRESS IN THE Q-REGISTER. THERE ARE NO A3900151 RR* CONTINUTOR OR TIMEOUT ENTRIES. A3900152 RR* A3900153 RR* A3900154 RR* A3900155 RR* A3900156 RR* A3900157 RR* EXIT A3900158 RR* ---- A3900159 RR* A3900160 RR* A3900161 RR* A3900162 RR* NORMAL EXIT IS TO THE DISPATCHER AFTER COMPLETING A3900163 RR* REQUEST FOR ALL REQUESTS QUEUED TO THE PHTSICAL A3900164 RR* DEVICE TABLE. A3900165 RR* A3900166 RR* ERROR EXIT IS TO THE ALTERNATE DEVICE HANDLER WITH A3900167 RR* ERROR CODE = 28(NO FILE). ALL ERRORS ARISE FROM A3900168 RR* FILE MANAGER ERROR STATUS AND RESULT IN ANY CONNECTED A3900169 RR* JOB BEING DISCONNECT AND MARKED 'INACTIVE' IN THE A3900170 RR* $$HOST FILE. THUS THE SOFTWARE DUMMY DEVICE SHOULD A3900171 RR* BE SPECIFED FOR ALL APPLICABLE LOGICAL UNITS TO A3900172 RR* RESULT IN AUTOMATIC REQUEST COMPLETION WITH ERROR. A3900173 RR* A3900174 RR* ON ERROR EXITS THE DRIVER WILL POST ON THE SYSTEM A3900175 RR* COMMENT DEVICE THE FOLLOWING DIAGNOSTIC MESSAGE IF IT A3900176 RR* IS ENABLED FOR THE FAILING PSEUDO DEVICE: A3900177 RR* A3900178 RR* ' JMNN FM RJT =$XXXX, REQTYP FILENAME/ USERNAME' A3900179 RR* A3900180 RR* WHERE - A3900181 RR* A3900182 RR* 'JMNN' IS JOB NAME (JOBKEY), M=HOST ID, NN=JOB ID A3900183 RR* 'XXXX' IS FILE MANAGER ERROR STATUS(HEXDEC) A3900184 RR* REQTYP IS 'OPENFL','CLOSFL','READR','GETS','UPDREC', A3900185 RR* 'CREATE','RENAME','PUTS ','DELETE', A3900186 RR* 'REDUCE'. A3900187 RR* FILE- IS THE ASCII NAME OF FILE AND ITS USER NAME A3900188 RR* NAME/ ENCOUNTERING THE FAILURE. A3900189 RR* USER- A3900190 RR* NAME A3900191 RR* A3900192 RR* A3900193 RR* A3900194 RR* A3900195 RR* A3900196 RR* ENTRY POINTS A3900197 RR* ------------ A3900198 RR* A3900199 RR* A3900200 RR* A3900201 RR ENT DBATIN INITIATOR ENTRY A3900202 RR ENT ABSADD ADDRESS ABSOLUTIZING ROUTINE A3900203 RR* A3900204 RR* A3900205 RR* A3900206 RR* A3900207 RR* A3900208 RR* EXTERNAL REFERENCES A3900209 RR* ------------------- A3900210 RR* A3900211 RR* A3900212 RR* A3900213 RR EXT* OPHOST BATCH DRIVER OPEN $$HOST FILE ROUTINE A3900214 RR EXT* OPBATF BATCH DRIVER OPEN $$BATCH FILE ROUTINE A3900215 RR EXT* BOPENF BATCH DRIVER 'OPENFL' ROUTINE A3900216 RR EXT* BCLOSF BATCH DRIVER 'CLOSFL' ROUTINE A3900217 RR EXT* BREADR BATCH DRIVER 'READR' ROUTINE A3900218 RR EXT* BGETS BATCH DRIVER 'GETS' ROUTINE A3900219 RR EXT* BUPREC BATCH DRIVER 'UPDREL' ROUTINE A3900220 RR EXT* BFWRIT BATCH DRIVER MSOS FWRITE REQUEST A3900221 RR EXT* BTIMER BATCH DRIVER MSOS TIMER REQUEST A3900222 RR EXT HORTO MSOS CURRENT HOUR (INTEGER) A3900223 RR EXT MINTO MSOS CURRENT MINUTE (INTEGER) A3900224 RR EXT SECON MSOS CURRENT SECOND (INTEGER) A3900225 RR EXT DAYTO MSOS CURRENT DAY (INTEGER) A3900226 RR EXT MONTO MSOS CURRENT MONTH (INTEGER) A3900227 RR EXT YERTO MSOS CURRENT YEAR (INTEGER) A3900228 RR EXT ALTDEV MSOS ALTERNATE DEVICE HANDLER A3900229 RR EXT MAS300 A3900230 RR EXT FMEOFC FM/ITOS END-OF-FILE CODE A3900231 RR EXT JOBIND JOB PROCESSOR IN CORE A3900232 RR EXT SWTCH LOCK-OUT SWITHC FOR JP A3900233 RR EXT LOADIN LOADER IN CORE FLAG A3900234 RR EXT MIBUF ADDRESS OF MIINP BUFFER IN JOBENT A3900235 RR EXT JBCNCL JOB CANCEL PROCESSOR A3900236 RR EXT AUTON AUTO MODE IN SYSDAT, MINUS = NOT ALLOWED A3900237 RR* 0 = NOT ENABLED A3900238 RR* 1 = ENABLED A3900239 RR EXT* DELET FILE MANAGER DELETE FILE REQUEST PROCESSOR. A3900240 RR EXT SYFAIL SYSTEM FAILURE PROCESSOR A3900241 RR EXT WKSPLU FILE MANAGER UNIT FOR SCRATCH FILES A3900242 RR EXT MMLUTB FILE MANAGER MASS MEMORY UNIT TABLE A3900243 RR EXT AUTOBT AUTOMATIC BATCH MODE ROUTINE A3900244 RR* A3900245 RR* A3900246 RR* A3900247 RR* A3900248 RR* A3900249 RR* SYSTEM EQUATES A3900250 RR* -------------- A3900251 RR* A3900252 RR* A3900253 RR* A3900254 RR EQU FNR($B5) MSOS FIND NEXT REQUEST A3900255 RR EQU COMPRQ($B6) MSOS COMPLETE REQUEST A3900256 RR EQU AMONI($F4) MONITOR REQUEST ENTRY A3900257 RR EQU ADISP($EA) MSOS DISPATCHER A3900258 RR EQU MOT(14) MOTION REQUEST CODE A3900259 RR* A3900260 RR* A3900261 RR* A3900262 RR* A3900263 RR* A3900264 RR* MASKING EQUATES A3900265 RR* --------------- A3900266 RR* A3900267 RR* A3900268 RR* A3900269 RR EQU FOUR($25) MSOS MASK = $0004 A3900270 RR EQU MAXTRY($B) MSOS MASK = $01FF A3900271 RR EQU M0020($28) MSOS MASK = $0020 A3900272 RR EQU M00FF($A) MSOS MASK = $00FF A3900273 RR EQU M0200($2C) MSOS MASK = $0200 A3900274 RR EQU ONE(3) MSOS MASK = $0001 A3900275 RR EQU TEN($46) MSOS MASK = $000A A3900276 RR EQU ZERO($22) MSOS MASK = $0000 A3900277 RR EQU ONEBIT($23) A3900278 RR* A3900279 RR* A3900280 RR* A3900281 RR* A3900282 RR* A3900283 RR* PHYSTB EQUATES A3900284 RR* -------------- A3900285 RR* A3900286 RR* A3900287 RR* A3900288 RR EQU ELVL(0) PBATXX ADC $5200+LVL SCHDL CALL A3900289 RR EQU EDIN(1) ADC DBATIN INITIATOR A3900290 RR EQU EDCN(2) ADC 0 (NOT USED) A3900291 RR EQU EDPGM(3) ADC 0 (NOT USED) A3900292 RR EQU EDCLK(4) NUM -1 (NOT USED) A3900293 RR EQU ELU(5) NUM 0 LOGICAL UNIT A3900294 RR EQU EPTR(6) NUM 0 REQ LOCATION A3900295 RR EQU EWES(7) NUM 0 (NOT USED) A3900296 RR EQU EREQST(8) NUM $08A2 REQ. STATUS A3900297 RR EQU ESTAT1(9) NUM 0 DRIVER STATUS A3900298 RR EQU ECCOR(10) NUM 0 CURRENT LOC. A3900299 RR EQU ELSTWD(11) NUM 0 LWA+1 A3900300 RR EQU ESTAT2(12) NUM 0 DEVICE STATUS A3900301 RR EQU MASLGN(13) NUM 0 MM LENGTH A3900302 RR EQU MASSEC(14) NUM $7FFF MM SECTOR A3900303 RR EQU RETURN(15) NUM 0 RESERVED A3900304 RR EQU HSTRNO(16) NUM 0,0 $$HOST REL A3900305 RR* REC. NO. A3900306 RR EQU HSTNN(18) NUM 0 TERM/JOB ID A3900307 RR EQU ERSTAT(19) NUM 0 FM ERR STATUS A3900308 RR EQU TIMTRY(20) NUM $8000 ENABLE DIAG/ A3900309 RR* FM CODE/TRYS A3900310 RR EQU JOBKEY(21) ALF 2,J $$BATCH KEY A3900311 RR EQU MOTPAR(23) NUM 0 MOTION PARM. A3900312 RR EQU RTJCAL(24) BZS RTJBF(13) FM/MONI CALLS A3900313 RR EQU REQBUF(37) BZS REQBUF(24) FM 'REQBUF' A3900314 RR EQU IDATA(61) BZS IDATBF(24) FM 'IDATA' A3900315 RR EQU ISTAT(85) BZS ISTABF(1) FM 'ISTAT' A3900316 RR EQU RECBUF(86) BZS RECBF(40) FM 'RECBUF' A3900317 RR* A3900318 RR* A3900319 RR* 'HSTNN' BYTE EQUATES A3900320 RR* -------------------- A3900321 RR* A3900322 RR* A3900323 RR* JOB ID NN=1,99 JOB ID FOR HOST 'M' A3900324 RR* A3900325 RR EQU JNNSTR(7) FLDSTR = BIT7 A3900326 RR EQU JNNLTH(8) FLDLTH = 8 BITS A3900327 RR* A3900328 RR* MSOS END-OF-JOB (EOJ) STATUS A3900329 RR EQU EOJSTR(13) FLDSTR = BIT13 A3900330 RR EQU EOJLTH(1) FLDLTH = 1 BIT A3900331 RR* A3900332 RR* WORKSTATION TYPE = 0 MSOS, = 1 200UT, = 2 HASP A3900333 RR* A3900334 RR EQU TYPSTR(15) FLDSTR = BIT15 A3900335 RR EQU TYPLTH(2) FLDLTH = 2 BITS A3900336 RR* A3900337 RR* A3900338 RR* 'TIMTRY' BYTE EQUATES A3900339 RR* ---------------------- A3900340 RR* A3900341 RR* A3900342 RR* TALLY OF TIMER TRYS FOR LOCK FILE/RECORD ACCESS A3900343 RR* A3900344 RR EQU TIMSTR(8) FLDSTR = BIT8 A3900345 RR EQU TIMLTH(9) FLDLTH = 9 BITS A3900346 RR* A3900347 RR* CURRENT FILE MGR ACCESS REQUEST CODE A3900348 RR* = 0 'OPENFL', =1 'CLOSFL', =2 'READR', =3 'GETS', A3900349 RR* = 4 'UPDREC', =5 'CREATE', =6 'RENAME', A3900350 RR* = 7 'REDUCE', =8 'PUTS ', =9 'DELETE'. A3900351 RR* A3900352 RR EQU FMCSTR(12) FLDSTR = BIT12 A3900353 RR EQU FMCLTH(4) FLDLTH = 4 BITS A3900354 RR* A3900355 RR* USER TEXT FILE TRANSMISSION STATUS A3900356 RR* =0 TRANSMISSION IN-PROGRESS A3900357 RR* =1 INITIATING TRANSMISSION A3900358 RR* A3900359 RR EQU XMTSTR(14) FLDSTR = BIT14 A3900360 RR EQU XMTLTH(1) FLDLTH = 1 BIT A3900361 RR* A3900362 RR* ERROR DIAGNOSTIC POSTING = 0 DISABLED, =1 ENABLE A3900363 RR* A3900364 RR* FLDSTR= BIT15, FLDLTH = 1 BIT A3900365 RR* A3900366 RR* A3900367 RR* 'JOBKEY' - KEY TO $$BATCH FILE RECORD (ASCII) = 'JMNN' A3900368 RR* 'MNN' = BLANK, NO JOB CONNECTED A3900369 RR* A3900370 RR EQU MSTR(7) FLDSTR = BIT7 (REL REC NO OF $$HOST A3900371 RR EQU MLTH(8) FLDLTH = 8 BITS (FILE RECORD MINUS ONE) A3900372 RR* A3900373 RR EQU N1STR(15) FLDSTR = BIT 15 ) A3900374 RR EQU N1LTH(8) FLDLTH = 8 BITS) JOBKEY+1 A3900375 RR EQU N2STR(7) FLDSTR = BIT7 ) A3900376 RR EQU N2LTH(8) FLDLTH = 8 BITS) A3900377 RR* A3900378 RR* A3900379 RR* 'HSTRNO' - $$HOST FILE RELATIVE RECORD NUMBER A3900380 RR* - = 0,0 NOT CONNECTED TO A HOST A3900381 RR**** A3900382 RR EJT A3900383 RRSTART STQ- I MASS MEMORY ENTRY TO DRIVER A3900384 RR LDQ =XDBATIN-START A3900385 RR AAQ Q A3900386 RR STQ- 1,I SET UP INITIATOR ENTRY A3900387 RR JMP* DI0010 A3900388 RRMS300 ADC MAS300 A3900389 RR* A3900390 RR* INITIATOR ENTRY A3900391 RR* A3900392 RR SPC 2 A3900393 RRDBATIN STQ- I SAVE PHYSTB ADDR A3900394 RR SPC 2 A3900395 RR* A3900396 RR* FIND NEXT REQUEST, NORMAL EXIT IF NONE. A3900397 RR* A3900398 RR SPC 2 A3900399 RRDI0010 RTJ- (FNR) A3900400 RR JMP* (MS300) NO RQST OUTSTANDING A3900401 RR* A3900402 RR* FOUND A REQUEST, INITIALIZE PHYSTB FOR THIS REQUEST A3900403 RR* A3900404 RRDI0020 ENA 0 A3900405 RR SFA- TIMTRY,XMTSTR,15,I CLR ALL BUT MSG ENABLE A3900406 RR STA- ERSTAT,I CLR FM ERROR STATUS A3900407 RR STA- MOTPAR,I CLR MOTION PARAMETER A3900408 RR STA- ESTAT2,I CLR ESTAT2 A3900409 RR CLF- ESTAT1,15,3,I CLR V-FIELD A3900410 RR SPC 3 A3900411 RR* A3900412 RR* IF MOTION REQUEST THEN A3900413 RR* A3900414 RR LDQ- EPTR,I GET REQ PARM ADDR A3900415 RR LFA- (ZERO),13,5,Q PICK REQ CODE A3900416 RR INA -MOT A3900417 RR SAN FR0010 A3900418 RR* A3900419 RR* GO TO MOTION REQUEST PROCESSOR A3900420 RR* A3900421 RR JMP MT0010 A3900422 RR* A3900423 RR* OTHERWISE EACH REQUEST IS PROCESSED AS A FREAD REQUEST A3900424 RR* A3900425 RR SPC 4 A3900426 RR* A3900427 RR* IF THE DRIVER IS NOT LOGICALLY CONNECTED TO A A3900428 RR* HOST (REL REC NO. = 0,0) THEN, A3900429 RR* A3900430 RR* A3900431 RRFR0010 LDA- HSTRNO+1,I GET REL RECORD LSB A3900432 RR SAZ FR0020 A3900433 RR JMP FR0500 CONNECTED TO A HOST A3900434 RR* A3900435 RR* SEARCH $$HOST FILE TO LOGICALLY CONNECT TO A3900436 RR* A HOST WITH SAME LU AS THIS REQUEST. A3900437 RR* A3900438 RRFR0020 RTJ OPHOST OPENFL ON $$HOST A3900439 RR SAZ FR0050 CK FM 'ISTAT' A3900440 RR AND* HOPBSY RJT- CK IF BUSY A3900441 RR SAN FR0030 STATUS. A3900442 RR* NO- FM ERROR XIT A3900443 RR LFA- TIMTRY,TIMSTR,TIMLTH,I YES- CK IF MAX A3900444 RR SUB- MAXTRY TRYS A3900445 RR SAM FR0040 ATTEMPTED. A3900446 RRFR0030 JMP ER0020 YES - ERR XIT A3900447 RRFR0040 RTJ BTIMER NO - DELAY A3900448 RR JMP* FR0020 RETRY A3900449 RR SPC 2 A3900450 RRHOPBSY NUM $6A23 BSY STATUS 'OPENFL' $$HOST/$$BATCH A3900451 RR EQU BOPBSY(HOPBSY) A3900452 RRHGTBSY NUM $6120 BSY STATUS 'GETS' $$HOST A3900453 RR SPC 2 A3900454 RR* NO FM RJT A3900455 RRFR0050 CLF- TIMTRY,TIMSTR,TIMLTH,I CLR RETRY COUNTS A3900456 RRFR0060 ENA 0 ZERO FM 'RECBUF' A3900457 RR ENQ 39 A3900458 RRFR0070 STA- RECBUF,B A3900459 RR DQP *-FR0070 A3900460 RRFR0075 ENQ HSTRNO SET Q-REG FOR BGETS A3900461 RR RTJ BGETS RTV NEXT $$HOST REC A3900462 RR SAN FR0077 CK FM ISTAT A3900463 RR JMP* FR0100 A3900464 RRFR0077 EQU FR0077(*) A3900465 RR AND* HGTBSY RJT CK IF BUSY A3900466 RR SAN FR0080 STATUS. A3900467 RR* NO-FM ERROR XIT A3900468 RR LFA- TIMTRY,TIMSTR,TIMLTH,I YES- CK IF MAX A3900469 RR SUB- MAXTRY TRYS A3900470 RR SAP FR0080 ATTEMPTED A3900471 RR JMP* FR0090 A3900472 RRFR0080 EQU FR0080(*) A3900473 RR AND- ONEBIT+8 A3900474 RR SAN FR0081 SKIP IF END-OF-FILE A3900475 RR JMP* FR0085 A3900476 RRFR0081 EQU FR0081(*) A3900477 RR ENQ 0 PUT LU IN ALRT MSG A3900478 RR LDA- ELU,I A3900479 RR DVI- TEN A3900480 RR ALS 8 A3900481 RR AAQ A A3900482 RR ADD =N$3030 A3900483 RR STA* ALRT+10 A3900484 RR ENQ LNALRT ALERT OPERATOR HOST IS NOT SET TO LU A3900485 RR INQ -1 A3900486 RRFR0082 EQU FR0082(*) A3900487 RR LDA* ALRT,Q MOVE MSG TO RECBUF A3900488 RR STA- RECBUF,B A3900489 RR DQP *-FR0082 A3900490 RR ENA LNALRT MSG LENGTH A3900491 RR RTJ BFWRIT WRITE THE MSG A3900492 RRFR0085 EQU FR0085(*) A3900493 RR JMP ER0010 YES - ERROR EXIT A3900494 RR SPC 2 A3900495 RRALRT EQU ALRT(*) A3900496 RR ALF ., HOST NOT SET TO LU XX. A3900497 RRLNALRT EQU LNALRT(*-ALRT) A3900498 RRFR0090 RTJ BTIMER NO - DELAY A3900499 RR JMP* FR0075 RETRY A3900500 RR* NO FM RJT, COMPARE A3900501 RRFR0100 LFA- RECBUF+2,7,8,I THE LU ASSIGNED A3900502 RR EOR- ELU,I TO $$HOST RECORD A3900503 RR SAZ FR0110 WITH REQUESTORS LU. A3900504 RR JMP* FR0050 MISMATCH,NEXT REC. A3900505 RR* MATCH - CONNECT TO A3900506 RRFR0110 LDA- REQBUF+15,I THIS HOST. SAVE A3900507 RR STA- HSTRNO,I REL RECORD NUMBER'S A3900508 RR LDA- REQBUF+16,I 16-BIT LSB. A3900509 RR STA- HSTRNO+1,I A3900510 RR INA $2F CONSTRUCT JOBKEY, A3900511 RR SFA- JOBKEY,MSTR,MLTH,I 'M' = RECNO-1 A3900512 RR LFA- RECBUF+2,9,2,I SAVE WORKSTATION A3900513 RR SFA- HSTNN,TYPSTR,TYPLTH,I TYPE. A3900514 RR* A3900515 RR* ASCERTAIN THE NEXT QUEUED JOB 'NOT SENT' A3900516 RR* FOR THIS HOST(I.E., STNN = 1) A3900517 RR* A3900518 RR* A3900519 RRFR0115 CLF- HSTNN,JNNSTR,JNNLTH,I CLR JOB ID (NN) A3900520 RR ENA 24 SET WD LOOP CONTROL A3900521 RR XFA 2 FOR ST01 TO ST99 A3900522 RR ENQ 0 SET Q FOR ST01-ST04 A3900523 RR SPC 2 A3900524 RR* MAIN LOOP OVER R2. A3900525 RRFR0120 ENA 3 LOOP CONTROL OVER A3900526 RR XFA 1 4 STATUS 4-BIT BYTES A3900527 RR LDA- RECBUF+3,B GET NEXT 4 BYTES. A3900528 RR XFQ 3 SAVE INDEX TO RECBUF. A3900529 RR* * * SECONDARY LOOP OVER 4 BYTES A3900530 RRFR0130 RAO- HSTNN,I SAVE CURRENT JOB ID A3900531 RR CLR Q ISOLATE NEXT STATUS A3900532 RR LLS 4 BYTE IN Q-REG. A3900533 RR INQ -1 CK IF STNN=1 A3900534 RR SQZ FR0150 YES - CONNECT IT. A3900535 RR D1P *-FR0130 * * SECONDARY LOOP,A-REG PRESERVED A3900536 RR XF3 Q NO- RESTORE INDEX A3900537 RR INQ 1 TO NEXT RECBUF A3900538 RR D2P *-FR0120 CK IF ST99 DONE A3900539 RR* A3900540 RR* KILL BATCH - DISCONNECT HOST AND JOB. A3900541 RR* A3900542 RRFR0140 CLF- RECBUF+2,10,1,I JA=SAVJA=0,NO A3900543 RR CLF- TIMTRY,13,1,I JOB ACTIVITY. A3900544 RR JMP FR2000 EXIT TO A3900545 RR* TERMINATION. A3900546 RR* A3900547 RR* LOGICALLY CONNECT TO QUEUED JOB NN BY A3900548 RR* COMPLETING ASCII 'NN' IN JOBKEY 'JMNN'. A3900549 RR* A3900550 RRFR0150 LFA- HSTNN,JNNSTR,JNNLTH,I NN ISOLATED BY A3900551 RR CLR Q RAO AT FR0130. A3900552 RR DVI- TEN NN/10 = A3900553 RR INA $30 N1 IN A-REG A3900554 RR SFA- JOBKEY+1,N1STR,N1LTH,I N2 IN Q-REG A3900555 RR TRQ A A3900556 RR INA $30 'N1' = N1+$30 A3900557 RR SFA- JOBKEY+1,N2STR,N2LTH,I 'N2' = N2+$30 A3900558 RR* A3900559 RR* UPDATE STATUS STNN IN $$HOST RECORD A3900560 RR* TO 'BEING SENT' (I.E. STNN=2) A3900561 RR* A3900562 RR XF1 A R1 = 4 BIT BYTE IDX A3900563 RR ALS 2 = 0, FLDSTR = 3 A3900564 RR INA 3 = 3, FLDSTR = 15 A3900565 RR SFA- MOTPAR,3,4,I SAVE FLDSTR FOR A3900566 RR* STNN RECOVERY A3900567 RR SFA* STNN+1,15,4 FLDSTR = 4*R1 + 3 A3900568 RR* A3900569 RR XF2 Q R2 = (RECBUF+3) IDX A3900570 RR TCQ Q = 24, IDX = 0 A3900571 RR INQ 24 = 23, IDX = 1 A3900572 RR TRQ A SAVE Q-IDX FOR A3900573 RR SFA- MOTPAR,8,5,I ERR RECOVERY. A3900574 RR ADQ- I = 0, IDX =24 A3900575 RR ENA 2 STNN = 2, IDX= 24-R2 A3900576 RRSTNN SFA- RECBUF+3,15,4,Q Q = IDX + PHYSTB ADR A3900577 RR* A3900578 RR* MARK $$HOST RECORD THAT BATCH DRIVER A3900579 RR* ACTIVITY PROCESSING HOST'S JOBS (JA=1) A3900580 RR* FOR ITOS UTILTY PROCESSORS. A3900581 RR* A3900582 RR SEF- RECBUF+2,10,1,I A3900583 RR* A3900584 RR* UPDATE $$HOST RECORD, RECORD LOCKED ON RTV A3900585 RR* A3900586 RR RTJ BUPREC FM 'UPPREC' REQUEST A3900587 RR SAZ FR0160 CK FM 'ISTAT' A3900588 RR JMP ER0010 YES - FM ERR XIT A3900589 RR* A3900590 RR* CLOSE $$HOST FILE AND RETRIEVE BY JOBKEY A3900591 RR* 'JMNN' THE JOB'S RECORD FROM THE $$BATCH A3900592 RR* FILE INORDER TO RECORD DATE/TIME TEXT A3900593 RR* TRANSMITTED. A3900594 RR* A3900595 RRFR0160 RTJ BCLOSF FM 'CLOSFL' REQUEST A3900596 RR SAM FR0165 CK FM 'ISTAT' A3900597 RR JMP* FR0210 NO RTJ - CONTINUE A3900598 RRFR0165 STA- ERSTAT,I A3900599 RR ENA 1 SET 'CLOSFL' CODE. A3900600 RR SFA- TIMTRY,FMCSTR,FMCLTH,I FOR DIAG. MSG. A3900601 RR ENA 0 RJT-LOG DIAG MSG A3900602 RR RTJ BFWRIT IF ENABLED. A3900603 RRFR0170 ENA 0 CLR TRY COUNTS A3900604 RR SFA- TIMTRY,TIMSTR,TIMLTH,I A3900605 RRFR0175 ENQ HSTRNO RTV $$HOST A3900606 RR RTJ BREADR RECORD. A3900607 RR SAZ FR0200 CK FM 'ISTAT' A3900608 RR AND BRDBSY RTJ - CK BSY A3900609 RR SAN FR0180 STATUS. A3900610 RR* NO-ERXIT A3900611 RR LFA- TIMTRY,TIMSTR,TIMLTH,I RETRY IF A3900612 RR SUB- MAXTRY OK A3900613 RR SAM FR0190 A3900614 RRFR0180 JMP ER0010 NO-ERXIT A3900615 RRFR0190 RTJ BTIMER YES,DLY A3900616 RR JMP* FR0175 RETRY A3900617 RR SPC 2 A3900618 RRFR0200 LFA- MOTPAR,3,4,I ERR RECOVERY EXIT A3900619 RR SFA* RSTNN+1,15,4 RESTORE STNN FLDSTR A3900620 RR LFA- MOTPAR,8,5,I RESTORE Q-IDX A3900621 RR TRA Q A3900622 RR ADQ- I A3900623 RR ENA 0 STNN=0, IDX=RESTORED A3900624 RRRSTNN SFA- RECBUF+3,15,4,Q Q = IDX + PHYSTB A3900625 RR CLF- RECBUF+2,11,2,I JA=0, AI=0 INACTIVE A3900626 RR RTJ BUPREC 'UPDREC' REQUEST A3900627 RR JMP ER0010 FM ERR XIT A3900628 RR* A3900629 RR* OPEN $$BATCH FILE, LOCK RECORD ON RTV A3900630 RR* A3900631 RRFR0210 CLF- TIMTRY,TIMSTR,TIMLTH,I CLR TRY COUNTS A3900632 RRFR0220 RTJ OPBATF 'OPENFL' REQUEST A3900633 RR SAM FR0225 CK FM 'ISTAT' A3900634 RR JMP* FR0320 NO RTJ - RTV RECORD A3900635 RRFR0225 AND BOPBSY RJT - CK IF BUSY A3900636 RR SAZ FR0240 A3900637 RRFR0230 ENA 0 NO- DIAG MSG A3900638 RR RTJ BFWRIT AND A3900639 RR JMP* FR0260 ERR RECOVERY A3900640 RRFR0240 LFA- TIMTRY,TIMSTR,TIMLTH,I YES- CK IF A3900641 RR SUB- MAXTRY OK TO A3900642 RR SAM FR0250 RETRY. A3900643 RR JMP* FR0230 NO-ERR XIT A3900644 RRFR0250 RTJ BTIMER YES-DELAY A3900645 RR JMP* FR0220 RETRY A3900646 RR* MARK STNN=0, JA=0 A3900647 RRFR0260 CLF- TIMTRY,TIMSTR,TIMLTH,I CLR RETRY COUNTS A3900648 RRFR0270 RTJ OPHOST 'OPENFL' FOR $$HOST A3900649 RR SAM FR0280 CK FM 'ISTAT' A3900650 RR JMP* FR0170 NO RJT- ERR RECOVERY A3900651 RRFR0280 AND HOPBSY RJT - CK IF BUSY A3900652 RR SAZ FR0290 A3900653 RR JMP* FR0300 NO-FM ERR XIT A3900654 RRFR0290 LFA- TIMTRY,TIMSTR,TIMLTH,I YES- CK IF OK A3900655 RR SUB- MAXTRY TO RETRY. A3900656 RR SAM FR0310 A3900657 RRFR0300 JMP ER0020 NO-ER XIT A3900658 RRFR0310 RTJ BTIMER YES-DELAY A3900659 RR JMP* FR0270 RETRY A3900660 RR* A3900661 RR* RETRIEVE 'JOBKEY' $$BATCH RECORD A3900662 RR* A3900663 RRFR0320 CLF- TIMTRY,TIMSTR,TIMLTH,I CLR RETRY COUNT A3900664 RRFR0330 ENQ JOBKEY 'RECSPC' = JOBKEY A3900665 RR RTJ BREADR 'READR' REQUEST A3900666 RR SAN FR0340 CK FM 'ISTAT' A3900667 RR JMP* FR0400 NO RTJ - SET DATE A3900668 RRFR0340 SAP FR0350 VERIFY NON-RJT STAT A3900669 RR AND BRDBSY RJT - CK IF BUSY A3900670 RR SAZ FR0360 A3900671 RRFR0350 ENA 0 NO, DIAG MSG A3900672 RR RTJ BFWRIT THEN, ERROR A3900673 RR JMP* FR0380 RECOVERY. A3900674 RRFR0360 LFA- TIMTRY,TIMSTR,TIMLTH,I YES- CK IF A3900675 RR SUB- MAXTRY RETRY OK A3900676 RR SAM FR0370 A3900677 RR JMP* FR0380 NO-RECOVER A3900678 RRFR0370 RTJ BTIMER YES-DELAY A3900679 RR JMP* FR0330 RETRY A3900680 RR* MARK STNN=0, JA=0 A3900681 RRFR0380 RTJ BCLOSF 'CLOSFL' ON $$BATCH A3900682 RR SAP FR0390 CK FM 'ISTAT' A3900683 RRFR0385 STA- ERSTAT,I RJT - DIAG MSG A3900684 RR ENA 1 SET 'CLOSFL' CODE. A3900685 RR SFA- TIMTRY,FMCSTR,FMCLTH,I FOR DIAG. MSG. A3900686 RR ENA 0 A3900687 RR RTJ BFWRIT A3900688 RRFR0390 JMP* FR0260 ERROR RECOVERY A3900689 RR* A3900690 RR* SET DATE/TOD TEXT TRANSMITTED A3900691 RR* A3900692 RRDECASI NUM 0 ENTRY TO CONVERT A3900693 RR CLR Q 2-DIGIT DECIMAL A3900694 RR DVI- TEN TO ASCII. A3900695 RR INA $30 IT/10 = A-REG TENS A3900696 RR INQ $30 Q-REG ONES A3900697 RR ALS 8 A-REG = MSB IS TENS A3900698 RR EAQ A A-REG = LSB IS ONES A3900699 RR JMP* (DECASI) A3900700 RR SPC 2 A3900701 RRDATOD ADC DAYTO CURRENT DAY (BIN) A3900702 RR ADC MONTO CURRENT MONTH (BIN) A3900703 RR ADC YERTO CURRENT YEAR (BIN) A3900704 RR ADC HORTO CURRENT HOUR (BIN) A3900705 RR ADC MINTO CURRENT MINUTE (BIN) A3900706 RR ADC SECON CURRENT SECOND (BIN) A3900707 RR SPC 2 A3900708 RRFR0400 ENQ 5 USE R1 TO SAVE Q-REG A3900709 RR XFQ 1 AND FOR LOOP CONTROL A3900710 RRFR0410 XF1 Q GET UPDATED R1 A3900711 RR LDQ* DATOD,Q GET ADDR OF ITEM A3900712 RR LDA- (ZERO),Q PICKUP ITEM A3900713 RR RTJ* DECASI CONVERT TO ASCII A3900714 RR XF1 Q RESTORE Q-REG A3900715 RR STA- RECBUF+20,B STORE ITEM A3900716 RR D1P *-FR0410 DO NEXT ITEM A3900717 RR* A3900718 RR* UPDATE JOBKEY $$BATCH RECORD A3900719 RR* A3900720 RR RTJ BUPREC A3900721 RR SAZ FR0420 A3900722 RR ENA 0 A3900723 RR RTJ BFWRIT A3900724 RR JMP* FR0380 A3900725 RR* A3900726 RR* CLOSE $$BATCH FILE A3900727 RR* A3900728 RRFR0420 RTJ BCLOSF 'CLOSFL' REQUEST A3900729 RR SAP FR0430 CK FM 'ISTAT' A3900730 RR JMP* FR0385 RJT -ERR RECOVERY A3900731 RR* A3900732 RR* OPEN USER TEXT FILE TO RETRIEVE A3900733 RR* FIRST INPUT RECORD. A3900734 RRFR0430 ENQ 3 MOVE USER FILE NAME A3900735 RRFR0431 LDA- RECBUF+10,B FROM JMNN $$BATCH A3900736 RR STA- IDATA,B RECORD TO IDATA(1) A3900737 RR DQP *-FR0431 THRU IDATA(4). A3900738 RR* A3900739 RR ENQ 3 MOVE USER'S NAME A3900740 RRFR0435 LDA* TXTOWN,Q (TEXT FILES ARE $$ ) A3900741 RR STA- IDATA+4,B RECORD TO IDATA(5) A3900742 RR DQP *-FR0435 THRU IDATA(8). A3900743 RR* A3900744 RR LDQ+ WKSPLU A3900745 RR LDQ+ MMLUTB,Q A3900746 RR INQ 1 A3900747 RR STQ* VOLADD ADDRESS OF SCRATCH VOLUME NAME A3900748 RR ENQ 3 MOVE USER'S VOLUMN A3900749 RRFR0440 LDA* (VOLADD),Q FROM VOLUME INFORMATION TABLE A3900750 RR STA- IDATA+8,B RECORD TO IDATA(9) A3900751 RR DQP *-FR0440 THRU IDATA(12). A3900752 RR* A3900753 RR ENA 0 IDATA(13)=0, ACCESS A3900754 RR STA- IDATA+12,I BY REL RECORD NO. A3900755 RR ENA 1 IDATA(14)=1, ONE A3900756 RR STA- IDATA+13,I RECORD PER RTV A3900757 RR ENA -1 IDATA(15)<0, FILE A3900758 RR STA- IDATA+14,I LOCKED ON ACESS. A3900759 RR* A3900760 RR CLF- TIMTRY,TIMSTR,TIMLTH,I CLR RETRY COUNTS A3900761 RRFR0450 RTJ BOPENF 'OPENFL' REQUEST A3900762 RR SAP FR0480 CK FM 'ISTAT' A3900763 RR AND* TXTBSY RTJ- CK IF BUSY A3900764 RR SAZ FR0470 A3900765 RRFR0460 ENA 0 NO-DIAG MSG A3900766 RR RTJ BFWRIT AND ERROR A3900767 RR JMP* FR0260 RECOVERY. A3900768 RRFR0470 LFA- TIMTRY,TIMSTR,TIMLTH,I YES-CK IF RETRY A3900769 RR SUB- MAXTRY OK. A3900770 RR SAM FR0475 A3900771 RR JMP* FR0460 NO-RECOVERY A3900772 RRFR0475 RTJ BTIMER YES-DELAY, A3900773 RR JMP* FR0450 RETRY A3900774 RR* A3900775 RRFR0480 SEF- TIMTRY,XMTSTR,XMTLTH,I NO RJT, MARK INIT. A3900776 RR JMP* FR0510 XMIT,AND TRV RECORD. A3900777 RRTXTBSY NUM $6A22 BSY MASK 'OPENFL' TEXT A3900778 RRTXTOWN ALF 4,$$ A3900779 RR* A3900780 RR* OTHERWISE DRIVER IS IMPLIED ALREADY CONNECTED A3900781 RR* TO A HOST. A3900782 RR* A3900783 RR* A3900784 RR* IF THE DRIVER IS ALSO LOGICALLY CONNECTED A3900785 RR* TO A JOB FOR THIS HOST THEN, A3900786 RR* A3900787 RRFR0500 LDA- JOBKEY+1,I COMARE LSB OF JOBKEY A3900788 RR EOR =A TO BLANKS A3900789 RR SAN FR0510 A3900790 RR JMP* FR0620 NOT CONNECTED A3900791 RR* A3900792 RR* THE NEXT RECORD IS SEQUENTIALLY A3900793 RR* RETRIEVED FROM THE USER'S INPUT A3900794 RR* TEXT FILE. A3900795 RR* A3900796 RRFR0510 ENQ HSTRNO DUMMY KEYNAL A3900797 RR RTJ BGETS SEQ RTV A3900798 RR* A3900799 RR* IF AN EOF(OR ERROR) IS DETECTED THEN, A3900800 RR* A3900801 RR SAM FR0520 CK FM 'ISTAT' A3900802 RR EOR- FOUR NO RJT -VERIFY LOCK A3900803 RR SAN FR0520 FILE ONLY. A3900804 RR LDA- RECBUF,I YES-LOOK FOR A3900805 RR EOR* TXTEOF TEXT EDITOR EOF A3900806 RR SAZ FR0520 CK FOR TEXT RECD A3900807 RR JMP* FR0550 YES-XMIT RECORD A3900808 RR SPC 2 A3900809 RRTXTEOF ADC FMEOFC ITOS TEXT EDITOR EOF A3900810 RRVOLADD ADC 0 ADDRESS OF SCRATCH VOLUME NAME A3900811 RR EJT A3900812 RR* A3900813 RR* FOR ONE OR MORE TEXT RECORDS XMIT, A3900814 RR* AN EOF INDICATION IS RETURNED TO A3900815 RR* THE REQUESTOR AND THE BATCH A3900816 RR* WORKSTATION AND DRIVER ARE A3900817 RR* LOGICALLY DISOCNNECTED FROM A3900818 RR* THE JOB. A3900819 RR* A3900820 RR* A3900821 RR* IF NO TEXT RECORDS TRANS- A3900822 RR* MITTED THEN, A3900823 RR* A3900824 RRFR0520 LFA- TIMTRY,XMTSTR,XMTLTH,I NO-CK FOR A3900825 RR SAZ FR0540 RECORDS XMIT. A3900826 RR* A3900827 RR* JOB IS MARKED INACTIVE A3900828 RR* (I.E., STNN = 0) A3900829 RR* A3900830 RRFR0530 ENA 0 YES-DIAG MSG A3900831 RR RTJ BFWRIT 'CLOSFL' A3900832 RR RTJ BCLOSF ON TEXT. A3900833 RR SAP FR0535 RECOVERY A3900834 RR STA- ERSTAT,I A3900835 RR ENA 1 SET 'CLOSFL' CODE. A3900836 RR SFA- TIMTRY,FMCSTR,FMCLTH,I FOR DIAG. MSG. A3900837 RR JMP* FR0460 EXIT. A3900838 RRFR0535 JMP FR0260 STNN=0. A3900839 RR* A3900840 RR* OTHERWISE A3900841 RR* A3900842 RR* JOB IS MARKED 'SENT' A3900843 RR* (I.E., STNN = 0) A3900844 RR* A3900845 RRFR0540 STA- MOTPAR,I CLEAR TEMP USEAGE A3900846 RR JMP FR0800 OF MOTPAR, CLOSE TEXT A3900847 RR* FILE, MARK STNN = 3. A3900848 RR* A3900849 RR* OTHERWISE THE RETRIEVED TEXT RECORD IS A3900850 RR* RETURNED TO THE CALLER. A3900851 RR* A3900852 RR* IF WORKSTATION IS 200UT AND RECORD A3900853 RR* IS '**EOR' THEN, A3900854 RR* A3900855 RRFR0550 LFA- HSTNN,TYPSTR,TYPLTH,I CK IF TYPE = 1 A3900856 RR INA -1 (200UT) A3900857 RR SAN FR0570 A3900858 RR* A3900859 RR* EDIT '**EOR' TO $0400 A3900860 RR* A3900861 RR ENQ 4 LOOP OVER 5 CHAR. A3900862 RRFR0560 LCA* UTEOR,Q A3900863 RR CCE- RECBUF,Q,I A3900864 RR JMP* FR0570 A3900865 RR DQP *-FR0560 A3900866 RR LDA =N$0400 A3900867 RR STA- RECBUF,I A3900868 RR LDA* ETX A3900869 RR STA- RECBUF+1,I A3900870 RR* A3900871 RR* OTHERWISE, CONTINUE. A3900872 RR* A3900873 RR* MOVE TEXT RECORD TO REQUESTOR'S A3900874 RR* I/O BUFFER. A3900875 RR* A3900876 RRFR0570 EQU FR0570(*) A3900877 RR LDA- ECCOR,I PREVENT USER FROM TURNING OFF BATCH A3900878 RR EOR+ MIBUF A3900879 RR SAN FR0575 SKIP IF INPUT BFR NOT MIBUF A3900880 RR LDA- RECBUF,I GET 1ST 2 CHARS FROM BFR A3900881 RR SUB =A*Z A3900882 RR SAN FR0575 SKIP IF NOT '*Z' A3900883 RR JMP* FR0520 CLOSE TEXT INPUT A3900884 RRFR0575 EQU FR0575(*) A3900885 RR LDA- ELSTWD,I CALL REQUESTOR'S I/O A3900886 RR SUB- ECCOR,I LENGTH-1. A3900887 RR INA -1 CK FOR ZERO LENGTH A3900888 RR SAN FR0580 REQ L1 CHAR. REQ) A3900889 RR LDA- M00FF YES - NULL 2-CHAR A3900890 RR SFA- RECBUF,7,8,I A3900891 RR ENA 0 XFR 1-WORD A3900892 RR JMP* FR0590 TO CALLER. A3900893 RR* NO - CK FOR REQ A3900894 RRFR0580 TRA Q LENGTH.GT. A3900895 RR INQ -40 80 CHAR. A3900896 RR SQM FR0590 A3900897 RR LDQ- ELSTWD,I YES-MARK REQ A3900898 RR INQ -1 FOR SHORT A3900899 RR LDA- ECCOR,I READ. A3900900 RR INA 40 SAVE LWA+1 A3900901 RR STA- (ZERO),Q FOR XFR. A3900902 RR* SHORT READ, A3900903 RR SEF- ESTAT1,14,2,I DEVICE RDY. A3900904 RR ENA 39 LENGTH=40 A3900905 RR* A-REG= TRF LENGTH-1 A3900906 RRFR0590 XFA 1 REG 1 FOR LOOP CONTRL A3900907 RR ENQ 0 INIT TRF CONTROL A3900908 RR LDA- ECCOR,I INDEX AND ADDRESS A3900909 RR STA* ACALBF A3900910 RRFR0600 LDA- RECBUF,B XFR TEXT RECORD TO A3900911 RR STA* (ACALBF),Q REQUESTOR'S BUFFER. A3900912 RR EOR* ETX IF ETX,BLANK FILL A3900913 RR SAN FR0610 REST OF ACALBF. A3900914 RR LDA* SPACE A3900915 RRFR0605 STA* (ACALBF),Q A3900916 RR INQ 1 FINISH REG 1 A3900917 RR D1P *-FR0605 LOOP HERE, A3900918 RR JMP* FR0615 A3900919 RRFR0610 INQ 1 BUMP INDEX A3900920 RR D1P *-FR0600 XFR LOOP CONTROL A3900921 RR* A3900922 RR* COMPLETE THE REQUEST AND RETURN TO A3900923 RR* INITIATOR FOR NEXT REQUEST. A3900924 RRFR0615 RTJ- (COMPRQ) A3900925 RR JMP DI0010 A3900926 RR SPC 3 A3900927 RRBRDBSY NUM $6320 BSY MASK 'READR' $$HOST/$$BATCH A3900928 RRUTEOR ALF 3,**EOR 200UT EOR RECORD (EDIT TO $0400)A3900929 RRETX NUM $0303 EDITING DELIMITOR FOR START A3900930 RRSPACE ALF 1, ETX EDITING TO SPACES. A3900931 RRACALBF ADC 0 ABS ADDR OF REQUESTOR'S I/O BUFFER. A3900932 RR SPC 2 A3900933 RR* SPECIAL FOR MSOS 5.0 *BATCH A3900934 RR* A3900935 RRJOBI ADC JOBIND JOB PROCESSOR IN CORE A3900936 RRSTH ADC SWTCH JP LOCK-OUT FOR LIBEDT/RECOVERY A3900937 RRLDIN ADC LOADIN LOADER IN CORE FLAG A3900938 RR EJT A3900939 RR* A3900940 RR* OTHERWISE THE DRIVER ATTEMPTS TO CONNECT TO A3900941 RR* THE NEXT QUEUED JOB FOR THE HOST. A3900942 RR* A3900943 RR* A3900944 RR* FOR MSOS 5 BATCH INPUT PROTECT USERS A3900945 RR* JOB STREAM FROM BAD JOB CONTROL TEXT A3900946 RR* FROM PREVIOUS JOB. IF THIS READ REQUEST A3900947 RR* NOT ORIGINATING FROM JOBPRO THEN A3900948 RR* CANCEL CURRENT JOB BEFORE STARTING NEXT A3900949 RR* QUEUED JOB. A3900950 RR* HOWEVER, IF THE RQUEST IS FROM JOBENT, A3900951 RR* ISSUE EOF, AND DEFER STARING THE NEXT A3900952 RR* JOB UNTIL THE NEXT READ REQUEST. A3900953 RR* A3900954 RR* A3900955 RR* A3900956 RRFR0620 SFZ- HSTNN,TYPSTR,TYPLTH,I CK FOR MSOS HOST A3900957 RR JMP* FR0629 NO - GET NEXT JOB A3900958 RR LDA+ MIBUF COMPARE INPUT BUFFER A3900959 RR EOR- ECCOR,I FOR JOBPRO TO A3900960 RR SAZ FR0621 REQUESTORS BUFFER. A3900961 RR JMP* FR0623 NO - ABORT A3900962 RRFR0621 LFA- HSTNN,EOJSTR,EOJLTH,I YES- CK IF EOJ A3900963 RR SAZ FR0622 ISSUED. A3900964 RR CLF- HSTNN,EOJSTR,EOJLTH,I YES-CLR EOJ, A3900965 RR JMP* FR0629 GET NXT JOB A3900966 RRFR0622 SEF- HSTNN,EOJSTR,EOJLTH,I NO-ISSUE EOF A3900967 RR SEF- ESTAT2,11,1,I FOR A3900968 RR SEF- ESTAT1,15,3,I END-OF-JOB A3900969 RR LDA =N$00F0 TO JOBPRO. A3900970 RR STA- RECBUF,I DEFER NEXT A3900971 RR LDA* ETX JOB UNTIL A3900972 RR STA- RECBUF+1,I NEXT READ A3900973 RR JMP* FR0575 REQUEST. A3900974 RR* NO -ABORT CURRENT A3900975 RRFR0623 LDA* (JOBI) JOB (BAD JCL). A3900976 RR SAZ FR0624 CK IF JP IN CORE A3900977 RR JMP* FR0628 YES - CANCEL JOB A3900978 RRFR0624 LDA* (STH) NO - CK JP LOCK-OUT A3900979 RR SAN FR0626 FOR LIBEDT, A3900980 RR JMP* FR0629 OR RECOVERY. A3900981 RRFR0626 ENA 0 YES - A3900982 RR STA* (LDIN) CLR LOADIN A3900983 RR ENA 1 SET SWITCH A3900984 RR STA* (STH) POSITIVE, A3900985 RRFR0628 RTJ- (AMONI) CANCEL JOB AND A3900986 RR NUM $5202 COMPLETE REQUEST A3900987 RR ADC JBCNCL WITH BLANK RECORD, A3900988 RR LDA* ETX DEFER JOB UNTIL A3900989 RR STA- RECBUF,I SLEW TO EOF AND A3900990 RR JMP* FR0575 NEXT READ. A3900991 RR* A3900992 RR* GET NEXT JOB FOR THE HOST FROM ITS A3900993 RR* RECORD IN THE $$HOST FILE. A3900994 RR* A3900995 RRFR0629 CLF- TIMTRY,TIMSTR,TIMLTH,I CLR RETRY COUNTS A3900996 RRFR0630 RTJ OPHOST 'OPENFL' ON $$HOST A3900997 RR SAP FR0660 CK FM 'ISTAT' A3900998 RR AND HOPBSY RTJ -CK FOR BUSY A3900999 RR SAN FR0640 STATUS. A3901000 RR* NO-FM ERR XIT A3901001 RR LFA- TIMTRY,TIMSTR,TIMLTH,I YES- CK IF MAX A3901002 RR SUB- MAXTRY TRYS A3901003 RR SAM FR0650 ATTEMPED. A3901004 RRFR0640 JMP ER0020 YES- ERR XIT A3901005 RRFR0650 RTJ BTIMER NO- DELAY, A3901006 RR JMP* FR0630 RETRY. A3901007 RR* NO FM RJT A3901008 RRFR0660 CLF- TIMTRY,TIMSTR,TIMLTH,I CLR RETRY COUNTS A3901009 RRFR0670 ENA 0 ZERO FM 'RELBUF' A3901010 RR ENQ 39 A3901011 RRFR0680 STA- RECBUF,B A3901012 RR DQP *-FR0680 A3901013 RRFR0690 ENQ HSTRNO 'READR' REQ FOR A3901014 RR RTJ BREADR $$HOST RECORD. A3901015 RR SAZ FR0720 CK FM 'ISTAT' A3901016 RR AND* BRDBSY RTJ - CK IF BUSY A3901017 RR SAN FR0700 STATUS A3901018 RR LFA- TIMTRY,TIMSTR,TIMLTH,I YES-CK FOR MAX A3901019 RR SUB- MAXTRY RETRYS. A3901020 RR SAM FR0710 A3901021 RRFR0700 JMP ER0010 YES-ER XIT A3901022 RRFR0710 RTJ BTIMER NO- DELAY, A3901023 RR JMP* FR0690 RETRY. A3901024 RR* A3901025 RR* IF OPERATOR REQUESTED BATCH TERM- A3901026 RR* INATION ON COMPLETION OF CURRENT A3901027 RR* JOB, THEN A3901028 RR* A3901029 RRFR0720 LFA- RECBUF+2,11,1,I A3901030 RR SAZ FR0730 A3901031 RR* A3901032 RR* DRIVER LOGICALLY DISCONNECTS FROM A3901033 RR* THE HOST AND RETURNS AN END-OF- A3901034 RR* BATCH INDICATION TO THE REQUESTOR. A3901035 RR* A3901036 RR JMP FR0140 DISCONNECT, EOB. A3901037 RR* A3901038 RR* OTHERWISE, GO SEARCH FOR NEXT JOB A3901039 RR* 'NOT SENT' (STNN =1) IN $$HOST A3901040 RR* RECORD JUST RETRIEVED. A3901041 RR* A3901042 RRFR0730 JMP FR0115 NEXT QUUED JOB. A3901043 RR SPC 2 A3901044 RR* A3901045 RR* ADDRESS ABSOLUTIZING ROUTINE A3901046 RR* A3901047 RRABSADD NOP 0 A3901048 RR SPC 1 A3901049 RR LDA* (ABSADD) A = RELATIVE ADDRESS OF FILE REQUEST A3901050 RR ADD* ABSADD A = ABSOLUTE ADDRESS OF FILE REQUEST A3901051 RR RAO* ABSADD A3901052 RR SPC 1 A3901053 RR JMP* (ABSADD) RETURN A3901054 RR EJT A3901055 RR* THE FOLLOWING IS ENTERED TO OBTAIN THE HOST'S RECORD A3901056 RR* FROM THE $$HOST INORDER TO UPDATE JOB 'JMNN' STATUS A3901057 RR* STNN. A3901058 RR* A3901059 RR* ENTERED FROM FREAD PROCESSING _ A3901060 RR* A3901061 RR* A TEXT FILE EOF, OR ERROR OCCURRED A3901062 RR* A3901063 RR* ENTERED FROM MOTION PROCESSING S A3901064 RR* A3901065 RR* ISSUE MOTION REQUEST. A3901066 RR SPC 2 A3901067 RRFR0800 RTJ BCLOSF 'CLOSFL' ON TEXT FILE A3901068 RR SAP FR0805 CK FM 'ISTAT' A3901069 RR STA- ERSTAT,I A3901070 RR ENA 1 SET 'CLOSFL' CODE. A3901071 RR SFA- TIMTRY,FMCSTR,FMCLTH,I FOR DIAG. MSG. A3901072 RR ENA 0 RJT- POST DIAG A3901073 RR RTJ BFWRIT MSG A3901074 RR* DELETE TEXT FILE A3901075 RRFR0805 EQU FR0805(*) A3901076 RR ENA 9 SET REQUEST CODE FOR 'DELETE' A3901077 RR SFA- TIMTRY,12,4,I A3901078 RR RTJ* ABSADD ABSOLUTIZE THE FILE REQUEST ADDRESS A3901079 RR ADC* DELET A3901080 RR STA* DEN010+1 STORE IN THE REQUEST A3901081 RR ENQ DCALTH MOVE 'DELETE' ROUTINE TO PHYSTB A3901082 RRFR0807 EQU FR0807(*) A3901083 RR LDA* DENTRY,Q A3901084 RR STA- RTJCAL,B A3901085 RR DQP *-FR0807 A3901086 RR RTJ- RTJCAL,I GO EXECUTE ROUTINE IN PHYSTB A3901087 RR* A3901088 RR* RETURN FROM 'DELETE' ROUTINE IN PHYSTB, A-REG = ISTAT. A3901089 RR* A3901090 RR SAP FR0810 SKIP IF NO ERROR A3901091 RR ENA 0 REJECT, POST DIAG MSG A3901092 RR RTJ BFWRIT A3901093 RR JMP* FR0810 A3901094 RR SPC 2 A3901095 RR* A3901096 RR* THE FOLLOWING CODE STARTING AT LABEL 'DENTRY' THRU A3901097 RR* LABEL 'DCALTH' IS NOT EXECUTED IN THE DRIVER, BUT IS A3901098 RR* BUILT AN D MOVED TO THE PHYSTB. THE CODE IS THEN A3901099 RR* EXECUTED FROM THE PHYSTB WITH RETURN TO THE DRIVER. A3901100 RR* A3901101 RRDENTRY NUM 0 ENTRY A3901102 RRDEN010 RTJ+ SYFAIL DELETE FILE REQUEST A3901103 RR ADC (REQBUF-RTJCAL-3) REL ADR TO 'REQBUF' PARAMETER A3901104 RR ADC (IDATA-RTJCAL-4) REL ADR TO 'IDATA' PARAMETER A3901105 RR ADC (ISTAT-RTJCAL-5) REL ADR TO 'ISTAT' PARAMETER A3901106 RR LDA- ISTAT,I PICKUP REQUEST STATUS A3901107 RR STA- ERSTAT,I AND SAVE A3901108 RR JMP* (DENTRY) A3901109 RRDCALTH EQU DCALTH(*-DENTRY-1) A3901110 RR* A3901111 RR* CALLER'S Q/I REGISTERS PRESERVED BY FILE MANAGER A3901112 RR* A3901113 RR SPC 2 A3901114 RRFR0810 CLF- TIMTRY,TIMSTR,TIMLTH,I CLR RETRY COUNTS A3901115 RRFR0820 RTJ OPHOST 'OPENFL' ON $$HOST A3901116 RR SAM FR0825 CK FM 'INSTAT' A3901117 RR JMP* FR0860 NORTJ ' RTV REC A3901118 RRFR0825 AND HOPBSY RTJ- CK FOR BUSY A3901119 RR SAZ FR0840 STATUS. A3901120 RRFR0830 ENA 0 NO-DIAG MSG A3901121 RR RTJ BFWRIT KILL A3901122 RR* BATCH A3901123 RRFR0835 CLF- TIMTRY,13,1,I FOR THIS A3901124 RR JMP* FR2000 HOST. A3901125 RRFR0840 LFA- TIMTRY,TIMSTR,TIMLTH,I YES-CK FOR A3901126 RR SUB- MAXTRY RETRY. A3901127 RR SAM FR0850 A3901128 RR JMP* FR0830 A3901129 RRFR0850 RTJ BTIMER YES-DELAY, A3901130 RR JMP* FR0820 RETRY. A3901131 RR* A3901132 RRFR0860 CLF- TIMTRY,TIMSTR,TIMLTH,I CLRRETRY COUNTS A3901133 RRFR0870 ENQ HSTRNO RTV $$HOST RECORD A3901134 RR RTJ BREADR BY REC REC ND. A3901135 RR SAM FR0880 CK FM 'ISTAT' A3901136 RR JMP* FR0920 NO RJT- TERM JOB A3901137 RRFR0880 AND BRDBSY RTJ_ CK IF BMSY A3901138 RR SAZ FR0900 STATUS. A3901139 RRFR0885 ENA 0 NO-DIAG MSG A3901140 RR RTJ BFWRIT 'CLOSFL' REQ ON A3901141 RR RTJ BCLOSF TEXT FILE. A3901142 RR SAP FR0890 CK FM 'ISTAT' A3901143 RR STA- ERSTAT,I A3901144 RR ENA 1 SET 'CLOSFL' CODE. A3901145 RR SFA- TIMTRY,FMCSTR,FMCLTH,I FOR DIAG. MSG. A3901146 RR JMP* FR0830 KILL BATCH. A3901147 RRFR0890 JMP* FR0835 NO RJT, KILL A3901148 RR* RTJ, BUSY STATUS A3901149 RRFR0900 LFA- TIMTRY,TIMSTR,TIMLTH,I CK IF MAX RETRY A3901150 RR SUB- MAXTRY ATTEMPTS. A3901151 RR SAM FR0910 A3901152 RR JMP* FR0885 YES-KILL BATCH A3901153 RRFR0910 RTJ BTIMER NO - DELAY A3901154 RR JMP* FR0870 RETRY. A3901155 RR* A3901156 RR* UPDATE JOB 'JMNN' STATUS IN $$HOST RECORD, A3901157 RR* END-OF-JOB TERMINATION. A3901158 RR* A3901159 RRFR0920 LFA- RECBUF+2,10,1,I GET JOB ACTIVITY(JA), A3901160 RR SFA- TIMTRY,13,1,I SAVE FOR KILBATCH TST A3901161 RR LFA- HSTNN,JNNSTR,JNNLTH,I GET JOB ID = NN A3901162 RR INA -1 (NN-1)14 GIVES: A3901163 RR CLR Q A-REG= RECBUF+3 IDX A3901164 RR DVI- FOUR Q-REG= BYTE INDEX A3901165 RR ADD- I SAVE RECBUF+3 IDX A3901166 RR XFA 1 IN REG 1. A3901167 RR QLS 2 CALC 'FLDSTR' = A3901168 RR TCQ Q =(15 - 4*Q-REG) A3901169 RR ENA 15 A3901170 RR AAQ A MODIFY FLDSTR IW A3901171 RR SFA* GTSTNN+1,15,4 GET STNN INSTR, A3901172 RR SFA* UPSTNN+1,15,4 STORE STNN INSTR. A3901173 RR* A3901174 RR* STNN UPDATED BASED ON CURRENT VALUE AND A3901175 RR* REQUEST BEING PROCESSED. A3901176 RR* A3901177 RR* ----------------- ------------ A3901178 RR* - PRESENT VALUE UPDATED VALUE A3901179 RR* FWRITE REQUESTS: A3901180 RR* A3901181 RR* =2(BEING SENT) =3(SENT) A3901182 RR* . =8(DISCARD) =9(SENT,DISCARD) A3901183 RR* A3901184 RR* MOTION REQUEST(SLEW TO EOF): A3901185 RR* A3901186 RR* =2(BEING SENT) =7(JOB ABORTED) A3901187 RR* =8(DISCARD) =9(SENT,DISCARD) A3901188 RR* A3901189 RR* MOTION REQUEST(BACKSPACE FILE): A3901190 RR* A3901191 RR* =2(BEING SENT) =1(NOT SENT) A3901192 RR* =8(DISCARD) =9(SENT,DISCARD) A3901193 RR* A3901194 RRGTSTNN LFA- RECBUF+3,15,4,1 GET CURRENT STNN A3901195 RR XFA 3 SAVE IN REG 3 A3901196 RR LFA- MOTPAR,15,4,I GET MOTION P1. A3901197 RR* REG 1 = INDEX TO RECBUF+3 A3901198 RR* FOR STNN. A3901199 RR* REG 3 = STNN A3901200 RR SAN FR0950 A3901201 RR* FWRITE REQUEST A3901202 RR XF3 A RESTORE STNN A3901203 RR INA -2 A3901204 RR SAZ FR0930 CK IF STNN=2 A3901205 RR INA -6 A3901206 RR SAN FR0940 CK IF STNN=8 A3901207 RRFR0930 AR3- ONE REG3=STNN+1 A3901208 RRFR0940 JMP* FR1010 UPDATE STNN W1REG 3 A3901209 RR* MOTION REQUEST A3901210 RRFR0950 INA -6 CK FOR SLEW EOF A3901211 RR SAZ FR0990 A3901212 RR XF3 A YES- MOTPAR=5 A3901213 RR INA -2 CK STNN=2 A3901214 RR SAN FR0960 A3901215 RR ENA 7 SET STNN=7 A3901216 RR JMP* UPSTNN A3901217 RRFR0960 INA -6 NO - CK STNN=8 A3901218 RR SAN FR1010 A3901219 RR ENA 9 SET STNN=9 A3901220 RRFR0980 JMP* UPSTNN UPDATE STNN A3901221 RR* NOTPAR=6, A3901222 RRFR0990 XF3 A DO FILE BACKSPACE. A3901223 RR INA -2 CK FOR STNN=2 A3901224 RR SAN FR1000 A3901225 RR ENA 1 YES- SET STNN=1 A3901226 RR JMP* UPSTNN A3901227 RRFR1000 JMP* FR0960 NO - CK FOR STNN=8 A3901228 RR* UPDATE STNN IN RECORD FROM REG 3 A3901229 RR* INDEXED BY REG 1. A3901230 RRFR1010 XF3 A VALID STNN VALUE A3901231 RRUPSTNN SFA- RECBUF+3,15,4,1 SAVED IN HOST RECORD A3901232 RR SPC 2 A3901233 RR* KILL JOB BY DISCONNECTING FROM A3901234 RR* JOB 'JMNN'. A3901235 RR EJT A3901236 RR* THE FOLLOWING ENTERED TO DISCONNECT FROM A JOB IF: A3901237 RR* 1. CURRENT JOB TERMINATED EITHER BY NORMAL OR A3901238 RR* ERROR COMPLETION. A3901239 RR* 2. CURRENT JOB TERMINATED BY MOTION REQUEST. A3901240 RR* MOTPAR=5, SLEW EOF(JOB CONSIDERED SENT). A3901241 RR* MOTPAR=6, BKSPC FILE,(JOB CANBE RESTARTED). A3901242 RR* A3901243 RR* IN ADDITION, ENTRY IS MADE TO TERMINATE BATCH A3901244 RR* PROCESSING FOR THE HOST (DISCONNECT FROM HOST WITH A3901245 RR* END-OF-BATCH INDICATION) IF: A3901246 RR* 1. ALL QUEUED JOBS COMPLETED FOR THE HOST. A3901247 RR* 2. OPERATOR INDICATES BATCH TERMINATION ON A3901248 RR* COMPLETION OF CURRENT JOB. A3901249 RR* 3. IRRECOVERABLE FILE MANAGER ERROR ENCOUNTERED A3901250 RR* WITH $$HOST FILE WHILE DISCONNECTING FROM A3901251 RR* A JOB. A3901252 RR SPC 2 A3901253 RR* A3901254 RR* DISCONNECT FROM CURRENT JOB ('JMNN' SET 'JM ') A3901255 RR* A3901256 RRFR2000 LDA =A SET 'NN' BLANK A3901257 RR STA- JOBKEY+1,I IN JOBKEY. A3901258 RR* A3901259 RR* IF MOTION REQUEST THEN A3901260 RR* A3901261 RR LDA- MOTPAR,I A3901262 RR SAN FR2005 A3901263 RR JMP* FR2040 A3901264 RR* A3901265 RR* COMPLETE REQUEST WITH, OR WITHOUT ERROR A3901266 RR* A3901267 RRFR2005 LDA- ERSTAT,I CK IF ERROR DURING A3901268 RR SAP FR2007 MOTION REQUEST. A3901269 RR JMP ER0030 YES- ERR POSTED A3901270 RRFR2007 ENQ HSTRNO NO - UPDATE $$HOST A3901271 RR RTJ BUPREC FILE, 'UPDREC' A3901272 RR SAZ FR2010 CK FM 'ISTAT' A3901273 RR JMP ER0010 RTJ A3901274 RRFR2010 RTJ BCLOSF OK, 'CLOSFL' A3901275 RR SAP FR2015 CK ISTAT A3901276 RR STA- ERSTAT,I A3901277 RR ENA 1 SET 'CLOSFL' CODE. A3901278 RR SFA- TIMTRY,FMCSTR,FMCLTH,I FOR DIAG. MSG. A3901279 RR JMP ER0020 A3901280 RRFR2015 RTJ- (COMPRQ) OK-COMPLETE A3901281 RR JMP DI0010 REQ, FNR. A3901282 RR* A3901283 RR* OTHERWISE A3901284 RR* A3901285 RR* ISSUE TO FWRITE REQUESTOR EOF, OR END-OF- A3901286 RR* BATCH(EOB) INDICATION AFTER UPDATING A3901287 RR* $$HOST FILE AND ESTAT1, ESTAT2. A3901288 RR* A3901289 RR* EOF CONDITION (EOF) A3901290 RR* ------------------- (SAVJA=1) A3901291 RR* A3901292 RR* MSOS(TYP=0) 200UT(TYP=1) HASP(TYP=2) A3901293 RR* ---------- ------------ ---------- A3901294 RR* EOF DATA $00F0 $0200 $00F0 A3901295 RR* V-FLD(ESTAT1) 7 7 7 A3901296 RR* ESTAT2(BIT11) 1 1 1 A3901297 RR* A3901298 RRFR2040 SEF- ESTAT2,11,1,I SET ESTAT2 EOF STATUS A3901299 RR SEF- ESTAT1,15,3,I SHORT RD, READY A3901300 RR LDQ =N$00F0 SET EOF DATA BASED A3901301 RR LFA- HSTNN,TYPSTR,TYPLTH,I ON STATION TYPE A3901302 RR INA -1 CK FOR 200UT A3901303 RR SAN FR2050 A3901304 RR LDQ- M0200 YES, EOF=$0200 A3901305 RRFR2050 STQ- MOTPAR,I SAVE EOF DATA A3901306 RR* A3901307 RR* EOB CONDITION (EOB) A3901308 RR* ------------------- (SAVJA=0) A3901309 RR* A3901310 RR* MSOS 200UT HASP A3901311 RR* ---------------- ----- ---- A3901312 RR* A3901313 RR* EOB DATA '*Z' $0200 $00F0 A3901314 RR* V-FLD(ESTAT1) 1 4 4 A3901315 RR* ESTAT2(BIT11) 0 1 1 A3901316 RR* A3901317 RR LFA- TIMTRY,13,1,I GET 'SAVJA' A3901318 RR SAZ FR2060 CK FOR EOB A3901319 RR JMP* FR2100 NO -UPDATE $$HOST A3901320 RR* A3901321 RR* EOB FLAGGED. A3901322 RR* A3901323 RR* SET NORMAL EOB CONDITION A3901324 RR* A3901325 RRFR2060 LFA- HSTNN,TYPSTR,TYPLTH,I CK FOR MSOS STATION A3901326 RR SAN FR2080 A3901327 RR LDA* MSOS YES - SET AND SAVE A3901328 RR STA- MOTPAR,I EOB DATA A3901329 RR CLF- ESTAT1,15,2,I NO ERR, READY A3901330 RR CLF- ESTAT2,11,1,I NO EOF A3901331 RR JMP* FR2090 DISCONNECT A3901332 RR* FROM HOST. A3901333 RR* A3901334 RR* CLEAR V-FIELD (ESTAT1) BIT13,14 A3901335 RR* FOR DEVICE NOT READY. A3901336 RR* A3901337 RRFR2080 CLF- ESTAT1,14,2,I V-FIELD = 4 A3901338 RR* A3901339 RR* DISCONNECT FROM HOST 'M'. A3901340 RR* A3901341 RRFR2090 LDA- M0020 BLANK 'M' IN A3901342 RR SFA- JOBKEY,MSTR,MLTH,I JOBKEY. A3901343 RR ENA 0 ZERO $$HOST REL A3901344 RR STA- HSTRNO+1,I RECORD NUMBER. A3901345 RR* A3901346 RR* IF POSSIBLE TO UPDATE $$HOST A3901347 RR* FILE, THEN A3901348 RR* A3901349 RR LDA- ERSTAT,I CK IF FM ERR DIS- A3901350 RR SAP FR2095 CONNECTING JOB. A3901351 RR JMP* FR2140 A3901352 RR* A3901353 RR* NO DISCONNECT ERROR, A3901354 RR* CLEAR JOB ACTIVITY (JA) A3901355 RR* AND ABORT INPUT (AI) FLAGS. A3901356 RR* A3901357 RRFR2095 CLF- RECBUF+2,11,2,I A3901358 RR EJT A3901359 RR SPC 2 A3901360 RR* AUTOMATIC BATCH MODE A3901361 RR LDA+ AUTON A3901362 RR SAN FR2100 SKIP IF AUTO MODE NOT A3901363 RR* ALLOWED OR ALREADY ENABLED A3901364 RR RAO+ AUTON SET AUTO BATCH ENABLED A3901365 RR RTJ- (AMONI) SCHEDULE AUTO BATCH IN 15 SEC. A3901366 RR NUM $1E27 A3901367 RR ADC AUTOBT A3901368 RR NUM 15 A3901369 RR SPC 2 A3901370 RR* A3901371 RR* UPDATE $$HOST FILE RECORD A3901372 RR* 'HSTRNO'. A3901373 RRFR2100 RTJ BUPREC A3901374 RR SAZ FR2110 A3901375 RR ENA 0 A3901376 RR RTJ BFWRIT A3901377 RRFR2110 RTJ BCLOSF A3901378 RR SAP FR2140 A3901379 RR STA- ERSTAT,I A3901380 RR ENA 1 SET 'CLOSFL' CODE. A3901381 RR SFA- TIMTRY,FMCSTR,FMCLTH,I FOR DIAG. MSG. A3901382 RR ENA 0 A3901383 RR RTJ BFWRIT A3901384 RR* A3901385 RR* A3901386 RR* IF MSOS EOF AND LIBEDT IS IN THEN, A3901387 RR* A3901388 RR* RETURN *Z, ERASE EOF STATUS. A3901389 RR* A3901390 RRFR2140 SFZ- HSTNN,TYPSTR,TYPLTH,I CK IF LOCL HOST A3901391 RR JMP* FR2200 NO - RETURN DAT A3901392 RR LDA- MOTPAR,I YES- CK IF EOF A3901393 RR EOR =N$00F0 A3901394 RR SAZ FR2150 A3901395 RR JMP* FR2200 NO-RTN DATA. A3901396 RRFR2150 LDA (JOBI) YES-CK IF A3901397 RR SAZ FR2160 JOBPRO. A3901398 RR JMP* FR2200 NO-EXIT. A3901399 RRFR2160 LDA (STH) YES-CK A3901400 RR SAN FR2170 IF LIBEDT. A3901401 RR JMP* FR2200 NO-EXIT. A3901402 RRFR2170 LDA* MSOS YES-ISSUE A3901403 RR STA- MOTPAR,I *Z, CLR A3901404 RR CLF- ESTAT2,11,1,I EOF A3901405 RR CLF- ESTAT1,15,2,I STATUS. A3901406 RR* A3901407 RR* OTHERWISE, RETURN DESIGNATED DATA. A3901408 RR* A3901409 RRFR2200 LDA- MOTPAR,I RESTORE EOF/EOB DATA, A3901410 RR STA- RECBUF,I RETURN IT TO CALLER. A3901411 RR LDA ETX SET BLANK FILL DELIM- A3901412 RR STA- RECBUF+1,I ITOR ($0303). A3901413 RRFR2210 EQU FR2210(*) A3901414 RR JMP FR0575 MOVE TEXT TO CALLER. A3901415 RR SPC 2 A3901416 RRMSOS ALF 1,*Z MSOS EOB DATA A3901417 RR EJT A3901418 RR* A3901419 RR* MOTION REQUEST PROCESSING, REQUEST ADDRESS A3901420 RR* IN Q-REGISTER. A3901421 RR* A3901422 RR* A3901423 RRMT0010 LDA- 4,Q PICK P1 THRU P3 A3901424 RR STA- MOTPAR,I SAVE MOTION PARAMETER A3901425 RR* A3901426 RR* IF P1 NOT VALID, OR NOT CONNECTED TO A3901427 RR* A JOB, THEN A3901428 RR* A3901429 RR* IGNORE REQUEST, COMPLETE WITHOUT ERROR A3901430 RR* A3901431 RR LFA- MOTPAR,15,4,I GET AND PROCESS ONLY A3901432 RR INA -5 P1. A3901433 RR SAZ MT0020 CK IF P1=5 A3901434 RR INA -1 NO - CK IF P1=6 A3901435 RR SAN MT0030 A3901436 RRMT0020 LDA- HSTRNO+1,I YES-CK IF CONN'T A3901437 RR SAZ MT0030 TO HOST. A3901438 RR LDA- JOBKEY+1,I YES-CK CONN'T A3901439 RR EOR =A TO JOB. A3901440 RR SAN MT0040 A3901441 RRMT0030 RTJ- (COMPRQ) NO-COMPL A3901442 RR JMP DI0010 REQUEST. A3901443 RR* A3901444 RR* OTHERWISE A3901445 RR* A3901446 RR* P1 = 5, SLEW-TO-EOF A3901447 RR* P1 = 6, BACKSPACE FILE A3901448 RR* A3901449 RRMT0040 JMP FR0800 XEQ MOTION REQUEST A3901450 RR EJT A3901451 RR* A3901452 RR* COMMON ERROR EXIT FOR FM ERRORS ENCOUNTERED, OTHER A3901453 RR* THAN ERRORS DISCONNECTING FROM A JOB. A3901454 RR* A3901455 RR* A3901456 RRER0010 RTJ BCLOSF 'CLOSFL' ON EXISTING A3901457 RR* FILE. IGNORE 'ISTAT' A3901458 RR SPC 2 A3901459 RRER0020 ENA 0 POST ERROR'S DIAG A3901460 RR RTJ BFWRIT MSG WITH 'ERSTAT' A3901461 RR SPC 2 A3901462 RRER0030 LDA =A DISCONNECT FROM A3901463 RR STA- JOBKEY+1,I HOST AND JOB A3901464 RR SFA- JOBKEY,MSTR,MLTH,I 'JMNN' TO 'J ' A3901465 RR ENA 0 ZERO REL REC NO. A3901466 RR STA- HSTRNO+1,I TO $$HOST RECORD. A3901467 RR SPC 2 A3901468 RR SEF- ESTAT1,15,2,I SET V-FLD, NOT RDY A3901469 RR SPC 2 A3901470 RR LDQ- ELU,I SET DEV FAILURE A3901471 RR QLS 6 CODE = 28 (NO FILE) A3901472 RR ENA 28 A3901473 RR EAQ Q LU/FAILURE CODE A3901474 RR JMP+ ALTDEV EXIT TO ALTDEV A3901475 RR SPC 2 A3901476 RR END A3901477 RR NAM BOPENF A40 A ITOS CCS 3.0 SL-149A4000001 RR* BATCH DRIVER OPEN FILE PROCESSOR A4000002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 A4000003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A4000004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 A4000005 RR* A4000006 RR**** A4000007 RR*E A4000008 RR* FUNCTION A4000009 RR* -------- A4000010 RR*S3 PROVIDES INTERFACE BETWEEN BATCH DRIVERS AND FILE MANAGER 2.0 A4000011 RR* FOR 'OPENFL' REQUESTS PERTAINING TO ANY BATCH DRIVER FILE. FOR A4000012 RR* THE PARTICULAR SYSTEM FILES $$HOST AND $$BATCH THE 'IDATA' ARRAY A4000013 RR* IS INITIALIZED. USEAGE OF THE ROUTINE FOR OTHER FILES REQUIRES A4000014 RR* THE CALLER TO PRE-SET THE 'IDATA' ARRAY BEFORE CALLING A4000015 RR* THE ROUTINE. A4000016 RR* A4000017 RR*S4 GENERAL DESCRIPTION A4000018 RR* ------------------- A4000019 RR*S3 THE ROUTINE PERFORMS DRIVER/FILE MANAGER INTERFACE BY BUILDING A4000020 RR* THE 'OPENFL' REQUEST IN THE PHYSICAL DEVICE TABLE SPECIFIED IN A4000021 RR* SUCH A MANNER THAT CONTROL RETURNS TO THE CALLER UPON COMPLETION A4000022 RR* OF THE 'OPENFL' REQUEST. ALL PARAMETERS PERTINENT TO THE REQUESTA4000023 RR* ARE AT PRESPECIFIED RELATIVE LOCATIONS IN THE PHYSTB. A4000024 RR* THE FOLLOWING AUXILARY FUNCTIONS ARE PROVIDED: A4000025 RR*S1 1. THE FM REQUEST FOR 'OPENFL' (=0) IS SET IN PHYSTB, WD 20. A4000026 RR* 2. THE REQUEST 'REQBUF' ARRAY BACKGROUND TO BINARY ZEROS. A4000027 RR* 3. THE $$HOST 'OPENFL' IDATA ARRAY IS SPECIFIED FOR: A4000028 RR* RECORD ACCESS BY RELATIVE RECORD NUMBER, A4000029 RR* BLOCK TRANSFER OF ONE RECORD, A4000030 RR* RECORD LOCKED ON RETRIEVAL. A4000031 RR* 4 THE $$BATCH 'OPENFL' IDATA ARRAY IS SPECIFIED FOR: A4000032 RR* RECORD ACCESS BY 'KEY1', A4000033 RR* BLOCK TRANSFER OF ONE RECORD, A4000034 RR* RECORD LOCKED ON RETRIEVAL. A4000035 RR* A4000036 RR*S4 ENTRY/EXIT CONDITIONS A4000037 RR* --------------------- A4000038 RR*S3 THE ADDRESS OF THE PHYSICAL DEVICE TABLE IS PASSED VIA THE A4000039 RR* I-REGISTER ON ENTRY BY A RELATIVE 2-WORD RTJ TO ENTRY POINT NAME.A4000040 RR* UPON RETURN TO THE CALLER AFTER COMPLETION OF THE 'OPENFL' REQUESA4000041 RR* BOTH THE I AND Q-REGISTERS ARE RESTORED AND CONTENTS OF THE A4000042 RR* REQUEST PARAMETER STATUS WORD 'ISTAT' IS SAVED IN PHYSTB WD 19, A4000043 RR* 'ERSTAT' FOR DIAGNOSTIC MESSAGE POSTING. A-REG ='ISTAT'CONTENTS.A4000044 RR* A4000045 RR*S4 ENTRY POINTS A4000046 RR* ------------ A4000047 RR*S3 BOPENF - ENTRY FOR 'OPENFL'REQUEST ON 'IDATA' ARRAY SPECIFIED A4000048 RR* BY CALLER. A4000049 RR* A4000050 RR* OPHOST - ENTRY FOR 'OPENFL' REQUEST FOR $$HOST SYSTEM FILE. A4000051 RR* THE 'IDATA' ARRAY IS INITIALIZED BY THIS ENTRY. A4000052 RR* A4000053 RR* OPBATF - ENTRY FOR 'OPENFL' REQUEST FOR $$BATCH SYSTEM FILE. A4000054 RR* THE 'IDATA' ARRAY IS INITIALIZED BY THIS ENTRY. A4000055 RR* A4000056 RR*E ENTRY, EXTERNAL AND PHYSTB EQUATES SPECIFICATIONS A4000057 RR* ------------------------------------------------- A4000058 RR*S3 ENTRY POINTS A4000059 RR* A4000060 RR ENT BOPENF,OPHOST,OPBATF A4000061 RR*S3 EXTERNAL A4000062 RR* A4000063 RR EXT SYFAIL SYSTEM FAILURE PROCESSOR A4000064 RR EXT* ABSADD ADDRESS ABSOLUTIZING ROUTINE A4000065 RR EXT* OPENF FILE MANAGER OPEN FILE REQUEST PROCESSOR. A4000066 RR*S3 PHYSTB EQUATES A4000067 RR* A4000068 RR EQU ERSTAT(19) SAVE 'OPENFL' REQUEST STATUS A4000069 RR EQU TIMTRY(20) FM REQ CODE = 0 FOR 'OPENFL' (BITS 9 THRU 12) A4000070 RR EQU RTJCAL(24) PHYSTB FILE MGR CALLING SEQUENCE, 9 WORDS. A4000071 RR EQU REQBUF(37) OPENFL PARAMETER, 24 WORDS. A4000072 RR EQU IDATA(61) OPENFL PARAMETER, ONLY FIRST 15 WORDS. A4000073 RR EQU ISTAT(85) OPENFL PARAMETER, 1 WORD. A4000074 RR* A4000075 RR*S4 STRUCTURE OF 'OPENFL' PHYSTB ROUTINE A4000076 RR* ------------------------------------ A4000077 RR*S3 STARTS AT PHYSTB INDEX 'RTJCAL' A4000078 RR* A4000079 RR EQU P1(REQBUF-RTJCAL-3) A4000080 RR EQU P5(IDATA-RTJCAL-4) A4000081 RR EQU P3(ISTAT-RTJCAL-5) A4000082 RR* A4000083 RRENTRY NUM 0 PSEUDO RTJ ENTRY, CALLERS RETURN ADDRESS A4000084 RRENT010 RTJ+ SYFAIL OPEN FILE REQUEST A4000085 RR ADC (P1) REL ADDR TO 'REQBUF' PARAMETER A4000086 RR ADC (P5) REL ADDR TO 'IDATA ' PARAMETER A4000087 RR ADC (P3) REL ADDR TO 'ISTAT' PARAMETER A4000088 RR LDA- ISTAT,I PICKUP 'OPENFL' REQUEST STATUS A4000089 RR STA- ERSTAT,I AND SAVE IN 'ERSTAT' A4000090 RRCALXIT JMP* (ENTRY) RETURN TO BOPENF,OPHOST,OPBATF CALLER.A4000091 RR EQU CALTH(CALXIT-ENTRY) A4000092 RR**** CALLER'S Q/I-REGISTERS SAVED/RESTORED BY FM. A4000093 RR EJT A4000094 RR* IDATA ARRAY FOR $$HOST FILE A4000095 RR* A4000096 RRHSTDAT ALF 4,$$HOST FILE NAME A4000097 RR ALF 4,$$ USER NAME IS ITOS MASTER TERMINAL A4000098 RR ALF 4,SYSVOL VOLUMN NAME IS SYSTEM VOLUMN A4000099 RR NUM 0,1,1 ACCESS BY REL REC NO, 1 REC, LOCK ON RTV A4000100 RR SPC 2 A4000101 RR* IDATA ARRAY FOR $$BATCH FILE A4000102 RR* A4000103 RRBATDAT ALF 4,$$BATCH FILE NAME A4000104 RR ALF 4,$$ USER NAME IS ITOS MASTER TERMINAL A4000105 RR ALF 4,SYSVOL VOLUMN NAME IS SYSTEM VOLUMN A4000106 RR NUM 1,1,1 ACCESS BY KEY1, 1 REC, LOCK ON RTV A4000107 RR SPC 2 A4000108 RRDATLTH EQU DATLTH(14) IDATA XFR LENGTH CONTROL A4000109 RR EJT A4000110 RR* ENTRY TO 'OPENFL' FILE WITH 'IDATA' SPECIFIED BY CALLER A4000111 RR* A4000112 RRBOPENF NUM 0 CALLER'S RTN ADDR ON ENTRY A4000113 RR XFQ 1 SAVE CALLER'S Q-REG FOR RESTORATION IN R1 A4000114 RR LDA* BOPENF SAVE CALLER'S RTN ADDR A4000115 RR STA* ENTRY IN 'OPENFL' ROUTINE. A4000116 RR SPC 4 A4000117 RR* COMMON EXIT FROM 'OPHOST' AND 'OPBATF' ENTRIES A4000118 RRBOP01 ENQ 23 BACKGROUND 24-WD 'REQBUF' A4000119 RR ENA 0 ARRAY IN PHYSTB. A4000120 RRBOP05 STA- REQBUF,B A4000121 RR DQP *-BOP05 A4000122 RR SPC 2 A4000123 RR* SET REQ CODE FOR 'OPENFL'(BITS 12-9)=0 A4000124 RRBOP10 CLF- TIMTRY,12,4,I IN PHYSTB. A4000125 RR SPC 2 A4000126 RR RTJ ABSADD ABSOLUTIZE THE FILE REQUEST ADDRESS A4000127 RR ADC* OPENF A4000128 RR STA* ENT010+1 STORE IN THE REQUEST A4000129 RR SPC 1 A4000130 RR ENQ CALTH MOVE 'OPENFL' ROUTINE TO PHYSTB 'RTJCAL' A4000131 RRBOP15 LDA* ENTRY,Q A4000132 RR STA- RTJCAL,B A4000133 RR DQP *-BOP15 A4000134 RR SPC 2 A4000135 RRBOP20 XF1 Q RESTORE CALLER'S Q-REG FROM REG 1 AND A4000136 RR JMP- RTJCAL+1,I PERFORM PSUEDO RTJ TO PHYSTB ROUTINE. A4000137 RR SPC 2 A4000138 RR EJT A4000139 RR* ENTRY TO 'OPENFL' $$HOST FILE A4000140 RR* A4000141 RROPHOST NUM 0 A4000142 RR LDA* BOP45 INDEX TO $$HOST IDATA A4000143 RR STA* BOP35+1 ARRAY 'HSTDAT'. A4000144 RR LDA* OPHOST PICKUP CALLER'S RTN ADDR A4000145 RR JMP* BOP30 A4000146 RR SPC 4 A4000147 RR* ENTRY TO 'OPENFL' $$BATCH FILE A4000148 RR* A4000149 RROPBATF NUM 0 A4000150 RR LDA* BOP50 INDEX TO $$BATCH IDATA A4000151 RR STA* BOP35+1 ARRAY 'BATDAT'. A4000152 RR LDA* OPBATF PICKUP CALLER'S RTN ADDR A4000153 RR SPC 4 A4000154 RR* MOVE INDICATED IDATA ARRAY INTO PHYSTB. A4000155 RR* A4000156 RRBOP30 XFQ 1 SAVE CALLER'S Q-REG. IN ENHANCED REG 1 A4000157 RR STA* ENTRY SAVE CALLER'S RTN ADDR A4000158 RR ENQ DATLTH A4000159 RRBOP35 LDA HSTDAT,Q LOOP OVER SPECIFIED IDATA ARRAY. A4000160 RR STA- IDATA,B A4000161 RR DQP *-BOP35 A4000162 RR SPC 2 A4000163 RR* EXIT VIA 'BOPENF' ROUTINE TO MOVE 'OPENFL' REQUEST TO PHYSTB A4000164 RR* A4000165 RRBOP40 JMP* BOP01 A4000166 RR SPC 3 A4000167 RR* RELATIVE ADDRESS TO INTERNAL IDATA ARRAYS A4000168 RR* A4000169 RRBOP45 ADC (HSTDAT-BOP35-1) $$HOST IDATA ARRAY A4000170 RRBOP50 ADC (BATDAT-BOP35-1) $$BATCH IDATA ARRAY A4000171 RR END A4000172 RR NAM BCLOSF A41 A ITOS CCS 3.0 SL-149A4100001 RR* BATCH DRIVER CLOSE FILE ROUTINE A4100002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 A4100003 RR* DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A4100004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 A4100005 RR* A4100006 RR**** A4100007 RR*E A4100008 RR* FUNCTION A4100009 RR* -------- A4100010 RR*S3 PROVIDES INTERFACE BETWEEN BATCH DRIVERS AND FILE MANAGER 2.0 A4100011 RR* FOR 'CLOSFL' REQUESTS PERTAINING TO ANY BATCH DRIVER FILE. A4100012 RR* A4100013 RR*S4 GENERAL DESCRIPTION A4100014 RR* ------------------- A4100015 RR*S3 THE ROUTINE PERFORMS DRIVER/FILE MANAGER INTERFACE BY BUILDING A4100016 RR* THE 'CLOSFL' REQUEST IN THE PHYSICAL DEVICE TABLE SPECIFIED IN A4100017 RR* SUCH A MANNER THAT CONTROL RETURNS TO THE CALLER UPON COMPLETION A4100018 RR* OF THE 'CLOSFL' REQUEST. ALL PARAMETERS PERTINENT TO THE REQUESTA4100019 RR* ARE AT PRESPECIFIED RELATIVE LOCATIONS IN THE PHYSTB. A4100020 RR* THE FOLLOWING AUXILARY FUNCTION IS PROVIDED: A4100021 RR*S1 THE FM REQUEST FOR 'CLOSFL' IS NOT SET IN PHYSTB, WD 20. A4100022 RR* A4100023 RR*S4 ENTRY/EXIT CONDITIONS A4100024 RR* --------------------- A4100025 RR*S3 THE ADDRESS OF THE PHYSICAL DEVICE TABLE IS PASSED VIA THE A4100026 RR* I-REGISTER ON ENTRY BY A RELATIVE 2-WORD RTJ TO ENTRY 'BCLOSF'. A4100027 RR* A4100028 RR* UPON RETURN TO THE CALLER AFTER COMPLETION OF THE 'CLOSFL' REQUESA4100029 RR* BOTH THE I AND Q-REGISTERS ARE RESTORED AND CONTENTS OF THE A4100030 RR* REQUEST PARAMETER STATUS WORD 'ISTAT' IS RETURNED IN A4100031 RR* THE A-REGISTER. A4100032 RR* A4100033 RR*S4 ENTRY, EXTERNAL AND PHYSTB EQUATE SPECIFICATIONS A4100034 RR* ------------------------------------------------ A4100035 RR*S3 ENTRY POINT A4100036 RR* A4100037 RR ENT BCLOSF ROUTINE'S ENTRY POINT A4100038 RR*S3 EXTERNAL A4100039 RR* A4100040 RR EXT SYFAIL SYSTEM FAILURE PROCESSOR A4100041 RR EXT* ABSADD ADDRESS ABSOLUTIZING ROUTINE A4100042 RR EXT* CLOSF FILE MANAGER CLOSE FILE REQUEST PROCESSOR A4100043 RR*S3 PHYSTB EQUATES A4100044 RR* A4100045 RR EQU TIMTRY(20) FM REQ CODE = 1 FOR 'CLOSFL' (BITS 9 THRU 12) A4100046 RR EQU RTJCAL(24) PHYSTB FILE MGR CALLING SEQUENCE, 7 WORDS. A4100047 RR EQU REQBUF(37) CLOSFL PARAMETER, 24 WORDS. A4100048 RR EQU ISTAT(85) CLOSFL PARAMETER, 1 WORD. A4100049 RR* A4100050 RR*S4 STRUCTURE OF 'CLOSFL' PHYSTB ROUTINE A4100051 RR* ------------------------------------ A4100052 RR*S3 STARTS AT PHYSTB INDEX 'RTJCAL' A4100053 RR* A4100054 RR EQU P1(REQBUF-RTJCAL-3) A4100055 RR EQU P3(ISTAT-RTJCAL-4) A4100056 RR* A4100057 RRENTRY NUM 0 PSEUDO RTJ ENTRY, CALLERS RETURN ADDRESS A4100058 RRENT010 RTJ+ SYFAIL CLOSE FILE REQUEST A4100059 RR ADC (P1) REL ADDR TO 'REQBUF' PARAMETER A4100060 RR ADC (P3) REL ADDR TO 'ISTAT' PARAMETER A4100061 RR LDA- ISTAT,I PICKUP 'CLOSFL' REQUEST STATUS A4100062 RRCALXIT JMP* (ENTRY) RETURN TO BCLOSF CALLER. A4100063 RR EQU CALTH(CALXIT-ENTRY) A4100064 RR**** CALLER'S Q/I-REGISTERS SAVED/RESTORED BY FM. A4100065 RR EJT A4100066 RR* ENTRY TO 'CLOSFL' ON ANY BATCH DRIVER FILE A4100067 RR* A4100068 RRBCLOSF NUM 0 CALLER'S RTN ADDR ON ENTRY A4100069 RR XFQ 1 SAVE CALLER'S Q-REG FOR RESTORATION IN R1. A4100070 RR LDA* BCLOSF SAVE CALLER'S RTN ADDR A4100071 RR STA* ENTRY IN 'CLOSFL' ROUTINE. A4100072 RR SPC 2 A4100073 RR RTJ ABSADD ABSOLUTIZE THE FILE REQUEST ADDRESS A4100074 RR ADC* CLOSF A4100075 RR STA* ENT010+1 STORE IN THE REQUEST A4100076 RR SPC 1 A4100077 RR ENQ CALTH MOVE 'CLOSFL' ROUTINE TO PHYSTB 'RTJCAL' A4100078 RRBCL01 LDA* ENTRY,Q A4100079 RR STA- RTJCAL,B A4100080 RR DQP *-BCL01 A4100081 RR SPC 2 A4100082 RRBCL05 XF1 Q RESTORE CALLER'S Q-REG FROM R1 AND A4100083 RR JMP- RTJCAL+1,I PERFORM PSUEDO RTJ TO PHYSTB ROUTINE. A4100084 RR SPC 2 A4100085 RR END A4100086 RR NAM BREADR A42 A ITOS CCS 3.0 SL-149A4200001 RR* BATCH DRIVER READ RECORD ROUTINE A4200002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 A4200003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A4200004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 A4200005 RR* A4200006 RR**** A4200007 RR*E A4200008 RR* FUNCTION A4200009 RR* -------- A4200010 RR*S3 PROVIDES INTERFACE BETWEEN BATCH DRIVERS AND FILE MANAGER 2.0 A4200011 RR* FOR 'READR' REQUESTS PERTAINING TO ANY BATCH DRIVER FILE. A4200012 RR* A4200013 RR*S4 GENERAL DESCRIPTION A4200014 RR* ------------------- A4200015 RR*S3 THE ROUTINE PERFORMS DRIVER/FILE MANAGER INTERFACE BY BUILDING A4200016 RR* THE 'READR' REQUEST IN THE PHYSICAL DEVICE TABLE SPECIFIED IN A4200017 RR* SUCH A MANNER THAT CONTROL RETURNS TO THE CALLER UPON COMPLETION A4200018 RR* OF THE 'READR' REQUEST. ALL PARAMETERS PERTINENT TO THE REQUEST A4200019 RR* ARE AT PRESPECIFIED RELATIVE LOCATIONS IN THE PHYSTB. A4200020 RR* THE FOLLOWING AUXILARY FUNCTION IS PROVIDED: A4200021 RR* THE FM REQUEST FOR 'READR' (=2) IS SET IN PHYSTB, WD 20. A4200022 RR* A4200023 RR*S4 ENTRY/EXIT CONDITIONS A4200024 RR* --------------------- A4200025 RR*S3 ON ENTRY THE ADDRESS OF THE PHYSICAL DEVICE TABLE IS IN THE A4200026 RR* I-REGISTER AND THE PHYSTB INDEX TO PARAMETER 'RELSPC' IS A4200027 RR* IN THE Q-REGISTER. CALLING SEQUENCE FOR ACCESS BY: A4200028 RR* REL RECORD NO: KEY VALUE(2-WD): A4200029 RR* ENQ HSTRNO ENQ JOBKEY A4200030 RR* RTJ BREADR RTJ BREADR A4200031 RR* RECURSIVE CALLS TO 'BREADR' MAY REFERENCE THE 'RECSPC' PARAMETER A4200032 RR* STORED IN THE PHYSTB 'READR' CALLING SEQUENCE STARTING AT PHYSTB A4200033 RR* INDEX 'RTJCAL+10'. A4200034 RR* A4200035 RR* UPON RETURN TO THE CALLER AFTER COMPLETION OF THE 'READR' REQUESTA4200036 RR* BOTH THE I AND Q-REGISTERS ARE RESTORED AND CONTENTS OF THE A4200037 RR* REQUEST PARAMETER STATUS WORD 'ISTAT' IS SAVED IN PHYSTB WD 19, A4200038 RR* 'ERSTAT' FOR DIAGNOSTIC MESSAGE POSTING. A-REG ='ISTAT' CONTENTSA4200039 RR* NOTE - FOR KEY VALUE RECORD ACCESS THE FILE MGR MAY HAVE A4200040 RR* MODIFIED THE CONTENTS OF 'RECSPC' (RTJCAL+10). A4200041 RR* A4200042 RR*S4 ENTRY, EXTERNAL AND PHYSTB EQUATE SPECIFICATIONS A4200043 RR* ------------------------------------------------ A4200044 RR*S3 ENTRY POINT A4200045 RR* A4200046 RR ENT BREADR ROUTINE'S ENTRY POINT A4200047 RR*S3 EXTERNAL A4200048 RR* A4200049 RR EXT SYFAIL SYSTEM FAILURE PROCESSOR A4200050 RR EXT* ABSADD ADDRESS ABSOLUTIZING ROUTINE A4200051 RR EXT* READRX FILE MANAGER READ RECORD ROUTINE. A4200052 RR*S3 PHYSTB EQUATES A4200053 RR* A4200054 RR EQU ERSTAT(19) SAVE 'READR' REQUEST STATUS A4200055 RR EQU TIMTRY(20) FM REQ CODE = 2 FOR 'READR' (BITS 9 THRU 12) A4200056 RR EQU RTJCAL(24) PHYSTB FILE MGR CALLING SEQUENCE, 12 WORDS A4200057 RR EQU REQBUF(37) READR PARAMETER, 24 WORDS A4200058 RR EQU ISTAT(85) READR PARAMETER, 1 WORD A4200059 RR EQU RECBUF(86) READR PARAMETER, PHYSTB DEPENDANT A4200060 RR* A4200061 RR*S4 STRUCTURE OF 'READR' PHYSTB ROUTINE A4200062 RR* ----------------------------------- A4200063 RR*S3 STARTS AT PHYSTB INDEX 'RTJCAL' A4200064 RR* A4200065 RR EQU P1(REQBUF-RTJCAL-3) A4200066 RR EQU P2(RECBUF-RTJCAL-4) A4200067 RR EQU P3(ISTAT-RTJCAL-6) A4200068 RR* A4200069 RRENTRY NUM 0 PSEUDO RTJ ENTRY, CALLERS RETURN ADDRESS A4200070 RRENT010 RTJ+ SYFAIL READR FILE REQUEST A4200071 RR ADC (P1) REL ADDR TO 'REQBUF' PARAMETER A4200072 RR ADC (P2) REL ADDR TO 'RECBUF' PARAMETER A4200073 RR ADC (RECSPC-*) REL ADDR TO 'RECSPC' PARAMETER A4200074 RR ADC (P3) REL ADDR TO 'ISTAT' PARAMETER A4200075 RR LDA- ISTAT,I PICKUP 'READR ' REQUEST STATUS A4200076 RR STA- ERSTAT,I AND SAVE IN 'ERSTAT'. A4200077 RR JMP* (ENTRY) RETURN TO BREADR CALLER A4200078 RRRECSPC BZS RECSPC(2) 2-WD 'RECSPC' PARAMETER A4200079 RR EQU CALTH(RECSPC+1-ENTRY) A4200080 RR**** CALLER'S Q/I-REGISTERS SAVED/RESTORED BY FM. A4200081 RR EJT A4200082 RR* ENTRY TO 'READR' FOR ANY BATCH DRIVER FILE A4200083 RR* A4200084 RRBREADR NUM 0 CALLER'S RTN ADDR ON ENTRY A4200085 RR XFQ 1 SAVE CALLERS Q-REG FOR RESTORATION IN R1. A4200086 RR LDA* BREADR SAVE CALLER'S RTN ADDR A4200087 RR STA* ENTRY IN 'READR' ROUTINE. A4200088 RR ENA 2 SET REQ CODE A4200089 RR SFA- TIMTRY,12,4,I FOR 'READR' (BITS 12-9)=2 A4200090 RR SPC 2 A4200091 RR* MOVE 'RECSPC' DATA INTO PHYSTB ROUTINE A4200092 RR LDA- ($22),B A4200093 RR STA* RECSPC A4200094 RR LDA- 1,B A4200095 RR STA* RECSPC+1 A4200096 RR SPC 2 A4200097 RR RTJ ABSADD ABSOLUTIZE THE FILE REQUEST ADDRESS A4200098 RR ADC* READRX A4200099 RR STA* ENT010+1 STORE IN THE REQUEST A4200100 RR SPC 1 A4200101 RR ENQ CALTH MOVE 'READR' ROUTINE TO PHYSTB 'RTJCAL' A4200102 RRBRD01 LDA* ENTRY,Q A4200103 RR STA- RTJCAL,B A4200104 RR DQP *-BRD01 A4200105 RR SPC 2 A4200106 RRBRD05 XF1 Q RESTORE CALLER'S Q-REG FROM R1 AND A4200107 RR JMP- RTJCAL+1,I PERFORM PSUEDO RTJ TO PHYSTB ROUTINE A4200108 RR SPC 2 A4200109 RR END A4200110 RR NAM BGETS A43 A ITOS CCS 3.0 SL-149A4300001 RR* BATCH DRIVER GET SEQUENTIAL RECORD ROUTINE A4300002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 A4300003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A4300004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 A4300005 RR* A4300006 RR**** A4300007 RR*E A4300008 RR* FUNCTION A4300009 RR* -------- A4300010 RR*S3 PROVIDES INTERFACE BETWEEN BATCH DRIVERS AND FILE MANAGER 2.0 A4300011 RR* FOR 'GETS' REQUESTS PERTAINING TO ANY BATCH DRIVER FILE. A4300012 RR* A4300013 RR*S4 GENERAL DESCRIPTION A4300014 RR* ------------------- A4300015 RR*S3 THE ROUTINE PERFORMS DRIVER/FILE MANAGER INTERFACE BY BUILDING A4300016 RR* THE 'GETS' REQUEST IN THE PHYSICAL DEVICE TABLE SPECIFIED IN A4300017 RR* SUCH A MANNER THAT CONTROL RETURNS TO THE CALLER UPON COMPLETION A4300018 RR* OF THE 'GETS' REQUEST. ALL PARAMETERS PERTINENT TO THE REQUEST A4300019 RR* ARE AT PRESPECIFIED RELATIVE LOCATIONS IN THE PHYSTB. A4300020 RR* THE FOLLOWING AUXILARY FUNCTION IS PROVIDED: A4300021 RR* THE FM REQUEST FOR 'GETS' (=3) IS SET IN PHYSTB, WD 20. A4300022 RR* A4300023 RR*S4 ENTRY/EXIT CONDITIONS A4300024 RR* --------------------- A4300025 RR*S3 ON ENTRY THE ADDRESS OF THE PHYSICAL DEVICE TABLE IS IN THE A4300026 RR* I-REGISTER AND THE PHYSTB INDEX TO PARAMETER 'KEYVAL' IS A4300027 RR* IN THE Q-REGISTER. CALLING SEQUENCE FOR ACCESS BY: A4300028 RR* REL RECORD NO: KEY VALUE(2-WD): A4300029 RR* (Q-REG ARBITRARY) ENQ JOBKEY A4300030 RR* RTJ BGETS RTJ BGETS A4300031 RR* RECURSIVE CALLS TO 'BGETS' MUST REFERENCE THE 'KEYVAL' PARAMETER A4300032 RR* STORED IN THE PHYSTB 'GETS' CALLING SEQUENCE STARTING AT PHYSTB A4300033 RR* INDEX 'RTJCAL+10'. A4300034 RR* A4300035 RR* UPON RETURN TO THE CALLER AFTER COMPLETION OF THE 'GETS' REQUEST A4300036 RR* BOTH THE I AND Q-REGISTERS ARE RESTORED AND CONTENTS OF THE A4300037 RR* REQUEST PARAMETER STATUS WORD 'ISTAT' IS SAVED IN PHYSTB WD 19, A4300038 RR* 'ERSTAT' FOR DIAGNOSTIC MESSAGE POSTING. A-REG ='ISTAT' CONTENTSA4300039 RR* NOTE - FOR RECURSIVE CALLS TO 'BGETS' USING KEY VALUE ACCESS A4300040 RR* THE CONTENTS OF 'KEYVAL' (RTJCAL+10) MUST NOT BE ALTERED A4300041 RR* BY THE CALLER. A4300042 RR* A4300043 RR*S4 ENTRY, EXTERNAL AND PHYSTB EQUATE SPECIFICATIONS A4300044 RR* ------------------------------------------------ A4300045 RR*S3 ENTRY POINT A4300046 RR* A4300047 RR ENT BGETS A4300048 RR*S3 EXTERNAL A4300049 RR* A4300050 RR EXT SYFAIL SYSTEM FAILURE PROCESSOR A4300051 RR EXT* ABSADD ADDRESS ABSOLUTIZING ROUTINE A4300052 RR EXT* GETZ FILE MANAGER GET NEXT RECORD REQUEST. A4300053 RR*S3 PHYSTB EQUATES A4300054 RR* A4300055 RR EQU ERSTAT(19) SAVE 'GETS' REQUEST STATUS A4300056 RR EQU TIMTRY(20) FM REQ CODE = 2 FOR 'GETS' (BITS 9 THRU 12) A4300057 RR EQU RTJCAL(24) PHYSTB FILE MGR CALLING SEQUENCE, 12 WORDS A4300058 RR EQU REQBUF(37) GETS PARAMETER, 24 WORDS A4300059 RR EQU ISTAT(85) GETS PARAMETER, 1 WORD A4300060 RR EQU RECBUF(86) GETS PARAMETER, PHYSTB DEPENDANT A4300061 RR* A4300062 RR*S4 STRUCTURE OF 'GETS' PHYSTB ROUTINE A4300063 RR* ---------------------------------- A4300064 RR*S3 STARTS AT PHYSTB INDEX 'RTJCAL' A4300065 RR* A4300066 RR EQU P1(REQBUF-RTJCAL-3) A4300067 RR EQU P2(RECBUF-RTJCAL-4) A4300068 RR EQU P3(ISTAT-RTJCAL-6) A4300069 RR* A4300070 RRENTRY NUM 0 PSEUDO RTJ ENTRY, CALLERS RETURN ADDRESS A4300071 RRENT010 RTJ+ SYFAIL GETS FILE REQUEST A4300072 RR ADC (P1) REL ADDR TO 'REQBUF' PARAMETER A4300073 RR ADC (P2) REL ADDR TO 'RECBUF' PARAMETER A4300074 RR ADC (KEYVAL-*) REL ADDR TO 'KEYVAL' PARAMETER A4300075 RR ADC (P3) REL ADDR TO 'ISTAT' PARAMETER A4300076 RR LDA- ISTAT,I PICKUP 'GETS ' REQUEST STATUS A4300077 RR STA- ERSTAT,I AND SAVE IN 'ERSTAT'. A4300078 RR JMP* (ENTRY) RETURN TO BGETS CALLER A4300079 RRKEYVAL BZS KEYVAL(2) 2-WD 'KEYVAL' PARAMETER A4300080 RR EQU CALTH(KEYVAL+1-ENTRY) A4300081 RR**** CALLER'S Q/I-REGISTERS SAVED/RESTORED BY FM. A4300082 RR EJT A4300083 RR* ENTRY TO 'GETS' FOR ANY BATCH DRIVER FILE A4300084 RR* A4300085 RRBGETS NUM 0 CALLER'S RTN ADDR ON ENTRY A4300086 RR XFQ 1 SAVE CALLERS Q-REG FOR RESTORATION IN R1. A4300087 RR LDA* BGETS SAVE CALLER'S RTN ADDR A4300088 RR STA* ENTRY IN 'GETS' ROUTINE. A4300089 RR ENA 3 SET REQ CODE A4300090 RR SFA- TIMTRY,12,4,I FOR 'GETS' (BITS 12-9)=3 A4300091 RR SPC 2 A4300092 RR* MOVE 'KEYVAL' DATA INTO PHYSTB ROUTINE A4300093 RR LDA- ($22),B A4300094 RR STA* KEYVAL A4300095 RR LDA- 1,B A4300096 RR STA* KEYVAL+1 A4300097 RR SPC 2 A4300098 RR RTJ ABSADD ABSOLUTIZE THE FILE REQUEST ADDRESS A4300099 RR ADC* GETZ A4300100 RR STA* ENT010+1 STORE IN THE REQUEST A4300101 RR SPC 1 A4300102 RR ENQ CALTH MOVE 'GETS' ROUTINE TO PHYSTB 'RTJCAL' A4300103 RRBGET01 LDA* ENTRY,Q A4300104 RR STA- RTJCAL,B A4300105 RR DQP *-BGET01 A4300106 RR SPC 2 A4300107 RRBGET05 XF1 Q RESTORE CALLER'S Q-REG FROM R1 AND A4300108 RR JMP- RTJCAL+1,I PERFORM PSEUDO RTJ TO PHYSTB ROUTINE A4300109 RR SPC 2 A4300110 RR END A4300111 RR NAM BUPREC A44 A ITOS CCS 3.0 SL-149A4400001 RR* BATCH DRIVER UPDATE RECORD PROCESSOR A4400002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 A4400003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A4400004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 A4400005 RR* A4400006 RR**** A4400007 RR*E A4400008 RR* FUNCTION A4400009 RR* -------- A4400010 RR*S3 PROVIDES INTERFACE BETWEEN BATCH DRIVERS AND FILE MANAGER 2.0 A4400011 RR* FOR 'UPDREC' REQUESTS PERTAINING TO ANY BATCH DRIVER FILE. A4400012 RR* A4400013 RR*S4 GENERAL DESCRIPTION A4400014 RR* ------------------- A4400015 RR*S3 THE ROUTINE PERFORMS DRIVER/FILE MANAGER INTERFACE BY BUILDING A4400016 RR* THE 'UPDREC' REQUEST IN THE PHYSICAL DEVICE TABLE SPECIFIED IN A4400017 RR* SUCH A MANNER THAT CONTROL RETURNS TO THE CALLER UPON COMPLETION A4400018 RR* OF THE 'UPDREC' REQUEST. ALL PARAMETERS PERTINENT TO THE REQUESTA4400019 RR* ARE AT PRESPECIFIED RELATIVE LOCATIONS IN THE PHYSTB. A4400020 RR* THE FOLLOWING AUXILARY FUNCTION IS PROVIDED: A4400021 RR* THE FM REQUEST FOR 'UPDREC' (=4) IS SET IN PHYSTB, WD 20. A4400022 RR* A4400023 RR*S4 ENTRY/EXIT CONDITIONS A4400024 RR* --------------------- A4400025 RR*S3 THE ADDRESS OF THE PHYSICAL DEVICE TABLE IS PASSED VIA THE A4400026 RR* I-REGISTER ON ENTRY BY A RELATIVE 2-WORD RTJ TO ENTRY 'BUPREC'. A4400027 RR* A4400028 RR* UPON RETURN TO THE CALLER AFTER COMPLETION OF THE 'UPDREC' REQUESA4400029 RR* BOTH THE I AND Q-REGISTERS ARE RESTORED AND CONTENTS OF THE A4400030 RR* REQUEST PARAMETER STATUS WORD 'ISTAT' IS SAVED IN PHYSTB WD 19, A4400031 RR* 'ERSTAT' FOR DIAGNOSTIC MESSAGE POSTING. A-REG = 'ISTAT' CONTENTA4400032 RR* A4400033 RR*S4 ENTRY, EXTERNAL AND PHYSTB EQUATE SPECIFICATIONS A4400034 RR* ------------------------------------------------ A4400035 RR*S3 ENTRY POINT A4400036 RR* A4400037 RR ENT BUPREC ROUTINE'S ENTRY POINT A4400038 RR*S3 EXTERNAL A4400039 RR* A4400040 RR EXT SYFAIL SYSTEM FAILURE PROCESSOR A4400041 RR EXT* ABSADD ADDRESS ABSOLUTIZING ROUTINE A4400042 RR EXT* UPREC FILE MANAGER UPDATE RECORD REQUEST. A4400043 RR*S3 PHYSTB EQUATES A4400044 RR* A4400045 RR EQU TIMTRY(20) FM REQ CODE = 4 FOR 'UPDREC' (BITS 9 THRU 12) A4400046 RR EQU RTJCAL(24) PHYSTB FILE MGR CALLING SEQUENCE, 9 WORDS A4400047 RR EQU REQBUF(37) UPDREC PARAMETER, 24 WORDS A4400048 RR EQU ISTAT(85) UPDREC PARAMETER, 1 WORD A4400049 RR EQU RECBUF(86) UPDREC PARAMETER, PHYSTB DEPENDANT A4400050 RR EQU ERSTAT(19) SAVE 'UPDREC' REQUEST STATUS A4400051 RR* A4400052 RR*S4 STRUCTURE OF 'UPDREC' PHYSTB ROUTINE A4400053 RR* ------------------------------------ A4400054 RR*S3 STARTS AT PHYSTB INDEX 'RTJCAL' A4400055 RR* A4400056 RR EQU P1(REQBUF-RTJCAL-3) A4400057 RR EQU P2(RECBUF-RTJCAL-4) A4400058 RR EQU P3(ISTAT-RTJCAL-5) A4400059 RR* A4400060 RRENTRY NUM 0 PSEUDO RTJ ENTRY, CALLERS RETURN ADDRESS A4400061 RRENT010 RTJ+ SYFAIL UPDREC FILE REQUEST A4400062 RR ADC (P1) REL ADDR TO 'REQBUF' PARAMETER A4400063 RR ADC (P2) REL ADDR TO 'RECBUF' PARAMETER A4400064 RR ADC (P3) REL ADDR TO 'ISTAT' PARAMETER A4400065 RR LDA- ISTAT,I PICKUP 'UPDREC' REQUEST STATUS A4400066 RR STA- ERSTAT,I AND SAVE IN 'ERSTAT'. A4400067 RRCALXIT JMP* (ENTRY) RETURN TO BUPREC CALLER. A4400068 RR EQU CALTH(CALXIT-ENTRY) A4400069 RR**** CALLER'S Q/I-REGISTERS SAVED/RESTORED BY FM. A4400070 RR EJT A4400071 RR* ENTRY TO 'UPDREC' FOR ANY BATCH DRIVER FILE A4400072 RR* A4400073 RRBUPREC NUM 0 CALLER'S RTN ADDR ON ENTRY A4400074 RR XFQ 1 SAVE CALLERS Q-REG FOR RESTORATION IN R1. A4400075 RR LDA* BUPREC SAVE CALLER' RTN ADDR A4400076 RR STA* ENTRY IN 'UPDREC' ROUTINE. A4400077 RR ENA 4 SET REQ CODE A4400078 RR SFA- TIMTRY,12,4,I FOR 'UPDREC' (BITS 12-9)=4 A4400079 RR SPC 2 A4400080 RR RTJ ABSADD ABSOLUTIZE THE FILE REQUEST ADDRESS A4400081 RR ADC* UPREC A4400082 RR STA* ENT010+1 STORE IN THE REQUEST A4400083 RR SPC 1 A4400084 RR ENQ CALTH MOVE 'UPDREC' ROUTINE TO PHYSTB 'RTJCAL' A4400085 RRBUP01 LDA* ENTRY,Q A4400086 RR STA- RTJCAL,B A4400087 RR DQP *-BUP01 A4400088 RR SPC 2 A4400089 RRBUP05 XF1 Q RESTORE CALLER'S Q-REG FROM R1 AND A4400090 RR JMP- RTJCAL+1,I PERFORM PSUEDO RTJ TO PHYSTB ROUTINE A4400091 RR SPC 2 A4400092 RR END A4400093 RR NAM BTIMER A45 A ITOS CCS 3.0 SL-149A4500001 RR* BATCH DRIVER TIMER REQUEST PROCESSOR A4500002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 A4500003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A4500004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 A4500005 RR* A4500006 RR**** A4500007 RR*E A4500008 RR* FUNCTION A4500009 RR* -------- A4500010 RR*S3 PROVIDES FOR BATCH DRIVER QUEUING REQUESTS FOR ACCESS TO A4500011 RR* FILES/RECORDS THAT ARE FOUND LOCKED BY THE BATCH DRIVER. A4500012 RR* A4500013 RR*S4 GENERAL DESCRIPTION A4500014 RR* ------------------- A4500015 RR*S3 THE ROUTINE ALLOWS BATCH DRIVERS TO DELAY REPEATING FILE MANAGER A4500016 RR* ACCESS REQUESTS BY BUIDING A MSOS TIMER CALL IN THE PHYSICAL A4500017 RR* DEVICE TABLE IN SUCH A MANNER THAT CONTROL RETURNS TO THE CALLER A4500018 RR* UPON EXPIRATION OF A PRESPECIFIED TIME DELAY. A4500019 RR* A4500020 RR*S4 ENTRY/EXIT CONDITIONS A4500021 RR* --------------------- A4500022 RR*S3 THE ADDRESS OF THE PHYSICAL DEVICE TABLE IS PASSED VIA THE A4500023 RR* I-REGISTER ON ENTRY BY A RELATIVE 2-WORD RTJ TO ENTRY 'BTIMER'. A4500024 RR* A4500025 RR* UPON RETURN TO THE CALLER AFTER COMPLETION OF THE MSOS TIMER A4500026 RR* CALL THE I-REGISTER IS RESTORED. BOTH A/Q-REGISTERS ARE A4500027 RR* DESTROYED. A4500028 RR* A4500029 RR*S4 ENTRY AND EQUATE SPECIFICATIONS A4500030 RR* ------------------------------- A4500031 RR*S3 ENTRY POINT A4500032 RR* A4500033 RR ENT BTIMER A4500034 RR*S3 EQUATES A4500035 RR* A4500036 RR EQU PRLVL($EF) CALLER CURRENT RUNNING LEVEL A4500037 RR EQU AMONI($F4) MONITOR REQUEST ENTRY PROCESSOR ADDRESS A4500038 RR EQU ADISP($EA) MONITOR DISPATCHER ADDRESS A4500039 R INQ $30 A3800869 ALS 8 A3800870 EAQ A A3800871 JMP* (DECASC) A3800872 SPC 2 A3800873 DBO535 EQU DBO535(*) A3800874 RTJ BUPREC UPDATE THE FILE RECORD A3800875 SAP DBO540 SKIP IF NO ERROR A3800876 DBO537 EQU DBO537(*) A3800877 JMP DBO900 ERROR, ATTEMPT TO CLOSE, POST MSG, EXIT A3800878 DBO540 EQU DBO540(*) A3800879 RTJ BCLOSF CLOSE THE FILE A3800880 SAP DBO550 SKIP IF NO ERROR A3800881 STA- ERSTAT,I A3800882 ENA 1 'CLOSE' RQST CODE A3800883 SFA- TIMTRY,12,4,I A3800884 DBO545 EQU DBO545(*) A3800885 JMP DBO910 ERROR - POST MSG, EXIT A3800886 * A3800887 * A3800888 * RENAME THE SCRATCH FILE TO THE JOBKEY A3800889 * A3800890 DBO550 EQU DBO550(*) A3800891 ENQ 3 MOVE OWNER TO NEWNAM A3800892 DBO560 EQU DBO560(*) A3800893 LDA* SNAM+4,Q A3800894 STA- NEWNAM+4,B A3800895 DQP *-DBO560 A3800896 RTJ* DBO570 A3800897 JMP* DBO590 GO SETUP RENAME REQUEST A3800898 EJT A3800899 * A3800900 * ROUTINE SETS UP SCRATCH FILE NAME, USER, VOLUMN A3800901 * A3800902 DBO570 EQU DBO570(*) A3800903 NUM 0 ENTRY, SETUP SCRATCH FILE NAME A3800904 LDA- ELU,I A3800905 ENQ 0 A3800906 DVI- TEN CONVERT BINARY LU TO ASCII A3800907 INA $30 FOR LU = 1, 99 A3800908 ALS 8 A3800909 INQ $30 A3800910 EAQ A A3800911 STA* SNAM+2 A3800912 LDQ+ WKSPLU A3800913 LDQ+ MMLUTB,Q Q = VOLUME TABLE FOR SCRATCH FILES A3800914 INQ 1 A3800915 STQ* VOLNAM A3800916 ENQ 3 A3800917 DBO575 LDA* (VOLNAM),Q MOVE THE VOLUME NAME A3800918 STA* SVOL,Q A3800919 DQP *-DBO575 A3800920 ENQ 11 A3800921 DBO580 EQU DBO580(*) A3800922 LDA* SNAM,Q MOVE OLD NAME, OWNER, VOLUME TO IDATA A3800923 STA- IDATA,B A3800924 DQP *-DBO580 A3800925 JMP* (DBO570) RETURN A3800926 SPC 2 A3800927 VOLNAM ADC 0 TEMPORARY STORAGE A3800928 EJT A3800929 * A3800930 * THE FOLLOWING CODE STARTING AT LABEL 'ENTRY' THRU A3800931 * LABEL 'CALTH' IS NOT EXECUTED IN THE DRIVER, BUT IS A3800932 * BUILT AND MOVED TO THE PHYSTB. THE CODE IS THEN A3800933 * EXECUTED FROM THE PHYSTB WITH RETURN TO THE DRIVER. A3800934 * A3800935 ENTRY NUM 0 RTJ ENTRY A3800936 ENT010 RTJ+ SYFAIL RENAME FILE REQUEST A3800937 ADC (REQBUF-RTJCAL-3) REL ADR TO 'REQBUF' PARAMETER A3800938 ADC (IDATA-RTJCAL-4) REL ADR TO 'IDATA' PARAMETER A3800939 ADC (NEWNAM-RTJCAL-5) REL ADR TO 'NEWNAM' PARAMETER A3800940 ADC (ISTAT-RTJCAL-6) REL ADR TO 'ISTAT' PARAMETER A3800941 LDA- ISTAT,I PICKUP 'RENAME' REQUST STATUS A3800942 STA- ERSTAT,I SAVE REQUEST STATUS A3800943 JMP* (ENTRY) RETURN TO CALLER A3800944 CALTH EQU CALTH(*-ENTRY-1) A3800945 * A3800946 * CALLER'S Q/I REGISTERS PRESERVED BY FM A3800947 * A3800948 EJT A3800949 DBO590 EQU DBO590(*) A3800950 ENA 6 SET RQST CODE FOR 'RENAME' A3800951 SFA- TIMTRY,12,4,I A3800952 RTJ ABSADD ABSOLUTIZE THE FILE REQUEST ADDRESS A3800953 ADC* RENAM A3800954 STA* ENT010+1 STORE IN THE REQUEST A3800955 ENQ CALTH MOVE 'RENAME' ROUTINE TO PHYSTAB A3800956 DBO600 EQU DBO600(*) A3800957 LDA* ENTRY,Q A3800958 STA- RTJCAL,B A3800959 DQP *-DBO600 A3800960 RTJ- RTJCAL,I GO EXECUTE ROUTINE IN PHYSTB A3800961 * A3800962 * RETURN FROM 'RENAME ROUTINE IN PHYSTB. A-REG = ISTAT. A3800963 * A3800964 SAM DBO605 SKIP IF REJECTED A3800965 CLF- HSTNN,13,6,I CLEAR DRIVER STATUS FLAGS A3800966 JMP DBO310 GO COMPLETE THE REQUEST A3800967 DBO605 EQU DBO605(*) A3800968 ENA 0 ERROR, POST DIAG MSG A3800969 STA- MOTPAR,I A3800970 RTJ BFWRIT A3800971 DBO607 EQU DBO607(*) A3800972 JMP* DBO505 GO DELETE THE SCRATCH FILE, EXIT A3800973 SPC 2 A3800974 PRTNAM ALF 4,$$PRINT PRINT FILE NAME A3800975 SPC 2 A3800976 SNAM ALF 4,$$BD SCRATCH FILE NAME A3800977 SOWN ALF 4,$$ FILE OWNER NAME A3800978 SVOL ALF 4,SYSVOL VOLUME NAME A3800979 EJT A3800980 * A3800981 * PROCESS UNIDENTIFIED FILE, I.E., NO '*JOB,JMNN,' A3800982 * RECORD WAS FOUND. FIND AN AVAILABLE ENTRY IN THE A3800983 * $$PRINT FILE, UPDATE IT, AND RENAME THE SCRATCH A3800984 * FILE ACCORDINGLY. A3800985 * A3800986 DBO610 EQU DBO610(*) A3800987 ENQ 3 MOVE $$PRINT FILE NAME TO IDATA 1-4 A3800988 DBO620 EQU DBO620(*) A3800989 LDA* PRTNAM,Q A3800990 STA- IDATA,B A3800991 DQP *-DBO620 A3800992 ENQ 7 MOVE OWNER NAME AND VOLUME A3800993 DBO630 EQU DBO630(*) NAME TO IDATA 5-12 A3800994 LDA* SOWN,Q A3800995 STA- IDATA+4,B A3800996 DQP *-DBO630 A3800997 ENA 0 ACCESS INDICATOR, RETRIEVAL BY A3800998 STA- IDATA+12,I RELATIVE RECORD NUMBER A3800999 ENA 1 NUMBER OF RECORDS PER RETRIEVAL A3801000 STA- IDATA+13,I A3801001 STA- IDATA+14,I RECORD LOCK ON RETRIEVAL A3801002 DBO640 EQU DBO640(*) A3801003 RTJ BOPENF OPEN PRINT FILE, A=ISTAT ON RETURN A3801004 ENQ -1 A3801005 XFQ 1 NO REJECT MASK A3801006 LDQ =XBOSMSK REJECT, BUSY MASK A3801007 RTJ RETRY CHECK FOR ERRORS, RETRY IF BUSY A3801008 * NO RETURN IF OTHER ERRORS A3801009 JMP* DBO640 BUSY, RETRY A3801010 DBO650 EQU DBO650(*) NO ERRORS A3801011 RTJ BGETS GET THE NEXT SEQUENTIAL RECORD A3801012 SFZ- ISTAT,8,1,I SKIP IF NOT EOF A3801013 JMP* DBO705 NO AVAILABLE ENTRIES IN PRINT FILE A3801014 LDQ- NZERO A3801015 XFQ 1 A3801016 LDQ =XBGETSM A3801017 RTJ RETRY A3801018 JMP* DBO650 BUSY, RETRY A3801019 * NO ERROR A3801020 LDA- RECBUF+15,I SEE IF THIS RECORD IS AN AVAILABLE ENTRY A3801021 EOR DBO525 ENTRY AVAILABLE IF NO. OF RECORDS=2 BLANKS A3801022 SAZ DBO660 SKIP IF AVAILABLE A3801023 JMP* DBO650 GO GET NEXT RECORD A3801024 DBO660 EQU DBO660(*) A3801025 ENQ 2 MOVE PRINT FILE NAME TO NEWNAM A3801026 DBO670 EQU DBO670(*) A3801027 LDA- RECBUF,B A3801028 STA- NEWNAM,B A3801029 DQP *-DBO670 A3801030 LDA- RECBUF+2,I COMPLETE FILE NAME WITH 2 MORE BLANKS A3801031 STA- NEWNAM+3,I A3801032 ENQ 5 MOVE DATE/TIME TO RECORD A3801033 XFQ 1 A3801034 DBO680 EQU DBO680(*) A3801035 XF1 Q A3801036 LDQ DAYTIM,Q GET DATE/TIME ADR A3801037 LDA- (ZERO),Q PICKUP THE INTEGER A3801038 RTJ DECASC CONVERT TO ASCII A3801039 XF1 Q A3801040 STA- RECBUF+8,B PUT IT IN THE RECORD A3801041 D1P *-DBO680 A3801042 ENA 0 SETUP TO GET NUMBER OF RECORDS IN A3801043 XFA 1 SCRATCH FILE (LAST RELATIVE RECORD A3801044 ENA 3 STORED), CONVERT TO ASCII AND A3801045 XFA 2 PUT IN PRINT FILE RECORD. A3801046 LDQ- RELREC,I Q = NUMBER RECORDS A3801047 DBO690 EQU DBO690(*) A3801048 ENA 0 A3801049 LLS 4 A = NEXT DIGIT (HEX) A3801050 INA -$A A3801051 SAM DBO700 SKIP IF DIGIT 0-9 A3801052 INA 7 BIAS FOR A-F A3801053 DBO700 EQU DBO700(*) A3801054 INA $3A = ASCII REPRESENTATION THIS DIGIT A3801055 SCA- RECBUF+15,1,I PUT IT IN THE PRINT FILE RECORD A3801056 AR1- ONE A3801057 D2P *-DBO690 A3801058 JMP DBO535 GO UPDATE PRINT FILE AND RENAME SCRATCH A3801059 EJT A3801060 * A3801061 * THE $$PRINT FILE IS FULL, NO AVAILABLE ENTRIES FOUND. A3801062 * ALERT THE OPERATOR AND DELETE THE SCRATCH FILE. A3801063 * A3801064 DBO705 EQU DBO705(*) A3801065 ENQ PMSGL MOVE WARNING MSG TO RECBUF A3801066 DBO710 EQU DBO710(*) A3801067 LDA* PMSG,Q A3801068 STA- RECBUF,B A3801069 DQP *-DBO710 A3801070 ENA PMSGL PASS MSG LENGTH IN A-REG A3801071 INA 1 A3801072 RTJ BFWRIT POST THE MSG A3801073 RTJ BCLOSF CLOSE THE $$PRINT FILE A3801074 SAP DBO720 SKIP IF NO ERROR A3801075 STA- ERSTAT,I A3801076 ENA 1 'CLOSE' RQST CODE A3801077 SFA- TIMTRY,12,4,I A3801078 DBO715 EQU DBO715(*) A3801079 JMP* DBO910 A3801080 DBO720 EQU DBO720(*) A3801081 ENA BSF MAKE MOTION PARAMETER LOOK LIKE BSF A3801082 STA- MOTPAR,I A3801083 JMP* DBO607 GO DELETE SCRATCH FILE A3801084 SPC 2 A3801085 PMSG ALF ., $$PRINT FILE FULL, FILES ARE BEING LOST. A3801086 PMSGL EQU PMSGL(*-PMSG-1) A3801087 EJT A3801088 * A3801089 * THE JOB HAS BEEN IDENTIFIED, HOWEVER, THE CORRESPONDING A3801090 * STATUS CODE IS INVALID. ALERT THE OPERATOR AND SAVE THE A3801091 * OUTPUT DATA AS A PRINT FILE. A3801092 * A3801093 DBO725 EQU DBO725(*) A3801094 RTJ BCLOSF CLOSE THE $$HOST FILE A3801095 SAP DBO730 SKIP IF NO ERROR A3801096 ENA 0 A3801097 STA- MOTPAR,I A3801098 JMP DBO607 GO DELETE THE SCRATCH FILE AND ERROR EXIT A3801099 DBO730 EQU DBO730(*) A3801100 ENQ IMSGL MOVE THE MSG TO RECBUF A3801101 DBO740 EQU DBO740(*) A3801102 LDA* IMSG,Q A3801103 STA- RECBUF,B A3801104 DQP *-DBO740 A3801105 LDA- JOBKEY,I PUT JOB NAME IN MSG A3801106 STA- RECBUF+1,I A3801107 LDA- JOBKEY+1,I A3801108 STA- RECBUF+2,I A3801109 ENA IMSGL PASS MSG LENGTH IN A-REG A3801110 INA 1 A3801111 RTJ BFWRIT POST THE MSG A3801112 JMP DBO610 GO SAVE THE OUTPUT DATA AS A PRINT FILE A3801113 SPC 2 A3801114 IMSG ALF ., *JMNN RECEIVED, STATUS INVALID. A3801115 IMSGL EQU IMSGL(*-IMSG-1) A3801116 EJT A3801117 * A3801118 * ERROR EXIT FOR FM REJECT ON CALLS WHEN THE FILE IS A3801119 * ACTUALLY OPEN TO THE DRIVER. A3801120 * A3801121 DBO900 EQU DBO900(*) A3801122 RTJ BCLOSF ATTEMPT TO CLOSE THE FILE, IGNORE REJECT A3801123 * A3801124 * ERROR EXIT FOR FM REJECT ON CALLS WHEN THE FILE IS A3801125 * NOT OPEN TO THE DRIVER AND DIAGNOSTIC MESSAGE POSTING A3801126 * IS REQUIRED. A3801127 * A3801128 DBO910 EQU DBO910(*) A3801129 SFN- ERSTAT,15,16,I SKIP IF THERE IS ERROR TO POST A3801130 JMP* DBO920 OTHERWISE, BYPASS A3801131 ENA 0 INDICATE CANNED MSG A3801132 RTJ BFWRIT POST THE DIAGNOSTIC MSG A3801133 * A3801134 * GENERAL ERROR EXIT FOR ALL DRIVER ERRORS. CLEAR THE A3801135 * DRIVER STATUS BITS AND SETUP TO GO TO ALTERNATE DEVICE A3801136 * HANDLER A3801137 * A3801138 DBO920 EQU DBO920(*) A3801139 CLF- HSTNN,13,6,I CLEAR DRIVER STATUS FLAGS A3801140 LDQ- ELU,I GET LU NUMBER A3801141 QLS 6 POSITION TO MERGE ERROR CODE A3801142 ENA 28 NO FILE ERROR CODE A3801143 EAQ Q LU/ERROR CODE A3801144 JMP+ ALTDEV GO TO ALTERNATE DEVICE HANDLER A3801145 EJT A3801146 * A3801147 * RETRY CHECKS THE REQUEST STATUS BASED ON THE INFORMATION A3801148 * PASSED IN REGISTERS Q, A AND 1. IF RETRY IS PERMITTED A3801149 * RETURN IS TO P, IF REQUEST ACCEPTED RETURN IS TO P+1. A3801150 * IF REQUEST REJECTED RETURN IS TO ERROR ROUTINE. A3801151 * ON ENTRY - Q = REJECT, BUSY MASK A3801152 * A = ISTAT A3801153 * 1 = NO REJECT MASK A3801154 * A3801155 RETRY NUM 0 ENTRY A3801156 SAM REJ SKIP IF REJECT A3801157 XF1 Q A3801158 LAQ A A3801159 SAN ERR SKIP IF ERROR A3801160 SFA- TIMTRY,8,9,I CLEAR RETRIES A3801161 RAO* RETRY A3801162 JMP* (RETRY) NO ERROR RETURN A3801163 REJ LAQ A A3801164 SAN ERR SKIP IF ERROR A3801165 LFA- TIMTRY,8,9,I GET NUMBER OF TRIES A3801166 SUB- MAXTRY A3801167 SAP ERR SKIP IF EXCEEDED MAX NUMBER OF TRIES A3801168 RTJ BTIMER DELAY A3801169 JMP* (RETRY) RETURN A3801170 ERR LFA- TIMTRY,12,4,I GET REQUEST CODE A3801171 INA -2 A3801172 SAM ERR1 SKIP IF RQST WAS 'OPEN' OR 'CLOSE' A3801173 INA -3 A3801174 SAZ ERR1 SKIP IF RQST WAS 'CREATE' A3801175 JMP* DBO900 ATTEMPT TO CLOSE AND POST MSG A3801176 ERR1 JMP* DBO910 POST MSG A3801177 END A3801178 NAM DBATIN A39 A ITOS CCS 3.0 SL-149A3900001 * DEFERRED BATCH INPUT DRIVER A3900002 * CREDIT COLLECTION SYSTEM VERSION 3.0 A3900003 * DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A3900004 * COPYRIGHT CONTROL DATA CORPORATION 1979 A3900005 * A3900006 **** A3900007 *E A3900008 * FUNCTION A3900009 * -------- A3900010 * A3900011 * A3900012 * A3900013 * THIS PSEUDO DRIVER READS INPUT FROM FILE MANAGER A3900014 * FILES FOR JOBS SUBMITTED FOR DEFERRED BATCH PROCESSING A3900015 * FROM AN ITOS USER TERMINAL. A3900016 * A3900017 * A3900018 * A3900019 * A3900020 * A3900021 * GENERAL DESCRIPTION A3900022 * ------------------- A3900023 * A3900024 * A3900025 * A3900026 * IF THE REQUEST IS A MOTION REQUEST THEN, A3900027 * A3900028 * IF MOTION REQUEST IS VALID THEN, A3900029 * A3900030 * SLEW TO EOF - POINTERS TO THE CURRENT JOB A3900031 * IN THE $$HOST FILE ARE ADJUSTED A3900032 * TO POINT TO THE NEXT QUEUED JOB. A3900033 * (I.E., TERMINATE JOB) A3900034 * A3900035 * BACKSPACE - POINTERS TO THE CURRENT JOB A3900036 * FILE IN THE $$HOST FILE ARE ADJUSTED A3900037 * TO POINT TO THE CURRENT JOB AS A3900038 * THE NEXT QUEUED JOB. A3900039 * (I.E., RESTART JOB) A3900040 * A3900041 * OTHERWISE THE MOTION REQUEST IS IGNORED. A3900042 * A3900043 * A3900044 * OTHERWISE EACH REQUEST IS PROCESSED AS A FREAD REQUEST A3900045 * AS FOLLOWS: A3900046 * A3900047 * IF THE DRIVER IS NOT LOGICALLY CONNECTED TO A A3900048 * HOST (I.E., A RECORD IN $$HOST FILE) THEN, A3900049 * A3900050 * A SEARCH OF THE $$HOST FILE IS MADE TO FIND A3900051 * A HOST ASSIGNED TO THE SAME LOGICAL UNIT A3900052 * ASSOCIATED WITH THE REQUEST. WHEN FOUND A3900053 * THE DRIVER LOGICALLY CONNECTS TO THAT HOST A3900054 * AND ASCERTAINS THE NEXT QUEUED JOB 'NOT SENT' A3900055 * FOR THAT HOST AND MARKS THE JOB 'BEING SENT', A3900056 * AND LOGICALLY CONNECTS TO THAT JOB. A3900057 * A3900058 * LOGICAL CONNECTION TO A JOB ENTAILS: A3900059 * 1. CONSTRUCT A JOBKEY BASED ON HOST ID A3900060 * AND JOB ID TO ACESS THE $$BATCH FILE. A3900061 * 2. THE JOB STATUS IN $$HOST FILE IS A3900062 * UPDATED TO 'BEING SENT' FOR JMNN. A3900063 * 3. RETRIEVE FROM THE $$BATCH FILE THE A3900064 * RECORD FOR JOBKEY (JNMM) AND EXTRACT A3900065 * THE USER'S INPUT TEXT FILE NAME. A3900066 * 4. UPDATE DATE/TOD TEXT TRANSMITTED A3900067 * IN JMNN $BATCH RECORD. A3900068 * 5. RETRIEVE THE FIRST RECORD FROM THE A3900069 * USER'S INPUT AND RETURN IT TO THE A3900070 * REQUESTOR. A3900071 * A3900072 * OTHERWISE LOGICAL CONNECTION TO A HOST IS IMPLIED. A3900073 * A3900074 * A3900075 * IF THE DRIVER IS ALSO LOGICALLY CONNECTED A3900076 * TO A JOB FOR THIS HOST THEN, A3900077 * A3900078 * THE NEXT RECORD IS SEQUENTIALLY RETRIEVED A3900079 * FROM THE USER'S INPUT FILE. A3900080 * A3900081 * IF AN EOF IS DETECTED THEN, A3900082 * A3900083 * A EOF INDICATION IS RETURNED TO A3900084 * THE REQUESTOR AND THE A3900085 * BATCH WORKSTATION AND THE DRIVER A3900086 * IS LOGICALLY DISCONNECTED FROM THE A3900087 * JOB. A3900088 * THE STATUS OF THE JOB IS MARKED A3900089 * 'SENT' FOR JMNN IN THE $$HOST A3900090 * FILE. A3900091 * A3900092 * OTHERWISE THE RETRIEVED USER RECORD IS A3900093 * RETURNED TO THE CALLER. A3900094 * A3900095 * A3900096 * OTHERWISE THE DRIVER ATTEMPTS TO CONNECT TO A3900097 * THE NEXT QUEUED JOB FOR THE HOST. A3900098 * A3900099 * IF ALL QUEUED JOBS FOR THE HOST HAVE A3900100 * BEEN 'SENT' THEN, A3900101 * A3900102 * THE DRIVER LOGICALLY DISCONNECTS A3900103 * FROM THE HOST AND RETURNS AN A3900104 * END-OF-BATCH INDICATION TO THE A3900105 * REQUESTOR. A3900106 * A3900107 * A3900108 * OTHERWISE THE DRIVER LOGICALLY CONNECTS A3900109 * TO THE NEXT QUEUED JOB FOR THE HOST AND A3900110 * RETURNS THE FIRST USER'S INPUT RECORD A3900111 * FOR THAT JOB TO THE REQUESTOR. A3900112 * A3900113 * A3900114 * SUMMARIZING DATA RETURNED TO FREAD REQUESTORS BASED A3900115 * ON TYPE OF BATCH WORKSTATION: A3900116 * A3900117 * 200UT HASP MSOS 5 A3900118 * ----- ---- ------ A3900119 * A3900120 * 1-ST JOB 1-ST JOB 1-ST JOB A3900121 * EOF EOF EOF,EOF A3900122 * 2-ND JOB 2-ND JOB 2-ND JOB A3900123 * EOF EOF EOF,EOF A3900124 * . . . A3900125 * . . . A3900126 * LAST JOB LAST JOB LAST JOB A3900127 * EOF ( ) EOF ( ) EOF,EOF A3900128 * EOF (EOB) EOF (EOB) '*Z' (EOB) A3900129 * A3900130 * (EOF = $0200 (EOF = $0F00) (EOF = $0F00) A3900131 * A3900132 * 2-EOF = END- 2-EOF = END- *Z = END- A3900133 * OF- OF- OF- A3900134 * BATCH BATCH BATCH A3900135 * A3900136 * '**EOR' IS EDITED A3900137 * TO=$0400 A3900138 * A3900139 * A3900140 * A3900141 * A3900142 * A3900143 * ENTRY A3900144 * ----- A3900145 * A3900146 * A3900147 * A3900148 * THE DRIVER IS ENTERED AT THE INITIATOR VIA THE A3900149 * READ-WRITE REQUEST PROCESSOR WITH THE PHYSICAL DEVICE A3900150 * TABLE ADDRESS IN THE Q-REGISTER. THERE ARE NO A3900151 * CONTINUTOR OR TIMEOUT ENTRIES. A3900152 * A3900153 * A3900154 * A3900155 * A3900156 * A3900157 * EXIT A3900158 * ---- A3900159 * A3900160 * A3900161 * A3900162 * NORMAL EXIT IS TO THE DISPATCHER AFTER COMPLETING A3900163 * REQUEST FOR ALL REQUESTS QUEUED TO THE PHTSICAL A3900164 * DEVICE TABLE. A3900165 * A3900166 * ERROR EXIT IS TO THE ALTERNATE DEVICE HANDLER WITH A3900167 * ERROR CODE = 28(NO FILE). ALL ERRORS ARISE FROM A3900168 * FILE MANAGER ERROR STATUS AND RESULT IN ANY CONNECTED A3900169 * JOB BEING DISCONNECT AND MARKED 'INACTIVE' IN THE A3900170 * $$HOST FILE. THUS THE SOFTWARE DUMMY DEVICE SHOULD A3900171 * BE SPECIFED FOR ALL APPLICABLE LOGICAL UNITS TO A3900172 * RESULT IN AUTOMATIC REQUEST COMPLETION WITH ERROR. A3900173 * A3900174 * ON ERROR EXITS THE DRIVER WILL POST ON THE SYSTEM A3900175 * COMMENT DEVICE THE FOLLOWING DIAGNOSTIC MESSAGE IF IT A3900176 * IS ENABLED FOR THE FAILING PSEUDO DEVICE: A3900177 * A3900178 * ' JMNN FM RJT =$XXXX, REQTYP FILENAME/ USERNAME' A3900179 * A3900180 * WHERE - A3900181 * A3900182 * 'JMNN' IS JOB NAME (JOBKEY), M=HOST ID, NN=JOB ID A3900183 * 'XXXX' IS FILE MANAGER ERROR STATUS(HEXDEC) A3900184 * REQTYP IS 'OPENFL','CLOSFL','READR','GETS','UPDREC', A3900185 * 'CREATE','RENAME','PUTS ','DELETE', A3900186 * 'REDUCE'. A3900187 * FILE- IS THE ASCII NAME OF FILE AND ITS USER NAME A3900188 * NAME/ ENCOUNTERING THE FAILURE. A3900189 * USER- A3900190 * NAME A3900191 * A3900192 * A3900193 * A3900194 * A3900195 * A3900196 * ENTRY POINTS A3900197 * ------------ A3900198 * A3900199 * A3900200 * A3900201 ENT DBATIN INITIATOR ENTRY A3900202 ENT ABSADD ADDRESS ABSOLUTIZING ROUTINE A3900203 * A3900204 * A3900205 * A3900206 * A3900207 * A3900208 * EXTERNAL REFERENCES A3900209 * ------------------- A3900210 * A3900211 * A3900212 * A3900213 EXT* OPHOST BATCH DRIVER OPEN $$HOST FILE ROUTINE A3900214 EXT* OPBATF BATCH DRIVER OPEN $$BATCH FILE ROUTINE A3900215 EXT* BOPENF BATCH DRIVER 'OPENFL' ROUTINE A3900216 EXT* BCLOSF BATCH DRIVER 'CLOSFL' ROUTINE A3900217 EXT* BREADR BATCH DRIVER 'READR' ROUTINE A3900218 EXT* BGETS BATCH DRIVER 'GETS' ROUTINE A3900219 EXT* BUPREC BATCH DRIVER 'UPDREL' ROUTINE A3900220 EXT* BFWRIT BATCH DRIVER MSOS FWRITE REQUEST A3900221 EXT* BTIMER BATCH DRIVER MSOS TIMER REQUEST A3900222 EXT HORTO MSOS CURRENT HOUR (INTEGER) A3900223 EXT MINTO MSOS CURRENT MINUTE (INTEGER) A3900224 EXT SECON MSOS CURRENT SECOND (INTEGER) A3900225 EXT DAYTO MSOS CURRENT DAY (INTEGER) A3900226 EXT MONTO MSOS CURRENT MONTH (INTEGER) A3900227 EXT YERTO MSOS CURRENT YEAR (INTEGER) A3900228 EXT ALTDEV MSOS ALTERNATE DEVICE HANDLER A3900229 EXT MAS300 A3900230 EXT FMEOFC FM/ITOS END-OF-FILE CODE A3900231 EXT JOBIND JOB PROCESSOR IN CORE A3900232 EXT SWTCH LOCK-OUT SWITHC FOR JP A3900233 EXT LOADIN LOADER IN CORE FLAG A3900234 EXT MIBUF ADDRESS OF MIINP BUFFER IN JOBENT A3900235 EXT JBCNCL JOB CANCEL PROCESSOR A3900236 EXT AUTON AUTO MODE IN SYSDAT, MINUS = NOT ALLOWED A3900237 * 0 = NOT ENABLED A3900238 * 1 = ENABLED A3900239 EXT* DELET FILE MANAGER DELETE FILE REQUEST PROCESSOR. A3900240 EXT SYFAIL SYSTEM FAILURE PROCESSOR A3900241 EXT WKSPLU FILE MANAGER UNIT FOR SCRATCH FILES A3900242 EXT MMLUTB FILE MANAGER MASS MEMORY UNIT TABLE A3900243 EXT AUTOBT AUTOMATIC BATCH MODE ROUTINE A3900244 * A3900245 * A3900246 * A3900247 * A3900248 * A3900249 * SYSTEM EQUATES A3900250 * -------------- A3900251 * A3900252 * A3900253 * A3900254 EQU FNR($B5) MSOS FIND NEXT REQUEST A3900255 EQU COMPRQ($B6) MSOS COMPLETE REQUEST A3900256 EQU AMONI($F4) MONITOR REQUEST ENTRY A3900257 EQU ADISP($EA) MSOS DISPATCHER A3900258 EQU MOT(14) MOTION REQUEST CODE A3900259 * A3900260 * A3900261 * A3900262 * A3900263 * A3900264 * MASKING EQUATES A3900265 * --------------- A3900266 * A3900267 * A3900268 * A3900269 EQU FOUR($25) MSOS MASK = $0004 A3900270 EQU MAXTRY($B) MSOS MASK = $01FF A3900271 EQU M0020($28) MSOS MASK = $0020 A3900272 EQU M00FF($A) MSOS MASK = $00FF A3900273 EQU M0200($2C) MSOS MASK = $0200 A3900274 EQU ONE(3) MSOS MASK = $0001 A3900275 EQU TEN($46) MSOS MASK = $000A A3900276 EQU ZERO($22) MSOS MASK = $0000 A3900277 EQU ONEBIT($23) A3900278 * A3900279 * A3900280 * A3900281 * A3900282 * A3900283 * PHYSTB EQUATES A3900284 * -------------- A3900285 * A3900286 * A3900287 * A3900288 EQU ELVL(0) PBATXX ADC $5200+LVL SCHDL CALL A3900289 EQU EDIN(1) ADC DBATIN INITIATOR A3900290 EQU EDCN(2) ADC 0 (NOT USED) A3900291 EQU EDPGM(3) ADC 0 (NOT USED) A3900292 EQU EDCLK(4) NUM -1 (NOT USED) A3900293 EQU ELU(5) NUM 0 LOGICAL UNIT A3900294 EQU EPTR(6) NUM 0 REQ LOCATION A3900295 EQU EWES(7) NUM 0 (NOT USED) A3900296 EQU EREQST(8) NUM $08A2 REQ. STATUS A3900297 EQU ESTAT1(9) NUM 0 DRIVER STATUS A3900298 EQU ECCOR(10) NUM 0 CURRENT LOC. A3900299 EQU ELSTWD(11) NUM 0 LWA+1 A3900300 EQU ESTAT2(12) NUM 0 DEVICE STATUS A3900301 EQU MASLGN(13) NUM 0 MM LENGTH A3900302 EQU MASSEC(14) NUM $7FFF MM SECTOR A3900303 EQU RETURN(15) NUM 0 RESERVED A3900304 EQU HSTRNO(16) NUM 0,0 $$HOST REL A3900305 * REC. NO. A3900306 EQU HSTNN(18) NUM 0 TERM/JOB ID A3900307 EQU ERSTAT(19) NUM 0 FM ERR STATUS A3900308 EQU TIMTRY(20) NUM $8000 ENABLE DIAG/ A3900309 * FM CODE/TRYS A3900310 EQU JOBKEY(21) ALF 2,J $$BATCH KEY A3900311 EQU MOTPAR(23) NUM 0 MOTION PARM. A3900312 EQU RTJCAL(24) BZS RTJBF(13) FM/MONI CALLS A3900313 EQU REQBUF(37) BZS REQBUF(24) FM 'REQBUF' A3900314 EQU IDATA(61) BZS IDATBF(24) FM 'IDATA' A3900315 EQU ISTAT(85) BZS ISTABF(1) FM 'ISTAT' A3900316 EQU RECBUF(86) BZS RECBF(40) FM 'RECBUF' A3900317 * A3900318 * A3900319 * 'HSTNN' BYTE EQUATES A3900320 * -------------------- A3900321 * A3900322 * A3900323 * JOB ID NN=1,99 JOB ID FOR HOST 'M' A3900324 * A3900325 EQU JNNSTR(7) FLDSTR = BIT7 A3900326 EQU JNNLTH(8) FLDLTH = 8 BITS A3900327 * A3900328 * MSOS END-OF-JOB (EOJ) STATUS A3900329 EQU EOJSTR(13) FLDSTR = BIT13 A3900330 EQU EOJLTH(1) FLDLTH = 1 BIT A3900331 * A3900332 * WORKSTATION TYPE = 0 MSOS, = 1 200UT, = 2 HASP A3900333 * A3900334 EQU TYPSTR(15) FLDSTR = BIT15 A3900335 EQU TYPLTH(2) FLDLTH = 2 BITS A3900336 * A3900337 * A3900338 * 'TIMTRY' BYTE EQUATES A3900339 * ---------------------- A3900340 * A3900341 * A3900342 * TALLY OF TIMER TRYS FOR LOCK FILE/RECORD ACCESS A3900343 * A3900344 EQU TIMSTR(8) FLDSTR = BIT8 A3900345 EQU TIMLTH(9) FLDLTH = 9 BITS A3900346 * A3900347 * CURRENT FILE MGR ACCESS REQUEST CODE A3900348 * = 0 'OPENFL', =1 'CLOSFL', =2 'READR', =3 'GETS', A3900349 * = 4 'UPDREC', =5 'CREATE', =6 'RENAME', A3900350 * = 7 'REDUCE', =8 'PUTS ', =9 'DELETE'. A3900351 * A3900352 EQU FMCSTR(12) FLDSTR = BIT12 A3900353 EQU FMCLTH(4) FLDLTH = 4 BITS A3900354 * A3900355 * USER TEXT FILE TRANSMISSION STATUS A3900356 * =0 TRANSMISSION IN-PROGRESS A3900357 * =1 INITIATING TRANSMISSION A3900358 * A3900359 EQU XMTSTR(14) FLDSTR = BIT14 A3900360 EQU XMTLTH(1) FLDLTH = 1 BIT A3900361 * A3900362 * ERROR DIAGNOSTIC POSTING = 0 DISABLED, =1 ENABLE A3900363 * A3900364 * FLDSTR= BIT15, FLDLTH = 1 BIT A3900365 * A3900366 * A3900367 * 'JOBKEY' - KEY TO $$BATCH FILE RECORD (ASCII) = 'JMNN' A3900368 * 'MNN' = BLANK, NO JOB CONNECTED A3900369 * A3900370 EQU MSTR(7) FLDSTR = BIT7 (REL REC NO OF $$HOST A3900371 EQU MLTH(8) FLDLTH = 8 BITS (FILE RECORD MINUS ONE) A3900372 * A3900373 EQU N1STR(15) FLDSTR = BIT 15 ) A3900374 EQU N1LTH(8) FLDLTH = 8 BITS) JOBKEY+1 A3900375 EQU N2STR(7) FLDSTR = BIT7 ) A3900376 EQU N2LTH(8) FLDLTH = 8 BITS) A3900377 * A3900378 * A3900379 * 'HSTRNO' - $$HOST FILE RELATIVE RECORD NUMBER A3900380 * - = 0,0 NOT CONNECTED TO A HOST A3900381 **** A3900382 EJT A3900383 START STQ- I MASS MEMORY ENTRY TO DRIVER A3900384 LDQ =XDBATIN-START A3900385 AAQ Q A3900386 STQ- 1,I SET UP INITIATOR ENTRY A3900387 JMP* DI0010 A3900388 MS300 ADC MAS300 A3900389 * A3900390 * INITIATOR ENTRY A3900391 * A3900392 SPC 2 A3900393 DBATIN STQ- I SAVE PHYSTB ADDR A3900394 SPC 2 A3900395 * A3900396 * FIND NEXT REQUEST, NORMAL EXIT IF NONE. A3900397 * A3900398 SPC 2 A3900399 DI0010 RTJ- (FNR) A3900400 JMP* (MS300) NO RQST OUTSTANDING A3900401 * A3900402 * FOUND A REQUEST, INITIALIZE PHYSTB FOR THIS REQUEST A3900403 * A3900404 DI0020 ENA 0 A3900405 SFA- TIMTRY,XMTSTR,15,I CLR ALL BUT MSG ENABLE A3900406 STA- ERSTAT,I CLR FM ERROR STATUS A3900407 STA- MOTPAR,I CLR MOTION PARAMETER A3900408 STA- ESTAT2,I CLR ESTAT2 A3900409 CLF- ESTAT1,15,3,I CLR V-FIELD A3900410 SPC 3 A3900411 * A3900412 * IF MOTION REQUEST THEN A3900413 * A3900414 LDQ- EPTR,I GET REQ PARM ADDR A3900415 LFA- (ZERO),13,5,Q PICK REQ CODE A3900416 INA -MOT A3900417 SAN FR0010 A3900418 * A3900419 * GO TO MOTION REQUEST PROCESSOR A3900420 * A3900421 JMP MT0010 A3900422 * A3900423 * OTHERWISE EACH REQUEST IS PROCESSED AS A FREAD REQUEST A3900424 * A3900425 SPC 4 A3900426 * A3900427 * IF THE DRIVER IS NOT LOGICALLY CONNECTED TO A A3900428 * HOST (REL REC NO. = 0,0) THEN, A3900429 * A3900430 * A3900431 FR0010 LDA- HSTRNO+1,I GET REL RECORD LSB A3900432 SAZ FR0020 A3900433 JMP FR0500 CONNECTED TO A HOST A3900434 * A3900435 * SEARCH $$HOST FILE TO LOGICALLY CONNECT TO A3900436 * A HOST WITH SAME LU AS THIS REQUEST. A3900437 * A3900438 FR0020 RTJ OPHOST OPENFL ON $$HOST A3900439 SAZ FR0050 CK FM 'ISTAT' A3900440 AND* HOPBSY RJT- CK IF BUSY A3900441 SAN FR0030 STATUS. A3900442 * NO- FM ERROR XIT A3900443 LFA- TIMTRY,TIMSTR,TIMLTH,I YES- CK IF MAX A3900444 SUB- MAXTRY TRYS A3900445 SAM FR0040 ATTEMPTED. A3900446 FR0030 JMP ER0020 YES - ERR XIT A3900447 FR0040 RTJ BTIMER NO - DELAY A3900448 JMP* FR0020 RETRY A3900449 SPC 2 A3900450 HOPBSY NUM $6A23 BSY STATUS 'OPENFL' $$HOST/$$BATCH A3900451 EQU BOPBSY(HOPBSY) A3900452 HGTBSY NUM $6120 BSY STATUS 'GETS' $$HOST A3900453 SPC 2 A3900454 * NO FM RJT A3900455 FR0050 CLF- TIMTRY,TIMSTR,TIMLTH,I CLR RETRY COUNTS A3900456 FR0060 ENA 0 ZERO FM 'RECBUF' A3900457 ENQ 39 A3900458 FR0070 STA- RECBUF,B A3900459 DQP *-FR0070 A3900460 FR0075 ENQ HSTRNO SET Q-REG FOR BGETS A3900461 RTJ BGETS RTV NEXT $$HOST REC A3900462 SAN FR0077 CK FM ISTAT A3900463 JMP* FR0100 A3900464 FR0077 EQU FR0077(*) A3900465 AND* HGTBSY RJT CK IF BUSY A3900466 SAN FR0080 STATUS. A3900467 * NO-FM ERROR XIT A3900468 LFA- TIMTRY,TIMSTR,TIMLTH,I YES- CK IF MAX A3900469 SUB- MAXTRY TRYS A3900470 SAP FR0080 ATTEMPTED A3900471 JMP* FR0090 A3900472 FR0080 EQU FR0080(*) A3900473 AND- ONEBIT+8 A3900474 SAN FR0081 SKIP IF END-OF-FILE A3900475 JMP* FR0085 A3900476 FR0081 EQU FR0081(*) A3900477 ENQ 0 PUT LU IN ALRT MSG A3900478 LDA- ELU,I A3900479 DVI- TEN A3900480 ALS 8 A3900481 AAQ A A3900482 ADD =N$3030 A3900483 STA* ALRT+10 A3900484 ENQ LNALRT ALERT OPERATOR HOST IS NOT SET TO LU A3900485 INQ -1 A3900486 FR0082 EQU FR0082(*) A3900487 LDA* ALRT,Q MOVE MSG TO RECBUF A3900488 STA- RECBUF,B A3900489 DQP *-FR00R EQU RTJCAL(24) MSOS TIMER CALL SEQUENCE, 12 WORDS A4500041 RR* A4500042 RR*S4 STRUCTURE OF TIMER PHYSTB ROUTINE A4500043 RR* --------------------------------- A4500044 RR*S3 STARTS AT PHYSTB INDEX 'RTJCAL' A4500045 RR* A4500046 RR EQU LVL(9) SET DUMMY COMPLETION PRIORITY A4500047 RRENTRY NUM 0 PSEUDO RTJ ENTRY, CALLERS RETURN ADDRESS A4500048 RR RTJ- (AMONI) A4500049 RRTIMREQ ADC $1110+LVL DELAY IN 0.1 SEC UNITS/MERGED CURRENT LEVEL A4500050 RR ADC ICMPL-TIMREQ COMPLETION ADDRESS A4500051 RR NUM 1 1 TIME UNIT DELAY A4500052 RR JMP- (ADISP) EXIT DISPATCHER, AWAIT TIME EXPIRATION. A4500053 RRICMPL LDA =N0 UPON TIME EXPIRATION, RESTORE I-REG TO A4500054 RR EQU PHYADR(ICMPL+1) PHYSTB ADDRESS A4500055 RR STA- I AND A4500056 RR RAO- TIMTRY,I BUMP TALLY OF TIMER TRYS. A4500057 RRCALXIT JMP* (ENTRY) RETURN TO BTIMER CALLER WITH CALLER'S A4500058 RR EQU CALTH(CALXIT-ENTRY) I-REGISTER RESTORED, CALLER'S A4500059 RR**** A/Q-REGISTERS DESTROYED. A4500060 RR EJT A4500061 RR* ENTRY TO PROVIDE BATCH DRIVER TIME DELAY A4500062 RR* A4500063 RRBTIMER NUM 0 CALLER'S RTN ADDR ON ENTRY A4500064 RR LDA* BTIMER SAVE CALLER'S RTN ADDR A4500065 RR STA* ENTRY IN TIMER CALL ROUTINE. A4500066 RR* A4500067 RR LDA- PRLVL MERGE CURRENT PRIORITY LEVEL A4500068 RR SFA* TIMREQ,3,4 INTO TIMER CALL FOR COMPLETION PRIORITY. A4500069 RR* A4500070 RR LDA- I SAVE PHYSTB ADDRESS A4500071 RR STA* PHYADR IN TIMER CALL ROUTINE. A4500072 RR SPC 2 A4500073 RR ENQ CALTH MOVE TIMER CALL ROUTINE TO PHYSTB 'RTJCAL' A4500074 RRBTIM01 LDA* ENTRY,Q A4500075 RR STA- RTJCAL,B A4500076 RR DQP *-BTIM01 A4500077 RRBTIM05 JMP- RTJCAL+1,I PERFORM PSEUDO RTJ TO PHYSTB ROUTINE A4500078 RR SPC 2 A4500079 RR END A4500080 RR NAM BFWRIT A46 A ITOS CCS 3.0 SL-149A4600001 RR* BATCH DRIVER FORMATTED WRITE REQUEST PROCESSOR A4600002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 A4600003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A4600004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 A4600005 RR* A4600006 RR**** A4600007 RR*E A4600008 RR* FUNCTION A4600009 RR* -------- A4600010 RR*S3 PROVIDES BATCH DRIVERS THE CAPABILITY OF LOGGING ABNORMAL OR A4600011 RR* DIAGNOSTIC ERROR INFORMATION ON THE SYSTEM COMMENT DEVICE. A4600012 RR* A4600013 RR*S4 GENERAL DESCRIPTION A4600014 RR* ------------------- A4600015 RR*S3 THE ROUTINE ALLOWS BATCH DRIVERS TO LOG 2 CLASSES OF MESSAGES: A4600016 RR* CLASS A - UNCONDITIONAL LOGGING OF MESSAGE SPECIFIED BY A4600017 RR* THE BATCH DRIVER. A4600018 RR* CLASS B - CONDITIONAL LOGGING OF THE FOLLOWING DIAGNOSTIC: A4600019 RR* A4600020 RR* ' JMNN FM RTJ =$XXXX, REQTYP FILENAME/ USERNAME' A4600021 RR* ---- ---- ------ -------- ---------- A4600022 RR* JOBKEY --- - - - - A4600023 RR* 'ERSTAT' ---- - - - A4600024 RR* - IDATA(1)- IDATA(5)- A4600025 RR* OPENFL, CLOSFL, READR, GETS---- THRU - THRU - A4600026 RR* UPDREC, CREATE, RENAME,PUTS---- IDATA(4)- IDATA(8)- A4600027 RR* DELETE, REDUCE----------------- A4600028 RR* A4600029 RR* CLASS B MESSAGE IS LOGGED ONLY IF FM DIAGNOSTIC POSTING IS A4600030 RR* ENABLED IN THE PHYSTB (BIT15=1) WD 20) AND A4600031 RR* FM ERROR STATUS (WD 19) IS NON-ZERO. A4600032 RR* A4600033 RR* CLASS A MESSAGE ENCODED BY BATCH DRIVER IN PHYSTB 'RECBUF' A4600034 RR* ARRAY BEFORE CALLING BFWRIT. A4600035 RR* A4600036 RR* THE ROUTINE BUILDS A MSOS FWRITE REQUEST IN THE PHYSICAL DEVICE A4600037 RR* TABLE IN SUCH A MANNER THAT CONTROL RETURNS TO THE CALLER UPON A4600038 RR* I/O COMPLETION OF THE REQUEST. A4600039 RR* A4600040 RR*S4 ENTRY/EXIT CONDITIONS A4600041 RR* --------------------- A4600042 RR*S3 THE ADDRESS OF THE PHYSICAL DEVICE TABLE IS PASSED VIA THE A4600043 RR* I-REGISTER AND THE MESSAGE CLASS IS SPECIFIED IN THE A-REGISTER A4600044 RR* ON ENTRY BY A RELATIVE 2-WORD RTJ TO ENTRY 'BFWRIT'. A4600045 RR* A-REG = 0, CLASS B A4600046 RR* A-REG = MESSAGE LENGTH, CLASS A (LENGTH.LE.40) A4600047 RR* A4600048 RR* UPON RETURN TO THE CALLER AFTER I/O COMPLETION OF THE MSOS FWRITEA4600049 RR* REQUEST, THE I-REGISTER IS RESTORED. BOTH A/Q-REGISTERS ARE A4600050 RR* DESTROYED. A4600051 RR* A4600052 RR*E ENTRY AND EQUATE SPECIFICATIONS A4600053 RR* ------------------------------- A4600054 RR*S3 ENTRY POINT A4600055 RR* A4600056 RR ENT BFWRIT A4600057 RR*S3 EQUATES A4600058 RR* A4600059 RR EQU PRLVL($EF) CALLER CURRENT RUNNING LEVEL A4600060 RR EQU AMONI($F4) MONITOR REQUEST ENTRY PROCESSOR ADDRESS A4600061 RR EQU ADISP($EA) MONITOR DISPATCHER ADDRESS A4600062 RR EQU ONE(3) LOCORE MASK = $0001 A4600063 RR EQU THREE(4) LOCORE MASK = $0003 A4600064 RR EQU ERSTAT(19) PHYSTB FILE MGR ERROR STATUS A4600065 RR EQU TIMTRY(20) DIAGNOSTIC POSTING (BIT15=0,DISABLED A4600066 RR* BIT15=1,ENABLED) A4600067 RR* FM REG CODE (BIT 12-9)=0, OPENFL A4600068 RR* =1, CLOSFL A4600069 RR* =2, READR A4600070 RR* =3, GETS A4600071 RR* =4, UPDREC A4600072 RR* =5, CREATE A4600073 RR* =6, RENAME A4600074 RR* =7, REDUCE A4600075 RR* =8, PUTS A4600076 RR* =9, DELETE A4600077 RR* =10-15, UNUSED A4600078 RR EQU JOBKEY(21) PHYSTB JOB NUMBER A4600079 RR EQU RTJCAL(24) MSOS FWRITE REQUEST A4600080 RR EQU IDATA(61) FILE MGR REQUEST PARAMETER 'IDATA' A4600081 RR EQU ISTAT(85) FILE MGR REQUEST PARAMETER 'ISTAT' A4600082 RR EQU RECBUF(86) FWRITE OUTPUT BUFFER A4600083 RR* A4600084 RR*S4 STRUCTURE OF FWRITE PHYSTB ROUTINE A4600085 RR* ---------------------------------- A4600086 RR*S3 STARTS AT PHYSTB INDEX 'RTJCAL' A4600087 RR* A4600088 RR EQU P2(RECBUF-RTJCAL-2) A4600089 RR EQU LVL(9) SET DUMMY RP, LP A4600090 RRENTRY NUM 0 PSEUDO RTJ ENTRY, CALLERS RETURN ADDRESS A4600091 RR RTJ- (AMONI) A4600092 RRFWRITE ADC $0D00+$10*LVL+LVL MERGED CURRENT LEVEL TO RP, CP A4600093 RR ADC ICMPL-FWRITE COMPLETION ADDRESS A4600094 RR NUM 0 REQUEST THREAD A4600095 RRLOGLU NUM $18FC STD COMMENT LU (ASCII MODE) A4600096 RRLNGTH NUM 0 I/O LENGTH SET BY 'BFWRIT' A4600097 RR ADC P2 MESSAGE OUTPUT BUFFER A4600098 RR JMP- (ADISP) EXIT DISPATCHER, AWAIT OUTPUT COMPLETION A4600099 RRICMPL LDA =N0 UPON OUTPUT COMPLETION, RESTORE I-REG TO A4600100 RR EQU PHYADR(ICMPL+1) PHYSTB ADDRESS A4600101 RR STA- I AND A4600102 RRCALXIT JMP* (ENTRY) RETURN TO BFWRIT CALLER WITH CALLER'S A4600103 RR EQU CALTH(CALXIT-ENTRY) I-REGISTER RESTORED, CALLER'S A4600104 RR**** A/Q-REGISTERS DESTROYED. A4600105 RR EJT A4600106 RR* ENTRY TO PROVIDE BATCH DRIVER MESSAGE LOGGING A4600107 RR* A4600108 RRBFWRIT NUM 0 CALLER'S RTN ADDR ON ENTRY A4600109 RR STA* LNGTH SAVE A-REG = MSG LENGTH (=0, CANNED MSG) A4600110 RR LDA* BFWRIT SAVE CALLER'S RTN ADDR A4600111 RR STA* ENTRY IN FWRITE CALL ROUTINE A4600112 RR* A4600113 RR LDA- I SAVE PHYSTB ADDRESS A4600114 RR STA* PHYADR IN FWRITE CALL ROUTINE. A4600115 RR* A4600116 RR LDA- PRLVL GET CURRENT (CALLER'S) RUNNING LEVEL A4600117 RR SFA* FWRITE,3,4 SET COMPLETION PRIORITY (CP) A4600118 RR SFA* FWRITE,7,4 SET REQUEST PRIORITY (RP) A4600119 RR SPC 2 A4600120 RR* BRANCH ON MESSAGE CLASS A4600121 RR LDA* LNGTH A4600122 RR SAZ BFWT20 A4600123 RR SPC 3 A4600124 RR* CLASS A MSG - OUTPUT BUFFER IN PHYSTB (RECBUF) PRESET A4600125 RR* BY CALL. OUTPUT LENGTH.LE.40 WORDS A4600126 RR* A4600127 RRBFWT01 SAM BFWT05 VERIFY POSITIVE LENGTH A4600128 RR INA -41 VERIFY LENGTH.LE.40 A4600129 RR SAM BFWT10 A4600130 RRBFWT05 ENA 40 INVALID LENGTH, A4600131 RR STA* LNGTH SET TO 40 WORDS. A4600132 RRBFWT10 JMP BFWT70 MOVE FWRITE TO PHYSTB AND XEQ IT A4600133 RR SPC 4 A4600134 RR* CLASS B MSG - VERIFY CONDITIONAL OUTPUT IS PERMISIVE A4600135 RR* A4600136 RRBFWT20 LDA- ERSTAT,I VERIFY THERE IS NON-ZERO A4600137 RR SAN BFWT25 FM ERROR STATUS. A4600138 RR JMP* (BFWRIT) NO - OMIT DIAG MESSAGE AND RETURN A4600139 RR* A4600140 RRBFWT25 LDA- TIMTRY,I VERIFY IF DIAGNOSTIC MESSAGE A4600141 RR SAM BFWT30 POSTING IS ENABLED. A4600142 RR JMP* (BFWRIT) NO - DIAG MSG POSTING DISABLED, RETURN A4600143 RR EJT A4600144 RR* STRUCTURE CANNED DIAGNOSTIC MESSAGE IN PHYSTB (RECBUF) A4600145 RR* ' JMNN FM RJT =$XXXX, REQTYP FILENAME/ USERNAME' A4600146 RR* A4600147 RRBFWT30 LDA- JOBKEY,I MOVE ASCII JOBKEY A4600148 RR STA* BFWT81 INTO DIAG MSG. A4600149 RR LDA- JOBKEY+1,I A4600150 RR STA* BFWT81+1 A4600151 RR* CONVERT'ERSTAT' TO ASCII AND MOVE TO DIAG MSG A4600152 RR ENA 0 INITIAL CHAR ADDR A4600153 RR XFA 1 REG 1. A4600154 RR LFA- ERSTAT,15,4,I GET HI-ORDER HEXDEC DIGIT A4600155 RR RTJ* HEXASC AND CONVERT TO ASCII, STORE IN DIAG MSG. A4600156 RR LFA- ERSTAT,11,4,I GET NEXT HEXDEC DIGIT A4600157 RR RTJ* HEXASC A4600158 RR LFA- ERSTAT,7,4,I A4600159 RR RTJ* HEXASC A4600160 RR LFA- ERSTAT,3,4,I GET LO-ORDER HEXDEC DIGIT A4600161 RR RTJ* HEXASC AND CONVERT TO ASCII, STORE IN DIAG MSG A4600162 RR* ENCODE REQTYP INTO DIAG MSG. A4600163 RR LFA- TIMTRY,12,4,I GET FM REQTYP CODE (BITS 12-9) A4600164 RR MUI- THREE CALC INDEX INTO 'REQTYP' ARRAY A4600165 RR TRA Q AND SAVE FOR INDEXING. A4600166 RR SUB* INVADR INSURE INDEX TO REQTPY DESCRIPTOR VALID A4600167 RR SAM BFWT40 A4600168 RR LDQ* INVADR NO - ENCODE BLANKS FOR INVALID CODE A4600169 RR* ENCODE ASCII REQTYP DESCRIPTOR A4600170 RRBFWT40 ENA 5 USE R1 FOR INDEX AND LOOP CONTROL A4600171 RR XFA 1 A4600172 RRBFWT45 LCA* REQTYP,1,Q MOVE DESCRIPTOR TO DIAG. MSG A4600173 RR SCA* BFWT83,1 A4600174 RR D1P *-BFWT45 A4600175 RR* MOVE FILENAME FROM PHYSTB TO DIAG MSG A4600176 RR ENQ 3 A4600177 RRBFWT50 LDA- IDATA,B IDATA(4) TO IDATA(1) A4600178 RR STA* BFWT84,Q A4600179 RR DQP *-BFWT50 A4600180 RR* MOVE USERNAME FROM PHYSTB TO DIAG MSG A4600181 RR ENQ 3 A4600182 RRBFWT55 LDA- IDATA+4,B IDATA(8) TO IDATA(5) A4600183 RR STA* BFWT85,Q A4600184 RR DQP *-BFWT55 A4600185 RR* A4600186 RR LDQ* DIALTH SET LENGTH OF DIAG. MSG A4600187 RR STQ* LNGTH IN FWRITE REQUEST A4600188 RR INQ -1 MOVE ENCODED DIAGNOSTIC MSG A4600189 RR* A4600190 RRBFWT60 LDA* BFWT80,Q TO OUTPUT BUFFER IN PHYSTB (RECBUF) A4600191 RR STA- RECBUF,B A4600192 RR DQP *-BFWT60 A4600193 RR EJT A4600194 RR* MOVE FWRITE ROUTINE TO PHYSTB AND XEQ IT A4600195 RR* A4600196 RRBFWT70 ENQ CALTH A4600197 RRBFWT72 LDA* ENTRY,Q A4600198 RR STA- RTJCAL,B A4600199 RR DQP *-BFWT72 A4600200 RRBFWT74 JMP- RTJCAL+1,I PERFORM PSEUDO RTJ TO PHYSTB ROUTINE A4600201 RR SPC 10 A4600202 RR* ROUTINE CONVERTS HEXDEC DIGIT IN LO-ORDER A-REG A4600203 RR* AND STORES INTO THE CHARACTER ADDRESS SPECIFIED A4600204 RR* BY REG 1. A4600205 RRHEXASC NUM 0 ENTRY A4600206 RR INA -10 CK IF DIGIT .LE.9 A4600207 RR SAM HEX01 A4600208 RR INA 7 NO - RESTORE DIGIT, ADD $37 A4600209 RRHEX01 INA $3A YES- RESTORE DIGIT, ADD $30 A4600210 RR SCA* BFWT82,1 STORE ASCII DIGIT INTO CHARACTER ADDRESS A4600211 RR AR1- ONE BUMP CHARACTER ADDRESS A4600212 RR JMP* (HEXASC) RETURN A4600213 RR EJT A4600214 RR* INTERNAL TABLES FOR DIAGNOSTIC MSG ENCODING A4600215 RR SPC 4 A4600216 RR* CANNED DIAGNOSTIC MESSAGE A4600217 RR* A4600218 RRBFWT80 ALF 1, BLANKS A4600219 RRBFWT81 ALF 2, ASCII 4-CHAR JOBKEY A4600220 RR ALF 5, FM RJT =$ A4600221 RRBFWT82 ALF 2, ASCII 4-CHAR 'ERSTAT' A4600222 RR ALF 1,, A4600223 RRBFWT83 ALF 4, ASCII 6-CHAR REQTYP + 2 BLANKS A4600224 RRBFWT84 ALF 4, ASCII 8-CHAR FILENAME A4600225 RR ALF 1,/ A4600226 RRBFWT85 ALF 4, ASCII 8-CHAR USERNAME A4600227 RR* A4600228 RRDIALTH ADC *-BFWT80 DIAGNOSTIC MESSAGE LENGTH A4600229 RR SPC 4 A4600230 RR* TABLE OF ASCII FM REQUEST TYPES A4600231 RR* A4600232 RRREQTYP ALF 3,OPENFL CODE = 0 A4600233 RR ALF 3,CLOSFL = 1 A4600234 RR ALF 3,READR = 2 A4600235 RR ALF 3,GETS = 3 A4600236 RR ALF 3,UPDREC = 4 A4600237 RR ALF 3,CREATE = 5 A4600238 RR ALF 3,RENAME = 6 A4600239 RR ALF 3,REDUCE = 7 A4600240 RR ALF 3,PUTS = 8 A4600241 RR ALF 3,DELETE = 9 A4600242 RR* INSERT ADDITIONS AFTER LAST ENTRY ABOVE A4600243 RRINVALD ALF 3, USE BLANK FOR INVALID REQTYP CODES A4600244 RRINVADR ADC INVALD-REQTYP A4600245 RR SPC 2 A4600246 RR END A4600247 RR NAM AUTOBT A47 A ITOS CCS 3.0 . SL-149A4700001 RR* AUTOMATIC DEFERRED BATCH PROCESSOR A4700002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 A4700003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A4700004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 A4700005 RR* A4700006 RR**** A4700007 RR*E A4700008 RR* FUNCTION A4700009 RR* -------- A4700010 RR* A4700011 RR* A4700012 RR* A4700013 RR* THIS PROCESSOR MONITORS FILE $$HOST FOR JOBS SUBMITTED FOR A4700014 RR* DEFERRED BATCH PROCESSING FROM AN ITOS USER TERMINAL. IF A4700015 RR* JOBS HAVE BEEN SUBMITTED AND PROCESSING IS NOT IN PROGRESS, A4700016 RR* IT IS INITIATED BY THIS PROCESSOR. A4700017 RR* A4700018 RR* A4700019 RR* A4700020 RR* A4700021 RR* A4700022 RR* GENERAL DESCRIPTION A4700023 RR* ------------------- A4700024 RR* A4700025 RR* A4700026 RR* A4700027 RR* READ THE $$HOST FILE. A4700028 RR* A4700029 RR* IF THE HOST IS SET TO A LU THEN, A4700030 RR* A4700031 RR* IF THE HOST IS NOT ACTIVE THEN, A4700032 RR* A4700033 RR* IF JOBS ARE QUEUED THEN, A4700034 RR* A4700035 RR* IF THE HOST TYPE IS LOCAL THEN, A4700036 RR* A4700037 RR* SIMULATE: MI A4700038 RR* *BATCH A4700039 RR* CHECK NEXT HOST. A4700040 RR* OTHERWISE, CHECK NEXT HOST (200UT AND HASP A4700041 RR* AUTOMATIC MODE IS NOT CURRENTLY IMPLEMENTED). A4700042 RR* A4700043 RR* OTHERWISE, SET CONTINUE TO MONITOR FLAG. A4700044 RR* A4700045 RR* OTHERWISE, CHECK NEXT HOST. A4700046 RR* A4700047 RR* OTHERWISE, CHECK NEXT HOST. A4700048 RR* A4700049 RR* IF THE CONTINUE TO MONITOR FLAG SET WHEN DONE THEN, A4700050 RR* A4700051 RR* MAKE A TIMER CALL FOR SELF AND RELEASE. A4700052 RR* A4700053 RR* OTHERWISE, RESET RUNNING FLAG AND RELEASE. A4700054 RR* A4700055 RR* A4700056 RR* A4700057 RR* A4700058 RR* A4700059 RR* ENTRY A4700060 RR* ----- A4700061 RR* A4700062 RR* A4700063 RR* A4700064 RR* ENTRY IS VIA A TIMER CALL FROM EITHER DBATIN OR FROM A4700065 RR* THE ROUTINE ITSELF. THERE ARE NO PARAMETERS PASSED. A4700066 RR* A4700067 RR* A4700068 RR* A4700069 RR* A4700070 RR* A4700071 RR* EXIT A4700072 RR* ---- A4700073 RR* A4700074 RR* A4700075 RR* A4700076 RR* IF ANY HOST IS NOT STOPPED AND IS NOT ACTIVE A TIMER A4700077 RR* CALL IS MADE FOR ITSELF AND THE ROUTINE IS RELEASED. A4700078 RR* OTHERWISE, THE ROUTINE ACTIVE FLAG IS RESET AND THE A4700079 RR* ROUTINE IS RELEASED. A4700080 RR* A4700081 RR* A4700082 RR* A4700083 RR* A4700084 RR* A4700085 RR* ENTRY POINTS A4700086 RR* ------------ A4700087 RR* A4700088 RR* A4700089 RR* A4700090 RR* NONE A4700091 RR* A4700092 RR* A4700093 RR* A4700094 RR* A4700095 RR* A4700096 RR* EXTERNAL REFERENCES A4700097 RR* ------------------- A4700098 RR* A4700099 RR* A4700100 RR* A4700101 RR EXT AUTOBT AUTOMATIC BATCH MODE ORDINAL A4700102 RR EXT* OPENFL FILE MANAGER OPEN FILE REQUEST A4700103 RR EXT* GETS FILE MANAGER GETS FILE REQUEST A4700104 RR EXT* CLOSFL FILE MANAGER CLOSE FILE REQUEST A4700105 RR EXT BAITOS CONCURRENT BATCH INDICATOR A4700106 RR EXT TSNABL ITOS ENABLED INDICATOR A4700107 RR EXT AUTON AUTO MODE IN SYSDAT: MINUS = NOT ALLOWED A4700108 RR* 0 = NOT ACTIVE A4700109 RR* 1 = ACTIVE A4700110 RR EXT MIB MANUAL INTERRUPT A4700111 RR EXT MIBX LOCK OUT FLAGS A4700112 RR EXT MIINP MI INPUT BFR IN SYSDAT A4700113 RR EXT JOBIND JOB PROCESSOR IN MEMORY FLAG A4700114 RR EXT SWTCH LIBEDT LOCK OUT SWITCH A4700115 RR EXT JOBSTR JOB PROCESSOR START IN MINT A4700116 RR* A4700117 RR* A4700118 RR* A4700119 RR* A4700120 RR* A4700121 RR* EQUATES A4700122 RR* ------- A4700123 RR* A4700124 RR* A4700125 RR* A4700126 RR EQU ONEBIT($23) A4700127 RR EQU AMONI($F4) MONITOR REQUEST ENTRY A4700128 RR EQU ADISP($EA) DISPATCHER A4700129 RR EQU PRLVL($EF) CURRENT PRIORITY LEVEL A4700130 RR EQU OPNBSY($6A23) OPEN FILE BUSY STATUS A4700131 RR EQU GTSBSY($6120) SET RECORD BUSY STATUS A4700132 RR EQU L(36) LENGTH OF MI BUFFER A4700133 RR EJT A4700134 RRAUT000 RTJ OPENFL OPEN THE $$HOST FILE A4700135 RR ADC (REQBUF-AUT000-2) A4700136 RR ADC (IDATA-AUT000-3) A4700137 RR ADC (ISTAT-AUT000-4) A4700138 RR LDA* ISTAT REQUEST STATUS A4700139 RR SAP AUT030 SKIP IF REQUEST NOT REJECTED A4700140 RR AND =XOPNBSY CHECK IF BUSY A4700141 RR SAN AUT010 SKIP IF REJECT A4700142 RR LDA* TIMTRY CHECK NUMBER OF REQUESTS TRIED A4700143 RR INA -11 MAX TRIES 127*5131A4700144 RR SAM AUT020 SKIP IF RETRY PERMITTED A4700145 RRAUT010 JMP AUTERR ERROR EXIT A4700146 RRAUT020 RTJ ATIMER DELAY A4700147 RR JMP* AUT000 RETRY A4700148 RRAUT030 ENA 0 CLEAR RECBUF A4700149 RR ENQ 27 A4700150 RRAUT040 STA RECBUF,Q 127*5131A4700151 RR DQP *-AUT040 A4700152 RR STA* TIMTRY CLEAR NUMBER OF TRYS A4700153 RRAUT050 RTJ GETS GET THE NEXT SEQUENTIAL RECORD A4700154 RR ADC (REQBUF-AUT050-2) A4700155 RR ADC (RECBUF-AUT050-3) A4700156 RR ADC (KEYVAL-AUT050-4) A4700157 RR ADC (ISTAT-AUT050-5) A4700158 RR LDA* ISTAT REQUEST STATUS A4700159 RR SAM AUT055 SKIP IF REJECT A4700160 RR JMP* AUT120 PROCESS THIS HOST A4700161 RRAUT055 AND =XGTSBSY CHECK IF BUSY A4700162 RR SAN AUT060 SKIP IF REJECT A4700163 RR LDA* TIMTRY CHECK NUMBER TRIED A4700164 RR INA -25 MAX TRIES 127*5131A4700165 RR SAP AUT065 SKIP IF EXCEEDED TRYS PERMITTED A4700166 RR RTJ ATIMER DELAY A4700167 RR JMP* AUT050 RETRY A4700168 RRAUT060 AND- ONEBIT+8 A4700169 RR SAN AUT070 SKIP IF END-OF-FILE A4700170 RR LDA* ERRFLG HAS ERROR MESSAGE ALREADY BEEN ISSUED 127*5131A4700171 RR SAN AUT070 YES 127*5131A4700172 RRAUT065 JMP AUTERR ERROREXIT A4700173 RRAUT070 RTJ CLOSFL EOF, ALL $$HOST RECORDS CHECKED, CLOSE FILE A4700174 RR ADC (REQBUF-AUT070-2) A4700175 RR ADC (ISTAT-AUT070-3) A4700176 RR LDA* ISTAT CHECK REQUEST STATUS A4700177 RR SAP AUT080 SKIP IF REQUEST NOT REJECTED A4700178 RR LDA* ERRFLG HAS ERROR MESSAGE ALREADY BEEN ISSUED 127*5131A4700179 RR SAZ AUT075 NO 127*5131A4700180 RR ENA 0 127*5131A4700181 RR STA+ AUTON 127*5131A4700182 RR JMP* AUT110 127*5131A4700183 RR* 127*5131A4700184 RRAUT075 JMP AUTERR ERROR EXIT 127*5131A4700185 RRAUT080 LDA* CTC CHECK CONTINUE TO CYCLE FLAG A4700186 RR SAN AUT090 SKIP IF CONTINUE A4700187 RR STA+ AUTON RESET AUTO MODE ACTIVE FLAG A4700188 RR JMP* AUT110 EXIT A4700189 RRAUT090 LDA- PRLVL TIMER REQUEST FOR SELF A4700190 RR SFA* AUT100,3,4 MERGE CPL IN TIMER REQUEST A4700191 RR RTJ- (AMONI) A4700192 RRAUT100 NUM $1020 DELAY IN 1 SEC UNITS/MERGED CPL A4700193 RR ADC (AUTOBT) SCHEDULE SELF A4700194 RR NUM 15 15 TIME UNIT DELAY A4700195 RRAUT110 RTJ- (AMONI) RELEASE AND DISP REQUEST A4700196 RR NUM $1901 REL ALLOC AND DISP A4700197 RR ADC (AUT000-AUT110-1) A4700198 RR EJT A4700199 RRAUT120 SFN* RECBUF+2,7,8 SKIP IF LU ASSIGNED TO HOST A4700200 RR JMP* AUT030 GET NEXT RECORD A4700201 RR SFZ* RECBUF+2,11,2 SKIP IF HOST NOT ACTIVE OR ABORTED A4700202 RR JMP* AUT030 GET NEXT RECORD A4700203 RR* CHECK THIS HOST FOR ANY QUEUED JOB 'NOT SENT' A4700204 RR ENA 14 SET WORD LOOP CONTROL A4700205 RR XFA 2 FOR ST01 TO ST99 A4700206 RR ENQ 0 SET Q FOR ST01-ST04 A4700207 RR* MAIN LOOP OVER R2 A4700208 RRAUT130 ENA 3 LOOP CONTROL OVER A4700209 RR XFA 1 4 STATUS 4-BIT BYTES A4700210 RR LDA* RECBUF+3,Q GET NEXT 4 BYTES A4700211 RR XFQ 3 SAVE INDEX TO RECBUF A4700212 RR* SECONDARY LOOP OVER 4 BYTES A4700213 RRAUT140 CLR Q ISOLATE NEXT STATUS A4700214 RR LLS 4 BYTE IN Q-REG A4700215 RR INQ -1 CK IF STNN=1 A4700216 RR SQZ AUT150 YES - INITIATE BATCH FOR HOST TYPE A4700217 RR D1P *-AUT140 SECONDARY LOOP, A-REG PRESERVED A4700218 RR XF3 Q NO - RESTORE INDEX A4700219 RR INQ 1 TO NEXT RECBUF A4700220 RR D2P *-AUT130 CK IF ST99 DONE A4700221 RR* THIS HOST HAS NO QUEUED JOBS A4700222 RR RAO* CTC AT PRESENT, SET CONTINUE TO A4700223 RR JMP* AUT030 CYCLE FLAG AND GET NEXT RECORD A4700224 RRAUT150 LFA* RECBUF+2,9,2 A4700225 RR TRA Q A4700226 RR JMP* AUTYP,Q A4700227 RRAUTYP JMP* LOCAL LOCAL BATCH PROCESSING A4700228 RR JMP* UT200 200UT SIMULATOR A4700229 RR JMP* HASP HASP WORK STATION SIMULATOR A4700230 RR JMP* AUT030 INVALID TYPE A4700231 RR EJT A4700232 RRTIMTRY NUM 0 FILE MANAGER REQUEST TRYS ATTEMPTED A4700233 RRCTC NUM 0 CONTINUE TO CYCLE AUTO BATCH MODE FLAG A4700234 RRERRFLG NUM 0 ERROR MESSAGE FLAG 127*5131A4700235 RR SPC 2 A4700236 RR* A4700237 RR* FILE MANAGER REQUEST BUFFERS A4700238 RR* A4700239 RRISTAT NUM 0 FILE MANAGWER STATUS A4700240 RRREQBUF BZS REQBUF(24) A4700241 RRIDATA ALF 4,$$HOST FILE NAME A4700242 RR ALF 4,$$ FILE OWNER A4700243 RR ALF 4,SYSVOL VOLUME NAME A4700244 RR NUM 0 ACCESS FOR RELATIVE RECORD RETRIEVAL A4700245 RR NUM 1 NUMBER OF RECORDS TO RETRIEVE PER REQUEST A4700246 RR NUM 0 NO FILE LOCKING A4700247 RRRECBUF BZS RECBUF(28) FILE MANAGER RETRIEVED RECORD A4700248 RRKEYVAL BZS KEYVAL(2) KEY VALUE IGNORED IF NOT RETRIEVE BY KEY A4700249 RR EJT A4700250 RR* A4700251 RR* PROVIDES DELAY FOR REQUST RETRY IF FILE FOUND LOCKED A4700252 RR* A4700253 RRATIMER NUM 0 ENTRY A4700254 RR LDA- PRLVL MERGE CURRENT PRIORITY LEVEL A4700255 RR SFA* TIMREQ,3,4 A4700256 RR RTJ- (AMONI) A4700257 RRTIMREQ NUM $1110 DELAY IN 0.1 SECS UNITS/MERGED CPL A4700258 RR ADC ICMPL-TIMREQ COMPLETION ADR A4700259 RR NUM 1 1 TIME UNIT DELAY A4700260 RR JMP- (ADISP) EXIT DISPATCHER, AWAIT TIME EXPIRATION A4700261 RRICMPL RAO* TIMTRY BUMP TALLY OF TIMER TRYS A4700262 RR JMP* (ATIMER) RETURN A4700263 RR EJT A4700264 RR* A4700265 RR* COMMON ERROR ROUTINE A4700266 RR* A4700267 RRAUTERR ENA 0 DISABLE AUTO MODE A4700268 RR STA* CTC A4700269 RR RAO* ERRFLG SET ERROR FLAG. 127*5131A4700270 RR LDA- PRLVL MERGE CPL IN RQST A4700271 RR SFA* ERR,3,4 A4700272 RR RTJ- (AMONI) ALERT OPERATOR AUTO MODE DISABLED A4700273 RRERR NUM $0D07 A4700274 RR ADC AUT070-ERR COMPLETION ATTEMPTS TO CLOSE FILE A4700275 RR ADC 0 A4700276 RR ADC $18FC A4700277 RR ADC 13 A4700278 RR ADC ERRM-ERR A4700279 RR JMP- (ADISP) A4700280 RR SPC 2 A4700281 RRERRM ALF 13, AUTO BATCH MODE DISABLED. A4700282 RR EJT A4700283 RR* A4700284 RR* 200UT SIMULATION PROCESSING A4700285 RR* NOT CURRENTLY IMPLEMENTED A4700286 RR* A4700287 RRUT200 JMP AUT030 GET NEXT HOST RECORD A4700288 RR SPC 2 A4700289 RR* A4700290 RR* HASP WORK STATION SIMULATION PROCESSING A4700291 RR* NOT CURRENTLY IMPLEMENTED A4700292 RR* A4700293 RRHASP JMP AUT030 GET NEXT HOST RECORD A4700294 RR SPC 2 A4700295 RR EJT A4700296 RR* A4700297 RR* LOCAL BATCH PROCESSING - SIMULATE MI, *BATCH A4700298 RR* A4700299 RRLOCAL LDA* ABITOS IS CONCURRENT BATCH ALLOWED A4700300 RR SAN AUT155 YES A4700301 RR LDA* (ATSNBL) NO, IS ITOS ENABLED A4700302 RR SAN AUT160 YES, DO NOT PROCESS LOCAL BATCH THIS CYCLE A4700303 RRAUT155 LDA* (MIBA) A4700304 RR ADD* (MIBXA) BOTH LOCK OUT FLAGS MUST BE ZERO A4700305 RR SAZ AUT165 A4700306 RRAUT160 JMP* AUT187 DO LOCAL HOST NEXT CYCLE A4700307 RR SPC 1 A4700308 RRAUT165 RAO* (MIBA) SET LOCK OUT FLAG A4700309 RR ENA -0 A4700310 RR ENQ L-1 A4700311 RRAUT170 STA* (MIBFAD),Q LOAD MI BFR WITH NULL CHARS A4700312 RR DQP *-AUT170 A4700313 RR ENQ 3 A4700314 RRAUT180 LDA* BATCH,Q MOVE *BATCH TO MI BUFFER A4700315 RR STA* (MIBFAD),Q A4700316 RR DQP *-AUT180 A4700317 RR LDA* (JOBI) CK IF JOB PROCESSOR IN MEMORY A4700318 RR SAZ AUT190 SKIP IF NOT A4700319 RRAUT185 ENA 0 RESET MI BUSY FLAG A4700320 RR STA* (MIBA) A4700321 RRAUT187 RAO CTC OTHERWISE, SET CONTINUE TO CYCLE FLAG A4700322 RR JMP AUT030 AND GET NEXT HOST RECORD A4700323 RRAUT190 LDA* (STH) CK JP LOCK OUT SWITCH A4700324 RR SAZ AUT200 SKIP IF NOT A4700325 RR JMP* AUT185 DO LOCAL HOST NEXT CYCLE A4700326 RRAUT200 LFA* RECBUF+2,7,8 LU OF LOCAL HOST INPUT A4700327 RR STA- $F9 IS STANDARD INPUT DEVICE A4700328 RR RTJ- (AMONI) A4700329 RR NUM $5207 SCHEDULE MINT JOBSTR ENTRY AT LEVEL 7 A4700330 RR ADC JOBSTR A4700331 RR JMP AUT030 GET NEXT HOST RECORD A4700332 RR SPC 2 A4700333 RRABITOS ADC BAITOS A4700334 RRATSNBL ADC TSNABL A4700335 RRMIBA ADC MIB A4700336 RRMIBXA ADC MIBX A4700337 RRMIBFAD ADC MIINP A4700338 RRJOBI ADC JOBIND A4700339 RRSTH ADC SWTCH A4700340 RRBATCH ALF 4,*BATCH,F A4700341 RR END A4700342 RR NAM COMINT A48 A ITOS CCS 3.0 SL-149A4800001 RR* COMM18 INITIALIZATION ROUTINE A4800002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 A4800003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A4800004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 A4800005 RR SPC 3 A4800006 RR* THIS PROGRAM PATCHES SYSDAT TO MODIFY IT FOR COMM18 USE. IT ALSO A4800007 RR* UNPATCHES SYSDAT UPON COMPLETION OF COMM18 USE. A4800008 RR SPC 3 A4800009 RR* ENTRY A4800010 RR* A = 1 INITIALIZE SYSDAT A4800011 RR* A = 0 UNPATCH SYSDAT A4800012 RR SPC 2 A4800013 RR* EXTERNALS A4800014 RR EXT PHYEQI FIRST PHYSTAB ADDRESS OF 1X2 CLA DRIVER A4800015 RR EXT AMINTX MINT ENTRY POINT FOR QMINTX ADDRESS PATCH A4800016 RR EXT QMINTX EXTENDED COMM18 MINT A4800017 RR EXT I8431S,C8431S,E8431S 1X2 CLA INT,CONT,ERROR ENTRIES A4800018 RR EXT INTRSP INTERRUPT RESPONS ROUTINE IN SYSDAT A4800019 RR EXT PHYTHD WORD NUMBER OF PHYSTAB THREAD WORD A4800020 RR EXT COMM18 COMM18 FLAG WORD IN SYSDAT A4800021 RR SPC 2 A4800022 RR* ENTRY POINTS A4800023 RR ENT COMINT INITIALIZE COMM18 A4800024 RR ENT COMUNP UNPATCH COMM18 A4800025 RR* A4800026 RR* A4800027 RR SPC 3 A4800028 RRCOMINT NOP 0 A4800029 RR SAN COMIN1 A4800030 RR JMP* COMUNP A4800031 RRCOMIN1 LDA* MICOMM PATCH QMINTX INTO MINT A4800032 RR STA AMINTX A4800033 RR SPC 3 A4800034 RR* A4800035 RR* PATCH INTERRUPT RESPONSE ROUTINE A4800036 RR* A4800037 RR LDA =N$1C00 A4800038 RR LDQ* RESPON A4800039 RR STA- (ZERO),Q A4800040 RR LDA PHYEQI A4800041 RR INA 2 A4800042 RR SUB* RESPON CAL. RELATIVE DISTANCE A4800043 RR INA -1 A4800044 RR STA- 1,Q A4800045 RR SPC 3 A4800046 RR* A4800047 RR* PATCH PHYSTABS WITH INIT,CONT., AND ERROR ENTRIES A4800048 RR LDQ PHYEQI A4800049 RRPHYLOP INQ 1 A4800050 RR LDA* ICLA A4800051 RR STA- (ZERO),Q A4800052 RR LDA* CCLA A4800053 RR STA- 1,Q A4800054 RR LDA* ECLA A4800055 RR STA- 2,Q A4800056 RR INQ -1 A4800057 RR ADQ PHYTHD PICKUP PHYSTAB THREAD ADDRESS TO SEE IF DONE A4800058 RR LDA- (ZERO),Q A4800059 RR TRA Q A4800060 RR SUB PHYEQI SEE IF ALL DONE A4800061 RR SAZ COMDON A4800062 RR JMP* PHYLOP A4800063 RR* A4800064 RRCOMDON STQ COMM18 SET COMM18 FLAG IN SYSDAT A4800065 RR JMP* (COMINT) A4800066 RR EJT A4800067 RRCOMUNP NOP 0 A4800068 RR LDA =N$14EA A4800069 RR STA INTRSP A4800070 RR LDA- $11 $7FFF A4800071 RR STA AMINTX PATCH OUT QMINTX IN MINT A4800072 RR ENQ 0 SET COMM18 NOT BUSY A4800073 RR JMP* COMDON A4800074 RR SPC 3 A4800075 RRICLA ADC I8431S A4800076 RRCCLA ADC C8431S A4800077 RRECLA ADC E8431S A4800078 RRMICOMM ADC QMINTX A4800079 RRRESPON ADC INTRSP A4800080 RR EQU ZERO($22) A4800081 RR END A4800082 RR MON 00001 RR SUBROUTINE SUBRCM(BUFR,RQTYPE,BLEN,RCODE,MASK,DTYPE) A5000001 RR 1 /A50 F ITOS CCS 3.0 SL-149A5000002 RRC ITOS TERMINAL MANAGER A5000003 RRC CREDIT COLLECTION SYSTEM VERSION 3.0ED SYSTEM VERSION 1.0 A5000004 RRC DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA A5000005 RRC COPYRIGHT CONTROL DATA CORPORATION 1979 A5000006 RRC A5000007 RR3 A5000008 RR INTEGER BUFR(1),RQTYPE,BLEN,RCODE,MASK,DTYPE A5000009 RR INTEGER GETCHR A5000010 RR INTEGER ERRBAS A5000011 RR* 122*4879A5000012 RR INTEGER CLRLEN,CLEN A5000013 RR DATA CLRLEN/0/ A5000014 RR EXTERNAL DATFMT A5000015 RR INTEGER DLOC(3),MLOC(3) A5000016 RR DATA DLOC/2,1,3/ A5000017 RR DATA MLOC/1,2,2/ A5000018 RR* 122*4879A5000019 RR DATA ERRBAS/90/ A5000020 RR INTEGER OLEN A5000021 RR INTEGER TERMLU A5000022 RR DATA TERMLU/0/ A5000023 RR* 122*4879A5000024 RR INTEGER RTYPEC(9),RTYPE A5000025 RR DATA NTYPES/9/ A5000026 RR DATA RTYPEC/1RS,1RT,1RA,1RR,1RP,1RC,1RF,1RN,1RB/ A5000027 RR* 122*4879A5000028 RR INTEGER CPOS,XPOS,YPOS A5000029 RR DATA CPOS/0/ A5000030 RR BYTE(XPOS,CPOS(15=8)),(YPOS,CPOS(7=0)) A5000031 RR INTEGER TC,TCODE(5) A5000032 RR DATA TCODE/1HO,1HN,1HC,1HL,1HR/ A5000033 RR INTEGER RESPCD(3) A5000034 RR DATA RESPCD/1HC,1HE,1HR/ A5000035 RR INTEGER UCHR(1),LCHR(1) A5000036 RR BYTE(UCHR,BUFR(15=8)),(LCHR,BUFR(7=0)) A5000037 RR. A5000038 RR* FIND REQUEST TYPE A5000039 RR1 A5000040 RR DO 10 RTYPE=1,NTYPES A5000041 RR IF(EOR(RQTYPE/$100,RTYPEC(RTYPE)).EQ.0) GO TO 20 A5000042 RR 10 CONTINUE A5000043 RR2 A5000044 RR* ILLEGAL REQUEST TYPE A5000045 RR1 A5000046 RR IERR=1 A5000047 RR GO TO 9900 A5000048 RR2 A5000049 RR* FOUND THE REQUEST TYPE, VECTOR TO PROCESSOR A5000050 RR1 A5000051 RR* 122*4879A5000052 RR* S T A R P C F N B A5000053 RR 20 GO TO (100,100,300,400,500,600,9990,300,700),RTYPE A5000054 RR* 122*4879A5000055 RR. A5000056 RR* REQUEST TYPE 'S' - OUTPUT BUFFER. CURSOR AT END +1 A5000057 RR* REQUEST TYPE 'T' - OUTPUT BUFFER. CURSOR TO X(0) OF NEXT LINE A5000058 RR1 A5000059 RR 100 CONTINUE A5000060 RR IF(BLEN.LT.1.OR.BLEN.GT.80) GO TO 9200 A5000061 RR CALL WTREAD(TERMLU,CPOS,BUFR,BLEN,0,0,0,0) A5000062 RR XPOS=XPOS+BLEN A5000063 RR IF(XPOS.LT.80) GO TO 110 A5000064 RR XPOS=XPOS-80 A5000065 RR YPOS=YPOS+1 A5000066 RR IF(YPOS.GE.24) YPOS=0 A5000067 RR 110 IF(RTYPE.NE.2) RETURN A5000068 RR XPOS=0 A5000069 RR YPOS=YPOS+1 A5000070 RR IF(YPOS.GE.24) YPOS=0 A5000071 RR RETURN A5000072 RR. A5000073 RR* REQUEST TYPE 'A' - INPUT BUFFER FROM TERMINAL A5000074 RR1 A5000075 RR 300 CONTINUE A5000076 RR IF(BLEN.LT.1.OR.BLEN.GT.80) GO TO 9200 A5000077 RR IFLAG=1 A5000078 RR ILEN=BLEN A5000079 RR IF(XPOS+BLEN.LE.80) GO TO 305 A5000080 RR IFLAG=2 A5000081 RR ILEN=80-XPOS A5000082 RR 305 LLOC=((ILEN+1)/2)+1 A5000083 RR LSAVE=BUFR(LLOC) A5000084 RR* 122*4879A5000085 RR IF(RTYPE.NE.8) GO TO 308 A5000086 RR OLEN=2 A5000087 RR ISTART=$8007 A5000088 RR* 122*4879A5000089 RR GO TO 310 A5000090 RR 308 OLEN=1 A5000091 RR ISTART=$0700 A5000092 RR 310 CALL WTREAD(TERMLU,-1,ISTART,OLEN,CPOS,BUFR,ILEN,TC) A5000093 RR JLEN=BUFR(LLOC) A5000094 RR BUFR(LLOC)=LSAVE A5000095 RR* 122*4879A5000096 RR IDTYPE=DTYPE+1 A5000097 RR* DTYPE = 0 1 2 3 A5000098 RR GO TO (328,312,315,320),IDTYPE A5000099 RR* ONLY 0 TO 9 ALLOWED A5000100 RR 312 DO 313 I=1,JLEN A5000101 RR ICHR=GETCHR(BUFR,I) A5000102 RR IF(ICHR.LT.1R0.OR.ICHR.GT.1R9) GO TO 305 A5000103 RR 313 CONTINUE A5000104 RR GO TO 328 A5000105 RR* FIELD MUST BE NON BLANK A5000106 RR 315 DO 316 I=1,JLEN A5000107 RR ICHR=GETCHR(BUFR,I) A5000108 RR IF(ICHR.NE.1R ) GO TO 328 A5000109 RR 316 CONTINUE A5000110 RR GO TO 305 A5000111 RR* FIELD MUST BE A VALID DATE A5000112 RR 320 IF(JLEN.NE.6) GO TO 305 A5000113 RR DO 321 I=1,6 A5000114 RR ICHR=GETCHR(BUFR,I) A5000115 RR IF(ICHR.LT.1R0.OR.ICHR.GT.1R9) GO TO 305 A5000116 RR 321 CONTINUE A5000117 RR ASSEM $C000,+DATFMT A5000118 RR+ LDA =XDATFMT A5000119 RR ASSEM $6400,+IFMT A5000120 RR+ STA+ IFMT A5000121 RR ILOC=MLOC(IFMT+1) A5000122 RR IF(BUFR(ILOC).LT.2H01.OR.BUFR(ILOC).GT.2H12) GO TO 305 A5000123 RR ILOC=DLOC(IFMT+1) A5000124 RR IF(BUFR(ILOC).LT.2H01.OR.BUFR(ILOC).GT.2H31) GO TO 305 A5000125 RR* 122*4879A5000126 RR 328 CONTINUE A5000127 RR* 122*4879A5000128 RR IF(TC.EQ.7) TC=2 A5000129 RR IF(TC.NE.8) GO TO 329 A5000130 RR TC=2 A5000131 RR BUFR(JLEN)=BUFR(JLEN)+$19 A5000132 RR IF(BUFR(JLEN).EQ.$49) BUFR(JLEN)=$7D A5000133 RR 329 CONTINUE A5000134 RR IF(TC.EQ.2.AND.JLEN.EQ.ILEN) TC=0 A5000135 RR* 122*4879A5000136 RR IF(TC.NE.0) GO TO 330 A5000137 RR RCODE=TCODE(IFLAG) A5000138 RR GO TO 340 A5000139 RR 330 RCODE=TCODE(TC+1) A5000140 RR 340 XPOS=XPOS+JLEN A5000141 RR IF(XPOS.LT.80) GO TO 350 A5000142 RR XPOS=XPOS-80 A5000143 RR YPOS=YPOS+1 A5000144 RR IF(YPOS.GE.24) YPOS=0 A5000145 RR 350 ISTART=JLEN+1 A5000146 RR* 122*4879A5000147 RR CLEN=CLRLEN A5000148 RR IF(CLEN.EQ.0) CLEN=BLEN A5000149 RR DO 355 I=ISTART,CLEN A5000150 RR* 122*4879A5000151 RR CALL PUTCHR($20,BUFR,I) A5000152 RR 355 CONTINUE A5000153 RR RETURN A5000154 RR. A5000155 RR* REQUEST TYPE 'R' - OUTPUT ERROR MESSAGE AND INPUT RESPONSE A5000156 RR1 A5000157 RR 400 CALL WTREAD(TERMLU,CPOS,BUFR,50,-1,RCODE,1,TC) A5000158 RR XPOS=XPOS+50 A5000159 RR IF(XPOS.LT.80) GO TO 410 A5000160 RR XPOS=XPOS-80 A5000161 RR YPOS=YPOS+1 A5000162 RR IF(YPOS.GE.24) YPOS=0 A5000163 RR 410 J=$8000 A5000164 RR DO 420 I=1,3 A5000165 RR J=J*2 A5000166 RR IF(AND(EOR(RCODE,RESPCD(I)),$FF00).EQ.0) GO TO 430 A5000167 RR 420 CONTINUE A5000168 RR GO TO 450 A5000169 RR 430 IF(AND(MASK,J).EQ.0) GO TO 450 A5000170 RR GO TO (9990,440,440),I A5000171 RR 440 XPOS=XPOS+1 A5000172 RR IF(XPOS.LT.80) RETURN A5000173 RR XPOS=XPOS-80 A5000174 RR YPOS=YPOS+1 A5000175 RR IF(YPOS.GE.24) YPOS=0 A5000176 RR RETURN A5000177 RR 450 CALL WTREAD(TERMLU,-1,$0708,2,CPOS,RCODE,1,TC) A5000178 RR GO TO 410 A5000179 RR2 A5000180 RR* REQUEST TYPE 'P' - POSITION CURSOR A5000181 RR1 A5000182 RR 500 XPOS=(UCHR(1)-$30)*10+(LCHR(1)-$30) A5000183 RR IF(XPOS.LT.0.OR.XPOS.GT.79) GO TO 9100 A5000184 RR YPOS=(UCHR(2)-$30)*10+(LCHR(2)-$30) A5000185 RR IF(YPOS.LT.0.OR.YPOS.GT.23) GO TO 9100 A5000186 RR RETURN A5000187 RR2 A5000188 RR* REQUEST TYPE 'C' - CLEAR SCREEN A5000189 RR1 A5000190 RR 600 CALL WTREAD(TERMLU,-1,$1800,1,-1,0,0,TC) A5000191 RR CPOS=0 A5000192 RR RETURN A5000193 RR* 122*4879A5000194 RR2 A5000195 RR* REQUEST TYPE 'B' - SET BUFFER CLEAR LENGTH A5000196 RR1 A5000197 RR 700 IF(BLEN.LT.0.OR.BLEN.GT.80) GO TO 9200 A5000198 RR CLRLEN=BLEN A5000199 RR RETURN A5000200 RR* 122*4879A5000201 RR. A5000202 RR* ERROR HANDLING SECTION A5000203 RR2 A5000204 RR* INVALID CURSOR POSITION A5000205 RR1 A5000206 RR 9100 CONTINUE A5000207 RR IF(XPOS.LT.0) IERR=2 A5000208 RR IF(XPOS.GT.79) IERR=3 A5000209 RR IF(YPOS.LT.0) IERR=4 A5000210 RR IF(YPOS.GT.23) IERR=5 A5000211 RR GO TO 9900 A5000212 RR2 A5000213 RR* INVALID BUFFER LENGTH A5000214 RR1 A5000215 RR 9200 CONTINUE A5000216 RR IERR=6 A5000217 RR IF(BLEN.GT.80) IERR=7 A5000218 RR GO TO 9900 A5000219 RR2 A5000220 RR* OUTPUT ERROR MESSAGE AND TERMINATE A5000221 RR1 A5000222 RR 9900 CONTINUE A5000223 RR IERR=IERR+ERRBAS A5000224 RR CALL SYSMSG(IERR,0) A5000225 RR 9990 CALL PGMOUT A5000226 RR END A5000227 RR MON 00001 RR NAM MINT M01 A ITOS CCS 3.0 SL-149M0100001 RR* MANUAL INTERRUPTS PROCESSOR M0100002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 M0100003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA M0100004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 M0100005 RR* M0100006 RR SPC 2 M0100007 RR* MANUAL INTERRUPTS PROCESSOR M0100008 RR ENT MINT M0100009 RR EQU MINT(*) M0100010 RR SPC 1 M0100011 RR SPC 1 M0100012 RR* THIS IS THE MANUAL INTERRUPT ROUTINE M0100013 RR* NO ATTEMPT IS MADE TO INTERRUPT REQUESTS IN PROGRESS M0100014 RR SPC 1 M0100015 RR ENT MI M0100016 RR ENT MIB M0100017 RR ENT MIBX M0100018 RR ENT RELFLE M0100019 RR ENT JOBSTR M0100020 RR ENT AMINTX ADDRESS LOCATION OF COMM18 QMINTX M0100021 RR EXT LSTOUT,STDINP M0100022 RR EXT BATLST,BATINP M0100023 RR EXT AUTF9,AUTFB M0100024 RR* E X T E R N A L S 116*4377M0100025 RR SPC 1 116*4377M0100026 RR EXT MIINP 'MI' INPUT BUFFER (IN 'SYSDAT') 116*4377M0100027 RR EXT BAITOS ITOS CONCURRENT BATCH FLAG M0100028 RR EXT TSNABL ITOS ENABLED FLAG M0100029 RR SPC 1 M0100030 RR EXT JOBIND M0100031 RR EXT FILE1 M0100032 RR EXT SWTCH M0100033 RR EXT JOBENT M0100034 RR EXT BATCLU 116*4377M0100035 RR EXT JBCNCL M0100036 RR EXT MIPRO M0100037 RR EXT LVLSTR,SWAPON,LEND M0100038 RR EXT RESTOR M0100039 RR EXT JPCHGE M0100040 RR EXT LOADIN LOADER IN CORE FLAG *444**** M0100041 RR EXT QMINTX EXTENDED MINT ROUTINE FOR COMM18 M0100042 RR EXT COMM18 M0100043 RR EXT TSAREA M0100044 RR SPC 1 116*4377M0100045 RR* S Y S T E M E Q U I V A L E N C E 116*4377M0100046 RR EQU MONIT($F4) LOCATION CONTAINS MONITOR ADDRESS 116*4377M0100047 RR EQU LPMSK(2) 116*4377M0100048 RR EQU ZERO($22) LOCATION CONTAINS ZERO 116*4377M0100049 RR EQU LOCORE($F7) LOW CORE STARTING ADDRESS 116*4377M0100050 RR EQU CREXTB($E9) LOCATION CONTAINS CORE EXTENDED TABLE 116*4377M0100051 RR EQU CHARSK($2A) CHARACTER * 116*4377M0100052 RR SPC 1 M0100053 RR EQU DISP($EA) M0100054 RR EQU L(36) BUFFER LENGTH **MSOS 4.0M0100055 RR EQU RP(1) M0100056 RR EQU HICORE($F6) M0100057 RR SPC 2 M0100058 RRMI LDA MIB M0100059 RR SAZ MIGO M0100060 RR JMP- (DISP) NOT ZERO, JUST GO AWAY 116*4377M0100061 RRMIGO RAO MIB M0100062 RR RTJ- (MONIT) OUTPUT 'MI' 116*4377M0100063 RR NUM $4CE3 M0100064 RR ADC $0,$0,$18FC,$2,MIOUT M0100065 RR ENA -0 M0100066 RR ENQ L-1 **MSOS 4.0M0100067 RRMI1 STA* (MIBFAD),Q 116*4377M0100068 RR INQ -1 M0100069 RR SQM MI2-*-1 M0100070 RR JMP* MI1 M0100071 RR SPC 1 M0100072 RRMI2 RTJ- (MONIT) INPUT STATEMENT 116*4377M0100073 RR NUM $48E7 116*4377M0100074 RR ADC MI2AX COMPLETION ADDRESS TO BE ENTERED 116*4377M0100075 RR* AT LEVEL 7 116*4377M0100076 RRTHR ADC $0,$18FD,L+1,MIINP **MSOS 4.0M0100077 RR EQU MIBFAD(*-1) 'MI' INPUT BUFFER ADDRESS 116*4377M0100078 RR RTJ- (MONIT) SCHEDULE DOWN TO 116*4377M0100079 RR NUM $5203 LEVEL 3. 116*4377M0100080 RR ADC MI2AA 116*4377M0100081 RR JMP- (DISP) 116*4377M0100082 RRMI2AA LDA* THR THIS LOOP RUNS AT LEVEL 3. ITS 116*4377M0100083 RR SAZ MI2AE PURPOSE IS TO INHIBIT THE BACKGROUND 116*4377M0100084 RR JMP* MI2AA PROGRAMS FROM EXECUTING UNTIL THE MI 116*4377M0100085 RRMI2AE JMP- (DISP) INPUT REQUEST IS COMPLETED 116*4377M0100086 RR* (AT LEVEL 7) 116*4377M0100087 RR SPC 2 116*4377M0100088 RR* THE INPUT REQUEST IS SATISFIED. 116*4377M0100089 RR* 116*4377M0100090 RRMI2AX SQP MI21 SKIP IF NO INPUT ERROR. 116*4377M0100091 RR JMP MI16 IGNORE INPUT AND EXIT. 116*4377M0100092 RRMI21 LDA* (MIBFAD) 116*4377M0100093 RR SUB* Z WAS A *Z ENTERED M0100094 RR SAZ MI3 YES, CONTINUE PROCESSING THE INPUT M0100095 RR LDA* MIBX NO, IS A REQUEST CURRENTLY IN PROCESS M0100096 RR SAZ MI22 NO, CONTINUE M0100097 RR JMP- (DISP) YES, IGNORE THE MANUAL INTERRUPT M0100098 RRMI22 LDA* (MIBFAD) NO, CONTINUE M0100099 RR ARS 8 M0100100 RR INA -CHARSK CHECK FOR '*' 116*4377M0100101 RR SAZ MI3-*-1 M0100102 RR JMP MI10 M0100103 RR* M0100104 RRACOM18 ADC COMM18 M0100105 RR SPC 2 M0100106 RRZ ALF 1,*Z M0100107 RRSTH ADC SWTCH M0100108 RR SPC 2 M0100109 RRMI3 LDA =XBAITOS PICK UP ITOS CONCURRENT BATCH FLAG M0100110 RR SAN MI31 SKIP IF CONCURRENT BATCH ALLOWED M0100111 RR LDA TSNABL PICK UP ITOS ENABLED FLAG M0100112 RR SAZ MI31 SKIP IF NOT ENABLED M0100113 RRMMMII JMP MI12 GO PRINT A JP05 ERROR MESSAGE M0100114 RRMI31 LDA* ACOM18 SEE IF COMM18 IN SYSTEM M0100115 RR EOR- LPMSK+15 M0100116 RR SAZ MI31A NOT IN SYSTEM M0100117 RR LDA* (ACOM18) SEE IF ACTIVE M0100118 RR SAZ MI31A M0100119 RR LDA- $F7 ACTIVE, SEE IF THEY USE THE SAME AREA TO RUN M0100120 RR INA 1 M0100121 RR SUB TSAREA M0100122 RR SAN MI31A GO AHEAD AND RUN BATCH M0100123 RR JMP* MMMII ERROR M0100124 RR* M0100125 RRMI31A LDA* (JOBI) M0100126 RR SAZ 1 IN CORE. M0100127 RR JMP* MI5 M0100128 RR LDA* (STH) CHECK JP LOCK-OUT SWITCH IF M0100129 RR SAZ NLO-*-1 LIBEDIT OR RECOVERY PROGRAM M0100130 RR LDA* (MIBFAD) CHECK IF *Z 116*4377M0100131 RR SUB* Z M0100132 RR SAZ NLA-*-1 M0100133 RR JMP* MI6 CK FOR *, *R, *K M0100134 RRNLA STA LOADIN CLEAR LOADER IN CORE FLAG *444*****M0100135 RR ENA 1 *444**** M0100136 RR STA* (STH) FLAG POSITIVE. M0100137 RR JMP* MI5AA GO CANCEL LIBEDT AS ANY OTHER JOB 116*4377M0100138 RRNLO EQU NLO(*) M0100139 RR LDA* (MIBFAD) 116*4377M0100140 RR SUB =A*R **MSOS 4.0M0100141 RRASTSKR EQU ASTSKR(*-1) 116*4377M0100142 RR SAN 2 **MSOS 4.0M0100143 RR LDQ* MIP LET AN *R THRU **MSOS 4.0M0100144 RR JMP* MI9B FOR FOREGROUND UNITS **MSOS 4.0M0100145 RR ENQ 2 116*4377M0100146 RRMORE LDA* (MIBFAD),Q 116*4377M0100147 RR SUB* BATCH,Q 116*4377M0100148 RR SAN ERR **MSOS 4.0M0100149 RR SQZ JOBSTR 116*4377M0100150 RR INQ -1 116*4377M0100151 RR JMP* MORE **MSOS 4.0M0100152 RRERR JMP* MI12 **MSOS 4.0M0100153 RRJOBSTR LDQ* MIBFAD SEE IF FILE OR LOCAL BATCH M0100154 RR LDA- 3,Q M0100155 RR SUB =A,F M0100156 RR TRA Q M0100157 RR SQN JOBST1 LOCAL BATCH M0100158 RR LDA =XBATINP SET BATCH DRIVER STANDARD INPUT M0100159 RR JMP* JOBST2 M0100160 RRJOBST1 LDA =XSTDINP SET LOCAL BATCH STD. INPUT M0100161 RR* M0100162 RRJOBST2 STA+ AUTF9 M0100163 RR SQN JOBST3 M0100164 RR LDA =XBATLST SET BATCH LIST STD. M0100165 RR JMP* JOBST4 M0100166 RRJOBST3 LDA =XLSTOUT SET LOCAL BATCH LIST STD. M0100167 RR* M0100168 RRJOBST4 STA+ AUTFB IN TRVEC M0100169 RR LDQ- $E9 127*5195M0100170 RR STA- 3,Q SET COSY STANDARD LIST 127*5179M0100171 RR* M0100172 RR LDQ- CREXTB M0100173 RR LDA- 11,Q TEST FOR AND SKIP IF SWAP NOT ALLOWED M0100174 RR SAN SJOB SWAPPING NOT ALLOWED M0100175 RR LDA- 10,Q TEST FOR AND SKIP IF UNPROTEC IN PART M0100176 RR SAZ JOBA PART 0 SWAPPED M0100177 RR RTJ- (MONIT) REQ FOR PARTITION 16 116*4377M0100178 RR ADC $6200 BEFORE CALLING IN **MSOS 4.0M0100179 RR ADC SJOB JOB PROCESSOR **MSOS 4.0M0100180 RR NUM 0,0 **MSOS 4.0M0100181 RR NUM 10 **MSOS 4.0M0100182 RR NUM 16 **MSOS 4.0M0100183 RR JMP- (DISP) **MSOS 4.0M0100184 RRJOBA RTJ- (MONIT) RELEASE PART 0 116*4377M0100185 RR NUM $1800 M0100186 RRRELSWP ADC 0 M0100187 RR SPC 2 M0100188 RR* THE JOB PROCESSOR IS NOW SCHEDULED BUT M0100189 RR* CANNOT RUN UNTIL THE SWAPPED AREA IS M0100190 RR* AVAILABLE AND THE LEVEL 2 LOOP IN THE M0100191 RR* SPACE DRIVER IS TURNED OFF. M0100192 RR SPC 2 M0100193 RRSJOB LDQ* MIP **MSOS 4.0M0100194 RR RTJ- (MONIT) SCHEDULE JOB PROCESSOR 116*4377M0100195 RR NUM $2400 PART 1 DIRECTORY SCHEDULE M0100196 RR ADC JOBENT **MSOS 4.0M0100197 RR JMP- (DISP) M0100198 RR SPC 1 M0100199 RRMIB NUM 0 **MSOS 4.0M0100200 RRMIBX NUM 0 **MSOS 4.0M0100201 RRJOBI ADC JOBIND **MSOS 4.0M0100202 RRMI5 LDA* (MIBFAD) CHECK IF *Z 122*4569M0100203 RR SUB* Z M0100204 RR SAN MI5A M0100205 RRMI5AA LDA- $FD SET CONTROL LU TO COMMENT DEVICE 116*4377M0100206 RR STA+ BATCLU 116*4377M0100207 RR RTJ- (MONIT) SCHEDULE JOB CANCEL 116*4377M0100208 RR NUM $5202 AT LEVEL TWO **MSOS 4.0M0100209 RR ADC JBCNCL M0100210 RR JMP* MI16 RESET MIB M0100211 RRMI5A LDA (MIBFAD) M0100212 RR EOR =A*K CHECK FOR *K STATEMENT M0100213 RR SAZ MI5B **MSOS 4.0M0100214 RR INA -8 *C **MSOS 4.0M0100215 RR SAN MI6 **MSOS 4.0M0100216 RRMI5B LDQ* MIP **MSOS 4.0M0100217 RR RAO* MIBX **MSOS 4.0M0100218 RR RTJ- (MONIT) 116*4377M0100219 RR NUM $2403 M0100220 RR ADC JPCHGE M0100221 RR JMP* MI16 **MSOS 4.0M0100222 RRMI6 LDA (MIBFAD) M0100223 RR EOR =X$2AFF CK FOR * CR M0100224 RR SAN MI9 M0100225 RR JMP* MI16 * CR - JUST CONTINUE M0100226 RRMI9 LDQ* MIP Q POINTS TO INPUT BUFFER M0100227 RR LDA (MIBFAD) M0100228 RR EOR* ASTSKR CHECK FOR RESTORE A DEVICE 116*4377M0100229 RR SAZ MI9B YES - SCHEDULE RESTOR M0100230 RR JMP* MI12 NO - J05 ERROR M0100231 RRMI9B RAO* MIBX SET LOCK OUT FLAG M0100232 RR RTJ- (MONIT) 116*4377M0100233 RR NUM $2403 M0100234 RR ADC RESTOR M0100235 RR JMP* MI16 EXIT M0100236 RRMIP ADC MIINP **MSOS 4.0M0100237 RR SPC 1 M0100238 RRMI10 LDA* AMINTX IS QMINTX PATCHED TO COMM18 M0100239 RR EOR- LPMSK+15 M0100240 RR SAZ MI11 NO, COMM18 IS NOT IN M0100241 RR RTJ+ QMINTX YES, TEST FOR SPECIAL COMM18 COMMANDS M0100242 RR EQU AMINTX(*-1) M0100243 RRMI11 LDA* AMIPRO SEE IF MIPRO IN SYSTEM M0100244 RR ADD- $32 8000 **MSOS 4.0M0100245 RR INA 0 M0100246 RR SAZ MI12-*-1 SKIP IF NOT PRESENT M0100247 RR LDQ* MIP M0100248 RR RAO* MIBX SET MIBX FLAG - RECOVER, MIPRO M0100249 RR RTJ- (MONIT) SCHEDULE PROCESSOR 116*4377M0100250 RR NUM $2447 116*4377M0100251 RRAMIPRO ADC MIPRO SYSTEM DIRECTORY ENTRY **MSOS 4.0M0100252 RR JMP* MI16 M0100253 RR SPC 1 M0100254 RRMI12 RTJ- (MONIT) NO PROCESSOR 116*4377M0100255 RR NUM $4C00 ERROR - JP05 **MSOS 4.0M0100256 RR ADC $0,$0,$18FC,$2 M0100257 RR ADC MI14 M0100258 RRMI16 ENA 0 M0100259 RR STA* MIB SET MI NOT BUSY M0100260 RR JMP- (DISP) M0100261 RR SPC 1 M0100262 RR* 116*4377M0100263 RR*---- KEY WORD, ADDRESSES AND STORAGE 116*4377M0100264 RR* 116*4377M0100265 RR SPC 1 116*4377M0100266 RRBATCH ALF 3,*BATCH **MSOS 4.0M0100267 RR* 1 CARD DELETED 116*4377M0100268 RRF1 ADC FILE1 M0100269 RRMI14 ALF 2,JP05 **MSOS 4.0M0100270 RRMIOUT NUM $184D M0100271 RR NUM $490D M0100272 RRALVLST ADC LVLSTR ADR OF START OF RP=0 ALLOCATABLE M0100273 RR ADC LEND ADR OF END OF ALLOCATABLE AREA M0100274 RR ADC SWAPON ADR OF UNPROTECTED INDICATOR M0100275 RRLVLSTV ADC 0 M0100276 RR EJT M0100277 RR* THIS ROUTINE IS ENTERED WHEN THE JOB PROCESSOR M0100278 RR* IS SIGNED OFF OR CANCELLED. M0100279 RR* THE JOB AREA IS MADE AVAILABLE TO THE M0100280 RR* PROTECTED PROGRAMS. THIS IS DONE BY M0100281 RR* FORCING A CORE-SWAP WHICH WILL NOT BE M0100282 RR* TERMINATED UNTIL THE JOB PROCESSOR IS M0100283 RR* REQUESTED AGAIN M0100284 RR* CORE SWAP IS NOT FORCED IN PART 0 IF **MSOS 4.0M0100285 RR* NOSWAP FLAG IS SET **MSOS 4.0M0100286 RR SPC 2 M0100287 RRRELFLE NOP 0 RELEASE ALL FILES ROUTINE M0100288 RR RAO* MIB SET MIB - LOCK OUT FOR MANUAL INTERRUPT M0100289 RR EIN 0 M0100290 RR ENQ 3 M0100291 RRRELFL0 LDA* (F1),Q RELEASE LAST FILE FIRST M0100292 RR SAZ RELFL1-*-1 IF ZERO, SKIP RELEASE M0100293 RR STA* RELFL M0100294 RR RTJ- (MONIT) RELEASE FILE 116*4377M0100295 RR NUM $1800 M0100296 RRRELFL NUM $0000 M0100297 RR ENA 0 M0100298 RR STA* (F1),Q ZERO FILE LOCATION M0100299 RRRELFL1 INQ -1 M0100300 RR SQM RELFL2-*-1 M0100301 RR JMP* RELFL0 M0100302 RRRELFL2 ENA 0 ZERO JP IN-CORE SWITCH. M0100303 RR STA* (JOBI) 116*4377M0100304 RR LDQ- CREXTB 116*4377M0100305 RR LDA- 11,Q M0100306 RR SAZ RELFL3 SKIP IF SWAP ALLOWED M0100307 RR JMP* MI16 NO SWAP ALLOWED M0100308 RRRELFL3 LDA- 10,Q M0100309 RR SAZ RELFL4 SKIP IF UNPROTECTED IN PART 0 M0100310 RR JMP* RELPRT UNPROTECTED IN PART 1 M0100311 RR SPC 2 M0100312 RR* FORCE A CORE SWAP M0100313 RR SPC 2 M0100314 RRRELFL4 ENQ RP SET REQUEST PRIORITY M0100315 RR LDA* (ALVLST),Q SAVE START OF ALLOCATABLE FOR THIS RP M0100316 RR STA* LVLSTV M0100317 RR LDA- HICORE M0100318 RR INA -5 M0100319 RR STA* (ALVLST),Q M0100320 RR RTJ- (MONIT) SPACE REQUEST 116*4377M0100321 RR ADC RP*16+$5403 61*1285 M0100322 RR ADC SWAPPD,0,0,0 LENGTH 0 M0100323 RR JMP- (DISP) M0100324 RR SPC 2 M0100325 RRSWAPPD LDA* LVLSTV SWAP COMPLETED M0100326 RR STQ RELSWP SAVE ADR FOR RELEASE **MSOS 4.0M0100327 RR ENQ RP M0100328 RR STA* (ALVLST),Q RESTORE LVLSTR + RP M0100329 RR JMP* MI16 RELEASE MIB AND EXIT M0100330 RR* **MSOS 4.0M0100331 RR* **MSOS 4.0M0100332 RRRELPRT LDA- LOCORE 116*4377M0100333 RR INA 1 **MSOS 4.0M0100334 RR STA* RELUP **MSOS 4.0M0100335 RR STA* RELUPA **MSOS 4.0M0100336 RR RTJ- (MONIT) 116*4377M0100337 RR ADC $5800 PARTITION CORE RELEASE M0100338 RRRELUP NUM 0 OF BACKGROUND **MSOS 4.0M0100339 RR RTJ- (MONIT) 116*4377M0100340 RR ADC $62F3 REQ OF PART 16 AT CP^2 **MSOS 4.0M0100341 RR ADC RELA WILL CAUSE PROTECT BITS **MSOS 4.0M0100342 RR NUM 0,0 TO BE SET, THEN PARTITION **MSOS 4.0M0100343 RR NUM 10 16 IS RELEASED FOR **MSOS 4.0M0100344 RR NUM 16 SYSTEM USE **MSOS 4.0M0100345 RR JMP- (DISP) 116*4377M0100346 RRRELA RTJ- (MONIT) 116*4377M0100347 RR ADC $5800 **MSOS 4.0M0100348 RRRELUPA ADC 0 **MSOS 4.0M0100349 RR JMP* MI16 **MSOS 4.0M0100350 RR END M0100351 RR NAM SPACE M02 A ITOS CCS 3.0 . SL-149M0200001 RR* SPACE REQUEST PROCESSOR, ALLOCATABLE SPACE AND RESTART M0200002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 M0200003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA M0200004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 M0200005 RR* M0200006 RR SPC 2 M0200007 RR ENT SPACE M0200008 RR EQU SPACE(*) M0200009 RR SPC 1 M0200010 RR SPC 1 M0200011 RR*********************************************************************** M0200012 RR* ENTRY POINTS M0200013 RR*********************************************************************** M0200014 RR ENT T10 SPACE REQUEST PROCESSOR M0200015 RR ENT STMSV4 START OF SPACE PROGRAM M0200016 RR ENT T17 PARTITION CORE REQUEST PROCESSOR M0200017 RR ENT AREAC TOTAL LENGTH OF ALLOCATABLE M0200018 RR ENT ALCLGH ALLOCATABLE CORE LENGTH TABLE M0200019 RR*********************************************************************** M0200020 RR* EXTERNALS M0200021 RR*********************************************************************** M0200022 RR EXT UBPROT LOCATION CONTAINS UPPER BOUND REGISTER DATA M0200023 RR EXT LBPROT LOWER M0200024 RR EXT UPBDTB UPPER BOUND REGISTER DATA TABLE BASE M0200025 RR EXT LOBDTB LOWER BOUND REGISTER DATA TABLE BASE M0200026 RR EXT CKTHRD CHECK THREAD FOR NON-ZERO ENTRY(RW SUB.) M0200027 RR EXT SAVLU ENTRY IN RW PROGRAM FOR SPACE PROCESSOR M0200028 RR EXT RPMASK REQUEST PRIORITY MASK M0200029 RR EXT LVLSTR LEVEL START TABLE M0200030 RR EXT LEND LOCATION CONTAINING END OF ALLOCATABLE M0200031 RR EXT CALTHD LOCATION CONTAINING NO. OF AVAIL ALLOCATABLE M0200032 RR EXT DTIMER DIAGNOSTIC TIMER PROGRAM M0200033 RR EXT IDLE IDLE PROGRAM M0200034 RR EXT DMICOD DEFINE MICRO-INTRPT CODE MP MSOSM0200035 RR EXT TBLADR ADT TABLE ADDRESS MP MSOSM0200036 RR EXT EMPSRT RESET/START FUNCTION CODE MP MSOSM0200037 RR EXT END0V4 LAST LOCATION IN PART 0 M0200038 RR EXT SYFAIL SYSTEM FAILURE ROUTINE M0200039 RR EXT MMLUTB MASS STORAGE LU TABLE M0200040 RR EXT MNTCHK MOUNT CHECKING ORDINAL M0200041 RR EXT UPTOD TIME OF DAY PROGRAM **MSOS 4.1**M0200042 RR EXT TMRTYP TIMER TYPE DESIGNATOR **MSOS 4.1**M0200043 RR EXT LOG1A TABLE OF P.D.T. ADDRESSES **MSOS 4.1**M0200044 RR EXT JOBENT INDEX TO JOBENT DIRECTORY ENTRY M0200045 RR EXT LIBEDT INDEX TO LIBEDT DIRECTORY ENTRY M0200046 RR EXT PROTEC INDEX TO PROTEC DIRECTORY ENTRY M0200047 RR EXT SYSLVL SYSTEM LEVEL (*S STATEMENT) M0200048 RR EXT K65T10 ENTRY TO PARTITION CORE DRIVER (PRTCDR) M0200049 RR EXT IUP STANDARD INPUT (TRVEC) M0200050 RR EXT INPTV4 INPUT UNIT FOR JOB PROCESSOR (TRVEC) M0200051 RR EXT AUTF9 AUTOLOAD STD INPUT (TRVEC) 86*2718M0200052 RR EXT AUTFA AUTOLOAD STD PUNCH (TRVEC) 86*2718M0200053 RR EXT AUTFB AUTOLOAD STD LIST (TRVEC) 86*2718M0200054 RR EXT N1,N2,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15 **MSOS 4.1**M0200055 RR EXT LSIZV4 OVERLAY LENGTH OF LIBEDT **MSOS 4.0M0200056 RR EXT PSIZV4 OVERLAY LENGTH OF PROTECT PROCESSOR **MSOS 4.0M0200057 RR EXT EFLOCK LOCK OUT LOGGER FLAG **MSOS 4.1**M0200058 RR EXT MIBX LOCK OUT MIPRO M0200059 RR EXT TDFUNC TIME/DATE FUNCTION ORDINAL **MSOS 4.1**M0200060 RR EXT SYSMON MONTH SYSTEM WAS LAST BUILT **MSOS 4.1**M0200061 RR EXT SYSDAY DAY SYSTEM WAS LAST BUILT **MSOS 4.1**M0200062 RR EXT SYSYER YEAR SYSTEM WAS LAST BUILT **MSOS 4.1**M0200063 RR EXT SYSID SYSTEM IDENTIFICATION BUFFER **MSOS 4.1**M0200064 RR EXT OUTPUT SWAP ROUTINE WRITE REQUEST (DCORE) 83*2390M0200065 RR EXT SPACE4 SPACE REQUEST TO UNSWAP (DCORE) 83*2390M0200066 RR EXT NOG30A SWAP ROUTINE READ REQUEST (DCORE) 83*2390M0200067 RR EXT REL RELEASE ROUTINE (DCORE) 83*2390M0200068 RR EXT SCH SCHEDULE ROUTINE (DCORE) 83*2390M0200069 RR EXT PTNALC SCHEDULE PRTCDR (PRTCDR) 83*2390M0200070 RR EXT PTNREL RELEASE PRTCDR (PRTCDR) 83*2390M0200071 RR EXT SPCEV4 PRT 16 PARTITION CORE REQ. (PRTCDR) 83*2390M0200072 RR EXT RDPTV4 PRT 16 SWAP AREA READ REQ. (PRTCDR) 83*2390M0200073 RR EXT OUTPV4 PRT 16 SWAP AREA WRITE REQ.(PRTCDR) 83*2390M0200074 RR EXT PCORE PHYSTAB FOR CORE DRIVER (SYSDAT) 83*2390M0200075 RR EXT P83310 UNIT 0 PHY. DEV. TBL. M0200076 RR*********************************************************************** M0200077 RR* EQUIVALENCES M0200078 RR*********************************************************************** M0200079 RR EQU LOCORE($F7) SYSTEM LOW CORE DATA M0200080 RR EQU HICORE($F6) SYSTEM HIGH CORE DATA M0200081 RR EQU LUCORE(1) LOGICAL UNIT OF CORE ALLOCATOR M0200082 RR EQU LABLEN(34) LENGTH OF VOLUME LABEL M0200083 RR EQU VR(3) RETURN IN VOLATILE M0200084 RR EQU VPL(4) PRIORITY IN VOLATILE M0200085 RR EQU ZERO($22) ZERO M0200086 RR EQU ONEBIT($23) M0200087 RR EQU ZROBIT($33) M0200088 RR EQU VTMP(7) TEMP IN VOLATILE M0200089 RR EQU LPMSK(2) M0200090 RR EQU AMONI($F4) M0200091 RR EQU FOUR($25) M0200092 RR EQU SYDIR($EB) M0200093 RR EQU H7FFF($11) M0200094 RR EJT M0200095 RR* VOLUME LABEL M0200096 RR EQU VLIFLG(0) VOLUME INITIALIZED FLAG M0200097 RR EQU VLNAME(2) VOLUME NAME M0200098 RR EQU VLNMBR(6) VOLUME NUMBER M0200099 RR EQU VLSER(7) VOLUME SERIAL M0200100 RR EQU VLSEC(12) VOLUME SECURITY CODE M0200101 RR EQU VLDATE(16) VOLUME CREATE DATE M0200102 RR EQU VLBMSM(20) BEGINNING OF MANAGEABLE SPACE (MSB) M0200103 RR EQU VLBMSL(21) BEGINNING OF MANAGEABLE SPACE (LSB) M0200104 RR EQU VLASDM(22) ALLOCATABLE SPACE DIRECTORY SECTOR (MSB) M0200105 RR EQU VLASDL(23) ALLOCATABLE SPACE DIRECTORY SECTOR (LSB) M0200106 RR EQU VLASDS(24) SIZE OF ALLOCATABLE SPACE DIRECTORY M0200107 RR EQU VLLBA(25) LARGEST BLOCK AVAILABLE(MSB) M0200108 RR EQU VLWPS(27) # WORDS/SECTOR M0200109 RR EQU VLFDD(28) ADDRESS OF FILE DIRECTORY M0200110 RR EQU VLMAXF(30) MAXIMUM NUMBER OF FILES M0200111 RR EQU VLCURF(31) CURRENT NUMBER OF FILES M0200112 RR EQU VLNFDB(32) NUMBER OF BLOCKS IN FILE DIRECTORY M0200113 RR EQU VLNXTB(33) NEXT AVAILABLE FILE DIRECTORY BLOCK M0200114 RR SPC 3 M0200115 RR* VOLUME INFORMATION TABLE M0200116 RR* M0200117 RR EQU VISLUN(2) SYSTEM LOGICAL UNIT NUMBER (BIT 15=1,NOT READYM0200118 RR* ACCESS VISLUN INDIRECTLY M0200119 RR EQU VINAME(1) VOLUME NAME - ASCII CHARACTERS 1 AND 2 M0200120 RR* VOLUME NAME - ASCII CHARACTERS 3 AND 4 M0200121 RR* VOLUME NAME - ASCII CHARACTERS 5 AND 6 M0200122 RR* VOLUME NAME - ASCII CHARACTERS 7 AND 8 M0200123 RR EQU VINMBR(5) VOLUME NUMBER - (2 ASCII CHARACTERS) M0200124 RR EQU VIBMSM(6) BEGINNING OF MANAGEABLE SPACE - MSB M0200125 RR EQU VIBMSL(7) BEGINNING OF MANAGEABLE SPACE - LSB M0200126 RR EQU VIASDM(8) AVAILABLE SPACE DIRECTORY ADDRESS - MSB M0200127 RR EQU VIASDL(9) AVAILABLE SPACE DIRECTORY ADDRESS - LSB M0200128 RR EQU VIASDS(10) # SECTORS IN AVAILABLE SPACE DIRECTORY M0200129 RR EQU VILBAM(11) LARGEST BLOCK OF SPACE AVAILABLE - MSB M0200130 RR EQU VILBAL(12) LARGEST BLOCK OF SPACE AVAILABLE - LSB M0200131 RR EQU VIWPS(13) WORDS/SECTOR FOR VOLUME M0200132 RR EQU VIFDDM(14) FILE DEFINITION DIRECTORY ADDRESS - MSB M0200133 RR EQU VIFDDL(15) FILE DEFINITION DIRECTORY ADDRESS - LSB M0200134 RR EQU VIMAXF(16) MAX. NUMBER OF FILES PERMITTED ON VOLUME M0200135 RR EQU VICURF(17) CURRENT NUMBER OF FILES EXISTING ON VOLUME M0200136 RR EQU VINFDB(18) NUMBER OF BLOCKS IN FILE DEFINITION DIRECTORY M0200137 RR EQU VINXTB(19) NEXT AVAILABLE BLOCK IF FILE DEF. DIRECTORY M0200138 RR EQU VINOOF(20) NUMBER OF OPEN FILES ON VOLUME M0200139 RR SPC 2 M0200140 RR* M0200141 RR* SMD PHYSICAL DEVICE TABLE EQUIVALENCES M0200142 RR* M0200143 RR EQU NUMHDS(49) NUMBER OF HEADS (5 OR 19) M0200144 RR EQU DRVSAK(68) DEVICE SELECT ACK. STATSU & MASK M0200145 RR SPC 1 M0200146 RR EQU DIFMSB($16) DIFFERENCE IN NO. OF MAX. SECTORS BETWEEN M0200147 RR EQU DIFLSB($4080) 50MB AND 180MB DRIVES M0200148 RR EQU NOHDS(19) NO. OF HEADS ON 180MB DRIVE M0200149 RR EJT M0200150 RR* M0200151 RR* RW REQUEST PROCESSOR MUST BE PRESENT M0200152 RR* FOR OPERATION OF THIS MODULE. M0200153 RR* M0200154 RR* LUCORE MUST BE EQUATED TO THE LOGICAL M0200155 RR* UNIT ASSIGNED TO THE CORE ALLOCATOR. M0200156 RR SPC 1 M0200157 RR EQU T17(*) **MSOS 4.0M0200158 RRT10 TRA Q M0200159 RR LDA- 8,I **MSOS 4.0M0200160 RR SAM COR1 SKIP IF INDIRECT REQ **MSOS 4.0M0200161 RR ENA 5 INCREMENT RETURN ADDRESS M0200162 RR* FOR DIRECT M0200163 RR ADD- VR,I CALL M0200164 RR STA- VR,I M0200165 RRCOR1 LDA- (ZERO),Q GET REQUEST PRIORITY M0200166 RR AND RPMASK M0200167 RR STA- VPL,I M0200168 RR RTJ CKTHRD CHK FOR ZERO THREAD LOC. M0200169 RR LDA- VTMP,I CHECK REQ CODE **MSOS 4.0M0200170 RR INA -10 **MSOS 4.0M0200171 RR SAZ CORZ SPACE REQUEST **MSOS 4.0M0200172 RR JMP K65T10 A PARTITIONED REQ **MSOS 4.0M0200173 RRCORZ ENQ LUCORE **MSOS 4.0M0200174 RR JMP SAVLU SET UP LU FOR ALLOCATOR M0200175 RR SPC 2 **MSOS 4.1**M0200176 RRTOIDLE ENQ 1 ENTER TIME/DATE Q CODE **MSOS 4.1**M0200177 RR SCHDLE (TDFUNC),4 **MSOS 4.1**M0200178 RR SCHDLE (MNTCHK),5 M0200179 RR JMP+ IDLE GO TO IDLE LOOP **MSOS 4.1**M0200180 RR SPC 2 M0200181 RR*********************************************************************** M0200182 RRAREAC ADC 0 TOTAL LENGTH OF ALLOCATABLE CORE M0200183 RR ADC ($7FFF) THREAD M0200184 RR*********************************************************************** M0200185 RR EJT M0200186 RR* THIS IS THE RESTART ROUTINE. ITS PURPOSE IS - M0200187 RR* M0200188 RR* 1. SET UP THE CORE ALLOCATION TABLE M0200189 RR* 2. PROTECT AND UNPROTECT APPROPRIATE CORE LOCATIONS M0200190 RR* 3. SET UP THE SYSTEM DIRECTORY ENTRY OF CERTAIN JOB M0200191 RR* PROCESSOR MODULES M0200192 RR* 4. START THE SYSTEM TIMER, AND INITIATE THE DIAGNOSTIC M0200193 RR* TIMER AND TIME-OF-DAY PROGRAMS M0200194 RR* 5. PRINT THE SYSTEM PSR LEVEL MESSAGE M0200195 RR* 6. REQUEST THAT THE PROGRAM PROTECT SWITCH BE ENABLED M0200196 RR* IF IT IS NOT M0200197 RR* 7. PRINT THE SYSTEM IDENTIFICATION M0200198 RR* 8. PRINT THE SYSTEM CORE SIZE MODE M0200199 RR* 9. PERFORM A VALIDITY CHECK ON THE SYSTEM FILES (IF ANY) M0200200 RR* 10. INITIATE A REQUEST FOR THE TIME AND DATE M0200201 RR* 11. TRANSFER CONTROL TO THE SYSTEM IDLE LOOP M0200202 RR SPC 2 M0200203 RR* SET UP THE CORE ALLOCATION TABLE M0200204 RR* M0200205 RRRESTRT LDA ALCLGH M0200206 RR INA 2 ALLOW ROOM FOR THREAD BETWEEN AREA 0-1 85*2565M0200207 RR STA ALCLGH M0200208 RRRST1 ENQ 15 M0200209 RR LDA =XAREAC M0200210 RRSETTBL INQ -1 SETUP ALLOCATION TABLE (LVLSTR) M0200211 RR STA- I M0200212 RR LDA ALCLGH,Q M0200213 RR SAZ CHKEND NO ALLOCATION, SEE IF DONE M0200214 RR INA 2 M0200215 RRCHKEND ADD- I M0200216 RR SQZ SETEND M0200217 RR STA LVLSTR,Q M0200218 RR JMP* SETTBL M0200219 RR EJT M0200220 RRSETEND INA 1 SETUP END OF PROTECTED ALLOCATABLE AREA M0200221 RR STA LEND M0200222 RR ENQ 10 M0200223 RR LDQ- ($E9),Q IS UNPROTECTED IN PART 1 M0200224 RR SQN FIX4 YES M0200225 RR JMP* FIX4Y NO M0200226 RRFIX4 TCA Q -(END OF ALLOCATABLE) TO Q M0200227 RR LDA =XEND0V4 ADDRESS OF LAST LOCATION IN PART 0 TO A M0200228 RR AAQ A COMPUTE # EXTRA LOCATIONS M0200229 RR SAP FIX4A SKIP IF EXTRA.GE.ZERO M0200230 RR JMP* NTENUF GO AWAY IF NOT ENOUGH ROOM M0200231 RRFIX4A SAZ FIX4X SKIP IF ZERO EXTRA MEMORY M0200232 RR LDQ =XALCLGH START OF LENGTH TABLE TO A M0200233 RR ADD- 3,Q ADD EXTRA TO REQUESTED AREA 4 M0200234 RR STA- 3,Q STORE BACK IN TABLE M0200235 RR JMP* RST1 SET UP ALLOCATABLE WITH NEW AREA 4 M0200236 RRFIX4X TCQ A SET A TO END OF ALLOCATABLE M0200237 RR JMP* SKIPIT M0200238 RRFIX4Y TRA Q IS THE SIZE OF ALLOCATABLE GREATER M0200239 RR SUB- $F7 THAN SPECIFIED BY THE INITIALIZER M0200240 RR SAM SKIPIT-1 NO M0200241 RR STQ- $F7 YES, SPECIFY THE NEW SIZE M0200242 RR STQ- $ED M0200243 RR TRQ A M0200244 RRSKIPIT SUB =XAREAC-1 M0200245 RR STA* AREAC SETUP TOTAL AVAILABLE PROTECTED ALLOCATABLE M0200246 RR STA CALTHD M0200247 RR STA MIBX LOCK OUT MIPRO M0200248 RR STA EFLOCK LOCK OUT LOGGER **MSOS 4.1**M0200249 RR JMP* INIT M0200250 RR EJT M0200251 RRNTENUF RTJ- (AMONI) PRINT INSUFFICIENT MEMORY MESSAGE M0200252 RR ADC $0C00 M0200253 RR ADC 0 M0200254 RRNTETHD ADC 0 M0200255 RR NUM $18FC M0200256 RR ADC NTEMSL M0200257 RR ADC NTEMSG M0200258 RR SPC 2 M0200259 RRNTEWAT LDA* NTETHD M0200260 RR SAZ 1 M0200261 RR JMP* NTEWAT WAIT FOR COMPLETION M0200262 RR RTJ SYFAIL KILL SYSTEM M0200263 RR SPC 2 M0200264 RRNTEMSG ALF *,INSUFFICIENT ALLOCATABLE MEMORY* M0200265 RRNTEMSL EQU NTEMSL(*-NTEMSG) M0200266 RR EJT 0 M0200267 RR* M0200268 RR* INITIALIZE ALL LOCATIONS ABOVE PHYSICAL LOCATION $FFFF M0200269 RR* M0200270 RR* M0200271 RR* 1. SET PAGE REGS 0-15 TO 0-15 BECAUSE M0200272 RR* THIS CODE IS IN THE LOWEST 32K OF MEMORY M0200273 RR* ---------- M0200274 RR* 2. GO TO PAGE MODE 0 M0200275 RR* 3. USE PAGE REG 16 TO INDEX PAGE (2K) TO WORK ON M0200276 RR* START WITH PAGE 127 (POSSIBLE LAST PAGE IN MACHINE) M0200277 RR* 4. WRITE $18FF TO ALL LOCATIONS IN CURRENT PAGE M0200278 RR* AND SET PROTECT BIT ON M0200279 RR* 5. DECREMENT PAGE NUMBER UNTIL ALL PAGES ABOVE $FFFF IN BOTH M0200280 RR* CPUS HAVE BEEN COVERED. M0200281 RR* IF A PAGE DOES NOT EXIST, THE WRITE OPERATION WILL M0200282 RR* BE ABORTED AND PARITY ERROR SET M0200283 RR* 6. GO TO ABSOLUTE MODE M0200284 RR* 7. SET UP PAGE REGS 16-31 TO CONTAIN 16-31. THUS M0200285 RR* PHYSICAL ADDRESS = LOGICAL ADDRESS FOR THE LOWEST 65K. M0200286 RR* M0200287 RRINIT APM 0 GO TO ABSOLUTE MODE M0200288 RR CLR A ASSUME THIS CODE IS IN THE LOWEST 32K OF M0200289 RR ENQ 15 MACHINE. THUS M0200290 RRSETUP WPR A FILL PAGE REGS 0-15 WITH 0-15 M0200291 RR* WRITE IN PAGE REG M0200292 RR ADD =N$0801 INCREMENT PAGE REG AND ITS CONTENT BY ONE M0200293 RR DQP *-SETUP M0200294 RR* M0200295 RR IIN 0 INHIBIT INTERRUPT FROM PARITY ERROR M0200296 RR PM0 0 GO TO PAGE MODE 0 M0200297 RR ENA $10 M0200298 RR ALS 11 USE PAGE REG $10 TO INDEX EACH PAGE M0200299 RR STA- I CURRENTLY BEING WRITTEN M0200300 RR INA $7F MAX PAGE IN MACHINE M0200301 RR XFA 1 REG 1 CONTAINS CURRENT PAGE (BITS 0-8) M0200302 RR* AND PAGE REG (BITS 10-15) M0200303 RR ENA $5F TOTAL NO. OF PAGES = 96 ($60) FROM PAGE 127 M0200304 RR* TO 31 (ALL LOCATIONS ABOVE PHYSICAL $FFFF) M0200305 RR XFA 2 M0200306 RR LDA LOC0 DATA TO WRITE IN REGISTER A ($18FF) M0200307 RRNXTPGE EQU NXTPGE(*) REPEAT M0200308 RR WPR 1 WRITE CURRENT PAGE IN PAGE REG $10 M0200309 RR LR3- LPMSK+11 TOTAL NO. OF LOCATIONS IN ONE PAGE = $800 M0200310 RR* (2K) M0200311 RR LDQ- I M0200312 RR ADQ- LPMSK+11 REG Q CONTAINS THE LOGICAL ADDRESS OF M0200313 RR* LOCATIONS IN PAGE, LAST LOCATION=$7FF M0200314 RRNXTLOC EQU NXTLOC(*) REPEAT M0200315 RR STA- (ZERO),Q WRITE 16 BIT DATA M0200316 RR SPB 0 SET PROTECT BIT TO ONE M0200317 RR INQ -1 DECREMENT LOGICAL ADDRESS BY ONE M0200318 RR D3P *-NXTLOC UNTIL ALL LOCATIONS IN A PAGE WERE WRITTEN M0200319 RR* ENDREPEAT M0200320 RR SB1- LPMSK+1 DECREMENT PAGE NUMBER BY ONE M0200321 RR D2P *-NXTPGE UNTIL ALL 96 PAGES HAS BEEN WRITTEN M0200322 RR* ENDREPEAT M0200323 RR SPE 0 CLEAR PARITY ERRORS WHICH MIGHT BE CAUSED BY M0200324 RR* WRITING INTO NON-EXISTING MEMORY M0200325 RR SPC 5 M0200326 RR* M0200327 RR* FILL PAGE REGS 16-31 WITH 16-31 SUCH THAT PHYSICAL ADDRESS M0200328 RR* =LOGICAL ADDRESS FOR LOWEST 65K OF MEMORY M0200329 RR* M0200330 RR APM 0 M0200331 RR ENQ 15 M0200332 RR LDA =N$8010 M0200333 RRSETUP1 WPR A M0200334 RR ADD =N$0801 M0200335 RR DQP *-SETUP1 M0200336 RR EJT M0200337 RR* PROTECT AND UNPROTECT APPROPRIATE CORE LOCATIONS M0200338 RR SPC 2 M0200339 RR LDQ- $F5 **MSOS 4.1**M0200340 RRSPBLOP SPB 0 PROTECT ALL OF AVAILABLE CORE **MSOS 4.0M0200341 RR SQZ CLRPB SKIP IF ALL UNPROTECTED **MSOS 4.0M0200342 RR INQ -1 **MSOS 4.0M0200343 RR JMP* SPBLOP **MSOS4.0*M0200344 RR* M0200345 RR*----- SPECIAL INSTRUCTION ON SETTING UPPER AND LOWER M0200346 RR*----- BOUND REGISTERS : M0200347 RR* (1) SET UPPER BOUND REGISTER TO ZERO -- TURN OFF M0200348 RR* BOUNDS M0200349 RR* (2) SET LOWER BOUND REGISTER, AND M0200350 RR* (3) SET UPPER BOUND REGISTER. M0200351 RR* M0200352 RRCLRPB IIN 0 DISABLE INTERRUPT M0200353 RR ENA 0 M0200354 RR LUB A M0200355 RR LDA- LOCORE M0200356 RR STA LBPROT M0200357 RR LLB A M0200358 RR LDA- HICORE M0200359 RR STA UBPROT M0200360 RR LUB A M0200361 RR LDA- LOCORE GET LOW CORE DATA AND SET FOR LOWER BOUND M0200362 RR ENQ 1 REGISTER DATA FOR TABLE M0200363 RR STA LOBDTB,Q LEVEL -1, 0 AND 1 LOWER BOUND REGISTER TABLE M0200364 RR EQU LOBDAD(*-1) M0200365 RR STA* (LOBDAD) INITIALIZATION M0200366 RR ENQ -1 M0200367 RR STA* (LOBDAD),Q M0200368 RR LDA- HICORE GET HI-CORE DATA M0200369 RR ENQ 1 INITIALIZE LEVEL -1, 0 AND 1 UPPER BOUND M0200370 RR STA UPBDTB,Q REGISTER TABLE DATA M0200371 RR EQU UPBDAD(*-1) M0200372 RR STA* (UPBDAD) M0200373 RR ENQ -1 M0200374 RR STA* (UPBDAD),Q M0200375 RR SPC 1 M0200376 RRRSTRT2 LDQ =N$F3 CLEAR SPECIAL COMMUNICATION AREA M0200377 RR CPB 0 M0200378 RR INQ $C M0200379 RR CPB 0 M0200380 RR INQ -$3A UNPROTECT FORTRAN AREA ($C5-$E5) M0200381 RRRSTRT3 CPB 0 M0200382 RR LDA =N$E5 M0200383 RR EAQ A M0200384 RR INQ 1 M0200385 RR SAZ 1 M0200386 RR JMP* RSTRT3 M0200387 RR LDQ- $F4 UNPROTECTED REQUEST ENTRY M0200388 RR CPB 0 POINT M0200389 RR SPC 1 M0200390 RR LDA- $F2 UNPROTECT PRESET LOCATIONS M0200391 RR STA- I M0200392 RR ENQ 2 M0200393 RRRSTRT4 TCQ A M0200394 RR ADD- $F1 LENGTH OF TABLE OF PRESETS M0200395 RR SAM RSTRT6 M0200396 RR STQ* RSTRT5 M0200397 RR LDQ- 1,B M0200398 RR CPB 0 M0200399 RR LDQ* RSTRT5 M0200400 RR INQ 4 M0200401 RR JMP* RSTRT4 M0200402 RR SPC 1 M0200403 RRRSTRT5 NUM 0 COUNTER M0200404 RR SPC 3 M0200405 RRRSTRT6 RTJ- (AMONI) CLEAR CRT SCREEN M0200406 RR ADC $0C00 M0200407 RR ADC 0 M0200408 RRCLRTHD ADC 0 M0200409 RR ADC $18FC M0200410 RR ADC 1 M0200411 RR ADC CLRSCR M0200412 RRCLRWAT LDA* CLRTHD M0200413 RR SAZ RSTRT7 M0200414 RR JMP* CLRWAT M0200415 RR SPC 1 M0200416 RRCLRSCR NUM $1800 M0200417 RR EJT M0200418 RR* SET UP SYSTEM DIRECTORY FOR JOBENT, LIBEDT, AND PROTEC M0200419 RR SPC 2 M0200420 RRSDJOB ADC JOBENT M0200421 RRSDLIB ADC LIBEDT M0200422 RRSDPRO ADC PROTEC M0200423 RRLOC0 ADC $18FF M0200424 RR SPC 2 M0200425 RRRSTRT7 LDQ- SYDIR M0200426 RR ADQ* SDJOB M0200427 RR ENA $10 SET PRIORITY OF JOBENT TO 1 M0200428 RR STA- (ZERO),Q M0200429 RR LDQ- SYDIR M0200430 RR ADQ* SDLIB SET LIMITS FOR INITIAL LOAD M0200431 RR LDA =XLSIZV4 LIBEDT LOAD LENGTH **MSOS 4.0M0200432 RR STA- (FOUR),Q **MSOS 4.1* M0200433 RR LDQ- SYDIR M0200434 RR ADQ* SDPRO SET LIMITS FOR INITIAL LOAD M0200435 RR LDA =XPSIZV4 PROTEC LOAD LENGTH **MSOS 4.0M0200436 RR STA- (FOUR),Q M0200437 RR LDA- $FB GET STANDARD LIST 86*2718M0200438 RR STA+ AUTFB SAVE IN TRVEC 86*2718M0200439 RR LDA- $FA GET STD PUNCH 86*2718M0200440 RR STA+ AUTFA SAVE IN TRVEC 86*2718M0200441 RR LDA- $F9 GET STANDARD INPUT **MSOS 4.0M0200442 RR STA+ AUTF9 SAVE IN TRVEC 86*2718M0200443 RR ADD- $2F ADD ASCII MODE **MSOS 4.0M0200444 RR STA IUP **MSOS 4.0M0200445 RR STA INPTV4 SET UP FOR JOB PROCESSOR INPUT **MSOS 4.0M0200446 RR EJT M0200447 RR* START THE SYSTEM TIMER M0200448 RR SPC 2 M0200449 RR* TIMER INITIATION CODING **MSOS 4.1**M0200450 RR* **MSOS 4.1**M0200451 RRTIMSRT LDQ DMICOD ENABLE ADT/MICRO INTERRUPT NUMBER M0200452 RR LDA+ TBLADR ADT TABLE ADDRESS MP MSOSM0200453 RR DMI 0 DEFINE MICRO INTERRUPT M0200454 RR LDQ+ EMPSRT RESET AND START FUNCTION CODE MP MSOSM0200455 RR OUT REJ-* M0200456 RR EJT **MSOS 4.1**M0200457 RR* INITIATE THE DIAGNOSTIC TIMER AND TIME-OF-DAY PROGRAMS M0200458 RR SPC 2 M0200459 RRCHKTMR LDA* RSTRTA M0200460 RR EOR- LPMSK+15 M0200461 RR SAN 1 M0200462 RR JMP* RSTRTT SKIP IF DTIMER NOT PRESENT **MSOS 4.1**M0200463 RR SPC 1 M0200464 RR RTJ- (AMONI) START DIAG TIMER M0200465 RR NUM $5206 ***MSOS4.0M0200466 RRRSTRTA ADC DTIMER M0200467 RR SPC 1 M0200468 RRRSTRTT LDA* TTRSTR **MSOS 4.1**M0200469 RR EOR- LPMSK+15 **MSOS 4.1**M0200470 RR SAN 1 SKIP IF TOD PRESENT **MSOS 4.1**M0200471 RR JMP* RSTRT9 **MSOS 4.1**M0200472 RR SPC 1 M0200473 RR RTJ- (AMONI) START TOD PROGRAM **MSOS 4.1**M0200474 RR NUM $5206 **MSOS 4.1**M0200475 RRTTRSTR ADC UPTOD **MSOS 4.1**M0200476 RR JMP* RSTRT9 **MSOS 4.1**M0200477 RR EJT M0200478 RR* TIMER REJECT MESSAGE M0200479 RR SPC 2 M0200480 RRREJ NOP 0 M0200481 RR LDQ =XLOG1A **MSOS 4.1**M0200482 RR LDQ- 1,Q **MSOS 4.1**M0200483 RR LDA- 13,Q **MSOS 4.1**M0200484 RR AND- LPMSK+15 **MSOS 4.1**M0200485 RR EOR- ONEBIT+15 DISABLE DELAYED CORE SWAPS **MSOS 4.1**M0200486 RR STA- 13,Q **MSOS 4.1**M0200487 RR ENA 0 INDICATE NO TIMER **MSOS 4.1**M0200488 RR STA+ TMRTYP **MSOS 4.1**M0200489 RR SPC 1 M0200490 RR RTJ- (AMONI) PRINT TIMER REJECT MSG M0200491 RR ADC $0C00 M0200492 RR ADC 0 M0200493 RRREJTH ADC 0 M0200494 RR ADC $18FC M0200495 RR ADC 6 M0200496 RR ADC REJMSG M0200497 RR SPC 1 M0200498 RRREJCK LDA* REJTH M0200499 RR SAZ 1 M0200500 RR JMP* REJCK WAIT FOR COMPLETION M0200501 RR JMP* RSTRT9 M0200502 RR SPC 2 M0200503 RRREJMSG ALF 6,TIMER REJECT **MSOS 4.1**M0200504 RR EJT M0200505 RR* M0200506 RR******* CLEAR POLL TABLE STATUS FOR SMD DRIVES M0200507 RR* M0200508 RR SPC 2 M0200509 RR EQU CLRSEK($701) CLEAR SEEK IN POLL TABLE M0200510 RR EQU CONCU($703) CU CONNECT CODE M0200511 RR EQU DIRFNC($708) DIRECTOR FUNCTION CODE M0200512 RR SPC 1 M0200513 RRCOUNTQ NUM 0 M0200514 RR SPC 1 M0200515 RRRSTRT9 ENA 0 M0200516 RR LDQ =XCONCU M0200517 RR OUT 1 CONNECT TO CU M0200518 RR NOP 0 M0200519 RR SOV *+1 M0200520 RR LDA =N$FF00 M0200521 RR STA* COUNTQ M0200522 RR LDQ =XDIRFNC M0200523 RRRSTR9A INP 1 READ DA STATUS M0200524 RR NOP 0 M0200525 RR ALS 13 M0200526 RR SAM RSTR9B SENSE CU CONNECTED M0200527 RR RAO* COUNTQ M0200528 RR SOV RSTR10 SENSE WAIT CU CONNECT EXPIRED M0200529 RR JMP* RSTR9A M0200530 RRRSTR9B SOV *+1 M0200531 RR LDA =N$7FF0 (SET TO LOOP 16 TIMES) M0200532 RR STA* COUNTQ M0200533 RR LDQ =XCLRSEK M0200534 RR ENA $60 M0200535 RRRSTR9C OUT 1 CLEAR SEEK PENDING/SEEKCOMPLETE M0200536 RR NOP 0 FROM POLL TABLE FOR EACH DRIVE M0200537 RR INA 1 M0200538 RR RAO* COUNTQ M0200539 RR SOV RSTR10 SENSE DONE M0200540 RR JMP* RSTR9C M0200541 RR EJT M0200542 RR* M0200543 RR****** THE FOLLOWING LOGIC MUST BE MANUALLY ENABLED AND DISABLED VIA M0200544 RR****** DEBUG BY SETTING OR RESETTING 'SMDFLG' FLAG. IT IS EXECUTED 1 M0200545 RR****** TIME AFTER INITIAL AUTOLOAD FOLLOWING ENABLING OF LOGIC. M0200546 RR****** ENABLING SHOULD BE DONE PRIOR TO TAKING DTLP OR EDTLP SO THAT M0200547 RR****** LOGIC IS EXECUTED FIRST TIME AUTOLOAD OCCURS AFTER DTLP IS M0200548 RR****** LOADED. IF ENABLED, THE LOGIC DOES THE FOLLOWING: M0200549 RR****** A) STATUS DRIVE FOR SELECT ACKNOWLEDGE STATUS M0200550 RR****** B) DETERMINE IF DRIVE IS 50MB OR 180MB M0200551 RR****** C) IF 50MB, DO NOTHING M0200552 RR****** IF 180MB, DO THE FOLLOWING: M0200553 RR****** 1) CHANGE PHY. DEV. TBL. FOR 180MB DRIVE M0200554 RR****** 2) ADD TO LENGTH OF AVAILABLE SPACE IN SYSVOL VOLUME M0200555 RR****** LABEL THE DIFFERENCE BETWEEN 50MB AND 180MB M0200556 RR****** MAX. SECTORS. M0200557 RR****** 3) UPDATE SAME VALUE IN VIT TABLE ON CORE IMAGE M0200558 RR****** 4) INCREASE LAST ENTRY IN ALLOCATABLE SPACE DIRECTORY M0200559 RR****** BY SAME DIFFERENCE. M0200560 RR* M0200561 RR SPC 2 M0200562 RRSMDFLG NUM 1 ENABLE/DISABLE FLAG M0200563 RR SPC 1 M0200564 RRRSTR10 LDA* SMDFLG M0200565 RR SAN RST10A SENSE SMD CONFIG LOGIC ENABLED M0200566 RR JMP* RS10AA M0200567 RR SPC 1 M0200568 RRRST10A LDQ =XCONCU M0200569 RR ENA 0 (SET FOR DRIVE 0/DRIVE STATUS) M0200570 RR OUT 1 CONNECT TO DRIVE(PRIVIOUS LOGIC CONNECTED CU) M0200571 RR NOP 0 M0200572 RR INP 1 READ SELECT ACKNOWLEDGE STATUS M0200573 RR NOP 0 M0200574 RR ALS 9 (BIT 6 = 1 MEANS 300MB DRIVE) M0200575 RR SAM RST10B SENSE 180MB DRIVE M0200576 RRRS10AA JMP RSTR11 DO NOTHING IF 50MB DRIVE M0200577 RR****** REDEFINE PHYSICAL DEVICE TABLE REQUIREMENTS M0200578 RRAP8331 ADC P83310 ADDR. OF SMD UNIT 0 PHY. DEV. TBL. M0200579 RRRST10B LDQ* AP8331 M0200580 RR ENA NOHDS M0200581 RR STA- NUMHDS,Q REDEFINE NO. OF HEADS M0200582 RR LDA =N$C0EF M0200583 RR STA- DRVSAK,Q REDEFINE DEVICE SELECT ACK. MASK M0200584 RR LDQ- $E9 CALC. WORD ADDRESS OF SMD UNIT 0 P. D. T. M0200585 RR LDA- 4,Q NO. OF HEADS WORD ON MM. M0200586 RR MUI =N96 M0200587 RR ADD* AP8331 M0200588 RR INA NUMHDS M0200589 RR STA* LSBNHD M0200590 RR LDA* AP8331 CALC. CORE ADDRESS OF NO. OF HEADS WORD M0200591 RR INA NUMHDS M0200592 RR STA* SNHDS M0200593 RR RTJ- (AMONI) WRITE CHANGED P. D. T. TO CORE IMAGE M0200594 RR NUM $4400 WRITE REQUEST M0200595 RR NUM 0 M0200596 RRTHDWM1 NUM 0 M0200597 RR NUM 8 LU M0200598 RR NUM 20 LENGTH(FROM NUMHDS TO DRVSAK) M0200599 RRSNHDS NUM 0 M0200600 RR NUM 0 MSB M0200601 RRLSBNHD NUM 0 LSB M0200602 RR SPC 1 M0200603 RR****** REDEFINE 'SYSVOL' VOLUME LABEL M0200604 RR SPC 1 M0200605 RR RTJ- (AMONI) READ IN VOLUME LABEL M0200606 RR NUM $4800 FREAD M0200607 RR NUM 0 M0200608 RRTHDR NUM 0 M0200609 RR NUM 8 LU M0200610 RR ADC LABLEN M0200611 RR ADC LABEL M0200612 RR NUM 0,0 M0200613 RRRST10C LDA* THDR M0200614 RR SAZ RST10D SENSE READ DONE M0200615 RR JMP* RST10C M0200616 RRRST10D LDA ALABEL M0200617 RR INA VLLBA M0200618 RR STA- I M0200619 RR LDQ- (ZERO),I M0200620 RR LDA- 1,I M0200621 RR ADQ* MSBDIF INCREASE AVAILABLE SPACE BY DIFERENCE M0200622 RR ADD* LSBDIF BETWEEN 50MB AND 180MB M0200623 RR SAP RST10E M0200624 RR INQ 1 M0200625 RR AND- H7FFF M0200626 RRRST10E STQ- (ZERO),I REDEFINE LENGTH OF ALLOCATABLE M0200627 RR STA 1,I FILE MANAGER SPACE M0200628 RR RTJ- (AMONI) WRITE BACK VOLUME LABEL M0200629 RR NUM $4C00 FWRITE M0200630 RR NUM 0 M0200631 RRTHDW NUM 0 M0200632 RR NUM 8 LU M0200633 RR ADC LABLEN M0200634 RR ADC LABEL M0200635 RR NUM 0,0 M0200636 RRRST10F LDA* THDW M0200637 RR SAZ RST10G SENSE WRITE DONE M0200638 RR JMP* RST10F M0200639 RR****** REDEFINE LENGTH OF AVAILABLE SPACE IN VIT TBL. ON CORE IMAGE. M0200640 RRRST10G LDQ- $E9 =ADDR. OF EXTENDED CORE TABLE M0200641 RR LDA- 4,Q =SECTOR ADDR. OF CORE IMAGE M0200642 RR MUI =N96 =WORD ADDR. OF CORE IMAGE M0200643 RR ENQ 1 M0200644 RR ADD* (AMLUT),Q =WORD ADDR. OF FM UNIT 0 VIT TBL. ON MM M0200645 RR INA VILBAM M0200646 RR STA* LSB1 M0200647 RR RTJ- (AMONI) WRITE REDEFINED LENGTH OF AVAILABLE SPACE M0200648 RR NUM $4400 (WRITE) TO VIT ON CORE IMAGE M0200649 RR NUM 0 M0200650 RRTHDW2 NUM 0 M0200651 RR NUM 8 LU M0200652 RR NUM 2 LENGTH M0200653 RR ADC LABEL+VLLBA M0200654 RR NUM 0 M0200655 RRLSB1 NUM 0 M0200656 RRRST10H LDA* THDW2 M0200657 RR SAZ RST10I SENSE WRITE DONE M0200658 RR JMP* RST10H M0200659 RR SPC 1 M0200660 RRAMLUT ADC MMLUTB ADDR. OF FM VECTOR TBL. TO VIT TBLS. M0200661 RRNUMENT ADC -96/4+1 NO. OF ENTRIES IN SEGMENT(ADJ. FOR OVRFLW CHK.M0200662 RRMSBDIF ADC DIFMSB (SEE EQUS) M0200663 RRLSBDIF ADC DIFLSB (SEE EQUS) M0200664 RR SPC 1 M0200665 RR****** REDEFINE LAST ENTRY IN ALLOCATABLE FILE SPACE DIRECTORY M0200666 RR****** TO INCREASE AVAILABLE SPACE BY DIFFERENCE BETWEEN 50MB AND M0200667 RR****** 180MB MAX. SECTORS. M0200668 RR SPC 1 M0200669 RRRST10I ENQ VLASDM GET SECTOR ADDR. OF MSB,LSB OF AVAIL. SPACE DRM0200670 RR LDA LABEL,Q M0200671 RR STA* ASDSEC M0200672 RR ENQ VLASDL M0200673 RR LDA LABEL,Q M0200674 RR STA* ASDSEC+1 M0200675 RR RTJ- (AMONI) READ A DIRECTORY SEGMENT(1 96 WD. SECTOR) M0200676 RR NUM $4800 FREAD M0200677 RR NUM 0 M0200678 RRTHDR2 NUM 0 M0200679 RR NUM 8 LU M0200680 RR NUM 96 M0200681 RR ADC DIRSEG M0200682 RRASDSEC NUM 0,0 MSB,LSB M0200683 RRRST10J LDA* THDR2 M0200684 RR SAZ RST10K SENSE READ DONE M0200685 RR JMP* RST10J M0200686 RR****** SCAN FOR LAST 4-WORD ENTRY(END FLAG = -1) M0200687 RRRST10K SOV 0 M0200688 RR LDA* NUMENT M0200689 RR STA- I M0200690 RR ENQ 0 M0200691 RRRST10L LDA DIRSEG,Q M0200692 RR SAM RST10P SENSE LAST ENTRY + 1 FOUND M0200693 RR INQ 4 M0200694 RR RAO- I M0200695 RR SOV RST10M SENSE LAST NOT FOUND IN SEGMENT M0200696 RR JMP* RST10L M0200697 RRRST10M RAO* ASDSEC+1 BUMP TO NEXT SEGMENT M0200698 RR ENQ VLASDS M0200699 RR LDA* ASDSEC+1 M0200700 RR SUB LABEL,Q -NO. OF SECTORS IN AVAIL. SPACE DIRECTORY M0200701 RR ENQ VLASDL M0200702 RR SUB LABEL,Q -ADDR. OF START OF AVAIL. SPACE DIR. M0200703 RR SAP RST10N SENSE END FLAG NOT FOUND IN DIRECTORY M0200704 RR JMP* RST10I GO BACK AND READ NEXT SEGMENT M0200705 RRRST10N JMP* RST10U M0200706 RR SPC 1 M0200707 RRRST10P INQ -4 M0200708 RR STQ- I M0200709 RR LDQ* DIRSEG,I M0200710 RR LDA* DIRSEG+1,I M0200711 RR ADQ* MSBDIF INCREASE AVAIL. SPACE BY DIFF.BETWEN 50MB&180MM0200712 RR ADD* LSBDIF M0200713 RR SAP RST10Q SENSE NO OVERFLOW M0200714 RR INQ 1 M0200715 RR AND- H7FFF M0200716 RRRST10Q STQ* DIRSEG,I M0200717 RR STA* DIRSEG+1,I M0200718 RR LDA* ASDSEC SET UP SECTOR ADDR. OF SEGMENT M0200719 RR STA* ASDSCW M0200720 RR LDA* ASDSEC+1 M0200721 RR STA* ASDSCW+1 M0200722 RR RTJ- (AMONI) WRITE SEGMENT BACK TO MM M0200723 RR NUM $4C00 FWRITE M0200724 RR NUM 0 M0200725 RRTHDW3 NUM 0 M0200726 RR NUM 8 LU M0200727 RR NUM 96 LENGTH M0200728 RR ADC DIRSEG M0200729 RRASDSCW NUM 0,0 MSB,LSB M0200730 RRRST10S LDA* THDW3 M0200731 RR SAZ RST10T SENSE WRITE DONE M0200732 RR JMP* RST10S M0200733 RRRST10T LDQ- $E9 (CALC. WORD ADDR. OF SMDFLG ON CORE IMAGE) M0200734 RR LDA- 4,Q M0200735 RR MUI =N96 M0200736 RR ADD =XSMDFLG M0200737 RR STA* LSBFLG M0200738 RR RTJ- (AMONI) CLEAR SMDFLG ON CORE IMAGE M0200739 RR NUM $4400 WRITE M0200740 RR NUM 0 M0200741 RRTHDW5 NUM 0 M0200742 RR NUM 8 LU M0200743 RR NUM 1 LENGTH M0200744 RR ADC ZERO M0200745 RR NUM 0 MSB M0200746 RRLSBFLG NUM 0 LSB M0200747 RRRST10X LDA* THDW5 M0200748 RR SAZ RST10Y SENSE WRITE DONE M0200749 RR JMP* RST10X M0200750 RRRST10Y JMP* RSTR11 GO TO NEXT LOGIC M0200751 RR SPC 2 M0200752 RRRST10U RTJ- (AMONI) PRINT FM SPACE DIRECTORY ERROR M0200753 RR NUM $0C00 M0200754 RR NUM 0 M0200755 RRTHDW4 NUM 0 M0200756 RR NUM $18FC M0200757 RR ADC SDELEN M0200758 RR ADC SDEMSG M0200759 RRRST10V LDA* THDW4 M0200760 RR SAZ RST10W M0200761 RR JMP* RST10V M0200762 RRRST10W RTJ SYFAIL KILL SYSTEM M0200763 RR SPC 1 M0200764 RRSDEMSG ALF *,FILE MGR. SPACE DIRECTORY ERROR* M0200765 RRSDELEN EQU SDELEN(*-SDEMSG) M0200766 RRDIRSEG BZS DIRSEG(96) AREA FOR AVAILABLE SPACE DIRECTORY SEGMENT M0200767 RR EJT M0200768 RR* PRINT THE SYSTEM PSR LEVEL AND DATE OF BUILD M0200769 RR SPC 2 M0200770 RRRSTR11 LDA MONTH M0200771 RR EOR- LPMSK+15 IS THE BUILD DATE PATCHED **MSOS 4.1**M0200772 RR SAN 1 **MSOS 4.1**M0200773 RR JMP* PSRMSG NO **MSOS 4.1**M0200774 RR LDA MONTH **MSOS 4.1**M0200775 RR ENQ $20 ADD LEADING SPACE **MSOS 4.1**M0200776 RR LLS 8 **MSOS 4.1**M0200777 RR INA $2F ADD TRAILING SLASH **MSOS 4.1**M0200778 RR STQ DATE+1 **MSOS 4.1**M0200779 RR STA DATE+2 FORM SYSTEM BUILD DATE **MSOS 4.1**M0200780 RR LDA DAY **MSOS 4.1**M0200781 RR STA DATE+3 **MSOS 4.1**M0200782 RR LDA YEAR **MSOS 4.1**M0200783 RR ENQ $2F ADD LEADING SLASH **MSOS 4.1**M0200784 RR LLS 8 **MSOS 4.1**M0200785 RR INA $20 ADD TRAILING SPACE **MSOS 4.1**M0200786 RR STQ DATE+4 **MSOS 4.1**M0200787 RR STA DATE+5 **MSOS 4.1**M0200788 RR SPC 1 M0200789 RRPSRMSG RTJ- (AMONI) PRINT THE MESSAGE **MSOS 4.1**M0200790 RR ADC $0C01 M0200791 RR ADC 0 M0200792 RRTX ADC 0 M0200793 RR ADC $18FC M0200794 RR ADC LSUMLV M0200795 RR ADC SUMLVL M0200796 RR SPC 1 M0200797 RRLTX LDA* TX M0200798 RR SAZ MAT100 M0200799 RR JMP* LTX WAIT FOR COMPLETION M0200800 RR EJT M0200801 RR************************************************************************M0200802 RR* *M0200803 RR* THIS CODE DETERMINES THE AMOUNT OF MEMORY INSTALLED IN THE *M0200804 RR* MACHINE. *M0200805 RR* IT THEN DETERMINES IF THE AMOUNT INSTALLED IS EQUAL TO OR *M0200806 RR* GREATER THAN THE MINIMUM AMOUNT NECESSARY TO RUN THE *M0200807 RR* CCS 2.0 APPLICATION PACKAGE. IF THERE IS INSUFFICIENT MEMORY, *M0200808 RR* A MESSAGE IS WRITTEN ON THE COMMENT DEVICE AND SYFAIL IS CALLED.*M0200809 RR* IF SUFFICIENT MEMORY EXISTS, THE MEMORY ALLOCATION TABLE IS *M0200810 RR* SET UP TO MATCH THE REAL MEMORY CONFIGURATION AND A MESSAGE *M0200811 RR* STATING THE AMOUNT OF MEMORY IN THE MACHINE IS WRITTEN ON THE *M0200812 RR* COMMENT DEVICE. *M0200813 RR* THE FOLLOWING RESTRICTIONS ARE PLACED ON THE CONSTRUCTION *M0200814 RR* OF THE XMAT TABLE IN SYSDAT: *M0200815 RR* *M0200816 RR* 1. ONLY TABLE ENTRIES = -1 ARE CANDIDATES TO BE UPDATED. *M0200817 RR* 2. THE FIRST PAGE OF REMOTE MEMORY MUST NOT BE REPRESENTED *M0200818 RR* IN THE SAME WORD AS THE LAST PAGE OF LOCAL MEMORY. *M0200819 RR* 3. THE FIRST PAGE OF REMOTE MEMORY IS REPRESENTED *M0200820 RR* IN A WORD DEFINED AS XMATR. *M0200821 RR* *M0200822 RR************************************************************************M0200823 RR SPC 2 M0200824 RR EXT XMAT MEMORY ALLOCATION TABLE, LOCAL BANK. M0200825 RR EXT XMATR MEMORY ALLOCATION TABLE, REMOTE BANK. M0200826 RR SPC 2 M0200827 RRMAT100 IIN 0 M0200828 RR ENQ 31 Q = 8K BLOCK NUMBER. M0200829 RRMAT110 RTJ SIZE FIND OUT IF THIS 8K BLOCK EXISTS. M0200830 RR STA MAT900,Q SAVE RETURNED FLAG. M0200831 RR SAN MAT120 SKIP IF NO PAGE REGISTER ERRORS HAVE OCCURRED.M0200832 RR JMP* MAT800 A PAGE REGISTER ERROR HAS OCCURRED. M0200833 RRMAT120 DQP *-MAT110 GO CHECK THE NEXT 8K BLOCK. M0200834 RR SPC 2 M0200835 RR ENQ 15 COUNT THE NUMBER OF 2K PAGES IN LOCAL BANK. M0200836 RRMAT200 LDA MAT900,Q M0200837 RR SAM MAT220 SKIP IF THIS 8K BLOCK NOT IN MACHINE. M0200838 RR ADD MAT901 M0200839 RR STA MAT901 UPDATE NUMBER OF 2K PAGES IN LOCAL BANK. M0200840 RR JMP* MAT250 CHECK NEXT 8K BLOCK. M0200841 RRMAT220 LDA MAT901 M0200842 RR SAM MAT250 SKIP IF CONTIGUOUS MEMORY IN LOCAL BANK. M0200843 RR JMP* MAT810 NONCONTIGUOUS MEMORY IN LOCAL BANK-ERROR. M0200844 RRMAT250 DQP *-MAT200 CHECK THE NEXT 8K BLOCK. M0200845 RR SPC 2 M0200846 RR ENQ 15 COUNT THE NUMBER OF 2K PAGES IN REMOTE BANK. M0200847 RRMAT260 LDA MAT900+16,Q M0200848 RR SAM MAT270 SKIP IF THIS 8K BLOCK IS NOT IN THE MACHINE. M0200849 RR ADD MAT902 M0200850 RR STA MAT902 UPDATE NUMBER OF 2K PAGES IN REMOTE BANK. M0200851 RR JMP* MAT280 CHECK THE NEXT 8K BLOCK. M0200852 RRMAT270 LDA MAT902 M0200853 RR SAM MAT280 SKIP IF CONTIGUOUS MEMORY IN REMOTE BANK. M0200854 RR JMP* MAT820 NONCONTIGUOUS MEMORY IN REMOTE BANK - ERROR. M0200855 RRMAT280 DQP *-MAT260 CHECK THE NEXT 8K BLOCK. M0200856 RR SPC 2 M0200857 RR LDA MAT901 M0200858 RR SUB MAT903 M0200859 RR SAP MAT310 SKIP IF SUFFICIENT LOCAL MEMORY. M0200860 RR JMP* MAT830 INSUFFICIENT LOCAL MEMORY. M0200861 RR SPC 2 M0200862 RRMAT310 LDA MAT902 M0200863 RR SUB MAT904 M0200864 RR SAP MAT320 SKIP IF SUFFICIENT REMOTE MEMORY. M0200865 RR JMP* MAT840 INSUFFICIENT LOCAL MEMORY. M0200866 RR EJT 0 M0200867 RR*********************************************************************** M0200868 RR* * M0200869 RR* UPDATE MEMORY ALLOCATION TABLE FOR * M0200870 RR* THE LOCAL BANK. * M0200871 RR* * M0200872 RR*********************************************************************** M0200873 RR SPC 2 M0200874 RRMAT320 LRI- ZERO I = 0 M0200875 RR LDQ MAT901 Q = NUMBER OF 2K PAGES IN LOCAL BANK. M0200876 RRMAT330 ADQ+ XMAT,I M0200877 RR SQM MAT350 SKIP IF XMAT UPDATE IS COMPLETE. M0200878 RR LDA+ XMAT,I M0200879 RR INA 1 M0200880 RR SAN MAT340 SKIP IF XMAT TABLE ENTRY IS NOT -1 M0200881 RR STA+ XMAT,I MARK THIS PAGE AVAILABLE. M0200882 RRMAT340 SQZ MAT350 SKIP IF XMAT UPDATE IS COMPLETE. M0200883 RR RAO- I M0200884 RR JMP* MAT330 CHECK NEXT ENTRY IN XMAT TABLE. M0200885 RR EJT 0 M0200886 RR*********************************************************************** M0200887 RR* * M0200888 RR* UPDATE MEMORY ALLOCATION TABLE * M0200889 RR* FOR THE REMOTE BANK. * M0200890 RR* * M0200891 RR*********************************************************************** M0200892 RR SPC 2 M0200893 RRMAT350 LRI- ZERO I = 0 M0200894 RR LDQ* MAT902 Q = NUMBER OF 2K PAGES IN REMOTE BANK. M0200895 RRMAT360 ADQ+ XMATR,I M0200896 RR SQM MAT380 SKIP IF XMATR UPDATE COMPLETE. M0200897 RR LDA+ XMATR,I M0200898 RR INA 1 M0200899 RR SAN MAT370 SKIP IF XMATR ENTRY IS NOT -1. M0200900 RR STA+ XMATR,I MARK THIS PAGE AVAILABLE. M0200901 RRMAT370 SQZ MAT380 SKIP IF XMATR UPDATE COMPLETE. M0200902 RR RAO- I M0200903 RR JMP* MAT360 CHECK NEXT ENTRY IN XMATR TABLE. M0200904 RR EJT 0 M0200905 RR*********************************************************************** M0200906 RR* * M0200907 RR* MEMORY ALLOCATION TABLE UPDATE SUCCESSFUL. PRINT * M0200908 RR* MEMORY CONFIGURATION MESSAGES. * M0200909 RR* * M0200910 RR*********************************************************************** M0200911 RR SPC 2 M0200912 RRMAT380 LDA* MAT901 A = NUMBER OF 2K PAGES IN LOCAL BANK. M0200913 RR ALS 2 M0200914 RR LDQ MES801 M0200915 RR RTJ BINDEC CONVERT LOCAL BANK MEMORY SIZE TO ASCII. M0200916 RR ENQ 1 M0200917 RR RTJ MESAGE WRITE LOCAL BANK MEMORY SIZE ON CONSOLE. M0200918 RR LDA* MAT902 A = NUMBER OF 2K PAGES IN REMOTE BANK. M0200919 RR ALS 2 M0200920 RR LDQ MES802 M0200921 RR RTJ BINDEC CONVERT REMOTE BANK MEMORY SIZE TO ASCII. M0200922 RR ENQ 2 M0200923 RR RTJ MESAGE WRITE REMOTE BANK MEMORY SIZE TO CONSOLE. M0200924 RR JMP CONFIG GO CONFIGURE MAG TAPES AND LINE PRINTERS. M0200925 RR SPC 2 M0200926 RR EJT 0 M0200927 RRMAT800 ENQ 5 PAGE REGISTER ERROR. M0200928 RR RTJ MESAGE M0200929 RR RTJ* (MAT905) HANG. M0200930 RR SPC 2 M0200931 RRMAT810 ENQ 6 NONCONTIGUOUS MEMORY IN THE LOCAL BANK. M0200932 RR RTJ MESAGE M0200933 RR RTJ* (MAT905) HANG. M0200934 RR SPC 2 M0200935 RRMAT820 ENQ 7 NONCONTIGUOUS MEMORY IN THE REMOTE BANK. M0200936 RR RTJ MESAGE M0200937 RR RTJ* (MAT905) HANG. M0200938 RR SPC 2 M0200939 RRMAT830 ENQ 3 INSUFFICIENT MEMORY IN LOCAL BANK. M0200940 RR RTJ MESAGE M0200941 RR LDA* MAT901 A = NUMBER OF 2K PAGES IN LOCAL BANK. M0200942 RR ALS 2 M0200943 RR LDQ MES808 M0200944 RR RTJ* BINDEC M0200945 RR ENQ 8 M0200946 RR RTJ MESAGE M0200947 RR LDA* MAT903 A = NUMBER OF PAGES REQUIRED IN LOCAL BANK. M0200948 RR ALS 2 M0200949 RR LDQ MES809 M0200950 RR RTJ* BINDEC M0200951 RR ENQ 9 M0200952 RR RTJ MESAGE M0200953 RR RTJ* (MAT905) HANG. M0200954 RR SPC 2 M0200955 RRMAT840 ENQ 4 INSUFFICIENT MEMORY IN THE REMOTE BANK. M0200956 RR RTJ MESAGE M0200957 RR LDA* MAT902 A = NUMBER OF 2K PAGES IN THE REMOTE BANK. M0200958 RR ALS 2 M0200959 RR LDQ MES808 M0200960 RR RTJ* BINDEC M0200961 RR ENQ 8 M0200962 RR RTJ* MESAGE M0200963 RR LDA* MAT904 A = NUMBER OF 2K PAGES REQUIRED IN REM BANK. M0200964 RR ALS 2 M0200965 RR LDQ MES809 M0200966 RR RTJ* BINDEC M0200967 RR ENQ 9 M0200968 RR RTJ* MESAGE M0200969 RR RTJ* (MAT905) HANG. M0200970 RRMAT900 BZS MAT900(32) 8K BLOCK EXISTANCE TABLE. M0200971 RRMAT901 NUM $FFFF NUMBER OF 2K PAGES IN THE LOCAL BANK. M0200972 RRMAT902 NUM $FFFF NUMBER OF 2K PAGES IN THE REMOTE BANK. M0200973 RRMAT903 NUM 48 MINIMUM NUMBER OF 2K PAGES IN THE LOCAL BANK. M0200974 RRMAT904 NUM 24 MINIMUM NUMBER OF 2K PAGES IN REMOTE BANK. M0200975 RRMAT905 ADC SYFAIL ADDRESS OF THE SYSTEM FAILURE ROUTINE. M0200976 RR EJT 0 M0200977 RR************************************************************************M0200978 RR* *M0200979 RR* THIS ROUTINE DETERMINES IF A PARTICULAR 8K BLOCK OF MEMORY *M0200980 RR* EXISTS IN THE MACHINE. A CYBER 18-30 HAS A MAXIMUM OF 32 8K *M0200981 RR* BLOCKS OF MEMORY = 256K WORDS IN THE MAXIMUM CONFIGURATION. *M0200982 RR* THE BLOCKS ARE NUMBERED 0 - 31. *M0200983 RR* *M0200984 RR* ENTRY *M0200985 RR* Q = BLOCK NUMBER *M0200986 RR* RTJ SIZE *M0200987 RR* *M0200988 RR* EXIT *M0200989 RR* A = -1 IF BLOCK DOES NOT EXIST. *M0200990 RR* A = 4 IF BLOCK DOES EXIST. (4 2K PAGES PER 8K BLOCK) *M0200991 RR* A = 0 IF A PAGE REGISTER ERROR HAS BEEN DETECTED. *M0200992 RR* *M0200993 RR************************************************************************M0200994 RR SPC 2 M0200995 RRSIZE 0 M0200996 RR STQ* SIZ900 SAVE THE 8K BLOCK NUMBER M0200997 RR TRQ A TRANSLATE 8K BLOCK M0200998 RR ALS 2 NUMBER TO 2K PAGE NUMBER. M0200999 RR INA 3 M0201000 RR STA* SIZ901 SAVE THE 2K PAGE NUMBER. M0201001 RR LDQ* SIZ902 PAGE REGISTER NUMBER TO Q15-Q11. M0201002 RR RPR Q READ OLD PAGE REGISTER VALUE. M0201003 RR AND- LPMSK+9 M0201004 RR STA* SIZ906 SAVE OLD PAGE REGISTER VALUE. M0201005 RR LDA* SIZ901 A = NEW PAGE REGISTER VALUE. M0201006 RR AAQ Q PAGE REGISTER VALUE TO Q08-Q00. M0201007 RR WPR Q WRITE INTO THE PAGE REGISTER. M0201008 RR LDQ* SIZ902 M0201009 RR RPR Q READ PAGE REGISTER VALUE BACK FROM PAGE REG. M0201010 RR AND- LPMSK+9 M0201011 RR STA* SIZ903 M0201012 RR CAE* SIZ901 SKIP IF REQ VALUE = ACTUAL VALUE. M0201013 RR JMP* SIZ800 PAGE REGISTER ERROR. M0201014 RR SPC 2 M0201015 RR* PAGE REGISTER IS WORKING OK. M0201016 RR PM0 0 SET PAGE MODE 0 M0201017 RR LR1* (SIZ904) SAVE CONTENT OF LOCATION TO BE TESTED. M0201018 RR LR2* (SIZ905) SAVE CONTENT OF LOCATION TO BE TESTED. M0201019 RR LDQ* SIZ901 Q = PAGE NUMBER (USED AS A PATTERN) M0201020 RR STQ* (SIZ904) STORE THE PATTERN. M0201021 RR SET A M0201022 RR STA* (SIZ905) PUT $FFFF ON THE DATA BUS. M0201023 RR LDA* (SIZ905) M0201024 RR LDA* (SIZ904) READ THE PATTERN FROM MEMORY TO A REGISTER. M0201025 RR SR1* (SIZ904) RESTORE THE TESTED LOCATION. M0201026 RR SR2* (SIZ905) RESTORE THE TESTED LOCATION. M0201027 RR EAQ A M0201028 RR APM RESTORE ABSOLUTE PAGE MODE. M0201029 RR SPE 0 CLEAR PARITY ERROR INDICATOR WHICH MIGHT M0201030 RR* GET SET WHEN WRITTING INTO NON-EXISTANT MEM. M0201031 RR LDQ* SIZ902 M0201032 RR ADQ* SIZ906 M0201033 RR WPR Q RESTORE OLD PAGE REGISTER VALUE. M0201034 RR SAZ SIZ100 SKIP IF THE 8K BLOCK OF MEMORY EXISTS. M0201035 RR ENA -1 THE MEMORY DOES NOT EXIST. M0201036 RR JMP* SIZ850 M0201037 RRSIZ100 ENA 4 THE MEMORY EXISTS. M0201038 RR JMP* SIZ850 M0201039 RRSIZ800 ENA 0 A PAGE REGISTER ERROR HAS OCCURRED. M0201040 RRSIZ850 LDQ* SIZ900 RESTORE Q. M0201041 RR JMP* (SIZE) RETURN. M0201042 RR SPC 2 M0201043 RRSIZ900 NUM 0 REQUESTED 8K BLOCK NUMBER. M0201044 RRSIZ901 NUM 0 2K PAGE NUMBER CORRESPONDING TO REQUESTED M0201045 RR* 8K BLOCK NUMBER. M0201046 RRSIZ902 NUM $8000 PAGE REGISTER 16 USED TO TEST MEMORY. M0201047 RRSIZ903 NUM 0 VALUE READ BACK FROM PAGE REGISTER. SHOULD M0201048 RR* EQUAL (SIZ901). M0201049 RRSIZ904 NUM $87FF LAST ADDRESS OF PAGE USED TO TEST REQUESTED M0201050 RR* 8K BLOCK OF MEMORY. M0201051 RRSIZ905 NUM $87FE AN ADDRESS IN THE TEST PAGE. M0201052 RRSIZ906 NUM 0 INITIAL PAGE REGISTER VALUE. M0201053 RR EJT 0 M0201054 RR*********************************************************************** M0201055 RR* * M0201056 RR* THIS ROUTINE CONVERTS A BINARY NUMBER INTO A DECIMAL * M0201057 RR* NUMBER IN ASCII FORMAT. * M0201058 RR* IT WILL CONVERT FOUR DIGITS. * M0201059 RR* ENTRY: * M0201060 RR* A = BINARY VALUE TO BE CONVERTED. * M0201061 RR* Q = ADDRESS OF OUTPUT BUFFER. * M0201062 RR* * M0201063 RR* EXIT: * M0201064 RR* THE FOUR CONVERTED DIGITS ARE STORED INTO * M0201065 RR* THE FIRST FOUR CHARACTERS OF THE OUTPUT BUFFER. * M0201066 RR* * M0201067 RR*********************************************************************** M0201068 RR SPC 2 M0201069 RRBINDEC 0 0 M0201070 RR STA* BIN101 SAVE VALUE TO BE CONVERTED. M0201071 RR STQ* BIN100 SAVE BUFFER BASE ADDRESS. M0201072 RR ENA 3 M0201073 RR XFA 1 SET UP TO CONVERT 4 DIGITS. M0201074 RRBIN010 LDA* BIN101 A = VALUE TO BE CONVERTED. M0201075 RR CLR Q M0201076 RR DVI* BIN102 DIVIDE BY 10. M0201077 RR STA* BIN101 M0201078 RR TRQ A M0201079 RR ADD* BIN103 ADD $30 TO MAKE AN ASCII DIGIT. M0201080 RR SCA* (BIN100),1 STORE CHARACTER INTO OUTPUT BUFFER. M0201081 RR D1P *-BIN010 CONVERT NEXT CHARACTER. M0201082 RR JMP* (BINDEC) RETURN. M0201083 RR SPC 5 M0201084 RRBIN100 NUM 0 OUTPUT BUFFER ADDRESS. M0201085 RRBIN101 NUM 0 VALUE TO BE CONVERTED. M0201086 RRBIN102 NUM 10 M0201087 RRBIN103 NUM $30 M0201088 RR EJT 0 M0201089 RR*********************************************************************** M0201090 RR* * M0201091 RR* THIS ROUTINE IS USED TO WRITE MESSAGES ON THE * M0201092 RR* SYSTEM CONSOLE CRT. IT HANGS ON THE I/O THREAD * M0201093 RR* UNTIL THE OUTPUT IS COMPLETE. * M0201094 RR* * M0201095 RR* ENTRY: * M0201096 RR* Q = MESSAGE NUMBER. * M0201097 RR* RTJ MESAGE * M0201098 RR* * M0201099 RR* EXIT: * M0201100 RR* RETURNS TO USER AFTER THE OUTPUT IS COMPLETE. * M0201101 RR* * M0201102 RR*********************************************************************** M0201103 RR SPC 2 M0201104 RRMESAGE 0 0 M0201105 RR LDA* MES800,Q M0201106 RR STA* MES020 SET UP THE ADDRESS OF THE OUTPUT BUFFER. M0201107 RR LDA* MES700,Q M0201108 RR STA* MES014 SET UP THE OUTPUT MESSAGE LENGTH. M0201109 RR SPC 2 M0201110 RR RTJ- (AMONI) M0201111 RR NUM $4C00 REQUEST = FORMAT WRITE. M0201112 RR NUM 0 COMPLETION. M0201113 RRMES010 NUM 0 THREAD M0201114 RR NUM $18FC LOGICAL UNIT. M0201115 RRMES014 NUM 0 OUTPUT MESSAGE LENGTH (PLUGGED). M0201116 RRMES020 NUM 0 BUFFER ADDRESS (PLUGGED). M0201117 RRMES025 LDA* MES010 M0201118 RR SAZ MES030 WAIT FOR THE THREAD TO CLEAR. M0201119 RR JMP* MES025 M0201120 RRMES030 JMP* (MESAGE) M0201121 RR EJT 0 M0201122 RRMES700 NUM 0 MESSAGE LENGTH TABLE. M0201123 RR ADC MES902-MES901 M0201124 RR ADC MES903-MES902 M0201125 RR ADC MES904-MES903 M0201126 RR ADC MES905-MES904 M0201127 RR ADC MES906-MES905 M0201128 RR ADC MES907-MES906 M0201129 RR ADC MES908-MES907 M0201130 RR ADC MES909-MES908 M0201131 RR ADC MES910-MES909 M0201132 RR ADC MES911-MES910 M0201133 RR ADC MES912-MES911 M0201134 RR SPC 4 M0201135 RRMES800 NUM 0 MESSAGE ADDRESS TABLE. M0201136 RRMES801 ADC MES901 M0201137 RRMES802 ADC MES902 M0201138 RRMES803 ADC MES903 M0201139 RRMES804 ADC MES904 M0201140 RRMES805 ADC MES905 M0201141 RRMES806 ADC MES906 M0201142 RRMES807 ADC MES907 M0201143 RRMES808 ADC MES908 M0201144 RRMES809 ADC MES909 M0201145 RRMES810 ADC MES910 M0201146 RRMES811 ADC MES911 M0201147 RR SPC 4 M0201148 RRMES901 ALF *,XXXXK BYTES OF MEMORY - CPU I.* M0201149 RRMES902 ALF *,XXXXK BYTES OF MEMORY - CPU II.* M0201150 RRMES903 ALF *,INSUFFICIENT MEMORY - CPU I.* M0201151 RRMES904 ALF *,INSUFFICIENT MEMORY - CPU II.* M0201152 RRMES905 ALF *,PAGE REGISTER ERROR.* M0201153 RRMES906 ALF *,NONCONTIGUOUS MEMORY - CPU I.* M0201154 RRMES907 ALF *,NONCONTIGUOUS MEMORY - CPU II.* M0201155 RRMES908 ALF *,XXXXK BYTES EXIST.* M0201156 RRMES909 ALF *,XXXXK BYTES ARE REQUIRED.* M0201157 RRMES910 ALF *,SYSTEM CONFIGURED FOR USE OF 1860-5 DUAL MODE MAG TAPES* M0201158 RR ALF *, (50 IPS DRIVES)* M0201159 RRMES911 ALF *,SYSTEM CONFIGURED FOR USE OF 1860-4 NRZI MAG TAPES* M0201160 RR ALF *, (25 IPS DRIVES)* M0201161 RRMES912 EQU MES912(*) M0201162 RR EJT 0 M0201163 RR*********************************************************************** M0201164 RR* * M0201165 RR* THIS CODE CONFIGURES THE SYSTEM FOR EITHER 1860-5 * M0201166 RR* DUAL MODE 50 IPS TAPES OR 1860-4 NRZI TAPES. * M0201167 RR* IF THE 1860-5 CONTROLLER RESPONDS TO A STATUS FUNCTION * M0201168 RR* THE SYSTEM WILL BE CONFIGURED FOR 1860-5 TAPES. IF AN * M0201169 RR* INTERNAL REJECT OCCURS WHEN STATUS IS TAKEN, THE * M0201170 RR* SYSTEM WILL BE CONFIGURED FOR 1860-4 TAPES. A MESSAGE * M0201171 RR* WILL BE WRITTEN ON THE CONSOLE ADVISING THE OPERATOR * M0201172 RR* WHICH TAPES HAVE BEEN CONFIGURED INTO THE SYSTEM. * M0201173 RR* * M0201174 RR*********************************************************************** M0201175 RR SPC 2 M0201176 RR EXT MT25U0 LOG1A LOCATION CONTAINING 1860-4 PHYSTAB ADD. M0201177 RR EXT MT25U1 LOG1A LOCATION CONTAINING 1860-4 PHYSTAB ADD. M0201178 RR EXT MT50U0 LOG1A LOCATION CONTAINING 1860-5 PHYSTAB ADD. M0201179 RR EXT MT50U1 LOG1A LOCATION CONTAINING 1860-5 PHYSTAB ADD. M0201180 RR SPC 2 M0201181 RRCONFIG LDQ MT50U0 Q = PHYSTAB ADDRESS OF 1860-5, UNIT 0. M0201182 RR LDQ- 7,Q Q = EQUIPMENT CODE OF 1860-5 MAG TAPE. M0201183 RR INQ $F M0201184 RR INP CON100-* READ STATUS TO SEE IF THE DEVICE EXISTS. M0201185 RR* NO REJECT, ASSUME IT DOES EXIST. M0201186 RRCON050 ENQ 10 M0201187 RR RTJ MESAGE WRITE 1860-5 CONFIGURATION MESSAGE. M0201188 RR JMP* CON900 CONTINUE PROCESSING. M0201189 RR SPC 2 M0201190 RRCON100 JMP* CON110 INTERNAL REJECT, ASSUME 1860-4 MAG TAPES. M0201191 RR JMP* CON050 EXTERNAL REJECT, ASSUME 1860-5 MAG TAPES. M0201192 RRCON110 ENQ 11 M0201193 RR RTJ MESAGE WRITE 1860-4 CONFIGURATION MESSAGE. M0201194 RR LDA MT25U0 SWAP THE PHYSTAB ADDRESSES IN LOG1A. M0201195 RR LDQ MT50U0 M0201196 RR STA MT50U0 M0201197 RR STQ MT25U0 M0201198 RR LDA MT25U1 M0201199 RR LDQ MT50U1 M0201200 RR STQ MT25U1 M0201201 RR STA MT50U1 M0201202 RR ENQ 11 M0201203 RR STA LOG1A,Q M0201204 RRCON900 NOP 0 CONTINUE WITH NORMAL RESTART PROCESSING. M0201205 RR JMP* A101M M0201206 RR EJT M0201207 RR* DETERMINE THE POSITION OF THE PROGRAM PROTECT SWITCH M0201208 RR SPC 2 M0201209 RRA101M IIN 0 **MSOS 4.1**M0201210 RRA101 LDA+ $101 SAVE THE CONTENTS OF THE TRAP 50*919 M0201211 RR STA* S101+1 50*919 M0201212 RRA102 LDA+ $102 50*919 M0201213 RR STA* S102+1 50*919 M0201214 RR TRM A SAVE THE CONTENTS OF 'M' 50*919 M0201215 RR STA* SM+1 50*919 M0201216 RR LDA =N$1400 SET UP RETURN 50*919 M0201217 RR STA* (A101+1) 50*919 M0201218 RR LDQ =XFAULT 50*919 M0201219 RR CPB 0 50*919 M0201220 RR ENA 1 50*919 M0201221 RR TRA M ALLOW ONLY A PP FAULT 50*919 M0201222 RR INQ 6 **MSOS 4.1**M0201223 RR STQ* (A102+1) 50*919 M0201224 RR EIN 0 51*919 M0201225 RRFAULT STQ* (A102+1) 50*919 M0201226 RR LDA* PPFLAG IS THIS FIRST PASS **MSOS 4.1**M0201227 RR SAZ HANGIT NO, HANG WAITING FOR PP SET **MSOS 4.1**M0201228 RR RAO* FLAGIT SET FLAG FOR SET PP MESSAGE **MSOS 4.1**M0201229 RR JMP* GOPP GO TO RESTORE PROTECT SETUP **MSOS 4.1**M0201230 RR SPC 3 M0201231 RRPPFLAG NUM 1 M0201232 RRFLAGIT NUM 0 M0201233 RR SPC 3 M0201234 RRHANGIT JMP* FAULT WAIT FOR PP FAULT **MSOS 4.1**M0201235 RRGOPP SPF 0 CLEAR PROTECT FAULT **MSOS 4.1**M0201236 RR INQ -6 **MSOS 4.1**M0201237 RR SPB 0 RETURN TO PRIOR STATUS 50*919 M0201238 RR EJT M0201239 RRS101 LDA =N0 50*919 M0201240 RR STA* (A101+1) 50*919 M0201241 RRS102 LDA =N0 50*919 M0201242 RR STA* (A102+1) 50*919 M0201243 RRSM LDA =N0 50*919 M0201244 RR TRA M 50*919 M0201245 RR EIN 0 50*919 M0201246 RR LDA* PPFLAG IS THIS FIRST TIME THROUGH **MSOS 4.1**M0201247 RR SAZ MOUNT SKIP IS SECOND PASS M0201248 RR LDA* FLAGIT IS THIS FIRST TIME BUT NEED MSG **MSOS 4.1**M0201249 RR SAZ MOUNT SKIP IF NO MESSAGE NEEDED M0201250 RR CLR A NEED TO SET PP **MSOS 4.1**M0201251 RR STA* PPFLAG SECOND TIME FLAG **MSOS 4.1**M0201252 RR SPC 1 M0201253 RR RTJ- (AMONI) WRITE PP MESSAGE **MSOS 4.1**M0201254 RR ADC $0C01 **MSOS 4.1**M0201255 RR ADC 0 **MSOS 4.1**M0201256 RRPPTH ADC 0 **MSOS 4.1**M0201257 RR ADC $18FC **MSOS 4.1**M0201258 RR ADC PPLEN M0201259 RR ADC PP **MSOS 4.1**M0201260 RR SPC 1 M0201261 RRPPWAIT LDA* PPTH **MSOS 4.1**M0201262 RR SAZ OUTPP **MSOS 4.1**M0201263 RR JMP* PPWAIT WAIT FOR COMPLETION **MSOS 4.1**M0201264 RROUTPP JMP* A101M GO WAIT FOR PP SET **MSOS 4.1**M0201265 RR EJT M0201266 RR* MOUNT THE SYSTEM VOLUME M0201267 RR SPC 3 M0201268 RRMOUNT ENQ 1 M0201269 RR LDQ* (AMMLUT),Q PICK UP ADDRESS OF VIT00 M0201270 RR STQ* AVIT00 SAVE FOR LATER M0201271 RR LDA* (AVIT00) PICK UP SYSTEM LU FROM VIT M0201272 RR AND- ZROBIT+15 DROP 'NOT MOUNTED' FLAG M0201273 RR STA* (AVIT00) STORE BACK M0201274 RR STA* MASLU SAVE IN READ REQUEST M0201275 RR RTJ- (AMONI) READ IN THE VOLUME LABEL M0201276 RR ADC $4800 FREAD M0201277 RR ADC 0 M0201278 RRTL ADC 0 M0201279 RRMASLU ADC 0 M0201280 RR ADC LABLEN M0201281 RR ADC LABEL M0201282 RR ADC 0 M0201283 RR ADC 0 M0201284 RRMNT1 LDA* TL PICK UP THREAD M0201285 RR SAZ MNT2 SKIP IF REQUEST COMPLETED M0201286 RR JMP* MNT1 WAIT FOR COMPLETION M0201287 RR SPC 2 M0201288 RR* MOVE VOLUME NAME AND NUMBER TO VIT M0201289 RR SPC 1 M0201290 RRMNT2 LDA* ALABEL PICK UP ADDRESS OF LABEL M0201291 RR INA VLNAME COMPUTE ADDRESS OF VOLUME NAME IN LABEL M0201292 RR STA* LPTR SAVE AS POINTER TO LABEL M0201293 RR LDA* AVIT00 PICK UP ADDRESS OF VIT00 M0201294 RR INA VINAME COMPUTE ADDRESS OF VOLUME NAME IN VIT M0201295 RR STA* VPTR STORE AS POINTER TO VIT M0201296 RR ENQ 4 M0201297 RRMNT3 LDA* (LPTR),Q PICK UP WORD FROM LABEL M0201298 RR STA* (VPTR),Q STORE IN VIT M0201299 RR INQ -1 DECREMENT COUNT M0201300 RR SQM MNT4 SKIP IF DONE M0201301 RR JMP* MNT3 GO BACK AND MOVE NEXT M0201302 RR EJT M0201303 RR* MOVE REST OF INFO FROM LABEL TO VIT M0201304 RR SPC 1 M0201305 RRMNT4 LDA* ALABEL PICK UP ADDRESS OF LABEL M0201306 RR INA VLBMSM COMPUTE ADDRESS OF NEXT BLOCK TO BE MOVED M0201307 RR STA* LPTR SAVE AS POINTER TO LABEL M0201308 RR LDA* AVIT00 PICK UP ADDRESS OF VIT00 M0201309 RR INA VIBMSM COMPUTE ADDRESS IN VIT M0201310 RR STA* VPTR SAVE AS POINTER TO VIT M0201311 RR ENQ 13 M0201312 RRMNT5 LDA* (LPTR),Q PICK UP WORD FROM LABEL M0201313 RR STA* (VPTR),Q STORE INTO VIT M0201314 RR INQ -1 DECREMENT COUNTER M0201315 RR SQP MNT6 SKIP IF NOT DONE M0201316 RR JMP* OUTID M0201317 RRMNT6 JMP* MNT5 GO BACK AND MOVE ANOTHER WORD M0201318 RR SPC 3 M0201319 RRAMMLUT ADC MMLUTB ADDRESS OF MASS MEMORY LU TABLE M0201320 RRAVIT00 ADC 0 ADDRESS OF VIT00 M0201321 RRALABEL ADC LABEL ADDRESS OF LABEL BUFFER M0201322 RRLPTR NUM 0 POINTER TO LABEL M0201323 RRVPTR NUM 0 POINTER TO VIT M0201324 RRLABEL BSS LABEL(LABLEN) BUFFER FOR VOLUME LABEL M0201325 RR EJT **MSOS 4.1**M0201326 RR* PRINT THE SYSTEM IDENTIFICATION **MSOS 4.1**M0201327 RR SPC 2 **MSOS 4.1**M0201328 RROUTID LDA =XSYSID **MSOS 4.1**M0201329 RR EOR- LPMSK+15 IS THE IDENTIFICATION PATCHED **MSOS 4.1**M0201330 RR SAN ID1 **MSOS 4.1**M0201331 RR JMP* MODE NO, DONT PRINT IT **MSOS 4.1**M0201332 RRID1 LDA+ SYSID **MSOS 4.1**M0201333 RR STA* SAVID **MSOS 4.1**M0201334 RR AND- LPMSK+7 **MSOS 4.1**M0201335 RR EOR =N$0D00 ADD AN EXTRA CARRIAGE RETURN **MSOS 4.1**M0201336 RR STA+ SYSID **MSOS 4.1**M0201337 RR SPC 1 **MSOS 4.1**M0201338 RR ENQ 15 FIND THE END OF THE TRAILING **MSOS 4.1**M0201339 RRID2 LDA+ SYSID,Q BLANKS IN THE IDENTIFICATION **MSOS 4.1**M0201340 RR SUB =A **MSOS 4.1**M0201341 RR SAN ID3 FOUND THE END **MSOS 4.1**M0201342 RR DQP *-ID2 GO BACK IF NOT ALL BLANK M0201343 RR JMP* ID4 ALL BLANK, DON'T PRINT M0201344 RRID3 INQ 1 **MSOS 4.1**M0201345 RR STQ* IDL FORM THE MESSAGE LENGTH **MSOS 4.1**M0201346 RR SPC 1 **MSOS 4.1**M0201347 RR RTJ- (AMONI) PRINT THE IDENTIFICATION **MSOS 4.1**M0201348 RR ADC $0C01 **MSOS 4.1**M0201349 RR ADC 0 **MSOS 4.1**M0201350 RR ADC 0 M0201351 RR ADC $18FC **MSOS 4.1**M0201352 RRIDL ADC 0 **MSOS 4.1**M0201353 RR ADC SYSID **MSOS 4.1**M0201354 RR RTJ- (AMONI) PRINT CR/LF,NULL M0201355 RR ADC $0C01 M0201356 RR ADC 0 M0201357 RRIDTH ADC 0 M0201358 RR ADC $18FC M0201359 RR ADC 1 M0201360 RR ADC ZERO M0201361 RR SPC 1 **MSOS 4.1**M0201362 RRIDWAIT LDA* IDTH **MSOS 4.1**M0201363 RR SAZ ID4 **MSOS 4.1**M0201364 RR JMP* IDWAIT WAIT FOR COMPLETION **MSOS 4.1**M0201365 RR SPC 1 M0201366 RRID4 LDA* SAVID **MSOS 4.1**M0201367 RR STA+ SYSID RESTORE LEADING BLANK IN THE ID **MSOS 4.1**M0201368 RR EJT M0201369 RR* DETERMINE THE CORE SIZE MODE, AND PRINT IT M0201370 RR SPC 2 M0201371 RRMODE LDA* (I1) CHECK MULTI-LEVEL INDIRECT **MSOS 4.1**M0201372 RR EOR* I3 FOR MODE **MSOS 4.1**M0201373 RR SAZ M32K **MSOS 4.1**M0201374 RR ENQ 1 **MSOS 4.1**M0201375 RR STQ- ($E9) SET MODE FLAG **MSOS 4.1**M0201376 RR JMP* T0 M0201377 RR SPC 2 M0201378 RRM32K RTJ- (AMONI) WRITE MODE ERROR MESSAGE M0201379 RR ADC $0C01 **MSOS 4.1**M0201380 RR ADC 0 **MSOS 4.1**M0201381 RRMODETH ADC 0 **MSOS 4.1**M0201382 RR ADC $18FC **MSOS 4.1**M0201383 RR ADC LMDERR M0201384 RR ADC MODERR M0201385 RR SPC 1 M0201386 RRMODWAT LDA* MODETH **MSOS 4.1**M0201387 RR SAZ QUIT KILL SYSTEM WHEN DONE M0201388 RR JMP* MODWAT WAIT FOR COMPLETION **MSOS 4.1**M0201389 RRQUIT RTJ SYFAIL KILL THE SYSTEM M0201390 RR SPC 2 M0201391 RRT0 IIN 0 INHIBIT INTERRUPTS WHILE SETTING PRIORITIES M0201392 RRT1 LDQ* ATC LOAD Q WITH COUNT VALUE 83*2390M0201393 RR LDQ* T,Q GET ADDRESS FROM TABLE 83*2390M0201394 RR TRQ A DO NOT SET PRIORITY IF 83*2390M0201395 RR EOR- LPMSK+15 EXTERNAL IS UNPATCHED 83*2390M0201396 RR SAZ T1B 83*2390M0201397 RR LDA- (ZERO),Q IF VALUE OF ADDRESS IS ZERO 83*2390M0201398 RR SAZ T1AA TABLE IS COMPLETED 83*2390M0201399 RR LDA PCORE GET CORE DRIVER COMPLETION PRIORITY 83*2390M0201400 RR AND- LPMSK+4 83*2390M0201401 RR EOR- (ZERO),Q AND 83*2390M0201402 RR STA- (ZERO),Q STORE BACK INTO REQUEST 83*2390M0201403 RRT1B RAO* ATC CONTINUE SETTING PRIORITIES 83*2390M0201404 RR JMP* T1 83*2390M0201405 RRT1AA EIN 0 83*2390M0201406 RR ENA 0 **MSOS 4.1**M0201407 RR STA MIBX CLEAR MIPRO AND M0201408 RR STA EFLOCK LOGGER LOCKOUT FLAGS **MSOS 4.1**M0201409 RR JMP TOIDLE GO TO IDLE EXIT **MSOS 4.1**M0201410 RR SPC 2 M0201411 RR SPC 1 M0201412 RRI1 ADC (I2) **MSOS 4.1**M0201413 RRI2 ADC I3 **MSOS 4.1**M0201414 RRI3 NUM $7F9C **MSOS 4.1**M0201415 RRSAVID NUM 0 **MSOS 4.1**M0201416 RR SPC 2 83*2390M0201417 RRATC NUM 0 INDEX FOR TABLE 83*2390M0201418 RRT ADC OUTPUT 83*2390M0201419 RR ADC SPACE4 83*2390M0201420 RR ADC NOG30A 83*2390M0201421 RR ADC REL 83*2390M0201422 RR ADC SCH 83*2390M0201423 RR ADC PTNALC 83*2390M0201424 RR ADC PTNREL 83*2390M0201425 RR ADC SPCEV4 83*2390M0201426 RR ADC RDPTV4 83*2390M0201427 RR ADC OUTPV4 83*2390M0201428 RR ADC ZERO THIS IS USED TO INDICATE THE END 83*2390M0201429 RR EJT M0201430 RRSUMLVL NUM $0D0A M0201431 RR ALF $,CCS 3.0 -- PSR LEVEL$ M0201432 RR NUM $2031 FOR PSR SUMMARIES OVER 100 100*3663M0201433 RR ADC SYSLVL SYSLVL ISC2 LEAST SIGNIFICANT DIGITS 100*3663M0201434 RRDATE ALF 6, **MSOS 4.1**M0201435 RR NUM $200D M0201436 RR EQU LSUMLV(*-SUMLVL) **MSOS 4.1**M0201437 RR SPC 1 M0201438 RRPP NUM $200D M0201439 RR ALF *,SET PROGRAM PROTECT (ESC J28@)* M0201440 RR NUM $200D **MSOS 4.1**M0201441 RRPPLEN EQU PPLEN(*-PP) M0201442 RRMODERR ALF 1,:R:L M0201443 RR ALF *,ERROR - MULTI LEVEL INDIRECT ADDRESSING SELECTED* M0201444 RRLMDERR EQU LMDERR(*-MODERR) M0201445 RRMONTH ADC SYSMON **MSOS 4.1**M0201446 RRDAY ADC SYSDAY **MSOS 4.1**M0201447 RRYEAR ADC SYSYER **MSOS 4.1**M0201448 RR EJT M0201449 RR* ALLOCATION LENGTHS M0201450 RR* M0201451 RR* AREAS 1, 2, AND 3 ARE SETUP BY *S CONTROL CARDS IN **MSOS 4.1**M0201452 RR* SYSTEM INSTALLATION FILE. AREAS 4-15 ARE SETUP BY **MSOS 4.1**M0201453 RR* EQUATES IN SYSDAT **MSOS 4.1**M0201454 RR SPC 2 M0201455 RRALCLGH ADC N1 ALLOCATION LENGTH FOR AREA 1 M0201456 RR ADC N2 ALLOCATION LENGTH FOR AREA 2 M0201457 RR ADC PSIZV4 ALLOCATION LENGTH FOR AREA 3 **MSOS 4.1**M0201458 RR ADC N4 ALLOCATION LENGTH FOR AREA 4 M0201459 RR ADC N5 ALLOCATION LENGTH FOR AREA 5 M0201460 RR ADC N6 ALLOCATION LENGTH FOR AREA 6 M0201461 RR ADC N7 ALLOCATION LENGTH FOR AREA 7 M0201462 RR ADC N8 ALLOCATION LENGTH FOR AREA 8 M0201463 RR ADC N9 ALLOCATION LENGTH FOR AREA 9 M0201464 RR ADC N10 ALLOCATION LENGTH FOR AREA 10 M0201465 RR ADC N11 ALLOCATION LENGTH FOR AREA 11 M0201466 RR ADC N12 ALLOCATION LENGTH FOR AREA 12 M0201467 RR ADC N13 ALLOCATION LENGTH FOR AREA 13 M0201468 RR ADC N14 ALLOCATION LENGTH FOR AREA 14 M0201469 RR ADC N15 ALLOCATION LENGTH FOR AREA 15 M0201470 RR SPC 4 M0201471 RR JMP RESTRT MUST ALWAYS BE 2 WORD INSTRUCTION **MSOS4.0*M0201472 RR* AUTOLOAD PROGRAM MOVED TO HERE M0201473 RR* *M0201474 RRSTMSV4 JMP RESTRT FIRST WORD OF AUTOLOAD PROGRAM **MSOS4.0*M0201475 RR SPC 4 M0201476 RR BSS (2) RESERVE TWO WORD FOR THE ALLOCATABLE M0201477 RR* CORE THREAD M0201478 RR END M0201479 RR NAM MIPRO M03 A ITOS CCS 3.0 SL-149M0300001 RR* MANUAL INTERRUPT RESPONSE HANDLER FOR INPUTS OTHER THAN * M0300002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 M0300003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA M0300004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 M0300005 RR* M0300006 RR SPC 5 M0300007 RR* THE PROGRAM BASICALLY INVOLVES ENTRY FROM MINT (IN **MSOS 4.1**M0300008 RR* MONITOR) WHEN THE FIRST CHARACTER INPUT AFTER A MANUAL **MSOS 4.1**M0300009 RR* INTERRUPT IS NOT AN *. IF THE INPUT CHARACTER STRING **MSOS 4.1**M0300010 RR* IS MATCHED IN TABLE -FUNCTN-, THE REQUESTED ACTION IS **MSOS 4.1**M0300011 RR* TAKEN. IF THE ACTION INVOLVES STARTING OR STOPPING A **MSOS 4.1**M0300012 RR* TIMER AND A REJECT IS FOUND, THE MESSAGE -TIMER REJECT-**MSOS 4.1**M0300013 RR* UNLINKED, OR THE INPUT IS OTHERWISE IN ERROR, THE **MSOS 4.1**M0300014 RR* MESSAGE, -MI INPUT ERROR IS PRINTED. THE FOLLOWING **MSOS 4.1**M0300015 RR* LIST OF INPUT CODES IS CONSIDERED BASIC TO THE PROGRAM.**MSOS 4.1**M0300016 RR* ADDITIONS TO THIS LIST MAY BE MADE BY USERS AS REQUIRED**MSOS 4.1**M0300017 RR SPC 2 **MSOS 4.1**M0300018 RR* INPUT FUNCTION **MSOS 4.1**M0300019 RR SPC 1 **MSOS 4.1**M0300020 RR* =S FOR SCHEDULING SYSTEM LIBRARY ORDINAL WITH **MSOS 4.1**M0300021 RR* THE INPUT FORMAT =SXXX,Y,ZZZZ WHERE XXX IS**MSOS 4.1**M0300022 RR* THE 3-DIGIT DECIMAL ORDINAL NUMBER (NUMBER**MSOS 4.1**M0300023 RR* CORRESPONDS TO DIRECTORY POSITION), Y IS **MSOS 4.1**M0300024 RR* THE HEX PRIORITY FOR EXECUTION, AND ZZZZ **MSOS 4.1**M0300025 RR* IS A HEX PARAMETER PASSED TO THE PROGRAM **MSOS 4.1**M0300026 RR* IN THE Q-REGISTER. **MSOS 4.1**M0300027 RR SPC 1 **MSOS 4.1**M0300028 RR* EF SCHEDULES ORDINAL EFLIST TO PRINT **MSOS 4.1**M0300029 RR* ENGINEERING FILE DATA FOR ALL LOGICAL **MSOS 4.1**M0300030 RR* UNITS **MSOS 4.1**M0300031 RR SPC 1 **MSOS 4.1**M0300032 RR* EFMM SCHEDULES ORDINAL EFLIST TO PRINT **MSOS 4.1**M0300033 RR* ENGINEERING FILE DATA FOR MASS MEMORY **MSOS 4.1**M0300034 RR* UNITS **MSOS 4.1**M0300035 RR SPC 1 **MSOS 4.1**M0300036 RR* EFLU SCHEDULES ORDINAL EFLIST TO PRINT **MSOS 4.1**M0300037 RR* ENGINEERING FILE DATA FOR SPECIFIED **MSOS 4.1**M0300038 RR* LOGICAL UNIT **MSOS 4.1**M0300039 RR SPC 1 **MSOS 4.1**M0300040 RR* TON STARTS SYSTEM HARDWARE TIME BASE AS DEFINED **MSOS 4.1**M0300041 RR* IN SYSDAT **MSOS 4.1**M0300042 RR SPC 1 **MSOS 4.1**M0300043 RR* TOFF STOPS SYSTEM HARDWARE TIME BASE AS DEFINED **MSOS 4.1**M0300044 RR* IN SYSDAT **MSOS 4.1**M0300045 RR SPC 1 **MSOS 4.1**M0300046 RR* SYSCOP SCHEDULES SYSTEM CHECKOUT PACKAGE LOADED **MSOS 4.1**M0300047 RR* UNDER ORDINAL NAME SYSCOP **MSOS 4.1**M0300048 RR SPC 1 **MSOS 4.1**M0300049 RR* DB STARTS ON-LINE DEBUG PACKAGE, ODEBUG, LOADED**MSOS 4.1**M0300050 RR* UNDER ORDINAL NAME ODEBUG. **MSOS 4.1**M0300051 RR SPC 1 **MSOS 4.1**M0300052 RR* DX STOPS ON-LINE DEBUG PACKAGE BY CLEARING **MSOS 4.1**M0300053 RR* CHRSFG IN SYSDAT **MSOS 4.1**M0300054 RR SPC 1 **MSOS 4.1**M0300055 RR* DATE ALLOWS THE USER TO ENTER A NEW DATE AND **MSOS 4.1**M0300056 RR* TIME. ROUTINE IS A SUB-FUNCTION OF TDFUNC**MSOS 4.1**M0300057 RR* LOADED UNDER ORDINAL NAME TDFUNC. **MSOS 4.1**M0300058 RR SPC 1 **MSOS 4.1**M0300059 RR* TIME CAUSES THE CURRENT DATE AND TIME TO BE **MSOS 4.1**M0300060 RR* PRINTED ON THE COMMENT UNIT. ROUTINE IS A**MSOS 4.1**M0300061 RR* SUB-FUNCTION OF TDFUNC LOADED UNDER **MSOS 4.1**M0300062 RR* ORDINAL NAME TDFUNC. **MSOS 4.1**M0300063 RR SPC 1 M0300064 RR* VERIFY SCHEDULES THE MSOS VERIFICATION PACKAGE LOADED M0300065 RR* UNDER ORDINAL NAME VERIFY. M0300066 RR SPC 1 **MSOS 4.1**M0300067 RR* INIT INITIALIZES THE ITOS SYSTEM VOLUME FILES M0300068 RR SPC 1 M0300069 RR* START STARTS THE ITOS SYSTEM M0300070 RR SPC 1 M0300071 RR* STOP STOPS THE ITOS SYSTEM M0300072 RR SPC 1 M0300073 RR* PASSWRD DEFINES THE ITOS SYSTEM PASSWORD M0300074 RR SPC 1 M0300075 RR* WRON,LU ENABLE THE WRITE RING FEATURE ON THE MAG TAPE M0300076 RR* SIMULATOR SPECIFIED BY LU. M0300077 RR SPC 1 M0300078 RR* WROF,LU DISABLE THE WRITE RING FEATURE ON THE MAG TAPE M0300079 RR* SIMULATOR SPECIFIED BY LU. M0300080 RR SPC 1 SCAD MODM0300081 RR* JIN,LU CHANGE JOB PROC. INPUT DEVICE M0300082 RR* WHERE: LU IS A 1 OR 2 DIGIT SCAD MODM0300083 RR* DECIMAL NUMBER. SCAD MODM0300084 RR SPC 1 SCAD MODM0300085 RR* JLT,LU CHANGE JOB PROC. LIST DEVICE SCAD MODM0300086 RR* WHERE: LU IS A 1 OR 2 DIGIT SCAD MODM0300087 RR* DECIMAL NUMBER. SCAD MODM0300088 RR SPC 1 SCAD MODM0300089 RR* INP,LU CHANGE STANDARD INPUT DEVICE SCAD MODM0300090 RR* WHERE: LU IS A 1 OR 2 DIGIT SCAD MODM0300091 RR* DECIMAL NUMBER. SCAD MODM0300092 RR SPC 1 SCAD MODM0300093 RR* OUT,LU CHANGE STANDARD OUTPUT DEVICE SCAD MODM0300094 RR* WHERE: LU IS A 1 OR 2 DIGIT SCAD MODM0300095 RR* DECIMAL NUMBER. SCAD MODM0300096 RR SPC 1 SCAD MODM0300097 RR* LST,LU CHANGE STANDARD LIST DEVICE SCAD MODM0300098 RR* WHERE: LU IS A 1 OR 2 DIGIT SCAD MODM0300099 RR* DECIMAL NUMBER. SCAD MODM0300100 RR SPC 1 SCAD MODM0300101 RR* CARDNN CHANGE CARD READER MODE (1829-30/60) SCAD MODM0300102 RR* WHERE: NN = 26 FOR 026 MODE SCAD MODM0300103 RR* NN = 29 FOR 029 MODE SCAD MODM0300104 RR SPC 1 SCAD MODM0300105 RR* REW,LU REWIND MAG TAPE LU SCAD MODM0300106 RR* WHERE: LU IS A 1 OR 2 DIGIT SCAD MODM0300107 RR* DECIMAL NUMBER. SCAD MODM0300108 RR SPC 1 SCAD MODM0300109 RR* RSV,XX,Y RESERVE BUFFER SPACE FOR COMM-18 SCAD MODM0300110 RR* SIMULATORS. SCAD MODM0300111 RR SPC 1 SCAD MODM0300112 RR* UT2,LU ACTIVATE A UT200 TERMINAL AND ATTACH SCAD MODM0300113 RR* IT TO COMMUNICATIONS CHANNEL 'LU'. SCAD MODM0300114 RR SPC 1 SCAD MODM0300115 RR* HWS,LU,I,O ACTIVATE A HASP WORKSTATION TERMINAL SCAD MODM0300116 RR* AND ATTACH IT TO COMMUNICATIONS SCAD MODM0300117 RR* CHANNEL 'LU' WITH 'I' INPUT SCAD MODM0300118 RR* STREAMS AND 'O' OUTPUT STREAMS. SCAD MODM0300119 RR SPC 1 M0300120 RR* SCOM STOP COMM18 SIMULATORS M0300121 RR* M0300122 RR SPC 1 M0300123 RR* CCSDB INITIATES CCS ON-LINE DEBUG M0300124 RR SPC 1 M0300125 RR* UP ATTEMPTS TO PUT A DOWN TERMINAL M0300126 RR* BACK INTO SERVICE. M0300127 RR SPC 1 M0300128 RR* DENSITY SETS DENSITY AND SELECTS MODE (NRZI OR M0300129 RR* PHASE ENCODE) FOR DUAL MODE MAG TAPES. M0300130 RR SPC 1 M0300131 RR* SMDC ORDINAL TO CONFIGURE SMD PHY. DEV. TBLS. M0300132 RR* FOR 50MB AND 300MB DRIVES, AT 96 OR M0300133 RR* 569 WORDS PER SECTOR. M0300134 RR* M0300135 RR EJT M0300136 RR* THE TABLE -FUNCTN- CONTAINS A 6-WORD DATA BLOCK FOR EACH **MSOS 4.1**M0300137 RR* PARAMETERIZED INPUT MNEMONIC. THE DATA BLOCK IS **MSOS 4.1**M0300138 RR* DEFINED AS FOLLOWS... **MSOS 4.1**M0300139 RR SPC 2 **MSOS 4.1**M0300140 RR* WORDS 0-1 A MNEMONIC CODE WHICH MAY CONTAIN **MSOS 4.1**M0300141 RR* 2-4 CHARACTERS. UNUSED CHARACTERS **MSOS 4.1**M0300142 RR* MUST BE SPACES. ANY LEGAL ASCII **MSOS 4.1**M0300143 RR* CODE MAY BE USED BUT A SPACE. **MSOS 4.1**M0300144 RR SPC 1 **MSOS 4.1**M0300145 RR* WORD 2 THE RELATIVE DISTANCE BETWEEN THE **MSOS 4.1**M0300146 RR* LABEL JMP AND ANY DESIRED FUNCTION**MSOS 4.1**M0300147 RR* PRE-PROCESSOR. IF A DATA STRING **MSOS 4.1**M0300148 RR* FOLLOWS THE MNEMONIC, THE PRE- **MSOS 4.1**M0300149 RR* PROCESSOR MAY BE USED FOR ITS **MSOS 4.1**M0300150 RR* ANALYSIS. IN THIS CASE, THE **MSOS 4.1**M0300151 RR* ADDRESS OF THE INPUT BUFFER IS **MSOS 4.1**M0300152 RR* CONTAINED IN LOCATION, QSAVE. IF **MSOS 4.1**M0300153 RR* NO PRE-PROCESSING IS REQUIRED, **MSOS 4.1**M0300154 RR* CONTROL SHOULD BE PASSED TO LABEL,**MSOS 4.1**M0300155 RR* GETIND. **MSOS 4.1**M0300156 RR SPC 1 **MSOS 4.1**M0300157 RR* WORD 3 A SCHEDULER CALL (SYSCHD TYPE) FOR THE M0300158 RR* DESIRED PROCESSOR M0300159 RR SPC 1 **MSOS 4.1**M0300160 RR* WORD 4 AN INDEX TO THE ORDINAL TABLE (ORDTBL) M0300161 RR* SET TO $FFFF IF NO ORDINAL M0300162 RR SPC 1 M0300163 RR* WORD 5 THE PARAMETER TO BE PASSED TO THE **MSOS 4.1**M0300164 RR* PROCESSOR PROGRAM IN THE Q- **MSOS 4.1**M0300165 RR* REGISTER. **MSOS 4.1**M0300166 RR SPC 3 **MSOS 4.1**M0300167 RR* EACH ENTRY IN THIS TABLE MUST CONTAIN SIX WORDS EVEN IF **MSOS 4.1**M0300168 RR* LESS ARE USED. A SAMPLE ENTRY FOLLOWS... **MSOS 4.1**M0300169 RR SPC 1 **MSOS 4.1**M0300170 RR* ALF 2,SAMPLE MNEMONIC NAME **MSOS 4.1**M0300171 RR* ADC PREPRO-JMP INCREMENT FROM PRE-PROCESSOR TO **MSOS 4.1**M0300172 RR* JMP LABEL **MSOS 4.1**M0300173 RR* NUM $240X SYSTEM SCHEDULER CALL AT PRIORITY M0300174 RR* X. **MSOS 4.1**M0300175 RR* NUM X OR $FFFF WHERE X IS THE INDEX TO TABLE ORDTBL M0300176 RR* $FFFF IS USED IF NO ORDINAL REQUIRED M0300177 RR* NUM XXXX PARAMETER TO BE PASSED IN THE Q- **MSOS 4.1**M0300178 RR* REGISTER. **MSOS 4.1**M0300179 RR EJT **MSOS 4.1**M0300180 RR* PROGRAM ENTRY POINTS **MSOS 4.1**M0300181 RR ENT MIPROC TRANSFER ADDRESS **MSOS 4.1**M0300182 RR SPC 2 **MSOS 4.1**M0300183 RR* PROGRAM EXTERNAL POINTS **MSOS 4.1**M0300184 RR EXT LOG1A TABLE OF P.D.T. ADDRESSES **MSOS 4.1**M0300185 RR EXT MIBX MANUAL INTERRUPT BUSY FLAG **MSOS 4.1**M0300186 RR EXT CHRSFG ODEBUG ACTIVE FLAG **MSOS 4.1**M0300187 RR EXT SYSCOP SYSTEM CHECKOUT ORDINAL **MSOS 4.1**M0300188 RR EXT ODEBUG ON-LINE DEBUG ORDINAL **MSOS 4.1**M0300189 RR EXT ODBSIZ ON-LINE DEBUG OVERLAY SIZE M0300190 RR EXT EFLIST ENGINEERING FILE LIST ORDINAL **MSOS 4.1**M0300191 RR EXT TDFUNC TIME/DATE FUNCTION ORDINAL **MSOS 4.1**M0300192 RR EXT VERIFY MSOS VERIFICATION ORDINAL M0300193 RR EXT SYUTIL ITOS SYSTEM UTILITIES M0300194 RR EXT TMRTYP TIMER TYPE DESIGNATOR **MSOS 4.1**M0300195 RR EXT TMCODE TIMER TYPE CODE **MSOS 4.1**M0300196 RR EXT DMICOD CODE TO DEFINE MICRO-INTRPT MP MSOSM0300197 RR EXT TBLADR ADDRESS OF ADT TABLE FOR CLOCK MP MSOSM0300198 RR EXT EMPSRT RESET/START FUNCTION CODE MP MSOSM0300199 RR EXT EMPSTP STOP FUNCTION CODE MP MSOSM0300200 RR EXT SIMRSV RESERVE BUFFER SPACE FOR COMM-18 SIMS SCAD MODM0300201 RR EXT U2INIT ACTIVATE A UT200 TERMINAL SCAD MODM0300202 RR EXT HWINIT ACTIVATE A HASP WORKSTATION TERMINAL SCAD MODM0300203 RR EXT TSAREA M0300204 RR EXT PARTBL M0300205 RR EXT TRMLUP RESTORE DOWN TERMINAL. M0300206 RR EXT TAPSET SELECT MAG TAPE DENSITY AND MODE. M0300207 RR EXT SAVLAB SAVE SYSVOL VOLUME LABEL. M0300208 RR EXT RESLAB RESTORE SYSVOL VOLUME LABEL. M0300209 RR EXT SMDCFG CONFIGURE SMD PHY. DEV. TBL. M0300210 RR SPC 2 **MSOS 4.1**M0300211 RR* PROGRAM EQUIVALENCES **MSOS 4.1**M0300212 RR EQU LPMSK($2) RIGHT JUSTIFIED MASKS **MSOS 4.1**M0300213 RR EQU NZERO($12) LEFT JUSTIFIED MASKS **MSOS 4.1**M0300214 RR EQU ONEBIT($23) SINGLE BIT MASKS **MSOS 4.1**M0300215 RR EQU ZERO($22) CELL CONTAINING ZERO **MSOS 4.1**M0300216 RR EQU FOUR($25) CELL CONTAINING FOUR **MSOS 4.1**M0300217 RR EQU SIX($44) CELL CONTAINING SIX **MSOS 4.1**M0300218 RR EQU ADISP($EA) ADDRESS OF DISPATCHER **MSOS 4.1**M0300219 RR EQU AMONI($F4) ADDRESS OF MONITOR **MSOS 4.1**M0300220 RR EJT **MSOS 4.1**M0300221 RRMIPRO ENA 0 INITIALIZE INDEX **MSOS 4.1**M0300222 RR STA- I **MSOS 4.1**M0300223 RR STA* ISAVE **MSOS 4.1**M0300224 RR STQ* QSAVE SAVE LOCATION OF INPUT CHAR BUFFER**MSOS 4.1**M0300225 RR SPC 1 **MSOS 4.1**M0300226 RRREPEAT LDQ* QSAVE **MSOS 4.1**M0300227 RR LDA- (ZERO),Q PICKUP FIRST 2 CHAR INPUT **MSOS 4.1**M0300228 RR SUB* FUNCTN,I DO THEY MATCH **MSOS 4.1**M0300229 RR SAZ CHAR2 YES **MSOS 4.1**M0300230 RR JMP* NEXT NO, TRY AGAIN **MSOS 4.1**M0300231 RR SPC 1 **MSOS 4.1**M0300232 RRCHAR2 LDA* FUNCTN+1,I **MSOS 4.1**M0300233 RR SUB =A IS THIS A 2 CHARACTER INPUT **MSOS 4.1**M0300234 RR SAN NOT2 NO **MSOS 4.1**M0300235 RR LDA- I SAVE INDEX TO 2 CHAR INPUT MATCH **MSOS 4.1**M0300236 RR STA* FOUND2 **MSOS 4.1**M0300237 RR JMP* NEXT CONTINUE TO SEE IF 3 OR 4 CHAR **MSOS 4.1**M0300238 RRNOT2 LDA* FUNCTN+1,I **MSOS 4.1**M0300239 RR AND- LPMSK+8 NO, IS IT 3 CHARACTERS **MSOS 4.1**M0300240 RR INA -$20 **MSOS 4.1**M0300241 RR SAN CHAR4 NO, IT IS 4 CHAR. **MSOS 4.1**M0300242 RR LDA- 1,Q 3 CHARACTER INPUT **MSOS 4.1**M0300243 RR ALS 8 MERGE THE 4TH CHAR OF THE INPUT **MSOS 4.1**M0300244 RR LDQ* FUNCTN+1,I WITH THE 3RD CHAR OF THE FUNCTION **MSOS 4.1**M0300245 RR QRS 8 **MSOS 4.1**M0300246 RR LRS 8 **MSOS 4.1**M0300247 RR STA* FUNCTN+1,I **MSOS 4.1**M0300248 RR LDQ* QSAVE **MSOS 4.1**M0300249 RR LDA* FUNCTN+1,I SEE IF THREE CHAR MATCH **MSOS 4.1**M0300250 RR SUB- 1,Q **MSOS 4.1**M0300251 RR SAN NEXT SKIP IF NO MATCH **MSOS 4.1**M0300252 RR LDA- I SAVE INDEX TO 3 CHAR MATCH **MSOS 4.1**M0300253 RR STA* FOUND3 **MSOS 4.1**M0300254 RR JMP* NEXT SEE IF SIMILAR 4 CHAR MATCH **MSOS 4.1**M0300255 RRCHAR4 LDA* FUNCTN+1,I **MSOS 4.1**M0300256 RR SUB- 1,Q DO THE SECOND SET OF CHAR MATCH **MSOS 4.1**M0300257 RR SAN NEXT NO **MSOS 4.1**M0300258 RR SPC 1 **MSOS 4.1**M0300259 RRFOUND LDA* FUNCTN+2,I YES, PROCESS THE REQUEST **MSOS 4.1**M0300260 RR INA -1 **MSOS 4.1**M0300261 RR STA* JMP+1 **MSOS 4.1**M0300262 RRJMP JMP ERROR **MSOS 4.1**M0300263 RR EJT M0300264 RR SPC 2 **MSOS 4.1**M0300265 RRNEXT RAO* ISAVE **MSOS 4.1**M0300266 RR LDA* ISAVE **MSOS 4.1**M0300267 RR MUI- SIX SET UP FOR NEXT GROUP **MSOS 4.1**M0300268 RR STA- I **MSOS 4.1**M0300269 RR SUB MAX ARE WE THROUGH M0300270 RR SAP FINI YES **MSOS 4.1**M0300271 RR JMP* REPEAT NO, TRY AGAIN **MSOS 4.1**M0300272 RR SPC 1 **MSOS 4.1**M0300273 RRFINI LDQ* QSAVE **MSOS 4.1**M0300274 RR LDA* FOUND3 SEE IF 3 CHAR MATCH FOUND **MSOS 4.1**M0300275 RR SAM TRY2 SKIP IF NOT **MSOS 4.1**M0300276 RRSMALL STA- I SETUP MATCH INDEX **MSOS 4.1**M0300277 RR JMP* FOUND PROCESS INPUT **MSOS 4.1**M0300278 RRTRY2 LDA* FOUND2 SEE IF 2 CHAR MATCH **MSOS 4.1**M0300279 RR SAM GERROR SKIP IF NO **MSOS 4.1**M0300280 RR JMP* SMALL PROCESS INPUT **MSOS 4.1**M0300281 RRGERROR JMP ERROR ILLEGAL REQUEST **MSOS 4.1**M0300282 RR SPC 1 **MSOS 4.1**M0300283 RRFOUND3 NUM -1 **MSOS 4.1**M0300284 RRFOUND2 NUM -1 **MSOS 4.1**M0300285 RRQSAVE NUM 0 **MSOS 4.1**M0300286 RRISAVE NUM 0 **MSOS 4.1**M0300287 RR EJT **MSOS 4.1**M0300288 RRFUNCTN ALF 2,=S =S SCHEDULE ORDINAL **MSOS 4.1**M0300289 RR ADC EQUALS-JMP **MSOS 4.1**M0300290 RR NUM $2404 M0300291 RR NUM $FFFF **MSOS 4.1**M0300292 RR NUM 0 **MSOS 4.1**M0300293 RR SPC 2 **MSOS 4.1**M0300294 RR SPC 2 **MSOS 4.1**M0300295 RR ALF 2,EF EF LIST ALL UNITS **MSOS 4.1**M0300296 RR ADC GETIND-JMP **MSOS 4.1**M0300297 RR NUM $2404 M0300298 RR NUM 1 EFLIST M0300299 RR NUM 0 **MSOS 4.1**M0300300 RR SPC 2 **MSOS 4.1**M0300301 RR ALF 2,EFMM EF LIST MASS MEMORY **MSOS 4.1**M0300302 RR ADC GETIND-JMP **MSOS 4.1**M0300303 RR NUM $2404 M0300304 RR NUM 1 EFLIST M0300305 RR NUM 2 **MSOS 4.1**M0300306 RR SPC 2 **MSOS 4.1**M0300307 RR ALF 2,EFLU EF LIST SPECIFIED LU **MSOS 4.1**M0300308 RR ADC GETIND-JMP **MSOS 4.1**M0300309 RR NUM $2404 M0300310 RR NUM 1 EFLIST M0300311 RR NUM 1 **MSOS 4.1**M0300312 RR SPC 2 **MSOS 4.1**M0300313 RR ALF 2,TON START TIMER **MSOS 4.1**M0300314 RR ADC TIMER-JMP **MSOS 4.1**M0300315 RR NUM $2404 M0300316 RR NUM $FFFF **MSOS 4.1**M0300317 RR NUM 0 **MSOS 4.1**M0300318 RR SPC 2 **MSOS 4.1**M0300319 RR ALF 2,TOFF STOP TIMER **MSOS 4.1**M0300320 RR ADC MOTIME-JMP **MSOS 4.1**M0300321 RR NUM $2404 M0300322 RR NUM $FFFF **MSOS 4.1**M0300323 RR NUM 0 **MSOS 4.1**M0300324 RR SPC 2 **MSOS 4.1**M0300325 RR ALF 2,SYSCOP SYSTEM CHECKOUT **MSOS 4.1**M0300326 RR ADC GETIND-JMP **MSOS 4.1**M0300327 RR NUM $2404 M0300328 RR NUM 2 SYSCOP M0300329 RR NUM 0 **MSOS 4.1**M0300330 RR SPC 2 **MSOS 4.1**M0300331 RR ALF 2,DB START ODEBUG **MSOS 4.1**M0300332 RR ADC DB-JMP **MSOS 4.1**M0300333 RR NUM $2407 M0300334 RR NUM 3 ODEBUG M0300335 RR NUM 0 **MSOS 4.1**M0300336 RR SPC 2 **MSOS 4.1**M0300337 RR ALF 2,DX STOP ODEBUG **MSOS 4.1**M0300338 RR ADC DX-JMP **MSOS 4.1**M0300339 RR NUM $2404 M0300340 RR NUM $FFFF **MSOS 4.1**M0300341 RR NUM 0 **MSOS 4.1**M0300342 RR SPC 2 **MSOS 4.1**M0300343 RR ALF 2,DATE ENTER DATE/TIME **MSOS 4.1**M0300344 RR ADC GETIND-JMP **MSOS 4.1**M0300345 RR NUM $2404 M0300346 RR NUM 4 TDFUNC M0300347 RR NUM 1 **MSOS 4.1**M0300348 RR SPC 3 M0300349 RR ALF 2,VERIFY MSOS VERIFICATION M0300350 RR ADC GETIND-JMP M0300351 RR NUM $2404 M0300352 RR NUM 5 VERIFY M0300353 RR NUM 0 M0300354 RR SPC 2 **MSOS 4.1**M0300355 RR ALF 2,TIME PRINT CURRENT DATE AND TIME **MSOS 4.1**M0300356 RR ADC GETIND-JMP **MSOS 4.1**M0300357 RR NUM $2404 M0300358 RR NUM 4 TDFUNC M0300359 RR NUM 2 **MSOS 4.1**M0300360 RR SPC 2 **MSOS 4.1**M0300361 RR ALF 2,INIT INITIALIZE SYSTEM VOLUME FILES M0300362 RR ADC GETIND-JMP M0300363 RR NUM $2406 M0300364 RR NUM 6 SYUTIL M0300365 RR NUM 0 M0300366 RR SPC 2 M0300367 RR ALF 2,START ACTIVATE THE ITOS SYSTEM M0300368 RR ADC GETIND-JMP M0300369 RR NUM $2406 M0300370 RR NUM 6 SYUTIL M0300371 RR NUM 1 M0300372 RR SPC 2 M0300373 RR ALF 2,STOP DE-ACTIVATE THE ITOS SYSTEM M0300374 RR ADC GETIND-JMP M0300375 RR NUM $2406 M0300376 RR NUM 6 SYUTIL M0300377 RR NUM 2 M0300378 RR SPC 2 M0300379 RR ALF 2,PASSWD DEFINE THE SYSTEM PASSWORD M0300380 RR ADC GETIND-JMP M0300381 RR NUM $2406 M0300382 RR NUM 6 SYUTIL M0300383 RR NUM 3 M0300384 RR SPC 2 SCAD MODM0300385 RR ALF 2,JIN, CHANGE JOB PROC. INPUT DEVICE SCAD MODM0300386 RR ADC JOBINP-JMP SCAD MODM0300387 RR NUM $2404 SCAD MODM0300388 RR NUM $FFFF SCAD MODM0300389 RR NUM 0 SCAD MODM0300390 RR SPC 2 SCAD MODM0300391 RR ALF 2,JLT, CHANGE JOB PROC. LIST DEVICE SCAD MODM0300392 RR ADC JOBLST-JMP SCAD MODM0300393 RR NUM $2404 SCAD MODM0300394 RR NUM $FFFF SCAD MODM0300395 RR NUM 0 SCAD MODM0300396 RR SPC 2 SCAD MODM0300397 RR ALF 2,INP, CHANGE STANDARD INPUT DEVICE SCAD MODM0300398 RR ADC STDEV-JMP SCAD MODM0300399 RR NUM $2404 SCAD MODM0300400 RR NUM $FFFF SCAD MODM0300401 RR NUM 0 SCAD MODM0300402 RR SPC 2 SCAD MODM0300403 RR ALF 2,OUT, CHANGE STANDARD OUTPUT DEVICE SCAD MODM0300404 RR ADC STDEV-JMP SCAD MODM0300405 RR NUM $2404 SCAD MODM0300406 RR NUM $FFFF SCAD MODM0300407 RR NUM 1 SCAD MODM0300408 RR SPC 2 SCAD MODM0300409 RR ALF 2,LST, CHANGE STANDARD LIST DEVICE SCAD MODM0300410 RR ADC STDEV-JMP SCAD MODM0300411 RR NUM $2404 SCAD MODM0300412 RR NUM $FFFF SCAD MODM0300413 RR NUM 2 SCAD MODM0300414 RR SPC 2 SCAD MODM0300415 RR ALF 2,CARD CHANGE CARD READ MODE (1829-30/60) SCAD MODM0300416 RR ADC CARDMD-JMP SCAD MODM0300417 RR NUM $2404 SCAD MODM0300418 RR NUM 0 SCAD MODM0300419 RR NUM 43 SCAD MODM0300420 RR SPC 2 SCAD MODM0300421 RR ALF 2,REW, REWIND A MAG TAPE SCAD MODM0300422 RR ADC REWMGT-JMP SCAD MODM0300423 RR NUM $2404 SCAD MODM0300424 RR NUM $FFFF SCAD MODM0300425 RR NUM 0 SCAD MODM0300426 RR SPC 2 SCAD MODM0300427 RR ALF 2,RSV, RESERVE BUFFER SPACE FOR COMM-18 SIMS SCAD MODM0300428 RR ADC RSV-JMP M0300429 RR NUM $2404 SCAD MODM0300430 RR NUM 7 M0300431 RR NUM 0 SCAD MODM0300432 RR SPC 2 SCAD MODM0300433 RR ALF 2,SAVE SAVE SYSVOL VOLUME LABEL. M0300434 RR ADC GETIND-JMP SCAD MODM0300435 RR NUM $2407 M0300436 RR NUM 8 M0300437 RR NUM 0 SCAD MODM0300438 RR SPC 2 SCAD MODM0300439 RR ALF 2,RESTORE RESTORE SYSVOL VOLUME LABLE. M0300440 RR ADC GETIND-JMP SCAD MODM0300441 RR NUM $2407 M0300442 RR NUM 9 M0300443 RR NUM 0 SCAD MODM0300444 RR SPC 2 M0300445 RR ALF 2,SCOM M0300446 RR ADC COMSTP-JMP M0300447 RR NUM $2402 M0300448 RR NUM $FFFF M0300449 RR NUM 0 M0300450 RR SPC 2 M0300451 RR ALF 2,WRON ENABLE WRITE RING M0300452 RR ADC WRNGON-JMP M0300453 RR NUM $2402 M0300454 RR NUM $FFFF M0300455 RR NUM 0 M0300456 RR SPC 2 M0300457 RR ALF 2,WROF DISABLE WRITE RING M0300458 RR ADC WRNGOF-JMP M0300459 RR NUM $2402 M0300460 RR NUM $FFFF M0300461 RR NUM 0 M0300462 RR SPC 2 M0300463 RR ALF 2,CCSD CCS 2.0 DEBUG M0300464 RR ADC DB-JMP M0300465 RR NUM $2407 M0300466 RR NUM 3 M0300467 RR NUM 0 M0300468 RR SPC 2 M0300469 RR ALF 2,UP RESTORE DOWN TERMINAL. M0300470 RR ADC GETIND-JMP M0300471 RR NUM $2407 M0300472 RR NUM 10 M0300473 RR NUM 0 M0300474 RR SPC 2 M0300475 RR ALF 2,DENSITY MAG TAPE DENSITY AND MODE SELECT. M0300476 RR ADC GETIND-JMP M0300477 RR NUM $2407 M0300478 RR NUM 11 M0300479 RR NUM 0 M0300480 RR SPC 2 M0300481 RR ALF 2,SMDC CONFIGURE SMD PHY. DEV. TBL. M0300482 RR ADC GETIND-JMP M0300483 RR NUM $2404 M0300484 RR NUM 12 M0300485 RR NUM 0 M0300486 RR SPC 2 M0300487 RR ALF 2,SYID DEFINE SYSTEM IDENTIFICATION M0300488 RR ADC GETIND-JMP M0300489 RR NUM $2404 M0300490 RR NUM 12 M0300491 RR NUM 1 M0300492 RR SPC 2 M0300493 RR ALF 2,LPCF CONFIGURE LINE PRINTER LOWER CASE OPTION M0300494 RR ADC GETIND-JMP M0300495 RR NUM $2404 M0300496 RR NUM 12 M0300497 RR NUM 2 M0300498 RR EJT M0300499 RR SPC 2 **MSOS 4.1**M0300500 RRMAX ADC *-FUNCTN FUNCTION TABLE SIZE **MSOS 4.1**M0300501 RRORDTBL ADC 0 ORDINAL TABLE FOR MNEMONICS M0300502 RR ADC EFLIST M0300503 RR ADC SYSCOP M0300504 RR ADC ODEBUG M0300505 RR ADC TDFUNC M0300506 RR ADC VERIFY M0300507 RR ADC SYUTIL ITOS SYSTEM UTILITIES M0300508 RR ADC SIMRSV SCAD MODM0300509 RR ADC SAVLAB M0300510 RR ADC RESLAB M0300511 RR ADC TRMLUP RESTORE DOWN TERMINAL. M0300512 RR ADC TAPSET SELECT MAG TAPE DENSITY AND MODE. M0300513 RR ADC SMDCFG 12 CONFIGURE SMD PHY. DEV. TBL. M0300514 RR EJT **MSOS 4.1**M0300515 RR* TIMER INITIATION CODING **MSOS 4.1**M0300516 RR* **MSOS 4.1**M0300517 RR* MP17 REAL-TIME CLOCK 8 M0300518 RR* **MSOS 4.1**M0300519 RR* **MSOS 4.1**M0300520 RRTIMER LDQ =XLOG1A **MSOS 4.1**M0300521 RR LDQ- 1,Q **MSOS 4.1**M0300522 RR LDA- 13,Q **MSOS 4.1**M0300523 RR INA 1 IS THERE A SWAP TIME DEFINED **MSOS 4.1**M0300524 RR SAZ TIMER1 NO **MSOS 4.1**M0300525 RR LDA- 13,Q **MSOS 4.1**M0300526 RR AND- LPMSK+15 RE-ENABLE CORE SWAP DELAYS **MSOS 4.1**M0300527 RR STA- 13,Q **MSOS 4.1**M0300528 RRTIMER1 LDQ =XTMCODE **MSOS 4.1**M0300529 RR STQ+ TMRTYP RESTORE THE TIMER TYPE CODE **MSOS 4.1**M0300530 RR* MP MSOSM0300531 RR* MP17 REAL-TIME ADT CLOCK MP MSOSM0300532 RR* MP MSOSM0300533 RRMP17CK ENA 0 CLEAR A MP MSOSM0300534 RR LDQ+ TBLADR GET ADDR OF ADT TABLE MP MSOSM0300535 RR STA- 1,Q AND CLEAR CLOCK CYCLE COUNTER MP MSOSM0300536 RR ENA 5 M0300537 RR STA- 2,Q SET CYCLE LIMIT M0300538 RR TRQ A ADT TABLE ADDR TO A MP MSOSM0300539 RR LDQ+ DMICOD DEFINE/U-INT NO. IN Q MP MSOSM0300540 RR DMI DEFINE MICRO-INTRPT M0300541 RR LDQ+ EMPSRT RESET/START FUNCTION CODE MP MSOSM0300542 RR OUT REJ-* M0300543 RR JMP* MIDONE M0300544 RR SPC 3 MP MSOSM0300545 RR EJT M0300546 RR* MAKE SYSTEM DIRECTORY SCHEDULER CALL IF PROGRAM SUPPLIED M0300547 RR SPC 3 M0300548 RRGETIND LDQ FUNCTN+4,I GET ORDINAL INDEX M0300549 RR LDA ORDTBL,Q GET ORDINAL M0300550 RR EOR- LPMSK+15 M0300551 RR SAN GET1 SKIP IF ENTRY PRESENT M0300552 RR JMP ERROR M0300553 RRGET1 LDA ORDTBL,Q GET ORDINAL M0300554 RR STA* CALL+1 STORE ORDINAL IN SCHEDULER CALL M0300555 RR TRA Q M0300556 RR ADQ- $EB M0300557 RR LDA- 4,Q HAS THE ORDINAL BEEN LOADED M0300558 RR SAN GET2 YES M0300559 RRGETERR JMP ERROR PROGRAM IS UNLINKED OR NOT LOADED M0300560 RRGET2 LDA FUNCTN+3,I M0300561 RR STA* CALL SET THE LEVEL OF THE PROGRAM **MSOS 4.1**M0300562 RR LDQ FUNCTN+5,I OBTAIN THE PARAMETER TO PASS **MSOS 4.1**M0300563 RRSCHDRP RTJ- (AMONI) SCHEDULE REQUESTED PROGRAM *MSOS V4.0 M0300564 RRCALL NUM $5204 M0300565 RR ADC 0 **MSOS 4.1**M0300566 RR SPC 3 M0300567 RR* EXIT PATH FROM MIPRO M0300568 RR SPC 3 M0300569 RRMIDONE ENA 0 M0300570 RR STA+ MIBX CLEAR BUSY FLAG IN MANINT PROGRAM M0300571 RR RTJ- (AMONI) RELEASE CORE AND EXIT M0300572 RRLIST NUM $1901 M0300573 RR ADC (MIPRO-LIST) M0300574 RR* REJECT EXIT M0300575 RRREJ NOP 0 M0300576 RR ENA 0 M0300577 RR STA+ TMRTYP INDICATE NO TIMER M0300578 RRREJ1 LDA =XMSG2-REF TO PRINT -TIMER REJECT- M0300579 RR JMP* STORIT M0300580 RR EJT M0300581 RR SPC 2 M0300582 RR* TIMER TERMINATION CODING **MSOS 4.1**M0300583 RR* **MSOS 4.1**M0300584 RR* TIMER TERMINATION SEQUENCE IS BASED ON TIMER TYPE **MSOS 4.1**M0300585 RR* AS DEFINED ABOVE **MSOS 4.1**M0300586 RR* **MSOS 4.1**M0300587 RRMOTIME LDQ =XLOG1A **MSOS 4.1**M0300588 RR LDQ- 1,Q **MSOS 4.1**M0300589 RR LDA- 13,Q **MSOS 4.1**M0300590 RR AND- LPMSK+15 **MSOS 4.1**M0300591 RR EOR- ONEBIT+15 DISABLE DELAYED CORE SWAPS **MSOS 4.1**M0300592 RR STA- 13,Q **MSOS 4.1**M0300593 RR LDQ =XTMCODE **MSOS 4.1**M0300594 RR ENA 0 **MSOS 4.1**M0300595 RR STA+ TMRTYP INDICATE NO TIMER **MSOS 4.1**M0300596 RR* MP MSOSM0300597 RR* MP17 REAL-TIME ADT CLOCK MP MSOSM0300598 RR* MP MSOSM0300599 RRNMP17 LDQ+ EMPSTP TIMER STOP FUNCTION CODE MP MSOSM0300600 RR OUT REJ-* STOP THE TIMER,'A' NOT USED MP MSOSM0300601 RR LDA+ DMICOD ENABLE/U-INTRPT NO. MP MSOSM0300602 RR AND- LPMSK+15 CHANGE TO DISABLE MP MSOSM0300603 RR TRA Q CODE TO Q-REG MP MSOSM0300604 RR LDA+ TBLADR ADT TABLE ADDRESS MP MSOSM0300605 RR DMI CLEAR MICRO-INTRPT M0300606 RR JMP* MIDONE EXIT MP MSOSM0300607 RR SPC 3 MP MSOSM0300608 RR EJT M0300609 RR* MAG TAPE SIMULATOR WRITE RING PROCESSOR M0300610 RR* THIS ROUTINE ENABLES OR DISABLES THE WRITE RING ON THE M0300611 RR* SPECIFIED MAG TAPE SIMULATOR UNIT. M0300612 RR* M0300613 RR* THE LOGICAL UNIT SPECIFIED MUST CONTAIN 2 DIGITS M0300614 RR* EXAMPLE... WRON,09 M0300615 RR* WROF,28 M0300616 RR SPC 2 M0300617 RRWRNGON LDA- ONEBIT+15 SET ON FLAG M0300618 RR JMP* TAPSIM M0300619 RRWRNGOF ENA 0 SET OFF FLAG M0300620 RRTAPSIM STA* FLAGPS M0300621 RR LDQ QSAVE M0300622 RR LDA- 2,Q ISOLATE FIELD SEPARATOR M0300623 RR ALS 8 M0300624 RR AND- LPMSK+8 M0300625 RR INA -$2C IS IT A COMMA M0300626 RR SAZ NOERR M0300627 RR JMP* TAPERR M0300628 RRNOERR LDA- 3,Q TEST IF ONE OR TWO CHARS SCAD MODM0300629 RR SAP TWOCHA IS 2 CHARS SCAD MODM0300630 RR LDA- 2,Q IS 1 CHAR SCAD MODM0300631 RR JMP* ONECHA SCAD MODM0300632 RR* SCAD MODM0300633 RRTWOCHA LDA- 2,Q GET AND ISOLATE 1ST CHAR SCAD MODM0300634 RR RTJ DCK SCAD MODM0300635 RR ALS 4 SCAD MODM0300636 RR STA TEMP SAVE IT SCAD MODM0300637 RR LDA- 3,Q GET 2ND CHAR SCAD MODM0300638 RR ALS 8 SCAD MODM0300639 RRONECHA RTJ DCK CHECK IF A DECIMAL DIGIT SCAD MODM0300640 RR RTJ TSTLU TEST RANGE OF LOGICAL UNIT SCAD MODM0300641 RR JMP* OKTAP2 SCAD MODM0300642 RR* SCAD MODM0300643 RRTAPERR LDA =XMSG3-REF TO PRINT -TAPE SIM ERROR- M0300644 RR JMP* STORIT M0300645 RR* SCAD MODM0300646 RROKTAP2 LDQ+ LOG1A,Q M0300647 RR STQ- I SAVE THE PHYSTAB ADDRESS M0300648 RR LDA- 8,I ISOLATE THE EQUIPMENT TYPE CODE M0300649 RR ARS 4 M0300650 RR AND- LPMSK+7 M0300651 RR INA -60 IS IT A MAG TAPE SIMULATOR M0300652 RR SAZ OKTAP3 M0300653 RR JMP* TAPERR NO, ERROR M0300654 RROKTAP3 IIN 0 M0300655 RR LDA- 12,I GET THE HARDWARE STATUS WORD M0300656 RR AND- LPMSK+15 CLEAR THE WRITE RING BIT M0300657 RR EOR* FLAGPS SET/CLEAR THE BIT M0300658 RR STA- 12,I RESTORE THE STATUS WORD M0300659 RR EIN 0 M0300660 RR JMP MIDONE EXIT M0300661 RR* M0300662 RRFLAGPS NUM 0 M0300663 RR SPC 3 M0300664 RR* 6 CARDS DELETED M0300665 RR EJT M0300666 RR SPC 3 M0300667 RR* ERROR EXIT M0300668 RR SPC 3 M0300669 RRERROR LDA =XMSG1-REF TO PRINT -MI INPUT ERROR- **MSOS 4.1**M0300670 RRSTORIT STA* MSGLOC **MSOS 4.1**M0300671 RR RTJ- (AMONI) M0300672 RRREF NUM $0D37 M0300673 RR ADC MIDONE-REF M0300674 RR ADC 0 M0300675 RR ADC $18FC M0300676 RR ADC 7 **MSOS 4.1**M0300677 RRMSGLOC ADC 0 **MSOS 4.1**M0300678 RR JMP- ($EA) M0300679 RR SPC 2 M0300680 RRMSG1 ALF 7,MI INPUT ERROR **MSOS 4.1**M0300681 RRMSG2 ALF 7,TIMER REJECT **MSOS 4.1**M0300682 RRMSG3 ALF 7,TAPE SIM ERROR M0300683 RR SPC 5 M0300684 RR SPC 2 M0300685 RR* INITIATE DEBUG PACKAGE M0300686 RR SPC 1 M0300687 RRDBSYSD ADC ODEBUG REL. INCREMENT TO DEBUG ENTRY IN SYS. DIR. M0300688 RRDB LDQ- $EB STORE CORRECT LENGTH M0300689 RR ADQ* DBSYSD IN SYS. DIR. ENTRY M0300690 RR LDA =XODBSIZ CHANGE DIR. LENGTH M0300691 RR STA- (FOUR),Q M0300692 RRDBCKIT LDA+ CHRSFG IS DEBUG IN M0300693 RR SAZ DBRQIT-*-1 SKIP NO M0300694 RR JMP* ERROR PRINT ERROR MSG. M0300695 RRDBRQIT JMP GETIND SCHEDULE OBEDUG M0300696 RR* TURN OFF DEBUG PKG. M0300697 RR SPC 1 SCAD MODM0300698 RRDX ENA 0 M0300699 RR STA+ CHRSFG M0300700 RR JMP MIDONE M0300701 RR EJT M0300702 RR SPC 5 M0300703 RR* EQUAL S ROUTINE TO START SYSTEM DIRECTORY PROGRAMS. M0300704 RR SPC 3 M0300705 RREQUALS LDA- 1,Q PICKUP TWO DIGITS OF DIRECTORY NUMBER M0300706 RR STQ- I SAVE BUFFER ADDRESS M0300707 RR RTJ* CK CHECK AND CONVERT TO HEX M0300708 RR STA* HOLD SAVE SECOND DIGIT M0300709 RR LDA- 1,Q M0300710 RR ALS 8 DO SECOND DIGIT FIRST M0300711 RR RTJ* CK NOW FIRST DIGIT M0300712 RR ALS 4 X 16 M0300713 RR ADD* HOLD FORM COMPLETE DIRECTORY NUMBER M0300714 RR ALS 4 M0300715 RR STA* HOLD M0300716 RR LDA- 2,Q M0300717 RR ALS 8 RIGHT JUSTIFY 3RD DIGIT M0300718 RR RTJ* CK M0300719 RR ADD* HOLD M0300720 RR RTJ* DEOCT CONVERT FROM DECIMAL TO HEX M0300721 RR INA -1 REFERENCE TO ZERO M0300722 RR MUI- $5 X 7 M0300723 RR ADD- $E7 ADDRESS OF 1ST MASS STORAGE ENTRY M0300724 RR STA CALL+1 STORE SCHEDULER CALL M0300725 RR AND- $42 REMOVE BIT 15 M0300726 RR LDQ- $EB 53*1069 M0300727 RR AAQ Q 53*1069 M0300728 RR LDQ- 4,Q CHECK FOR ZERO LENGTH ORDINAL 53*1069 M0300729 RR SQN SPICI SKIP IF OK 53*1069 M0300730 RR JMP* ERROR **MSOS 4.1**M0300731 RRSPICI SUB- $E6 CHECK IF WITHIN LIMITS 53*1069 M0300732 RR SAM SPIC2 SK-P IF WITHIN LIMITS M0300733 RR JMP* ERROR TO ERROR ROUTINE **MSOS 4.1**M0300734 RR SPC 1 M0300735 RR* SET PRIORITY LEVEL M0300736 RR SPC 1 M0300737 RRSPIC2 LDA- 3,I M0300738 RR ALS 8 M0300739 RR RTJ* CK M0300740 RR AND- LPMSK+4 SCHEDULE PRIORITY/ **MSOS 4.1**M0300741 RR ADD =N$2400 M0300742 RR STA CALL **MSOS 4.1**M0300743 RR SPC 1 M0300744 RR* CHECK FOR A PARAMETER TO PASS M0300745 RR SPC 1 M0300746 RR LDA- 3,I M0300747 RR AND- $A FFMASK M0300748 RR EOR =N$2C , M0300749 RR SAZ SPIC3 SKIP IF NEXT CHARACTER COMMA M0300750 RR JMP SCHDRP SCHEDL. REQSED. PROGR. M0300751 RRSPIC3 LDA- 4,I M0300752 RR ALS 8 M0300753 RR RTJ* CK M0300754 RR ALS 4 M0300755 RR STA* HOLD SAVE DIGIT 1 M0300756 RR LDA- 4,I M0300757 RR RTJ* CK M0300758 RR ADD* HOLD M0300759 RR ALS 4 M0300760 RR STA* HOLD SAVE DIGITS 1 AND 2 M0300761 RR LDA- 5,I M0300762 RR ALS 8 M0300763 RR RTJ* CK M0300764 RR ADD* HOLD M0300765 RR ALS 4 M0300766 RR STA* HOLD SAVE DIGITS 1,2 AND 3 M0300767 RR LDA- 5,I M0300768 RR RTJ* CK M0300769 RR* THIS INSTRUCTION ORS IN CASE OF NEGATIVE ZERO IS PASSED M0300770 RR EOR* HOLD FORM COMPLETE PARAMETER *629 M0300771 RR TRA Q PUT IN Q TO PASS M0300772 RR SPC 1 M0300773 RR* SCHEDULE THE PROGRAM M0300774 RR SPC 1 M0300775 RR JMP SCHDRP SCHEDL. REQSED. PROGR. M0300776 RRHOLD 0 0 TEMPORARY STORAGE CELL M0300777 RR SPC 1 M0300778 RR* INPUT DATA CHECK AND CONVERSION ROUTINE M0300779 RR SPC 1 M0300780 RRCK 0 0 M0300781 RR AND- $A FF MASK M0300782 RR INA -$30 M0300783 RR SAM ER-*-1 SKIP IF LESS THAN $30 M0300784 RR INA -$17 *629 M0300785 RR SAP ER NOT 0 THRU $F *629 M0300786 RR INA 6 *629 M0300787 RR SAP ATHRUF DO NOT ALLOW ASCII M0300788 RR INA 7 CODES *3A THRU *40 M0300789 RR SAP ER TO PASS THRU THIS M0300790 RRATHRUF INA 10 ROUTINE M0300791 RR JMP* (CK) M0300792 RRER JMP ERROR ILLEGAL CHARACTER INPUT M0300793 RRDEOCT 0 0 M0300794 RR LDQ- $1E SET ALL THRU FLAG M0300795 RR LLS 20 FIRST DIGIT TO A, REST TO Q M0300796 RR STQ* BAKER SAVE REST M0300797 RR EOR* MINUS CHECK FOR MINUS SIGN M0300798 RR STA* ABLE SET INDICATOR FOR LATER M0300799 RR SAZ ADEOCT-*-1 START TO CONVERT M0300800 RR EOR* MINUS SET FIRST DIGIT BACK IF NOT - M0300801 RR INA -10 DO NOT ALLOW INPUT OF M0300802 RR SAM DDEOCT A THRU F TO THIS DECIMAL/HEX M0300803 RR JMP* ER CONVERSION ROUTINE M0300804 RRDDEOCT INA 10 M0300805 RRADEOCT MUI- $46 CONVERT THIS PART (TIMES 10) M0300806 RR STA* CHARLE PUT NEW VALUE TO TEMP M0300807 RR CLR A CLEAR A M0300808 RR LDQ* BAKER GET SAVED NEXT PORTION M0300809 RR LLS 4 NEXT FOUR TO A M0300810 RR INA -10 DO NOT ALLOW INPUT OF M0300811 RR SAM EDEOCT A THRU F TO THIS DECIMAL/HEX M0300812 RR JMP* ER CONVERSION ROUTINE M0300813 RREDEOCT INA 10 M0300814 RR ADD* CHARLE ADD THE PREVIOUS M0300815 RR STQ* BAKER SAVE THE REST M0300816 RR ADQ- $E CHECK FOR DONE M0300817 RR SQZ BDEOCT-*-1 ZERO MEANS DONE M0300818 RR JMP* ADEOCT GO BACK FOR ANOTHER TRY M0300819 RRBDEOCT LDQ* ABLE CHECK FOR MINUS SIGN M0300820 RR SQN CDEOCT-*-1 ZERO IS MINUS M0300821 RR TCA A COMPLEMENT THE ANSWER M0300822 RRCDEOCT JMP* (DEOCT) GO BACK HOME M0300823 RRMINUS NUM $D MINUS SIGN M0300824 RRABLE 0 0 M0300825 RRBAKER 0 0 M0300826 RRCHARLE 0 0 M0300827 RR EJT SCAD MODM0300828 RR* ROUTINE TO CHANGE THE JOB PROCESSOR INPUT DEVICE SCAD MODM0300829 RR* SCAD MODM0300830 RR* JIN,NN CHANGE JOB PROCESSOR INPUT SCAD MODM0300831 RR* DEVICE TO LU NN. SCAD MODM0300832 RR* SCAD MODM0300833 RR* NOTE: NN MAY BE A 1 OR 2 CHAR SCAD MODM0300834 RR* DECIMAL LOGICAL UNIT SCAD MODM0300835 RR* NUMBER. SCAD MODM0300836 RR* SCAD MODM0300837 RR SPC 2 SCAD MODM0300838 RR* SCAD MODM0300839 RR EXT INPTV4 JOB PROCESSOR INPUT LOGICAL UNIT SCAD MODM0300840 RR EXT AUTF9 STD INPUT SLOT IN TRVEC SCAD MODM0300841 RR* SCAD MODM0300842 RR SPC 2 SCAD MODM0300843 RRJOBINP RTJ* GETLU PICK UP LOGICAL UNIT SCAD MODM0300844 RR RTJ* TSTLU TEST RANGE OF LOGICAL UNIT SCAD MODM0300845 RR ENA 2 MASK FOR READ TYPE DEVICE SCAD MODM0300846 RR LDQ+ LOG1A,Q GET POINTER TO PHYSTB SCAD MODM0300847 RR AND- 8,Q TEST IF DEVICE IS READ TYPE SCAD MODM0300848 RR SAN READOK IF NOT ZERO, OK SCAD MODM0300849 RR JMP* UNITER IF ZERO, REJECT THE REQUEST SCAD MODM0300850 RR* SCAD MODM0300851 RRREADOK RTJ* TSTCLS CHECK DEVICE CLASS SCAD MODM0300852 RR LDA* TEMP GET LOGICAL UNIT AGAIN SCAD MODM0300853 RR STA+ INPTV4 STORE IN JOB INPUT DEVICE SLOT SCAD MODM0300854 RR STA+ AUTF9 AND AUTF9 SLOT IN TRVEC. SCAD MODM0300855 RR STA- $F9 STORE IN COMMUNICATIONS REGION SCAD MODM0300856 RR JMP MIDONE EXIT M0300857 RR* SCAD MODM0300858 RR* SCAD MODM0300859 RR EJT SCAD MODM0300860 RR* ROUTINE TO CHANGE THE JOB PROCESSOR LIST DEVICE SCAD MODM0300861 RR* SCAD MODM0300862 RR* JLT,NN CHANGE JOB PROCESSOR LIST SCAD MODM0300863 RR* DEVICE TO LU NN. SCAD MODM0300864 RR* SCAD MODM0300865 RR* NOTE: NN MAY BE A 1 OR 2 CHAR SCAD MODM0300866 RR* DECIMAL LOGICAL UNIT SCAD MODM0300867 RR* NUMBER. SCAD MODM0300868 RR* SCAD MODM0300869 RR SPC 2 M0300870 RR* SCAD MODM0300871 RR EXT AUTFB JOB PROCESSOR LIST LOGICAL UNIT SCAD MODM0300872 RR* SCAD MODM0300873 RR SPC 2 SCAD MODM0300874 RRJOBLST RTJ* GETLU PICK UP LOGICAL UNIT SCAD MODM0300875 RR RTJ* TSTLU TEST RANGE OF LOGICAL UNIT SCAD MODM0300876 RR ENA 4 MASK FOR WRITE TYPE DEVICE SCAD MODM0300877 RR LDQ+ LOG1A,Q GET POINTER TO PHYSTB SCAD MODM0300878 RR AND- 8,Q TEST IF DEVICE IS WRITE TYPE SCAD MODM0300879 RR SAN WRITOK IF NOT ZERO, OK SCAD MODM0300880 RR JMP* UNITER IF ZERO, REJECT THE REQUEST SCAD MODM0300881 RR* SCAD MODM0300882 RRWRITOK RTJ* TSTCLS CHECK DEVICE CLASS SCAD MODM0300883 RR LDA* TEMP GET LOGICAL UNIT AGAIN SCAD MODM0300884 RR STA+ AUTFB STORE IN JOB LIST DEVICE SLOT SCAD MODM0300885 RR STA- $FB STORE IN COMMUNICATIONS REGION SCAD MODM0300886 RR LDQ- $E9 ADDR OF EXTENDED CORE TABLE SCAD MODM0300887 RR STA- 3,Q STORE IN CSYLST IN EXT CORE TABLE SCAD MODM0300888 RR JMP MIDONE EXIT M0300889 RR* ONE CARD DELETED 127-5180M0300890 RR* SCAD MODM0300891 RR* SCAD MODM0300892 RR EJT SCAD MODM0300893 RR* ROUTINE TO CHANGE STANDARD LOGICAL UNITS SCAD MODM0300894 RR* SCAD MODM0300895 RR* INP,NN CHANGE STD INPUT DEV TO LU NN SCAD MODM0300896 RR* OUT,NN CHANGE STD OUTPUT DEV TO LU NN SCAD MODM0300897 RR* LST,NN CHANGE STD LIST DEV TO LU NN SCAD MODM0300898 RR* SCAD MODM0300899 RR* NOTE: NN MAY BE A 1 OR 2 CHAR SCAD MODM0300900 RR* DECIMAL LOGICAL UNIT SCAD MODM0300901 RR* NUMBER. SCAD MODM0300902 RR* SCAD MODM0300903 RR SPC 2 SCAD MODM0300904 RRSTDEV LDA FUNCTN+5,I SAVE FLAG FOR SCAD MODM0300905 RR STA* DEVFLG STD DEVICE TYPE. SCAD MODM0300906 RR RTJ* GETLU PICK UP LOGICAL UNIT SCAD MODM0300907 RR RTJ* TSTLU TEST RANGE OF LOGICAL UNIT SCAD MODM0300908 RR LDA* DEVFLG GET DEVICE TYPE FLAG SCAD MODM0300909 RR SAN WRTDEV IF .NE. 0, DEVICE MUST WRITE SCAD MODM0300910 RR ENA 2 IF .EQ. 0, DEVICE MUST READ SCAD MODM0300911 RR JMP* CHKTYP SCAD MODM0300912 RRWRTDEV ENA 4 SCAD MODM0300913 RRCHKTYP LDQ+ LOG1A,Q GET POINTER TO PHYSTB SCAD MODM0300914 RR AND- 8,Q TEST IF DEVICE HAS CORRECT MODE SCAD MODM0300915 RR SAN CAPOK IF NOT ZERO, OK SCAD MODM0300916 RR JMP* UNITER IF ZERO, REJECT THE REQUEST SCAD MODM0300917 RR* SCAD MODM0300918 RRCAPOK RTJ* TSTCLS CHECK DEVICE CLASS SCAD MODM0300919 RR LDQ* DEVFLG GET STD DEVICE TYPE SCAD MODM0300920 RR LDA* TEMP GET LU SCAD MODM0300921 RR STA- $F9,Q STORE IN COMMUN. REGION SLOT SCAD MODM0300922 RR* SCAD MODM0300923 RR* SCAD MODM0300924 RRDEVFLG NUM 0 SCAD MODM0300925 RRTEMP NUM 0 SCAD MODM0300926 RR* SCAD MODM0300927 RR* SCAD MODM0300928 RR SPC 3 SCAD MODM0300929 RRDCK NUM 0 SCAD MODM0300930 RR AND- LPMSK+8 ISOLATE CHAR SCAD MODM0300931 RR INA -$30 TEST FOR SCAD MODM0300932 RR SAM DER RANGE IS 0 SCAD MODM0300933 RR INA -$A TO 9. SCAD MODM0300934 RR SAM DOK SCAD MODM0300935 RRDER JMP ERROR SCAD MODM0300936 RRDOK INA $A SCAD MODM0300937 RR AND- LPMSK+4 ISOLATE HEX VALUE SCAD MODM0300938 RR JMP* (DCK) SCAD MODM0300939 RR* SCAD MODM0300940 RR* SCAD MODM0300941 RR SPC 3 SCAD MODM0300942 RRGETLU NUM 0 SCAD MODM0300943 RR LDA- 2,Q GET LU CHARS SCAD MODM0300944 RR AND- LPMSK+8 IS LU ONE SCAD MODM0300945 RR SUB- LPMSK+8 OR TWO CHARS. SCAD MODM0300946 RR SAN TWOCHR NOT ZERO, TWO CHARS SCAD MODM0300947 RR LDA- 2,Q GET AND SCAD MODM0300948 RR ALS 8 ISOLATE CHAR. SCAD MODM0300949 RR JMP* ONECHR SCAD MODM0300950 RR* SCAD MODM0300951 RRTWOCHR LDA- 2,Q GET AND SCAD MODM0300952 RR ALS 8 ISOLATE 1ST CHAR. SCAD MODM0300953 RR RTJ* DCK CHECK IF A DECIMAL DIGIT SCAD MODM0300954 RR ALS 4 SCAD MODM0300955 RR STA* TEMP SAVE IT SCAD MODM0300956 RR LDA- 2,Q GET 2ND CHAR SCAD MODM0300957 RRONECHR RTJ* DCK CHECK IF A DECIMAL DIGIT SCAD MODM0300958 RR JMP* (GETLU) SCAD MODM0300959 RR* SCAD MODM0300960 RR* SCAD MODM0300961 RR SPC 3 SCAD MODM0300962 RRTSTLU NUM 0 SCAD MODM0300963 RR ADD* TEMP COMBINE WITH 1ST CHAR SCAD MODM0300964 RR RTJ DEOCT CONVERT FROM DEC TO HEX SCAD MODM0300965 RR STA* TEMP SAVE IT SCAD MODM0300966 RR TRA Q PLACE IN Q REG SCAD MODM0300967 RR INA -2 SCAD MODM0300968 RR SAM UNITER IF LU IS .LE. 1 -- AN ERROR SCAD MODM0300969 RR LDA+ LOG1A SCAD MODM0300970 RR SUB* TEMP TEST IF LU IS TOO LARGE SCAD MODM0300971 RR SAP RNGOK SCAD MODM0300972 RRUNITER JMP ERROR YES, INPUT ERROR SCAD MODM0300973 RR* SCAD MODM0300974 RRRNGOK JMP* (TSTLU) SCAD MODM0300975 RR* SCAD MODM0300976 RR* SCAD MODM0300977 RR SPC 3 SCAD MODM0300978 RRTSTCLS NUM 0 PHYSTB ADDRESS IN Q-REG SCAD MODM0300979 RR LDA- 8,Q GET AND ISOLATE EQUIPMENT CLASS SCAD MODM0300980 RR ALS 5 SCAD MODM0300981 RR AND- LPMSK+3 SCAD MODM0300982 RR SAZ CLSERR IS CLASS 0 (UNDEFINED) -- ERROR SCAD MODM0300983 RR INA -2 SCAD MODM0300984 RR SAZ CLSERR IS CLASS 2 (MASS MEM) -- ERROR SCAD MODM0300985 RR INA -5 SCAD MODM0300986 RR SAZ CLSERR IS CLASS 7 (RESERVED) -- ERROR SCAD MODM0300987 RR JMP* (TSTCLS) SCAD MODM0300988 RR* SCAD MODM0300989 RRCLSERR JMP* UNITER REPORT ERROR SCAD MODM0300990 RR* SCAD MODM0300991 RR* SCAD MODM0300992 RR EJT SCAD MODM0300993 RR* ROUTINE TO CHANGE CARD READER AND PUNCH MODES SCAD MODM0300994 RR* SCAD MODM0300995 RR* (1829-30/60) CARD26 CHANGE TO 026 MODE SCAD MODM0300996 RR* (1829-30/60) CARD29 CHANGE TO 029 MODE SCAD MODM0300997 RR* SCAD MODM0300998 RR* SCAD MODM0300999 RR EXT P1829 PHYSTB FOR 1829-30/60 SCAD MODM0301000 RR* SCAD MODM0301001 RRCARDMD STQ* CRDFLG SAVE Q REGISTER SCAD MODM0301002 RR LDQ FUNCTN+4,I GET DEVICE INDEX SCAD MODM0301003 RR LDA* CRDTBL,Q GET PHYSTB ADDRESS SCAD MODM0301004 RR EOR- LPMSK+15 IS PHYSTB PATCHED SCAD MODM0301005 RR SAN CRDPOK YES, CONTINUE SCAD MODM0301006 RR JMP* CRDERR NO, REPORT ERROR SCAD MODM0301007 RR* SCAD MODM0301008 RRCRDPOK LDQ* CRDFLG RESTORE Q REGISTER SCAD MODM0301009 RR LDA FUNCTN+5,I SAVE READER SCAD MODM0301010 RR STA* CRDFLG OR PUNCH FLAG. SCAD MODM0301011 RR LDA- 2,Q GET 26 OR 29 MESSAGE SCAD MODM0301012 RR SUB =N$3236 IS IT 26 SCAD MODM0301013 RR SAZ IS026-*-1 YES SCAD MODM0301014 RR LDA- 2,Q NO, GET MESSAGE AGAIN SCAD MODM0301015 RR SUB =N$3239 IS IT 29 SCAD MODM0301016 RR SAZ IS029-*-1 YES SCAD MODM0301017 RRCRDERR JMP ERROR NOT 26 OR 29 -- AN INPUT ERROR SCAD MODM0301018 RR* SCAD MODM0301019 RRIS029 ENA 1 IS 029, SET FLAG SCAD MODM0301020 RRIS026 LDQ FUNCTN+4,I GET DEVICE INDEX INTO TABLE SCAD MODM0301021 RR LDQ* CRDTBL,Q SCAD MODM0301022 RR ADQ* CRDFLG GET FLAG FOR READ OR PUNCH SCAD MODM0301023 RR STA- (ZERO),Q SET OR CLEAR MODE FLAG SLOT SCAD MODM0301024 RR JMP MIDONE EXIT M0301025 RR* SCAD MODM0301026 RR* SCAD MODM0301027 RRCRDFLG NUM 0 SCAD MODM0301028 RR* SCAD MODM0301029 RRCRDTBL ADC P1829 PHYSTB FOR 1829-30/60 SCAD MODM0301030 RR ADC $7FFF NO PUNCH FOR ITOS M0301031 RR* SCAD MODM0301032 RR* SCAD MODM0301033 RR EJT SCAD MODM0301034 RR* ROUTINE TO REWIND MAG TAPE 'LU' SCAD MODM0301035 RR* SCAD MODM0301036 RR SPC 2 SCAD MODM0301037 RRREWMGT RTJ* GETLU PICK UP LOGICAL UNIT SCAD MODM0301038 RR RTJ* TSTLU TEST LOGICAL UNIT RANGE M0301039 RR* SCAD MODM0301040 RR STQ* TEMPLU SAVE LU NUMBER IN REQUEST SCAD MODM0301041 RR LDQ+ LOG1A,Q GET PHYSTB LOCATION SCAD MODM0301042 RR LDA- 8,Q ISOLATE SCAD MODM0301043 RR ALS 5 EQUIPMENT SCAD MODM0301044 RR AND- LPMSK+3 CLASS. SCAD MODM0301045 RR INA -1 IS IT MAG TAPE CLASS SCAD MODM0301046 RR SAZ TAPOK2 YES, CONTINUE SCAD MODM0301047 RR JMP ERROR NO -- INPUT ERROR SCAD MODM0301048 RR* SCAD MODM0301049 RRTAPOK2 RTJ- (AMONI) TAPE MOTION REQUEST FOR REWIND SCAD MODM0301050 RR VFD N1/0,N1/0,N5/14,N1/1,N4/3,N4/3 SCAD MODM0301051 RR ADC MIDONE-*+1 M0301052 RR NUM 0 SCAD MODM0301053 RRTEMPLU NUM 0 SCAD MODM0301054 RR VFD N4/3,N4/0,N4/0,N4/0 SCAD MODM0301055 RR* SCAD MODM0301056 RR JMP- (ADISP) SCAD MODM0301057 RR* SCAD MODM0301058 RR* SCAD MODM0301059 RR EJT SCAD MODM0301060 RR* M0301061 RR* RSV RESERVE SPACE FOR COMM18 SIMULATORS M0301062 RR* M0301063 RR EXT* LOCATE M0301064 RR EXT COMM18 M0301065 RR EXT* XMRESV M0301066 RR EXT* XMRETN M0301067 RR EXT JOBIND,SWTCH M0301068 RR* M0301069 RR* M0301070 RRRSV LDA- I SAVE I M0301071 RR STA* ISAV+1 M0301072 RR LDA JOBIND SEE IF BACKGROUND BATCH IS ACTIVE M0301073 RR SAZ RSV02 M0301074 RR JMP* RSV03 M0301075 RRRSV02 LDA SWTCH M0301076 RR SAZ RSV08 M0301077 RRRSV03 LDA- $F7 BATCH IS BUSY, SEE IF THEY USE THE SAME AREA M0301078 RR INA 1 M0301079 RR SUB TSAREA M0301080 RR SAZ RSV08 USE DIFFERENT AREAS GO AND LOAD COMM18 M0301081 RR JMP ERROR M0301082 RR* M0301083 RRRSV08 LDA COMM18 SEE IF COMM18 ALREADY ACTIVE M0301084 RR SAZ RSV10 M0301085 RR JMP* ISAV ALREADY ACTIVE M0301086 RR SPC 2 M0301087 RR* SEE IF COMM18 IN PROGRAM LIBRARY M0301088 RR* M0301089 RRRSV10 RTJ* CNAME PICKUP ADDRESS OF COMM18 NAME IN Q M0301090 RR RTJ LOCATE M0301091 RR SAP RSV20 M0301092 RR JMP ERROR NOT IN PROGRAM LIBRARY M0301093 RRRSV20 STA* MSECTR START SECTOR M0301094 RR STQ* MLGTH LENGTH OF COMM18 M0301095 RR SPC 2 M0301096 RR* M0301097 RR* DETERMINE NUMBER OF PAGES TO ALLOCATE M0301098 RR* M0301099 RR RTJ* NPAGES M0301100 RR SPC 2 M0301101 RR* GO ALLOCATE MEMORY M0301102 RR* M0301103 RR RTJ XMRESV M0301104 RR SPC 2 M0301105 RR* READ OVER FILE INTO AREA ALLOCATED M0301106 RR RTJ FILRED M0301107 RR SQP RSV30 M0301108 RR JMP ERROR READ ERROR M0301109 RRRSV30 LDQ =XPARTBL M0301110 RR LDQ- 2,Q M0301111 RR ENA 1 M0301112 RR RTJ- (ZERO),Q GO INITIALIZE COMM18 M0301113 RRISAV LDA =N0 M0301114 RR STA- I RESTORE I M0301115 RR JMP GETIND M0301116 RR EJT M0301117 RR* M0301118 RR* SCOM STOP COMM18 AFTER ALL SIMULATORS HAVE BEEN M0301119 RR* RELEASED. M0301120 RR SPC 2 M0301121 RRCOMSTP LDA COMM18 SEE IF COMM18 ALREADY RELEASED M0301122 RR SAN SCOM10 M0301123 RR JMP ERROR ALREADY RELEASED M0301124 RR SPC 2 M0301125 RR* SEARCH PROGRAM LIBRARY FOR COMM18 M0301126 RR* M0301127 RRSCOM10 RTJ* CNAME PICKUP ADDRESS OF COMM18 NAME IN Q M0301128 RR RTJ LOCATE SEARCH LIBRARY M0301129 RR SAP SCOM20 M0301130 RR JMP ERROR NOT IN SYSTEM M0301131 RR SPC 2 M0301132 RR* UNPATCH COMM18 FROM SYSDAT M0301133 RR* M0301134 RRSCOM20 STQ* MLGTH SAVE LENGTH M0301135 RR LDQ =XPARTBL M0301136 RR LDQ- 2,Q M0301137 RR ENA 0 M0301138 RR RTJ- (ZERO),Q RELEASE COMM18 FROM SYSDAT M0301139 RR SPC 2 M0301140 RR* RELEASE USER AREA BACK TO ITOS EXECUTIVE M0301141 RR* M0301142 RR RTJ* NPAGES DETERMINE NUMBER OF PAGES TO RELASE M0301143 RR RTJ XMRETN M0301144 RR JMP MIDONE M0301145 RR EJT M0301146 RR* READ FILE FROM PROGRAM LIBRARY M0301147 RR* M0301148 RR* M0301149 RRFILRED NOP 0 M0301150 RR RTJ* FILR1 M0301151 RRFILR1 NUM 0 M0301152 RR LDA* FILR1 M0301153 RR INA COMPLA M0301154 RR STA* FILCOM M0301155 RR LDQ =XPARTBL M0301156 RR LDA- 2,Q M0301157 RR STA* MBUFAD M0301158 RR* M0301159 RR RTJ- (AMONI) M0301160 RR ADC $4844 M0301161 RRFILCOM NUM 0 M0301162 RR ADC 0,$08C2 M0301163 RRMLGTH NUM 0 M0301164 RRMBUFAD NUM 0 M0301165 RR ADC 0 M0301166 RRMSECTR ADC 0 M0301167 RR JMP- (ADISP) M0301168 RR EQU COMPLA(*-FILR1) M0301169 RRCOMPL JMP* (FILRED) M0301170 RR EJT M0301171 RR* M0301172 RR* CNAME STUFF INTO Q THE ADDRESS OF THE NAME OF COMM18 M0301173 RR* M0301174 RRCNAME NOP 0 M0301175 RR RTJ* RSVXX M0301176 RRRSVXX NUM 0 M0301177 RR LDQ* RSVXX M0301178 RR INQ COMADD M0301179 RR JMP* (CNAME) M0301180 RRCOMNAM ALF 3,COMM18 M0301181 RR EQU COMADD(COMNAM-RSVXX) M0301182 RR EJT M0301183 RR* M0301184 RR* NPAGES DETERMINES THE NUMBER OF PAGES TO ALLOCATE M0301185 RR* AND RETURNS THE INFO. IN A,Q M0301186 RR* M0301187 RRNPAGES NOP 0 M0301188 RR LDQ =XPARTBL M0301189 RR LDA- 2,Q M0301190 RR SUB- 1,Q A = SIZE OF PARTITION (1) M0301191 RR ADD* MLGTH DETERMINE THE NUMBER OF PAGES REQUIRED M0301192 RR ENQ 0 M0301193 RR LLS 5 M0301194 RR SAZ PAGE1 M0301195 RR INQ 1 M0301196 RRPAGE1 LDA TSAREA M0301197 RR AND- $1D $F800 M0301198 RR JMP* (NPAGES) M0301199 RRMIPROC EQU MIPROC(MIPRO) M0301200 RR END MIPROC M0301201 RR NAM JCRDV4 M05 A ITOS CCS 3.0 SL-149M0500001 RR* MASS STORAGE OPERATING SYSTEM VERSION 5.0 M0500002 RR* SMALL SYSTEMS DIVISION, LA JOLLA, CALIFORNIA M0500003 RR* COPYRIGHT CONTROL DATA CORPORATION 1976 M0500004 RR SPC 2 M0500005 RR* JCRDV4-STATEMENT PROCESSOR FOR *JOB, *CTO, *PAUS **MSOS 4.0M0500006 RR SPC 1 **MSOS 4.0M0500007 RR ENT CRDV4 **MSOS 4.0M0500008 RR EXT JBPROE **MSOS 4.0M0500009 RR EXT MIBUF **MSOS 4.0M0500010 RR EXT TRNVEC **MSOS 4.0M0500011 RR EXT AUTF9 (TRVEC) M0500012 RR EXT AUTFA (TRVEC) M0500013 RR EXT AUTFB (TRVEC) M0500014 RR EXT FILE2 **MSOS 4.0M0500015 RR EXT MIB M0500016 RR EXT LOG1A M0500017 RR EXT FMPFLG FILEMANAGER M0500018 RR EXT LOG1A M0500019 RR EQU EQ(8) M0500020 RR EQU LPMSK(2) M0500021 RR EQU H0007($5) M0500022 RR EQU M7FFF($42) M0500023 RR EQU HFF(10) **MSOS 4.0M0500024 RR SPC 1 **MSOS 4.0M0500025 RRCRDV4 NUM $C8FE **MSOS 4.0M0500026 RR STA ABS M0500027 RR STA (F2) SET JCRDV4 ADDRESS IN FILE2 M0500028 RR CLR A **MSOS 4.0M0500029 RR STA MIB CLEAR LOCKOUT **MSOS 4.0M0500030 RR LDA MIBUF ADDRESS OF INPUT BUFFER **MSOS 4.0M0500031 RR STA ISAVE M0500032 RR STA- I **MSOS 4.0M0500033 RR LDA- 2,I **MSOS 4.0M0500034 RR LDQ- 1,I **MSOS 4.0M0500035 RR LRS 8 **MSOS 4.0M0500036 RR LDQ TRNVEC TRANTA TABLE ADD. IN JOBENT **MSOS 4.0M0500037 RR EQU TARD(*-1) **MSOS 4.0M0500038 RR LDQ- 10,Q J.P. REQUEST CODE **MSOS 4.0M0500039 RR INQ -13 M0500040 RR LDQ* TAB,Q **MSOS 4.0M0500041 RR JMP* CRDV4,Q GO TO PROPER ROUTINE **MSOS 4.0M0500042 RRTAB ADC JO-CRDV4 **MSOS 4.0M0500043 RR ADC CTO-CRDV4 **MSOS 4.0M0500044 RR ADC PA-CRDV4 **MSOS 4.0M0500045 RRCTO SUB =N$4F2C LOOK FOR O, **MSOS 4.0M0500046 RR SAZ CT1 FOUND IT **MSOS 4.0M0500047 RRLOAD ENA 2 NOT A $CTO GET JPLOAD AND **MSOS 4.0M0500048 RR JMP* EXIT+1 TRY TO LOAD IT **MSOS 4.0M0500049 RRCT1 ENQ L-1 INPUT BUFFER LENGTH-1 **MSOS 4.0M0500050 RR EQU L(36) **MSOS 4.0M0500051 RRCT2 LDA- (ZERO),B LAST WORD OF BUFFER **MSOS 4.0M0500052 RR EQU ZERO($22) **MSOS 4.0M0500053 RR INA 0 GET RID OF BACKGROUND **MSOS 4.0M0500054 RR SAZ CT3 **MSOS 4.0M0500055 RR STA* CTOBUF,Q OVERLAID BUFFER **MSOS 4.0M0500056 RR RAO* CWD BUMP WORD COUNT **MSOS 4.0M0500057 RRCT3 INQ -1 **MSOS 4.0M0500058 RR SQM CT4 **MSOS 4.0M0500059 RR JMP* CT2 GET MORE **MSOS 4.0M0500060 RRCT4 RTJ- ($F4) **MSOS 4.0M0500061 RRCT5 NUM $D00,0 **MSOS 4.0M0500062 RRTR NUM 0 **MSOS 4.0M0500063 RR NUM $18FC **MSOS 4.0M0500064 RRCWD NUM 0 **MSOS 4.0M0500065 RR ADC CTOBUF-CT5 **MSOS 4.0M0500066 RR LDA* TR **MSOS 4.0M0500067 RR SAZ 1 **MSOS 4.0M0500068 RR JMP* *-2 **MSOS 4.0M0500069 RR SQP 1 **MSOS 4.0M0500070 RR JMP* CT5-1 I/O ERROR TRY AGAIN **MSOS 4.0M0500071 RR ENA 1 SCHEDULE JBPRO **MSOS 4.0M0500072 RR JMP* EXIT **MSOS 4.0M0500073 RRCTOBUF BZS CTOBUF(36) M0500074 RRPA SUB =N$5553 WAS STATMENT PAUS **MSOS 4.0M0500075 RR SAN PAX **MSOS 4.0M0500076 RR LDA- 2,I MAKE SURE REST **MSOS 4.0M0500077 RR LDQ- 3,I IS BACKGROUND **MSOS 4.0M0500078 RR LLS 8 **MSOS 4.0M0500079 RR INA 0 **MSOS 4.0M0500080 RR SAZ PA1-1 YES **MSOS 4.0M0500081 RRPAX JMP* LOAD NO - TRY TO LOAD IT **MSOS 4.0M0500082 RR RTJ- ($F4) **MSOS 4.0M0500083 RRPA1 NUM $D00,0 **MSOS 4.0M0500084 RRTR1 NUM 0 **MSOS 4.0M0500085 RR NUM $18FC,3 **MSOS 4.0M0500086 RR ADC PABUF-PA1 READY **MSOS 4.0M0500087 RR LDA* TR1 **MSOS 4.0M0500088 RR SAZ PA2 **MSOS 4.0M0500089 RR JMP* *-2 **MSOS 4.0M0500090 RRPA2 LDA* TR1+1 127*5196M0500091 RR SAP PA3-1 127*5196M0500092 RR JMP* PA1-1 I/O ERROR TRY AGAIN **MSOS 4.0M0500093 RR RTJ- ($F4) INPUT A CR **MSOS 4.0M0500094 RRPA3 NUM $0900,0 127*5185M0500095 RRTR2 NUM 0 **MSOS 4.0M0500096 RR NUM $18FD,0 **MSOS 4.0M0500097 RR ADC CR-PA3 **MSOS 4.0M0500098 RR LDA* TR2 **MSOS 4.0M0500099 RR SAZ PA4 **MSOS 4.0M0500100 RR JMP* *-2 **MSOS 4.0M0500101 RRPA4 LDA* TR2+1 127*5196M0500102 RR SAP PA5 127*5196M0500103 RR JMP* PA1-1 I/O ERROR START OVER **MSOS 4.0M0500104 RRPA5 ENA 1 127*5185M0500105 RR JMP* EXIT **MSOS 4.0M0500106 RRCR NUM 0 **MSOS 4.0M0500107 RRPABUF ALF 3,READY? **MSOS 4.0M0500108 RRABS NUM 0 ABSOLUTE LOAD ADDRESS **MSOS 4.0M0500109 RRCHCT NUM 0 CHARACTER COUNT **MSOS 4.0M0500110 RR ENA 1 **MSOS 4.0M0500111 RREXIT ENQ 14 **MSOS 4.0M0500112 RR STA* RMOD **MSOS 4.0M0500113 RR LDA JBPROE **MSOS 4.0M0500114 RR STA- I **MSOS 4.0M0500115 RR LDA* RMOD **MSOS 4.0M0500116 RRERR JMP- (I) **MSOS 4.0M0500117 RR ENA 1 **MSOS 4.0M0500118 RR ENQ 6 TERMINATE IN JOBPRO **MSOS 4.0M0500119 RR JMP* EXIT+1 **MSOS 4.0M0500120 RRRMOD NUM 0 **MSOS 4.0M0500121 RR EQU PARAM(RMOD) **MSOS 4.0M0500122 RRF2 ADC FILE2 **MSOS 4.0M0500123 RRJO SUB =N$422C IS IT A B, **MSOS 4.0M0500124 RR EQU NAME(JO) **MSOS 4.0M0500125 RR SAZ JO1 YES **MSOS 4.0M0500126 RR SUB =N$D3 LOOK FOR BACKGROUND **MSOS 4.0M0500127 RR SAN JO11 **MSOS 4.0M0500128 RR RAO* PARAM JOB CARD NO PARAMETERS **MSOS 4.0M0500129 RR JMP* JO1 **MSOS 4.0M0500130 RRJO11 LDQ (TARD) IS A JOB IN PROGRESS M0500131 RR LDA- 12,Q M0500132 RR SAZ J012 NO, OUTPUT JP15 ERROR M0500133 RR JMP LOAD YES, LET JPLOAD HANDLE IT M0500134 RRJO1 LDQ (TARD) M0500135 RR LDA- 12,Q IS A JOB IN PROGRESS **MSOS 4.0M0500136 RR SAZ JO3 **MSOS 4.0M0500137 RRJ012 LDA =N$3135 OUTPUT JP15 ERROR M0500138 RR STA- 10,Q **MSOS 4.0M0500139 RR JMP* ERR+1 **MSOS 4.0M0500140 RRISAVE NUM 0 **MSOS 4.0M0500141 RRJO3 LDQ- $FB GET LIST LU M0500142 RR STQ* WEOFB+4 M0500143 RR LDQ LOG1A,Q GET PHYSTB ADDRESS M0500144 RR LDA- EQ,Q GET EQUIPMENT CLASS, TYPE M0500145 RR AND- LPMSK+14 M0500146 RR ARS 4 M0500147 RR SUB =N$28A IS LIST = BATCH OUTPUT DEVICE M0500148 RR SAN NOEOF SKIP IF NOT M0500149 RRWEOFB RTJ- ($F4) WRITE EOF TO LIST DEVICE M0500150 RR ADC $1D00 M0500151 RR ADC 0 M0500152 RRTR3 ADC 0 M0500153 RR ADC 0 M0500154 RR NUM $2000 M0500155 RRTRL LDA* TR3 M0500156 RR SAZ NOEOF M0500157 RR JMP* TRL M0500158 RRNOEOF LDQ (TARD) M0500159 RR LDA+ AUTF9 RESTORE LOCATIONS $F9,FA,FB M0500160 RR STA- $F9 TO AUTOLOAD VALUES M0500161 RR LDA+ AUTFA IN CASE M0500162 RR STA- $FA PREVIOUS USER M0500163 RR LDA+ AUTFB HAS CHANGED THEM M0500164 RR STA- $FB TO SUIT HIS OWN PURPOSES M0500165 RR LDA FMPFLG IS FILE MANAGER PRESENT M0500166 RR EOR- M7FFF SEE IF UNPATCHED M0500167 RR SAN JO31 M0500168 RR STA FMPFLG CLEAR FMPFLG JUST IN CASE SOMEONE SET IT M0500169 RRJO31 RAO- 12,Q M0500170 RR LDA* PARAM **MSOS 4.0M0500171 RR SAZ JO33 **MSOS 4.0M0500172 RR SET A FLAG ABSENSE OF NAME **MSOS 4.0M0500173 RR STA- 15,Q **MSOS 4.0M0500174 RR JMP* JO1A-1 **MSOS 4.0M0500175 RRJO33 RAO- I **MSOS 4.0M0500176 RR RAO- I **MSOS 4.0M0500177 RR ENQ 6 M0500178 RR ENA $20 M0500179 RRBLN STA* NAME,Q BLANK OUT NAME BUFFER M0500180 RR INQ -1 M0500181 RR SQM 1 M0500182 RR JMP* BLN M0500183 RRGOON RTJ* CRACK GET THE JOB NAME **MSOS 4.0M0500184 RR LDA* CT M0500185 RR SAN 1 M0500186 RR JMP* ERRX M0500187 RR ENA 15 M0500188 RR RTJ PACK PUT NAME IN WORD 15 OF TRANTA M0500189 RR ENA 0 **MSOS 4.0M0500190 RR STA* CT **MSOS 4.0M0500191 RR RTJ* CRACK GET THE ACCOUNT NUMBER **MSOS 4.0M0500192 RR LDA* CT M0500193 RR SAN 1 M0500194 RR JMP* ERRX M0500195 RR ENA 18 M0500196 RR RTJ PACK PUT ACCT. IN WORD 18 OF TRANTA M0500197 RR LDA* ISAVE **MSOS 4.0M0500198 RR STA- I **MSOS 4.0M0500199 RR ENQ L-1 **MSOS 4.0M0500200 RRJO1A LDA- (ZERO),B **MSOS 4.0M0500201 RR INA 0 **MSOS 4.0M0500202 RR SAZ JO2 **MSOS 4.0M0500203 RR STA CTOBUF,Q M0500204 RRJO2 INQ -1 **MSOS 4.0M0500205 RR SQM JO3A **MSOS 4.0M0500206 RR JMP* JO1A **MSOS 4.0M0500207 RRJO3A LDA- $FB STANDARD LIST **MSOS 4.0M0500208 RR SUB- $FC LU OF OUTPUT COMMENT DEVICE M0500209 RR SAN TAG100 LIST AND COMMENT UNITS NOT THE SAME M0500210 RR JMP* EXIT-1 SAME - DO NOT PRINT TWICE M0500211 RRTAG100 LDA- $FB M0500212 RR EOR- $2F ADD MOBE BIT **MSOS 4.0M0500213 RR STA* LU **MSOS 4.0M0500214 RR LDA* ABS **MSOS 4.0M0500215 RR ADD =XCTOBUF-CRDV4 **MSOS 4.0M0500216 RR STA* BF **MSOS 4.0M0500217 RR LDA CTOBUF **MSOS 4.0M0500218 RR SUB =N$1E00 CHANGE THE * TO A **MSOS 4.0M0500219 RR STA CTOBUF PAGE EJECT($0C) **MSOS 4.0M0500220 RR RTJ- ($F4) **MSOS 4.0M0500221 RRJO5 NUM $C00,0 **MSOS 4.0M0500222 RRTR4 NUM 0 **MSOS 4.0M0500223 RRLU NUM 0 **MSOS 4.0M0500224 RRWORDS NUM $24 M0500225 RRBF ADC 0 **MSOS 4.0M0500226 RR LDA* TR4 **MSOS 4.0M0500227 RR SAZ JO6 **MSOS 4.0M0500228 RR JMP* *-2 **MSOS 4.0M0500229 RRJO6 SQP JO7 **MSOS 4.0M0500230 RR JMP* JO5-1 I/O ERROR **MSOS 4.0M0500231 RRJO7 LDQ- $FB LU OF STD LIST DEVICE M0500232 RR LDQ LOG1A,Q PHYSTB ADDRESS TO Q M0500233 RR LDA- 8,Q WORD 8 OF PHYSTB TO A M0500234 RR ARS 11 CLASS CODE TO A 2-0 M0500235 RR AND- H0007 MASK OFF UPPER BITS M0500236 RR INA -6 CHECK FOR TTY CLASS M0500237 RR SAZ JO7A DONT PRINT BLOCK JOB NAME IF TTY M0500238 RR ENA 8 **MSOS 4.0M0500239 RR JMP EXIT PRINT THE NAME M0500240 RRJO7A JMP EXIT-1 DON'T PRINT IT M0500241 RRCT NUM 0 M0500242 RRCRACK NOP 0 **MSOS 4.0M0500243 RRJO41 LDA* RL M0500244 RR SAZ 1 **MSOS 4.0M0500245 RR JMP* JO4B COMMA WAS IN RIGHT CHAR. POSITION **MSOS 4.0M0500246 RRJO4A LDA- (ZERO),I **MSOS 4.0M0500247 RR AND- HFF **MSOS 4.0M0500248 RR RTJ* SUB **MSOS 4.0M0500249 RR SQZ 1 **MSOS 4.0M0500250 RR JMP* ASCH1 END OF FIELD **MSOS 4.0M0500251 RR SAN 1 **MSOS 4.0M0500252 RR JMP* ASCH2 **MSOS 4.0M0500253 RR RAO* CT M0500254 RR LDQ* CT INDEX **MSOS 4.0M0500255 RR STA NAME,Q M0500256 RRJO4B RAO- I **MSOS 4.0M0500257 RR LDA- (ZERO),I **MSOS 4.0M0500258 RR TRA Q **MSOS 4.0M0500259 RRJO4 ADQ =N$D3D3 **MSOS 4.0M0500260 RR SQN 1 **MSOS 4.0M0500261 RR JMP* ERRX TWO COMMAS IN A ROW **MSOS 4.0M0500262 RR ARS 8 **MSOS 4.0M0500263 RR AND- HFF **MSOS 4.0M0500264 RR RTJ* SUB **MSOS 4.0M0500265 RR SQN ASCH1 END OF FIELD **MSOS 4.0M0500266 RR SAZ ASCH1 COMMA **MSOS 4.0M0500267 RR RAO* CT M0500268 RR LDQ* CT INDEX **MSOS 4.0M0500269 RR STA NAME,Q **MSOS 4.0M0500270 RR JMP* JO41 **MSOS 4.0M0500271 RRASCH2 ENA 1 M0500272 RR STA* RL M0500273 RR JMP* (CRACK) M0500274 RRASCH1 ENA 0 M0500275 RR STA* RL M0500276 RR JMP* (CRACK) M0500277 RRERRX LDQ (TARD) **MSOS 4.0M0500278 RR LDA =N$3033 **MSOS 4.0M0500279 RR STA- 10,Q **MSOS 4.0M0500280 RR JMP ERR+1 **MSOS 4.0M0500281 RRSUB NOP 0 **MSOS 4.0M0500282 RR ENQ $2C COMMA **MSOS 4.0M0500283 RR EAQ Q **MSOS 4.0M0500284 RR SQN SUB2 **MSOS 4.0M0500285 RRSUB5 ENA 0 **MSOS 4.0M0500286 RR ENQ 0 **MSOS 4.0M0500287 RR JMP* (SUB) **MSOS 4.0M0500288 RRSUB0 SET Q **MSOS 4.0M0500289 RRSUB1 JMP* (SUB) **MSOS 4.0M0500290 RRSUB2 LDQ- HFF **MSOS 4.0M0500291 RR EAQ Q **MSOS 4.0M0500292 RR SQZ SUB2A **MSOS 4.0M0500293 RR ENQ $20 **MSOS 4.0M0500294 RR EAQ Q **MSOS 4.0M0500295 RR SQN SUB3 **MSOS 4.0M0500296 RRSUB2A JMP* SUB0 **MSOS 4.0M0500297 RRSUB3 JMP* SUB5+1 **MSOS 4.0M0500298 RRRL NUM 0 M0500299 RRPACK NUM 0 M0500300 RR LDQ (TARD) M0500301 RR AAQ Q M0500302 RR STQ* ADR M0500303 RR ENQ 1 M0500304 RRANOT LDA NAME,Q M0500305 RR ALS 8 M0500306 RR INQ 1 M0500307 RR ADD NAME,Q M0500308 RR STA* (ADR) M0500309 RR RAO* ADR M0500310 RR INQ 1 M0500311 RR INQ -7 M0500312 RR SQZ DONE M0500313 RR INQ 7 M0500314 RR JMP* ANOT M0500315 RRDONE JMP* (PACK) M0500316 RRADR NUM 0 M0500317 RR END M0500318 RR NAM CONTRL M06 A ITOS CCS 3.0 SL-149M0600001 RR* CONTROL STATEMENT PROCESSOR FOR SYSTEM INITIALIZER M0600002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 M0600003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA M0600004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 M0600005 RR* M0600006 RR SPC 2 M0600007 RR SPC 8 M0600008 RR* E N T R Y P O I N T T A B L E M0600009 RR SPC 3 M0600010 RR ENT RSTART STARTING ADDRESS OF SYSTEM INITIALIZER M0600011 RR ENT TCODE FLAG FOR SYSTEM DIRECTORY CORE OR MASS LOAD M0600012 RR ENT IN INPUT LOGICAL UNIT M0600013 RR ENT OU MASS STORAGE LOGICAL UNIT M0600014 RR ENT CO COMMENT DEVICE LOGICAL UNIT M0600015 RR ENT COMMA ENTRY TO TEST FOR COMMA AS FIELD DEVIMETER M0600016 RR ENT VALID ENTRY TO TEST FOR A VALID FIELD DELIMETER M0600017 RR ENT CM45 ENTRY TO READ IN NEXT CONTROL STATEMENT M0600018 RR ENT CM65 ROUTINE TO PROCESS NEXT CONTROL STATEMENT M0600019 RR ENT BACKGR ROUTINE TO BACKROUND INPUT BUFFER TO ALL ONES M0600020 RR ENT LSSECT NEXT AVAILABLE MASS STORAGE SECTOR M0600021 RR ENT TYPEQ ROUTINE TO GET NEXT CONTROL STATEMENT M0600022 RR* FROM COMMENT DEVICE M0600023 RR ENT QTYPE ROUTINE TO LOG ERRORS ON TTY M0600024 RR ENT ERFLAG FLAG INDICATING IF ANY LOADER ERRORS OCCURED M0600025 RR ENT FMXSEC ROUTINE TO FIND ADDRESS OF MAXSEC M0600026 RR EJT 1 M0600027 RR* E X T E R N A L T A B L E M0600028 RR SPC 5 M0600029 RR* EXTERNAL LOCATION IN 'IDRIV' TO PASS 'MSIZV4' M0600030 RR EXT* I2MZV4 'IDRIV' LOCATION TO BE CONTAINED 'MSIZV4' M0600031 RR EXT* I1 ROUTINE TO BUILD SYSTEM DIRECTORY M0600032 RR EXT* I2 CONTROL MODULE FOR MASS STORAGE DRIVERS M0600033 RR EXT* ISAV STARTING ADDRESS OF LOADER TABLE M0600034 RR EXT* CONENT ROUTINE TO INITIALIZE LOADER TABLE M0600035 RR EXT* CONMAS ROUTINE TO INITIALIZE MASS STORAGE CONSTANTS M0600036 RR EXT* CONMS1 ROUTINE TO BUILD PAGE FLAGS IN LDRTBL M0600037 RR EXT* CONMS M0600038 RR EXT* ILOAD START OF LOADER FUNCTION M0600039 RR EXT* TABLE TABLE OF LOGICAL UNITS IN IDRIV M0600040 RR EXT* IDRIV CONTROL MODULE FOR INPUT DEVICE DRIVERS M0600041 RR EXT* OETERM ROUTINE TO TEST FOR FIELD TERMINATORS - IN I2 M0600042 RR EXT* MDRIV MASS STORAGE DRIVER ENTRY M0600043 RR EXT* QCOM COMMENT DRIVER ENTRY M0600044 RR EXT* TELOUT ENTRY FOR TELETYPE OUTPUT - NOT COMMENT OUTPUTM0600045 RR EXT* IDRIV INPUT DRIVER ENTRY M0600046 RR EXT* FORMFD TOP OF FORM FUNCTION IN LPRINT M0600047 RR EXT* SIB STANDARD BINARY INPUT LOGICAL UNIT - IN IDRIV M0600048 RR EXT* MASS MASS STORAGE DEVICE LOGICAL UNIT - IN IDRIV M0600049 RR EXT* COLU COMMENT DEVICE LOGICAL UNIT - IN IDRIV M0600050 RR EXT* EPTAPE EQUIPMENT CODE FOR PAPER TAPE **MSOS 4.1**M0600051 RR EXT* ECARD EQUIPMENT CODE FOR CARD READER **MSOS 4.1**M0600052 RR EXT* EMTAPE EQUIPMENT CODE FOR MAG TAPE **MSOS 4.1**M0600053 RR EXT* EMASS EQUIPMENT CODE FOR MASS MEMORY M0600054 RR EXT* ECOM EQUIPMENT CODE FOR COMMENT **MSOS 4.1**M0600055 RR EXT* EPRINT EQUIPMENT CODE FOR PRINTER **MSOS 4.1**M0600056 RR EXT* ENTSTR ROUTINE TO STORE NEW ENTRY POINTS IN ILOAD M0600057 RR EXT* DISKWR ROUTINE TO STORE A WORD IN CSQ M0600058 RR EXT* WRTOUT ROUTINE TO WRITE OUT ALL PAGES THAT HAVE M0600059 RR* BEEN MODIFIED M0600060 RR EXT* HEADR1 DATE BUFFER IN LPRINT M0600061 RR EXT* FNDSEC ROUTINE TO CONVERT PAGE NUMBER TO SECTOR M0600062 RR EXT* LENSDT NUMBER OF CORE RESIDENT PAGES 66*1455 M0600063 RR EXT* DATBS0,DATLM0 DATA BASE AND LIMIT FOR PART 0 M0600064 RR EXT* DATBS1,DATLM1 DATA BASE AND LIMIT FOR PART 1 M0600065 RR EXT* PART1L MODIFIED LENGTH OF PART1 M0600066 RR EXT* PART1A MODIFIED ADDRESS OF PART1 M0600067 RR EXT* SIGNCK 65K SIGN CHECK ROUTINE M0600068 RR EXT* PART1C STARTING SECTOR OF PART1 IMAGE M0600069 RR EXT* PARSTR START ADDRESS OF PARTITION LOAD M0600070 RR EXT* QMASS MASS MEMORY DRIVER ENTRY M0600071 RR EJT 1 M0600072 RR* LOADER TABLE ENTRIES M0600073 RR EQU PGENUM(1) CELL FOR PAGE NUMBER IN FLAG TABLE ENTRY M0600074 RR EQU REFER(2) NUMBER OF TIMES A PAGE HAS BEEN MODIFIED M0600075 RR EQU MODIFY(3) FLAG SAYING THAT THIS PAGE HAS BEEN MODIFIED M0600076 RR SPC 3 M0600077 RR EQU COMBAS(1) RELOCATION BASE FOR COMMON STORAGE M0600078 RR EQU DATBAS(2) RELOCATION BASE FOR DATA STORAGE M0600079 RR EQU PROBAS(3) RELOCATION BASE FOR PROGRAM BEING LOADED M0600080 RR EQU COMLIM(4) HIGHEST ADDRESS OF COMMON STORAGE +1 M0600081 RR EQU DATLIM(5) HIGHEST ADDRESS OF DATA STORAGE +1 M0600082 RR EQU CSQLIM(6) HIGHEST ADDRESS OF COMMAND SEQUENCE STORAGE +1M0600083 RR EQU EXTCTR(7) NEXT AVAILABLE LOCATION IN EXTERNAL TABLE M0600084 RR EQU ENDSW(8) =1 IF LAST BYTE IN RBD OR BZS BLOCK M0600085 RR EQU ABRLSW(9) 0 IF ABSOLUTE EXTERNAL, 1 IF RELATIVE EXTERNALM0600086 RR EQU INPWRD(10) END OF COMMAND SEQUENCE STORAGE M0600087 RR EQU INPREL(11) CONTAINS RELATIVE FLAG FOR WORD OF COMMAND M0600088 RR* SEQUENCE IN RBD OR BZS BLOCK M0600089 RR EQU CSQNUM(12) NUMBER OF SECTORS RESERVED BEFORE START M0600090 RR* OF COMMAND SEQUENCE STORAGE M0600091 RR EQU ENTPNT(13) CONTAINS THE ADDRESS ASSOCIATED WITH THE M0600092 RR* NAME IN A ENTRY OR EXTERNAL BLOCK M0600093 RR EQU LINK(14) CONTAINS ADDRESS ASSOCIATED WITH NAME M0600094 RR* IN LOADER TABLE M0600095 RR EQU INPCTR(15) USED TO ADDRESS CORE LOCATION OF COMMAND M0600096 RR* SEQUENCE STORAGE AT LOAD TIME M0600097 RR* USED TO HOLD ADDRESS OF ENTRY FOR TABLE M0600098 RR* SEARCH AND TABLE STORE ROUTINES M0600099 RR EQU NOTLNK(16) FLAG =1 IF UNPATCHED EXTERNALS EXIST M0600100 RR EQU ENDINP(17) LAST STORAGE ADDRESS +1 AT END OF M0600101 RR* RELOCATABLE BINARY LOAD M0600102 RR EQU BLANKS(18) ASCII CODE FOR TWO SPACES M0600103 RR EQU SYMSTR(19) SET TO THE ASCII CODE FOR THE CHARACTERS IN M0600104 RR* EQU SYMSTR+1(20) THE FIELD BEING PROCESSED BY SCAN. IF FIELD M0600105 RR* EQU SYMSTR+2(21) IS NUMERIC SYMSTR=0. M0600106 RR EQU SCANSW(22) IF BIT ZERO =0 AND FIELD BEING PROCESSED IS M0600107 RR* NUMERIC, THE NUMBER WILL BE PROCESSED AS M0600108 RR* DECIMAL UNLESS PRECEEDED BY $ M0600109 RR* IF BIT ZERO =1 AND FIELD BEING PROCESSED IS M0600110 RR* NUMERIC, THE NUMBER WILL BE PROCESSED AS M0600111 RR* HEXIDECIMAL REGARDLESS OF OCCURENCE OF $ M0600112 RR EQU BASE(23) BASE OF SYSTEM INITIALIZER M0600113 RR EQU WRDCNT(24) CHARACTER REFERENCE COUNTER - SET TO STORAGE M0600114 RR* ADDRESS OF THE FIRST CHARACTER OF A FIELD M0600115 RR* TO BE PROCESSED. BIT ZERO IS R/L INDICATER M0600116 RR* 0 = FIRST CHARACTER IN LEFT HALF OF WORD M0600117 RR* 1 = FIRST CHARACTER IN RIGHT HALF OF WORD M0600118 RR EQU COUNT1(25) CHARACTER COUNTER- SET TO COMPLEMENT OF M0600119 RR* MAXIMUM NUMBER OF CHARACTERS A FIELD MAY HAVE M0600120 RR EQU BZSSW(26) USED BY SUBROUTINES COMMON TO RBDPRO AND M0600121 RR* BZSPRO TO DETERMINE BLOCK TYPE. M0600122 RR* 0= RBD BLOCK -1= BZS BLOCK M0600123 RR EQU COUNT2(27) COUNTER USED BY SCAN M0600124 RR EQU BLKCNT(27) BLOCK COUNTER CONTAINS WORD COUNT FOR M0600125 RR* NUMBER OF SEQUENTIAL LOCATIONS TO BE SET M0600126 RR* TO ZERO IN A BZS BLOCK ENTRY M0600127 RR EQU SW6(28) FLAGWORD FOR LOADER TABLE SEARCH ROUTINE M0600128 RR* =0 MATCH HAS BEEN FOUND IN TABLE M0600129 RR* =- (NEGATIVE) MATCHING NAME NOT FOUND M0600130 RR EQU ASAV(29) TEMPORY STORAGE FOR A-REQISTER M0600131 RR EQU QSAV(30) TEMPORY STORAGE FOR Q-REQISTER M0600132 RR* EQU ISAV(31) TEMPORY STORAGE FOR I-REQISTER M0600133 RR EQU XFRNAM(32) STORAGE OF SIX CHARACTER TRANSFER ADDRESS M0600134 RR EQU NAME(35) ASCII CODED INFORMATION M0600135 RR EQU SCHXIT(39) EXIT FROM TABLE SEARCH ROUTINE M0600136 RR EQU TABSCH(40) ENTRY ADDRESS FOR RTJ TO ROUTINE FOR M0600137 RR* SEARCHING LOADER TABLE FOR ENTRIES OR EXTERNALM0600138 RR EQU CENTAD(43) ADDRESS OF ENTRY BEING CURRENTLY EXAMINED M0600139 RR* IN ENTRY POINT TABLE M0600140 RR EQU MAXENT(44) LARGEST ADDRESS BEING USED IN ENTRY POINT TBL M0600141 RR EQU TEMP(45) TABLE OF TEMPORY LOCATIONS USED BY HASH M0600142 RR EQU NOJUMP(49) FLAG = 0 IF NO JUMP INSTRUCTION IS M0600143 RR* NEEDED TO JUMP AROUND DATA OR COMMON M0600144 RR EQU FLGLGN(50) NUMBER OF CORE FLAGS PER PAGE M0600145 RR EQU BINASC(51) STORAGE OF ASCII CODE FOR NUMBER CONVERSION M0600146 RR EQU PRINT3(54) ENTRY TO ERROR OUTPUT ROUTINE M0600147 RR EQU INPXC0(57) CONTAINS ADDRESS CONSTANT INPUT M0600148 RR EQU INPADR(57) SAME AS INPXCO - ADDRESS OF INPUT BUFFER M0600149 RR EQU INPXC1(58) CONTAINS ADDRESS CONSTANT INPUT + 1 M0600150 RR EQU PRINT2(59) ENTRY TO FATAL ERROR OUTPUT ROUTINE M0600151 RR EQU INPXCC(62) CONTAINS ADDRESS CONSTANT INPUT - 3 M0600152 RR EQU NXTINP(63) JMP INSTRUCTION TO READ NEXT BLOCK M0600153 RR EQU M7FFF(65) MASK OF $7FFF M0600154 RR EQU M8000(66) MASK OF $8000 M0600155 RR EQU MFF00(68) MASK OF $FF00 M0600156 RR EQU M00FF(69) MASK OF $00FF M0600157 RR EQU ASKII(70) ASCII MODE SWITCH FOR 405 AND MAG TAPE M0600158 RR EQU NEGSW(71) SET BY SCAN TO VALUE OF LEGAL ALGEBRAIC SIGN M0600159 RR EQU SCNTRM(72) SET BY SCAN TO ASCII CODE FOR FIELD TERMINATORM0600160 RR EQU SCNINP(73) SET BY SCAN TO THE BINARY VALUE OF A NUMERIC M0600161 RR* OPERAND AFTER ITS CONVERSION FROM ASCII M0600162 RR EQU SCNXIT(74) EXIT FROM SCAN ROUTINE M0600163 RR EQU SCAN(75) ENTRY TO SCAN ROUTINE M0600164 RR EQU CSNAME(78) CODE FOR CONTROL STATEMENT BEING PROCESSED M0600165 RR* =1 *Y STATEMENT M0600166 RR* =2 *YM STATEMENT M0600167 RR* =3 *L STATEMENT M0600168 RR* =4 *LP STATEMENT M0600169 RR* =5 *M STATEMENT M0600170 RR* =6 *MP STATEMENT M0600171 RR EQU XCSNAM(79) CODE FOR LAST CONTROL STATEMENT PROCESSED M0600172 RR EQU INMED(80) INPUT MEDIUM SWITCH M0600173 RR* 0 = USE COMMENT DEVICE M0600174 RR* 1 = USE STANDARD BINARY INPUT DEVICE M0600175 RR EQU ADJOVF(82) ENTRY CELL FOR ADDRESS ARITHMETIC SUBROUTINE M0600176 RR EQU EXTPCH(85) FLAG - NEGATIVE IF EXTERNAL NOT PATCHED M0600177 RR EQU NGRLSW(86) FLAG - 0= POSITIVE RELOCATION M0600178 RR* 1= NEGATIVE ADDRESS RELOCATION M0600179 RR EQU ARIT15(87) 0 = USE 15 BIT ARITHMETIC M0600180 RR* 1 = USE 16 BIT ARITHMETIC M0600181 RR EQU PRESET(88) USED TO HOLD CONTENTS OF A WORD READ INTO COREM0600182 RR* BY THE PAGING ROUTINE DURING A TABLE SEARCH M0600183 RR EQU CONVRT(90) ENTRY FOR BINARY TO ASCII CONVERSION ROUTINE M0600184 RR EQU AINPUT(101) A-REGISTER CONTENTS UPON ENTRY TO LOADER M0600185 RR EQU SYSPGE(102) NUMBER OF SYSTEM PAGES M0600186 RR EQU LINK1(104) ENTRY FOR LINK ROUTINE M0600187 RR EQU ENTPGS(107) STARTING ADDRESS OF ENTRY POINT TABLE *EXTRA* M0600188 RR EQU TOP(108) HIGHEST CORE LOCATION AVAILABLE FOR THIS LOAD M0600189 RR EQU PGEWRT(109) FLAG =1 IF ANY PAGE WRITTEN TO MASS STORAGE M0600190 RR EQU LGEPGE(110) LARGEST COMMAND SEQUENCE PAGE USED M0600191 RR EQU IGNORE(111) FLAG SAYING TO IGNORE DUPLICATE ENTRY POINTS M0600192 RR* WHEN LINKING *M OR *MP TO CREP OR CREP1 M0600193 RR EQU LNKSTR(112) ADDRESS OF LINK TABLE M0600194 RR EQU LNKCTR(113) NEXT AVAILABLE LOCATION IN LINK TABLE M0600195 RR EQU LNKEND(114) LAST ADDRESS +1 IN LINK TABLE M0600196 RR EQU ENTST0(115) STARTING ADDRESS OF PART 0 ENTRY POINTS M0600197 RR EQU ENTST1(116) STARTING ADDRESS OF PART 1 ENTRY POINTS M0600198 RR EQU EXTSTR(118) WORD ADDRESS OF START OF EXTERNAL TABLE M0600199 RR EQU CORADR(119) LOWEST LOCATION AVAILABLE FOR USE BY LOADER M0600200 RR EQU PRODAT(120) FLAG - NON-ZERO IF PROTECTED DATA IS DECLARED M0600201 RR EQU PROCOM(121) FLAG - NON-ZERO IF PROTECTED COMMON DECLARED M0600202 RR EQU PAGE(122) LENGTH OF PAGE FOR MASS MEMORY - MUST BE M0600203 RR* A MULTIPLE OF 96 M0600204 RR EQU CSQCTR(123) LAST ADDRESS OF PROGRAM COMMAND SEQUENCE M0600205 RR* STORAGE +1 M0600206 RR EQU CEXTAD(124) ADDRESS OF EXTERNAL BEING CURRENTLY PROCESSED M0600207 RR* FROM EXTERNAL TABLE M0600208 RR EQU MINEXT(125) FIRST WORD ADDRESS OF SYSTEM EXTERNAL TABLE M0600209 RR EQU MAXEXT(126) LAST WORD ADDRESS OF SYSTEM EXTERNAL TABLE M0600210 RR EQU ENTSEC(127) STARTING SECTOR OF ENTRY/EXTERNAL TABLES M0600211 RR EQU CSQSEC(128) STARTING SECTOR OF COMMAND SEQUENCE IMAGE M0600212 RR EQU MAXPGE(129) MAXIMUM PAGE NUMBER THAT CAN BE USED ON DISK M0600213 RR EQU NOPAGE(130) NUMBER OF PAGES IN CORE M0600214 RR EQU PARBAS(131) ADDRESS OF STARTING PARTITION M0600215 RR EQU PARLIM(132) LAST WORD ADDRESS +1 OF LAST PARTITION M0600216 RR EQU STRSEC(133) STARTING SECTOR OF IMAGE ON MASS MEMORY M0600217 RR EQU MSDWCT(134) NUMBER OF WORDS STORED ON MASS MEMORY M0600218 RR EQU XFRADR(135) TRANSFER ADDRESS OF NAME FROM XFR BLOCK M0600219 RR EQU AHOLD(136) TEMPORY M0600220 RR EQU QHOLD(137) TEMPORY M0600221 RR EQU SECTOR(138) NUMBER OF WORDS IN A SECTOR M0600222 RR EQU ECREP(139) END ADDRESS OF CREP TABLE M0600223 RR EQU ECREP1(140) END ADDRESS OF CREP1 TABLE M0600224 RR EQU EXTSWT(141) FLAG - NON-ZERO IF PROCESSING EXTERNAL BLOCK M0600225 RR EQU SAVEA(142) TEMPORARY M0600226 RR EQU JUMP(143) JUMP FLAG FOR I1 M0600227 RR EQU TEMP3(144) TEMPORARY M0600228 RR EQU FLGBSE(145) BASE ADDRESS OF CORE FLAGS TABLE M0600229 RR EQU PROGCT(146) LENGTH OF PROGRAM FROM NAM CARD M0600230 RR EQU ONTAB(147) *Y ORDINAL COUNTER FOR I1 M0600231 RR EQU MONTAB(148) *YM COUNTER FOR I1 M0600232 RR EQU FLGBS1(149) INITIAL ADDRESS OF SYSTEM FLAG TABLE M0600233 RR EQU INPUT(150) INPUT BUFFER M0600234 RR SPC 3 M0600235 RR* EQUIVALENCES M0600236 RR SPC 1 M0600237 RR EQU SYSECT(16) FIRST SECTOR OF SYSTEM CORE IMAGE M0600238 RR EJT 1 M0600239 RR* OPERATING SYSTEM INITIALIZER M0600240 RR* ERROR CODES M0600241 RR* M0600242 RR* 1 ASTERISK INITIATOR MISSING M0600243 RR* 2 NUMBER APPEARS IN NAME FIELD M0600244 RR* 3 ILLEGAL CONTROL STATEMENT NAME M0600245 RR* 4 INPUT MODE ILLEGAL M0600246 RR* 5 STATEMENT OTHER THAN *Y OR *YM PREVIOUSLY ENTERED M0600247 RR* 7 *Y NOT ENTERED PRIOR TO FIRST *L STATEMENT M0600248 RR* 6 STATEMENT OTHER THAN *Y PREVIOUSLY ENTERED M0600249 RR* 8 NAME APPEARS IN NUMBER FIELD M0600250 RR* 9 ILLEGAL HEX CORE RELOCATION FIELD M0600251 RR* A ILLEGAL MASS STORAGE SECTOR NUMBER M0600252 RR* B NO DATA RETURN FROM LOADER M0600253 RR* C UNPATCHED EXTERNAL AT CONCLUSION OF SYS DIR LOAD M0600254 RR* D UNPATCHED EXTERNAL AT CONCLUSION OF *L LOAD M0600255 RR* E FIELD TERMINATOR INVALID M0600256 RR* F MORE THAN 120 CHARACTERS IN CONTROL STATEMENT M0600257 RR*10 ORDINAL NAME WITHOUT ORDINAL NUMBER M0600258 RR*11 NAME APPEARED PREVIOUSLY IN LOADER TABLE M0600259 RR*12 INVALID ORDINAL NUMBER M0600260 RR*13 LOADER CONTROL STATEMENT OUT OF ORDER. CORRECT ORDER = L,LP,M,MP M0600261 RR*14 DATA DECLARED DURING *M LOAD BUT NOT BY FIRST M0600262 RR* SEGMENT. INITIALIZATION RESTARTED. M0600263 RR*15 ATTEMPT MADE TO ENTER DATA INTO LOCATION 0 OR M0600264 RR* ABOVE LOCATION $FE. INITIALIZATION RESTARTED. M0600265 RR*16 UNRECOVERABLE MASS STORAGE I/O ERROR M0600266 RR*17 LOADER SLEWING ALL BLOCKS UNTIL NEXT NAM BLOCK. M0600267 RR*18 FIRST STATEMENT INPUT TO INITIALIZER DID NOT DEFINE M0600268 RR* THE MASS STORAGE DEVICE. M0600269 RR*19 UNABLE TO READ IN BAD SECTOR DIRECTORY M0600270 RR*20 *S,END0V4,HHHH NOT DEFINED BEFORE FIRST *L CONTROL STATEMENT M0600271 RR*21 *S,MSIZV4,HHHH NOT DEFINED BEFORE FIRST *LP CONTROL STATEMENT M0600272 RR*22 ATTEMPT TO LOAD PART 1 CORE RESIDENT INTO UNAVAILABLE MEMORY M0600273 RR*23 THE NAME USED IN THE SECOND FIELD OF A *M CONTROL STATEMENT M0600274 RR* WAS NOT PREVIOUSLY DEFINED AS AN ENTRY POINT M0600275 RR*24 THE ENTRY POINT SECTOR WAS NOT DEFINED AT THE START OF M0600276 RR* INITIALIZATION AND IS NOT AVAILABLE TO THE INITIALIZER M0600277 RR*25 ILLEGAL PARTITION NUMBER IN FIRST FIELD OF *MP STATEMENT M0600278 RR* OR ILLEGAL NUMBER OF PARTITIONS IN SECOND FIELD OF STATEMENT M0600279 RR*26 AN ATTEMPT WAS MADE TO LOAD *MP PROGRAMS WHEN NO PARTITIONED M0600280 RR* CORE TABLE EXISTS IN SYSDAT M0600281 RR* ********************************************************************M0600282 RR EJT 1 M0600283 RRRSTART IIN 0 CAUSE PROTECT ERROR IF CALLED AS 122*4842M0600284 RR* AN ITOS USER PROGRAM 122*4842M0600285 RR RTJ CONENT 122*4842M0600286 RR ENA SYSECT SET STARTING AREA OF DISK M0600287 RR STA LSSECT M0600288 RR LDA COLU INITIALIZE COMMENT DEVICE LOGICAL UNIT M0600289 RR STA CO M0600290 RR LDA SIB INITIALIZE STANDARD BINARY INPUT LOGICAL UNIT M0600291 RR STA IN M0600292 RR LDA MASS INITIALIZE MASS STORAGE UNIT **MSOS 4.1**M0600293 RR STA OU **MSOS 4.1**M0600294 RR LDA CONENT PICKUP STARTING ADDRESS OF CONTROL M0600295 RR INA -3 122*4842M0600296 RR RTJ- CONVRT,I CONVERT TO ASCII M0600297 RR LDA- BINASC,I PICKUP FIRST WORD OF ADDRESS M0600298 RR STA* SI+23 STORE IN OUTPUT BUFFER **MSOS 4.1**M0600299 RR LDA- BINASC+1,I PICKUP SECOND WORD OF ADDRESS M0600300 RR STA* SI+24 STORE IN OUTPUT BUFFER **MSOS 4.1**M0600301 RR RTJ* CNTR1 GENERATE BUFFER ADDRESS M0600302 RRSI ALF 14,ITOS 1.2 SYSTEM INITIALIZER M0600303 RR NUM $0D0A CARRIAGE RETURN - LINE FEED M0600304 RR ALF *,FWA OF CONTRL = * M0600305 RR NUM 0,0 RESERVED FOR ADDRESS OF CONTROL M0600306 RR NUM $0D0A CARRIAGE RETURN - LINE FEED M0600307 RRCNTR1 NOP 0 STORAGE FOR RUN-TIME BUFFER ADDRESS M0600308 RR LDA* CNTR1 PICKUP BUFFER ADDRESS M0600309 RRCNTR2 ENQ 26 PICKUP WORD COUNT **MSOS 4.1**M0600310 RR RTJ TELOUT OUTPUT MESSAGE TO TELETYPE M0600311 RRCNTR3 RTJ BACKGR BACKROUND INPUT BUFFER TO ALL ONES M0600312 RR CLR A **MSOS 4.1**M0600313 RR RTJ I2 INITIALIZE FOR AUTOLOAD **MSOS 4.1**M0600314 RR RTJ* CNTR9 JUMP AROUND BUFFER M0600315 RR NUM $0D0A CARRIAGE RETURN - LINE FEED M0600316 RRDATE1 ALF 7,DATE MM/DD/YY M0600317 RRCNTR9 NOP 0 RUN TIME BUFFER ADDRESS M0600318 RR ENQ 8 SETUP WORD COUNT M0600319 RR LDA* CNTR9 PICKUP BUFFER ADDRESS M0600320 RR RTJ TELOUT OUTPUT MESSAGE TO TELETYPE M0600321 RR CLR Q SET FLAG FOR COMMENT INPUT M0600322 RR LDA- INPADR,I SETUP POINTER TO BUFFER M0600323 RR RTJ QCOM READ IN DATE M0600324 RR SPC 2 M0600325 RR ENQ 3 MOVE DATE TO BUFFER IN LPRINT M0600326 RRCNTR10 LDA- INPUT,B M0600327 RR INA 0 M0600328 RR STA HEADR1,Q M0600329 RR INQ -1 M0600330 RR SQM CNTR11-*-1 SKIP OUT IF ENTIRE DATE MOVED M0600331 RR JMP* CNTR10 MOVE NEXT WORD OF DATE M0600332 RRCNTR11 RTJ CONMAS INITIALIZE MASS STORAGE CONSTANTS M0600333 RR CLR A ZERO THE FOLLOWING LOCATIONS M0600334 RR STA FORMFD M0600335 RR STA YORDNL CLEAR CORE RESIDENT ORDINAL COUNTER M0600336 RR STA I1CALL M0600337 RR STA ERFLAG M0600338 RR STA PART1C M0600339 RR STA PART1L M0600340 RR STA PART1A M0600341 RR STA FRSTLP M0600342 RR STA PARDEF M0600343 RR STA CRPFLG M0600344 RR STA YPOINT M0600345 RR STA END0V4 M0600346 RR STA PARTBL M0600347 RR STA LSTLOC M0600348 RR STA MSIZV4 M0600349 RR STA MAXSEC M0600350 RR STA YCNTER M0600351 RR STA ENTTMP M0600352 RR STA STRTEX M0600353 RR STA TEMPEX M0600354 RR STA ENDEXT M0600355 RR STA YMCNTR M0600356 RR STA YMORDN M0600357 RR STA PP M0600358 RR STA NN M0600359 RR STA SECVAL M0600360 RR STA BLDADD M0600361 RR STA PCOUNT M0600362 RR STA PAGADD M0600363 RR STA TMPSEC M0600364 RR STA LENDC M0600365 RR STA LPENDC M0600366 RR STA DATBS0 CLEAR PART 0 DATA BASE M0600367 RR STA DATLM0 CLEAR PART 0 DATA LIMIT M0600368 RR STA DATBS1 CLEAR PART 1 DATA BASE M0600369 RR STA DATLM1 CLEAR PART 1 DATA LIMIT M0600370 RR LDA =N$7FFF M0600371 RR STA (MSIZV4) M0600372 RR JMP* CM20 GET NEXT CONTROL STATEMENT M0600373 RRCMASKT NUM $002A MASK FOR ASTERISK M0600374 RR EJT 1 M0600375 RR* ********************************************************************M0600376 RR* BACKGROUND BUFFER TO ALL ONES M0600377 RR* SETUP CALL TO COMMENT OR INPUT MEDIUM DRIVER M0600378 RR* ********************************************************************M0600379 RRCM20 RTJ BACKGR BACKGROUND INPUT BUFFER M0600380 RR* M0600381 RRCM40 LDA- INPADR,I ADDRESS OF INPUT BUFFER TO A M0600382 RR LDQ- INMED,I FETCH INPUT MEDIUM SWITCH M0600383 RR SQZ CM44-*-1 M0600384 RR JMP* CM50 M0600385 RRCM44 ENQ 1 NO ERROR IF Q = 1 M0600386 RR RTJ TYPEQ TYPE Q M0600387 RRCM45 CLR Q Q ZERO FOR INPUT OPERATION M0600388 RR RTJ QCOM CALL COMMENT MEDIUM DRIVER M0600389 RRCM45A SAN CM65 **MSOS 4.1**M0600390 RR JMP* CM44 TYPE Q, INTERROGATE COMM MEDIUM **MSOS 4.1**M0600391 RRCM50 ENQ 96 SETUP WORD COUNT FOR READ M0600392 RR TCA A A-= BINARY MODE FOR CARD READER M0600393 RR RTJ IDRIV CALL INPUT MEDIUM DRIVER M0600394 RRCM60 SAN CM65-*-1 NO DATA RETURN IF ZERO M0600395 RR JMP* CM44 TYPE Q, INTERROGATE COMM MED M0600396 RRCM65 LDA- INPADR,I ADDR OF INPUT BUFFER M0600397 RR ENQ 30 PRINT 30 WORDS M0600398 RR RTJ QCOM CALL COMMENT DRIVER M0600399 RR EJT 1 M0600400 RR* M0600401 RR* TEST FIRST CHARACTER IN INPUT BUFFER FOR AN ASTERISK M0600402 RR* M0600403 RR LDQ- INPADR,I PICKUP ADDRESS OF INPUT BUFFER **MSOS 4.1**M0600404 RR LDA- CSNAME,I CURRENT CONT STMNT NAME CODE M0600405 RR STA- XCSNAM,I TO PREVIOUS M0600406 RR INQ -1 Q = ADDR OF INPUT BUFFER - 1 M0600407 RR LDA- 1,Q FETCH FIRST WORD OF INPUT BUFFER M0600408 RR ARS 8 SHIFT OFF RIGHT HAND HALF M0600409 RR EOR* CMASKT TEST FOR AN ASTERISK (*) M0600410 RR SAZ CM80-*-1 ZERO IMPLIES CHAR IS ASTERISK M0600411 RR ENA 1 ASTERISK INITIATOR MISSING M0600412 RR JMP* CM195X+1 TYPE Q AND INTERROGATE COM MED M0600413 RRCM80 LDA- INPADR,I ADDRESS OF INPUT BUFFER M0600414 RR ALS 1 TO BITS (15 - 1) M0600415 RR INA 1 SET RIGHT HALF WORD SWITCH TO ON M0600416 RR STA- WRDCNT,I PLACE IN SCAN CONTROL WORD M0600417 RR ENA $8 LEADING + OR - ILLEG, NAME OR M0600418 RR STA- SCANSW,I DEC NBR OK. TO SCAN CONTROL WD M0600419 RR CLR A CLEAR A PRIOR TO CALLING SCAN M0600420 RR RTJ- SCAN,I FETCH A CONTROL STATEMENT CODE M0600421 RR LDA- SYMSTR,I ZERO IMPLIES A NUMBER M0600422 RR SUB- 18,I TWO BLANKS 2020 M0600423 RR SAN CM90-*-1 ZERO IMPLIES NO FIELD PRESENT M0600424 RR JMP* CM190 TEST FOR *CR M0600425 RR EJT 1 M0600426 RR* C O N T R O L S T A T E M E N T R E C O G N I Z E R M0600427 RR SPC 1 M0600428 RRCM90 CLR Q CLEAR TABLE INDEX M0600429 RRCM72 LDA* STTYP1,Q PICKUP TABLE ENTRY M0600430 RR SAN CM74-*-1 GO ON IF NOT AT END OF TABLE M0600431 RR JMP* CM195X END OF TABLE - ERROR M0600432 RRCM74 EOR- SYMSTR,I COMPARE TABLE ENTRY TO INPUT M0600433 RR SAZ CM76-*-1 ENTRY COMPARES CHECK SECOND WORD M0600434 RR INQ 1 NO COMPARE, CHECK NEXT TABLE ENTRY M0600435 RR JMP* CM72 M0600436 RRCM76 LDA- BLANKS,I MAKE SURE THAT SECOND WORD OF M0600437 RR EOR- SYMSTR+1,I CONTROL STATEMENT IS BLANKS M0600438 RR SAZ CM78-*-1 M0600439 RR JMP* CM195X ERROR UNRECOGNIZEABLE CONTROL STATEMENT M0600440 RRCM78 LDA- CSNAME,I PICKUP CODE OF LAST CONTROL STATEMENT M0600441 RR QLS 1 MULTIPLY TABLE INDEX BY TWO M0600442 RR JMP* STTYP3,Q GO TO PROCESS CONTROL STATEMENT M0600443 RRCM190 LDA- INPREL,I TEST FOR CARRIAGE RETURN M0600444 RR LDQ- CSNAME,I CONTROL STATEMENT NAME M0600445 RRCM195 SQN CM196-*-1 NON-ZERO IMPLIES *CR M0600446 RRCM195X ENA 3 ILLEGAL CONTROL STMNT NAME M0600447 RRHOP2 JMP* YM2 ZERO IMPLIES ILLEGAL STATEMENT, OUTPUT ERROR M0600448 RRCM196 JMP* CM20 HANDLE ASTERISK FOLLOWED BY BLANK M0600449 RR* AS COMMENT CARD. COMMENT CARDS MUST BE M0600450 RR* FOLLOWED BY ANOTHER COMMENT CARD OR M0600451 RR* BY A CONTROL STATEMENT. THEY ARE NOT M0600452 RR* ALLOWED BETWEEN TWO PROGRAMS OR M0600453 RR* IMMEDIATELY PRECEEDING A PROGRAM. M0600454 RR SPC 2 M0600455 RRSTTYP1 ALF 1,L *L CORE RESIDENT PART 0 M0600456 RR ALF 1,LP *LP CORE RESIDENT PART 1 M0600457 RR ALF 1,M *M MASS RESIDENT PART 0 M0600458 RR ALF 1,MP *MP MASS RESIDENT PART 1 M0600459 RR ALF 1,S *S DEFINE ENTRY POINT M0600460 RR ALF 1,Y *Y DEFINE CORE RESIDENT DIRECTORY ENTRY M0600461 RR ALF 1,YM *YM DEFINE MASS RESIDENT DIRECTORY ENTRY M0600462 RR ALF 1,V *V CONTROL TO STANDARD BINARY INPUT M0600463 RR ALF 1,U *U CONTROL TO STANDARD COMENT DEVICE M0600464 RR ALF 1,I *I ASSIGN STANDARD BINARY INPUT DEVICE M0600465 RR ALF 1,O *O ASSIGN STANDARD LIBRARY DEVICE M0600466 RR ALF 1,C *C ASSIGN STANDARD LIST DEVICE M0600467 RR ALF 1,T *T END OF BINARY INPUT M0600468 RR ALF 1,D *D DEFINE DATA M0600469 RR ALF 1,G *G WRITE DISK ADDRESS TAGS M0600470 RR ALF 1,H *H PERFORM DISK SURFACE TEST M0600471 RR NUM 0 *** END OF TABLE *** M0600472 RRSTTYP3 JMP STARL *L M0600473 RR JMP STARLP *LP M0600474 RR JMP STARM *M M0600475 RR JMP STARMP *MP M0600476 RR JMP STARS *S M0600477 RR JMP STARY *Y M0600478 RR JMP STARYM *YM M0600479 RR JMP STARV *V M0600480 RR JMP STARU *U M0600481 RR JMP STARI *I M0600482 RR JMP STARO *O M0600483 RR JMP STARC *C M0600484 RR JMP START *T M0600485 RR JMP STARD *D M0600486 RR JMP STARG *G M0600487 RR JMP STARH *H M0600488 RR EJT 1 M0600489 RR* R O U T I N E T O G E T A H E X I D E C I M A L M0600490 RR* M0600491 RR* V A L U E F R O M A F I E L D O F A M0600492 RR* M0600493 RR* C O N T R O L S T A T E M E N T A N D R E T U R N M0600494 RR* M0600495 RR* I T S B I N A R Y V A L U E I N ' A ' M0600496 RR SPC 3 M0600497 RRGETHEX NOP 0 ENTRY LOCATION FOR STORAGE OF RETURN ADDRESS M0600498 RR ENA 9 SET BIT 0 OF SCANSW SAYING GET HEX FIELD M0600499 RR STA- SCANSW,I SET BIT 3 OF SCANSW SAYING SAVE ASCII CODES M0600500 RR CLR A M0600501 RR RTJ- SCAN,I CHECK INPUT FIELD M0600502 RR JMP* (GETHEX) RETURN TO CALLER WITH BINARY VALUE IN SCNINP M0600503 RR SPC 8 M0600504 RR* R O U T I N E T O C H E C K F O R C O M M A M0600505 RR SPC 3 M0600506 RR* C A L L I N G S E Q U E N C E M0600507 RR SPC 3 M0600508 RR* RTJ* COMMA CALL ROUTINE M0600509 RR* XXX P+1 - ERROR RETURN, NO COMMA M0600510 RR* XXX P+2 - NORMAL RETURN, COMMA DELIMETER FOUND M0600511 RR SPC 2 M0600512 RRCOMMA NOP 0 ENTRY LOCATION FOR STORAGE OF RETURN ADDRESS M0600513 RR RTJ OETERM GO TO I1 TO FIND TERMINATOR TYPE M0600514 RR INQ -2 OETERM RETURNS 2 IN Q-REGISTER IF COMMA FOUND M0600515 RR SQN 1 SKIP IF NOT COMMA M0600516 RR RAO* COMMA UPDATE RETURN ADDRESS, COMMA FOUND M0600517 RR JMP* (COMMA) RETURN TO CALLER M0600518 RR EJT 1 M0600519 RR* R O U T I N E T O P R O C E S S * Y O R * Y M M0600520 RR SPC 3 M0600521 RRSTARYM INA -3 MAKE SURE CSNAME IS LESS THAN TWO MEANING M0600522 RR SAM YM1-*-1 THAT STATEMENTS ARE IN ORDER M0600523 RR ENA 5 ERROR 5, STATEMENT OTHER THAN *Y OR *YM M0600524 RRYM2 JMP* LSTM4 PREVIOUSLY ENTERED M0600525 RRYM1 ENA 2 SET UP CONTROL STATEMENT NAME CODE M0600526 RR JMP* Y0 GO TO PROCESS ORDINAL M0600527 RRSTARY INA -2 MAKE SURE THAT CSNAME IS LESS THAN OR EQUAL M0600528 RR SAM Y1-*-1 TO ONE MEANING THAT ONLY *Y'S HAVE BEEN INPUT M0600529 RR ENA 6 ERROR 6, STATEMENT OTHER THAN M0600530 RR JMP* YM2 *Y PREVIOUSLY DEFINED M0600531 RRY1 ENA 1 SETUP CONTROL STATEMENT NAME CODE M0600532 RRY0 STA- CSNAME,I SAVE CODE FOR STATEMENT TYPE M0600533 RR LDQ- INPXC0,I LOAD Q WITH THE ADDRESS OF THE INPUT BUFFER M0600534 RR RTJ I1 CALL I1 TO BUILD SYSTEM DIRECTORY M0600535 RR JMP CM20 READ NEXT CONTROL STATEMENT **MSOS 4.1**M0600536 RRI1CALL NUM 0 ZERO IF MODULE I1 NOT CALLED M0600537 RR EJT 1 M0600538 RR* R O U T I N E T O P R O C E S S * L S T A T E M E N T M0600539 RR SPC 3 M0600540 RRSTARL SAN LSTM1-*-1 HAS I1 ALREADY RUN M0600541 RR ENA 7 ERROR 7, NO SYSTEM DIRECTORY BUILT M0600542 RR JMP* LSTM4 BEFORE PROGRAM LOAD M0600543 RRLSTM1 INA -3 M0600544 RR SAM LSTM3A-*-1 LAST STATEMENT WAS *Y OR *YM M0600545 RR SAN LSTM2 STATEMENT BAD M0600546 RR JMP* LSTM3D LAST STATEMENT WAS *L M0600547 RRLSTM2 ENA $13 STATEMENT IS OUT OF ORDER M0600548 RR JMP* LSTM4 M0600549 RRLSTM3A RTJ* LSTM3B PICKUP RUN-TIME ADDRESS OF ENTRY POINT NAME M0600550 RR ALF 3,END0V4 NAME FOR END ADDRESS OF PART 0 M0600551 RRLSTM3B NOP 0 ENTRY POINT ADDRESS M0600552 RR LDA* LSTM3B M0600553 RR STA- INPCTR,I MAKE SURE THAT END OF PART 0 WAS DEFINED M0600554 RR RTJ- TABSCH,I BEFORE BEGINNING *L LOAD M0600555 RR LDQ- SW6,I HAS THIS NAME BEEN DEFINED M0600556 RR SQM LSTM3C-*-1 NO, PRINT ERROR M0600557 RR STA- COMLIM,I YES, SAVE AS UPPER BOUND FOR LOAD M0600558 RR STA- TOP,I SAVE AS END OF PART 0 M0600559 RR STA END0V4 SAVE END ADDRESS OF PART 0 M0600560 RRLSTM3D JMP* LSTM4A GO TO EXIMINE *L CONTROL STATEMENT M0600561 RRLSTM3C ENA $20 ERROR 20, *S,END0V4,HHHH NOT ENTERED M0600562 RR JMP* LSTM4 BEFORE THE FIRST *L CONTROL STATEMENT M0600563 RRLSTM4A ENA 3 SET CSNAME=3, SAYING *L IS BEING PROCESSED M0600564 RR STA- CSNAME,I M0600565 RRLSTM40 RTJ* COMMA IS FIELD DELIMETER A COMMA M0600566 RR JMP* LSTM41 NO, CHECK FOR END OF STATEMENT M0600567 RR RTJ* GETHEX YES, PICKUP THE LOAD ADDRESS M0600568 RR LDA- SYMSTR,I MAKE SURE THAT THE FIELD IS NUMERIC M0600569 RR SAN LSTM4Q THIS FEILD NOT NUMERIC M0600570 RR JMP* LSTM5 THIS FIELD NUMERIC, CHECK IF VALID M0600571 RRLSTM4Q SUB- BLANKS,I IS THIS FIELD EMPTY M0600572 RR SAZ LSTM43-*-1 YES GO ON TO LOAD STAGE M0600573 RR ENA 8 ERROR 8, NAME APPEARS IN NUMBER FIELD M0600574 RRLSTM4 JMP QTYPE M0600575 RRLSTM41 RTJ VALID TEST FOR CARRIAGE RETURN OR BLANK DELIMETER M0600576 RR SQZ LSTM43 TERMINATOR IS VALID M0600577 RRLSTM42 ENA $E ERROR E, INVALID FIELD TERMINATOR M0600578 RR JMP* LSTM4 M0600579 RRLSTM43 LDA- PROBAS,I IS THIS *L FOR SYSDAT M0600580 RR SAZ LSTM4X YES M0600581 RR SUB- $EB NO, DOES *L IMMEDIATELY FOLLOW SYSDAT M0600582 RR SAN LSTM4X NO, JUST LOAD AT PROBAS M0600583 RR LDA- $EB YES, INCREASE PROBAS PAST SYSTEM M0600584 RR ADD- $E6 DIRECTORY M0600585 RR STA- PROBAS,I M0600586 RR CLR Q COMPUTE NUMBER OF PAGES USED FOR M0600587 RR DVI =N$60 SYSDAT AND DIRECTORY M0600588 RR SQZ EVPG M0600589 RR INA 1 M0600590 RREVPG STA LENSDT NUMBER OF CORE RESIDENT PAGES M0600591 RRLSTM4X JMP* LSTM8 GO LOAD PROGRAM STARTING AT PROBAS M0600592 RRLSTM5 LDA- PROBAS,I CHECK FOR A VALID LOAD ADDRESS M0600593 RR SAZ LSTM6-*-1 SKIP IF LOADER PROGRAM BASE IS ZERO M0600594 RR SUB- $EB DOES THIS *L IMMEDIATELY FOLLOW THE SYSDAT M0600595 RR SAN LSTM6-*-1 NO, COMPARE THE LOAD ADDRESS TO PROBAS M0600596 RR LDA- $EB YES, INCREASE PROBAS PAST THE SYSTEM M0600597 RR ADD- $E6 DIRECTORY AND THEN COMPARE THE LOAD ADDRESS M0600598 RR STA- PROBAS,I TO PROBAS M0600599 RR CLR Q M0600600 RR DVI =N96 COMPUTE NUMBER OF PAGES USED FOR M0600601 RR SQZ EVENPG SYSDAT AND DIRECTORY M0600602 RR INA 1 M0600603 RREVENPG STA LENSDT NUMBER OF CORE RESIDENT PAGES M0600604 RRLSTM6 LDA- SCNINP,I HEX LOAD ADDRESS M0600605 RR LDQ- PROBAS,I LOAD PROGRAM BASE M0600606 RR* M0600607 RR* SIGN CHECK COMPARES A AND Q, M0600608 RR RTJ SIGNCK IF A.GT.Q OR A.EQ.Q, A RETURNS M0600609 RR* A POSITIVE VALUE, IF A.LT.Q THEN M0600610 RR* A RETURNS NEGATIVE M0600611 RR* M0600612 RR SAP LSTM7 NEW BASE IS GREATER THAN PROBAS M0600613 RR JMP* LSTM6A ILLEGAL PROGRAM RELOCATION BASE M0600614 RRLSTM7 LDQ* CRPFLG IF WE ARE IN PART1 (*LP LOADS) M0600615 RR SQN LSTM7X NO NEED TO CHECK COMLIM M0600616 RR LDA- COMLIM,I IS THE RELOCATION BASE BELOW THE M0600617 RR LDQ- SCNINP,I BEGINNING OF SYSTEM COMMON M0600618 RR RTJ SIGNCK M0600619 RR SAP LSTM7A YES, CONTINUE THE LOAD M0600620 RR JMP* LSTM6A ILLEGAL PROGRAM RELOCATION BASE M0600621 RRLSTM7A LDQ- SCNINP,I UPDATE PROBAS TO THE NEW LOAD ADDRESS MAKING M0600622 RR STQ- PROBAS,I THE AREA BETWEEN THE OLD AND NEW ADDRESSES M0600623 RR STQ- CSQCTR,I UNAVAILABLE FOR LOADING M0600624 RRLSTM7L RTJ VALID TEST FOR VALID RECORD TERMINATOR M0600625 RR SQZ LSTM8-*-1 SKIP IF TERMINATOR IS VALID M0600626 RR JMP* LSTM42 ERROR E, ILLEGAL FIELD TERMINATOR M0600627 RRLSTM7X ADD- CSQCTR,I A-REG NOW CONTAINS RELATIVE DISTANCE M0600628 RR STA- CSQCTR,I FROM PROBAS,I TO SCNINP,I M0600629 RR LDQ- SCNINP,I CSQCTR,I IN PART 1 LOADS CONTAINS M0600630 RR STQ- PROBAS,I AN ACCUMULATION OF PROGRAM LENGTHS M0600631 RR JMP* LSTM7L ADDED TO PART1L FOR LENGTH OF PART 1. M0600632 RRLSTM6A ENA 9 ILLEGAL PROGRAM RELOCATION BASE M0600633 RR JMP* LSTM4 OUTPUT THE ERROR M0600634 RRLSTM8 RAO* YORDNL INCREMENT THE ORDINAL COUNTER M0600635 RR LDQ- ONTAB,I PICKUP THE NEXT ADDRESS TO CHECK IN THE M0600636 RR* *Y ORDINAL TABLE M0600637 RR SQZ LSTM9-*-1 SKIP IF THERE WERE NO *Y STATEMENTS M0600638 RR LDA* YORDNL PICKUP THE ORDINAL OF THIS *L STATEMENT M0600639 RR SUB- 1,Q COMPARE IT TO THE NEXT ENTRY IN THE M0600640 RR* *Y ORDINAL TABLE M0600641 RR SAZ LSTM8A-*-1 SKIP IF THIS ORDINAL IS IN THE TABLE M0600642 RRLSTM9 JMP* LSTM9A M0600643 RRYORDNL NUM 0 ORDINAL OF CURRENT *L STATEMENT M0600644 RRLSTM8A RAO- ONTAB,I INCREMENT POINTER FOR ORDINAL TABLE M0600645 RR RAO* YCNTER INCREMENT COUNTER OF CORE RESIDENT ORDINALS M0600646 RR ENA 4 LENGTH OF SYSTEM DIRECTORY ENTRY TIMES M0600647 RR MUI* YCNTER COUNTER OF CORE RESIDENT ORDINALS EQUALS M0600648 RR TRA Q THE INDEX TO THE SYSTEM DIRECTORY ENTRY M0600649 RR INQ -3 DECREMENT INDEX TO WORDQ OF ENTRY M0600650 RR LDA- PROBAS,I PICKUP RELOCATION BASE FOR PROGRAM BEING M0600651 RR STA- ($EB),Q LOADED AND STORE IN WORD 2 OF THE SYSTEM M0600652 RR* DIRECTORY ENTRY M0600653 RR STQ* YPOINT M0600654 RR LDA- CSNAME,I CHECK FOR *L OR *LP TO DETERMINE M0600655 RR INA -3 REQUEST CODE FOR SYSTEM DIRECTORY ENTRY M0600656 RR SAZ LSTM8B-*-1 *L M0600657 RR LDA =N$4200 *LP REQUEST CODE NEEDS D-BIT SET = 4200 M0600658 RR JMP* LSTM8C M0600659 RRLSTM8B LDA =N$200 *L REQUEST CODE = 0200 M0600660 RRLSTM8C INQ -1 DECREMENT POINTER TO START OF ENTRY M0600661 RR STA- ($EB),Q STORE REQUEST CODE IN WORD 0 OF ENTRY M0600662 RRLSTM9A LDA- CSNAME,I M0600663 RR INA -4 IS THIS A *LP STATEMENT M0600664 RR SAN LSTM9B-*-1 NO, M0600665 RR LDA* FRSTLP YES, IS THIS THE FIRST *LP M0600666 RR SAN LSTM9B-*-1 NO, GO TO LOAD M0600667 RR RTJ* LPBNDY YES, GO TO SETUP AUTOLOAD PARAMETERS M0600668 RRLSTM9B LDA- PROBAS,I M0600669 RR STA* STLOAD M0600670 RR CLR A,Q SETUP A RELOCATABLE LOAD FUNCTION M0600671 RR RTJ ILOAD LOAD THE PROGRAM M0600672 RR LDA- CSNAME,I M0600673 RR INA -4 IS THIS A *LP LOAD M0600674 RR SAN LSTM9C NO M0600675 RR LDQ (PARTBL) Q = START ADDRESS OF PARTITION 0 M0600676 RR TCQ Q M0600677 RR LDA* STLOAD A = START OF LAST PROGRAM LOAD M0600678 RR AAQ A COMPUTE STLOAD - PARTBL(0) M0600679 RR SAZ LSTMER ERROR, PROGRAM OVERLAYS PARTITION 0 M0600680 RR SAP LSTM9C SKIP IF PROGRAM STARTS ABOVE THE PARTITIONS M0600681 RR LDA- PROBAS,I M0600682 RR AAQ A COMPUTE PROBAS - PARTBL(0) M0600683 RR SAM LSTM9C OK, PROGRAM ENDS BELOW BELOW PARTITION 0 M0600684 RRLSTMER ENA 5 ERROR 5 M0600685 RR JMP* LSTM4 OUTPUT THE ERROR M0600686 RR SPC 1 M0600687 RRLSTM9C LDQ* YPOINT PICKUP THE INDEX FOR THIS SYSTEM DIRECTORY M0600688 RR* ENTRY M0600689 RR LDA- ($EB),Q FETCH THE INITIAL EXECUTION ADDRESS FOR THIS M0600690 RR SUB- DATBAS,I BLOCK OF PROGRAMS AND COMPARE IT TO THE M0600691 RR SAN LSTM9D-*-1 RELOCATION BASE FOR DATA STORAGE M0600692 RR LDA- DATLIM,I IF THEY ARE EQUAL RESET THE FIRST EXECUTABLE M0600693 RR STA- ($EB),Q ADDRESS TO THE END OF THE DATA BLOCK M0600694 RRLSTM9D LDA- CSNAME,I M0600695 RR INA -4 IS THIS A *LP M0600696 RR SAN LSTM9E-*-1 NO, GO TO GET NEXT STATEMENT M0600697 RR RAO* FRSTLP YES, SET FLAG SAYING LP PROCESSED M0600698 RRLSTM9E JMP CM65 GO TO PROCESS THE NEXT CONTROL STATEMENT M0600699 RRPARDEF NUM 0 FLAG SAYING IF PARTITIONS WERE DEFINED M0600700 RRCRPFLG NUM 0 FLAG INDICATING IF CREP1 OR CREP IS USED M0600701 RRYPOINT NUM 0 TEMPOTARY HOLDER FOR ORDINAL M0600702 RREND0V4 NUM 0 ENDING ADDRESS OF PART 0 M0600703 RRYCNTER NUM 0 COUNTER OF ORDINAL PROGRAMS M0600704 RRFRSTLP NUM 0 FLAG INDICATING IF LP HAS BEEN PROCESSED M0600705 RRSTLOAD NUM 0 PREVIOUS *LP LOAD ADDRESS M0600706 RR SPC 1 M0600707 RRLPBNDY NOP 0 M0600708 RR LDA- PROBAS,I PICKUP PROGRAM BASE FOR FIRST LP M0600709 RR CLR Q M0600710 RR DVI =N96 DEVIDE BY SECTOR LENGTH M0600711 RR ADD LSSECT ADD STARTING SECTOR OF CORE IMAGE M0600712 RR STA PART1C SAVE STARTING SECTOR OF PART1 CORE IMAGE M0600713 RR STQ PART1L SAVE INCREMENTAL PART OF PART 1 IMAGE M0600714 RR TCQ Q M0600715 RR ADQ- PROBAS,I M0600716 RR STQ PART1A SAVE MODIFIED CORE ADDRESS OF PART1 M0600717 RR JMP* (LPBNDY) M0600718 RR EJT 1 M0600719 RR* R O U T I N E T O P R O C E S S * L P S T A T E M E N T M0600720 RR SPC 5 M0600721 RRSTARLP INA -3 WAS THE LAST STATEMENT *L M0600722 RR SAZ LP2-*-1 YES M0600723 RR INA -1 NO, WAS THE LAST STATEMENT *LP M0600724 RR SAZ LP1-*-1 YES, GO TO PROCESS THIS *LP M0600725 RR ENA $13 NO, ERROR 13 CONTROL STATEMENT OUT OF ORDER M0600726 RRLP0 JMP LSTM4 OUTPUT THE ERROR M0600727 RRLP1 JMP LSTM40 M0600728 RRLP2 CLR Q ISSUE A PATCH ENTRY POINTS FUNCTION TO M0600729 RR ENA 1 LINK TOGETHER THE PART 0 ENTRY POINTS M0600730 RR RTJ ILOAD M0600731 RR RTJ WRTOUT WRITE OUT ALL PAGES THAT HAVE BEEN USED M0600732 RR LDA- CSQCTR,I SAVE THE LENGTH OF PART O FOR USE AS A M0600733 RR STA LENDC BOUND OF UNPROTECTED M0600734 RR LDA- COMLIM,I SAVE THE TOP OF SYSTEM COMMON AS BOUND M0600735 RR STA COMM0 OF UNPROTECTED M0600736 RR RTJ* LP3 FIND THE STARTING ADDRESS OF THE PARTITIONED M0600737 RR ALF 3,PARTBL CORE TABLE M0600738 RRLP3 NOP 0 M0600739 RR LDA* LP3 PUT ADDRESS OF THE ENTRY POINT NAME M0600740 RR STA- INPCTR,I INTO THE POINTER FOR THE ENTRY SEARCH ROUTINE M0600741 RR RTJ- TABSCH,I SEARCH FOR THE NAME M0600742 RR LDQ- SW6,I IS PARTBL DEFINED M0600743 RR SQP LP4-*-1 YES, GO GET THE ADDRESS OF THE FIRST PARTITIONM0600744 RR JMP* LP6 NO, IS LSTLOC DEFINED M0600745 RRLP4 STA* PARTBL SAVE THE STARTING ADDRESS OF THE TABLE M0600746 RR INA -1 M0600747 RR TRA Q PICKUP THE FIRST WORD OF THE M0600748 RR LDA- 1,Q PARTITIONED CORE TABLE M0600749 RR SAP LP5-*-1 SKIP IF ADDRESS LESS THAN $8000 M0600750 RR INA 0 M0600751 RR SAN LP5-*-1 SKIP IF ADDRESS NOT EQUAL $FFFF M0600752 RR ENA 0 CLEAR THE PARTITIONED CORE FLAG INDICATING M0600753 RR STA* PARDEF NO PARTITIONS M0600754 RR JMP* LP6 M0600755 RRLP5 ENA 1 SET THE PARDEF FLAG SAYING THAT PARTITIONED M0600756 RR STA* PARDEF CORE EXISTS IN THIS SYSTEM M0600757 RRLP6 RTJ* LP7 FIND THE LAST LOCATION OF PARTITIONED CORE +1 M0600758 RR ALF 3,LSTLOC M0600759 RRLP7 NOP 0 M0600760 RR LDA* LP7 STORE RUN TIME ADDRESS OF ENTRY POINT NAME M0600761 RR STA- INPCTR,I INTO POINTER FOR ENTRY SEARCH ROUTINE M0600762 RR RTJ- TABSCH,I SEARCH FOR NAME M0600763 RR LDQ- SW6,I IS LSTLOC DEFINED M0600764 RR SQP LP8-*-1 YES, CHECK IT FOR USE AS THE START OF *LP LOADM0600765 RR LDA* END0V4 NO, USE END0V4 FOR *LP RELOCATION BASE M0600766 RR JMP* LP9 M0600767 RRLP8 STA* LSTLOC SAVE THE ADDRESS OF LSTLOC M0600768 RR INA -1 M0600769 RR TRA Q PICKUP LSTLOC TO SEE WHERE TO BEGIN M0600770 RR LDA- 1,Q THE *LP LOADING M0600771 RR SAP LP9-*-1 SKIP IF LSTLOC LESS THAN $8000 M0600772 RR INA 0 M0600773 RR SAZ LP10-*-1 SKIP IF LSTLOC =$FFFF M0600774 RRLP9 STA- PROBAS,I USE LSTLOC AS THE PART 1 RELOCATION BASE M0600775 RR JMP* LP12A GO TO PROCESS THE CONTROL STATEMENT M0600776 RRLP10 LDA* PARDEF IS LSTLOC = $FFFF AND DO PARTITIONS EXIST M0600777 RR SAZ LP11-*-1 M0600778 RR ENA $22 ERROR 22, ATTEMPT TO LOAD PART 1 CORE M0600779 RR JMP* LP0 RESIDENT INTO NON-EXISTANT MEMORY M0600780 RRLP11 LDA- COMLIM,I IF THERE ARE NO PARTITIONS AND LSTLOC = FFFF M0600781 RR INA 1 THEN USE END0V4+1 AS RELOCATION BASE FOR M0600782 RR STA- PROBAS,I PART 1 CORE RESIDENT M0600783 RRLP12A STA- CSQLIM,I SAVE NEW COMMAND SEQUENCE LIMIT M0600784 RR RTJ* LP11A M0600785 RR JMP* LP14A M0600786 RRLP11A NOP 0 M0600787 RRLP12 RTJ* LP13 TEST TO DETERMINE IF MSIZV4 IS DEFINED M0600788 RR ALF 3,MSIZV4 M0600789 RRLP13 NOP 0 M0600790 RR LDA* LP13 PICKUP THE RUN-TIME ADDRESS OF THE NAME M0600791 RR STA- INPCTR,I M0600792 RR RTJ- TABSCH,I SEARCH FOR THE NAME MSIZV4 M0600793 RR LDQ- SW6,I IS MSIZV4 DEFINED M0600794 RR SQP LP14-*-1 YES, SETUP NEW TOP OF CORE M0600795 RR ENA $21 NO, ERROR 21 MSIZV4 NOT DEFINED M0600796 RR JMP QTYPE M0600797 RRLP14 JMP* (LP11A) M0600798 RRLP14A STA* MSIZV4 SAVE THE TOP OF CORE M0600799 RR STA I2MZV4 PASS 'MSIZV4' TO IDRIV FOR AUTOLOAD CLEAR PAR.M0600800 RR STA- TOP,I SETUP THE NEW TOP OF CORE FOR THE LOADER M0600801 RR ENA 0 M0600802 RR STA- CSQCTR,I CLEAR LENGTH OF PART1 CORE RESIDENT TO ZERO M0600803 RR ENA 1 M0600804 RR STA* CRPFLG SET FLAG SAYING USE PART1 ENTRY POINT TABLE M0600805 RR STA- ARIT15,I SET THE ARITHMETIC TYPE FLAG TO 16 BIT M0600806 RR ENA 4 SET CSNAME = 4 SAYING THAT A *LP IS M0600807 RR STA- CSNAME,I BEING PROCESSED M0600808 RR LDA- PROBAS,I SAVE PROGRAM RELOCATION BASE M0600809 RR STA LPENDC M0600810 RR RTJ* LP15 GO TO END CREP TABLE M0600811 RR JMP LSTM40 GO TO PROCESS THE CONTROL STATEMENT M0600812 RRLP15 NOP 0 END THE CREP TABLE M0600813 RR LDA- MAXENT,I SAVE THE ENDING ADDRESS OF THE CREP TABLE M0600814 RR STA- ECREP,I FOR LATER USE IN PATCHING EXTERNALS M0600815 RR CLR Q COMPUTE THE STARTING ADDRESS FOR THE M0600816 RR DVI- SECTOR,I CREP1 TABLE SO THAT THE TABLE BEGINS M0600817 RR INA 20 ON A SECTOR BOUNDARY STILL LEAVING M0600818 RR MUI- SECTOR,I ROOM FOR FURTHER CREP ENTRIES M0600819 RR STA- ENTST1,I SAVE THE STARTING ADDRESS OF CREP1 M0600820 RR STA- ENTPGS,I SETUP THE NEW STARTING SECTOR OF ENTRY TABLE M0600821 RR STA- MAXENT,I SETUP THE NEW MAXIMUM VALUE IN ENTRY TABLE M0600822 RR JMP* (LP15) M0600823 RRPARTBL NUM 0 ADDRESS OF PARTITIONED CORE TABLE M0600824 RRLSTLOC NUM 0 ADDRESS OF WORD CONTAINING LWA+1 OF PARTITIONSM0600825 RRMSIZV4 NUM 0 LAST WORD ADDRESS OF MEMORY M0600826 RR EJT 1 M0600827 RR* R O U T I N E T O P R O C E S S * M S T A T E M E N T S M0600828 RR SPC 3 M0600829 RRSTARM INA -3 WAS THE LAST STATEMENT *L M0600830 RR SAZ M0-*-1 YES, COMPLETE IT M0600831 RR JMP* M2 NO, TEST FOR *LP AS LAST ENTRY M0600832 RRM0 CLR Q THE ENTRY POINTERS POINT TO THE CREP M0600833 RR ENA 1 TABLE SO ISSUE A PATCH EXTERNAL FUNCTION TO M0600834 RR RTJ ILOAD LINK ALL OF CORE RESIDENT M0600835 RR LDA- CSQCTR,I SAVE THE LENGTH OF PART O FOR USE AS A M0600836 RR STA LENDC BOUND OF UNPROTECTED M0600837 RR LDA- COMLIM,I SAVE THE TOP OF SYSTEM COMMON AS BOUND M0600838 RR STA COMM0 OF UNPROTECTED M0600839 RR RTJ FMXSEC MAKE SURE ENTRY SECTOR IS DEFINED M0600840 RR RTJ* LP15 GO TO END THE CREP TABLE M0600841 RR RTJ* ENDET1 SETUP VALUES FOR TEMPORARY ENT/EXT TABLES M0600842 RRM1 RTJ CONMS GO TO SETUP THE NEW PAGES M0600843 RR JMP* M7 GO TO PROCESS THE *M M0600844 RRM2 INA -1 WAS THE LAST STATEMENT *LP M0600845 RR SAZ M3-*-1 YES,COMPLETE *LP PROCESSING M0600846 RR JMP* M5 NO, GO TO CHECK FOR *M AS LAST STATEMENT M0600847 RRM3 LDA PART1L UPDATE THE LENGTH OF PART 1 M0600848 RR ADD- CSQCTR,I IN THE AUTOLOAD PROGRAM M0600849 RR STA PART1L M0600850 RR LDA- CSQCTR,I SAVE THE LENGTH OF PART1 FOR USE AS THE M0600851 RR ADD LPENDC LOWER BOUND OF UNPROTECTED CORE M0600852 RR STA LPENDC M0600853 RR STA- CSQCTR,I UPDATE CSQCTR SO THE *M SECTORS ARE CORRECT M0600854 RR RTJ* ENDET1 CLOSE OFF CREP1 TABLE AND SAVE ITS ADDRESS M0600855 RR RTJ LCREP SETUP POUNTERS TO CREP TABLE M0600856 RR RTJ FMXSEC MAKE SURE ENTRY SECTOR IS DEFINED M0600857 RR RTJ LCREP1 RESET POINTERS BACK TO CREP1 TABLE M0600858 RR JMP* M3A CONTINUE FINISHING *LP M0600859 RRENDET1 NOP 0 ROUTINE TO FIND BOUNDS FOR TEMPORARY ENT/EXT M0600860 RR LDA- ENTPGS,I TABLES USED FOR *M AND *MP PROCESSING M0600861 RR STA- ENTST1,I SAVE THE STARTING ADDRESS OF THE ENTRY TABLE M0600862 RR LDA- MAXENT,I M0600863 RR STA- ECREP1,I SAVE THE ENDING ADDRESS OF THE CREP OR CREP1 M0600864 RR CLR Q TABLE FOR LATER USE M0600865 RR DVI- SECTOR,I COMPUTE THE STARTING VALUE FOR THE M0600866 RR INA 1 TEMPORARY ENTRY POINT TABLE SO THAT THE M0600867 RR MUI- SECTOR,I TABLE BEGINS ON A SECTOR BOUNDARY. M0600868 RR STA* ENTTMP SAVE THIS STARTING VALUE M0600869 RR STA- ENTPGS,I SETUP THE NEW STARTING SECTOR OF ENTRY TABLE M0600870 RR STA- MAXENT,I SETUP THE NEW MAXIMUM VALUE OF ENTRY TABLE M0600871 RR LDA- EXTSTR,I PICKUP THE START OF THE SYSTEM EXTERNAL M0600872 RR STA* STRTEX TABLE AND SAVE IT LOCALLY M0600873 RR LDA- EXTCTR,I PICKUP THE END OF THE SYSTEM EXTERNAL M0600874 RR STA* ENDEXT TABLE AND SAVE IT LOCALLY M0600875 RR CLR Q M0600876 RR DVI- SECTOR,I COMPUTE THE STARTING VALUE FOR THE TEMPORARY M0600877 RR INA 1 EXTERNAL TABLE SO THAT THE TABLE BEGINS M0600878 RR MUI- SECTOR,I ON A NEW PAGE. M0600879 RR STA* TEMPEX SAVE THIS VALUE FOR SETTING UP THE M0600880 RR JMP* (ENDET1) EXTERNAL TABLE BEFORE BEGINNING LOADING M0600881 RRENTTMP NUM 0 STARTING VALUE OF TEMPORARY ENTRY POINT TABLE M0600882 RRSTRTEX NUM 0 STARTING ADDRESS OF SYSTEM EXTERNAL TABLE M0600883 RRTEMPEX NUM 0 STARTING ADDRESS OF TEMPORARY EXTERNAL TABLE M0600884 RRENDEXT NUM 0 END ADDRESS OF SYSTEM EXTERNAL TABLE M0600885 RRM3A CLR Q ISSUE A PATCH EXTERNALS FUNCTION TO LINK M0600886 RR ENA 1 THE PART 1 CORE RESIDENT M0600887 RR RTJ ILOAD M0600888 RR SQZ M4-*-1 SKIP IF NO UNPATCHED EXTERNALS EXIST M0600889 RR RTJ LCREP SWAP THE TABLE POINTERS FOR LINKING PART 1 M0600890 RR CLR Q CORE RESIDENT TO CREP TABLE M0600891 RR ENA 1 ISSUE PATCH EXTERNAL FUNCTION TO LINK M0600892 RR RTJ ILOAD PART1 TO PART0 M0600893 RRM4 JMP* M1 GO TO PROCESS THE *M M0600894 RRM5 INA -1 WAS THE LAST STATEMENT *M M0600895 RR SAZ M6A-*-1 YES, HANDLE THIS *M M0600896 RR ENA $13 ERROR 13, OUT OF ORDER CONTROL STATEMENT M0600897 RRM6 JMP QTYPE OUTPUT THE ERROR M0600898 RRM6A RTJ WRTOUT OUTPUT THE *M OR *MP PROGRAMS AND ENTRIES M0600899 RRM7 LDA =N$FFFE LARGEST SIZE FOR *M AND *MP M0600900 RR STA- TOP,I LOADS WILL BE $FFFE M0600901 RR RTJ* M7A UPDATE LSSECT AND PAGES M0600902 RR JMP* M10A M0600903 RRM7A NOP 0 M0600904 RR LDA- CSQCTR,I UPDATE LSSECT SO THAT THE NEXT *M OR *MP M0600905 RR RTJ NXTSEC LOAD WILL BEGIN ON A NEW SECTOR M0600906 RR LDA- NOPAGE,I PICKUP THE NUMBER OF PAGES IN CORE M0600907 RR STA- COUNT1,I SETUP THE COUNTER FOR THE PAGE BUILD ROUTINE M0600908 RR RTJ CONMS1 GO TO RESET THE PAGE FLAGS M0600909 RR LDQ- CORADR,I PICKUP THE STARTING ADDRESS OF THE PAGING M0600910 RRM9 CLR A AREA IN CORE M0600911 RR STA- 1,Q CLEAR A WORD OF THE PAGING AREA M0600912 RR INQ 1 M0600913 RR TRQ A HAS THE ENTIRE PAGING AREA BEEN CLEARED M0600914 RR SUB- FLGBSE,I M0600915 RR SAZ M10-*-1 YES, CONTINUE *M PROCESSING M0600916 RR JMP* M9 NO, GO BACK TO CLEAR THE NEXT WORD M0600917 RRM10 STA- CSQCTR,I CLEAR PROGRAM LENGTH TO ZERO M0600918 RR JMP* (M7A) M0600919 RRM10A ENA 5 SET CSNAME = 5 TO SAY THAT A *M IS M0600920 RR STA- CSNAME,I CURRENTLY BEING PROCESSED M0600921 RR LDA DATBS0 GET DATA BASE FOR PART 0 LOAD M0600922 RR STA- DATBAS,I M0600923 RR LDA DATLM0 GET DATA LIMIT FOR PART 0 LOAD M0600924 RR STA- DATLIM,I M0600925 RR RTJ COMMA IS FIELD TERMINATOR A COMMA M0600926 RR JMP* M11 NO, CHECK FOR END OF STATEMENT M0600927 RR JMP* M13 YES, PICKUP NEXT FIELD M0600928 RRM11 RTJ VALID IS FIELD TERMINATOR BLANK OR CARRIAGE RETURN M0600929 RR SQZ M12-*-1 YES, FINISH PROCESSING STATEMENT M0600930 RRMTRMER JMP LSTM42 NO, ERROR E - INVALID FIELD TERMINATOR M0600931 RRM12 STQ- PROBAS,I ABSOLUTIZE THE PROGRAM TO LOCATION 0 M0600932 RR JMP* M20A GO TO LOAD THE PROGRAMS M0600933 RRM13 ENA 8 SET BIT 3 OF SCAN SWITCH SAYING PICKUP AN M0600934 RR STA- SCANSW,I ASCII FIELD. SAVE THE ASCII CHARACTER CODES M0600935 RR CLR A IN THE SYMSTR BLOCK AND IF THE FIELD IS M0600936 RR RTJ- SCAN,I NUMERIC, CONVERT THE NUMBER TO BINARY. M0600937 RR LDA- SYMSTR,I IS THE FIELD NUMERIC M0600938 RR SAN M15-*-1 NO, DETERMINE THE SECTOR ADDRESS M0600939 RR LDA END0V4 YES, IS IT A VALID PROGRAM BASE M0600940 RR SUB- SCNINP,I M0600941 RR SAP M14-*-1 PROGRAM BASE IS LESS THAN ENDOV4 M0600942 RR ENA 9 ERROR 9, ILLEGAL HEX CORE RELOCATION BASE M0600943 RRMERROR JMP QTYPE OUTPUT ERROR MESSAGE M0600944 RRM14 LDA- SCNINP,I UPDATE THE PROGRAM RELOCATION BASE TO THE M0600945 RR STA- PROBAS,I VALUE SPECIFIED ON THE CONTROL STATEMENT M0600946 RR JMP* M19 GO TO CHECK IF A SECTOR ADDRESS IS SPECIFIED M0600947 RRM15 LDA- SYMSTR,I PICKUP THE FIELD TO SEE IF IT IS EMPTY M0600948 RR SUB- BLANKS,I M0600949 RR SAN M15A-*-1 SKIP IF FIELD IS NOT EMPTY M0600950 RR STA- PROBAS,I FIELD IS EMPTY - ABSOLUTIZE PROGRAM TO ZERO M0600951 RR JMP* M19 CHECK NEXT FIELD M0600952 RRM15A LDA- SCNTRM,I IS THE ENTRY POINT NAME FOLLOWED M0600953 RR AND =N$7F BY A PLUS SIGN (ASCII CODE = $2B) M0600954 RR INA -$2B M0600955 RR SAZ M16-*-1 YES, FIND THE SECTOR VALUE M0600956 RR JMP* MTRMER NO, ERROR 14 ILLEGAL FIELD TERMINATOR M0600957 RRM16 LDA- I M0600958 RR INA SYMSTR M0600959 RR STA- INPCTR,I SETUP THE POINTER FOR THE LOADER TO SEARCH M0600960 RR RTJ- TABSCH,I FOR THE NAME ON THE CONTROL STATEMENT. M0600961 RR LDQ- SW6,I IS THE NAME DEFINED M0600962 RR SQP M17-*-1 YES, COMPUTE THE SECTOR ADDRESS M0600963 RR ENA $23 ERROR 23, NAME USED IN *M CONTROL STATEMENT M0600964 RR JMP* MERROR IS NOT A DEFINED ENTRY POINT M0600965 RRM17 RTJ GETHEX GET THE SPECIFIED SECTOR INCREMENT M0600966 RR LDA- SYMSTR,I IS THE FIELD NUMERIC M0600967 RR SAZ M18-*-1 YES, CONTINUE PROCESSING M0600968 RRM17A ENA 8 NO, ERROR 8 NAME APPEARS IN NUMBER FIELD M0600969 RR JMP* MERROR M0600970 RRM18 LDA- ENTPNT,I PICKUP THE ENTRY POINT VALUE M0600971 RR ADD- SCNINP,I ADD THE SPECIFIED INCREMENT M0600972 RR STA SECVAL SAVE THE SECTOR VALUE TEMPORARILY M0600973 RR RTJ CHKSEC GO TO VERIFY THAT THE SECTOR IS VALID M0600974 RR LDA SECVAL UPDATE LSSECT TO THE NEW SECTOR VALUE M0600975 RR STA LSSECT GIVEN ON THE CONTROL STATEMENT M0600976 RR ENA 0 M0600977 RR STA- PROBAS,I RESET THE PROGRAM BASE TO ZERO M0600978 RR JMP* M19A GO TO LOAD THE PROGRAM M0600979 RRM19 RTJ COMMA IS THE FIELD DELIMETER A COMMA M0600980 RR JMP* M19A NO, TEST FOR END OF STATEMENT M0600981 RR RTJ GETHEX YES, GO TO PICKUP THE SECTOR VALUE M0600982 RR LDA- SYMSTR,I IS THE FIELD NUMERIC M0600983 RR SAZ M20-*-1 YES, CHECK ITS VALIDITY M0600984 RR SUB- BLANKS,I IS THE FIELD EMPTY M0600985 RR SAZ M20A-*-1 YES, GO TO LOAD PROGRAMS M0600986 RR JMP* M17A NO, ERROR - NAME APPEARS IN NUMBER FIELD M0600987 RRM19A RTJ VALID IS TERMINATOR BLANK OR CARRIAGE RETURN M0600988 RR SQZ M20A-*-1 YES, GO TO PERFORM LOAD M0600989 RR JMP* MTRMER NO, ERROR E - ILLEGAL TERMINATOR M0600990 RRM20 LDA- SCNINP,I PICKUP THE VALUE GIVEN FOR THE PROGRAM M0600991 RR STA SECVAL ADDRESS ON MASS STORAGE. M0600992 RR RTJ CHKSEC CHECK IF THE VALUE IS LEGAL M0600993 RR LDA SECVAL UPDATE LSSECT TO THE VALUE GIVEN ON M0600994 RR STA LSSECT THE CONTROL STATEMENT M0600995 RRM20A LDA ENTTMP PICKUP THE ADDRESS OF THE TEMPORARY ENTRY M0600996 RR STA- ENTPGS,I POINT TABLE AND USE IT AS THE START AND M0600997 RR STA- MAXENT,I END OF THE LOADER ENTRY POINT TABLE. M0600998 RR LDA TEMPEX PICKUP THE ADDRESS OF THE TEMPORARY EXTERNAL M0600999 RR STA- EXTSTR,I TABLE AND USE IT AS THE START AND END OF M0601000 RR STA- EXTCTR,I THE LOADER EXTERNAL TABLE. M0601001 RR LDA- LNKSTR,I 120*4607M0601002 RR STA- LNKCTR,I RESET LINK TABLE POINTER 120*4607M0601003 RRM20B CLR A,Q SETUP THE ADDRESS ARITHMETIC FLAG TO TELL M0601004 RR STA- ARIT15,I THE LOADER TO USE 15 BIT ARITHMETIC. M0601005 RR RTJ ILOAD ISSUE RBD LOAD FUNCTION M0601006 RR ENA 1 SETUP AND ISSUE A PATCH EXTERNALS FUNCTION M0601007 RR RTJ ILOAD TO LINK ALL THE *M PROGRAMS M0601008 RR SQZ M21-*-1 SKIP IF ALL EXTERNALS HAVE BEEN PATCHED M0601009 RR RTJ LCREP SETUP ENTRY POINTERS TO LINK TO CREP M0601010 RR ENA 1 M0601011 RR RTJ ILOAD ISSUE A PATCH TO CREP FUNCTION M0601012 RRM21 SQZ M22-*-1 SKIP IF ALL EXTERNALS HAVE BEEN PATCHED M0601013 RR RTJ LCREP1 SETUP POINTERS FOR A LINK TO CREP1 M0601014 RR ENA 1 M0601015 RR RTJ ILOAD ISSUE A PATCH TO CREP1 FUNCTION M0601016 RRM22 SQZ M23-*-1 SKIP IF ALL EXTERNALS HAVE BEEN PATCHED M0601017 RR ENA 2 M0601018 RR RTJ ILOAD ISSUE PRINT UNPATCHED EXTERNAL FUNCTION M0601019 RRM23 RAO* YMORDN INCREMENT THE *Y/*YM PROGRAM COUNTER M0601020 RR LDQ- MONTAB,I WERE THERE ANY *YM STATEMENTS M0601021 RR SQN M23A-*-1 YES, MAKE DIRECTORY ENTRY M0601022 RR JMP* M26 NO, SKIP DIRECTORY BUILD M0601023 RRM23A LDA* YMORDN IS THIS LOAD TO BE PUT IN DIRECTORY M0601024 RR SUB- 1,Q SUBTRACT THE YM ORDINAL IN MONTAB M0601025 RR SAZ M25-*-1 SKIP IF DIRECTORY ENTRY TO BE MADE M0601026 RRM24 JMP* M26 GO TO GET NEXT CONTROL STATEMENT M0601027 RRM25 RAO- MONTAB,I BUMP COUNTER FOR MASS STORAGE ORDINAL TABLE M0601028 RR RAO* YMCNTR BUMP THE ORDINAL COUNTER M0601029 RR ENA 7 M0601030 RR MUI* YMCNTR COMPUTE AN INDEX TO THE SYSTEM DIRECTORY M0601031 RR ADD- $E7 TO USE FOR BUILDING THIS ENTRY. M0601032 RR INA -1 M0601033 RR TRA Q M0601034 RR LDA LSSECT STORE THE PROGRAM SECTOR ADDRESS IN M0601035 RR STA- ($EB),Q WORD SEVEN OF THE DIRECTORY ENTRY M0601036 RR INQ -2 M0601037 RR LDA- CSQCTR,I STORE THE PROGRAM LENGTH OF THE LOAD M0601038 RR STA- ($EB),Q IN WORD FIVE OF THE DIRECTORY ENTRY M0601039 RR LDA- CSNAME,I M0601040 RR INA -5 IS THIS A *M LOAD M0601041 RR SAZ M26-*-1 YES, GO TO GET NEXT STATEMENT PROCESSED M0601042 RR INQ -3 NO, PUT PROGRAM BASE IN WORD 2 OF DIRECTORY M0601043 RR LDA PARSTR USING START OF PARTITION ADDRESS M0601044 RR STA- ($EB),Q M0601045 RR LDA =N$4000 M0601046 RR INQ -1 M0601047 RR STA- ($EB),Q SET D-BIT IN DIRECTORY M0601048 RR* SETUP THE POINTERS SO THE NEXT ENTRY POINT M0601049 RRM26 RTJ LCREP PROCESSED GOES INTO CREP IN CASE A *S FOLLOWS M0601050 RR JMP CM65 M0601051 RRYMCNTR NUM 0 YM ORDINAL COUNTER M0601052 RRYMORDN NUM 0 M/MP PROGRAM COUNTER M0601053 RR EJT 1 M0601054 RR* R O U T I N E T O P R O C E S S * M P S T A T E M E N T S M0601055 RR SPC 5 M0601056 RRSTARMP INA -3 WAS THE LAST STATEMENT *L M0601057 RR SAZ MP0-*-1 YES, COMPLETE IT M0601058 RR JMP* MP2 NO, CONTINUE CHECKING M0601059 RRMP0 CLR Q ISSUE A PATCH EXTERNAL FUNCTION TO LINK M0601060 RR ENA 1 TOGETHER ALL OF CORE RESIDENT. ( IF *L WAS M0601061 RR RTJ ILOAD LAST THEN CORE RESIDENT IS PART 0 ONLY) M0601062 RR LDA- CSQCTR,I SAVE THE LENGTH OF PART 1 FOR USE AS A M0601063 RR STA LENDC BOUND OF UNPROTECTED M0601064 RR LDA- COMLIM,I SAVE THE TOP OF SYSTEM COMMON AS BOUND M0601065 RR STA COMM0 OF UNPROTECTED M0601066 RR RTJ FMXSEC MAKE SURE ENTRY SECTOR IS DEFINED M0601067 RRMP1 RTJ ENDET1 COMPUTE START VALUES FOR TEMP ENT/EXT TABLES M0601068 RR RTJ CONMS REALLOCATE CORE FOR NEW PAGES M0601069 RR JMP* MP4 GO TO PROCESS THE *MP CONTROL STATEMENT M0601070 RRMP2 INA -1 WAS THE LAST STATEMENT *LP M0601071 RR SAZ MP2A-*-1 YES, COMPLETE THE *LP M0601072 RR JMP* MP3A NO, COMPLETE THE *M OR *MP M0601073 RRMP2A RTJ FMXSEC MAKE SURE ENTRY M0601074 RR LDA- CSQCTR,I SAVE THE LENGTH OF PART 1 FOR USE AS A M0601075 RR STA LPENDC BOUND OF UNPROTECTED M0601076 RR CLR Q YES, ISSUE A PATCH EXTERNALS FUNCTION M0601077 RR ENA 1 TO LINK TOGETHER THE PART1 CORE RESIDENT M0601078 RR RTJ ILOAD M0601079 RR SQZ MP3-*-1 SKIP IF NO UNPATCHED EXTERNALS M0601080 RR RTJ LCREP SWAP TABLE POINTERS FOR A LINK TO CREP M0601081 RR ENA 1 ISSUE A PATCH EXTERNALS FUNCTION TO LINK PART1M0601082 RR RTJ ILOAD CORE RESIDENT TO PART 0 ENTRIES M0601083 RRMP3 JMP* MP1 GO TO PROCESS THIS *MP M0601084 RR SPC 2 M0601085 RR* COME HERE AFTER COMPLETING *L OR *LP M0601086 RR* FALL THROUGH TO HERE IF THE LAST STATEMENT WAS *M OR *MP M0601087 RRMP3A RTJ WRTOUT OUTPUT THE *M OR *MP PROGRAMS AND ENTRIES M0601088 RRMP4 RTJ M7A GO TO ALLOCATE TEMPORARY PAGES M0601089 RR RTJ GETHEX PICKUP THE STARTING PARTITION NUMBER M0601090 RR LDA- SYMSTR,I IS THE FIELD NUMERIC M0601091 RR SAZ MP5-*-1 YES, ANALYZE THE PARAMETER M0601092 RR RTJ NAMBAS NO, GO CHECK FOR A BASE NAME M0601093 RR JMP* MP15B BASE NAME FOUND, CONTINUE M0601094 RRMP4A ENA 8 ERROR 8, NAME APPEARS IN NUMBER FIELD M0601095 RRMPERR JMP QTYPE M0601096 RRMP5 LDA- SCNINP,I SAVE THE STARTING PARTITION NUMBER M0601097 RR STA PP M0601098 RR SAM MP6-*-1 SKIP IF PARTITION NUMBER IS NEGATIVE - ILLEGALM0601099 RR INA -16 IS THE PARTITION NUMBER LESS THAN 16 M0601100 RR SAM MP7-*-1 YES, THE NUMBER IS VALID (0-15) M0601101 RRMP6 ENA $25 NO, ILLEGAL PARTITION NUMBER M0601102 RR JMP* MPERR OUTPUT ERROR 9 M0601103 RRMP7 RTJ COMMA IS THE FIELD TERMINATOR A COMMA M0601104 RR JMP* MPTERM NO, OUTPUT ERROR E M0601105 RR RTJ GETHEX YES, GET THE NEXT PARAMETER M0601106 RR LDA- SYMSTR,I IS THE FIELD NUMERIC M0601107 RR SAZ MP8-*-1 YES, CHECK THE PARAMETER M0601108 RR JMP* MP4A NO, ERROR 8 - NAME APPEARS IN NUMBER FIELD M0601109 RRMP8 LDA- SCNINP,I SAVE THE NUMBER OF PARTITIONS M0601110 RR STA* NN M0601111 RR SAM MP9-*-1 SKIP IF NUMBER IS NEGATIVE - ILLEGAL M0601112 RR ADD* PP ADD THE STARTING PARTITION TO NUMBER OF M0601113 RR INA -17 PARTITIONS AND CHECK FOR PARTITION OVERFLOW M0601114 RR SAM MP10-*-1 SKIP IF NUMBER IS VALID M0601115 RRMP9 JMP* MP6 ERROR 25, ILLEGAL PARTITION NUMBER M0601116 RRMP10 RTJ COMMA IS THE TERMINATOR A COMMA M0601117 RR JMP* MP12 NO, CHECK FOR BLANK OR CARRIAGE RETURN M0601118 RR RTJ GETHEX YES, PICKUP THE SECTOR NUMBER M0601119 RR LDA- SYMSTR,I IS THE FIELD NUMERIC M0601120 RR SAZ MP11-*-1 YES, CHECK IT FOR VALIDITY M0601121 RR JMP* MP4A NO, ERROR 8 - NAME APPEARS IN NUMBER FIELD M0601122 RRMP11 LDA- SCNINP,I PICKUP THE SECTOR NUMBER FROM THE CONTROL M0601123 RR STA SECVAL STATEMENT AND SAVE IT M0601124 RR RTJ CHKSEC MAKE SURE THAT THE SECTOR NUMBER IS LEGAL M0601125 RR LDA SECVAL M0601126 RR STA LSSECT M0601127 RRMP12 RTJ VALID IS TERMINATOR BLANK OR CARRIAGE RETURN M0601128 RR SQZ MP13-*-1 YES, CONTINUE PROCESSING THE *MP M0601129 RRMPTERM ENA $E NO, ERROR E - INVALID FIELD TERMINATOR M0601130 RR JMP* MPERR M0601131 RRMP13 LDA PARTBL HAS PARTBL BEEN DEFINED FOR THE INITIALIZER M0601132 RR SAZ MP13A M0601133 RR JMP* MP15A YES, FIND THE BOUNDS FOR THIS LOAD M0601134 RRMP13A RTJ* MP14 NO, SEE IF PARTBL IS DEFINED AS AN M0601135 RR ALF 3,PARTBL ENTRY POINT IN SYSDAT M0601136 RRMP14 NOP 0 M0601137 RR LDA* MP14 PICKUP RUNTIME ADDRESS OF ENTRY POINT NAME M0601138 RR STA- INPCTR,I FOR TABLE SEARCH POINTER M0601139 RR RTJ LCREP SETUP THE POINTERS TO USE THE CREP TABLE M0601140 RR RTJ- TABSCH,I SEARCH CREP FOR PARTBL M0601141 RR LDQ- SW6,I WAS IT DEFINED M0601142 RR SQP MP15-*-1 YES, SAVE ITS VALUE M0601143 RR ENA $26 NO, OUTPUT ERROR $26 - NO PARTBL IN SYSDAT M0601144 RR JMP* MPERR M0601145 RRMP15 STA PARTBL SAVE THE ADDRESS OF THE PARTITIONED CORE TABLEM0601146 RRMP15A LDQ* PP PICKUP THE STARTING ADDRESS FOR THE LOAD M0601147 RR LDA (PARTBL),Q M0601148 RR STA- PROBAS,I SAVE THE PROGRAM RELOCATION BASE FOR THIS LOADM0601149 RR STA PARSTR SAVE FOR CHECK ON NAME PRINT IN ILOAD M0601150 RR LDA =N$FFFE SET UPPER BOUND FOR THIS LOAD M0601151 RR STA- TOP,I AND SAVE IT IN LOCATION TOP M0601152 RR ADQ* NN ADD # PARTITIONS TO START PARTITION M0601153 RR LDA (PARTBL),Q PICK UP START OF NEXT PARTITION M0601154 RR STA- COMLIM,I SETUP UPPER BOUND OF COMMON FOR PARTITION M0601155 RRMP15B ENA 6 SETUP CSNAME = 6 SAYING THAT A M0601156 RR STA- CSNAME,I *MP IS BEING PROCESSED M0601157 RR LDA DATBS1 GET DATA BASE FOR PART 1 LOAD M0601158 RR STA- DATBAS,I M0601159 RR LDA DATLM1 GET DATA LIMIT FOR PART 1 LOAD M0601160 RR STA- DATLIM,I M0601161 RR LDA ENTTMP PICKUP THE STARTING ADDRESS FOR THE TEMPORARY M0601162 RR STA- ENTPGS,I ENTRY POINT TABLE AND SAVE AS THE START AND M0601163 RR STA- MAXENT,I END OF THE TABLE FOR THIS LOAD. M0601164 RR LDA TEMPEX PICK UP START OF TEMPORARY EXTERNAL M0601165 RR STA- EXTSTR,I TABLE AND USE AS THE START AND END OF THE M0601166 RR STA- EXTCTR,I EXTERNAL TABLE FOR THIS LOAD M0601167 RR ENA 1 SETUP THE ADDRESS ARITHMETIC FLAG TO TELL M0601168 RR STA- ARIT15,I THE LOADER TO USE 16 BIT ARITHMETIC M0601169 RR LDA =X$1400 STORE JUMP INSTRUCTION AS FIRST TWO M0601170 RR STA VALUE1 CSQ VALUES M0601171 RR LDA- PROBAS,I M0601172 RR STA- PARBAS,I SAVE BASE ADDRESS M0601173 RR RTJ* STORE M0601174 RR LDA =X($7FFF) M0601175 RR STA VALUE1 TEMPORARILY SET SECOND WORD $FFFF M0601176 RR RAO- PROBAS,I INCREMENT BASE COUNT M0601177 RR LDA- PROBAS,I M0601178 RR RTJ* STORE M0601179 RR RAO- PROBAS,I INCREMENT BASE COUNT M0601180 RR LDA- CSQCTR,I M0601181 RR INA 2 M0601182 RR STA- CSQCTR,I INCREMENT LENGTH TO INCLUDE 2 WORD JMP M0601183 RR LDA- LNKSTR,I 120*4607M0601184 RR STA- LNKCTR,I RESET LINK TABLE POINTER 120*4607M0601185 RR RAO- NOJUMP,I SET NOJUMP TO FLAG TRANSFER ADDRESS M0601186 RR* NEEDED FOR JUMP INSTRUCTION M0601187 RR CLR A,Q M0601188 RRMP16 RTJ ILOAD ISSUE RBD LOAD FUNCTION M0601189 RR ENA 1 ISSUE PATCH EXTERNAL FUNCTION TO LINK THE M0601190 RR RTJ ILOAD PROGRAMS OF THIS LOAD TOGETHER M0601191 RR SQZ MP17-*-1 SKIP IF NO UNPATCHED EXTERNALS EXIST M0601192 RR RTJ* LCREP1 RESET ENTRY POINTERS FOR LINK TO CREP1 M0601193 RR ENA 1 ISSUE PATCH EXTERNAL FUNCTION TO LINK THE M0601194 RR RTJ ILOAD PROGRAMS OF THIS LOAD TO CREP1 M0601195 RRMP17 SQZ MP18-*-1 SKIP IF NO UNPATCHED EXTERNALS EXIST M0601196 RR RTJ* LCREP RESET ENTRY POINTERS FOR LINK TO CREP M0601197 RR ENA 1 ISSUE PATCH EXTERNAL FUNCTION TO LINK THE M0601198 RR RTJ ILOAD PROGRAMS OF THIS LOAD TO CREP M0601199 RRMP18 SQZ MP19-*-1 SKIP IF NO UNPATCHED EXTERNALS EXIST M0601200 RR ENA 2 ISSUE PRINT UNPATCHED EXTERNALS FUNCTION M0601201 RR RTJ ILOAD BEFORE COMPLETING LOAD M0601202 RRMP19 JMP M23 GO TO TERMINATE THIS LOAD M0601203 RRPP NUM 0 STARTING PARTITION NUMBER M0601204 RRNN NUM 0 NUMBER OF PARTITIONS TO USE M0601205 RR EJT M0601206 RR SPC 4 M0601207 RRSTORE NUM 0 SECTION TO STORE A WORD IN CSQ M0601208 RR RTJ DISKWR M0601209 RRVALUE1 NUM 0 M0601210 RR NUM 0 M0601211 RR JMP* (STORE) M0601212 RR EJT M0601213 RR* R O U T I N E T O P R O C E S S * M P B A S E M0601214 RR SPC 1 M0601215 RR* A D D R E S S L A B E L N A M E M0601216 RR SPC 8 M0601217 RRNAMBAS NOP 0 M0601218 RR SPC 1 M0601219 RR LDA- SYMSTR,I M0601220 RR STA* BASBUF M0601221 RR LDA- SYMSTR+1,I M0601222 RR STA* BASBUF+1 MOVE THE BASE NAME M0601223 RR LDA- SYMSTR+2,I M0601224 RR STA* BASBUF+2 M0601225 RR SPC 1 M0601226 RR RTJ* NAM010 M0601227 RR BZS BASBUF(3) M0601228 RRNAM010 NOP 0 M0601229 RR SPC 1 M0601230 RR LDA* NAM010 M0601231 RR STA- INPCTR,I M0601232 RR RTJ- TABSCH,I SEARCH FOR AN ENTRY POINT WITH THE NAME M0601233 RR LDQ- SW6,I WAS IT FOUND M0601234 RR SQP NAM020 YES, CONTINUE M0601235 RR RAO* NAMBAS NO, SPECIFY AN ERROR RETURN M0601236 RR JMP* (NAMBAS) INDICATE AN ILLEGAL *MP STATEMENT M0601237 RR SPC 1 M0601238 RRNAM020 STA- PROBAS,I SPECIFY THE NEW BASE ADDRESS M0601239 RR STA PARSTR M0601240 RR LDA MSIZV4 END OF LOAD = MAXIMUM SYSTEM ADDRESS M0601241 RR STA- TOP,I M0601242 RR STA- COMLIM,I M0601243 RR SPC 1 M0601244 RR JMP* (NAMBAS) RETURN M0601245 RR EJT 1 M0601246 RR* R O U T I N E T O V E R I F Y T H A T A M0601247 RR SPC 1 M0601248 RR* G I V E N V A L U E I S G R E A T E R T H A N M0601249 RR SPC 1 M0601250 RR* L S S E C T A N D L E S S T H A N T H E M0601251 RR SPC 1 M0601252 RR* V A L U E O F E N T R Y P O I N T S E C T O R . M0601253 RR SPC 8 M0601254 RRFMXSEC NOP 0 M0601255 RR LDQ* MAXSEC HAS SECTOR BEEN DEFINED IN CONTRL M0601256 RR SQZ CKSEC1 NO, SEE IF IT HAS BEEN OPERATOR DEFINED M0601257 RR TRQ A RETURN ADDRESS OF MAXSEC IN A M0601258 RR JMP* (FMXSEC) YES, RETURN TO CALLER M0601259 RRCKSEC1 RTJ* CKSEC2 M0601260 RR ALF 3,SECTOR M0601261 RRCKSEC2 NOP 0 M0601262 RR LDA* CKSEC2 PICKUP THE RUN TIME ADDRESS OF THE ENTRY M0601263 RR STA- INPCTR,I POINT NAME FOR THE TABLE SEARCH ROUTINE M0601264 RR RTJ- TABSCH,I SEARCH TO SEE IF SECTOR HAS BEEN DEFINED M0601265 RR LDQ- SW6,I IS SECTOR DEFINED M0601266 RR SQP CKSEC3-*-1 YES, SAVE ITS VALUE M0601267 RR ENA $24 NO, ERROR SECTOR IS NOT DEFINED M0601268 RRCKSERR JMP* QTYPE M0601269 RRCKSEC3 STA* MAXSEC SAVE THE VALUE OF SECTOR M0601270 RR JMP* (FMXSEC) M0601271 RR SPC 3 M0601272 RRCHKSEC NOP 0 M0601273 RRCKSEC LDA* SECVAL IS THE NEW SECTOR VALUE GREATER THAN OR M0601274 RR SUB LSSECT EQUAL TO THE CURRENT VALUE OF LSSECT M0601275 RR SAP CKSEC5-*-1 YES, CHECK FOR MASS STORAGE OVERFLOW M0601276 RRCKSEC4 ENA $A ERROR A, ILLEGAL SECTOR SPECIFIED ON M0601277 RR JMP* CKSERR INITIALIZER CONTROL STATEMENT M0601278 RRCKSEC5 LDA* MAXSEC IS THE NEW SECTOR VALUE LESS THAN OR M0601279 RR SUB* SECVAL EQUAL TO THE MAXIMUM SECTOR ALLOWABLE M0601280 RR SAP CKSEC6-*-1 YES, RETURN TO CALLER M0601281 RR JMP* CKSEC4 NO, OUTPUT THE ERROR TO THE USER M0601282 RRCKSEC6 JMP* (CHKSEC) RETURN TO CALLER M0601283 RRMAXSEC NUM 0 MAXIMUM SYSTEM SECTOR SPECIFIED BY THE USER M0601284 RRSECVAL NUM 0 SECTOR VALUE SPECIFIED ON *M OR *MP M0601285 RR* CONTROL STATEMENT M0601286 RR EJT 1 M0601287 RR* ********************************************************************M0601288 RR* ROUTINE TO SETUP POINTERS FOR A LINK TO THE CREP TABLE M0601289 RR* ********************************************************************M0601290 RR SPC 1 M0601291 RRLCREP NOP 0 M0601292 RR LDA- ENTST0,I SET THE START OF THE ENTRY POINT TABLE M0601293 RR STA- ENTPGS,I TO POINT TO THE START OF THE CREP TABLE. M0601294 RR LDA- ECREP,I SET THE END OF THE ENTRY POINT TABLE M0601295 RR STA- MAXENT,I TO POINT TO THE END OF THE CREP TABLE M0601296 RR JMP* (LCREP) M0601297 RR SPC 10 M0601298 RR* ********************************************************************M0601299 RR* ROUTINE TO SETUP POINTERS FOR A LINK TO THE CREP1 TABLE M0601300 RR* ********************************************************************M0601301 RR SPC 1 M0601302 RRLCREP1 NOP 0 M0601303 RR LDA- ENTST1,I SET THE START OF THE ENTRY POINT TABLE TO M0601304 RR STA- ENTPGS,I POINT TO THE START OF THE CREP1 TABLE. M0601305 RR LDA- ECREP1,I SET THE END OF THE ENTRY POINT TABLE TO M0601306 RR STA- MAXENT,I POINT TO THE END OF THE CREP1 TABLE. M0601307 RR JMP* (LCREP1) M0601308 RR EJT 1 M0601309 RR* ********************************************************************M0601310 RR* ROUTINE FOR BACKGROUNDING INPUT BUFFER M0601311 RR* ********************************************************************M0601312 RRBACKGR ADC 0 ADDR FROM WHENCE WE CAME M0601313 RR LDQ ISAV RESTORE INDEX I M0601314 RR LDA- INPADR,Q ADDR OF INPUT BUFFER M0601315 RR INA -1 M0601316 RR STA- I TO INDEX I M0601317 RR ENQ 59 M0601318 RR SET A SET A TO ALL ONES M0601319 RRBG10 STA- 1,B ALL ONES TO INPUT BUFFER M0601320 RR INQ -1 M0601321 RR SQM BG20-*-1 MINUS IMPLIES BUFFER BACKGROUNDED M0601322 RR JMP* BG10 M0601323 RRBG20 LDA ISAV RESTORE INDEX I M0601324 RR STA- I ONE OF CONTAB M0601325 RR JMP* (BACKGR) RETURN M0601326 RR EJT 1 M0601327 RR* ********************************************************************M0601328 RR* ROUTINE FOR OUTPUTTING THE MESSAGE M0601329 RR* ERROR XX M0601330 RR* ********************************************************************M0601331 RRTYPEQ ADC 0 A = ERROR NBR ON ENTRY M0601332 RR JMP* TYPEQ9 Q = 0 IF ERROR, 1 OTHERWISE M0601333 RRTYPEQ1 ADC 0 M0601334 RR SQZ QERR-*-1 M0601335 RR JMP* QOUT M0601336 RRQERR LDQ ISAV RESTORE INDEX I M0601337 RR STQ- I M0601338 RR RTJ- CONVRT,I CONVERT NBR IN A REG M0601339 RR LDQ- INPADR,I ADDR OF INPUT BUFFER M0601340 RR LDA- BINASC+1,I CONVERSION RESULTANT M0601341 RR ARS 8 TEST LEFT HALF CHARACTER M0601342 RR INA -$30 FOR A ZERO M0601343 RR SAN TYPEQ2-*-1 NON-ZERO IF NUMBER M0601344 RR LDA- BINASC+1,I CHANGE ZERO TO A BLANK M0601345 RR SUB =N$1000 M0601346 RR JMP* TYPEQ3 M0601347 RRTYPEQ2 LDA- BINASC+1,I CONVERSION RESULTANT M0601348 RRTYPEQ3 STA* ERNBR STORE IN OUTPUT BUFFER M0601349 RR LDA* TYPEQ1 ADDRESS OF QBUFR M0601350 RR INA 1 ADDRESS OF EBUFR M0601351 RR ENQ 5 5 WORDS OUT M0601352 RR RTJ TELOUT OUTPUT MESSAGE TO TELETYPE M0601353 RR SPC 5 M0601354 RR* ********************************************************************M0601355 RR* ROUTINE FOR OUTPUTTING Q TO THE COMMENT DEVICE M0601356 RR* M0601357 RR* ********************************************************************M0601358 RRQOUT LDA* TYPEQ1 ADDRESS OF QBUFR M0601359 RR LDQ ISAV RESTORE INDEX I M0601360 RR STQ- I M0601361 RR ENQ 1 M0601362 RR RTJ TELOUT OUTPUT MESSAGE TO TELETYPE M0601363 RR RTJ* BACKGR M0601364 RR LDA- INPADR,I ADDR OF INPUT BUFFER M0601365 RR JMP CM45 M0601366 RRTYPEQ9 RTJ* TYPEQ1 M0601367 RRQBUFR NUM $0A51 LINE FEED AND CHARACTER Q M0601368 RREBUFR NUM $0A45 LINE FEED AND CHAR E M0601369 RR ALF 3,RROR ERROR MESSAGE M0601370 RRERNBR ADC 0 ASCII ERROR NBR M0601371 RRQTYPE CLR Q ERROR IF Q = 0 M0601372 RR RTJ TYPEQ TYPE ERROR AND Q, COMM MED M0601373 RR EJT 1 M0601374 RR* ********************************************************************M0601375 RR* PROCESS *I, *O, AND *C CONTROL STATEMENTS M0601376 RR* M0601377 RR* ACCEPTABLE LU ASSIGNMENTS M0601378 RR* INPUT................LU M0601379 RR* PAPER TAPE 1 M0601380 RR* CARD 2 **MSOS 4.1**M0601381 RR* MAG TAPE 3 **MSOS 4.1**M0601382 RR* M0601383 RR* OUTPUT...............LU M0601384 RR* MASS MEMORY 4 M0601385 RR* UNUSED(RESERVED) 5 M0601386 RR* M0601387 RR* LIST.................LU M0601388 RR* TELETYPE 6 M0601389 RR* PRINTER 7 M0601390 RR* DUMMY 8 M0601391 RR* ********************************************************************M0601392 RR SPC 2 M0601393 RRSTARI ENA 0 PROCESS STATEMENT OF FORM *I,LU,EQUIP M0601394 RR JMP* SETIO M0601395 RR SPC 2 M0601396 RRSTARO ENA 1 PROCESS STATEMENT OF FORM *O,LU,EQUIP M0601397 RR JMP* SETIO M0601398 RR SPC 2 M0601399 RRSTARC ENA 2 PROCESS STATEMENT OF FORM *C,LU,EQUIP M0601400 RR SPC 2 M0601401 RRSETIO STA* SWTHIO 0=INPUT, 1=OUTPUT, 2=LIST M0601402 RR RTJ COMMA IS DELIMETER A COMMA M0601403 RR JMP* ILDEL NO, TYPE ERROR E, Q M0601404 RR ENA 8 YES, PICKUP LOGICAL UNIT NUMBER M0601405 RR STA- SCANSW,I SETTING BIT 3 OF SCANSW SAYS FETCH A NAME M0601406 RR CLR A OR DECIMAL NUMBER M0601407 RR RTJ- SCAN,I M0601408 RR LDA- SYMSTR,I IF SYMSTR EQUALS ZERO THE FIELD WAS NUMERIC M0601409 RR SAZ OKNB-*-1 M0601410 RRNOKNB ENA 8 NAME APPEARS IN NUMBER FIELD M0601411 RR JMP* QTYPEX TYPE ERROR 8, Q M0601412 RROKNB LDQ- SCNINP,I PICKUP BINARY VALUE OF NUMBER M0601413 RR ADQ TABLE IS THE NUMBER VALID (TABLE= -MAXLU-1 ) M0601414 RR SQM LUOK-*-1 YES M0601415 RRSTIOER ENA $12 NO, TYPE ERROR 12, Q M0601416 RRQTYPEX JMP QTYPE M0601417 RRLUOK LDQ SCNINP,I M0601418 RR RTJ* ABS CALCULATE THE ABSOLUTE ADDRESS **MSOS 4.1**M0601419 RRABS NUM 0 OF THE L. U. TABLE **MSOS 4.1**M0601420 RR LDA* ABS **MSOS 4.1**M0601421 RR ADD* REL **MSOS 4.1**M0601422 RR ADD* ATABLE **MSOS 4.1**M0601423 RR AAQ A ADDRESS OF THIS L.U. ENTRY **MSOS 4.1**M0601424 RR LDQ TABLE,Q REL. ADDRESS OF THIS L.U. DRIVER **MSOS 4.1**M0601425 RR AAQ Q **MSOS 4.1**M0601426 RR LDA* (ZERO),Q IS THE REQUIRED MODULE LOADED **MSOS 4.1**M0601427 RR SAZ DEVDEF YES **MSOS 4.1**M0601428 RR INA 0 **MSOS 4.1**M0601429 RR SAN DEVDEF-*-1 YES M0601430 RR JMP* STIOER NO, OUTPUT ERROR 12, Q M0601431 RRATABLE ADC TABLE **MSOS 4.1**M0601432 RRREL ADC ATABLE-ABS **MSOS 4.1**M0601433 RRZERO NUM 0 **MSOS 4.1**M0601434 RRDEVDEF LDA SCNINP,I **MSOS 4.1**M0601435 RR LDQ SWTHIO M0601436 RR STA* IN,Q STORE ADDRESS OF DRIVER IN UNIT WORD M0601437 RR RTJ* VALID IS DELIMITER BLANK OR CARRIAGE RETURN M0601438 RR SQN OKNB1-*-1 NO, CHECK FOR COMMA M0601439 RR JMP* CM44EX YES, TYPE Q AND INTERROGATE COMMENT MEDIUM M0601440 RROKNB1 RTJ COMMA IS DELIMETER A COMMA M0601441 RR JMP* ILDEL NO, OUTPUT ERROR E, Q M0601442 RR RTJ GETHEX YES, GET EQUIPMENT CODE M0601443 RR LDA- SYMSTR,I IS FIELD NUMERIC M0601444 RR SAZ OKNB2-*-1 YES M0601445 RR JMP* NOKNB NO,OUTPUT ERROR 8, Q M0601446 RROKNB2 RTJ* VALID IS DELIMETER BLANK OR CARRIAGE RETURN M0601447 RR SQZ OKNB3-*-1 YES M0601448 RR JMP* ILDEL NO, OUTPUT ERROR E, Q M0601449 RROKNB3 LDA- SCNINP,I PICKUP FOUR DIGIT EQUIPMENT CODE M0601450 RR LDQ* SWTHIO PICKUP INDEX TO CONTROL STATEMENT TYPE M0601451 RR LDQ* IN,Q PICKUP LOGICAL UNIT BEING SETUP BY STATEMENT M0601452 RR STQ* SWTHIO SAVE LOGICAL UNIT M0601453 RR QLS 1 MULTIPLY LOGICAL UNIT BY THREE TO M0601454 RR ADQ* SWTHIO FORM INDEX TO UNIT TABLE M0601455 RR JMP* IN,Q STORE EQUIP CODE THEN GET NEXT STATEMENT M0601456 RRDUMMY NUM 0 SLOT FOR DUMMY DEVICES M0601457 RRILDEL ENA 14 ERROR E, ILLEGAL FIELD DELIMETER M0601458 RRTYPIO JMP* QTYPE OUTPUT ERROR XX, Q M0601459 RRSWTHIO NUM 0 SWITCH DEFINING I/O DEVICE TYPE M0601460 RRIN NUM 0 INPUT UNIT M0601461 RROU NUM 0 OUTPUT UNIT M0601462 RRCO NUM 0 COMMENT UNIT M0601463 RR STA EPTAPE SAVE EQUIPMENT FOR PAPER TAPE **MSOS 4.1**M0601464 RR JMP* CM44EX M0601465 RR STA ECARD SAVE EQUIPMENT FOR CARD READER **MSOS 4.1**M0601466 RR JMP* CM44EX M0601467 RR STA EMTAPE SAVE EQUIPMENT FOR MAG TAPE **MSOS 4.1**M0601468 RR JMP* CM44EX M0601469 RR STA EMASS SAVE EQUIPMENT FOR MASS MEMORY M0601470 RR JMP* CM44EX M0601471 RR NOP 0 NO EQUIPMENT---UNUSED(RESERVED) M0601472 RR NOP 0 M0601473 RR JMP* CM44EX M0601474 RR STA ECOM SAVE EQUIPMENT FOR COMMENT **MSOS 4.1**M0601475 RR JMP* CM44EX M0601476 RR STA EPRINT SAVE EQUIPMENT FOR PRINTER **MSOS 4.1**M0601477 RR JMP* CM44EX M0601478 RR STA DUMMY SLOT FOR DUMMY DEVICE L.U. 8 M0601479 RRCM44EX JMP CM44 NO, PROCESS NEXT CONTROL STATEMENT**MSOS 4.1**M0601480 RR EJT 1 M0601481 RR* ********************************************************************M0601482 RR* TEST FOR BLANK OR CARRIAGE RETURN AS FIELD TERM M0601483 RR* ********************************************************************M0601484 RRVALID ADC 0 TEST FOR BLANK OR CARR RET M0601485 RR RTJ OETERM FETCH TERMINATOR M0601486 RR INQ -1 TEST CONST FOR CARR RETURN M0601487 RR SQN VAL10-*-1 M0601488 RR JMP* (VALID) CARRIAGE RETURN M0601489 RRVAL10 INQ -2 TEST CONST FOR BLANK M0601490 RR JMP* (VALID) RETURN M0601491 RR SPC 5 M0601492 RR* ********************************************************************M0601493 RR* COMPUTE NEXT MASS STORAGE SECTOR NUMBER M0601494 RR* ********************************************************************M0601495 RRNXTSEC ADC 0 M0601496 RR CLR Q M0601497 RR DVI =N96 96 WORDS PER SECTOR M0601498 RR SQZ NXT10-*-1 ZERO IMPLIES NO REMAINDER M0601499 RR INA 1 M0601500 RRNXT10 ADD LSSECT LSB OF MASS STG SECT NBR M0601501 RR STA LSSECT LSB OF MASS STG SECT NBR M0601502 RR JMP* (NXTSEC) M0601503 RR EJT 1 M0601504 RR* R O U T I N E T O P R O C E S S * S , N A M E , H H H H M0601505 RR SPC 1 M0601506 RR* C O N T R O L S T A T E M E N T M0601507 RR SPC 5 M0601508 RR* STATEMENT *S,NAME,H H H H WHERE NAME IS A ONE TO SIX M0601509 RR* CHARACTER NAME THAT WILL BE ENTERED INTO THE LOADER TABLE M0601510 RR* WITH A VALUE OF H H H H. IF THE *S STATEMENT IS ENTERED BEFORE M0601511 RR* THE FIRST *LP STATEMENT, THEN THE NAME AND ENTRY POINT WILL M0601512 RR* RESIDE IN THE CREP TABLE AT TERMINATION OF INITIALIZATION. M0601513 RR* IF THE *S STATEMENT FOLLOWS THE FIRST *LP STATEMENT, THEN M0601514 RR* THE NAME AND VALUE WILL RESIDE IN THE CREP1 TABLE AFTER M0601515 RR* INITIALIZATION IS COMPLETED. M0601516 RR* M0601517 RRSTARS RTJ COMMA IS DELIMETER COMMA M0601518 RRSERR1 JMP* ILDEL NO, TYPE ERROR E, Q M0601519 RR ENA 8 SET BIT 3 OF SCAN SWITCH SAYING PICKUP AN M0601520 RR STA- SCANSW,I ASCII FIELD, SAVE THE ASCII CHARACTER CODES M0601521 RR CLR A IN THE SYMSTR BLOCK, AND IF THE FIELD IS M0601522 RR RTJ- SCAN,I NUMERIC CONVERT THE NUMBER TO BINARY. M0601523 RR RTJ COMMA IS FIELD DELIMETER A COMMA M0601524 RR JMP* SERR1 NO, TYPE ERROR E, Q M0601525 RR LDA- SYMSTR,I YES, CHECK FOR NAME AND SAVE IT M0601526 RR SAZ SERR2-*-1 SYMSTR=0 IF A NUMERIC OPERAND WAS PROCESSED M0601527 RR SUB- BLANKS,I CHECK TO SEE IF NAME FIELD WAS BLANK M0601528 RR SAN SOK1-*-1 NOT BLANK M0601529 RRSERR2 ENA 2 OUTPUT ERROR 2 - NUMBER APPEARS IN NAME FIELD M0601530 RR JMP* TYPIO OR NAME FIELD IS BLANK M0601531 RRSOK1 LDA- SYMSTR,I NAME OCCURRED SO SAVE IT M0601532 RR STA* ENTRY M0601533 RR LDA- SYMSTR+1,I M0601534 RR STA* ENTRY+1 M0601535 RR LDA- SYMSTR+2,I M0601536 RR STA* ENTRY+2 M0601537 RR RTJ* LOCENT RETURN JUMP TO THE NEXT EXECUTABLE STATEMENT M0601538 RR BZS ENTRY(3) SO THE ADDRESS OF THE CODES FOR THIS NAME M0601539 RRVALUE ADC 0 CAN BE PASSED TO THE LOADER M0601540 RRLOCENT NOP 0 ADDRESS OF ENTRY NAME IS STORED HERE BY RTJ M0601541 RR RTJ GETHEX PICKUP HEX FIELD M0601542 RR RTJ* VALID WAS DELIMETER CARRIAGE RETURN OR BLANK M0601543 RR SQZ SOK2-*-1 YES M0601544 RR JMP* ILDEL NO, OUTPUT ERROR E, Q M0601545 RRSOK2 LDA- SYMSTR,I WAS FIELD NUMERIC M0601546 RR SAN TESTAL-*-1 NO M0601547 RR LDA- SCNINP,I YES, PICKUP THE VALUE M0601548 RRVALU STA* VALUE AND SAVE IT M0601549 RR JMP* LDRTAB MAKE ENTRY TO LOADER TABLE M0601550 RRTESTAL ARS 8 COME HERE IF FIELD 2 IS NOT NUMERIC M0601551 RR INA -$50 IS THE FIELD P M0601552 RR SAN NOTP-*-1 NO M0601553 RR LDA- PROBAS,I IF FIELD CONTAINED P AS FIRST CHARACTER, THEN M0601554 RR JMP* VALU SET THE ENTRY POINT TO THE PROGRAM BASE M0601555 RRNOTP INA -3 IS THE FIELD S M0601556 RR SAZ SOK3-*-1 NO, M0601557 RR JMP* SERR2 ILLEGAL STATEMENT FORMAT M0601558 RRSOK3 LDA LSSECT YES, PICKUP THE LSB OF CURRENT MASS STORAGE M0601559 RR JMP* VALU SECTOR AS VALUE FOR ENTRY POINT M0601560 RRLDRTAB STA- ENTPNT,I VALUE ASSOCIATED WITH ENTRY POINT NAME M0601561 RR LDA* LOCENT M0601562 RR STA- INPCTR,I ADDRESS OF ENTRY POINT NAME M0601563 RR RTJ- TABSCH,I IS THIS NAME ALREADY IN THE LOADER TABLE M0601564 RR LDQ- SW6,I M0601565 RR SQM NIN-*-1 NO, GO DOWN AND PUT IT INTO THE TABLE M0601566 RR JMP* CM20EX YES, IGNORE THIS *S STATEMENT M0601567 RRNIN ENA 4 M0601568 RR SUB- CSNAME,I IS THIS AN *M OR *MP LOAD M0601569 RR SAP NIN1-*-1 NO, STORE ENTRY M0601570 RR LDA- ECREP,I YES, BUMP END OF CREP TABLE M0601571 RR INA 4 M0601572 RR STA- ECREP,I M0601573 RRNIN1 RTJ ENTSTR PUT NEW ENTRY POINT INTO TABLE M0601574 RRCM20EX JMP CM20 GET NEXT CONTROL STATEMENT M0601575 RRLSSECT NUM 0 STARTING COMMAND SEQUENCE SECTOR M0601576 RR EJT 1 M0601577 RR SPC 5 M0601578 RR* M0601579 RR* *********************************************************************M0601580 RR* M0601581 RR* PROCESS *U STATEMENT M0601582 RR* M0601583 RR* *********************************************************************M0601584 RRSTARU RTJ* VALID IS DELIMETER CR OR BLANK M0601585 RR SQN ILDEL2-*-1 M0601586 RR CLR A YES, SET FOR INITIALIZER TO INTERROGATE M0601587 RR STA- INMED,I COMMENT MEDIUM. M0601588 RR JMP CM44 *U..TYPE Q, INTERROGATE COMMENT MEDIUM M0601589 RR* M0601590 RR* *********************************************************************M0601591 RR* M0601592 RR* PROCESS *V STATEMENT M0601593 RR* M0601594 RR* *********************************************************************M0601595 RRSTARV RTJ* VALID IS DELIMETER CR OR BLANK M0601596 RR SQN ILDEL2-*-1 M0601597 RR ENA 1 YES, SET FOR INITIALIZER TO INTERROGATE M0601598 RR STA- INMED,I INPUT MEDIUM. M0601599 RR JMP CM20 BACKGROUND BUFFER, GET NEXT INPUT M0601600 RRILDEL2 JMP* SERR1 TYPE ERROR E, Q M0601601 RR* M0601602 RR*************************************************************** M0601603 RR* * M0601604 RR* PROCESS *D STATEMENT * M0601605 RR* * M0601606 RR*************************************************************** M0601607 RR* M0601608 RRSTARD RTJ* VALID IS DELIMITER CARRIAGE RETURN M0601609 RR* OR A BLANK M0601610 RR SQZ CONT M0601611 RR JMP* ILDEL2 M0601612 RRCONT ENA 0 ZERO TO RELOCATION M0601613 RR STA- DATBAS,I BASE FOR DATA STORAGE M0601614 RR STA- DATLIM,I HIGHEST ADDR.DATA STG+1 M0601615 RR CLR A,Q M0601616 RR RTJ ILOAD LOAD THE PROGRAM M0601617 RR JMP CM65 GO PROCESS NEXT CONTROL STATEMENT M0601618 RR EJT M0601619 RR************************************************************************M0601620 RR* *M0601621 RR* PROCESS *G STATEMENT *M0601622 RR* *M0601623 RR************************************************************************M0601624 RR SPC 2 M0601625 RRSTARG RTJ* VALID CHECK VALID DELIMITER M0601626 RR SQZ VALOK M0601627 RR JMP* ILDEL2 ERROR * AND REQUEST WITH Q M0601628 RRVALOK LDQ EMASS GET DISK STATUS ADDRESS M0601629 RR INP ERDISK-* TAKE STATUS TO DETERMINE ACTIVE DISK M0601630 RR RTJ* WAT GET ADDRESS M0601631 RR ALF 15,ENABLE ADDRESS WRITE--THEN CR M0601632 RR NUM $0D0A CR,LF M0601633 RRWAT NUM 0 M0601634 RR ENQ 16 WRITE 16 WORDS M0601635 RR LDA* WAT OUTPUT BUFFER ADDRESS M0601636 RR RTJ TELOUT WRITE MESSAGE M0601637 RR CLR Q READ CR ENTRY M0601638 RR LDA- INPADR,I M0601639 RR RTJ QCOM M0601640 RR SET A SET FLAG FOR ADDRESS WRITE M0601641 RR RTJ QMASS WRITE TAGS M0601642 RR SAZ DKERR (A)=0 INDICATES ERROR M0601643 RR JMP CM20 NO ERROR -- PRINT Q M0601644 RRDKERR RTJ* DSKER PRINT ERROR M0601645 RR ALF 06,DISK ERROR M0601646 RR NUM $0D0A M0601647 RRDSKER NUM 0 M0601648 RR ENQ 7 PRINT ERROR MESSAGE M0601649 RR LDA* DSKER M0601650 RR RTJ TELOUT M0601651 RR JMP CM20 GO TO PRINT Q M0601652 RRERDISK NOP 0 REJECT PATH M0601653 RR RTJ* DISKER M0601654 RR ALF 6,DISK REJECT M0601655 RR NUM $0D0A M0601656 RRDISKER NUM 0 M0601657 RR ENQ 7 PRINT REJECT MESSAGE M0601658 RR LDA* DISKER M0601659 RR RTJ TELOUT M0601660 RR JMP CM20 GO TO PRINT Q M0601661 RR EJT M0601662 RR************************************************************************M0601663 RR* *M0601664 RR* PROCESS *H STATEMENT *M0601665 RR* *M0601666 RR************************************************************************M0601667 RR SPC 2 M0601668 RRSTARH RTJ COMMA IS DELIMITER A COMMA M0601669 RR JMP* ILDEL2 NO, ERROR E M0601670 RR RTJ GETHEX GET STOP SECTOR M0601671 RR LDA- SYMSTR,I CHECK NUMERIC FIELD M0601672 RR SAZ OKNH M0601673 RR JMP NOKNB NO, ERROR 8 M0601674 RROKNH LDA- SCNINP,I SAVE STOP SECTOR NUMBER M0601675 RR STA TSECT M0601676 RR RTJ VALID CHECK FOR CR OR BLANK M0601677 RR SQZ TERMH M0601678 RR JMP* ILDEL2 NO, ERROR E M0601679 RRTERMH SET A FIRST PATTERN - ALL ONES M0601680 RR STA* PTN M0601681 RR LDA- I M0601682 RR STA* PTNI SAVE TABLE POINTER M0601683 RR RTJ* SETPTN M0601684 RR SET A M0601685 RR STA* PTN1 M0601686 RR RTJ* WPTN M0601687 RR RTJ* RPTN M0601688 RR LDA =N$5555 PATTERN $5555 M0601689 RR STA* PTN M0601690 RR CLR A M0601691 RR STA* PTN1 M0601692 RR RTJ* SETPTN M0601693 RR RTJ* WPTN M0601694 RR RTJ* RPTN M0601695 RR LDA =N$AAAA PATTERN $AAAA M0601696 RR STA* PTN M0601697 RR RTJ* SETPTN M0601698 RR RTJ* WPTN M0601699 RR RTJ* RPTN M0601700 RR CLR A PATTERN 0 M0601701 RR STA* PTN M0601702 RR RTJ* SETPTN M0601703 RR RTJ* WPTN M0601704 RR RTJ* RPTN M0601705 RR JMP CM20 COMPLETED M0601706 RR SPC 4 M0601707 RRSETPTN NUM 0 SET BUFFER TO PATTERN M0601708 RR ENQ 95 M0601709 RR LDA* PTN GET DATA PATTERN M0601710 RRPTNSET STA PTNBUF,Q M0601711 RR INQ -1 M0601712 RR SQM RTNPTN M0601713 RR JMP* PTNSET M0601714 RRRTNPTN JMP* (SETPTN) M0601715 RRPTN NUM 0 M0601716 RR SPC 4 M0601717 RRWPTN NUM 0 WRITE DATA M0601718 RR ENQ 0 SET ZERO SECTOR ADDRESS M0601719 RR STQ- I SECTOR ADDRESS M0601720 RRLWPTN RTJ* FWA M0601721 RRFWA NUM 0 M0601722 RR LDA* FWA COMPUTE BUFFER ADDRESS M0601723 RR ADD =XPTNBUF-FWA M0601724 RR ENQ -96 M0601725 RR RTJ QMASS WRITE SECTOR M0601726 RR SAM GODY SKIP, NO ERROR M0601727 RR TRQ A M0601728 RR INA -7 M0601729 RR SAN BADERR SKIP NO COMPARE ERROR M0601730 RR LDA* PTN1 M0601731 RR SAM GODY FIRST WRITE--COMPARE OK M0601732 RRBADERR JMP* PTNERR PRINT ERROR M0601733 RRGODY RAO- I CHECK LIMITS M0601734 RR LDA- I M0601735 RR* 1 CARD DELETED M0601736 RR SUB TSECT M0601737 RR SAZ WDONE SKIP IF ALL WRITTEN M0601738 RR JMP* LWPTN DO MORE M0601739 RRWDONE JMP* (WPTN) M0601740 RRPTN1 NUM 0 M0601741 RRPTNI NUM 0 M0601742 RR* 1 CARD DELETED M0601743 RR SPC 4 M0601744 RRRPTN NUM 0 READ DATA M0601745 RR ENQ 0 SET ZERO SECTOR ADDRESS M0601746 RR STQ CURSCT M0601747 RRLRPTN STQ- I M0601748 RR RTJ* RFWA M0601749 RRRFWA NUM 0 READ DATA SUBROUTINE M0601750 RR LDA* RFWA M0601751 RR ADD =XPTNBUF-RFWA COMPUTE BUFFER ADDRESS M0601752 RR ENQ 96 M0601753 RR RTJ QMASS READ SECTOR OF DATA M0601754 RR SAM RGODY M0601755 RR JMP* PTNERR DISK ERROR - PRINT MESSAGE AND EXIT M0601756 RRRGODY ENQ 95 LOOP TO CHECK PATTERN M0601757 RRRGODYA LDA* PTNBUF,Q M0601758 RR EOR* PTN M0601759 RR SAN NOMTCH ZERO INDICATES GOOD MATCH M0601760 RR INQ -1 SEE IF SECTOR DONE M0601761 RR SQM SECNXT M0601762 RR JMP* RGODYA MORE THIS SECTOR M0601763 RRSECNXT JMP* BMPSCT GO TO NEXT SECTOR M0601764 RRNOMTCH LDA* PTNI FAILED SECTOR, RESTORE TABLE POINTER M0601765 RR STA- I M0601766 RR LDA CURSCT M0601767 RR* 1 CARD REMOVED FOR PSR 90*2673 M0601768 RR RTJ- CONVRT,I CONVERT TO ASCII M0601769 RR LDA- BINASC,I STORE IN MESSAGE BUFFER M0601770 RR STA* COMBUF+13 M0601771 RR LDA- BINASC+1,I M0601772 RR STA* COMBUF+14 M0601773 RR TRQ A FAILED WORD M0601774 RR RTJ- CONVRT,I M0601775 RR LDA- BINASC,I M0601776 RR STA* COMBUF+18 M0601777 RR LDA- BINASC+1,I M0601778 RR STA* COMBUF+19 M0601779 RR LDA* PTNBUF,Q BAD PATTERN READ M0601780 RR RTJ- CONVRT,I M0601781 RR LDA- BINASC,I M0601782 RR STA* COMBUF+22 M0601783 RR LDA- BINASC+1,I M0601784 RR STA* COMBUF+23 M0601785 RR LDA* PTN EXPECTED PATTERN M0601786 RR RTJ- CONVRT,I M0601787 RR LDA- BINASC,I M0601788 RR STA* COMBUF+26 M0601789 RR LDA- BINASC+1,I M0601790 RR STA* COMBUF+27 M0601791 RR RTJ* COMMSG PRINT MESSAGE M0601792 RRCOMBUF ALF 28,DISK COMPARE ERROR SECT XXXX WORD XXXX IS XXXX SB XXXX M0601793 RR NUM $0D0A M0601794 RRCOMMSG NUM 0 M0601795 RR LDA* COMMSG M0601796 RR ENQ 29 M0601797 RR RTJ TELOUT M0601798 RRBMPSCT LDQ CURSCT LOOK AT NEXT SECTOR-ONE ERROR PER SECT M0601799 RR INQ 1 HAVE ALL SECTORS BEEN READ M0601800 RR STQ CURSCT M0601801 RR TRQ A M0601802 RR* 1 CARD DELETED M0601803 RR SUB* TSECT M0601804 RR SAZ RDONE ZERO INDICATES ALL DONE M0601805 RR JMP* LRPTN GO TO NEXT SECTOR M0601806 RRRDONE JMP* (RPTN) RETURN - ALL READS DONE M0601807 RR SPC 4 M0601808 RRPTNERR LDA* PTNI DISK FAILURE ERROR M0601809 RR STA- I M0601810 RR TRQ A M0601811 RR RTJ- CONVRT,I CONVERT ERROR TO ASCII M0601812 RR LDA- BINASC,I STORE IN MESSAGE M0601813 RR STA* DFAIL+7 M0601814 RR LDA- BINASC+1,I M0601815 RR STA* DFAIL+8 M0601816 RR RTJ* FALMSG PRINT MESSAGE M0601817 RRDFAIL ALF 09,DISK FAILURE XXXX M0601818 RR NUM $0D0A M0601819 RRFALMSG NUM 0 M0601820 RR LDA* FALMSG M0601821 RR ENQ 10 M0601822 RR RTJ TELOUT M0601823 RR JMP CM20 FATAL ERROR, EXIT TO GET NEXT STATEMEN M0601824 RRPTNBUF BZS PTNBUF(96) M0601825 RRTSECT NUM 0 M0601826 RRCURSCT NUM 0 M0601827 RR EJT 1 M0601828 RR* R O U T I N E T O P R O C E S S * T M0601829 RR SPC 5 M0601830 RRSTART RTJ WRTOUT WRITE OUT THE RESULT OF THE LAST *M OR *MP M0601831 RR RTJ M7A UPDATE LSSECT AND PAGES M0601832 RR ENA 0 M0601833 RR STA- CSNAME,I CLEAR CONTROL STATEMENT INDICATOR M0601834 RR STA- CORADR,I RESET THE START OF THE PAGING AREA TO ZERO M0601835 RR LDA- FLGBS1,I RESET THE BASE OF THE FLAG TABLE TO M0601836 RR STA- FLGBSE,I THE FLAGS FOR SYSTEM PAGES M0601837 RR LDA- SYSPGE,I REBUILD THOSE PAGES WRITTEN OUT TO M0601838 RR STA- NOPAGE,I MAKE ROOM FOR *M AND *MP LOADS M0601839 RR LDA LENSDT SETUP COUNTER EQUAL TO THE COMPLIMENT66*1455 M0601840 RR TCA A OF THE NUMBER OF PAGES (LENSDT) M0601841 RR STA* PCOUNT M0601842 RR LDQ- FLGBSE,I PICKUP THE START OF THE FLAG TABLE M0601843 RRT0 ENA 1 M0601844 RR STA- MODIFY,Q SET THE MODIFIED FLAG FOR THIS PAGE M0601845 RR RAO* PCOUNT INCREMENT THE PAGE COUNTER M0601846 RR LDA* PCOUNT HAS THE FLAG BEEN SET FOR ALL LENSDT PAGES M0601847 RR SAZ T0A-*-1 YES M0601848 RR INQ 3 NO,INCREMENT POINTER TO THE NEXT SET OF FLAGS M0601849 RR JMP* T0 LOOP BACK TO SET NEXT FLAG M0601850 RRT0A LDA LSSECT TEMPORARILY SAVE LSSECT M0601851 RR STA* TMPSEC M0601852 RR ENA SYSECT RESTORE LSSECT SO IT WILL POINT TO M0601853 RR STA LSSECT THE START OF CORE IMAGE M0601854 RR LDA LENSDT NUMBER OF CORE RESIDENT PAGES 66*1455 M0601855 RR MUI- FLGLGN,I MULTIPLY BY THE NUMBER OF FLAGS/PAGE AND M0601856 RR ADD- FLGBSE,I ADD ON THE BASE OF THE FLAG TABLE TO M0601857 RR STA* BLDADD FIND THE START OF THE PAGES TO REBUILD M0601858 RR LDA LENSDT NUMBER OF CORE RESIDENT PAGES 66*1455 M0601859 RR SUB- NOPAGE,I COMPUTE A COUNTER FOR THE PAGES TO BE M0601860 RR STA* PCOUNT READ IN FROM MASS STORAGE M0601861 RR LDA LENSDT COMPUTE ADDRESS OF THE PAGE TO - 66*1455 M0601862 RR MUI- PAGE,I BE READ IN M0601863 RR STA* PAGADD M0601864 RRT1 LDQ* BLDADD PICKUP THE BASE FLAG ADDRESS FOR REBUILD M0601865 RR LDA- PGENUM,Q READ THE PAGE BACK INTO CORE M0601866 RR RTJ FNDSEC CONVERT PAGE NUMBER TO SECTOR ADDRESS M0601867 RR LDA* PAGADD PICKUP ADDRESS TO READ INTO M0601868 RR RTJ MDRIV READ THE PAGE INTO CORE M0601869 RR LDQ ISAV M0601870 RR STQ- I RESTORE THE I-REGISTER M0601871 RR SAN T2-*-1 SKIP IF NO ERROR M0601872 RR JMP* T21 IRRECOVERABLE MASS STORAGE ERROR M0601873 RRT2 RAO* PCOUNT INCREMENT THE PAGE COUNTER M0601874 RR LDA* PCOUNT HAVE ALL PAGES BEEN READ BACK IN M0601875 RR SAZ T2A-*-1 YES, GO ON TO LINK STAGE M0601876 RR LDQ* BLDADD UPDATE THE POINTER TO THE FLAGS FOR THE M0601877 RR INQ 3 NEXT PAGE TO REBUILD M0601878 RR STQ* BLDADD M0601879 RR LDA* PAGADD INCREMENT THE ADDRESS COUNTER TO THE M0601880 RR ADD- PAGE,I CORE ADDRESS FOR THE NEXT PAGE M0601881 RR STA* PAGADD M0601882 RR JMP* T1 GO TO GET NEXT PAGE M0601883 RRT2A LDA STRTEX RESTORE THE EXTERNAL POINTER TO THE START M0601884 RR STA- EXTSTR,I OF THE SYSTEM EXTERNAL TABLE M0601885 RR LDA ENDEXT RESTORE THE EXTERNAL POINTER TO THE END M0601886 RR STA- EXTCTR,I OF THE SYSTEM EXTERNAL TABLE M0601887 RR RTJ LCREP SETUP POINTERS FOR A LINK TO CREP M0601888 RR RTJ* T20 M0601889 RR ALF 3,STMSV4 M0601890 RRT20 NOP 0 M0601891 RR LDA* T20 M0601892 RR STA- INPCTR,I M0601893 RR RTJ- TABSCH,I FIND THE ENTRY POINT STMSV4 M0601894 RR LDQ- SW6,I M0601895 RR SQM T21-*-1 SKIP IF STMSV4 NOT DEFINED M0601896 RR RTJ I2 WRITE OUT THE AUTOLOAD SECTOR M0601897 RR LDQ ISAV M0601898 RR STQ- I RESTORE THE I-REGISTER M0601899 RR SAZ T21-*-1 SKIP IF ERROR M0601900 RR JMP* T3 M0601901 RRT21 ENA $16 IRRECOVERABLE MASS STORAGE ERROR M0601902 RR JMP QTYPE M0601903 RRT3 LDA- COMBAS,I SET START OF SYSTEM COMMON M0601904 RR ENQ 16 INTO THE EXTENDED CORE TABLE. M0601905 RR STA- ($E9),Q M0601906 RR ENQ 10 PICK UP UNPROTECTED FLAG FROM WORD M0601907 RR LDQ- ($E9),Q 10 OF EXTENDED CORE TABLE M0601908 RR SQN T3A-*-1 SKIP IF UNPROTECTED IN PART1 M0601909 RR JMP* T10 GO TO HANDLE UNPROTECTED IN PART 0 M0601910 RRT3A RTJ* T3B LOOK UP ENTRY POINT 'UNPEND' 120*4614M0601911 RR ALF 3,UNPEND 120*4614M0601912 RRT3B NOP 0 120*4614M0601913 RR LDA* T3B 120*4614M0601914 RR STA- INPCTR,I 120*4614M0601915 RR RTJ- TABSCH,I 120*4614M0601916 RR LDQ- SW6,I IS 'UNPEND' DEFINED ? 120*4614M0601917 RR SQM T3C IF 'UNPEND' NOT DEFINED USE 'MSIZV4' 120*4614M0601918 RR INA 1 120*4614M0601919 RR JMP* T4 USE 'UNPEND' AS END OF UNPROTECTED 120*4614M0601920 RRT3C LDA MSIZV4 120*4614M0601921 RR SAZ T5-*-1 SKIP IF MSIZV4 HAS NOT BEEN USED BY SI M0601922 RRT4 STA- $F6 SET F6 TO MSIZV4 (END OF PART1) M0601923 RR JMP* T6 M0601924 RRT5 RTJ LP11A GO TO GET MSIZV4 M0601925 RR JMP* T4 M0601926 RRT6 RTJ* T6A LOOK UP ENTRY POINT 'UNPSRT' 120*4614M0601927 RR ALF 3,UNPSRT 120*4614M0601928 RRT6A NOP 0 120*4614M0601929 RR LDA* T6A 120*4614M0601930 RR STA- INPCTR,I 120*4614M0601931 RR RTJ- TABSCH,I 120*4614M0601932 RR LDQ- SW6,I IS 'UNPSRT' DEFINED ? 120*4614M0601933 RR SQM T6B IF 'UNPSRT' UNDEFINED USE OLD METHOD 120*4614M0601934 RR INA -1 120*4614M0601935 RR JMP* T7 120*4614M0601936 RRT6B LDA LPENDC WERE THERE ANY *LP LOADS ? 120*4614M0601937 RR SAZ T8-*-1 NO, USE LSTLOC FOR END OF PART1 M0601938 RRT7 STA- $F7 YES, USE END OF *LP LOADS FOR END OF PART1 M0601939 RR JMP* T11 M0601940 RRBLDADD NUM 0 M0601941 RRPCOUNT NUM 0 M0601942 RRPAGADD NUM 0 M0601943 RRTMPSEC NUM 0 M0601944 RRT8 LDA LSTLOC HAS LSTLOC BEEN DEFINED M0601945 RR SAZ T8A-*-1 NO, SEE IF IT EXISTS M0601946 RR JMP* T7 YES, USE LSTLOC FOR F7 M0601947 RRT8A RTJ LCREP POINT TO CREP TO FIND LSTLOC M0601948 RR RTJ* T8B M0601949 RR ALF 3,LSTLOC M0601950 RRT8B NOP 0 M0601951 RR LDA* T8B M0601952 RR STA- INPCTR,I M0601953 RR RTJ- TABSCH,I M0601954 RR LDQ- SW6,I IS LSTLOC DEFINED M0601955 RR SQP T8C-*-1 YES, USE IT AS THE START OF UNPROTECTED M0601956 RR JMP* T9 NO, USE END0V4 AS THE START OF UNPROTECTED M0601957 RRT8C INA -1 M0601958 RR TRA Q M0601959 RR LDA- 1,Q PICKUP THE VALUE OF LSTLOC M0601960 RR INA -1 DECREMENT TO THE END OF PROTECTED M0601961 RR JMP* T7 M0601962 RRT9 LDA END0V4 USE END0V4 FOR F7 M0601963 RR JMP* T7 M0601964 RRT10 LDA- COMBAS,I SET F6 = START OF SYSTEM COMMON 61*1287 M0601965 RR SAN 2 61*1287 M0601966 RR LDA COMM0 61*1287 M0601967 RR STA- $F6 M0601968 RR RTJ LCREP SET ENTRY TABLE TO CREP0 M0601969 RR RTJ* TAG001 M0601970 RR ALF 3,AREAC M0601971 RRTAG001 ADC 0 M0601972 RR LDA* TAG001 M0601973 RR STA- INPCTR,I M0601974 RR RTJ- TABSCH,I PICKUP ADDRESS OF AREAC M0601975 RR STA- $F7 M0601976 RRT11 LDA- $F6 SETUP THE TEMPORARY BOUNDS OF UNPROTECTED M0601977 RR STA- $EC M0601978 RR LDA- $F7 M0601979 RR STA- $ED M0601980 RR RTJ* T13 M0601981 RR BZS OHS(96) M0601982 RRT13 NOP 0 ADDRESS OF 96 WORD BUFFER FOR I/O USE M0601983 RR LDA TMPSEC M0601984 RR STA LSSECT RESTORE NEXT AVAILABLE SECTOR M0601985 RR* 3 CARDS DELETED M0601986 RR STA- $C4 M0601987 RR ENQ -96 M0601988 RR STQ* T13A M0601989 RR LDQ* T13 PICKUP ADDRESS OF 96 WORD BUFFER M0601990 RR INQ 94 M0601991 RRT13C CLR A M0601992 RR STA- 1,Q CLEAR A WORD OF THE BUFFER M0601993 RR RAO* T13A M0601994 RR INQ -1 M0601995 RR LDA* T13A M0601996 RR SAZ T13B-*-1 M0601997 RR JMP* T13C M0601998 RRT13A NUM 0 M0601999 RRT13B LDA* T13 M0602000 RR LDQ LSSECT M0602001 RR STQ- I M0602002 RR ENQ -96 WRITE THE FIRST SECTOR OF PROGRAM LIBRARY M0602003 RR RTJ MDRIV DIRECTORY FOR LIBEDT M0602004 RR SAN T13D-*-1 SKIP IF NO ERROR M0602005 RR JMP T21 IRRECOVERABLE MASS STORAGE ERROR M0602006 RRT13D LDA ISAV M0602007 RR STA- I RESTORE THE I-REGISTER M0602008 RR RTJ* T14A M0602009 RR ALF 3,DATBAS M0602010 RRT14 NUM 0 ADDRESS OF SYSTEM DATA M0602011 RRT14A NOP 0 M0602012 RR LDA- DATBAS,I M0602013 RR STA* T14 M0602014 RR STA- ENTPNT,I SAVE THE ADDRESS ASSOCIATED WITH THE NAME M0602015 RR LDA* T14A M0602016 RR STA- INPCTR,I M0602017 RR RTJ ENTSTR SAVE DATBAS IN THE CREP TABLE M0602018 RR LDA- DATLIM,I SAVE DATLIM IN EXTENDED COMM. REGION M0602019 RR ENQ 25 WORD 25 M0602020 RR STA- ($E9),Q M0602021 RR RAO LSSECT INCREMENT SECTOR COUNTER PAST LIBRARY DIRECT. M0602022 RR LDA LSSECT M0602023 RR STA* SWAPSC SAVE STARTING SECTOR OF SWAP AREA M0602024 RR RTJ* T12 M0602025 RR ALF 3,SWAPAR M0602026 RRSWAPSC NUM 0 M0602027 RRT12 NOP 0 M0602028 RR LDA* SWAPSC M0602029 RR STA- ENTPNT,I SAVE THE ADDRESS ASSOCIATED WITH THE NAME M0602030 RR LDA* T12 M0602031 RR STA- INPCTR,I STUFF SWAPAR INTO CREP M0602032 RR RTJ ENTSTR M0602033 RR LDA- ECREP,I BUMP THE END OF THE CREP TABLE TO M0602034 RR INA 8 INCLUDE THE TWO NEW ENTRIES M0602035 RR STA- ECREP,I M0602036 RR RTJ WRTOUT UPDATE CREP WITH NEW ENTRIES M0602037 RR LDA- $F6 M0602038 RR SUB- $F7 M0602039 RR RTJ NXTSEC FIND STARTING SECTOR FOR CREP M0602040 RR LDA LSSECT M0602041 RR ENQ 6 PUT THE STARTING SECTOR OF THE CREP TABLE M0602042 RR STA- ($E9),Q INTO WORD 6 OF THE EXTENDED CORE TABLE M0602043 RR RTJ LCREP PICKUP THE MOST RECENT LENGTH OF THE CREP M0602044 RR LDA- ENTSEC,I PICKUP STARTING SECTOR OF CREP M0602045 RR RTJ* MOVDSK MOVE THE CREP TABLE UP ON THE DISK M0602046 RR LDA- MAXENT,I M0602047 RR SUB- ENTPGS,I M0602048 RR RTJ NXTSEC COMPUTE SECTOR FOR THE CREP1 TABLE M0602049 RR RTJ LCREP1 SETUP POINTERS FOR THE CREP1 TABLE M0602050 RR LDA- MAXENT,I M0602051 RR SUB- ENTPGS,I IS THERE A CREP1 TABLE M0602052 RR SAZ T12AA-*-1 NO M0602053 RR SAP T12A-*-1 YES,MOVE IT UP ON THE DISK M0602054 RRT12AA ENQ 7 NO, STORE A ZERO IN WORD 7 OF THE M0602055 RR STA- ($E9),Q EXTENDED CORE TABLE AND GO ON TO SAT M0602056 RR JMP* T12B M0602057 RRT12A LDA LSSECT M0602058 RR ENQ 7 PUT THE STARTING SECTOR OF THE CREP1 M0602059 RR STA- ($E9),Q TABLE IN WORD 7 OF EXTENDED CORE TABLE M0602060 RR LDA- ENTST1,I COMPUTE THE STARTING SECTOR OF CREP1 M0602061 RR CLR Q M0602062 RR DVI- SECTOR,I M0602063 RR ADD- ENTSEC,I M0602064 RR RTJ* MOVDSK MOVE THE CREP1 TABLE UP ON THE DISK M0602065 RR LDA- MAXENT,I M0602066 RR SUB- ENTPGS,I M0602067 RR RTJ NXTSEC M0602068 RRT12B LDA LSSECT M0602069 RR ENQ 20 PUT START OF EF DATA IN WORD 20 **MSOS 4.1**M0602070 RR STA- ($E9),Q OF EXT. CORE TABLE **MSOS 4.1**M0602071 RR STA* EFSECT SAVE STARTING SECTOR OF EF DATA **MSOS 4.1**M0602072 RR INA 99 99 SECTORS OF EF DATA **MSOS 4.1**M0602073 RR ENQ 5 PUT STARTING SECTOR OF SAT IN WORD 5 M0602074 RR STA- ($E9),Q OF EXTENDED CORE TABLE M0602075 RR STA TMPSEC SAVE STARTING SECTOR OF SAT M0602076 RR INA 30 **MSOS 4.1**M0602077 RR STA- $C1 PUT START OF SCRATCH IN C1 M0602078 RR STA* ENDBSY M0602079 RR ENA SYSECT CORE IMAGE SECTOR TO A M0602080 RR ENQ 4 PUT THE STARTING SECTOR OF THE CORE IMAGE M0602081 RR STA- ($E9),Q INTO WORD 4 OF THE EXTENDED CORE TABLE M0602082 RR LDA LPENDC IS THERE A PART1 CORE RESIDENT M0602083 RR SAZ T22A-*-1 NO, USE 15 BIT ARITHMETIC FOR PATCHING M0602084 RR ENA 1 YES, USE 16 BIT ARITHMETIC FOR PATCHING M0602085 RRT22A STA- ARIT15,I M0602086 RR* 1 CARD DELETED M0602087 RR RTJ LCREP PICKUP CREP POINTERS M0602088 RR ENA SYSECT M0602089 RR STA LSSECT SETUP LSSECT TO POINT TO CORE IMAGE M0602090 RR ENA 1 M0602091 RR RTJ ILOAD PATCH TO CREP USING 15 BIT ARITHMETIC M0602092 RR SQZ T30-*-1 SKIP IF NO UNPATCHED EXTERNALS M0602093 RR RTJ LCREP1 SWAP POINTERS TO LINK TO CREP1 M0602094 RR ENA 1 M0602095 RR STA- ARIT15,I ISSUE PATCH TO CREP1 USING 16-BIT ARITHMETIC M0602096 RR RTJ ILOAD M0602097 RR SQZ T30-*-1 SKIP IF NO UNPATCHED EXTERNALS M0602098 RR ENA 2 M0602099 RR RTJ ILOAD PRINT UNPATCHED EXTERNALS M0602100 RRT30 ENA SYSECT SET LSSECT TO POINT TO CORE IMAGE M0602101 RR STA LSSECT M0602102 RR RTJ WRTOUT WRITE CORE IMAGE AND CREP/CREP1 TABLES M0602103 RR LDA TMPSEC M0602104 RR STA LSSECT RESTORE STARTING SECTOR OF SAT M0602105 RR JMP* BLDSAT GO TO BUILD SAT M0602106 RRCOMM0 NUM 0 M0602107 RRLENDC NUM 0 LENGTH OF PART 0 M0602108 RRLPENDC NUM 0 LENGTH OF PART 1 M0602109 RRMOVDSK NOP 0 M0602110 RR STA* MOVE1 SAVE SECTOR TO MOVE FROM M0602111 RR LDA- MAXENT,I M0602112 RR SUB- ENTPGS,I COMPUTE WORD LENGTH OF TABLE M0602113 RR CLR Q M0602114 RR DVI- SECTOR,I CONVERT WORD LENGTH TO SECTOR LENGTH M0602115 RR SQZ MOV1-*-1 M0602116 RR INA 1 M0602117 RRMOV1 TCA A M0602118 RR STA* MOVE2 M0602119 RR LDA LSSECT M0602120 RR STA* MOVE3 M0602121 RRMOV2 LDA T13 PICKUP ADDRESS OF 96 WORD BUFFER M0602122 RR LDQ* MOVE1 PICKUP SECTOR ADDRESS FOR READ M0602123 RR STQ- I M0602124 RR ENQ 96 SETUP WORD COUNT OF 96 M0602125 RR RTJ MDRIV READ IN SECTOR M0602126 RR LDQ* MOVE3 PICKUP SECTOR TO WRITE ON M0602127 RR STQ- I M0602128 RR ENQ -96 COMPLEMENT WORD COUNT TO SIGNAL WRITE M0602129 RR LDA T13 PICKUP BUFFER ADDRESS M0602130 RR RTJ MDRIV WRITE OUT THE SECTOR M0602131 RR RAO* MOVE1 INCREMENT SECTOR TO READ M0602132 RR RAO* MOVE2 INCREMENT SECTOR TO WRITE M0602133 RR RAO* MOVE3 INCREMENT COMPLEMENT OF COUNT M0602134 RR LDA* MOVE2 HAVE ALL SECTORS BEEN MOVED M0602135 RR SAZ MOV3-*-1 YES - EXIT M0602136 RR JMP* MOV2 NO, LOOP BACK FOR NEXT SECTOR M0602137 RRMOV3 LDA ISAV M0602138 RR STA- I RESTORE THE I-REGISTER M0602139 RR JMP* (MOVDSK) M0602140 RRMOVE1 NUM 0 SECTOR TO BE READ M0602141 RRMOVE2 NUM 0 COMPLEMENT OF NUMBER OF SECTORS TO MOVE M0602142 RRMOVE3 NUM 0 SECTOR TO BE WRITTEN M0602143 RR EJT 1 M0602144 RR* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ******M0602145 RR* *****M0602146 RR* THIS ROUTINE WILL WRITE THE SECTOR AVAILABILITY *****M0602147 RR* TABLE (SAT). THIS IS A 30-SECTOR TABLE CONTAINING A PICTURE*****M0602148 RR* OF ALL THE SECTORS ON THE DISK. ONE BIT REPRESENTS EACH *****M0602149 RR* SECTOR. IF THE BIT IS ON--THIS SECTOR IS AVAILABLE FOR *****M0602150 RR* STORAGE OF THE PROGRAM LIBRARY AND DIRECTORY. *****M0602151 RR* IF THE BIT IS ZERO, THIS SECTOR IS USED, EITHER BY SWAP AREA*****M0602152 RR* SYSTEM LIBRARY, OR PROGRAM LIBRARY AND DIRECTORY. *****M0602153 RR* THE TABLE IS UPDATED BY LIBEDT, AND IS USED TO FIND HOLES *****M0602154 RR* FOR PROGRAMS IN THE PROGRAM LIBRARY. *****M0602155 RR* *****M0602156 RR* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ******M0602157 RR* *****M0602158 RRSATGO NUM 256 STARTING WORD OF SAT (LATER LAST BUSY SECTOR )M0602159 RR* 1-CARD DELETED M0602160 RREFSECT NUM 0 **MSOS 4.1**M0602161 RRENDBSY NUM 0 LAST SECTOR BUSY IN SAT M0602162 RR* 1-CARD DELETED M0602163 RRSIXTEN NUM 16 M0602164 RRENDSAT NUM 0 M0602165 RRBLDSAT LDA =N$100 SETUP STARTING WORD OF SAT M0602166 RR STA* SATGO M0602167 RR LDQ- BASE,I M0602168 RR INQ -10 M0602169 RR CLR A M0602170 RRSAT0 STA- 1,Q CLEAR ALL OF CORE BELOW THE INITIALIZER M0602171 RR INQ -1 TO ZEROS M0602172 RR SQZ SAT1-*-1 M0602173 RR JMP* SAT0 M0602174 RRSAT1 LDA =N$100 MOVE EF DATA BLOCK OF ZEROS **MSOS 4.1**M0602175 RR LDQ* EFSECT POINTS TO EF BLOCK **MSOS 4.1**M0602176 RR STQ- I **MSOS 4.1**M0602177 RR LDQ =N-9504 WRITE 99 SECTORS **MSOS 4.1**M0602178 RR RTJ MDRIV **MSOS 4.1**M0602179 RR CLR Q M0602180 RR LDA* ENDBSY COMPUTE THE BIT ADDRESS OF THE LAS**MSOS 4.1**M0602181 RR DVI* SIXTEN SECTOR TO SET BUSY M0602182 RR ADD* SATGO M0602183 RR* 1-CARD DELETED M0602184 RR STA* SATGO SAVE LAST BUSY SECTOR M0602185 RR SET A M0602186 RR SQZ SAT3 M0602187 RR ENA 1 M0602188 RR INQ -16 M0602189 RRSAT2 INQ 1 SET THE BITS FOR THE FIRST AVAILABLE SECTOR M0602190 RR SQZ SAT3-*-1 M0602191 RR ALS 1 M0602192 RR INA 1 SKIP IF DONE WITH FIRST WORD M0602193 RR JMP* SAT2 SET THE NEXT SECTOR AVAILABLE M0602194 RRSAT3 STA* (SATGO) SETUP THE FIRST WORD WITH AVAILABLE SECTORS M0602195 RR RAO* SATGO M0602196 RR LDA MAXSEC M0602197 RR INA 1 INCREMENT MAXSEC FOR TOTAL SECTORS M0602198 RR CLR Q M0602199 RR DVI* SIXTEN FIND THE LAST WORD WITH AVAILABLE SECTORS M0602200 RR ADD* BLDSAT+1 OFFSET LAST AVAILABLE WORD M0602201 RR* 1-CARD DELETED M0602202 RR STA* ENDSAT M0602203 RR CLR A M0602204 RR SQZ SAT5-*-1 M0602205 RR LDA =N$8000 M0602206 RRSAT4 INQ -1 SETUP LAST WORD WITH AVAILABLE SECTORS M0602207 RR SQZ SAT5-*-1 M0602208 RR ARS 1 M0602209 RR JMP* SAT4 M0602210 RRSAT5 STA* (ENDSAT) M0602211 RR SET A PICKUP FIRST WORD TO BE SET FOR M0602212 RRSAT6 STA* (SATGO) M0602213 RR RAO* SATGO INCREMENT STORAGE ADDRESS M0602214 RR LDQ* SATGO M0602215 RR TCQ Q M0602216 RR ADQ* ENDSAT M0602217 RR SQZ SATDON-*-1 M0602218 RR JMP* SAT6 M0602219 RRSATDON LDQ LSSECT M0602220 RR STQ- I M0602221 RR LDA =N$100 M0602222 RR LDQ =N-2880 SETUP WRITE OF 30 SECTORS **MSOS 4.1**M0602223 RR RTJ MDRIV WRITE SAT TABLE M0602224 RR LDA* ERFLAG WERE THERE ANY ERRORS M0602225 RR SAZ SAT9-*-1 NO, PRINT AUTOLOAD MESSAGE M0602226 RR JMP* SAT10 YES, PRINT AUTOLOAD ERROR MESSAGE M0602227 RRSAT9 RTJ* SAT7 M0602228 RRSAT8 ALF 22,INITIALIZATION COMPLETED - YOU MAY AUTOLOAD M0602229 RRSAT7 NOP 0 M0602230 RR LDA* SAT7 PICKUP BUFFER ADDRESS M0602231 RR ENQ SAT7-SAT8 M0602232 RR RTJ TELOUT M0602233 RR NUM $18FF M0602234 RRSAT10 RTJ* SAT11 M0602235 RR ALF *,ERRORS OCCURED - YOU MAY ATTEMPT TO AUTOLOAD* M0602236 RRSAT11 NOP 0 M0602237 RR LDA* SAT11 M0602238 RR ENQ SAT11-SAT10-1 M0602239 RR RTJ TELOUT M0602240 RR NUM $18FF M0602241 RRERFLAG NUM 0 M0602242 RRTCODE NUM 0 M0602243 RR END M0602244 RR NAM I2 M07 A ITOS CCS 3.0 SL-149M0700001 RR* INITIALIZER CONTROLLER FOR DISK/DRUM AUTOLOAD AREA M0700002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 M0700003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA M0700004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 M0700005 RR* M0700006 RR SPC 2 M0700007 RR************************************************************************M0700008 RR* ENTRY PARAMETERS *M0700009 RR* (A) = 0 - INITIALIZE DRIVER *M0700010 RR* (A) = ADDRESS OF STMSV4 IN MSOS SPACE*M0700011 RR************************************************************************M0700012 RR SPC 1 M0700013 RR ENT I2 M0700014 RR ENT I2RETN M0700015 RR ENT PART1A,PART1L,PART1C M0700016 RR EXT* OU M0700017 RR EXT* MMINIT DRIVER ENTRY FOR MASS MEMORY SETUP M0700018 RR EXT* MDRIV IN MDRIV M0700019 RR EXT* FMXSEC RETURNS "MAXSEC" IN A M0700020 RR EXT* HEADR1 DATE INPUT BY OPERATOR M0700021 RR EXT* SIZMAS ROUTINE TO COMPUTE AND RETURN MM SIZE M0700022 RR EXT NFILES MAX. NUMBER OF FILES ON SYSTEM VOLUME 121*4743M0700023 RR* M0700024 RRI2 NOP 0 M0700025 RR SAZ FIRST-*-1 SKIP IF DRIVER INITIALIZATION M0700026 RR JMP* IOTYPE M0700027 RRFIRST STA* PART1C CLEAR PART 1 CORE IMAGE SECTOR NO. M0700028 RR JMP MMINIT GO TO SETUP AUTOLOAD AREA POINTERS M0700029 RRI2RETN NOP 0 ADDRESS OF THE AUTOLOAD PROGRAM M0700030 RR STQ* LENGTH LENGTH OF THE AUTOLOAD PROGRAM M0700031 RR ADD* I2RETN M0700032 RR STA* PUTTER TABLE ADDRESS IN THE AUTOLOAD PROGRAM M0700033 RR JMP* (I2) EXIT M0700034 RR SPC 3 M0700035 RRIOTYPE STA* STMSV4 M0700036 RR ENQ 3 M0700037 RRLOOPDT LDA* PART1C,Q MOVE THE TABLE TO M0700038 RR STA* (PUTTER),Q THE AUTOLOAD PROGRAM M0700039 RR SQZ GOON-*-1 SKIP WHEN ALL MOVED M0700040 RR INQ -1 M0700041 RR JMP* LOOPDT M0700042 RRGOON ENQ 1 SET FOR AUTOLOAD SECTOR M0700043 RR STQ- I M0700044 RR LDQ* LENGTH LENGTH OF AUTOLOAD PROGRAM 68*1529 M0700045 RR TCQ Q M0700046 RR LDA* I2RETN FWAB M0700047 RR RTJ MDRIV WRITE OUT AUTOLOAD PGM SECTS 0-4 **MSOS 4.1**M0700048 RR EJT M0700049 RR* MOVE DATE INTO LABEL M0700050 RR ENQ 3 M0700051 RRLB1 LDA HEADR1,Q PICK UP WORD OF DATE M0700052 RR STA* VLDATE,Q STORE IN LABEL M0700053 RR INQ -1 M0700054 RR SQM LB2 SKIP IF ALL OF DATE MOVED M0700055 RR JMP* LB1 GO BACK AND DO NEXT WORD M0700056 RR* SET UP DIRECTORY AND START ALLOCATABLE SECTORS M0700057 RRLB2 RTJ FMXSEC PICK UP "MAXSEC" M0700058 RR INA 1 DIRECTORY IS NEXT SECTOR M0700059 RR STA* VLASDL SAVE IN LABEL M0700060 RR LDA* VLMAXF PICK UP MAXIMUM NUMBER OF FILES 121*4743M0700061 RR* THE FOLLOWING TWO LINES OF CODE FIX A BUG. THE BUG IS THAT M0700062 RR* THE FILE MANAGER'S AVAILABLE SPACE DIRECTORY HAD BEEN M0700063 RR* DEFINED ABOUT HALF THE SIZE IT SHOULD HAVE BEEN. M0700064 RR* M0700065 RR INA 1 COMPUTE MAX # ENTRIES IN DIRECTORY M0700066 RR ALS 2 M0700067 RR CLR Q 121*4743M0700068 RR DVI* VLWPS COMPUTE DIRECTORY SIZE IN SECTORS 121*4743M0700069 RR SQZ LB2A SKIP IF NO PARTIAL SECTOR 121*4743M0700070 RR INA 1 ADD 1 SECTOR 121*4743M0700071 RRLB2A STA* VLASDS SAVE AS DIRECTORY SIZE 121*4743M0700072 RR ADD* VLASDL ADD START ADDRESS OF DIRECTORY 121*4743M0700073 RR STA* VLBMSL SAVE AS FIRST ALLOCATABLE SECTOR M0700074 RR STA* ASDIR+3 SAVE AS START OF BLOCK IN DIRECTORY M0700075 RR RTJ SIZMAS GO GET SECTOR SIZE OF MM DEVICE M0700076 RR SUB* VLBMSL SUBTRACT SECTORS ALREADY USED M0700077 RR SAP LB3 SKIP IF RESULT CORRECT M0700078 RR AND =N$7FFF M0700079 RR INQ -1 M0700080 RRLB3 STQ* VLLBA SAVE IN LABEL M0700081 RR STA* VLLBA+1 M0700082 RR STQ* ASDIR SAVE IN DIRECTORY M0700083 RR STA* ASDIR+1 M0700084 RR RTJ* HERE FIND OUT WHERE WE ARE M0700085 RRHERE NUM 0 M0700086 RR LDA =XLABEL-HERE M0700087 RR ADD* HERE COMPUTE ADDRESS OF LABEL M0700088 RR ENQ 0 SET FOR SECTOR 0 M0700089 RR STQ- I M0700090 RR ENQ LABLEN LENGTH OF LABEL TO Q M0700091 RR TCQ Q COMPLEMENT FOR WRITE M0700092 RR RTJ MDRIV WRITE OUT LABEL M0700093 RR* WRITE OUT DIRECTORY M0700094 RR LDA =XASDIR-HERE M0700095 RR ADD* HERE COMPUTE ADDRESS OF DIRECTORY M0700096 RR LDQ* VLASDL PICK UP SECTOR ADDRESS OF DIRECTORY M0700097 RR STQ- I SAVE IN I M0700098 RR ENQ 5 SET Q TO LENGTH OF DIRECTORY M0700099 RR TCQ Q COMPLEMENT Q FOR WRITE M0700100 RR RTJ MDRIV WRITE OUT DIRECTORY M0700101 RR JMP* (I2) EXIT M0700102 RRLENGTH NUM 0 LENGTH OF AUTOLOAD PROGRAM M0700103 RRPUTTER NUM 0 M0700104 RRPART1C NUM 0 STARTING SECTOR ADDRESS OF PART 1 IMAGE M0700105 RRPART1L NUM 0 MODIFIED LENGTH OF PART 1 M0700106 RRPART1A NUM 0 MODIFIED CORE ADDRESS OF PART 1 M0700107 RRSTMSV4 NUM 0 ADDRESS IN SPACE WHERE TO MOVE THE AUTOLOAD M0700108 RR SPC 3 M0700109 RRLABEL JMP $60 SET TO JUMP OVER LABEL M0700110 RRVLNAME ALF 4,SYSVOL VOLUME NAME M0700111 RRVLNMBR ALF 1,00 VOLUME NUMBER M0700112 RRVLSER ALF 5, VOLUME SERIAL NUMBER M0700113 RRVLSEC ALF 4, VOLUME SECURITY CODE M0700114 RRVLDATE ALF 4, VOLUME CREATE DATE M0700115 RRVLBMSM NUM 0 BEGINNING OF MANAGEABLE SPACE (MSB) M0700116 RRVLBMSL NUM 0 BEGINNING OF MANAGEABLE SPACE (LSB) M0700117 RRVLASDM NUM 0 ALLOCATABLE SPACE DIRECTORY SECTOR (MSB) M0700118 RRVLASDL NUM 0 ALLOCATABLE SPACE DIRECTORY SECTOR (LSB) M0700119 RRVLASDS NUM 22 SIZE OF ALLOCATABLE SPACE DIRECTORY M0700120 RRVLLBA NUM 0 LARGEST AVAILABLE BLOCK (MSB) M0700121 RR NUM 0 LARGEST AVAILABLE BLOCK (LSB) M0700122 RRVLWPS NUM 96 WORDS/SECTOR M0700123 RRVLFDD NUM 0 ADDRESS OF FILE DIRECTORY (MSB) M0700124 RR NUM 0 ADDRESS OF FILE DIRECTORY (LSB) M0700125 RRVLMAXF ADC NFILES MAXIMUM NUMBER OF FILES 121*4743M0700126 RRVLCURF NUM 0 CURRENT NUMBER OF FILES M0700127 RRVLNFDB NUM 0 NUMBER OF BLOCKS IN FILE DIRECTORY M0700128 RRVLNXTB NUM 0 NEXT AVAILABLE FILE DIRECTORY BLOCK M0700129 RRLABLEN EQU LABLEN(*-LABEL) M0700130 RR SPC 2 M0700131 RRASDIR NUM 0 # FREE SECTORS IN THIS BLOCK (MSB) M0700132 RR NUM 0 # FREE SECTORS IN THIS BLOCK (LSB) M0700133 RR NUM 0 START SECTOR OF THIS BLOCK (MSB) M0700134 RR NUM 0 START SECTOR OF THIS BLOCK (LSB) M0700135 RR NUM -1 END OF DIRECTORY M0700136 RR END M0700137 RR NAM FMULOD B01 A ITOS CCS 3.0 SL-149B0100001 RR* FILE MANAGER UTILITY START PROGRAM B0100002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B0100003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B0100004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B0100005 RR* B0100006 RR**** B0100007 RR* B0100008 RR* FILE MANAGER UTILITY START PROGRAM B0100009 RR* B0100010 RR* B0100011 RR* FUNCTION B0100012 RR* B0100013 RR* THIS ROUTINE STARTS THE UTIL 1.0 EXECUTIVE B0100014 RR* B0100015 RR* B0100016 RR* GENERAL DESCRIPTION B0100017 RR* B0100018 RR* THIS MUST BE THE FIRST PROGRAM LOADED B0100019 RR* IT WILL JUMP TO THE UTIL 1.0 EXECUTIVE B0100020 RR* PAST THE LABELED COMMON AREA B0100021 RR* B0100022 RR* B0100023 RR* ENTRY B0100024 RR* B0100025 RR* TO ENTER THE UTILITIES TYPE UTIL AND PRESS THE B0100026 RR* CARRIAGE RETURN FOLLOWING THE ITOS REQUEST= MESSAGE B0100027 RR* B0100028 RR* B0100029 RR* ENTRY POINT B0100030 RR* B0100031 RR ENT FMULOD START ADDR. OF THE UTILITIES B0100032 RR* B0100033 RR* B0100034 RR* EXTERNAL B0100035 RR* B0100036 RR EXT FMUTEX UTIL 1.0 EXECUTIVE PROGRAM B0100037 RR* B0100038 RR**** B0100039 RRFMULOD NOP 0 B0100040 RR JMP FMUTEX B0100041 RR* B0100042 RR END B0100043 RR NAM FMUTEX B02 A ITOS CCS 3.0 SL-149B0200001 RR* FILE MANAGER UTILITY EXECUTIVE PROGRAM B0200002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4867B0200003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B0200004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B0200005 RR* B0200006 RR**** B0200007 RR* B0200008 RR* FMUTEX : FILE-MANAGER UTILITY EXECUTIVE 122*4873B0200009 RR* B0200010 RR* B0200011 RR* FUNCTION B0200012 RR* B0200013 RR* THE EXECUTIVE DISPLAYS THE PROMPTING LINE(S) IF APPLICABLE B0200014 RR* READS THE INPUT RECORD(S),CHECKS THE REQUESTED COMMAND CODE B0200015 RR* LOADS AND TRANSFERS CONTROL TO THE REQUESTED PROCESSOR B0200016 RR* B0200017 RR* B0200018 RR* GENERAL DESCRIPTION B0200019 RR* B0200020 RR* THE EXECUTIVE ACCEPTS INPUT FROM EITHER AN INTERACTIVE DEVICE B0200021 RR* OR THE DEVICE IT WAS INITIATED ON B0200022 RR* THE EXECUTIVE AND ITS PROCESSORS RUN UNDER THE ITOS 1.0 EXECUTIVEB0200023 RR* IT ACCEPTS INPUT-STRINGS LIKE B0200024 RR* B0200025 RR* COMMAND CODE,PARAMETER-STRING (CR) B0200026 RR* OR B0200027 RR* COMMAND CODE,PARAMETER-STRING;(CR) B0200028 RR* PARAMETER-STRING (CR) B0200029 RR* PARAMETER STRINGS ARE B0200030 RR* P1,P2,P3 (P IS PARAMETER VALUE) B0200031 RR* OR B0200032 RR* P1,,P3 OR P1, ,P3 B0200033 RR* OR B0200034 RR* I1=P1,I2=P2,,I4=P4, ,I6=P6 (I=PARAMETER IDENT) B0200035 RR* B0200036 RR* ONLY THE FIRST FOUR CHARACTERS OF THE COMMAND CODE ARE CHECKED B0200037 RR* B0200038 RR* CONTROL LU IS ASSUMED TO BE THE INTERACTIVE DEVICE OR THE B0200039 RR* DECLARED INPUT DEVICE,WHOEVER CALLED UTIL B0200040 RR* B0200041 RR* B0200042 RR* FLOW B0200043 RR* B0200044 RR* ON ENTRY A RETURN JMP IS DONE TO PGMIN IN ORDER TO OBTAIN B0200045 RR* THE ENTRY PARAMETERS (ID-USER,LUN,MODE,NOPORT) B0200046 RR* BIT 12 OF LUNIT IS SET TO SPECIFY WORD-MODE I/O B0200047 RR* INTERRUPT ADDR IS FMUT1 B0200048 RR* IF IN INTERACTIVE MODE (MODE=0) A PROMPTING MSG IS DISPLAYED B0200049 RR* TO INDICATE THE UTILITIES ARE LOADED B0200050 RR* THE MSG IS B0200051 RR* UTIL IN B0200052 RR* READY B0200053 RR* AND THE PROMPTING INDICATOR(PIND) IS SET TO ZERO B0200054 RR* IF IN BATCH-MODE(MODE=NOT EQ 0) PIND=-1 B0200055 RR* NEXT A READ WILL BE DONE TO READ IN THE REQUIRED COMMAND B0200056 RR* AT COMPLETION OF THE READ,A CALL TO THE SUBROUTINE B0200057 RR* GETFLD IS DONE TO OBTAIN THE FIRST FIELD OF THE INPUTBUFFER B0200058 RR* (INBUF).THE FIRST FIELD IS MOVED TO ANOTHER BUFFER(CODE) B0200059 RR* A CHECK IS DONE TO SEE IF CODE CONTAINS: B0200060 RR* 1. EXIT B0200061 RR* 2. INPUT B0200062 RR* 3. OUTPUT B0200063 RR* 4. HELP B0200064 RR* IF ONE OF THESE IS FOUND,A JUMP TO THE CORRESPONDING B0200065 RR* SUBPROGRAM WITHIN FMUTEX IS DONE B0200066 RR* IF NONE OF THE ABOVE IS FOUND A CALL IS DONE TO THE B0200067 RR* SUBROUTINE COMSEK B0200068 RR* IF THE COMMAND CODE CANNOT BE FOUND,ERROR 31 IS DISPLAYED B0200069 RR* ELSE A CHECK IS DONE TO SEE IF THE COMMAND IS ALLOWED TO B0200070 RR* BE EXECUTED FROM THIS TERMINAL AND IF ITOS SHOULD OR B0200071 RR* SHOULD NOT BE DISABLED. B0200072 RR* THE 6 CHARACTER COMMAND NAME FOUND BY COMSEK WILL NOW B0200073 RR* BE MOVED TO A BUFFER(CLBUF1) AND TO CODE B0200074 RR* THE SCREEN WILL BE CLEARED AND THE COMMAND-NAME IS B0200075 RR* DISPLAYED IF IN INTERACTIVE MODE B0200076 RR* NEXT A FM-CALL IS MADE TO OBTAIN THE INFORMATION B0200077 RR* NECESSARY TO READ IN THE COMMAND-PROCESSOR B0200078 RR* THIS INFO IS CONTAINED IN FILE $$PGMNAM B0200079 RR* THE COMMAND PROCESSOR IS READ INTO THE USER AREA(UTSTRT) B0200080 RR* AND CONTROL IS TRANSFERRED TO THE COMMAND PROCESSOR B0200081 RR* B0200082 RR* B0200083 RR* OUTPUT B0200084 RR* B0200085 RR* WHEN A JMP IS DONE TO UTSTRT TO START THE COMMAND B0200086 RR* PROCESSOR THE FOLLOWING BUFFERS ARE SET B0200087 RR* B0200088 RR* INBUF CONTAINS THE FIRST LINE OF DATA IF READ FROM B0200089 RR* A BATCH DEVICE B0200090 RR* ELSE THE COMMAND-CODE B0200091 RR* CODE CONTAINS THE 6 CHAR COMMAND-CODE B0200092 RR* LUNIT CONTAINS THE LOG.UNIT NUMBER OF THE DEVICE B0200093 RR* MODE IF 0 ,INTERACTIVE-ELSE BATCH-MODE B0200094 RR* IDUSER USER-ID LOGGED IN WITH B0200095 RR* NOPORT TERMINAL PORT NO. B0200096 RR* SWORD START INDEX OF NEXT FIELD WORD IN INBUF B0200097 RR* SBYTE START INDEX OF NEXT FIELD BYTE IN INBUF B0200098 RR* PARLST ADDR OF THE CORRESPONDING PARAMETER LIST TABLE B0200099 RR* PIND PROMPTING LEVEL INDICATOR (-1,0,+1) B0200100 RR* B0200101 RR* B0200102 RR* SUBROUTINES B0200103 RR* B0200104 RR* PGMIN OBTAIN INPUT PARAMETERS B0200105 RR* PGMOUT EXIT TO ITOS 1.0 EXECUTIVE B0200106 RR* PGMINT ALLOW INTERRUPT B0200107 RR* WTREAD TERMINAL WRITE/READ REQUEST B0200108 RR* GETFLD GET NEXT FLD B0200109 RR* OUTEQ SET OUTPUT TO BE THE SPECIFIED DEVICE B0200110 RR* INPEQ SET INPUT TO BE THE SPECIFIED DEVICE B0200111 RR* COMSEK SEARCH FOR COMMAND CODE B0200112 RR* READR FM 2.0 READ FILE REQUEST B0200113 RR* OPENFL FM 2.0 OPEN FILE REQUEST B0200114 RR* CLOSFL FM 2.0 CLOSE FILE REQUEST B0200115 RR* UTSTRT UTIL 1.0 PROCESSOR AREA B0200116 RR* SYSMSG SYSTEM ERROR MSG ROUTINE B0200117 RR* B0200118 RR* PARAMETERS B0200119 RR* B0200120 RR* LABELED COMMON AREA B0200121 RR* B0200122 RR* COMCOD(133) COMMAND CODE TABLE B0200123 RR* FOUR WORD ENTRIES B0200124 RR* 0-2 6 CHARACTER COMMAND CODE B0200125 RR* 3 ADDR OF CORRESPONDING PARAMETER B0200126 RR* PROCESSING TABLE B0200127 RR* B0200128 RR* PARNAM(124) PARAMETER MNEMONIC TABLE B0200129 RR* THREE WORD PER ENTRY B0200130 RR* 1 TWO CHAR.PARAMETER IDENTIFIER B0200131 RR* 2 LENGTH OF PARAMETER VALUE B0200132 RR* WHEN ENTERED B0200133 RR* 3 STORE AREA B0200134 RR* PPHELP(2) PARAMETER PROCESSING TABLE FOR HELP B0200135 RR* PPINIT(4) INIT B0200136 RR* PPDEFI(16) DEFINE B0200137 RR* PPSTAT(4) STATUS B0200138 RR* PPRELO(5) RELOAD 122*4875B0200139 RR* PPDUMP(5) DUMP 122*4875B0200140 RR* PPCOPY(6) COPY B0200141 RR* PPDELE(3) DELETE B0200142 RR* PPCLEA(3) CLEAR B0200143 RR* PPLIST(6) LIST 122*4875B0200144 RR* PPREANA(5) RENAME B0200145 RR* PPCOMM(2) COMMAND B0200146 RR* PPEXIT(1) EXIT B0200147 RR* PPMOUN(3) MOUNT B0200148 RR* PPDISM(2) DISMOUNT B0200149 RR* PPSAVE(3) SAVE B0200150 RR* PPBATC(8) BATCH B0200151 RR* PPLOAD(5) LOAD B0200152 RR* PPPURG(3) PURGE B0200153 RR* PPINPU(2) INPUT B0200154 RR* PPOUTP(2) OUTPUT B0200155 RR* PPCOMP(3) COMPRESS B0200156 RR* PPHOST(4) HOST B0200157 RR* PPSET(3) SET B0200158 RR* PPBATS(4) BATCH STATUS B0200159 RR* PPDISC(2) DISCARD B0200160 RR* PPDISP(7) DISPOSE B0200161 RR* PPFLUSH(3) FLUSH B0200162 RR* PPPRINT(3) PRINT B0200163 RR* DUMMY(6) TEMPORARY STORE AREA OF SOME PARAMETERS B0200164 RR* INBUF(41) INPUT BUFFER TO READ IN B0200165 RR* CODE(20) OUTPUT BUFFER FROM GETFLD B0200166 RR* LUNIT LOGICAL UNIT NO OF THIS TERMINAL B0200167 RR* MODE INDICATES INTERACTIVE MODE OR BATCH MODE B0200168 RR* IDUSER(4) USER-ID LOGGED IN WITH B0200169 RR* NOPORT TERMINAL PORT NO B0200170 RR* SWORD INDEX USED BY GETFLD B0200171 RR* SBYTE INDEX USED BY GETFLD B0200172 RR* PARLST ADDR OF PARAMETER PROCESSING TABLE B0200173 RR* NOCOD ALARM INDICATOR USED BY COMSEK B0200174 RR* PIND PROMPTING LEVEL INDICATOR B0200175 RR* REQBUF(24) USED BY FM 2.0 CALLS REFER TO ERS FM 2.0 B0200176 RR* IDATA(24) USED BY FM 2.0 CALLS REFER TO ERS FM 2.0 B0200177 RR* PARDEF(24) CONTAINS DEFAULTS FOR IDATA B0200178 RR* FCBHDR(5) REFER TO ERS FM 2.0 B0200179 RR* FDBBUF(96) FILE CONTROL BLOCK REFER TO ERS FM 2.0 B0200180 RR* B0200181 RR* B0200182 RR* MESSAGES B0200183 RR* B0200184 RR* UTIL IN INDICATES THE UTILITIES ARE LOADED B0200185 RR* READY READY TO ACCEPT NEXT UTIL 1.0 COMMAND B0200186 RR* B0200187 RR* ERROR MESSAGES B0200188 RR* B0200189 RR* 30 REQUESTED PROCESSOR NOT FOUND B0200190 RR* 31 REQUESTED UTIL COMMAND ILLEGAL B0200191 RR* 32 ILLEGAL COMMAND FORMAT B0200192 RR* 75 ITOS SHOULD BE DISABLED B0200193 RR* 76 SUPERVISOR COMMAND ONLY B0200194 RR* B0200195 RR* MISC B0200196 RR* B0200197 RR* SUPERVISOR COMMAND TABLE SUPCOM B0200198 RR* B0200199 RR**** B0200200 RR EJT B0200201 RR* B0200202 RR* ENTRY POINTS B0200203 RR* B0200204 RR ENT FMUTEX B0200205 RR* B0200206 RR* EXTERNALS B0200207 RR* B0200208 RR EXT PGMIN B0200209 RR EXT PGMOUT B0200210 RR EXT PGMINT B0200211 RR EXT WTREAD B0200212 RR EXT GETFLD B0200213 RR EXT OUTEQ B0200214 RR EXT INPEQ B0200215 RR EXT COMSEK B0200216 RR EXT READR B0200217 RR EXT OPENFL B0200218 RR EXT CLOSFL B0200219 RR EXT UTSTRT B0200220 RR EXT SYSMSG B0200221 RR EXT TSNABL ITOS ENABLE FLAG B0200222 RR* B0200223 RR* EQUATES B0200224 RR* B0200225 RR EQU INPLEN(40) LENGTH OF INPUT BUFFER B0200226 RR EQU ZROBIT($33) B0200227 RR EQU ONEBIT($23) B0200228 RR EQU ONE($03) B0200229 RR EQU TWO($24) B0200230 RR EJT B0200231 RR* B0200232 RR* LABELED COMMON AREA B0200233 RR* B0200234 RR DAT COMCOD(133),PARNAM(124) B0200235 RR DAT PPHELP(2) B0200236 RR DAT PPINIT(4) B0200237 RR DAT PPDEFI(16) B0200238 RR DAT PPSTAT(4) B0200239 RR DAT PPRELO(5) 122*4875B0200240 RR DAT PPDUMP(5) 122*4875B0200241 RR DAT PPCOPY(6) B0200242 RR DAT PPDELE(3) B0200243 RR DAT PPCLEA(3) B0200244 RR DAT PPLIST(6) 122*4875B0200245 RR DAT PPRENA(5) B0200246 RR DAT PPCOMM(2) B0200247 RR DAT PPEXIT(1) B0200248 RR DAT PPMOUN(3) B0200249 RR DAT PPDISM(2) B0200250 RR DAT PPSAVE(3) B0200251 RR DAT PPBATC(8) BATCH B0200252 RR DAT PPLOAD(5) B0200253 RR DAT PPPURG(3) B0200254 RR DAT PPINPU(2) B0200255 RR DAT PPOUTP(2) B0200256 RR DAT PPCOMP(3) B0200257 RR DAT PPHOST(4) HOST B0200258 RR DAT PPSET(3) SET B0200259 RR DAT PPBATS(4) BATCH STATUS B0200260 RR DAT PPDISC(2) DISCARD B0200261 RR DAT PPDISP(7) B0200262 RR DAT PPFLUS(3) FLUSH B0200263 RR DAT PPPRIN(3) PRINT B0200264 RR DAT DUMMY(6) B0200265 RR DAT INBUF(41),CODE(20) B0200266 RR DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B0200267 RR DAT REQBUF(24),IDATA(24) B0200268 RR DAT PARDEF(24) B0200269 RR DAT FCBHDR(5) B0200270 RR DAT FCBBUF(96) B0200271 RR DAT ISPARE(72) SPARE LABELED COMMON B0200272 RR EQU ENDCOM(ISPARE+72) END OF COMMON AREA B0200273 RR EQU COMLEN(ENDCOM-COMCOD) B0200274 RR EJT B0200275 RR* B0200276 RR* ZEROISE ALL OF LABELED COMMON B0200277 RR* B0200278 RR ORG COMCOD B0200279 RR BZS ZEROES(COMLEN) B0200280 RR* B0200281 RR ORG PIND B0200282 RR NUM -1 PRESET PROMPTING LEVEL B0200283 RR* B0200284 RR* COMMAND CODE TABLE B0200285 RR* B0200286 RR ORG COMCOD B0200287 RR ALF 3,HELP B0200288 RR ADC PPHELP B0200289 RR ALF 3,INIT B0200290 RR ADC PPINIT B0200291 RR ALF 3,DEFINE B0200292 RR ADC PPDEFI B0200293 RR ALF 3,STATUS B0200294 RR ADC PPSTAT B0200295 RR ALF 3,RELOAD B0200296 RR ADC PPRELO B0200297 RR ALF 3,DUMP B0200298 RR ADC PPDUMP B0200299 RR ALF 3,COPY B0200300 RR ADC PPCOPY B0200301 RR ALF 3,DELETE B0200302 RR ADC PPDELE B0200303 RR ALF 3,CLEAR B0200304 RR ADC PPCLEA B0200305 RR ALF 3,LIST B0200306 RR ADC PPLIST B0200307 RR ALF 3,RENAME B0200308 RR ADC PPRENA B0200309 RR ALF 3,COMMAND B0200310 RR ADC PPCOMM B0200311 RR ALF 3,EXIT B0200312 RR ADC PPEXIT B0200313 RR ALF 3,MOUNT B0200314 RR ADC PPMOUN B0200315 RR ALF 3,DISMOUNT B0200316 RR ADC PPDISM B0200317 RR ALF 3,SAVE B0200318 RR ADC PPSAVE B0200319 RR ALF 3,BATCH B0200320 RR ADC PPBATC B0200321 RR ALF 3,LOAD B0200322 RR ADC PPLOAD B0200323 RR ALF 3,PURGE B0200324 RR ADC PPPURG B0200325 RR ALF 3,INPUT B0200326 RR ADC PPINPU B0200327 RR ALF 3,OUTPUT B0200328 RR ADC PPOUTP B0200329 RR ALF 3,COMPRES B0200330 RR ADC PPCOMP B0200331 RR ALF 3,HOST B0200332 RR ADC PPHOST B0200333 RR ALF 3,SET B0200334 RR ADC PPSET B0200335 RR ALF 3,BATS BATCH FILE STATUS. B0200336 RR ADC PPBATS B0200337 RR ALF 3,DISCARD B0200338 RR ADC PPDISC B0200339 RR ALF 3,DISPOSE B0200340 RR ADC PPDISP B0200341 RR ALF 3,FLUSH B0200342 RR ADC PPFLUSH B0200343 RR ALF 3,PRINT B0200344 RR ADC PPPRIN B0200345 RR NUM $FFFF END OF TABLE B0200346 RR EJT B0200347 RR* B0200348 RR ORG PARNAM B0200349 RR* B0200350 RR* PARAMETER MNEMONIC TABLE B0200351 RR* B0200352 RR* WORD 1 = TWO CHAR.PARAMETER IDENTIFIER B0200353 RR* B0200354 RR* 2 = PARAMETER VALUE LENGTH IN BYTES B0200355 RR* B0200356 RR* 3 = POINTER TO IDATA IF APPLICABLE B0200357 RR* POINTER TO FCBBUF IF APPLICABLE B0200358 RR* OR TO TEMPORARY SAVE AREA (DUMMY) B0200359 RR* B0200360 RR* FOR IDATA REFER TO FILE-MANAGER 2.0 ERS B0200361 RR* B0200362 RR ALF 1,FN 1 FILE-NAME B0200363 RR NUM 8 B0200364 RR ADC IDATA B0200365 RR ALF 1,OW 2 OWNER-NAME B0200366 RR NUM 8 B0200367 RR ADC IDATA+4 B0200368 RR ALF 1,VL 3 VOLUME-NAME B0200369 RR NUM 8 B0200370 RR ADC IDATA+8 B0200371 RR ALF 1,DK 4 DISK-UNIT B0200372 RR NUM 2 B0200373 RR ADC DUMMY+2 B0200374 RR ALF 1,NF 5 NO.OF FILES B0200375 RR NUM 4 B0200376 RR ADC DUMMY B0200377 RR ALF 1,ED 6 EXPIRATION DATE B0200378 RR NUM 6 B0200379 RR ADC FCBBUF+88 B0200380 RR ALF 1,TY 7 FILE-TYPE B0200381 RR NUM 1 B0200382 RR ADC IDATA+15 B0200383 RR ALF 1,LR 8 LENGTH OF RECORD B0200384 RR NUM 5 B0200385 RR ADC IDATA+12 B0200386 RR ALF 1,NR 9 NO. OF RECORDS B0200387 RR NUM 8 B0200388 RR ADC IDATA+13 B0200389 RR ALF 1,K1 10 KEY1 B0200390 RR NUM 2 B0200391 RR ADC IDATA+16 B0200392 RR ALF 1,P1 11 KEY11 POSTION B0200393 RR NUM 4 B0200394 RR ADC IDATA+17 B0200395 RR ALF 1,K2 12 KEY2 B0200396 RR NUM 2 B0200397 RR ADC IDATA+18 B0200398 RR ALF 1,P2 13 KEY2 POSITION B0200399 RR NUM 4 B0200400 RR ADC IDATA+19 B0200401 RR ALF 1,K3 14 KEY3 B0200402 RR NUM 2 B0200403 RR ADC IDATA+20 B0200404 RR ALF 1,P3 15 KEY3 POSITION B0200405 RR NUM 4 B0200406 RR ADC IDATA+21 B0200407 RR ALF 1,K4 16 KEY4 B0200408 RR NUM 2 B0200409 RR ADC IDATA+22 B0200410 RR ALF 1,P4 17 KEY4 POSITION B0200411 RR NUM 4 B0200412 RR ADC IDATA+23 B0200413 RR ALF 1,SA 18 SECTOR ALIGNMENT B0200414 RR NUM 1 B0200415 RR ADC IDATA+15 B0200416 RR ALF 1,I 19 INPUT-UNIT B0200417 RR NUM 8 B0200418 RR ADC DUMMY B0200419 RR ALF 1,P 20 OUTPUT-UNIT B0200420 RR NUM 8 B0200421 RR ADC DUMMY B0200422 RR ALF 1,M 21 MODE B0200423 RR NUM 1 B0200424 RR ADC DUMMY+5 B0200425 RR ALF 1,L 22 LIST-UNIT B0200426 RR NUM 8 B0200427 RR ADC DUMMY B0200428 RR ALF 1,F2 23 FILE-NAME 2 B0200429 RR NUM 8 B0200430 RR ADC IDATA B0200431 RR ALF 1,V2 24 VOLUME-NAME 2 B0200432 RR NUM 8 B0200433 RR ADC IDATA+8 B0200434 RR ALF 1,D2 25 DISK 2 B0200435 RR NUM 2 B0200436 RR ADC DUMMY+2 B0200437 RR ALF 1,PN 26 PROGRAM NAME B0200438 RR NUM 6 B0200439 RR ADC DUMMY B0200440 RR ALF 1,F 27 FORMAT SPECIFICATION 122*4869B0200441 RR NUM 1 122*4869B0200442 RR ADC DUMMY+4 122*4869B0200443 RR ALF 1,HO 28 HOST NAME B0200444 RR NUM 4 B0200445 RR ADC DUMMY+4 B0200446 RR ALF 1,OP 29 OPTION B0200447 RR NUM 6 B0200448 RR ADC IDATA+19 B0200449 RR ALF 1,NC 30 NUMBER OF CHARACTERS B0200450 RR NUM 3 B0200451 RR ADC DUMMY B0200452 RR ALF 1,SC 31 STARTING CHARACTER B0200453 RR NUM 3 B0200454 RR ADC DUMMY+4 B0200455 RR ALF 1,DO 32 DAYS OLD B0200456 RR NUM 3 B0200457 RR ADC DUMMY B0200458 RR ALF 1,PT 33 PROTOCOL TYPE B0200459 RR NUM 2 B0200460 RR ADC DUMMY B0200461 RR ALF 1,JN 34 JOB NUMBER B0200462 RR NUM 4 B0200463 RR ADC IDATA+22 B0200464 RR ALF 1,LU 35 BATCH INPUT LU B0200465 RR NUM 2 B0200466 RR ADC DUMMY B0200467 RR ALF 1,M 36 BATCH MODE B0200468 RR NUM 1 B0200469 RR ADC IDATA+17 B0200470 RR NUM 0 END OF TABLE B0200471 RR* B0200472 RR EJT B0200473 RR* B0200474 RR* PARAMETER PROCESSING TABLE B0200475 RR* B0200476 RR* BIT SET TO DESCRIPTION B0200477 RR* B0200478 RR* 00-07 NN INDEX TO PARAMETER MNEMONIC TABLE (PARNAM)B0200479 RR* 08 0 RIGHT JUSTIFY B0200480 RR* 1 LEFT JUSTIFY B0200481 RR* 09 0 NO CONVERSION B0200482 RR* 1 ASCII-BINARY CONVERSION B0200483 RR* 10 0 ONE-WORD BINARY OUTPUT B0200484 RR* 1 TWO-WORD BINARY OUTPUT B0200485 RR* 11 0 STANDARD PROCESSING B0200486 RR* 1 SPECIAL PROCESSING(SA,TY) B0200487 RR* 12 0 REQUIRED PARAMETER B0200488 RR* 1 OPTIONAL PARAMETER B0200489 RR* 13-14 NOT USED B0200490 RR* 15 FOUND FLAG B0200491 RR* B0200492 RR ORG PPHELP B0200493 RR NUM $1015 B0200494 RR NUM 0 B0200495 RR ORG PPINIT B0200496 RR NUM $0103 INIT VL B0200497 RR NUM $1205 NF B0200498 RR NUM $0204 DK B0200499 RR NUM 0 END OF PARAMETER STRING B0200500 RR ORG PPDEFI B0200501 RR NUM $0101 DEFINE FN B0200502 RR NUM $1103 VL B0200503 RR NUM $1006 ED B0200504 RR NUM $1807 TY B0200505 RR NUM $1208 LR B0200506 RR NUM $1609 NR B0200507 RR NUM $120A K1 B0200508 RR NUM $120B P1 B0200509 RR NUM $120C K2 B0200510 RR NUM $120D P2 B0200511 RR NUM $120E K3 B0200512 RR NUM $120F P3 B0200513 RR NUM $1210 K4 B0200514 RR NUM $1211 P4 B0200515 RR NUM $1812 SA B0200516 RR NUM 0 END OF PARAMETER STRING B0200517 RR ORG PPSTAT B0200518 RR NUM $1101 STATUS FN B0200519 RR NUM $1102 OW B0200520 RR NUM $1103 VL B0200521 RR NUM 0 B0200522 RR ORG PPRELO B0200523 RR NUM $1101 RELOAD FN B0200524 RR NUM $1102 OW 122*4870B0200525 RR NUM $1103 VL B0200526 RR NUM $1813 I 122*4861B0200527 RR NUM 0 B0200528 RR ORG PPDUMP B0200529 RR NUM $1101 DUMP FN B0200530 RR NUM $1102 OW B0200531 RR NUM $1103 VL B0200532 RR NUM $1814 P 122*4861B0200533 RR NUM $0 B0200534 RR ORG PPCOPY B0200535 RR NUM $0101 COPY FN B0200536 RR NUM $1103 VL B0200537 RR NUM $0117 F2 B0200538 RR NUM $1102 OW B0200539 RR NUM $1118 V2 B0200540 RR NUM 0 B0200541 RR ORG PPDELE B0200542 RR NUM $0101 DELETE FN B0200543 RR NUM $1103 VL B0200544 RR NUM 0 B0200545 RR ORG PPCLEA B0200546 RR NUM $0101 CLEAR FN B0200547 RR NUM $1103 VL B0200548 RR NUM 0 B0200549 RR ORG PPLIST B0200550 RR NUM $0101 LIST FN B0200551 RR NUM $1103 VL B0200552 RR NUM $1815 M B0200553 RR NUM $1816 L B0200554 RR NUM $181B F 122*4869B0200555 RR NUM 0 B0200556 RR ORG PPRENA B0200557 RR NUM $0101 RENAME FN B0200558 RR NUM $1103 VL B0200559 RR NUM $1117 F2 B0200560 RR NUM $1006 ED B0200561 RR NUM 0 B0200562 RR ORG PPCOMM B0200563 RR NUM $1015 COMMAND M B0200564 RR NUM 0 B0200565 RR ORG PPEXIT B0200566 RR NUM 0 B0200567 RR ORG PPMOUN B0200568 RR NUM $0103 MOUNT VL B0200569 RR NUM $0204 DK B0200570 RR NUM 0 B0200571 RR ORG PPDISM B0200572 RR NUM $0204 DISMOUNT DK B0200573 RR NUM 0 B0200574 RR ORG PPSAVE B0200575 RR NUM $204 SAVE DK B0200576 RR NUM $219 D2 B0200577 RR NUM 0 B0200578 RR ORG PPBATC B0200579 RR NUM $0101 BATCH FN B0200580 RR NUM $1102 OW B0200581 RR NUM $1103 VL B0200582 RR NUM $111C HO B0200583 RR NUM $1807 TY B0200584 RR NUM $111A PN B0200585 RR NUM $1824 BATCH MODE B0200586 RR NUM 0 B0200587 RR ORG PPLOAD B0200588 RR NUM $0101 LOAD FN B0200589 RR NUM $1103 VL B0200590 RR NUM $1813 I B0200591 RR NUM $1815 M B0200592 RR NUM 0 B0200593 RR ORG PPPURG B0200594 RR NUM $1102 PURGE OW B0200595 RR NUM $1103 VL B0200596 RR NUM 0 B0200597 RR ORG PPINPU B0200598 RR NUM $0813 I B0200599 RR NUM 0 B0200600 RR ORG PPOUTP B0200601 RR NUM $0814 P B0200602 RR NUM 0 B0200603 RR ORG PPCOMP B0200604 RR NUM $0101 COMPRESS FN B0200605 RR NUM $1103 VL B0200606 RR NUM 0 B0200607 RR ORG PPHOST B0200608 RR NUM $011C HO B0200609 RR NUM $011D OP B0200610 RR NUM $0121 PT B0200611 RR NUM 0 B0200612 RR ORG PPSET B0200613 RR NUM $011C HO B0200614 RR NUM $0223 LU B0200615 RR NUM 0 B0200616 RR ORG PPBATS B0200617 RR NUM $1122 JN B0200618 RR NUM $111C HO B0200619 RR NUM $1116 L B0200620 RR NUM 0 B0200621 RR ORG PPDISC B0200622 RR NUM $0122 JN B0200623 RR NUM 0 B0200624 RR ORG PPDISP B0200625 RR NUM $0122 JN B0200626 RR NUM $011D OP B0200627 RR NUM $121E NC B0200628 RR NUM $121F SC B0200629 RR NUM $1118 V2 B0200630 RR NUM $101 FN B0200631 RR NUM 0 B0200632 RR ORG PPFLUS B0200633 RR NUM $011C HO B0200634 RR NUM $0220 DO B0200635 RR NUM 0 B0200636 RR ORG PPPRIN B0200637 RR NUM $011D OP B0200638 RR NUM $1116 L B0200639 RR NUM 0 B0200640 RR NUM 0 END OF PPTAB B0200641 RR EJT B0200642 RR* B0200643 RR ORG PARDEF B0200644 RR**** B0200645 RR* B0200646 RR* PARAMETER DEFAULT VALUES ********* B0200647 RR* B0200648 RR ALF 4, FILE NAME B0200649 RR ALF 4, OWNER NAME B0200650 RR ALF 4, VOLUME NAME B0200651 RR NUM 192 RECORD LENGTH (BYTES) B0200652 RR NUM 0,1024 NO. OF RECORDS B0200653 RR NUM 0 S/A=N,SEQUENTIAL FILE 122*4874B0200654 RR NUM 1,1 LENGTH AND POSITION OF KEY 1 B0200655 RR NUM 0,0 LENGTH AND POSITION OF KEY 4 B0200656 RR NUM 0,0 LENGTH AND POSITION OF KEY 2 B0200657 RR NUM 0,0 LENGTH AND POSITION OF KEY 3 B0200658 RR**** B0200659 RR ORG* B0200660 RR EJT B0200661 RR* B0200662 RR* START OF FILE-MANAGER UTILITIES EXECUTIVE B0200663 RR* B0200664 RRFMUTEX NOP B0200665 RR RTJ PGMIN OBTAIN ENTRY PARAMETERS B0200666 RR ADC IDUSER ASCII USER INFO B0200667 RR ADC LUNIT SYST LOG UNIT B0200668 RR ADC MODE CURRENT MODE OF OPERATION B0200669 RR ADC NOPORT USER TMNL PORT NO B0200670 RR* B0200671 RR LDA LUNIT SET BIT 12 OF LUNIT FOR WORD-MODE B0200672 RR AND- ZROBIT+12 $EFFF B0200673 RR EOR- ONEBIT+12 $1000 B0200674 RR STA LUNIT B0200675 RR* B0200676 RR RTJ PGMINT ALLOW INTERRUPT(EXCLAMATION MARK) B0200677 RR ADC IADDR B0200678 RR ADC ZRO B0200679 RR* B0200680 RR LDA MODE ARE WE IN INTERACTIVE MODE B0200681 RR SAN FMUT0 NO B0200682 RR STA PIND SET PROMPTING LEVEL 0 B0200683 RR* B0200684 RR RTJ WTREAD DISPLAY 'UTIL' B0200685 RR ADC LUNIT LOGIGAL UNIT NUMBER B0200686 RR ADC NOCUR NO CURSOR POSITIONING REQUESTED B0200687 RR ADC MSG1 OUTPUT BUFFER ADDRESS B0200688 RR ADC LENG1 LENGTH OF MSG 1 B0200689 RR ADC NOCUR NO CURSOR POSITIONING REQUESTED B0200690 RR ADC DUMMY B0200691 RR ADC ZRO B0200692 RR ADC TC TERMINATION CODE B0200693 RR JMP* FMUT2 B0200694 RRFMUT0 ENA -1 B0200695 RR STA PIND SET PROMPTING LEVEL -1 B0200696 RR EJT B0200697 RR* B0200698 RR* READ NEXT LINE OF DATA FROM INPUT DEVICE B0200699 RR* B0200700 RRFMUT1 RTJ PROMPT GO DISPLAY READY B0200701 RRFMUT2 RTJ WTREAD B0200702 RR ADC LUNIT B0200703 RR ADC NOCUR NO CURSOR POSITIONING REQUESTED B0200704 RR ADC DUMMY B0200705 RR ADC ZRO B0200706 RR ADC NOCUR NO CURSOR POSITIONING REQUESTED B0200707 RR ADC INBUF B0200708 RR ADC BUFLEN B0200709 RR ADC TC B0200710 RR* B0200711 RR* INITIALIZE FOR COMMAND SEEK B0200712 RR* B0200713 RR ENA 0 B0200714 RR STA END B0200715 RR STA SWORD B0200716 RR STA SBYTE B0200717 RR RTJ GETFLD B0200718 RR ADC INBUF INPUT STRING BUFFER (40 WORDS) B0200719 RR ADC CODE OUTPUT BUFFER (20 WORDS B0200720 RR ADC SWORD STARTING WORD INDEX B0200721 RR ADC SBYTE STARTING CHAR INDEX B0200722 RR ADC STATUS STATUS TO RETURN B0200723 RR LDA STATUS IS IT END OF STRING B0200724 RR SUB N2 B0200725 RR SAN SCOMSK NO B0200726 RR RAO END YES,SET END FLAG B0200727 RR EJT B0200728 RR* B0200729 RR* START OF CHECKING COMMAND CODES B0200730 RR* B0200731 RRSCOMSK LDA CODE IS IT AN EXIT COMMAND B0200732 RR SUB EXCOM B0200733 RR SAN NOEND NO B0200734 RR JMP ENDUT1 YES,STOP EXECUTION B0200735 RR* B0200736 RRNOEND LDA CODE IS IT AN INPUT COMMAND B0200737 RR SUB INPCOM B0200738 RR SAN NOINP NO B0200739 RR LDA CODE+1 B0200740 RR SUB INPCOM+1 CHECK FOR PU B0200741 RR SAN NOINP B0200742 RR JMP CINPUT B0200743 RRNOINP LDA CODE IS IT AN OUTPUT COMMAND B0200744 RR SUB OUTCOM B0200745 RR SAN NOOUT NO B0200746 RR JMP COUPU B0200747 RR* B0200748 RRNOOUT LDA CODE IS IT A HELP COMMAND B0200749 RR SUB HLPCOM B0200750 RR SAZ CSTAT IT IS A HELP-COMMAND B0200751 RR JMP* NOHELP B0200752 RR* B0200753 RRCSTAT LDA STATUS FIELD TERMINATED BY AN EOL B0200754 RR INA -2 B0200755 RR SAZ PRO2 YES B0200756 RR INA 2 NO,TERMINATED BY A COMMA B0200757 RR SAZ PRO1 YES,PROMPTING LEVEL 1 IS SET B0200758 RR ENA 2 ILLEGAL COMMAND FORMAT B0200759 RR JMP ALARM B0200760 RRPRO1 ENA 1 B0200761 RRSETPRO STA PIND B0200762 RR JMP* FMUT1 GO,READ NEXT LINE B0200763 RR* B0200764 RRPRO2 LDA MODE ARE WE IN INTERACTIVE MODE B0200765 RR SAN NOPRO NO B0200766 RR CLR A YES B0200767 RR JMP* SETPRO B0200768 RR* B0200769 RRNOPRO ENA -1 NO PROMPTING B0200770 RR JMP* SETPRO B0200771 RR* B0200772 RRNOHELP RTJ COMSEK SEARCH COMCOD FOR CODE MATCH B0200773 RR ADC CODE B0200774 RR ADC NOCOD B0200775 RR ADC PARLST B0200776 RR* B0200777 RR LDQ NOCOD IS COMMAND LEGAL B0200778 RR SQP CMDFND YES B0200779 RR ENA 1 ILLEGAL COMMAND B0200780 RR JMP ALARM B0200781 RR* B0200782 RRCMDFND TRQ A CALCULATE INDEX TO SUPCOM B0200783 RR ARS 2 B0200784 RR STA- I B0200785 RR LDA SUPCOM,I B0200786 RR SAP CNDCHK CHECK CONDITIONS B0200787 RR ENA 1 31 REQUESTED COMMAND NOT LEGAL B0200788 RR JMP ALARM B0200789 RR* B0200790 RR* CONDITION CHECK B0200791 RR* B0200792 RRCNDCHK AND- ONE SHOULD ITOS BE DISABLED ? B0200793 RR SAZ CHKTML NO,CHECK FOR SUPERVISOR ONLY B0200794 RR LDA TSNABL GET ITOS ENABLED FLAG B0200795 RR SAZ CHKTML ITOS IS DISABLED B0200796 RR ENA 45 75 ITOS SHOULD BE DISABLED B0200797 RR JMP ALARM B0200798 RR* B0200799 RR* CHECK FOR SUPERVISOR TERMINAL ONLY COMMAND B0200800 RR* B0200801 RRCHKTML LDA SUPCOM,I B0200802 RR ARS 1 B0200803 RR AND- ONE B0200804 RR SAZ MOVCOM NOT A SUPERVISOR COMMAND B0200805 RR LDA NOPORT CHECK IF TERMINAL IS SUPERVISOR B0200806 RR SAZ MOVCOM YES,IT IS A SUPERVISOR B0200807 RR ENA 46 76 SUPERVISOR COMMAND ONLY B0200808 RR JMP ALARM B0200809 RR* B0200810 RRMOVCOM CLR A MOVE 6 CHAR. COMMAND CODE B0200811 RR STA- I B0200812 RR LDA UT STORE UT IN FRONT OF THE B0200813 RR STA CODE PROCESSOR NAME TO CALL IN THE FILE B0200814 RRMVCMD LDA COMCOD,B GET COMMAND FROM COMCOD TABLE B0200815 RR STA CODE+1,I B0200816 RR STA CLBUF1,I B0200817 RR LDA- I CHECK IF COMMAND MOVED COMPLETELY B0200818 RR SUB- TWO B0200819 RR SAZ DSPPRG DISPLAY PROCESSOR NAME B0200820 RR RAO- I B0200821 RR JMP* MVCMD B0200822 RR* B0200823 RRDSPPRG LDA MODE INTERACTIVE ? B0200824 RR SAN LDPGM NO B0200825 RR RTJ WTREAD CLEAR SCREEN AND DISPLAY PROC.NAME B0200826 RR ADC LUNIT B0200827 RR ADC NOCUR B0200828 RR ADC CLBUF B0200829 RR ADC LENCL B0200830 RR ADC NOCUR B0200831 RR ADC DUMMY B0200832 RR ADC ZRO B0200833 RR ADC TC B0200834 RR* B0200835 RR* CLEAR REQUEST BUFFER B0200836 RR* B0200837 RRLDPGM LDQ =N23 B0200838 RRLDP1 CLR A B0200839 RR STA REQBUF,Q B0200840 RR INQ -1 B0200841 RR SQM LDPG B0200842 RR JMP* LDP1 B0200843 RR* B0200844 RRLDPG LDA =XFCBHDR B0200845 RR STA REQBUF+9 B0200846 RR* B0200847 RR RTJ OPENFL OPEN THE PROG.NAME FILE B0200848 RR ADC REQBUF B0200849 RR ADC NDATA B0200850 RR ADC STATUS RETURN STATUS OF FM REQUEST B0200851 RR* B0200852 RR LDA STATUS CHECK IF OPENED CORRECTLY B0200853 RR SAZ RDNAM YES B0200854 RR ENA 3 NO,FILE REQUEST REJECTED B0200855 RR JMP ALARM B0200856 RR* B0200857 RRRDNAM RTJ READR READ THE DESIRED ENTRY B0200858 RR ADC REQBUF B0200859 RR ADC INFO 6 WORD OUTPUT BUFFER B0200860 RR ADC CODE CONTAINS THE PRG.NAME ASKED FOR B0200861 RR ADC STATUS B0200862 RR* B0200863 RR RTJ CLOSFL CLOSE THE PGMNAM FILE B0200864 RR ADC REQBUF B0200865 RR ADC ISTAT B0200866 RR* B0200867 RR LDA STATUS CHECK IF PROGRAM FOUND B0200868 RR SAZ BLDREQ B0200869 RR* B0200870 RR ENA 0 UTILITY PROCESSOR NOT FOUND B0200871 RR JMP* ALARM B0200872 RR* B0200873 RRBLDREQ LDA INFO+3 BUILD THE PGM READ REQUEST B0200874 RR STA* MSBP B0200875 RR LDA INFO+4 B0200876 RR STA* LSBP B0200877 RR LDA INFO+5 B0200878 RR STA* PLEN B0200879 RR* B0200880 RR* READ IN THE DESIRED COMMAND PROCESSOR B0200881 RR* B0200882 RRREDPRO RTJ- ($F4) B0200883 RR NUM $4844 FREAD REQUEST B0200884 RR NUM 0 B0200885 RR NUM 0 B0200886 RR NUM $08C2 SYSTEM DISK B0200887 RRPLEN NUM 0 B0200888 RR ADC UTSTRT B0200889 RRMSBP NUM 0 B0200890 RRLSBP NUM 0 B0200891 RR* B0200892 RR RTJ UTSTRT START THE COMMAND PROCESSOR B0200893 RR* B0200894 RR RTJ PGMINT RESET CONTROL D ENTRY B0200895 RR ADC IADDR B0200896 RR ADC ZRO B0200897 RR RTJ PGMIN OBTAIN ENTRY PARAMETERS B0200898 RR ADC IDUSER ASCII USER INFO B0200899 RR ADC LUNIT SYST LOG UNIT B0200900 RR ADC MODE CURRENT MODE OF OPERATION B0200901 RR ADC NOPORT USER TMNL PORT NO B0200902 RR* B0200903 RR LDA LUNIT SET BIT 12 FOR WORD MODE B0200904 RR AND- ZROBIT+12 B0200905 RR EOR- ONEBIT+12 B0200906 RR STA LUNIT B0200907 RR* B0200908 RR LDA MODE HAS MODE CHANGED TO INTERACTIVE ? B0200909 RR SAN RDNXT NO B0200910 RR LDA PIND YES,CHECK PROMPTING INDICATOR B0200911 RR SAP RDNXT SET FOR PROMPTING ALREADY B0200912 RR CLR A SET FOR HELP MODE PROMPTING B0200913 RR STA PIND B0200914 RRRDNXT JMP FMUT1 GO,READ NEXT COMAND B0200915 RR EJT B0200916 RR* B0200917 RR* CHANGE INPUT UNIT B0200918 RR* B0200919 RRCINPUT LDA* STATUS B0200920 RR SUB* N3 TERMINATED ON A =SIGN B0200921 RR SAZ RUNAM YES B0200922 RR ENA 2 ILLEGAL COMMAND FORMAT B0200923 RR JMP* ALARM NO B0200924 RR* B0200925 RR* READ UNIT NAME B0200926 RR* B0200927 RRRUNAM RTJ GETFLD B0200928 RR ADC INBUF B0200929 RR ADC CODE B0200930 RR ADC SWORD B0200931 RR ADC SBYTE B0200932 RR ADC STATUS B0200933 RR* B0200934 RR LDA* STATUS B0200935 RR SUB* N2 IS IT END OF LINE B0200936 RR SAN CINP2 NO B0200937 RR RAO* END B0200938 RRCINP2 RTJ INPEQ B0200939 RR ADC CODE B0200940 RR ADC STATUS B0200941 RR* B0200942 RR LDA* STATUS IS COMMAND ACCEPTED ? B0200943 RR SAN IOER B0200944 RR JMP FMUT1 B0200945 RR* B0200946 RRIOER ENA $22 B0200947 RR JMP* ALARM B0200948 RR EJT B0200949 RR* B0200950 RR* CHANGE OUTPUT UNIT B0200951 RR* B0200952 RRCOUPU RTJ GETFLD B0200953 RR ADC INBUF B0200954 RR ADC CODE B0200955 RR ADC SWORD B0200956 RR ADC SBYTE B0200957 RR ADC STATUS B0200958 RR* B0200959 RR RTJ OUTEQ B0200960 RR ADC CODE B0200961 RR ADC STATUS B0200962 RR* B0200963 RR LDA* STATUS B0200964 RR SAN OUTERR B0200965 RR JMP FMUT1 B0200966 RR* B0200967 RROUTERR JMP* IOER B0200968 RR EJT B0200969 RR* B0200970 RR* DISPLAY READY DEPENDING UPON PIND B0200971 RR* B0200972 RRPROMPT NOP B0200973 RR LDA PIND PROMPTING WANTED B0200974 RR SAM EXT0 NO B0200975 RR* B0200976 RR RTJ WTREAD B0200977 RR ADC LUNIT B0200978 RR ADC NOCUR NO CURSOR POSITIONING REQUESTED B0200979 RR ADC MSG2 B0200980 RR ADC LENG2 B0200981 RR ADC NOCUR NO CURSOR POSITIONING REQUESTED B0200982 RR ADC DUMMY B0200983 RR ADC ZRO B0200984 RR ADC TC B0200985 RR* B0200986 RREXT0 JMP* (PROMPT) B0200987 RR* B0200988 RRENDUT1 RTJ WTREAD DISPLAY END OF UTIL MESSAGE B0200989 RR ADC LUNIT B0200990 RR ADC NOCUR B0200991 RR ADC ENDMSG B0200992 RR ADC ELENG B0200993 RR ADC NOCUR B0200994 RR ADC DUMMY B0200995 RR ADC ZRO B0200996 RR ADC TC B0200997 RR* B0200998 RR RTJ PGMOUT CONTROL GOES BACK TO ITOS B0200999 RR EJT B0201000 RR* B0201001 RR* ALARM ROUTINE B0201002 RR* B0201003 RRALARM ADD* ERNUM ADD BASE ERROR NO. TO ERROR CODE B0201004 RR STA* INDEX B0201005 RR LDA MODE INTERACTIVE ? B0201006 RR SAN ALARM1 NO B0201007 RR RTJ SYSMSG DISPLAY ERROR B0201008 RR ADC INDEX B0201009 RR ADC ERBUF B0201010 RR* B0201011 RRALARM1 JMP FMUT1 READ NEXT LINE B0201012 RR* B0201013 RRINDEX NUM 0 B0201014 RRERBUF NUM 0 B0201015 RRERNUM NUM 30 ERROR BASE NUMBER B0201016 RR EJT B0201017 RR* B0201018 RR* LOCAL VARIABLES B0201019 RR* B0201020 RRN2 NUM 2 B0201021 RRN3 NUM 3 B0201022 RRHLPCOM ALF 1,HE B0201023 RROUTCOM ALF 1,OU B0201024 RRINPCOM ALF 2,INPU INPUT-COMMAND B0201025 RREXCOM ALF 1,EX EXIT-COMMAND B0201026 RRTC NUM 0 B0201027 RREND NUM 0 B0201028 RRSTATUS NUM 0 B0201029 RRIADDR ADC FMUT1 B0201030 RRNDATA ALF 4,$$PGMNAM B0201031 RR ALF 4,$$ B0201032 RR ALF 4, B0201033 RR NUM 1,1,0 B0201034 RRINFO BZS INFO(6) B0201035 RRISTAT NUM 0 B0201036 RR* B0201037 RR* FMUTEX MESSAGES B0201038 RR* B0201039 RRMSG1 NUM $1800 CLEAR SCREEN B0201040 RR ALF 4, UTIL IN B0201041 RR NUM $0A0D LF/CR B0201042 RR ALF 4, READY B0201043 RR EQU MSG1L(*-MSG1) B0201044 RRMSG2 NUM $0A0D LF/CR B0201045 RR ALF 4, READY B0201046 RR EQU MSG2L(*-MSG2) B0201047 RRCLBUF NUM $1800 CLEAR SCREEN B0201048 RRCLBUF1 ALF 3, B0201049 RR NUM $0A0D LF/CR B0201050 RR EQU LCL(*-CLBUF) B0201051 RRENDMSG NUM $0A0D LF/CR B0201052 RR ALF 10, END UTIL B0201053 RR NUM $0A0D LF/CR B0201054 RR EQU EMSGL(*-ENDMSG) B0201055 RR* B0201056 RRNOCUR NUM -1 B0201057 RRZRO NUM 0 B0201058 RRBUFLEN ADC INPLEN B0201059 RRLENG1 ADC MSG1L B0201060 RRLENG2 ADC MSG2L B0201061 RRLENCL ADC LCL B0201062 RRELENG ADC EMSGL B0201063 RRUT ALF 1,UT B0201064 RR EJT B0201065 RR**** B0201066 RR* B0201067 RR* SUPERVISOR COMMAND TABLE B0201068 RR* B0201069 RR* THE ORDER OF THIS TABLE MUST BE THE SAME AS COMCOD-TABLE B0201070 RR* B0201071 RR* BIT 0 = 1 ITOS MUST BE DISABLED B0201072 RR* BIT 1 = 1 ONLY ALLOWED FOR MASTER TERMINAL B0201073 RR* B0201074 RR* BIT 15 = 1 NON-EXCISTING COMMAND B0201075 RR* B0201076 RRSUPCOM NUM 0 HELP B0201077 RR NUM 2 INIT B0201078 RR NUM 0 DEFINE B0201079 RR NUM 0 STATUS 122*4867B0201080 RR NUM 2 RELOAD B0201081 RR NUM 2 DUMP B0201082 RR NUM 0 COPY B0201083 RR NUM 0 DELETE B0201084 RR NUM 0 CLEAR B0201085 RR NUM 0 LIST B0201086 RR NUM 0 RENAME B0201087 RR NUM 0 COMMAND B0201088 RR NUM 0 EXIT B0201089 RR NUM 2 MOUNT B0201090 RR NUM 2 DISMOUNT B0201091 RR NUM 3 SAVE B0201092 RR NUM 0 BATCH B0201093 RR NUM 0 LOAD B0201094 RR NUM 3 PURGE B0201095 RR NUM 2 INPUT B0201096 RR NUM 2 OUTPUT B0201097 RR NUM 0 COMPRESS B0201098 RR NUM 2 HOST B0201099 RR NUM 2 SET B0201100 RR NUM 0 BATCH STATUS (BATS) B0201101 RR NUM 0 DISCARD B0201102 RR NUM 0 DISPOSE B0201103 RR* ALLOW FLUSH FROM PROCEDURE STREAM B0201104 RR NUM 0 FLUSH B0201105 RR NUM 2 PRINT B0201106 RR NUM $FFFF B0201107 RR* B0201108 RR**** B0201109 RR END B0201110 RR NAM SEKVIT B03 A ITOS CCS 3.0 SL-149B0300001 RR* SEARCH VIT FOR MATCH AGAINST VOLUME NAME B0300002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B0300003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B0300004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B0300005 RR* B0300006 RR**** B0300007 RR* FUNCTION B0300008 RR* B0300009 RR* B0300010 RR* THIS ROUTINE SEARCHES THE CORE-RESIDENT VOLUME-INFORMATION TABLES B0300011 RR* FOR A MATCH AGAINST A PASSED VOLUME-NAME.IF A MATCH IS FOUND THEN B0300012 RR* THE CORE-ADDRESS AND THE MASS-MEMORY UNIT NO.OF THE SELECTED VIT B0300013 RR* ARE RETURNED . IF NO MATCH IS FOUND,AN ADDRESS OF ZERO IS RETURNED B0300014 RR* B0300015 RR* CALLING SEQUENCE B0300016 RR* B0300017 RR* CALL SEKVIT (NAME,VITADR,MMUNIT) B0300018 RR* B0300019 RR* B0300020 RR* INPUT B0300021 RR* B0300022 RR* NAME VOLUME NAME B0300023 RR* B0300024 RR* B0300025 RR* OUTPUT B0300026 RR* B0300027 RR* VITADR VOLUME INFORMATION TABLE ADDR B0300028 RR* MMUNIT PHYSICAL MM UNIT NO B0300029 RR* B0300030 RR* PARAMETER B0300031 RR* B0300032 RR* NAME 4 WORD ASCII BUFFER CONTAINING THE VOLUME-NAME B0300033 RR* VITADR SELECTED VIT OR ZERO B0300034 RR* MMUNIT VOLUME'S MASS MEMORY UNIT NO(INDEX TO MMLUTB) B0300035 RR* B0300036 RR* ENTRY POINTS B0300037 RR* B0300038 RR ENT SEKVIT B0300039 RR* B0300040 RR* EXTERNALS B0300041 RR* B0300042 RR EXT MMLUTB MASS MEMORY LU TABLE B0300043 RR EXT Q8PREP B0300044 RR EXT Q8PKUP B0300045 RR* B0300046 RR* EQUIVALENCES B0300047 RR* B0300048 RR EQU ZERO(2) B0300049 RR* B0300050 RR* VOLUME INFORMATION TABLE B0300051 RR* B0300052 RR EQU VISLUN(2) SYSTEM LOGICAL UNIT NUMBER (BIT 15=1,NOT READYB0300053 RR* ACCESS VISLUN INDIRECTLY B0300054 RR EQU VINAME(1) VOLUME NAME - ASCII CHARACTERS 1 AND 2 B0300055 RR* VOLUME NAME - ASCII CHARACTERS 3 AND 4 B0300056 RR* VOLUME NAME - ASCII CHARACTERS 5 AND 6 B0300057 RR* VOLUME NAME - ASCII CHARACTERS 7 AND 8 B0300058 RR EQU VINMBR(5) VOLUME NUMBER - (2 ASCII CHARACTERS) B0300059 RR EQU VIBMSM(6) BEGINNING OF MANAGEABLE SPACE - MSB B0300060 RR EQU VIBMSL(7) BEGINNING OF MANAGEABLE SPACE - LSB B0300061 RR EQU VIASDM(8) AVAILABLE SPACE DIRECTORY ADDRESS - MSB B0300062 RR EQU VIASDL(9) AVAILABLE SPACE DIRECTORY ADDRESS - LSB B0300063 RR EQU VIASDS(10) # SECTORS IN AVAILABLE SPACE DIRECTORY B0300064 RR EQU VILBAM(11) LARGEST BLOCK OF SPACE AVAILABLE - MSB B0300065 RR EQU VILBAL(12) LARGEST BLOCK OF SPACE AVAILABLE - LSB B0300066 RR EQU VIWPS(13) WORDS/SECTOR FOR VOLUME B0300067 RR EQU VIFDDM(14) FILE DEFINITION DIRECTORY ADDRESS - MSB B0300068 RR EQU VIFDDL(15) FILE DEFINITION DIRECTORY ADDRESS - LSB B0300069 RR EQU VIMAXF(16) MAX. NUMBER OF FILES PERMITTED ON VOLUME B0300070 RR EQU VICURF(17) CURRENT NUMBER OF FILES EXISTING ON VOLUME B0300071 RR EQU VINFDB(18) NUMBER OF BLOCKS IN FILE DEFINITION DIRECTORY B0300072 RR EQU VINXTB(19) NEXT AVAILABLE BLOCK IF FILE DEF. DIRECTORY B0300073 RR EQU VINOOF(20) NUMBER OF OPEN FILES ON VOLUME B0300074 RR**** B0300075 RR* B0300076 RR* B0300077 RR* START OF VIT SEARCH B0300078 RR* B0300079 RRSEKVIT NOP B0300080 RR STQ* QSAVE SAVE Q REGISTER B0300081 RR LDA- I B0300082 RR STA* ISAVE SAVE I REGISTER B0300083 RR* B0300084 RR RTJ Q8PREP B0300085 RR ADC* SEKVIT ABSOLUTISE PARAMETER ADDRESS B0300086 RR* B0300087 RRHERE RTJ Q8PKUP B0300088 RR STA* NAME SAVE BUFFER ADDRESS B0300089 RR RTJ* (HERE+1) B0300090 RR STA* VITADR SAVE VITADR ADDRESS B0300091 RR RTJ* (HERE+1) B0300092 RR STA* MMUNIT SAVE MMUNIT ADDRESS B0300093 RR* B0300094 RR* START TABLE LOOP B0300095 RR* B0300096 RR ENQ 1 B0300097 RR STQ* (MMUNIT) B0300098 RR* B0300099 RRTLOOP LDQ* (MMUNIT) Q=CURRENT INDEX TO MMLUTB B0300100 RRADDR LDA MMLUTB,Q GET TABLE ADDRESS B0300101 RR STA- I B0300102 RR LDA- (VISLUN),I CHECK IF VOLUME IS MOUNTED B0300103 RR SAM NEXT SKIP IF NOT MOUNTED B0300104 RR LDA- I B0300105 RR INA VINAME SAVE VOLUME NAME ADDRESS B0300106 RR STA- I B0300107 RR ENQ 3 CHECK IF NAME MATCHES B0300108 RR* B0300109 RRNLOOP LDA* (NAME),Q B0300110 RR EOR- (ZERO),B B0300111 RR SAN NEXT SKIP IF NOT EQUAL B0300112 RR INQ -1 B0300113 RR SQM FOUND B0300114 RR JMP* NLOOP B0300115 RR* B0300116 RRNEXT LDA* (MMUNIT) ALL TABLES SEARCHED B0300117 RR SUB* (ADDR+1) B0300118 RR SAZ FAIL YES B0300119 RR RAO* (MMUNIT) NO B0300120 RR JMP* TLOOP B0300121 RR* B0300122 RRFOUND LDA- I RETURN VIT ADDRESS B0300123 RR INA -VINAME B0300124 RR JMP* EXIT B0300125 RR* B0300126 RRFAIL ENA 0 B0300127 RR* B0300128 RREXIT STA* (VITADR) B0300129 RR LDQ* QSAVE RESTORE Q REGISTER B0300130 RR LDA* ISAVE B0300131 RR STA- I RESTORE I REGISTER B0300132 RR* B0300133 RR JMP* (SEKVIT) B0300134 RR* B0300135 RR* LOCAL VARIABLES B0300136 RR* B0300137 RRQSAVE NUM 0 LOCATION TO SAVE Q REGISTER B0300138 RRISAVE NUM 0 LOCATION TO SAVE I REGISTER B0300139 RRNAME NUM 0 LOCATION TO SAVE VOLNAM ADDRESS B0300140 RRVITADR NUM 0 B0300141 RRMMUNIT NUM 0 B0300142 RR* B0300143 RR END B0300144 RR NAM REDLAB B04 A ITOS CCS 3.0 SL-149B0400001 RR* READ LABEL FROM SPECIFIED VOLUME B0400002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B0400003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B0400004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B0400005 RR* B0400006 RR**** B0400007 RR* B0400008 RR* FUNCTION B0400009 RR* B0400010 RR* THIS ROUTINE READS THE VOLUME LABEL FROM THE SPECIFIED B0400011 RR* VOLUME B0400012 RR* B0400013 RR* B0400014 RR* GENERAL DESCRIPTION B0400015 RR* B0400016 RR* A MSOS FREAD REQUEST IS DONE TO READ THE LABEL OF THE B0400017 RR* MOUNTED VOLUME ON THE SPECIFIED DISK B0400018 RR* B0400019 RR* B0400020 RR* INPUT REQUIREMENTS B0400021 RR* B0400022 RR* VITADR VIT ADDR OF SPECIFIED DISK B0400023 RR* MMUNIT PHYSICAL DISK NO B0400024 RR* B0400025 RR* B0400026 RR* OUTPUT B0400027 RR* B0400028 RR* LABEL THIS BUFFER WILL CONTAIN THE LABEL READ B0400029 RR* B0400030 RR* B0400031 RR* CALLING SEQUENCE B0400032 RR* B0400033 RR* CALL REDLAB (LABEL,VITADR,MMUNIT) B0400034 RR* B0400035 RR* B0400036 RR* ENTRY POINTS B0400037 RR* B0400038 RR ENT REDLAB B0400039 RR* B0400040 RR* EXTERNALS B0400041 RR* B0400042 RR EXT Q8PREP B0400043 RR EXT Q8PKUP B0400044 RR* B0400045 RR* EQUIVALENCES B0400046 RR* B0400047 RR EQU LABSIZ(96) LENGTH OF LABEL (IN WORDS) B0400048 RR EQU VIWPS(13) B0400049 RR EQU LMSB(21) LABEL MSB 121*4742B0400050 RR EQU LLSB(22) LABEL LSB 121*4742B0400051 RR EQU ZERO($22) B0400052 RR* B0400053 RR* VOLUME LABEL B0400054 RR* B0400055 RR EQU VLIFLG(0) VOLUME INITIALIZED FLAG B0400056 RR EQU VLNAME(2) VOLUME NAME B0400057 RR EQU VLNMBR(6) VOLUME NUMBER B0400058 RR EQU VLSER(7) VOLUME SERIAL B0400059 RR EQU VLSEC(12) VOLUME SECURITY CODE B0400060 RR EQU VLDATE(16) VOLUME CREATE DATE B0400061 RR EQU VLBMSM(20) BEGINNING OF MANAGEABLE SPACE (MSB) B0400062 RR EQU VLBMSL(21) BEGINNING OF MANAGEABLE SPACE (LSB) B0400063 RR EQU VLASDM(22) ALLOCATABLE SPACE DIRECTORY SECTOR (MSB) B0400064 RR EQU VLASDL(23) ALLOCATABLE SPACE DIRECTORY SECTOR (LSB) B0400065 RR EQU VLASDS(24) SIZE OF ALLOCATABLE SPACE DIRECTORY B0400066 RR EQU VLLBA(25) LARGEST BLOCK AVAILABLE(MSB) B0400067 RR EQU VLWPS(27) # WORDS/SECTOR B0400068 RR EQU VLFDD(28) ADDRESS OF FILE DIRECTORY B0400069 RR EQU VLMAXF(30) MAXIMUM NUMBER OF FILES B0400070 RR EQU VLCURF(31) CURRENT NUMBER OF FILES B0400071 RR EQU VLNFDB(32) NUMBER OF BLOCKS IN FILE DIRECTORY B0400072 RR EQU VLNXTB(33) NEXT AVAILABLE FILE DIRECTORY BLOCK B0400073 RR* B0400074 RR**** B0400075 RRREDLAB NOP B0400076 RR STQ* QSAVE SAVE Q REGISTER B0400077 RR LDA- I B0400078 RR STA* ISAVE SAVE I-REGISTER B0400079 RR* B0400080 RR RTJ Q8PREP B0400081 RR ADC* REDLAB B0400082 RR* B0400083 RRHERE RTJ Q8PKUP B0400084 RR STA* LABBUF STORE BUFFER WHERE TO READ INTO B0400085 RR RTJ* (HERE+1) B0400086 RR STA* VITAD STORE VIT-ADDRESS B0400087 RR RTJ* (HERE+1) B0400088 RR STA* MMUNIT B0400089 RR* B0400090 RR* PREPARE MASS MEMORY READ REQUEST B0400091 RR* B0400092 RR LDQ* (VITAD) B0400093 RR LDA- (ZERO),Q B0400094 RR STA* REQLUN MASS MEMORY UNIT TO RED FROM B0400095 RR LDA* LABBUF B0400096 RR STA* REQBUF BUFFER TO READ INTO B0400097 RR LDA* (VITAD) VITADR TO A 121*4742B0400098 RR INA LMSB 121*4742B0400099 RR TRA Q 121*4742B0400100 RR LDA- (ZERO),Q GET LABEL MSB 121*4742B0400101 RR STA* REQMSB STORE INTO REQUEST 121*4742B0400102 RR INQ 1 121*4742B0400103 RR LDA- (ZERO),Q GET LABEL LSB 121*4742B0400104 RR STA* REQLSB STORE INTO REQUEST 121*4742B0400105 RR* B0400106 RR* MAKE A REQUEST TO READ IN THE LABEL INFORMATION B0400107 RR* B0400108 RR RTJ- ($F4) B0400109 RR NUM $4800 B0400110 RR NUM 0,0 NOT USED UNDER ITOS-DIALOG B0400111 RRREQLUN NUM 0 B0400112 RR ADC LABSIZ B0400113 RRREQBUF NUM 0 B0400114 RRREQMSB NUM 0 121*4742B0400115 RRREQLSB NUM 0 121*4742B0400116 RR* B0400117 RR LDQ* QSAVE RESTORE Q REGISTER B0400118 RR LDA* ISAVE RESTORE I REGISTER B0400119 RR STA- I B0400120 RR JMP* (REDLAB) RETURN B0400121 RR* B0400122 RR* LOCAL VARIABLES B0400123 RR* B0400124 RRQSAVE NUM 0 LOCATION TO SAVE Q REGISTER B0400125 RRISAVE NUM 0 LOCATION TO SAVE I REGISTER B0400126 RRLABBUF NUM 0 LOCATION OF BUFFER ADDRESS B0400127 RRVITAD NUM 0 LOCATION OF VIT ADDRESS B0400128 RRMMUNIT NUM 0 MASS MEMORY LU NUMBER B0400129 RR* B0400130 RR END B0400131 RR NAM NXTVOL B05 A ITOS CCS 3.0 SL-149B0500001 RR* GET LU OF NEXT MOUNTED VOLUME B0500002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B0500003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B0500004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B0500005 RR* B0500006 RR**** B0500007 RR* B0500008 RR* FUNCTION B0500009 RR* B0500010 RR* THIS ROUTINE SEARCHES THE NEXT MOUNTED VOLUME B0500011 RR* B0500012 RR* B0500013 RR* GENERAL DESCRIPTION B0500014 RR* B0500015 RR* ON ENTRY THE PARAMETER MMUNIT IS CHECKED TO SEE IF IT B0500016 RR* IS WITHIN THE RANGE OF THE NO OF DISK-UNITS ATTACHED B0500017 RR* TO THE SYSTEM (NO OF DISK UNITS IS IN MMLUTB) B0500018 RR* THE CORE-RESIDENT VOLUME INFORMATION TABLE CORRESPONDING B0500019 RR* WITH MMUNIT IS NOW CHECKED TO SEE IF A VOLUME IS MOUNTED B0500020 RR* IF SO, THE VOLUME-NAME FROM THE VIT IS TRANSFERRED TO B0500021 RR* THE COMMON AREA IDATA(9)-IDATA(12) B0500022 RR* IF NOT,MMUNIT IS INCREMENTED BY ONE AND SEARCH WILL B0500023 RR* CONTINUE B0500024 RR* IF THE END OF MMLUTB IS REACHED AND NO VOLUME IS FOUND B0500025 RR* TO BE MOUNTED,MMUNIT IS SET TO ZERO B0500026 RR* B0500027 RR* B0500028 RR* INPUT REQUIREMENTS B0500029 RR* B0500030 RR* MMUNIT PHYSICAL DISK-UNIT NO. STARTING AT 1 B0500031 RR* B0500032 RR* B0500033 RR* OUTPUT B0500034 RR* B0500035 RR* IF A MOUNTED VOLUME IS FOUND,IDATA(9-12) CONTAINS B0500036 RR* VOLUME-NAME B0500037 RR* ELSE MMUNIT=0 B0500038 RR* B0500039 RR* B0500040 RR* CALLING SEQUENCE B0500041 RR* B0500042 RR* CALL NXTVOL (MMUNIT) B0500043 RR* B0500044 RR* B0500045 RR* ENTRY POINT B0500046 RR* B0500047 RR ENT NXTVOL B0500048 RR* B0500049 RR* EXTERNALS B0500050 RR* B0500051 RR EXT MMLUTB B0500052 RR EXT Q8PREP B0500053 RR EXT Q8PKUP B0500054 RR* B0500055 RR* LABELED COMMON AREA B0500056 RR* B0500057 RR DAT COMCOD(133),PARNAM(124) B0500058 RR DAT PPHELP(2) B0500059 RR DAT PPINIT(4) B0500060 RR DAT PPDEFI(16) B0500061 RR DAT PPSTAT(4) B0500062 RR DAT PPRELO(5) 122*4875B0500063 RR DAT PPDUMP(5) 122*4875B0500064 RR DAT PPCOPY(6) B0500065 RR DAT PPDELE(3) B0500066 RR DAT PPCLEA(3) B0500067 RR DAT PPLIST(6) 122*4875B0500068 RR DAT PPRENA(5) B0500069 RR DAT PPCOMM(2) B0500070 RR DAT PPEXIT(1) B0500071 RR DAT PPMOUN(3) B0500072 RR DAT PPDISM(2) B0500073 RR DAT PPSAVE(3) B0500074 RR DAT PPBATC(8) BATCH B0500075 RR DAT PPLOAD(5) B0500076 RR DAT PPPURG(3) B0500077 RR DAT PPINPU(2) B0500078 RR DAT PPOUTP(2) B0500079 RR DAT PPCOMP(3) B0500080 RR DAT PPHOST(4) HOST B0500081 RR DAT PPSET(3) SET B0500082 RR DAT PPBATS(4) BATCH STATUS B0500083 RR DAT PPDISC(2) DISCARD B0500084 RR DAT PPDISP(7) DISPOSE B0500085 RR DAT PPFLUS(3) FLUSH B0500086 RR DAT PPPRIN(3) PRINT B0500087 RR DAT DUMMY(6) B0500088 RR DAT INBUF(41),CODE(20) B0500089 RR DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B0500090 RR DAT REQBUF(24),IDATA(24) B0500091 RR DAT PARDEF(24) B0500092 RR DAT FCBHDR(5) B0500093 RR DAT FCBBUF(96) B0500094 RR EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B0500095 RR EQU COMLEN(ENDCOM-COMCOD) B0500096 RR* B0500097 RR* B0500098 RR* EQUIVALENCES B0500099 RR* B0500100 RR EQU ZERO(2) B0500101 RR* B0500102 RR* VOLUME INFORMATION TABLE B0500103 RR* B0500104 RR EQU VISLUN(2) SYSTEM LOGICAL UNIT NUMBER (BIT 15=1,NOT READYB0500105 RR* ACCESS VISLUN INDIRECTLY B0500106 RR EQU VINAME(1) VOLUME NAME - ASCII CHARACTERS 1 AND 2 B0500107 RR* VOLUME NAME - ASCII CHARACTERS 3 AND 4 B0500108 RR* VOLUME NAME - ASCII CHARACTERS 5 AND 6 B0500109 RR* VOLUME NAME - ASCII CHARACTERS 7 AND 8 B0500110 RR EQU VINMBR(5) VOLUME NUMBER - (2 ASCII CHARACTERS) B0500111 RR EQU VIBMSM(6) BEGINNING OF MANAGEABLE SPACE - MSB B0500112 RR EQU VIBMSL(7) BEGINNING OF MANAGEABLE SPACE - LSB B0500113 RR EQU VIASDM(8) AVAILABLE SPACE DIRECTORY ADDRESS - MSB B0500114 RR EQU VIASDL(9) AVAILABLE SPACE DIRECTORY ADDRESS - LSB B0500115 RR EQU VIASDS(10) # SECTORS IN AVAILABLE SPACE DIRECTORY B0500116 RR EQU VILBAM(11) LARGEST BLOCK OF SPACE AVAILABLE - MSB B0500117 RR EQU VILBAL(12) LARGEST BLOCK OF SPACE AVAILABLE - LSB B0500118 RR EQU VIWPS(13) WORDS/SECTOR FOR VOLUME B0500119 RR EQU VIFDDM(14) FILE DEFINITION DIRECTORY ADDRESS - MSB B0500120 RR EQU VIFDDL(15) FILE DEFINITION DIRECTORY ADDRESS - LSB B0500121 RR EQU VIMAXF(16) MAX. NUMBER OF FILES PERMITTED ON VOLUME B0500122 RR EQU VICURF(17) CURRENT NUMBER OF FILES EXISTING ON VOLUME B0500123 RR EQU VINFDB(18) NUMBER OF BLOCKS IN FILE DEFINITION DIRECTORY B0500124 RR EQU VINXTB(19) NEXT AVAILABLE BLOCK IF FILE DEF. DIRECTORY B0500125 RR EQU VINOOF(20) NUMBER OF OPEN FILES ON VOLUME B0500126 RR* B0500127 RR**** B0500128 RRNXTVOL NOP B0500129 RR STQ* QSAVE SAVE Q REGISTER B0500130 RR LDA- I B0500131 RR STA* ISAVE SAVE I REGISTER B0500132 RR* B0500133 RR RTJ Q8PREP B0500134 RR ADC* NXTVOL PICK UP PARAMETERS B0500135 RR* B0500136 RRHERE RTJ Q8PKUP B0500137 RR STA* MMUNIT SAVE MMUNIT ADDRESS B0500138 RR CLR Q CHECK IF MMUNIT B0500139 RR LDA MMLUTB,Q IS WITHIN RANGE B0500140 RR SUB* (MMUNIT) B0500141 RR SAP TLOOP IT IS B0500142 RR JMP* ENDTAB B0500143 RR* B0500144 RR* GET NEXT MOUNTED VOLUME-NAME B0500145 RR* B0500146 RRTLOOP LDQ* (MMUNIT) Q=CUURENT INDEX B0500147 RRADDR LDA MMLUTB,Q GET TABLE ADDRESS B0500148 RR STA- I B0500149 RR LDA- (VISLUN),I IS VOLUME MOUNTED ? B0500150 RR SAM NEXT SKIP IF NOT B0500151 RR LDA- I B0500152 RR INA VINAME B0500153 RR STA- I B0500154 RR ENQ 3 B0500155 RR* B0500156 RRNLOOP LDA- (ZERO),B TRANSFER VOLUME NAME B0500157 RR STA IDATA+8,Q B0500158 RR INQ -1 B0500159 RR SQM END NAME TRANSFERRED B0500160 RR JMP* NLOOP NOT YET B0500161 RR* B0500162 RRNEXT LDA* (MMUNIT) SET READY TO GET NEXT VIT B0500163 RR SUB* (ADDR+1) B0500164 RR SAZ ENDTAB END OF VITTAB REACHED B0500165 RR RAO* (MMUNIT) NO B0500166 RR JMP* TLOOP B0500167 RR* B0500168 RRENDTAB ENA 0 B0500169 RR STA* (MMUNIT) B0500170 RR* B0500171 RREND LDQ* QSAVE RESTORE Q REGISTER B0500172 RR LDA* ISAVE RESTORE I REGISTER B0500173 RR STA- I B0500174 RR JMP* (NXTVOL) RETURN B0500175 RR* B0500176 RR* LOCAL VARIABLES B0500177 RR* B0500178 RRMMUNIT NUM 0 B0500179 RRQSAVE NUM 0 B0500180 RRISAVE NUM 0 B0500181 RR END B0500182 RR NAM COMSEK B06 A ITOS CCS 3.0 SL-149B0600001 RR* SEARCH FOR VALID COMMAND CODE B0600002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B0600003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B0600004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B0600005 RR* B0600006 RR**** B0600007 RR* B0600008 RR* COMSEK :COMMAND-CODE SEEK ROUTINE B0600009 RR* B0600010 RR* FUNCTION B0600011 RR* B0600012 RR* THIS ROUTINE SEARCHES A COMMAND-CODE TABLE (COMCOD) B0600013 RR* TO CHECK IF THE COMMAND ENTERED (CODE) IS LEGAL B0600014 RR* B0600015 RR* GENERAL DESCRIPTION B0600016 RR* B0600017 RR* CONSEK TESTS IF THE COMMAND CODE CONTAINED IN A B0600018 RR* TWO-WORD BUFFER (CODE) CORRESPONDS WITH ONE OF B0600019 RR* THE ENTRIES IN THE COMCOD-TABLE B0600020 RR* B0600021 RR* IF NO MATCH IS FOUND AN ERROR MSG WILL BE FORWARDED B0600022 RR* B0600023 RR* CALLING PROCEDURE B0600024 RR* B0600025 RR* CALL COMSEK (CODE,STAT,PARLST) B0600026 RR* B0600027 RR* CODE = ADDRESS OF INPUT STRING B0600028 RR* STAT = INDEX IN COMCOD TABLE B0600029 RR* PARLST= ADDRESS OF PARAMETER PROCESSING TABLE B0600030 RR* B0600031 RR* INPUT REQUIREMENTS B0600032 RR* B0600033 RR* CODE CONTAINS THE FOUR CHARACTER COMMAND-CODE B0600034 RR* B0600035 RR* B0600036 RR* OUTPUT B0600037 RR* B0600038 RR* STAT IF COMMAND FOUND CONTAINS INDEX TO COMCOD B0600039 RR* ELSE IS SET TO MINUS B0600040 RR* PARLST CONTAINS ADDR OF PARAMETER PROCESSING TABLE B0600041 RR* B0600042 RR* B0600043 RR* TABLES USED B0600044 RR* B0600045 RR* COMCOD COMMAND CODE TABLE B0600046 RR* B0600047 RR* B0600048 RR* ENTRY POINTS B0600049 RR* B0600050 RR ENT COMSEK B0600051 RR* B0600052 RR* LABELED COMMON AREA B0600053 RR* B0600054 RR DAT COMCOD(133),PARNAM(124) B0600055 RR DAT PPHELP(2) B0600056 RR DAT PPINIT(4) B0600057 RR DAT PPDEFI(16) B0600058 RR DAT PPSTAT(4) B0600059 RR DAT PPRELO(5) 122*4875B0600060 RR DAT PPDUMP(5) 122*4875B0600061 RR DAT PPCOPY(6) B0600062 RR DAT PPDELE(3) B0600063 RR DAT PPCLEA(3) B0600064 RR DAT PPLIST(6) 122*4875B0600065 RR DAT PPRENA(5) B0600066 RR DAT PPCOMM(2) B0600067 RR DAT PPEXIT(1) B0600068 RR DAT PPMOUN(3) B0600069 RR DAT PPDISM(2) B0600070 RR DAT PPSAVE(3) B0600071 RR DAT PPBATC(8) BATCH B0600072 RR DAT PPLOAD(5) B0600073 RR DAT PPPURG(3) B0600074 RR DAT PPINPU(2) B0600075 RR DAT PPOUTP(2) B0600076 RR DAT PPCOMP(3) B0600077 RR DAT PPHOST(4) HOST B0600078 RR DAT PPSET(3) SET B0600079 RR DAT PPBATS(4) BATCH STATUS B0600080 RR DAT PPDISC(2) DISCARD B0600081 RR DAT PPDISP(7) DISPOSE B0600082 RR DAT PPFLUS(3) FLUSH B0600083 RR DAT PPPRIN(3) PRINT B0600084 RR DAT DUMMY(6) B0600085 RR DAT INBUF(41),CODE(20) B0600086 RR DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B0600087 RR DAT REQBUF(24),IDATA(24) B0600088 RR DAT PARDEF(24) B0600089 RR DAT FCBHDR(5) B0600090 RR DAT FCBBUF(96) B0600091 RR EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B0600092 RR EQU COMLEN(ENDCOM-COMCOD) B0600093 RR**** B0600094 RR* B0600095 RRCOMSEK NOP B0600096 RR LDA* (COMSEK) B0600097 RR STA* ICODE B0600098 RR RAO* COMSEK B0600099 RR LDA* (COMSEK) B0600100 RR STA* STAT B0600101 RR RAO* COMSEK B0600102 RR LDA* (COMSEK) B0600103 RR STA* PPTAB B0600104 RR RAO* COMSEK B0600105 RR* B0600106 RR ENQ 0 B0600107 RR STQ- I B0600108 RRCONTC LDA COMCOD,Q IS THIS END OF TABLE B0600109 RR SAP NOTEND NO B0600110 RR JMP* WRONG YES,ILLEGAL COMMAND CODE B0600111 RRNOTEND SUB* (ICODE) B0600112 RR SAZ MATCH1 B0600113 RR INQ 1 B0600114 RRNOMTCH INQ 3 B0600115 RR JMP* CONTC B0600116 RR* B0600117 RRMATCH1 INQ 1 FIRST TWO CHAR ARE EQUAL B0600118 RR ENA 1 B0600119 RR STA- I B0600120 RR LDA COMCOD,Q B0600121 RR SUB* (ICODE),I B0600122 RR SAZ FOUND COMMAND FOUND B0600123 RR JMP* NOMTCH B0600124 RR* B0600125 RRFOUND INQ -1 B0600126 RR STQ* (STAT) B0600127 RR INQ 3 B0600128 RR LDQ COMCOD,Q B0600129 RR STQ* (PPTAB) STORE PARAMETER LIST ADDRESS B0600130 RR JMP* (COMSEK) B0600131 RR* B0600132 RR* COMMAND DOES NOT EXCIST B0600133 RR* B0600134 RRWRONG ENA -1 B0600135 RR STA* (STAT) B0600136 RR JMP* (COMSEK) B0600137 RR* B0600138 RR* LOCAL VARIABLES B0600139 RR* B0600140 RRICODE NUM 0 B0600141 RRSTAT NUM 0 B0600142 RRPPTAB NUM 0 B0600143 RR* B0600144 RR END B0600145 RR NAM MOVEL B07 A ITOS CCS 3.0 SL-149B0700001 RR* MOVE FIELD LEFT JUSTIFIED, BLANK FILL B0700002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B0700003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B0700004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B0700005 RR* B0700006 RR**** B0700007 RR* B0700008 RR* FUNCTION B0700009 RR* B0700010 RR* MOVE FIELD LEFT JUSTIFIED WITH BLANK FILL B0700011 RR* B0700012 RR* B0700013 RR* GENERAL DESCRIPTION B0700014 RR* B0700015 RR* MOVEL PICKS UP CHAR. FROM THE INPUT FIELD (INP) B0700016 RR* AND TRANSFERS THE NUMBER OF CHAR. SPECIFIED(LNGO) B0700017 RR* LEFT JUSTIFIED TO THE OUTPUT FIELD (OUTP) B0700018 RR* B0700019 RR* FIELD WILL BE TRUNCATED AT RIGHT END IF IT EXCEEDS B0700020 RR* LNGO CHARACTERS B0700021 RR* B0700022 RR* B0700023 RR* INPUT REQUIREMENTS B0700024 RR* B0700025 RR* INP ADDRESS OF THE INPUT BUFFER B0700026 RR* OUTP ADDRESS CONTAINING THE OUTPUT ADDRESS B0700027 RR* LNGO ADDRESS CONTAINING THE NO. OF CHAR TO MOVE B0700028 RR* B0700029 RR* B0700030 RR* CALLING SEQUENCE B0700031 RR* B0700032 RR* CALL MOVEL (INP,OUTP,LNGO) B0700033 RR* B0700034 RR* B0700035 RR* EQUATES B0700036 RR* B0700037 RR EQU LPMASK(2) B0700038 RR EQU NZERO($12) B0700039 RR EQU ONEBIT($23) B0700040 RR* B0700041 RR* B0700042 RR* ENTRY POINT B0700043 RR* B0700044 RR ENT MOVEL B0700045 RR* B0700046 RR**** B0700047 RRMOVEL NOP B0700048 RR LDA* (MOVEL) PICK UP PARAMETERS B0700049 RR STA* INP INPUT BUFFER ADDRESS B0700050 RR RAO* MOVEL B0700051 RR LDA* (MOVEL) B0700052 RR STA* OUTP OUTPUT FIELD ADDRESS B0700053 RR LDA* (OUTP) B0700054 RR STA* OUTP B0700055 RR RAO* MOVEL B0700056 RR LDA* (MOVEL) B0700057 RR STA* LNGO NO.OF CHAR.TO MOVE B0700058 RR RAO* MOVEL B0700059 RR ENA 0 INITIALISE POINTERS B0700060 RR STA* OUTWRD OUTPUT-WORD POINTER B0700061 RR STA* INPCHR INPUT-CHAR LEFT/RIGHT POINTER B0700062 RR STA* OUTCHR OUTPUT-CHAR LEFT/RIGHT POINTER B0700063 RR STA* INPWRD INPUT-WORD POINTER B0700064 RR CLR Q B0700065 RR LDA* (LNGO) CALCULATE NO OF WORDS TO BE MOVED B0700066 RR DVI* N2 B0700067 RR SQZ MOV1 EVEN NO OF BYTES B0700068 RR INA 1 ODD NO OF BYTES (ROUND UP) B0700069 RRMOV1 STA* ENDFLD NO OF WORDS TO BE MOVED B0700070 RR* B0700071 RR* PRESET OUTPUT-FIELD WITH SPACES B0700072 RR* B0700073 RR ENQ 0 B0700074 RRMOV2 LDA* BLANK B0700075 RR STA* (OUTP),Q STORE SPACE TO OUTPUT-FIELD B0700076 RR INQ 1 B0700077 RR TRQ A B0700078 RR SUB* ENDFLD ALL SET B0700079 RR SAZ MOV3 YES B0700080 RR JMP* MOV2 NO,CONTINUE B0700081 RR* B0700082 RRMOV3 LDQ* INPWRD GET NEXT INPUT CHAR B0700083 RR LDA* (INP),Q GET WORD B0700084 RR LDQ* INPCHR IS A LOWER HALF CHAR B0700085 RR SQN MOV4 YES B0700086 RR ARS 8 NO,SHIFT UPPER CHAR B0700087 RRMOV4 AND- LPMASK+8 $00FF B0700088 RR STA* TEMP SAVE NEXT CHAR B0700089 RR INA -$20 IS IT A BLANK B0700090 RR SAN MOV5 NO B0700091 RR JMP* MOV7 B0700092 RR* B0700093 RRMOV5 LDQ* OUTWRD GET OUTPUT WORD B0700094 RR LDA* (OUTP),Q B0700095 RR LDQ* OUTCHR LOWER HALF B0700096 RR SQN MOV6 YES B0700097 RR AND- LPMASK+8 NO,MASK OUT UPPER PART B0700098 RR LDQ* TEMP B0700099 RR QLS 8 B0700100 RR EAQ A MERGE TO ONE WORD B0700101 RR LDQ* OUTWRD B0700102 RR STA* (OUTP),Q B0700103 RR JMP* MOV7 SEE IF FINISHED B0700104 RR* B0700105 RRMOV6 LDQ* OUTWRD B0700106 RR AND- NZERO+8 B0700107 RR EOR* TEMP MERGE WITH LOWER PART CHAR B0700108 RR STA* (OUTP),Q B0700109 RR* B0700110 RRMOV7 LDA* (LNGO) B0700111 RR INA -1 B0700112 RR STA* (LNGO) B0700113 RR SAN MOV8 NOT ALL MOVED B0700114 RRFINIS JMP* (MOVEL) READY B0700115 RR* B0700116 RRMOV8 LDA* OUTWRD LAST WORD REACHED B0700117 RR SUB* ENDFLD B0700118 RR SAN MOV9 NO B0700119 RR LDA* OUTCHR YES,IS IT LAST CHAR B0700120 RR SAZ MOV9 NO B0700121 RR JMP* FINIS YES B0700122 RR* B0700123 RRMOV9 LDA* OUTCHR SWITCH OUTPUT-CHAR POSITION B0700124 RR EOR- ONEBIT B0700125 RR STA* OUTCHR B0700126 RR SAN MOV10 NEXT OUTPUT CHAR TO SAME WORD B0700127 RR RAO* OUTWRD NEXT OUTPUT CHAR TO NEXT WORD B0700128 RR* B0700129 RR* B0700130 RR* B0700131 RRMOV10 LDA* INPCHR SWITCH INPUT-CHAR POSITION B0700132 RR EOR- ONEBIT B0700133 RR STA* INPCHR B0700134 RR SAN MOV11 NEXT INPUT CHAR IS IN SAME WORD B0700135 RR RAO* INPWRD NEXT INPUT CHAR IS IN NEXT WORD B0700136 RR* B0700137 RRMOV11 JMP* MOV3 GO,GET NEXT INPUT CHAR B0700138 RR* B0700139 RR* LOCAL VARIABLES B0700140 RR* B0700141 RRBLANK ALF 1, B0700142 RRN2 NUM 2 B0700143 RROUTCHR NUM 0 B0700144 RRINPCHR NUM 0 B0700145 RRENDFLD NUM 0 B0700146 RRLNGO NUM 0 B0700147 RROUTP NUM 0 B0700148 RRINP NUM 0 B0700149 RRINPWRD NUM 0 B0700150 RRTEMP NUM 0 B0700151 RROUTWRD NUM 0 B0700152 RR* B0700153 RR END B0700154 RR NAM MOVER B08 A ITOS CCS 3.0 SL-149B0800001 RR* MOVE FIELD RIGHT JUSTIFIED, ZERO FILL B0800002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B0800003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B0800004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B0800005 RR* B0800006 RR**** B0800007 RR* B0800008 RR* FUNCTION B0800009 RR* B0800010 RR* MOVE FIELD RIGHT JUSTIFIED WITH ZERO FILL B0800011 RR* B0800012 RR* B0800013 RR* GENERAL DESCRIPTION B0800014 RR* B0800015 RR* MOVER ZEROES THE OUTPUT-FIELD PRIOR TO THE TRANSFER B0800016 RR* OF CHARACTERS.IT PICKS UP CHAR.FROM RIGHT TO LEFT B0800017 RR* AND STORES THEM IN THE SAME ORDER B0800018 RR* B0800019 RR* BLANKS DETECTED IN THE INPUT-FIELD WILL BE IGNORED B0800020 RR* WHEN THE MOVE IS DONE LNGI WILL BE SET TO ZERO B0800021 RR* B0800022 RR* B0800023 RR* INPUT REQUIREMENTS B0800024 RR* B0800025 RR* INP INPUT BUFFER ADDRESS B0800026 RR* LNGI ADDR CONTAINING NO OF CHAR IN INP TO MOVE B0800027 RR* OUTP ADDR CONTAINING THE OUTPUT BUFFER ADDR B0800028 RR* LNGO ADDR CONTAINING NO OF CHAR IN OUTPUT BUFFER B0800029 RR* B0800030 RR* B0800031 RR* CALLING SEQUENCE B0800032 RR* B0800033 RR* CALL MOVER (INP,LNGI,OUTP,LNGO) B0800034 RR* B0800035 RR* B0800036 RR* ENTRY POINT B0800037 RR* B0800038 RR ENT MOVER B0800039 RR* B0800040 RR* B0800041 RR* EQUATES B0800042 RR* B0800043 RR EQU LPMASK(2) B0800044 RR EQU NZERO($12) B0800045 RR EQU ONEBIT($23) B0800046 RR* B0800047 RR* B0800048 RR* PARAMETERS B0800049 RR* B0800050 RR* OUTCHR POINTER TO BYTE IN OUTPUTWORD B0800051 RR* OUTWRD POINTER TO OUTPUT WORD B0800052 RR* INPCHR POINTER TO BYTE IN INPUT WORD B0800053 RR* INPWRD POINTER TO INPUT WORD B0800054 RR* ENDFLD NO OF WORDS IN INPUTFIELD B0800055 RR* B0800056 RR* B0800057 RR**** B0800058 RRMOVER NOP B0800059 RR* B0800060 RR LDA* (MOVER) PICK UP PARAMETERS B0800061 RR STA* INP INPUT BUFFER ADDRESS B0800062 RR RAO* MOVER B0800063 RR LDA* (MOVER) B0800064 RR STA* LNGI B0800065 RR RAO* MOVER B0800066 RR LDA* (MOVER) B0800067 RR STA* OUTP OUTPUT BUFFER ADDRESS B0800068 RR LDA* (OUTP) B0800069 RR STA* OUTP B0800070 RR RAO* MOVER B0800071 RR LDA* (MOVER) B0800072 RR STA* LNGO NO OF CHAR. TO TRANSFER B0800073 RR RAO* MOVER B0800074 RR* B0800075 RR* INITIALISATION B0800076 RR* B0800077 RR ENA 1 INITIALISE POINTERS B0800078 RR STA* INPCHR TO POINT TO LOWER HALF B0800079 RR STA* OUTCHR B0800080 RR ENA 0 B0800081 RR STA* INPWRD B0800082 RR STA* OUTWRD B0800083 RR* B0800084 RR CLR Q B0800085 RR LDA* (LNGO) CALCULATE NO OF WORDS OF OUTPUT FIELD B0800086 RR DVI N2 B0800087 RR SQZ MOV1 EVEN NO OF CHAR B0800088 RR INA 1 ODD B0800089 RRMOV1 STA* ENDFLD NO OF WORDS B0800090 RR* B0800091 RR CLR Q B0800092 RR LDA* (LNGI) CALCULATE NO OF WORDS OF INPUT FIELD B0800093 RR DVI* N2 B0800094 RR SQZ MOV15 B0800095 RR* B0800096 RR TRA Q B0800097 RR LDA* INPCHR SWITCH INPCHR TO UPPER HALF B0800098 RR EOR- ONEBIT IF ODD NO OF CHAR INPUT B0800099 RR STA* INPCHR B0800100 RR TRQ A B0800101 RR* B0800102 RR INA 1 B0800103 RRMOV15 STA* ENDINP B0800104 RR* B0800105 RR LDA* INP CALCULATE END OF FIELD ADDRESS B0800106 RR ADD* ENDINP B0800107 RR INA -1 B0800108 RR STA* INPL END INPUT FIELD ADDRESS B0800109 RR* B0800110 RR LDA* OUTP CALCULATE END ADDRESS OF B0800111 RR ADD* ENDFLD OUTPUT-FIELD B0800112 RR INA -1 B0800113 RR STA* OUTPL END OUTPUT FIELD ADDRESS B0800114 RR* B0800115 RR* PRESET OUTPUT FIELD WITH ZEROES B0800116 RR* B0800117 RR LDQ* ENDFLD B0800118 RRMOV2 INQ -1 B0800119 RR LDA* ZEROES B0800120 RR STA* (OUTP),Q STORE ZEROES TO OUTPUT FIELD B0800121 RR TRQ A B0800122 RR SAZ MOV3 ALL ZEROED B0800123 RR JMP* MOV2 NO.CONTINUE B0800124 RR* B0800125 RR* GET NEXT INPUT CHARACTER B0800126 RR* B0800127 RRMOV3 LDQ* INPWRD B0800128 RR LDA* (INPL),Q GET WORD OF INPUT FIELD B0800129 RR LDQ* INPCHR IS IT A LOWER CHAR B0800130 RR SQN MOV4 YES B0800131 RR ARS 8 NO,SHIFT UPPER B0800132 RRMOV4 AND- LPMASK+8 MASK OUT B0800133 RR STA* TEMP SAVE TEMPORARILY B0800134 RR INA -$20 IS IT A BLANK B0800135 RR SAN MOV5 NO B0800136 RR JMP* MOV9 YES,IGNORE B0800137 RR* B0800138 RRMOV5 LDQ* OUTWRD GET OUTPUT WORD B0800139 RR LDA* (OUTPL),Q B0800140 RR LDQ* OUTCHR LOWER CHAR B0800141 RR SQN MOV6 YES B0800142 RR AND- LPMASK+8 NO,MASK OUT B0800143 RR LDQ* TEMP COMBINE WITH CHAR STORED B0800144 RR QLS 8 B0800145 RR EAQ A B0800146 RR LDQ* OUTWRD B0800147 RR STA* (OUTPL),Q B0800148 RR JMP* MOV7 NEXT TO BE DONE ? B0800149 RR* B0800150 RRMOV6 LDQ* OUTWRD B0800151 RR AND- NZERO+8 B0800152 RR EOR* TEMP COMBINE WITH STORED ONE B0800153 RR STA* (OUTPL),Q B0800154 RR* B0800155 RRMOV7 LDA* (LNGI) B0800156 RR INA -1 B0800157 RR STA* (LNGI) B0800158 RR SAN MOV8 NOT ALL MOVED B0800159 RRFINIS JMP* (MOVER) FINISHED,EXIT B0800160 RR* B0800161 RRMOV8 LDA* OUTCHR SWITCH OUTPUT CHAR POINTER B0800162 RR EOR- ONEBIT B0800163 RR STA* OUTCHR B0800164 RR SAZ MOV10 WORD NOT YET COMPLETED B0800165 RR LDA* OUTWRD UPDATE FOR NEXT WORD B0800166 RR INA -1 B0800167 RR STA* OUTWRD B0800168 RR JMP* MOV10 B0800169 RR* B0800170 RRMOV9 LDA* (LNGI) DECREMENT NO OF CHAR TO MOVE B0800171 RR INA -1 B0800172 RR STA* (LNGI) B0800173 RR SAN MOV10 ALL MOVED ? B0800174 RR JMP* FINIS YES B0800175 RR* B0800176 RRMOV10 LDA* INPCHR SWITCH INPUT CHAR B0800177 RR EOR- ONEBIT B0800178 RR STA* INPCHR B0800179 RR SAZ MOV11 UPPER HALF B0800180 RR LDA* INPWRD LOWER HALF,SO B0800181 RR INA -1 UPDATE INPUT WORD B0800182 RR STA* INPWRD B0800183 RRMOV11 JMP* MOV3 GET NEXT CHAR B0800184 RR* B0800185 RR* LOCAL VARIABLES B0800186 RR* B0800187 RRZEROES ALF 1,00 B0800188 RRN2 NUM 2 B0800189 RROUTCHR NUM 0 B0800190 RRINPCHR NUM 0 B0800191 RROUTWRD NUM 0 B0800192 RRINPWRD NUM 0 B0800193 RRENDFLD NUM 0 B0800194 RRLNGO NUM 0 B0800195 RRINPL NUM 0 B0800196 RROUTPL NUM 0 B0800197 RRINP NUM 0 B0800198 RROUTP NUM 0 B0800199 RRTEMP NUM 0 B0800200 RRENDINP NUM 0 B0800201 RRLNGI NUM 0 B0800202 RR* B0800203 RR END B0800204 RR NAM GETFLD B09 A ITOS CCS 3.0 SL-149B0900001 RR* GET NEXT INPUT FIELD B0900002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B0900003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B0900004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B0900005 RR* B0900006 RR**** B0900007 RR* B0900008 RR* FUNCTION B0900009 RR* B0900010 RR* THIS ROUTINE SEARCHES AN ASCII BUFFER AND RETURNS WITH THE B0900011 RR* FIELD CONTENTS IN AN OUTPUT BUFFER(SBUF) B0900012 RR* THE FIELDS ARE CONTROLLED BY DELIMETERS AND BLANKS ARE IGNORED B0900013 RR* B0900014 RR* GENERAL DESCRIPTION B0900015 RR* B0900016 RR* GETFLD SEARCHES THE ASCII INPUT BUFFER (IBUF),STARTING AT A B0900017 RR* SPECIFIED WORD LOCATION(SWORD) AND A SPECIFIED BYTE LOCATION B0900018 RR* WITHIN THE WORD (SCHAR) B0900019 RR* CHARACTERS ARE EXTRACTED FROM THE STRING AND STORED INTO THE B0900020 RR* OUTPUT BUFFER (SBUF) B0900021 RR* AT RETURN THE LOCATIONS SWORD AND SCHAR WILL BE UPDATED FOR B0900022 RR* THE NEXT CALL B0900023 RR* B0900024 RR* A STATUS WORD (STAT) WILL BE RETURNED,INDICATING THE TERMINATION B0900025 RR* OF THE SEARCH B0900026 RR* STAT = 0 SEARCH TERMINATED AT A COMMA B0900027 RR* 1 A SEMI-COLON B0900028 RR* 2 AN END-OF-LINE B0900029 RR* 3 AN EQUAL-SIGN B0900030 RR* B0900031 RR* BLANKS ARE IGNORED B0900032 RR* B0900033 RR* CALLING PROCEDURE B0900034 RR* B0900035 RR* CALL GETFLD(IBUF,SBUF,SWORD,SCHAR,STAT) B0900036 RR* B0900037 RR* IBUF = INPUT BUFFER (40 WORDS) B0900038 RR* SBUF = OUTPUT BUFFER (20 WORDS) B0900039 RR* SWORD= START WORD LOCATION INDEX (0-39) B0900040 RR* SCHAR= START BYTE LOCATION INDICATOR(0=UPPER,1=LOWER) B0900041 RR* STAT = STATUS TO BE RETURNED B0900042 RR* B0900043 RR* ENTRY POINT B0900044 RR* B0900045 RR ENT GETFLD B0900046 RR* B0900047 RR* EQUIVALENCES B0900048 RR* B0900049 RR EQU ZERO($22) B0900050 RR EQU ONEBIT($23) B0900051 RR EQU LPMASK(2) B0900052 RR EQU NZERO($12) B0900053 RR EQU BLANK($20) B0900054 RR EQU ETX($03) B0900055 RR EQU EQUAL($3D) B0900056 RR EQU COMMA($2C) B0900057 RR EQU SEMCOL($3B) B0900058 RR**** B0900059 RR EJT B0900060 RRGETFLD NOP B0900061 RR LDQ* (GETFLD) PICK UP THE PARAMETERS B0900062 RR STQ* IBUF B0900063 RR RAO* GETFLD B0900064 RR LDQ* (GETFLD) B0900065 RR STQ* SBUF B0900066 RR RAO* GETFLD B0900067 RR LDQ* (GETFLD) B0900068 RR STQ* SWORD B0900069 RR RAO* GETFLD B0900070 RR LDQ* (GETFLD) B0900071 RR STQ* SCHAR B0900072 RR RAO* GETFLD B0900073 RR LDQ* (GETFLD) B0900074 RR STQ* STAT B0900075 RR RAO* GETFLD B0900076 RR* B0900077 RR* INITIALIZATION B0900078 RR* B0900079 RR ENA 0 B0900080 RR STA* END CLEAR END FLAG B0900081 RR STA* (STAT) STATUS B0900082 RR* B0900083 RR* SET AN ETX AFTER THE LAST INPUT CHARACTER B0900084 RR* B0900085 RR ENQ 40 B0900086 RR LDQ* (IBUF),Q GET NO OF CHAR READ B0900087 RR* B0900088 RR TRQ A 120*4570B0900089 RR INA -80 IS THIS A 40 WORD REQUEST (80 CH.) 120*4570B0900090 RR SAZ OKA YES 120*4570B0900091 RR* B0900092 RROK LRS 1 CONVERT TO NO OF WORDS B0900093 RR SAP GF0 SKIP IF EVEN B0900094 RR LDA* (IBUF),Q ODD B0900095 RR AND- NZERO+8 MASK OUT LOWER HALF B0900096 RR INA BLANK REPLACE WITH BLANK B0900097 RR STA* (IBUF),Q B0900098 RR INQ 1 B0900099 RR TRQ A GET NUMBER OF WORDS READ 120*4570B0900100 RR INA -36 HAS THE LAST COLUMN BEEN REACHED 120*4570B0900101 RR SAM GF0 NO 120*4570B0900102 RROKA ENQ 36 YES, SET LAST TO 72 120*4570B0900103 RR* B0900104 RRGF0 LDA* ETXCOD STORE ETX-CODE B0900105 RR STA* (IBUF),Q B0900106 RR* B0900107 RROKD ENQ 19 B0900108 RR LDA SPACES B0900109 RRGF1 STA* (SBUF),Q WITH SPACES B0900110 RR SQZ GF2 B0900111 RR INQ -1 B0900112 RR JMP* GF1 B0900113 RRGF2 STQ* OWORD SET OUTPUT POINTER WORD LOCATION B0900114 RR STQ* OCHAR BYTE INDICATOR B0900115 RR* B0900116 RR* GET NEXT CHARACTER FROM INPUT STRING B0900117 RR* B0900118 RRGF3 LDQ* (SWORD) GET NEXT INPUT WORD B0900119 RR LDA* (IBUF),Q B0900120 RR LDQ* (SCHAR) UPPER OR LOWER HALF B0900121 RR SQN GF4 B0900122 RR ARS 8 UPPER HALF B0900123 RRGF4 AND- LPMASK+8 $00FF B0900124 RR STA* TEMP SAVE TEMPORARELY B0900125 RR TRA Q B0900126 RR* B0900127 RR* CHECK FOR SPECIAL CHARACTERS B0900128 RR* B0900129 RR INA -BLANK IS IT A SPACE ? B0900130 RR SAN GF5 NO B0900131 RR JMP* NXTCHR YES,IGNORE B0900132 RRGF5 LDA* END FIELD TERMINATOR ALREADY DETECTED B0900133 RR SAZ GF51 NO B0900134 RR JMP* (GETFLD) YES,EXIT B0900135 RRGF51 TRQ A B0900136 RR INA -ETX IS IT END OF INPUT ? B0900137 RR SAN GF61 NO B0900138 RR JMP* GF11 YES,SET END STATUS AND EXIT B0900139 RRGF61 TRQ A IS IT AN EQUAL-SIGN ? B0900140 RR INA -EQUAL IS IT AN EQUAL-SIGN ? B0900141 RR SAN GF7 NO B0900142 RR ENA 3 YES,SET STATUS = 3 B0900143 RR STA* (STAT) B0900144 RR RAO* END SET END B0900145 RR JMP* NXTCHR CONTINUE TO NEXT NON-BLANK CHAR B0900146 RRGF7 TRQ A IS IT A COMMA B0900147 RR INA -COMMA IS IT A COMMA ? B0900148 RR SAN GF75 NO B0900149 RR ENA 0 YES,STATUS=0 B0900150 RRGF77 STA* (STAT) B0900151 RR RAO* END B0900152 RR JMP* NXTCHR B0900153 RRGF75 TRQ A B0900154 RR INA -SEMCOL IS IT A SEMI-COLON ? B0900155 RR SAN GF8 NO B0900156 RR ENA 1 YES,STATUS=1 B0900157 RR JMP* GF115 B0900158 RR* B0900159 RR* LOCAL VARIABLES B0900160 RR* B0900161 RRIBUF NUM 0 B0900162 RRSBUF NUM 0 B0900163 RRSWORD NUM 0 B0900164 RRSCHAR NUM 0 B0900165 RRSTAT NUM 0 B0900166 RREND NUM 0 B0900167 RROWORD NUM 0 B0900168 RROCHAR NUM 0 B0900169 RRTEMP NUM 0 B0900170 RRSPACES ALF 1, B0900171 RRETXCOD NUM $0320 B0900172 RR EJT B0900173 RR* B0900174 RR* STORE CHARACTERS IN OUTPUT BUFFER B0900175 RR* B0900176 RRGF8 LDQ* OWORD B0900177 RR LDA* (SBUF),Q B0900178 RR LDQ* OCHAR UPPER OF LOWER BYTE TO STORE B0900179 RR SQN GF9 LOWER B0900180 RR AND- LPMASK+8 $00FF UPPER BYTE MUST BE STORED B0900181 RR LDQ* TEMP B0900182 RR QLS 8 B0900183 RR EAQ A B0900184 RR LDQ* OWORD B0900185 RR STA* (SBUF),Q B0900186 RR JMP* GF10 B0900187 RRGF9 LDQ* OWORD STORE LOWER BYTE IN SBUF B0900188 RR AND- NZERO+8 $FF00 B0900189 RR EOR* TEMP B0900190 RR STA* (SBUF),Q B0900191 RRGF10 LDA* OCHAR B0900192 RR EOR- ONEBIT B0900193 RR STA* OCHAR B0900194 RR SAN NXTCHR B0900195 RR LDA* OWORD B0900196 RR INA 1 B0900197 RR STA* OWORD B0900198 RR INA -20 EXCEEDED SBUF SIZE 132*5346B0900199 RR SAP GF11 YES, SET LAST CHARACTER STATUS 132*5346B0900200 RR* B0900201 RR* END OF FIELD PROCESSING B0900202 RR* B0900203 RRNXTCHR LDA* (SWORD) LAST WORD OF INPUT BUFFER REACHED B0900204 RR INA -35 120*4570B0900205 RR SAN GF12 NO B0900206 RR LDA* (SCHAR) YES,IS IT LAST CHAR B0900207 RR SAZ GF12 NO B0900208 RRGF11 ENA 2 YES,SET STATUS =2 B0900209 RRGF115 STA* (STAT) B0900210 RR JMP* (GETFLD) B0900211 RRGF12 LDA* (SCHAR) B0900212 RR EOR- ONEBIT SWITCH CHARACTER B0900213 RR STA* (SCHAR) B0900214 RR SAN GF13 LOWER HALF OF SAME WORD B0900215 RR LDA* (SWORD) UPPER HALF OF NXT WORD B0900216 RR INA 1 B0900217 RR STA* (SWORD) B0900218 RRGF13 JMP* GF3 GET NEXT CHAR B0900219 RR END B0900220 RR NAM MMSIZ B10 A ITOS CCS 3.0 SL-149 00001 RR* GET MAX SECTOR NO. FOR SPECIFIED UNIT AND WORDS PER SECTOR 00002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 00003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00004 RR* COPYRIGHT CONTROL DATA CORPORATION 1978 00005 RR* 00006 RR**** 00007 RR* 00008 RR* FUNCTION 00009 RR* 00010 RR* THIS ROUTINE SEARCHES A TABLE (MMTC) TO OBTAIN THE 00011 RR* MAXIMUM NO OF SECTORS FOR A GIVEN MASS-MEMORY 00012 RR* EQUIPMENT TYPE IF CDD OR COMPUTES THE MAXIMUM NO. OF 00013 RR* SECTORS FROM PDT PARAMETERS FOR SMDS. IT ALSO PROVIDES 00014 RR* WORDS PER SECTOR FOR SMD 00015 RR* 00016 RR* 00017 RR* GENERAL DESCRIPTION 00018 RR* 00019 RR* 00020 RR* SMD 00021 RR* USING THE LOGICAL UNIT AS INPUT, INFORMATION IS EXTRACTED 00022 RR* FROM THE PDT TO COMPUTE THE MAXIMUM SECTOR. (NOTE THAT THE 00023 RR* LAST TWO TRACKS ARE ASSUMED TO BE FOR BAD SECTOR ADDRESSING 00024 RR* 00025 RR* 00026 RR* INPUT REQUIREMENTS 00027 RR* 00028 RR* LU LOGICAL UNIT OF MM DEVICE 00029 RR* 00030 RR* 00031 RR* OUTPUT 00032 RR* 00033 RR* SECTM MAXIMUM SECTOR NO MSB 00034 RR* SECTL MAXIMUM SECTOR NO LSB 00035 RR* WPS WORDS PER SECTOR (SMD ONLY) 00036 RR* SECTRK SECTORS PER TRACK (SMD ONLY) 00037 RR* 00038 RR* 00039 RR* CALLING SEQUENCE 00040 RR* 00041 RR* CALL MMSIZ (LU,SECTM,SECTL,WPS,SECTRK) 00042 RR* 00043 RR* 00044 RR* SUBROUTINE 00045 RR* 00046 RR* SYSMSG SYSTEM ERROR MESSAGE ROUTINE 00047 RR* 00048 RR* 00049 RR* PARAMETERS 00050 RR* 00051 RR* MMTC MASS MEMORY TYPE CODE TABLE (CDD ONLY) 00052 RR* 00053 RR* WORD 1 EQUIPMENT TYPE CODE 00054 RR* WORD 2 MSB OF MAX SECTOR NO 00055 RR* WORD 3 LSB OF MAX SECTOR NO 00056 RR* 00057 RR* 00058 RR* MESSAGES 00059 RR* 00060 RR* 46 EQUIPMENT TYPE CANNOT BE FOUND 00061 RR* 74 CLASS CODE NOT A DISK 00062 RR* 00063 RR* 00064 RR* ENTRY POINT 00065 RR* 00066 RR ENT MMSIZ 00067 RR* 00068 RR* EXTERNALS 00069 RR* 00070 RR EXT SYSMSG 00071 RR* 00072 RR* EQUIVALENCES 00073 RR* 00074 RR EQU LPMASK(2) 00075 RR EQU LOG1A(28) ADDRESS POSITION IN ADRECT 00076 RR EQU ADRECT($E9) ADDRESS OF EXTENDED CORE TABLE 00077 RR EQU EREQST(8) PDT LOCATION OF REQUEST STATUS 00078 RR EQU NOTDSK(74) SYSMSG ERROR NUMBER 00079 RR EQU NRWHD(49) PDT LOCATION OF # OF RW HEADS(TRKS/CYL) 00080 RR EQU NSECT(71) PDT LOCATION OF # OF SECTORS/TRACK 00081 RR EQU NWPS(70) PDT LOCATION OF # OF WORDS/SECTOR 00082 RR EQU ZERO($22) 00083 RR* 00084 RR**** 00085 RRMMSIZ NOP 00086 RR STQ* QSAVE SAVE Q AND I REGISTER 00087 RR LDA- I 00088 RR STA* ISAVE 00089 RR* 00090 RR LDA* (MMSIZ) PICK UP PARAMETERS 00091 RR STA* LU 00092 RR RAO* MMSIZ 00093 RR LDA* (MMSIZ) 00094 RR STA* SECTM 00095 RR RAO* MMSIZ 00096 RR LDA* (MMSIZ) 00097 RR STA* SECTL 00098 RR RAO* MMSIZ 00099 RR LDA* (MMSIZ) 00100 RR STA* WPS 00101 RR RAO* MMSIZ 00102 RR LDA* (MMSIZ) 00103 RR STA* SECTRK 00104 RR RAO* MMSIZ 00105 RR* 00106 RR* DETERMINE EQUIPMENT TYPE 00107 RR* 00108 RR ENQ LOG1A 00109 RR LDQ- (ADRECT),Q 00110 RR ADQ (LU) 00111 RR LDA- (ZERO),Q GET PDT LOCATION FOR ASSOCIATED LU 00112 RR STA- I SAVE PDT IN I 00113 RR LDA- EREQST,I GET REQUEST STATUS 00114 RR ARS 11 00115 RR AND- LPMASK+3 $0007 00116 RR SUB =N2 CHECK CLASS CODE FOR DISK 00117 RR SAZ OK 00118 RR ENA NOTDSK CLASS CODE IS NOT A DISK 00119 RR JMP* ENDTB1 REPORT ERROR 00120 RROK LDA- EREQST,I GET REQUEST STATUS 00121 RR ARS 4 00122 RR AND- LPMASK+7 $007F 00123 RR STA* EQTYP SAVE EQUIPMENT TYPE 00124 RR* 00125 RR* S M D PICK UP PARAMETERS FROM PDT 00126 RR* 00127 RR LDA- NRWHD,I 00128 RR STA* TRKCYL TRACKS PER CYLINDER 00129 RR LDA- NSECT,I 00130 RR STA* (SECTRK) SECTORS PER TRACK 00131 RR LDA- NWPS,I 00132 RR STA (WPS) WORDS PER SECTOR 00133 RR LDQ =XSMDTB SEARCH FOR EQUIPMENT TYPE CODE TO GET 00134 RRSLOOP LDA- (ZERO),Q CORRECT CYLINDERS PER DEVICE 00135 RR SAP T2 00136 RR JMP* ENDTAB EQUIPMENT TYPE NOT FOUND 00137 RR* 00138 RRT2 SUB* EQTYP 00139 RR SAZ GOTIT SKIP IF FOUND 00140 RR INQ 2 00141 RR JMP* SLOOP 00142 RR* 00143 RR* EQUIPMENT CODE FOUND, GET CYLINDERS / DEVICE 00144 RR* 00145 RRGOTIT INQ 1 00146 RR LDA- (ZERO),Q 00147 RR STA* CYLDEV 00148 RR* 00149 RR* COMPUTE MAX SECTOR 00150 RR* 00151 RR* MAX SECTOR = CYLDEV * TRKCYL * SECTRK - 2 * SECTRK 00152 RR* 00153 RRS SOV 0 CLEAR OVERFLOW FLAG 00154 RR LDA* CYLDEV 00155 RR MUI* TRKCYL 00156 RR MUI* (SECTRK) 00157 RR SNO 1 SKIP IF NO OVERFLOW 00158 RR STA- 1 FATAL ERROR - FORCE PROTECT VIOLATION 00159 RR LLS 1 CONVERT TO MSB/LSB FORMAT 00160 RR ALS 15 00161 RR SUB* (SECTRK) ADJUST FOR LAST TWO TRACKS NOT AVAILABLE 00162 RR SUB* (SECTRK) 00163 RR INA -1 ADJUST TO SECTOR ADDRESS FROM # SECTORS 00164 RR SAP GOON ADJUST FOR LSB FORMAT 00165 RR AND =N$7FFF 00166 RR INQ -1 00167 RRGOON STA* (SECTL) STORE LSB 00168 RR STQ* (SECTM) STORE MSB 00169 RR JMP* EXIT 00170 RRENDTAB LDA* ERNUM 00171 RRENDTB1 STA* INDEX 00172 RR* 00173 RR* 00174 RR* DISPLAY ERROR MSG 00175 RR* 00176 RR RTJ SYSMSG 00177 RR ADC INDEX 00178 RR ADC ERBUF 00179 RR* 00180 RREXIT LDQ* QSAVE RESTORE Q AND I REGISTER 00181 RR LDA* ISAVE 00182 RR STA- I 00183 RR JMP* (MMSIZ) RETURN 00184 RR* 00185 RR* LOCAL VARIABLES 00186 RR* 00187 RRLU NUM 0 ADDRESS OF LOGICAL UNIT 00188 RRWPS NUM 0 ADDRESS OF WORDS/SECTOR PARAMETER 00189 RRTRKCYL NUM 0 TRACKS PER CYLINDER 00190 RRSECTRK NUM 0 SECTORS PER TRACK 00191 RRCYLDEV NUM 0 CYLINDERS PER DEVICE 00192 RRQSAVE NUM 0 00193 RRISAVE NUM 0 00194 RRINDEX NUM 0 00195 RRERBUF NUM 0 00196 RRERNUM NUM 46 00197 RRSECTM NUM 0 00198 RRSECTL NUM 0 00199 RREQTYP NUM 0 00200 RR* 00201 RR* SMDTB TABLE 00202 RR* WORD 1 = EQUIPMENT TYPE CODE 00203 RR* WORD 2 = # OF CYLINDERS PER DEVICE 00204 RR* 00205 RRSMDTB NUM 69 1833-1/1867-10 00206 RR NUM 411 00207 RR NUM 70 1833-1/1867-20 00208 RR NUM 823 00209 RR NUM -1 00210 RR END 00211 RR NAM GETVIT B11 A ITOS CCS 3.0 SL-149B1100001 RR* GET VIT FOR SPECIFIED VOLUME B1100002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B1100003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B1100004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B1100005 RR* B1100006 RR**** B1100007 RR* B1100008 RR* FUNCTION B1100009 RR* B1100010 RR* THIS ROUTINE GETS THE CONTENTS OF THE VIT SPECIFIED BY MMUNIT B1100011 RR* AND MOVES IT TO A TABLE POINTED TO BY OUTP B1100012 RR* B1100013 RR* CALLING SEQUENCE B1100014 RR* B1100015 RR* CALL GETVIT(MMUNIT,OUTP) B1100016 RR* B1100017 RR* PARAMETERS B1100018 RR* B1100019 RR* MMUNIT MASS MEMORY LOGICAL UNIT NO B1100020 RR* B1100021 RR* OUTP TABLE ADDR TO READ IN THE SPECIFIED VIT B1100022 RR* B1100023 RR* B1100024 RR* ENTRY POINT B1100025 RR* B1100026 RR ENT GETVIT B1100027 RR* B1100028 RR* EXTERNALS B1100029 RR* B1100030 RR EXT MMLUTB B1100031 RR* B1100032 RR* EQUIVALENCES B1100033 RR* B1100034 RR EQU ZERO($22) B1100035 RR* B1100036 RR* START OF GETVIT B1100037 RR* B1100038 RR**** B1100039 RRGETVIT NOP B1100040 RR STQ* QSAVE SAVE Q REGISTER B1100041 RR LDA- I B1100042 RR STA* ISAVE SAVE I REGISTER B1100043 RR* B1100044 RR LDA* (GETVIT) PICK-UP PARAMETERS B1100045 RR STA* MMUNIT B1100046 RR RAO* GETVIT B1100047 RR LDA* (GETVIT) B1100048 RR STA* OUTP B1100049 RR RAO* GETVIT B1100050 RR* B1100051 RR LDQ =XMMLUTB B1100052 RR ADQ* (MMUNIT) B1100053 RR INQ 1 PASS UNIT 0,SYSTEM DISK B1100054 RR LDQ- (ZERO),Q VIT-ADDR IN Q B1100055 RR ENA 0 SET POINTER TO 0 B1100056 RR STA- I B1100057 RR* B1100058 RRLOOP LDA- (ZERO),Q TRANSFER VIT CONTENTS TO OUTP B1100059 RR STA* (OUTP),I B1100060 RR* B1100061 RR RAO- I INCREMENT POINTER B1100062 RR LDA- I CHECK IF ALL DONE B1100063 RR INA -21 END OF VIT REACHED B1100064 RR SAZ ENDVIT YES B1100065 RR INQ 1 NO CONTINUE B1100066 RR JMP* LOOP B1100067 RR* B1100068 RRENDVIT LDQ* QSAVE RESTORE REGISTERS B1100069 RR LDA* ISAVE B1100070 RR STA- I B1100071 RR JMP* (GETVIT) RETURN B1100072 RR* B1100073 RR* LOCAL VARIABLES B1100074 RR* B1100075 RRMMUNIT NUM 0 B1100076 RROUTP NUM 0 B1100077 RRQSAVE NUM 0 B1100078 RRISAVE NUM 0 B1100079 RR END B1100080 RR NAM UTSTRT B12 A ITOS CCS 3.0 SL-149B1200001 RR* OVERLAY AREA FOR FILE MANAGER UTILITY PROCESSORS. B1200002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B1200003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B1200004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B1200005 RR* B1200006 RR* B1200007 RR* OVERLAY AREA FOR FILE-MANAGER UTILITY COMMAND PROCESSOR B1200008 RR* B1200009 RR ENT UTSTRT B1200010 RR* B1200011 RR* OVERLAY AREA = ENDING ADDRESS OF BIGGEST OVERLAY + 1 - ADDRESS B1200012 RR* OF UTSTRT B1200013 RR* $2974 = $AFF0 - $867C (12-04-79) B1200014 RR BSS UTSTRT($2974) B1200015 RR END B1200016 RR NAM GTINIT B13 A ITOS CCS 3.0 SL-149B1300001 RR* START ROUTINE FOR COMMAND PROCESSOR INIT B1300002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B1300003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B1300004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B1300005 RR* B1300006 RR* B1300007 RR* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B1300008 RR* AN ENTRY POINT FOR THE COMMAND PROCESSOR INIT B1300009 RR* IN OREDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B1300010 RR* B1300011 RR* B1300012 RR* B1300013 RR* LABELED COMMON AREA B1300014 RR* B1300015 RR DAT COMCOD(89),PARNAM(83) 122*4875B1300016 RR DAT PPHELP(2) B1300017 RR DAT PPINIT(4) B1300018 RR DAT PPDEFI(16) B1300019 RR DAT PPSTAT(4) B1300020 RR DAT PPRELO(5) 122*4875B1300021 RR DAT PPDUMP(5) 122*4875B1300022 RR DAT PPCOPY(6) B1300023 RR DAT PPDELE(3) B1300024 RR DAT PPCLEA(3) B1300025 RR DAT PPLIST(6) 122*4875B1300026 RR DAT PPRENA(5) B1300027 RR DAT PPCOMM(2) B1300028 RR DAT PPEXIT(1) B1300029 RR DAT PPMOUN(3) B1300030 RR DAT PPDISM(2) B1300031 RR DAT PPSAVE(3) B1300032 RR DAT PPBATC(7) 122*4875B1300033 RR DAT PPLOAD(5) B1300034 RR DAT PPPURG(3) B1300035 RR DAT PPINPU(2) B1300036 RR DAT PPOUTP(2) B1300037 RR DAT PPCOMP(3) B1300038 RR DAT DUMMY(6) B1300039 RR DAT INBUF(41),CODE(20) B1300040 RR DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B1300041 RR DAT REQBUF(24),IDATA(24) B1300042 RR DAT PARDEF(24) B1300043 RR DAT FCBHDR(5) B1300044 RR DAT FCBBUF(96) B1300045 RR EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B1300046 RR EQU COMLEN(ENDCOM-COMCOD) B1300047 RR* B1300048 RR ENT MARKER B1300049 RR ENT UTSTRT B1300050 RR* B1300051 RR EXT INIT B1300052 RR* B1300053 RRMARKER NOP 0 B1300054 RR RTJ INIT B1300055 RR JMP* (MARKER) B1300056 RR* B1300057 RR EQU UTSTRT(MARKER) B1300058 RR* B1300059 RR END B1300060 RR NAM GETDEF B14 A ITOS CCS 3.0 SL-149B1400001 RR* START ROUTINE FOR COMMAND PROCESSOR DEFINE B1400002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B1400003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B1400004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B1400005 RR* B1400006 RR* B1400007 RR* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B1400008 RR* AN ENTRY POINT FOR THE COMMAND PROCESSOR DEFINE B1400009 RR* IN OREDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B1400010 RR* B1400011 RR* B1400012 RR* B1400013 RR* LABELED COMMON AREA B1400014 RR* B1400015 RR DAT COMCOD(89),PARNAM(83) 122*4875B1400016 RR DAT PPHELP(2) B1400017 RR DAT PPINIT(4) B1400018 RR DAT PPDEFI(16) B1400019 RR DAT PPSTAT(4) B1400020 RR DAT PPRELO(5) 122*4875B1400021 RR DAT PPDUMP(5) 122*4875B1400022 RR DAT PPCOPY(6) B1400023 RR DAT PPDELE(3) B1400024 RR DAT PPCLEA(3) B1400025 RR DAT PPLIST(6) 122*4875B1400026 RR DAT PPRENA(5) B1400027 RR DAT PPCOMM(2) B1400028 RR DAT PPEXIT(1) B1400029 RR DAT PPMOUN(3) B1400030 RR DAT PPDISM(2) B1400031 RR DAT PPSAVE(3) B1400032 RR DAT PPBATC(7) 122*4875B1400033 RR DAT PPLOAD(5) B1400034 RR DAT PPPURG(3) B1400035 RR DAT PPINPU(2) B1400036 RR DAT PPOUTP(2) B1400037 RR DAT PPCOMP(3) B1400038 RR DAT DUMMY(6) B1400039 RR DAT INBUF(41),CODE(20) B1400040 RR DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B1400041 RR DAT REQBUF(24),IDATA(24) B1400042 RR DAT PARDEF(24) B1400043 RR DAT FCBHDR(5) B1400044 RR DAT FCBBUF(96) B1400045 RR EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B1400046 RR EQU COMLEN(ENDCOM-COMCOD) B1400047 RR* B1400048 RR ENT MARKER B1400049 RR ENT UTSTRT B1400050 RR* B1400051 RR EXT DEFINE B1400052 RR* B1400053 RRMARKER NOP 0 B1400054 RR RTJ DEFINE B1400055 RR JMP* (MARKER) B1400056 RR* B1400057 RR EQU UTSTRT(MARKER) B1400058 RR* B1400059 RR END B1400060 RR NAM GTSTAT B15 A ITOS CCS 3.0 SL-149B1500001 RR* START ROUTINE FOR COMMAND PROCESSOR STATUS B1500002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B1500003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B1500004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B1500005 RR* B1500006 RR* B1500007 RR* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B1500008 RR* AN ENTRY POINT FOR THE COMMAND PROCESSOR STATUS B1500009 RR* IN OREDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B1500010 RR* B1500011 RR* B1500012 RR* B1500013 RR* LABELED COMMON AREA B1500014 RR* B1500015 RR DAT COMCOD(89),PARNAM(83) 122*4875B1500016 RR DAT PPHELP(2) B1500017 RR DAT PPINIT(4) B1500018 RR DAT PPDEFI(16) B1500019 RR DAT PPSTAT(4) B1500020 RR DAT PPRELO(5) 122*4875B1500021 RR DAT PPDUMP(5) 122*4875B1500022 RR DAT PPCOPY(6) B1500023 RR DAT PPDELE(3) B1500024 RR DAT PPCLEA(3) B1500025 RR DAT PPLIST(6) 122*4875B1500026 RR DAT PPRENA(5) B1500027 RR DAT PPCOMM(2) B1500028 RR DAT PPEXIT(1) B1500029 RR DAT PPMOUN(3) B1500030 RR DAT PPDISM(2) B1500031 RR DAT PPSAVE(3) B1500032 RR DAT PPBATC(7) 122*4875B1500033 RR DAT PPLOAD(5) B1500034 RR DAT PPPURG(3) B1500035 RR DAT PPINPU(2) B1500036 RR DAT PPOUTP(2) B1500037 RR DAT PPCOMP(3) B1500038 RR DAT DUMMY(6) B1500039 RR DAT INBUF(41),CODE(20) B1500040 RR DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B1500041 RR DAT REQBUF(24),IDATA(24) B1500042 RR DAT PARDEF(24) B1500043 RR DAT FCBHDR(5) B1500044 RR DAT FCBBUF(96) B1500045 RR EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B1500046 RR EQU COMLEN(ENDCOM-COMCOD) B1500047 RR* B1500048 RR ENT MARKER B1500049 RR ENT UTSTRT B1500050 RR* B1500051 RR EXT STATUS B1500052 RR* B1500053 RRMARKER NOP 0 B1500054 RR RTJ STATUS B1500055 RR JMP* (MARKER) B1500056 RR* B1500057 RR EQU UTSTRT(MARKER) B1500058 RR* B1500059 RR END B1500060 RR NAM GTDUMP B16 A ITOS CCS 3.0 SL-149B1600001 RR* START ROUTINE FOR COMMAND PROCESSOR DUMP B1600002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B1600003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B1600004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B1600005 RR* B1600006 RR* B1600007 RR* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B1600008 RR* AN ENTRY POINT FOR THE COMMAND PROCESSOR DUMP B1600009 RR* IN ORDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B1600010 RR* B1600011 RR* B1600012 RR* B1600013 RR* LABELED COMMON AREA B1600014 RR* B1600015 RR DAT COMCOD(89),PARNAM(83) 122*4875B1600016 RR DAT PPHELP(2) B1600017 RR DAT PPINIT(4) B1600018 RR DAT PPDEFI(16) B1600019 RR DAT PPSTAT(3) B1600020 RR DAT PPRELO(5) 122*4875B1600021 RR DAT PPDUMP(5) 122*4875B1600022 RR DAT PPCOPY(5) B1600023 RR DAT PPDELE(3) B1600024 RR DAT PPCLEA(3) B1600025 RR DAT PPLIST(6) 122*4875B1600026 RR DAT PPRENA(5) B1600027 RR DAT PPCOMM(2) B1600028 RR DAT PPEXIT(1) B1600029 RR DAT PPMOUN(3) B1600030 RR DAT PPDISM(2) B1600031 RR DAT PPSAVE(3) B1600032 RR DAT PPBATC(7) 122*4875B1600033 RR DAT PPLOAD(5) B1600034 RR DAT PPPURG(3) B1600035 RR DAT PPINPU(2) B1600036 RR DAT PPOUTP(2) B1600037 RR DAT PPCOMP(3) B1600038 RR DAT DUMMY(6) B1600039 RR DAT INBUF(41),CODE(20) B1600040 RR DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B1600041 RR DAT REQBUF(24),IDATA(24) B1600042 RR DAT PARDEF(24) B1600043 RR DAT FCBHDR(5) B1600044 RR DAT FCBBUF(96) B1600045 RR EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B1600046 RR EQU COMLEN(ENDCOM-COMCOD) B1600047 RR* B1600048 RR ENT MARKER B1600049 RR ENT UTSTRT B1600050 RR* B1600051 RR EXT DMPFIL B1600052 RR* B1600053 RRMARKER NOP 0 B1600054 RR RTJ DMPFIL B1600055 RR JMP* (MARKER) B1600056 RR* B1600057 RR EQU UTSTRT(MARKER) B1600058 RR* B1600059 RR END B1600060 RR NAM GTCOPY B17 A ITOS CCS 3.0 SL-149B1700001 RR* START ROUTINE FOR COMMAND PROCESSOR COPY B1700002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B1700003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B1700004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B1700005 RR* B1700006 RR* B1700007 RR* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B1700008 RR* AN ENTRY POINT FOR THE COMMAND PROCESSOR COPY B1700009 RR* IN OREDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B1700010 RR* B1700011 RR* B1700012 RR* B1700013 RR* LABELED COMMON AREA B1700014 RR* B1700015 RR DAT COMCOD(89),PARNAM(83) 122*4875B1700016 RR DAT PPHELP(2) B1700017 RR DAT PPINIT(4) B1700018 RR DAT PPDEFI(16) B1700019 RR DAT PPSTAT(4) B1700020 RR DAT PPRELO(5) 122*4875B1700021 RR DAT PPDUMP(5) 122*4875B1700022 RR DAT PPCOPY(6) B1700023 RR DAT PPDELE(3) B1700024 RR DAT PPCLEA(3) B1700025 RR DAT PPLIST(6) 122*4875B1700026 RR DAT PPRENA(5) B1700027 RR DAT PPCOMM(2) B1700028 RR DAT PPEXIT(1) B1700029 RR DAT PPMOUN(3) B1700030 RR DAT PPDISM(2) B1700031 RR DAT PPSAVE(3) B1700032 RR DAT PPBATC(7) 122*4875B1700033 RR DAT PPLOAD(5) B1700034 RR DAT PPPURG(3) B1700035 RR DAT PPINPU(2) B1700036 RR DAT PPOUTP(2) B1700037 RR DAT PPCOMP(3) B1700038 RR DAT DUMMY(6) B1700039 RR DAT INBUF(41),CODE(20) B1700040 RR DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B1700041 RR DAT REQBUF(24),IDATA(24) B1700042 RR DAT PARDEF(24) B1700043 RR DAT FCBHDR(5) B1700044 RR DAT FCBBUF(96) B1700045 RR EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B1700046 RR EQU COMLEN(ENDCOM-COMCOD) B1700047 RR* B1700048 RR ENT MARKER B1700049 RR ENT UTSTRT B1700050 RR* B1700051 RR EXT COPY B1700052 RR* B1700053 RRMARKER NOP 0 B1700054 RR RTJ COPY B1700055 RR JMP* (MARKER) B1700056 RR* B1700057 RR EQU UTSTRT(MARKER) B1700058 RR* B1700059 RR END B1700060 RR NAM GETDEL B18 A ITOS CCS 3.0 SL-149B1800001 RR* START ROUTINE FOR COMMAND PROCESSOR DELETE B1800002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B1800003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B1800004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B1800005 RR* B1800006 RR* B1800007 RR* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B1800008 RR* AN ENTRY POINT FOR THE COMMAND PROCESSOR DELETE B1800009 RR* IN OREDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B1800010 RR* B1800011 RR* B1800012 RR* B1800013 RR* LABELED COMMON AREA B1800014 RR* B1800015 RR DAT COMCOD(89),PARNAM(83) 122*4875B1800016 RR DAT PPHELP(2) B1800017 RR DAT PPINIT(4) B1800018 RR DAT PPDEFI(16) B1800019 RR DAT PPSTAT(4) B1800020 RR DAT PPRELO(5) 122*4875B1800021 RR DAT PPDUMP(5) 122*4875B1800022 RR DAT PPCOPY(6) B1800023 RR DAT PPDELE(3) B1800024 RR DAT PPCLEA(3) B1800025 RR DAT PPLIST(6) 122*4875B1800026 RR DAT PPRENA(5) B1800027 RR DAT PPCOMM(2) B1800028 RR DAT PPEXIT(1) B1800029 RR DAT PPMOUN(3) B1800030 RR DAT PPDISM(2) B1800031 RR DAT PPSAVE(3) B1800032 RR DAT PPBATC(7) 122*4875B1800033 RR DAT PPLOAD(5) B1800034 RR DAT PPPURG(3) B1800035 RR DAT PPINPU(2) B1800036 RR DAT PPOUTP(2) B1800037 RR DAT PPCOMP(3) B1800038 RR DAT DUMMY(6) B1800039 RR DAT INBUF(41),CODE(20) B1800040 RR DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B1800041 RR DAT REQBUF(24),IDATA(24) B1800042 RR DAT PARDEF(24) B1800043 RR DAT FCBHDR(5) B1800044 RR DAT FCBBUF(96) B1800045 RR EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B1800046 RR EQU COMLEN(ENDCOM-COMCOD) B1800047 RR* B1800048 RR ENT MARKER B1800049 RR ENT UTSTRT B1800050 RR* B1800051 RR EXT DELET B1800052 RR* B1800053 RRMARKER NOP 0 B1800054 RR RTJ DELET B1800055 RR JMP* (MARKER) B1800056 RR* B1800057 RR EQU UTSTRT(MARKER) B1800058 RR* B1800059 RR END B1800060 RR NAM GTCLEA B19 A ITOS CCS 3.0 SL-149B1900001 RR* START ROUTINE FOR COMMAND PROCESSOR CLEAR B1900002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B1900003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B1900004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B1900005 RR* B1900006 RR* B1900007 RR* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B1900008 RR* AN ENTRY POINT FOR THE COMMAND PROCESSOR CLEAR B1900009 RR* IN OREDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B1900010 RR* B1900011 RR* B1900012 RR* B1900013 RR* LABELED COMMON AREA B1900014 RR* B1900015 RR DAT COMCOD(89),PARNAM(83) 122*4875B1900016 RR DAT PPHELP(2) B1900017 RR DAT PPINIT(4) B1900018 RR DAT PPDEFI(16) B1900019 RR DAT PPSTAT(3) B1900020 RR DAT PPRELO(5) 122*4875B1900021 RR DAT PPDUMP(5) 122*4875B1900022 RR DAT PPCOPY(5) B1900023 RR DAT PPDELE(3) B1900024 RR DAT PPCLEA(3) B1900025 RR DAT PPLIST(6) 122*4875B1900026 RR DAT PPRENA(5) B1900027 RR DAT PPCOMM(2) B1900028 RR DAT PPEXIT(1) B1900029 RR DAT PPMOUN(3) B1900030 RR DAT PPDISM(2) B1900031 RR DAT PPSAVE(3) B1900032 RR DAT PPBATC(7) 122*4875B1900033 RR DAT PPLOAD(5) B1900034 RR DAT PPPURG(3) B1900035 RR DAT PPINPU(2) B1900036 RR DAT PPOUTP(2) B1900037 RR DAT PPCOMP(3) B1900038 RR DAT DUMMY(6) B1900039 RR DAT INBUF(41),CODE(20) B1900040 RR DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B1900041 RR DAT REQBUF(24),IDATA(24) B1900042 RR DAT PARDEF(24) B1900043 RR DAT FCBHDR(5) B1900044 RR DAT FCBBUF(96) B1900045 RR EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B1900046 RR EQU COMLEN(ENDCOM-COMCOD) B1900047 RR* B1900048 RR ENT MARKER B1900049 RR ENT UTSTRT B1900050 RR* B1900051 RR EXT CLEER B1900052 RR* B1900053 RRMARKER NOP 0 B1900054 RR RTJ CLEER B1900055 RR JMP* (MARKER) B1900056 RR* B1900057 RR EQU UTSTRT(MARKER) B1900058 RR* B1900059 RR END B1900060 RR NAM GTLIST B20 A ITOS CCS 3.0 SL-149B2000001 RR* START ROUTINE FOR COMMAND PROCESSOR LIST B2000002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B2000003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B2000004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B2000005 RR* B2000006 RR* B2000007 RR* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B2000008 RR* AN ENTRY POINT FOR THE COMMAND PROCESSOR LIST B2000009 RR* IN OREDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B2000010 RR* B2000011 RR* B2000012 RR* B2000013 RR* LABELED COMMON AREA B2000014 RR* B2000015 RR DAT COMCOD(89),PARNAM(83) 122*4875B2000016 RR DAT PPHELP(2) B2000017 RR DAT PPINIT(4) B2000018 RR DAT PPDEFI(16) B2000019 RR DAT PPSTAT(4) B2000020 RR DAT PPRELO(5) 122*4875B2000021 RR DAT PPDUMP(5) 122*4875B2000022 RR DAT PPCOPY(6) B2000023 RR DAT PPDELE(3) B2000024 RR DAT PPCLEA(3) B2000025 RR DAT PPLIST(6) 122*4875B2000026 RR DAT PPRENA(5) B2000027 RR DAT PPCOMM(2) B2000028 RR DAT PPEXIT(1) B2000029 RR DAT PPMOUN(3) B2000030 RR DAT PPDISM(2) B2000031 RR DAT PPSAVE(3) B2000032 RR DAT PPBATC(7) 122*4875B2000033 RR DAT PPLOAD(5) B2000034 RR DAT PPPURG(3) B2000035 RR DAT PPINPU(2) B2000036 RR DAT PPOUTP(2) B2000037 RR DAT PPCOMP(3) B2000038 RR DAT DUMMY(6) B2000039 RR DAT INBUF(41),CODE(20) B2000040 RR DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B2000041 RR DAT REQBUF(24),IDATA(24) B2000042 RR DAT PARDEF(24) B2000043 RR DAT FCBHDR(5) B2000044 RR DAT FCBBUF(96) B2000045 RR EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B2000046 RR EQU COMLEN(ENDCOM-COMCOD) B2000047 RR* B2000048 RR ENT MARKER B2000049 RR ENT UTSTRT B2000050 RR* B2000051 RR EXT LIST B2000052 RR* B2000053 RRMARKER NOP 0 B2000054 RR RTJ LIST B2000055 RR JMP* (MARKER) B2000056 RR* B2000057 RR EQU UTSTRT(MARKER) B2000058 RR* B2000059 RR END B2000060 RR NAM ASCEBC B21 A ITOS CCS 3.0 SL-149B2100001 RR* ASCII-EBCDIC/EBCDIC-ASCII CONVERSION ROUTINE B2100002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4873B2100003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B2100004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B2100005 RR* B2100006 RR**** 122*4873B2100007 RR* 122*4873B2100008 RR* FUNCTION 122*4873B2100009 RR* 122*4873B2100010 RR* B2100011 RR* THIS ROUTINE CONVERTS A SPECIFIED BUFFER FROM ASCII TO EBCDIC B2100012 RR* OR FROM EBCDIC TO ASCII ACCORDING TO A SWITCH(ASEBSW) B2100013 RR* IF ASEBSW=0 ASCII-EBCDIC B2100014 RR* =1 EBCDIC-ASCII B2100015 RR* B2100016 RR* CALLING SEQUENCE B2100017 RR* B2100018 RR* CALL ASCEBC (OUTBUF,ASEBSW,BUFLEN) B2100019 RR* B2100020 RR* PARAMETERS B2100021 RR* B2100022 RR* OUTBUF BUFFER TO BE CONVERTED B2100023 RR* ASEBSW SWITCH TO INDICATE WHICH CONVERSION B2100024 RR* BUFLEN LENGTH OF BUFFER B2100025 RR* B2100026 RR* EQUATES B2100027 RR* B2100028 RR EQU MASK($1A) B2100029 RR EQU MASK1($A) B2100030 RR* B2100031 RR ENT ASCEBC B2100032 RR* B2100033 RR**** 122*4873B2100034 RRASCEBC NOP B2100035 RR LDA* (ASCEBC) PICK UP PARAMET+RS B2100036 RR STA* OUTBUF B2100037 RR RAO* ASCEBC B2100038 RR LDA* (ASCEBC) B2100039 RR STA* ASEBSW B2100040 RR RAO* ASCEBC B2100041 RR LDA* (ASCEBC) B2100042 RR STA* LENGTH B2100043 RR RAO* ASCEBC B2100044 RR* B2100045 RR LDA* (ASEBSW) GET ASCII-EBCDIC SWITCH B2100046 RR SAZ CON1 B2100047 RR ENQ $40 EBCDIC-ASCII B2100048 RR LDA- MASK B2100049 RR SAN CON2 B2100050 RRCON1 ENQ $20 ASCII-EBCDIC B2100051 RR LDA- MASK1 B2100052 RRCON2 STQ* ASEBCO STORE IN ASCII-EBCDIC CONSTANT B2100053 RR STA* ASEBMS B2100054 RR LDA* (LENGTH) B2100055 RR INA -1 B2100056 RR STA* CONTER B2100057 RRCONVLP LDQ* CONTER B2100058 RR LDA* (OUTBUF),Q B2100059 RR STA* CHAR GET CHAR TO BE CONVERTED B2100060 RR AND- MASK1 B2100061 RR RTJ* CONLOP B2100062 RR STA* CHAR+1 B2100063 RR LDA* CHAR B2100064 RR AND- MASK B2100065 RR ALS 8 B2100066 RR RTJ* CONLOP B2100067 RR STA* CHAR B2100068 RR LDQ* (ASEBSW) B2100069 RR SQN 1 B2100070 RR ALS 8 B2100071 RR STA* CHAR B2100072 RR LDA* CHAR+1 B2100073 RR SQZ 1 B2100074 RR ALS 8 B2100075 RR EOR* CHAR B2100076 RR LDQ* CONTER B2100077 RR STA* (OUTBUF),Q B2100078 RR INQ -1 B2100079 RR STQ* CONTER B2100080 RR SQM 1 B2100081 RR JMP* CONVLP B2100082 RR JMP* (ASCEBC) B2100083 RR* B2100084 RRCONLOP NOP 0 CONVERSION LOOP B2100085 RR SUB* ASEBCO B2100086 RR SAP 1 B2100087 RR CLR A B2100088 RR TRA Q B2100089 RR LDA* TABLE,Q B2100090 RR AND* ASEBMS B2100091 RR JMP* (CONLOP) B2100092 RR* B2100093 RR* LOCAL VARIABLES B2100094 RR* B2100095 RRASEBCO NUM 0 B2100096 RRASEBSW NUM 0 B2100097 RRASEBMS NUM 0 B2100098 RRCHAR NUM 0,0 B2100099 RRCONTER NUM 0 B2100100 RROUTBUF NUM 0 B2100101 RRLENGTH NUM 0 B2100102 RRTABLE NUM $2040,$205A,$207F,$207B,$205B B2100103 RR NUM $206C,$2050,$207D,$204D,$205D B2100104 RR NUM $205C,$2E4E,$3C6B,$2860,$2B4B B2100105 RR NUM $2061,$26F0,$20F1,$20F2,$20F3 B2100106 RR NUM $20F4,$20F5,$20F6,$20F7,$20F8 B2100107 RR NUM $20F9,$217A,$245E,$2A4C,$297E B2100108 RR NUM $3B6E,$206F,$2D7C,$2FC1,$20C2 B2100109 RR NUM $20C3,$20C4,$20C5,$20C6,$20C7 B2100110 RR NUM $20C8,$20C9,$20D1,$2CD2,$25D3 B2100111 RR NUM $5FD4,$3ED5,$3FD6,$20D7,$20D8 B2100112 RR NUM $20D9,$20E2,$20E3,$20E4,$20E5 B2100113 RR NUM $20E6,$20E7,$20E8,$3AE9,$234D B2100114 RR NUM $4040,$275D,$3D40,$226D,$2040 B2100115 RR NUM $6181,$6282,$6383,$6484,$6585 B2100116 RR NUM $6686,$6787,$6888,$6989,$2091 B2100117 RR NUM $2092,$2093,$2094,$2095,$2096 B2100118 RR NUM $2097,$6A98,$6B99,$6CA2,$6DA3 B2100119 RR NUM $6EA4,$6FA5,$70A6,$71A7,$72A8 B2100120 RR NUM $20A9,$2040,$2040,$2040,$2040 B2100121 RR NUM $2040,$2040,$2040 B2100122 RR NUM $7340,$7440,$7540,$7640,$7740 B2100123 RR NUM $7840,$7940,$7A40 B2100124 RR NUM $2040,$2040,$2040,$2040,$2040 B2100125 RR NUM $2040,$2040,$2040,$2040,$2040 B2100126 RR NUM $2040,$2040,$2040,$2040,$2040 B2100127 RR NUM $2040,$2040,$2040,$2040,$2040 B2100128 RR NUM $2040,$2040,$2040,$4140,$4240 B2100129 RR NUM $4340,$4440,$4540,$4640,$4740 B2100130 RR NUM $4840,$4940,$2040,$2040,$2040 B2100131 RR NUM $2040,$2040,$2040,$2040,$4A40 B2100132 RR NUM $4B40,$4C40,$4D40,$4E40,$4F40 B2100133 RR NUM $5040,$5140,$5240,$2040,$2040 B2100134 RR NUM $2040,$2040,$2040,$2040,$2040 B2100135 RR NUM $2040,$5340,$5440,$5540,$5640 B2100136 RR NUM $5740,$5840,$5940,$5A40,$2040 B2100137 RR NUM $2040,$2040,$2040,$2040,$2040 B2100138 RR NUM $3040,$3140,$3240,$3340,$3440 B2100139 RR NUM $3540,$3640,$3740,$3840,$3940 B2100140 RR NUM $2040,$2040,$2040,$2040,$2040,$2040 B2100141 RR END B2100142 RR NAM GTRENA B22 A ITOS CCS 3.0 SL-149B2200001 RR* START ROUTINE FOR COMMAND PROCESSOR RENAME B2200002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B2200003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B2200004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B2200005 RR* B2200006 RR* B2200007 RR* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B2200008 RR* AN ENTRY POINT FOR THE COMMAND PROCESSOR RENAME B2200009 RR* IN OREDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B2200010 RR* B2200011 RR* B2200012 RR* B2200013 RR* LABELED COMMON AREA B2200014 RR* B2200015 RR DAT COMCOD(89),PARNAM(83) 122*4875B2200016 RR DAT PPHELP(2) B2200017 RR DAT PPINIT(4) B2200018 RR DAT PPDEFI(16) B2200019 RR DAT PPSTAT(4) B2200020 RR DAT PPRELO(5) 122*4875B2200021 RR DAT PPDUMP(5) 122*4875B2200022 RR DAT PPCOPY(6) B2200023 RR DAT PPDELE(3) B2200024 RR DAT PPCLEA(3) B2200025 RR DAT PPLIST(6) 122*4875B2200026 RR DAT PPRENA(5) B2200027 RR DAT PPCOMM(2) B2200028 RR DAT PPEXIT(1) B2200029 RR DAT PPMOUN(3) B2200030 RR DAT PPDISM(2) B2200031 RR DAT PPSAVE(3) B2200032 RR DAT PPBATC(7) 122*4875B2200033 RR DAT PPLOAD(5) B2200034 RR DAT PPPURG(3) B2200035 RR DAT PPINPU(2) B2200036 RR DAT PPOUTP(2) B2200037 RR DAT PPCOMP(3) B2200038 RR DAT DUMMY(6) B2200039 RR DAT INBUF(41),CODE(20) B2200040 RR DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B2200041 RR DAT REQBUF(24),IDATA(24) B2200042 RR DAT PARDEF(24) B2200043 RR DAT FCBHDR(5) B2200044 RR DAT FCBBUF(96) B2200045 RR EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B2200046 RR EQU COMLEN(ENDCOM-COMCOD) B2200047 RR* B2200048 RR ENT MARKER B2200049 RR ENT UTSTRT B2200050 RR* B2200051 RR EXT RENAM B2200052 RR* B2200053 RRMARKER NOP 0 B2200054 RR RTJ RENAM B2200055 RR JMP* (MARKER) B2200056 RR* B2200057 RR EQU UTSTRT(MARKER) B2200058 RR* B2200059 RR END B2200060 RR NAM COMAND B23 A ITOS CCS 3.0 SL-149B2300001 RR* COMMAND PROCESSOR FOR COMMAND B2300002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B2300003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B2300004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B2300005 RR* B2300006 RR**** B2300007 RR* B2300008 RR* FUNCTION B2300009 RR* B2300010 RR* THIS FMU-COMMAND PROCESSOR PRINTS A LIST OF ALL POSSIBLE B2300011 RR* FMUTIL COMMANDS ON THE SELECTED OUTPUT DEVICE B2300012 RR* B2300013 RR* B2300014 RR* GENERAL DESCRIPTION B2300015 RR* B2300016 RR* ON ENTRY IT WILL SKIP PAST THE FIRST FIELD OF THE INPUT-BUFFER B2300017 RR* (INBUF). IF THIS FIELD IS TERMINATED ON A COMMA IT WILL DO B2300018 RR* ANOTHER GETFLD AND CHECK IF THIS IS A NON-BLANK FIELD B2300019 RR* IF SO,IT WILL PRINT THE CORRESPONDING PARAMETER LIST OF THE B2300020 RR* COMMAND TOO B2300021 RR* B2300022 RR* B2300023 RR* COMMAND FORMAT B2300024 RR* B2300025 RR* COMMAND B2300026 RR* COMMAND,X B2300027 RR* B2300028 RR* B2300029 RR* ENTRY POINTS B2300030 RR* B2300031 RR ENT COMAND B2300032 RR ENT UTSTRT B2300033 RR* B2300034 RR* B2300035 RR* EXTERNALS B2300036 RR* B2300037 RR EXT WTREAD B2300038 RR EXT PGMOUT B2300039 RR EXT GETFLD B2300040 RR EXT CLRSCR B2300041 RR* B2300042 RR* B2300043 RR* EQUATES B2300044 RR* B2300045 RR EQU ZERO($22) B2300046 RR EQU LPMASK(2) B2300047 RR* B2300048 RR* LABELED COMMON AREA B2300049 RR* B2300050 RR DAT COMCOD(133),PARNAM(124) B2300051 RR DAT PPHELP(2) B2300052 RR DAT PPINIT(4) B2300053 RR DAT PPDEFI(16) B2300054 RR DAT PPSTAT(4) B2300055 RR DAT PPRELO(5) 122*4875B2300056 RR DAT PPDUMP(5) 122*4875B2300057 RR DAT PPCOPY(6) B2300058 RR DAT PPDELE(3) B2300059 RR DAT PPCLEA(3) B2300060 RR DAT PPLIST(6) 122*4875B2300061 RR DAT PPRENA(5) B2300062 RR DAT PPCOMM(2) B2300063 RR DAT PPEXIT(1) B2300064 RR DAT PPMOUN(3) B2300065 RR DAT PPDISM(2) B2300066 RR DAT PPSAVE(3) B2300067 RR DAT PPBATC(8) BATCH B2300068 RR DAT PPLOAD(5) B2300069 RR DAT PPPURG(3) B2300070 RR DAT PPINPU(2) B2300071 RR DAT PPOUTP(2) B2300072 RR DAT PPCOMP(3) B2300073 RR DAT PPHOST(4) HOST B2300074 RR DAT PPSET(3) SET B2300075 RR DAT PPBATS(4) BATCH STATUS B2300076 RR DAT PPDISC(2) DISCARD B2300077 RR DAT PPDISP(7) DISPOSE B2300078 RR DAT PPFLUS(3) FLUSH B2300079 RR DAT PPPRIN(3) PRINT B2300080 RR DAT DUMMY(6) B2300081 RR DAT INBUF(41),CODE(20) B2300082 RR DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B2300083 RR DAT REQBUF(24),IDATA(24) B2300084 RR DAT PARDEF(24) B2300085 RR DAT FCBHDR(5) B2300086 RR DAT FCBBUF(96) B2300087 RR EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B2300088 RR EQU COMLEN(ENDCOM-COMCOD) B2300089 RR* B2300090 RR**** B2300091 RR EJT B2300092 RR* B2300093 RR* START OF THE LIST PROCESSOR B2300094 RR* B2300095 RRCOMAND NOP B2300096 RR ENA 0 B2300097 RR STA SWORD B2300098 RR STA SBYTE B2300099 RR* B2300100 RR RTJ GETFLD SKIP PAST FIRST FIELD B2300101 RR ADC INBUF B2300102 RR ADC CODE B2300103 RR ADC SWORD B2300104 RR ADC SBYTE B2300105 RR ADC STATUS B2300106 RR* B2300107 RR LDA STATUS B2300108 RR SAZ NXTFLD THERE IS A NEXT FIELD B2300109 RR JMP* NOLST NO PARAMETER LIST DESIRED B2300110 RR* B2300111 RRNXTFLD RTJ GETFLD SEE IF THERE IS A PARAMETER LIST DESIRED B2300112 RR ADC INBUF ADDRESS OF INPUT BUFFER B2300113 RR ADC CODE ADDRESS OF OUTPUT BUFFER B2300114 RR ADC SWORD START WORD IN INPUT BUFFER B2300115 RR ADC SBYTE START BYTE OF INPUT BUFFER B2300116 RR ADC STATUS STATUS TO RETURN B2300117 RR* B2300118 RR LDA CODE B2300119 RR SUB BLANK CHECK IF BLANK B2300120 RR SAZ NOLST YES,NO PARMMLIST REQUIRED B2300121 RR* B2300122 RR ENA -1 B2300123 RR STA PARMIN SET PARLST REQ. INDICATOR B2300124 RR JMP* LST1 B2300125 RR* B2300126 RRNOLST CLR A NO PARLST REQ B2300127 RR STA PARMIN RESET PARLST REQ. INDICAROR B2300128 RR* B2300129 RRLST1 ENQ 0 B2300130 RRNXTCOM ENA 0 GET NEXT COMMAND B2300131 RR STA- I B2300132 RRNXT LDA COMCOD,Q B2300133 RR SAP STOR B2300134 RR JMP* (COMAND) B2300135 RR* B2300136 RRSTOR STA OUTBUF,I B2300137 RR RAO- I B2300138 RR INQ 1 B2300139 RR LDA- I COMMAND COMPLETE B2300140 RR SUB N3 B2300141 RR SAZ DISPLY YES B2300142 RR JMP* NXT B2300143 RRDISPLY LDA FTSW IS IT FIRST TIME ? B2300144 RR SAN CMDDIS NO,DISPLY COMMAND B2300145 RR RTJ CLRSCR CLEAR THE SCREEN B2300146 RR ADC LUNIT B2300147 RR* B2300148 RR ENA -1 B2300149 RR STA FTSW SET FIRST TIME SWITCH NON-ZERO B2300150 RRCMDDIS LDA COMCOD,Q B2300151 RR STA PPTAB B2300152 RR RAO LINCNT INCREMENT LINE COUNTER B2300153 RR LDA LINCNT CHECK IF SCREEN FULL B2300154 RR SUB =N24 B2300155 RR SAZ PAUSE B2300156 RR* B2300157 RR RTJ WTREAD B2300158 RR ADC LUNIT B2300159 RR ADC NOCUR NO CURSOR POSITIONING REQUESTED B2300160 RR ADC DISBUF B2300161 RR ADC MESLEN B2300162 RR ADC NOCUR NO CURSOR POSITIONING REQUESTED B2300163 RR ADC DUMMY B2300164 RR ADC ZRO B2300165 RR ADC TC B2300166 RR LDA* PARMIN IS PARLST REQUIRED B2300167 RR SAN LST2 YES B2300168 RR INQ 1 B2300169 RR JMP* NXTCOM B2300170 RRLST2 JMP* PRMLST B2300171 RR* B2300172 RRPAUSE RTJ WTREAD B2300173 RR ADC LUNIT B2300174 RR ADC NOCUR B2300175 RR ADC PAUSBF B2300176 RR ADC MSPAUS B2300177 RR ADC NOCUR B2300178 RR ADC DUMMY B2300179 RR ADC N3 B2300180 RR ADC TC B2300181 RR CLR A RESET FIRST TIME SWITCH B2300182 RR STA FTSW B2300183 RR STA* LINCNT RESET LINE COUNTER B2300184 RR JMP* DISPLY B2300185 RRPRMLST STQ* QSAV SAVE Q TEMP B2300186 RR* B2300187 RR LDA* PPTAB GET PPTAB ADDRESS B2300188 RR STA- I B2300189 RRNXTPAR LDA- (ZERO),I IS THERE A PARAMETER LIST B2300190 RR SAN PRM1 YES B2300191 RR JMP* INCR NO B2300192 RRPRM1 LDA* BCOM STORE BLANK COMMA FIRST B2300193 RR LDQ* LSTWRD POINTER IN PARMLST BUFFER B2300194 RR STA* PARBUF,Q B2300195 RR RAO* LSTWRD UPDATE POINTER B2300196 RR LDA- (ZERO),I GET FIRST ENTRY IN PPTAB SPECIFIED B2300197 RR SAZ ENDLST END OF PPTAB B2300198 RR* B2300199 RR AND- LPMASK+8 MASK OUT INDEX B2300200 RR INA -1 CALCULATE INDEX TO PARNAM B2300201 RR MUI* N3 B2300202 RR TRA Q B2300203 RR* B2300204 RR LDA PARNAM,Q GET PARAMETER IDENTIFIER B2300205 RR LDQ* LSTWRD B2300206 RR STA* PARBUF,Q B2300207 RR* B2300208 RR RAO- I B2300209 RR RAO* LSTWRD B2300210 RR LDA- (ZERO),I B2300211 RR SAZ ENDLST END OF PARAMETER LIST B2300212 RR JMP* NXTPAR GET NEXT PARAMETER B2300213 RR* B2300214 RRENDLST RTJ WTREAD DISPLAY PARAMETER LIST B2300215 RR ADC LUNIT B2300216 RR ADC NOCUR B2300217 RR ADC PARBUF B2300218 RR ADC LSTWRD B2300219 RR ADC NOCUR B2300220 RR ADC DUMMY B2300221 RR ADC ZRO B2300222 RR ADC TC B2300223 RR* B2300224 RRINCR LDA- I B2300225 RR INA 1 B2300226 RR STA- I B2300227 RR STA* PPTAB SET READY FOR NEXT PARAMETER MNEMONIC B2300228 RR LDA- (ZERO),I CHECK IF NEXT WORD NON-ZERO B2300229 RR SAN NXTLST THIS WORD IS START OF NXT LIST B2300230 RR JMP* INCR NXT LIST NOT YET REACHED B2300231 RR* B2300232 RRNXTLST CLR A B2300233 RR STA* LSTWRD B2300234 RR LDQ* QSAV B2300235 RR INQ 1 B2300236 RR JMP NXTCOM B2300237 RR* B2300238 RR* LOCAL VARIABLES B2300239 RR* B2300240 RRBCOM ALF 1, , B2300241 RRLSTWRD NUM 0 B2300242 RRQSAV NUM 0 B2300243 RRPARMIN NUM 0 B2300244 RRPARBUF BSS PARBUF(32) B2300245 RRSTATUS NUM 0 B2300246 RR* B2300247 RRDISBUF NUM $0A0D LF/CR B2300248 RR BSS OUTBUF(3) B2300249 RR EQU DISBL(*-DISBUF) B2300250 RRMESLEN ADC DISBL B2300251 RRPAUSBF NUM $0A0D LF/CR B2300252 RR ALF 3,PAUSE B2300253 RR EQU PAUSLN(*-PAUSBF) B2300254 RRMSPAUS ADC PAUSLN B2300255 RRLINCNT NUM 0 LINE COUNTER B2300256 RRN3 NUM 3 B2300257 RRTC NUM 0 B2300258 RRNOCUR NUM -1 B2300259 RRZRO NUM 0 B2300260 RRBLANK ALF 1, B2300261 RRPPTAB ADC PPHELP B2300262 RRFTSW NUM 0 B2300263 RR EQU UTSTRT(COMAND) B2300264 RR* B2300265 RR END B2300266 RR NAM GTMOUN B24 A ITOS CCS 3.0 SL-149B2400001 RR* START ROUTINE FOR COMMAND PROCESSOR MOUNT B2400002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B2400003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B2400004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B2400005 RR* B2400006 RR* B2400007 RR* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B2400008 RR* AN ENTRY POINT FOR THE COMMAND PROCESSOR MOUNT B2400009 RR* IN ORDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B2400010 RR* B2400011 RR* B2400012 RR* B2400013 RR* LABELED COMMON AREA B2400014 RR* B2400015 RR DAT COMCOD(89),PARNAM(83) 122*4875B2400016 RR DAT PPHELP(2) B2400017 RR DAT PPINIT(4) B2400018 RR DAT PPDEFI(16) B2400019 RR DAT PPSTAT(4) B2400020 RR DAT PPRELO(5) 122*4875B2400021 RR DAT PPDUMP(5) 122*4875B2400022 RR DAT PPCOPY(6) B2400023 RR DAT PPDELE(3) B2400024 RR DAT PPCLEA(3) B2400025 RR DAT PPLIST(6) 122*4875B2400026 RR DAT PPRENA(5) B2400027 RR DAT PPCOMM(2) B2400028 RR DAT PPEXIT(1) B2400029 RR DAT PPMOUN(3) B2400030 RR DAT PPDISM(2) B2400031 RR DAT PPSAVE(3) B2400032 RR DAT PPBATC(7) 122*4875B2400033 RR DAT PPLOAD(5) B2400034 RR DAT PPPURG(3) B2400035 RR DAT PPINPU(2) B2400036 RR DAT PPOUTP(2) B2400037 RR DAT PPCOMP(3) B2400038 RR DAT DUMMY(6) B2400039 RR DAT INBUF(41),CODE(20) B2400040 RR DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B2400041 RR DAT REQBUF(24),IDATA(24) B2400042 RR DAT PARDEF(24) B2400043 RR DAT FCBHDR(5) B2400044 RR DAT FCBBUF(96) B2400045 RR EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B2400046 RR EQU COMLEN(ENDCOM-COMCOD) B2400047 RR* B2400048 RR ENT MARKER B2400049 RR ENT UTSTRT B2400050 RR* B2400051 RR EXT MOUNT B2400052 RR* B2400053 RRMARKER NOP 0 B2400054 RR RTJ MOUNT B2400055 RR JMP* (MARKER) B2400056 RR* B2400057 RR EQU UTSTRT(MARKER) B2400058 RR* B2400059 RR END B2400060 RR NAM GTDISM B25 A ITOS CCS 3.0 SL-149B2500001 RR* START ROUTINE FOR COMMAND PROCESSOR DISMOUNT B2500002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B2500003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B2500004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B2500005 RR* B2500006 RR* B2500007 RR* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B2500008 RR* AN ENTRY POINT FOR THE COMMAND PROCESSOR DISMOUNT B2500009 RR* IN OREDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B2500010 RR* B2500011 RR* B2500012 RR* B2500013 RR* LABELED COMMON AREA B2500014 RR* B2500015 RR DAT COMCOD(89),PARNAM(83) 122*4875B2500016 RR DAT PPHELP(2) B2500017 RR DAT PPINIT(4) B2500018 RR DAT PPDEFI(16) B2500019 RR DAT PPSTAT(4) B2500020 RR DAT PPRELO(5) 122*4875B2500021 RR DAT PPDUMP(5) 122*4875B2500022 RR DAT PPCOPY(6) B2500023 RR DAT PPDELE(3) B2500024 RR DAT PPCLEA(3) B2500025 RR DAT PPLIST(6) 122*4875B2500026 RR DAT PPRENA(5) B2500027 RR DAT PPCOMM(2) B2500028 RR DAT PPEXIT(1) B2500029 RR DAT PPMOUN(3) B2500030 RR DAT PPDISM(2) B2500031 RR DAT PPSAVE(3) B2500032 RR DAT PPBATC(7) 122*4875B2500033 RR DAT PPLOAD(5) B2500034 RR DAT PPPURG(3) B2500035 RR DAT PPINPU(2) B2500036 RR DAT PPOUTP(2) B2500037 RR DAT PPCOMP(3) B2500038 RR DAT DUMMY(6) B2500039 RR DAT INBUF(41),CODE(20) B2500040 RR DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B2500041 RR DAT REQBUF(24),IDATA(24) B2500042 RR DAT PARDEF(24) B2500043 RR DAT FCBHDR(5) B2500044 RR DAT FCBBUF(96) B2500045 RR EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B2500046 RR EQU COMLEN(ENDCOM-COMCOD) B2500047 RR* B2500048 RR ENT MARKER B2500049 RR ENT UTSTRT B2500050 RR* B2500051 RR EXT DSMOUN B2500052 RR* B2500053 RRMARKER NOP 0 B2500054 RR RTJ DSMOUN B2500055 RR JMP* (MARKER) B2500056 RR* B2500057 RR EQU UTSTRT(MARKER) B2500058 RR* B2500059 RR END B2500060 RR NAM GTSAVE B26 A ITOS CCS 3.0 SL-149B2600001 RR* START ROUTINE FOR COMMAND PROCESSOR SAVE B2600002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B2600003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B2600004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B2600005 RR* B2600006 RR* B2600007 RR* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B2600008 RR* AN ENTRY POINT FOR THE PROCESSOR SAVE B2600009 RR* IN OREDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B2600010 RR* B2600011 RR* B2600012 RR* B2600013 RR* LABELED COMMON AREA B2600014 RR* B2600015 RR DAT COMCOD(89),PARNAM(83) 122*4875B2600016 RR DAT PPHELP(2) B2600017 RR DAT PPINIT(4) B2600018 RR DAT PPDEFI(16) B2600019 RR DAT PPSTAT(4) B2600020 RR DAT PPRELO(5) 122*4875B2600021 RR DAT PPDUMP(5) 122*4875B2600022 RR DAT PPCOPY(6) B2600023 RR DAT PPDELE(3) B2600024 RR DAT PPCLEA(3) B2600025 RR DAT PPLIST(6) 122*4875B2600026 RR DAT PPRENA(5) B2600027 RR DAT PPCOMM(2) B2600028 RR DAT PPEXIT(1) B2600029 RR DAT PPMOUN(3) B2600030 RR DAT PPDISM(2) B2600031 RR DAT PPSAVE(3) B2600032 RR DAT PPBATC(7) 122*4875B2600033 RR DAT PPLOAD(5) B2600034 RR DAT PPPURG(3) B2600035 RR DAT PPINPU(2) B2600036 RR DAT PPOUTP(2) B2600037 RR DAT PPCOMP(3) B2600038 RR DAT DUMMY(6) B2600039 RR DAT INBUF(41),CODE(20) B2600040 RR DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B2600041 RR DAT REQBUF(24),IDATA(24) B2600042 RR DAT PARDEF(24) B2600043 RR DAT FCBHDR(5) B2600044 RR DAT FCBBUF(96) B2600045 RR EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B2600046 RR EQU COMLEN(ENDCOM-COMCOD) B2600047 RR* B2600048 RR ENT MARKER B2600049 RR ENT UTSTRT B2600050 RR* B2600051 RR EXT SAVE B2600052 RR* B2600053 RRMARKER NOP 0 B2600054 RR RTJ SAVE B2600055 RR JMP* (MARKER) B2600056 RR* B2600057 RR EQU UTSTRT(MARKER) B2600058 RR* B2600059 RR END B2600060 RR NAM MMCOPY B27 A ITOS CCS 3.0 . SL-149 00001 RR* DISK COPY ROUTINE 00002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 00003 RR* DATA SYSTEMS - LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 00005 RR* 00006 RR SPC 1 00007 RR* LOGIC FOR 'MULTIPLE COPY' SAVE REMAINS IN CODE 00008 RR* BUT HAS NOT BEEN IMPLEMENTED. SPECIFICALLY, FLAGS 00009 RR* 'MPCYFG' AND 'TOFMFG'. 00010 RR**** 00011 RR* 00012 RR* FUNCTION 00013 RR* 00014 RR* 00015 RR* THIS ROUTINE COPIES ONE DISK UNIT TO ANOTHER DISK UNIT. 00016 RR* 00017 RR* 00018 RR* EXPLANATION -- 00019 RR* 00020 RR* MMCOPY DETERMINES WHICH ONE OF THE FOUR BELOW LISTED TYPES OF COPY 00021 RR* SCHEMES IS GOING TO BE USED DEPENDING ON THE PARAMETERS IN THE PDT 00022 RR* OF THE LOGICAL UNITS SPECIFIED AND ON THE VOLUME 1 LABEL. THE 4 00023 RR* TYPES ARE: 00024 RR* 00025 RR* 1. SAME SIZE WORDS PER SECTOR ON BOTH PACKS ARE EQUAL. 00026 RR* 2. SMALL TO LARGE WORDS PER SECTOR ON FROM PACK IS SMALLER. 00027 RR* 3. LARGE TO SMALL WORDS PER SECTOR ON FROM PACK IS LARGER. 00028 RR* 4. SMALL TO LARGE(RV) WORDS PER SECTOR ON FROM PACK IS SMALLER 00029 RR* THIS IS THE REVERSE OF SCHEME 3. 00030 RR* 00031 RR* 00032 RR* THE COPY IS PERFORMED OFF-LINE AFTER ALL CHECKS AND PRELIMINARY 00033 RR* PROCESSING HAVE BEEN COMPLETED AND AFTER REQUESTING THAT THE PROTECT 00034 RR* SWITCH BE DISABLED, AND DISABLING THE SYSTEM TIMER, MANUAL INTERRUPT, 00035 RR* MIRRO INTERRUPT, AND DEVICE ERROR LOGGING. THE MASK TABLE IS MODIFI- 00036 RR* ED TO ENSURE THAT NO UNWANTED INTERRUPTS CAN BE SERVICED. 00037 RR* 00038 RR* PART OF THE CODE IS MOVED INTO THE FILE MANAGER PARTITION AND EXECU- 00039 RR* TED FROM THERE. 00040 RR* THE TRANSFER BUFFER IS POSITIONED AT THE BEGINNING OF BACKGROUND 00041 RR* AND PAGING IS TURNED OFF TO ACCOMPLISH THE TRANSFER. 00042 RR* 137*A107 00043 RR* DEPENDING ON THE VALUE OF THE SYSDAT RESIDENT PARAM SAVOPT, 137*A107 00044 RR* A VERIFICATION WIL BE MADE TO ASSURE THAT THE PACK TO PACK 137*A107 00045 RR* TRANSFER IS COMPLETED WITHOUT ERROR (NO DIFFERENCES IN THE 137*A107 00046 RR* DATA ON THE TWO PACKS). THIS VERIFICATION WILL BE MADE IF 137*A107 00047 RR* SAVOPT IS NON-ZERO. THE VERIFICATION WILL BE MADE ON A TRACK137*A107 00048 RR* BY TRACK BASIS - IMMEDIATELY AFTER EACH TRACK IS COPIED. 137*A107 00049 RR* 137*A107 00050 RR* 00051 RR* CALLING SEQUENCE 00052 RR* 00053 RR* CALL MMCOPY (LU1,LU2) 00054 RR* 00055 RR* PARAMETERS 00056 RR* 1 CARD DELETED 137*A107 00057 RR* LU1 DISK-UNIT TO COPY FROM 00058 RR* LU2 DISK-UNIT TO COPY TO 00059 RR EJT 00060 RR* ENTRY POINTS 00061 RR* 00062 RR ENT MMCOPY 00063 RR* 00064 RR* EXTERNALS 00065 RR* 00066 RR EXT Q8PKUP 00067 RR EXT Q8PREP 00068 RR EXT SYSMSG 00069 RR EXT MMSIZ 00070 RR EXT EMPSTP 00071 RR EXT DMICOD 00072 RR EXT TBLADR 00073 RR EXT EFSTOR 00074 RR EXT MIBX 00075 RR EXT JOBIND 00076 RR EXT SWTCH 00077 RR EXT TODAY 00078 RR EXT PARTBL 00079 RR EXT CPSET 00080 RR EXT* VERWPS VERIFY COMPATIBILITY OF SMD LU PARTS. 00081 RR EXT LVERWP LENGTH OF 'VERWPS' SUBROUTINE 00082 RR* 00083 RR* EQUATES 00084 RR* 00085 RR EQU DISP($EA) 00086 RR EQU ZERO($22) 00087 RR EQU ONEMSK(3) 00088 RR EQU LPMASK($2) 00089 RR EQU ZROBIT($33) 00090 RR EQU ONEBIT($23) ONE BIT TABLE 00091 RR EQU MTBADR($B7) ADDRESS OF MASK TABLE 00092 RR EQU ADRECT($E9) ADDRESS OF EXTENDED COMMUNICATION TABLE 00093 RR EQU LOG1A(28) ADDRESS OF LOG1A TABLE (IN EXT COM TABLE) 00094 RR EQU MMLUTB(29) FWA OF FM LOGICAL UNIT TABLE (IN EXT COM TBL) 00095 RR EQU NRWHD(49) DISK # OF RW HEADS IN PDT 00096 RR EQU UNPBGN($F7) LOCATION OF ADDRESS OF BEGINNING OF BACKGROUND 00097 RR************************************************** 00098 RR EQU TERMLU(5) TERMINAL LOGICAL UNIT 00099 RR************************************************** 00100 RR EQU LABMSB(21) LABEL SECTOR MSB 00101 RR EQU LABLSB(22) LABEL SECTOR LSB 00102 RR SPC 3 00103 RR* ERROR CODES 00104 RR EQU NOTDSK(74) CLASS CODE IS NOT OF A DISK 00105 RR EQU IOECOD(35) I/O ERROR CODE 00106 RR EQU NCOMDE(88) NON-COMPATIBLE TYPE DEVICES ERROR CODE 00107 RR EQU TOMUCH(399) TOO MUCH MM SPACE USED ON LARGE DISK 00108 RR EQU JPORLA(398) JOB PROCESSOR OR LIBEDT ACTIVE 00109 RR EJT 00110 RR* VOLUME LABEL EQUIVALENCES 00111 RR EQU VLNAM1(2) VOLUME NAME - 1ST WORD 00112 RR EQU VLNAM2(3) VOLUME NAME - 2ND WORD 00113 RR EQU VLNAM3(4) VOLUME NAME - 3RD WORD 00114 RR EQU VLNAM4(5) VOLUME - 4TH WORD 00115 RR EQU VLASDM(22) AVAILABLE SPACE DIRECTORY SECTOR ADDRESS - MSB 00116 RR EQU VLASDL(23) AVAILABLE SPACE DIRECTORY SECTOR ADDRESS - LSB 00117 RR EQU VLASDS(24) AVAILABLE SPACE DIRECTORY NO. OF SECTORS 00118 RR EQU VLLBMB(25) LARGEST AVAILABLE BLOCK SIZE - MSB 00119 RR EQU VLLBLB(26) LARGEST AVAILABLE BLOCK SIZE - LSB 00120 RR EQU VLFDD1(28) FILE DEFINITION DIR. SECTOR ADDRESS - MSB 00121 RR EQU VLFDD2(29) FILE DEFINITION DIR. SECTOR ADDRESS - LSB 00122 RR EQU VLNFDB(32) NO. OF BLOCKS IN FDD 00123 RR EQU VLSDT1(35) LAST SAVE DATE - 1ST WORD 00124 RR EQU VLSDT2(36) LAST SAVE DATE - 2ND WORD 00125 RR EQU VLSDT3(37) LAST SAVE DATE - 3RD WORD 00126 RR EQU VLTYPE(38) VOLUME TYPE 00127 RR EJT 00128 RRMMCOPY NOP 0 00129 RR* 00130 RR RTJ Q8PREP PREPARE FOR PARAMETER PICK-UP 00131 RR ADC* MMCOPY 00132 RR* 00133 RRHERE RTJ Q8PKUP PICK-UP PARAMETERS 00134 RR STA LU1 00135 RR RTJ* (HERE+1) 00136 RR STA LU2 00137 RR JMP* GO8 00138 RR EJT 00139 RRGO8 LDA JOBIND CHECK IF JOB PROCESSOR ACTIVE 00140 RR SAN GO8A SKIP IF YES 00141 RR LDA SWTCH CHECK IF LIBEDT ACTIVE 00142 RR SAZ GO8B SKIP IF NO 00143 RRGO8A LDA =XJPORLA SET ERROR MESSAGE AND EXIT 00144 RR JMP GO235 00145 RR* 00146 RRGO8B RTJ TODAY GET TODAY'S DATE 00147 RR ADC ITEMP 00148 RR ADC ITEMP+1 00149 RR******* GET 'FROM' DISK DATA 00150 RR* 00151 RRGO9 ENQ MMLUTB GET ACTUAL LOGICAL NO. 00152 RR LDQ- (ADRECT),Q 00153 RR ADQ (LU1) 00154 RR INQ 1 00155 RR LDA- (ZERO),Q 00156 RR STA- I 00157 RR LDA- (ZERO),I 00158 RR AND- LPMASK+8 $00FF 00159 RR STA DISK1 STORE INTO REQUEST PARAMETER LIST 00160 RR STA LUF 00161 RR STA LUA 00162 RR STA LUNIT1 00163 RR LDA- LABMSB,I BEGIN TRANSFER AT THE VOLUME LABEL 00164 RR STA MSB 00165 RR STA SAVMB1 00166 RR STA MSBC 00167 RR STA VLMSB1 00168 RR LDA- LABLSB,I 00169 RR STA LSB 00170 RR STA SAVLB1 00171 RR STA LSBC 00172 RR STA VLLSB1 00173 RR EJT 00174 RR******* GET 'TO' DISK DATA 00175 RR ENQ MMLUTB GET ACTUAL L.U. NUMBER OF 2ND DISK 00176 RR LDQ- (ADRECT),Q 00177 RR ADQ (LU2) 00178 RR INQ 1 00179 RR LDA- (ZERO),Q 00180 RR STA- I 00181 RR LDA- (ZERO),I 00182 RR AND- LPMASK+8 $00FF 00183 RR STA DISK2 STORE IN PARAMETER LIST OF REQUEST 00184 RR STA LUNIT2 00185 RR STA LU2A 00186 RR STA LUT 00187 RR STA LU2B XXXX 00188 RR LDA- LABMSB,I BEGIN TRANSFER AT THE VOLUME LABEL 00189 RR STA MSB2 00190 RR STA SAVMB2 00191 RR STA VLMSB2 00192 RR STA MSB2A 00193 RR STA MSB2B XXXX 00194 RR LDA- LABLSB,I 00195 RR STA LSB2 00196 RR STA SAVLB2 00197 RR STA VLLSB2 00198 RR STA LSB2A 00199 RR STA LSB2B XXXX 00200 RR* 00201 RR CLR A 00202 RR STA MSB3 INITIALIZE THE TRANSFER COUNT 00203 RR STA LSB3 00204 RR* 00205 RR* GET MAXIMUM SECTOR VALUES, SECTORS/TRACK, AND WORDS/SECTOR OF 1ST DIS 00206 RR* 00207 RR RTJ MMSIZ 00208 RR ADC LUF 00209 RR ADC MSMF 00210 RR ADC MSLF 00211 RR ADC WPSF 00212 RR ADC SPTF 00213 RR* 00214 RR* GET MAXIMUM SECTOR VALUES, SECTORS/TRACK, AND WORDS/SECTOR OF 2ND DIS 00215 RR* 00216 RR RTJ MMSIZ 00217 RR ADC LUT 00218 RR ADC MSMT 00219 RR ADC MSLT 00220 RR ADC WPST 00221 RR ADC SPTT 00222 RR* INITIALIZE CONTROL VARIABLES 00223 RR LDA SPTF 00224 RR STA READU 00225 RR STA WRITU 00226 RR MUI WPSF 00227 RR STA FTRKLN 00228 RR JMP* GO250 00229 RR SPC 1 00230 RR* OUTPUT ERROR MESSAGE LOGIC 00231 RR SPC 1 00232 RRGO235 STA* ERCODE STORE ERROR CODE FOR SYSMSG 00233 RR RTJ SYSMSG REPORT MESSAGE 00234 RR ADC ERCODE 00235 RR ADC ERBUF 00236 RR JMP (MMCOPY) 00237 RR SPC 2 00238 RRERCODE NUM 0 00239 RR EJT 00240 RRGO250 RTJ MESAGE REQUEST THE PROTECT SWITCH DISABLE 00241 RR RTJ INPUT1 AWAIT A REPLY 00242 RR SPC 1 00243 RR LDQ+ EMPSTP DISABLE TIMER 00244 RRREJ ENA 0 00245 RR OUT REJ-* 00246 RR LDA+ DMICOD 00247 RR AND- LPMASK+15 00248 RR TRA Q 00249 RR LDA+ TBLADR 00250 RR DMI DISABLE THE MICRO-INTERRUPT 00251 RR SPC 1 00252 RR SPC 2 00253 RR LDA- MTBADR GET FWA OF MASK TABLE 00254 RR INA -1 00255 RR STA* MASKTA STORE LOCALLY 00256 RR ENQ 16 SET Q TO INDEX 00257 RRGO260 LDA* (MASKTA),Q RESET MASK TABLE WORD BY ANDING WITH SYSDAT 00258 RR AND* MASKAD VALUE OF SAVMSK 00259 RR STA* (MASKTA),Q 00260 RR INQ -1 DECREMENT INDEX 00261 RR SQM GO270 SKIP IF DONE 00262 RR JMP* GO260 REPEAT 00263 RR* 00264 RRMASKTA NUM 0 MASK TABLE FWA 00265 RRMASKAD NUM $4003 REMOVED - MASKAD ADC SAVMSK, EXT SAVMSK 00266 RRPT ADC PARTBL 00267 RR EJT 00268 RR* MOVE 'MMCOPY' TO FILE MGR AREA (PARTITION 0) 00269 RRGO270 LDQ PT 00270 RR LDA- (ZERO),Q SET UP TO MOVE ALL CODE FROM 00271 RR STA* STORE LABEL 'START' TO END OF MMCOPY 00272 RR* LOGIC TO FILE MANAGER PARTIT. 00273 RR LDA =XSTART 00274 RR STA* LOAD DEFINE LOAD AND STORE ADDRESSES 00275 RR* 00276 RR LDQ =XPGMEND-START LENGTH OF MMCOPY TO XFER 00277 RR ADQ =XLVERWPS LENGTH OF VERWPS SUBROUTINE 00278 RR INQ -1 00279 RRLOOP LDA* (LOAD),Q MOVE ONE WORD 00280 RR STA* (STORE),Q 00281 RR INQ -1 DECREMENT INDEX 00282 RR SQM DONE SKIP IF DONE 00283 RR JMP* LOOP GO MOVE NEXT WORD 00284 RR SPC 2 00285 RRSTORE NUM 0 STORE ADDRESS (IN FM SPACE) 00286 RRLOAD NUM 0 LOAD ADDRESS (IN MMCOPY) 00287 RR SPC 2 00288 RRDONE JMP* (STORE) TRANSFER CONTROL TO START 00289 RR* (NOW IN FM'S PARTITION) 00290 RR EJT 00291 RR* BEGINING OF MOVED LOGIC. 00292 RRSTART RTJ- ($F4) DISABLE THE ERROR LOGGING ROUTINE 00293 RR ADC $26FF 00294 RR ADC EFSTOR GETS INITIALIZED TO EFSTOR 00295 RR RAO+ MIBX DISABLE MANUAL INTERRUPT 00296 RR SPC 2 00297 RRFMNT ENQ 0 REQUEST THE VOLUME MOUNTING 00298 RR RTJ MESSAG 00299 RR RTJ INPUT2 AWAIT THE REPLY 00300 RR SPC 1 00301 RR LDA INPBUF CHECK IF 'OK' ENTERED 00302 RR SUB =N$4F4B 00303 RR SAZ GETABS SKIP IF YES 00304 RR JMP* FMNT REPEAT MOUNTING REQUEST 00305 RR SPC 2 00306 RRGETABS RTJ* ABS 00307 RRABS 000 000 00308 RR LDA* ABS 00309 RR ADD =XVLBUF1-ABS 00310 RR STA BUF1 00311 RR* 00312 RR LDA* ABS 00313 RR ADD =XVLBUF2-ABS 00314 RR STA BUF2 00315 RR LDA* ABS 00316 RR ADD =XVLTYP-ABS 00317 RR STA VLBUF 00318 RR ENA 1 00319 RR STA PACKNO 00320 RR EJT 00321 RR* 00322 RR* VERIFY COMPATIBILITY OF DISK, DRIVE, AND PDT AS TO WORDS PER SECTOR 00323 RR* 00324 RR SPC 3 00325 RR* VERIFY DISK1 00326 RR RTJ* MYLOC CALC. ABS. LOC. OF 'VERWPS' PARAMETERS 00327 RRMYLOC NUM 0 00328 RR LDA* MYLOC 00329 RR INA VWPSS-MYLOC 00330 RR STA* AVWPS1 00331 RR STA* AVWPS2 00332 RR ADD =XLUF-VWPSS 00333 RR STA* ALUF 00334 RR INA LUT-LUF 00335 RR STA* ALUT 00336 RR RTJ VERWPS CALL VERIFY ROUTINE 00337 RRALUF NUM 0 00338 RRAVWPS1 NUM 0 00339 RR LDA* VWPSS CHECK FOR COMPATIBILITY ERROR 00340 RR SAZ NV 00341 RR JMP* VERERR 00342 RR SPC 3 00343 RR* VERIFY DISK 2 00344 RR SPC 2 00345 RRNV RTJ VERWPS CALL VERIFY ROUTINE 00346 RRALUT NUM 0 00347 RRAVWPS2 NUM 0 00348 RR LDA* VWPSS CHECK FOR COMPATIBILITY ERROR 00349 RR SAZ UPDPRO 00350 RRVERERR ENQ 16 00351 RR RTJ MESSAG ISSUE INCOMPATIBILITY MESSAGE 00352 RR JMP* FMNT GO AND TRY MOUNT AGAIN 00353 RRVWPSS NUM 0 STATUS RETURNED FROM 'VERWPS' ROUTINE 00354 RR SPC 3 00355 RR* UPDATE CONTROL PARAMTERS TO REFLECT DISKS MOUNTED. 00356 RRUPDPRO LDA ABS 00357 RR ADD =XVLTYP-ABS 00358 RR STA* VLBUF 00359 RR RTJ MMREAD READ IN VOLUME TYPE 00360 RRVLBUF ADC VLTYP 1. BUFFER ADDRESS 00361 RR ADC 1 2. NUMBER OF WORDS 00362 RRLUA ADC 0 3. LOGICAL UNIT 00363 RR ADC 38 4. INDEX OFFSET 00364 RR ADC 0 5. MSB SECTOR ADDRESS 00365 RR ADC 0 6. LSB SECTOR ADDRESS 00366 RR SQP OKVLRD SKIP IF NO I/O ERROR 00367 RR ENA IOECOD SET ERROR MESSAGE CODE - I/O ERROR 00368 RR JMP GO235 00369 RROKVLRD LDA VLTYP 00370 RR AND =N$BFFF MASK BIT 14 OUT 00371 RR STA MPCYFG 00372 RR LDA FTRKLN COMPUTE ADJUST READU OR WRITU 00373 RR DVI WPST 00374 RR SQZ 1 ROUND UP TO NEXT INTEGER 00375 RR INA 1 00376 RR TRA Q SAVE IN Q 00377 RR LDA WPSF COMPUTE SIZE DIFFERENCE (WPS) 00378 RR SUB WPST 00379 RR SAZ EQ IF WORDS/SECTOR ARE EQUAL SKIP. 00380 RR JMP* NOTEQ IF WORDS/SECTOR ARE NOT EQUAL JUMP. 00381 RR EJT 00382 RR* 00383 RR* WORDS/SECTOR ARE EQUAL, SET CONTROL PARAMETERS 00384 RR* 00385 RREQ ENA 0 INITIALIZE FORCED SINGLE COPY FLAG 00386 RR STA FSCFG 00387 RR LDA MPCYFG DETERMINE IF FORCED SINGLE COPY IS SPECIFIED 00388 RR SAP NEQ SKIP IF NOT FORCED SINGLE COPY 00389 RR JMP* EQB1 00390 RRNEQ AND =N$7FFF AND OUT BIT 15 00391 RR INA -2 00392 RR STA MPCYFG STORE ADJUSTED MULTIPLE COPY FLAG 00393 RR* 00394 RR* DETERMINE IF DIFFERENT CAPACITY DISKS FOR MULTIPLE COPY 00395 RR* 00396 RR ENQ LOG1A 00397 RR LDQ- (ADRECT),Q 00398 RR ADQ LUNIT1 00399 RR LDQ- (ZERO),Q GET PDT LOCATION FOR UNIT 1 00400 RR LDA- NRWHD,Q GET NUMBER OF R/W HEADS 00401 RR STA TYPE1 SAVE IN TYPE1 00402 RR ENQ LOG1A 00403 RR LDQ- (ADRECT),Q 00404 RR ADQ LUNIT2 00405 RR LDQ- (ZERO),Q GET PDT LOCATION FOR UNIT 2 00406 RR LDA- NRWHD,Q GET NUMBER OF R/W HEADS 00407 RR SUB TYPE1 DETERMINE IF DIFFERENCE EXISTS 00408 RR SAN EQT1 SKIP IF NOT SAME SIZE 00409 RR JMP* EQ1 00410 RREQT1 SAM T35 SKIP IF FROM PACK IS LARGER 00411 RR LDA MPCYFG SET FORCED SINGLE COPY FLAG IF NECESSARY 00412 RR SAP M53 SKIP IF NOT 00413 RR LDA =N$8000 00414 RR STA FSCFG SAVE FLAG 00415 RR JMP* EQ1 00416 RR EQU M53(*) 00417 RRT35 JMP* NOTEQ 00418 RR* FORCED SINGLE COPY PER 'MPCYFG' FLAG 00419 RREQB1 AND =N$7FFF ADJUST MPCYFG FOR FORCED SINGLE COPY 00420 RR STA MPCYFG 00421 RR LDA FTRKLN SET TRANSFER LENGTH TO ONE TRACK OF FROM PACK 00422 RR STA LENGTH 00423 RR STA LENG2 00424 RR ENA 1 00425 RR STA NUMPKS INDICATE ONE PACK 00426 RR LDA MSMT SET MAX SECTORS TO 'TO' PACK 00427 RR STA SECTM 00428 RR LDA MSLT 00429 RR STA SECTL 00430 RR JMP COMAL 00431 RR EJT 00432 RR* 00433 RR* SAME CAPACITY, SAME WPS SIZE COPY 00434 RR* 00435 RREQ1 LDA FTRKLN SET TRANSFER LENGTH TO ONE TRACK OF FROM PACK 00436 RR STA LENGTH 00437 RR STA LENG2 00438 RR ENA 1 00439 RR STA NUMPKS SET NUMBER OF PACKS = 1 00440 RR TCA A 00441 RR STA MPCYFG SET MULTIPLE COPY FLAG TO -1 (NO MULTIPLE COPY 00442 RR LDA MSMF 00443 RR STA SECTM SET MSB,LSB OF TRANSFER MAXIMUM SECTOR 00444 RR LDA MSLF 00445 RR STA SECTL 00446 RR JMP COMAL 00447 RR EJT 00448 RR* 00449 RR* NUMBER OF WORDS PER SECTOR ARE DIFFERENT. 00450 RR* 00451 RRNOTEQ LDA FTRKLN 00452 RR STA LENGTH SET READ AND WRITE 00453 RR STA LENG2 LENGTHS TO $1800. 00454 RR ENA 1 00455 RR STA NUMPKS ONE PACK. 00456 RR TCA A 00457 RR STA MPCYFG NO MULTIPLE COPIES. 00458 RR LDA SPTF 00459 RR STA READU SEC/TRK FOR READ DEVICE. 00460 RR LDA SPTT 00461 RR STA WRITU SEC/TRK FOR WRITE DEVICE 00462 RR LDA MSMF 00463 RR STA SECTM MSB,LSB OF READ DEVICE. 00464 RR LDA MSLF 00465 RR STA SECTL 00466 RR EJT 00467 RRCOMAL LDA* NUMPKS SET PACKS LEFT PARAMETER 00468 RR INA -1 00469 RR STA* PACLFT 00470 RR* GET READY TO DISPLAY VOL LABELS OF MOUNTED 00471 RR* VOLUMES FOR OPERATOR VERIFICATION 00472 RRNXTPK RTJ MMREAD READ IN LABEL OF VOLUME 1 00473 RRBUF1 ADC VLBUF1 1. BUFFER ADDRESS 00474 RR ADC 96 2. NO. OF WORDS 00475 RRLUNIT1 ADC 0 3. LOGIC UNIT 00476 RR ADC 0 4. INDEX OFFSET 00477 RRVLMSB1 ADC 0 5. MSB SECTOR ADDRESS 00478 RRVLLSB1 ADC 0 6. LSB SECTOR ADDRESS 00479 RR SPC 1 00480 RR SQM RDE SKIP IF I/O ERROR 00481 RR JMP* GO280 00482 RRRDE ENA IOECOD SET ERROR MESSAGE CODE - I/O ERROR 00483 RR JMP GO235 00484 RR* 00485 RR* CONTROL VARIABLES 00486 RR* 00487 RRLUF NUM 0 LOGICAL UNIT OF FROM DISK 00488 RRWPSF NUM 0 WORDS/SECTOR OF FROM DISK 00489 RRMSMF NUM 0 MAX SECTOR (MSB) FROM DISK 00490 RRMSLF NUM 0 MAX SECTOR (LSB) FROM DISK 00491 RRSPTF NUM 0 SECTORS/TRACK OF FROM DISK 00492 RRREADU NUM 0 SECTOR UPDATE FOR READ FROM DISK 00493 RR* 00494 RRLUT NUM 0 LOGICAL UNIT OF TO DISK 00495 RRWPST NUM 0 WORDS/SECTOR (MSB) TO DISK 00496 RRMSMT NUM 0 MAX SECTOR (MSB) TO DISK 00497 RRMSLT NUM 0 MAX SECTOR (LSB) TO DISK 00498 RRSPTT NUM 0 SECTORS/TRACK OF TO DISK 00499 RRWRITU NUM 0 SECTOR UPDATE FOR WRITE TO DISK 00500 RR* 00501 RRFTRKLN NUM 0 TRACK LENGTH OF FROM DISK 00502 RRNUMPKS NUM 0 NUMBER OF PACKS TO BE USED 00503 RRMPCYFG NUM 0 MULTIPLE COPY FLAG (NEG. = NO MULTIPLE COPY) 00504 RRSECTM NUM 0 MSB OF MAXIMUM SECTOR FOR TRANSFER 00505 RRSECTL NUM 0 LSB OF MAXIMUM SECTOR FOR TRANSFER 00506 RRSECTMR NUM 0 MSB OF REMAINDER SECTOR FOR TRANSFER 00507 RRSECTLR NUM 0 LSB OF REMAINDER SECTOR FOR TRANSFER 00508 RRVLTYP NUM 0 VOLUME TYPE FOR FROM DISK 00509 RRPACLFT NUM 0 NUMBER OF PACKS LEFT TO COPY TO/FROM 00510 RRPACKNO NUM 0 PACK NUMBER (CURRENT) MULTIPLE COPY 00511 RRTOFMFG NUM 0 TO/FROM MULTIPLY COPY FLAG (1 = TO) 00512 RRFSCFG NUM 0 FORCED SINGLE COPY FLAG(0,$8000) 00513 RR SPC 1 00514 RRGO280 LDA* BUF1 STORE VOL NAME 00515 RR STA- I 00516 RR LDA- VLNAM1,I 00517 RR SAN N1 CONVERT ZEROES TO BLANKS. 00518 RR LDA =N$2020 00519 RRN1 STA NAME1 00520 RR LDA- VLNAM2,I 00521 RR SAN N2 00522 RR LDA =N$2020 00523 RRN2 STA NAME1+1 00524 RR LDA- VLNAM3,I 00525 RR SAN N3 00526 RR LDA =N$2020 00527 RRN3 STA NAME1+2 00528 RR LDA- VLNAM4,I 00529 RR SAN N4 00530 RR LDA =N$2020 00531 RRN4 STA NAME1+3 00532 RR LDA- VLSDT1,I STORE LAST SAVE DATE 00533 RR SAN D1 00534 RR LDA =N$2A2A CONVERT BLANK DATE TO ****** 00535 RRD1 STA DATE1 00536 RR LDA- VLSDT2,I 00537 RR SAN D2 00538 RR LDA =N$2A2A 00539 RRD2 STA DATE1+1 00540 RR LDA- VLSDT3,I 00541 RR SAN D3 00542 RR LDA =N$2A2A 00543 RRD3 STA DATE1+2 00544 RR LDA- VLTYPE,I STORE VOL TYPE 00545 RR STA TYPE1 00546 RR SPC 2 00547 RR 00548 RR RTJ MMREAD READ IN LABEL OF VOLUME 2 00549 RRBUF2 ADC VLBUF2 1. BUFFER ADDRESS 00550 RR ADC 96 2. NO. OF WORDS 00551 RRLUNIT2 ADC 0 3. LOGIC UNIT 00552 RR ADC 0 4. INDEX OFFSET 00553 RRVLMSB2 ADC 0 5. MSB OF SECTOR ADDRESS 00554 RRVLLSB2 ADC 0 6. LSB OF SECTOR ADDRESS 00555 RR SPC 1 00556 RR SQP GO290 SKIP IF NO I/O ERROR 00557 RR ENA IOECOD SET ERROR MESSAGE CODE - I/O ERROR 00558 RR JMP GO235 00559 RR SPC 1 00560 RRGO290 LDA* BUF2 STORE VOL NAME 00561 RR STA- I 00562 RR LDA- VLNAM1,I 00563 RR SAN N5 00564 RR LDA =N$2020 00565 RRN5 STA NAME2 00566 RR LDA- VLNAM2,I 00567 RR SAN N6 00568 RR LDA =N$2020 00569 RRN6 STA NAME2+1 00570 RR LDA- VLNAM3,I 00571 RR SAN N7 00572 RR LDA =N$2020 00573 RRN7 STA NAME2+2 00574 RR LDA- VLNAM4,I 00575 RR SAN N8 00576 RR LDA =N$2020 00577 RRN8 STA NAME2+3 00578 RR LDA- VLSDT1,I STORE LAST SAVE DATE 00579 RR SAN D4 00580 RR LDA =N$2A2A 00581 RRD4 STA DATE2 00582 RR LDA- VLSDT2,I 00583 RR SAN D5 00584 RR LDA =N$2A2A 00585 RRD5 STA DATE2+1 00586 RR LDA- VLSDT3,I 00587 RR SAN D6 00588 RR LDA =N$2A2A 00589 RRD6 STA DATE2+2 00590 RR LDA- VLTYPE,I STORE VOL TYPE 00591 RR STA TYPE2 00592 RR SPC 2 00593 RR LDA =N$4241 CHECK TYPE OF VOLS FOR DISPLAY PURPOSES 00594 RR STA V1TYP 00595 RR STA V2TYP 00596 RR LDA =N$434B 00597 RR STA V1TYP+1 00598 RR STA V2TYP+1 00599 RR LDA =N$5550 00600 RR STA V1TYP+2 00601 RR STA V2TYP+2 00602 RR LDA TYPE1 00603 RR SAN GO295 SKIP IF NOT MASTER 00604 RR LDA =N$4D41 00605 RR STA V1TYP 00606 RR LDA =N$5354 00607 RR STA V1TYP+1 00608 RR LDA =N$4552 00609 RR STA V1TYP+2 00610 RRGO295 LDA TYPE2 00611 RR SAN GO300 SKIP IF NOT MASTER 00612 RR LDA =N$4D41 00613 RR STA V2TYP 00614 RR LDA =N$5354 00615 RR STA V2TYP+1 00616 RR LDA =N$4552 00617 RR STA V2TYP+2 00618 RR* 00619 RR SPC 2 00620 RR* DISPLAY VOL NAME, DATE AND TYPE 00621 RR* GET VERIFICATION FROM OPERATOR 00622 RRGO300 ENQ 4 WRITE HEADER MESSAGE 00623 RR RTJ MESSAG 00624 RR SPC 1 00625 RR ENQ 5 DISPLAY VOLUME NAMES, DATES AND TYPES 00626 RR RTJ MESSAG 00627 RR SPC 1 00628 RR ENQ 6 00629 RR RTJ MESSAG 00630 RR SPC 1 00631 RR ENQ 7 00632 RR RTJ MESSAG 00633 RR SPC 1 00634 RR SPC 4 00635 RR* 00636 RR* OUTPUT MSG 9 ONLY IF COPYING FROM BACKUP TO MASTER. 00637 RR* 00638 RRCHKM9 LDA TYPE1 00639 RR SAZ GO310 SKIP IF 'FROM' PACK IS MASTER. 00640 RR LDA TYPE2 00641 RR SAN GO310 SKIP IF 'TO' PACK IS NOT MASTER. 00642 RR ENQ 8 00643 RR RTJ MESSAG OUTPUT WARNING MSG. 00644 RR SPC 4 00645 RR SPC 2 00646 RRGO310 ENQ 0 VERIFY NAMES ON BOTH VOLUMES ARE SAME 00647 RRGO320 LDA NAME1,Q 00648 RR SUB NAME2,Q 00649 RR SAN DIFNM 00650 RR INQ 1 00651 RR TRQ A 00652 RR INA -4 00653 RR SAZ CKDAT YES 00654 RR JMP* GO320 00655 RRDIFNM ENQ 9 NO - ISSUE WARNING MESSAGE 00656 RR RTJ MESSAG 00657 RR SPC 4 00658 RR* 00659 RR* IF COPYING FROM MASTER TO BACKUP - DO NOT OUTPUT MSG 11 00660 RR* 00661 RRCKDAT LDA TYPE1 00662 RR SAN CKDATE SKIP IF 'FROM' IS NOT MASTER. 00663 RR LDA TYPE2 00664 RR SAZ CKDATE SKIP IF 'TO' IS MASTER. 00665 RR JMP* GO330 JUMP AROUND MSG 11. 00666 RR SPC 4 00667 RRCKDATE ENQ 2 VERIFY THAT THE LAST SAVE DATE ON THE VOLUME 00668 RR LDA DATE1,Q TO BE COPIED FROM IS LATER THAN THE LAST SAVE 00669 RR SUB DATE2,Q DATE ON THE VOLUME TO BE COPIED TO 00670 RR SAM DIFDT1 00671 RR SAZ 1 00672 RR JMP* GO330 00673 RR ENQ 0 00674 RR LDA DATE1,Q 00675 RR SUB DATE2,Q 00676 RRDIFDT1 SAM DIFDT 00677 RR SAZ 1 00678 RR JMP* GO330 00679 RR ENQ 1 00680 RR LDA DATE1,Q 00681 RR SUB DATE2,Q 00682 RR SAM DIFDT 00683 RR SAZ DIFDT 00684 RR JMP* GO330 00685 RRDIFDT ENQ 10 NO - ISSUE WARNING MESSAGE 00686 RR RTJ MESSAG 00687 RR SPC 2 00688 RRGO330 ENQ 11 ASK IF WANT TO ABORT SAVE 00689 RR RTJ MESSAG 00690 RR SPC 1 00691 RR RTJ INPUT2 AWAIT REPLY 00692 RR LDA INPBUF 00693 RR SUB =N$474F 00694 RR SAZ GETIT GO 00695 RR JMP FMNT EX 00696 RR SPC 2 00697 RR* 00698 RRGETIT RTJ* ABSADR GET ABSOLUTE ADDRESS 00699 RRABSADR 000 000 00700 RR LDA* ABSADR SET COMPLETION ADDRESS FOR READ 00701 RR ADD =XRDCOMP-ABSADR 00702 RR STA* COMP1 00703 RR ADD =XWTCOMP-RDCOMP 00704 RR STA* COMP2 SET COMPLETION ADDRESS FOR WRITE 00705 RR LDA* ABSADR 00706 RR ADD =XMSB-ABSADR 00707 RR STA* AMSB 00708 RR ADD =XMSB2-MSB 00709 RR STA* AMSB2 00710 RR ADD =XMSB3-MSB2 00711 RR STA* AMSB3 00712 RR* 00713 RR LDA* ABSADR 00714 RR ADD =XITEMP-ABSADR 00715 RR STA ATEMP 00716 RR* 00717 RR* COMPARE VLTYPE AGAINST SEQUENCE NUMBER IF MULTIPLE COPY FROM 00718 RR* 00719 RR LDA MPCYFG 00720 RR SAP COMPR 00721 RR JMP* COPTRK NOT MULTIPLE COPY 00722 RRCOMPR LDA TOFMFG 00723 RR SAN COMPR1 00724 RR JMP* COPTRK NOT FROM MULTIPLE COPY 00725 RRCOMPR1 LDA* TYPE1 00726 RR AND =N$BFFF MASK BIT 14 00727 RR INA -1 00728 RR SUB PACKNO COMPARE PACKNO TO SEQUENCE NUMBER 00729 RR SAN NOTSEQ NOT CORRECT 00730 RR JMP* COPTRK OK CONTINUE 00731 RRNOTSEQ ADD PACKNO STORE PACK NO. IN MESSAGE 00732 RR AND =N$2030 00733 RR STA SPKNO 00734 RR LDA PACKNO SET PACK NO. IN MESSAGE 00735 RR AND =N$2030 00736 RR STA PKNO 00737 RRRESEQM ENQ 14 00738 RR RTJ MESSAG ISSUE WRONG SEQUENCED PACK NO. MESSAGE 00739 RR RTJ INPUT2 CHECK VERIFY REPLY 00740 RR LDA INPBUF 00741 RR SUB =N$4F4B 00742 RR SAZ AGAIN 00743 RR JMP* RESEQM TRY AGAIN 00744 RRAGAIN JMP NXTPK START PACK VERIFY AGAIN. 00745 RR EJT 00746 RR* 00747 RR* 137*A107 00748 RRCOPTRK LDA =N$4C44 SET UP 2ND MONITOR REQUEST FOR WRITE 137*A107 00749 RR STA* WRTRED 137*A107 00750 RR ENQ 0 TURN OFF PAGING 00751 RR RTJ+ CPSET 00752 RR LDA- UNPBGN SET TRANSFER BUFFER ADDRESS TO BACKGROUND 00753 RR INA 1 00754 RR STA* BUFAD1 00755 RR STA* BUFAD2 137*A107 00756 RR CLR A SET READ/WRITE FLAG TO INDICATE WRITE 137*A107 00757 RR STA* RWFLAG 137*A107 00758 RR STA* BUFIDX CLEAR BUFFER INDEX FOR VERIFY 137*A107 00759 RR JMP* REDTRK 137*A107 00760 RR* 137*A107 00761 RRVSETUP LDA =N$4844 VERIFICATION SET-UP 137*107 00762 RR STA* WRTRED SET UP 2ND MONITOR REQUEST FOR READ 137*A107 00763 RR LDA* BUFAD2 137*A107 00764 RR ADD* LENGTH RESET BUFFER ADDR TO SPACE OVER INIT 137*A107 00765 RR STA* BUFAD2 INPUT BUFFER 137*A107 00766 RR RAO* RWFLAG BUMP READ/WRITE FLAG TO INDICATE READ 137*A107 00767 RR* 137*A107 00768 RRREDTRK RTJ- ($F4) 137*A107 00769 RR* 137*A107 00770 RR NUM $4844 FREAD 00771 RRCOMP1 ADC RDCOMP (GETS RESET) 00772 RR NUM 0 THREAD 00773 RRDISK1 NUM 0 LOGICAL UNIT NUMBER 00774 RRLENGTH NUM 0 BUFFER LENGTH 00775 RR* 137*A107 00776 RRBUFAD1 NUM 0 BUFFER ADDRESS 00777 RR* 137*A107 00778 RRMSB NUM 0 MSB OF START READ 00779 RRLSB NUM 0 LSB OF START READ 00780 RR* 00781 RR JMP- (DISP) 00782 RRRDCOMP SQP WRTTRK NO ERROR 00783 RR JMP EREND ERROR, TERMINATE 00784 RR* 00785 RRWRTTRK RTJ- ($F4) 00786 RR* 137*A107 00787 RRWRTRED NUM $4C44 FWRITE - GETS RESET TO FREAD 137*A107 00788 RR* 137*A107 00789 RRCOMP2 ADC WTCOMP (GETS RESET) 00790 RR NUM 0 THREAD 00791 RRDISK2 NUM 0 LOGICAL UNIT NO 00792 RRLENG2 NUM 0 LENGTH OF BUFFER 00793 RR* 137*A107 00794 RRBUFAD2 ADC 0 ADDRESS OF I/O BUFFER 137*A107 00795 RR* 137*A107 00796 RRMSB2 NUM 0 START MSB OF WRITE 00797 RRLSB2 NUM 0 START LSB OF WRITE 00798 RR JMP- (DISP) 00799 RRWTCOMP SQP CL 00800 RR JMP EREND ERROR TERMINATE 00801 RRCL JMP* COMPL 00802 RR SPC 3 00803 RRMSB3 NUM 0 00804 RRLSB3 NUM 0 00805 RRAMSB ADC 0 00806 RRAMSB2 ADC 0 00807 RRAMSB3 ADC 0 00808 RRSAVMB1 NUM 0 SAVED MSB/LSB OF START READ SECTOR ADDRESS 00809 RRSAVLB1 NUM 0 00810 RRSAVMB2 NUM 0 SAVED MSB/LSB OF START WRITE SECTOR 00811 RRSAVLB2 NUM 0 00812 RR* 137*A107 00813 RRRWFLAG NUM 0 READ/WRITE FLAG 0=WRITE, 1=READ 137*A107 00814 RRVERIFY NUM 0 REMOVED - VERIFY ADC SAVOPT, EXT SAVOPT 00815 RRBUFIDX NUM 0 BUFFER INDEX 137*A107 00816 RRTYPE1 BZS TYPE1(1) TYPE OF VOLUME 2 00817 RRTYPE2 BZS TYPE2(1) TYPE OF VOLUME 2 00818 RR* 137*A107 00819 RR EJT 00820 RR* 137*A107 00821 RRCOMPL LDA* VERIFY CHECK IF VERIFY NEEDED 00822 RR SAZ COMPLA SKIP IF NO 137*A107 00823 RR LDA* RWFLAG CHECK IF READS NEEDED 137*A107 00824 RR SAN LOOOP SKIP IF READS WERE MADE 137*A107 00825 RR JMP* VSETUP GO SETUP FOR VERIFICATION READS 137*A107 00826 RR* 137*A107 00827 RRLOOOP LDQ* BUFIDX SET Q TO BUFFER INDEX 137*A107 00828 RR LDA* (BUFAD1),Q CHECK IF TWO WORDS COMPARE 137*A107 00829 RR EOR* (BUFAD2),Q 137*A107 00830 RR SAZ OKCMPR SKIP IF TWO WORD COMPARE WAS GOOD 137*A107 00831 RR JMP CMPERR GO LOG COMPARE ERROR 137*A107 00832 RR* 137*A107 00833 RROKCMPR RAO* BUFIDX BUMP BUFFER INDEX 137*A107 00834 RR LDA* BUFIDX CHECK IF DONE 137*A107 00835 RR SUB* LENGTH 137*A107 00836 RR SAZ COMPLA SKIP IF YES 137*A107 00837 RR JMP* LOOOP REPEAT TO CONTINUE VERIFY 137*A107 00838 RR* 137*A107 00839 RRCOMPLA LDA* AMSB 137*A107 00840 RR* 137*A107 00841 RR STA- I 00842 RR LDQ READU 00843 RR RTJ ADD INCREMENT THE READ SECTOR ADDRESS 00844 RR* 00845 RR LDA* AMSB2 00846 RR STA- I 00847 RR LDQ WRITU 00848 RR RTJ ADD INCREMENT THE WRITE SECTOR ADDRESS 00849 RR* 00850 RR LDA* AMSB3 00851 RR STA- I 00852 RR LDQ READU 00853 RR RTJ ADD INCREMENT THE SECTOR COUNTER 00854 RR* 00855 RR LDA* MSB3 CHECK FOR END MSB 00856 RR SUB SECTM 00857 RR SAZ TSTLSB END MSB REACHED ,CHECK LSB END 00858 RR SAM CT CHECK FOR END 00859 RR JMP* END 00860 RRCT JMP* CONT 00861 RR* 00862 RRTSTLSB LDA* LSB3 CHECK FOR LAST LSB 00863 RR SUB SECTL 00864 RR INA -1 00865 RR SAP END 00866 RR ADD READU CHECK FOR A REMAINDER 00867 RR SAM CONT 00868 RR SUB READU 00869 RR TCA A 00870 RR MUI WPSF CALCULATE THE NUMBER OF WRODS REMAINING. 00871 RR STA* LENGTH 00872 RR STA* LENG2 00873 RR* 00874 RRCONT JMP* COPTRK 00875 RR* 00876 RR EJT 00877 RREND LDA* DISK2 FIRST, SET UP TO UPDATE VOLUME LABEL 00878 RR STA* LUC 00879 RR TRA Q 00880 RR LDA MPCYFG 00881 RR SAM GOON1 00882 RR LDA TOFMFG 00883 RR SAN GOON1 SKIP TO MULTIPLE FROM COPY 00884 RR LDA PACKNO 00885 RR INA 1 INCREMENT PACKNO 00886 RR LDQ PACLFT 00887 RR SQN STTYP SKIP IF NOT LAST PACK 00888 RR ADD =N$4000 SET BIT 14 FOR LAST PACK 00889 RRSTTYP STA- VLTYPE,I STORE NEW VOLUME TYPE WORD IN LABEL BUFFER 00890 RRGOON1 LDA* COMP2 00891 RR ADD =XVLBUF1-WTCOMP 00892 RR STA* BAC SET ABSOLUTE ADDRESS OF VOL. LABEL BUFFER 00893 RR RTJ MMWRIT WRITE OUT VOLUME LABLE 00894 RRBAC ADC 0 1. BUFFER ADDRESS 00895 RR ADC 96 2. NO. OF WORDS 00896 RRLUC ADC 0 3. LOG UNIT 00897 RR ADC 0 4. INDEX OFFSET 00898 RRMSBC ADC 0 5. MSB SECTOR ADDRESS 00899 RRLSBC ADC 0 6. LSB SECTOR ADDRESS 00900 RR* 00901 RR SQP SAVDT SKIP IF NO I/O ERROR 00902 RR JMP EREND GO NOTE I/O ERROR 00903 RR SPC 2 00904 RR* STORE TODAYS DATE AS LAST SAVE DATE ON 00905 RR* DISK COPIED TO 00906 RR SPC 1 00907 RRSAVDT RTJ MMWRIT 00908 RRATEMP ADC ITEMP 1. BUFFER ADDRESS 00909 RR ADC 3 2. NO. OF WORDS 00910 RRLU2A ADC 0 3. LOGIC UNIT 00911 RR ADC 35 4. INDEX OFFSET 00912 RRMSB2A ADC 0 5. MSB OF SECTOR ADDRESS 00913 RRLSB2A ADC 0 6. LSB OF SECTOR ADDRESS 00914 RRREALEN LDA MPCYFG 00915 RR SAM GOON5 00916 RR LDA TOFMFG 00917 RR SAN GOON5 SKIP IF MULTIPLE COPY FROM 00918 RR* JMP* GOON6 THIS JMP MADE A COMMENT TO INSURE REQUEST 00919 RR* FOR PACK DESIGNATE MODE. 00920 RRGOON5 ENQ 12 00921 RR RTJ MESSAG ASK FOR DESIGNATION OF VOLUME TYPE 00922 RR RTJ INPUT2 GET ANSWER XXXX 00923 RR LDA INPBUF XXXX 00924 RR ALS 8 (USE ONLY FIRST CHAR. ENTERED) 00925 RR AND =N$0001 CONVERT TO 0 OR 1 XXXX 00926 RR TCA A FLIP BITS. 00927 RR AND- $3 0=M, 1=B 00928 RR STA ITEMP XXXX 00929 RR RTJ* VADDR 00930 RRVADDR 0 0 00931 RR LDA* VADDR 00932 RR ADD =XITEMP-VADDR 00933 RR STA* AITEMP 00934 RR RTJ MMWRIT WRITE LABEL WITH UPDATED VOLUME TYPE XXXX 00935 RRAITEMP ADC ITEMP 1. BUFFER ADDRESS 00936 RR ADC 1 2. NO. OF WORDS XXXX 00937 RRLU2B ADC 0 3. LOGIC UNIT XXXX 00938 RR ADC 38 4. INDEX OFFSET XXXX 00939 RRMSB2B ADC 0 5. MSB OF SECTOR ADDRESS XXXX 00940 RRLSB2B ADC 0 6. LSB OF SECTOR ADDRESS XXXX 00941 RRGOON6 LDA SAVMB1 RESET START READ ADDRESS 00942 RR STA MSB 00943 RR LDA SAVLB1 00944 RR STA LSB 00945 RR LDA SAVMB2 RESET START WRITE ADDRESS 00946 RR STA MSB2 00947 RR LDA SAVLB2 00948 RR STA LSB2 00949 RR CLR A 00950 RR STA MSB3 CLEAR SECTOR COUNTER 00951 RR STA LSB3 00952 RR ENQ 1 00953 RR RTJ* MESSAG OUTPUT 'VOLUME SAVE COMPLETE'. 00954 RR SPC 2 00955 RRFINI IIN 0 00956 RR JMP* FINI WAIT FOR AUTO LOAD 00957 RR SPC 2 00958 RREREND ENQ 2 GIVE ERROR MESSAGE 00959 RR RTJ MESSAG 00960 RR JMP* FINI 00961 RR EJT 00962 RR EJT 00963 RR* 00964 RR* LOCAL VARIABLES 00965 RR* 00966 RRINDEX NUM 74 74 CLASS CODE IS NOT OF A DISK 00967 RRERBUF NUM 0 00968 RRLU1 NUM 0 00969 RRLU2 NUM 0 00970 RR SPC 1 121*4758 00971 RRMESADD ADC MESS01-MSGRQT 0 - OUTPUT MESSAGE ADDRESS 00972 RR ADC MESS02-MSGRQT 1 00973 RR ADC MESS03-MSGRQT 2 00974 RR* 137*A107 00975 RR ADC MESS04-MSGRQT 3 137*A107 00976 RR ADC MESS05-MSGRQT 4 00977 RR ADC MESS06-MSGRQT 5 00978 RR ADC MESS07-MSGRQT 6 00979 RR ADC MESS08-MSGRQT 7 00980 RR ADC MESS09-MSGRQT 8 00981 RR ADC MESS10-MSGRQT 9 00982 RR ADC MESS11-MSGRQT 10 00983 RR ADC MESS12-MSGRQT 11 00984 RR ADC MESS13-MSGRQT 12 00985 RR ADC MESS14-MSGRQT 13 00986 RR ADC MESS15-MSGRQT 14 00987 RR ADC MESS16-MSGRQT 15 00988 RR ADC MESS17-MSGRQT 16 00989 RR* 137*A107 00990 RR SPC 1 121*4758 00991 RRMESLEN ADC MESLN1 0 - OUTPUT MESSAGE LENGTH 00992 RR ADC MESLN2 1 00993 RR ADC MESLN3 2 00994 RR* 137*A107 00995 RR ADC MESLN4 137*A107 00996 RR ADC MESLN5 4 00997 RR ADC MESLN6 5 00998 RR ADC MESLN7 6 00999 RR ADC MESLN8 7 01000 RR ADC MESLN9 8 01001 RR ADC MESL10 9 01002 RR ADC MESL11 10 01003 RR ADC MESL12 11 01004 RR ADC MESL13 12 01005 RR ADC MESL14 13 01006 RR ADC MESL15 14 01007 RR ADC MESL16 15 01008 RR ADC MESL17 16 01009 RR* 137*A107 01010 RR SPC 1 01011 RRINPBUF NUM 0 BUFFER FOR OPERATOR REPLY 01012 RR EJT 01013 RR SPC 5 01014 RR* 01015 RR* DOUBLE WORD MATH ERROR - FORCE PROTECT VIOLATION 01016 RR* 01017 RR SPC 2 01018 RRDWERR NOP 0 01019 RR STA- 1 01020 RR EJT 01021 RRMESSAG NOP 0 01022 RR SPC 1 01023 RR LDA* MESADD,Q SET UP THE REQUIRED MESSAGE 01024 RR STA* MESAD 01025 RR LDA* MESLEN,Q AND THE LENGTH 01026 RR STA* MESLN 01027 RR SPC 1 01028 RR RTJ- ($F4) OUTPUT THE MESSAGE 01029 RRMSGRQT ADC $0D44 01030 RR ADC MES010-MSGRQT 01031 RR ADC 0 01032 RR ADC $1004 01033 RRMESLN ADC 0 01034 RRMESAD ADC 0 01035 RR JMP- (DISP) 01036 RR SPC 1 01037 RRMES010 JMP* (MESSAG) RETURN 01038 RR SPC 2 01039 RRADD NOP 0 01040 RR SPC 1 01041 RR STQ* UPD 01042 RR LDQ- (I) Q = MSB OF SECTOR 01043 RR LDA- 1,I A = LSB OF SECTOR 01044 RR ADD* UPD INCREMENT 01045 RR SAP ADD010 01046 RR AND- LPMASK+15 MAINTAIN SECTOR FORMAT 01047 RR INQ 1 01048 RRADD010 STQ- (I) SPECIFY NEW SECTOR ADDRESS 01049 RR STA- 1,I 01050 RR SPC 1 01051 RR JMP* (ADD) RETURN 01052 RRUPD NUM 0 UPDATE AMOUNT 01053 RR SPC 2 01054 RRMESAGE NOP 0 01055 RR RTJ- ($F4) OUTPUT PROTECT SWITCH MESSAGE 01056 RR ADC $4C44 01057 RR ADC MSG10 01058 RR ADC 0 01059 RR ADC $1005 01060 RR ADC MESLN0 01061 RR ADC MESS00 01062 RR JMP- (DISP) 01063 RR SPC 1 01064 RRMSG10 JMP* (MESAGE) RETURN 01065 RR EJT 01066 RRINPUT1 NOP 0 01067 RR SPC 1 01068 RR RTJ- ($F4) INPUT THE REPLY 01069 RR ADC $4844 01070 RR ADC 0 01071 RR ADC 0 01072 RR ADC TERMLU 01073 RR ADC 1 01074 RR ADC INPBUF 01075 RR SPC 1 01076 RR JMP* (INPUT1) RETURN 01077 RR SPC 2 01078 RRINPUT2 NOP 0 01079 RR SPC 1 01080 RR RTJ- ($F4) INPUT THE REPLY 01081 RRINPRQT ADC $0944 01082 RR ADC INP010-INPRQT 01083 RR ADC 0 01084 RR ADC $1004 01085 RR ADC 1 01086 RR ADC INPBUF-INPRQT 01087 RR JMP- (DISP) 01088 RR SPC 1 01089 RRINP010 JMP* (INPUT2) RETURN 01090 RR* 137*A107 01091 RR EJT 137*A107 01092 RRCMPERR TRQ A COMPARE ERROR NOTED 137*A107 01093 RR ENQ 0 137*A107 01094 RR DVI =N96 GET RELATIVE SECTOR INDEX 137*A107 01095 RR ADD LSB ADD SECTOR INDEX TO BASE SECTOR ADDR 137*A107 01096 RR LDQ MSB 137*A107 01097 RR SAP CMP10 137*A107 01098 RR AND- ONEMSK+14 137*A107 01099 RR INQ 1 137*A107 01100 RRCMP10 STA* LSBSAV SAVE LSB TEMPORARILY 137*A107 01101 RR RTJ* CNVRT CONVERT DIGIT 5 137*A107 01102 RR STA* C5 SAVE IT 137*A107 01103 RR QRS 4 SHIFT TO DIGIT 6 137*A107 01104 RR RTJ* CNVRT CONVERT DIGIT 6 137*A107 01105 RR STA* C6 137*A107 01106 RR QRS 4 137*A107 01107 RR RTJ* CNVRT CONVERT DIGIT 7 137*A107 01108 RR STA* C7 137*A107 01109 RR QRS 4 137*A107 01110 RR RTJ* CNVRT CONVERT DIGIT 8 137*A107 01111 RR STA* C8 137*A107 01112 RR LDQ* LSBSAV PICKUP SAVED LSB 137*A107 01113 RR RTJ* CNVRT CONVERT DIGIT 1 137*A107 01114 RR STA* C1 SAVE IT 137*A107 01115 RR QRS 4 137*A107 01116 RR RTJ* CNVRT DIGIT 2 137*A107 01117 RR STA* C2 137*A107 01118 RR QRS 4 137*A107 01119 RR RTJ* CNVRT DIGIT 3 137*A107 01120 RR STA* C3 137*A107 01121 RR QRS 4 137*A107 01122 RR RTJ* CNVRT DIGIT 4 137*A107 01123 RR STA* C4 137*A107 01124 RR EJT 137*A107 01125 RR ENQ $20 137*A107 01126 RR LDA* C8 BLANK OUT LEADING DIGITS 137*A107 01127 RR INA -$30 137*A107 01128 RR SAN CMP20 137*A107 01129 RR STQ* C8 137*A107 01130 RR LDA* C7 137*A107 01131 RR INA -$30 137*A107 01132 RR SAN CMP20 137*A107 01133 RR STQ* C7 137*A107 01134 RR LDA* C6 137*A107 01135 RR INA -$30 137*A107 01136 RR SAN CMP20 137*A107 01137 RR STQ* C6 137*A107 01138 RR LDA* C5 137*A107 01139 RR INA -$30 137*A107 01140 RRCMP20 SAN CMP30 137*A107 01141 RR STQ* C5 137*A107 01142 RR LDA* C4 137*A107 01143 RR INA -$30 137*A107 01144 RR SAN CMP30 137*A107 01145 RR STQ* C4 137*A107 01146 RR LDA* C3 137*A107 01147 RR INA -$30 137*A107 01148 RR SAN CMP30 137*A107 01149 RR STQ* C3 137*A107 01150 RR LDA* C2 137*A107 01151 RR INA -$30 137*A107 01152 RR SAN CMP30 137*A107 01153 RR STQ* C2 137*A107 01154 RR EJT 137*A107 01155 RR* ASSEMBLE ASCII DIGITS FOR OUTPUT 137*A107 01156 RRCMP30 LDA* C8 137*A107 01157 RR ALS 8 137*A107 01158 RR ADD* C7 137*A107 01159 RR STA* BADADR 137*A107 01160 RR LDA* C6 137*A107 01161 RR ALS 8 137*A107 01162 RR ADD* C5 137*A107 01163 RR STA* BADADR+1 137*A107 01164 RR LDA* C4 137*A107 01165 RR ALS 8 137*A107 01166 RR ADD* C3 137*A107 01167 RR STA* BADADR+2 137*A107 01168 RR LDA* C2 137*A107 01169 RR ALS 8 137*A107 01170 RR ADD* C1 137*A107 01171 RR STA* BADADR+3 137*A107 01172 RR* 137*A107 01173 RR ENQ 3 OUTPUT ERROR MESSAGE 137*A107 01174 RR RTJ MESSAG 137*A107 01175 RR JMP SAVDT GO PRINT OUT END MESSAGE 137*A107 01176 RR SPC 1 137*A107 01177 RRLSBSAV NUM 0 137*A107 01178 RRC8 NUM 0 137*A107 01179 RRC7 NUM 0 137*A107 01180 RRC6 NUM 0 137*A107 01181 RRC5 NUM 0 137*A107 01182 RRC4 NUM 0 137*A107 01183 RRC3 NUM 0 137*A107 01184 RRC2 NUM 0 137*A107 01185 RRC1 NUM 0 137*A107 01186 RRDIGSAV NUM 0 137*A107 01187 RR SPC 1 137*A107 01188 RRCNVRT 000 000 CNVRT LOW 4 BITS OF Q TO ASCII HEX DGT137*A107 01189 RR TRQ A 137*A107 01190 RR AND- ONEMSK+3 137*A107 01191 RR STA* DIGSAV 137*A107 01192 RR TCA A 137*A107 01193 RR INA 9 137*A107 01194 RR SAM CN10 137*A107 01195 RR LDA* DIGSAV DIGIT IN RANGE 0-9 137*A107 01196 RR INA $30 137*A107 01197 RR JMP* (CNVRT) 137*A107 01198 RR* 137*A107 01199 RRCN10 LDA* DIGSAV DIGIT IN RANGE A-F 137*A107 01200 RR INA $37 137*A107 01201 RR JMP* (CNVRT) 137*A107 01202 RR EJT 01203 RRMESS00 ALF $,TURN OFF PROTEC SWITCH (ESC J20@):R$ 01204 RR ALF $,AND TYPE CARRIAGE RETURN$ 01205 RR EQU MESLN0(*-MESS00) 01206 RRMESS01 ALF $,SET UP VOLUME(S) TO BE SAVED :R$ 01207 RR ALF $,AND VERIFY :R$ 01208 RR EQU MESLN1(*-MESS01) 01209 RR EJT 01210 RRMESS02 NUM $1800 01211 RR ALF $, VOLUME SAVE COMPLETE.$ 01212 RR EQU MESLN2(*-MESS02) 01213 RRMESS03 ALF $,I/O ERROR NOTED.$ 01214 RR EQU MESLN3(*-MESS03) 01215 RR* 137*A107 01216 RRMESS04 ALF $,VERIFICATION FAILED AT SECTOR $ 137*A107 01217 RR BZS BADADR(4) 137*A107 01218 RR NUM $200D 137*A107 01219 RR EQU MESLN4(*-MESS04) 137*A107 01220 RR* 01221 RRMESS05 ALF $,VERIFICATION OF CORRECT SAVE VOLUMES $ 01222 RR EQU MESLN5(*-MESS05) 01223 RR* 01224 RRMESS06 NUM $0A0D 01225 RR ALF $, PACK VOLUME NAME LAST SAVE DATE$ 01226 RR ALF $, TYPE$ 01227 RR EQU MESLN6(*-MESS06) 01228 RR* 137*A107 01229 RRMESS07 ALF $, FROM $ 01230 RRNAME1 BZS NAME1(4) NAME OF VOLUME 1 01231 RR ALF $, $ 01232 RRDATE1 BZS DATE1(3) LAST SAVE DATE OF VOL 1 01233 RR ALF $, $ 01234 RRV1TYP BZS V1TYP(3) TYPE OF VOLUME 1 01235 RR EQU MESLN7(*-MESS07) 01236 RR* 01237 RRMESS08 ALF $, TO $ 01238 RRNAME2 BZS NAME2(4) NAME OF VOLUME 2 01239 RR ALF $, $ 01240 RRDATE2 BZS DATE2(3) LAST SAVE DATE OF VOL 2 01241 RR ALF $, $ 01242 RRV2TYP BZS V2TYP(3) TYPE OF VOLUME 2 01243 RR EQU MESLN8(*-MESS08) 01244 RR* 01245 RRMESS09 NUM $0A0D 01246 RR ALF $,WARNING - YOU ARE COPYING FROM A BACKUP TO A MASTER $ 01247 RR ALF $,VOLUME$ 01248 RR EQU MESLN9(*-MESS09) 01249 RR* 01250 RRMESS10 NUM $0A0D 01251 RR ALF $,WARNING - VOLUME NAMES DO NOT COINCIDE$ 01252 RR EQU MESL10(*-MESS10) 01253 RR* 01254 RRMESS11 NUM $0A0D 01255 RR ALF $,WARNING - DATE ON COPY TO VOLUME IS THE SAME AS OR$ 01256 RR ALF $, LATER THAN $ 01257 RR NUM $000D 01258 RR ALF $, DATE ON COPY FROM VOLUME$ 01259 RR EQU MESL11(*-MESS11) 01260 RR* 01261 RRMESS12 NUM $0A0D 01262 RR ALF $,TYPE GO TO CONTINUE, EX TO EXIT$ 01263 RR EQU MESL12(*-MESS12) 01264 RR* 01265 RRMESS13 NUM $0A0D XXXX 01266 RR ALF $, DESIGNATE COPY 'TO' PACK AS: MASTER=1 BACKUP=0 ?$ 01267 RR EQU MESL13(*-MESS13) XXXX 01268 RRMESS14 NUM $1800 01269 RR ALF $,NUMBER OF PACKS NEEDED FOR THIS COPY = $ 01270 RRNWMP NUM $2020 01271 RR EQU MESL14(*-MESS14) 01272 RR* 01273 RRMESS15 ALF $,PACK NUMBER $ 01274 RRPKNO NUM $2020 01275 RR ALF $,MOUNTED, SHOULD BE PACK NUMBER $ 01276 RRSPKNO NUM $2020 01277 RR ALF $, VERIFY $ 01278 RR EQU MESL15(*-MESS15) 01279 RR* 01280 RRMESS16 ALF $, MULTIPLE COPY - MOUNT NEXT PACK NUMBER $ 01281 RRPKM NUM $2020 01282 RR ALF $, VERIFY $ 01283 RR EQU MESL16(*-MESS16) 01284 RR* 01285 RRMESS17 ALF $, DRIVE/DISK ARE INCOMPATIBLE AS TO WORDS/SECTOR $ 01286 RR ALF $, REMOUNT AND TRY AGAIN $ 01287 RR EQU MESL17(*-MESS17) 01288 RR EJT 01289 RR* MASS MEMORY READ/WRITE ROUTINES 01290 RR* 01291 RR* CALL SEQUENCE IS: 01292 RR* RTJ MMREAD/MMWRIT 01293 RR* ADC ---- 1. BUFFER ADDRESS 01294 RR* ADC ---- 2. NO. OF WORDS 01295 RR* ADC ---- 3. LOGICAL UNIT 01296 RR* ADC ---- 4. INDEX OFFSET FROM 1ST WORD 01297 RR* ADC ---- 5. MSB SECTOR ADDERSS 01298 RR* ADC ---- 6. LSB SECTOR ADDRESS 01299 RR* 01300 RR* NOTE THAT WORDS 2-6 ARE VALUES - NOT ADDRESSES OF WORDS CONTAIN- 01301 RR* ING THE VALUES 01302 RR SPC 2 01303 RR* M A S S M E M O R Y R E A D R O U T I N E 01304 RR* 01305 RRMMREAD 000 000 01306 RR LDQ* MMREAD 01307 RR LDA =N$420 SET A TO READ CODE PLUS D BIT 01308 RR JMP* REDWRT 01309 RR SPC 2 01310 RR* M A S S M E M O R Y W R I T E R O U T I N E 01311 RR* 01312 RRMMWRIT 000 000 01313 RR LDQ* MMWRIT 01314 RR LDA =N$440 SET A TO WRITE CODE PLUS D BIT 01315 RR SPC 2 01316 RRREDWRT EOR- $EF 01317 RR ALS 4 USE PRIORITY LEVEL FOR RP AND CP 01318 RR EOR- $EF 01319 RR STA* DICODE STORE IN I/O REQUEST 01320 RR STQ- I Q= ADDRESS OF FIRST PARAMETER 01321 RR INQ 6 01322 RR STQ* MMWRIT SETUP RETURN 01323 RR* 01324 RR LDA- (ZERO),I 01325 RR STA* DIBADR SET STARTING ADDRESS 01326 RR LDA- 1,I 01327 RR STA* DINWDS SET NUMBER OF WORDS 01328 RR LDA- 2,I 01329 RR STA* DILOGU SET LOGICAL UNIT 01330 RR* 01331 RR EJT 01332 RR LDA- 4,I COMPUTE MSB/LSB MASS MEMORY ADDRESS 01333 RR STA* MB 01334 RR LDA- 5,I SET UP FOR USE OF DWMUL 01335 RR STA* LB 01336 RR RTJ* IMHERE GET ABSOLUTE ADDRESS OF DICOMP AND PARBUF 01337 RRIMHERE 000 000 01338 RR LDA* IMHERE 01339 RR ADD =XDICOMP-IMHERE 01340 RR STA* DICADR STORE COMPLETION ADDRESS 01341 RR INA 1 01342 RR TRA Q ABS ADDRESS OF PARBUF TO Q 01343 RR RTJ DWMUL MULTIPLY SECTOR ADDRESS BY WORDS PER SECTOR 01344 RR LDQ* MBRSLT GET RESULT AND DO DOUBLE PRECISION ADD OF 01345 RR LDA* LBRSLT INDEX OFFSET 01346 RR ADD- 3,I 01347 RR SAP STORIT 01348 RR INQ 1 01349 RR AND- ONEMSK+14 01350 RRSTORIT STQ* DIOMSB STORE MSB/LSB RESULT 01351 RR STA* DIOLSB 01352 RR* 01353 RR RTJ- ($F4) PLACE I/O REQUEST 01354 RRDICODE NUM 0 1. I/O CODE, RP, CP 01355 RRDICADR NUM 0 2. COMPLETION ADDRESS 01356 RR NUM 0 3. THREAD WORD 01357 RRDILOGU NUM 0 4. LOGICAL UNIT NUMBER 01358 RRDINWDS NUM 96 5. BUFFER LENGTH 01359 RRDIBADR ADC DABUFR 6. BUFFER ADDRESS 01360 RRDIOMSB NUM 0 7. MSB FOR I/O 01361 RRDIOLSB NUM 0 8. LSB FOR I/O 01362 RR JMP- (DISP) 01363 RR* 01364 RRDICOMP JMP* (MMWRIT) RETURN WITH COMPLETION STATUS IN Q-REG 01365 RR SPC 2 01366 RR* PARAMETER LIST FOR DWMUL CALL - MUST FOLLOW 01367 RR* DICOMP. 01368 RRMB NUM 0 DWV - MSB 01369 RRLB NUM 0 DWV - LSB 01370 RR NUM 96 NUMBER TO MULTIPLY BY - WORDS PER SECTOR 01371 RRMBRSLT NUM 0 RESULT - MSB 01372 RRLBRSLT NUM 0 01373 RR NUM 0 STATUS WORD 01374 RR EJT 01375 RR* THIS PACKAGE PROVIDES SUBROUTINES TO PERFORM 01376 RR* FOUR DOUBLE WORD ARITHMETIC OPERATIONS. 01377 RR* THE DOUBLE WORD FORMAT IS THE SAME AS THE 01378 RR* MSB/LSB FORMAT USED FOR SECTOR AND WORD 01379 RR* ADDRESSING: WORD 1 OF A DOUBLE WORD VALUE 01380 RR* CONTAINS THE UPPER 15 BITS OF THE VALUE - AN 01381 RR* INTEGRAL MULTIPLE OF 32767, WORD 2 CONTAINS 01382 RR* THE LOWER 15 BITS OF THE VALUE (BIT 15 = 0). 01383 RR* IN THE FOLLOWING DESCRIPTIONS 'DWV' REFERS TO 01384 RR* 'DOUBLE WORD VALUE'. 01385 RR* 01386 RR* THE FOLLOWING OPERATIONS ARE IMPLEMENTED: 01387 RR* ADD A DWV TO A 2ND DWV 01388 RR* SUBTRACT A DWV FROM ANOTHER DWV 01389 RR* MULTIPLE A DWV BY A SINGLE WORD VALUE 01390 RR* DIVIDE A DWV BY A SINGLE WORD VALUE 01391 RR* 01392 RR* TO UTILIZE ONE OF THESE ROUITNES, THE CALLER 01393 RR* STORES THE VALUES TO BE OPERATED ON IN AN 01394 RR* ARRAY, SETS THE Q-REGISTER TO THE ADDRESS OF 01395 RR* THE ARRAY AND EXECUTES A RTJ TO THE APPROPRI- 01396 RR* ATE ROUTINE. THE I REGISTER CONTENTS WILL BE 01397 RR* SAVED AND RESTORED PRIOR TO RETURN TO THE 01398 RR* CALLER. THE COMPLETION STATUS WILL BE 0 IF 01399 RR* GOOD, ELSE IT WILL BE NON-ZERO. 01400 RR EJT 01401 RR* THE ARRAY PARAMETER LISTS ARE AS FOLLOWS: 01402 RR* FOR DWADD 01403 RR* WORD DESCRIPTION 01404 RR* 1 MSB OF 1ST DWV 01405 RR* 2 LSB OF 1ST DMV 01406 RR* 3 MSB OF 2ND DMV 01407 RR* 4 LSB OF 2ND DMV 01408 RR* 5 MSB OF RESULT DMV 01409 RR* 6 LSB OF RESULT DMV 01410 RR* 7 COMPLETION STATUS 01411 RR* 01412 RR* FOR DWSUB 01413 RR* WORD DESCRIPTION 01414 RR* 1 MSB OF MINUEND 01415 RR* 2 LSB OF MINUEND 01416 RR* 3 MSB OF SUBTRAHEND 01417 RR* 4 LSB OF SUBTRAHEND 01418 RR* 5 MSB OF RESULT 01419 RR* 6 LSB OF RESULT 01420 RR* 7 COMPLETION STATUS 01421 RR* FOR DWMUL 01422 RR* WORD DESCRIPTION 01423 RR* 1 MSB OF DWV 01424 RR* 2 LSB OF DMV 01425 RR* 3 SINGLE WORD VALUE 01426 RR* 4 MSB OF RESULT 01427 RR* 5 LSB OF RESULT 01428 RR* 6 COMPLETION STATUS 01429 RR* 01430 RR EJT 01431 RRDWADD 000 000 DOUBLE WORD ADD ROUTINE 01432 RRA1 LDA- I SAVE I-REG CONTENTS 01433 RR STA* ISAVE 01434 RR STQ- I SET I TO ARRAY ADDRESS 01435 RR LDA- 1,I SET A TO LSB 01436 RR ENQ 0 CLEAR Q FOR USE AS MSB OFFSET 01437 RR SOV 0 CLEAR OVERFLOW STATUS 01438 RR ADD- 3,I ADD LSB 01439 RR SNO A2 SKIP TO A3 IF NO OVERFLOW 01440 RR AND- ONEMSK+14 MASK OUT BIT 15 01441 RR INQ 1 BUMP Q TO PUT OVERFLOW IN MSB 01442 RRA2 SAP A3 SKIP IF RESULT POSITIVE 01443 RR INQ -1 SUBTRACT 1 FROM Q FOR MSB OFFSET 01444 RR ADD- ONEBIT+15 MAKE LSW POSITIVE 01445 RRA3 STA- 5,I STORE LSB 01446 RR TRQ A TRANSFER MSB OFFSET TO A 01447 RR SOV 0 CLEAR OVERFLOW 01448 RR ADD- (ZERO),I ADD THE TWO MSBS TO THE OFFSET 01449 RR ADD- 2,I 01450 RR STA- 4,I STORE MSB 01451 RR ENQ 0 CLEAR Q FOR COMPLETION STATUS 01452 RR SOV A4 SET TO BAD COMPLETION IF OVERFLOW OR A-REG NEG 01453 RR SAP A5 01454 RRA4 ENQ 1 01455 RRA5 STQ- 6,I 01456 RR LDA- 2,I COMPLEMENT 2ND DWV IF COMPLEMENTED BY US 01457 RR SAP A6 SKIP IF NOT COMPLEMENTED 01458 RR TCA A 01459 RR STA- 2,I 01460 RR LDA- 3,I 01461 RR TCA A 01462 RR STA- 3,I 01463 RRA6 LDA* ISAVE RESTORE I-REG 01464 RR STA- I 01465 RR JMP* (DWADD) 01466 RR SPC 4 01467 RRISAVE NUM 0 01468 RR EJT 01469 RRDWSUB 000 0 DOUBLE WORD SUBTRACT ROUTINE 01470 RR LDA* DWSUB 01471 RR STA* DWADD STORE RETURN ADDRESS IN DWADD'S ENTRY POINT 01472 RR LDA- 2,Q COMPLEMENT SUBTRAHEND AND USE DWADD TO ADD 01473 RR TCA A 01474 RR STA- 2,Q 01475 RR LDA- 3,Q 01476 RR TCA A 01477 RR STA- 3,Q 01478 RR JMP* A1 01479 RR EJT 01480 RRDWMUL 000 000 DOUBLE WORD MULTIPLY 01481 RR LDA- I 01482 RR STA* ISAVE SAVE I-REG 01483 RR STQ- I SET I TO ARRAY ADDRESS 01484 RR LDA- 1,I SET A TO LSB OF DOUBLE WORD VALUE 01485 RR MUI- 2,I MULTIPLY BY SINGLE WORD VALUE 01486 RR LLS 1 01487 RR ALS 15 CONVERT TO DOUBLE PRECISION FORMAT 01488 RR STQ* SAVE SAVE MSB 01489 RR STA- 4,I STORE LSB IN RESULT 01490 RR LDA- (ZERO),I 01491 RR MUI- 2,I MULTIPLY MSB BY SINGLE WORD 01492 RR LLS 1 01493 RR ALS 15 DOUBLE PRECISION FORMAT 01494 RR SOV 0 CLEAR OVERFLOW 01495 RR INQ 0 CHECK FOR OVERFLOW 01496 RR SQZ 2 01497 RR LDQ- $11 SET OVERFLOW IND 01498 RR INQ 1 01499 RR LDQ* SAVE ADD MSB THAT WAS SAVED 01500 RR AAQ Q ADD IN RESULT FROM MSB MULTIPLY 01501 RR STQ- 3,I STORE IN RESULT 01502 RR CLR A 01503 RR SOV M0 SKIP IF OVERFLOW 01504 RR SQP M1 01505 RRM0 INA 1 01506 RRM1 STA- 5,I SET STATUS WORD, 0 IF GOOD, 1 IF BAD 01507 RR LDA* ISAVE RESTORE I-REG 01508 RR STA- I 01509 RR JMP* (DWMUL) RETURN TO CALLER 01510 RR SPC 2 01511 RRSAVE NUM 0 01512 RR EJT 01513 RR SPC 1 01514 RRVLBUF1 BZS VLBUF1(96) VOLUME ONE LABEL BUFFER 01515 RRVLBUF2 BZS VLBUF2(96) VOLUME TWO LABEL BUFFER 01516 RR SPC 1 01517 RRDABUFR BZS DABUFR(96) DATA BUFFER 01518 RRITEMP BZS ITEMP(3) DATE BUFFER 01519 RR SPC 2 01520 RRPGMEND EQU PGMEND(*) 01521 RR END 01522 RR NAM GTLOAD B28 A ITOS CCS 3.0 SL-149B2800001 RR* START ROUTINE FOR COMMAND PROCESSOR LOAD B2800002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B2800003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B2800004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B2800005 RR* B2800006 RR* B2800007 RR* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B2800008 RR* AN ENTRY POINT FOR THE COMMAND PROCESSOR LOAD B2800009 RR* IN OREDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B2800010 RR* B2800011 RR* B2800012 RR* B2800013 RR ENT MARKER B2800014 RR ENT UTSTRT B2800015 RR* B2800016 RR EXT PRELOD B2800017 RR* B2800018 RRMARKER NOP 0 B2800019 RR RTJ PRELOD B2800020 RR JMP* (MARKER) B2800021 RR* B2800022 RR EQU UTSTRT(MARKER) B2800023 RR* B2800024 RR END B2800025 RR NAM REDREC B29 A ITOS CCS 3.0 SL-149B2900001 RR* READ ONE RECORD FROM SPECIFIED UNIT B2900002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4863B2900003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B2900004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B2900005 RR* B2900006 RR* B2900007 RR**** B2900008 RR* B2900009 RR* FUNCTION B2900010 RR* B2900011 RR* THIS ROUTINE READS ONE RECORD FROM THE SPECIFIED LU B2900012 RR* INTO A SPECIFIED BUFFER B2900013 RR* B2900014 RR* B2900015 RR* CALLING SEQUENCE B2900016 RR* B2900017 RR* CALL REDREC (LOGUNT,RECLEN,RECBUF,ISTAT) B2900018 RR* B2900019 RR* LOGUNT = LOGICAL UNIT NO TO READ FROM B2900020 RR* RECLEN = RECORD LENGTH IN WORDS B2900021 RR* RECBUF = BUFFER TO READ INTO B2900022 RR* ISTAT = RETURN STATUS OF READ RECORD B2900023 RR* B2900024 RR* B2900025 RR* ENTRY POINT B2900026 RR* B2900027 RR ENT REDREC B2900028 RR* B2900029 RR* B2900030 RR* EXTERNALS B2900031 RR* B2900032 RR EXT Q8PKUP B2900033 RR EXT Q8PREP B2900034 RR* B2900035 RR EQU DISP($EA) B2900036 RR EQU ZROBIT($33) B2900037 RR EQU ONEBIT($23) B2900038 RR EQU ZERO($22) B2900039 RR* B2900040 RR**** B2900041 RRREDREC NOP B2900042 RR STQ* QSAVE SAV Q-REGISTER B2900043 RR LDA- I B2900044 RR STA* ISAVE SAVE I-REGISTER B2900045 RR* B2900046 RR RTJ Q8PREP ABSOLUTIZE PARAMETER ADDR B2900047 RR ADC* REDREC B2900048 RRHERE RTJ Q8PKUP PICK UP THE PARAMETERS B2900049 RR STA* LUNIT B2900050 RR RTJ* (HERE+1) B2900051 RR STA* RECLEN B2900052 RR RTJ* (HERE+1) B2900053 RR STA* RECBUF B2900054 RR RTJ* (HERE+1) B2900055 RR STA* ISTAT B2900056 RR* B2900057 RR LDA* (LUNIT) SET UP THE READ PARAMETER LIST B2900058 RR AND- ZROBIT+12 B2900059 RR EOR- ONEBIT+12 SET BIT 12 FOR WORD MODE B2900060 RR STA* UNIT B2900061 RR LDA* (RECLEN) B2900062 RR STA* LNG B2900063 RR* B2900064 RR* PERFORM THE READ REQUEST B2900065 RR* B2900066 RR RTJ- ($F4) B2900067 RR NUM $4800 FREAD B2900068 RR ADC COMPL B2900069 RR NUM 0 B2900070 RRUNIT NUM 0 B2900071 RRLNG NUM 0 B2900072 RRRECBUF NUM 0 B2900073 RR JMP- (DISP) B2900074 RRC B2900075 RRCOMPL SQM EOF B2900076 RR LDA* (RECBUF) CHECK FOR PSEUDO EOF (/*) B2900077 RR SUB* PSDEOF B2900078 RR SAZ EOF1 PSEUDO EOF FOUND B2900079 RR CLR A B2900080 RR STA* (ISTAT) B2900081 RR* B2900082 RREXIT LDQ* QSAVE B2900083 RR LDA* ISAVE B2900084 RR STA- I B2900085 RR JMP* (REDREC) B2900086 RR* B2900087 RR* ERROR WAS DETECTED,TRADE LIKE AN EOF B2900088 RR* B2900089 RREOF STQ* (ISTAT) B2900090 RR JMP* EXIT B2900091 RR* B2900092 RREOF1 ENQ -1 B2900093 RR JMP* EOF B2900094 RR* B2900095 RR* LOCAL VARIABLES B2900096 RR* B2900097 RRQSAVE NUM 0 B2900098 RRISAVE NUM 0 B2900099 RRLUNIT NUM 0 B2900100 RRRECLEN NUM 0 B2900101 RRISTAT NUM 0 B2900102 RRPSDEOF NUM $2F21 /! 122*4863B2900103 RR END B2900104 RR NAM GTPURG B30 A ITOS CCS 3.0 SL-149B3000001 RR* START ROUTINE FOR COMMAND PROCESSOR PURGE B3000002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B3000003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B3000004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B3000005 RR* B3000006 RR* B3000007 RR* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B3000008 RR* AN ENTRY POINT FOR THE COMMAND PROCESSOR PURGE B3000009 RR* IN OREDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B3000010 RR* B3000011 RR* B3000012 RR* B3000013 RR* LABELED COMMON AREA B3000014 RR* B3000015 RR DAT COMCOD(89),PARNAM(83) 122*4875B3000016 RR DAT PPHELP(2) B3000017 RR DAT PPINIT(4) B3000018 RR DAT PPDEFI(16) B3000019 RR DAT PPSTAT(4) B3000020 RR DAT PPRELO(5) 122*4875B3000021 RR DAT PPDUMP(5) 122*4875B3000022 RR DAT PPCOPY(6) B3000023 RR DAT PPDELE(3) B3000024 RR DAT PPCLEA(3) B3000025 RR DAT PPLIST(6) 122*4875B3000026 RR DAT PPRENA(5) B3000027 RR DAT PPCOMM(2) B3000028 RR DAT PPEXIT(1) B3000029 RR DAT PPMOUN(3) B3000030 RR DAT PPDISM(2) B3000031 RR DAT PPSAVE(3) B3000032 RR DAT PPBATC(7) 122*4875B3000033 RR DAT PPLOAD(5) B3000034 RR DAT PPPURG(3) B3000035 RR DAT PPINPU(2) B3000036 RR DAT PPOUTP(2) B3000037 RR DAT PPCOMP(3) B3000038 RR DAT DUMMY(6) B3000039 RR DAT INBUF(41),CODE(20) B3000040 RR DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B3000041 RR DAT REQBUF(24),IDATA(24) B3000042 RR DAT PARDEF(24) B3000043 RR DAT FCBHDR(5) B3000044 RR DAT FCBBUF(96) B3000045 RR EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B3000046 RR EQU COMLEN(ENDCOM-COMCOD) B3000047 RR* B3000048 RR ENT MARKER B3000049 RR ENT UTSTRT B3000050 RR* B3000051 RR EXT PURGE B3000052 RR* B3000053 RRMARKER NOP 0 B3000054 RR RTJ PURGE B3000055 RR JMP* (MARKER) B3000056 RR* B3000057 RR EQU UTSTRT(MARKER) B3000058 RR* B3000059 RR END B3000060 RR NAM GETBAT B31 A ITOS CCS 3.0 SL-149B3100001 RR* START ROUTINE FOR COMMAND PROCESSOR BATCH B3100002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B3100003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B3100004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B3100005 RR* B3100006 RR* LABELED COMMON AREA B3100007 RR* B3100008 RR DAT COMCOD(133),PARNAM(121) B3100009 RR DAT PPHELP(2) B3100010 RR DAT PPINIT(4) B3100011 RR DAT PPDEFI(16) B3100012 RR DAT PPSTAT(4) B3100013 RR DAT PPRELO(4) B3100014 RR DAT PPDUMP(4) B3100015 RR DAT PPCOPY(6) B3100016 RR DAT PPDELE(3) B3100017 RR DAT PPCLEA(3) B3100018 RR DAT PPLIST(5) B3100019 RR DAT PPRENA(5) B3100020 RR DAT PPCOMM(2) B3100021 RR DAT PPEXIT(1) B3100022 RR DAT PPMOUN(3) B3100023 RR DAT PPDISM(2) B3100024 RR DAT PPSAVE(3) B3100025 RR DAT PPBATC(5) B3100026 RR DAT PPLOAD(5) B3100027 RR DAT PPPURG(3) B3100028 RR DAT PPINPU(2) B3100029 RR DAT PPOUTP(2) B3100030 RR DAT PPCOMP(3) B3100031 RR DAT PPHOST(4) B3100032 RR DAT PPSET(3) B3100033 RR DAT PPBATS(4) B3100034 RR DAT PPDISC(2) B3100035 RR DAT PPDISP(7) B3100036 RR DAT PPFLUS(3) B3100037 RR DAT PPPRIN(3) B3100038 RR DAT DUMMY(6) B3100039 RR DAT INBUF(41),CODE(20) B3100040 RR DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B3100041 RR DAT REQBUF(24),IDATA(24) B3100042 RR DAT PARDEF(24) B3100043 RR DAT FCBHDR(5) B3100044 RR DAT FCBBUF(96) B3100045 RR EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B3100046 RR EQU COMLEN(ENDCOM-COMCOD) B3100047 RR ENT MARKER B3100048 RR ENT UTSTRT B3100049 RR* B3100050 RR EXT BATC B3100051 RRMARKER NOP 0 B3100052 RR RTJ BATC B3100053 RR JMP* (MARKER) B3100054 RR* B3100055 RR EQU UTSTRT(MARKER) B3100056 RR* B3100057 RR END B3100058 RR NAM CNTCHR B32 A ITOS CCS 3.0 SL-149B3200001 RR* COUNT NO. OF CHAR IN INPUT FIELD B3200002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4873B3200003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B3200004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B3200005 RR* B3200006 RR**** 122*4873B3200007 RR* 122*4873B3200008 RR* FUNCTION 122*4873B3200009 RR* 122*4873B3200010 RR* B3200011 RR* THIS PROGRAM COUNTS THE NUMBER OF CHARACTERS OF THE INPUT FIELD B3200012 RR* B3200013 RR* CALLING SEQUENCE B3200014 RR* B3200015 RR* CALL CNTCHR(BUF,CNT) B3200016 RR* B3200017 RR* BUF INPUT BUFFER B3200018 RR* CNT CHAR. COUNT B3200019 RR* B3200020 RR EQU LPMASK($2) B3200021 RR EQU BLANK($20) B3200022 RR* B3200023 RR EXT Q8PREP B3200024 RR EXT Q8PKUP B3200025 RR ENT CNTCHR B3200026 RR* B3200027 RR**** 122*4873B3200028 RRCNTCHR NOP 0 B3200029 RR STQ* QSAVE SAVE REGISTERS B3200030 RR LDA- I B3200031 RR STA* ISAVE B3200032 RR* B3200033 RR RTJ Q8PREP GET PARAMETERS B3200034 RR ADC* CNTCHR B3200035 RR* B3200036 RRHERE RTJ Q8PKUP B3200037 RR STA* BUF B3200038 RR RTJ* (HERE+1) B3200039 RR STA* CNT B3200040 RR* B3200041 RR CLR Q B3200042 RR STQ* (CNT) B3200043 RR* B3200044 RRLOOP LDA* (BUF),Q GET NEXT WORD OF INPUT B3200045 RR ARS 8 TEST UPPER HALF B3200046 RR AND- LPMASK+8 B3200047 RR INA -BLANK B3200048 RR SAZ TSTLOW UPPER HALF IS A BLANK B3200049 RR RAO* (CNT) NOT A BLANK,INCR COUNTER B3200050 RR* B3200051 RRTSTLOW LDA* (BUF),Q TST LOWER HALF B3200052 RR AND- LPMASK+8 B3200053 RR INA -BLANK B3200054 RR SAZ TSTEND B3200055 RR RAO* (CNT) B3200056 RR* B3200057 RRTSTEND INQ -2 ALL DONE ? B3200058 RR SQZ END YES B3200059 RR INQ 3 NO B3200060 RR JMP* LOOP B3200061 RR* B3200062 RREND LDQ* QSAVE RESTORE REGISTERS B3200063 RR LDA* ISAVE B3200064 RR STA- I B3200065 RR JMP* (CNTCHR) B3200066 RR* B3200067 RR* LOCAL VARIABLES B3200068 RR* B3200069 RRQSAVE NUM 0 B3200070 RRISAVE NUM 0 B3200071 RRBUF NUM 0 B3200072 RRCNT NUM 0 B3200073 RR* B3200074 RR END B3200075 RR NAM GTCOMP B33 A ITOS CCS 3.0 SL-149B3300001 RR* START ROUTINE FOR COMMAND PROCESSOR COMPRESS B3300002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B3300003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B3300004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B3300005 RR* B3300006 RR* B3300007 RR* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B3300008 RR* AN ENTRY POINT FOR THE COMMAND PROCESSOR COMPRES B3300009 RR* IN OREDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B3300010 RR* B3300011 RR* B3300012 RR* B3300013 RR* LABELED COMMON AREA B3300014 RR* B3300015 RR DAT COMCOD(89),PARNAM(83) 122*4875B3300016 RR DAT PPHELP(2) B3300017 RR DAT PPINIT(4) B3300018 RR DAT PPDEFI(16) B3300019 RR DAT PPSTAT(4) B3300020 RR DAT PPRELO(5) 122*4875B3300021 RR DAT PPDUMP(5) 122*4875B3300022 RR DAT PPCOPY(6) B3300023 RR DAT PPDELE(3) B3300024 RR DAT PPCLEA(3) B3300025 RR DAT PPLIST(6) 122*4875B3300026 RR DAT PPRENA(5) B3300027 RR DAT PPCOMM(2) B3300028 RR DAT PPEXIT(1) B3300029 RR DAT PPMOUN(3) B3300030 RR DAT PPDISM(2) B3300031 RR DAT PPSAVE(3) B3300032 RR DAT PPBATC(7) 122*4875B3300033 RR DAT PPLOAD(5) B3300034 RR DAT PPPURG(3) B3300035 RR DAT PPINPU(2) B3300036 RR DAT PPOUTP(2) B3300037 RR DAT PPCOMP(3) B3300038 RR DAT DUMMY(6) B3300039 RR DAT INBUF(41),CODE(20) B3300040 RR DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B3300041 RR DAT REQBUF(24),IDATA(24) B3300042 RR DAT PARDEF(24) B3300043 RR DAT FCBHDR(5) B3300044 RR DAT FCBBUF(96) B3300045 RR EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B3300046 RR EQU COMLEN(ENDCOM-COMCOD) B3300047 RR* B3300048 RR ENT MARKER B3300049 RR ENT UTSTRT B3300050 RR* B3300051 RR EXT COMPRES B3300052 RR* B3300053 RRMARKER NOP 0 B3300054 RR RTJ COMPRES B3300055 RR JMP* (MARKER) B3300056 RR* B3300057 RR EQU UTSTRT(MARKER) B3300058 RR* B3300059 RR END B3300060 RR NAM GTRELO B34 A ITOS CCS 3.0 SL-149B3400001 RR* START ROUTINE FOR COMMAND PROCESSOR RELOAD B3400002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 122*4875B3400003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B3400004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B3400005 RR* B3400006 RR* B3400007 RR* THE ONLY PURPOSE OF THIS PROGRAM IS TO CREATE B3400008 RR* AN ENTRY POINT FOR THE COMMAND PROCESSOR RELOAD B3400009 RR* IN ORDER TO LOAD IT AT THE TOP OF THE EXECUTIVE B3400010 RR* B3400011 RR* B3400012 RR* B3400013 RR* LABELED COMMON AREA B3400014 RR* B3400015 RR DAT COMCOD(89),PARNAM(83) 122*4875B3400016 RR DAT PPHELP(2) B3400017 RR DAT PPINIT(4) B3400018 RR DAT PPDEFI(16) B3400019 RR DAT PPSTAT(3) B3400020 RR DAT PPRELO(5) 122*4875B3400021 RR DAT PPDUMP(5) 122*4875B3400022 RR DAT PPCOPY(5) B3400023 RR DAT PPDELE(3) B3400024 RR DAT PPCLEA(3) B3400025 RR DAT PPLIST(6) 122*4875B3400026 RR DAT PPRENA(5) B3400027 RR DAT PPCOMM(2) B3400028 RR DAT PPEXIT(1) B3400029 RR DAT PPMOUN(3) B3400030 RR DAT PPDISM(2) B3400031 RR DAT PPSAVE(3) B3400032 RR DAT PPBATC(7) 122*4875B3400033 RR DAT PPLOAD(5) B3400034 RR DAT PPPURG(3) B3400035 RR DAT PPINPU(2) B3400036 RR DAT PPOUTP(2) B3400037 RR DAT PPCOMP(3) B3400038 RR DAT DUMMY(6) B3400039 RR DAT INBUF(41),CODE(20) B3400040 RR DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B3400041 RR DAT REQBUF(24),IDATA(24) B3400042 RR DAT PARDEF(24) B3400043 RR DAT FCBHDR(5) B3400044 RR DAT FCBBUF(96) B3400045 RR EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B3400046 RR EQU COMLEN(ENDCOM-COMCOD) B3400047 RR* B3400048 RR ENT MARKER B3400049 RR ENT UTSTRT B3400050 RR* B3400051 RR EXT RELOAD B3400052 RR* B3400053 RRMARKER NOP 0 B3400054 RR RTJ RELOAD B3400055 RR JMP* (MARKER) B3400056 RR* B3400057 RR EQU UTSTRT(MARKER) B3400058 RR* B3400059 RR END B3400060 RR NAM CHARMV B35 A ITOS CCS 3.0 SL-149B3500001 RR* CHARACTER MOVE ROUTINE B3500002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B3500003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B3500004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B3500005 RR* B3500006 RR* CALLING SEQUENCE B3500007 RR* CALL CHARMV (IBUFRM,IFRMX,IBUFTO,ITOX,INOZMV) B3500008 RR* WHERE - IBUFRM = ARRAY FROM WHICH CHAR IS TO BE MOVED B3500009 RR* IFRMX = CHAR INDEX INTO IBUFRM(0-N) B3500010 RR* IBUFTO = ARRAY TO WHICH CHAR IS TO BE MOVED B3500011 RR* ITOX = CHAR INDEX INTO BUFTO (0-N) B3500012 RR* INOZMV = NO. OF CHARACTERS TO MOVE (1-P) B3500013 RR SPC 2 B3500014 RR ENT CHARMV B3500015 RR EXT Q8PREP,Q8PKUP B3500016 RR EQU ZERO($22) B3500017 RRCHARMV 0 0 B3500018 RR STQ* QSAVE B3500019 RR RTJ Q8PREP B3500020 RR ADC (CHARMV-*) B3500021 RR RTJ Q8PKUP B3500022 RR STA* AIBUFR =ADDR OF IBUFRM ARRAY B3500023 RR RTJ Q8PKUP B3500024 RR TRA Q B3500025 RR LDA- (ZERO),Q B3500026 RR STA* IFRMX B3500027 RR RTJ Q8PKUP B3500028 RR STA* AIBUFT =ADDR OF IBUFTO ARRAY B3500029 RR RTJ Q8PKUP B3500030 RR TRA Q B3500031 RR LDA- (ZERO),Q B3500032 RR STA* ITOX B3500033 RR RTJ Q8PKUP B3500034 RR TRA Q B3500035 RR LDQ- (ZERO),Q =NO OF CHAR TO MOVE B3500036 RR LR1* IFRMX B3500037 RR LR2* ITOX B3500038 RRCHAR01 INQ -1 B3500039 RR SQP CHAR04 B3500040 RR JMP* JMPIT B3500041 RRCHAR04 LDA* ESC CHECK FOR ESCAPE CODE ($1B) B3500042 RR CCE* (AIBUFR),1 B3500043 RR JMP* CHAR00 NO COMPARE, NOT ESCAPE CODE B3500044 RR LDA* TWENTY BLANK ESCAPE CODE AND FOLLOWING CONTROL CHARACB3500045 RR RTJ* STORIT B3500046 RR RTJ* STORIT B3500047 RR INQ -1 B3500048 RR JMP* CHAR01 B3500049 RRCHAR00 LCA* (AIBUFR),1 B3500050 RR SUB* SIXTY CHECK IF CHAR GREATER THAN $5F B3500051 RR SAM CHKAGN B3500052 RR LDA* TWENTY REPLACE ILLEGAL CHAR WITH A BLANK B3500053 RR RTJ* STORIT B3500054 RR JMP* CHAR01 B3500055 RRJMPIT JMP* CHAR02 B3500056 RRCHKAGN LCA* (AIBUFR),1 B3500057 RR STA* TEMP B3500058 RR LDA* NINTEN B3500059 RR SUB* TEMP CHECK IF CHAR LESS THAN $20 B3500060 RR SAM OK B3500061 RR LDA* TWENTY REPLACE ILLEGAL CHAR WITH A BLANK B3500062 RR RTJ* STORIT B3500063 RR JMP* CHAR01 B3500064 RROK LCA* (AIBUFR),1 LEGAL ASCII CHARACTER B3500065 RR RTJ* STORIT B3500066 RR JMP* CHAR01 B3500067 RRSTORIT NUM 0 B3500068 RR SCA* (AIBUFT),2 B3500069 RR AR1* ONE B3500070 RR AR2* ONE B3500071 RR JMP* (STORIT) B3500072 RRCHAR02 LDQ* QSAVE B3500073 RR JMP* (CHARMV) B3500074 RRONE NUM 1 B3500075 RRQSAVE NUM 0 B3500076 RRIFRMX NUM 0 B3500077 RRITOX NUM 0 B3500078 RRAIBUFR NUM 0 B3500079 RRAIBUFT NUM 0 B3500080 RRNINTEN NUM $1F B3500081 RRTWENTY NUM $20 B3500082 RRSIXTY NUM $60 B3500083 RRESC NUM $1B B3500084 RRTEMP NUM 0 B3500085 RR END B3500086 RR NAM BMPRRN B36 A ITOS CCS 3.0 SL-149B3600001 RR* BUMP RELATIVE RECORD/BLOCK NUMBER B3600002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B3600003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B3600004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B3600005 RR* B3600006 RR**** B3600007 RR* BMPRRN BUMPS RELATIVE RECORD NUMBER OR RELATIVE BLOCK B3600008 RR* NUMBER BY 1. THE CALL SEQUENCE IS: B3600009 RR* B3600010 RR* CALL BMPRRN (RRN) B3600011 RR* B3600012 RR* WHERE RRN IS THE RELATIVE RECORD/BLOCK NUMBER TO BE B3600013 RR* INCREMENTED. B3600014 RR**** B3600015 RR SPC 2 B3600016 RR ENT BMPRRN ENTRY POINT B3600017 RR SPC 1 B3600018 RR EXT Q8PREP PREPARE TO PICKUP PARAMS B3600019 RR EXT Q8PKUP PICKUP PARAMS B3600020 RR SPC 2 B3600021 RRBMPRRN NUM 0 ENTRY B3600022 RR STQ* QSAVE SAVE Q B3600023 RR RTJ Q8PREP PREPARE TO PICKUP PARAM B3600024 RR ADC* BMPRRN B3600025 RR RTJ Q8PKUP GET RRN ADDRESS B3600026 RR TRA Q B3600027 RR STA* RRNADR SAVE ADDRESS B3600028 RR LDA- 1,Q SET A TO LSB AND Q TO MSB B3600029 RR LDQ* (RRNADR) B3600030 RR SAP BMP10 SKIP IF LSB IS 0-$7FFF B3600031 RR INA 0 CHECK FOR $FFFF B3600032 RR SAN BMP10 SKIP IF OLD LSB .NE. $FFFF B3600033 RR INQ 1 BUMP MSB B3600034 RR JMP* BMP20 B3600035 RR* B3600036 RRBMP10 INA 1 BUMP LSB WORD B3600037 RR SAN BMP20 SKIP IF OLD LSB .NE. $FFFE B3600038 RR SET A WAS $FFFE SO SET IT TO $FFFF B3600039 RRBMP20 STQ* (RRNADR) STORE NEW MSB/LSB B3600040 RR RAO* RRNADR B3600041 RR STA* (RRNADR) B3600042 RR LDQ* QSAVE RESTORE Q B3600043 RR JMP* (BMPRRN) RETURN B3600044 RR SPC 2 B3600045 RRQSAVE NUM 0 B3600046 RRRRNADR NUM 0 B3600047 RR END B3600048 RR NAM GTBATS B37 A ITOS CCS 3.0 SL-149B3700001 RR* START ROUTINE FOR COMMAND PROCESSOR BATS B3700002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B3700003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B3700004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B3700005 RR* B3700006 RR* LABELED COMMON AREA B3700007 RR* B3700008 RR DAT COMCOD(133),PARNAM(121) B3700009 RR DAT PPHELP(2) B3700010 RR DAT PPINIT(4) B3700011 RR DAT PPDEFI(16) B3700012 RR DAT PPSTAT(4) B3700013 RR DAT PPRELO(4) B3700014 RR DAT PPDUMP(4) B3700015 RR DAT PPCOPY(6) B3700016 RR DAT PPDELE(3) B3700017 RR DAT PPCLEA(3) B3700018 RR DAT PPLIST(5) B3700019 RR DAT PPRENA(5) B3700020 RR DAT PPCOMM(2) B3700021 RR DAT PPEXIT(1) B3700022 RR DAT PPMOUN(3) B3700023 RR DAT PPDISM(2) B3700024 RR DAT PPSAVE(3) B3700025 RR DAT PPBATC(5) B3700026 RR DAT PPLOAD(5) B3700027 RR DAT PPPURG(3) B3700028 RR DAT PPINPU(2) B3700029 RR DAT PPOUTP(2) B3700030 RR DAT PPCOMP(3) B3700031 RR DAT PPHOST(4) B3700032 RR DAT PPSET(3) B3700033 RR DAT PPBATS(4) B3700034 RR DAT PPDISC(2) B3700035 RR DAT PPDISP(7) B3700036 RR DAT PPFLUS(3) B3700037 RR DAT PPPRIN(3) B3700038 RR DAT DUMMY(6) B3700039 RR DAT INBUF(41),CODE(20) B3700040 RR DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B3700041 RR DAT REQBUF(24),IDATA(24) B3700042 RR DAT PARDEF(24) B3700043 RR DAT FCBHDR(5) B3700044 RR DAT FCBBUF(96) B3700045 RR EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B3700046 RR EQU COMLEN(ENDCOM-COMCOD) B3700047 RR ENT MARKER B3700048 RR ENT UTSTRT B3700049 RR* B3700050 RR EXT BATS B3700051 RRMARKER NOP 0 B3700052 RR RTJ BATS B3700053 RR JMP* (MARKER) B3700054 RR* B3700055 RR EQU UTSTRT(MARKER) B3700056 RR* B3700057 RR END B3700058 RR NAM GTDISC B38 A ITOS CCS 3.0 SL-149B3800001 RR* START ROUTINE FOR COMMAND PROCESSOR DISCARD B3800002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B3800003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B3800004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B3800005 RR* B3800006 RR* LABELED COMMON AREA B3800007 RR* B3800008 RR DAT COMCOD(133),PARNAM(121) B3800009 RR DAT PPHELP(2) B3800010 RR DAT PPINIT(4) B3800011 RR DAT PPDEFI(16) B3800012 RR DAT PPSTAT(4) B3800013 RR DAT PPRELO(4) B3800014 RR DAT PPDUMP(4) B3800015 RR DAT PPCOPY(6) B3800016 RR DAT PPDELE(3) B3800017 RR DAT PPCLEA(3) B3800018 RR DAT PPLIST(5) B3800019 RR DAT PPRENA(5) B3800020 RR DAT PPCOMM(2) B3800021 RR DAT PPEXIT(1) B3800022 RR DAT PPMOUN(3) B3800023 RR DAT PPDISM(2) B3800024 RR DAT PPSAVE(3) B3800025 RR DAT PPBATC(5) B3800026 RR DAT PPLOAD(5) B3800027 RR DAT PPPURG(3) B3800028 RR DAT PPINPU(2) B3800029 RR DAT PPOUTP(2) B3800030 RR DAT PPCOMP(3) B3800031 RR DAT PPHOST(4) B3800032 RR DAT PPSET(3) B3800033 RR DAT PPBATS(4) B3800034 RR DAT PPDISC(2) B3800035 RR DAT PPDISP(7) B3800036 RR DAT PPFLUS(3) B3800037 RR DAT PPPRIN(3) B3800038 RR DAT DUMMY(6) B3800039 RR DAT INBUF(41),CODE(20) B3800040 RR DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B3800041 RR DAT REQBUF(24),IDATA(24) B3800042 RR DAT PARDEF(24) B3800043 RR DAT FCBHDR(5) B3800044 RR DAT FCBBUF(96) B3800045 RR EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B3800046 RR EQU COMLEN(ENDCOM-COMCOD) B3800047 RR ENT MARKER B3800048 RR ENT UTSTRT B3800049 RR* B3800050 RR EXT DISC B3800051 RRMARKER NOP 0 B3800052 RR RTJ DISC B3800053 RR JMP* (MARKER) B3800054 RR* B3800055 RR EQU UTSTRT(MARKER) B3800056 RR* B3800057 RR END B3800058 RR NAM GTDISP B39 A ITOS CCS 3.0 SL-149B3900001 RR* START ROUTINE FOR COMMAND PROCESSOR DISPOSE B3900002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B3900003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B3900004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B3900005 RR* B3900006 RR* LABELED COMMON AREA B3900007 RR* B3900008 RR DAT COMCOD(133),PARNAM(121) B3900009 RR DAT PPHELP(2) B3900010 RR DAT PPINIT(4) B3900011 RR DAT PPDEFI(16) B3900012 RR DAT PPSTAT(4) B3900013 RR DAT PPRELO(4) B3900014 RR DAT PPDUMP(4) B3900015 RR DAT PPCOPY(6) B3900016 RR DAT PPDELE(3) B3900017 RR DAT PPCLEA(3) B3900018 RR DAT PPLIST(5) B3900019 RR DAT PPRENA(5) B3900020 RR DAT PPCOMM(2) B3900021 RR DAT PPEXIT(1) B3900022 RR DAT PPMOUN(3) B3900023 RR DAT PPDISM(2) B3900024 RR DAT PPSAVE(3) B3900025 RR DAT PPBATC(5) B3900026 RR DAT PPLOAD(5) B3900027 RR DAT PPPURG(3) B3900028 RR DAT PPINPU(2) B3900029 RR DAT PPOUTP(2) B3900030 RR DAT PPCOMP(3) B3900031 RR DAT PPHOST(4) B3900032 RR DAT PPSET(3) B3900033 RR DAT PPBATS(4) B3900034 RR DAT PPDISC(2) B3900035 RR DAT PPDISP(7) B3900036 RR DAT PPFLUS(3) B3900037 RR DAT PPPRIN(3) B3900038 RR DAT DUMMY(6) B3900039 RR DAT INBUF(41),CODE(20) B3900040 RR DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B3900041 RR DAT REQBUF(24),IDATA(24) B3900042 RR DAT PARDEF(24) B3900043 RR DAT FCBHDR(5) B3900044 RR DAT FCBBUF(96) B3900045 RR EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B3900046 RR EQU COMLEN(ENDCOM-COMCOD) B3900047 RR ENT MARKER B3900048 RR ENT UTSTRT B3900049 RR* B3900050 RR EXT DISPOS B3900051 RRMARKER NOP 0 B3900052 RR RTJ DISPOS B3900053 RR JMP* (MARKER) B3900054 RR* B3900055 RR EQU UTSTRT(MARKER) B3900056 RR* B3900057 RR END B3900058 RR NAM GTFLUS B40 A ITOS CCS 3.0 SL-149B4000001 RR* START ROUTINE FOR COMMAND PROCESSOR FLUSH B4000002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B4000003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B4000004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B4000005 RR* B4000006 RR* LABELED COMMON AREA B4000007 RR* B4000008 RR DAT COMCOD(133),PARNAM(121) B4000009 RR DAT PPHELP(2) B4000010 RR DAT PPINIT(4) B4000011 RR DAT PPDEFI(16) B4000012 RR DAT PPSTAT(4) B4000013 RR DAT PPRELO(4) B4000014 RR DAT PPDUMP(4) B4000015 RR DAT PPCOPY(6) B4000016 RR DAT PPDELE(3) B4000017 RR DAT PPCLEA(3) B4000018 RR DAT PPLIST(5) B4000019 RR DAT PPRENA(5) B4000020 RR DAT PPCOMM(2) B4000021 RR DAT PPEXIT(1) B4000022 RR DAT PPMOUN(3) B4000023 RR DAT PPDISM(2) B4000024 RR DAT PPSAVE(3) B4000025 RR DAT PPBATC(5) B4000026 RR DAT PPLOAD(5) B4000027 RR DAT PPPURG(3) B4000028 RR DAT PPINPU(2) B4000029 RR DAT PPOUTP(2) B4000030 RR DAT PPCOMP(3) B4000031 RR DAT PPHOST(4) B4000032 RR DAT PPSET(3) B4000033 RR DAT PPBATS(4) B4000034 RR DAT PPDISC(2) B4000035 RR DAT PPDISP(7) B4000036 RR DAT PPFLUS(3) B4000037 RR DAT PPPRIN(3) B4000038 RR DAT DUMMY(6) B4000039 RR DAT INBUF(41),CODE(20) B4000040 RR DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B4000041 RR DAT REQBUF(24),IDATA(24) B4000042 RR DAT PARDEF(24) B4000043 RR DAT FCBHDR(5) B4000044 RR DAT FCBBUF(96) B4000045 RR EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B4000046 RR EQU COMLEN(ENDCOM-COMCOD) B4000047 RR ENT MARKER B4000048 RR ENT UTSTRT B4000049 RR* B4000050 RR EXT FLUSH B4000051 RRMARKER NOP 0 B4000052 RR RTJ FLUSH B4000053 RR JMP* (MARKER) B4000054 RR* B4000055 RR EQU UTSTRT(MARKER) B4000056 RR* B4000057 RR END B4000058 RR NAM GTHOST B41 A ITOS CCS 3.0 SL-149B4100001 RR* START ROUTINE FOR COMMAND PROCESSOR HOST B4100002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B4100003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B4100004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B4100005 RR* B4100006 RR* LABELED COMMON AREA B4100007 RR* B4100008 RR DAT COMCOD(133),PARNAM(121) B4100009 RR DAT PPHELP(2) B4100010 RR DAT PPINIT(4) B4100011 RR DAT PPDEFI(16) B4100012 RR DAT PPSTAT(4) B4100013 RR DAT PPRELO(4) B4100014 RR DAT PPDUMP(4) B4100015 RR DAT PPCOPY(6) B4100016 RR DAT PPDELE(3) B4100017 RR DAT PPCLEA(3) B4100018 RR DAT PPLIST(5) B4100019 RR DAT PPRENA(5) B4100020 RR DAT PPCOMM(2) B4100021 RR DAT PPEXIT(1) B4100022 RR DAT PPMOUN(3) B4100023 RR DAT PPDISM(2) B4100024 RR DAT PPSAVE(3) B4100025 RR DAT PPBATC(5) B4100026 RR DAT PPLOAD(5) B4100027 RR DAT PPPURG(3) B4100028 RR DAT PPINPU(2) B4100029 RR DAT PPOUTP(2) B4100030 RR DAT PPCOMP(3) B4100031 RR DAT PPHOST(4) B4100032 RR DAT PPSET(3) B4100033 RR DAT PPBATS(4) B4100034 RR DAT PPDISC(2) B4100035 RR DAT PPDISP(7) B4100036 RR DAT PPFLUS(3) B4100037 RR DAT PPPRIN(3) B4100038 RR DAT DUMMY(6) B4100039 RR DAT INBUF(41),CODE(20) B4100040 RR DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B4100041 RR DAT REQBUF(24),IDATA(24) B4100042 RR DAT PARDEF(24) B4100043 RR DAT FCBHDR(5) B4100044 RR DAT FCBBUF(96) B4100045 RR EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B4100046 RR EQU COMLEN(ENDCOM-COMCOD) B4100047 RR ENT MARKER B4100048 RR ENT UTSTRT B4100049 RR* B4100050 RR EXT HOST B4100051 RRMARKER NOP 0 B4100052 RR RTJ HOST B4100053 RR JMP* (MARKER) B4100054 RR* B4100055 RR EQU UTSTRT(MARKER) B4100056 RR* B4100057 RR END B4100058 RR NAM GTPRIN B42 A ITOS CCS 3.0 SL-149B4200001 RR* START ROUTINE FOR COMMAND PROCESSOR PRINT B4200002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B4200003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B4200004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B4200005 RR* B4200006 RR* LABELED COMMON AREA B4200007 RR* B4200008 RR DAT COMCOD(133),PARNAM(121) B4200009 RR DAT PPHELP(2) B4200010 RR DAT PPINIT(4) B4200011 RR DAT PPDEFI(16) B4200012 RR DAT PPSTAT(4) B4200013 RR DAT PPRELO(4) B4200014 RR DAT PPDUMP(4) B4200015 RR DAT PPCOPY(6) B4200016 RR DAT PPDELE(3) B4200017 RR DAT PPCLEA(3) B4200018 RR DAT PPLIST(5) B4200019 RR DAT PPRENA(5) B4200020 RR DAT PPCOMM(2) B4200021 RR DAT PPEXIT(1) B4200022 RR DAT PPMOUN(3) B4200023 RR DAT PPDISM(2) B4200024 RR DAT PPSAVE(3) B4200025 RR DAT PPBATC(5) B4200026 RR DAT PPLOAD(5) B4200027 RR DAT PPPURG(3) B4200028 RR DAT PPINPU(2) B4200029 RR DAT PPOUTP(2) B4200030 RR DAT PPCOMP(3) B4200031 RR DAT PPHOST(4) B4200032 RR DAT PPSET(3) B4200033 RR DAT PPBATS(4) B4200034 RR DAT PPDISC(2) B4200035 RR DAT PPDISP(7) B4200036 RR DAT PPFLUS(3) B4200037 RR DAT PPPRIN(3) B4200038 RR DAT DUMMY(6) B4200039 RR DAT INBUF(41),CODE(20) B4200040 RR DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B4200041 RR DAT REQBUF(24),IDATA(24) B4200042 RR DAT PARDEF(24) B4200043 RR DAT FCBHDR(5) B4200044 RR DAT FCBBUF(96) B4200045 RR EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B4200046 RR EQU COMLEN(ENDCOM-COMCOD) B4200047 RR ENT MARKER B4200048 RR ENT UTSTRT B4200049 RR* B4200050 RR EXT PRINT B4200051 RRMARKER NOP 0 B4200052 RR RTJ PRINT B4200053 RR JMP* (MARKER) B4200054 RR* B4200055 RR EQU UTSTRT(MARKER) B4200056 RR* B4200057 RR END B4200058 RR NAM GTSET B43 A ITOS CCS 3.0 SL-149B4300001 RR* START ROUTINE FOR COMMAND PROCESSOR SET B4300002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B4300003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B4300004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B4300005 RR* B4300006 RR* LABELED COMMON AREA B4300007 RR* B4300008 RR DAT COMCOD(133),PARNAM(121) B4300009 RR DAT PPHELP(2) B4300010 RR DAT PPINIT(4) B4300011 RR DAT PPDEFI(16) B4300012 RR DAT PPSTAT(4) B4300013 RR DAT PPRELO(4) B4300014 RR DAT PPDUMP(4) B4300015 RR DAT PPCOPY(6) B4300016 RR DAT PPDELE(3) B4300017 RR DAT PPCLEA(3) B4300018 RR DAT PPLIST(5) B4300019 RR DAT PPRENA(5) B4300020 RR DAT PPCOMM(2) B4300021 RR DAT PPEXIT(1) B4300022 RR DAT PPMOUN(3) B4300023 RR DAT PPDISM(2) B4300024 RR DAT PPSAVE(3) B4300025 RR DAT PPBATC(5) B4300026 RR DAT PPLOAD(5) B4300027 RR DAT PPPURG(3) B4300028 RR DAT PPINPU(2) B4300029 RR DAT PPOUTP(2) B4300030 RR DAT PPCOMP(3) B4300031 RR DAT PPHOST(4) B4300032 RR DAT PPSET(3) B4300033 RR DAT PPBATS(4) B4300034 RR DAT PPDISC(2) B4300035 RR DAT PPDISP(7) B4300036 RR DAT PPFLUS(3) B4300037 RR DAT PPPRIN(3) B4300038 RR DAT DUMMY(6) B4300039 RR DAT INBUF(41),CODE(20) B4300040 RR DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B4300041 RR DAT REQBUF(24),IDATA(24) B4300042 RR DAT PARDEF(24) B4300043 RR DAT FCBHDR(5) B4300044 RR DAT FCBBUF(96) B4300045 RR EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B4300046 RR EQU COMLEN(ENDCOM-COMCOD) B4300047 RR ENT MARKER B4300048 RR ENT UTSTRT B4300049 RR* B4300050 RR EXT SET B4300051 RRMARKER NOP 0 B4300052 RR RTJ SET B4300053 RR JMP* (MARKER) B4300054 RR* B4300055 RR EQU UTSTRT(MARKER) B4300056 RR* B4300057 RR END B4300058 RR NAM PRINZ B44 A ITOS CCS 3.0 SL-149B4400001 RR* PRINT ROUTINE FOR PRINT UTILITY B4400002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B4400003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B4400004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B4400005 RR SPC 2 B4400006 RR* THIS ROUTINE PRINTS A LINE OF DATA ON THE B4400007 RR* SPECIFIED LOGICAL UNIT. NUMBER OF WORDS TO B4400008 RR* PRINT ARE SPECIFIED IN FIRST WORD OF SPECIFIED B4400009 RR* BUFFER. B4400010 RR* IF CARRIAGE CONTROL IS INCLUDED IN DATA,A WRITE REQUEST B4400011 RR* IS MADE. OTHERWISE,A FORMAT WRITE REQUEST IS MADE. B4400012 RR* CALLING SEQUENCE- B4400013 RR* CALL PRINZ(J,LINBUF,LOGUNT) B4400014 RR* WHERE- J = INDEX INTO 'LINBUF' B4400015 RR* LINBUF = ARRAY OF 73 WORD RECORDS B4400016 RR* LOGUNT = LOGICAL UNIT OF PRINT DEVICE B4400017 RR SPC 2 B4400018 RR ENT PRINZ B4400019 RR SPC 1 B4400020 RR EXT Q8PREP,Q8PKUP B4400021 RR SPC 1 B4400022 RR EQU ZERO($22) B4400023 RR EQU MONI($F4) B4400024 RR EQU DISP($EA) B4400025 RR EQU HFF00($1A) B4400026 RR SPC 2 B4400027 RRPRINZ 0 0 B4400028 RR STQ* QSAVE B4400029 RR RTJ Q8PREP B4400030 RR ADC (PRINZ-*) B4400031 RR RTJ Q8PKUP B4400032 RR TRA Q B4400033 RR LDA- (ZERO),Q B4400034 RR STA* J B4400035 RR RTJ Q8PKUP B4400036 RR ADD* J B4400037 RR INA -1 ADJUST FOR INDEX STARTING AT 1 B4400038 RR TRA Q B4400039 RR LDA- (ZERO),Q =NO, OF WORDS TO PRINT B4400040 RR STA* N B4400041 RR INQ 1 B4400042 RR STQ* S B4400043 RR LDA* RCFW INITIALIZE FOR FORMAT WRITE B4400044 RR STA* RC B4400045 RR LDA- (ZERO),Q B4400046 RR AND- HFF00 B4400047 RR EOR =N$1B00 B4400048 RR SAN PRIN10 SENSE 1ST CHAR NOT ESCAPE CODE B4400049 RR LDA* RCW (ESCAPE CODE IMPLIES CARRIAGE CONTROL B4400050 RR STA* RC IN DATA) B4400051 RRPRIN10 EQU PRIN10(*) B4400052 RR RTJ Q8PKUP B4400053 RR TRA Q B4400054 RR LDA- (ZERO),Q B4400055 RR ADD =N$1000 SET FOR LENGTH = WORD B4400056 RR STA* LU B4400057 RR RTJ- (MONI) B4400058 RRRC NUM $4C00 RC B4400059 RR ADC CA CA B4400060 RR NUM 0 THREAD B4400061 RRLU NUM 0 B4400062 RRN NUM 0 B4400063 RRS NUM 0 B4400064 RR JMP- (DISP) B4400065 RRCA LDQ* QSAVE B4400066 RR JMP* (PRINZ) B4400067 RRQSAVE NUM 0 B4400068 RRJ NUM 0 B4400069 RRRCW NUM $4400 B4400070 RRRCFW NUM $4C00 B4400071 RR END B4400072 RR NAM MPWRXX B45 A ITOS CCS 3.0 SL-149B4500001 RR* UTILITY READ/WRITE RECORD ROUTINE B4500002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B4500003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B4500004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B4500005 RR* B4500006 RR* B4500007 RR* *****************************************'****** B4500008 RR* * * B4500009 RR* * ROUTINE FOR READ/WRITE RECORD(S) FOR * B4500010 RR* * 'DUMP FILE' AND 'RELOAD' (FORMATTED) * B4500011 RR* * (REQUEST) * B4500012 RR* * * B4500013 RR* ************************************************ B4500014 RR* B4500015 RR* B4500016 RR* B4500017 RR* B4500018 RR***** ROUTINE FUNCTION : B4500019 RR* B4500020 RR* THIS ROUTINE IS USE FOR READ/WRITE (FORMATTED) B4500021 RR* OPERATION (MAINLY FOR MAG. TAPE) FOR FILE DUMP B4500022 RR* OR RELOAD. B4500023 RR* B4500024 RR* B4500025 RR SPC 2 B4500026 RR* B4500027 RR**** B4500028 RR* B4500029 RR**** THIS ROUTINE IS AN INTEGER FUNCTION --- B4500030 RR* B4500031 RR* CALLING SEQUENCES : B4500032 RR* B4500033 RR* (1) ASSEM : B4500034 RR* B4500035 RR* RTJ MPWRXX B4500036 RR* ADC LU LOGICAL UNIT B4500037 RR* ADC BUFFER BUFFER ADDRESS B4500038 RR* ADC SIZE SIZE OF DATA B4500039 RR* B4500040 RR* A-REGISTER CONTAIN LOGICAL UNIT STAUTUS B4500041 RR* B4500042 RR* (2) FORTRAN : B4500043 RR* B4500044 RR* MSTATS = MPWRXX(LU,KBUF,KSIZE) B4500045 RR* B4500046 RR* B4500047 RR* B4500048 RR SPC 2 B4500049 RR* B4500050 RR***** ***** E N T R Y P O I N T S B4500051 RR* B4500052 RR SPC 1 B4500053 RR ENT MPWRIX WRITE ENTRY B4500054 RR ENT MPREDX READ ENTRY B4500055 RR SPC 2 B4500056 RR* B4500057 RR***** ***** E U Q I V A L E N C E S B4500058 RR* B4500059 RR SPC 1 B4500060 RR* MSOS EQUIVALENCES B4500061 RR SPC 1 B4500062 RRADISP EQU ADISP($EA) DISPATCHER B4500063 RRCURLV EQU CURLV($EF) CURRENT PRIORITY LEVEL B4500064 RRAMONI EQU AMONI($F4) MONITOR B4500065 RR SPC 1 B4500066 RR* I/O REQUEST EQUIVALENCES B4500067 RR SPC 1 B4500068 RRD EQU D(1) 'D' BIT B4500069 RRX EQU X(0) 'X' BIT B4500070 RRRP EQU RP(4) REQUEST PRIORITY B4500071 RRNULL EQU NULL(0) NULL B4500072 RRREADCD EQU READCD(4) F-READ B4500073 RRWRITCD EQU WRITCD(6) F-WRITE B4500074 RR SPC 1 B4500075 RR* MSOS LOW CORE EQUIVALENCE B4500076 RR SPC 1 B4500077 RRZERO EQU ZERO(2) LOCATION CONTAINS ZERO B4500078 RR SPC 5 B4500079 RR* B4500080 RR***** ***** P R O G R A M S T A R T ***** B4500081 RR* B4500082 RR SPC 3 B4500083 RRMPWRIX NOP 0 WRITE REQUEST ENTRY B4500084 RR LDA* MPWRIX MOVE RETURN ADDRESS B4500085 RR STA* MPREDX B4500086 RR ENA WRITCD SET TO WRITE REQUEST B4500087 RR JMP* COMPRO TO COMMON PROCESSING SEQUENCE B4500088 RR SPC 2 B4500089 RR* READ ENTRY B4500090 RR SPC 1 B4500091 RRMPREDX NOP 0 READ ENTRY B4500092 RR ENA READCD SET FOR READ CODE B4500093 RR* B4500094 RRCOMPRO ALS 9 ASSEMBLE I/O REQUEST CODE B4500095 RR ADD- CURLV + CURRENT PRIORITY LEVEL B4500096 RR ADD* CALBAS + CALL CODE BASE B4500097 RR STA* CALPAR SAVE CALL CODE B4500098 RR STQ* QSAVE SAVE Q-REGISTER B4500099 RR LDA- I I B4500100 RR STA* ISAVE B4500101 RR SPC 1 B4500102 RR* GET PARAMETERS FOR I/O REQUEST B4500103 RR SPC 1 B4500104 RR LDQ* (MPREDX) GET LOGICAL B4500105 RR LDA- (ZERO),Q B4500106 RR STA* LU B4500107 RR RAO* MPREDX BUMP TO NEXT ONE B4500108 RR LDQ* (MPREDX) GET SIZE B4500109 RR STQ* BUF B4500110 RR RAO* MPREDX BUMP TO NEXT ONE B4500111 RR LDQ* (MPREDX) GET BUFFER ADDRESS B4500112 RR LDA- (ZERO),Q GET SIZE B4500113 RR STA* SIZE B4500114 RR SPC 2 B4500115 RR* I/O REQUEST VIA MONITOR B4500116 RR SPC 1 B4500117 RR RTJ- (AMONI) B4500118 RRCALPAR NUM 0 0. CALL CODE (FILLED) B4500119 RR ADC RETURN 1. COMPLETION ADDRESS B4500120 RR NUM 0 2. THREAD B4500121 RRLU NUM 0 3. LOGICAL UNIT B4500122 RRSIZE NUM 0 4. SIZE (FILLED) B4500123 RRBUF NUM 0 5. BUFFER ADDRESS (FILLED) B4500124 RR JMP- (ADISP) B4500125 RR SPC 1 B4500126 RR* B4500127 RRCALBAS VFD X2/D,X5/NULL,X1/X,X4/RP,X4/NULL B4500128 RR SPC 1 B4500129 RR* RETURN FROM I/O B4500130 RR SPC 1 B4500131 RRRETURN TRQ A STATUS TO A B4500132 RR LDQ* ISAVE RESTORE I-REGISTER B4500133 RR STQ- I B4500134 RR LDQ* QSAVE Q B4500135 RR RAO* MPREDX BUMP TO EXIT B4500136 RR JMP* (MPREDX) RETURN TO SENDER B4500137 RR* B4500138 RRISAVE NUM 0 I-SAVE B4500139 RRQSAVE NUM 0 Q-SAVE B4500140 RR END B4500141 RR NAM OBFIMK B46 A ITOS CCS 3.0 SL-149B4600001 RR* UTILITY E-O-F CODE PICKUP ROUTINE B4600002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B4600003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B4600004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B4600005 RR* B4600006 RR* *********'*******************************'**** B4600007 RR* * * B4600008 RR* * GET EOF OR DELETE CODE FROM SYSTEM * B4600009 RR* * * B4600010 RR* *****************************************'**** B4600011 RR* B4600012 RR* B4600013 RR SPC 1 B4600014 RR* B4600015 RR***** ROUTINE FUNCTION : B4600016 RR* B4600017 RR* THIS ROUTINE IS USED TO OBTAIN EOF AND DELETE CODES B4600018 RR* FROM SYSTEM. B4600019 RR* B4600020 RR* B4600021 RR SPC 1 B4600022 RR* B4600023 RR* B4600024 RR***** CALLING SEQUENCES : B4600025 RR* B4600026 RR* (1) ASSEM : B4600027 RR* B4600028 RR* RTJ OBFIMK B4600029 RR* ADC BUF BUFFER FOR DATA B4600030 RR* B4600031 RR* (2) FORTRAN : B4600032 RR* B4600033 RR* CALL OBFIMK(KBUF) B4600034 RR* B4600035 RR* B4600036 RR SPC 2 B4600037 RR* B4600038 RR***** ***** E N T R Y P O I N T B4600039 RR* B4600040 RR SPC 1 B4600041 RR ENT OBFIMK ENTRY POINT B4600042 RR SPC 2 B4600043 RR* B4600044 RR***** ***** E X T E R N A L S B4600045 RR* B4600046 RR SPC 1 B4600047 RR EXT FMEOFC EOF CODE B4600048 RR EXT FMRDEL DELETE CODE B4600049 RR SPC 1 B4600050 RR* B4600051 RR***** ***** E Q U I V A L E N C E B4600052 RR* B4600053 RR SPC 1 B4600054 RRZERO EQU ZERO(2) ZERO B4600055 RR SPC 4 B4600056 RR* B4600057 RR***** ***** P R O G R A M S T A R T ***** B4600058 RR* B4600059 RR SPC 2 B4600060 RROBFIMK NOP 0 ENTRY B4600061 RR STQ* QSAVE SAVE Q-REGISTER B4600062 RR LDQ* (OBFIMK) GET SAVE DATA BUFFER ADDRESS B4600063 RR LDA* EXT1 GET EOF CODE AND SAVE B4600064 RR STA- (ZERO),Q B4600065 RR LDA* EXT2 GET DELETE CODE AND SAVE B4600066 RR STA- 1,Q B4600067 RR* B4600068 RR LDQ* QSAVE RESTORE Q B4600069 RR RAO* OBFIMK BUMP TO EXIT B4600070 RR JMP* (OBFIMK) RETURN TO CALLER B4600071 RR* B4600072 RRQSAVE NUM 0 Q B4600073 RREXT1 ADC FMEOFC EOF B4600074 RREXT2 ADC FMRDEL DELETE B4600075 RR END B4600076 RR NAM OBL000 B47 A ITOS CCS 3.0 SL-149B4700001 RR* UTILITY I/O BUFFER SIZING ROUTINE B4700002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B4700003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B4700004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B4700005 RR* B4700006 RR* *****************************************'*********** B4700007 RR* * * B4700008 RR* * ROUTINE TO GET ITOS MAG. TAPE BUFFER SIZE * B4700009 RR* * * B4700010 RR* *****************************************'*********** B4700011 RR* B4700012 RR* B4700013 RR* B4700014 RR**** ROUTINE FUNCTION : B4700015 RR* B4700016 RR* THIS ROUTINE IS USED TO GET THE ITOS EXECTUE MAG. B4700017 RR* TAPE BUFFER SIZE FROM 'SYSDAT' FOR BLOCKING. B4700018 RR* B4700019 RR* B4700020 RR SPC 1 B4700021 RR* B4700022 RR* B4700023 RR* THIS ROUTINE IS AN INTEGER FUNCTION AND THE CALL B4700024 RR* SEQUENCES ARE : B4700025 RR* B4700026 RR* (1) ASSEM : B4700027 RR* B4700028 RR* RTJ OBL000 B4700029 RR* ADC DUMY DUMMY PARAMETER B4700030 RR* B4700031 RR* A-REGISTER CONTAINS BUFFER SIZE IN RETURN B4700032 RR* B4700033 RR* B4700034 RR* (2) FORTRAM : B4700035 RR* B4700036 RR* INTEGER OBL000 B4700037 RR* B4700038 RR* MAGSIZ = OBL000( 0) B4700039 RR* B4700040 RR* B4700041 RR* B4700042 RR SPC 2 B4700043 RR* B4700044 RR****** ***** E X T E R N A L B4700045 RR* B4700046 RR SPC 1 B4700047 RR EXT L000 LOCATION CONTAINS ITOS MAG. TAPE BUFFER SIZE B4700048 RR SPC 2 B4700049 RR* B4700050 RR****** ***** E N T R Y P O I N T B4700051 RR* B4700052 RR SPC 1 B4700053 RR ENT OBL000 ENTRY POINT B4700054 RR SPC 4 B4700055 RR* B4700056 RR****** ***** P R O G R A M S T A R T ***** B4700057 RR* B4700058 RR SPC 2 B4700059 RROBL000 NOP 0 ENTRY B4700060 RR RAO* OBL000 BUMP TO EXIT LOCATION B4700061 RR LDA* L00EXT GET BUFFER SIZE B4700062 RR JMP* (OBL000) EXIT B4700063 RR* B4700064 RRL00EXT ADC L000 ITOS MAG. TAPE BUFFER SIZE ADDRESS B4700065 RR END B4700066 RR NAM RWBUWM B48 A ITOS CCS 3.0 SL-149B4800001 RR* UTILITY MOTION CONTROL ROUTINE B4800002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B4800003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B4800004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B4800005 RR* B4800006 RR* B4800007 RR* *****************************************'********** B4800008 RR* * * B4800009 RR* * ROUTINE TO PERFORM MOTION CONTROL OPTION * B4800010 RR* * * B4800011 RR* **************************************************** B4800012 RR* B4800013 RR* B4800014 RR* B4800015 RR SPC 1 B4800016 RR* B4800017 RR***** ROUTINE FUNCTION : B4800018 RR* B4800019 RR* ROUTINE TO PERFORM MOTION CONTROL FUNCTIONS, THEY B4800020 RR* ARE : (1) 1 = BACKSPACE, 2 = WRITE EOF, 3 = REWIND, B4800021 RR* 4 = REWIND AND UNLOAD, 5 = SKIP FILE FORWARD, B4800022 RR* 6 = SKIP BACKWARD 1 FILE, 7 = ADVANCE 1 RECORD, B4800023 RR* B4800024 RR* B4800025 RR* B4800026 RR***** CALLING SEQUENCES : B4800027 RR* B4800028 RR* B4800029 RR* (1) ASSEM : B4800030 RR* B4800031 RR* RTJ RWBUWM B4800032 RR* ADC LU LOGICAL UNIT B4800033 RR* ADC TYPE REQUEST TYPE B4800034 RR* B4800035 RR* B4800036 RR* B4800037 RR SPC 2 B4800038 RR* B4800039 RR***** ***** E N T R Y P O I N T B4800040 RR* B4800041 RR SPC 1 B4800042 RR ENT RWBUWM ENTRY NAME B4800043 RR SPC 2 B4800044 RR* B4800045 RR***** ***** E Q U I V A L E N C E S B4800046 RR* B4800047 RR SPC 1 B4800048 RR SPC 1 B4800049 RR* MSOS EQUIVALENCES B4800050 RR SPC 1 B4800051 RRADISP EQU ADISP($EA) DISPATCHER B4800052 RRAMONI EQU AMONI($F4) MONITOR B4800053 RRCURLV EQU CURLV($EF) CURRENT PRIORITY LEVEL B4800054 RR SPC 1 B4800055 RR* I/O REQUEST EQUIVALENCES B4800056 RR SPC 1 B4800057 RRD EQU D(1) 'D' BIT B4800058 RRX EQU X(0) 'X' BIT B4800059 RRRP EQU RP(4) REQUEST PRIORITY B4800060 RRNULL EQU NULL(0) NULL B4800061 RRMOTCOD EQU MOTCOD(14) MOTION REQUEST CODE B4800062 RR SPC 1 B4800063 RR* MSOS LOW CORE EQUIVALENCE B4800064 RR SPC 1 B4800065 RRZERO EQU ZERO(2) LOCATION CONTAINS ZERO B4800066 RR SPC 5 B4800067 RR* B4800068 RR***** ***** P R O G R A M S T A R T ***** B4800069 RR* B4800070 RR SPC 2 B4800071 RRRWBUWM NOP 0 ENTRY B4800072 RR STQ* QSAVE SAVE Q-REGISTER B4800073 RR LDQ- I B4800074 RR STQ* ISAVE I B4800075 RR* B4800076 RR LDQ* (RWBUWM) GET LOGICAL UNIT B4800077 RR LDA- (ZERO),Q B4800078 RR STA* LU B4800079 RR RAO* RWBUWM BUMP TO NEXT PARAMETER B4800080 RR LDQ* (RWBUWM) B4800081 RR LDA- (ZERO),Q GET TYPE CODE B4800082 RR ALS 12 AND POSITION TO HIGH 4-BITS B4800083 RR STA* MOTCON B4800084 RR RAO* RWBUWM BUMP RETURN ADDRESS FOR CORRECT RTN 132*5336B4800085 RR SPC 1 B4800086 RR* B4800087 RR LDA- CURLV ASSEMBLE CURRENT PRIORITY LEVEL WITH CALL B4800088 RR ADD* CALCOD B4800089 RR STA* CALPAR B4800090 RR SPC 1 B4800091 RR* B4800092 RR RTJ- (AMONI) B4800093 RRCALPAR NUM 0 0. CALL CODE (FILLED) B4800094 RR ADC RETURN 1. RETURN ADDRESS B4800095 RR NUM 0 2. THREAD B4800096 RRLU NUM 0 3. LOGICAL UNIT (FILLED) B4800097 RRMOTCON NUM 0 4. CONTROL MOTION CODE (FILLED) B4800098 RR JMP- (ADISP) B4800099 RR SPC 1 B4800100 RR* B4800101 RRCALCOD VFD X2/D,X5/MOTCOD,X1/X,X4/RP,X4/NULL B4800102 RR* B4800103 RR SPC 1 B4800104 RR* I/O REQUEST RETURN B4800105 RR SPC 1 B4800106 RRRETURN TRQ A STATUS TO A-REGISTER B4800107 RR LDQ* ISAVE RESTORE I-REGISTER B4800108 RR STQ- I B4800109 RR LDQ* QSAVE Q B4800110 RR* B4800111 RR JMP* (RWBUWM) RETURN TO CALLER B4800112 RR* B4800113 RRQSAVE NUM 0 Q B4800114 RRISAVE NUM 0 I B4800115 RR END B4800116 RR NAM UTEFCK B49 A ITOS CCS 3.0 SL-149B4900001 RR* UTILITY EOF MASK PICKUP ROUTINE B4900002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B4900003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B4900004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B4900005 RR* B4900006 RR* B4900007 RR* ************************************************* B4900008 RR* * * B4900009 RR* * ROUTINE TO GET EOF MASK FORM 'PHYTAB' * B4900010 RR* * * B4900011 RR* *****************************************'******* B4900012 RR* B4900013 RR* B4900014 RR* B4900015 RR SPC 2 B4900016 RR* B4900017 RR* B4900018 RR******* ROUTINE FUNCTION : B4900019 RR* B4900020 RR* THIS ROUTINE IS USED TO GET EOF MASK CODE FROM B4900021 RR* THE DEVICE PHYSCIAL TABLE B4900022 RR* B4900023 RR* B4900024 RR* B4900025 RR SPC 1 B4900026 RR* B4900027 RR* B4900028 RR***** CALLING SEQUENCES : B4900029 RR* B4900030 RR* (1) ASSEM : B4900031 RR* B4900032 RR* RTJ UTEFCK B4900033 RR* ADC LU LOGICAL UNIT B4900034 RR* A-REGISTER = EOF (NON-ZERO) OR NOT (ZERO) B4900035 RR* B4900036 RR* (2) FORTRAN : B4900037 RR* B4900038 RR* (2) FORTRAN : B4900039 RR* B4900040 RR* MEOFMK = UTEFCK(LU) B4900041 RR* B4900042 RR* B4900043 RR SPC 2 B4900044 RR* B4900045 RR***** ***** E N T R Y P O I N T B4900046 RR* B4900047 RR SPC 1 B4900048 RR ENT UTEFCK ENTRY POINT B4900049 RR SPC 2 B4900050 RR* B4900051 RR***** ***** E X T E R N A L B4900052 RR* B4900053 RR SPC 1 B4900054 RR EXT LOG1A LOG 1A TABLE ENTRY B4900055 RR SPC 2 B4900056 RR* B4900057 RR***** ***** E Q U I V A L E N C E S B4900058 RR* B4900059 RR SPC 1 B4900060 RRZERO EQU ZERO(2) ZERO B4900061 RRLPMSK EQU LPMSK(2) BIT MASK B4900062 RR SPC 1 B4900063 RR* B4900064 RRESTAT2 EQU ESTAT2(12) STATUS WORD 12 OF 'PHYTAB' B4900065 RR SPC 3 B4900066 RR* B4900067 RR***** ***** P R O G R A M S T A R T ***** B4900068 RR* B4900069 RR SPC 1 B4900070 RRUTEFCK NOP 0 ENTRY B4900071 RR STQ* QSAVE SAVE Q-REGISTER B4900072 RR LDQ* (UTEFCK) GET LOGICAL UNIT B4900073 RR LDA- (ZERO),Q GET AND ISOLATE LOGICAL UNIT , THEN TO Q B4900074 RR AND- LPMSK+8 B4900075 RR TRA Q B4900076 RR LDQ LOG1A,Q B4900077 RR LDA- ESTAT2,Q B4900078 RR LDQ* QSAVE RESTORE Q-REGISTER B4900079 RR RAO* UTEFCK BUMP TO EXIT B4900080 RR JMP* (UTEFCK) RETURN TO CALLER B4900081 RR* B4900082 RRQSAVE NUM 0 Q B4900083 RR END B4900084 RR NAM AS2 B50 A ITOS CCS 3.0 SL-149B5000001 RR* UTILITY CHARACTER ASSEMBLY ROUTINE B5000002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B5000003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B5000004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B5000005 RR* B5000006 RR* ************************************************ B5000007 RR* * * B5000008 RR* * ROUTINE TO ASSEMBLE 1 CHAR/WORD INTO * B5000009 RR* * 2 CHAR/WORD * B5000010 RR* * * B5000011 RR* ************************************************ B5000012 RR* B5000013 RR* B5000014 RR****** CALLING SEQUENCE : B5000015 RR* B5000016 RR* RTJ AS2 B5000017 RR* ADC SOURCE 4 WORDS OF 1 CHAR./WORD B5000018 RR* ADC TARGET 2 WORDS OF 2 CHAR./WORD B5000019 RR* B5000020 RR* B5000021 RR****** ROUTINE FUNCTION : B5000022 RR* B5000023 RR* THIS ROUTINE IS USED TO ASSEMBLE 4-WORD OF 1 CHAR./ B5000024 RR* WORD (RIGHT JUSTIFIED AND NULL FILL HIGH BYTE) INTO B5000025 RR* 2-WORD OF 2 CHAR./WORD. B5000026 RR* B5000027 RR* B5000028 RR* B5000029 RR SPC 3 B5000030 RR* B5000031 RR****** *** E N T R Y N A M E B5000032 RR* B5000033 RR SPC 1 B5000034 RR ENT AS2 ENTRY NAME B5000035 RR SPC 2 B5000036 RR* B5000037 RR****** *** E Q U I V A L E N C E B5000038 RR* B5000039 RRZERO EQU ZERO(2) CONSTANT ZERO B5000040 RR SPC 5 B5000041 RR* B5000042 RR****** ***** P R O G R A M S T A R T ***** B5000043 RR* B5000044 RR SPC 2 B5000045 RRAS2 NOP 0 ENTRY B5000046 RR STQ* QSAVE SAVE Q B5000047 RR LDA- I I B5000048 RR STA* ISAVE B5000049 RR* B5000050 RR LDA* (AS2) GET SOURCE DATA ARRAY ADDRESS B5000051 RR STA- I B5000052 RR RAO* AS2 BUMP TO NEXT PARAMETER B5000053 RR LDQ* (AS2) GET TARGET DATA ARRAY ADDRESS B5000054 RR* B5000055 RR LDA- (ZERO),I ASSEMBLE FIRST 2 CHARACTERS B5000056 RR ALS 8 (FIRST TO HIGH BYTE) B5000057 RR ADD- 1,I (ADD LOW BYTE) B5000058 RR STA- (ZERO),Q SAVE B5000059 RR LDA- 2,I ASSEMBLE SECOND AND LAST 2 CHARACTERS B5000060 RR ALS 8 B5000061 RR ADD- 3,I B5000062 RR STA- 1,Q B5000063 RR* B5000064 RR RAO* AS2 SET EXIT B5000065 RR LDQ* QSAVE RESTORE Q AND I B5000066 RR LDA* ISAVE B5000067 RR STA- I B5000068 RR JMP* (AS2) RETURN B5000069 RR SPC 1 B5000070 RRISAVE NUM 0 B5000071 RRQSAVE NUM 0 B5000072 RR END B5000073 RR NAM CHO2LR B51 A ITOS CCS 3.0 SL-149B5100001 RR* UTILITY CHARACTER ASSEMBLY ROUTINE B5100002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B5100003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B5100004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B5100005 RR* B5100006 RR* *****************************************'****** B5100007 RR* * * B5100008 RR* * ROUTINE TO ASSEMBLE 1 CHAR/WORD INTO * B5100009 RR* * 2 CHAR/WORD, EITHER LEFT OR RIGHT * B5100010 RR* * JUSTIFIED * B5100011 RR* * * B5100012 RR* ************************************************ B5100013 RR* B5100014 RR* B5100015 RR****** CALLING SEQUENCE : B5100016 RR* B5100017 RR* RTJ CH02LR B5100018 RR* ADC SOURCE SOURCE DATA ARRAY (1 CHAR/WORD) B5100019 RR* ADC TARGET TARGET DATA ARRAY B5100020 RR* ADC SIZELR SIZE AND LEFT/RIGHT B5100021 RR* B5100022 RR* B5100023 RR* CALL CH02LR(SOURCE,TARGET,SIZELR) (FORTRAN CALLB5100024 RR* B5100025 RR* B5100026 RR****** ROUTINE FUNCTION B5100027 RR* B5100028 RR* THIS ROUTINE IS USED TO ASSEMBLE 1 CHAR/WORD DATA B5100029 RR* INTO 2 CHAR/WORD DATA EITHER LEFT/RIGHT (0/1) B5100030 RR* JUSTIFIED OF THE 2 CHAR/WORD B5100031 RR* B5100032 RR* B5100033 RR* B5100034 RR SPC 3 B5100035 RR* B5100036 RR****** *** E N T R Y N A M E B5100037 RR* B5100038 RR SPC 1 B5100039 RR ENT CHO2LR ENTRY NAME B5100040 RR SPC 2 B5100041 RR* B5100042 RR****** *** E Q U I V A L E N C E B5100043 RR* B5100044 RR SPC 1 B5100045 RRLPMSK EQU LPMSK(2) BIT MASK B5100046 RRONE EQU ONE(3) CONSTANT ONE B5100047 RRZERO EQU ZERO(2) CONSTANT ZERO B5100048 RR SPC 4 B5100049 RR* B5100050 RR****** ***** P R O G R A M S T A R T ***** B5100051 RR* B5100052 RR SPC 2 B5100053 RRCHO2LR NOP 0 ENTRY B5100054 RR STQ* QSAVE SAVE Q-REGISTER B5100055 RR LDA- I I B5100056 RR STA* ISAVE B5100057 RR* B5100058 RR LDA* (CHO2LR) GET SOURCE DATA BUFFER ADDRESS B5100059 RR STA- I B5100060 RR RAO* CHO2LR BUMP TO NEXT PARAMETER B5100061 RR SPC 1 B5100062 RR LDA* (CHO2LR) GET TARGET BUFFER ADDRESS B5100063 RR STA* TARGET B5100064 RR RAO* CHO2LR BUMP TO THIRD PARAMETER B5100065 RR* B5100066 RR LDQ* (CHO2LR) GET SIZE/LEFT-RIGHT INDICATOR PARA. ADD. B5100067 RR LDA- (ZERO),Q FETCH SIZE AND SAVE B5100068 RR STA* NOCHAR B5100069 RR LDA- 1,Q OBTAIN LEFT/RIGHT INDICATOR (0/1) B5100070 RR STA* HILO B5100071 RR SPC 1 B5100072 RR*** GET CHARACTER AND ASSEMBLE B5100073 RR SPC 1 B5100074 RRGETCHA LDA- (ZERO),I GET CHARACTER FROM SOURCE B5100075 RR AND- LPMSK+8 B5100076 RR LDQ* HILO FETCH HI/LO INSERTION FLAG AND POSITION CHAR. B5100077 RR SQN CHAPOS B5100078 RR ALS 8 B5100079 RRCHAPOS STA* TEMP B5100080 RR LDA* (TARGET) GET TARGET WORD AND SAVE THE PROPER BYTE B5100081 RR AND* BYTMSK,Q B5100082 RR ADD* TEMP INSERT CURRENT BYTE AND SAVE B5100083 RR STA* (TARGET) B5100084 RR SPC 2 B5100085 RR* B5100086 RR*---- UPDATE POINTERS B5100087 RR* B5100088 RR SPC 1 B5100089 RR LDA* NOCHAR DECREMENT SIZE BY 1 AND CHECK IF DONE B5100090 RR INA -1 B5100091 RR SAN UPTR SKIP, NO DONE B5100092 RR LDA* ISAVE RESTORE I AND Q-REGISTERS PRIOR TO RETURN B5100093 RR STA- I B5100094 RR LDQ* QSAVE B5100095 RR RAO* CHO2LR SET EXIT ADDRESS AND B5100096 RR JMP* (CHO2LR) RETURN B5100097 RR* B5100098 RRUPTR STA* NOCHAR SAVE REMAINDER SIZE B5100099 RR LDA* HILO UPDATE HI/LOW POINTER B5100100 RR INA 1 B5100101 RR AND- ONE B5100102 RR STA* HILO B5100103 RR SAN NOBUMP B5100104 RR RAO* TARGET BUMP TARGET ADD. BY 1 IF 2 CHAR. INSERTED B5100105 RRNOBUMP RAO- I INCREMENT SOURCE B5100106 RR JMP* GETCHA B5100107 RR SPC 2 B5100108 RR*** STORAGES B5100109 RR SPC 1 B5100110 RRTEMP NUM 0 B5100111 RRQSAVE NUM 0 B5100112 RRISAVE NUM 0 B5100113 RRNOCHAR NUM 0 SIZE B5100114 RRHILO NUM 0 HI/LO BYTE B5100115 RRTARGET NUM 0 TARGET BUFFER ADD. B5100116 RRBYTMSK NUM $00FF,$FF00 MASK B5100117 RR END B5100118 RR NAM CNVRT B52 A ITOS CCS 3.0 SL-149B5200001 RR* UTILITY DECIMAL ASCII TO HEXIDECIMAL ROUTINE B5200002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B5200003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B5200004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B5200005 RR* B5200006 RR* **************************************************** B5200007 RR* * * B5200008 RR* * ROUTINE TO CONVERT 8 BYTES ASCII NUMERIC * B5200009 RR* * (DECIMAL) INTO A TWO WORDS BINARY VALUE * B5200010 RR* * * B5200011 RR* **************************************************** B5200012 RR* B5200013 RR* B5200014 RR****** CALLING SEQUENCE : B5200015 RR* B5200016 RR* RTJ CNVRT B5200017 RR* ADC ASCII 4-WORD ASCII DATA TO BE CONVERTED B5200018 RR* ADC BINVA 2-WORD BINARY VALUE B5200019 RR* B5200020 RR* B5200021 RR* CALL CNVRT(ASCII,BINVA) (FORTRAN CALL SEQUENCE, B5200022 RR* INTEGER PARAMETERS) B5200023 RR* B5200024 RR* B5200025 RR****** ROUTINE FUNCTION : B5200026 RR* B5200027 RR* THE 8 ASCII CHARACTERS ARE CHECKED TO ENSURE THEY B5200028 RR* ARE DECIMAL DIGITALS. THEN VALUE IS CONVERTED BY B5200029 RR* THIS METHOD : B5200030 RR* VALUE = 10 X (LAST VALUE) + (CURRENT VALUE) B5200031 RR* THE ABOVE EQUATION IS REPEATED 8 TIMES FOR ALL 8 B5200032 RR* ASCII CHARACTER WITH 'VALUE' INITIALIZED TO ZERO B5200033 RR* AT ENTRY. B5200034 RR* B5200035 RR* THE 2-WORD BINARY VALUE IS THE STANDARD MSB + LSB B5200036 RR* TYPE 2-WORD FORMAT AND IS UNSIGNED B5200037 RR* B5200038 RR* B5200039 RR* B5200040 RR****** SUBROUTINES USED : B5200041 RR* B5200042 RR* DWADD = DOUBLE-WORD ADDITION B5200043 RR* DWMUL = DOUBLE-WORD MULTIPLY B5200044 RR* SYSMSG = SYSTEM ERROR MESSAGE B5200045 RR* B5200046 RR* B5200047 RR****** EXIT CONDITION : B5200048 RR* B5200049 RR* A-REGISTER CONTAIN ZERO FOR NO ERROR AND 2-WORD B5200050 RR* VALUE IN CALLER BUFFER B5200051 RR* A-REGISTER CONTAINS A CONSTATNT 1 FOR ERROR AND B5200052 RR* ERROR MESSAGE IS PRINTED. 2-WORD VALUE BUFFER B5200053 RR* UNALTERED. B5200054 RR* B5200055 RR* B5200056 RR* B5200057 RR SPC 3 B5200058 RR* B5200059 RR****** *** E N T R Y N A M E B5200060 RR* B5200061 RR SPC 1 B5200062 RR ENT CNVRT ENTRY NAME B5200063 RR SPC 2 B5200064 RR* B5200065 RR****** *** E X T E R N A L S B5200066 RR* B5200067 RR SPC 1 B5200068 RR EXT DWADD DOUBLE-WORD ADDITION B5200069 RR EXT DWMUL DOUBLE-WORD MULTIPLY B5200070 RR EXT SYSMSG SYSTEM MESSAGE PROCESSOR B5200071 RR SPC 2 B5200072 RR* B5200073 RR****** *** E Q U I V A L E N C E S B5200074 RR* B5200075 RR SPC 1 B5200076 RRLPMSK EQU LPMSK(2) BIT MASK B5200077 RRZERO EQU ZERO(2) CONSTANT ZERO B5200078 RR SPC 5 B5200079 RR* B5200080 RR****** ***** P R O G R A M S T A R T ***** B5200081 RR* B5200082 RR SPC 2 B5200083 RRCNVRT NOP 0 ENTRY B5200084 RR STQ* QSAVE SAVE Q-REGISTER B5200085 RR LDA- I I B5200086 RR STA* ISAVE B5200087 RR* B5200088 RR LDA* (CNVRT) GET ASCII INPUT DATA BUFFER ADDRESS B5200089 RR STA- I B5200090 RR RAO* CNVRT BUMP TO NEXT PARAMETER B5200091 RR LDA* (CNVRT) GET DOUBLE WORD VALUE PARAMETER ADDRESS B5200092 RR STA* BINAD B5200093 RR RAO* CNVRT SET TO EXIT B5200094 RR SPC 2 B5200095 RR* INITIALIZE B5200096 RR SPC 1 B5200097 RR ENQ STKSZ-1 B5200098 RR CLR A CLEAR LOCAL ARRAY B5200099 RRCLEAR STA* ADDSTK,Q B5200100 RR INQ -1 B5200101 RR SQM SEPCHA B5200102 RR JMP* CLEAR B5200103 RR SPC 1 B5200104 RR* EXTRACT AND CHECK ASCII B5200105 RR SPC 1 B5200106 RRSEPCHA LDQ* INDEX SET GET INPUT ASCII WORD INDEX B5200107 RR LDA- (ZERO),B AND OBTAIN INPUT WORD B5200108 RR STA* TEMP B5200109 RR LDQ* COUNT GET STORE CHARACTER INDEX TO Q B5200110 RR AND- LPMSK+8 EXTRACT LOWER BYTE AND SAVE B5200111 RR STA* ONECHA+1,Q B5200112 RR LDA* TEMP SHIFT HIGH BYTE TO LOW AND ISOLATE THEN SAVE B5200113 RR ALS 8 B5200114 RR AND- LPMSK+8 B5200115 RR STA* ONECHA,Q B5200116 RR INQ 2 UPDATE STORAGE COUNT BY 2 B5200117 RR STQ* COUNT B5200118 RR LDQ* INDEX UPDATE INPUT WORD COUNT BY 1 AND CHECK IF B5200119 RR INQ 1 ALL 4 WORDS BE SEPARATED B5200120 RR STQ* INDEX B5200121 RR INQ -4 B5200122 RR SQZ DONSEP SKIP, ALL DONE B5200123 RR JMP* SEPCHA NO, GO REPEAT B5200124 RR SPC 2 B5200125 RR* B5200126 RR***** CONVERT AND ASSEMBLE VALUE (2-WORD VALUE) B5200127 RR* B5200128 RR SPC 2 B5200129 RRDONSEP STQ* COUNT INITIALIZE B5200130 RR STQ* NOZOIN B5200131 RR SPC 1 B5200132 RR* CALCULATE VALUE = 10 * LAST VALUE B5200133 RR SPC 1 B5200134 RRSKPCHK LDA* NOZOIN CHECK IF NON-ZERO INTEGER ENCOUNTERED B5200135 RR SAZ GETA SKIP, NO CALCULATION FOR NO VALUE YET B5200136 RR ENA 10 SET MULTIPLY BY 10 B5200137 RR STA* MULSTK+2 B5200138 RR LDQ =XMULSTK SET ADD. TO MULTIPLY LAST VALUE BY 10 B5200139 RR RTJ DWMUL B5200140 RR* B5200141 RR LDA* MULSTK+5 CHECK IF ERROR ENCOUNTERED B5200142 RR SAZ MVMLRE SKIP, NO ERROR B5200143 RR JMP* ERGO GO TO ERROR B5200144 RR SPC 1 B5200145 RR* MOVE MULTIPLY RESULT TO ADD STACK B5200146 RR SPC 1 B5200147 RRMVMLRE LDA* MULSTK+3 MOVE MULTIPLY RESULT TO SECOND ADD VALUE B5200148 RR STA* ADDSTK+2 B5200149 RR LDA* MULSTK+4 B5200150 RR STA* ADDSTK+3 B5200151 RR SPC 1 B5200152 RR* EXTRACT INPUT CHARACTER B5200153 RRGETA LDQ* COUNT GET CURRENT CHARACTER INDEX AND FETCH B5200154 RR LDA* ONECHA,Q CHARACTER AND CHECK TO ENSURE IT IS B5200155 RR INA -$30 BETWEEN 0 - 9 B5200156 RR SAN KARCHK B5200157 RR LDQ* NOZOIN CHAR. IS ZERO, IF LEADING ZERO, SKIP B5200158 RR SQZ UPPTR B5200159 RRKARCHK INA -10 B5200160 RR SAP ERGO B5200161 RR INA 10 B5200162 RRKAROK STA* ADDSTK+1 B5200163 RR RAO* NOZOIN B5200164 RR SPC 1 B5200165 RR* CALCULATE = CURRENT VALUE + LAST VALUE (ADJUSTED) B5200166 RR SPC 1 B5200167 RR LDQ =XADDSTK SET ADD STACK ADDRESS AND TO ADD B5200168 RR RTJ DWADD B5200169 RR LDA* ADDSTK+6 CHECK IF ERROR ENCOUNTERED DURING ADD B5200170 RR SAZ UPPTR SKIP OK B5200171 RRERGO JMP* PTER TO PRINT ERROR B5200172 RR SPC 2 B5200173 RR* B5200174 RR*** CHECK IF DONE B5200175 RR* B5200176 RR SPC 1 B5200177 RRUPPTR RAO* COUNT BUMP COUNT BY 1 AND CHECK IF DONE B5200178 RR LDA* COUNT B5200179 RR INA -8 B5200180 RR SAZ DONCAL SKIP, DONE B5200181 RR JMP* SKPCHK GO TO PROCESS NEXT CHARACTER B5200182 RR* B5200183 RR*----- DONE, MOVE DATA TO CALLER BUFFER FROM ADD STACK B5200184 RR* B5200185 RRDONCAL LDA* ADDSTK+4 MOVE MSB B5200186 RR STA* (BINAD) B5200187 RR LDA* ADDSTK+5 LSB B5200188 RR RAO* BINAD B5200189 RR STA* (BINAD) B5200190 RR ENA 0 CLEAR NO ERROR B5200191 RRRESREG LDQ* ISAVE RESTORE I-REGISTER B5200192 RR STQ- I B5200193 RR LDQ* QSAVE Q B5200194 RR JMP* (CNVRT) RETURN TO SENDER B5200195 RR SPC 4 B5200196 RR* B5200197 RR*******************************************************'********** B5200198 RR* B5200199 RR* STORAGES B5200200 RR* B5200201 RRADDSTK NUM 0,0 1. FIRST 2-WORD FOR ADD B5200202 RR NUM 0,0 2. SECOND B5200203 RRMULSTK NUM 0,0 3. RESULT 2-WORD FOR ADD (FIRST 2 FOR MUL) B5200204 RR NUM 0 4. STATUS FOR ADD (VALUE FOR MULTIPLY) B5200205 RR NUM 0,0 5. RESULT 2-WORD (FOR MULTIPLY) B5200206 RR NUM 0 6. STATUS FOR MULTIPLY B5200207 RRONECHA BZS ONECHA(8) B5200208 RRCOUNT NUM 0 B5200209 RRTEMP NUM 0 B5200210 RRINDEX NUM 0 B5200211 RRNOZOIN EQU NOZOIN(INDEX) B5200212 RRSTKSZ EQU STKSZ(*-ADDSTK) SIZE OF STORAGE LOCATIONS B5200213 RRISAVE NUM 0 I-SAVE B5200214 RRQSAVE NUM 0 Q-SAVE B5200215 RRBINAD NUM 0 2-WORD RESULT VALUE ADD. (FILLED) B5200216 RR SPC 3 B5200217 RR* B5200218 RR*******************************************************'******** B5200219 RR* B5200220 RR* ERROR ERROR ERROR B5200221 RR* B5200222 RR SPC 1 B5200223 RRPTER RTJ SYSMSG CALL SYSTEM MESSAGE ROUTINE B5200224 RR ADC ER307 B5200225 RR ADC TEMP B5200226 RR ENA 1 SET ERROR EXIT B5200227 RR JMP* RESREG B5200228 RRER307 NUM 307 ERROR MESSAGE INDEX B5200229 RR END B5200230 RR NAM FRHX B53 A ITOS CCS 3.0 SL-149B5300001 RR* UTILITY HEXIDECIMAL CONVERSION ROUTINE B5300002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B5300003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B5300004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B5300005 RR* B5300006 RR* *********'*******************************'***** B5300007 RR* * * B5300008 RR* * ROUTINE TO CONVERT A VALUE INTO HEX * B5300009 RR* * * B5300010 RR* *****************************************'***** B5300011 RR* B5300012 RR* B5300013 RR****** CALLING SEQUENCES : B5300014 RR* B5300015 RR* RTJ FRHX B5300016 RR* ADC DATBUF 5-WORD ARRAY, WORD 1 FOR VALUE B5300017 RR* THE LAST 4 WORDS ARE FOR HEX. VALUE B5300018 RR* (BITS 15-08-NULL, BITS 07-00-HEX) B5300019 RR* B5300020 RR* CALL FRHX(LVALUE) (FORTRAN SEQUENCE) B5300021 RR* B5300022 RR* B5300023 RR****** FOUTINE FUNCTION : B5300024 RR* B5300025 RR* THE VALUE IS CONVERTED INTO 4 ASCII CHARACTERS, B5300026 RR* RIGHT JUSTIFIED AND NULL FILLES BITS 15-08. B5300027 RR* B5300028 RR* B5300029 RR* B5300030 RR SPC 3 B5300031 RR* B5300032 RR****** *** E N T R Y N A M E B5300033 RR* B5300034 RR SPC 1 B5300035 RR ENT FRHX ROUTINE ENTRY NAME B5300036 RR SPC 2 B5300037 RR* B5300038 RR****** *** E Q U I V A L E N C E S B5300039 RR* B5300040 RR SPC 1 B5300041 RRLPMSK EQU LPMSK(2) BIT MASK B5300042 RRZERO EQU ZERO(2) CONSTANT ZERO B5300043 RR SPC 4 B5300044 RR* B5300045 RR****** ***** P R O G R A M S T A R T ***** B5300046 RR* B5300047 RR SPC 2 B5300048 RRFRHX NOP 0 ENTRY B5300049 RR STQ* QSAVE SAVE Q-REGISTER B5300050 RR LDA- I B5300051 RR STA* ISAVE SAVE I-REGISTER B5300052 RR* B5300053 RR LDA* (FRHX) GET PARAMETER ADDRESS AND SAVE IN I-REG. B5300054 RR STA- I B5300055 RR LDA- (ZERO),I GET VALUE AND SAVE B5300056 RR STA* TEMP B5300057 RR SPC 2 B5300058 RR* EXTRACT VALUE B5300059 RR SPC 1 B5300060 RR CLR A CLEAR CHARACTER COUNT B5300061 RR STA* INDEX B5300062 RRGETVAL LDA* TEMP GET VALUE AND EXTRACT 4 BIT B5300063 RR CLR Q B5300064 RR LLS 4 B5300065 RR STA* TEMP SAVE REMAINDER B5300066 RR TRQ A 4-BIT VALUE IN BOTH A AND Q B5300067 RR SPC 2 B5300068 RR* ASSEMBLE VALUE EITHER NUMERIC OR ALPHABETIC CHARACTER B5300069 RR SPC 1 B5300070 RR INA $30 SET FOR NUMERIC B5300071 RR INQ -10 B5300072 RR SQM SAVCHA B5300073 RR INA 7 BUMP TO ALPHABETIC CHARACTER B5300074 RR SPC 2 B5300075 RR* GET INDEX, STORE, INCREMENT COUNT AND CHECK IF DONE B5300076 RR SPC 1 B5300077 RRSAVCHA LDQ* INDEX GET STORAGE INDEX AND SAVE CHARACTER B5300078 RR STA- 1,B B5300079 RR INQ 1 INCREMENT INDEX BY 1 AND CHECK IF DONE B5300080 RR STQ* INDEX B5300081 RR INQ -4 B5300082 RR SQZ TOREST SKIP, ON DONE B5300083 RR JMP* GETVAL NOT DONE, TO REPEAT B5300084 RR SPC 2 B5300085 RR* RESTORE REGISTERS AND EXIT B5300086 RR SPC 1 B5300087 RRTOREST RAO* FRHX SET EXIT ADDRESS B5300088 RR LDA* ISAVE RESTORE I-REGISTER B5300089 RR STA- I B5300090 RR LDQ* QSAVE B5300091 RR JMP* (FRHX) RETURN TO SENDER B5300092 RR SPC 2 B5300093 RR* STORAGES B5300094 RR SPC 1 B5300095 RRISAVE NUM 0 I-REGISTER SAVE LOCATION B5300096 RRQSAVE NUM 0 Q B5300097 RRTEMP NUM 0 VALUE TEMPORARY STORAGE B5300098 RRINDEX NUM 0 NUMBER OF CHARACTER COUNT B5300099 RR END B5300100 RR NAM GENEOF B54 A ITOS CCS 3.0 SL-149B5400001 RR* UTILITY FILE MARK GENERATION ROUTINE B5400002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B5400003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B5400004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B5400005 RR* B5400006 RR* ************************************* B5400007 RR* * * B5400008 RR* * ROUTINE TO WRITE EOF MARK * B5400009 RR* * * B5400010 RR* ************************************* B5400011 RR* B5400012 RR* B5400013 RR******* ROUTINE FUNCTION : B5400014 RR* B5400015 RR* THIS ROUTINE IS USED TO WRITE END OF FILE MARK TO B5400016 RR* THE LOGICAL UNIT SUPPLIED BY THE CALLER. B5400017 RR* B5400018 RR* B5400019 RR******* CALLING SEQUENCE : B5400020 RR* B5400021 RR* RTJ GENEOF B5400022 RR* ADC LOGUNT LOGICAL UNIT B5400023 RR* B5400024 RR* B5400025 RR* B5400026 RR SPC 2 B5400027 RR* B5400028 RR******* E N T R Y N A M E B5400029 RR* B5400030 RR SPC 1 B5400031 RR ENT GENEOF ENTRY NAME B5400032 RR SPC 2 B5400033 RR* B5400034 RR******* E Q U I V A L E N C E S B5400035 RR* B5400036 RR SPC 1 B5400037 RRADISP EQU ADISP($EA) DISPATCHER B5400038 RRAMONI EQU AMONI($F4) MONITOR B5400039 RRCURLV EQU CURLV($EF) CURRENT PRIORITY LEVEL B5400040 RR* B5400041 RRD EQU D(1) 'D' BIT IN REQUEST B5400042 RRMOTCD EQU MOTCD(14) MOTION REQUEST CODE B5400043 RRNULL EQU NULL(0) NULL FIELD B5400044 RRRP EQU RP(4) REQUEST PRIORITY B5400045 RREOF EQU EOF(2) EOF MARK WITHIN MOTION REQUEST B5400046 RR SPC 1 B5400047 RR* LOW CORE EQUIVALENCE B5400048 RR SPC 1 B5400049 RRZERO EQU ZERO(2) CONSTANT ZERO B5400050 RR SPC 5 B5400051 RR* B5400052 RR****** ***** P R O G R A M S T A R T ***** B5400053 RR* B5400054 RR SPC 2 B5400055 RRGENEOF NOP 0 ENTRY B5400056 RR STQ* QSAVE SAVE Q-REGISTER B5400057 RR LDA- I I B5400058 RR STA* ISAVE B5400059 RR LDQ* (GENEOF) GET LOGICAL UNIT B5400060 RR LDA- (ZERO),Q B5400061 RR STA* LU B5400062 RR RAO* GENEOF SET TO EXIT B5400063 RR SPC 2 B5400064 RR* B5400065 RR* ASSEMBLE CURRENT PRIORITY WITH CALL CODE AND B5400066 RR* WRITE END OF FILE B5400067 RR* B5400068 RR SPC 1 B5400069 RR LDA- CURLV ASSEMBLE CURRENT PRIORITY LEVEL WITH CALL B5400070 RR ADD* CALCOD CODE B5400071 RR STA* CALPAR B5400072 RR* B5400073 RR RTJ- (AMONI) B5400074 RRCALPAR NUM 0 0. CALL CODE (FILLED) B5400075 RR ADC DONEOF 1. COMPLETION ADDRESS B5400076 RR NUM 0 2. THREAD B5400077 RRLU NUM 0 3. LOGICAL UNIT (FILLED) B5400078 RR VFD X4/EOF,N12/0 4. EOF CODE B5400079 RR JMP- (ADISP) B5400080 RR SPC 1 B5400081 RR* RETURN FROM EOF WRITE. IGNORE ERROR B5400082 RR SPC 1 B5400083 RRDONEOF LDA* ISAVE RESTORE I-REGISTER B5400084 RR STA- I B5400085 RR LDQ* QSAVE Q B5400086 RR JMP* (GENEOF) RETURN TO CALLER B5400087 RR SPC 1 B5400088 RR* STORAGES STORAGES B5400089 RR SPC 1 B5400090 RRISAVE NUM 0 B5400091 RRQSAVE NUM 0 B5400092 RRCALCOD VFD X2/D,X5/MOTCD,X1/NULL,X4/RP,X4/NULL B5400093 RR END B5400094 RR NAM BLD2 B55 A ITOS CCS 3.0 SL-149B5500001 RR* UTILITY CHARACTER ASSEMBLY ROUTINE B5500002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B5500003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B5500004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B5500005 RR* B5500006 RR* *****************************************'****** B5500007 RR* * * B5500008 RR* * ROUTINE TO ASSEMBLE 1 CHARACTER/WORD * B5500009 RR* * INTO 2 CHARACTERS/WORD * B5500010 RR* * * B5500011 RR* *****************************************'****** B5500012 RR* B5500013 RR* B5500014 RR****** CALLING SEQUENCE : B5500015 RR* B5500016 RR* RTJ BLD2 B5500017 RR* ADC LSOUR SOURCE DATA BUFFER (1 CHAR./WORD) B5500018 RR* ADC TARGT TARGET DATA BUFFER (2 CHAR./WORD) B5500019 RR* ADC SIZE SIZE (NO. OF CHARACTERS) B5500020 RR* B5500021 RR* B5500022 RR****** ROUTINE FUNCTION : B5500023 RR* B5500024 RR* THIS ROUTINE IS USED TO ASSEMBLE A SINGLE CHARACTER B5500025 RR* WORD INTO 2 CHARACTERS WORD. IT IS ALWAYS ASSUMED B5500026 RR* LEFT JUSTIFIED. B5500027 RR* B5500028 RR* B5500029 RR* B5500030 RR SPC 3 B5500031 RR* B5500032 RR****** *** E N T R Y N A M E B5500033 RR* B5500034 RR SPC 1 B5500035 RR ENT BLD2 ENTRY NAME B5500036 RR SPC 2 B5500037 RR* B5500038 RR****** *** E Q U I V A L E N C E S B5500039 RR* B5500040 RR SPC 1 B5500041 RRLPMSK EQU LPMSK(2) BIT MASK B5500042 RRONE EQU ONE(3) CONSTANT ONE B5500043 RRZERO EQU ZERO(2) CONSTANT ZERO B5500044 RR SPC 5 B5500045 RR* B5500046 RR****** ***** P R O G R A M S T A R T ***** B5500047 RR* B5500048 RR SPC 2 B5500049 RRBLD2 NOP 0 ENTRY B5500050 RR STQ* QSAVE SAVE Q-REGISTER B5500051 RR LDA- I I B5500052 RR STA* ISAVE B5500053 RR* B5500054 RR LDA* (BLD2) GET SOURCE BUFFER ADDRESS B5500055 RR STA- I B5500056 RR RAO* BLD2 BUMP TO NEXT PARAMETER ADD. B5500057 RR LDA* (BLD2) FETCH TARGET BUFFER ADDRESS B5500058 RR STA* TARGET B5500059 RR RAO* BLD2 INCREMENT TO THIRD PARAMETER ADD. B5500060 RR* B5500061 RR LDQ* (BLD2) OBTAIN NO. OF CHARACTER IN SOURCE BUFFER B5500062 RR LDA- (ZERO),Q B5500063 RR STA* SIZE B5500064 RR RAO* BLD2 SET EXIT LOCATION B5500065 RR SPC 1 B5500066 RR* INITIALIZATION B5500067 RR SPC 1 B5500068 RR CLR A CLEAR HIGH/LOW BYTE FLAG AND STORAGE INDEX B5500069 RR STA* HILO B5500070 RR STA* INDEX B5500071 RR STA* FETCH B5500072 RR SPC 1 B5500073 RR* GET CHARACTER AND ASSEMBLE B5500074 RR SPC 1 B5500075 RRAGAIN LDQ* FETCH SET GET CHARACTER INDEX B5500076 RR LDA- (ZERO),B B5500077 RR LDQ* HILO POSITION CHARACTER ACCORDING TO HI/LO FLAG B5500078 RR SQN POSCHA B5500079 RR ALS 8 B5500080 RRPOSCHA STA* TEMP B5500081 RR* B5500082 RR LDA* EXTMSK,Q GET MASK, RETAIN THE PROPER BYTE AND INSERT B5500083 RR LDQ* INDEX WITH CURRENT CHARACTER. THEN SAVE B5500084 RR AND* (TARGET),Q B5500085 RR ADD* TEMP B5500086 RR STA* (TARGET),Q B5500087 RR SPC 1 B5500088 RR* INCREMENT POINTERS AND CHECK IF DONE B5500089 RR SPC 1 B5500090 RR RAO* FETCH BUMP CHARACTER BEEN PROCESSED BY 1 B5500091 RR LDA* FETCH CHECK IF DONE B5500092 RR SUB* SIZE B5500093 RR SAN BMPTR SKIP, NOT DONE B5500094 RR* B5500095 RR LDA* ISAVE DONE, RESTORE I AND Q-REGISTERS B5500096 RR STA- I B5500097 RR LDQ* QSAVE B5500098 RR JMP* (BLD2) RETURN TO CALLER B5500099 RR SPC 1 B5500100 RR* B5500101 RRBMPTR LDA* HILO UPDATE HIGH/LOW BYTE FLAG B5500102 RR ADD- ONE B5500103 RR AND- ONE B5500104 RR STA* HILO B5500105 RR SAN TOREP B5500106 RR RAO* INDEX UPDATE SOTRAGE INDE IF 2 CHAR. BEEN PROCESSED B5500107 RRTOREP JMP* AGAIN TO REPEAT B5500108 RR SPC 2 B5500109 RR* CONSTANTS AND STORAGES B5500110 RR SPC 1 B5500111 RREXTMSK NUM $00FF,$FF00 EXTRACT CHARACTER MASKS B5500112 RRTARGET NUM 0 TARGET BUFFER ADD. B5500113 RRTEMP NUM 0 CHARACTER TEMPORARY STORAGE B5500114 RRINDEX NUM 0 SAVE INDEX B5500115 RRHILO NUM 0 HI/LO FLAG B5500116 RRFETCH NUM 0 GET INDEX B5500117 RRISAVE NUM 0 I-REGISTER B5500118 RRQSAVE NUM 0 Q B5500119 RRSIZE NUM 0 B5500120 RR END B5500121 RR NAM ORDER B56 A ITOS CCS 3.0 SL-149B5600001 RR* UTILITY DUMMY INTERFACE ROUTINE B5600002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B5600003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B5600004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B5600005 RR* B5600006 RR* ********************************************* B5600007 RR* * * B5600008 RR* * DUMMY INTERFACE BETWEEN PROCESSOR * B5600009 RR* * AND LOAD OPTION ANALYZER * B5600010 RR* * * B5600011 RR* *****************************************'*** B5600012 RR* B5600013 RR* B5600014 RR******* ROUTINE ENTRY METHOD : B5600015 RR* B5600016 RR* THIS ROUTINE IS ENTERED BY JUMP FROM PRE-LOAD WITH B5600017 RR* RETURN ADDRESS IN A-REGISTER B5600018 RR* B5600019 RR* B5600020 RR******* EXIT CONDITION : B5600021 RR* B5600022 RR* EXIT BACK TO PRE-LOAD ROUTINE WITH A-REGISTER B5600023 RR* CONTAINS EXIT INDICATOR (O FOR EXIT, NON-ZERO FOR B5600024 RR* OVERLAY NEXT MODULE). A-REGISTER IS SET BY B5600025 RR* PROCESSOR. B5600026 RR* B5600027 RR* B5600028 RR******* ROUTINE FUNCTION : B5600029 RR* B5600030 RR* THIS ROUTINE IS A DUMMY AND SERVES TWO MAJOR B5600031 RR* FUNCTIONS. THEY ARE : (1) UNIQUE LOAD PROCESSOR B5600032 RR* ENTRY NAME, AND (2) BINARY FILE ENTRY NAME. B5600033 RR* B5600034 RR* B5600035 RR* B5600036 RR SPC 3 B5600037 RR* B5600038 RR******* *** E N T R Y N A M E B5600039 RR* B5600040 RR SPC 1 B5600041 RR ENT UTSPEC LOAD SPECIAL OVERLAY MARKER B5600042 RR SPC 2 B5600043 RR* B5600044 RR****** *** E X T E R N A L B5600045 RR* B5600046 RR SPC 1 B5600047 RR EXT LDIXOD ORDERED INDEXED FILE B5600048 RR SPC 5 B5600049 RR* B5600050 RR****** ***** P R O G R A M S T A R T ***** B5600051 RR* B5600052 RR SPC 2 B5600053 RRUTSPEC NOP 0 ENTRY B5600054 RR STA* RETADD RETURN ADDRESS SAVE B5600055 RR RTJ LDIXOD CALL ORDERED INDEX FILE LOAD B5600056 RR ADC UTSPEC DUMMY PARAMETER B5600057 RR JMP* (RETADD) RETURN TO SENDER B5600058 RRRETADD NUM 0 RETURN ADDRESS (FILLED) B5600059 RR END B5600060 RR NAM PRELOD B57 A ITOS CCS 3.0 SL-149B5700001 RR* UTILITY LOAD FUNCTION MODE ANALYZER B5700002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B5700003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B5700004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B5700005 RR* B5700006 RR* *****************************************' B5700007 RR* * * B5700008 RR* * ROUTINE TO DETERMINE LOAD MODE * B5700009 RR* * * B5700010 RR* ****************************************** B5700011 RR* B5700012 RR* B5700013 RR****** ROUTINE FUNCITON : B5700014 RR* B5700015 RR* THIS ROUTINE SERVES AS BUFFERING TO DETERMINE WHICH B5700016 RR* 'LOAD' MODULE TO BE EXECUTED. THE NORMAL LOAD MODULEB5700017 RR* IS CALLED AT ENTRY, REGARDLESS. AFTER ANALYSIS THE B5700018 RR* PARAMETER, THIS ROUTINE IS CALLED,IF IT IS 'INDEXED B5700019 RR* FILE', TO OVERLAY THE PROPER PROCESSING MODULE. B5700020 RR* OTHERWISE LOADING IS COMPLETED PRIOR TO CONTROL TO B5700021 RR* RETURN TO THIS MODULE. B5700022 RR* B5700023 RR* OVERLAY FLAG (IN A-REGISTER) FROM MODULE 'LOAD'. B5700024 RR* B5700025 RR* 0 = LOADING DONE (EXIT) B5700026 RR* 1 = ORDERED INDEXED FILE LOADING B5700027 RR* 2 = NON-ORDERED INDEXED FILE LOADING B5700028 RR* B5700029 RR* B5700030 RR****** CALLING SEQUENCE : B5700031 RR* B5700032 RR* RTJ PRELOD B5700033 RR* B5700034 RR* B5700035 RR* B5700036 RR****** CALL METHOD TO PROCESSOR : B5700037 RR* B5700038 RR* JMP NEXTLO+1 LAST LOCATION OF THIS ROUTINE + 1 B5700039 RR* B5700040 RR* A-REGISTER = RETURN ADDRESS B5700041 RR* B5700042 RR SPC 3 B5700043 RR* B5700044 RR****** *** E N T R Y N A M E B5700045 RR* B5700046 RR SPC 1 B5700047 RR ENT PRELOD ENTRY NAME B5700048 RR SPC 2 B5700049 RR* B5700050 RR****** *** E X T E R N A L S B5700051 RR* B5700052 RR SPC 1 B5700053 RR EXT FMULOD MODULE STARTING LOCATION B5700054 RR EXT CLOSFL CLOSE FILE B5700055 RR EXT OPENFL OPEN FILE B5700056 RR EXT READR READ 1 RECORD B5700057 RR EXT SYSMSG PRINT ERROR MESSAGE B5700058 RR SPC 3 B5700059 RR* B5700060 RR****** *** E Q U I V A L E N C E S B5700061 RR* B5700062 RR SPC 1 B5700063 RRAMONI EQU AMONI($F4) MONITOR B5700064 RRADISP EQU ADISP($EA) DISPATCHER B5700065 RRCURLV EQU CURLV($EF) CURRENT PRIORITY LEVEL B5700066 RRD EQU D(1) 'D' BIT B5700067 RRFRED EQU FRED(4) F-READ REQUEST CODE B5700068 RRNULL EQU NULL(0) NULL B5700069 RRRP EQU RP(4) REQUEST PRIORITY B5700070 RRTHREE EQU THREE(4) CONSTANT 3 B5700071 RR SPC 1 B5700072 RR* ERROR CODE B5700073 RR SPC 1 B5700074 RRER30 EQU ER30(30) UTILITY PROCESSOR NOT FOUND B5700075 RRER33 EQU ER33(33) OPEN FILE REJECT B5700076 RR SPC 3 B5700077 RR* B5700078 RR* B5700079 RR* LABELED COMMON AREA B5700080 RR* B5700081 RR DAT COMCOD(133),PARNAM(121) B5700082 RR DAT PPHELP(2) B5700083 RR DAT PPINIT(4) B5700084 RR DAT PPDEFI(16) B5700085 RR DAT PPSTAT(4) B5700086 RR DAT PPRELO(5) 122*4875B5700087 RR DAT PPDUMP(5) 122*4875B5700088 RR DAT PPCOPY(6) B5700089 RR DAT PPDELE(3) B5700090 RR DAT PPCLEA(3) B5700091 RR DAT PPLIST(6) 122*4875B5700092 RR DAT PPRENA(5) B5700093 RR DAT PPCOMM(2) B5700094 RR DAT PPEXIT(1) B5700095 RR DAT PPMOUN(3) B5700096 RR DAT PPDISM(2) B5700097 RR DAT PPSAVE(3) B5700098 RR DAT PPBATC(5) BATCH B5700099 RR DAT PPLOAD(5) B5700100 RR DAT PPPURG(3) B5700101 RR DAT PPINPU(2) B5700102 RR DAT PPOUTP(2) B5700103 RR DAT PPCOMP(3) B5700104 RR DAT PPHOST(4) HOST B5700105 RR DAT PPSET(3) SET B5700106 RR DAT PPBATS(4) BATCH STATUS B5700107 RR DAT PPDISC(2) DISCARD B5700108 RR DAT PPDISP(7) DISPOSE B5700109 RR DAT PPFLUS(3) FLUSH B5700110 RR DAT PPPRIN(3) PRINT B5700111 RR DAT DUMMY(6) B5700112 RR DAT INBUF(41),CODE(20) B5700113 RR DAT LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST,NOCOD,PIND B5700114 RR DAT REQBUF(24),IDATA(24) B5700115 RR DAT PARDEF(24) B5700116 RR DAT FCBHDR(5) B5700117 RR DAT FCBBUF(96) B5700118 RR EQU ENDCOM(FCBBUF+96) END OF COMMON AREA B5700119 RR EQU COMLEN(ENDCOM-COMCOD) B5700120 RR SPC 5 B5700121 RR* B5700122 RR****** ***** P R O G R A M S T A R T ***** B5700123 RR* B5700124 RR SPC 2 B5700125 RRPRELOD NOP 0 ENTRY B5700126 RRSETUP LDA =XCOMBAK GET UP RETURN ADDRESS B5700127 RRTOEX LDQ =XNEXTLO SET PROCESSOR ADDRESS (MINUS 1) B5700128 RR JMP- 1,Q JUMP TO PROCESSOR B5700129 RRCOMBAK SAN INDEX SKIP ON REQUEST FOR INDEXED FILE MODULE B5700130 RRGETOUT JMP* (PRELOD) RETURN TO SENDER. DONE B5700131 RR SPC 2 B5700132 RR* B5700133 RR*----- SET UP GET FILE REQUEST TO OVERLAY PROPER LOAD MODULE B5700134 RR* B5700135 RR* 1 = ORDERED INDEX REQUEST B5700136 RR* 2 = RANDOM INDEX REQUEST B5700137 RR* B5700138 RR SPC 1 B5700139 RRINDEX INA -1 CALCULATE INDEX TO MOVE FILE NAME FOR B5700140 RR MUI- THREE REQUEST B5700141 RR STA- I B5700142 RRRLDNAM LDA* NAME,B B5700143 RR STA* CODEX,Q B5700144 RR INQ 1 B5700145 RR TRQ A B5700146 RR INA -3 B5700147 RR SAZ TOCLR B5700148 RR JMP* RLDNAM B5700149 RR SPC 2 B5700150 RR* CLEAR REQUEST BUFFER AND OPEN FILE B5700151 RR SPC 1 B5700152 RRTOCLR ENQ 23 CLERE REQUEST BUFFER B5700153 RR CLR A B5700154 RRCLREQB STA* REQBUX,Q B5700155 RR SQZ TOPNFL B5700156 RR INQ -1 B5700157 RR JMP* CLREQB B5700158 RR* B5700159 RRTOPNFL LDA =XFCBHDR B5700160 RR STA* REQBUX+9 B5700161 RR RTJ OPENFL OPEN FILE (SYSTEM PROGRAM FILE) B5700162 RR ADC REQBUX B5700163 RR ADC NDATA B5700164 RR ADC STATUS B5700165 RR SPC 1 B5700166 RR* UPON RETURN, CHECK STATUS B5700167 RR SPC 1 B5700168 RR LDA* STATUS CHECK IF OK B5700169 RR SAZ REDNAM B5700170 RR ENA ER33 B5700171 RR JMP* ERROR B5700172 RR* B5700173 RRREDNAM RTJ READR READ THE DESIRE ENTRY RECORD B5700174 RR ADC REQBUX B5700175 RR ADC INFO B5700176 RR ADC CODEX B5700177 RR ADC STATUS B5700178 RR* B5700179 RR RTJ CLOSFL CLOSE FILE B5700180 RR ADC REQBUX B5700181 RR ADC STATUS+1 B5700182 RR* B5700183 RR SPC 1 B5700184 RR* CHECK IF PROGRAM FOUND B5700185 RR SPC 1 B5700186 RR LDA* STATUS CHECK IF PROCESSOR FOUND B5700187 RR SAZ LODPFD YES, SKIP B5700188 RR ENA ER30 NO, SET ERROR CODE AND TO ERROR PROCESSING B5700189 RR JMP* ERROR B5700190 RR SPC 3 B5700191 RR* B5700192 RR* B5700193 RR*----- GET MM ADDRESS AND READ B5700194 RR* B5700195 RR* B5700196 RR SPC 1 B5700197 RRLODPFD LDA* INFO+3 GET PROCESS PROGRAM FILE MASS MEMORY ADDRESS B5700198 RR STA* MSB MSB B5700199 RR LDA* INFO+4 LSB B5700200 RR STA* LSB B5700201 RR LDA* INFO+5 LENGTH B5700202 RR STA* LENGTH B5700203 RR LDA- CURLV ASSEMBLE CALL CODE WITH CURRENT PRIORITY B5700204 RR ADD* CALCOD B5700205 RR STA* REQCOD B5700206 RR LDA* TOEX+1 GENERATE OVERLAY ADDRESS AND SAVE B5700207 RR INA 1 B5700208 RR STA* STADDR B5700209 RR* B5700210 RR* READ INTO OVERLAY AREA B5700211 RR* B5700212 RR RTJ- (AMONI) B5700213 RRREQCOD VFD X2/D,X5/FRED,X1/NULL,X4/RP,X4/NULL B5700214 RR ADC TOSTAR 1. COMPLETION ADD. B5700215 RR NUM 0 2. THREAD B5700216 RR NUM $08C2 3. LU (LIBRARY) B5700217 RRLENGTH NUM 0 4. LENGTH (FILLED) B5700218 RRSTADDR NUM 0 5. OVERLAY STARTING ADD. (FILLED) B5700219 RRMSB NUM 0 6. MSB OF MM ADD. (FILLED) B5700220 RRLSB NUM 0 7. LSB (FILLED) B5700221 RR JMP- (ADISP) B5700222 RR SPC 2 B5700223 RR* B5700224 RR***** TO START PROGRAM B5700225 RR* B5700226 RR SPC 1 B5700227 RRTOSTAR JMP* SETUP TO TRANSFER CONTROL TO PROCESSOR B5700228 RR SPC 3 B5700229 RR* B5700230 RR*----- *** ERROR ERROR B5700231 RR* B5700232 RR SPC 1 B5700233 RRERROR STA* STATUS B5700234 RR RTJ SYSMSG B5700235 RR ADC STATUS B5700236 RR ADC NONE B5700237 RR ENA 0 B5700238 RR JMP* GETOUT B5700239 RR SPC 3 B5700240 RR* B5700241 RR****** ***** ***** ***** ***** ***** B5700242 RR* B5700243 RR* B5700244 RR* CONSTANTS AND STORAGES B5700245 RR* B5700246 RR SPC 1 B5700247 RRSTATUS NUM 0,0 B5700248 RRCALCOD VFD X2/D,X5/FRED,X1/NULL,X4/RP,X4/NULL B5700249 RR SPC 1 B5700250 RR* INDEXED FILE LOAD NAMES B5700251 RRNAME ALF *,UTORLD* 1- ORDERED INDEX LOAD B5700252 RR ALF *,UTRMLD* 2. RANDOM INDEX LOAD B5700253 RRINFO BZS INFO(6) B5700254 RRCODEX BZS CODEX(4) B5700255 RRREQBUX BZS REQBUX(24) B5700256 RRNDATA ALF *,$$PGMNAM$$ * B5700257 RR NUM 1,1,0 B5700258 RRNONE EQU NONE(*-1) B5700259 RRNEXTLO EQU NEXTLO(*-1) B5700260 RR END B5700261 RR NAM RANDOM B58 A ITOS CCS 3.0 SL-149B5800001 RR* UTILITY DUMMY INTERFACE ROUTINE B5800002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B5800003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B5800004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B5800005 RR* B5800006 RR* *****************************************'*** B5800007 RR* * * B5800008 RR* * DUMMY INTERFACE BETWEEN PROCESSOR * B5800009 RR* * AND LOAD OPTION ANALYZER * B5800010 RR* * * B5800011 RR* ********************************************* B5800012 RR* B5800013 RR* B5800014 RR******* ROUTINE ENTRY METHOD : B5800015 RR* B5800016 RR* THIS ROUTINE IS ENTERED BY JUMP FROM PRE-LOAD WITH B5800017 RR* RETURN ADDRESS IN A-REGISTER B5800018 RR* B5800019 RR* B5800020 RR******* EXIT CONDITION : B5800021 RR* B5800022 RR* EXIT BACK TO PRE-LOAD ROUTINE WITH A-REGISTER B5800023 RR* CONTAINS EXIT INDICATOR (O FOR EXIT, NON-ZERO FOR B5800024 RR* OVERLAY NEXT MODULE). A-REGISTER IS SET BY B5800025 RR* PROCESSOR. B5800026 RR* B5800027 RR* B5800028 RR******* ROUTINE FUNCTION : B5800029 RR* B5800030 RR* THIS ROUTINE IS A DUMMY AND SERVES TWO MAJOR B5800031 RR* FUNCTIONS. THEY ARE : (1) UNIQUE LOAD PROCESSOR B5800032 RR* ENTRY NAME, AND (2) BINARY FILE ENTRY NAME. B5800033 RR* B5800034 RR* B5800035 RR* B5800036 RR SPC 3 B5800037 RR* B5800038 RR******* *** E N T R Y N A M E B5800039 RR* B5800040 RR SPC 1 B5800041 RR ENT UTSPEC LOAD SPECIAL OVERLAY MARKER B5800042 RR SPC 2 B5800043 RR* B5800044 RR****** *** E X T E R N A L B5800045 RR* B5800046 RR SPC 1 B5800047 RR EXT BLDIDR RANDOM INDEXED FILE B5800048 RR SPC 5 B5800049 RR* B5800050 RR****** ***** P R O G R A M S T A R T ***** B5800051 RR* B5800052 RR SPC 2 B5800053 RRUTSPEC NOP 0 ENTRY B5800054 RR STA* RETADD RETURN ADDRESS SAVE B5800055 RR RTJ BLDIDR RANDOM INDEXED FILE PROCESSOR B5800056 RR ADC UTSPEC DUMMY PARAMETER B5800057 RR JMP* (RETADD) RETURN TO SENDER B5800058 RRRETADD NUM 0 RETURN ADDRESS (FILLED) B5800059 RR END B5800060 RR NAM SEQLOD B59 A ITOS CCS 3.0 SL-149B5900001 RR* UTILITY DUMMY INTERFACE ROUTINE B5900002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B5900003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B5900004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B5900005 RR* B5900006 RR* *****************************************'*** B5900007 RR* * * B5900008 RR* * DUMMY INTERFACE BETWEEN PROCESSOR * B5900009 RR* * AND LOAD OPTION ANALYZER * B5900010 RR* * * B5900011 RR* ********************************************* B5900012 RR* B5900013 RR* B5900014 RR******* ROUTINE ENTRY METHOD : B5900015 RR* B5900016 RR* THIS ROUTINE IS ENTERED BY JUMP FROM PRE-LOAD WITH B5900017 RR* RETURN ADDRESS IN A-REGISTER B5900018 RR* B5900019 RR* B5900020 RR******* EXIT CONDITION : B5900021 RR* B5900022 RR* EXIT BACK TO PRE-LOAD ROUTINE WITH A-REGISTER B5900023 RR* CONTAINS EXIT INDICATOR (O FOR EXIT, NON-ZERO FOR B5900024 RR* OVERLAY NEXT MODULE). A-REGISTER IS SET BY B5900025 RR* PROCESSOR. B5900026 RR* B5900027 RR* B5900028 RR******* ROUTINE FUNCTION : B5900029 RR* B5900030 RR* THIS ROUTINE IS A DUMMY AND SERVES TWO MAJOR B5900031 RR* FUNCTIONS. THEY ARE : (1) UNIQUE LOAD PROCESSOR B5900032 RR* ENTRY NAME, AND (2) BINARY FILE ENTRY NAME. B5900033 RR* B5900034 RR* B5900035 RR* B5900036 RR SPC 2 B5900037 RR* B5900038 RR****** *** E X T E R N A L B5900039 RR* B5900040 RR SPC 1 B5900041 RR EXT LOAD SEQUENCE FILE LOAD B5900042 RR SPC 5 B5900043 RR* B5900044 RR****** ***** P R O G R A M S T A R T ***** B5900045 RR* B5900046 RR SPC 2 B5900047 RRUTSPEC NOP 0 ENTRY B5900048 RR STA* RETADD RETURN ADDRESS SAVE B5900049 RR RTJ LOAD CALL ORDERED INDEX FILE LOAD B5900050 RR ADC UTSPEC DUMMY PARAMETER B5900051 RR JMP* (RETADD) RETURN TO SENDER B5900052 RRRETADD NUM 0 RETURN ADDRESS (FILLED) B5900053 RR END B5900054 RR NAM TOWT B60 A ITOS CCS 3.0 SL-149B6000001 RR* UTILITY UNFORMATTED WRITE PROCESSOR B6000002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B6000003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B6000004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B6000005 RR* B6000006 RR* ************************************************* B6000007 RR* * * B6000008 RR* * * ROUTINE TO WRITE DATA TO PRINT DEVICE * B6000009 RR* * VIA MONITOR WITH NORMAL WRITE REQUEST * B6000010 RR* * * B6000011 RR* *********'*******************************'******* B6000012 RR* B6000013 RR* B6000014 RR****** CALLING SEQUENCE : B6000015 RR* B6000016 RR* RTJ TOWT B6000017 RR* ADC LU LOGICAL UNIT B6000018 RR* ADC MES MESSAGE BUFFER B6000019 RR* ADC SIZE SIZE OF MESSAGE B6000020 RR* B6000021 RR* B6000022 RR* CALL TOWT(LU,MES,SIZE) (FORTRAN CALL) B6000023 RR* B6000024 RR* B6000025 RR* B6000026 RR****** ROUTINE FUNCTION : B6000027 RR* B6000028 RR* THIS ROUTINE IS USED TO OUTPUT A CALLER'S MESSAGE B6000029 RR* WITH CALLER SUPPLIED LOGICAL UNIT. CURRENT ROUTINE B6000030 RR* EXECUTION PRIORITY IS USED FOR COMPLETION PRIORITY B6000031 RR* B6000032 RR* B6000033 RR* B6000034 RR SPC 3 B6000035 RR* B6000036 RR****** *** E N T R Y N A M E B6000037 RR* B6000038 RR SPC 1 B6000039 RR ENT TOWT ENTRY NAME B6000040 RR SPC 2 B6000041 RR* B6000042 RR****** *** E Q U I V A L E N C E S B6000043 RR* B6000044 RR SPC 1 B6000045 RRAMONI EQU AMONI($F4) MSOS MONITOR ENTRY B6000046 RRADISP EQU ADISP($EA) MSOS DISPATCHER ENTRY B6000047 RRCURPL EQU CURPL($EF) MSOS CURRENT PRIORITY LEVEL B6000048 RR SPC 1 B6000049 RRWTCD EQU WTCD(2) WRITE REQUEST CODE B6000050 RRRQPL EQU RQPL(4) REQUEST PRIORITY LEVEL B6000051 RRD EQU D(1) PART 1 REQUEST FLAG B6000052 RRX EQU X(0) RELATIVE REQUEST FLAG B6000053 RRNULL EQU NULL(0) NULL FIELD B6000054 RRZERO EQU ZERO(2) CONSTANT ZERO B6000055 RR SPC 5 B6000056 RR* B6000057 RR****** ***** P R O G R A M S T A R T ***** B6000058 RR* B6000059 RR SPC 2 B6000060 RRTOWT NOP 0 ENTRY B6000061 RR STQ* QSAVE SAVE Q-REGISTER B6000062 RR LDA- I I B6000063 RR STA* ISAVE B6000064 RR* B6000065 RR LDQ* (TOWT) GET OUTPUT DEVICE LOGICAL UNIT B6000066 RR LDA- (ZERO),Q B6000067 RR STA* LU B6000068 RR RAO* TOWT BUMP TO NEXT PARAMETER ADD. B6000069 RR* B6000070 RR LDA* (TOWT) GET MESSAGE BUFFER ADDRESS B6000071 RR STA* BUFAD B6000072 RR RAO* TOWT SET TO NEXT PARAMETER ADD. B6000073 RR* B6000074 RR LDQ* (TOWT) GET MESSAGE SIZE B6000075 RR LDA- (ZERO),Q B6000076 RR STA* SIZE B6000077 RR RAO* TOWT SET EXIT LOCATION B6000078 RR SPC 2 B6000079 RR* ASSEMBLE CALL CODE B6000080 RR SPC 1 B6000081 RR LDA- CURPL INSERT CURRENT PRIORITY LEVEL IN CALL CODE B6000082 RR ADD* CALCOD B6000083 RR STA* CALPAR B6000084 RR RTJ- (AMONI) B6000085 RRCALPAR NUM 0 0. CALL PARAMETER (FILLED) B6000086 RR ADC COMPAD 1. COMPLETION ADDRESS B6000087 RR NUM 0 2. THREAD B6000088 RRLU NUM 0 3. LOGICAL UNIT (FILLED) B6000089 RRSIZE NUM 0 4. SIZE (FILLED) B6000090 RRBUFAD NUM 0 5. BUFFER (FILLED) B6000091 RR JMP- (ADISP) B6000092 RR SPC 2 B6000093 RR* RETURN FROM WRITE B6000094 RR SPC 1 B6000095 RRCOMPAD LDA* ISAVE RESTORE I-REGISTER B6000096 RR STA- I B6000097 RR LDQ* QSAVE RECALL Q-REGISTER B6000098 RR JMP* (TOWT) RETURN B6000099 RR SPC 3 B6000100 RR* STORAGES B6000101 RR SPC 1 B6000102 RRISAVE NUM 0 I-REGISTER B6000103 RRQSAVE NUM 0 Q-REGISTER B6000104 RRCALCOD VFD X2/D,X5/WTCD,X1/X,X4/RQPL,X4/NULL B6000105 RR END B6000106 RR NAM VLTOI B61 A ITOS CCS 3.0 SL-149B6100001 RR* UTILITY INTEGER CONVERSION ROUTINE B6100002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B6100003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B6100004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B6100005 RR* B6100006 RR* *****************************************'***** B6100007 RR* * * B6100008 RR* * ROUTINE TO CONVERT VALUE TO INTEGER * B6100009 RR* * * B6100010 RR* *********'************************************* B6100011 RR* B6100012 RR* B6100013 RR****** CALLING SEQUENCE : B6100014 RR* B6100015 RR* RTJ VLTOI B6100016 RR* ADC DATBUF 6-WORD ARRAY WITH WORD 1 AS VALUE AND B6100017 RR* LAST 5 WORDS FOR ASCII INTEGERS B6100018 RR* B6100019 RR* CALL VLTOI(DATBUF) (FORTRAN SEQUENCE) B6100020 RR* B6100021 RR* B6100022 RR****** ROUTINE FUNCTION : B6100023 RR* B6100024 RR* THIS ROUTINE CONVERTS AN UNSIGN VALUE TO 5 ASCII B6100025 RR* INTEGER AND RIGHT JUSTIFIED WITH NULL FILLED LEFT B6100026 RR* PORTION. LEADING ZERO IS SPACE FILLED. B6100027 RR* B6100028 RR* B6100029 RR* B6100030 RR SPC 3 B6100031 RR* B6100032 RR****** *** E N T R Y N A M E B6100033 RR* B6100034 RR SPC 1 B6100035 RR ENT VLTOI ENTRY NAME B6100036 RR SPC 2 B6100037 RR* B6100038 RR****** *** E Q U I V A L E N C E S B6100039 RR* B6100040 RR SPC 1 B6100041 RRLPMSK EQU LPMSK(2) BIT MASK B6100042 RRZERO EQU ZERO(2) CONSTANT ZERO B6100043 RR SPC 1 B6100044 RR* SYSTEM DEPENDENT VARIABLE B6100045 RR SPC 1 B6100046 RRMAXDIG EQU MAXDIG(5) MAX. NO. OF DIGITS TO BE CONVERTED B6100047 RR SPC 5 B6100048 RR* B6100049 RR****** ***** P R O G R A M S T A R T ***** B6100050 RR* B6100051 RR SPC 3 B6100052 RRVLTOI NOP 0 ENTRY B6100053 RR STQ* QSAVE SAVE Q-REGISTER B6100054 RR LDA- I I B6100055 RR STA* ISAVE B6100056 RR SPC 1 B6100057 RR* GET PARAMETER B6100058 RR SPC 1 B6100059 RR LDA* (VLTOI) GET PARAMETER ADDRESS B6100060 RR STA- I B6100061 RR STA* PARADD B6100062 RR LDA- (ZERO),I GET VALUE TO BE CONVERTED B6100063 RR STA* VALUE B6100064 RR* B6100065 RR CLR A B6100066 RR STA* INDEX B6100067 RR STA* LEDZRO B6100068 RR SPC 1 B6100069 RR* REPEAT DIVIDE VALUE BY 10**I B6100070 RR SPC 1 B6100071 RRREPEAT LDA* INDEX GET CHARACTER INDEX B6100072 RR STA- I B6100073 RR CLR Q B6100074 RR LDA* VALUE CONVERT VALUE BY DIVIDING TO TEN POWER B6100075 RR DVI* POWER,I B6100076 RR STQ* VALUE B6100077 RR* B6100078 RR LDQ* LEDZRO GET LEADING ZERO FLAG B6100079 RR SAZ CHARO B6100080 RR RAO* LEDZRO SET NON-LEADING ZERO FOR VALUE OTHER THAN 0 B6100081 RRASMASC INA $30 CONVERT AS ASCII B6100082 RR* B6100083 RR LDQ* INDEX BUMP INDEX AND SAVE CHARACTER B6100084 RR INQ 1 B6100085 RR STA* (PARADD),Q B6100086 RR STQ* INDEX B6100087 RR INQ -MAXDIG CHECK IF DONE B6100088 RR SQZ DONASM YES, SKIP (DONE) B6100089 RR JMP* REPEAT NO, REPEAT B6100090 RR SPC 1 B6100091 RR* CHARACTER IS ZERO, CHECK IF LEADING ZERO B6100092 RR* IF SO IGNORE IT AND REPLACE WITH SPACE B6100093 RR SPC 1 B6100094 RRCHARO SQN TOASM B6100095 RR ENA $20-$30 B6100096 RRTOASM JMP* ASMASC B6100097 RR SPC 2 B6100098 RR* DONE CONVERSION B6100099 RR* CHECK IF ALL ZERO, IF SO, SET ONE ZERO B6100100 RR SPC 1 B6100101 RRDONASM LDQ* LEDZRO CHECK IF ANY VALUE (NON-ZERO) B6100102 RR SQN RESTR YES, SKIP B6100103 RR ENQ MAXDIG B6100104 RR ENA $30 SAVE ZERO B6100105 RR STA* (PARADD),Q B6100106 RR SPC 1 B6100107 RR* B6100108 RRRESTR LDQ* QSAVE RESTORE Q-REGISTER B6100109 RR LDA* ISAVE I B6100110 RR STA- I B6100111 RR RAO* VLTOI SET EXIT B6100112 RR JMP* (VLTOI) RETURN TO CALLER B6100113 RR SPC 3 B6100114 RR* CONSTANTS AND STORAGES B6100115 RR SPC 1 B6100116 RRPOWER NUM 10000,1000,100,10,1 B6100117 RRVALUE NUM 0 B6100118 RRQSAVE NUM 0 Q-REGISTER B6100119 RRISAVE NUM 0 I B6100120 RRPARADD NUM 0 PARAMETER ADDRESS B6100121 RRLEDZRO NUM 0 LEADING ZERO FLAG (NON-ZERO FOR NON-ZERO) B6100122 RRINDEX NUM 0 CHARACTER STORAGE INDEX B6100123 RR END B6100124 RR NAM KIBMGR B62 A ITOS CCS 3.0 SL-149B6200001 RR* KEY INFORMATION BLOCK MANAGER B6200002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 B6200003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA B6200004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 B6200005 RR* B6200006 RR* KIBMGR WILL PERFORM SATISFACTORILY AS LONG AS SECTOR B6200007 RR* SIZE IS GREATER THAN OR EQUAL TO 96 WORDS AND LESS THAN B6200008 RR* OR EQUAL TO 572 WORDS. KIBMGR WILL EFFICIENTLY MANAGE B6200009 RR* KIB BUFFER SPACE AS LONG AS THIS REQUIREMENT IS MET. B6200010 RR* THIS BUFFER IS CURRENTLY SIZED FOR FOURTEEN 288 WORD KIBS. B6200011 RR* B6200012 RR* B6200013 RR* ENTRY POINTS B6200014 RR ENT INIKIB INITIALIZE KIB CONTROL TABLES B6200015 RR ENT NXTKIB GET RELATIVE KIB NO. FOR NEXT FREE KIB SPACE B6200016 RR ENT MRKKIB MARK KIB IN COMMON BUFFER AS CHANGED B6200017 RR ENT FREEUP FREE UP BUFFER FOR NEW KIB. B6200018 RR ENT GETKIB GET SPECIFIED KIB B6200019 RR ENT WRTKIB WRITE ALL CHANGED RESIDENT KIBS TO MASS MEMORYB6200020 RR SPC 3 B6200021 RR* EXTERNALS B6200022 RR EXT READR READ RECORD (KIB) RANDOMLY B6200023 RR EXT UPDREC UPDATE RECORD (KIB) B6200024 RR EXT FMEOFC FILE MANAGER END OF FILE CODE B6200025 RR EXT DWSUB DOUBLE WORD SUBTRACT B6200026 RR EXT DWADD DOUBLE WORD ADD B6200027 RR SPC 2 B6200028 RR* EQUIVALENCES B6200029 RR EQU ONEMSK(3) ONE MASK TABLE B6200030 RR EQU ZERO($22) SYSTEM ZERO B6200031 RR EQU ONEBIT($23) ONE BIT TABLE B6200032 RR SPC 2 B6200033 RR* DEFINITION OF BUILD INDEX COMMON B6200034 RR DAT RQBADR REQUEST BUFFER ADDRESS B6200035 RR DAT FCBADR FCB ADDRESS (INCLUDES HEADER) B6200036 RR DAT IDUM1(23) B6200037 RR DAT KIBBUF(572) B6200038 RR DAT IDUM2(83) B6200039 RR DAT NEWKBM NEW KIB MSB B6200040 RR DAT NEWKBL NEW KIB LSB B6200041 RR DAT IDUM3(7) B6200042 RR DAT REQSTA B6200043 RR DAT RKIBNO(2) REL. KIB. NO. OF COMMON BUFFER KIB B6200044 RR DAT IDUM4(4) B6200045 RR DAT WPS WORDS PER SECTOR B6200046 RR DAT ZERO2(2) B6200047 RR DAT BUFIDX OFFSET INDEX FROM KIBBUF TO CURRENT KIB B6200048 RR EJT B6200049 RR* FILE CONTROL BLOCK EQUIVALENCES B6200050 RR EQU FH(4) LENGTH -1 OF FCB HEADER B6200051 RR EQU FILEID(ZERO) FILE IDENTIFIER B6200052 RR* ACCESS FILEID INDIRECTLY B6200053 RR* BITS 15-11 FILE MANAGER LOGICAL UNIT NUMBERB6200054 RR* BITS 10-00 INDEX OF FCB IN FCB TABLE B6200055 RR EQU FCBFLG(1) FCB FLAGS B6200056 RR* BITS 15-8, SPARE B6200057 RR* BITS 7-00, NUMBER OF USERS USING FILE B6200058 RR EQU FILOCK(2) FILE LOCK FLAG (IF NON-0, CONTAINS USER ID) B6200059 RR EQU NUMSET(3) NUMBER OF SETS OF LOCKED RECORDS IN FILE B6200060 RR EQU NUMNEW(4) NUMBER OF NEW RECORDS SINCE FCB UPDATED ON MM B6200061 RR SPC 1 B6200062 RR EQU RECLEN(FH+1) RECORD LENGTH IN WORDS B6200063 RR EQU TDATRM(FH+2) TOTAL NUMBER OF DATA RECORDS, MSB B6200064 RR EQU TDATRL(FH+3) TOTAL NUMBER OF DATA RECORDS, LSB B6200065 RR EQU DATBAM(FH+4) DATA RECORDS BEGINNING SECTOR ADDRESS, MSB B6200066 RR EQU DATBAL(FH+5) DATA RECORDS BEGINNING SECTOR ADDRESS,LMSB B6200067 RR EQU FCBIND(FH+6) FCB INDICATORS B6200068 RR* BIT 15 , SECTOR ALLIGNED RECORDS IF =1 B6200069 RR* BIT 14 , STORAGE MODE FOR INDEXED FILE B6200070 RR* =0, RECORDS STORED RANDOMLY WITHB6200071 RR* RESPECT TO PRIMARY KEY B6200072 RR* =1, RECORDS STORED IN ORDER WIT B6200073 RR* RESPECT TO PRIMARY KEY B6200074 RR* BIT 13 , =1, FILE IS CURRENTLY OPEN B6200075 RR* =0, FILE IS CURRENTLY CLOSED B6200076 RR* BIT 12 , =1, FILE IS BEING COMPRESSED B6200077 RR* =0, FILE IS NOT BEING COMPRESSEDB6200078 RR* BIT 0 , FILE TYPE B6200079 RR* =0, SEQUENTIAL FILE B6200080 RR* =1, INDEXED FILE B6200081 RR EQU NEDATM(FH+7) NUMBER OF EXISTING DATA RECORDS, MSB B6200082 RR EQU NEDATL(FH+8) NUMBER OF EXISTING DATA RECORDS, LSB B6200083 RR EQU SEQLTH(NEDATL-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION B6200084 RR* OF FCB FOR A SEQUENTIAL FILE B6200085 RR SPC 1 B6200086 RR EQU NEXTBM(FH+9) NEXT FREE KEY INDEX BLOCK, MSB B6200087 RR EQU NEXTBL(FH+10) NEXT FREE KEY INDEX BLOCK, LSB B6200088 RR EQU TNKEYM(FH+11) TOTAL NUMBER OF KEY INDEX BLOCKS, MSB B6200089 RR EQU TNKEYL(FH+12) TOTAL NUMBER OF KEY INDEX BLOCKS, LSB B6200090 RR EQU KEYBAM(FH+13) KEY INDEX BEGINNING SECTOR ADDRESS, MSB B6200091 RR EQU KEYBAL(FH+14) KEY INDEX BEGINNING SECTOR ADDRESS, LSB B6200092 RR EQU LENKY1(FH+15) LENGTH OF KEY NO. 1 B6200093 RR EQU POSKY1(FH+16) BYTE POSITION OF KEY NO. 1 B6200094 RR EQU LENKY2(FH+17) LENGTH OF KEY NO. 2 B6200095 RR EQU POSKY2(FH+18) BYTE POSITION OF KEY NO. 2 B6200096 RR EQU LENKY3(FH+19) LENGTH OF KEY NO. 3 B6200097 RR EQU POSKY3(FH+20) BYTE POSITION OF KEY NO. 3 B6200098 RR EQU LENKY4(FH+21) LENGTH OF KEY NO. 4 B6200099 RR EJT B6200100 RR*E B6200101 RR EQU POSKY4(FH+22) BYTE POSITION OF KEY NO. 4 B6200102 RR EQU INDLEN(POSKY4-FH) LENGTH OF MAIN MEMORY RESIDENT PORTION B6200103 RR* OF FCB FOR AN INDEXED FILE B6200104 RR* THE FOLLOWING PORTION OF THE FCB EXISTS ONLY B6200105 RR* ON MASS MEMORY. THESE 10 WORDS ARE NOT LOADEDB6200106 RR* INTO EITHER OF THE FILE MANAGER CONTROLLED FCBB6200107 RR* TABLES. B6200108 RR EQU TSFILM(FH+23) TOTAL NUMBER OF SECTORS IN FILE, MSB B6200109 RR EQU TSFILL(FH+24) TOTAL NUMBER OF SECTORS IN FILE, LSB B6200110 RR EQU NAME12(FH+25) FILE NAME, CHARACTERS 1 AND 2 B6200111 RR EQU NAME34(FH+26) FILE NAME, CHARACTERS 3 AND 4 B6200112 RR EQU NAME56(FH+27) FILE NAME, CHARACTERS 5 AND 6 B6200113 RR EQU NAME78(FH+28) FILE NAME, CHARACTERS 7 AND 8 B6200114 RR EQU OWNR12(FH+29) OWNER NAME, CHARACTERS 1 AND 2 B6200115 RR EQU OWNR34(FH+30) OWNER NAME, CHARACTERS 3 AND 4 B6200116 RR EQU OWNR56(FH+31) OWNER NAME, CHARACTERS 5 AND 6 B6200117 RR EQU OWNR78(FH+32) OWNER NAME, CHARACTERS 7 AND 8 B6200118 RR EQU BYTLEN(FH+33) BYTE LENGTH OF RECORD B6200119 RR* B6200120 RR* FOR COMPRESS ONLY B6200121 RR* B6200122 RR EQU PRSRNM(FH+34) RRN OF LAST PROCESSED RECORD - MSB B6200123 RR EQU PRSRNL(FH+35) RRN OF LAST PROCESSED RECORD - LSB B6200124 RR EQU NEWRNM(FH+36) RRN OF THE LATEST 'NEW' RECORD - MSB B6200125 RR EQU NEWRNL(FH+37) RRN OF THE LATEST 'NEW' RECORD - LSB B6200126 RR SPC 4 B6200127 RR* WORDS 0 THRU 4 OF THE FCB HEADER AND WORDS B6200128 RR* 6 THRU 10 OF THE FCB ARE REFERRED TO AS THE B6200129 RR* SHARED SUBSET OF THE FCB. THEY INCLUDE THE B6200130 RR* ONLY FCB WORDS THAT CAN BE MODIFIED AFTER FILEB6200131 RR* CREATION. IF TWO OR MORE USERS HAVE THE SAME B6200132 RR* FILE OPEN, THERE HAS TO BE A SINGLE MASTER B6200133 RR* COPY OF THE SUBSET THAT RECEIVES (AND RECORDS)B6200134 RR* ALL OF THE UPDATES. THE CONTROLLED SUBSET B6200135 RR* WILL ALWAYS BE PART OF A MAIN MEMORY RESIDENT B6200136 RR* FCB IF THE FCB IS IN A FM CONTROLLED TABLE. B6200137 RR* IF THE FCB IS IN USER SPACE, THE SUBSET MAY ATB6200138 RR* TIMES RESIDE IN THE SUBSET CONTROL TABLE. B6200139 RR SPC 2 B6200140 RR* ALTERNATE NAMES FOR SUBSET WORDS B6200141 RR EQU SAFCBI(FH+1) SUBSET ALTERNATE NAME FOR FCBIND B6200142 RR EQU SADATM(FH+2) SUBSET ALTERNATE NAME FOR NEDATM B6200143 RR EQU SADATL(FH+3) SUBSET ALTERNATE NAME FOR NEDATL B6200144 RR EQU SANXTM(FH+4) SUBSET ALTERNATE NAME FOR NEXTBM B6200145 RR EQU SANXTL(FH+5) SUBSET ALTERNATE NAME FOR NEXTBL B6200146 RR EJT B6200147 RR EQU KIBLEN(288) KIB LENGTH - DEFAULT FOR 96 WORD SECTOR B6200148 RR EQU KIBBLN(572) KIB BUFFER LENGTH B6200149 RR EQU NUMKIB(14) NUMBER OF KIBS IN BUFFER B6200150 RR EQU BUFLEN(NUMKIB*KIBLEN) KIB BUFFER LENGTH B6200151 RR BSS BUFFER(BUFLEN) KIB BUFFER ADDRESS B6200152 RR BSS RKNMSB(NUMKIB+1) RELATIVE KIB NUMBERS - MSBS B6200153 RR BSS RKNLSB(NUMKIB+1) RELATIVE KIB NUMBERS - LSBS B6200154 RR BSS KIBCHG(NUMKIB+1) KIB CHANGED FLAGS B6200155 RR BSS KIBUSE(NUMKIB+1) KIB USAGE COUNTERS B6200156 RR* B6200157 RRSAVEDI NUM 0 SAVED CURRENT VALUE OF BUFIDX B6200158 RRCIDENT NUM 0 CURRENT KIB BUFFER IDENTIFIER (SPECIFIES B6200159 RR* BUFFER RESIDENCY OF KIB DEFINED BY RKIBNO) B6200160 RR* WHERE 0 SIGNIFIES KIBBUF (COMMON) B6200161 RR* 1 SIGNIFIES 1ST SPACE IN BUFFER B6200162 RR* 2 SIGNIFIES 2ND SPACE IN BUFFER B6200163 RR* . B6200164 RR* . B6200165 RR* N SPECIFIES NTH SPACE IN BUFFER B6200166 RRAKIBLN ADC KIBLEN ACTUAL KIB LENGTH B6200167 RRANUMKB ADC NUMKIB ACTUAL NUMBER OF KIBS B6200168 RR SPC 2 B6200169 RR EQU REWARD(6) REWARD VALUE FOR USE OF KIB B6200170 RR EQU PENALT(1) PENALTY VALUE FOR NON-USE OF KIB B6200171 RR EJT B6200172 RR* INITIALIZE KIB CONTROL TABLES B6200173 RR SPC 2 B6200174 RR* INIKIB SHOULD BE CALLED AS A SUBROUTINE WITH B6200175 RR* NO PARAMETERS. AS NO I/O IS PERFORMED, NO B6200176 RR* STATUS IS NEEDED. B6200177 RR SPC 2 B6200178 RRINIKIB NUM 0 ENTRY B6200179 RR STQ QRSAVE SAVE Q-REG. LOCALLY B6200180 RR LDA WPS CHECK SECTOR SIZE B6200181 RR INA -96 B6200182 RR SAN INI05 SENSE NOT 96 B6200183 RR ENA NUMKIB B6200184 RR JMP* INI07 B6200185 RR* B6200186 RRINI05 ENQ 0 COMPUTE KIB LENGTH B6200187 RR LDA =N572 B6200188 RR DVI WPS EQUAL TO INTEGRAL NUMBER B6200189 RR MUI WPS OF SECTORS THAT WILL FIT IN B6200190 RR STA* AKIBLN 572 WORD BUFFER. B6200191 RR STA LENGTH SAVE LENGTH B6200192 RR STA LEN B6200193 RR ENQ 0 B6200194 RR LDA =XBUFLEN B6200195 RR DVI* AKIBLN COMPUTE NUMBER OF KIB SPACES IN BUFFER B6200196 RR STA* ANUMKB B6200197 RRINI07 TRA Q B6200198 RR INQ 1 SET UP TO CLEAR RKN TABLES B6200199 RR CLR A B6200200 RRINI10 INQ -1 DECREMENT COUNT B6200201 RR SQM INI20 SKIP IF DONE B6200202 RR STA* RKNMSB,Q CLEAR MSB B6200203 RR STA* RKNLSB,Q CLEAR LSB B6200204 RR STA* KIBCHG,Q CLEAR KIB CHANGED FLAG B6200205 RR STA* KIBUSE,Q CLEAR KIB USAGE FLAG B6200206 RR JMP* INI10 REPEAT B6200207 RR* B6200208 RR* B6200209 RRINI20 LDQ =XKIBBLN B6200210 RRINI30 INQ -1 B6200211 RR SQM INI40 SKIP IF FINISHED B6200212 RR STA KIBBUF,Q B6200213 RR JMP* INI30 B6200214 RR* B6200215 RRINI40 LDQ =XBUFLEN CLEAR BIG BUFFER B6200216 RRINI45 INQ -1 B6200217 RR SQM INI50 SKIP IF FINISHED B6200218 RR STA BUFFER,Q B6200219 RR JMP* INI45 B6200220 RR* B6200221 RRINI50 STA* SAVEDI CLEAR LOCAL AND COMMON INDEXES B6200222 RR STA* CIDENT B6200223 RR STA BUFIDX B6200224 RR LDA RQBADR SET UP REQBUF ADDRESS FOR FILE MANAGER CALLS B6200225 RR STA RQBUF1 B6200226 RR STA RQBUF2 B6200227 RR STA RQBUF3 B6200228 RR STA RQBUF5 B6200229 RR LDA FCBADR STORE FCB ADDRESS FOR SETUP AND RESET B6200230 RR INA 5 SUBROUTINES. B6200231 RR STA ADFCB B6200232 RR LDQ* QRSAVE RELOAD Q-REG B6200233 RR JMP* (INIKIB) RETURN B6200234 RR EJT B6200235 RR* GET NEXT AVAILABLE KIB NUMBER B6200236 RR SPC 2 B6200237 RR* NXTKIB SHOULD BE CALLED AS A SUBROUTINE WITH B6200238 RR* NO PARAMETERS. STATUS IS PASSED BACK VIA B6200239 RR* REQSTA WHERE 0 SIGNIFIES OK AND NOT 0 SIGNI- B6200240 RR* FIES THAT INSUFFICIENT FILE SPACE WAS B6200241 RR* AVAILABLE FOR THE INDEX. REQSTA CAN BE USED B6200242 RR* AS AN APPROPRIATE STATUS FOR ERCHK (REQBUF(4) B6200243 RR* WILL BE SET AS IF A WRITER REQUEST REQUEST HADB6200244 RR* JUST BEEN MADE. B6200245 RR* B6200246 RR* THE NEW RELATIVE KIB NUMBER WILL BE STORED IN B6200247 RR* NEWKBM/NEWKBL OF COMMON. B6200248 RR SPC 2 B6200249 RRNXTKIB NUM 0 B6200250 RR STQ* QRSAVE SAVE Q-REG CONTENTS B6200251 RR LDA- I SAVE I B6200252 RR STA* IRSAVE B6200253 RR LDQ FCBADR FIRST, CHECK IF CURRENT NEXT KIB IS VALID FOR B6200254 RR STQ- I USE B6200255 RR LDQ- NEXTBM,I B6200256 RR LDA- NEXTBL,I B6200257 RR LLS 1 CONVERT TO 15 BIT FORMAT B6200258 RR ALS 15 B6200259 RR STQ* PARLST+2 B6200260 RR STQ* PARAMS B6200261 RR STA* PARLST+3 STORE NEXT KIB NO. AS SUBTRAHEND B6200262 RR STA* PARAMS+1 STORE ALSO FOR ADD TO 1 B6200263 RR LDQ- TNKEYM,I B6200264 RR LDA- TNKEYL,I B6200265 RR LLS 1 B6200266 RR ALS 15 B6200267 RR STQ* PARLST STORE TOTAL NO. OF KIB SPACES B6200268 RR STA* PARLST+1 B6200269 RR CLR A B6200270 RR STA* PARLST+6 CLEAR STATUS WORD B6200271 RR LDQ =XPARLST B6200272 RR RTJ DWSUB PERFORM SUBTRACT B6200273 RR LDA* PARLST+6 CHECK STATUS B6200274 RR SAZ NXT10 SKIP IF 0 - OK B6200275 RR LDQ RQBADR SET REQBUF(4) TO INDICATE WRITER CALL B6200276 RR ENA 12 B6200277 RR STA- 3,Q B6200278 RR LDA =N$8800 SET REQSTA TO REFLECT ERROR B6200279 RR STA REQSTA B6200280 RRNXT05 LDA* IRSAVE B6200281 RR STA- I RESTORE I-REG B6200282 RR LDQ* QRSAVE RESET Q AND RETURN - NO MORE KIB SPACE B6200283 RR JMP* (NXTKIB) B6200284 RR EJT B6200285 RRNXT10 LDQ =XPARAMS B6200286 RR RTJ DWADD COMPUTE NEXT AVAILABLE KIB NUMBER B6200287 RR LDQ FCBADR B6200288 RR STQ- I B6200289 RR LDA- NEXTBM,I SET NEW KIB NUMBER TO OLD NEXT KIB NUMBER B6200290 RR STA NEWKBM B6200291 RR LDA- NEXTBL,Q B6200292 RR STA NEWKBL B6200293 RR LDQ* PARAMS+4 SET NEW NEXT KIB NUDB5R B6200294 RR LDA* PARAMS+5 B6200295 RR ALS 1 CONVERT TO 24 BIT FORMAT B6200296 RR LRS 1 B6200297 RR STQ- NEXTBM,I B6200298 RR STA- NEXTBL,I B6200299 RR CLR A CLEAR REQSTA - SIGNIFIES GOOD COMPLETION B6200300 RR STA REQSTA B6200301 RR JMP* NXT05 SET UP FOR RETURN B6200302 RR SPC 3 B6200303 RRIRSAVE NUM 0 SAVED I-REGISTER B6200304 RRQRSAVE NUM 0 SAVED Q-REGISTER B6200305 RRPARLST BSS PARLST(7) PARAM LIST FOR DWSUB B6200306 RRPARAMS NUM 0,0,0,1,0,0,0 PARAM LIST FOR DWADD B6200307 RR EJT B6200308 RR* MARK CURRENT KIB AS CHANGED B6200309 RR SPC 2 B6200310 RR* MRKKIB SHOULD BE CALLED AS A SUBROUTINE WITH B6200311 RR* NO PARAMETERS. AS NO I/O IS PERFORMED, NO B6200312 RR* STATUS IS NEEDED. B6200313 RR SPC 2 B6200314 RRMRKKIB NUM 0 ENTRY B6200315 RR ENA 1 SET A=1 FOR KIB CHANGED FLAG B6200316 RR LDQ CIDENT GET CURRENT KIB BUFFER IDENTIFIER B6200317 RR STA KIBCHG,Q STORE CHANGED FLAG IN KIBS WORD B6200318 RR JMP* (MRKKIB) RETURN B6200319 RR EJT B6200320 RR* FREE UP KIB BUFFER FOR NEW KIB B6200321 RR* B6200322 RR* FREEUP SHOULD BE CALLED AS A SUBROUTINE WITH B6200323 RR* NO PARAMETERS. STATUS IS PASSED BACK VIA B6200324 RR* REQSTA WHERE 0 SIGNIFIES OK AND NOT 0 SIGNI- B6200325 RR* FIES A FILE MANAGER ERROR WAS NOTED. REQSTA B6200326 RR* CONTAINS THE REQUEST STATUS. B6200327 RR* B6200328 RR* THE NEW KIB THAT IS TO BE CREATED IS DEFINED B6200329 RR* BY RKIBNO. B6200330 RR* B6200331 RR* FEEUP SETS BIT 15 OF RKIBNO(1) AND EXECUTES B6200332 RR* GETKIB TO FREE THE KIB BUFFER FOR IT. UPON B6200333 RR* RETURN, FREEUP CLEARS BIT 15 OF RKIBNO AND B6200334 RR* CKBMSB. GETKIB USES BIT 15 (SET) OF RKIBNO(1)B6200335 RR* AS A FLAG TO SIGNAL THAT THE KIB DOES NOT B6200336 RR* EXIST AND THUS SHOULD NOT BE READ IN. B6200337 RR* B6200338 RR* B6200339 RR* B6200340 RRFREEUP NUM 0 ENTRY POINT B6200341 RR LDA* (KIBADR) SET BIT 15 OF RKIBNO(1) B6200342 RR EOR- ONEBIT+15 B6200343 RR STA* (KIBADR) B6200344 RR* B6200345 RR RTJ GETKIB B6200346 RR* B6200347 RR LDA* (KIBADR) CLEAR BIT 15 OF RKIBNO(1) B6200348 RR AND- ONEMSK+14 B6200349 RR STA* (KIBADR) B6200350 RR JMP* (FREEUP) B6200351 RR SPC 2 B6200352 RRKIBADR ADC RKIBNO B6200353 RR EJT B6200354 RR* GET SPECIFIED KIB B6200355 RR SPC 2 B6200356 RR* GETKIB SHOULD BE CALLED AS A SUBROUTINE WITH B6200357 RR* NO PARAMETERS. STATUS IS PASSED BACK VIA B6200358 RR* REQSTA WHERE 0 SIGNIFIES OK AND NOT 0 SIGNI- B6200359 RR* FIES A FILE MANAGER ERROR WAS NOTED. REQSTA B6200360 RR* CONTAINS THE REQUEST STATUS. B6200361 RR SPC 2 B6200362 RR* THE REQUIRED KIB IS SPECIFIED BY RKIBNO OF B6200363 RR* LABELLED COMMON B6200364 RR* B6200365 RR* IF THE SPECIFIED KIB IS IN KIBBUF OR BUFFER, B6200366 RR* BUFIDX WILL BE SET TO AN APPROPRIATE INDEX B6200367 RR* OFFSET SUCH THAT THE CONSTRUCTION B6200368 RR* KIBBUF(BUFIDX+1) WILL REFERENCE THE FIRST WORDB6200369 RR* OF THE SPECIFIED KIB. CIDENT WILL BE SET TO B6200370 RR* IDENTIFY THE CURRENTLY SPECIFIED KIB. B6200371 RR* B6200372 RR* IF THE SPECIFIED KIB IS NOT IN THE LARGE KIB B6200373 RR* BUFFER, THE RESULTING PROCESSING DEPENDS ON B6200374 RR* WHETHER OR NOT THERE IS AN EMPTY KIB SPACE IN B6200375 RR* THE LARGE BUFFER. B6200376 RR* B6200377 RR* IF THERE IS AN EMPTY KIB SPACE: B6200378 RR* 1. BUFIDX AND CIDENT WILL BE SET TO ENABLE B6200379 RR* USE OF THE EMPTY KIB SPACE. B6200380 RR* 2. THE SPECIFIED KIB WILL BE READ INTO THE B6200381 RR* EMPTY KIB SPACE. B6200382 RR* 3. THE RELATED TABLES WILL BE SET TO DEFINE B6200383 RR* THE KIB. B6200384 RR* B6200385 RR* IF THERE IS NO EMPTY KIB SPACE: B6200386 RR* 1. THE KIB WITH THE SMALLEST USAGE COUNTER B6200387 RR* (OR FIRST OF SEVERAL WITH THE SAME SMALL- B6200388 RR* EST USAGE COUNTER) IS LOCATED. B6200389 RR* 2. IF THE KIB HAS BEEN CHANGED, IT IS B6200390 RR* WRITTEN TO MASS MEMORY. B6200391 RR* 3. THE SPECIFIED KIB WILL BE READ INTO THE B6200392 RR* EMPTIED KIB SPACE. B6200393 RR* 4. BUFIDX AND CIDENT WILL BE SET TO ENABLE B6200394 RR* USE OF THE KIB'S APACE. B6200395 RR* 5. THE RELATED TABLES WILL BE SET TO DEFINE B6200396 RR* THE KIB. B6200397 RR EJT B6200398 RR* EACH TIME A KIB IS LOCATED VIA GETKIB, ALL KIBB6200399 RR* USAGE COUNTERS ARE CHANGED. B6200400 RR* 1. IF THE KIB WAS ALREADY RESIDENT, ITS USAGEB6200401 RR* COUNTER IS INCREMENTED BY 'REWARD' AND THEB6200402 RR* USAGE COUNTERS OF ALL OTHER RESIDENT KIBS B6200403 RR* ARE DECREMENTED BY 'PENALT'. B6200404 RR* 2. IF THE KIB WAS NOT ALREADY RESIDENT, ALL B6200405 RR* REMAINING KIB'S USAGE COUNTERS ARE DECRE- B6200406 RR* MENTED BY 'PENALT' AND THE NEW KIB'S USAGEB6200407 RR* COUNTER IS SET TO THE HIGEST COUNTER VALUEB6200408 RR* OF THE REMAINING KIBS. B6200409 RR EJT B6200410 RRGETKIB NUM 0 ENTRY B6200411 RR STQ* QREG SAVE Q AND I REGISTERS B6200412 RR LDQ- I B6200413 RR STQ* IREG B6200414 RR* B6200415 RR LDA* KIBADR SET I-REG TO ADDRESS OF RKIBNO B6200416 RR STA- I B6200417 RR* INITIALIZE TO SEARCH KIB REL. KIB NO. TABLES B6200418 RR* FOR REQUIRED KIB B6200419 RR ENA -1 B6200420 RR STA* IND SET SEARCH INDEX TO -1 B6200421 RR STA* FOUND FOUND KIB FLAG TO -1 B6200422 RR STA* MININD INDEX OF MINIMUM USE KIB TO -1 B6200423 RR CLR A B6200424 RR STA* MAXCNT MAXIMUM COUNT VALUE TO 0 B6200425 RR* B6200426 RR* SEARCH FOR NEEDED KIB B6200427 RRGET10 LDQ* IND BUMP SEARCH INDEX BY 1 B6200428 RR INQ 1 B6200429 RR STQ* IND B6200430 RR TRQ A CHECK IF SEARCH PROCESS IS FINISHED B6200431 RR SUB ANUMKB B6200432 RR INA -1 B6200433 RR SAN GET20 B6200434 RR JMP* GET140 SEARCH IS FINISHED B6200435 RR* B6200436 RRGET20 LDA* (ADRMSB),Q CHECK IF A KIB IS DEFINED BY THE SLOT IND OF B6200437 RR SAN GET30 THE KIB TABLES B6200438 RR LDA* (ADRLSB),Q B6200439 RR SAN GET30 SKIP IF EITHER MSB OR LSB OF REL. KIB. NO. B6200440 RR JMP* GET130 NOT 0. ELSE GO TO GET130 B6200441 RR* B6200442 RRGET30 LDA* (ADRUSE),Q DECREMENT USAGE COUNTER BY PENALT - DO NOT B6200443 RR INA -PENALT DROP BELOW 0 B6200444 RR SAP GET40 B6200445 RR CLR A B6200446 RRGET40 STA* (ADRUSE),Q B6200447 RR* B6200448 RR* CHECK IF THIS IS LARGEST USAGE COUNT - SAVE ITB6200449 RR SUB* MAXCNT IF YES B6200450 RR SAM GET45 B6200451 RR LDA* (ADRUSE),Q B6200452 RR STA* MAXCNT B6200453 RR EJT B6200454 RRGET45 LDA- (I) CHECK IF THIS IS THE REQUIRED KIB B6200455 RR SUB* (ADRMSB),Q B6200456 RR SAN GET50 B6200457 RR LDA- 1,I B6200458 RR SUB* (ADRLSB),Q B6200459 RR SAZ GET60 B6200460 RRGET50 JMP* GET80 GO TO GET80 IF NOT B6200461 RR* B6200462 RRGET60 LDA* (ADRUSE),Q BUMP THIS KIBS COUNTER BY REWARD + PENALTY B6200463 RR INA REWARD+PENALT B6200464 RR STA* (ADRUSE),Q B6200465 RR STQ* FOUND SET FOUND FLAG TO KIB INDEX B6200466 RR STQ CIDENT SET CURRENT KIB BUFFER IDENTIFIER B6200467 RR* B6200468 RR* SET BUFFER INDEX FOR OTHER PROCESSORS B6200469 RR SQN GET70 SKIP IF NOT IN COMMON BUFFER B6200470 RR CLR A USE 0 AS COMMON BUFFER INDEX OFFSET B6200471 RR JMP* GET75 B6200472 RR* B6200473 RRGET70 TRQ A COMPUTE INDEX OFFSET TO ENABLE USE OF BUFFER B6200474 RR INA -1 KIB AS IF IT WERE IN THE COMMON BUFFER B6200475 RR MUI* LENGTH B6200476 RR ADD =XBUFFER B6200477 RR SUB =XKIBBUF B6200478 RRGET75 STA BUFIDX STORE THE INDEX OFFSET B6200479 RR STA SAVEDI SAVE ALSO LOCALLY B6200480 RR JMP GET10 GO CHECK IF THERE ARE MORE KIB SPACES TO CHECKB6200481 RR* B6200482 RR* A KIB SPACE EXISTS THAT HAS THE WRONG KIB B6200483 RRGET80 LDA* MININD CHECK IF MINIMUM COUNT USAGE HAS BEEN SET YET B6200484 RR SAP GET100 SKIP IF YES B6200485 RR* B6200486 RRGET90 STQ* MININD SET INDEX OF CURRENT MINIMUM USE KIB B6200487 RR LDA* (ADRUSE),Q B6200488 RR STA* MINCNT SET USAGE COUNT B6200489 RR LDA* (ADRCHG),Q B6200490 RR STA* MINCHG SET CHANGE FLAG B6200491 RR JMP* GET10 GO CHECK FOR MORE KIB SPACES B6200492 RR EJT B6200493 RRGET100 LDA* (ADRUSE),Q CHECK IF CURRENT KIB'S USAGE COUNT IS THE SAMEB6200494 RR SUB* MINCNT AS THE SAVED MIN COUNT B6200495 RR SAN GET110 SKIP IF NO B6200496 RR LDA* (ADRCHG),Q HAS THIS KIB BEEN CHANGED B6200497 RR SAZ GET115 SKIP IF NO B6200498 RR LDA* MINCHG WAS THE PREVIOUS MIN USE KIB CHANGED B6200499 RR SAZ GET115 SKIP IF NO B6200500 RR JMP* GET90 GO SWAP MIN USE KIB INFO B6200501 RR* B6200502 RRGET110 LDA* MINCNT CHECK IF THIS KIB HAS LOWER USAGE COUNT THAN B6200503 RR SUB* (ADRUSE),Q SAVE MIN USE KIB B6200504 RR SAP GET120 SKIP IF YES B6200505 RRGET115 JMP* GET10 GO CHECK FOR MORE KIB SPACES B6200506 RR* B6200507 RRGET120 JMP* GET90 GO SWAP MIN USE KIB INFO B6200508 RR SPC 3 B6200509 RRIND NUM 0 INDEX/COUNTER FOR KIB SEARCH B6200510 RRFOUND NUM 0 NEEDED KIB FOUND FLAG, POSITIVE IF FOUND B6200511 RRMININD NUM 0 INDEX OF MINIMUM USAGE COUNT KIB B6200512 RRMINCNT NUM 0 COUNT FOR MINIMUM USAGE COUNT KIB B6200513 RRMINCHG NUM 0 CHANGE FLAG OF MINIMUM USAGE COUNT KIB B6200514 RRMAXCNT NUM 0 MAXIMUM USAGE COUNT B6200515 RRQREG NUM 0 SAVED Q-REGISTER B6200516 RRIREG NUM 0 SAVED I-REGISTER B6200517 RRLENGTH ADC KIBLEN REAL LENGTH OF KIB (MAY BE RESET) B6200518 RRKIBIDX NUM 0 SAVED KIB INDEX B6200519 RRADCBUF ADC KIBBUF ADDRESS OF COMMON BUFFER KIB B6200520 RRADRUSE ADC KIBUSE ADDRESS OF USAGE COUNTERS B6200521 RRADRCHG ADC KIBCHG ADDRESS OF CHANGE FLAGS B6200522 RRADRMSB ADC RKNMSB ADDRESS OF RKN MSBS B6200523 RRADRLSB ADC RKNLSB ADDRESS OF RKN MSBS B6200524 RRSTAT1 NUM 0 STATUS WORD FOR READ REQUEST B6200525 RR EJT B6200526 RR* AN EMPTY KIB SPACE EXISTS SO USE IT FOR B6200527 RRGET130 STQ* MININD NEEDED KIB B6200528 RR CLR A SET MIN USE KIB INDEX TO CURRENT INDEX AND B6200529 RR STA* MINCHG CLEAR KIB CHANGE FLAG B6200530 RR SPC 2 B6200531 RRGET140 LDA* FOUND CHECK IF NEEDED KIB WAS FOUND IN A TABLE SPACEB6200532 RR SAM GET150 SKIP IF NO B6200533 RR* B6200534 RR CLR A CLEAR A AS COMPLETION STATUS B6200535 RRGET145 STA REQSTA STORE COMPLETION STATUS B6200536 RR LDQ* IREG RESTORE Q AND I-REGS AND RETURN B6200537 RR STQ- I B6200538 RR LDQ* QREG B6200539 RR JMP* (GETKIB) RETURN B6200540 RR* B6200541 RRGET150 LDA* MINCHG CHECK IF A KIB NEEDS TO BE WRITTEN OUT TO MASSB6200542 RR SAN GET160 MEMORY B6200543 RR JMP* GET180 GO TO GET180 IF WRITE NOT NEEDED B6200544 RR* B6200545 RRGET160 LDQ* MININD SET Q TO INDEX OF KIB TO WRITE OUT B6200546 RR RTJ* SETUP SET UP REQBUF AND THE FCB TO WRITE OUT THE KIBB6200547 RR LDA* MININD CHECK IF KIB IS IN COMMON BUFFER B6200548 RR SAN GET170 SKIP IF NO B6200549 RR* B6200550 RR LDA* ADCBUF GET ADDRESS OF COMMON BUFFER B6200551 RR JMP* GET175 B6200552 RR* B6200553 RRGET170 INA -1 COMPUTE ADDRESS OF KIBS SPACE WITHIN BIG B6200554 RR MUI* LENGTH BUFFER B6200555 RR ADD =XBUFFER B6200556 RRGET175 STA* ADDR1 STORE ADDRESS FOR I/O CALL B6200557 RR* B6200558 RR RTJ UPDREC STORE KIB VIA UPDATE RECORD CALL B6200559 RRRQBUF1 ADC 0 REQBUF ADDRESS B6200560 RRADDR1 ADC 0 BUFFER ADDRESS B6200561 RR ADC STAT1 STATUS WORD B6200562 RR* B6200563 RR RTJ* RESET RESET REQBUF AND FCB FOR RECORD I/O B6200564 RR LDA* STAT1 CHECK IF FM ERROR NOTED B6200565 RR SAP GET180 SKIP IF NO B6200566 RR JMP* GET145 GO EXIT TO CALLER B6200567 RR* B6200568 RR* KIB SPACE IS NOW FREE FOR NEW KIB B6200569 RRGET180 LDA* MININD FIRST, SET INDEX OFFSET FOR OTHER PROCESSORS B6200570 RR SAN GET190 SKIP IF KIB SPACE NOT IN KIBBUF B6200571 RR LDA* ADCBUF STORE KIBBUF ADDRESS IN FM CALL FOR READ B6200572 RR STA* ADDR2 B6200573 RR CLR A B6200574 RR JMP* GET195 GO STORE A (=0) AS INDEX OFFSET B6200575 RR EJT B6200576 RRGET190 INA -1 COMPUTE ADDRESS OF KIBS SPACE WITHIN BIG B6200577 RR MUI* LENGTH BUFFER B6200578 RR ADD =XBUFFER B6200579 RR STA* ADDR2 STORE THIS AS ABSOLUTE ADDRESS FOR I/O B6200580 RR SUB* ADCBUF SUBTRACT KIBBUF ADDR TO GET OFFSET B6200581 RRGET195 STA BUFIDX STORE THE INDEX OFFSET B6200582 RR STA SAVEDI SAVE ALSO LOCALLY B6200583 RR LDA =XRKIBNO B6200584 RR STA- I B6200585 RR LDA- (I) CHECK IF THIS KIB EXISTS ON MASS MEMORY B6200586 RR SAP GET200 B6200587 RR JMP* GET210 B6200588 RR* B6200589 RRGET200 RTJ* SETUP SET UP THE FCB AND THE REQUEST BUFFER TO B6200590 RR* PERMIT READING IN THE NEEDED KIB B6200591 RR RTJ READR B6200592 RRRQBUF2 ADC 0 REQBUF ADDRESS B6200593 RRADDR2 ADC 0 BUFFER ADDRESS B6200594 RR ADC RKIBNO RELATIVE KIB NO. - IN COMMON B6200595 RR ADC STAT1 STATUS WORD B6200596 RR* B6200597 RR RTJ* RESET RESET THE FCB AND REQBUF FOR REG. RECORD I/O B6200598 RR* B6200599 RR LDA* STAT1 CHECK IF FM ERROR RETURNED B6200600 RR SAP GET210 SKIP IF NO B6200601 RR JMP* GET145 RETURN TO CALLER WITH ERROR B6200602 RR* B6200603 RRGET210 LDA* MAXCNT SET USAGE COUNT FOR NEW KIB TO MAX COUNT B6200604 RR LDQ* MININD B6200605 RR STA* (ADRUSE),Q B6200606 RR LDA =XRKIBNO B6200607 RR STA- I B6200608 RR LDA- (I) STORE REL. KIB NO. IN KIB BUFFER CONTROL B6200609 RR AND- ONEMSK+14 TABLE B6200610 RR STA* (ADRMSB),Q B6200611 RR LDA- 1,I B6200612 RR STA* (ADRLSB),Q B6200613 RR CLR A CLEAR KIB CHANGE WORD FOR NEW KIB B6200614 RR STA* (ADRCHG),Q B6200615 RR STQ CIDENT SAVE CURRENT KIB SPACE INDEX B6200616 RR JMP* GET145 GO RETURN TO CALLER WITH STATUS = 0 (OK) B6200617 RR EJT B6200618 RR* SET UP FCB AND REQBUF FOR READ OR WRITE OF B6200619 RR* A KIB B6200620 RRSETUP NUM 0 ENTRY B6200621 RR STQ* SAVIDX SAVE Q AS INDEX TO KIB CONTROL TABLES B6200622 RR ENQ 8 SAVE THE FIRST 8 WORDS OF THE FCB 127*5170B6200623 RRSET10 INQ -1 DECREMENT COUNTER B6200624 RR SQM SET20 B6200625 RR LDA* (ADFCB),Q MOVE 1 WORD B6200626 RR STA* BUF1,Q B6200627 RR JMP* SET10 REPEAT B6200628 RR* B6200629 RRSET20 LDA AKIBLN RESET THE FIRST 6 WORDS TO REFLECT RECORDS. B6200630 RR LDQ* ADFCB THAT ARE KIB SIZED AND RECORD SPACE STARTING B6200631 RR STA- (ZERO),Q AT KIB SPACE. B6200632 RR LDA- 10,Q MOVE WORD 11 TO WORD 2 B6200633 RR STA- 1,Q B6200634 RR STA- 6,Q AND WORD 7 127*5170B6200635 RR LDA- 11,Q WORD 12 TO WORD 3 B6200636 RR STA- 2,Q B6200637 RR STA- 7,Q AND WORD 8 127*5170B6200638 RR LDA- 12,Q WORD 13 TO WORD 4 B6200639 RR STA- 3,Q B6200640 RR LDA- 13,Q WORD 14 TO WORD 5 B6200641 RR STA- 4,Q B6200642 RR LDA- 5,Q CLEAR BITS 0 AND 15 OF FCBIND WORD B6200643 RR AND =N$7FFE B6200644 RR STA- 5,Q B6200645 RR* B6200646 RRSET25 LDA RQBADR SAVE WORDS 13-20 OF REQBUF B6200647 RR INA 12 B6200648 RR STA- I SET I TO ADDRESS OF REQBUF(13) B6200649 RR ENQ 8 SET COUNTER B6200650 RRSET30 INQ -1 B6200651 RR SQM SET40 SKIP IF DONE B6200652 RR LDA- (ZERO),B B6200653 RR STA* BUF2,Q SAVE A WORD B6200654 RR JMP* SET30 REPEAT B6200655 RR* B6200656 RRSET40 LDQ* (SET25+1) SET I TO REQBUF ADDRESS B6200657 RR STQ- I B6200658 RR ENA 1 SET REQBUF(13)=1 - FOR READ B6200659 RR STA- 12,I B6200660 RR STA- 14,I SET REQBUF(15)=1 - FOR UPDATE RECORD CALL B6200661 RR LDQ* SAVIDX SET WORDS 16-17 TO REL. KIB NUMBER FOR UPDATE B6200662 RR LDA RKNMSB,Q RECORD CALL B6200663 RR STA- 15,I B6200664 RR LDA RKNLSB,Q B6200665 RR STA- 16,I B6200666 RR JMP* (SETUP) ALL SET UP - RETURN B6200667 RR SPC 3 B6200668 RRBUF1 BSS BUF1(8) BUFFER TO SAVE 1ST 8 WORDS OF FCB 127*5170B6200669 RRBUF2 BSS BUF2(8) BUFFER TO SAVE WORDS 13-20 OF REQBUF B6200670 RRSAVIDX NUM 0 SAVED FCB SPACE INDEX B6200671 RRADFCB NUM 0 ADDRESS OF MAIN BODY OF THE FCB B6200672 RR EJT B6200673 RR* RESET THE FCB FOR REGULAR RECORD I/O. B6200674 RR* SETUP MUST HAVE BEEN CALLED PRIOR TO A RESET B6200675 RR* CALL. B6200676 RRRESET NUM 0 ENTRY B6200677 RR ENQ 8 RESTORE WORDS 1-8 OF THE FCB 127*5170B6200678 RRRES10 INQ -1 B6200679 RR SQM RES20 B6200680 RR LDA* BUF1,Q B6200681 RR STA* (ADFCB),Q B6200682 RR JMP* RES10 B6200683 RR* B6200684 RRRES20 LDA RQBADR RESTORE WORDS 13-20 OF REQBUF B6200685 RR INA 12 B6200686 RR STA- I B6200687 RR ENQ 8 B6200688 RRRES30 INQ -1 B6200689 RR SQM RES40 B6200690 RR LDA* BUF2,Q B6200691 RR STA- (ZERO),B B6200692 RR JMP* RES30 B6200693 RR* B6200694 RRRES40 JMP* (RESET) ALL DONE - RETURN B6200695 RR EJT B6200696 RR* WRITE ALL CHANGED RESIDENT KIBS TO MASS MEMORYB6200697 RR SPC 2 B6200698 RR* WRTKIB SHOULD BE CALLED AS A SUBROUTINE WITH B6200699 RR* NO PARAMETERS. STATUS IS PASSED BACK VIA B6200700 RR* REQSTA WHERE 0 SIGNIFIES OK AND NOT 0 SIGNI- B6200701 RR* FIES A FILE MANAGER ERROR WAS NOTED. REQSTA B6200702 RR* CONTAINS THE REQUEST STATUS. B6200703 RR SPC 2 B6200704 RRWRTKIB NUM 0 ENTRY B6200705 RR STQ* QSAVE SAVE Q AND I REGISTERS LOCALLY B6200706 RR LDQ- I B6200707 RR STQ* ISAVE B6200708 RR* B6200709 RR LDA ANUMKB B6200710 RR INA 1 B6200711 RR STA* CNTR INITIALIZE COUNTER TO NUMBER OF KIBS B6200712 RR* B6200713 RRWRT10 LDQ* CNTR DECREMENT COUNTER/INDEX B6200714 RR INQ -1 B6200715 RR STQ* CNTR B6200716 RR SQP WRT20 SKIP IF NOT DONE B6200717 RR JMP* WRT60 B6200718 RR* B6200719 RRWRT20 LDA KIBCHG,Q CHECK IF QTH KIB WAS CHANGED B6200720 RR SAN WRT25 SKIP IF YES B6200721 RR JMP* WRT50 B6200722 RR* B6200723 RRWRT25 RTJ* SETUP SET UP FOR OUTPUT OF KIB (VIA UPDREC CALL) B6200724 RR LDA* CNTR COMPUTE AND STORE START ADDRESS OF QTH KIB B6200725 RR SAZ WRT30 SKIP IF INDEX IS FOR KIBBUF KIB B6200726 RR INA -1 DECREMENT INDEX AS 1 IS FOR FIRST BUFFER KIB B6200727 RR MUI* LEN B6200728 RR ADD =XBUFFER B6200729 RR JMP* WRT40 B6200730 RR* B6200731 RRWRT30 LDA =XKIBBUF USE KIBBUF ADDRESS B6200732 RR* B6200733 RRWRT40 STA* ADDR3 B6200734 RR* B6200735 RR RTJ UPDREC B6200736 RRRQBUF3 ADC 0 REQBUF ADDRESS B6200737 RRADDR3 ADC 0 KIB START ADDRESS B6200738 RR ADC STAT2 STATUS WORD B6200739 RR* B6200740 RR RTJ* RESET RESET THE FCB AND REQBUF FOR REGULAR PROCESSINB6200741 RR LDA* STAT2 B6200742 RR SAP WRT50 CHECK STATUS - SKIP IF OK B6200743 RR JMP* WRT80 EXIT WITH ERROR STATUS IN A-REG B6200744 RR* B6200745 RRWRT50 JMP* WRT10 GO CHECK NEXT KIB B6200746 RR* B6200747 RR* ALL CHANGED KIBS HAVE BEEN OUTPUT B6200748 RRWRT60 LDQ FCBADR CHECK IF THE LAST KIB POSITION HAS BEEN USED B6200749 RR STQ- I B6200750 RR LDQ- NEXTBM,I B6200751 RR LDA- NEXTBL,I B6200752 RR STQ RKNMSB STORE FOR POSSIBLE WRITE B6200753 RR STA RKNLSB B6200754 RR LLS 1 CONVERT TO 15 BIT FORMAT B6200755 RR ALS 15 B6200756 RR STQ* PLIST+2 SET UP TO SUBTRACT NEXT KIB FROM TOTAL KIBS B6200757 RR STA* PLIST+3 B6200758 RR LDQ- TNKEYM,I B6200759 RR LDA- TNKEYL,I B6200760 RR LLS 1 CONVERT TO 15 BIT FORMAT B6200761 RR ALS 15 B6200762 RR STQ* PLIST B6200763 RR STA* PLIST+1 B6200764 RR LDQ =XPLIST B6200765 RR RTJ DWSUB PERFORM THE SUBTRACT B6200766 RR LDA* PLIST+6 CHECK STATUS B6200767 RR SAZ WRT65 SKIP IF NO ERROR B6200768 RR JMP* WRT70 B6200769 RR* B6200770 RRWRT65 ENQ 0 B6200771 RR RTJ SETUP SET UP FOR KIB OUTPUT FROM 1ST KIB SPACE B6200772 RR* B6200773 RR LDA =XFMEOFC STORE END OF FILE CODE IN FIRST 2 WORDS OF B6200774 RR LDQ* BADR BUFFER B6200775 RR STA- (ZERO),Q B6200776 RR STA- 1,Q B6200777 RR EJT B6200778 RR RTJ UPDREC OUTPUT THE KIB B6200779 RRRQBUF5 ADC 0 REQBUF ADDRESS B6200780 RRBADR ADC BUFFER KIB BUFFER ADDRESS B6200781 RR ADC STAT2 STATUS WORD B6200782 RR* B6200783 RR RTJ RESET RESET REQBUF AND THE FCB B6200784 RR LDA* STAT2 SET A TO STATUS B6200785 RR JMP* WRT80 B6200786 RR* B6200787 RRWRT70 CLR A CLEAR A AS COMPLETION STATUS B6200788 RRWRT80 LDQ* ISAVE B6200789 RR STQ- I B6200790 RR LDQ* QSAVE RESTORE Q AND I REGS B6200791 RR STA REQSTA STORE COMPLETION STATUS B6200792 RR JMP* (WRTKIB) RETURN TO CALLER B6200793 RR SPC 3 B6200794 RRLEN ADC KIBLEN REAL LENGTH OF KIB (MAY BE RESET) B6200795 RRISAVE NUM 0 B6200796 RRQSAVE NUM 0 B6200797 RRCNTR NUM 0 LOOP COUNTER B6200798 RRSTAT2 NUM 0 FILE REQUEST STATUS B6200799 RR BSS PLIST(7) PARAMETER LIST FOR DWSUB B6200800 RR SPC 3 B6200801 RR END B6200802 RR NAM GETSSZ B63 A ITOS CCS 3.0 SL-149 00001 RR* GET SECTOR SIZE ROUTINE 00002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 00003 RR* DATA SYSTEMS- LA JOLLA DIVISION, LA JOLLA CALIFORNIA 00004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 00005 RR* 00006 RR SPC 2 00007 RR ENT GETSSZ 00008 RR SPC 2 00009 RR EXT Q8PREP 00010 RR EXT Q8PKUP 00011 RR EXT MMLUTB FM TABLE IN SYSDAT 00012 RR SPC 2 00013 RR EQU ONEMSK(3) BIT TABLE IN SYSDAT 00014 RR EQU VIWPS(13) WORDS PER SECTOR ENTRY OF VIT TBL. IN SYSDAT 00015 RR SPC 2 00016 RRGETSSZ 0 0 00017 RR STQ* QSAVE 00018 RR RTJ Q8PREP 00019 RR ADC* GETSSZ 00020 RR RTJ Q8PKUP 00021 RR STA* PSUFID 00022 RR RTJ Q8PKUP 00023 RR STA* SIZE ADDRESS OF SIZE PARAMETER 00024 RR LDA* (PSUFID) GET PSEUDO FILE ID OF FILE 00025 RR ARS 11 AND EXTRACT MM LU PORTION 00026 RR AND- ONEMSK+4 00027 RR TRA Q 00028 RR LDQ MMLUTB,Q 00029 RR LDA- VIWPS,Q GET WPS FOR THAT UNIT 00030 RR STA* (SIZE) 00031 RR LDQ* QSAVE 00032 RR JMP* (GETSSZ) 00033 RR SPC 2 00034 RRQSAVE NUM 0 00035 RRPSUFID NUM 0 00036 RRSIZE NUM 0 00037 RR END 00038 RR NAM UTCKLN B64 A ITOS CCS 3.0 . SL-149 00001 RR* COMPUTE LENGTH OF KIB IN SECTORS 00002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 00003 RR* DATA SYSTEM-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 00005 RR* 00006 RR**** 00007 RR* 00008 RR* THIS ROUTINE COMPUTES THE LENGTH OF A KIB IN WORDS. 00009 RR* IF SECTOR LENGTH = 96 WORDS, KIB LENGTH IS SET TO 3 00010 RR* SECTORS($120 WORDS) TO REMAIN COMPATIBLE WITH PREVIOUS VERSIONS 00011 RR* 00012 RR* IF SECTOR LENGTH IS NOT 96 WORDS, KIB LENGTH IS SET TO THE NUMBER 00013 RR* OF SECTORS OF DATA THAT WILL FIT INTO A 572 WORD BUFFER. 00014 RR* 00015 RR* CALLING SEQUENCE: 00016 RR* CALL UTCKLN (WPS,KIBLEN) 00017 RR* 00018 RR* PARAMETERS: 00019 RR* WPS - SECTOR SIZE (IN WORDS) 00020 RR* KIBLEN - PASSED BACK TO CALLER 00021 RR* 00022 RR* EXIT: 00023 RR* Q AND I REGISTERS ARE PRESERVED 00024 RR* 00025 RR*E 00026 RR ENT UTCKLN PROGRAM ENTRY POINT 00027 RR* 00028 RR* EXTERNALS 00029 RR EXT Q8PREP PREPARE TO PICKUP PARAMETER ADDRESS 00030 RR EXT Q8PKUP PICKUP/ABSOLUTIZE PARAMETER ADDRESS 00031 RR* 00032 RR* EQUIVALENCES 00033 RR EQU ZERO($22) 00034 RR SPC 2 00035 RRUTCKLN 0 0 00036 RR STQ* QSAVE 00037 RR RTJ Q8PREP 00038 RR ADC* UTCKLN 00039 RR RTJ Q8PKUP 00040 RR TRA Q 00041 RR LDA- (ZERO),Q = WPS 00042 RR STA* WPS 00043 RR RTJ Q8PKUP 00044 RR STA* KIBLEN = ADDRESS OF KIBLEN 00045 RR* 00046 RRCP00 LDA* WPS 00047 RR INA -96 00048 RR SAN CP10 SENSE NOT 96 WORD SECTORS 00049 RR LDA =N$120 USE 3 SECTORS AS KIB LENGTH. 00050 RR JMP* CP20 00051 RR* 00052 RRCP10 LDA =N572 COMPUTE LENGTH = 572/VIWPS 00053 RR ENQ 0 00054 RR DVI* WPS 00055 RR MUI* WPS 00056 RRCP20 STA* (KIBLEN) STORE IT FOR USER 00057 RR LDQ* QSAVE 00058 RR JMP* (UTCKLN) RETURN 00059 RR* 00060 RRQSAVE NUM 0 00061 RRWPS NUM 0 00062 RRKIBLEN NUM 0 00063 RR END 00064 RR NAM VERWPS B65 A ITOS CCS 3.0 SL-149 00001 RR* CHECK COMPATIBILITY BETWEEN DISK PACK AND DISK DRIVE 00002 RR* CREDIT COLLECTION SYSTEM VERSION 3.0 00003 RR* DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA 00004 RR* COPYRIGHT CONTROL DATA CORPORATION 1979 00005 RR SPC 2 00006 RR* FUNCTION 00007 RR SPC 1 00008 RR* THIS ROUTINE CHECKS THE COMPATIBILITY OF THE DISK PACK 00009 RR* FORMAT, THE DISK DRIVE SECTORS/TRACK PLUG WIRING AND THE 00010 RR* PHYSICAL DEVICE TABLE DEFINITIONS FOR A SPECIFIED LOGICAL 00011 RR* UNIT. A STATUS IS RETURNED. 00012 RR SPC 1 00013 RR* CALLING SEQUENCE 00014 RR SPC 1 00015 RR* CALL VERWPS(LU,STATUS) 00016 RR* LU = MSOS LOGICAL UNIT NO. FOR A MM DEVICE 00017 RR* STATUS = 0 RETURNED IF FOUND COMPATIBLE 00018 RR* 1 RETURNED IF FOUND INCOMPATIBLE 00019 RR SPC 2 00020 RR ENT VERWPS 00021 RR ENT LVERWP LENGTH OF VERWPS SUBROUTINE 00022 RR SPC 2 00023 RR EXT LOG1A LOGICAL UNIT VECTOR TABLE 00024 RR SPC 2 00025 RR EQU AMONI($F4),ADISP($EA) 00026 RR EQU ZERO($22),H7FFF($11) 00027 RR EQU DIAGLU(17),WDSSEC(70) 00028 RR SPC 2 00029 RRVERWPS 0 0 00030 RR STQ* QSAVE 00031 RR LDA- I 00032 RR STA* ISAVE 00033 RR LDA* (VERWPS) GET ADDRESS OF PARAMETERS 00034 RR STA* ALU 00035 RR RAO* VERWPS 00036 RR LDA* (VERWPS) 00037 RR STA* ASTAT 00038 RR RAO* VERWPS (BUMP FOR RETURN) 00039 RR******** GET DIAGNOSTIC LU CORRESPONDING TO GIVEN LU FROM P. D. T. 00040 RR LDQ =XLOG1A 00041 RR ADQ* (ALU) 00042 RR LDQ- (ZERO),Q 00043 RR STQ* APDT 00044 RR LDA- DIAGLU,Q 00045 RR STA* LU 00046 RR RTJ* MYLOC 00047 RRMYLOC NUM 0 00048 RR LDA* MYLOC 00049 RR INA CA-MYLOC 00050 RR STA* REQ1+1 00051 RR INA TAGBUF-CA 00052 RR STA* REQ1+5 00053 RR******** READ IN TWO TAGS 00054 RR RTJ- (AMONI) 00055 RRREQ1 ADC $4244,CA,0 00056 RRLU ADC 0,10,TAGBUF,0,0 (10 WORDS FROM SECTORS 0,1) 00057 RR JMP- (ADISP) 00058 RR* 00059 RRCA SQP CA01 SENSE NO I/O ERROR 00060 RR JMP* CA06 00061 RR******** VERIFY PACK SECTOR SIZE(FIELD LENGTH) AND P. D. T. 00062 RR******** WORDS/SECTOR ARE EQUAL. 00063 RRCA01 LDQ* APDT 00064 RR LDA- WDSSEC,Q (=WORDS/SECTOR) 00065 RR ALS 1 00066 RR INA -1 (= FIELD LENGTH FORMAT) 00067 RR TRA Q 00068 RR LDA* TAGBUF+4 (= FIELD LENGTH, TAG 0) 00069 RR ALS 8 (TAGS HAVE FIELD LENGTH BYTES REVERSED) 00070 RR AND- H7FFF (REMOVE BAD SECTOR FLAG) 00071 RR EAQ A 00072 RR SAZ CA02 SENSE TAG 0 FIELD LENGTH OK 00073 RR JMP* CA06 00074 RR******** VERIFY TAG 1 FORMAT 00075 RRCA02 LDA* TAGBUF+9 (= FIELD LENGTH, TAG 1) 00076 RR ALS 8 (TAGS HAVE FIELD LENGTH BYTES REVERSED) 00077 RR AND- H7FFF (REMOVE BAD SECTOR FLAG) 00078 RR EAQ A 00079 RR SAZ CA03 SENSE TAG 1 FIELD LENGTH OK 00080 RR JMP* CA06 00081 RR* 00082 RRCA03 ENQ 4 00083 RRCA04 INQ -1 00084 RR SQM CA05 SENSE TAG 1 VERIFY DONE W/O ERROR 00085 RR LDA* TAGBUF+5,Q 00086 RR SUB* TAG1,Q 00087 RR SAN CA06 SENSE TAG 1 FORMAT INCORRECT 00088 RR JMP* CA04 00089 RR******** DISK PACK/DISK DRIVE COMPATIBLE 00090 RRCA05 ENA 0 SET STATUS COMPATIBLE 00091 RR JMP* CA07 00092 RR******** DISK PACK/DISK DRIVE NOT COMPATIBLE 00093 RRCA06 ENA 1 SET STATUS INCOMPATIBLE 00094 RRCA07 STA* (ASTAT) 00095 RR LDA* ISAVE 00096 RR STA- I 00097 RR LDQ* QSAVE 00098 RR JMP* (VERWPS) RETURN 00099 RR SPC 2 00100 RRQSAVE NUM 0 00101 RRISAVE NUM 0 00102 RRALU NUM 0 00103 RRASTAT NUM 0 00104 RRAPDT NUM 0 00105 RRTAGBUF BZS TAGBUF(10) 00106 RRTAG1 NUM 0,0,0,1 TAG 1 FORMAT(WDS 0-3) 00107 RRLVERWP EQU LVERWP(*-VERWPS) 00108 RR END 00109 RR MON 00001 RR MACRO FMUCOM C0100001 RRC C01 F ITOS CCS 3.0 SL-149C0100002 RRC COMMON MACRO FOR UTILITY FORTRAN PROGRAMS C0100003 RRC ************************************************************* 122*4875C0100004 RRC CYBER 18 INTERACTIVE TERMINAL ORIENTED SYSTEM VERSION 1.1 C0100005 RRC ************************************************************* 122*4875C0100006 RRC THIS IS THE LABELED COMMON AREA FOR THE FILE-MANAGER UTILITY PROGRAMSC0100007 RRC C0100008 RR INTEGER COMCOD,PARNAM,PPHELP,PPINIT,PPDEFI C0100009 RR INTEGER PPSTAT,PPRELO,PPDUMP,PPCOPY,PPDELE C0100010 RR INTEGER PPCLEA,PPLIST,PPRENA,PPCOMM,PPEXIT C0100011 RR INTEGER PPMOUN,PPDISM,PPSAVE,PPBATC,PPLOAD C0100012 RR INTEGER PPPURG,PPINPU,PPOUTP,PPCOMP,DUMMY C0100013 RR INTEGER CODE,SWORD,SBYTE,PARLST,PIND,REQBUF C0100014 RR INTEGER PARDEF C0100015 RR INTEGER PPHOST,PPSET,PPBATS,PPDISC C0100016 RR INTEGER PPDISP,PPFLUS,PPPRIN C0100017 RR INTEGER FCBHDR,FCBBUF C0100018 RRC C0100019 RRC ************************************************************* 122*4875C0100020 RR COMMON /AA/COMCOD(133),PARNAM(124) C0100021 RRC ************************************************************* 122*4875C0100022 RR COMMON /AA/PPHELP(2),PPINIT(4),PPDEFI(16) C0100023 RRC ************************************************************* 122*4875C0100024 RR COMMON /AA/PPSTAT(4),PPRELO(5),PPDUMP(5) C0100025 RRC ************************************************************* 122*4875C0100026 RR COMMON /AA/PPCOPY(6),PPDELE(3),PPCLEA(3) C0100027 RRC ************************************************************* 122*4875C0100028 RR COMMON /AA/PPLIST(6),PPRENA(5),PPCOMM(2) C0100029 RRC ************************************************************* 122*4875C0100030 RR COMMON /AA/PPEXIT(1),PPMOUN(3),PPDISM(2) C0100031 RRC ************************************************************* 122*4875C0100032 RR COMMON /AA/PPSAVE(3),PPBATC(8),PPLOAD(5) C0100033 RRC ************************************************************* 122*4875C0100034 RR COMMON /AA/PPPURG(3),PPINPU(2),PPOUTP(2) C0100035 RR COMMON /AA/PPCOMP(3) C0100036 RR COMMON /AA/PPHOST(4),PPSET(3),PPBATS(4),PPDISC(2) C0100037 RR COMMON /AA/PPDISP(7),PPFLUS(3),PPPRIN(3) C0100038 RR COMMON /AA/DUMMY(6) C0100039 RR COMMON /AA/INBUF(41),CODE(20) C0100040 RR COMMON /AA/LUNIT,MODE,IDUSER(4),NOPORT,SWORD,SBYTE,PARLST C0100041 RR COMMON /AA/NOCOD,PIND,REQBUF(24),IDATA(24) C0100042 RR COMMON /AA/PARDEF(24) C0100043 RR COMMON /AA/FCBHDR(5),FCBBUF(96) C0100044 RR COMMON /AA/ISPARE(72) C0100045 RRC THE ISPARE ARRAY WAS ADDED TO MAKE THE LENGTH C0100046 RRC OF THIS DEFINITION OF COMMON TO BE THE SAME AS C0100047 RRC FMCOM'S DEFINITION. THIS WAS LENGTHENED FOR LARGE C0100048 RRC SECTOR IMPLEMENTATION. C0100049 RRC .................... END OF FMUCOM MACRO ..................... C0100050 RR END C0100051 RR MACRO FMCOM C0100052 RRC DECK-ID C01 CCS 2.1 SUMMARY-126C0100053 RR**** C0100054 RRC MACRO DEFINING COMMON FOR SPECIAL INDEXED LOAD PROGRAMS OF THE C0100055 RRC UTILITIES. C0100056 RR COMMON /AA/RQBADR C0100057 RR COMMON /AA/FCBADR C0100058 RR COMMON /AA/EOF C0100059 RR COMMON /AA/FTHRUD C0100060 RR COMMON /AA/I C0100061 RR COMMON /AA/J C0100062 RR COMMON /AA/KEYFND C0100063 RR COMMON /AA/KEYLNG C0100064 RR COMMON /AA/KEYLWD C0100065 RR COMMON /AA/KEYTYP C0100066 RR COMMON /AA/KEYVAL(15) C0100067 RR COMMON /AA/KIBBUF(572) C0100068 RR COMMON /AA/KIBHRL C0100069 RR COMMON /AA/KIBLEN C0100070 RR COMMON /AA/KIBTYP C0100071 RR COMMON /AA/KISA (17) C0100072 RR COMMON /AA/KISA1 (17) C0100073 RR COMMON /AA/KISBUF(17) C0100074 RR COMMON /AA/KISD (17) C0100075 RR COMMON /AA/KISFND C0100076 RR COMMON /AA/KISIDX C0100077 RR COMMON /AA/KISLNG C0100078 RR COMMON /AA/KLIDX (4) C0100079 RR COMMON /AA/LASTKB C0100080 RR COMMON /AA/LASTSS C0100081 RR COMMON /AA/LCKFLG C0100082 RR COMMON /AA/MAXKIS C0100083 RR COMMON /AA/NEWBUF C0100084 RR COMMON /AA/NEWKBM C0100085 RR COMMON /AA/NEWKBL C0100086 RR COMMON /AA/NOROOT C0100087 RR COMMON /AA/NKIBNL C0100088 RR COMMON /AA/NKIBNM C0100089 RR COMMON /AA/NUMKIS C0100090 RR COMMON /AA/PKIBNL C0100091 RR COMMON /AA/PKIBNM C0100092 RR COMMON /AA/RECLNG C0100093 RR COMMON /AA/REQSTA C0100094 RR COMMON /AA/RKIBNO(2) C0100095 RR COMMON /AA/ROOT C0100096 RR COMMON /AA/RRDATA(2) C0100097 RR COMMON /AA/SSET C0100098 RR COMMON /AA/WPS C0100099 RR COMMON /AA/ZERO2 (2) C0100100 RR COMMON /AA/BUFIDX C0100101 RR INTEGER BUFIDX, CMPSTG, EOF , FCBAD C0100102 RR INTEGER FCBADR, FTHRUD, FWAKIS, KEYFND, KEYLNG C0100103 RR INTEGER KEYLWD, KEYTYP, KEYVAL, KIBBUF, KIBHRL C0100104 RR INTEGER KEYLEN, KIBSEC, KIBTYP, KISA , KISA1 C0100105 RR INTEGER KISBUF, KISD , KISFND, KISIDX, KISLNG, KLIDX , LASTKB C0100106 RR INTEGER LASTSS, LCKFLG, MAXKIS, NEWBUF, NEWKBL C0100107 RR INTEGER NEWKIB(2) , NKIBNL, NKIBNM, NOROOT, NUMKIS C0100108 RR INTEGER PKIBNL, PKIBNM, RECLNG C0100109 RR INTEGER REQSTA, RKIBNO, ROOT , RQBADR, RRDATA, SSET C0100110 RR INTEGER VIWPS, WPS, ZERO2 C0100111 RR EQUIVALENCE (NEWKIB (1) ,NEWKBM) C0100112 RR EQUIVALENCE (NEWKIB (2) ,NEWKBL) C0100113 RR**** C0100114 RR END C0100115 RR MACRO FMCOM2 C0100116 RRC DECK-ID C01 ITOS 1.2 SUMMARY-126C0100117 RR**** C0100118 RRC MACRO CONTAINING BIT DEFINITIONS OF THE REQUEST STATUS WORD. C0100119 RRC C0100120 RR INTEGER ERRIDC, BADREQ, DATFUL, KIDERR, KIDFUL, BADKEY, NOKEY C0100121 RR INTEGER HITEOF, RCDLCK, MMIOER, RECDUP, LCKIDC C0100122 RR BYTE (ERRIDC, REQSTA(15=15)) C0100123 RR BYTE (BADREQ, REQSTA(13=13)) C0100124 RR BYTE (DATFUL, REQSTA(12=12)) C0100125 RR BYTE (KIDERR, REQSTA(11=11)) C0100126 RR BYTE (KIDFUL, REQSTA(11=11)) C0100127 RR BYTE (BADKEY, REQSTA(9=9)) C0100128 RR BYTE (NOKEY , REQSTA( 9= 9)) C0100129 RR BYTE (HITEOF, REQSTA( 8= 8)) C0100130 RR BYTE (RCDLCK, REQSTA (7= 7)) C0100131 RR BYTE (MMIOER, REQSTA( 5= 5)) C0100132 RR BYTE (RECDUP, REQSTA( 4= 4)) C0100133 RR BYTE (LCKIDC, REQSTA( 2= 2)) C0100134 RR**** C0100135 RR END C0100136 RR MACRO FMCOM3 C0100137 RRC DECK-ID C01 ITOS 1.2 SUMMARY-126C0100138 RR**** C0100139 RRC MACRO CONTAINING DEFINITIONS FOR SPECIAL INDEXED LOAD PROGRAMS OFC0100140 RRC UTILITIES. C0100141 RRC C0100142 RRC BUFIDX - KIBBUF INDEX - APPLY TO NORMAL LOCAL INDEX C0100143 RRC CMPSTG - INTEGER FUNCTION C0100144 RRC DATFUL - STATUS BIT: INSUFFICIENT ROOM TO STORE DATA C0100145 RRC EOF - EOF ENCOUNTERED FLAG C0100146 RRC FCBADR - ADDRESS OF FCB FOR FILE (IN BLDIDR) C0100147 RRC FTHRUD - FATHER KIB ALREADY UPDATED FLAG C0100148 RRC FWAKIS - INTEGER FUNCTION C0100149 RRC I - SCRTACH C0100150 RRC J - SCRTACH C0100151 RRC KEYFND - EXACT KEY VALUE FOUND, SET BY POSKID C0100152 RRC KEYLNG - LENGTH OF KEY (IN BYTES) CURRENTLY WORKED ON C0100153 RRC KEYLWD - LENGTH OF KEY IN WORDS C0100154 RRC KEYTYP - KEY TYPE FOR KEY BEING WORKED ON (1<=KEYTYP<=4) C0100155 RRC KEYVAL - VALUE OF KEY BEING WORKED ON C0100156 RRC KIBBUF - BUFFER FOR KIB CURRENTLY WORKED ON C0100157 RRC KIBHRL - LENGTH OF HEADER IN KIB BLOCK, BEFORE KIS STARTS C0100158 RRC KIBLEN - LENGTH OF KIB IN WORDS C0100159 RRC KIBSEC - NO. OF SECTORS PER KIB C0100160 RRC KIBTYP - POSITION OF KIB TYPE IB KIB HEADER C0100161 RRC KIDERR - KID IS NOT FULLY UPDATED BECASUE IT IS MESS UP C0100162 RRC KIDFUL - STATUS BIT: INDEXES NOT FULLY UPDATED DUE TO C0100163 RRC INSUFFICIENT ROOM IN KEY INFO C0100164 RRC KISA - KIS TO BE ADDED IN AN UPDATE C0100165 RRC KISA1 - KIS TO BE ADDED IN AN UPDATE C0100166 RRC KISBUF - KIS BUFFER CURRENTLY WORKED ON C0100167 RRC KISD - KIS TO BE DELETED IN AN UPDATE C0100168 RRC KISFND - FLAG WHETHER THE EXACT KIS IS FOUND C0100169 RRC SET BY POSKID C0100170 RRC KISLNG - LENGHT OF A KIS IN WORDS C0100171 RRC KLIDX - INDEX INTO ENTRIES IN FCB FOR KEY LENGTH C0100172 RRC OF THE DIFFERENT KEY TYPE C0100173 RRC LASTKB - FLAG THAT THE LAST KIB IS BEGIN USED C0100174 RRC LASTSS - LAST S.S. ENCOUNTERED FLAG. SET IN SUBROUTINE C0100175 RRC NEXTSS C0100176 RRC LCKFLG - RECORD IS TO BE LOCKED FLAG C0100177 RRC LCKIDC - STATUS BIT: FILE IS LOCKED INDICATOR C0100178 RRC MAXKIS - MAX NUMBER OF KISES IN A KIB C0100179 RRC MMIOER - STATUS BIT: MASS MEMORY I/O ERROR C0100180 RRC NEWBUF - FLAG THAT T[ KIB IS A NEW ONE C0100181 RRC NEWKBL - NEW KIB NUMBER, LSB C0100182 RRC NEWKBM - NEW KIB NUMBER, MSB C0100183 RRC NEWKIB - RELATIVE KIB NUMBER OF LASTEST KIB C0100184 RRC NKIBNL - POSITION OF NEXT KIB, LEAST SIGNIFICANT BITS C0100185 RRC NKIBNM - POSITION OF NEXT KIB, MOST SIGNIFICANT BITS C0100186 RRC NOKEY - STATUS BIT: KEY IS NOT FOUND C0100187 RRC NOROOT - KIB TYPE FOR NOT ROOT, NOR S.S C0100188 RRC NUMKIS - POSITION OF NUMBER OF KIS IN KIB C0100189 RRC PKIBNL - POSITION OF PREVIOUS KIB, LEAST SIGNIFICANT BITS C0100190 RRC PKIBNM - POSITION OF PREVIOUS KIB, MOST SIGNIFICANT BITS C0100191 RRC RECDUP - STATUS BIT: KEY IS DUPLICATED C0100192 RRC RECLNG - RECORD LENGTH IN WORDS C0100193 RRC REQSTA - STATUS OF REQUEST ,LOCAL VERSION OF ISTAT C0100194 RRC RKIBNO - RELATIVE KIB NUMBER IN KEY INFO SECTION C0100195 RRC ROOT - KIB TYPE FOR ROOT C0100196 RRC RQBADR - ADDRESS OF REQBUF (IN BLDIDR) C0100197 RRC RRDATA - RELATIVE RECORD NO. IN DATA FILE C0100198 RRC SSET - KIB TYPE FOR SEQUENCE SET C0100199 RRC VIWPS - WORDS PER SECTOR IN VOLUME C0100200 RRC WPS - WORDS PER SECTOR FOR THIS VOLUME C0100201 RRC ZERO2 - CONSTANT C0100202 RRC C0100203 RRC ENTRY IN REQBUF C0100204 RRC WORD 1 - Q REGISTER C0100205 RRC WORD 2 - I REGISTER GC0100206 RRC WORD 3 - ADDRESS OF PARAMETER LIST C0100207 RRC WORD 4 - UCT ENTRY INDEX AND ACESS MODE C0100208 RRC WORD 5 - USER IDENTIFIER C0100209 RRC WORD 6 - FCB ADDRESS C0100210 RRC WORD 7 RETURN ADDRESS TO INTERCEPTOR C0100211 RRC WORD 8 REQUEST PROCESSOR INDEX C0100212 RRC WORD 9 BIT 15 = 0 DO NOT LOCK RECORD ON RETRIEVAL C0100213 RRC BIT 15 = 1 LOCK RECORD ON RETRIEVAL C0100214 RRC BITS 14-00 NUMBER OF RECORDS PER CALL C0100215 RRC WORD 10 - KEY TYPE C0100216 RRC WORD 11 - NO. OF RECORDS ACTUALLY RETRIEVED C0100217 RRC WORD 12 - REL REC NO. OF FIRST RECORD STORED/RETRIEVED,MSB C0100218 RRC WORD 13 - REL REC NO. OF FIRST RECORD STORED/RETRIEVED,LSB C0100219 RRC WORD 14 - REL KIB NO. OF LAST RETRIEVED KIB, MSB C0100220 RRC WORD 15 - REL KIB NO. OF LAST RETRIEVED KIB, LSB C0100221 RRC WORD 16 - INDEX OF KIS POINTING TO RECORD LAST RETRIEVED C0100222 RRC WORD 17 - REL REC NO. OF LAST RETRIEVED RECORD, MSB C0100223 RRC WORD 18 - REL REC NO. OF LAST RETRIEVED RECORD, LSB C0100224 RRC------------------------------------------------------ -------------- C0100225 RR**** C0100226 RR. C0100227 RR END C0100228 RR SUBROUTINE TODAY(ARG) C0200001 RR 1 /C02 F ITOS CCS 3.0 SL-149C0200002 RRC GET TODAY'S DATE C0200003 RRC CREDIT COLLECTION SYSTEM VERSION 3.0 C0200004 RRC DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C0200005 RRC COPYRIGHT CONTROL DATA CORPORATION 1979 C0200006 RRC C0200007 RR INTEGER TEMP(3),ARG(3),AMONTO,ADAYTO,AYERTO C0200008 RR EXTERNAL AMONTO,ADAYTO,AYERTO C0200009 RRC BELOW IS: C0200010 RRC LDA+ AMONTO C0200011 RRC STA FCBBUF+91 C0200012 RRC LDA+ ADAYTO C0200013 RRC STA FCBBUF+92 C0200014 RRC LDA+ AYERTO C0200015 RRC STA FCBBUF+93 C0200016 RR ASSEM $C400,+AMONTO,$6800,TEMP(1) C0200017 RR ASSEM $C400,+ADAYTO,$6800,TEMP(2) C0200018 RR ASSEM $C400,+AYERTO,$6800,TEMP(3) C0200019 RR ARG(1)=TEMP(1) C0200020 RR ARG(2)=TEMP(2) C0200021 RR ARG(3)=TEMP(3) C0200022 RR RETURN C0200023 RR END C0200024 RR SUBROUTINE ERCHK(ISTAT,ICALL) C0300001 RR 1 /C03 F ITOS CCS 3.0 SL-149C0300002 RRC DETERMINES WHICH FM ERROR OCCURRED C0300003 RRC CREDIT COLLECTION SYSTEM VERSION 3.0 C0300004 RRC DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C0300005 RRC COPYRIGHT CONTROL DATA CORPORATION 1979 C0300006 RRC C0300007 RRC C0300008 RRC FUNCTION C0300009 RRC C0300010 RRC THIS ROUTINE DETERMINES WHICH BIT OF ISTAT IS SET AND C0300011 RRC SUBMITS THE ERROR MSG CORRESPONDING TO THE TYPE(ICALL) OF C0300012 RRC FILE MANAGER REQUEST MADE C0300013 RRC C0300014 RRC GENERAL DESCRIPTION C0300015 RRC C0300016 RRC UPON ENTRY A CHECK IS MADE WHICH FM-REQ STATUS HAS TO BE C0300017 RRC EXAMINED.IMSK IS THE BIT TO CHECK AND ALL ERNUM ARE RELATIVE C0300018 RRC TO THE ERROR-BASE NUMBER(ERBAS) C0300019 RRC C0300020 RRC CALLING SEQUENCE C0300021 RRC CALL ERCHK(ISTAT,ICALL) C0300022 RRC C0300023 RRC ISTAT = STATUS RETURNING FROM FM-REQUEST C0300024 RRC ICALL = TYPE NO OF FM-REQUEST (CONTAINED IN REQBUF(4)) C0300025 RRC C0300026 RR INTEGER ERBAS,ERNUM,ERBUF C0300027 RRC C0300028 RRC EXTERNAL C0300029 RRC C0300030 RR EXTERNAL SYSMSG C0300031 RRC C0300032 RR ERBAS=30 C0300033 RR+ ERROR BASE NO C0300034 RR ICNT=0 C0300035 RRC C0300036 RRC FIND ERROR BIT C0300037 RRC C0300038 RR IMSK=1 C0300039 RR DO 30 I=0,14 C0300040 RR IF(AND(ISTAT,IMSK)) 10,20,10 C0300041 RR 10 ICNT=I C0300042 RR GO TO 40 C0300043 RR 20 IMSK=IMSK*2 C0300044 RR 30 CONTINUE C0300045 RRC C0300046 RRC WHICH FM-REQUEST C0300047 RRC C0300048 RR 40 GO TO (100,200,200,400,500,600,700,800,800,1000,1100,1200,1300, C0300049 RR *1300,1500,1600,1700,1800),ICALL C0300050 RRC C0300051 RRC C0300052 RRC CREATE FILE C0300053 RRC C0300054 RR 100 ICNT=ICNT+1 C0300055 RR GO TO (9998,9998,9998,9998,9998,105,9998,9998,9998,9998,110,111, C0300056 RR *112,113,114,9998),ICNT C0300057 RR 105 ERNUM=5 C0300058 RR GO TO 9999 C0300059 RR 110 ERNUM=27 C0300060 RR GO TO 9999 C0300061 RR 111 ERNUM=25 C0300062 RR GO TO 9999 C0300063 RR 112 ERNUM=25 C0300064 RR GO TO 9999 C0300065 RR 113 ERNUM=6 C0300066 RR GO TO 9999 C0300067 RR 114 ERNUM=7 C0300068 RR GO TO 9999 C0300069 RRC C0300070 RRC CLEAR FILE/DELETE FILE C0300071 RRC C0300072 RR 200 ICNT=ICNT+1 C0300073 RR GO TO (210,211,9998,9998,9998,215,9998,9998,9998,9998,9998,9998, C0300074 RR *9998,223,224,9998),ICNT C0300075 RRC C0300076 RR 210 ERNUM=8 C0300077 RR GO TO 9999 C0300078 RR 211 ERNUM=4 C0300079 RR GO TO 9999 C0300080 RR 215 ERNUM=5 C0300081 RR GO TO 9999 C0300082 RR 223 ERNUM=6 C0300083 RR GO TO 9999 C0300084 RR 224 ERNUM=7 C0300085 RR GO TO 9999 C0300086 RRC C0300087 RRC OPEN FILE C0300088 RRC C0300089 RR 400 ICNT=ICNT+1 C0300090 RR GO TO (210,211,412,9998,9998,215,9998,9998,9998,9998,420,421,422, C0300091 RR *223,224,9998),ICNT C0300092 RR 412 ERNUM=12 C0300093 RR GO TO 9999 C0300094 RR 420 ERNUM=13 C0300095 RR GO TO 9999 C0300096 RR 421 ERNUM=14 C0300097 RR GO TO 9999 C0300098 RR 422 ERNUM=15 C0300099 RR GO TO 9999 C0300100 RRC C0300101 RRC CLOSE FILE C0300102 RRC C0300103 RR 500 ICNT=ICNT+1 C0300104 RR GO TO(9998,9998,9998,9998,9998,215,9998,9998,9998,9998,9998,9998, C0300105 RR *9998,510,224,9998),ICNT C0300106 RR 510 ERNUM=29 C0300107 RR GO TO 9999 C0300108 RRC C0300109 RRC LOCK FILE C0300110 RRC C0300111 RR 600 ICNT=ICNT+1 C0300112 RR GO TO (610,9998,9998,620,9998,9998,9998,9998,9998,9998,9998,9998, C0300113 RR *9998,510,224,9998),ICNT C0300114 RR 610 ERNUM=51 C0300115 RR GO TO 9999 C0300116 RR 620 ERNUM=52 C0300117 RR GO TO 9999 C0300118 RRC C0300119 RRC UNLOCK FILE C0300120 RRC C0300121 RR 700 ICNT=ICNT+1 C0300122 RR GO TO (9998,9998,710,9998,9998,9998,9998,9998,9998,9998,9998,9998,C0300123 RR *9998,510,9998,9998),ICNT C0300124 RR 710 ERNUM=53 C0300125 RR GO TO 9999 C0300126 RRC C0300127 RRC GET FCB/UPDATE FCB C0300128 RRC C0300129 RR 800 ICNT=ICNT+1 C0300130 RR GO TO (9998,9998,9998,9998,9998,215,9998,9998,9998,9998,9998,9998,C0300131 RR *810,223,224,9998),ICNT C0300132 RR 810 ERNUM=28 C0300133 RR GO TO 9999 C0300134 RRC C0300135 RRC RENAME C0300136 RRC C0300137 RR 1000 ICNT=ICNT+1 C0300138 RR GO TO (210,211,9998,9998,9998,215,9998,9998,9998,9998,1010,1011, C0300139 RR *9998,223,224,9998),ICNT C0300140 RR 1010 ERNUM=27 C0300141 RR GO TO 9999 C0300142 RR 1011 ERNUM=26 C0300143 RRC C0300144 RRC VOLUSE C0300145 RRC C0300146 RR 1800 ICNT=ICNT+1 C0300147 RR GO TO(9998,1801,9998,9998,9998,215,9998,9998,9998,9998,9998,9998, C0300148 RR *9998,223,224,9998),ICNT C0300149 RR 1801 ERNUM=17 C0300150 RR GO TO 9999 C0300151 RRC C0300152 RRC PUTS C0300153 RRC C0300154 RR 1100 ICNT=ICNT+1 C0300155 RR GO TO (9998,9998,412,9998,9998,215,9998,9998,9998,9998,9998,9998, C0300156 RR *1112,223,224,9998),ICNT C0300157 RR 1112 ERNUM=25 C0300158 RR GO TO 9999 C0300159 RRC C0300160 RRC WRITER C0300161 RRC C0300162 RR 1200 ICNT=ICNT+1 C0300163 RR GO TO (9998,9998,412,9998,1204,215,9998,9998,9998,1209,9998,1211, C0300164 RR *1112,223,224,9998),ICNT C0300165 RR 1204 ERNUM=38 C0300166 RR GO TO 9999 C0300167 RR 1209 ERNUM=38 C0300168 RR GO TO 9999 C0300169 RR 1211 ERNUM=25 C0300170 RR GO TO 9999 C0300171 RRC C0300172 RRC READR/GETS C0300173 RRC C0300174 RR 1300 ICNT=ICNT+1 C0300175 RR GO TO (9998,9998,412,9998,1304,215,1306,1307,9998,9998,9998,9998, C0300176 RR *9998,223,224,9998),ICNT C0300177 RR 1304 ERNUM=31 C0300178 RR GO TO 9999 C0300179 RR 1306 ERNUM=47 C0300180 RR GO TO 9999 C0300181 RR 1307 ERNUM=48 C0300182 RR GO TO 9999 C0300183 RRC C0300184 RRC UPDATE RECORD C0300185 RRC C0300186 RR 1500 ICNT=ICNT+1 C0300187 RR GO TO(9998,9998,9998,9998,9998,215,9998,1507,9998,9998,9998,9998, C0300188 RR *9998,223,224,9998),ICNT C0300189 RR 1507 ERNUM=54 C0300190 RR GO TO 9999 C0300191 RRC C0300192 RRC DELETE RECORD C0300193 RRC C0300194 RR 1600 ICNT=ICNT+1 C0300195 RR GO TO (9998,9998,9998,9998,9998,215,9998,1507,9998,9998,9998,1611,C0300196 RR *9998,223,224,9998),ICNT C0300197 RR 1611 ERNUM=55 C0300198 RR GO TO 9999 C0300199 RRC C0300200 RRC COMPRESS FILE C0300201 RRC C0300202 RR 1700 ICNT=ICNT+1 C0300203 RR GO TO (9998,9998,9998,9998,9998,215,9998,9998,1708,9998,9998,9998,C0300204 RR *9998,223,224,9998),ICNT C0300205 RR 1708 ERNUM=56 C0300206 RR GO TO 9999 C0300207 RR 9999 ERNUM=ERNUM+ERBAS C0300208 RRC C0300209 RR CALL SYSMSG (ERNUM,ERBUF) C0300210 RR 9998 RETURN C0300211 RR END C0300212 RR SUBROUTINE INIT C0400001 RR 1 /C04 F ITOS CCS 3.0 SL-149C0400002 RRC COMMAND PROCESSOR FOR INIT C0400003 RRC CREDIT COLLECTION SYSTEM VERSION 3.0 C0400004 RRC DATA SYSTEMS-LA JOLLA DIVISION, LA JOLLA, CALIFORNIA C0400005 RRC COPYRIGHT CONTROL DATA CORPORATION 1979 C0400006 RRC C0400007 RRC*** C0400008 RRC C0400009 RRC C0400010 RRC FUNCTION C0400011 RRC C0400012 RRC THIS COMMAND PROCESSOR WILL WRITE A VOLUME LABEL TO C0400013 RRC A MASS MEMORY DEVICE AND IS TO BE USED IN AN INTERACTIVE MODE ONLY C0400014 RRC C0400015 RRC GENERAL DESCRIPTION C0400016 RRC C0400017 RRC ON ENTRY THE PARAMETER PROCESSING TABLE (PPINIT) IS C0400018 RRC COPIED INTO A TEMPORARILY TABLE (PPTEMP) C0400019 RRC AFTER ALL REQUIRED PARAMETERS HAVE BEEN ENTERED AND C0400020 RRC CHECKED,THE DISK NO IS CONVERTED AND THE CORRESPONDING C0400021 RRC VIT-ADDR IS OBTAINED C0400022 RRC NEXT A FREAD REQUEST IS DONE TO READ IN SECTOR 0 C0400023 RRC FROM THE SPECIFIED DISK C0400024 RRC IF WORD 0 CONTAINS A $1400 THE DISK IS CONSIDERED TO C0400025 RRC BE LABELED AND THE VOLUME-NAME,VOLUME-NO,SEC.CODE AND C0400026 RRC CREATION DATE IS DISPLAYED FOLLOWED BY C0400027 RRC RENAME= C0400028 RRC IF 'NO' IS ENTERED,THE DISK WILL BE TREATED AS AN C0400029 RRC UNLABELED DISK AND A NEW LABEL AND AVAILABLE SPACE C0400030 RRC DIRECTORY IS WRITTEN C0400031 RRC IF ANYGHING ELSE IS ENTERED,ONLY THE SPECIFIED VOLUME- C0400032 RRC NAME IS TRANSFERRED INTO THE LABEL AND THIS NEW LABEL C0400033 RRC IS WRITTEN BACK TO DISK C0400034 RRC IF THE DISK IS UNLABELED,NOTHING WILL BE DISPLAYED C0400035 RRC TODAYS DATE IS MOVED TO THE LABEL CREATE DATE ACCORDING C0400036 RRC TO DATFMT (0=MMDDYY,ELSE DDMMYY) C0400037 RRC THE NO OF FILES IS CONVERTED AND MOVED C0400038 RRC THE ALLOCATABLE AREA AND DIRECTORY SIZE ARE COMPUTED C0400039 RRC NEXT THE NEW LABEL AND AVAILABLE SPACE DIRECTORY ARE C0400040 RRC WRITTEN TO THE DISK C0400041 RRC C0400042 RRC C0400043 RRC SUBROUTINES C0400044 RRC C0400045 RRC CNVRT CONVERSION ASCII-TO-BINARY C0400046 RRC GETFLD GET NEXT FIELD C0400047 RRC SYSMSG SYSTEM ERROR MSG ROUTINE C0400048 RRC MMSIZ GET MAX SECTOR MSB AND LSB C0400049 RRC MOVE MOVE FIELD LEFT JUSTIFIED,BLANK FILL C0400050 RRC MOVER MOVE FIELD RIGHT JUSTIFIED,ZERO FILL C0400051 RRC MVCHAR MOVE CHARACTERS C0400052 RRC PGMINT ALLOW INTERRUPT C0400053 RRC TODAY GET DATE OF TODAY C0400054 RRC WTREAD TERMINAL WRITE/READ C0400055 RRC C0400056 RRC C0400057 RRC MESSAGES C0400058 RRC C0400059 RRC 39 PARAMETER MISSING C0400060 RRC 47 WRONG MM UNIT DEFINED C0400061 RRC 81 ILLEGAL TO INIT A SYSTEM DISK C0400062 RRC C0400063 RRC C0400064 RRC COMMAND FORMAT C0400065 RRC C0400066 RRC INIT,VL=AAAAAAAA,DK=NN C0400067 RRC OR C0400068 RRC INIT,AAAAAAAA,NN C0400069 RRC C0400070 RRC C0400071 RRC C0400072 RRM FMUCOM C0400073 RRC C0400074 RR INTEGER DSK,DSK1,DSK2,VLINIT,VLNAME,VLNMBR,VLSER C0400075 RR INTEGER VLSEC,VLDATE,VLBMS,VLASDM,VLASDL,VLBBA,VLWPS C0400076 RR INTEGER VLFDD,VLMAXF,VLCURF,VLNFDB,VLNXTB,ENDLAB C0400077 RR INTEGER OUTP,SECTM,SECTL C0400078 RR INTEGER DIRSIZ,VLLBAL,VLLBAM C0400079 RR INTEGER ZRO,ERBUF,PARNUM,PARID,PPTEMP(17),PPTAB(4) C0400080 RR INTEGER BUFLEN,TC,BLANK,QUEST,STAT,DATSEP,DATFMT,ASDIR(5),WPS C0400081 RR INTEGER VLBMSL,VLBMSM,VLLBA C0400082 RR INTEGER VLASDS C0400083 RR INTEGER IDUM1,IDUM2 C0400084 RRC C0400085 RR DIMENSION IPNAM(17) C0400086 RR DIMENSION IJUST(17) C0400087 RR DIMENSION ICONV(17) C0400088 RR DIMENSION IREQ(17) C0400089 RR DIMENSION IFND(17) C0400090 RR DIMENSION NAME(18) C0400091 RR DIMENSION ITEMP(3) C0400092 RR DIMENSION LABEL(572) C0400093 RR DIMENSION NF(2) C0400094 RR DIMENSION NR(4) C0400095 RR DIMENSION VLDATE(4) C0400096 RR DIMENSION VLBMS(2) C0400097 RR DIMENSION VLLBA(2) C0400098 RR DIMENSION MSG1(24) C0400099 RR DIMENSION VLSER(5),VLSEC(4) C0400100 RR DIMENSION VLFDD(2) C0400101 RRC C0400102 RRC EXTERNALS C0400103 RRC C0400104 RR EXTERNAL MOVER C0400105 RR EXTERNAL MOVEL C0400106 RR EXTERNAL LOG1A C0400107 RR EXTERNAL MMSIZ C0400108 RR EXTERNAL DATSEP C0400109 RR EXTERNAL MMLUTB C0400110 RR EXTERNAL DATFMT C0400111 RR EXTERNAL SYSMSG C0400112 RRC C0400113 RR INTEGER CNVRT C0400114 RRC C0400115 RR BYTE (DSK1,DSK(3=0)) C0400116 RR BYTE (DSK2,DSK(11=8)) C0400117 RR BYTE (LUN1,MMUNIT(6=0)) C0400118 RRC C0400119 RR BYTE (IFND,PPTEMP(15=15)) C0400120 RR BYTE (IREQ,PPTEMP(12=12)) C0400121 RR BYTE (ICONV,PPTEMP(10=9)) C0400122 RR BYTE (IJUST,PPTEMP(8=8)) C0400123 RR BYTE (IPNAM,PPTEMP(7=0)) C0400124 RRC C0400125 RR EQUIVALENCE (VLINIT,LABEL(1)) C0400126 RR EQUIVALENCE (VLNAME,LABEL(3)) C0400127 RR EQUIVALENCE (VLNMBR,LABEL(7)) C0400128 RR EQUIVALENCE (VLSER,LABEL(8)) C0400129 RR EQUIVALENCE (VLSEC,LABEL(13)) C0400130 RR EQUIVALENCE (VLDATE,LABEL(17)) C0400131 RR EQUIVALENCE (VLBMS,LABEL(21)) C0400132 RR EQUIVALENCE (VLASDM,LABEL(23)) C0400133 RR EQUIVALENCE (VLASDL,LABEL(24)) C0400134 RR EQUIVALENCE (VLASDS,LABEL(25)) C0400135 RR EQUIVALENCE (VLLBA,LABEL(26)) C0400136 RR EQUIVALENCE (VLWPS,LABEL(28)) C0400137 RR EQUIVALENCE (VLFDD,LABEL(29)) C0400138 RR EQUIVALENCE (VLMAXF,LABEL(31)) C0400139 RR EQUIVALENCE (VLCURF,LABEL(32)) C0400140 RR EQUIVALENCE (VLNFDB,LABEL(33)) C0400141 RR EQUIVALENCE (VLNXTB,LABEL(34)) C0400142 RR EQUIVALENCE (ENDLAB,LABEL(96)) C0400143 RRC C0400144 RR EQUIVALENCE (NOF,DUMMY(1)) C0400145 RR EQUIVALENCE (DSK,DUMMY(3)) C0400146 RR EQUIVALENCE (PPINIT,PPTAB) C0400147 RRC*** C0400148 RRC C0400149 RR DATA NAME/'VOLUME-NAME=NO.OF.FILES=DISK-UNIT ='/ C0400150 RR DATA MSG1/$0A0D,' ',$0A0D,'VOLUC0400151 RR *ME= '/ C0400152 RR DATA ZRO/0/,NOCUR/-1/ C0400153 RR DATA BUFLEN/40/ C0400154 RR DATA LENG1/24/ C0400155 RR DATA QUEST/'? '/ C0400156 RRC C0400157 RR DATA BLANK / $2020/ C0400158 RRC C0400159 RRC INITIALISATION C0400160 RRC C0400161 RR 11 INDEX=0 C0400162 RR+ ERROR MSG NO. C0400163 RRC 3 CARDS DELETED 121*4741C0400164 RR ASDIR(5)=-1 C0400165 RR ERBUF=0 C0400166 RR+ ERROR MSG BUF C0400167 RR ISTAT=0 C0400168 RR+ STATUS OF FM-REQUEST C0400169 RR LNGO=0 C0400170 RR+ LENGTH OF FIELD TO MOVE C0400171 RR MORPAR=0 C0400172 RR+ INDICATOR IF MORE PARAMETERS NEEDED C0400173 RR MORLIN=0 C0400174 RR+ INDICATOR IF MORE LINES NEED TO BE READ C0400175 RR PARNUM=0 C0400176 RR+ COUNT OF REQ.AND NOT FOUND PARAMETERS C0400177 RR PARID=0 C0400178 RR MORFIL=0 C0400179 RR IFTSW=0 C0400180 RR MMUNIT=0 C0400181 RR IRNFLG=0 C0400182 RR+ RENAME FLAG 1 IF RENAME IS REQUIRED C0400183 RR IFLAG=0 C0400184 RR IP=1 C0400185 RR NR(1) = $3030 C0400186 RR NR(2) = $3030 C0400187 RR NR(3) = $3030 C0400188 RR NR(4) = $3030 C0400189 RR ASSEM $C000,+DATSEP C0400190 RR ASSEM $6800,ISPRT C0400191 RRC C0400192 RR ASSIGN 9998 TO INTLOC C0400193 RR CALL PGMINT(INTLOC,IFLAG) C0400194 RRC C0400195 RRC COPY THE PARAMETER PROCESSING TABLE C0400196 RRC C0400197 RR I=0 C0400198 RR 10 I=I+1 C0400199 RR PPTEMP(I)=PPTAB(I) C0400200 RR IF(PPTEMP(I))10,20,10 C0400201 RRC C0400202 RRC C0400203 RRC C0400204 RR 20 DO 30 I=1,24 C0400205 RR REQBUF(I)=0 C0400206 RR IDATA(I)=PARDEF(I) C0400207 RR 30 CONTINUE C0400208 RRC C0400209 RR 35 IF(PIND)110,70,40 C0400210 RRC C0400211 RRC PROMPTING LEVEL = 1 FULL PARAMETERS WILL BE DISPLAYED C0400212 RRC C0400213 RR 40 KI=IP C0400214 RR I=(IP-1)*6+1 C0400215 RR IF(IPNAM(IP))50,100,50 C0400216 RRC C0400217 RR 50 J=I+5 C0400218 RR K=1 C0400219 RR CODE(K)=$0A0D C0400220 RR+ SET CR/LF C0400221 RR DO 60 I=I,J C0400222 RR K=K+1 C0400223 RR CODE(K)=NAME(I) C0400224 RR 60 CONTINUE C0400225 RRC C0400226 RR I=KI C0400227 RR LNGO=7 C0400228 RR GO TO 90 C0400229 RRC C0400230 RRC PROMPTING LEVEL = 0 PARAMETER ABBREVIATIONS WILL BE DISPLAYED C0400231 RRC C0400232 RR 70 I=IP C0400233 RR K=IPNAM(IP) C0400234 RR+ INDEX TO PARAM.MNEM.TABLE C0400235 RR IF(K)80,100,80 C0400236 RR 80 K=(K-1)*3+1 C0400237 RRC C0400238 RR CODE(1)=$0A0D C0400239 RR CODE(2)=PARNAM(K) C0400240 RR CODE(3)=$3D20 C0400241 RR LNGO=3 C0400242 RRC C0400243 RRC DISPLAY NEXT PARAMETER-IDENT C0400244 RRC C0400245 RR 90 CALL WTREAD (LUNIT,NOCUR,CODE,LNGO,NOCUR,DUMMY,ZRO,TC) C0400246 RRC C0400247 RR PARID=IP C0400248 RR+ INDEX IN PARNAM-TABLE C0400249 RR IFND(I)=1 C0400250 RR+ SET FOUND FLAG C0400251 RR IP=IP+1 C0400252 RR+ INCR. INDEX TO PPTEMP C0400253 RR MORPAR=1 C0400254 RR+ SET INDICATOR FOR MORE PARAMETERS NEEDED C0400255 RR GO TO 120 C0400256 RRC C0400257 RRC END OF PARAMETER LIST, ISSUE FM-REQUEST C0400258 RRC C0400259 RR 100 MORPAR=0 C0400260 RR GO TO 320 C0400261 RRC C0400262 RRC PROMPTING LEVEL = -1, NO PROMPTING DONE C0400263 RRC C0400264 RR 110 IF(MORLIN) 115,130,130 C0400265 RR+ DO WE NEED TO READ MORE LINES C0400266 RR 115 MORLIN=0 C0400267 RRC C0400268 RRC READ NEXT LINE C0400269 RRC C0400270 RR 120 CALL WTREAD (LUNIT,NOCUR,DUMMY,ZRO,NOCUR,INBUF,BUFLEN,TC) C0400271 RRC C0400272 RRC RESET SWORD AND SBYTE C0400273 RRC C0400274 RR SBYTE=0 C0400275 RR SWORD=0 C0400276 RRC C0400277 RR 130 CALL GETFLD (INBUF,CODE,SWORD,SBYTE,STAT) C0400278 RRC C0400279 RR 140 IF (STAT-2)150,160,200 C0400280 RR 150 IF (STAT-1)260,250,250 C0400281 RRC C0400282 RRC EOL DETECTED,COUNT NO OF REQUIRED AND NOT FOUND PARAMETERS (STATUS=1)C0400283 RRC C0400284 RR 160 IF(PIND)161,162,162 C0400285 RR 161 MORPAR=0 C0400286 RRC C0400287 RRC CHECK IF FULL NAME DESIRED C0400288 RRC C0400289 RR 162 IF (CODE(1)-QUEST)164,163,164 C0400290 RRC C0400291 RRC YES,FULL NAME FOR THIS PARAMETER ONLY C0400292 RRC C0400293 RR 163 IF (PIND .NE. -1) IP=IP-1 C0400294 RR GO TO 40 C0400295 RRC C0400296 RRC CHECK IF PARAMETER ENTERED C0400297 RRC C0400298 RR 164 IF(CODE(1)-BLANK)270,165,270 C0400299 RR 165 IFND(IP-1)=0 C0400300 RR IF (PIND .EQ. -1) GO TO 320 C0400301 RR GO TO 35 C0400302 RRC C0400303 RRC PARAMETER-ID FOUND (STATUS=3) C0400304 RRC C0400305 RR 200 I=1 C0400306 RR 210 K=IPNAM(I) C0400307 RR K=(K-1)*3+1 C0400308 RRC C0400309 RR IF (CODE(1)-PARNAM(K))230,220,230 C0400310 RRC C0400311 RRC PARAMETER-ID CORRESPONDS WITH PARAM.MNEMONIC TABLE C0400312 RRC C0400313 RR 220 PARID=I C0400314 RR IFND(I)=1 C0400315 RR IP = IP + 1 C0400316 RR GO TO 130 C0400317 RRC C0400318 RR 230 I=I+1 C0400319 RR+ NO MATCH,CONTINUE C0400320 RR IF(IPNAM(I))210,240,210 C0400321 RRC C0400322 RR 240 INDEX=39 C0400323 RR+ PARAMETER ILLEGAL C0400324 RR GO TO 9999 C0400325 RRC C0400326 RRC FIELD TERMINATED ON A SEMI-COLON (STATUS=1) C0400327 RRC C0400328 RR 250 MORLIN=-1 C0400329 RR+ SET INDICATOR TO READ MORE LINES C0400330 RRC C0400331 RRC FIELD TERMINATED ON A COMMA (STATUS=0) C0400332 RRC C0400333 RR 260 MORPAR=1 C0400334 RR+ SET INDICATOR FOR MORE PARAMETERS C0400335 RR IF(CODE(1) .NE. BLANK)GO TO 270 C0400336 RR IFND(IP)=0 C0400337 RR IP=IP+1 C0400338 RR GO TO 35 C0400339 RRC C0400340 RRC STORE PARAMETER VALUES INTO REQUIRED LOCATIONS C0400341 RRC C0400342 RR 270 IF (PARID)290,290,280 C0400343 RR+ PARAMETER-ID FOUND C0400344 RR 280 I=PARID C0400345 RR+ YES C0400346 RR GO TO 300 C0400347 RRC C0400348 RR 290 I=IP C0400349 RR IF (CODE(1) .NE. BLANK) IFND(I)=1 C0400350 RR IP=IP+1 C0400351 RRC C0400352 RR 300 I=(IPNAM(I)-1)*3+1 C0400353 RRC C0400354 RR LNGO=PARNAM(I+1) C0400355 RR OUTP=PARNAM(I+2) C0400356 RRC C0400357 RRC STORE INTO DESIGNATED OUTPUT FIELD C0400358 RRC C0400359 RR IF(ICONV(IP-1)-1)302,304,302 C0400360 RRC C0400361 RR 302 CALL MOVEL (CODE,OUTP,LNGO) C0400362 RR GO TO 306 C0400363 RRC C0400364 RR 304 LNGI=LNGO C0400365 RR CALL MOVER (CODE,LNGI,OUTP,LNGO) C0400366 RRC C0400367 RR 306 PARID=0 C0400368 RR IF(MORPAR)310,320,310 C0400369 RR+ ARE THERE MORE PARAM TO BE PROCESSED C0400370 RR 310 IF(PIND)110,70,40 C0400371 RR+ YES C0400372 RRC C0400373 RRC C0400374 RRC ARE ALL REQUIRED PARAMETERS FOUND ? C0400375 RRC C0400376 RR 320 I=0 C0400377 RR 330 I=I+1 C0400378 RR IF(PPTEMP(I))330,360,340 C0400379 RRC C0400380 RRC PARAMETER NOT FOUND,IS IT REQUIRED ? C0400381 RRC C0400382 RR 340 IF(IREQ(I))330,350,330 C0400383 RRC C0400384 RRC YES IT IS REQUIRED C0400385 RRC C0400386 RR 350 PARNUM=PARNUM+1 C0400387 RR GO TO 330 C0400388 RRC C0400389 RRC END OF PPTAB C0400390 RRC C0400391 RR 360 IF(PARNUM)240,400,240 C0400392 RR+ ARE ALL REQUIRED PARAMETERS FOUND C0400393 RRC C0400394 RRC C0400395 RRC C0400396 RRC C0400397 RRC READ LABEL FROM DESIGNATED MASS-STORAGE DEVICE C0400398 RRC C0400399 RRC GET ACTUAL SYSTEM-LOGICAL UNIT NO AND VIT-ADDR. C0400400 RRC C0400401 RR 400 MMUNIT=DSK1+DSK2*10 C0400402 RRC C0400403 RR IF (MMUNIT .EQ. 0) GO TO 560 C0400404 RR MMUNIT=MMUNIT+1 C0400405 RR+ FM UNITS ARE 1,2,3,4...... C0400406 RRC C0400407 RR ASSEM $0842 C0400408 RR+ CLR Q C0400409 RR ASSEM $C600,+MMLUTB C0400410 RR+ LDA MMLUTB,Q C0400411 RR ASSEM $6800,NLUN C0400412 RR+ STA NLUN C0400413 RRC C0400414 RR IF(MMUNIT .GT. NLUN) GO TO 550 C0400415 RRC C0400416 RRC C0400417 RR ASSEM $E800,MMUNIT C0400418 RR+ LDQ MMUNIT C0400419 RR ASSEM $C600,+MMLUTB C0400420 RR+ LDA MMLUTB,Q C0400421 RR ASSEM $60FF C0400422 RR+ STA- I C0400423 RR ASSEM $C502 C0400424 RR+ LDA- (VISLUN),I C0400425 RRC C0400426 RRC SAVE FOR MOUNT AND DISMOUNT CHECK C0400427 RRC C0400428 RR ASSEM $6800,KMODSM C0400429 RR+ STA KMODSM C0400430 RR ASSEM $A00A C0400431 RR+ AND- LPMASK+8 C0400432 RR ASSEM $6800,MMUNIT C0400433 RR+ STA MMUNIT C0400434 RR ASSEM $C10D C0400435 RR+ LDA- VIWPS,I C0400436 RR ASSEM $6800,WPS C0400437 RR+ STA WPS C0400438 RRC***************************************************************121*4741C0400439 RR ASSEM $C115 C0400440 RR+ LDA- LMSB,I C0400441 RR ASSEM $6800,404 C0400442 RR+ STA* REQMSB C0400443 RR ASSEM $6800,1104 C0400444 RR ASSEM $C116 C0400445 RR+ LDA- LLSB,I C0400446 RR ASSEM $6800,405 C0400447 RR ASSEM $6800,1105 C0400448 RR+ STA* REQLSB C0400449 RRC***************************************************************121*4741C0400450 RRC CHECK COMPATIBILITY OF P. D. T., DISK DRIVE AND DISK PACK C0400451 RR CALL VERWPS(MMUNIT, ISTAT) C0400452 RR IF (ISTAT .NE. 0) GO TO 580 C0400453 RRC C0400454 RRC BUILD THE READ REQUEST C0400455 RRC C0400456 RR ASSEM $C800,MMUNIT C0400457 RR+ LDA MMUNIT C0400458 RR ASSEM $680B C0400459 RR+ STA *+11 C0400460 RR ASSEM $C800,WPS C0400461 RR+ LDA WPS C0400462 RR ASSEM $6809 C0400463 RR+ STA *+9 C0400464 RR ASSEM $C000,+LABEL C0400465 RR+ LDA =XLABEL C0400466 RR ASSEM $6807 C0400467 RR+ STA *+7 C0400468 RRC C0400469 RRC READ SECTOR 0 OF MMUNIT C0400470 RRC C0400471 RRC******************************************************'********121*4741C0400472 RR ASSEM $54F4,$4800,$0,$0,$0,$0,$0 C0400473 RR 404 ASSEM $0 C0400474 RR 405 ASSEM $0 C0400475 RRC******************************************************'********121*4741C0400476 RRC C0400477 RR IF(LABEL(1) .EQ. $1400) GO TO 5000 C0400478 RRC C0400479 RRC VOLUME IS UNLABELED C0400480 RR* C0400481 RR LABEL(1)=$1400 C0400482 RR LABEL(2)=$0060 C0400483 RR* C0400484 RRC MOVE TODAY'S DATE INTO LABEL C0400485 RRC C0400486 RR 410 CALL TODAY(ITEMP) C0400487 RRC C0400488 RR ASSEM $C000,+DATFMT C0400489 RR ASSEM $6800,IDATFM C0400490 RR IF(IDATFM) 500,420,500 C0400491 RRC C0400492 RRC DATFMT=0 MMDDYY C0400493 RRC C0400494 RR 420 VLDATE(1)=ITEMP(1) C0400495 RR CALL MVCHAR(ISPRT,2,1,VLDATE(2),1) C0400496 RR CALL MVCHAR(ITEMP(2),1,2,VLDATE(2),2) C0400497 RR CALL MVCHAR(ISPRT,2,1,VLDATE(3),2) C0400498 RR GO TO 505 C0400499 RRC C0400500 RRC DATFMT=1 DDMMYY C0400501 RRC C0400502 RR 500 VLDATE(1)=ITEMP(2) C0400503 RR CALL MVCHAR(ISPRT,2,1,VLDATE(2),1) C0400504 RR CALL MVCHAR(ITEMP(1),1,2,VLDATE(2),2) C0400505 RR CALL MVCHAR(ISPRT,2,1,VLDATE(3),2) C0400506 RR 505 VLDATE(4)=ITEMP(3) C0400507 RRC C0400508 RRC MOVE VOLUME-NAME INTO LABEL C0400509 RRC C0400510 RR ASSEM $C000,+VLNAME C0400511 RR+ LDA =XVLNAME C0400512 RR ASSEM $6800,OUTP C0400513 RR+ STA OUTP C0400514 RR LNGO=8 C0400515 RR CALL MOVEL (IDATA(9),OUTP,LNGO) C0400516 RRC C0400517 RRC CONVERT NF AND MOVE INTO LABEL C0400518 RRC C0400519 RR ASSEM $C000,+NR(3) C0400520 RR+ LDA =XNR C0400521 RR ASSEM $6800,OUTP C0400522 RR LNGO=4 C0400523 RR LNGI=LNGO C0400524 RRC C0400525 RRC CHECK IF DATA INPUT C0400526 RRC C0400527 RR IF (PPTEMP(2) .LT. 0) CALL MOVER(NOF, LNGI, OUTP, LNGO) C0400528 RR NR(1)=$3030 C0400529 RR NR(2)=$3030 C0400530 RR IF (CNVRT(NR,NF) .NE. 0) GO TO 511 C0400531 RR IF (NF( 1) .NE. 0) GO TO 507 C0400532 RRC C0400533 RR IF (NF( 2) .EQ. 0) NF( 2) = 256 C0400534 RR IF (NF(2) .GT. 2048) GO TO 507 C0400535 RR VLMAXF = NF(2) C0400536 RR GO TO 600 C0400537 RRC C0400538 RR 507 CONTINUE C0400539 RR INDEX=52 C0400540 RR+ 52 PARAMETER ENTRY ERROR C0400541 RR IF(AND(MODE,$EFFF))9999,510,9999 C0400542 RRC C0400543 RR 510 CALL SYSMSG(INDEX,ERBUF) C0400544 RR 511 CONTINUE C0400545 RR IP = IP - 2 C0400546 RR GO TO 35 C0400547 RRC C0400548 RRC SET UP START OF ALLOC SECTOR DIR C0400549 RRC C0400550 RR 600 VLASDM=0 C0400551 RRC***************************************************************121*4741C0400552 RR ASSEM $C800,1105 C0400553 RR+ LDA 1105 C0400554 RR ASSEM $0901 C0400555 RR+ INA 1 C0400556 RR ASSEM $6800,VLASDL C0400557 RR+ STA VLASDL C0400558 RRC***************************************************************121*4741C0400559 RR VLWPS=WPS C0400560 RRC C0400561 RRC C0400562 RRC COMPUTE DIRECTORY SIZE BASED ON NF C0400563 RRC C0400564 RRC THE FOLLOWING LINE OF CODE FIXS A BUG. THE BUG WAS THAT C0400565 RRC THE FILE MANAGER'S AVAILABLE SPACE DIRECTORY HAD BEEN DEFINED C0400566 RRC ABOUT HALF THE SIZE IT SHOULD HAVE BEEN. C0400567 RRC C0400568 RR IRF = NF(2) + 1 C0400569 RR IRF=IRF*4 C0400570 RR DIRSIZ=IRF/VLWPS C0400571 RR IF(DIRSIZ*VLWPS .NE. IRF) DIRSIZ=DIRSIZ+1 C0400572 RRC C0400573 RR VLASDS=DIRSIZ C0400574 RR VLNMBR=$3031 C0400575 RRC C0400576 RR DO 7000 N=1,4 C0400577 RR VLSER(N)=$2020 C0400578 RR VLSEC(N)=$2020 C0400579 RR 7000 CONTINUE C0400580 RR VLSER(5)=$2020 C0400581 RR VLBMS(1)=VLASDM C0400582 RRC***************************************************************121*4741C0400583 RR VLBMS(2)=VLASDL+DIRSIZ C0400584 RRC******************************************************'********121*4741C0400585 RR VLCURF=0 C0400586 RR VLNFDB=0 C0400587 RR VLNXTB=0 C0400588 RR VLFDD(1)=0 C0400589 RR VLFDD(2)=0 C0400590 RRC C0400591 RRC WRITE VOLUME LABEL C0400592 RRC C0400593 RRC C0400594 RRC GET EQUIPMENT TYPE FOR THIS MMUNIT C0400595 RRC C0400596 RR 1000 ASSEM $E800,LUN1 C0400597 RR+ LDQ LUN1 Q=LOG. UNIT C0400598 RRC C0400599 RRC TEST IF VOLUME IS MOUNTED. IF SO, ERROR OUT C0400600 RRC C0400601 RR IF (KMODSM .GE. 0) GO TO 570 C0400602 RRC C0400603 RRC GET MAX. NO. OF SECTORS FOR MM DEVICE. C0400604 RRC C0400605 RR CALL MMSIZ (MMUNIT,SECTM,SECTL,IDUM1,IDUM2) C0400606 RRC C0400607 RRC CHECK IF RENAME IS REQUIRED C0400608 RRC C0400609 RR IF(IRNFLG .EQ. 1) GO TO 1100 C0400610 RRC C0400611 RR VLLBA(1)=SECTM C0400612 RR VLLBA(2)=SECTL-DIRSIZ-1 C0400613 RR ASDIR(1)=VLLBA(1) C0400614 RR ASDIR(2)=VLLBA(2) C0400615 RR ASDIR(3)=VLBMS(1) C0400616 RR ASDIR(4)=VLBMS(2) C0400617 RRC C0400618 RRC PREPARE FOR WRITE LABEL C0400619 RRC C0400620 RR 1100 ASSEM $C800,MMUNIT C0400621 RR ASSEM $680B C0400622 RR ASSEM $C800,WPS C0400623 RR ASSEM $6809 C0400624 RR ASSEM $C000,+LABEL C0400625 RR ASSEM $6807 C0400626 RRC C0400627 RRC***************************************************************121*4741C0400628 RR ASSEM $54F4,$4C00,$0,$0,$0,$0,$0 C0400629 RR 1104 ASSEM $0 C0400630 R