Directory of image this file is from
This file as a plain text file
/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 OPDEF DCAI 3400 OPDEF TADI 1400 OPDEF JMPI 5400 ENTRY RTAPE /READ TAPE ENTRY ENTRY WTAPE /WRITE TAPE ENTRY ENTRY XFILE /SEARCH XSYSTEM DIRECTORY /PARAMETER UNPACKING ROUTINE.... ARGAD, 0 HANDT, 0 GETARG, 0 /GETS NEXT ARGUMENT IN FORTRAN /GENERATED PARAMETER STRING GTCDF1, HLT /REPLACED BY CDF TADI WTAPE# /GET PARAM DATA FIELD DCA GTCDF2 INC WTAPE# /BUMP LIST ADDRESS TADI WTAPE# /GET PARAMETER ADDRESS DCA ARGAD /SAVE FOR INDIRECT (OR ARRAY) INC WTAPE# GTCDF2, HLT /REPLACED BY CDF TADI ARGAD /PASS VALUE IN ACC JMPI GETARG /EXIT QUIETLY.... /GENERAL DECODING AND PROCESSING (COMMON) DONE HERE. THEART, 0 JMS GETARG /GET THE UNIT NUMBER AND (1 /MUST BE 0 OR 1, SO.... CLL RAR /FORCE TO ZERO OR ONE. TAD HANDTD /COMPUTE THE ENTRY POINT TO /THE SYSTEM HANDLER ROUTINE. SZL /DTA0 OR DTA1....? TAD (5 DCA HANDT JMS GETARG /GET THE BLOCK NUMBER. SPA /IF NEGATIVE VALUED THEN SET ISZ ARG1 /FLAG IN THE FUNCTION WORD SPA /TO START THE SEARCH IN THE CIA /FORWARD DIRECTION. DCA ARG3 /BLOCK NUMBER = ARG3 JMS GETARG /GET THE NUMBER OF WORDS AND (3700 /CONVERT TO NUMBER OF BLOCKS CLL RAR TAD ARG1 /MASK INTO THE FUNCTION WORD DCA ARG1 JMS GETARG /FINALLY GET THE BUFFER CLA TAD GTCDF2 /MASK THE DATA FIELD INTO THE AND (0070 /FUNCTION WORD. TAD ARG1 DCA ARG1 TAD ARGAD /AND SET UP THE BUFFER ADDRESS DCA ARG2 DCA EROR JMS RDIT /DO THE DATA TRANSFER JMP I THEART /AND EXIT / NOW CALL THE SYSTEM HANDLER.... RDIT, 0 6202 /CHANGE TO FIELD 0 DOIT, JMS I HANDT ARG1, 0 /FUNCTION WORD ARG2, 0 /BUFFER ADDRESS ARG3, 0 /BLOCK NUMBER DCA EROR /ERROR EXIT JMP I RDIT /SEEMS RATHER PAINLESS.... IER, EROR, 0 HANDTD, 7607 / ENTRY POINT FOR WRITE FUNCTION (WTAPE) WTAPE, BLOCK 2 CLL CML RAR /SET WRITE FLAG WTPRS, DCA ARG1 /INTO FUNCTION WORD TAD WTAPE /SET UP DATA FIELD CHANGE DCA GTCDF1 /FOR GETTING PARAMETERS JMS THEART /GO DO IT.... JMS GETARG /PASS BACK ERROR STSTUS CLA TAD EROR DCAI ARGAD RETRN WTAPE / ENTRY POINT FOR READ FUNCTION (RTAPE) RTAPE, BLOCK 2 TAD RTAPE /MOVE CALLING SEQ TO WTAPE DCA WTAPE TAD RTAPE# DCA WTAPE# /ONLY DIFFERENCE IS THAT THE JMP WTPRS /FUNCTION FLAG IS FOR READ.
/ MAIN ENTRY FOR XSYSTEM FILE SEARCH. XFILE, BLOCK 2 TAD XFILE /SET UP PARAMETER FETCH DCA GTCDF1 TAD XFILE /SET UP THE RETURN DCA WTAPE TAD XFILE# DCA WTAPE# DCA IER /ZERO THE ERROR FLAG JMS GETARG /GET THE UNIT NUMBER AND (1 /MUST BE 0 OR 1 CLL RAR TAD HANDTD /SET ENTRY ADDRESS SZL TAD (5 DCA HANDT JMS GETARG /NEXT SET UP THE SCRATCH BUFF CLA TAD GTCDF2 /GET THE DATA FIELD AND (70 TAD (200 DCA ARG1 TAD GTCDF2 /SET UP BUFFER DATA FIELD LABL1, DCA GIMDF /FOR GIMME ROUTINE TAD ARGAD /THEN THE ADDRESS ITSELF DCA ARG2 JMS GETARG /SET UP NAME ADDRESS CLA TAD GTCDF2 LABL2, DCA SLCDF / NOW READ IN THE DIRECTORY AND SEARCH. CLA CLL IAC RTL DCA ARG3 /DIRECT IN BLOCK FOUR JMS RDIT /READ IN THE FIRST BLOCK JMP STRTP / PASS BACK A PARAMETER PTEM, 0 PASIT, 0 DCA PTEM /SAVE THE VALUE JMS GETARG /SET UP ADDRESS AND FIELD CLA TAD PTEM DCAI ARGAD /PASS IT BACK JMP I PASIT /EXIT PAGE
/ DO THE SEARCHING STRTP, TAD ARG2 /SET UP BUFFER POINTER TAD (200 /SECOND HALF OF BUFFER DCA XDAD TAD (-200 DCA XRDCT CLA IAC /GET THE FILE COUNT JMS GIMME TAD (-1 /DOCTOR IT UP. DCA XFCT JMS GIMME /AND THE NEXT FREE BLOCK DCA XLFRE JMS GIMME /SET TO FIRST NAME / OK GANG START THE SEARCH. XLOOP, CLA CLL CMA RTL /MATCH THREE WORDS DCA XFSR1 TAD ARGAD DCA XFSR2 SLOOP, JMS GIMME /GET THE DIRECTORY ENTRY DCA GIMME TAD GIMME SNA /IF THE NAME IS ZERO JMP IN4040 /INSERT 4040 (BLANKS) AND (77 SNA CLA /INSERT 40 IN LOWER HALF IF 0 TAD (40 TAD GIMME CIA JMP SLCDF /NOW COMPARE IN4040, CLA TAD (-4040 SLCDF, HLT TADI XFSR2 /COMPARE IT WITH THE NAME SZA CLA /DOES IT MATCH? JMP XNOF /NO. INC XFSR2 /YES. UPDATE NAME POINTER ISZ XFSR1 /THREE WORDS YET? JMP SLOOP /NO. CHECK THE REST. / FOUND IT.... JMS GIMME /GET THE START BLOCK JMS PASIT /PASS IT BACK ISZ XFCT /CHECK WHETHER LAST ENTRY JMP XNRM /IS A NORMAL ENTEY TAD XLFRE /GET THE START BLOCK XDNOB, CIA TAD PTEM /COMPUTE # OF BLOCKS CIA JMS PASIT /PASS IT BACK LABL3, TAD IER JMP EGGSIT /AND RETURN XNRM, JMS GIMME /GET START BLOCK OF SZA CLA JMP XNRM /NEXT ENTRY CLL CML IAC RAL JMS GIMME JMP XDNOB / ENTRY NOT THE ONE SO GO ON TO THE NEXT XNOF, CLA CLL IAC RAL /SKIP PAST NAME(HAS 0'S) JMS GIMME /SKIP TO THE END OF ENTRY SZA CLA JMP XNOF# ISZ XFCT /CHECK NUMBER OF ENTRIES JMP XLOOP /DONE ALREADY. JMS PASIT /NO MATCH SO PASS ZERO VALUES JMS PASIT CLA IAC /ALL SEARCHED AND NO MATCH / MAIN EXIT FUNNEL. EGGSIT, JMS PASIT /PASS BACK THE ERROR FLAG RETRN WTAPE XFSR2, 0 XFSR1, 0 XRDCT, 0 XFCT, 0 /# OF FILES IN THE DIRECTORY XLFRE, 0 /NEXT FREE BLOCK XDAD, 0 /DATA BUFFER CURRENT POINTER
/GET THE NEXT WORD IN THE DIRECTORY. GMTM1, 0 GIMTM, 0 GIMME, 0 CMA /SAVE THE SKIP COUNT DCA GIMTM GIMDF, HLT /REPLACED BY A CDF TADI XDAD /GET THE NEXT WORD DCA GMTM1 /SAVE IT FOR NOW INC XDAD /BUMP A FEW POINTERS ISZ XRDCT /OUT OF THIS BUFFER YET? JMP GIMOK /NO. ISZ ARG3 /YES. SO READ THE NEXT BLOCK JMS RDIT TAD ARG2 /RESET THE POINTERS DCA XDAD TAD (-400 DCA XRDCT GIMOK, ISZ GIMTM /ARE WE SKIPPIPN WORDS? JMP GIMDF /YES SO GET ANOTHER TAD GMTM1 /NO. PASS THE VALUE GIMEX, JMP I GIMME /THATS ALL. END