C PROGRAM MTATOBM.FT C -------------- C C C SUBROUTINE MTATOBM(LMEM,LIBYTE,LKINFILE,UNIT,IHEADER) C C C C P.LEMKIN C NATIONAL INSTUTUTES OF HEALTH C BETHESDA, MD 20014 C C C C MAY 27, 1977 C MAY 16, 1977 C MAY 3, 1977 C C C PURPOSE C -------- C AUXILLARY ROUTINES PACK, RDHEADER C MSEARCH, RDFILE. C FOR MAG10. C C COMPILE AS: C ----------- C .COMP MTATOBM.RL < MTATOBM.FT C C S OPDEF SWBA 7447 S OPDEF SWAB 7431 S OPDEF DAD 7443 S OPDEF DST 7445 S OPDEF DMAGO 6070 S SKPDF DMASKP 6071 S OPDEF DMAWC 6072 S OPDEF DMACA 6073 S OPDEF DMACLR 6074 S OPDEF EXDMA1 6524 S OPDEF EXDMA2 6525 C C C S OPDEF DISP1 6435 S OPDEF DISP2 6436 S OPDEF CLAMQ 7621 S OPDEF MQL 7421 S OPDEF MQA 7501 S OPDEF BSW 7002 S OPDEF TADI 1400 S OPDEF DCAI 3400 C C C C COMMON IBUF1 DIMENSION IBUF1(256) C DIMENSION KINFILE(4) DIMENSION JFILE(4) C *************************** P A R A M E T E R S ********* GOTO 1 S DUMMY OS8DATE S CPAGE 2 S OS8DATE, 6211 S 7666 S DUMMY MAGBUFFER S CPAGE 2 S MAGBUFFER, 6251 / CDF 50 S 0 C S DUMMY BMBUFFER S CPAGE 2 S BMBUFFER, 6261 /CDF 60 S 0 C S DUMMY DV S CPAGE 2 S DV, BLOCK 2 C 1 CONTINUE C C ********************************************************* C [0] INIT MEM=LMEM IBYTE=LIBYTE DO 2 I=1,4 KINFILE(I)=LKINFILE S INC \LKINFILE# 2 CONTINUE C C DEFINE THE RECORD SIZE AST 3456 BYTES MWDCT=2000+1456 C DEFINE THE UNIT # IUNIT=0 S INC \UNIT# S TAD I \UNIT S AND (0003 S DCA \IUNIT C C DEFINE THE TAPE AS 9 TRACTK 800 BPI MODE C C C [1] SETUP RDFILE CALL CALL RDFILE RETURN C IYEAR=0 IDAY=0 IMONTH=0 IDATE=0 JBLKCNT=0 C ************************************************* C * SUBROUTINE P A C K C ************************************************* C PACK 3/2 MAGBUFFER ==> BMBUFFER S ENTRY PACK S CPAGE 2 S PACK, BLOCK 2 C C [1] 3/2 PACK (I.E. 3 BYTES INTO 2 PDP8E WORDS) 3456 BYTES C INTO 9 BLOCKS. NOTE 9 OS8 BLOCKS=256X9=2304 PDP8E WORDS C OR (3/2)*2304=3456 BYTES = 768 PDP10 WORDS OR C 1152 3-BYTE TRIPLES. C C C [1.1] SETUP AUTO INDEX REG 15 IS MAG, 16 IS DSK. S CLA CMA S DCA 15 S CLA CMA S DCA 16 S TAD (-D1152 /FAST COUNTER S DCA 7 C C C [2] LOOP AND CVT S CPAGE 15 S PK2, 6251 /CDF 50 TO MAGBUFFER S TADI 15 /B1 S AND (377 /STRIP OFF PARITY BIT S DCA 20 S TADI 15 /B2 S AND (377 /STRIP OFF PARITY BIT S DCA 21 S TADI 15 S DCA 22 /B3 C C [2.1] NOW PACK INTO 2 WORDS S TAD 22 /GET B3[4:7] S RTR; RTR; RAR /MOVE BITES 8:11 AC, TO 0:3 S AND (7400 /0:3 BITS S TAD 21 /B2 S MQL /B3[4:7]&B2 S TAD 22 /GET B3[0:3] S RTL; RTL /MOVE AC 4:7 TO 0:3 S AND (7400 S TAD 20 /B1 C C(AC)=B3[0:3]&B1. C C C [2.2] PUSH 2 WORDS INTO BMBUFFER S CPAGE 11 S 6261 /CDF 60 TO BMBUFFER S DCAI 16 S MQA S DCAI 16 S JMS 45 S CLA S ISZ 7 /TEST IF DONE S JMP PK2 /NO, CONTINUE C C [3] RETURN S CPAGE 3 S JMS 45 S CLA S RETRN PACK /RETURN C ************************************************* C * SUBROUTINE R D H E A D E R C ************************************************* C READ THE MAGTAPE HEADER CONSISTING OF THE 4 TUPLE: C JFILE(1:3) - FILE NAME (6 BYTES) C JFILE(4) - FILE EXTENSION (2 BYTES) C JBLKCNT - FILE LENGTH IN OS/8 BLOCKS (2 BYTES HI,LOW) C IDATE - OS/8 DATE WORD ( 1 BYTE) S ENTRY RDHEA S CPAGE 2 S RDHEA, BLOCK 2 C C C C [1] READ IN THE RECORD OF 3456 BYTES, FROM MAGBUFFER C BYTE MODE C IPARITY=-50 C C TEST FOR PARITY OVERFLOW S \302, ISZ \IPARITY S JMP \310 /CONTINUE C DO 1306 IDEV=1,3,2 1306 WRITE(IDEV,306) 306 FORMAT(' PARITY ERR HEADER') C FATAL EXIT CALL CHAIN('BMON2') C 310 KBYTMODE=0 C COPY BUFFER POINTER S TAD MAGBUFFER S DCA AM1 S TAD MAGBUFFER# S DCA AM1# C S CPAGE 16 S CALL 6,MAGTA S ARG \MWDCT S AM1, ARG MAGBUFFER S ARG (2 /READ S ARG \MTRS S ARG \KBYTMODE S ARG \IUNIT C C RETURN IMMEDIATELY IF EOF S TAD \MTRS S AND (0100 S SNA CLA S JMP \311 /OK C C !!! LOGICAL EOT! !!! DO 1340 IDEV=1,3,2 1340 WRITE(IDEV,1341) 1341 FORMAT(' LOGICAL EOT FOUND, REWINDING!') CALL MAGTAP(0,0,1,MTRS,0,IUNIT) CALL CHAIN('BMON2') C C C [1.1] TEST FOR EOT AND PARITY ERRORS S \311, TAD \MTRS S AND (0040 /EOT? S SZA CLA S JMP \320 /FATAL EOT C S TAD \MTRS / PARITY? S AND (1616 S SNA CLA S JMP \301 /OK C CALL MAGTAP(1,0,7,MTRS,KBYTMODE,IUNIT) GOTO 302 C C C [1.2] FATAL EOT ERROR 320 DO 1320 IDEV=1,3,2 1320 WRITE(IDEV,321) 321 FORMAT(' EOT FOUND.') C C REWIND THE UNIT AND TAKE FATAL EXIT. CALL MAGTAP(0,0,1,MTRS,KBYTMODE,IUNIT) CALL CHAIN('BMON2') C C [2] CVT 8 BIT TO 6 BIT 301 CONTINUE S CLA CMA /-1 S DCA 15 /MAGBUFFER PTR DO 300 I=1,4 S CPAGE 10 S 6251 /CDF 50 MAGBUFFER S TADI 15 /GET 1ST BYTE S DCA 20 S TADI 15 /GET 2ND BYTE S DCA 21 S JMS 45 S NOP C C MAKE IT 6 BIT AND PACK IT S TAD 20 S RTL; RTL; RTL S AND (7700 S MQL S TAD 21 S AND (0077 S MQA S DCA \J1 300 JFILE(I)=J1 C [3] GET THE BLOCK COUNT AND OS8 DATE S CPAGE 15 S 6251 /CDF 50 MAGBUFFER S TADI 15 /GET HIGH BLOCK COUNT S DCA 20 S TADI 15 /GET LOW BLOCK COUNT S DCA 21 S TADI 15 /GET YEAR S DCA 22 S TADI 15 /GET MONTH S DCA 23 S TADI 15 /GET DAY S DCA 24 S JMS 45 S CLA C C [3.1] COMPUTE BLOCK COUNT AND SAVE IT S TAD 20 S RTL; RTL; RTL; RTL S AND (7400 S DCA 20 /SAVE IT S TAD 21 S AND (377 S TAD 20 S DCA \JBLKCNT C C C [3.2] COMPUTE PACKED DATE S TAD 22 S AND (7 S DCA \IYEAR S TAD 23 S AND (17 S DCA \IMONTH S TAD 24 S AND (37 S DCA \IDAY C S TAD \IDAY S CLL RAL; RTL S MQL S TAD \IMONTH S CLL RAR; RTR; RTR S MQA S TAD \IYEAR S DCA \IDATE C C C [4] RETURN S RETRN RDHEA /RETURN C C ************************************************* C * SUBROUTINE M S E A R C H C ************************************************* C SEARCH HEADER BLOCKS FOR C FILE SPECIFIED IN KINFILE(1:4) LEAVING THE TAPE C POSITIONED AT THE FRONT OF THE FILE. C IF THE SEARCH FAILS, THEN MSFLAG=0 ELSE MSFLAG=1. S ENTRY MSEAR S CPAGE 2 S MSEAR, BLOCK 2 C C C C [1] INIT THE SEARCH BYZEROING SWITCH. MSFLAG=0 C C [2] READ HEADER. IF EOF THEN DONE ELSE TEST FOR MATCH. C NOTE: HEADER FILENAME IN JFILE[1:4] 510 CALL RDHEADER C C NOW TEST FOR EOF THEN RETURN WITH FALSE (0). S TAD \MTRS /GET STATUS REGISTER S AND (0100 /EOF? S SNA CLA S JMP \500 /NOT EOF C C IT WAS EOF, SO RETURN WITH FAILURE. (MSFLAG=0) S \550, RETRN MSEAR C C [2.1] OK, NOW TEST IF JFILE=KINFILE. C IF KINFILE=NULL THEN ALWAYS ACCEPT IT. 500 IF (KINFILE) 502,501,502 502 IF (MATCH(KINFILE,JFILE) )501,511,501 C C C [2.2] YES, FOUND A MATCH, BACKSPACE DRIVE 1 RECORD AND C RETURN TRUE 501 MSFLAG=1 CALL MAGTAP(1,0,7,MTRS,0,IUNIT) S RETRN MSEAR C C [2.3] NO MATCH, GO LOOK FOR NEXT EOF. 511 CALL MAGTAP(1,0,6,MTRS,0,IUNIT) S TAD \MTRS S AND (0040 /EOT S SZA CLA S JMP \550 /FAILED C S TAD \MTRS S AND (0100 /EOF S SNA CLA S JMP \511 /NOT YET, READ NEXT RECORD SEARCHING FOR EOF C C C [2.4] OK, FOUND EOF. NOW CHECK NEXT HEADER GOTO 510 C ************************************************* C * SUBROUTINE R D F I L E C ************************************************* C READ THE NEXT MAGTAPE FILE INTO C OS8 FILE "KDEVOUT:KOUTFILE[1:4]". C I.E. *DSK: <== MTA: C C IF NO TRANSFER WAS POSSIBLE (I.E. SEARCH FAILED) THEN C RETURN WITH MFLAG=0 ELSE MFLAG=1. C C C SUBROUTINE RDFILE SEARCHES THE MTA: HEADERS FOR A FILE THAT C MATCHES THE USER INPUT FILE SPEC (SEE MAG10.FT COMMENTS) C FOR WHICH THERE ARE 2 CASES: C 1. NULL SPEC==>TAKE NEXT MTA: FILE IF EXISTS C 2. F.E, *.E, F.*, *.*==> EXACT MATCH. SEARCH C UNTIL FIND A MATCH OR FAIL. C C WHEN THE MATCHING FILE IS FOUND, TRANSFER IT FROM THE OUTPUT C UNIT USING A FILE NAME DERIVED FROM EITHER: C 1. THE USER SUPPLIED OUTPUT FILE NAME IF NON-NULL C OR C 2. THE NAME READ FROM THE MTA: HEADER RECORD. C C S ENTRY RDFIL S CPAGE 2 S RDFIL, BLOCK 2 C C C [1] INIT COUNTERS AND POINTERS, THEN ENTER OUTPUT FILE IRECORD=0 IPARERR=0 IPARFIX=0 MFLAG=0 C C [1.1] SEARCH AND TEST IF SUCCEED 600 CALL MSEARCH IF (MSFLAG) 603,601,603 S \601, RETRN RDFIL C C C [1.2] CHECK WHETHER OUTPUT FILE NAME SPECIFIED. C READ THE HEADER C IF NONE WAS SPECIFIED, THEN USE THE C FILE NAME IN THE MTA HEADER RECORD. C SET THE FLAG TO TRUE. 603 MFLAG=1 CALL RDHEADER C C COPY THE FILE SIZE IN BLOCKS FROM THE HEADER IBLKCNT=JBLKCNT C C C C [1.3] OK, PRINT FILE NAME 609 DO 1609 IDEV=1,3,2 S TAD (4040 S DCA \IHSYM S TAD \IBYTE S SNA CLA S JMP \1609 /LOW S TAD (1040 /"H " S DCA \IHSYM C 1609 WRITE(IDEV,610)JFILE,MEM,IHSYM 610 FORMAT(' R: ',3A2,'.',A2,' ==> BM',I1,A1) C C C C [2] READ 1 RECORD FROM MTA: C READ 1 RECORD==>MAGBUFFER C RESET MAXIMUM NUMBER OF RETRYS ON A PARITY ERROR 620 IPARITY=-50 C DECREMENT THE NUMBER-OF-BLOCKS-LEFT COUNTER IBLKCNT=IBLKCNT-9 C C COMPUTE THE # BLOCKS TO WRITE ON DSK: IF(IBLKCNT)621,621,622 C <9 BLOCKS 621 IBN=IBLKCNT+9 GOTO 623 C .GE. 9 BLOCKS 622 IBN=9 623 CONTINUE C C INCREMENT THE RECORD COUNTER IRECORD=IRECORD+1 S TAD \IRECORD S DISP1 S CLA /PUT RECORD NUMBER IN THE RQC DISPLAY REGISTER C C C [2.1] READ MTA: RECORD AND CHECK FOR ERRORS C DO AS SABR CODE SO CAN GET AT MAGBUFFER PTR S CPAGE 16 C COPY BUFFER POINTER S \630, TAD MAGBUFFER S DCA AM2 S TAD MAGBUFFER# S DCA AM2# C S CALL 6,MAGTA S ARG \MWDCT /WORD COUNT S AM2, ARG MAGBUFFER S ARG (2 S ARG \MTRS S ARG \KBYTMODE S ARG \IUNIT C C TEST FOR END OF TAPE (EOT) ERROR S TAD \MTRS S AND (0040 S SZA CLA S JMP \670 /FATAL - PRINT MSG, REWIND AND GIVE UP C C TEST FOR EOF S TAD \MTRS S AND (0100 S SZA CLA S JMP \640 /PREMATURE EOF C S TAD \MTRS S AND (1616 /TST FOR PARITY ERRORS S SNA CLA S JMP \650 /NO ERROR, GO WRITE DATA ONTO DSK: C C C [2.1.1] NOTE ERRROR AND BACKSPACE THE DRIVE S ISZ \IPARITY /SEE IF > 50 TRYS S SKP /NOPE, CONTINUE TRYING S JMP \635 /YES, FATAL ERROR CALL MAGTAP(1,0,7,MTRS,0,IUNIT) C TRY AGAIN GOTO 630 C C C [2.1.2] FATAL PARITY ERROR 635 DO 1635 IDEV=1,3,2 1635 WRITE(IDEV,636) 636 FORMAT(' READ PARITY ERR.') IPARERR=IPARERR+1 C JUST CONTINUE ANYWAY AND SALVAGE WHAT WE CAN... C C [2.1.3] PREMATURE END OF FILE REACHED 640 DO 1640 IDEV=1,3,2 1640 WRITE(IDEV,641) 641 FORMAT(' READ PREMATURE EOF.') C BACKSPACE TO IN FRONT OF EOF AND RETURN CALL MAGTAP(1,0,7,MTRS,0,IUNIT) IBLKCNT=0 C FORCE IT TO RETURN C C [2.2] WRITE IBN BLOCKS==>BMBUFFER C PACK MAGBUFFER TO 3/2 FORMAT BMBUFFER 650 CALL PACK C C [2.3] TEST IF FIXED PARITY ERROR C IF FIXED ERROR (-50 < IPARITY < 0) S TAD \IPARITY S SNA CLA S JMP \659 /FATAL PARITY C S TAD \IPARITY S TAD (D50 S SZA CLA S INC \IPARFIX /YES S CLA C C [2.4] COPY BMBUFFER TO BM CALL PUTBM C C C [2.5] TEST IF DONE. C IF DONE THEN RETURN ELSE GOTO [2]. 660 IF(IBLKCNT)662,662,620 C C C [2.5.1] FATAL PARITY 659 IPARERR=1 C C C [2.5.2] TEST IF PRINT OUT THE PARITY ERRORS 662 IF(IPARERR+IPARFIX)666,665,666 666 DO 1666 IDEV=1,3,2 1666 WRITE(IDEV,667)IPARERR,IPARFIX 667 FORMAT(I5,' NON-RECOV., ',I5,' RECOV. PARITY ERRORS.') C C C [2.5.3] MOVE PAST EOF ON MTA: AND VERIFY ITS EXISTANCE. C WE ARE NOT POSITIONED AT THE START OF THE NEXT HEADER OR EOF. 665 CALL MAGTAP(1,0,6,MTRS,KBYTMODE,IUNIT) S TAD \MTRS S AND (0100 /EOF S SNA CLA S JMP \668 /NO EOF, ERROR MFLAG=1 S RETRN RDFIL /NORMAL RETURN C C MISSING EOF ERROR 668 DO 1668 IDEV=1,3,2 1668 WRITE(IDEV,669) 669 FORMAT(' NO EOF AT LOGICAL EOF.) CALL CHAIN('BMON2') C C C [3] EOT FOUND WHILE READING 670 DO 1670 IDEV=1,3,2 1670 WRITE(IDEV,671) KOUTFILE 671 FORMAT(' EOTFOUND.') CALL CHAIN('BMON2') C C C **************************************************** C *SUBROUTINE P U T B M B U F C **************************************************** C IF IBLKCNT=173-9 C THEN BMBUFFER==>IHEADER[1:256]&8 BM BLOCKS C ELSE BMBUFFER==>NEXT 9 BM BLOCKS; C S ENTRY PUTBM S CPAGE 2 S PUTBM, BLOCK 2 C C [GB.0] IF (IBLKCNT-164)820,801,820 C C C [GB.1] BMBUFFER==>IHEADER[1:256]&8 BM BLOCKS S\801, TAD BMBUFFER /COPY PTR S DCA DV S TAD BMBUFFER# S DCA DV# C DO 802 I=1,256 S TAD I DV /BMBUFFER[I] S DCA \IZ IHEADER=IZ S INC \IHEADER# S INC DV# 802 CONTINUE C C C SETUP BMBUFFER FOR READING 8 RATHER THAN 9 BLOCKS IFIRST=-384 S TAD (D256 S DCA BMBUFFER# C C SETUP THE DMA CONTROL WORD IBMCTL=0000 C C TEST IF HIGH BYTE S TAD \IBYTE S SZA CLA S TAD (0200 /HIGH 8-BITS S TAD (0200 /LOW 8-BITS S DCA \IBMCTL C C SETUP THE DATA FIELD FOR BUFFER S TAD BMBUFFER /DATA FIELD FOR BUFFER S AND (0070 S TAD \IBMCTL S DCA \IBMCTL C C C SETUP THE BM ADDRESS S TAD \MEM /SET BY XMITBM C THE BM# IS SPECIFIED IN BITS [5:7] OF THE HIGH ORDER ADDRESS S RTL; RTL S AND (0160 S DCA DV# /LOAD HIGH ORDER S DCA DV /SET LOW ORDER TO ZERO. C C C [GB.2] READ BM DATA INTO BMBUFFER 820 CONTINUE S DMACLR /CLEAR THE CHANNEL AND ADDRESSES S TAD BMBUFFER# S DMACA S TAD (4400 /'400*9 S DMAWC C C SETUP THE CURRENT ADDRESS FOR BM DMA S TAD DV# S EXDMA1 /LOAD HIGH ADDRESS S TAD DV S EXDMA2 /LOAD LOW ADDRESS C C COMPUTE FUTURE BM DMA ADDRESS (NOTE: 8-BITS=(3/2)12-BITS): C DV_DV+(3/2)*256*9 [ I.E. 3456] S TAD \IFIRST /-384 IF FIRST WRITE S TAD (6600 /384*9=3456=(256*9+128*9) S SWAB /MODE B AND MQL C S CPAGE 4 S DAD S DV C S DST S DV C S CLAMQ S SWBA C C LOAD THE "PUT" GO WORD AND GO C NOTE: R/W BIT IS 1 FOR WRITE S TAD (4000 /WRITE BIT S TAD \IBMCTL /I/O CONTROL WORD S DMAGO S DMAPUT, DMASKP S JMP DMAPUT /NOT YET C C RESET BM BUFFER PTR S DCA BMBUFFER# C IFIRST=0 S RETRN PUTBM C C END C C END