
"FILE          (AS REQ'D BY THE SEQUENTIAL PASCAL COMPILER)"



"###########
#  PREFIX  #
###########"


CONST NL = '(:10:)';   FF = '(:12:)';   CR = '(:13:)';   EM = '(:25:)';

CONST PAGELENGTH = 512;
TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR;

CONST LINELENGTH = 132;
TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR;

CONST IDLENGTH = 16;
TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR;

CONST MAXFILE = 5;
TYPE FILE = 1..MAXFILE;

TYPE ARGTAG =
  (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE);

TYPE POINTER = @BOOLEAN;

TYPE ARGTYPE = RECORD
                 CASE TAG: ARGTAG OF
                   NILTYPE, BOOLTYPE: (BOOL: BOOLEAN);
                   INTTYPE: (INT: INTEGER);
                   IDTYPE: (ID: IDENTIFIER);
                   PTRTYPE: (PTR: POINTER)
               END;

CONST MAXARG = 10;
TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE;

PROCEDURE READ(VAR C: CHAR);
PROCEDURE WRITE(C: CHAR);

PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN);
PROCEDURE CLOSE(F: FILE);
PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE);
PROCEDURE PUT(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE);
FUNCTION LENGTH(F: FILE): INTEGER;

PROCEDURE MARK(VAR TOP: INTEGER);
PROCEDURE RELEASE(TOP: INTEGER);

PROCEDURE IDENTIFY(HEADER: LINE);
PROCEDURE ACCEPT(VAR C: CHAR);
PROCEDURE DISPLAY(C: CHAR);

PROGRAM MAIN(VAR PARAM: ARGLIST);

CONST

NWFL = 5;
INP = 2;

VAR

NEWSEQ: IDENTIFIER;
LENGTH: INTEGER;
BLOCK: PAGE;
OK: BOOLEAN;

PROCEDURE WRITEID (ID:IDENTIFIER);
VAR I: INTEGER; C: CHAR;
BEGIN
  FOR I:= 1 TO IDLENGTH DO
  BEGIN
    C:= ID(.I.);
    IF C<> ' ' THEN DISPLAY(C);
  END;
END;

PROCEDURE WRITETEXT (TEXT:LINE);
CONST NUL = '(:0:)';
VAR I: INTEGER; C: CHAR;
BEGIN
  I:= 1;; C:= TEXT(.1.);
  WHILE C <> NUL DO
  BEGIN
    DISPLAY(C);
    I:= I+1; C:= TEXT(.I.);
  END;
END;

PROCEDURE INITIALIZE;
VAR FOUND: BOOLEAN;
BEGIN
  OK:= TRUE;
  NEWSEQ:= PARAM(.3.).ID;
  LENGTH:= PARAM(.4.).INT;
  IF NEWSEQ(.1.) = ' '
    THEN OK:= FALSE
    ELSE
    BEGIN
      IDENTIFY ('FILE:(:10:)');
      OPEN (NWFL,NEWSEQ,FOUND);
      IF NOT FOUND
        THEN OK:=FALSE;
    END;
END;

PROCEDURE COPY;
VAR I: INTEGER;
BEGIN
  FOR I:= 1 TO LENGTH DO
  BEGIN
    GET (INP,I,BLOCK);
    PUT (NWFL,I,BLOCK);
  END;
END;

PROCEDURE TERMINATE;
BEGIN
  IF OK THEN
  BEGIN
    CLOSE (NWFL);
    WRITEID (NEWSEQ);
    WRITETEXT (' SEQ CODE FILE CREATED.(:10:) (:0:)');
  END;
  WITH PARAM(.1.) DO BEGIN
    TAG:= BOOLTYPE; BOOL:= TRUE END;
END;



"#############
 #  M A I N  #
 #############"

BEGIN
  INITIALIZE;
  IF OK THEN COPY;
  TERMINATE;
END.
