\ uuencode V1.1 A Forth version of the Unix utility \ @(#)uuencode.seq 1.1 21:55:34 11/15/94 EFC \ Typical usage: \ s" infile.dat" s" outfile.uu" uuencode \ This program ignores the file mode number that follows the word begin. \ See the customization section for the proper newline and the coding \ scheme. Some UUENCODEs are written so that SPACE characters appear \ in the encode data, others do not. This code can be compiled either \ way depending upon whether a single line in 'enc' is commented out or not. \ This is an ANS Forth program requiring: \ 1. The File word set \ 2. The word CMOVE in the String word set. \ (c) Copyright 1994 Everett F. Carter. Permission is granted by the \ author to use this software for any application provided this \ copyright notice is preserved. \ ported to GNU Forth by Alex Malyshev (alexript@mail.ru) DECIMAL \ buffers and I/O handles \ inbuf0 includes count, inbuf starts after count CREATE inbuf0 82 ALLOT inbuf0 1+ CONSTANT inbuf CREATE outbuf 82 ALLOT VARIABLE obp 0 obp ! -1 VALUE in-handle -1 VALUE out-handle \ write, putb : write ( n -- ) \ write n bytes out out-handle outbuf SWAP out-handle WRITE-FILE ABORT" write error " ; : putb ( b -- ) \ put a byte to the output buffer outbuf obp @ + C! \ write if its nearly full obp @ 1+ DUP OBP ! DUP 74 > IF write 0 obp ! ELSE DROP THEN ; : flushb ( -- ) obp @ DUP 0 > IF write 0 obp ! ELSE DROP THEN ; \ Basic Input \ read from in-handle and return the count \ return a zero if an error, result goes to inbuf : read ( n -- 0->err/n->ok ) \ read n bytes inbuf SWAP in-handle READ-FILE DROP DUP inbuf0 C! ; \ $write \ write a string to output buffer : $write ( $addr count -- ) 0 DO DUP I + C@ putb LOOP DROP ; \ ===================== CUSTOMIZATION SECTION ============================= : crlf 13 putb 10 putb ; \ output a CRLF : unix-newline 10 putb ; \ output a newline : newline unix-newline ; \ set to either unix-newline or crlf HEX : enc ( c -- c ) \ single character encode 3F AND 20 + \ comment out the next line for alternate (with blanks) encoding DUP 20 = IF 40 + THEN ; \ ======================= END CUSTOMIZATION ================================ DECIMAL : outenc ( bp -- ) \ output group of 3 bytes from bp DUP C@ 4 / enc putb DUP C@ 16 * 48 AND OVER 1+ C@ 16 / 15 AND OR enc putb 1+ DUP C@ 4 * 60 AND OVER 1+ C@ 64 / 3 AND OR enc putb 1+ C@ 63 AND enc putb ; \ out-loop : out-loop ( n -- ) \ output until n is zero DUP 0 > IF 0 DO inbuf I + outenc 3 +LOOP newline ELSE DROP THEN ; \ write_head \ expects $addr of remote file name : write_head ( $addr -- ) S" begin 644 " $write \ write file name COUNT $write newline ; \ ====== everything above here could be made private ========================= : uuencode ( $addr1 count1 $addr2 count2 -- ) ROT inbuf0 C! ROT inbuf inbuf0 C@ CMOVE W/O CREATE-FILE ABORT" Unable to open output file " TO out-handle inbuf0 COUNT R/O BIN OPEN-FILE ABORT" Unable to open input file to encode " TO in-handle inbuf0 write_head BEGIN 45 read DUP 0 > IF DUP enc putb ELSE DROP 0 THEN WHILE inbuf0 C@ out-loop REPEAT 0 enc putb newline S" end" $write newline flushb in-handle CLOSE-FILE DROP out-handle CLOSE-FILE DROP ;
Make your own free website on Tripod.com