[ont.micro.mac] Croft's fromhex in MacForth

info-mac@utcsrgv.UUCP (info-mac) (06/19/84)

Date: 12 Jun 1984 1634-PDT
Subject: Croft's fromhex in MacForth
From: Mike Schuster <uw-beaver!MIKES@CIT-20.ARPA>
To: info-mac@SUMEX-AIM.ARPA


Here is a translation of Bill Croft's 'fromhex' Pascal program into
Creative Solutions MacForth.  The program takes its input from a file
called 'C' and places the output the resource fork of a file called 'C
prog'.  You must use the 'Set File' program to set 'C prog's type to
'APPL', its creator to 'CCOM', and its 'bundle' bit.  (If anyone knows
how to do this with MacForth, and thus avoid the need for 'Set File',
let me know!)  Refer to Bill's SUMacC Development Kit note for more
information.
Mike
(mikes@cit-20)

5 constant c.file create c.filename ," C"
variable c.i variable c.p 512 constant c.recsize
create c.buffer c.recsize allot
6 constant cprog.file create cprog.filename ," C prog"
variable cprog.i variable cprog.p 512 constant cprog.recsize
create cprog.buffer cprog.recsize allot
variable c.count variable c.check variable c.val
: open.c ( -> )
  c.recsize c.i ! 0 c.p !
  c.filename c.file assign c.file open
  io-result @ if ." can't open C" abort then ;
: close.c ( ->) c.file close ;
: open.cprog ( -> )
  0 cprog.i ! 0 cprog.p !
  cprog.filename cprog.file assign cprog.file delete
  cprog.file create.file cprog.file open.rsrc
  io-result @ if ." can't open C prog" abort then ;
: close.cprog ( -> ) cprog.file flush.file cprog.file close ;
: getchar ( -> char )
  c.i @ c.recsize = if 
     0 c.i ! c.buffer c.recsize c.p @ c.file read.virtual c.recsize c.p +!
  then c.buffer c.i @ + c@ 1 c.i +! ;
: putflush ( -> )
  cprog.i @ 0 = not if
     cprog.buffer cprog.i @ cprog.p @ cprog.file write.virtual
     cprog.i @ cprog.p +! 0 cprog.i !
  then ;
: putchar ( char -> )
  cprog.buffer cprog.i @ + c! 1 cprog.i +!
  cprog.i @ cprog.recsize = if putflush then ;
: handlechar ( char -> )
  dup 80 < over 64 < not and if
     64 - c.val @ 16 * or c.val ! 1 c.count +!
     c.count @ 1 and 0 = if 
        c.val @ putchar c.val @ c.check +! 0 c.val !
     then
  else drop then ;
: handlesum ( -> )
  0 c.val ! 9 1 do
     getchar 15 and c.val @ 16 * or c.val !
  loop c.val @ c.check @ c.count @ 2/ + = not if 
     ." check failed" then ;
: c.to.cprog ( -> )
  0 c.count ! 0 c.check ! 0 c.val !
  begin getchar dup 124 = not while handlechar repeat drop
  putflush handlesum
  cr ." bytes = " c.count @ 2/ . ." check = " c.check @ . ;
: fromhex ( -> )
  open.c open.cprog c.to.cprog close.c close.cprog ;
fromhex

-------
Date: 13 Jun 1984 0819-PDT
Subject: MacForth 'fromhex' update
From: Mike Schuster <MIKES@CIT-20.ARPA>
To: info-mac@SUMEX-AIM.ARPA


Here is a patch to the MacForth version of 'fromhex' that sets 'C prog's
type, creator, and bundle bit, thus avoiding the need for the program
'Set File'.  Warning: the X and Y coordinates of 'C prog's icon in the
disk folder are both 0, so its icon may overlap existing icons when 
'fromhex' terminates.

Mike
(mikes@cit-20)

: close.cprog ( -> ) 
  cprog.file flush.file cprog.file close 
  cprog.file get.file.info
  " APPL" 1 + cprog.file >fcb 32 + 4 cmove
  " CCOM" 1 + cprog.file >fcb 36 + 4 cmove
  8448 cprog.file >fcb 40 + w!
  cprog.file set.file.info ;
-------