!CMPRES.IMP
!A PROGRAM TO COMPRESS FILES FOR THE IMP COMPILERS TRANSPORTATION
%BEGIN
%EXTERNALROUTINESPEC WRITEFS(%RECORD(FILESPEC)%NAME FS)
%EXTERNALROUTINESPEC READFS(%RECORD(FILESPEC)%NAME FS)
%RECORD(FILESPEC) FILE FS,IN FS
%INTEGER N,S
%CONSTINTEGER IN=1,OUT=2

%ROUTINE EXPAND
%RECORD(FILESPEC) OUTFS
%STRING(255) STR
%INTEGER N,S

   %ON %EVENT 9 %START
      SELECT OUTPUT(0)
      PRINTSTRING("Expansion complete"); NEWLINE
      %STOP
   %FINISH

   %ROUTINE COPYFILE
      %INTEGER N,M,S
      %CYCLE
         READSYMBOL(S)
         %IF S='$' %START
            %FOR N=1,1,11 %CYCLE
               READSYMBOL(S)
               %IF S#'$' %START
                  PRINTSYMBOL('$') %FOR M=1,1,N
                  ->LAB
               %FINISH
            %REPEAT
           SKIP SYMBOL
            CLOSE OUTPUT
            %RETURN
         %FINISH
LAB:     PRINTSYMBOL(S)
      %REPEAT
   %END

   %CYCLE
      SELECT INPUT(IN); SELECT OUTPUT(0)
      %FOR N=1,1,12 %CYCLE
         READSYMBOL(S)
         %IF S#'&' %START
            SELECT OUTPUT(0)
            PRINTSTRING("Bad file header line: ")
            READTEXT(STR,NL); PRINTSTRING(STR); NEWLINE
            %STOP
         %FINISH
      %REPEAT
      READFS(OUTFS); XDEFINEOUTPUT(OUT,OUTFS)
      WRITEFS(OUTFS); NEWLINE
      SELECT OUTPUT(OUT)
      SKIPSYMBOL; SKIP SYMBOL;  !SKIP OVER TWO NEWLINES
      COPYFILE
      SKIP SYMBOL %IF NEXT SYMBOL=FF
   %REPEAT
%END


%ROUTINE COMPRESS
   %INTEGER N,S,FIRST TIME
   %CONSTINTEGER TRUE=-1, FALSE=0
   %CONSTINTEGER IN1=5

   %ON %EVENT 9 %START
      CLOSE OUTPUT
      SELECT OUTPUT(0)
      PRINTSTRING("Compressed file "); WRITEFS(FILE FS)
      PRINTSTRING(" complete"); NEWLINE
      %STOP
   %FINISH

   %ROUTINE COPYFILE
      %ON %EVENT 9 %START
         CLOSE INPUT
         PRINTSTRING("$$$$$$$$$$$$"); NEWLINE
         %RETURN
      %FINISH
      %IF FIRST TIME=TRUE %THEN FIRST TIME=FALSE %ELSE NEWPAGE
      PRINTSTRING("&&&&&&&&&&&& "); WRITEFS(IN FS); NEWLINES(2)
      %CYCLE
         READSYMBOL(S); PRINTSYMBOL(S)
      %REPEAT
   %END

   FILEFS_EXT="COM"
   XDEFINE OUTPUT(OUT,FILEFS); SELECT OUTPUT(OUT)
   FIRST TIME=TRUE
   %CYCLE
      SELECT INPUT(IN); SELECT OUTPUT(0)
      SKIPSYMBOL %WHILE NEXTSYMBOL=NL;  !TO TRAP EOF PROPERLY **FRIG
      READFS(IN FS); XDEFINE INPUT(IN1,INFS)
      SELECT INPUT(IN1)
      WRITEFS(INFS); NEWLINE
      SELECT OUTPUT(OUT)
      COPY FILE
   %REPEAT
%END

PRINTSTRING("Filename (name.COM or name.SUB):- ")
READFS(FILE FS)
XDEFINE INPUT(IN,FILEFS); SELECT INPUT(IN)
%IF FILE FS_EXT="COM" %THEN EXPAND
%IF FILE FS_EXT="SUB" %THEN COMPRESS
PRINTSTRING("?Unknown file extension type"); NEWLINE
%ENDOFPROGRAM