FORTRAN IV V02.1-1 PAGE 001 0001 program tohex c c c Authors: E.F.Beadel, Jr., Manager c C.A.U.S.E. Instructional Computer Center c SUNY at Oswego c Oswego, NY 13126 c phone: 315/341-3055 c c and c c T.J.Weslowski, Instructor c Computer Science Department c SUNY at Oswego c Oswego, NY 13126 c c Date: 10-aug-83 c c************************************************************ c************************************************************ c c This program converts ANY disk file to a file of c hexidecimal characters replete with lines and line c numbers. This ascii hex file can then be transmitted c from one computer to another over normal terminal c transmission lines. c c The sister program, "TOBIN", will take the ascii hex c file created by this program and reconstruct the c original file. c c Therefor, these two programs afford a method of transmitting c ANY file between two computers over ascii transmission c lines. c c c This program must be compiled and linked with the c macro-11 program "BICB" as follows: c c FORTRAN TOHEX c MACRO BICB c LINK TOHEX,BICB c RUN TOHEX c c 0002 integer dada(256), cblk(5), filspc(39), deftyp(4), 1 fname(4), chan, lun, outfil(4), norec, 2 cptr,nrec,lnctr,lnyb,unyb,bicb,hex c c 0003 byte line(64), char(512), fname2(16) c c 0004 equivalence (dada(1),char(1)), (filspc(16), fname(1)), FORTRAN IV V02.1-1 PAGE 002 1 (filspc(1),outfil(1)) c c 0005 data deftyp /3RSAV, 3RHEX, 3RLST, 3RFOO/ c c 0006 chan=2 0007 type *,' = ' c c c Input to the prompt line issued by the next statement c is = c 0008 if(icsi(filspc, deftyp,,,0) .ne. 0) stop 'CSI error' 0010 norec = lookup(chan,fname) 0011 if(norec.lt.0) goto 2000 0013 type *,' File length is ',norec,' block' c c Reconstruct file name c 0014 call r50asc(3,outfil,char) 0015 call trim(char) 0016 call concat(char,':',fname2,4) 0017 call r50asc(6,outfil(2),char) 0018 call trim(char) 0019 call concat(fname2,char,fname2,10) 0020 call concat(fname2,'.',fname2,11) 0021 call r50asc(3,outfil(4),char) 0022 call trim(char) 0023 call scopy(char,char,3) 0024 call concat(fname2,char,fname2,14) 0025 type 888,fname2 0026 888 format(' DST file name is ',20a1) 0027 call assign(51,fname2,0,'new') c c c c Now the actual decoding process... c c 0028 lnctr=1 ! init line counter 0029 nrec=0 ! init the record counter c c 0030 10 type *,'working on block ',nrec !process the file 0031 if(ireadw(256,dada,nrec,chan).lt.0) goto 1000 c c 0033 cptr=1 ! init output buffer pointer 0034 do 11 j=1,512 ! process the block 0035 unyb=bicb("17,char(j))/16 ! get upper nybble 0036 lnyb=bicb("360,char(j)) ! and lower nybble 0037 unyb=hex(unyb) ! convert to hex character 0038 lnyb=hex(lnyb) ! " FORTRAN IV V02.1-1 PAGE 003 0039 line(cptr)=unyb !Save in output buffer 0040 line(cptr+1)=lnyb ! " 0041 cptr=cptr+2 ! Adjust buffer pointer. 0042 if(cptr .lt. 64) goto 11 ! Skip output if buffer not full 0044 write(51,52)lnctr,line ! Dump the buffer 0045 52 format(i4,':',64a1) 0046 lnctr=lnctr+1 ! Adjust the pointers 0047 cptr=1 0048 11 continue ! End of block 0049 nrec=nrec+1 0050 goto 10 0051 1000 call closec(chan) 0052 close (unit=51) 0053 call exit 0054 2000 if(i.eq.-1) stop 'File already open' 0056 if(i.eq.-2) stop 'FNF' 0058 if(i.eq.-3) stop 'Device in use' 0060 if(i.eq.-4) stop 'TAPE DRIVE NOT AVAIL' 0062 call exit 0063 end FORTRAN IV Storage Map for Program Unit TOHEX Local Variables, .PSECT $DATA, Size = 001310 ( 356. words) Name Type Offset Name Type Offset Name Type Offset CHAN I*2 001264 CPTR I*2 001272 I I*2 001306 J I*2 001304 LNCTR I*2 001276 LNYB I*2 001300 LUN I*2 001266 NOREC I*2 001270 NREC I*2 001274 UNYB I*2 001302 Local and COMMON Arrays: Name Type Section Offset ------Size----- Dimensions CBLK I*2 $DATA 001002 000012 ( 5.) (5) CHAR L*1 $DATA 000002 001000 ( 256.) (512) DADA I*2 $DATA 000002 001000 ( 256.) (256) DEFTYP I*2 $DATA 001132 000010 ( 4.) (4) FILSPC I*2 $DATA 001014 000116 ( 39.) (39) FNAME I*2 $DATA 001052 000010 ( 4.) (4) FNAME2 L*1 $DATA 001242 000020 ( 8.) (16) LINE L*1 $DATA 001142 000100 ( 32.) (64) OUTFIL I*2 $DATA 001014 000010 ( 4.) (4) Subroutines, Functions, Statement and Processor-Defined Functions: Name Type Name Type Name Type Name Type Name Type ASSIGN R*4 BICB I*2 CLOSEC R*4 CONCAT R*4 EXIT R*4 HEX I*2 ICSI I*2 IREADW I*2 LOOKUP I*2 R50ASC R*4 SCOPY R*4 TRIM R*4 FORTRAN IV V02.1-1 PAGE 001 0001 integer function hex(arg) c c This function returns the hexidecimal character c of its argument. The argument must be a value c between 0 and 15 (one nybble). c 0002 byte arg 0003 if(arg .lt. 10) hex = arg + '0' 0005 if(arg .ge. 10) hex = arg -10 + 'A' 0007 return 0008 end FORTRAN IV Storage Map for Program Unit HEX Local Variables, .PSECT $DATA, Size = 000004 ( 2. words) Name Type Offset Name Type Offset Name Type Offset ARG L*1 @ 000000 HEX I*2 000002 Eqv