TODD@DSS.MED.NYU.EDU (07/29/88)
Following this memo is what I hope to be the 'definitive' version of
MFTU (1.12). This is the last update I received from the author,
Carlo Mekenkamp (MEKENKAMP@HLERUL5.bitnet). Apparently some fractured
and imcomplete versions have been distributed (e.g. with PMDF). These
are the complete sources in a self-unpacking archive.
MFTU (Mail File Transfer Utility) is a wonderful program for compressing
and encoding a file (or files) for transfer over arbitrary communications
channels (such as MAIL). A typical use of the program for me is to PACK
a backup saveset (roughly 2/3 original size) and ENCODE the resulting
file (roughly 4/3 the input size, so about the same as the original size).
Sometimes the result is significantly smaller, but almost never bigger.
The resulting file is printable ASCII text that apparently even big blue
blunderbusses have a problem munging. I personally like the idea of having
a backup saveset at the core, so that I can easily post executables and
KNOW that they made it safely (you laugh that I trust BACKUP, eh?).
**************************** Note: ****************************************
I will be posting MAKE/VMS version 3.1 in the near future encoded via MFTU.
If you want that program, you're definitely going to need to save this one.
***************************************************************************
Regards,
Todd Aven
Datability Software Systems, Inc. [(212)807-7800]
Internet: todd%dss@med.nyu.edu
Bitnet: todd%dss@nyumed
Standard Disclaimer:
"Why should I disclaim anything? You think I actually claimed something???"
-------------------- Cut Here and '@' the following ---------------------------
$WRITE SYS$ERROR "Creating MAKEFILE...."
$CREATE MAKEFILE.
$DECK/DOLLARS="198807291104429"
!++
! Default build rules (these can go in MAKE_DEFAULTS)
!--
*.obj: *.c
cc/obj=$* $*
*.obj: *.mar
macro/obj=$* $*
*.obj: *.cld
set command/obj=$* $*
*.obj: *.msg
message/obj=$* $*
!++
! MFTU-specific rules
!--
OBJS = mftu.obj,mftu_msg.obj,mftu_cld.obj
mftu: mftu.exe mftu.hlb clean
mftu.exe: ${OBJS}
link/nodebug/notrace ${OBJS}
mftu.hlb: mftu.hlp
lib/cre/help mftu mftu
clean:
purge/log
198807291104429!End of MAKEFILE.
$WRITE SYS$ERROR "Creating MFTU.DOC..."
$CREATE MFTU.DOC
$DECK/DOLLARS="198807291104429"
Copyright (C) 1987 C.A.J. Mekenkamp. All rights reserved.
; Text protocol defined by
; Peter Laman and Carlo Mekenkamp
; Packing protocol defined by Carlo Mekenkamp
; Macro-32 Implementation by
; Carlo Mekenkamp
; Working of the program: It encodes the file in the following way.
; TEXT part (with ENCODE)
; It has sort of 3 phases: 1) three to four bytes
; 2) replacing non ebcdic characters
; 3) packing together
; a word is 2 bytes
; A file starts with: 40 tildes.
; program skips till it encounters them,
; so removing garbage before is not necessary
; The name: lenght word + 255 bytes + 1 spare byte (258)
; The fab: 80 bytes + 1 spare byte (81)
; The blocks: lenght word + 512 bytes + 2 spare bytes (516)
; cyclic redundancy check in 2 the spare bytes of the blocks
; a warning is given if crc does not match the calculated crc
; used polynome x^16+x^15+x^2+1,init=0 as in CCDMP.
; CRC calculated on 514 bytes (length word + 512 bytes).
; The CRC on the name is in the hi word of the CTX field of fab.
; CRC on name is calculated on lenght word+255 bytes (257 bytes)
; The CRC on the fab is in the lo word of the CTX field of fab.
; CRC on FAB is calculated with zero CTX field (80 bytes)
;;;;;Phase 1
;name, fab en blocks #bytes divisible by three
;Three bytes become four bytes (since 3*8=4*6).
; +-------+-------+-------+
; | 8 | 8 | 8 |
; +-----+-+---+---+-+-----+
; | 6 | 6 | 6 | 6 |
; +-----+-----+-----+-----+
;
; +-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+
; |1|a|b|c|d|e| -----> |0|0|1|a|b|c|d|e| (32..63)->(32..63)
; +-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+
;
; +-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+
; |0|a|b|c|d|e| -----> |0|1|0|a|b|c|d|e| (0--31)->(64..95)
; +-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+
;
;In that way all bytes are encoded to ascii chars
;Now we have printable bytes of the form 011abcde
;except for 01111111 (which is the <DEL> sign, 127)
;free for some other encoding.
;;;;;Phase 2
;The space is a problem (some mailers remove trailing spaces).
;so the space is replaced by a little m, (109)
;There are some ebcdic-ascii conversion problems,
;so the non-ebcdic characters are not used and replaced
;by another character in the following way:
;left bracket [ is replaced by a little d (100)
;backslash \ is replaced by a little e (101)
;right bracket ] is replaced by a little f (102)
;accent circumflex ^ is replaced by a little g (103)
;backquote ` is replaced by a little h (104)
;left brace { is replaced by a little i (105)
;bar | is replaced by a little j (106)
;right brace } is replaced by a little k (107)
;tilde ~ is replaced by a little l (108) NB<-
; except for the leading 40 in a file
;space is replaced by a little m (109)
;;;;;Phase 3
;the little z is end of file char. (122)
;the little b is repeat the next char 3 times (98)
;the little c is repeat the next char 4 times (99)
;the little y is end repeat char (121)
;the little a is start repeat count char (97)
;following a radix 24 sequence
; bytes with offset 97 (little a)
; least significant r24 number first
;a repeat count ends in either of two ways:
;1) a character has not both bit 5 and bit6 set,
; that is the character to repeat.
;2) the little y (121),
; the next char is to be repeated
; the latter is the case if one of the control bytes.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;worst case analysis
;;let N be the size in blocks (512 bytes) of the file
;Encoding of name costs <=344 bytes
;Encoding of fab costs <=108 bytes
;Encoding per block costs <=688 bytes
;So encoding scheme total block costs<= 452 + N*688 bytes
;Format of encoded file is CR VAR, with 80 bytes a line
;forty tildes to mark start
;42+(82/80)*(452+N*688) bytes are necessary to encode it
;Allright, roughly 4/3 of original
;Best case: a file with all zero bytes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Encoding scheme for packed files.
A .PCK file is a fixed record 512 bytes/block file.
It can contain several packed files in so called fileblocks.
+----------------------+
| file1 | fileblock1
+----------------------+
.PCK file | ... | ...
+----------------------+
| filen | fileblockn
+----------------------+
Every fileblock has a multiple of 512 bytes, so multiple .PCK files
can be appended to each other.
A fileblock consists of the following information:
+--+-----+--------+----------+
Fileblock |ID|Table|Filedata|EOF Marker|
+--+-----+--------+----------+
ID = 4 bytes 26,26,0,0 to mark the file as a packed file.
Table is the huffman tree.
+-----+-----+
Table |Left |Right|
+-----+-----+
Left Child Table (257 words + 1 word CRC) = 516 bytes
Right Child Table (257 words + 1 word CRC) = 516 bytes
File data is huffman encoded data, it consists of:
+---+---+----+----+----+
Filedata |Nam|Fab|Blk1| .. |Blkn|
+---+---+----+----+----+
Nam is the name of the file, it consists of:
+-----------+----+----------+
Nam |Length word|Name|Spare byte| 2+255+1=258 bytes
+-----------+----+----------+
Fab is the file allocation block with fileinfo, it consists of 81 bytes
80 for the fab itself and one spare byte.
The CTX field in the fab contains two CRC words.
The CRC on the name is in the hi word of the CTX field of fab.
CRC on name is calculated on the nam block length word+255 bytes=257 bytes.
The CRC on the fab is in the lo word of the CTX field of fab.
CRC on FAB is calculated on the fab block with zero CTX field. 80 bytes
The Blk's have the following format:
2 512 2
+-----------+-------+---+
Blk |Length word|DataBlk|CRC| 2+512+2=516 bytes
+-----------+-------+---+
The CRC on the blocks is calculated on the the lenght word + datablk
Eof Marker is 257.
Decoding a character:
The left and child arrays are array[1..515] of word.
Every word is an index in the table.
Of the left and right child tables only values from 259..515
are saved because 1..258 are zero anyway.
The root of the huffman tree is 515. When a bit is clear, it takes
the left child, when set the right child.
When it has a 1<=value<=258 it returns the value-1
Now char value is in range 0..257
257 means EOF
256 Means Repeat count sequence, following the repeat count-4,
following the char to repeat.
Any other character is just the character.
198807291104429!End of MFTU.DOC
$WRITE SYS$ERROR "Creating MFTU.HLP..."
$CREATE MFTU.HLP
$DECK/DOLLARS="198807291104429"
1 MFTU
The Mail File Transfer Utility Program
It encodes VAX/VMS files to a text file that can be handled by
mailers, and decodes encoded files.
It Huffman packs files for archive purposes,
and unpacks packed files.
2 ENCODE
Will encode the files to a text file.
Format: ENCODE file-spec[,...]
3 Parameter
The files to encode. Wildcard file specification allowed.
3 /LOG
/LOG (D)
/NOLOG
Will tell which files are to be encoded.
3 /DELERR
/DELERR (D)
/NODELERR
Created file will be deleted when a fatal error occurs.
3 /OUTPUT=file-spec
(D OUTPUT=ENCODING.MFT)
What will be the name of the encode file.
2 DECODE
Will decode the text files to original.
Format: DECODE file-spec[,...]
3 Parameter
The files to decode. Wildcard file specification allowed.
3 /CONFIRM
Asks for every created file for confirmation.
3 /CRC
/CRC (D)
/NOCRC
Gives a warning if a CRC error occurred.
3 /DELERR
/DELERR (D)
/NODELERR
Created file will be deleted when a fatal error occurs.
3 /LIST
Gives a listing of the files to be created when decoding.
3 /LOG
/LOG (D)
/NOLOG
Will tell which files have been decoded
2 PACK
Will huffman pack the files.
It is possible to append two or more huffman packed files.
Unpack recognizes them as different files.
Format: PACK file-spec[,...]
3 Parameter
The files to encode. Wildcard file specification allowed.
3 /LOG
/LOG (D)
/NOLOG
Will tell which files are to be encoded.
3 /DELERR
/DELERR (D)
/NODELERR
Created file will be deleted when a fatal error occurs.
3 /OUTPUT=file-spec
(D OUTPUT=PACKING.PCK)
What will be the name of the packed file.
2 UNPACK
Will UNPACK the packed files to original.
Format: UNPACK file-spec[,...]
3 Parameter
The files to unpack. Wildcard file specification allowed.
3 /CONFIRM
Asks for every created file for confirmation.
3 /CRC
/CRC (D)
/NOCRC
Gives a warning if a CRC error occurred.
When that happens data is not correct.
3 /DELERR
/DELERR (D)
/NODELERR
Created file will be deleted when a fatal error occurs.
3 /LIST
Gives a listing of the files to be created when unpacking.
3 /LOG
/LOG (D)
/NOLOG
Will tell which files have been decoded
2 Example
There are several methods to use MFTU.
1) $ RUN MFTU
MFTU> ENCODE FOO.EXE
%MFTU-I-ENCODING, encoding disk:[dirpath]FOO.EXE;vers.
Now there is a file ENCODING.MFT
$ RUN MFTU
MFTU> DECODE encoding.mft
%MFTU-I-DECODED, decoded disk:[dirpath]FOO.EXE;vers, 20 blocks.
2) As foreign command.
$ PACK:==$disk:[dirpath]MFTU PACK
$ MFTU:==$disk:[dirpath]MFTU
$ PACK/NOLOG/OUTPUT=FOO.PCK FOO.EXE
$ MFTU UNPACK FOO.PCK
%MFTU-I-DECODED, decoded disk:[dirpath]FOO.EXE;vers, 20 blocks.
3) As command.
$ SET COM MFTU
$ MFTU DECODE encoding.mft
%MFTU-I-DECODED, decoded disk:[dirpath]FOO.EXE;vers, 20 blocks.
198807291104429!End of MFTU.HLP
$WRITE SYS$ERROR "Creating MFTU.MAR..."
$CREATE MFTU.MAR
$DECK/DOLLARS="198807291104429"
.title MFTU
.subtitle Mail File Transfer Utility
.ident /MFTU V1.12/
.disable debug
.disable traceback
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Copyright (C) 1987 Carlo Mekenkamp
; President Krugerstraat 42
; 1975 EH IJmuiden
; Nederland
; MEKENKAM@HLERUL5.BITNET
; Rijks Universiteit Leiden
; Niels Bohrweg 1
; Nederland
; With thanks to:
; Peter Laman <P_LAMAN@HLERUL5.BITNET>
; for learning me how to use RMS I/O, and suggestions
; Todd Aven <TODD@UMCINCOM>
; for suggestions which lead to the Huffman Scheme
; Tom Allebrandi <ta2@edison.GE.COM>
; for removing bug with FOP field
; This program comes without any warranty.
; The author does not accept any responsibility for any damage
; caused by use or mis-use of this program.
; This program is NOT in public domain.
; This program may be reproduced freely, but including
; this copyright notion.
; Purpose of this program: To encode VMS-files to
; text files of 80 characters a line, so they can be handled
; by mailers. And decoding it to the VMS-file again.
; It is immune for wrapped lines.
; Or to pack a program for archive purposes.
; Modifications of MFTU which alter the encoding scheme
; is not allowed for compatibility reasons. The encoding scheme
; has to be compatible for all versions.
; Modifications which speed up the program and don't alter the
; encoding scheme are allowed.
; For documentation on the encoding schemes used:
; See MFTU.DOC
; Any suggestions/improvements, please mail to
; mekenkam@hlerul5.bitnet.
; End of copyright note.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; Known bugs: One
; When using UNPACK file.pck/LIST
; or /CONFIRM
; And there is a block in the packed file which start
; With the sequence 26,26,0,0 it is impossible to get a
; /LIST from what is in it. The chance this happens is
; 2^-32 <2.4E-10 per block. The reason is because when asking
; a /LIST, MFTU searches for blocks starting with that mark.
; When unpacking huffman decoding is used, so it won't fail.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; You can run the program in 3 manners
; 1) by RUN MFTU
; MFTU then prompts for command
; Commands: ENCODE [/NOLOG] file-spec{,file-spec}
; DECODE [/NOLOG] [/NOCRC] file-spec{,file-spec}
; 2a) as foreign command
; mftu:=$disk:[dirpath]mftu.exe
; It then prompts for command
; 2b) as foreign commands
; encode:=$disk:[dirpath]mftu.exe encode [/log]
; decode:=$disk:[dirpath]mftu.exe decode [/log]
; 3) as command
; set command mftu
; I think the 2nd method is the preferable
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
$rmsdef
$fabdef
$namdef
$rabdef
$xabdef
$clidef
$lbrdef
$jpidef
$fscndef
cli$_syntax = 200956
BUFSIZ=512
mftu_c_eof = 26+96 ;Little 'z'
.psect CTABLE,NOWRT,NOEXE
;In these table are the replacements of the non-ebcdic characters
;although many of the characters in the table ares not used,
;still the whole tables exist
decode_table: .byte 0, 1, 2, 3, 4, 5, 6, 7
.byte 8, 9, 10, 11, 12, 13, 14, 15
.byte 16, 17, 18, 19, 20, 21, 22, 23
.byte 24, 25, 26, 27, 28, 29, 30, 31
.byte 32, 33, 34, 35, 36, 37, 38, 39
.byte 40, 41, 42, 43, 44, 45, 46, 47
.byte 48, 49, 50, 51, 52, 53, 54, 55
.byte 56, 57, 58, 59, 60, 61, 62, 63
.byte 64, 65, 66, 67, 68, 69, 70, 71
.byte 72, 73, 74, 75, 76, 77, 78, 79
.byte 80, 81, 82, 83, 84, 85, 86, 87
.byte 88, 89, 90, 91, 92, 93, 94, 95
.byte 96, 97, 98, 99, 91, 92, 93, 94
.byte 96,123,124,125,126, 32,110,111
.byte 112,113,114,115,116,117,118,119
.byte 120,121,122,123,124,125,126,127
encode_table: .byte 0, 1, 2, 3, 4, 5, 6, 7
.byte 8, 9, 10, 11, 12, 13, 14, 15
.byte 16, 17, 18, 19, 20, 21, 22, 23
.byte 24, 25, 26, 27, 28, 29, 30, 31
.byte 109, 33, 34, 35, 36, 37, 38, 39
.byte 40, 41, 42, 43, 44, 45, 46, 47
.byte 48, 49, 50, 51, 52, 53, 54, 55
.byte 56, 57, 58, 59, 60, 61, 62, 63
.byte 64, 65, 66, 67, 68, 69, 70, 71
.byte 72, 73, 74, 75, 76, 77, 78, 79
.byte 80, 81, 82, 83, 84, 85, 86, 87
.byte 88, 89, 90,100,101,102,103, 95
.byte 104, 97, 98, 99,100,101,102,103
.byte 104,105,106,107,108,109,110,111
.byte 112,113,114,115,116,117,118,119
.byte 120,121,122,105,106,107,108,127
.psect CRC_AREA,WRT,NOEXE
;Cyclic redundancy check with polynome x^16+x^15+x^2+1, start zero
copyright:: .ascid "Copyright (C) 1987 C.A.J. Mekenkamp, IJmuiden"
crc: .long
crc_ptr: .long ;pointer to place where crc is going to be
crc_desc: .long BUFSIZ+2 ;describes the block on which to
.long ;calculate the checksum
crc_poly: .long 40961 ;octal 120001, hex 0A001
crc_table: .blkl 16 ;Cyclic redundancy check table
crc_start: .long 0 ;start_crc is zero
imaglst: .word nam$c_maxrss
.word jpi$_imagname
.address imagnam
.address imagdesc
.long 0 ;eolst
imagdesc: .long 0
.address imagnam
imagnam: .blkb nam$c_maxrss
scanlst: .word 0 ;length return
.word fscn$_name
.long 0 ;address return
.long 0 ;eolst
scandefnam: .word 0 ;length return
.word fscn$_name
.long 0 ;address return
.long 0 ;eolst
helplibdef: .ascid "MFTU"
helplib: .ascid 'SYS$DISK:[]MFTU'
mftulib: .ascid 'MFTU$HLP:MFTU'
exit_status: .long 0 ;
exit_block: .long 0 ;forward link filled in by system
.address exit_handler ;routine to execute
.long 0 ;zero arguments
.address exit_status
.psect BUFFERS,WRT,NOEXE
faobufid: .blkl 2
faobufod: .blkl 2
encodingd: .ascid "Encoding of file !AS"
filnamdesc: .blkl 2
charsleft: .long 0
lastchar: .long 0
filcount: .long 0
blkcount: .long 0
outbyte: .long 0
charsiz: .long 80 ;Linesize of the .MFT file
charcnt: .long 0
chardesc: .blkl 2
chardesc2: .blkl 2
preslog: .long 0
preslist: .long 0
presconf: .long 0
crc_warning: .long 0 ;default warning given on crc error
error_delete: .long 0 ;delete file on error
encoding_type: .long 0 ;bit 0 -> clear MFTU encoding
askdecode: .ascid "Get file !AS, !UL Block!%S ? [Y]: "
askid: .long 283,askbuf
askod: .long 0,askbuf
askbuf: .blkb 283
yes_or_no: .ascid "Y"
.psect PARS,WRT,NOEXE
logpar: .ascid "LOG"
listpar: .ascid "LIST"
confpar: .ascid "CONFIRM"
outpar: .ascid "OUTPUT"
copar: .ascid "OPTION"
inpar: .ascid "INFILE"
crcpar: .ascid "CRC"
delpar: .ascid "DELERR"
keypar: .ascid "KEYWORDS"
rivad: .long 1024,0 ;Descriptor getting pointer to 1024 bytes
rovad: .blkl 2 ;For commandline (+#bytes really there)
outid: .long nam$c_maxrss,0 ;Same trick for OUTPUT parameter value
outod: .blkl 2
invid: .long nam$c_maxrss,0 ;Same trick for INFILE parameter value
invod: .blkl 2
ipars: .long 0
cprm: .ascid "MFTU> "
tildes: .ascid "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
keyid: .long 512,keywords
keyod: .long 512,keywords
help: .long 4
.address help1
help1: .ascii "MFTU "
keywords: .blkb 512
.psect huffman,wrt,noexe
frequency_table: .blkl 258 ;longwords
forest_weight_table: .blkl 258 ;longwords
forest_root_table: .blkw 258 ;words
alphabet_leaf_table: .blkw 258 ;words
tree_parent_table: .blkw 516 ;words (dont care for word 516!)
huffman_lastchar: .long
huffman_bitcount: .long
huffman_charsleft: .long 0
lasttree: .long 258 ;# forest_table
lastnode: .long 258 ;# tree_table
first: .long
second: .long
huffman_buffer: .blkb 512
huffman_buffer2: .blkb 512
tree_left_child_table:: .blkw 516 ;words, word 516 for CRC
tree_right_child_table:: .blkw 516 ;words, word 516 for CRC
huffman_id: .byte 26,26,0,0 ;Mark giving Huffman Code
.psect INFABS,WRT,NOEXE
indesc: .blkl 2
seq: .long
infabdesc: .long infabend-infab,infab
innamdesc: .long 0,inrsa
infab: $FAB nam = innam
.blkb 1
infabend:
.blkb 3 ;Align two longword again
innam: $NAM esa = inesa, -
ess = nam$c_maxrss, -
rsa = inrsa, -
rss = nam$c_maxrss
inrab: $RAB fab = infab
lrlxab: $xabfhc ;for Longest Record Length
;which is not in the FAB
;some programs rely on the LRL field
;which is only for statistical purposes
inesa: .blkb nam$c_maxrss
inrsaptr: .long inrsastart
inrsastart: .blkw 1 ;Word room for starting
inrsa: .blkb nam$c_maxrss
.blkb 2 ;2 spare bytes
inrsaend:
crc_infab_desc: .long 80,infab
crc_innam_desc: .long nam$c_maxrss+2,inrsastart
alloc_bytes: .long BUFSIZ+4+14
filbuf_desc: .long BUFSIZ+4 ;That makes it dividable by 3
.long 0 ;pointer to BUFSIZ bytes
filbufptr: .long 0 ;pointer to read buffer = above+2
filbuf2_desc: .long BUFSIZ+4 ;Same as above
.long 0
filbuf2ptr: .long 0
.psect OUTFABS,WRT,NOEXE
outdesc: .blkl 2
outfabdesc: .long outfabend-outfab,outfab
outfab: $FAB nam = outnam
.blkb 1 ;must be there 81
outfabend:
.blkb 3 ;Align again as four number
outnam: $NAM esa = outesa, -
ess = nam$c_maxrss, -
rsa = outrsa, -
rss = nam$c_maxrss
outrab: $RAB fab = outfab
outesa: .blkb nam$c_maxrss
outrsa: .blkb nam$c_maxrss
outnamd: .ascid "SYS$DISK:[];" ;store it in default directory
;on default disk, new version
outdefnamd: .long 0,outdefnam+2
outdefnam: .blkb nam$c_maxrss+4
defnamd: .ascid "ENCODING.MFT"
altnamd: .ascid "PACKING.PCK"
crc_outfab_desc: .long 80,outfab
crc_outnam_desc: .long nam$c_maxrss+2,outdefnam
.psect CODE,NOWRT,EXE
.entry sigerr,^M<>
;Signal Warning error searching file
movl innam+nam$l_rsa,indesc+4 ;Fill in descriptor
movzbl innam+nam$b_rsl,indesc ;For resultant file name
pushl infab+fab$l_stv
pushl infab+fab$l_sts
pushaq indesc
pushl #1
pushal mftu_errsea
calls #5,G^lib$signal
movl #1,r0 ;Successfull completion of this routine
ret
.entry flushb,^M<r2,r3,r4,r5> ;registers used in movc3
;Output a line of chardesc chars iff chardesc>0
$wait rab=outrab ;Wait for pending i/o
blbs r0,5$ ;Error-> signal+stop
pushl outrab+rab$l_stv
pushl r0
calls #2,G^lib$stop
5$: tstl chardesc ;Chars available?
bneq 6$ ;No-> do nothing
ret
6$: movzbl chardesc,chardesc2 ;yes: copy number of chars
movc3 chardesc,@chardesc+4,@chardesc2+4
movl chardesc2+4,outrab+rab$l_rbf ;setup outrab
movw chardesc2,outrab+rab$w_rsz
$put rab=outrab ;issue a put request
10$: clrl chardesc ;buffer clear...
ret
.entry writechar,^M<>
;Write character in chardesc buffer
cmpl chardesc,charsiz ;Buffer full?
bneq 10$ ;No
calls #0,flushb ;Yes, flush buffer
10$: addl3 chardesc+4,chardesc,r0 ;Calculate place in buffer
movzbl 4(ap),r1 ;replace non ebcdic characters
;Phase 3
movb encode_table(r1),(r0)
incl chardesc ;One character more in buffer
ret
.entry putchar,^M<r2,r3,r4>
;Takes care of repeated characters
;Phase 2
tstl charsleft ; if charcount 0 -> no chars available
bneq 10$ ;else
movzbl 4(ap),lastchar ;Store character in lastchar
incl charsleft ;One char available
ret
10$: cmpb 4(ap),lastchar ; if char = lastchar -> increment
bneq 20$
incl charsleft
ret ;Else another character
20$: cmpl charsleft,#1 ;Howmany of previous charcter?
bneq 30$ ;1-> simply write it
pushl lastchar
calls #1,writechar
movzbl 4(ap),lastchar ;and store new character
ret
30$: cmpl charsleft,#2 ;2-> simply write it twice
bneq 40$
pushl lastchar
calls #1,writechar
pushl lastchar
calls #1,writechar
movzbl 4(ap),lastchar ;store new char
movl #1,charsleft ;one char available
ret
40$: cmpl charsleft,#3 ;3-> write rep3 + lastchar
bneq 50$
pushl #98
calls #1,writechar
pushl lastchar
calls #1,writechar
movzbl 4(ap),lastchar
movl #1,charsleft
ret
50$: cmpl charsleft,#4 ;4-> write rep4+lastchar
bneq 60$
pushl #99
calls #1,writechar
pushl lastchar
calls #1,writechar
movzbl 4(ap),lastchar
movl #1,charsleft
ret
60$: pushl #97 ;>4 write start repeat count
calls #1,writechar
movl charsleft,r2 ;Write radix 24 number
70$: cmpl r2,#24 ;least significant byte first
blss 80$ ;with byte offset 97
divl3 #24,r2,r3
mull3 #24,r3,r4
subl2 r4,r2
addl2 #97,r2 ;offset
pushl r2
calls #1,writechar ;write it
movl r3,r2
brb 70$
80$: addl2 #97,r2 ;offset
pushl r2
calls #1,writechar ;write it
movzbl lastchar,r2
movzbl encode_table(r2),r3 ;Take the nonebcdic transferred
;Version 1.00 had a bug here
;But this is a seldom case
bbc #5,r3,90$ ;normal character
bbc #6,r3,90$ ;normal character
pushl #121 ;control character: end repeat
calls #1,writechar ;necessary
90$: pushl r2 ;and then write the character
calls #1,writechar
movzbl 4(ap),lastchar ;lastchar becomes new char
movl #1,charsleft ;One char available
ret
.entry putlastchar,^M<>
;Write EOF and flush the buffer so it is ready to close
pushl #mftu_c_eof ;Putchar is one character slow
calls #1,putchar
pushl #0 ;so in this way lastchar will be zero
calls #1,putchar
clrl charsleft ;and charsleft too
calls #0,flushb ;flush the buffer
ret
.entry huffman_count_block,^M<r2>
clrl r2 ;Byte in block
tstl huffman_charsleft ;If zero chars (init)
beql 40$ ;Goto 40
10$: cmpb @4(ap)[r2],huffman_lastchar ;Compare with last char
bneq 20$ ;If equal
aoblss #260,huffman_charsleft,50$ ;<260 next
decl huffman_charsleft ;Essential
brb 30$ ;=260, say 259 chars available
20$: movzbl huffman_lastchar,r0 ;get lastchar index
cmpl huffman_charsleft,#4 ;If <4 no repeat
bgequ 30$
addl2 huffman_charsleft,frequency_table[r0] ;add counter
brb 40$ ;next
30$: incl frequency_table+1024 ;repeat count freq +=1
incl frequency_table[r0] ;character freq +=1
subl3 #4,huffman_charsleft,r0 ;howmany times-4 freq +=1
incl frequency_table[r0]
40$: movl #1,huffman_charsleft ;One character available
movzbl @4(ap)[r2],huffman_lastchar ;This char.
50$: aoblss 8(ap),r2,10$ ;increase pointer get next char
ret
.entry huffman_count_end,^M<>
movzbl huffman_lastchar,r0 ;get lastchar index
cmpl huffman_charsleft,#4 ;If <4 no repeat
bgequ 10$
addl2 huffman_charsleft,frequency_table[r0] ;add counter
brb 20$ ;next
10$: incl frequency_table+1024 ;repeat count freq +=1
incl frequency_table[r0] ;character freq +=1
subl3 #4,huffman_charsleft,r0 ;howmany times-4 freq +=1
incl frequency_table[r0]
20$: movl #1,frequency_table+1028 ;One EOF sign...
clrl huffman_charsleft ;Clear charsleft
ret
.entry create_forest,^M<>
;Creates a forest given a frequency table of characters.
movl #1,r0 ;start with chr(0)
10$: movl frequency_table-4[r0],forest_weight_table-4[r0] ;copy weight
movw r0,alphabet_leaf_table-2[r0] ;copy place in forest
movw r0,forest_root_table-2[r0]
20$: aobleq #258,r0,10$ ;try next char
ret
.entry light_ones,^M<r2,r3,r4>
;searches for the two smallest weights in the forest
;returns values in first and second.
cmpl forest_weight_table,forest_weight_table+4 ;try first two
bgtru 10$ ;smallest in r2, second in r3
movl #1,r2
movl #2,r3
brb 20$
10$: movl #1,r3
movl #2,r2
20$: movl #2,r4
brb 50$
30$: cmpl forest_weight_table-4[r4],forest_weight_table-4[r2] ;smaller?
bgtru 40$ ;No, test for smaller than second
movl r2,r3 ;Set second
movl r4,r2 ;set new smallest
brb 50$
40$: cmpl forest_weight_table-4[r4],forest_weight_table-4[r3] ;smaller?
bgtru 50$ ;No, next part
movl r4,r3 ;Yes set new second
50$: aobleq lasttree,r4,30$
60$: movl r2,first ;store smallest in first
movl r3,second ;store second in second
ret
.entry create_node,^M<r2,r3,r4,r5>
;returns the created node
incl lastnode ;lastnode increases
movl lastnode,r0 ;lastnode in r0
movl first,r2
movl second,r3
movzwl forest_root_table-2[r2],r4
movw r4,tree_left_child_table-2[r0]
movzwl forest_root_table-2[r3],r5
movw r5,tree_right_child_table-2[r0]
clrw tree_parent_table-2[r0]
movw r0,tree_parent_table-2[r4]
movw r0,tree_parent_table-2[r5]
ret
.entry huffman,^M<r2,r3,r4,r5>
;Generates an HUFFMAN tree.
movc5 #0,#0,#0,#1032,tree_left_child_table
movc5 #0,#0,#0,#1032,tree_right_child_table
movc5 #0,#0,#0,#1032,tree_parent_table
movl #258,lastnode
movl #258,lasttree
calls #0,create_forest
movl lasttree,r4
decl r4 ;So R4 is one less than lasttree for sobgtr
10$: calls #0,light_ones ;get least two in first and second
calls #0,create_node ;create new node with children first and second
movl first,r2 ;smallest in R2
movl second,r3 ;second in R3
addl2 forest_weight_table-4[r3],forest_weight_table-4[r2]
movw r0,forest_root_table-2[r2]
movl forest_weight_table[r4],forest_weight_table-4[r3]
movw forest_root_table[r4],forest_root_table-2[r3]
decl lasttree
sobgtr r4,10$ ;Get till lasttree=1
movzwl lastnode,r0
ret
.entry huffman_out_buffer,^M<r2,r3>
clrl r2
divl3 #8,huffman_bitcount,r3
10$: movb @4(ap)[r2],huffman_buffer[r3]
aoblss #512,r3,30$
calls #0,huffman_flushbits
clrl r3
30$: aoblss 8(ap),r2,10$
mull3 #8,r3,huffman_bitcount
ret
.entry huffman_getbits,^M<r2,r3,r4,r5>
$wait rab=inrab
blbs r0,20$ ;except for EOF!!!!!
cmpl r0,#rms$_eof
bneq 10$
ret
10$: pushl inrab+rab$l_stv
pushl r0
calls #2,g^lib$stop
20$: movc3 #512,huffman_buffer2,huffman_buffer
$get rab=inrab
movl #1,r0
ret
.entry huffman_in_buffer,^M<r2,r3>
divl3 #8,huffman_bitcount,r3
10$: movb huffman_buffer[r3],@4(ap)[r2]
aoblss #512,r3,20$
calls #0,huffman_getbits
blbs r0,15$
pushl inrab+rab$l_stv
pushl r0
calls #2,g^lib$stop
15$: clrl r3
20$: aoblss 8(ap),r2,10$
mull3 #8,r3,huffman_bitcount
ret
.entry huffman_flushbits,^M<r2,r3,r4,r5>
$wait rab=outrab ;wait for pending I/O
blbs r0,10$ ;stop on any error
pushl outrab+rab$l_stv
pushl r0
calls #2,g^lib$stop
10$: movc3 #512,huffman_buffer,huffman_buffer2 ;copy buffer
movc5 #0,#0,#0,#512,huffman_buffer ;Clear buffer
moval huffman_buffer2,outrab+rab$l_rbf ;setup outrab
movw #512,outrab+rab$w_rsz
$put rab=outrab ;issue put request
ret
.entry huffman_outchar,^M<R2,R3>
;put an huffman encoded stream character
clrl r2 ;Counter for #bits used
movl huffman_bitcount,r3 ;optimize count in register
movzwl 4(ap),r0 ;Character in r0
incl r0 ;Should be one more
10$: movzwl tree_parent_table-2[r0],r1 ;Get parent
tstw r1 ;If no parent->
beql 50$ ;Character encoded.
incl r2 ;One bit more
cmpw r0,tree_left_child_table-2[r1] ;Is it leftchild?
bneq 20$
clrl -(sp)
brb 30$
20$: cmpw r0,tree_right_child_table-2[r1] ;Is it rightchild?
bneq 40$ ;If not inconsistency error
pushl #1 ;If so, 1 = RIGHT
30$: movl r1,r0 ;parent to r0
brb 10$ ;next.
40$: pushal mftu_incons
calls #1,g^lib$stop ;Stop on inconsistency error
50$: insv (sp)+,r3,#1,huffman_buffer ;Pop bit from stack
aoblss #4096,r3,60$ ;If buffer full->flush
calls #0,huffman_flushbits
clrl r3
60$: sobgtr r2,50$
movl r3,huffman_bitcount ;restore in huffman_bitcount
ret
.entry huffman_readchar,^M<r2>
10$: movl #515,r2 ;Store Root of tree in R2
20$: bbs huffman_bitcount,huffman_buffer,30$ ;If bit set
;->right child
movzwl tree_left_child_table-2[r2],r2 ;else left child
brb 40$
30$: movzwl tree_right_child_table-2[r2],r2
40$: cmpw r2,#258 ;r2<258
blssu 50$ ;then character r2 is character
beql 60$ ;Eof: do not readin next block to prevent EOF error
;This is necessary because a new file starts on a block
;boundary
aoblss #4096,huffman_bitcount,20$ ;Increase bitcount
clrl huffman_bitcount
calls #0,huffman_getbits ;Get new block
blbs r0,20$
pushl inrab+rab$l_stv ;stop on error
pushl r0
calls #2,g^lib$stop
50$: aoblss #4096,huffman_bitcount,60$ ;Increase bitcount
clrl huffman_bitcount
calls #0,huffman_getbits ;Get new block
60$: movzwl r2,r0
decl r0 ;Return it
ret
.entry huffman_getchar,^M<>
tstl huffman_charsleft ;characters left?
beql 10$
decl huffman_charsleft
movzwl huffman_lastchar,r0
ret
10$: calls #0,huffman_readchar
cmpw r0,#256 ;repeat count?
bneq 20$
rsp=.
calls #0,huffman_readchar ;Get howmany
addl3 #3,r0,huffman_charsleft ;(0-255->4-259)
calls #0,huffman_readchar
movzwl r0,huffman_lastchar
20$: ret ;return with char in r0 (it's a word...)
.entry huffman_decode_block,^M<>
clrl r2
calls #0,huffman_getchar
cmpw r0,#257
bneq 20$
movl #rms$_eof,r0
ret
10$: calls #0,huffman_getchar
20$: movb r0,@4(ap)[r2]
aoblss 8(ap),r2,10$
movl #1,r0
ret
.entry huffman_encode_block,^M<r2>
clrl r2 ;Byte in block
tstl huffman_charsleft ;If zero chars (init)
beql 40$ ;Goto 40
10$: cmpb @4(ap)[r2],huffman_lastchar ;Compare with last char
bneq 20$ ;If equal
aoblss #260,huffman_charsleft,50$ ;<260 next
decl huffman_charsleft ;Essential
brb 30$ ;=260, say 259 chars available
20$: cmpl huffman_charsleft,#4 ;If <4 no repeat
bgequ 30$
25$: movzbl huffman_lastchar,-(sp) ;output charsleft characters
calls #1,huffman_outchar
sobgtr huffman_charsleft,25$
brb 40$ ;next
30$: pushl #256
calls #1,huffman_outchar
subl3 #4,huffman_charsleft,r0 ;howmany times-4
pushl r0
calls #1,huffman_outchar
movzbl huffman_lastchar,-(sp)
calls #1,huffman_outchar
40$: movl #1,huffman_charsleft ;One character available
movzbl @4(ap)[r2],huffman_lastchar ;This char.
50$: aoblss 8(ap),r2,10$ ;increase pointer get next char
ret
.entry huffman_encode_end,^M<>
cmpl huffman_charsleft,#4 ;If <4 no repeat
bgequ 10$
5$: movzbl huffman_lastchar,-(sp)
calls #1,huffman_outchar
sobgtr huffman_charsleft,5$
brb 20$ ;next
10$: pushl #256
calls #1,huffman_outchar
subl3 #4,huffman_charsleft,r0 ;howmany times-4
pushl r0
calls #1,huffman_outchar
movzbl huffman_lastchar,-(sp)
calls #1,huffman_outchar
20$: pushl #257
calls #1,huffman_outchar ;One EOF sign...
tstl huffman_bitcount
beql 30$
calls #0,huffman_flushbits
30$: clrl huffman_charsleft ;Clear charsleft
ret
.entry encode_block,^M<R2,R3,R4>
;Extract all sixbits as described above and putchar them
;phase 1
movl 8(ap),r2 ;# of sixbits to pass
clrl r3
brb 20$ ;don't add 6 first time
10$: addl2 #6,r3 ;point to next six bits
20$: extzv r3,#6,@4(ap),r4 ;Get six bits
bbs #5,r4,30$ ;Fifth bit clear then
bisb2 #64,R4 ;Set sixth bit
30$: pushl r4
calls #1,putchar ;putchar it
sobgtr r2,10$ ;get next six bits
ret
.entry readb,^M<r2,r3,r4,r5> ;Registers used in movc3
;read a line from the textfile
$wait rab=inrab ;wait for pending i/o
blbs r0,10$
cmpl r0,#rms$_eof ;signal and stop on error <> eof
beql 5$
cmpl r0,#rms$_rtb ;or RTB
bneq 7$
5$: ret
7$: pushl inrab+rab$l_stv
pushl r0
calls #2,G^lib$stop
10$: movzwl inrab+rab$w_rsz,chardesc
clrl charcnt ;0 characters read
movc3 chardesc,@chardesc2+4,@chardesc+4
movl chardesc2+4,inrab+rab$l_ubf
movw charsiz,inrab+rab$w_usz
$get rab=inrab
movl #1,r0 ;Successfull completion
ret
.entry readchar,^M<>
;gets a character from the buffer
5$: cmpl charcnt,chardesc ;No chars left?
bneq 10$
calls #0,readb ;get new buffer
blbs r0,5$ ;Skip Blank lines
pushl inrab+rab$l_stv ;signal and stop on error (eof)
pushl r0
calls #2,G^lib$stop
10$: addl3 chardesc+4,charcnt,r0 ;where is next char to read?
movzbl (r0),r0 ;return it in r0
incl charcnt ;one more character read
ret
.entry getchar,^M<R2,R3>
tstl charsleft ;Chars left?
beql 10$
decl charsleft ;yes one less left
movzbl lastchar,r0 ;and return it in r0
ret
10$: calls #0,readchar ;no: get new char
cmpb r0,#97 ;little a repeat count
bneq 20$
movl #1,r2 ;multiplication factor in radix 24
clrl r3
12$: calls #0,readchar
bbc #6,r0,18$ ;no con: end repeat count
bbc #5,r0,18$ ;idem
cmpb r0,#121 ;little y end repeat count
beql 17$ ;so get the next char
subl2 #97,r0 ;minus little a
mull2 r2,r0 ;multiply with radix factor
addl2 r0,r3 ;count with previous value
mull2 #24,r2 ;radix factor :* 24
brb 12$
17$: calls #0,readchar
18$: tstl r3
bneq 19$
pushl blkcount
pushl #1
pushal mftu_reperr ;Unrecoverable error in file format
calls #3,G^lib$stop
19$: decl r3
movl r3,charsleft
movzbl decode_table(r0),lastchar ;non ebcdic chars put back
movl lastchar,r0
ret
20$: cmpb r0,#98 ;little b repeat char 3
bneq 30$
calls #0,readchar
movl #2,charsleft
movzbl decode_table(r0),lastchar ;non ebcdic chars put back
movl lastchar,r0
ret
30$: cmpb r0,#99 ;little c repeat char 4
bneq 40$
calls #0,readchar
movl #3,charsleft
movzbl decode_table(r0),lastchar ;non ebcdic chars put back
movl lastchar,r0
ret
40$: movzbl decode_table(r0),r0 ;non ebcdic chars put back
ret
.entry decode_block,^M<r2,r3>
;turns whole block from 4*six bits to 3 bytes
movl 8(ap),r2 ;#sixbits to get
clrl r3
calls #0,getchar
cmpb r0,#mftu_c_eof ;little 'z' then eof on this file
bneq 30$
movl #rms$_eof,r0 ;so return it in r0
ret
20$: addl2 #6,r3
calls #0,getchar ;get next char
30$: insv r0,r3,#6,@4(ap) ;insert 6 bits in place
sobgtr r2,20$ ;for #sixbits
movl #1,r0 ;normal completion
ret
.entry encode_file,^M<r2,r3,r4,r5>
;encodes a file
movc5 #0,#0,#0,#1032,frequency_table ;Clear Frequency_table
clrl blkcount ;zero blocks
movl innam+nam$l_rsa,innamdesc+4 ;setup descriptor
movzbl innam+nam$b_rsl,innamdesc
blbc preslog,10$ ;if /log, signal it
pushaq innamdesc
pushl #1
pushaw mftu_encoding
calls #3,G^lib$signal
10$: $fab_store fab=infab, -
fop=<NAM>, -
fac=<BIO,GET>
moval lrlxab,infab+fab$l_xab
$open fab=infab ;open file for block input
blbs r0,30$ ;with namblock input
20$: pushl infab+fab$l_stv ;on error signal en stop
pushl r0
calls #2,G^lib$stop
30$: movzbl innam+nam$b_rsl,innamdesc ;find new length!
$display fab=infab ;get fab
blbc r0,20$
movw #BUFSIZ,inrab+rab$w_usz ;setup rab for input
movl filbufptr,inrab+rab$l_ubf
$rab_store rab=inrab, -
rop=<ASY>
$connect rab=inrab
$wait rab=inrab ;wait for completion connect
blbs r0,40$ ;signal and stop on error
pushl inrab+rab$l_stv ;wait for completion of connect
pushl r0
calls #2,g^lib$stop
40$: $wait rab=outrab ;wait for pending i/o
blbs r0,60$
50$: pushl outrab+rab$l_stv
pushl r0
calls #2,G^lib$stop ;put readable info in file
60$: bbc #0,encoding_type,68$ ;if bit0 clear standard
brw 71$
68$: $fao_s ctrstr=encodingd, -
outbuf=faobufid, -
outlen=faobufod, -
p1=#innamdesc
blbs r0,70$
pushl r0
calls #1,G^lib$stop
70$: movw faobufod,outrab+rab$w_rsz
movl faobufod+4,outrab+rab$l_rbf
$put rab=outrab ;put which file is encoded
$wait rab=outrab ;wait for completion
blbc r0,50$
movw tildes,outrab+rab$w_rsz ;put record with 40 tildes
movl tildes+4,outrab+rab$l_rbf
$put rab=outrab
71$: movw innamdesc,inrsastart ;Copy lenght of name to length word
clrl infab+fab$l_ctx ;Clear CTX field
clrl infab+fab$l_xab ;Clear XAB field not encode it!!!!!!
pushl infab+fab$l_fna ;save filename address
movw lrlxab+xab$w_lrl,infab+fab$l_fna ;save in fna field
movw #-1,infab+fab$l_fna+2 ;give marker
;Calculate cyclic redundancy check on FAB
crc crc_table,crc_start,crc_infab_desc,@crc_infab_desc+4
movw r0,infab+fab$l_ctx ;store it in user CTX field lo
;Calculate cyclic redundancy check on name
crc crc_table,crc_start,crc_innam_desc,@crc_innam_desc+4
movw r0,infab+fab$l_ctx+2 ;Store it in user CTX field hi
bbc #0,encoding_type,78$ ;standard encoding when bit0=0
bbc #1,encoding_type,76$ ;huffman counting when bit1=0
pushl #258
pushl inrsaptr
calls #2,huffman_encode_block
pushl #81
pushl infabdesc+4
calls #2,huffman_encode_block
brb 79$
76$: pushl #258
pushl inrsaptr
calls #2,huffman_count_block
pushl #81
pushl infabdesc+4
calls #2,huffman_count_block
brb 79$
78$: pushl #344 ;First encode file's name
pushl inrsaptr
calls #2,encode_block
pushl #108 ;Then encode file's fab
pushl infabdesc+4
calls #2,encode_block
79$: popl infab+fab$l_fna ;restore filename address
$read rab=inrab ;First block of file read synchronously
80$: $wait rab=inrab ;Wait for reading operation to complete
blbs r0,82$ ;On error 90$ what error??
brw 90$
82$: movw inrab+rab$w_rsz,@filbuf_desc+4 ;Store byte transfer count
incl blkcount ;Increase blkcount
;Calculate cyclic redundancy check on block
crc crc_table,crc_start,crc_desc,@crc_desc+4
movw r0,@crc_ptr ;Store it in spare 2 bytes of buffer
movc3 filbuf_desc,@filbuf_desc+4,@filbuf2_desc+4
$read rab=inrab ;Issue new read request
bbc #0,encoding_type,88$
bbc #1,encoding_type,86$
pushl #516
pushl filbuf2_desc+4
calls #2,huffman_encode_block
brw 80$
86$: pushl #516
pushl filbuf2_desc+4
calls #2,huffman_count_block
brw 80$
88$: pushl #688
pushl filbuf2_desc+4
calls #2,encode_block ;Encode block during read
brw 80$
90$: cmpl r0,#rms$_eof ;on end of file encode end of file
beql 100$
pushl inrab+rab$l_stv ;signal and stop on error
pushl r0
calls #2,G^lib$stop
100$: bbs #0,encoding_type,101$ ;standard
brw 108$
101$: bbcs #1,encoding_type,103$ ;if bit1 set end else set it
calls #0,huffman_encode_end
bbsc #1,encoding_type,102$ ;Set it zero again
102$: brw 109$
103$: $disconnect rab=inrab ;prepare for pass two
$wait rab=inrab
blbs r0,105$
pushl inrab+rab$l_stv
pushl r0
calls #2,g^lib$stop
105$:
huf=.
calls #0,huffman_count_end ;end of huffman count
calls #0,huffman ;create huffman tree
movl huffman_id,huffman_buffer ;Give mark
movl #32,huffman_bitcount ;Clear huffman_bitcount
crc crc_table,crc_start,#514,tree_left_child_table+516
movw r0,tree_left_child_table+1030
pushl #516 ;Lower half is zero!
pushal tree_left_child_table+516 ;So should't be saved
calls #2,huffman_out_buffer
crc crc_table,crc_start,#514,tree_right_child_table+516
movw r0,tree_right_child_table+1030
pushl #516 ;Lower half is zero!
pushal tree_right_child_table+516 ;So should't be saved
calls #2,huffman_out_buffer
brw 30$
108$: calls #0,putlastchar ;encode end of file
109$: $close fab=infab ;close infile
blbs r0,110$ ;signal and stop on error
pushl infab+fab$l_stv
pushl r0
calls #2,G^lib$stop
110$: ret
.entry alloc_bufs,^M<>
;allocates buffers for encoding/decoding
pushal chardesc+4 ;allocate two buffers space for text
pushaw charsiz
calls #2,G^lib$get_vm
blbs r0,10$ ;stop on errors
brw 40$
10$: pushal chardesc2+4
pushaw charsiz
calls #2,G^lib$get_vm
blbs r0,20$
brw 40$
20$: pushal filbuf_desc+4 ;Allocate two buffers with same length
pushaw alloc_bytes
calls #2,G^lib$get_vm
addl3 filbuf_desc+4,#2,filbufptr
blbs r0,30$
brw 40$
30$: pushal filbuf2_desc+4
pushaw alloc_bytes
calls #2,G^lib$get_vm
addl3 filbuf2_desc+4,#2,filbuf2ptr
blbs r0,50$
40$: pushl r0
calls #1,G^lib$stop
50$: movl filbuf_desc+4,crc_desc+4
addl3 crc_desc,crc_desc+4,crc_ptr ;fill in address for crc
pushal crc_table
pushal crc_poly
calls #2,G^lib$crc_table
movl #1,r0
ret
.entry before_encode,^M<>
;before encoding files: alloc buffers, create a file
calls #0,alloc_bufs
calls #0,logpres
calls #0,delpres
10$: pushaw outod
pushaq outid
pushaq outpar
calls #3,G^cli$get_value
blbs r0,15$ ;record format CR,VAR
brw 20$
15$: movl defnamd+4,outfab+fab$l_dna
movb defnamd,outfab+fab$b_dns
blbc encoding_type,17$ ;when pack default is packing.mft
movl altnamd+4,outfab+fab$l_dna
movb altnamd,outfab+fab$b_dns
17$: movl outod+4,outfab+fab$l_fna
movb outod,outfab+fab$b_fns
$parse fab=outfab
blbc r0,20$
bbc #0,encoding_type,18$
$fab_store fab=outfab, -
fop=<OFP>, -
fac=<PUT>, -
rfm=<FIX>, -
mrs=#512
brb 19$
18$: $fab_store fab=outfab, -
fop=<OFP>, -
fac=<PUT>, -
rat=<CR>, -
rfm=<VAR>
19$: $create fab=outfab
blbs r0,21$
20$: pushl outfab+fab$l_stv
pushl r0
calls #2,g^lib$stop
21$: $rab_store rab=outrab, -
rop=<ASY>
$connect rab=outrab
$wait rab=outrab
blbs r0,30$
pushl outrab+rab$l_stv
pushl r0
calls #2,G^lib$stop
30$: ret
.entry after_encode,^M<>
;after encoding files: allocated buffers should be freed
;but task will exit after it...
$wait rab=outrab ;wait for pending i/o
blbs r0,10$
pushl outrab+rab$l_stv
pushl r0
calls #2,G^lib$stop ;signal and stop on error
10$: $close fab=outfab ;close file
blbs r0,20$
pushl outfab+fab$l_stv
pushl r0
calls #2,g^lib$stop ;signal and stop on error
20$: ret
.entry cond_sat,^M<>
blbs presconf,5$
brw 30$
5$: pushl outfab+fab$l_alq
pushaq filnamdesc
pushaq askid
pushaw askod
pushaq askdecode
calls #5,g^sys$fao
blbs r0,10$
pushl r0
calls #1,g^lib$stop
10$: pushaq askod
pushaq yes_or_no
calls #2,g^lib$get_command ;Get from sys$command
blbs r0,20$
cmpl r0,#rms$_eof
bneq 20$
pushl #1
calls #1,g^sys$exit ;If control-z here, simply exit
20$: bicb2 #32,@yes_or_no+4 ;Make it uppercase and space->0
tstb @yes_or_no+4
beql 30$ ;If empty YES
cmpb @yes_or_no+4,#89 ;Y
beql 30$ ;yes
cmpb @yes_or_no+4,#78 ;N
bneq 10$
brb 35$ ;no
30$: blbc preslist,40$
pushl outfab+fab$l_alq
pushaq filnamdesc
pushl #2
pushal mftu_present
calls #4,G^lib$signal
35$: clrl r0 ;Do not select file
ret
40$: movl #1,r0 ;Select file
ret
.entry decode_file,^M<r2,r3,r4,r5> ;for cmpc3, movc3
clrl blkcount ;zero blocks
;First Open file
$fab_store fab=infab,-
fop=<NAM>,-
fac=<GET>
$open fab=infab
blbs r0,10$
pushl infab+fab$l_stv
pushl r0
calls #2,G^lib$stop
10$: $rab_store rab=inrab, -
rop=<ASY>
$connect rab=inrab ;asynchronous Input
$wait rab=inrab
blbs r0,20$
pushl inrab+rab$l_sts
pushl r0
calls #2,G^lib$stop
20$: bbs #0,encoding_type,21$
brw 28$
;Read in the tree, first the left part, then the right part
21$: moval huffman_buffer2,inrab+rab$l_ubf
movw #512,inrab+rab$w_usz
$get rab=inrab ;set up for read
214$: calls #0,huffman_getbits
blbs r0,215$
brw 40$
215$: clrl huffman_charsleft
movl #32,huffman_bitcount
cmpl huffman_buffer,huffman_id ;Is it a packed file
beql 22$ ;To avoid USERS from unpacking
movl innam+nam$l_rsa,innamdesc+4
movzbw innam+nam$b_rss,innamdesc
pushaq innamdesc
pushl #1
pushal mftu_nopack ;Files that are not packed
calls #3,g^lib$stop
22$: pushl #516 ;Lower half is zero!
pushal tree_left_child_table+516
calls #2,huffman_in_buffer ;Get left child
crc crc_table,crc_start,#514,tree_left_child_table+516
cmpw r0,tree_left_child_table+1030
beql 25$
blbc crc_warning,25$
movzwl tree_left_child_table+1030,-(sp)
pushl r0
pushl blkcount
pushl #3
pushal mftu_crcerr
blbc error_delete,24$
calls #5,g^lib$stop
24$: calls #5,g^lib$signal
25$: pushl #516 ;Lower half is zero!
pushal tree_right_child_table+516
calls #2,huffman_in_buffer ;Get right child
crc crc_table,crc_start,#514,tree_right_child_table+516
cmpw r0,tree_right_child_table+1030
beql 27$
blbc crc_warning,27$
clrl -(sp) ;Signal warning ! Bad data block zero
movzwl tree_right_child_table+1030,-(sp)
pushl r0
pushl blkcount
pushl #3
pushal mftu_crcerr
blbc error_delete,26$
calls #5,g^lib$stop
26$: calls #5,g^lib$signal
27$: brw 66$ ;Now get name and fab
;At this stage The file is open, now look for the forty tildes
28$: movl chardesc2+4,inrab+rab$l_ubf
movw charsiz,inrab+rab$w_usz
$get rab=inrab
30$: clrl charsleft ;initialize to zero
calls #0,readb
blbs r0,65$
cmpl r0,#rms$_rtb ;record to big, no error at this stage
bneq 40$
$get rab=inrab ;But necessary to get a new block
brb 65$
40$: tstl filcount
beql 60$
$close fab=infab
blbc r0,50$
movl #1,r0
ret
50$: pushl infab+fab$l_stv
pushl r0
calls #2,G^lib$stop
60$: pushl inrab+rab$l_stv
pushl r0
calls #2,G^lib$stop
65$: movzwl chardesc,charcnt
cmpc3 tildes,@tildes+4,@chardesc+4 ;beware of R2 and R3
bneq 30$
;At this stage the file is ready to decode
pushl #344 ;first get name
pushal outdefnam
calls #2,decode_block
pushl #108 ;then get fab
pushl outfabdesc+4
calls #2,decode_block
brb 68$
66$: pushl #258 ;first get name
pushal outdefnam
calls #2,huffman_decode_block
pushl #81 ;then get fab
pushl outfabdesc+4
calls #2,huffman_decode_block
68$: movzwl outdefnam,outdefnamd
movl outfab+fab$l_ctx,crc ;Get CRC on fab/nam from fab CTX field
clrl outfab+fab$l_ctx ;Clear CTX field
;Calculate cyclic redundancy check on FAB
crc crc_table,crc_start,crc_outfab_desc,@crc_outfab_desc+4
cmpw r0,crc ;compare with given crc
beql 70$
blbc crc_warning,70$
pushl crc ;else give warning message
pushl r0
pushl #0
pushl #3
pushal mftu_crcerr
calls #5,g^lib$signal
;Calculate cyclic redundancy check on name
70$: crc crc_table,crc_start,crc_outnam_desc,@crc_outnam_desc+4
cmpw r0,crc+2 ;compare with given crc
beql 80$
blbc crc_warning,80$
pushl crc+2 ;else give warning message
pushl r0
pushl #0
pushl #3
pushal mftu_crcerr
calls #5,g^lib$signal
;setup decoded fab
80$: $filescan_s srcstr=outdefnamd, -
valuelst=scandefnam ;search for start of filename
blbs r0,85$
pushl r0
calls #1,g^lib$stop
85$: cmpw #-1,outfab+fab$l_fna+2
bneq 86$ ;-1 is flag for lrl filled in
;if not, no LRL present
movw outfab+fab$l_fna,lrlxab+xab$w_lrl ;get lrl from name field
moval lrlxab,outfab+fab$l_xab ;according to documentation
;only the lrl field of the
;is used
;if not, blame DEC, not me!
86$: movb outnamd,outfab+fab$b_fns
movl outnamd+4,outfab+fab$l_fna
; movb outdefnamd,outfab+fab$b_dns
; movl outdefnamd+4,outfab+fab$l_dna
movl scandefnam+4,outfab+fab$l_dna
subl3 outdefnamd+4,scandefnam+4,r0
subw3 r0,outdefnamd,r0
movb r0,outfab+fab$b_dns
;;;;; clrl outfab+fab$l_fop ;Do NOT clear FOP
clrb outfab+fab$b_fac
clrw outfab+fab$w_ifi ;clear internal file identifier value!
clrb outfab+fab$b_shr
clrl outfab+fab$l_sts
clrl outfab+fab$l_stv
$fab_store fab=outfab, -
nam=outnam, -
fac=<BIO,PUT>
$parse fab=outfab
blbs r0,90$
pushl outfab+fab$l_stv
pushl r0
calls #2,g^lib$stop
90$: incl filcount
movl outnam+nam$l_esa,filnamdesc+4
movzbl outnam+nam$b_esl,filnamdesc
calls #0,cond_sat
blbs r0,95$
92$: blbs encoding_type,93$
brw 30$ ;skip till next forty tildes
;Other case: Try to look for a file starting with MARK
;There is a chance 2^-32 <= 2.4E-10 per block it will fail.
;But I'll take that risk. There is one feature less when it happens
;A /LIST is not possible, but unpacking is still possible.
93$: calls #0,huffman_getbits
blbs r0,94$
brw 40$
94$: cmpl huffman_buffer,huffman_id
bneq 93$
brw 215$
95$:
;;; $fab_store fab=outfab, -
;;; fop=<OFP>
;;;keep rest of FOP fields
insv #1,#fab$v_ofp,#1,outfab+fab$l_fop
$create fab=outfab ;Create the file
blbs r0,100$ ;Quit on any error
pushl outfab+fab$l_stv
pushl r0
calls #2,G^lib$stop
100$: $rab_store rab=outrab, -
rop=<ASY>
$connect rab=outrab
$wait rab=outrab
blbs r0,110$
pushl outrab+rab$l_sts
pushl r0
calls #2,G^lib$stop
110$: blbc encoding_type,118$
pushl #516
pushl filbuf_desc+4
calls #2,huffman_decode_block
brb 119$
118$: pushl #688
pushl filbuf_desc+4
calls #2,decode_block
119$: blbs r0,120$
brw 150$
120$: $wait rab=outrab ;wait for pending i/o
blbs r0,130$
pushl inrab+rab$l_stv
pushl r0
calls #2,g^lib$stop
130$: movc3 filbuf_desc,@filbuf_desc+4,@filbuf2_desc+4
incl blkcount ;Increase blkcount
movw @crc_ptr,crc
;Calculate cyclic redundancy check on block
crc crc_table,crc_start,crc_desc,@crc_desc+4
cmpw r0,crc ;compare with given crc
beql 140$
blbc crc_warning,140$ ;If /NOCRC no warning given
pushl crc ;else give warning message
pushl r0
pushl blkcount
pushl #3
pushal mftu_crcerr
calls #5,g^lib$signal
140$: movl filbuf2ptr,outrab+rab$l_rbf
movw @filbuf2_desc+4,outrab+rab$w_rsz
$write rab=outrab
brw 110$
150$: $wait rab=outrab
blbs r0,160$
pushl outrab+rab$l_stv
pushl r0
calls #2,g^lib$stop
160$: $close fab=outfab
blbc r0,180$
clrl blkcount
blbc preslog,170$
movl outnam+nam$l_rsa,filnamdesc+4
movzbl outnam+nam$b_rsl,filnamdesc
pushl outfab+fab$l_alq
pushaq filnamdesc
pushl #2
pushaq mftu_decoded
calls #4,G^lib$signal
170$: blbs encoding_type,175$
brw 30$
175$: brw 214$ ;upwards....
180$: pushl infab+fab$l_stv
pushl r0
calls #2,g^lib$stop
ret
.entry before_decode,^M<>
;before decoding files allocate buffers
calls #0,alloc_bufs
calls #0,logpres
calls #0,confpres
calls #0,listpres
calls #0,crcpres
calls #0,delpres
ret
.entry after_decode,^M<> ;nothing really
ret
.entry process_files,^M<r2>
;procedure handles all file given on commandline, wildcards allowed
movl 4(ap),r2
movb (r2),infab+fab$b_fns
movl 4(r2),infab+fab$l_fna
pushal seq
pushaw sigerr
pushl 8(ap)
pushab infab
calls #4,G^lib$file_scan ;call procedure on all files
cmpl r0,#rms$_nmf ;nmf is success
beql 10$
cmpl r0,#rms$_fnf ;fnf is success, all others fail
bnequ 20$
10$: movl #1,r0 ;if nmf successfull completion
20$: ret
.entry compar,^M<>
;Parses command line if command set with set command mftu
movaw G^lib$sig_to_ret,(FP) ;errors trapped status->r0
pushaq copar
calls #1,G^cli$present
blbs r0,10$ ;if not present return
ret
10$: pushaw rovad ;if present use it as
pushaq rivad ;commandstring
pushaq copar
calls #3,G^cli$get_value
blbs r0,20$
ret
20$: pushaq cprm
pushaw G^lib$get_input
pushaw G^lib$get_input
pushal mftu_table
pushaq rovad
calls #5,G^cli$dcl_parse
ret
.entry forpar,^M<>
;parses commandline if foreign command
movaw G^lib$sig_to_ret,(FP)
pushl #0
pushaw rovad
pushl #0
pushaq rivad
calls #4,G^lib$get_foreign
blbc r0,10$
tstw rovad
bnequ 20$
movl #cli$_syntax,r0
ret
20$: pushaq cprm
pushaw G^lib$get_input
pushaw G^lib$get_input
pushal mftu_table
pushaq rovad
calls #5,G^cli$dcl_parse
10$: ret
.entry runpar,^M<>
;asks for commandline when started with run mftu, or given no parameters
movaw G^lib$sig_to_ret,(FP)
pushl #cprm
pushaw G^lib$get_input
pushaw G^lib$get_input
pushal mftu_table
pushl #0
calls #5,cli$dcl_parse
ret
.entry getpar,^M<>
;gets commandline parameters
calls #0,compar ;started with CLI command MFTU
blbs r0,30$ ;if success return
cmpl r0,#rms$_eof ;else possible return codes:
beql 30$ ;eof->return
cmpl r0,#cli$_nocomd ;no command-> return
beql 30$
cmpl r0,#cli$_syntax ;if syntax error foreign command
beql 10$
cmpl r0,#cli$_absent
beql 20$ ;absent-> get command
pushl r0 ;others: signal error and quit
calls #1,G^lib$stop
10$: calls #0,forpar ;foreign command MFTU ?
blbs r0,30$
cmpl r0,#cli$_syntax ;not foreign command
beql 20$
cmpl r0,#cli$_nocomd ;no command->return
beql 30$
pushl r0
calls #1,G^lib$stop ;if error signal it
20$: calls #0,runpar ;started with RUN mftu
blbs r0,30$
cmpl r0,#rms$_eof ;eof->return
beql 30$
cmpl r0,#cli$_nocomd ;no command-> return
beql 30$
pushl r0 ;other error: signal+stop
calls #1,G^lib$stop
30$: ret
.entry getfil,^M<>
;gets a filename from list parameter
pushaw invod
pushaq invid
pushaq inpar
calls #3,G^cli$get_value
ret
.entry crcpres,^M<>
;sets flag if /CRC switch present
movaw G^lib$sig_to_ret,(FP)
pushaq crcpar
calls #1,G^cli$present
blbc r0,10$
incl crc_warning
10$: ret
.entry delpres,^M<>
;sets flag if /delerr qualifier present
movaw G^lib$sig_to_ret,(FP)
pushaq delpar
calls #1,G^cli$present
blbc r0,10$
incl error_delete
10$: ret
.entry listpres,^M<>
;sets flag if /list switch present
movaw G^lib$sig_to_ret,(FP)
pushaq listpar
calls #1,G^cli$present
blbc r0,10$
incl preslist
10$: ret
.entry confpres,^M<>
;sets flag if /confirm switch present
movaw G^lib$sig_to_ret,(FP)
pushaq confpar
calls #1,G^cli$present
blbc r0,10$
incl presconf
10$: ret
.entry logpres,^M<>
;sets flag if /log switch present
movaw G^lib$sig_to_ret,(FP)
pushaq logpar
calls #1,G^cli$present
blbc r0,10$
incl preslog
10$: ret
.entry mftu_encode,^M<>
;dispatched procedure which handles command encode files
calls #0,before_encode ;call procedure before encode
10$: calls #0,getfil
blbc r0,20$
pushaw encode_file
pushaq invod
calls #1,process_files
brb 10$ ;loop over all files given
20$: pushal seq
pushab infab
calls #2,G^lib$file_scan_end
calls #0,after_encode ;call procedure after encode
ret
.entry mftu_decode,^M<>
;dispatched procedure which handles command decode files
calls #0,before_decode
10$: calls #0,getfil
blbc r0,20$
pushaw decode_file
pushaq invod
calls #1,process_files
brb 10$
20$: pushal seq
pushab infab
calls #2,G^lib$file_scan_end
calls #0,after_decode
ret
.entry mftu_put_help,^M<>
movaw g^lib$sig_to_ret,(fp) ;Return when error signaled
pushaw g^lib$get_input
pushl #0
pushl 4(ap) ;which help library to search?
pushaq help
pushal #80
pushaw g^lib$put_output
calls #6,g^lbr$output_help ;call help
ret
.entry find_helplib,^M<r2,r3,r4,r5>
movaw g^lib$sig_to_ret,(fp)
$getjpiw_s itmlst=imaglst ;get filename off image executing
blbs r0,10$
ret
10$: $filescan_s srcstr=imagdesc, -
valuelst=scanlst ;search for start of filename
blbs r0,20$
ret
20$: movc5 #4,@helplibdef+4,#0,#5,@scanlst+4 ;say mftu in place
subl3 imagdesc+4,scanlst+4,imagdesc ;calculate new lenght
addl2 #4,imagdesc
movl #1,r0
ret
.entry mftu_get_help_key,^M<>
movaw g^lib$sig_to_ret,(fp) ;If error plane help
pushaw keyod
pushaq keyid
pushaq keypar
calls #3,G^cli$get_value
blbs r0,10$
ret
10$: tstw keyod
beql 20$
addw2 keyod,help ;add length
incw help ;add 1 for space in between
20$: ret
.entry mftu_help,^M<>
;dispatched procedure which handles command help
calls #0,mftu_get_help_key
pushaq mftulib ;First try to look for mftu$hlp
calls #1,mftu_put_help
blbs r0,10$
pushaq helplib ;Then try in current directory
calls #1,mftu_put_help
blbs r0,10$
calls #0,find_helplib ;finally try where executable is
blbc r0,5$
pushaq imagdesc
calls #1,mftu_put_help
blbs r0,10$
5$: pushal mftu_usehow
calls #1,g^lib$signal
10$: ret
.entry alloc_parbufs,^M<>
;Allocate some buffers for program to work
addw3 encodingd,#nam$c_maxrss,faobufid
pushal faobufid+4 ;address where pointer to fill in
pushaw faobufid ;address howmany bytes
calls #2,g^lib$get_vm
movl faobufid+4,faobufod+4 ;copy pointer
blbc r0,5$ ;No memory: signal error and stop
pushal rivad+4 ;allocate two buffers space for text
pushaw rivad
calls #2,G^lib$get_vm
movl rivad+4,rovad+4 ;copy address to descriptor
blbs r0,10$
5$: pushl r0
calls #1,G^lib$stop
10$: pushal outid+4
pushaw outid
calls #2,g^lib$get_vm
movl outid+4,outod+4
blbc r0,5$
pushal invid+4
pushaw invid
calls #2,g^lib$get_vm
movl invid+4,invod+4
blbc r0,5$
ret
;Closes files if an error occurred
;Delete file if an error occurs when asked.
.entry exit_handler,^M<>
$wait rab=inrab ;wait pending i/o
$wait rab=outrab
$close fab=infab ;Infab file will be kept
blbc error_delete,10$
$fab_store fab=outfab, -
fop=<NAM,DLT>
10$: $close fab=outfab ;Outfab file will be deleted
movl exit_status,r0
ret
.entry mftu_pack,^M<>
movl #1,encoding_type ;simply encoding_type = 1
calls #0,mftu_encode ;call as encode
ret
.entry mftu_unpack,^M<>
movl #1,encoding_type ;simply encoding_type = 1
calls #0,mftu_decode ;call as decode
ret
.entry MFTU,^M<>
calls #0,alloc_parbufs ;alloc the buffer for the parameters
calls #0,getpar ;get parameter info
blbs r0,10$
movl #1,r0
ret
10$: $dclexh_s desblk = exit_block
calls #0,G^cli$dispatch ;calls corresponding procedure
$canexh_s desblk = exit_block
movl #1,r0
ret
.end MFTU
198807291104429!End of MFTU.MAR
$WRITE SYS$ERROR "Creating MFTUCMD.CLD..."
$CREATE MFTUCMD.CLD
$DECK/DOLLARS="198807291104429"
define verb MFTU
parameter P1,label=OPTION,value(type=$rest_of_line)
198807291104429!End of MFTUCMD.CLD
$WRITE SYS$ERROR "Creating MFTUMAKE.COM..."
$CREATE MFTUMAKE.COM
$DECK/DOLLARS="198807291104429"
$ On Control_Y Then Goto The_Exit
$ On Error Then Goto The_Exit
$ macro/obj=mftu mftu
$ message/obj=mftu_msg mftu_msg
$ set command/obj=mftu_cld mftu_cld
$ link/nodebug/notrace mftu.obj,mftu_msg.obj,mftu_cld.obj
$ lib/cre/help mftu mftu
$ purge/log
$The_Exit:
$ Save_Status = $STATUS
$ exit Save_Status
198807291104429!End of MFTUMAKE.COM
$WRITE SYS$ERROR "Creating MFTU_CLD.CLD..."
$CREATE MFTU_CLD.CLD
$DECK/DOLLARS="198807291104429"
module mftu_table
define verb ENCODE
parameter P1,value(list,required,type=$infile),prompt="File(s)",label=infile
routine MFTU_ENCODE
qualifier LOG,negatable,default
qualifier DELERR,negatable,default
qualifier OUTPUT,value(default="ENCODING"),nonnegatable,default
define verb PACK
parameter P1,value(list,required,type=$infile),prompt="File(s)",label=infile
routine MFTU_PACK
qualifier LOG,negatable,default
qualifier DELERR,negatable,default
qualifier OUTPUT,value(default="PACKING"),nonnegatable,default
define verb DECODE
parameter P1,value(list,required,type=$infile),prompt="File(s)",label=infile
routine MFTU_DECODE
qualifier CRC,negatable,default
qualifier DELERR,negatable,default
qualifier LOG,negatable,default
qualifier LIST
qualifier CONFIRM
define verb UNPACK
parameter P1,value(list,required,type=$infile),prompt="File(s)",label=infile
routine MFTU_UNPACK
qualifier CRC,negatable,default
qualifier DELERR,negatable,default
qualifier LOG,negatable,default
qualifier LIST
qualifier CONFIRM
define verb HELP
parameter P1,value(list,type=$rest_of_line),label=keywords
routine MFTU_HELP
198807291104429!End of MFTU_CLD.CLD
$WRITE SYS$ERROR "Creating MFTU_MSG.MSG..."
$CREATE MFTU_MSG.MSG
$DECK/DOLLARS="198807291104429"
.FACILITY mftu,102
.SEVERITY INFORMATIONAL
usehow <ENCODE file-spec{,file-spec} or DECODE file-spec>/FAO_COUNT=0
encoding <encoding !AS.>/FAO_COUNT=1
decoded <decoded !AS, !UL block!%S.>/FAO_COUNT=2
present <file !AS, !UL block!%S.>/FAO_COUNT=2
.SEVERITY WARNING
errsea <error searching file !AS.>/FAO_COUNT=1
crcerr <crc error, block !UL, calculated %X!XW, should be %X!XW.>/FAO_COUNT=3
.SEVERITY FATAL
reperr <repeat count error on block !UL.>/FAO_COUNT=1
incons <inconsistency in huffman tree, report bug.>/FAO_COUNT=0
nopack <not a packed file !AS.>/fao_count=1
.END
198807291104429!End of MFTU_MSG.MSG
$ EXIT