From:	CSBVAX::MRGATE!info-vax-RELAY@KL.SRI.COM@SMTP  2-AUG-1988 11:55
To:	ARISIA::EVERHART
Subj:	MFTU 1.12 sources (file compression/encoding utility)


Received: from CUNYVM.CUNY.EDU by KL.SRI.COM with TCP; Fri, 29 Jul 88 12:12:59 PDT
Received: from MCCLB0.MED.NYU.EDU by CUNYVM.CUNY.EDU (IBM VM SMTP R1.1) with BSMTP id 4321; Fri, 29 Jul 88 15:06:29 EDT
Received: from DSS.MED.NYU.EDU by MCCLB0.MED.NYU.EDU; Fri, 29 Jul 88 14:16 EDT
Date: Fri, 29 Jul 88 11:21 EDT
From: TODD%DSS.MED.NYU.EDU@CUNYVM.CUNY.EDU
Subject: MFTU 1.12 sources (file compression/encoding utility)
To: info-vax@kl.sri.COM
X-VMS-To: IN%"info-vax@kl.sri.com"

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
