$! ------------------ CUT HERE ----------------------- $ v='f$verify(f$trnlnm("SHARE_VERIFY"))' $! $! This archive created by VMS_SHARE Version 7.1-004 3-AUG-1989 $! On 19-JAN-1990 23:22:59.23 By user CUR022 (Bob Eager, University of Kent) $! $! 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 3 PARTS, TO KEEP EACH PART $! BELOW 63 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. [.UUENCODE]AAAREADME.TXT;1 $! 2. [.UUENCODE]UUENCODE.HLP;1 $! 3. [.UUENCODE.DECODE]UUDECODE.CLD;4 $! 4. [.UUENCODE.DECODE]UUDECODE.MAR;14 $! 5. [.UUENCODE.DECODE]UUDECODEMSG.MSG;4 $! 6. [.UUENCODE.ENCODE]UUENCODE.CLD;4 $! 7. [.UUENCODE.ENCODE]UUENCODE.MAR;2 $! 8. [.UUENCODE.ENCODE]UUENCODEMSG.MSG;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' XThis is UUENCODE and UUDECODE for VMS, in MACRO-32. The programs were origin Vally Xwritten for local use, and contain some options not relevant to 99.99% of us Vers. X XThe two programs are in separate directories. To build, MACRO the .MAR Xfiles and MESSAGE the .MSG files. LINK the resultant .OBJ files to get Xthe .EXE files. Edit the .CLD files to reflect the locations of the .EXE fil Ves, Xand then use SET COMMAND to add the command definitions to the process Xcommand tables or to the DCLTABLES. X XGood luck! X XBob Eager Xrde@ukc.ac.uk $ CALL UNPACK [.UUENCODE]AAAREADME.TXT;1 777942488 $ create/nolog 'f' X1 UUENCODE-DECODE X The UUENCODE command encodes a file into a form which contains only X normal ASCII printable characters. This file may then be transmitted X to another machine, and decoded to produce a copy of the original X file. X X The UUDECODE command decodes a file previously encoded with the X UUENCODE command. X X The encoded format is compatible with that used by the UNIX commands X `096uuencode' and `096uudecode'. X X These commands make it possible to transmit files over communication X links such as mail and file transfer systems, even when the files X contain characters which have special meanings on the communication X link. They are also useful for circumventing certain problems in the X file transfer system on VMS (e.g. inability to handle long records). X2 UUENCODE X This command encodes a VMS file. The header line in the output file X always specifies a UNIX file mode of 600 (rw-------). X X Format: X X UUENCODE input-file-spec X3 Parameters X X input-file-spec X X Specifies the name of the file to be encoded. Only one file may be X specified. No wildcards are allowed. X X3 Command_Qualifiers X X/FORMAT X X /FORMAT=input-format X X Specifies the format of the input file, and may be one of the X following. The default format is TEXT. X X BINARY - the input file is assumed to contain binary X data. The contents of the file are encoded with no X additions or modifications. X X EMAS_BINARY - the input file is a binary file originally X resident on EMAS. The contents of the file are X encoded with the assumption that the EMAS file X header is not to be included, and that no other X changes are made. This option is useful for UNIX X binary files (e.g. `096tar' images) originally X archived on EMAS. X X TEXT - the input file is a normal text file. A newline X character is added at the end of each record, to X convert the file contents to a UNIX-style format. X X/LOG X X /LOG X /NOLOG (default) X X Controls whether a message is displayed when the encoding has been X completed. X X/OUTPUT X X /OUTPUT=output-file-spec X X Controls where the encoded output is sent. If you do not enter the X qualifier, the output is sent to the current process default output X stream or device, identified by the logical name SYS$OUTPUT. X X/REMOTE_FILE X X /REMOTE_FILE=remote-file-spec X X Specifies the name of the file into which the encoded file is to be X decoded, when this is eventually done on the remote system. This can X of course be altered at any time simply by editing the encoded file. X X If this qualifier is not specified, the name of the input file is X used. X X To conform to UNIX conventions, the remote file specification is X generated in lower case. X X/VERSION X X /VERSION X X Causes the version number of UUENCODE to be displayed. X X3 Examples X X 1. $ UUENCODE FRED.TXT/OUTPUT=FRED.UUE X X This command encodes the text file FRED.TXT into the file FRED.UUE. X X 2. $ UUENCODE TEST.EXE/FORMAT=BINARY/OUTPUT=TEST.UUE X X This command encodes the binary file TEST.EXE into the file TEST.UUE. X X2 UUDECODE X This command decodes a file into a VMS file. Output is to the file X specified when the file was encoded; this name may be found in the X header line of the input file, and may be edited if a different output X file is required. X X The UNIX mode digits in the header line are honoured, with the X addition of Delete permission for the file owner and RWED permission X for the system. X X Format: X X UUDECODE input-file-spec X3 Parameters X X input-file-spec X X Specifies the name of the file to be decoded. Only one file may be X specified. No wildcards are allowed. X X3 Command_Qualifiers X X/FORMAT X X /FORMAT=output-format X X Specifies the format of the output file, and may be one of the X following. The default format is TEXT. X X BINARY - the input file is assumed to contain binary X data. The contents of the file are decoded with no X additions or modifications, and the output file is X created with fixed length records of 512 bytes. X Any spare bytes in the last block are filled with X zeros (the ASCII NUL character). X X TEXT - the input file is assumed to contain normal text. X Each occurrence of a newline character causes a X new record to be started in the output file, and X the output file is created with variable length X records. X X/LOG X X /LOG X /NOLOG (default) X X Controls whether a message is displayed when the decoding has been X completed. X X/VERSION X X /VERSION X X Causes the version number of UUDECODE to be displayed. X X3 Examples X X 1. $ UUDECODE FRED.UUE/LOG X X This command decodes the file FRED.UUE, and outputs an advisory X message. The output file is a text file (variable length records). X X 2. $ UUDECODE TEST.UUE/FORMAT=BINARY X X This command decodes the file TEST.UUE into a binary file (fixed X length records of 512 bytes). $ CALL UNPACK [.UUENCODE]UUENCODE.HLP;1 1079924507 $ create/nolog 'f' X! X! File: UUDECODE.CLD X! X! Command definition for UUDECODE X! X! R.D. Eager University of Kent December 1988 X! X Xdefine type FORMAT_TYPES X`009keyword BINARY, nonnegatable X`009keyword TEXT, default, nonnegatable X Xdefine verb UUDECODE X X`009image disk$user6:`091cur022.uu.decode`093UUDECODE X X`009parameter P1 X`009`009prompt="File" X`009`009value(noconcatenate,required,type=$infile) X X`009qualifier FORMAT X`009`009default X`009`009nonnegatable X`009`009placement=global X`009`009value(required,type=FORMAT_TYPES) X X`009qualifier LOG X`009`009negatable X`009`009placement=global X X`009qualifier VERSION X`009`009nonnegatable X`009`009placement=global X X`009disallow ANY2(FORMAT.BINARY, FORMAT.TEXT) X! X! End of file: UUDECODE.CLD X! $ CALL UNPACK [.UUENCODE.DECODE]UUDECODE.CLD;4 1750039681 $ create/nolog 'f' X`009.TITLE`009UUDECODE X`009.IDENT`009\V01-02\ X; X; UNIX UUCP decoding utility X; X; R.D. Eager University of Kent March 1989 X; X`009.DISABLE`009GLOBAL X`009.ENABLE`009`009SUPPRESSION X; X; X; Update history X; ------ ------- X; X;`009V01-00`009- Base version X;`009V01-01`009- Translate `096 to space and translate `126 to `094 before d Vecoding X;`009`009- Reduce entry mask in DO_DECODE X;`009`009- Correct fault in expanding output buffer (use R4 as buffer X;`009`009 size) X;`009V01-02`009- Correct fault in flushing binary output buffer (invalid X;`009`009 descriptor). X; X; X; Manifest constants X; -------- --------- X; X; Version information X; X`009VERSION`009`009= 1`009`009; Major version X`009EDIT`009`009= 2`009`009; Edit number within major version X; X; Miscellaneous constants X; X`009BINRECSIZ`009= 512`009`009; Binary file record size X`009DEFRECSIZ`009= 512`009`009; Default text record size X`009MAXNAME`009`009= 255`009`009; Max length of filename X`009MINREC`009`009= 100`009`009; Min input buffer size X`009NL`009`009= `094X0A`009`009; Newline character X`009OBUFINC`009`009= 512`009`009; Text record size increment X; X; X; External symbols X; -------- ------- X; X`009.EXTERNAL`009CLI$GET_VALUE X`009.EXTERNAL`009CLI$PRESENT X`009.EXTERNAL`009LIB$CVT_OTB X`009.EXTERNAL`009LIB$FREE_VM X`009.EXTERNAL`009LIB$GET_VM X`009.EXTERNAL`009LIB$SIGNAL X`009.EXTERNAL`009STR$ANALYZE_SDESC X`009.EXTERNAL`009STR$COMPARE_EQL X`009.EXTERNAL`009STR$DUPL_CHAR X`009.EXTERNAL`009STR$TRANSLATE X`009.EXTERNAL`009STR$TRIM X`009.EXTERNAL`009STR$UPCASE X; X; X; Messages X; -------- X; X`009.EXTERNAL`009UUDECODE_BADBEGIN X`009.EXTERNAL`009UUDECODE_CORRUPT X`009.EXTERNAL`009UUDECODE_DECODED X`009.EXTERNAL`009UUDECODE_ENDOFFILE X`009.EXTERNAL`009UUDECODE_NOBEGIN X`009.EXTERNAL`009UUDECODE_NOEND X`009.EXTERNAL`009UUDECODE_OPENIN X`009.EXTERNAL`009UUDECODE_OPENOUT X`009.EXTERNAL`009UUDECODE_READERR X`009.EXTERNAL`009UUDECODE_VERSION X`009.EXTERNAL`009UUDECODE_WRITERR X; X; X; Macro libraries X; ----- --------- X; X`009.LIBRARY`009\SYS$LIBRARY:LIB.MLB\ X; X; X; System symbols X; ------ ------- X; X`009$DSCDEF`009`009`009`009; Descriptors X`009$FABDEF`009`009`009`009; File Access Block X`009$NAMDEF`009`009`009`009; Name Block X`009$RABDEF`009`009`009`009; Record Access Block X`009$RMSDEF`009`009`009`009; RMS status X`009$SSDEF`009`009`009`009; System services status X`009$STRDEF`009`009`009`009; String manipulation status X`009$XABPRODEF`009`009`009; Protection XAB symbols X; X`009.SUBTITLE`009Data areas X`009.PAGE X; X`009.PSECT`009`009DATA,CON,LCL,NOEXE,WRT,LONG X; XINP_D:`009.WORD`0090`009`009`009; Dynamic descriptor for input filename X`009.BYTE`009DSC$K_DTYPE_T X`009.BYTE`009DSC$K_CLASS_D X`009.LONG`0090 X; XOUT_D:`009.WORD`0090`009`009`009; Dynamic descriptor for output filename X`009.BYTE`009DSC$K_DTYPE_T X`009.BYTE`009DSC$K_CLASS_D X`009.LONG`0090 X; XWRK_D:`009.WORD`0090`009`009`009; Dynamic work descriptor X`009.BYTE`009DSC$K_DTYPE_T X`009.BYTE`009DSC$K_CLASS_D X`009.LONG`0090 X; XREC_D:`009.BLKW`0091`009`009`009; Descriptor for input record buffer X`009.BYTE`009DSC$K_DTYPE_T X`009.BYTE`009DSC$K_CLASS_S X`009.BLKL`0091 X; X; RMS control blocks for input file X; X`009.ALIGN`009LONG XIFAB:`009$FAB -`009`009`009`009; File Access Block X`009`009FAC=GET, -`009`009; GET service only X`009`009NAM=INAM, -`009`009; Associated NAM block X`009`009FOP=SQO`009, -`009`009; Sequential only X`009`009XAB=IXAB`009`009; Associated XAB X; XIXAB:`009$XABFHC`009`009`009`009; Extended Attribute Block (file header) X; XIRAB:`009$RAB -`009`009`009`009; Record Access Block X`009`009FAB=IFAB, -`009`009; Associated FAB X`009`009RAC=SEQ, -`009`009; Sequential access X`009`009ROP=RAH`009`009`009; Read ahead X; XINAM:`009$NAM -`009`009`009`009; Name Block X`009`009ESA=INAME, -`009`009; Expanded string area for name X`009`009ESS=MAXNAME`009`009; Length of expanded string area X; X; RMS control blocks for output file X; X`009.ALIGN`009LONG XOFAB:`009$FAB -`009`009`009`009; File Access Block X`009`009FAC=PUT, -`009`009; PUT service only X`009`009FOP=, -`009; Sequential only, truncate on close X`009`009NAM=ONAM, -`009`009; Associated NAM block X`009`009ORG=SEQ, -`009`009; Sequential X`009`009XAB=OXAB`009`009; Associated XAB X; XOXAB:`009$XABPRO`009`009`009`009; Extended Attribute Block (protection) X; XORAB:`009$RAB -`009`009`009`009; Record Access Block X`009`009FAB=OFAB, -`009`009; Associated FAB X`009`009RAC=SEQ, -`009`009; Sequential access X`009`009ROP=`009`009; Write behind X; XONAM:`009$NAM -`009`009`009`009; Name Block X`009`009ESA=ONAME, -`009`009; Expanded string area for name X`009`009ESS=MAXNAME`009`009; Length of expanded string area X; X; Miscellaneous storage X; XOBUFAD:`009.LONG`0090`009`009`009; Output buffer address XOBUFSIZ:.LONG`0090`009`009`009; Output buffer size XINAME:`009.BLKB`009MAXNAME`009`009`009; Area for expanded input filename XONAME:`009.BLKB`009MAXNAME`009`009`009; Area for expanded output filename XMFLAGS:`009.BLKB`0091`009`009`009; Miscellaneous flags X`009_VIELD`009UUDEC,0,< - X`009`009, -`009`009; Binary file format X`009`009>`009`009; Informational messages required X; X`009.SUBTITLE`009Constant areas X`009.PAGE X; X`009.PSECT`009`009CONST,CON,LCL,NOEXE,NOWRT,LONG X; X; Parameter names X; XP1:`009.ASCID`009\P1\ X; X; Command qualifiers X; XFORMAT:`009.ASCID`009\FORMAT\`009`009; Output file format XLOG:`009.ASCID`009\LOG\`009`009`009; Generate informational messages XVERSIO:`009.ASCID`009\VERSION\`009`009; Display version message X; X; FORMAT qualifier keywords X; XBINARY:`009.ASCID`009\FORMAT.BINARY\`009`009; Binary output file XTEXT:`009.ASCID`009\FORMAT.TEXT\`009`009; Text output file X; X; Message inserts X; XBINTYPE:.ASCID`009\binary\ XTEXTYPE:.ASCID`009\text\ X; X; Header and trailer lines X; XHEADER:`009.ASCID`009\begin\ XTRAILER:.ASCID`009\end\ X; X; Translation tables for strange characters X; XTR_FROM:.ASCID`009\`096`126\ XTR_TO:`009.ASCID`009\ `094\ X; X; Miscellaneous strings X; XSPACE:`009.ASCID`009\ \`009`009`009; Single space X; X`009.SUBTITLE`009Main program X`009.PAGE X; X`009.PSECT`009`009CODE,CON,LCL,EXE,NOWRT,LONG X; X`009.ENTRY`009`009BEGIN,`094M<> X; X; This is the main program for the utility. It obtains parameter and X; qualifier values, opens files and calls the actual decoding routines. X; X`009BICB2`009#, - X`009`009`009MFLAGS`009`009; initialise flags X; X; Check for VERSION qualifier and output message if requested X; X`009PUSHAQ`009VERSIO`009`009`009; qualifier name X`009CALLS`009#1,G`094CLI$PRESENT`009; present? X`009BLBC`009R0,10$`009`009`009; j if not X`009PUSHL`009#EDIT`009`009`009; parameters for message X`009PUSHL`009#VERSION X`009PUSHL`009#2`009`009`009; number of FAO args X`009PUSHL`009#UUDECODE_VERSION`009; message X`009CALLS`009#4,G`094LIB$SIGNAL`009`009; output message X; X; Get input filename X; X10$:`009PUSHAQ`009INP_D`009`009`009; where to put parameter X`009PUSHAQ`009P1 X`009CALLS`009#2,G`094CLI$GET_VALUE`009; get parameter value X`009BLBS`009R0,20$`009`009`009; j if OK X`009PUSHL`009R0`009`009`009; error status X`009CALLS`009#1,G`094LIB$SIGNAL`009`009; generate message X`009BRW`009250$`009`009`009; exit X; X20$:`009MOVL`009INP_D+DSC$A_POINTER,R1`009; get address of input filename X`009$FAB_STORE -`009`009`009; fill filename into FAB X`009`009FAB=IFAB, - X`009`009FNA=(R1), - `009`009; address of filename X`009`009FNS=INP_D+DSC$W_LENGTH`009; length of filename X; X; Open the input file X; X`009$OPEN - X`009`009FAB=IFAB`009`009; do the file open X`009BLBS`009R0,30$`009`009`009; j if opened OK X; X; Failed to open input file X; X`009CLRQ`009-(SP)`009`009`009; make space for temp descriptor X`009MOVAQ`009(SP),R1`009`009`009; point to it X`009MOVZBW`009INAM+NAM$B_ESL,DSC$W_LENGTH(R1)`009; fill it in X`009MOVB`009#DSC$K_DTYPE_T,DSC$B_DTYPE(R1) X`009MOVB`009#DSC$K_CLASS_S,DSC$B_CLASS(R1) X`009MOVL`009INAM+NAM$L_ESA,DSC$A_POINTER(R1) X`009PUSHL`009IFAB+FAB$L_STV`009`009; secondary RMS status X`009PUSHL`009R0`009`009`009; primary RMS status X`009PUSHL`009R1`009`009`009; filename X`009PUSHL`009#1`009`009`009; number of FAO args X`009PUSHL`009#UUDECODE_OPENIN`009; error message X`009CALLS`009#5,G`094LIB$SIGNAL`009`009; generate message X`009BRW`009250$`009`009`009; exit X; X30$:`009$CONNECT - X`009`009RAB=IRAB`009`009; connect the RMS stream X`009BLBS`009R0,40$`009`009`009; j if OK X; X; Failed to connect RMS input stream X; X`009CLRQ`009-(SP)`009`009`009; make space for temp descriptor X`009MOVAQ`009(SP),R1`009`009`009; point to it X`009MOVZBW`009INAM+NAM$B_ESL,DSC$W_LENGTH(R1)`009; fill it in X`009MOVB`009#DSC$K_DTYPE_T,DSC$B_DTYPE(R1) X`009MOVB`009#DSC$K_CLASS_S,DSC$B_CLASS(R1) X`009MOVL`009INAM+NAM$L_ESA,DSC$A_POINTER(R1) X`009PUSHL`009IRAB+RAB$L_STV`009`009; secondary RMS status X`009PUSHL`009R0`009`009`009; primary RMS status X`009PUSHL`009R1`009`009`009; filename X`009PUSHL`009#1`009`009`009; number of FAO args X`009PUSHL`009#UUDECODE_OPENIN`009; error message X`009CALLS`009#5,G`094LIB$SIGNAL`009`009; generate message X`009BRW`009250$`009`009`009; exit X; X; Get input buffer size X; X40$:`009MOVZWL`009IXAB+XAB$W_LRL,R0`009; get maximum record size X`009CMPL`009R0,#MINREC`009`009; check against minimum buffer X`009BGEQ`00950$`009`009`009; j if OK X`009MOVL`009#MINREC,R0`009`009; else make it that X; X; Allocate the input buffer X; X50$:`009ADDL2`009#4,R0`009`009`009; add margin for incomplete groups X`009MOVW`009R0,IRAB+RAB$W_USZ`009; set maximum user buffer size X`009PUSHL`009R0`009`009`009; store buffer size for allocate X`009MOVAL`009(SP),R0`009`009`009; get its address for call X`009PUSHAL`009IRAB+RAB$L_UBF`009`009; address for buffer address X`009PUSHL`009R0`009`009`009; address of buffer length X`009CALLS`009#2,G`094LIB$GET_VM`009`009; allocate buffer X`009POPL`009R1`009`009`009; clear stack X`009BLBS`009R0,60$`009`009`009; j if allocated OK X`009PUSHL`009R0`009`009`009; status for message X`009CALLS`009#1,G`094LIB$SIGNAL`009`009; generate message X`009BRW`009250$`009`009`009; else error X; X; Get output filename. This is stored in the first significant record of X; the input file. We skip down the input file until a line starting with X; "begin" is found. X; X60$:`009$GET - X`009`009RAB=IRAB`009`009; read a record X`009CMPL`009R0,#RMS$_EOF`009`009; end of file? X`009BNEQ`00970$`009`009`009; j if not X`009PUSHL`009#UUDECODE_NOBEGIN`009; error code X`009CALLS`009#1,G`094LIB$SIGNAL`009`009; generate message X`009BRW`009250$`009`009`009; exit X; X70$:`009BLBS`009R0,80$`009`009`009; j if otherwise OK X`009CLRQ`009-(SP)`009`009`009; make space for temp descriptor X`009MOVAQ`009(SP),R1`009`009`009; point to it X`009MOVZBW`009INAM+NAM$B_ESL,DSC$W_LENGTH(R1)`009; fill it in X`009MOVB`009#DSC$K_DTYPE_T,DSC$B_DTYPE(R1) X`009MOVB`009#DSC$K_CLASS_S,DSC$B_CLASS(R1) X`009MOVL`009INAM+NAM$L_ESA,DSC$A_POINTER(R1) X`009PUSHL`009IRAB+RAB$L_STV`009`009; secondary RMS status X`009PUSHL`009R0`009`009`009; primary RMS status X`009PUSHL`009R1`009`009`009; filename X`009PUSHL`009#1`009`009`009; number of FAO args X`009PUSHL`009#UUDECODE_READERR`009; error message X`009CALLS`009#5,G`094LIB$SIGNAL`009`009; generate message X`009BRW`009250$`009`009`009; exit X; X80$:`009MOVW`009IRAB+RAB$W_RSZ,R0`009; get input record length X`009CMPW`009R0,HEADER+DSC$W_LENGTH`009; long enough? X`009BGEQ`00990$`009`009`009; j if so X`009BRW`00960$`009`009`009; else keep looking X; X90$:`009MOVW`009HEADER+DSC$W_LENGTH,REC_D+DSC$W_LENGTH`009; set up descripto Vr X`009MOVL`009IRAB+RAB$L_RBF,REC_D+DSC$A_POINTER X`009PUSHAQ`009HEADER`009`009`009; set up for compare X`009PUSHAQ`009REC_D X`009CALLS`009#2,G`094STR$COMPARE_EQL`009; are they the same? X`009BLBC`009R0,100$`009`009`009; j if so - got it X`009BRW`00960$`009`009`009; else keep looking X; X; We have the header line. Extract the filename and mode from it. X; X; First the mode. X; X100$:`009MOVW`009IRAB+RAB$W_RSZ,REC_D+DSC$W_LENGTH`009; desc to whole line X`009PUSHAQ`009REC_D`009`009`009; set up for translation X`009PUSHAQ`009REC_D X`009CALLS`009#2,G`094STR$UPCASE`009`009; convert to upper case X`009PUSHAQ`009REC_D`009`009`009; set up for trim X`009PUSHAQ`009REC_D X`009CALLS`009#2,G`094STR$TRIM`009`009; trim trailing blanks X`009PUSHL`009#1`009`009`009; require element 1 - the mode X`009MOVAL`009(SP),R0`009`009`009; point to it X`009PUSHAQ`009REC_D`009`009`009; source string X`009PUSHAQ`009SPACE`009`009`009; delimiter X`009PUSHL`009R0`009`009`009; element number X`009PUSHAQ`009WRK_D`009`009`009; destination X`009CALLS`009#4,G`094STR$ELEMENT`009; extract element X`009ADDL2`009#4,SP`009`009`009; lose element number X`009CMPL`009R0,#STR$_NOELEM`009`009; element present? X`009BNEQ`009120$`009`009`009; j if so X; X110$:`009PUSHL`009#UUDECODE_BADBEGIN`009; error code X`009CALLS`009#1,G`094LIB$SIGNAL`009`009; generate message X`009BRW`009250$`009`009`009; exit X; X; The mode is now in WRK_D; decode it and store into the XAB for the X; output file. X; X120$:`009TSTW`009WRK_D+DSC$W_LENGTH`009; null field? X`009BEQL`009110$`009`009`009; j if so - error X`009CLRL`009-(SP)`009`009`009; space for result X`009MOVAL`009(SP),R0`009`009`009; point to it X`009PUSHL`009R0`009`009`009; stack for call X`009PUSHL`009WRK_D+DSC$A_POINTER`009; address of string X`009MOVZWL`009WRK_D+DSC$W_LENGTH,-(SP); length of string X`009CALLS`009#3,G`094LIB$CVT_OTB`009; convert octal string X`009BLBC`009R0,110$`009`009`009; j if error X`009POPL`009R0`009`009`009; get decoded mode X`009CLRL`009R1`009`009`009; set (S:RWED,O:RWED,G:RWED,W:RWED) X`009EXTZV`009#0,#3,R0,R2`009`009; extract required world permission X`009BSBW`009FIXPROT`009`009`009; reformat X`009INSV`009R2,#XAB$V_WLD,#XAB$S_WLD,R1`009; insert into protection word X`009EXTZV`009#3,#3,R0,R2`009`009; extract required group permission X`009BSBW`009FIXPROT`009`009`009; reformat X`009INSV`009R2,#XAB$V_GRP,#XAB$S_GRP,R1`009; insert into protection word X`009EXTZV`009#6,#3,R0,R2`009`009; extract required owner permission X`009BSBW`009FIXPROT`009`009`009; reformat X`009BICB2`009#XAB$M_NODEL,R2`009`009; allow delete permission X`009INSV`009R2,#XAB$V_OWN,#XAB$S_OWN,R1`009; insert into protection word X`009MOVW`009R1,OXAB+XAB$W_PRO`009; set into the XAB X; X; Now the output filename. X; X`009PUSHL`009#2`009`009`009; require element 2 - the name X`009MOVAL`009(SP),R0`009`009`009; point to it X`009PUSHAQ`009REC_D`009`009`009; source string X`009PUSHAQ`009SPACE`009`009`009; delimiter X`009PUSHL`009R0`009`009`009; element number X`009PUSHAQ`009OUT_D`009`009`009; destination X`009CALLS`009#4,G`094STR$ELEMENT`009; extract element X`009ADDL2`009#4,SP`009`009`009; lose element number X`009CMPL`009R0,#STR$_NOELEM`009`009; element present? X`009BNEQ`009130$`009`009`009; j if so X`009PUSHL`009#UUDECODE_BADBEGIN`009; error code X`009CALLS`009#1,G`094LIB$SIGNAL`009`009; generate message X`009BRW`009250$`009`009`009; exit X; X; The name is now in OUT_D; store it into the FAB for the X; output file. X; X130$:`009TSTW`009OUT_D+DSC$W_LENGTH`009; null name? X`009BNEQ`009140$`009`009`009; j if not X`009BRW`009110$`009`009`009; else error X; X140$:`009MOVL`009OUT_D+DSC$A_POINTER,R1`009; get address of output filename X`009$FAB_STORE -`009`009`009; fill filename into FAB X`009`009FAB=OFAB, - X`009`009FNA=(R1), - `009`009; address of filename X`009`009FNS=OUT_D+DSC$W_LENGTH`009; length of filename X; X; Get output file format keyword value, and set appropriate attributes X; X`009PUSHAQ`009BINARY`009`009`009; check for BINARY keyword X`009CALLS`009#1,G`094CLI$PRESENT`009; see if present X`009BLBC`009R0,150$`009`009`009; j if not X`009BISB2`009#UUDEC_M_BINARY,MFLAGS`009; remember binary required X; X; The output file is to be a binary file. Set attributes. X; X`009$FAB_STORE - X`009`009FAB=OFAB, - X`009`009MRS=#BINRECSIZ, -`009; fixed binary record size X`009`009RAT=NIL, -`009`009; no record attributes X`009`009RFM=FIX`009`009`009; fixed length records X`009MOVL`009#BINRECSIZ,R0`009`009; set record size X`009BRB`009160$`009`009`009; join common code X; X; The output file is to be a text file. Set attributes. X; X150$:`009$FAB_STORE - X`009`009FAB=OFAB, - X`009`009MRS=#0, -`009`009; no maximum record size X`009`009RAT=CR, -`009`009; CR format X`009`009RFM=VAR`009`009`009; variable length records X`009MOVL`009#DEFRECSIZ,R0`009`009; assume default record size for now X; X; Set the output record size and allocate a record buffer. X; X160$:`009MOVL`009R0,OBUFSIZ`009`009; set initial buffer size X`009PUSHAL`009OBUFAD`009`009`009; address for buffer address X`009PUSHAL`009OBUFSIZ`009`009`009; address of buffer length X`009CALLS`009#2,G`094LIB$GET_VM`009`009; allocate buffer X`009BLBS`009R0,170$`009`009`009; j if allocated OK X`009PUSHL`009R0`009`009`009; status for message X`009CALLS`009#1,G`094LIB$SIGNAL`009`009; generate message X`009BRW`009250$`009`009`009; else error X; X; Create and open the output file X; X170$:`009$CREATE - X`009`009FAB=OFAB`009`009; do the file open X`009BLBS`009R0,180$`009`009`009; j if opened OK X; X; Failed to open output file X; X`009CLRQ`009-(SP)`009`009`009; make space for temp descriptor X`009MOVAQ`009(SP),R1`009`009`009; point to it X`009MOVZBW`009ONAM+NAM$B_ESL,DSC$W_LENGTH(R1)`009; fill it in X`009MOVB`009#DSC$K_DTYPE_T,DSC$B_DTYPE(R1) X`009MOVB`009#DSC$K_CLASS_S,DSC$B_CLASS(R1) X`009MOVL`009ONAM+NAM$L_ESA,DSC$A_POINTER(R1) X`009PUSHL`009OFAB+FAB$L_STV`009`009; secondary RMS status X`009PUSHL`009R0`009`009`009; primary RMS status X`009PUSHL`009R1`009`009`009; filename X`009PUSHL`009#1`009`009`009; number of FAO args X`009PUSHL`009#UUDECODE_OPENOUT`009; error message X`009CALLS`009#5,G`094LIB$SIGNAL`009`009; generate message X`009BRW`009250$`009`009`009; exit X; X180$:`009$CONNECT - X`009`009RAB=ORAB`009`009; connect the RMS stream X`009BLBS`009R0,190$`009`009`009; j if connected OK X; X; Failed to connect RMS output stream X; X`009CLRQ`009-(SP)`009`009`009; make space for temp descriptor X`009MOVAQ`009(SP),R1`009`009`009; point to it X`009MOVZBW`009ONAM+NAM$B_ESL,DSC$W_LENGTH(R1)`009; fill it in X`009MOVB`009#DSC$K_DTYPE_T,DSC$B_DTYPE(R1) X`009MOVB`009#DSC$K_CLASS_S,DSC$B_CLASS(R1) X`009MOVL`009ONAM+NAM$L_ESA,DSC$A_POINTER(R1) X`009PUSHL`009ORAB+RAB$L_STV`009`009; secondary RMS status X`009PUSHL`009R0`009`009`009; primary RMS status X`009PUSHL`009R1`009`009`009; filename X`009PUSHL`009#1`009`009`009; number of FAO args X`009PUSHL`009#UUDECODE_OPENOUT`009; error message X`009CALLS`009#5,G`094LIB$SIGNAL`009`009; generate message X`009BRW`009250$`009`009`009; exit X; X; Check for and record any use of the LOG qualifier X; X190$:`009PUSHAQ`009LOG`009`009`009; check for LOG qualifier X`009CALLS`009#1,G`094CLI$PRESENT`009; see if present X`009BLBC`009R0,200$`009`009`009; j if not X`009BISB2`009#UUDEC_M_LOG,MFLAGS`009; else set LOG flag X; X; Files are now open; do the conversion X; X200$:`009CALLS`009#0,DO_DECODE`009`009; returns any status in R0 X`009PUSHL`009R0`009`009`009; save status X; X; Output any logging message X; X`009BBC`009#UUDEC_V_LOG,MFLAGS,230$; j if no logging X`009PUSHAQ`009OUT_D`009`009`009; output filename X`009BBC`009#UUDEC_V_BINARY,MFLAGS,210$`009; j if not binary conversion X`009PUSHAQ`009BINTYPE`009`009`009; "binary" X`009BRB`009220$ X; X210$:`009PUSHAQ`009TEXTYPE`009`009`009; "text" X; X220$:`009PUSHAQ`009INP_D`009`009`009; input filename X`009PUSHL`009#3`009`009`009; number of FAO args X`009PUSHL`009#UUDECODE_DECODED`009; message X`009CALLS`009#5,G`094LIB$SIGNAL`009`009; output message X; X; Close input and output files X; X230$:`009$CLOSE - X`009`009FAB=IFAB`009`009; does DISCONNECT too; ignore status X`009$CLOSE - X`009`009FAB=OFAB`009`009; does DISCONNECT too X`009BLBS`009R0,240$`009`009`009; j if OK X`009CLRQ`009-(SP)`009`009`009; make space for temp descriptor X`009MOVAQ`009(SP),R1`009`009`009; point to it X`009MOVZBW`009ONAM+NAM$B_ESL,DSC$W_LENGTH(R1)`009; fill it in X`009MOVB`009#DSC$K_DTYPE_T,DSC$B_DTYPE(R1) X`009MOVB`009#DSC$K_CLASS_S,DSC$B_CLASS(R1) X`009MOVL`009ONAM+NAM$L_ESA,DSC$A_POINTER(R1) X`009PUSHL`009ORAB+RAB$L_STV`009`009; secondary RMS status X`009PUSHL`009R0`009`009`009; primary RMS status X`009PUSHL`009R1`009`009`009; filename X`009PUSHL`009#1`009`009`009; number of FAO args X`009PUSHL`009#UUDECODE_WRITERR`009; error message +-+-+-+-+-+-+-+- END OF PART 1 +-+-+-+-+-+-+-+- -+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+ X`009CALLS`009#5,G`094LIB$SIGNAL`009`009; generate message X`009BRW`009250$`009`009`009; exit X; X240$:`009POPL`009R0`009`009`009; recover status X; X250$:`009RET`009`009`009`009; exit to system X; X; X; Subroutine to reformat a UNIX 3-bit protection field into the X; corresponding 4-bit VMS field. Delete permission is not included. X; X; Input parameters: X; X;`009R2`009- UNIX 3-bit permission X; X; Output parameters: X; X;`009R2`009- VMS 4-bit permission X; XFIXPROT: X`009PUSHL`009R0`009`009`009; save register for working X`009CLRL`009R0`009`009`009; initialise to allow all permissions X`009BISB2`009#XAB$M_NODEL,R0`009`009; disallow delete permission X`009BBS`009#0,R2,10$`009`009; j if execute permission X`009BISB2`009#XAB$M_NOEXE,R0`009`009; disallow execute permission X; X10$:`009BBS`009#1,R2,20$`009`009; j if write permission X`009BISB2`009#XAB$M_NOWRITE,R0`009; disallow write permission X; X20$:`009BBS`009#2,R2,30$`009`009; j if read permission X`009BISB2`009#XAB$M_NOREAD,R0`009; disallow read permission X; X30$:`009MOVL`009R0,R2`009`009`009; set result X`009POPL`009R0`009`009`009; recover register X`009RSB`009`009`009`009; return X; X`009.SUBTITLE`009Decode the file X`009.PAGE X; X; This routine performs the actual decoding and data transfer X; X; Input parameters: none X; X; Output parameters: X; X; R0`009`009- status X; X`009.ENTRY`009DO_DECODE,`094M X; X; During the copy: X; R2 = input record buffer counter X; R3 = input buffer pointer X; R4 = output record buffer counter X; R5 = output buffer pointer X; R6 = input record byte count X; X`009CLRL`009R4`009`009`009; nothing in output buffer X`009MOVL`009OBUFAD,R5`009`009; initialise output buffer pointer X; X; Set up input buffer descriptor X; X`009MOVL`009IRAB+RAB$L_RBF,REC_D+DSC$A_POINTER X`009MOVW`009IRAB+RAB$W_RSZ,REC_D+DSC$W_LENGTH X; X; Main copying loop X; X10$:`009MOVZWL`009REC_D+DSC$W_LENGTH,-(SP); repetition count X`009MOVAL`009(SP),R0`009`009`009; point to it X`009PUSHL`009R0`009`009`009; count, by reference X`009PUSHAQ`009REC_D X`009CALLS`009#2,G`094STR$DUPL_CHAR`009; fill buffer with spaces X`009POPL`009R0`009`009`009; lose count from stack X`009$GET - X`009`009RAB=IRAB`009`009; read a record X`009CMPL`009R0,#RMS$_EOF`009`009; check for end of file X`009BNEQ`00920$`009`009`009; j if not end of file X`009CLRQ`009-(SP)`009`009`009; make space for temp descriptor X`009MOVAQ`009(SP),R1`009`009`009; point to it X`009MOVZBW`009INAM+NAM$B_ESL,DSC$W_LENGTH(R1)`009; fill it in X`009MOVB`009#DSC$K_DTYPE_T,DSC$B_DTYPE(R1) X`009MOVB`009#DSC$K_CLASS_S,DSC$B_CLASS(R1) X`009MOVL`009INAM+NAM$L_ESA,DSC$A_POINTER(R1) X`009PUSHL`009R1`009`009`009; filename X`009PUSHL`009#1`009`009`009; number of FAO args X`009PUSHL`009#UUDECODE_ENDOFFILE`009; error message X`009CALLS`009#3,G`094LIB$SIGNAL`009`009; generate message X`009BRW`009150$`009`009`009; exit X; X20$:`009BLBS`009R0,30$`009`009`009; j if read OK X`009CLRQ`009-(SP)`009`009`009; make space for temp descriptor X`009MOVAQ`009(SP),R1`009`009`009; point to it X`009MOVZBW`009INAM+NAM$B_ESL,DSC$W_LENGTH(R1)`009; fill it in X`009MOVB`009#DSC$K_DTYPE_T,DSC$B_DTYPE(R1) X`009MOVB`009#DSC$K_CLASS_S,DSC$B_CLASS(R1) X`009MOVL`009INAM+NAM$L_ESA,DSC$A_POINTER(R1) X`009PUSHL`009IFAB+FAB$L_STV`009`009; secondary RMS status X`009PUSHL`009R0`009`009`009; primary RMS status X`009PUSHL`009R1`009`009`009; filename X`009PUSHL`009#1`009`009`009; number of FAO args X`009PUSHL`009#UUDECODE_READERR`009; error message X`009CALLS`009#5,G`094LIB$SIGNAL`009`009; generate message X`009BRW`009150$`009`009`009; else some read error X; X30$:`009MOVZWL`009IRAB+RAB$W_RSZ,R2`009; get record length X`009BNEQ`00940$`009`009`009; j if not null record X`009BRW`00910$`009`009`009; else read another X; X40$:`009MOVL`009IRAB+RAB$L_RBF,R3`009; get buffer pointer X`009CLRQ`009-(SP)`009`009`009; make space for temp descriptor X`009MOVAQ`009(SP),R0`009`009`009; point to it X`009MOVW`009R2,DSC$W_LENGTH(R0)`009; set it up X`009MOVB`009#DSC$K_DTYPE_T,DSC$B_DTYPE(R0) X`009MOVB`009#DSC$K_CLASS_S,DSC$B_CLASS(R0) X`009MOVL`009R3,DSC$A_POINTER(R0) X`009PUSHAQ`009TR_FROM`009`009`009; set up for translation... X`009PUSHAQ`009TR_TO`009`009`009; ...of strange characters X`009PUSHL`009R0`009`009`009; translate in situ X`009PUSHL`009R0 X`009CALLS`009#4,G`094STR$TRANSLATE`009; do the translation X`009ADDL2`009#8,SP`009`009`009; lose temp descriptor X`009MOVZBL`009(R3)+,R6`009`009; get byte counter X`009SUBL2`009#`094A\ \,R6`009`009; convert to binary value X`009BGTR`00950$`009`009`009; j if OK X`009BEQL`00980$`009`009`009; j if finished - negative is error X`009PUSHL`009#UUDECODE_CORRUPT`009; error code X`009CALLS`009#1,G`094LIB$SIGNAL`009`009; generate message X`009BRW`009150$`009`009`009; exit X; X; Loop to handle each byte group in record X; X50$:`009SUBB3`009#`094A\ \,(R3)+,R0`009`009; get next 6-bit group X`009SUBB3`009#`094A\ \,(R3)+,R1`009`009; get next 6-bit group X`009ASHL`009#2,R0,R0`009`009; move into correct place X`009PUSHL`009R1`009`009`009; save copy X`009ASHL`009#-4,R1,R1`009`009; only need top two bits X`009INSV`009R1,#0,#2,R0`009`009; combine with other 6 X`009BSBW`009PUTBYTE`009`009`009; output first byte X`009BLBC`009R0,70$`009`009`009; j if error X`009POPL`009R0`009`009`009; recover second group X`009DECL`009R6`009`009`009; more to output? X`009BEQL`00960$`009`009`009; j if not X`009ASHL`009#4,R0,R0`009`009; move other 4 bits into correct place X`009SUBB3`009#`094A\ \,(R3)+,R1`009`009; get next 6-bit group X`009PUSHL`009R1`009`009`009; save copy X`009ASHL`009#-2,R1,R1`009`009; only need top four bits X`009INSV`009R1,#0,#4,R0`009`009; insert required 4 bits X`009BSBW`009PUTBYTE`009`009`009; output second byte X`009BLBC`009R0,70$`009`009`009; j if error X`009POPL`009R0`009`009`009; recover third group X`009DECL`009R6`009`009`009; more to output? X`009BEQL`00960$`009`009`009; j if not X`009ASHL`009#6,R0,R0`009`009; move other 2 bits into correct place X`009SUBB3`009#`094A\ \,(R3)+,R1`009`009; get last 6-bit group X`009INSV`009R1,#0,#6,R0`009`009; insert final 6 bits X`009BSBW`009PUTBYTE`009`009`009; output third byte X`009BLBC`009R0,70$`009`009`009; j if error X`009DECL`009R6`009`009`009; more to output? X`009BNEQ`00950$`009`009`009; j if so X; X60$:`009BRW`00910$`009`009`009; get another record X; X70$:`009BRW`00990$`009`009`009; output error message X; X; End of input file; flush any partial output record. In the case of binary X; output, fill the rest of the record with zeros. X; X80$:`009TSTL`009R4`009`009`009; anything to write? X`009BNEQ`00982$`009`009`009; j if so X`009BRW`009100$`009`009`009; else nothing to do X; X82$:`009BBC`009#UUDEC_V_BINARY, -`009; j if text file X`009`009MFLAGS,85$ X`009SUBL3`009R4,#BINRECSIZ,R0`009; derive length of remainder X`009MOVC5`009#0,(R5),#0,R0,(R5)`009; fill with zeros X`009MOVL`009#BINRECSIZ,R4`009`009; set full fixed record size X; X85$:`009CLRQ`009-(SP)`009`009`009; make temp descriptor X`009MOVAQ`009(SP),R0`009`009`009; point to it X`009MOVW`009R4,DSC$W_LENGTH(R0)`009; set it up X`009MOVB`009#DSC$K_DTYPE_T,DSC$B_DTYPE(R0) X`009MOVB`009#DSC$K_CLASS_S,DSC$B_CLASS(R0) X`009MOVL`009OBUFAD,DSC$A_POINTER(R0) X`009PUSHL`009R0`009`009`009; record descriptor X`009CALLS`009#1,PUTREC`009`009; write partial record X`009ADDL2`009#8,SP`009`009`009; lose descriptor X`009BLBC`009R0,90$`009`009`009; j if error X`009BRW`009100$`009`009`009; else perform final checks and exit X; X90$:`009CLRQ`009-(SP)`009`009`009; make space for temp descriptor X`009MOVAQ`009(SP),R1`009`009`009; point to it X`009MOVZBW`009ONAM+NAM$B_ESL,DSC$W_LENGTH(R1)`009; fill it in X`009MOVB`009#DSC$K_DTYPE_T,DSC$B_DTYPE(R1) X`009MOVB`009#DSC$K_CLASS_S,DSC$B_CLASS(R1) X`009MOVL`009ONAM+NAM$L_ESA,DSC$A_POINTER(R1) X`009PUSHL`009ORAB+RAB$L_STV`009`009; secondary RMS status X`009PUSHL`009R0`009`009`009; primary RMS status X`009PUSHL`009R1`009`009`009; filename X`009PUSHL`009#1`009`009`009; number of FAO args X`009PUSHL`009#UUDECODE_WRITERR`009; error message X`009CALLS`009#5,G`094LIB$SIGNAL`009`009; generate message X`009MOVL`009#UUDECODE_WRITERR,R0`009; final status X`009BRW`009150$`009`009`009; exit X; X; The input file has been completely processed as regards actual data. The X; last task is to check that the next record is in fact an "end" line; if no Vt, X; output a warning message X; X100$:`009$GET - X`009`009RAB=IRAB`009`009; read a record X`009CMPL`009R0,#RMS$_EOF`009`009; end of file? X`009BNEQ`009110$`009`009`009; j if not X`009BRW`009130$ X; X110$:`009BLBS`009R0,120$`009`009`009; j if otherwise OK X`009CLRQ`009-(SP)`009`009`009; make space for temp descriptor X`009MOVAQ`009(SP),R1`009`009`009; point to it X`009MOVZBW`009INAM+NAM$B_ESL,DSC$W_LENGTH(R1)`009; fill it in X`009MOVB`009#DSC$K_DTYPE_T,DSC$B_DTYPE(R1) X`009MOVB`009#DSC$K_CLASS_S,DSC$B_CLASS(R1) X`009MOVL`009INAM+NAM$L_ESA,DSC$A_POINTER(R1) X`009PUSHL`009IRAB+RAB$L_STV`009`009; secondary RMS status X`009PUSHL`009R0`009`009`009; primary RMS status X`009PUSHL`009R1`009`009`009; filename X`009PUSHL`009#1`009`009`009; number of FAO args X`009PUSHL`009#UUDECODE_READERR`009; error message X`009CALLS`009#5,G`094LIB$SIGNAL`009`009; generate message X`009BRW`009150$`009`009`009; exit X; X120$:`009MOVW`009IRAB+RAB$W_RSZ,R0`009; get input record length X`009CMPW`009R0,TRAILER+DSC$W_LENGTH`009; long enough? X`009BLSS`009130$`009`009`009; j if not X`009MOVW`009TRAILER+DSC$W_LENGTH,REC_D+DSC$W_LENGTH`009; set up descriptor X`009MOVL`009IRAB+RAB$L_RBF,REC_D+DSC$A_POINTER X`009PUSHAQ`009TRAILER`009`009`009; set up for compare X`009PUSHAQ`009REC_D X`009CALLS`009#2,G`094STR$COMPARE_EQL`009; are they the same? X`009BLBC`009R0,140$`009`009`009; j if so - got it X; X; The end line was not found; output warning message X; X130$:`009PUSHL`009#UUDECODE_NOEND`009`009; status code X`009CALLS`009#1,G`094LIB$SIGNAL`009`009; output message X; X140$:`009MOVL`009#SS$_NORMAL,R0`009`009; indicate success X; X150$:`009RET X; X; X; Subroutine to output one byte. If the output is a text file, newline X; causes a new record to be started. X; X; Input parameters: X; X;`009R0`009- byte to be output X; X; Output parameters: X; X;`009R0`009- status X; XPUTBYTE: X`009BBS`009#UUDEC_V_BINARY, - X`009`009MFLAGS,10$`009`009; j if binary output - no newline processing X`009CMPB`009R0,#NL`009`009`009; newline? X`009BNEQ`00910$`009`009`009; j if not X`009CLRQ`009-(SP)`009`009`009; make temp descriptor X`009MOVAQ`009(SP),R0`009`009`009; point to it X`009MOVW`009R4,DSC$W_LENGTH(R0)`009; set it up X`009MOVB`009#DSC$K_DTYPE_T,DSC$B_DTYPE(R0) X`009MOVB`009#DSC$K_CLASS_S,DSC$B_CLASS(R0) X`009MOVL`009OBUFAD,DSC$A_POINTER(R0) X`009PUSHL`009R0`009`009`009; record descriptor X`009CALLS`009#1,PUTREC`009`009; write partial record X`009ADDL2`009#8,SP`009`009`009; lose descriptor X`009MOVL`009OBUFAD,R5`009`009; reset buffer pointer X`009CLRL`009R4`009`009`009; reset byte counter X`009BRW`00999$`009`009`009; exit with status in R0 X; X10$:`009MOVB`009R0,(R5)+`009`009; put byte into buffer X`009INCL`009R4`009`009`009; increment byte count X`009CMPL`009R4,OBUFSIZ`009`009; buffer full? X`009BEQL`00920$`009`009`009; j if so X`009BRW`00998$`009`009`009; else exit X; X; The output buffer is full. If it is a binary output file, this is easy; X; just flush the buffer and return. X; X20$:`009BBC`009#UUDEC_V_BINARY, -`009; j if text file X`009`009MFLAGS,30$ X`009CLRQ`009-(SP)`009`009`009; make temp descriptor X`009MOVAQ`009(SP),R0`009`009`009; point to it X`009MOVW`009R4,DSC$W_LENGTH(R0)`009; set it up X`009MOVB`009#DSC$K_DTYPE_T,DSC$B_DTYPE(R0) X`009MOVB`009#DSC$K_CLASS_S,DSC$B_CLASS(R0) X`009MOVL`009OBUFAD,DSC$A_POINTER(R0) X`009PUSHL`009R0`009`009`009; record descriptor X`009CALLS`009#1,PUTREC`009`009; write partial record X`009ADDL2`009#8,SP`009`009`009; lose descriptor X`009MOVL`009OBUFAD,R5`009`009; reset buffer pointer X`009CLRL`009R4`009`009`009; reset byte count X`009BRW`00999$`009`009`009; exit with status in R0 X; X; The text output buffer has overflowed. Allocate a bigger buffer, and X; change over to that. X; X30$:`009CLRQ`009-(SP)`009`009`009; make space for descriptor X`009MOVAQ`009(SP),R1`009`009`009; point to it X`009ADDL3`009OBUFSIZ,#OBUFINC,-(SP)`009; store buffer size for allocate X`009MOVAL`009(SP),R0`009`009`009; get its address for call X`009MOVW`009(R0),DSC$W_LENGTH(R1)`009; fill in descriptor X`009MOVB`009#DSC$K_DTYPE_T,DSC$B_DTYPE(R1) X`009MOVB`009#DSC$K_CLASS_S,DSC$B_CLASS(R1) X`009PUSHAL`009DSC$A_POINTER(R1)`009; address for buffer address X`009PUSHL`009R0`009`009`009; address of buffer length X`009CALLS`009#2,G`094LIB$GET_VM`009`009; allocate buffer X`009POPL`009R1`009`009`009; clear size from stack X`009BLBS`009R0,40$`009`009`009; j if allocated OK X`009ADDL2`009#8,SP`009`009`009; clear descriptor from stack X`009BRW`00999$`009`009`009; exit with status in R0 X; X40$:`009MOVL`009DSC$A_POINTER(SP),R1`009; recover new buffer address X`009PUSHR`009#`094M`009; save registers X`009MOVC3`009R4,@OBUFAD,(R1)`009`009; copy buffer contents X`009POPR`009#`094M`009; recover registers X`009PUSHAL`009OBUFAD`009`009`009; set up to free old buffer X`009PUSHAL`009OBUFSIZ X`009CALLS`009#2,G`094LIB$FREE_VM`009; free old buffer X`009SUBL2`009OBUFAD,R5`009`009; adjust pointer to new buffer X`009MOVL`009DSC$A_POINTER(SP),OBUFAD; record new buffer X`009MOVZWL`009DSC$W_LENGTH(SP),OBUFSIZ; record new buffer size X`009ADDL2`009#8,SP`009`009`009; clear descriptor from stack X`009ADDL2`009OBUFAD,R5`009`009; point into new buffer X; X98$:`009MOVL`009#SS$_NORMAL,R0`009`009; indicate success X; X99$:`009RSB`009`009`009`009; exit X; X`009.SUBTITLE`009Write record to output file X`009.PAGE X; X; This routine writes a single record to the output file. X; X; Input parameters: X; X; 4(AP)`009- record buffer (string descriptor, by reference) X; X; Output parameters: X; X; R0`009`009- status X; X`009.ENTRY`009PUTREC,`094M<> X; X`009PUSHAL`009ORAB+RAB$L_RBF`009`009; place to put address X`009PUSHAW`009ORAB+RAB$W_RSZ`009`009; place to put length X`009PUSHL`0094(AP)`009`009`009; descriptor for analysis X`009CALLS`009#3,G`094STR$ANALYZE_SDESC`009; get data address and length X; X10$:`009$PUT - X`009`009RAB=ORAB`009`009; write record, drop through X; X20$:`009RET X; X`009.SUBTITLE`009Extract string element X`009.PAGE X; X; This routine extracts an element from a string. It mimics the Version 5 X; routine of the same name. X; X; Input parameters: X; X;`0094(AP)`009Destination string (descriptor, by reference) X;`0098(AP)`009Element number (longword, by reference) X;`00912(AP)`009Delimiter (descriptor, by reference) X;`00916(AP)`009Source string (descriptor, by reference) X; X; Output parameters: X; X;`009R0`009= status (restricted, only SS$_NORMAL and SS$_ABORT X;`009`009 and STR$_NOELEM) X; X`009.EXTERNAL`009STR$COPY_DX X`009.EXTERNAL`009STR$POSITION X; X`009.ENTRY`009STR$ELEMENT,`094M X; X`009MOVL`00912(AP),R7`009`009; point to delimiter descriptor X`009CMPW`009DSC$W_LENGTH(R7),#1`009; check delimiter is one character X`009BEQL`00910$`009`009`009; j if so X`009BRW`00999$`009`009`009; else error X; X10$:`009MOVQ`009@16(AP),-(SP)`009`009; copy source descriptor X`009MOVAQ`009(SP),R9`009`009`009; point to copy X`009MOVL`009@8(AP),R8`009`009; get element number X`009CLRL`009-(SP)`009`009`009; initialise search position X`009MOVAL`009(SP),R10`009`009; point to it for call X; X20$:`009TSTL`009R8`009`009`009; found element yet? X`009BEQL`00940$`009`009`009; j if so X`009PUSHL`009R10`009`009`009; start position X`009PUSHL`009R7`009`009`009; substring X`009PUSHL`009R9`009`009`009; source string X`009CALLS`009#3,G`094STR$POSITION`009; find next occurrence X`009TSTL`009R0`009`009`009; found? X`009BNEQ`00930$`009`009`009; j if so X`009MOVL`009#SS$_ABORT,R0`009`009; error status X`009BRW`00999$`009`009`009; exit X; X30$:`009DECL`009R8`009`009`009; decrement element count X`009ADDL2`009R0,DSC$A_POINTER(R9)`009; point to start of next element X`009SUBW2`009R0,DSC$W_LENGTH(R9)`009; adjust total length X`009BGTR`00920$`009`009`009; j if something left X`009MOVL`009#SS$_ABORT,R0`009`009; else error X`009BRW`00999$ X; X; The source descriptor in R9 now points to the start of the required X; element. Truncate if another delimiter is found. X; X40$:`009PUSHL`009R10`009`009`009; start position X`009PUSHL`009R7`009`009`009; substring X`009PUSHL`009R9`009`009`009; source string X`009CALLS`009#3,G`094STR$POSITION`009; any delimiter? X`009TSTL`009R0 X`009BEQL`00950$`009`009`009; j if not - finished X`009SUBW3`009#1,R0,DSC$W_LENGTH(R9)`009; adjust final length X; X; R9 now points to the required substring's descriptor. Copy the substring X; to the output string. X; X50$:`009PUSHL`009R9`009`009`009; source string X`009PUSHL`0094(AP)`009`009`009; destination string X`009CALLS`009#2,G`094STR$COPY_DX`009; copy it X; X99$:`009RET X; X`009.END`009BEGIN $ CALL UNPACK [.UUENCODE.DECODE]UUDECODE.MAR;14 842536596 $ create/nolog 'f' X`009`009.TITLE`009UUDECODE$MSG - messages for UUDECODE X`009`009.IDENT`009"V01-00" X! X`009`009.FACILITY UUDECODE,15 X! X`009`009.BASE`0091 X`009`009.SEVERITY FATAL X! XBADBEGIN`009/FAO_COUNT=0 XCORRUPT`009`009/FAO_COUNT=0 XENDOFFILE`009/FAO_COUNT=1 XNOBEGIN`009`009/FAO_COUNT=0 XOPENIN`009`009/FAO_COUNT=1 XOPENOUT`009`009/FAO_COUNT=1 XREADERR`009`009/FAO_COUNT=1 XWRITERR`009`009/FAO_COUNT=1 X! X`009`009.BASE`00910 X`009`009.SEVERITY INFORMATIONAL XDECODED`009`009/FAO_COUNT=3 XVERSION`009`009/FAO_COUNT=2 X! X`009`009.BASE`00920 X`009`009.SEVERITY WARNING XNOEND`009`009/FAO_COUNT=0 X! X`009`009.END $ CALL UNPACK [.UUENCODE.DECODE]UUDECODEMSG.MSG;4 425345339 $ create/nolog 'f' X! X! File: UUENCODE.CLD X! X! Command definition for UUENCODE X! X! R.D. Eager University of Kent November 1988 X! X Xdefine type FORMAT_TYPES X`009keyword BINARY, nonnegatable X`009keyword EMAS_BINARY, nonnegatable X`009keyword TEXT, default, nonnegatable X Xdefine verb UUENCODE X X`009image DISK$USER6:`091CUR022.uu.encode`093UUENCODE X X`009parameter P1 X`009`009prompt="File" X`009`009value(noconcatenate,required,type=$infile) X X`009qualifier FORMAT X`009`009default X`009`009nonnegatable X`009`009placement=global X`009`009value(required,type=FORMAT_TYPES) X X`009qualifier LOG X`009`009negatable X`009`009placement=global X X`009qualifier OUTPUT X`009`009default X`009`009nonnegatable X`009`009placement=global X`009`009value(default=sys$output,type=$outfile) X X`009qualifier REMOTE_FILE X`009`009nonnegatable X`009`009placement=global X`009`009value(required,type=$quoted_string) X X`009qualifier VERSION X`009`009nonnegatable X`009`009placement=global X X`009disallow ANY2(FORMAT.BINARY, FORMAT.EMAS_BINARY, FORMAT.TEXT) X! X! End of file: UUENCODE.CLD X! $ CALL UNPACK [.UUENCODE.ENCODE]UUENCODE.CLD;4 1141646079 $ create/nolog 'f' X`009.TITLE`009UUENCODE X`009.IDENT`009\V01-00\ X; X; UNIX UUCP encoding utility X; X; R.D. Eager University of Kent November 1988 X; X`009.DISABLE`009GLOBAL X`009.ENABLE`009`009SUPPRESSION X; X; X; Manifest constants X; -------- --------- X; X; Version information X; X`009VERSION`009`009= 1`009`009; Major version X`009EDIT`009`009= 0`009`009; Edit number within major version X; X; Miscellaneous constants X; X`009EMAS_BINTYPE`009= 4`009`009; EMAS file type for binary file X`009EMAS_CHARTYPE`009= 3`009`009; EMAS file type for character file X`009EMAS_END`009= 0`009`009; Longword offset of data end in hdr X`009EMAS_FILE_TYPE`009= 3`009`009; Longword offset of file type in hdr X`009EMAS_OBJTYPE`009= 1`009`009; EMAS file type for object file X`009EMAS_PDTYPE`009= 6`009`009; EMAS file type for pdfile X`009EMAS_START`009= 1`009`009; Longword offset of data start in hdr X`009EMASRECSIZ`009= 512`009`009; Record size for EMAS binary file X`009MAXNAME`009`009= 255`009`009; Max length of filename X`009NL`009`009= `094X0A`009`009; Newline character X`009OUTBUFSIZ`009= 61`009`009; Size of output buffer X; X; X; External symbols X; -------- ------- X; X`009.EXTERNAL`009CLI$GET_VALUE X`009.EXTERNAL`009CLI$PRESENT X`009.EXTERNAL`009LIB$GET_VM X`009.EXTERNAL`009LIB$SIGNAL X`009.EXTERNAL`009STR$ANALYZE_SDESC X`009.EXTERNAL`009STR$CONCAT X`009.EXTERNAL`009STR$COPY_R X`009.EXTERNAL`009STR$FREE1_DX X`009.EXTERNAL`009STR$TRANSLATE X; X; X; Messages X; -------- X; X`009.EXTERNAL`009UUENCODE_EMASCHARFILE X`009.EXTERNAL`009UUENCODE_EMASOBJFILE X`009.EXTERNAL`009UUENCODE_EMASPDFILE X`009.EXTERNAL`009UUENCODE_EMASUNKFILE X`009.EXTERNAL`009UUENCODE_ENCODED X`009.EXTERNAL`009UUENCODE_INVALFORMAT X`009.EXTERNAL`009UUENCODE_NOTEMASBIN X`009.EXTERNAL`009UUENCODE_OPENIN X`009.EXTERNAL`009UUENCODE_OPENOUT X`009.EXTERNAL`009UUENCODE_READERR X`009.EXTERNAL`009UUENCODE_VERSION X`009.EXTERNAL`009UUENCODE_WRITERR X; X; X; Macro libraries X; ----- --------- X; X`009.LIBRARY`009\SYS$LIBRARY:LIB.MLB\ X; X; X; System symbols X; ------ ------- X; X`009$DSCDEF`009`009`009`009; Descriptors X`009$FABDEF`009`009`009`009; File Access Block X`009$NAMDEF`009`009`009`009; Name Block X`009$RABDEF`009`009`009`009; Record Access Block X`009$RMSDEF`009`009`009`009; RMS status X`009$SSDEF`009`009`009`009; System services status X; X; X; Assumed relationships X; ------- ------------- X; X; Output buffer must be a multiple of 3 in size, plus one for the X; leading count X; X`009ASSUME`009<</3>*3> EQ OUTBUFSIZ-1 X; X`009.SUBTITLE`009Data areas X`009.PAGE X; X`009.PSECT`009`009DATA,CON,LCL,NOEXE,WRT,LONG X; XINP_D:`009.WORD`0090`009`009`009; Dynamic descriptor for input filename X`009.BYTE`009DSC$K_DTYPE_T X`009.BYTE`009DSC$K_CLASS_D X`009.LONG`0090 X; XOUT_D:`009.WORD`0090`009`009`009; Dynamic descriptor for output filename X`009.BYTE`009DSC$K_DTYPE_T X`009.BYTE`009DSC$K_CLASS_D X`009.LONG`0090 X; XREM_D:`009.WORD`0090`009`009`009; Dynamic descriptor for remote filename X`009.BYTE`009DSC$K_DTYPE_T X`009.BYTE`009DSC$K_CLASS_D X`009.LONG`0090 X; XWRK_D:`009.WORD`0090`009`009`009; Dynamic work descriptor X`009.BYTE`009DSC$K_DTYPE_T X`009.BYTE`009DSC$K_CLASS_D X`009.LONG`0090 X; XREC_D:`009.BLKW`0091`009`009`009; Descriptor for output record buffer X`009.BYTE`009DSC$K_DTYPE_T X`009.BYTE`009DSC$K_CLASS_S X`009.ADDRESS OUTBUF X; X; RMS control blocks for input file X; X`009.ALIGN`009LONG XIFAB:`009$FAB -`009`009`009`009; File Access Block X`009`009FAC=GET, -`009`009; GET service only X`009`009NAM=INAM, -`009`009; Associated NAM block X`009`009FOP=SQO , -`009`009; Sequential only X`009`009XAB=IXAB`009`009; Associated XAB X; XIXAB:`009$XABFHC`009`009`009`009; Extended Attribute Block (file header) X; XIRAB:`009$RAB -`009`009`009`009; Record Access Block X`009`009FAB=IFAB, -`009`009; Associated FAB X`009`009RAC=SEQ, -`009`009; Sequential access X`009`009ROP=RAH`009`009`009; Read ahead X; XINAM:`009$NAM -`009`009`009`009; Name Block X`009`009ESA=INAME, -`009`009; Expanded string area for name X`009`009ESS=MAXNAME`009`009; Length of expanded string area X; X; RMS control blocks for output file X; X`009.ALIGN`009LONG XOFAB:`009$FAB -`009`009`009`009; File Access Block X`009`009FAC=PUT, -`009`009; PUT service only X`009`009FOP=, -`009; Sequential only, truncate on close X`009`009MRS=0, -`009`009; No maximum record size X`009`009NAM=ONAM, -`009`009; Associated NAM block X`009`009ORG=SEQ, -`009`009; Sequential X`009`009RAT=CR, -`009`009; CR format X`009`009RFM=VAR`009`009`009; Variable length records X; XORAB:`009$RAB -`009`009`009`009; Record Access Block X`009`009FAB=OFAB, -`009`009; Associated FAB X`009`009RAC=SEQ, -`009`009; Sequential access X`009`009ROP=`009`009; Write behind X; XONAM:`009$NAM -`009`009`009`009; Name Block X`009`009ESA=ONAME, -`009`009; Expanded string area for name X`009`009ESS=MAXNAME`009`009; Length of expanded string area X; X; Miscellaneous storage X; XINAME:`009.BLKB`009MAXNAME`009`009`009; Area for expanded input filename XONAME:`009.BLKB`009MAXNAME`009`009`009; Area for expanded output filename XOUTBUF:`009.BLKB`009OUTBUFSIZ`009`009; Output record buffer XMFLAGS:`009.BLKB`0091`009`009`009; Miscellaneous flags X`009_VIELD`009UUENC,0,< - X`009`009, -`009`009; Binary file format X`009`009, -`009`009; EMAS binary file -> binary X`009`009, -`009`009; First block flag (EMAS binary only) X`009`009>`009`009; Informational messages required X; X`009.SUBTITLE`009Constant areas X`009.PAGE X; X`009.PSECT`009`009CONST,CON,LCL,NOEXE,NOWRT,LONG X; X; Parameter names X; XP1:`009.ASCID`009\P1\ X; X; Command qualifiers X; XFORMAT:`009.ASCID`009\FORMAT\`009`009; Output file format XLOG:`009.ASCID`009\LOG\`009`009`009; Generate informational messages XOUTPUT:`009.ASCID`009\OUTPUT\`009`009; Output file name XREMOTE:`009.ASCID`009\REMOTE_FILE\`009`009; File name at remote site XVERSIO:`009.ASCID`009\VERSION\`009`009; Display version message X; X; FORMAT qualifier keywords X; XBINARY:`009.ASCID`009\FORMAT.BINARY\`009`009; Binary output file XEMAS:`009.ASCID`009\FORMAT.EMAS_BINARY\`009; EMAS format binary file -> bina Vry XTEXT:`009.ASCID`009\FORMAT.TEXT\`009`009; Text output file X; X; Message inserts X; XBINTYPE:.ASCID`009\Binary\ XEBTYPE:`009.ASCID`009\EMAS binary\ XTEXTYPE:.ASCID`009\Text\ X; X; Translation tables for lower case conversion X; XTR_FROM:.ASCID`009\ABCDEFGHIJKLMNOPQRSTUVWXYZ\ XTR_TO:`009.ASCID`009\abcdefghijklmnopqrstuvwxyz\ X; X; Header and trailer lines X; XHEADER:`009.ASCID`009\begin 600 \`009`009; Has remote file name added XBLANK:`009.ASCID`009\ \`009`009`009; Dummy empty record needed by some X`009`009`009`009`009; decoding programs XTRAILER:.ASCID`009\end\ X; X`009.SUBTITLE`009Main program X`009.PAGE X; X`009.PSECT`009`009CODE,CON,LCL,EXE,NOWRT,LONG X; X`009.ENTRY`009`009BEGIN,`094M<> X; X; This is the main program for the utility. It obtains parameter and X; qualifier values, opens files and calls the actual decoding routines. X;`032 X`009BICB2`009#, - X`009`009`009MFLAGS`009`009; initialise flags X; X; Check for VERSION qualifier and output message if requested X; X`009PUSHAQ`009VERSIO`009`009`009; qualifier name X`009CALLS`009#1,G`094CLI$PRESENT`009; present? X`009BLBC`009R0,10$`009`009`009; j if not X`009PUSHL`009#EDIT`009`009`009; parameters for message X`009PUSHL`009#VERSION X`009PUSHL`009#2`009`009`009; number of FAO args X`009PUSHL`009#UUENCODE_VERSION`009; message X`009CALLS`009#4,G`094LIB$SIGNAL`009`009; output message X; X; Get input filename X; X10$:`009PUSHAQ`009INP_D`009`009`009; where to put parameter X`009PUSHAQ`009P1 X`009CALLS`009#2,G`094CLI$GET_VALUE`009; get parameter value X`009BLBS`009R0,20$`009`009`009; j if OK X`009PUSHL`009R0`009`009`009; error status X`009CALLS`009#1,G`094LIB$SIGNAL`009`009; generate message X`009BRW`009230$`009`009`009; exit X; X20$:`009MOVL`009INP_D+DSC$A_POINTER,R1`009; get address of input filename X`009$FAB_STORE -`009`009`009; fill filename into FAB X`009`009FAB=IFAB, - X`009`009FNA=(R1), - `009`009; address of filename X`009`009FNS=INP_D+DSC$W_LENGTH`009; length of filename X; X; Open the input file X; X`009$OPEN - X`009`009FAB=IFAB`009`009; do the file open X`009BLBS`009R0,30$`009`009`009; j if opened OK X; X; Failed to open input file X; X`009CLRQ`009-(SP)`009`009`009; make space for temp descriptor X`009MOVAQ`009(SP),R1`009`009`009; point to it X`009MOVZBW`009INAM+NAM$B_ESL,DSC$W_LENGTH(R1)`009; fill it in X`009MOVB`009#DSC$K_DTYPE_T,DSC$B_DTYPE(R1) X`009MOVB`009#DSC$K_CLASS_S,DSC$B_CLASS(R1) X`009MOVL`009INAM+NAM$L_ESA,DSC$A_POINTER(R1) X`009PUSHL`009IFAB+FAB$L_STV`009`009; secondary RMS status X`009PUSHL`009R0`009`009`009; primary RMS status X`009PUSHL`009R1`009`009`009; filename X`009PUSHL`009#1`009`009`009; number of FAO args X`009PUSHL`009#UUENCODE_OPENIN`009; error message X`009CALLS`009#5,G`094LIB$SIGNAL`009`009; generate message X`009BRW`009230$`009`009`009; exit X; X30$:`009$CONNECT - X`009`009RAB=IRAB`009`009; connect the RMS stream X`009BLBS`009R0,40$`009`009`009; j if OK X; X; Failed to connect RMS input stream X; X`009CLRQ`009-(SP)`009`009`009; make space for temp descriptor X`009MOVAQ`009(SP),R1`009`009`009; point to it X`009MOVZBW`009INAM+NAM$B_ESL,DSC$W_LENGTH(R1)`009; fill it in X`009MOVB`009#DSC$K_DTYPE_T,DSC$B_DTYPE(R1) X`009MOVB`009#DSC$K_CLASS_S,DSC$B_CLASS(R1) X`009MOVL`009INAM+NAM$L_ESA,DSC$A_POINTER(R1) X`009PUSHL`009IRAB+RAB$L_STV`009`009; secondary RMS status X`009PUSHL`009R0`009`009`009; primary RMS status X`009PUSHL`009R1`009`009`009; filename X`009PUSHL`009#1`009`009`009; number of FAO args X`009PUSHL`009#UUENCODE_OPENIN`009; error message X`009CALLS`009#5,G`094LIB$SIGNAL`009`009; generate message X`009BRW`009230$`009`009`009; exit X; X; Get output filename X; X40$:`009PUSHAQ`009OUT_D`009`009`009; where to put output filename X`009PUSHAQ`009OUTPUT`009`009`009; qualifier name X`009CALLS`009#2,G`094CLI$GET_VALUE`009; get qualifier value X`009BLBS`009R0,50$`009`009`009; j if OK X`009PUSHL`009R0`009`009`009; error status X`009CALLS`009#1,G`094LIB$SIGNAL`009`009; generate message X`009BRW`009230$`009`009`009; exit X; X50$:`009MOVL`009OUT_D+DSC$A_POINTER,R1`009; get address of output filename X`009$FAB_STORE -`009`009`009; fill filename into FAB X`009`009FAB=OFAB, - X`009`009FNA=(R1), - `009`009; address of filename X`009`009FNS=OUT_D+DSC$W_LENGTH`009; length of filename X; X; Get input file format keyword value X; X`009PUSHAQ`009BINARY`009`009`009; check for BINARY keyword X`009CALLS`009#1,G`094CLI$PRESENT`009; see if present X`009BLBC`009R0,60$`009`009`009; j if not X`009BISB2`009#UUENC_M_BINARY,MFLAGS`009; remember binary required X`009BRB`00980$ X; X60$:`009PUSHAQ`009EMAS`009`009`009; check for EMAS_BINARY keyword X`009CALLS`009#1,G`094CLI$PRESENT`009; see if present X`009BLBC`009R0,80$`009`009`009; j if not - must be TEXT X`009BISB2`009#UUENC_M_EBINARY,MFLAGS`009; remember EMAS binary required X; X; Check that file looks like an EMAS binary file; that is, that it has X; fixed length 512 byte records. X; X`009CMPW`009IFAB+FAB$W_MRS,#EMASRECSIZ`009; correct record size? X`009BNEQ`00970$`009`009`009; j if not X`009CMPB`009IFAB+FAB$B_RFM,#FAB$C_FIX`009; correct format? X`009BEQL`00980$`009`009`009; j if so X; +-+-+-+-+-+-+-+- END OF PART 2 +-+-+-+-+-+-+-+- -+-+-+-+-+-+-+-+ START OF PART 3 -+-+-+-+-+-+-+-+ X70$:`009PUSHAQ`009INP_D`009`009`009; input filename X`009PUSHL`009#1`009`009`009; number of FAO args X`009PUSHL`009#UUENCODE_NOTEMASBIN`009; error message X`009CALLS`009#3,G`094LIB$SIGNAL`009`009; output message X`009BRW`009230$`009`009`009; exit X; X; Check for the REMOTE_FILE qualifier; if not present, derive the remote X; file name from the local one. X; X80$:`009PUSHAQ`009REMOTE`009`009`009; check for REMOTE_FILE X`009CALLS`009#1,G`094CLI$PRESENT`009; see if present X`009BLBC`009R0,100$`009`009`009; j if not X`009PUSHAQ`009REM_D`009`009`009; where to put remote filename X`009PUSHAQ`009REMOTE`009`009`009; qualifier name X`009CALLS`009#2,G`094CLI$GET_VALUE`009; get qualifier value X`009BLBC`009R0,90$`009`009`009; j if not there X`009BRW`009110$`009`009`009; else OK X; X90$:`009PUSHL`009R0`009`009`009; error status X`009CALLS`009#1,G`094LIB$SIGNAL`009`009; generate message X`009BRW`009230$`009`009`009; exit X; X100$:`009MOVZBL`009INAM+NAM$B_NAME,-(SP)`009; get length of filename part X`009MOVAW`009(SP),R0`009`009`009; get its address for call X`009PUSHL`009INAM+NAM$L_NAME`009`009; address of filename part of full name X`009PUSHL`009R0`009`009`009; address of length X`009PUSHAQ`009REM_D`009`009`009; destination X`009CALLS`009#3,G`094STR$COPY_R`009`009; copy name X`009POPL`009R0`009`009`009; clear stack X`009MOVZBL`009INAM+NAM$B_TYPE,-(SP)`009; get length of type part X`009MOVAW`009(SP),R0`009`009`009; get its address for call X`009PUSHL`009INAM+NAM$L_TYPE`009`009; address of type part of full name X`009PUSHL`009R0`009`009`009; address of length X`009PUSHAQ`009WRK_D`009`009`009; destination X`009CALLS`009#3,G`094STR$COPY_R`009`009; copy type X`009POPL`009R0`009`009`009; clear stack X`009PUSHAQ`009WRK_D`009`009`009; source 2 X`009PUSHAQ`009REM_D`009`009`009; source 1 X`009PUSHAQ`009REM_D`009`009`009; destination X`009CALLS`009#3,G`094STR$CONCAT`009`009; build NAME.TYPE X`009PUSHAQ`009WRK_D`009`009`009; unwanted space X`009CALLS`009#1,G`094STR$FREE1_DX`009; return dynamic memory X; X110$:`009PUSHAQ`009TR_FROM`009`009`009; set up for translation... X`009PUSHAQ`009TR_TO`009`009`009; ...to lower case X`009PUSHAQ`009REM_D`009`009`009; translate in situ X`009PUSHAQ`009REM_D X`009CALLS`009#4,G`094STR$TRANSLATE`009; do the translation X; X`009MOVZWL`009IXAB+XAB$W_LRL,R0`009; get maximum record size X`009BBS`009#UUENC_V_BINARY, -`009; already correct for binary input X`009`009MFLAGS,120$ X`009BBS`009#UUENC_V_EBINARY, -`009; already correct for EMAS binary input X`009`009MFLAGS,120$ X`009INCL`009R0`009`009`009; add extra byte for text newline X; X120$:`009CMPL`009R0,#2`009`009`009; must be at least two bytes X`009BGEQ`009130$`009`009`009; j if so X`009MOVL`009#2,R0`009`009`009; else make it that X; X130$:`009MOVW`009R0,IRAB+RAB$W_USZ`009; set maximum user buffer size X`009PUSHL`009R0`009`009`009; store buffer size for allocate X`009MOVAL`009(SP),R0`009`009`009; get its address for call X`009PUSHAL`009IRAB+RAB$L_UBF`009`009; address for buffer address X`009PUSHL`009R0`009`009`009; address of buffer length X`009CALLS`009#2,G`094LIB$GET_VM`009`009; allocate buffer X`009POPL`009R1`009`009`009; clear stack X`009BLBS`009R0,140$`009`009`009; j if allocated OK X`009PUSHL`009R0`009`009`009; status for message X`009CALLS`009#1,G`094LIB$SIGNAL`009`009; generate message X`009BRW`009230$`009`009`009; else error X; X; Create and open the output file X; X140$:`009$CREATE - X`009`009FAB=OFAB`009`009; do the file open X`009BLBS`009R0,150$`009`009`009; j if opened OK X; X; Failed to open output file X; X`009CLRQ`009-(SP)`009`009`009; make space for temp descriptor X`009MOVAQ`009(SP),R1`009`009`009; point to it X`009MOVZBW`009ONAM+NAM$B_ESL,DSC$W_LENGTH(R1)`009; fill it in X`009MOVB`009#DSC$K_DTYPE_T,DSC$B_DTYPE(R1) X`009MOVB`009#DSC$K_CLASS_S,DSC$B_CLASS(R1) X`009MOVL`009ONAM+NAM$L_ESA,DSC$A_POINTER(R1) X`009PUSHL`009OFAB+FAB$L_STV`009`009; secondary RMS status X`009PUSHL`009R0`009`009`009; primary RMS status X`009PUSHL`009R1`009`009`009; filename X`009PUSHL`009#1`009`009`009; number of FAO args X`009PUSHL`009#UUENCODE_OPENOUT`009; error message X`009CALLS`009#5,G`094LIB$SIGNAL`009`009; generate message X`009BRW`009230$`009`009`009; exit X; X150$:`009$CONNECT - X`009`009RAB=ORAB`009`009; connect the RMS stream X`009BLBS`009R0,160$`009`009`009; j if connected OK X; X; Failed to connect RMS output stream X; X`009CLRQ`009-(SP)`009`009`009; make space for temp descriptor X`009MOVAQ`009(SP),R1`009`009`009; point to it X`009MOVZBW`009ONAM+NAM$B_ESL,DSC$W_LENGTH(R1)`009; fill it in X`009MOVB`009#DSC$K_DTYPE_T,DSC$B_DTYPE(R1) X`009MOVB`009#DSC$K_CLASS_S,DSC$B_CLASS(R1) X`009MOVL`009ONAM+NAM$L_ESA,DSC$A_POINTER(R1) X`009PUSHL`009ORAB+RAB$L_STV`009`009; secondary RMS status X`009PUSHL`009R0`009`009`009; primary RMS status X`009PUSHL`009R1`009`009`009; filename X`009PUSHL`009#1`009`009`009; number of FAO args X`009PUSHL`009#UUENCODE_OPENOUT`009; error message X`009CALLS`009#5,G`094LIB$SIGNAL`009`009; generate message X`009BRW`009230$`009`009`009; exit X; X; Check for and record any use of the LOG qualifier X; X160$:`009PUSHAQ`009LOG`009`009`009; check for LOG qualifier X`009CALLS`009#1,G`094CLI$PRESENT`009; see if present X`009BLBC`009R0,170$`009`009`009; j if not X`009BISB2`009#UUENC_M_LOG,MFLAGS`009; else set LOG flag X; X; Files are now open; do the conversion X; X170$:`009PUSHAQ`009REM_D`009`009`009; remote filename X`009CALLS`009#1,DO_ENCODE`009`009; returns any status in R0 X; X`009PUSHL`009R0`009`009`009; save status X; X; Output any logging message X; X`009BBC`009#UUENC_V_LOG,MFLAGS,210$; j if no logging X`009PUSHAQ`009OUT_D`009`009`009; output filename X`009PUSHAQ`009INP_D`009`009`009; input filename X`009BBC`009#UUENC_V_BINARY,MFLAGS,180$`009; j if not binary conversion X`009PUSHAQ`009BINTYPE`009`009`009; "binary" X`009BRB`009200$ X; X180$:`009BBC`009#UUENC_V_EBINARY,MFLAGS,190$`009; j if not EMAS binary conve Vrsion X`009PUSHAQ`009EBTYPE`009`009`009; "EMAS binary" X`009BRB`009200$ X; X190$:`009PUSHAQ`009TEXTYPE`009`009`009; "text" X; X200$:`009PUSHL`009#3`009`009`009; number of FAO args X`009PUSHL`009#UUENCODE_ENCODED`009; message X`009CALLS`009#5,G`094LIB$SIGNAL`009`009; output message X; X; Close input and output files X; X210$:`009$CLOSE - X`009`009FAB=IFAB`009`009; does DISCONNECT too; ignore status X`009$CLOSE - X`009`009FAB=OFAB`009`009; does DISCONNECT too X`009BLBS`009R0,220$`009`009`009; j if OK X`009CLRQ`009-(SP)`009`009`009; make space for temp descriptor X`009MOVAQ`009(SP),R1`009`009`009; point to it X`009MOVZBW`009ONAM+NAM$B_ESL,DSC$W_LENGTH(R1)`009; fill it in X`009MOVB`009#DSC$K_DTYPE_T,DSC$B_DTYPE(R1) X`009MOVB`009#DSC$K_CLASS_S,DSC$B_CLASS(R1) X`009MOVL`009ONAM+NAM$L_ESA,DSC$A_POINTER(R1) X`009PUSHL`009ORAB+RAB$L_STV`009`009; secondary RMS status X`009PUSHL`009R0`009`009`009; primary RMS status X`009PUSHL`009R1`009`009`009; filename X`009PUSHL`009#1`009`009`009; number of FAO args X`009PUSHL`009#UUENCODE_WRITERR`009; error message X`009CALLS`009#5,G`094LIB$SIGNAL`009`009; generate message X`009BRW`009230$`009`009`009; exit X; X220$:`009POPL`009R0`009`009`009; recover status X; X230$:`009RET`009`009`009`009; exit to system X; X`009.SUBTITLE`009Encode the file X`009.PAGE X; X; This routine performs the actual encoding and data transfer X; X; Input parameters: X; X; 4(AP)`009- remote file name (string descriptor, by reference) X; X; Output parameters: X; X; R0`009`009- status X; X`009.ENTRY`009DO_ENCODE,`094M X; X; Write the header line X; X`009PUSHL`0094(AP)`009`009`009; remote file name X`009PUSHAQ`009HEADER`009`009`009; "begin 640 " X`009PUSHAQ`009WRK_D`009`009`009; destination string X`009CALLS`009#3,G`094STR$CONCAT`009`009; concatenate to make "begin 640 a.b" X`009PUSHAQ`009WRK_D`009`009`009; full header line X`009CALLS`009#1,PUTREC`009`009; write the record X`009BLBS`009R0,10$`009`009`009; j if OK X`009BRW`009240$`009`009`009; else write error X; X; Copy the body of the file X; X; During the copy: X; R2 = input record buffer counter X; R3 = input buffer pointer X; R4 = output record buffer counter X; R5 = output buffer pointer X; R6 = 0-1-2 counter X; R7 = character accumulator X; R8 = true character output counter X; R9 = EMAS logical start (EMAS_BINARY only) X; R10 = EMAS logical end (EMAS_BINARY only) X; X10$:`009CLRL`009R2`009`009`009; nothing in input buffer X`009CLRL`009R4`009`009`009; nothing in output buffer X`009CLRL`009R8`009`009`009; no characters encoded yet X`009MOVAB`009OUTBUF+1,R5`009`009; initialise output buffer pointer X`009CLRL`009R6`009`009`009; no pending characters X; X; Main copying loop X; X20$:`009TSTL`009R2`009`009`009; anything left in input buffer? X`009BEQL`00930$`009`009`009; j if not X`009BRW`009160$ X; X30$:`009$GET - X`009`009RAB=IRAB`009`009; read a record X`009CMPL`009R0,#RMS$_EOF`009`009; check for end of file X`009BNEQ`00950$`009`009`009; j if not end of file X`009TSTL`009R6`009`009`009; partial group output? X`009BEQL`00940$`009`009`009; j if not X`009SUBL3`009R6,#3,R2`009`009; make dummy record to clear X`009SUBL2`009R2,R8`009`009`009; fudge final count X`009MOVL`009IRAB+RAB$L_RBF,R3`009; set count and pointer X`009CLRW`009(R3)`009`009`009; fill with nulls X`009BRW`009160$`009`009`009; process dummy record to finish X; X40$:`009BRW`009220$`009`009`009; clean up and exit X; X50$:`009BLBS`009R0,60$`009`009`009; j if read OK X`009CLRQ`009-(SP)`009`009`009; make space for temp descriptor X`009MOVAQ`009(SP),R1`009`009`009; point to it X`009MOVZBW`009INAM+NAM$B_ESL,DSC$W_LENGTH(R1)`009; fill it in X`009MOVB`009#DSC$K_DTYPE_T,DSC$B_DTYPE(R1) X`009MOVB`009#DSC$K_CLASS_S,DSC$B_CLASS(R1) X`009MOVL`009INAM+NAM$L_ESA,DSC$A_POINTER(R1) X`009PUSHL`009IRAB+RAB$L_STV`009`009; secondary RMS status X`009PUSHL`009R0`009`009`009; primary RMS status X`009PUSHL`009R1`009`009`009; filename X`009PUSHL`009#1`009`009`009; number of FAO args X`009PUSHL`009#UUENCODE_READERR`009; error message X`009CALLS`009#5,G`094LIB$SIGNAL`009`009; generate message X`009MOVL`009#UUENCODE_READERR,R0`009; final status X`009BRW`009250$`009`009`009; exit X; X60$:`009MOVZWL`009IRAB+RAB$W_RSZ,R2`009; get record length X`009MOVL`009IRAB+RAB$L_RBF,R3`009; get buffer pointer X`009BBC`009#UUENC_V_BINARY, - X`009`009MFLAGS,70$`009`009; j if not binary record X`009BRW`009160$`009`009`009; else nothing to add X; X70$:`009BBS`009#UUENC_V_EBINARY, - X`009`009MFLAGS,80$`009`009; EMAS binary record ready X`009MOVB`009#NL,(R2)+`091R3`093`009`009; store newline for text record X`009BRW`009160$`009`009`009; skip other checks X; X; If we are doing EMAS binary conversion, extract information from the X; EMAS file header (the first eight longwords), if we are processing the X; first record. X; X80$:`009BBCS`009#UUENC_V_FIRST, -`009; j if first record X`009`009MFLAGS,90$ X`009BRW`009150$`009`009`009; else skip header processing X; X90$:`009MOVL`009#EMAS_END,R0`009`009; get logical end byte X`009BSBW`009GETWORD X`009MOVL`009R0,R10`009`009`009; save it X`009MOVL`009#EMAS_START,R0`009`009; get logical start byte X`009BSBW`009GETWORD X`009MOVL`009R0,R9`009`009`009; save it X`009SUBL2`009R0,R10`009`009`009; make R10 the actual file size X`009MOVL`009#EMAS_FILE_TYPE,R0`009; get file type X`009BSBW`009GETWORD X`009CMPL`009R0,#EMAS_BINTYPE`009; suitable type? X`009BEQL`009140$`009`009`009; j if so X`009CMPL`009R0,#EMAS_PDTYPE`009`009; pdfile? X`009BNEQ`009100$`009`009`009; j if not X`009MOVL`009#UUENCODE_EMASPDFILE,R0`009; message code X`009BRB`009130$ X; X100$:`009CMPL`009R0,#EMAS_OBJTYPE`009; object file? X`009BNEQ`009110$`009`009`009; j if not X`009MOVL`009#UUENCODE_EMASOBJFILE,R0; message code X`009BRB`009130$ X; X110$:`009CMPL`009R0,#EMAS_CHARTYPE`009; character file? X`009BNEQ`009120$`009`009`009; j if not X`009MOVL`009#UUENCODE_EMASCHARFILE,R0`009; message code X`009BRB`009130$ X; X120$:`009MOVL`009#UUENCODE_EMASUNKFILE,R0; message code X; X130$:`009PUSHAQ`009INP_D`009`009`009; filename X`009PUSHL`009#1`009`009`009; number of FAO args X`009PUSHL`009R0`009`009`009; message code X`009CALLS`009#3,G`094LIB$SIGNAL`009`009; output message X; X140$:`009ADDL2`009R9,R3`009`009`009; avoid file header now X`009SUBL2`009R9,R2`009`009`009; adjust count X`009BGTR`009150$`009`009`009; j if something left X`009MOVL`009#UUENCODE_INVALFORMAT,R0; message code X`009PUSHL`009R0`009`009`009; save code X`009PUSHAQ`009INP_D`009`009`009; filename X`009PUSHL`009#1`009`009`009; number of FAO args X`009PUSHL`009R0`009`009`009; message code X`009CALLS`009#3,G`094LIB$SIGNAL`009`009; output message X`009POPL`009R0`009`009`009; recover status X`009BRW`009250$`009`009`009; and exit X; X150$:`009TSTL`009R10`009`009`009; already finished? X`009BEQL`009220$`009`009`009; j if so X`009SUBL2`009R2,R10`009`009`009; subtract from binary total X`009BGEQ`009160$`009`009`009; j if all of this record required X`009ADDL2`009R10,R2`009`009`009; adjust actual count X`009CLRL`009R10`009`009`009; that will be all X; X160$:`009MOVZBL`009(R3)+,R0`009`009; get a byte (must clear top 24 bits) X`009INCL`009R8`009`009`009; update output character counter X`009CASE`009R6, -`009`009`009; switch on 0-1-2 state X`009`009<170$,180$,190$>, - X`009`009TYPE=B X; X170$:`009EXTZV`009#0,#2,R0,R7`009`009; save least significant 2 bits X`009ASHL`009#-2,R0,R0`009`009; normalise most significant 6 bits X`009BSBW`009PUTCHAR`009`009`009; output 6-bit value X`009BRB`009200$`009`009`009; go to common code X; X180$:`009EXTZV`009#0,#4,R0,R1`009`009; save least significant 4 bits X`009ASHL`009#-4,R0,R0`009`009; normalise most significant 4 bits X`009INSV`009R7,#4,#2,R0`009`009; insert saved 2 bits X`009MOVL`009R1,R7`009`009`009; save 4 bits for next time X`009BSBW`009PUTCHAR`009`009`009; output 6-bit value X`009BRB`009200$`009`009`009; go to common code X; X190$:`009EXTZV`009#0,#6,R0,R1`009`009; save least significant 6 bits X`009ASHL`009#-6,R0,R0`009`009; normalise most significant 2 bits X`009INSV`009R7,#2,#4,R0`009`009; insert saved 4 bits X`009MOVL`009R1,R7`009`009`009; save 4 bits for next time X`009BSBW`009PUTCHAR`009`009`009; output 6-bit value X`009MOVL`009R7,R0`009`009`009; recover saved 6 bits X`009BSBW`009PUTCHAR`009`009`009; output 6-bit value X`009BLBS`009R0,200$`009`009`009; j if OK X`009BRW`009240$`009`009`009; else write error X; X; One input character has been handled; update input count and continue X; X200$:`009DECL`009R2`009`009`009; one less character left X`009INCL`009R6`009`009`009; update 0-1-2 counter X`009CMPL`009R6,#3`009`009`009; reset? X`009BNEQ`009210$`009`009`009; j if not X`009CLRL`009R6 X; X210$:`009BRW`00920$ X; X; End of input file; flush any partial output record X; X220$:`009TSTL`009R4`009`009`009; anything to write? X`009BEQL`009230$`009`009`009; j if not X`009ADDW3`009R4,#1,REC_D+DSC$W_LENGTH; set up descriptor X`009ADDB3`009#`094A\ \,R8,OUTBUF`009; set encoded length byte X`009PUSHAQ`009REC_D X`009CALLS`009#1,PUTREC`009`009; write partial record X`009BLBC`009R0,240$`009`009`009; j if error X; X; Write the trailer lines X; X230$:`009PUSHAQ`009BLANK`009`009`009; dummy empty record X`009CALLS`009#1,PUTREC`009`009; write the record X`009BLBC`009R0,250$`009`009`009; j if error X`009PUSHAQ`009TRAILER`009`009`009; "end" X`009CALLS`009#1,PUTREC`009`009; write the record X`009BLBC`009R0,240$`009`009`009; j if error X; X`009MOVL`009#SS$_NORMAL,R0`009`009; indicate success X`009BRB`009250$ X; X240$:`009CLRQ`009-(SP)`009`009`009; make space for temp descriptor X`009MOVAQ`009(SP),R1`009`009`009; point to it X`009MOVZBW`009ONAM+NAM$B_ESL,DSC$W_LENGTH(R1)`009; fill it in X`009MOVB`009#DSC$K_DTYPE_T,DSC$B_DTYPE(R1) X`009MOVB`009#DSC$K_CLASS_S,DSC$B_CLASS(R1) X`009MOVL`009ONAM+NAM$L_ESA,DSC$A_POINTER(R1) X`009PUSHL`009ORAB+RAB$L_STV`009`009; secondary RMS status X`009PUSHL`009R0`009`009`009; primary RMS status X`009PUSHL`009R1`009`009`009; filename X`009PUSHL`009#1`009`009`009; number of FAO args X`009PUSHL`009#UUENCODE_WRITERR`009; error message X`009CALLS`009#5,G`094LIB$SIGNAL`009`009; generate message X`009MOVL`009#UUENCODE_WRITERR,R0`009; final status X; X250$:`009PUSHL`009R0`009`009`009; save status X`009PUSHAQ`009WRK_D`009`009`009; any workspace to return X`009CALLS`009#1,G`094STR$FREE1_DX`009; return it X`009POPL`009R0`009`009`009; recover status before return X`009RET X; X; X; Subroutine to get a longword from the first record of an EMAS file. X; The bytes in the longword are reversed to obtain a suitable VAX-format X; value. X; X; Input parameters: X; X;`009R0`009- longword offset into record X;`009R3`009- pointer to start of record buffer X; X; Output parameters: X; X;`009R0`009- extracted value X; XGETWORD: X`009MOVL`009(R3)`091R0`093,R0`009`009; get stored value X`009CLRL`009-(SP)`009`009`009; make space for reversed copy X`009INSV`009R0,#24,#8,(SP)`009`009; store bytes... X`009ASHL`009#-8,R0,R0 X`009INSV`009R0,#16,#8,(SP) X`009ASHL`009#-8,R0,R0 X`009INSV`009R0,#8,#8,(SP) X`009ASHL`009#-8,R0,R0 X`009MOVB`009R0,(SP)`009`009`009; ...in reverse order X`009POPL`009R0 X`009RSB X;`009 X; X; Subroutine to output a 6-bit value. This is encoded and placed in the X; output buffer. If the buffer fills, its length byte is filled in and X; it is written to the output file. X; X; Input parameters: X; X;`009R0`009- character for output (plus rubbish in high bits) X; X; Output parameters: X; X;`009R0`009- status X; XPUTCHAR: X`009BICB2`009#`094C`094X3F,R0`009`009; lose unwanted bits X`009ADDB3`009#`094A\ \,R0,(R5)+`009`009; encode and store into buffer X`009INCL`009R4`009`009`009; update character count X`009CMPL`009R4,#OUTBUFSIZ-1`009`009; buffer full? X`009BNEQ`00910$`009`009`009; j if not - just return X`009ADDB3`009#`094A\ \,R8,OUTBUF`009; store encoded count X`009ADDW3`009R4,#1,REC_D+DSC$W_LENGTH; set up descriptor (include length byt Ve) X`009PUSHAQ`009REC_D`009`009`009; descriptor to buffer X`009CALLS`009#1,PUTREC`009`009; write the record X`009CLRL`009R4`009`009`009; reset buffer counter X`009MOVAB`009OUTBUF+1,R5`009`009; reset buffer pointer X`009CLRL`009R8`009`009`009; reset character counter X`009BRB`00920$`009`009`009; and return with status in R0 X; X10$:`009MOVL`009#SS$_NORMAL,R0`009`009; indicate success X; X20$:`009RSB X; X`009.SUBTITLE`009Write record to output file X`009.PAGE X; X; This routine writes a single record to the output file. X; X; Input parameters: X; X; 4(AP)`009- record buffer (string descriptor, by reference) X; X; Output parameters: X; X; R0`009`009- status X; X`009.ENTRY`009PUTREC,`094M<> X; X`009PUSHAL`009ORAB+RAB$L_RBF`009`009; place to put address X`009PUSHAW`009ORAB+RAB$W_RSZ`009`009; place to put length X`009PUSHL`0094(AP)`009`009`009; descriptor for analysis X`009CALLS`009#3,G`094STR$ANALYZE_SDESC`009; get data address and length X; X10$:`009$PUT - X`009`009RAB=ORAB`009`009; write record, drop through X; X20$:`009RET X; X`009.END`009BEGIN $ CALL UNPACK [.UUENCODE.ENCODE]UUENCODE.MAR;2 2119869802 $ create/nolog 'f' X`009`009.TITLE`009UUENCODE$MSG - messages for UUENCODE X`009`009.IDENT`009"V01-00" X! X`009`009.FACILITY UUENCODE,14 X! X`009`009.BASE`0091 X`009`009.SEVERITY FATAL X! XINVALFORMAT`009/FAO_COUNT=1 XNOTEMASBIN`009/FAO_COUNT=1 XOPENIN`009`009/FAO_COUNT=1 XOPENOUT`009`009/FAO_COUNT=1 XREADERR`009`009/FAO_COUNT=1 XWRITERR`009`009/FAO_COUNT=1 X! X`009`009.BASE`00910 X`009`009.SEVERITY INFORMATIONAL XENCODED`009`009/FAO_COUNT=3 XVERSION`009`009/FAO_COUNT=2 X! X`009`009.BASE`00920 X`009`009.SEVERITY WARNING XEMASCHARFILE`009/FAO_COUNT=1 XEMASOBJFILE`009/FAO_COUNT=1 XEMASPDFILE`009/FAO_COUNT=1 XEMASUNKFILE`009/FAO_COUNT=1 X! X`009`009.END $ CALL UNPACK [.UUENCODE.ENCODE]UUENCODEMSG.MSG;1 1478377474 $ v=f$verify(v) $ EXIT ---------------------+----------------------------------------------------- Bob Eager | University of Kent at Canterbury rde@ukc.ac.uk | +44 227 764000 ext 7589 ---------------------+----------------------------------------------------- *** NB *** Do NOT use the return path in the article header *************** ---------------------------------------------------------------------------