
" FACTORIAL  -  DEMONSTRATION PROGRAM "

"###########
#  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;

TYPE FILE = 1..4;

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;

TYPE ARGSEQ = (INP, OUT);

TYPE PROGRESULT =
  (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR,
   HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR);

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);
PROCEDURE NOTUSED1;
PROCEDURE MARK(VAR TOP: INTEGER);
PROCEDURE RELEASE(TOP: INTEGER);
PROCEDURE IDENTIFY(HEADER: LINE);
PROCEDURE ACCEPT(VAR C: CHAR);
PROCEDURE DISPLAY(C: CHAR);
PROCEDURE NOTUSED2;
PROCEDURE NOTUSED3;
PROCEDURE NOTUSED4;
PROCEDURE NOTUSED5;
PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE);
PROCEDURE WRITEARG(S: ARGSEQ; ARG: ARGTYPE);
PROCEDURE NOTUSED6;
PROCEDURE NOTUSED7;
PROCEDURE NOTUSED8;
PROCEDURE NOTUSED9;
PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST;
              VAR LINE: INTEGER; VAR RESULT: PROGRESULT);

PROGRAM FACT;

VAR I: INTEGER;

PROCEDURE PRINTINT(ARG:INTEGER);
CONST MAXDIGIT = 6;
VAR T:ARRAY (.1..MAXDIGIT.) OF CHAR; REM,DIGIT,I: INTEGER;
BEGIN
  REM := ARG; DIGIT := 0;
  REPEAT
    DIGIT := DIGIT+1;
    T(.DIGIT.) := CHR(ABS(REM MOD 10) + ORD('0'));
    REM := REM DIV 10;
  UNTIL REM = 0;
  FOR I := DIGIT DOWNTO 1 DO DISPLAY(T(.I.));
  DISPLAY(CR);
  DISPLAY(NL);
END;

FUNCTION FACT (N: INTEGER): INTEGER;
 BEGIN
   IF N = 0
     THEN FACT := 1
     ELSE FACT := N*FACT(N-1);
 END;

BEGIN

  FOR I := 0 TO 20 DO
    BEGIN
      PRINTINT(FACT(I));
    END;

END.
