›;--- FILE DECOMPRESSION PROGRAM ---››;written by Peter Nicholls - May 18th, 1986››;from an idea by Johnathan Amsterdam (BYTE magazine, may '86)››;Modified by Keith Ledbetter to close›;IOCB's 1-7 before exiting to DOS.›; (5/23/86)››;---- ACTION compiler directives ----››;sets the compiled code above all known DOS's›;and includes the ACTION run-time code.››;SET $000E = $2C00›;SET $0491 = $2C00››set $B5=$0000›INCLUDE "D:runtime.act"››;---- start of UNSQUISH.ACT ----››MODULE››DEFINE RecSize = "7"›DEFINE Nil     = "$FFFF"›DEFINE PathIn  = "1"›DEFINE PathOut = "2"›DEFINE Read    = "4"›DEFINE Write   = "8"›DEFINE Dummy   = "0"››;---- global declarations ----››TYPE NODE = [CHAR Ltr›             INT Parent, Left, Right]››NODE POINTER Ptr, LPtr, RPtr››CHAR POINTER Base, Heap››CARD POINTER Stack››CARD CharCount››CHAR InByte, CurBit››CHAR ARRAY BitTable(8) = [$01 $02 $04 $08 $10 $20 $40 $80]››CHAR ARRAY FSource(16), FDest(16), InBuff(16)››;-- some primitive error trapping --››;user query prompt. Returns '1' if <RETURN> is pressed›;and '0' if <ESCAPE> is pressed.››CHAR FUNC Query()›CHAR key, ch = 764››  PutE()›  PrintE("Press RETURN to continue")›  Print("   or ESCAPE to abort...")›  ch = 255›  DO›    key = ch›  UNTIL key = 28 OR key = 12 OD›  ch = 255›  PutE()›  IF key = 12 THEN›    RETURN (1)›  ELSE›    RETURN (0)›  FI››; a catch-all for run-time I/O errors.›; You can ignore them (?) or return›; to DOS!››PROC PeteErr(CHAR errnum)›CHAR ok›BYTE iocbnum››  PutE()›  Print("I/O error #")›  PrintBE(errnum)›  PutE()›  ok = Query()›  IF ok THEN›    RETURN›  ELSE›    For iocbnum = 1 to 7 do    ;*KL*›      CLOSE (iocbnum)          ;*KL*›    Od                         ;*KL*›    [$A2$FF$9A$6C$0A$00]›  FI››;--- filename handling ---››;filename normalisation routine. if no destination filename›;is given, the source filename is used with a .TXT extender.›;If no device name is given, D1: is assumed.››PROC Normalise(CHAR ARRAY instr, fstr)›CHAR i, f, ch››  IF instr(0) = 0 THEN›    FOR i = 0 TO FSource(0) DO›      FDest(i) = FSource(i)›    OD›    i = 1›    WHILE i <= FSource(0) AND›          FSource (i) <> '. DO›      i = i + 1›    OD›    FDest(i) = '.›    FDest(i+1) = 'T›    FDest(i+2) = 'X›    FDest(i+3) = 'T›    FDest(0) = i + 3›  ELSEIF instr(3) = ': OR›         instr(2) = ': THEN›        fstr(0) = instr(0)›        i = 1›        f = 1›  ELSE ›    fstr(1) = 'D›    fstr(2) = ':›    fstr(0) = instr(0) + 2›    i = 1›    f = 3›  FI›  WHILE i <= instr(0) DO›    fstr(f) = instr(i)›    i = i + 1›    f = f + 1›  OD›RETURN››;------------- PASCAL imitation implementation -------------››;stack and heap initialisation››PROC InitMem()››  Heap = $5000›  Stack = $8000›RETURN››;dynamic memory allocation. Space is provided on top of›;a heap, according to the required record size. The›;address of the reserved space is returned.›;The heap grows upwards.››CARD FUNC New(CARD size)›CARD temp››  temp = Heap›  Heap = Heap + size›RETURN (temp)››;push a 16-bit value onto the stack and bump the stack›;pointer. The stack grows downwards.››PROC Push(CARD v)››  Stack^ = v›  Stack = Stack - 2›RETURN››;pull a 16-bit value from the stack.››CARD FUNC Pull()››  Stack = Stack + 2›RETURN (Stack^)››;--- single-bit input routines ---››;read one bit from the coded file.››CHAR FUNC ReadBit()›CHAR bit››  IF CurBit = 0 THEN›    InByte = GetD(PathIn)›  FI›  bit = InByte & BitTable(CurBit)›  CurBit = CurBit + 1›  IF CurBit > 7 THEN›    CurBit = 0›  FI›  IF bit = 0 THEN›    RETURN (0)›  ELSE›    RETURN (1)›  FI››;read 8 bits from the coded file and convert them to a byte››CHAR FUNC ReadChar()›CHAR i, ch, bit››  ch = 0›  FOR i = 0 TO 7 DO›    bit = ReadBit()›    IF bit = 1 THEN›      ch = ch % BitTable(i)›    FI›  OD›RETURN (ch)››;------------------- re-create the code tree -------------------››;read the code tree from the coded file.››PROC ReadTree()›CHAR bit, ch››  bit = ReadBit()›  IF bit = 1 THEN›    ReadTree()›    ReadTree()›    RPtr = Pull()›    LPtr = Pull()›    Ptr = New(RecSize)›    Ptr.Left = LPtr›    Ptr.Right = RPtr›    LPtr.Parent = Ptr›    RPtr.Parent = Ptr›    Push(Ptr)›  ELSE›    ch = ReadChar()›    Ptr = New(RecSize)›    Ptr.Ltr = ch›    Ptr.Left = Nil›    Ptr.Right = Nil›    Push(Ptr)›  FI›RETURN››;-------------------- decoding routines --------------------››;decode the file. Read a bit from the file. Start at the›;root of the tree. if the bit is a '0', turn left and if›;it is a '1', turn right. Continue until a leaf is found.›;The leaf node's character field is the decoded character.››PROC DeCode()›CHAR bit, byt›CARD p››  Close(PathIn)›  Close(PathOut)›  Open(PathIn,FSource,Read,Dummy)›  Open(PathOut,FDest,Write,Dummy)›  byt = GetD(PathIn)›  CharCount = GetD(PathIn)›  CharCount = CharCount LSH 8›  CharCount = CharCount + byt›  CurBit = 0›  ReadTree()›  Base = Pull()›  WHILE CharCount > 0 DO›    Ptr = Base›    DO›      bit = ReadBit()›      IF bit = 0 THEN›        Ptr = Ptr.Left›      ELSE›        Ptr = Ptr.Right›      FI›      p = Ptr.Left›    UNTIL Ptr.Left = Nil OD›    byt = Ptr.Ltr›    CharCount = CharCount - 1›    PutD(PathOut, byt)›  OD›  Close(PathIn)›  Close(PathOut)›RETURN››;-------------------- user input routines -------------------››;ask user for source and destination filenames. Allow user to›;abort if necessary!››CHAR FUNC GetFileNames()›CHAR check››  PutE()›  Print("Source file: ")›  InputS(InBuff)›  Normalise(InBuff,FSource)›  PutE()›  Print("Destination: ")›  InputS(InBuff)›  Normalise(InBuff,FDest)›  PutE()›  Print("Decompress ")›  Print(FSource)›  Print(" to ")›  PrintE(FDest)›  check = Query()›  PutE()›RETURN (check)››;----------------------- MAIN PROGRAM -----------------------››PROC Main()›CHAR ok›BYTE iocbnum››  Error = PeteErr›  ok = GetFileNames()›  IF ok THEN›    InitMem()›    DeCode()›  FI›  For iocbnum = 1 to 7 do      ;*KL*›    CLOSE (iocbnum)            ;*KL*›  Od                           ;*KL*›  [$A2$FF$9A$6C$0A$00]         ;*KL*›RETURN››