From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX"  4-AUG-1989 15:47
To:	MRGATE::"ARISIA::EVERHART"
Subj:	RE: Reading IBM tapes on VAX

Message-Id:  <8908041500.AA26183@crdgw1.ge.com>
Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Fri,  4 AUG 89 07:18:18 PDT
Received: from CUNYVM.CUNY.EDU by KL.SRI.COM with TCP; Fri, 4 Aug 89 06:56:25 PDT
Received: from NIHKLMB.BITNET by CUNYVM.CUNY.EDU (IBM VM SMTP R1.2.1MX) with BSMTP id 8777; Fri, 04 Aug 89 09:57:42 EDT
Date: Fri, 4 Aug 89 09:54 EDT
From: Gerson H Cohen <GHC%NIHKLMB.BITNET@CUNYVM.CUNY.EDU>
Subject: RE: Reading IBM tapes on VAX
To: greg@HMCVAX.BITNET, INFO-VAX@KL.SRI.COM
X-Vms-To: IN%"greg@hmcvax",GHC,INFO-VAX

Dear Greg -

You recently posted the following to info-vax:

> I need to read a bunch of tapes from an IBM 4341 (in various formats) on my
> VAX.  I have a program that seems to do the trick called MTEXCH, except that
> it does not support variable record lengths on the tape.  The version I have
> is rather old (V1.01, 1980).  Does anyone out there in netland have a newer
> version that they would be willing to send me?  Does anyone know of another
> utility that might do the job?  Please reply to me directly and I'll summarize
> to the net.  Thanks in advance...
>
>
> Greg Orman
> Systems Manager                                 GREG@HMCVAX.BITNET
> Seaver Academic Computing Services              greg@hmcvax.claremont.edu
> Pomona College

Some time ago (1982?), I submitted a tape handling package for the DECUS
symposium tape which does handle IBM VBS records (of that day), as well as FB.
The code is old and hasn't been touched but it still works.  It actually
derives from the very first program I wrote for our, then, new PDP 11/70
around 1975.  If you hack it up to something more useful, please let me have
your improved copy.  I will also post it to the full list in a 5-part series
under the name TAPE.   Part one is appended to this note.

Gerson Cohen

$! ------------- CUT AFTER THIS LINE ------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.1-002  17-JUl-1989
$!   On  4-AUG-1989 09:32:37.86   By user GHC
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$!+ THIS PACKAGE DISTRIBUTED IN 5 PARTS, TO KEEP EACH PART
$!  BELOW 30 BLOCKS
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. AAAREADME.TXT;2
$!       2. ASTEBC.FOR;8
$!       3. CARDIN.COM;12
$!       4. CARDIN.FOR;12
$!       5. CMPCARDIN.COM;1
$!       6. CMPSPOUT.COM;1
$!       7. EBTASC.FOR;9
$!       8. GETRATSIZ.MAR;19
$!       9. INITAP.TAP;7
$!      10. INIVBS.TAP;7
$!      11. INOTAP.TAP;7
$!      12. INOVBS.TAP;7
$!      13. IRD370.TAP;9
$!      14. IWR370.TAP;12
$!      15. MLTAPE.FOR;1
$!      16. NUMCON.MAR;2
$!      17. OUTTRM.TAP;6
$!      18. PROCNM.FOR;2
$!      19. RD370.TAP;12
$!      20. RDLBL.TAP;8
$!      21. RDVBS.TAP;8
$!      22. SPOUT.COM;5
$!      23. SPOUT.FOR;22
$!      24. TAPTRM.TAP;6
$!      25. WRT370.TAP;6
$!      26. WRTLBL.TAP;12
$!      27. WRTVBS.TAP;7
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ if f$getsyi("version") .ges. "4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$UNPACK: SUBROUTINE ! P1=filename, P2=checksum
$ if f$search(P1) .eqs. "" then $ goto file_absent
$ e "-W-EXISTS, File ''P1' exists. Skipped."
$ delete/nolog 'f'*
$ exit
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'."
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
$ delete/nolog 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");
buff:=CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(buff))
;LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(buff));g:=0;LOOP EXITIF MARK(NONE)=END_OF(buff);x:=
ERASE_CHARACTER(1);IF g = 0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x=
"V" THEN APPEND_LINE;MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;
IF x="+" THEN g:=1;ERASE_LINE;ENDIF;ELSE IF x="-" THEN g:=0;ENDIF;ERASE_LINE;
ENDIF;ENDLOOP;p:="`";POSITION(BEGINNING_OF(buff));LOOP r:=SEARCH(p,FORWARD);
EXITIF r=0;POSITION(r);ERASE(r);COPY_TEXT(ASCII(INT(ERASE_CHARACTER(3))));
ENDLOOP;o:=GET_INFO(COMMAND_LINE,"output_file");WRITE_FILE(buff,o);
ENDPROCEDURE;Unpacker;EXIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create/nolog 'f'
X                            Subdirectory - TAPE
X
X        This  subdirectory  contains  a   collection   of   tape   handling
X        subroutines  and  two  programs  which we use to read and write IBM
X        Standard Labelled or Unlabelled tapes, FB or VBS  type.   By  using
X        the  program MLTAPE as a template, it is possible to read and write
X        binary, VBS tapes as well.
X
X      o Programs:
X
X        CARDIN - This program reads ASCII or ECBDIC, FB or VBS, labelled or
X        unlabelled  IBM  type  tapes.   A tape is considered to have EBCDIC
X        codes if it is called labelled.  The program does  not  handle  IBM
X        style   ASCII   tapes   or   tape  labels.   We  install  a  symbol
X        CARDIN == "@CARDIN" to invoke the program via the command  file  of
X        the  similar  name.   Files  are transferred singly and the tape is
X        rewound after each transfer, a known  inconvenience  deriving  from
X        lack of forsight 6 years ago.
X
X        SPOUT - This program  writes  ASCII  or  ECBDIC,  FB,  labelled  or
X        unlabelled  IBM  type  tapes.   A tape is considered to have EBCDIC
X        codes  if  it  is   called   labelled.    We   install   a   symbol
X        SPOUT == "@SPOUT" to invoke the program via the command file of the
X        similar name.  Files may be strung  together  in  a  concattenation
X        into  a  single  output file on the tape.  Each file on the tape is
X        transferred singly and the tape is rewound after each  transfer,  a
X        known inconvenience deriving from lack of forsight 6 years ago.
X
X        The program MLTAPE may be used as a template  to  write  input  and
X        output  programs  for  IBM binary VBS tapes.  The subroutine NUMCON
X        contains the entry points for the  various  numerical  conversions.
X        The  source is not mine but I have had it for so long that I can no
X        longer remember to whom to attribute it.
$ CALL UNPACK AAAREADME.TXT;2 2083723466
$ create/nolog 'f'
X`009SUBROUTINE ASTEBC(N,ARRAY1,ARRAY2)
XCHANGES MADE 06-SEP-1980 ***
XC
XC`009TRANSLATE N BYTES OF ARRAY1 AND PLACE THEM IN ARRAY2.
XC
X`009BYTE ARRAY1(1),ARRAY2(1),ASCII(128)
X`009INTEGER*2 A1,A2,N
X`009DATA ASCII/
X`0091 ' 0'X,' 1'X,' 2'X,' 3'X,' 4'X,' 0'X,' 0'X,'4A'X,
X`0091 '16'X,' 0'X,' 0'X,' 0'X,' 0'X,' 0'X,' 0'X,' 0'X,
X`0091 ' 0'X,' 0'X,' 0'X,' 0'X,' 0'X,' 0'X,' 0'X,' 0'X,
X`0091 ' 0'X,' 0'X,' 0'X,' 0'X,' 0'X,' 0'X,' 0'X,' 0'X,
X`0091 '40'X,'5A'X,'7F'X,'7B'X,'5B'X,'6C'X,'50'X,'7D'X,
X`0091 '4D'X,'5D'X,'5C'X,'4E'X,'6B'X,'60'X,'4B'X,'61'X,
X`0091 'F0'X,'F1'X,'F2'X,'F3'X,'F4'X,'F5'X,'F6'X,'F7'X,
X`0091 'F8'X,'F9'X,'7A'X,'5E'X,'4C'X,'7E'X,'6E'X,'6F'X,
X`0091 '7C'X,'C1'X,'C2'X,'C3'X,'C4'X,'C5'X,'C6'X,'C7'X,
X`0091 'C8'X,'C9'X,'D1'X,'D2'X,'D3'X,'D4'X,'D5'X,'D6'X,
X`0091 'D7'X,'D8'X,'D9'X,'E2'X,'E3'X,'E4'X,'E5'X,'E6'X,
X`0091 'E7'X,'E8'X,'E9'X,'AD'X,'E0'X,'BD'X,'5F'X,'6D'X,
X`0091 '79'X,'81'X,'82'X,'83'X,'84'X,'85'X,'86'X,'87'X,
X`0091 '88'X,'89'X,'91'X,'92'X,'93'X,'94'X,'95'X,'96'X,
X`0091 '97'X,'98'X,'99'X,'A2'X,'A3'X,'A4'X,'A5'X,'A6'X,
X`0091 'A7'X,'A8'X,'A9'X,'8B'X,'4F'X,'9B'X,'A1'X,' 0'X/
X`009DO 10 I=1,N
X`009A1 = ARRAY1(I).AND."177
X`009A2 = ASCII(A1+1)
X`009ARRAY2(I) = A2
X10`009CONTINUE
X`009END
$ CALL UNPACK ASTEBC.FOR;8 1248662810
$ create/nolog 'f'
X$ SET NOVERIFY
X$ SET NOON
X$ ON CONTROL_Y THEN GOTO DISMOUNT
X$ INQUIRE M "Is tape already mounted with name TAPE (T/F)
X$ IF M THEN GOTO MOUNTED
X$ ALLOCATE MT: TAPE
X$ TYPE SYS$INPUT
X`009Place tape to be used on drive,
X`009when done, hit RETURN
X$ INQUIRE DONE DONE
X$ MOUNT/FOREIGN TAPE TAPE TAPE
X$ MOUNTED:
X$ RUN X$:CARDIN
X$ DISMOUNT:
X$ INQUIRE DISM "Is tape to be dismounted (T/F)
X$ IF .NOT.DISM THEN EXIT
X$ DISMOUNT TAPE
X$ DEALLOCATE TAPE
X$ DEASSIGN TAPE
X$ EXIT
$ CALL UNPACK CARDIN.COM;12 276764000
$ create/nolog 'f'
XC      PROGRAM CARDIN
XCHANGES MADE 23-Jul-1982 ***
XC
XC      A PROGRAM TO READ IBM370 TYPE TAPES OF FB OR VBS RECORDS,
XC      CONVERT TO ASCII WHEN NECESSARY, STRIP OFF THE FIRST CHARACTER
XC      IF NEEDED (AS WHEN THE LINE HAVE CONTROL CHARACTERS) AND TRIM`032
XC      TRAILING BLANKS IF DESIRED.  THE PROGRAM CAN ALSO SPLIT THE LINES
XC      INTO INDIVIDUAL FILES IF THERE IS A FLAG ON THE FIRST LINE
XC      OF EACH FILE.
XC
X      IMPLICIT INTEGER*2 (I-N)
X      COMMON /GHCITP/ IRC,IBC,LUNMT,LUNTT,ILRECL,IBLKSZ,IOSTAT(5),
X     1 IFN(17),IVOL(6),TRAN,LAB,IEOF,FV
X      LOGICAL*1 IFN,TRAN,LAB,IEOF,IVOL,FV
X      BYTE STRIP,INITAP,TRM,BREAK,T73,NFC
X      CHARACTER OUTPUT*300,NAME*120,FLAG*4,BLANK,C
X      INTEGER*4 L
X      DATA BLANK/' '/
XC
X    1 FORMAT ('$NAME OF OUTPUT FILE: ')
X    2 FORMAT (I10)
X    4 FORMAT (L1)
X    5 FORMAT ('$DROP 1ST CHARACTER OF EACH RECORD (T/F) ? ')
X    6 FORMAT ('$NAME OF OUTPUT FILE `091'17A1,'`093 ')
X    7 FORMAT (A)
X    8 FORMAT ('$TRIM TRAILING BLANKS (T/F) ? ')
X    9 FORMAT ('$WRITE FILE(S) WITH FORTRAN CARRIAGE CONTROL (T/F) ? ')
X   10 FORMAT (I10,' RECORDS PROCESSED.')
X   11 FORMAT (' OUTPUT FILE IS NAMED: 'A)
X   14 FORMAT ('$REMOVE COLS 73-80 (T/F) ? ')
X   15 FORMAT ('$BREAK UP INPUT INTO FILES (T/F) ? ')
X   16 FORMAT ('$TYPE A 4-CHARACTER FLAG WHICH',
X     1 ' APPEARS ON THE FIRST LINE OF EVERY FILE: ')
X   17 FORMAT ('$FLAG IS IN WHAT COL OF OUTPUT RECORD `0911`093 ')
X   18 FORMAT ('$IN WHAT COL OF THE OUTPUT RECORD DOES A 6-CHARACTER ',
X     1 'FILE NAME START `09114`093 ')
X   19 FORMAT ('$FILE TYPE FOR FILES (INCLUDE THE PERIOD BEFORE IT): ')
XC
X      L = 0
X      LUNTT = 1
X      LUNCD = 3
X      OPEN (UNIT=LUNTT,FILE='TT',STATUS='UNKNOWN')
X      IFN(1) = 0
X      IF (.NOT.INITAP(0)) STOP 'CAN`096T INIT TAPE'
X      IF (FV.NE.'F' .AND. FV.NE.'V') STOP 'HORRORS, F or V?'
X      WRITE(LUNTT,5)
X      READ (LUNTT,4) STRIP
X      WRITE (LUNTT,15)
X      READ (LUNTT,4) BREAK
X      IF (BREAK) THEN
X         WRITE (LUNTT,16)
X         READ (LUNTT,7) FLAG
X         WRITE (LUNTT,17)
X         READ (LUNTT,2) NF
X         IF (NF .EQ. 0) NF = 1
X         WRITE (LUNTT,18)
X         READ (LUNTT,2) NC
X         IF (NC .EQ. 0) NC = 14
X         WRITE (LUNTT,19)
X         READ (LUNTT,7) NAME(7:10)
X         NAME(11:) = BLANK
X      END IF
X      WRITE (LUNTT,14)
X      READ (LUNTT,4) T73
X      TRM = T73`009`009!IF DROPPING 73-80, TRIM ALSO
X      IF (.NOT.TRM) THEN
X         WRITE (LUNTT,8)
X         READ (LUNTT,4) TRM
X      END IF
X      LRECO = ILRECL
X      IF (STRIP) LRECO = LRECO - 1
X      WRITE (LUNTT,9)
X      READ (LUNTT,4) NFC
X      IF (.NOT.BREAK) THEN
X         IF (IFN(1) .NE. 0) THEN
X            WRITE (LUNTT,6) IFN
X         ELSE
X            WRITE (LUNTT,1)
X         END IF
X         READ (LUNTT,7) NAME
X         IF (NAME(1:1) .EQ. BLANK) THEN
X            IF (IFN(1).EQ.0) THEN
X               NAME ='CARDIN.OUT'
X            ELSE
X               NAME = BLANK
X               I = 1
X               DO WHILE (I.LE.17 .AND. IFN(I).NE.0)
X                  NAME(I:I) = CHAR(IFN(I))
X                  I = I + 1
X               END DO
X            END IF
X         END IF
X         IF (NFC) THEN
X            OPEN (UNIT=LUNCD,FILE=NAME,STATUS='NEW',RECORDSIZE=ILRECL,
X     1            CARRIAGECONTROL='FORTRAN')
X         ELSE
X            OPEN (UNIT=LUNCD,FILE=NAME,STATUS='NEW',RECORDSIZE=ILRECL,
X     1            CARRIAGECONTROL='LIST')
X         END IF
X         INQUIRE (UNIT=LUNCD,NAME=NAME)
X         WRITE (LUNTT,11) NAME(:INDEX(NAME,BLANK)-1)
X      END IF
XC NOW BEGIN TO PROCESS
XC NEXT CALL IS TO READ A RECORD
X      DO WHILE (.TRUE.)
X         IF (FV.EQ.'F') THEN
X            CALL RD370(%REF(OUTPUT))
X            LRECM = LRECO
X         ELSE
X            OUTPUT = ' '
X            CALL RDVBS(%REF(OUTPUT))
X            ! ALWAYS TRANSLATE VBS
X            CALL EBTASC(ILRECL,%REF(OUTPUT),%REF(OUTPUT))
X            LRECM = ILRECL
X            IF (STRIP) LRECM = LRECM - 1
X         END IF
X         IF (IEOF) GO TO 100
X         IF (STRIP) OUTPUT = OUTPUT(2:)//BLANK
X         L = L + 1
X         IF (T73) LRECM = MIN(LRECM,72)
X         IF (TRM) THEN
X            CALL STR$TRIM(OUTPUT(:LRECM),OUTPUT(:LRECM),K)
X            LRECM = K
X         END IF
X         IF ( BREAK) THEN
X            IF (FLAG.EQ.OUTPUT(NF:NF+3)) THEN
X               NAME(1:6) = OUTPUT(NC:NC+5)
X               CLOSE (UNIT=LUNCD)
X               OPEN (UNIT=LUNCD,FILE=NAME,STATUS='NEW',
X     1               RECORDSIZE=ILRECL,CARRIAGECONTROL='LIST')
X            END IF
X         END IF
X         WRITE (LUNCD,7) OUTPUT(1:LRECM)
X      END DO
XC CLOSE UP OPERATIONS!
X  100 CALL TAPTRM
X      CLOSE (UNIT=LUNCD)
X      WRITE (LUNTT,10) L
X      CALL EXIT
X      END
$ CALL UNPACK CARDIN.FOR;12 1349729041
$ create/nolog 'f'
X$ FOR/L CARDIN
X$ LINK/MAP CARDIN+`091GHC.UTIL`093TAP/LIB
X$ PURGE CARDIN.*/LOG
X$ DEL CARDIN.OBJ;0
$ CALL UNPACK CMPCARDIN.COM;1 421291931
$ create/nolog 'f'
X$ FOR/LIST SPOUT
X$ LINK/MAP SPOUT+`091GHC.UTIL`093TAP/LIB
X$! PURGE SPOUT.*/LOG
X$ DEL SPOUT.OBJ;0
$ CALL UNPACK CMPSPOUT.COM;1 827729642
$ create/nolog 'f'
X`009SUBROUTINE EBTASC(N,ARRAY1,ARRAY2)
XCHANGES MADE 06-SEP-1980 ***
XC
XC`009TRANSLATE N BYTES OF ARRAY1 TO EBCDIC AND STORE THEM IN ARRAY2
XC
X`009BYTE ARRAY1(1),ARRAY2(1),EBCDIC(256)
X`009INTEGER*2 A1,A2,N
X`009DATA EBCDIC/
X`0091 "  0,"  1,"  2,"  3,"  4," 40," 40," 40," 40," 40," 40," 40,
X`0091 " 40," 40," 40," 40," 40," 40," 40," 40," 40," 40," 10," 40,
X`0091 " 40," 40," 40," 40," 40," 40," 40," 40," 40," 40," 40," 40,
X`0091 " 40," 40," 40," 40," 40," 40," 40," 40," 40," 40," 40," 40,
X`0091 " 40," 40," 40," 40," 40," 40," 40," 40," 40," 40," 40," 40,
X`0091 " 40," 40," 40," 40," 40," 40," 40," 40," 40," 40," 40," 40,
X`0091 " 40," 40,"  7," 56," 74," 50," 53,"174," 46," 40," 40," 40,
X`0091 " 40," 40," 40," 40," 40," 40," 41," 44," 52," 51," 73,"136,
X`0091 " 55," 57," 40," 40," 40," 40," 40," 40," 40," 40," 40," 54,
X`0091 " 45,"137," 76," 77," 40," 40," 40," 40," 40," 40," 40," 40,
X`0091 " 40,"140," 72," 43,"100," 47," 75," 42," 40,"141,"142,"143,
X`0091 "144,"145,"146,"147,"150,"151," 40,"173," 40," 40," 40," 40,
X`0091 " 40,"152,"153,"154,"155,"156,"157,"160,"161,"162," 40,"175,
X`0091 " 40," 40," 40," 40," 40,"176,"163,"164,"165,"166,"167,"170,
X`0091 "171,"172," 40," 40," 40,"133," 40," 40," 40," 40," 40," 40,
X`0091 " 40," 40," 40," 40," 40," 40," 40," 40," 40,"135," 40," 40,
X`0091 " 40,"101,"102,"103,"104,"105,"106,"107,"110,"111," 40," 40,
X`0091 " 40," 40," 40," 40," 40,"112,"113,"114,"115,"116,"117,"120,
X`0091 "121,"122," 40," 40," 40," 40," 40," 40,"134," 40,"123,"124,
X`0091 "125,"126,"127,"130,"131,"132," 40," 40," 40," 40," 40," 40,
X`0091 " 60," 61," 62," 63," 64," 65," 66," 67," 70," 71," 40," 40,
X`0091 " 40," 40," 40," 40/
X`009DO 10 I=1,N
X`009A1 = ARRAY1(I).AND."377
X`009A2 = EBCDIC(A1+1)
X`009ARRAY2(I) = A2
X10`009CONTINUE
X`009END
$ CALL UNPACK EBTASC.FOR;9 2103197957
$ create/nolog 'f'
X`009.TITLE`009GET_RAT_SIZ
X;CHANGES MADE 17-JAN-1980 ***
X;
X; USEROPEN ROUTINE TO BE EMPLOYED TO GET THE RECORD ATTRIBUTE
X; BYTE AND THE MAXIMUM RECORD SIZE OF A FILE BEING OPENED.
X;
X; CALL VIA USEROPEN PARAMETER OF OPEN ONLY.
X; A COMMON BLOCK LABELED /RATSIZ/ MUST BE PROVIDED AND
+-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-

