ARGAD 0200 ARG1 0257 ARG2 0260 ARG3 0261 DCAI 3400OP DOIT 0255 EGGSIT 0503 EROR 0265 GETARG 0202 GIMDF 0521 GIMEX 0541 GIMME 0516 GIMOK 0536 GIMTM 0515 GMTM1 0514 GTCDF1 0203 GTCDF2 0212 HANDT 0201 HANDTD 0266 IER 0265 IN4040 0436 JMPI 5400OP LABL1 0342 LABL2 0351 LABL3 0461 PASIT 0360 PTEM 0357 RDIT 0253 RTAPE 0304EXT SLCDF 0440 SLOOP 0423 STRTP 0400 TADI 1400OP THEART 0215 WTAPE 0267EXT WTPRS 0272 XDAD 0513 XDNOB 0454 XFCT 0511 XFILE 0313EXT XFSR1 0507 XFSR2 0506 XLFRE 0512 XLOOP 0416 XNOF 0472 XNRM 0464 XRDCT 0510 /RTAPE, WTAPE FOR THE TD8E DECTAPE CONTROLLER /CALLED BY: CALL WTAPE(IUNIT,IBLOCK,IWORDS,IBUF,IER) /PLUS:.......(TODAY AND TODAY ONLY!) / XFILE - ROUTINE TO READ XSYSTEM DIRECTORIES. / CALLED BY: / CALL XFILE(IUNIT,IBFADR,FNAME,ISTBL,INOB,IER) / WHERE: IUNIT = THE UNIT NUMBER / FNAME = THE SIX LETTER FILE NAME / IBFADR = 256 WORD BUFFER ADDRESS / (USED FOR THE DIRECTORY) / ISTBL = THE START BLOCK NUMBER OF / THE FILE(128 WD BLOCKS) / INOB = THE NUMBER OF 128 WD BLOCKS / IER = THE ERROR FLAG (0 = ALL OK) / / LAP 3400 OPDEF DCAI 3400 1400 OPDEF TADI 1400 5400 OPDEF JMPI 5400 ENTRY RTAPE /READ TAPE ENTRY ENTRY WTAPE /WRITE TAPE ENTRY ENTRY XFILE /SEARCH XSYSTEM DIRECTORY /PARAMETER UNPACKING ROUTINE.... 0200 0000 ARGAD, 0 0201 0000 HANDT, 0 0202 0000 GETARG, 0 /GETS NEXT ARGUMENT IN FORTRAN /GENERATED PARAMETER STRING 0203 7402 GTCDF1, HLT /REPLACED BY CDF 0204 1670 TADI WTAPE# /GET PARAM DATA FIELD 0205 3212 DCA GTCDF2 0206 2270 INC WTAPE# /BUMP LIST ADDRESS 0207 1670 TADI WTAPE# /GET PARAMETER ADDRESS 0210 3200 DCA ARGAD /SAVE FOR INDIRECT (OR ARRAY) 0211 2270 INC WTAPE# 0212 7402 GTCDF2, HLT /REPLACED BY CDF 0213 1600 TADI ARGAD /PASS VALUE IN ACC 0214 5602 JMPI GETARG /EXIT QUIETLY.... /GENERAL DECODING AND PROCESSING (COMMON) DONE HERE. 0215 0000 THEART, 0 0216 4202 JMS GETARG /GET THE UNIT NUMBER 0217 0377 AND (1 /MUST BE 0 OR 1, SO.... 0220 7110 CLL RAR /FORCE TO ZERO OR ONE. 0221 1266 TAD HANDTD /COMPUTE THE ENTRY POINT TO /THE SYSTEM HANDLER ROUTINE. 0222 7430 SZL /DTA0 OR DTA1....? 0223 1376 TAD (5 0224 3201 DCA HANDT 0225 4202 JMS GETARG /GET THE BLOCK NUMBER. 0226 7510 SPA /IF NEGATIVE VALUED THEN SET 0227 2257 ISZ ARG1 /FLAG IN THE FUNCTION WORD 0230 7510 SPA /TO START THE SEARCH IN THE 0231 7041 CIA /FORWARD DIRECTION. 0232 3261 DCA ARG3 /BLOCK NUMBER = ARG3 0233 4202 JMS GETARG /GET THE NUMBER OF WORDS 0234 0375 AND (3700 /CONVERT TO NUMBER OF BLOCKS 0235 7110 CLL RAR 0236 1257 TAD ARG1 /MASK INTO THE FUNCTION WORD 0237 3257 DCA ARG1 0240 4202 JMS GETARG /FINALLY GET THE BUFFER 0241 7200 CLA 0242 1212 TAD GTCDF2 /MASK THE DATA FIELD INTO THE 0243 0374 AND (0070 /FUNCTION WORD. 0244 1257 TAD ARG1 0245 3257 DCA ARG1 0246 1200 TAD ARGAD /AND SET UP THE BUFFER ADDRESS 0247 3260 DCA ARG2 0250 3265 DCA EROR 0251 4253 JMS RDIT /DO THE DATA TRANSFER 0252 5615 JMP I THEART /AND EXIT / NOW CALL THE SYSTEM HANDLER.... 0253 0000 RDIT, 0 0254 6202 6202 /CHANGE TO FIELD 0 0255 6201 05 DOIT, JMS I HANDT 0256 4601 0257 0000 ARG1, 0 /FUNCTION WORD 0260 0000 ARG2, 0 /BUFFER ADDRESS 0261 0000 ARG3, 0 /BLOCK NUMBER 0262 3265 DCA EROR /ERROR EXIT 0263 6201 05 JMP I RDIT /SEEMS RATHER PAINLESS.... 0264 5653 IER, 0265 0000 EROR, 0 0266 7607 HANDTD, 7607 / ENTRY POINT FOR WRITE FUNCTION (WTAPE) 0267 0000 WTAPE, BLOCK 2 0270 0000 0271 7130 CLL CML RAR /SET WRITE FLAG 0272 3257 WTPRS, DCA ARG1 /INTO FUNCTION WORD 0273 1267 TAD WTAPE /SET UP DATA FIELD CHANGE 0274 3203 DCA GTCDF1 /FOR GETTING PARAMETERS 0275 4215 JMS THEART /GO DO IT.... 0276 4202 JMS GETARG /PASS BACK ERROR STSTUS 0277 7200 CLA 0300 1265 TAD EROR 0301 3600 DCAI ARGAD 0302 4040 RETRN WTAPE 0303 0002 06 / ENTRY POINT FOR READ FUNCTION (RTAPE) 0304 0000 RTAPE, BLOCK 2 0305 0000 0306 1304 TAD RTAPE /MOVE CALLING SEQ TO WTAPE 0307 3267 DCA WTAPE 0310 1305 TAD RTAPE# 0311 3270 DCA WTAPE# /ONLY DIFFERENCE IS THAT THE 0312 5272 JMP WTPRS /FUNCTION FLAG IS FOR READ. / MAIN ENTRY FOR XSYSTEM FILE SEARCH. 0313 0000 XFILE, BLOCK 2 0314 0000 0315 1313 TAD XFILE /SET UP PARAMETER FETCH 0316 3203 DCA GTCDF1 0317 1313 TAD XFILE /SET UP THE RETURN 0320 3267 DCA WTAPE 0321 1314 TAD XFILE# 0322 3270 DCA WTAPE# 0323 3265 DCA IER /ZERO THE ERROR FLAG 0324 4202 JMS GETARG /GET THE UNIT NUMBER 0325 0377 AND (1 /MUST BE 0 OR 1 0326 7110 CLL RAR 0327 1266 TAD HANDTD /SET ENTRY ADDRESS 0330 7430 SZL 0331 1376 TAD (5 0332 3201 DCA HANDT 0333 4202 JMS GETARG /NEXT SET UP THE SCRATCH BUFF 0334 7200 CLA 0335 1212 TAD GTCDF2 /GET THE DATA FIELD 0336 0374 AND (70 0337 1373 TAD (200 0340 3257 DCA ARG1 0341 1212 TAD GTCDF2 /SET UP BUFFER DATA FIELD 0342 6201 05 LABL1, DCA GIMDF /FOR GIMME ROUTINE 0343 3772 0344 1200 TAD ARGAD /THEN THE ADDRESS ITSELF 0345 3260 DCA ARG2 0346 4202 JMS GETARG /SET UP NAME ADDRESS 0347 7200 CLA 0350 1212 TAD GTCDF2 0351 6201 05 LABL2, DCA SLCDF 0352 3771 / NOW READ IN THE DIRECTORY AND SEARCH. 0353 7307 CLA CLL IAC RTL 0354 3261 DCA ARG3 /DIRECT IN BLOCK FOUR 0355 4253 JMS RDIT /READ IN THE FIRST BLOCK 0356 5770 JMP STRTP / PASS BACK A PARAMETER 0357 0000 PTEM, 0 0360 0000 PASIT, 0 0361 3357 DCA PTEM /SAVE THE VALUE 0362 4202 JMS GETARG /SET UP ADDRESS AND FIELD 0363 7200 CLA 0364 1357 TAD PTEM 0365 3600 DCAI ARGAD /PASS IT BACK 0366 5760 JMP I PASIT /EXIT 0370 0400 01 0371 0440 01 0372 0521 01 0373 0200 0374 0070 0375 3700 0376 0005 0377 0001 PAGE / DO THE SEARCHING 0400 4045 STRTP, TAD ARG2 /SET UP BUFFER POINTER 0401 7410 0402 1777 0403 1376 TAD (200 /SECOND HALF OF BUFFER 0404 3313 DCA XDAD 0405 1375 TAD (-200 0406 3310 DCA XRDCT 0407 7201 CLA IAC /GET THE FILE COUNT 0410 4316 JMS GIMME 0411 1374 TAD (-1 /DOCTOR IT UP. 0412 3311 DCA XFCT 0413 4316 JMS GIMME /AND THE NEXT FREE BLOCK 0414 3312 DCA XLFRE 0415 4316 JMS GIMME /SET TO FIRST NAME / OK GANG START THE SEARCH. 0416 7346 XLOOP, CLA CLL CMA RTL /MATCH THREE WORDS 0417 3307 DCA XFSR1 0420 6201 05 TAD ARGAD 0421 1773 0422 3306 DCA XFSR2 0423 4316 SLOOP, JMS GIMME /GET THE DIRECTORY ENTRY 0424 3316 DCA GIMME 0425 1316 TAD GIMME 0426 7450 SNA /IF THE NAME IS ZERO 0427 5236 JMP IN4040 /INSERT 4040 (BLANKS) 0430 0372 AND (77 0431 7650 SNA CLA /INSERT 40 IN LOWER HALF IF 0 0432 1371 TAD (40 0433 1316 TAD GIMME 0434 7041 CIA 0435 5240 JMP SLCDF /NOW COMPARE 0436 7200 IN4040, CLA 0437 1370 TAD (-4040 0440 7402 SLCDF, HLT 0441 1706 TADI XFSR2 /COMPARE IT WITH THE NAME 0442 7640 SZA CLA /DOES IT MATCH? 0443 5272 JMP XNOF /NO. 0444 2306 INC XFSR2 /YES. UPDATE NAME POINTER 0445 2307 ISZ XFSR1 /THREE WORDS YET? 0446 5223 JMP SLOOP /NO. CHECK THE REST. / FOUND IT.... 0447 4316 JMS GIMME /GET THE START BLOCK 0450 4767 JMS PASIT /PASS IT BACK 0451 2311 ISZ XFCT /CHECK WHETHER LAST ENTRY 0452 5264 JMP XNRM /IS A NORMAL ENTEY 0453 1312 TAD XLFRE /GET THE START BLOCK 0454 7041 XDNOB, CIA 0455 6201 05 TAD PTEM /COMPUTE # OF BLOCKS 0456 1766 0457 7041 CIA 0460 4767 JMS PASIT /PASS IT BACK 0461 6201 05 LABL3, TAD IER 0462 1765 0463 5303 JMP EGGSIT /AND RETURN 0464 4316 XNRM, JMS GIMME /GET START BLOCK OF 0465 7640 SZA CLA 0466 5264 JMP XNRM /NEXT ENTRY 0467 7125 CLL CML IAC RAL 0470 4316 JMS GIMME 0471 5254 JMP XDNOB / ENTRY NOT THE ONE SO GO ON TO THE NEXT 0472 7305 XNOF, CLA CLL IAC RAL /SKIP PAST NAME(HAS 0'S) 0473 4316 JMS GIMME /SKIP TO THE END OF ENTRY 0474 7640 SZA CLA 0475 5273 JMP XNOF# 0476 2311 ISZ XFCT /CHECK NUMBER OF ENTRIES 0477 5216 JMP XLOOP /DONE ALREADY. 0500 4767 JMS PASIT /NO MATCH SO PASS ZERO VALUES 0501 4767 JMS PASIT 0502 7201 CLA IAC /ALL SEARCHED AND NO MATCH / MAIN EXIT FUNNEL. 0503 4767 EGGSIT, JMS PASIT /PASS BACK THE ERROR FLAG 0504 4040 RETRN WTAPE 0505 0002 06 0506 0000 XFSR2, 0 0507 0000 XFSR1, 0 0510 0000 XRDCT, 0 0511 0000 XFCT, 0 /# OF FILES IN THE DIRECTORY 0512 0000 XLFRE, 0 /NEXT FREE BLOCK 0513 0000 XDAD, 0 /DATA BUFFER CURRENT POINTER /GET THE NEXT WORD IN THE DIRECTORY. 0514 0000 GMTM1, 0 0515 0000 GIMTM, 0 0516 0000 GIMME, 0 0517 7040 CMA /SAVE THE SKIP COUNT 0520 3315 DCA GIMTM 0521 7402 GIMDF, HLT /REPLACED BY A CDF 0522 1713 TADI XDAD /GET THE NEXT WORD 0523 3314 DCA GMTM1 /SAVE IT FOR NOW 0524 2313 INC XDAD /BUMP A FEW POINTERS 0525 2310 ISZ XRDCT /OUT OF THIS BUFFER YET? 0526 5336 JMP GIMOK /NO. 0527 6201 05 ISZ ARG3 /YES. SO READ THE NEXT BLOCK 0530 2764 0531 4763 JMS RDIT 0532 1777 TAD ARG2 /RESET THE POINTERS 0533 3313 DCA XDAD 0534 1362 TAD (-400 0535 3310 DCA XRDCT 0536 2315 GIMOK, ISZ GIMTM /ARE WE SKIPPIPN WORDS? 0537 5321 JMP GIMDF /YES SO GET ANOTHER 0540 1314 TAD GMTM1 /NO. PASS THE VALUE 0541 6201 05 GIMEX, JMP I GIMME /THATS ALL. 0542 5716 0562 7400 0563 0253 01 0564 0261 01 0565 0265 01 0566 0357 01 0567 0360 01 0570 3740 0571 0040 0572 0077 0573 0200 01 0574 7777 0575 7600 0576 0200 0577 0260 01 END