ASMB,R,L,C * NAME: SAVE * SOURCE: 92067-18335 * RELOC: 92067-16335 * PGMR: S.P.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * NAM SAVE,3,99 92067-16335 REV.2013 790620 * DISC TO MAG TAPE DATA TRANSFER EXT DMT,RMPAR,COR.A,EXEC,BUFER,ITASK SAVE JSB RMPAR GET PARAMETERS DEF *+2 DEF IP CLA STA ITASK TASK=0 FOR SAVE JSB BUFER ROUTINE TO FIND FWA IN FREE MEM OF PARTITION DEF FWA AND TO DETERMINE # OF WORDS IN AVMEM DEF PLEN DEF BFLEN # OF WORDS IN AVMEM * LDA FWA INA STA ITR SET UP VERIABLE FOR TRACK # INA STA JB ADDRESS FOR READ BUFFER JSB DMT GO TO MAIN DISC TO MAG TAPE ROUTINE DEF *+8 DEF FWA,I ADDR OF WRITE BUFFER - KB DEF JB,I ADDR OF READ BUFFER - JB DEF PLEN LENGTH OF PPARTITION DEF BFLEN # OF WORDS IN AVMEM DEF IP BUFFER WITH PARAMETERS DEF ITR,I ADDR OF TRACK # - ITR DEF FWA,I ADDR OF SUBCHNL # - ISUB JSB EXEC END OF SAVE PROGRAM DEF *+2 DEF D6 * A EQU 0 B EQU 1 IP BSS 5 ITR BSS 1 JB BSS 1 FWA BSS 1 PLEN BSS 1 BFLEN BSS 1 D6 DEC 6 END SAVE FTN4,L,C C NAME: DMT C SOURCE: 92067-18335 C RELOC: 92067-16335 C PGMR: S.P.K.,J.S.W. C C *************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C *************************************************************** C SUBROUTINE DMT (KB,JB,IPLEN,IBLEN,IP,ITR,ISUB X ),92067-16335 REV.2013 800103 DIMENSION IP(5),KB(1),JB(1),ILUTR(64),MSG(3), C IHDR(140),INAME(3),IREG(2),ICHAR2(2),ITITL(4) EXTERNAL MESG,MPFND,ASCDC,DCASC,SUB,CHDLU,TPPOS, C CHUTP,LUTRK,PRNTH,MEMGT,READU EQUIVALENCE (REG,IA,IREG),(IREG(2),IB),(INAME,NAME1), C (INAME(2),NAME2),(INAME(3),NAME3),(IHDR(37),ITAPE), C (IHDR(39),ITPSV),(IHDR(40),LU2),(IHDR(42),IREC), C (IHDR(43),ITB30) DATA ITITL/2HFI,2HLE,2H I,2HD?/,IHDR(41)/0/, C ISIGN/100000B/,IVERFY/0/,IQUES/2H??/ CALL EXEC (22,3) ITLU=IP CALL MEMGT (1653B,LUMAX) IF(ITLU.GT.64) GO TO 920 IF ((ITLU.LE.0).OR.(ITLU.GT.LUMAX)) GO TO 920 INT=IFTTY(ITLU) IF(INT.EQ.0) GO TO 920 LP=IP(2) IMLU=IP(4) IF(IMLU.GE.64) GO TO 580 IDTYP=IP(5) C IDISK=IDTYP C C IF (IBLEN.LT.2050) GO TO 770 IF (IPLEN.EQ.-1) CALL MESG (ITLU,27) IF (IBLEN.LT.6146) GO TO 5 C C C IF(LP.NEQ.0) GO TO 2 LU=IP(3) IDISK=7905 IF(LU.NEQ.2.AND.LU.NEQ.3) REG=EXEC(1,LU,MXSEC,1,-1,0) IF(LU.EQ.2) CALL MEMGT(1757B,MXSEC) IF(LU.EQ.3) CALL MEMGT(1760B,MXSEC) IF(MXSEC.EQ.128)IDISK=7925 C 2 IF(IBLEN.LT.8194.AND.IDISK.EQ.7925) GO TO 5 C C IF (IPLEN.EQ.0) CALL MESG (ITLU,3) CALL MESG (ITLU,2) CALL READU (ITLU,IYES,1) IF (IYES.NEQ.2HYE) GO TO 5 ISIZE=6144 INCR=96 IF(IDISK.EQ.7925) ISIZE=8192 IF(IDISK.EQ.7925) INCR=128 C C IREC=1 IF (IPLEN.EQ.1) GO TO 8 GO TO 9 5 ISIZE=2048 INCR=32 IREC=0 IF (IPLEN.EQ.-1) GO TO 9 8 CALL MESG (ITLU,0) CALL READU (ITLU,IVERFY,1) C CHECK IF LOGICAL OR PHYSICAL COPY 9 IF (LP) 10,100,10 C CHECK IF PROPER UNIT # SPECIFIED FOR PHYSICAL COPY 10 IUNIT=IP(3) ITPSV=2 CALL CHUTP(ITLU,IUNIT,IDTYP) IDISK=IDTYP IF(IDTYP.EQ.7925) IDTYP=7905 IF(IDISK.EQ.7925.AND.ISIZE.EQ.6144) ISIZE=8192 IF(IDISK.EQ.7925.AND.INCR.EQ.96) INCR=128 GO TO 110 C LOGICAL COPY TO BE DONE C CHECK IF IDLU IS FOR DISC UNITS ONLY 100 IDLU=IP(3) ITPSV=1 CALL CHDLU(ITLU,IDLU,ISUB,IDTYP) IF(IDLU.NEQ.2.AND.IDLU.NEQ.3) REG=EXEC(1,IDLU,MXSEC,1,-1,0) IF(IDLU.EQ.2) CALL MEMGT(1757B,MXSEC) IF(IDLU.EQ.3) CALL MEMGT(1760B,MXSEC) IF(MXSEC.EQ.128.AND.ISIZE.EQ.6144) ISIZE=8192 IF(MXSEC.EQ.128.AND.INCR.EQ.96) INCR=128 IF(MXSEC.EQ.128) IDISK=7925 110 NAME3=2H1 IF (IDTYP.EQ.7905) NAME3=2H2 IF (IDTYP.EQ.7900) IDISK=7900 D WRITE(1,3333) IDTYP,IDISK D3333 FORMAT("TYP ",2I8) CALL MPFND(INAME,ITLU,IDTYP,ITB30,JB) IHDR(38)=IDISK IF (IDTYP.EQ.7905) GO TO 140 MPST=43 IF (ITB30.LT.0) MPST=44 GO TO 150 140 MPST=44 IF (IHDR(44).LT.0) MPST=45 C CHECK IF IMLU IS FOR MAG TAPE UNIT ONLY 150 IF ((IMLU.LT.0).OR.(IMLU.GT.LUMAX)) GO TO 580 IF (IMLU.EQ.0) IMLU=8 IF (IMLU.GT.64) GO TO 580 CALL EXEC (13+100000B,IMLU,IEQT5) GO TO 580 151 IF (IAND(IEQT5,37000B)-11000B) 580,155,580 C REQUEST A MAG TAPE LU LOCK W/OUT WAIT & NO-ABORT 155 CALL LURQ (140001B,IMLU,1) GO TO 158 156 CONTINUE 158 CALL ABREG(IA,IB) C C IF (IA.EQ.0) GO TO 160 C MT LU LOCK WAS NOT SUCCESSFUL, TELL USER CALL MESG (ITLU,25) C REQUEST MT LU LOCK WITH WAIT CALL LURQ (1,IMLU,1) C WRITE RING IN THE MAG TAPE? 160 REG=EXEC(3,600B+IMLU) IF (IAND(IA,4B).EQ.4B) GO TO 750 CALL EXEC (2,ITLU,ITITL,4) 165 DO 170 ITRY = 1,36 IHDR(ITRY)=2H 170 CONTINUE REG = EXEC (1,ITLU+400B,IHDR,36) IF (IB.NEQ.0) GO TO 180 CALL EXEC (2,ITLU,IQUES,1) GO TO 165 180 IF (LP.EQ.0) GO TO 250 C C BUILD LU-# OF TRACKS TABLE FOR SOURCE DISC USING TRACK MAP INFO C LUFLG=1 CALL LUTRK(ITLU,LIMIT,IUNIT,IDTYP,IHDR,MPST,ILUTR,LUFLG,IEQT) LU2=LUFLG GO TO 300 C BUILD ILUTR TABLE FOR LP=0 250 ILUTR=IDLU ILUTR(2)=IHDR(MPST+ISUB+8) IF (IDTYP.EQ.7905) ILUTR(2)=IHDR(MPST+ISUB*3+2) LIMIT=1 LU2=0 IF (IDLU.EQ.2) LU2=1 C POSITION TAPE TO DESIRED FILE # AND WRITE HEADER RECORD ON TAPE 300 IFILE=0 ITAPE=1 CALL TPPOS(ITLU,IMLU,IFILE,ITAPE) CALL EXEC(2,IMLU,IHDR,140) C LFLAG=0 DO 320 ILU=1,LIMIT,2 IDLU=ILUTR(ILU) CALL EXEC(13+100000B,IDLU,IEQT5) GO TO 319 317 GO TO 320 319 IF(LFLAG.EQ.0) CALL EXEC(2,ITLU, X 45HPLEASE DEFINE FOLLOWING LU(S) IN THIS SESSION,-45) C LFLAG=1 CALL CNUMD(IDLU,MSG) CALL EXEC(2,ITLU,MSG,-6) 320 CONTINUE IF(LFLAG.EQ.1) STOP 66 C C START DATA TRANSFER FROM DISC TO MAG TAPE USING ILUTR TABLE C DO 410 ILU=1,LIMIT,2 IDLU=ILUTR(ILU) ILT=ILUTR(ILU+1)-1 C C IF(IDLU.NEQ.2.AND.IDLU.NEQ.3) REG=EXEC(1,LU,MXSEC,1,-1,0) IF(IDLU.EQ.2) CALL MEMGT(1757B,MXSEC) IF(IDLU.EQ.3) CALL MEMGT(1760B,MXSEC) MXSEC=MXSEC-1 C DO 400 ITR=0,ILT DO 390 ISEC=0,MXSEC,INCR CALL SUB (IDLU,ISUB) ITRY=1 335 CALL EXEC (1+100000B,IDLU,JB,ISIZE,ITR,ISEC) GO TO 3339 3336 CONTINUE CALL ABREG(IA,IB) 337 IF (IDTYP.EQ.7905) GO TO 340 IF (IAND(IA,10B)-10B) 350,345,350 340 IF (IAND(IA,20B).NEQ.20B) GO TO 350 345 ISUB=ISUB+ISIGN 350 REG=EXEC(3,600B+IMLU) 353 IF (IAND(IA,40B).EQ.40B) GO TO 650 354 ITRY=1 355 REG= EXEC (2,IMLU,KB,ISIZE+2) 390 CONTINUE 400 CONTINUE 410 CONTINUE 450 ENDFILE IMLU C C VERIFY WANTED? C IF (IVERFY.NEQ.2HYE) GO TO 500 C YES, PASS ILUTR TABLE TO SAM USING CLASS I/O CALL CALL EXEC(20,0,ILUTR,64,IDUMY,JDUMY,ICLAS) NAME1=2HVE NAME2=2HRF NAME3=2HY C POSITION MAG TAPE TO BEGINING OF FILE ON TAPE 1 IF (ITAPE.EQ.1) GO TO 470 JTAPE=ITAPE 460 CALL MESG (ITLU,24) CALL MESG (ITLU,11) REWIND IMLU PAUSE CALL TPPOS(ITLU,IMLU,IFILE,JTAPE) CALL PRNTH(ITLU,IMLU,KB) IF (KB.EQ.-1) GO TO 460 GO TO 480 470 CALL TPPOS(ITLU,IMLU,IFILE,ITAPE) CALL EXEC (1,IMLU,KB,140) C UNLOCK MAG TAPE LU 480 CALL LURQ (0,IMLU,1) C SCHEDULE VERFY PROGRAM WITH WAIT C IF(ISIZE.EQ.8192) IREC=2 IF(MXSEC.EQ.127.AND.ISIZE.NEQ.8192) IREC=-1 CALL EXEC (23,INAME,ITLU,ICLAS,LIMIT,IMLU,IREC) 500 REWIND IMLU STOP 580 CALL MESG (ITLU,8) CALL READU (ITLU,ICHAR,1) CALL ASCDC (ICHAR,1,IMLU) GO TO 150 650 CALL MESG (ITLU,12) CALL MESG (ITLU,11) REWIND IMLU CALL EXEC (7) ITAPE=ITAPE+1 677 CALL EXEC(3,600B+IMLU) CALL ABREG(IA,IB) D WRITE(1,9999) IA D9999 FORMAT("IA=",@8) IF(IAND(IA,4B).EQ.4B) GO TO 711 CALL EXEC (2,IMLU,IHDR,140) GO TO 354 C C 711 CALL MESG(ITLU,10) CALL MESG(ITLU,11) CALL EXEC(7) GO TO 677 680 CALL MESG (ITLU,13) CALL DCASC (ICHAR2,2,ITR) CALL EXEC (2,ITLU,ICHAR2,2) CALL DCASC(ICHAR,1,IDLU) CALL EXEC (2,ITLU,ICHAR,1) 695 CALL MESG (ITLU,14) STOP 750 CALL MESG(ITLU,10) CALL MESG (ITLU,11) CALL EXEC (7) GO TO 160 770 CALL MESG (ITLU,1) GO TO 695 920 CALL EXEC(2,1,18HILLEGAL CONSOLE LU,-18) STOP 3339 GO TO 3336 END END$