From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 21-NOV-1989 21:23
To:	MRGATE::"ARISIA::EVERHART"
Subj:	xbin 1 of 4 (was hqx to binary on vax)

Message-Id:  <8911211754.AA04309@crdgw1.ge.com>
Received: From NWC.NAVY.MIL by CRVAX.SRI.COM with TCP; Tue, 21 NOV 89 07:38:26 PDT
Date: 21 Nov 89 07:22:00 PDT
From: "LEVINE PETER J" <levine%y.mil:amiga-relay-request@louie.udel.edu>
Subject: xbin 1 of 4 (was hqx to binary on vax)
To: "info-vax" <info-vax@crvax.sri.com>

>i'm looking for a program that will take binhex files on a vax and convert them
>to the actual mac program before i download them. normally i send them to the
>mac and do the converting there, but it might be quicker if i can convert on
>the vax. does anyone know of such a program for vms? (does anyone want to write
>one?) :)
>                                                      Allen Edmiston
>                                                      ale101@psuvm.bitnet
	The following 4 part VMS_SHARE is a program I got off of
an old VAX Sig tape. The output is in a form that is uploaded in
MAC XMODEM protocol.

Michael N. LeVine  Naval Weapons Center, China Lake, Ca 93555, USA
Internet: levine%fidler.decnet@nwc.navy.mil,levine%fidler.decnet@26.3.0.85
(619) 939-2614  avn  437-2614 

 "Waiter, there's a bug in my soup!"        
 "No, Sir, it's not a bug, it's a feature!" 
*******************************************************************************
$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.1-004  3-AUG-1989
$!   On 21-NOV-1989 07:08:36.09   By user LEVINE 
$!
$! 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 4 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.DOC;2
$!       2. CVT.MAR;1
$!       3. LOAD.COM;1
$!       4. PARSE_TABLES.CLD;1
$!       5. XBIN.MAR;1
$!
$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. "V4.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'
XXBIN, by Gordon Davisson.
X
XThis program converts a BinHex format text file (ignoring leading garbage,
Xsuch as mail headers) into a MacBinary file.  To compile it, run LOAD.COM.
XTo use it, put a line like
X
X`009$ xbin :== $disk:`091directory`093xbin.exe
X
Xin your LOGIN.COM, then type
X
X`009$ xbin infile outfile
X
Xto convert infile to outfile.  The optional parameter /MACNAME=name can be
Xused to set the filename field of the MacBinary document.
X
X
XLOAD.COM compiles and links the program.
$ CALL UNPACK AAAREADME.DOC;2 252341820
$ create/nolog 'f'
X`009.title`009cvt -- convert unix-style filename to VMS-style
X;
X; Copyright (c) 1987 by Gordon Davisson.
X;
X; Premission is hereby granted to copy, use, and modify these routines,
X; provided this notice is retained intact.
X;
X
X; character constants
Xc_space`009= `094a/ /
Xc_lita`009= `094a/a/
Xc_litz`009= `094a/z/
Xc_biga`009= `094a/A/
Xc_bigz`009= `094a/Z/
Xc_zero`009= `094a/0/
Xc_nine`009= `094a/9/
Xc_dols`009= `094a/$/
Xc_under`009= `094a/_/
Xc_dash`009= `094a/-/
Xc_dot`009= `094a/./
Xc_slash = `094a?/?
Xc_obrk`009= `094a/`091/
Xc_cbrk`009= `094a/`093/
X
Xname_reserve`009= 13`009; space to reserve for filename
Xtype_reserve`009= 4`009; space to reserve for filetype
Xdefault_format`009= 3`009; default VMS filename format
X`009`009`009;    if you're using an old version ov VMS, change this
X
X`009.psect`009$code`009pic, rd, nowrt, exe, shr, long
X
Xnlen:`009.word`0090, 9, 39, 39`009; max filename length for various formats
Xtlen:`009.word`0090, 3, 39, 39`009; ditto for filetypes
X
X;
X;************************************************************************
X;
X
X`009.entry`009cvt_name_uv, `094m<r2,r3,r4,r5,r6,r7,r8,r9,r10,r11>
X;
X; This procedure converts a unix-style filespec to VMS-style.
X;
X; parameters:
X;  p1  = pointer to descriptor for unix-style name
X;  p2  = pointer to descriptor to return VMS-style name in
X;  p3  = pointer to word to return length of VMS-style name in
X;  p4  = VMS file format to use (optional parameter; default is format #3)
X;`009`0091 = VMS versions 1-3`0099-char name, 3-char type,
X;`009`009`009`009`009alphanumeric characters only
X;`009`0092 = versions 4.0-4.3`00939-char name & type, $ and _ allowed
X;`009`0093 = version 4.4 on`009- allowed as well
X;
X;
X; register usage:
X;  r6  = number of characters left in unix name
X;  r7  = pointer to current position in unix name
X;  r8  = number of characters left in VMS name buffer
X;  r9  = pointer to current position in VMS name buffer
X;  r10 = VMS file format number
X;  r11 = misc
X
X; parameter offsets:
Xp_uname`009= 4
Xp_vname`009= 8
Xp_vlen`009= 12
Xp_form`009= 16
X
X;
X; figure out what VMS filename format to use
X;
X`009movl`009#default_format, r10
X`009cmpb`009(ap), #4`009`009; see if the fourth parameter is there
X`009blss`00920$
X`009movl`009p_form(ap), r0
X`009beql`00920$`009`009`009; and nonzero
X`009cmpl`009r0, #`094x200`009`009; check for reference/value parameter
X`009blss`00910$
X`009cvtbl`009(r0), r0`009`009; if reference, dereference
X`009beql`00920$`009`009`009; and check for zero
X10$:`009cmpl`009r0, #3`009`009`009; check range
X`009bgtru`00920$
X`009movl`009r0, r10`009`009`009; if legal, use it
X20$:
X
X; get ready to start converting directory string
X`009movq`009@p_uname(ap), r6`009; get unix name descr
X`009movzwl`009r6, r6
X`009movq`009@p_vname(ap), r8`009; get VMS name descr
X`009movzwl`009r8, r8
X
X`009cmpb`009(r7), #c_slash`009`009; if unix name starts with /, eat it
X`009bneq`00930$
X`009incl`009r7
X`009decw`009r6
X30$:
X`009movb`009#c_obrk, (r9)+`009`009; start VMS name with a `091
X`009decw`009r8
X
X;
X; loop through the unix name, converting as we go
X;
X100$:`009locc`009#c_slash, r6, (r7)`009; find next slash in unix name
X`009beql`009200$`009`009`009; up to it is a dir name
X`009movq`009r6, r2`009`009`009; remember where the dir name started
X`009movq`009r0, r6`009`009`009; figure out where it ends
X`009incl`009r7
X`009decw`009r6
X`009subw3`009r6, r2, r0`009`009; figure out how long it is
X`009decw`009r0
X`009cmpw`009r0, nlen`091r10`093`009`009; if too long for VMS, trim it
X`009bleq`009110$
X`009movw`009nlen`091r10`093, r0
X110$:`009movb`009#c_dot, (r9)+`009`009; add dot to VMS buffer
X`009decw`009r8
X`009movl`009r3, r1`009`009`009; set up for call to cvt_string
X`009movl`009r9, r2
X`009addl2`009r0, r9`009`009`009; skip VMS buffer past dir name
X`009subw2`009r0, r8
X`009cmpw`009r8, #name_reserve`009; make sure there's some VMS buffer left
X`009bgtr`009120$
X`009subw3`009#name_reserve, r8, r3
X`009movw`009#name_reserve, r8
X`009subl2`009r3, r9
X`009subw2`009r3, r0
X`009bleq`009100$
X120$:`009bsbw`009cvt_string`009`009; translate the dir name into VMS buffer
X`009subl2`009r3, r9`009`009`009; correct for untranslatable chars
X`009addw2`009r3, r8
X`009brb`009100$`009`009`009; and do the next dir level
X
X;
X;finish up the dir spec
X;
X200$:`009cmpb`009<-1>(r9), #c_dot`009; if VMS name ends in '.', trim it
X`009bneq`009210$
X`009decl`009r9
X`009incw`009r8
X210$:`009cmpb`009<-1>(r9), #c_obrk`009; if it ends in '`091', trim that too
X`009bneq`009220$
X`009decl`009r9
X`009incw`009r8
X`009brb`009300$
X
X220$:`009movb`009#c_cbrk, (r9)+`009`009; if not, close the dir spec with '`0
V93'
X`009decw`009r8
X
X;
X; do the filename itself
X;
X300$:`009locc`009#c_dot, r6, (r7)`009; find the first dot in the unix name
X`009movq`009r6, r2`009`009`009; remember where the file name started
X`009movq`009r0, r6`009`009`009; figure out where it ends
X`009incl`009r7
X`009decw`009r6
X`009subw3`009r6, r2, r0`009`009; figure out how long it is
X`009decw`009r0
X`009cmpw`009r0, nlen`091r10`093`009`009; if too long for VMS, trim it
X`009bleq`009310$
X`009movw`009nlen`091r10`093, r0
X310$:`009movl`009r3, r1`009`009`009; set up for call to cvt_string
X`009movl`009r9, r2
X`009addl2`009r0, r9`009`009`009; skip VMS buffer past file name
X`009subw2`009r0, r8
X`009cmpw`009r8, #type_reserve`009; make sure there's some VMS buffer left
X`009bgtr`009320$
X`009subw3`009#type_reserve, r8, r3
X`009movw`009#type_reserve, r8
X`009subl2`009r3, r9
X`009subw2`009r3, r0
X`009bleq`009400$
X320$:`009bsbw`009cvt_string`009`009; translate the file name into VMS buff
X`009subl2`009r3, r9`009`009`009; correct for untranslatable chars
X`009addw2`009r3, r8
X
X;
X; do the file type
X;
X400$:`009movb`009#c_dot, (r9)+`009`009; delimit filetype with a dot
X`009decw`009r8
X`009cmpw`009r6, r8`009`009`009; figure out which has less left, unix
X`009blss`009410$`009`009`009; string or VMS buffer
X`009cvtwl`009r8, r0`009`009`009; and set r0 to min of the two
X`009brb`009420$
X410$:`009cvtwl`009r6, r0
X420$:`009cmpw`009r0, tlen`091r10`093`009`009; if too long for VMS, trim it
X`009bleq`009430$
X`009movw`009tlen`091r10`093, r0
X430$:`009movl`009r7, r1`009`009`009; set up for call to cvt_string
X`009movl`009r9, r2
X`009addl2`009r0, r9`009`009`009; skip VMS buffer past file type
X`009subw2`009r0, r8
X`009bsbw`009cvt_string`009`009; translate the file type into VMS buff
X`009subl2`009r3, r9`009`009`009; correct for untranslatable chars
X`009addw2`009r3, r8
X
X;
X; finish up
X;
X`009cmpb`009(ap), #3`009`009; make sure there are 3 parameters
X`009blss`009510$
X`009tstl`009p_vlen(ap)`009`009; make sure third parameter isn't null
X`009beql`009510$
X`009subw3`009r8, @p_vname(ap), @p_vlen(ap) ; calc & return VMS name length
X510$:`009ret`009`009`009`009; and return control
X
X;
X;************************************************************************
X;
Xcvt_string:
X;
X; This jsb routine copies a string and gets rid of characters not allowed
X; in a VMS file name.
X;
X; register usage:
X;  r0  = length of string to copy (input)
X;  r1  = address of string to copy (input)
X;  r2  = address of buffer to copy into (input)
X;  r3  = number of characters that couldn't be translated (output)
X;
X
X; initialze r3
X`009clrl`009r3
X
X;
X; loop through the string, copying & editing as we go
X;
X10$:`009tstw`009r0`009`009`009`009; if at end of string, ...
X`009bgtr`00920$
X`009rsb`009`009`009`009`009;    return
X
X20$:`009cmpb`009(r1), #c_lita`009`009`009; if char is lowercase, ...
X`009blss`00950$
X`009cmpb`009(r1), #c_litz
X`009bgtr`00950$
X`009subb3`009#<c_lita-c_biga>, (r1)+, (r2)+`009;    upcase it
X`009decw`009r0
X`009brb`00910$
X
X50$:`009cmpb`009(r1), #c_biga`009`009`009; if char is uppercase, ...
X`009blss`00970$
X`009cmpb`009(r1), #c_bigz
X`009bgtr`00970$
X60$:`009movb`009(r1)+, (r2)+`009`009`009;    leave it be
X`009decw`009r0
X`009brb`00910$
X
X70$:`009cmpb`009(r1), #c_zero`009`009`009; if it's a digit, ...
X`009blss`00980$
X`009cmpb`009(r1), #c_nine
X`009bleq`00960$`009`009`009`009;    leave it be
X
X80$:`009cmpb`009r10, #1`009`009`009`009; if form <= 1, ...
X`009bgtr`009100$
X`009incl`009r3`009`009`009`009;    we should ignore strangies
X`009incl`009r1
X`009decw`009r0
X`009brb`00910$
X
X100$:`009cmpb`009(r1), #c_dols`009`009`009; if char is '$', ...
X`009beql`00960$`009`009`009`009;    leave it be
X`009cmpb`009(r1), #c_under`009`009`009; if char is '_', ...
X`009beql`00960$`009`009`009`009;    leave it be
X`009cmpb`009(r1), #c_dot`009`009`009; if char is '.', ...
X`009beql`009110$`009`009`009`009;    make it a '_'
X
X`009cmpb`009(r1), #c_dash`009`009`009; if char is '-', ...
X`009bneq`009120$
X`009cmpb`009r10, #3`009`009`009`009;    if form >= 3, ...
X`009bgeq`00960$`009`009`009`009;       leave it be
X110$:`009movb`009#c_under, (r2)+`009`009`009;    else, make it a '_'
X`009incl`009r1
X`009decw`009r0
X`009brb`00910$
X
X120$:`009movb`009#c_dols, (r2)+`009`009`009; if all else fails, make it '$'
X`009incl`009r1
X`009decw`009r0
X`009brb`00910$
X
X;
X;************************************************************************
X;
X
Xmask:`009.ascii`009/---/ /--x/ /-w-/ /-wx/
X`009.ascii`009/r--/ /r-x/ /rw-/ /rwx/
X
X`009.entry`009cvt_prot, `094m<r2,r3,r4,r5>
X;
X; This procedure converts an octal digit to a 3-character protection mask
X;
X; parameters:
X;  p1  = pointer to a descriptor for the octal character
X;  p2  = pointer to a descriptor for the output buffer
X;
X
X; parameter offsets:
Xp_octal`009= 4
Xp_out`009= 8
X
X;
X; Convert the octal digit to an offset into the mask table, then look it up.
X;
X`009movaq`009@p_octal(ap), r0`009`009; get pointer to descriptor
X`009subb3`009#c_zero, @4(r0), r0`009`009; get binary value of digit
X`009mulb2`009#3, r0`009`009`009`009; table entries are 3 bytes long
X`009movq`009@p_out(ap), r1`009`009`009; get output string descr
X`009movc5`009#3, mask`091r0`093, #c_space, r1, (r2); copy the string
X`009ret`009`009`009`009`009; and return it
X
X`009.end
$ CALL UNPACK CVT.MAR;1 1499870134
$ create/nolog 'f'
X$ macro xbin, cvt
X$ set command/object parse_tables
X$ link xbin, cvt, parse_tables
$ CALL UNPACK LOAD.COM;1 1392784563
$ create/nolog 'f'
Xdefine verb XBIN
X   parameter P1, label=INFILE, prompt="Input File"
X      value (required, type=$infile)
X   parameter P2, label=OUTFILE, prompt="Output File"
X      value (type=$outfile)
X   qualifier MACNAME
X      nonnegatable
X      value (required)
$ CALL UNPACK PARSE_TABLES.CLD;1 1869901147
$ create/nolog 'f'
X`009.title`009xbin`009-- Translate BinHex to MacBinary
X`009.ident`009/1.0/
X;
X; Copyright (c) 1987 by Gordon Davisson.
X;
X; Premission is hereby granted to copy, use, and modify this program,
X; provided this notice is retained intact.
X;
X
X;
X; This program converts BinHex-format text files (including mail headers
X; or whatever) into MacBinary files.
X;
X; Version 1.0, Gordon Davisson, April 20 1987
X;
X
X`009.macro`009$iferr`009addr = error, ?x
X`009blbs`009r0, x
X`009brw`009addr
Xx:
X`009.endm`009$iferr
X
+-+-+-+-+-+-+-+-  END  OF PART 1 +-+-+-+-+-+-+-+-


