Directory of image this file is from
This file as a plain text file
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