10.3.5. Formatted transput

MODE FORMAT = STRUCT (FLEX [1: 0] PIECE {F}fff);
MODE {?} PIECE = STRUCT( INT cp ¢ pointer to current collection ¢,
    count ¢ number of times piece is to be repeated¢,
    bp ¢ back pointer¢,
    FLEX [1 : 0] COLLECTION c);
MODE {?} COLLECTION = UNION (PICTURE, COLLITEM):
  MODE {?} COLLITEM = STRUCT (INSERTION i1,
    PROC INT rep; ¢ replicator ¢,
    INT p ¢ pointer to another piece ¢, INSERTION i2);
MODE {?} INSERTION FLEX [1: 0] = STRUCT (PROC INT rep ¢ replicator ¢,
    UNION (STRING, CHAR) sa);
MODE {?} PICTURE =
  STRUCT (UNION (PATTERN, CPATTERN, FPATTERN, GPATTERN, VOID) p, INSERTION i);
MODE {?} PATTERN = STRUCT (INT type ¢ of pattern ¢,   
    FLEX [1: 0] FRAME frames),
MODE {?} FRAME = STRUCT (INSERTION,   
    PROC INT rep ¢ replicator ¢,
    BOOL supp ¢ true if suppressed ¢,
    CHAR marker);
MODE {?} CPATTERN = STRUCT (INSERTION i,
    INT type ¢ boolean or integral ¢,
    FLEX [1 : 0] INSERTION c);
MODE {?} FPATTERN = STRUCT (INSERTION i, PROC FORMAT pf);
MODE {?} GPATTERN = STRUCT(INSERTION i, FLEX [1 : 0] PROC INT spec);

b)

PROC {?} get next picture = (REF FILE , BOOL read, REF PICTURE picture) VOID:
  BEGIN
      BOOL picture found := FALSE, format ended := FALSE;
      WHILE ~ picture found
      DO IF forp OF f = 0 THEN
              IF format ended
              THEN undefined
              ELIF ~ (format mended OF f)(f)
              ELSE format ended :=TRUE
              FI
          ELSE REF INT forp = forp OF f;
              REF FLEX [ ] PIECE aleph = {F}fff OF format OF f;
              CASE (c OF aleph [forp])[cp OF aleph [forp]] IN
                  ( [ 1: UPB( i1 OF cl )] := forp; forp := SKIP;
                    ( staticize insertion ( i1 OF cl, si),
                      count OF aleph [p OF cl] := 0;
                      forp := p OF cl),
                    ( PICTURE pict): (picture found := TRUE; picture := pict)
              ESAC;
              WHILE
                  ( forp /= 0 | cp OF aleph [forp] = UPB c OF aleph [forp]) | FALSE)
              DO IF (count OF aleph[forp] -:= 1) <= 0
                  THEN
                      IF (forp := bp OF aleph [forp]) /= 0
                      THEN
                          INSERTION extra =
                            CASE (c OF aleph [forp])[cp OF aleph [forp]] IN
                                ( COLLITEM cl):
                                  ( bp OF aleph [p OF cl] := 0; i2 OF cl),
                                ( PICTURE pict):
                                  CASE p OF pict IN
                                      ( FPATTERN fpatt):  
                                        ( INT k := forp;
                                          WHILE bp OF aleph [k] /= forp DO k +:= 1 OD;
                                          aleph := aleph [:k-1];
                                          i OF pict)
                                  ESAC
                            ESAC;
                          INT m = UPB i OF picture, n = UPB extra;
                          [ 1:m+n] STRUCT( PROC INT rep, UNION(STRING , CHAR) sa)c;
                          c[1:m] := i OF picture; c[m+1:m+n] := extra;
                          i OF picture := c
                      FI
                  ELSE cp OF aleph [forp] := 0
                  FI OD;
              ( forp /= 0 | cp OF aleph [forp] +:= 1)
          FI OD
  END;

MODE {?} SINSERT = STRUCT (INT rep, UNION(STRING , CHAR) sa);

d)

PROC {?} staticize insertion = (INSERTION ins, REF [ ] SINSERT sins) VOID:
  ¢ calls collaterally all the replicators in 'frames' ¢
  IF UPB ins = 1  
  THEN
      rep OF sins[1] := rep OF ins[1];
      sa OF sins[1] := so OF ins[1]
  ELIF UPB ins > 1
  THEN staticize insertion (ins [1], sins [1]),
      staticize insertion (ins [2 : ], sins [2 : ])
  FI;

e)

MODE {?} SFRAME = STRUCT (FLEX [1 : 0 ] SINSERT si, INT rep, BOOL supp, CHAR marker);

f)

PROC {?} staticize frames =
  ( [ ] FRAME frames, REF [ ] SFRAME sframes) VOID:  
  ¢ calls collaterally all the replicators in 'frames' ¢
  IF UPB frames = 1
  THEN
      [ 1: UPB (i OF frames [1 ]) ] SINSERT si;
      ( staticize insertion (i OF frames [1], si),
        rep OF sframes [1 ] := rep OF frames [1]);
      si OF sframes [1]:= si;
      supp OF sframes [1] := supp OF frames [1];
      marker OF sframes [1] := marker OF frames[1]
  ELIF UPB frames > 1
  THEN (staticize frames (frames [1], sframes [1]).
          staticize frames (frames [2: ], sframes [2: ]))
  FI;

g)

PROC {?} put insertion = (REF FILE f, [ ] SINSERT si) VOID:
  BEGIN set write mood (f);
      FOR k TO UPB si
      DO
          CASE sa OF si[k] IN
              ( CHAR a): alignment(f, rep OF si [k], a, FALSE),
              ( STRING s):
                TO rep OF si[k]
                DO
                    FOR i TO UPB s
                    DO checkpos(f); putchar(f, s[i]) OD
                OD
          ESAC          
      OD
  END;

h)

PROC {?} get insertion (REF FILE f, [ ] SINSERT si) VOID:
  BEGIN set read mood (f);
      FOR k TO UPB si
      DO
          CASE sa OF si[k] IN
              ( CHAR a): alignment(f, rep OF si [k], a, TRUE),
              ( STRING s):
                ( CHAR c;
                  TO rep OF si[k]
                  DO
                      FOR i TO UPB s
                      DO checkpos(f); get char(f, c);
                          ( c /= s[i]
                          | ( ~ (char error mended OF f)(f, c := s[i])
                            | undefined);
                            set read mood(f)) 
                      OD
                  OD) 
          ESAC  
      OD
  END;