.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 ; for learning me how to use RMS I/O, and suggestions ; Todd Aven ; for suggestions which lead to the Huffman Scheme ; Tom Allebrandi ; 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 ;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 ;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 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 ;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 ;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 ;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 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 $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 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 $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 ;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 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 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 ;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 ;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 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 ;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 ;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=, - fac= 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= $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=, - fac=, - rfm=, - mrs=#512 brb 19$ 18$: $fab_store fab=outfab, - fop=, - fac=, - rat=, - rfm= 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= $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 ;for cmpc3, movc3 clrl blkcount ;zero blocks ;First Open file $fab_store fab=infab,- fop=,- fac= $open fab=infab blbs r0,10$ pushl infab+fab$l_stv pushl r0 calls #2,G^lib$stop 10$: $rab_store rab=inrab, - rop= $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= $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= ;;;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= $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 ;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 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= 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