head     56.3;
access   paws bayes jws quist brad dew jwh;
symbols  ;
locks    ; strict;
comment  @# @;


56.3
date     93.01.27.13.33.10;  author jwh;  state Exp;
branches ;
next     56.2;

56.2
date     93.01.27.12.09.42;  author jwh;  state Exp;
branches ;
next     56.1;

56.1
date     91.11.05.09.31.01;  author jwh;  state Exp;
branches ;
next     55.1;

55.1
date     91.08.25.10.09.03;  author jwh;  state Exp;
branches ;
next     54.1;

54.1
date     91.03.18.15.16.54;  author jwh;  state Exp;
branches ;
next     53.1;

53.1
date     91.03.11.19.17.31;  author jwh;  state Exp;
branches ;
next     52.1;

52.1
date     91.02.19.09.02.42;  author jwh;  state Exp;
branches ;
next     51.1;

51.1
date     91.01.30.16.01.51;  author jwh;  state Exp;
branches ;
next     50.1;

50.1
date     90.10.29.16.15.27;  author jwh;  state Exp;
branches ;
next     49.1;

49.1
date     90.08.14.14.03.46;  author jwh;  state Exp;
branches ;
next     48.1;

48.1
date     90.07.26.11.09.33;  author jwh;  state Exp;
branches ;
next     47.1;

47.1
date     90.05.14.10.47.15;  author dew;  state Exp;
branches ;
next     46.1;

46.1
date     90.05.07.08.35.25;  author jwh;  state Exp;
branches ;
next     45.1;

45.1
date     90.04.19.15.42.19;  author jwh;  state Exp;
branches ;
next     44.1;

44.1
date     90.04.01.22.00.13;  author jwh;  state Exp;
branches ;
next     43.1;

43.1
date     90.03.20.13.50.05;  author jwh;  state Exp;
branches ;
next     42.1;

42.1
date     90.01.23.17.35.28;  author jwh;  state Exp;
branches ;
next     41.1;

41.1
date     89.12.22.11.17.47;  author jwh;  state Exp;
branches ;
next     40.2;

40.2
date     89.12.11.08.35.48;  author jwh;  state Exp;
branches ;
next     40.1;

40.1
date     89.09.29.11.40.44;  author jwh;  state Exp;
branches ;
next     39.1;

39.1
date     89.09.26.16.26.04;  author dew;  state Exp;
branches ;
next     38.1;

38.1
date     89.08.29.11.16.31;  author jwh;  state Exp;
branches ;
next     37.1;

37.1
date     89.05.12.11.29.43;  author dew;  state Exp;
branches ;
next     36.1;

36.1
date     89.02.06.10.08.45;  author dew;  state Exp;
branches ;
next     35.1;

35.1
date     89.02.02.13.20.18;  author dew;  state Exp;
branches ;
next     34.1;

34.1
date     89.01.23.15.55.33;  author jwh;  state Exp;
branches ;
next     33.1;

33.1
date     89.01.16.11.30.46;  author dew;  state Exp;
branches ;
next     32.1;

32.1
date     89.01.10.11.36.53;  author bayes;  state Exp;
branches ;
next     31.1;

31.1
date     88.12.14.17.57.47;  author bayes;  state Exp;
branches ;
next     30.1;

30.1
date     88.12.09.13.36.03;  author dew;  state Exp;
branches ;
next     29.1;

29.1
date     88.10.31.15.20.08;  author bayes;  state Exp;
branches ;
next     28.1;

28.1
date     88.10.06.10.49.33;  author dew;  state Exp;
branches ;
next     27.1;

27.1
date     88.09.29.11.15.14;  author bayes;  state Exp;
branches ;
next     26.3;

26.3
date     88.09.28.12.32.44;  author bayes;  state Exp;
branches ;
next     26.2;

26.2
date     88.09.28.12.32.29;  author bayes;  state Exp;
branches ;
next     26.1;

26.1
date     88.09.28.12.32.16;  author bayes;  state Exp;
branches ;
next     24.1;

24.1
date     87.08.31.09.19.15;  author jws;  state Exp;
branches ;
next     23.2;

23.2
date     87.08.30.15.10.56;  author jws;  state Exp;
branches ;
next     23.1;

23.1
date     87.08.26.09.55.56;  author bayes;  state Exp;
branches ;
next     22.1;

22.1
date     87.08.17.10.36.13;  author bayes;  state Exp;
branches ;
next     21.1;

21.1
date     87.08.12.13.24.03;  author bayes;  state Exp;
branches ;
next     20.1;

20.1
date     87.07.30.10.34.22;  author bayes;  state Exp;
branches ;
next     19.1;

19.1
date     87.06.01.07.52.43;  author jws;  state Exp;
branches ;
next     18.1;

18.1
date     87.05.20.14.47.20;  author bayes;  state Exp;
branches ;
next     17.1;

17.1
date     87.04.30.10.05.01;  author jws;  state Exp;
branches ;
next     16.1;

16.1
date     87.04.26.15.19.26;  author jws;  state Exp;
branches ;
next     15.1;

15.1
date     87.04.13.08.44.48;  author jws;  state Exp;
branches ;
next     14.1;

14.1
date     87.04.01.14.40.56;  author jws;  state Exp;
branches ;
next     13.1;

13.1
date     87.02.28.18.07.33;  author jws;  state Exp;
branches ;
next     12.1;

12.1
date     87.02.02.12.53.51;  author jws;  state Exp;
branches ;
next     11.1;

11.1
date     87.01.19.09.20.42;  author jws;  state Exp;
branches ;
next     10.1;

10.1
date     86.12.24.10.26.53;  author jws;  state Exp;
branches ;
next     9.1;

9.1
date     86.12.12.13.49.21;  author bayes;  state Exp;
branches ;
next     8.1;

8.1
date     86.11.27.11.24.26;  author jws;  state Exp;
branches ;
next     7.1;

7.1
date     86.11.20.13.10.51;  author hal;  state Exp;
branches ;
next     6.1;

6.1
date     86.11.04.17.12.51;  author paws;  state Exp;
branches ;
next     5.1;

5.1
date     86.10.28.16.01.31;  author hal;  state Exp;
branches ;
next     4.1;

4.1
date     86.09.30.19.14.20;  author hal;  state Exp;
branches ;
next     3.1;

3.1
date     86.09.01.11.26.21;  author hal;  state Exp;
branches ;
next     2.1;

2.1
date     86.07.30.14.17.32;  author hal;  state Exp;
branches ;
next     1.1;

1.1
date     86.06.30.13.40.11;  author danm;  state tmp;
branches ;
next     ;


desc
@Base file for PWS 3.2 release.

@


56.3
log
@
pws2rcs automatic delta on Wed Jan 27 13:14:25 MST 1993
@
text
@			{file INIT}

implement

procedure init;
  var
    seconds: shortint;
    i: integer;

  procedure initdate;
    {Initialize TODAYSDATE to current date as 'dd-mmm-yy'.}
    {Uses system procedure sysdate(var d: daterec)}

    begin {initdate}
    sysdate(globaldate);
    systime(globaltime);
    with globaldate do
      begin
      {LAF 880101 added "mod 10" to "div 10" and removed "year<100" test}
      if (month in [1..12]) and (day>0) then
	begin                                 {Valid date}
	todaysdate := '  -' +
	  str('JanFebMarAprMayJunJulAugSepOctNovDec',
				  month*3-2,3) +
					   '-  ';
	if day>9 then todaysdate[1] := chr(day div 10 + ord('0'));
	todaysdate[2] := chr(day mod 10 + ord('0'));
	todaysdate[8] := chr(year div 10 mod 10 + ord('0'));
	todaysdate[9] := chr(year mod 10 + ord('0'));
	end
      else todaysdate := '         ';         {Invalid date}
      end;
    end; {initdate}

  PROCEDURE ENTSTDTYPES;
    BEGIN
    NEW(INTPTR,SCALAR,STANDARD);
    WITH INTPTR^ DO
      BEGIN ispackable := false; sizeoflo := false;
      unpacksize := INTSIZE; align := INTALIGN;
      FORM := SCALAR; SCALKIND := STANDARD; info := sysinfo;
      END;
    new(shortintptr,scalar,standard);
    with shortintptr^ do
      begin ispackable := true; sizeoflo := false;
      unpacksize := shortintsize; align := intalign;
      bitsize := shortintsize*bitsperchar; signbit := true;
      form := scalar; scalkind := standard; info := sysinfo;
      END;
    NEW(REALPTR,reals);
    WITH REALPTR^ DO
      BEGIN ispackable := false; sizeoflo := false;
      unpacksize := REALSIZE; align := REALALIGN;
      FORM := reals; info := sysinfo;
      END;
    NEW(CHAR_PTR,SCALAR,STANDARD);
    WITH CHAR_PTR^ DO
      BEGIN ispackable := true; sizeoflo := false;
      bitsize := BITSPERCHAR; signbit := false;
      unpacksize := CHARSIZE; align := CHARALIGN;
      FORM := SCALAR; SCALKIND := STANDARD; info := sysinfo;
      END;
    NEW(BOOLPTR,SCALAR,DECLARED);
    WITH BOOLPTR^ DO
      BEGIN ispackable := true; sizeoflo := false;
      bitsize := 1; signbit := false;
      unpacksize := BOOLSIZE; align := BOOLALIGN;
      FORM := SCALAR; SCALKIND := DECLARED; info := sysinfo;
      END;
    NEW(ANYFILEPTR,FILES);
    WITH ANYFILEPTR^ DO
      BEGIN ispackable := false; sizeoflo := false;
      unpacksize := FILESIZE; align := WORDALIGN;
      FORM := FILES; FILTYPE := NIL; info := sysinfo;
      END;
    NEW(ANYPTRPTR,POINTER);
    WITH ANYPTRPTR^ DO
      BEGIN ispackable := false; sizeoflo := false;
      unpacksize := PTRSIZE; align := PTRALIGN;
      FORM := POINTER; ELTYPE := NIL; info := sysinfo;
      END;
    NEW(cant_deref,POINTER);
    cant_deref^ := anyptrptr^;
    NEW(TEXTPTR,FILES);
    WITH TEXTPTR^ DO
      BEGIN ispackable := false; sizeoflo := false;
      unpacksize := FILESIZE+CHARSIZE; align := WORDALIGN;
      FORM := FILES; FILTYPE := CHAR_PTR;
      info := sysinfo + [mustinitialize, cantassign];
      END;
    NEW(STRGPTR,ARRAYS,TRUE,TRUE);
    WITH STRGPTR^ DO {var template & string parm}
      BEGIN ispackable := false; sizeoflo := false;
      unpacksize := ptrsize+shortintsize;
      align := WORDALIGN; FORM := ARRAYS;
      AELTYPE := CHAR_PTR; INXTYPE := INTPTR;
      AISPACKD := TRUE; aelbitsize := bitsperchar;
      AISSTRNG := TRUE; MAXLENG := 255;
      info := []; {NOT predeclared}
      END;
    END (*ENTSTDTYPES*) ;

  PROCEDURE ENTSTDNAMES;
    VAR CP,CP1: CTP; I: INTEGER;
    BEGIN
    NEW(CP,TYPES);
    WITH CP^ DO
      BEGIN newident(namep,'REAL'); IDTYPE := REALPTR; KLASS := TYPES;
      info := sysinfo
      END;
    ENTERID(CP);
    NEW(CP,TYPES);
    WITH CP^ DO
      BEGIN newident(namep,'LONGREAL'); IDTYPE := REALPTR; KLASS := TYPES;
      info := sysinfo + [nonstandard];
      END;
    ENTERID(CP);
    NEW(CP,TYPES);
    WITH CP^ DO
      BEGIN newident(namep,'INTEGER'); IDTYPE := INTPTR; KLASS := TYPES;
      info := sysinfo
      END;
    ENTERID(CP);
    NEW(CP,TYPES);
    WITH CP^ DO
      BEGIN newident(namep,'CHAR'); IDTYPE := CHAR_PTR; KLASS := TYPES;
      info := sysinfo
      END;
    ENTERID(CP);
    NEW(CP,TYPES);
    WITH CP^ DO
      BEGIN newident(namep,'BOOLEAN'); IDTYPE := BOOLPTR; KLASS := TYPES;
      info := sysinfo
      END;
    ENTERID(CP);
    NEW(CP,TYPES);
    WITH CP^ DO
      BEGIN newident(namep,'STRING'); IDTYPE := STRGPTR; KLASS := TYPES;
      info := sysinfo + [nonstandard];
      END;
    ENTERID(CP);
    NEW(CP,TYPES);
    WITH CP^ DO
      BEGIN newident(namep,'TEXT'); IDTYPE := TEXTPTR; KLASS := TYPES;
      info := sysinfo
      END;
    ENTERID(CP);
    NEW(CP,KONST);
    WITH CP^ DO
      BEGIN
      newident(namep,'MAXINT'); IDTYPE := INTPTR;
      KLASS := KONST;
      info := sysinfo;
      with VALUES do
	begin intval := true; ival := MAXINT end;
      END;
    ENTERID(CP);
    NEW(CP,KONST);
    WITH CP^ DO
      BEGIN
      newident(namep,'MININT'); IDTYPE := INTPTR;
      KLASS := KONST;
      info := sysinfo + [nonstandard];
      with VALUES do
	begin intval := true; ival := MININT end;
      END;
    ENTERID(CP);
    CP1 := NIL;
    FOR I := 0 TO 1 DO
      BEGIN
	NEW(CP,KONST);
	WITH CP^ DO
	  BEGIN
	    IDTYPE := BOOLPTR;
	    IF I = 0 THEN newident(namep,'FALSE')
	    ELSE newident(namep,'TRUE');
	    NEXT := CP1; KLASS := KONST;
	    with VALUES do begin intval := true; IVAL := I end;
	    info := sysinfo
	  END;
	ENTERID(CP); CP1 := CP
      END;
    BOOLPTR^.FCONST := CP;
    NEW(CP,KONST);
    WITH CP^ DO
      BEGIN newident(namep,'NIL'); IDTYPE := ANYPTRPTR;
	NEXT := NIL; KLASS := KONST;
	with values do
	  begin intval := true; ival := nilvalue end;
	info := sysinfo;
      END;
    ENTERID(CP);
    new(cp,types);
    with cp^ do
      begin
      newident(namep,'ANYPTR'); idtype := anyptrptr; next := nil;
      klass := types;
      info := sysinfo + [nonstandard,modcalreq,sysprogreq];
      end;
    enterid(cp);
    new(ioresultptr, vars);
    with ioresultptr^ do
      begin
      newident(namep, 'IORESULT'); idtype := intptr; next := nil;
      klass := vars;
      info := sysinfo + [nonstandard,ucsdreq,sysprogreq,modcalreq];
      globalptr := sysglobalptr;
      vlev := 1; vaddr := -22; vtype := localvar;
      end;
    enterid(ioresultptr);
    END (*ENTSTDNAMES*) ;

  PROCEDURE ENTUNDECL;
    var zip: alphaptr;
    BEGIN
    newident(zip,'*undecl*');
    NEW(UTYPPTR,TYPES);
    WITH UTYPPTR^ DO BEGIN
      namep := zip; IDTYPE := NIL;
      KLASS := TYPES; info := sysinfo  END;
    NEW(UCSTPTR,KONST);
    WITH UCSTPTR^ DO BEGIN
      namep := zip; IDTYPE := NIL; NEXT := NIL; KLASS := KONST;
      values.intval := true; VALUES.IVAL := 0; info := sysinfo END;
    NEW(UVARPTR,VARS,localvar);
    WITH UVARPTR^ DO BEGIN
      namep := zip; IDTYPE := NIL; NEXT := NIL; KLASS := VARS; globalptr := NIL;
      VLEV := 0; VADDR := 0; vtype := localvar; info := sysinfo END;
    NEW(UFLDPTR,FIELD,false);
    WITH UFLDPTR^ DO BEGIN
      namep := zip; IDTYPE := NIL; NEXT := NIL; FLDADDR := 0;
      fispackd := false; KLASS := FIELD; info := sysinfo END;
    NEW(UPRCPTR,prox,DECLARED);
    WITH UPRCPTR^ DO BEGIN
      namep := zip; IDTYPE := NIL; FORWDECL := FALSE; extdecl := false;
      NEXT := NIL; paramlc := 0; PFLEV := 0; inscope := false;
      KLASS := prox; ismodulebody := false;
      isexported := false;
      PFDECKIND := DECLARED; info := sysinfo; isrefed := false; END;
    NEW(UFCTPTR,FUNC,DECLARED);
    WITH UFCTPTR^ DO BEGIN
      namep := zip; IDTYPE := NIL; FORWDECL := FALSE; extdecl := false;
      NEXT := NIL; paramlc := 0; PFLEV := 0; KLASS := FUNC;
      pfaddr := 0; PFDECKIND := DECLARED; info := sysinfo;
      isexported := false; isrefed := false; inscope := false;
      END;
    END (*ENTUNDECL*) ;

  PROCEDURE ENTSPCPROCS;
    const spc1st = spabs;               {special procedure indices}
	  spclast = spfillchar;
    VAR LCP: CTP; I: spkeys;
	ISFUNC: BOOLEAN;
	NA: ARRAY [spc1st..spclast] OF ALPHAPTR;

    procedure fillna;
      begin
      newident(NA[spabs       ],'ABS');
      newident(NA[spchr       ],'CHR');
      newident(NA[spodd       ],'ODD');
      newident(NA[spord       ],'ORD');
      newident(NA[spround     ],'ROUND');
      newident(NA[sptrunc     ],'TRUNC');
      newident(NA[spsqr       ],'SQR');
      newident(NA[sppred      ],'PRED');
      newident(NA[spsucc      ],'SUCC');
      newident(NA[sphex       ],'HEX');
      newident(NA[spoctal     ],'OCTAL');
      newident(NA[spbinary    ],'BINARY');
      newident(NA[spnew       ],'NEW');
      newident(NA[spdispose   ],'DISPOSE');
      newident(NA[spaddr      ],'ADDR');
      newident(NA[spsizeof    ],'SIZEOF');
      newident(NA[spcall      ],'CALL');
      newident(NA[sppage      ],'PAGE');
      newident(NA[spoverprint ],'OVERPRINT');
      newident(NA[spprompt    ],'PROMPT');
      newident(NA[spwrite     ],'WRITE');
      newident(NA[spwriteln   ],'WRITELN');
      newident(NA[spread      ],'READ');
      newident(NA[spreadln    ],'READLN');
      newident(NA[spclose     ],'CLOSE');
      newident(NA[spreset     ],'RESET');
      newident(NA[sprewrite   ],'REWRITE');
      newident(NA[spappend    ],'APPEND');
      newident(NA[spreaddir   ],'READDIR');
      newident(NA[spwritedir  ],'WRITEDIR');
      newident(NA[spstrread   ],'STRREAD');
      newident(NA[spstrwrite  ],'STRWRITE');
      newident(NA[spstrmove   ],'STRMOVE');
      newident(NA[spopen      ],'OPEN');
      newident(NA[spseek      ],'SEEK');
      newident(NA[spposition  ],'POSITION');
      newident(NA[spmaxpos    ],'MAXPOS');
      newident(NA[splinepos   ],'LINEPOS');
      newident(NA[speoln      ],'EOLN');
      newident(NA[speof       ],'EOF');
      newident(NA[sphalt      ],'HALT');
      newident(NA[spstrlen    ],'STRLEN');
      newident(NA[spstrmax    ],'STRMAX');
      newident(NA[spsetstrlen ],'SETSTRLEN');
      newident(NA[sppack      ],'PACK');
      newident(NA[spunpack    ],'UNPACK');
      newident(NA[spunitread  ],'UNITREAD');
      newident(NA[spunitwrite ],'UNITWRITE');
      newident(NA[spblockread ],'BLOCKREAD');
      newident(NA[spblockwrite],'BLOCKWRITE');
      newident(NA[splength    ],'LENGTH');
      newident(NA[spconcat    ],'CONCAT');
      newident(NA[spmoveleft  ],'MOVELEFT');
      newident(NA[spmoveright ],'MOVERIGHT');
      newident(NA[spscan      ],'SCAN');
      newident(NA[spgotoxy    ],'GOTOXY');
      newident(NA[spfillchar  ],'FILLCHAR');
      end;  (* fillna *)

    BEGIN fillna;
    FOR I := spc1st TO spclast DO
      BEGIN
      ISFUNC := I IN
	[spabs,spchr,spodd,spord,spround,
	 sptrunc,spsqr,sppred,spsucc,sphex,
	 spoctal,spbinary,spaddr,splength,
	 spstrlen,spstrmax,spconcat,spsizeof,
	 spblockread,spblockwrite,spscan,speof,
	 speoln,spposition,spmaxpos,splinepos];
      IF ISFUNC THEN NEW(LCP,FUNC,SPECIAL)
      ELSE NEW(LCP,prox,SPECIAL);
      WITH LCP^ DO
	BEGIN NAMEP := NA[I]; NEXT := NIL;
	if I <> spconcat then IDTYPE := NIL
	else
	  begin new(IDTYPE,arrays,true,true);
	  IDTYPE^:=strgptr^; IDTYPE^.maxleng:=strglgth;
	  idtype^.unpacksize := strglgth+1;
	  end;
	IF ISFUNC THEN KLASS := FUNC ELSE KLASS := prox;
	PFDECKIND := SPECIAL; SPKEY := I;
	if (i in [spunitread,spunitwrite,
		  spblockread,spblockwrite,
		  splength,spconcat,spgotoxy,
		  spmoveright,spmoveleft,
		  spscan,spfillchar]) then
	  info := sysinfo + [nonstandard,ucsdreq]
	else if (i in [spsizeof]) then
	  info := sysinfo + [nonstandard,ucsdreq,
			    modcalreq,sysprogreq]
	else if (i in [spoverprint,spprompt,
		       spstrread,spstrwrite,
		       spreaddir,spwritedir,
		       spappend,splinepos,
		       spstrmove,spseek,spposition,
		       spmaxpos,splinepos,sphalt,
		       spstrmax,spsetstrlen,
		       spopen,spclose,spstrlen,
		       sphex,spoctal,spbinary]) then
	  info := sysinfo + [nonstandard]
	else if (i in [spcall,spaddr]) then
	  info := sysinfo + [nonstandard,modcalreq,sysprogreq]
	else info := sysinfo;
	END;
      ENTERID(LCP)
      END;
    END (*ENTSPCPROCS*) ;

  PROCEDURE ENTSTDPROCS;
    const std1st = spmark;              {standard procedure indices}
	  stdlast = spunitwait;
    VAR LCP,PARAM: CTP; FTYPE,MAXSTRINGP: STP;
	I: spkeys; ISFUNC: BOOLEAN;
	NA: ARRAY [std1st..stdlast] OF ALPHAPTR;

    procedure makeparm (typ: stp; kind: vartype);
      { sets up a parameter record. Call in right-to-left order }
      var parm: ctp;
      begin
      new(parm,vars,refparm);
      with parm^ do
	begin namep := nil; idtype := typ;
	next := param; info := sysinfo;
	klass := vars; vtype := kind;
	globalptr := NIL;
	end;
      param := parm;
      end;

    procedure fillna;
      begin
      newident(NA[spmemavail  ],'MEMAVAIL');
      newident(NA[sppos       ],'POS');
      newident(NA[spinsert    ],'INSERT');
      newident(NA[spdelete    ],'DELETE');
      newident(NA[spcopy      ],'COPY');
      newident(NA[spstr       ],'STR');
      newident(NA[spunitclear ],'UNITCLEAR');
      newident(NA[spunitbusy  ],'UNITBUSY');
      newident(NA[spunitwait  ],'UNITWAIT');
      newident(NA[spescape    ],'ESCAPE');
      newident(NA[spesccode   ],'ESCAPECODE');
      newident(NA[spnewwords  ],'NEWWORDS');
      newident(NA[spmark      ],'MARK');
      newident(NA[sprelease   ],'RELEASE');
      newident(NA[spsin       ],'SIN');
      newident(NA[spcos       ],'COS');
      newident(NA[spexp       ],'EXP');
      newident(NA[spln        ],'LN');
      newident(NA[spsqrt      ],'SQRT');
      newident(NA[sparctan    ],'ARCTAN');
      newident(NA[spget       ],'GET');
      newident(NA[spput       ],'PUT');
      newident(NA[spstrrpt    ],'STRRPT');
      newident(NA[spstrpos    ],'STRPOS');
      newident(NA[spstrappend ],'STRAPPEND');
      newident(NA[spltrim     ],'STRLTRIM');
      newident(NA[sprtrim     ],'STRRTRIM');
      newident(NA[spstrinsert ],'STRINSERT');
      newident(NA[spstrdelete ],'STRDELETE');
      end;

    BEGIN (*ENTSTDPROCS*)
    fillna;
    new(maxstringp,arrays,true,true);
    maxstringp^ := strgptr^;
    maxstringp^.maxleng := strglgth;
    maxstringp^.unpacksize := strglgth+1;
    FOR I := std1st TO stdlast DO
      BEGIN
      ISFUNC := I IN
	[spesccode,spmemavail,spstrpos,sppos,
	 spstrrpt,spcopy,spstr,spltrim,sprtrim,
	 spunitbusy,spsin,spcos,spexp,spln,
	 spsqrt,sparctan];
      IF ISFUNC THEN NEW(LCP,FUNC,STANDARD)
      ELSE NEW(LCP,prox,STANDARD);
      FTYPE := NIL; PARAM := NIL;
      CASE I OF
	spmark:         {var anyptr}
	  makeparm(anyptrptr,refparm);
	sprelease:      {anyptr}
	  makeparm(anyptrptr,valparm);
	spunitbusy:     {bool func of integer}
	  begin ftype := boolptr; makeparm(intptr,valparm); end;
	spunitclear,
	spunitwait:
	  makeparm(intptr,valparm);
	spescape:       {integer}
	  makeparm(shortintptr,valparm);
	spesccode,
	spmemavail:     {integer fcn}
	  ftype := intptr;
	spsin,spcos,
	spexp,spln,
	spsqrt,sparctan: {real func of real}
	  begin ftype := realptr; makeparm(realptr,valparm) end;
	spget,spput:        {var anyfile}
	  makeparm(anyfileptr,refparm);
	spnewwords:     {var anyptr, integer}
	  begin makeparm(intptr,valparm); makeparm(anyptrptr,refparm) end;
	spstrdelete,
	spdelete:       {var string, integer, integer}
	  begin makeparm(intptr,valparm);
	  makeparm(intptr,valparm);
	  makeparm(strgptr,refparm);{no max len}
	  end;
	spstrinsert,
	spinsert:       {string, var string, integer}
	  begin makeparm(intptr,valparm);
	  makeparm(strgptr,strparm);
	  makeparm(maxstringp,cvalparm);
	  end;
	spstrpos,
	sppos:          {integer func of string, string}
	  begin ftype := intptr;
	  makeparm(maxstringp,cvalparm);
	  makeparm(maxstringp,cvalparm);
	  end;
	spstrrpt:       {string fcn of string, integer}
	  begin ftype := maxstringp;
	  makeparm(intptr,valparm);
	  makeparm(maxstringp,cvalparm);
	  end;
	spstr,
	spcopy:         {string fcn of string,int,int}
	  begin ftype := maxstringp;
	  makeparm(intptr,valparm);
	  makeparm(intptr,valparm);
	  makeparm(maxstringp,cvalparm);
	  end;
	spstrappend:    {var string, string}
	  begin makeparm(maxstringp,cvalparm);
	  makeparm(strgptr,strparm);
	  end;
	spltrim,sprtrim: {string fcn of string}
	  begin ftype := maxstringp;
	  makeparm(maxstringp,cvalparm);
	  end;
	END; {case}
      WITH LCP^ DO
	BEGIN NAMEP := NA[I]; IDTYPE := FTYPE;
	NEXT := PARAM;
	IF ISFUNC THEN KLASS := FUNC ELSE KLASS := prox;
	PFDECKIND := STANDARD; SPKEY := I;
	if (i in [spescape,spesccode]) then
	  info := sysinfo + [nonstandard,sysprogreq]
	else if (i in [sppos,spinsert,
		       spdelete,spcopy,
		       spunitclear,spunitbusy,
		       spunitwait]) then
	  info := sysinfo + [nonstandard,ucsdreq]
	else if (i in [spmark,sprelease,
		       spstrrpt,spstrpos,
		       spstrappend,spltrim,
		       sprtrim,spstrinsert,spstr,
		       spstrdelete]) then
	  info := sysinfo + [nonstandard]
	else if i = spmemavail then
	  info := sysinfo + [nonstandard,ucsdreq,modcalreq]
	else if i = spnewwords then
	  info := sysinfo + [nonstandard,modcalreq]
	else info := sysinfo;
	END;
      ENTERID(LCP);
      END;
    END (*ENTSTDPROCS*) ;

  PROCEDURE INITSCALARS;
    BEGIN
    tables := false; gcallmode := abscall; gcopyright := '';
    totalerrors:=0; totalwarnings := 0;
    putcode:=true; uminus := false;
    inbody := false; indefinesection := false;
    FWPTR := NIL;
    gshortcircuit := false;
    LC := initlc; DP := TRUE;
    refilesize := refiledefault; defilesize := defiledefault;
    refvolname := ''; defvolname := '';
    oldDP := true; importexportext := false;
    linenumber := 0; SCREENDOTS := 0; STARTDOTS := 0;
    PRTERR := TRUE; BPTONLINE := FALSE; DEBUGGING := FALSE;
    GRANGECHECK := TRUE; GIOCHECK := TRUE; stdpasc := false;
    saveconst := true; govflcheck := true; gstackcheck := true;
    ucsd := false; modcal := false; sysprog := false;
    warn := true;
    $IF MC68020$
      float := flt_on;
    $END$
    $IF not MC68020$
      float := flt_off;
    $END$
    switch_strpos := false; strpos_warn := true;
    maxsearchfiles := 0; maxoverlays := 0;
    beforefirsttoken := true; syntxerr := false;
    heapdispose := false; gtemplist := listnone;
    systemglobals := 'SYSGLOBALS';
    sysglobalptr := addr(systemglobals);
    float_flag := 'FLTPTHDW';
    sawinput := false; sawoutput := false;
    sawkeyboard := false; sawlisting := false;
    disdef.level := -1; aliasok := false;
    uniquenum := 0; listabort := false;
    allow_packed := false;
    temp_put := false;
    END; (*INITSCALARS*)

  PROCEDURE INITSETS;
    BEGIN
    CONSTBEGSYS := [ADDOP,INTCONST,REALCONST,STRINGCONST,IDENT,
		    lbrack,lparent,notsy];
    SIMPTYPEBEGSYS := [addop,intconst,realconst,stringconst,ident,LPARENT];
    TYPEDELS := [ARRAYSY,RECORDSY,SETSY,FILESY];
    TYPEBEGSYS := [ARROW,PACKEDSY,procsy] + TYPEDELS + SIMPTYPEBEGSYS;
    BLOCKBEGSYS := [LABELSY,CONSTSY,TYPESY,VARSY,
	PROCSY,FUNCSY,BEGINSY,modulesy,importsy,
	forwardsy,externlsy];
    modulebegsys := blockbegsys + [importsy,exportsy,implmtsy];
    SELECTSYS := [ARROW,PERIOD,LBRACK];
    FACBEGSYS := [INTCONST,REALCONST,STRINGCONST,IDENT,LPARENT,LBRACK,NOTSY];
    STATBEGSYS := [BEGINSY,GOTOSY,IFSY,WHILESY,REPEATSY,FORSY,WITHSY,CASESY,
		   trysy];
    END (*INITSETS*) ;

  procedure initpowertable;
    var i: integer;
    begin
    power_table[0] := 1;
    for i := 1 to bitsperword-2 do
      power_table[i] := power_table[i-1]*2;
    end;

  BEGIN (*INIT*)

  initdate;
  userinfo^.gotcode := false;

  setstrlen(timestring,0);
  i := 1;
  if globaltime.hour < 10 then
    strwrite(timestring,i,i,'0');
  strwrite(timestring,i,i,globaltime.hour:1,':');
  if globaltime.minute < 10 then
    strwrite(timestring,i,i,'0');
  strwrite(timestring,i,i,globaltime.minute:1,':');
  seconds := globaltime.centisecond div 100;
  if seconds < 10 then
    strwrite(timestring,i,i,'0');
  strwrite(timestring,i,i,seconds:1);
  WRITELN(OUTPUT,compilername,
    ' [Rev ',crevno,' ',crevid.month:2,'/',crevid.day:2,
    '/',crevid.year:2,']',todaysdate:12,' ',timestring);
  writeln(output);
  writeln(output,copyright1);
  writeln(output,'':14,copyright2);
  writeln(output);
  compioinit; bodyanalyzerinit;
  INITSCALARS; INITSETS; initpowertable;
  LEVEL := 0; TOP := 0; linelevel := 0;
  levelatstart := 0; linlevatstart := 0;
  WITH DISPLAY[0] DO
    BEGIN OCCUR := BLOCKscope; FNAME := NIL;
    FFILE := NIL; FLABEL := NIL; fmodule := nil;
    available_module := nil;
    END;
  sysinfo := [predeclared];                {std attribute}
  ENTSTDTYPES;   ENTUNDECL;
  INSYMBOL; { must not access option flags
	      before this call to insymbol }
  ENTSTDNAMES;   ENTSPCPROCS;   ENTSTDPROCS;
  LEVEL := 1; TOP := 1;
  WITH DISPLAY[1] DO
    BEGIN OCCUR := BLOCKscope; FNAME := NIL;
    FFILE := NIL; FLABEL := NIL; fmodule := nil;
    available_module := nil;
    END;
  display_ok_to_import := 2;

  codegeninit;    { process $def or $ref before initializing code files }

  if maxsearchfiles = 0 then
    begin
    newbytes(searchlistptr,(122*searchdefault));
    maxsearchfiles := searchdefault;
    searchfilestop := 1;
    searchlistptr^[1] := syslibrary;
    end;

  if maxoverlays = 0 then
    begin
    newbytes(overlaylistptr,(16*overlaydefault));
    maxoverlays := overlaydefault;
    overlaytop := 0;
    end;

  beforefirsttoken := false;
  FOR I := 1 TO 8 DO WRITELN(OUTPUT);
  WRITE(OUTPUT,'<    0>');
  NEW(OUTERBLOCK,prox,DECLARED);
  WITH OUTERBLOCK^ DO
    BEGIN NEXT := NIL; paramlc := 0;
      newident(namep,'PROGRAM'); IDTYPE := NIL; KLASS := prox;
      PFDECKIND := DECLARED; PFLEV := 0; ismodulebody := false;
      FORWDECL := FALSE; extdecl := false; inscope := false;
      alias := false; othername := nil; info := [];
    END;
  sysinfo := [];           {std attributes for user names}
  END (*COMPINIT*) ;

@


56.2
log
@
pws2rcs automatic delta on Wed Jan 27 11:57:27 MST 1993
@
text
@d1 666
@


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 666
			{file INIT}

implement

procedure init;
  var
    seconds: shortint;
    i: integer;

  procedure initdate;
    {Initialize TODAYSDATE to current date as 'dd-mmm-yy'.}
    {Uses system procedure sysdate(var d: daterec)}

    begin {initdate}
    sysdate(globaldate);
    systime(globaltime);
    with globaldate do
      begin
      {LAF 880101 added "mod 10" to "div 10" and removed "year<100" test}
      if (month in [1..12]) and (day>0) then
	begin                                 {Valid date}
	todaysdate := '  -' +
	  str('JanFebMarAprMayJunJulAugSepOctNovDec',
				  month*3-2,3) +
					   '-  ';
	if day>9 then todaysdate[1] := chr(day div 10 + ord('0'));
	todaysdate[2] := chr(day mod 10 + ord('0'));
	todaysdate[8] := chr(year div 10 mod 10 + ord('0'));
	todaysdate[9] := chr(year mod 10 + ord('0'));
	end
      else todaysdate := '         ';         {Invalid date}
      end;
    end; {initdate}

  PROCEDURE ENTSTDTYPES;
    BEGIN
    NEW(INTPTR,SCALAR,STANDARD);
    WITH INTPTR^ DO
      BEGIN ispackable := false; sizeoflo := false;
      unpacksize := INTSIZE; align := INTALIGN;
      FORM := SCALAR; SCALKIND := STANDARD; info := sysinfo;
      END;
    new(shortintptr,scalar,standard);
    with shortintptr^ do
      begin ispackable := true; sizeoflo := false;
      unpacksize := shortintsize; align := intalign;
      bitsize := shortintsize*bitsperchar; signbit := true;
      form := scalar; scalkind := standard; info := sysinfo;
      END;
    NEW(REALPTR,reals);
    WITH REALPTR^ DO
      BEGIN ispackable := false; sizeoflo := false;
      unpacksize := REALSIZE; align := REALALIGN;
      FORM := reals; info := sysinfo;
      END;
    NEW(CHAR_PTR,SCALAR,STANDARD);
    WITH CHAR_PTR^ DO
      BEGIN ispackable := true; sizeoflo := false;
      bitsize := BITSPERCHAR; signbit := false;
      unpacksize := CHARSIZE; align := CHARALIGN;
      FORM := SCALAR; SCALKIND := STANDARD; info := sysinfo;
      END;
    NEW(BOOLPTR,SCALAR,DECLARED);
    WITH BOOLPTR^ DO
      BEGIN ispackable := true; sizeoflo := false;
      bitsize := 1; signbit := false;
      unpacksize := BOOLSIZE; align := BOOLALIGN;
      FORM := SCALAR; SCALKIND := DECLARED; info := sysinfo;
      END;
    NEW(ANYFILEPTR,FILES);
    WITH ANYFILEPTR^ DO
      BEGIN ispackable := false; sizeoflo := false;
      unpacksize := FILESIZE; align := WORDALIGN;
      FORM := FILES; FILTYPE := NIL; info := sysinfo;
      END;
    NEW(ANYPTRPTR,POINTER);
    WITH ANYPTRPTR^ DO
      BEGIN ispackable := false; sizeoflo := false;
      unpacksize := PTRSIZE; align := PTRALIGN;
      FORM := POINTER; ELTYPE := NIL; info := sysinfo;
      END;
    NEW(cant_deref,POINTER);
    cant_deref^ := anyptrptr^;
    NEW(TEXTPTR,FILES);
    WITH TEXTPTR^ DO
      BEGIN ispackable := false; sizeoflo := false;
      unpacksize := FILESIZE+CHARSIZE; align := WORDALIGN;
      FORM := FILES; FILTYPE := CHAR_PTR;
      info := sysinfo + [mustinitialize, cantassign];
      END;
    NEW(STRGPTR,ARRAYS,TRUE,TRUE);
    WITH STRGPTR^ DO {var template & string parm}
      BEGIN ispackable := false; sizeoflo := false;
      unpacksize := ptrsize+shortintsize;
      align := WORDALIGN; FORM := ARRAYS;
      AELTYPE := CHAR_PTR; INXTYPE := INTPTR;
      AISPACKD := TRUE; aelbitsize := bitsperchar;
      AISSTRNG := TRUE; MAXLENG := 255;
      info := []; {NOT predeclared}
      END;
    END (*ENTSTDTYPES*) ;

  PROCEDURE ENTSTDNAMES;
    VAR CP,CP1: CTP; I: INTEGER;
    BEGIN
    NEW(CP,TYPES);
    WITH CP^ DO
      BEGIN newident(namep,'REAL'); IDTYPE := REALPTR; KLASS := TYPES;
      info := sysinfo
      END;
    ENTERID(CP);
    NEW(CP,TYPES);
    WITH CP^ DO
      BEGIN newident(namep,'LONGREAL'); IDTYPE := REALPTR; KLASS := TYPES;
      info := sysinfo + [nonstandard];
      END;
    ENTERID(CP);
    NEW(CP,TYPES);
    WITH CP^ DO
      BEGIN newident(namep,'INTEGER'); IDTYPE := INTPTR; KLASS := TYPES;
      info := sysinfo
      END;
    ENTERID(CP);
    NEW(CP,TYPES);
    WITH CP^ DO
      BEGIN newident(namep,'CHAR'); IDTYPE := CHAR_PTR; KLASS := TYPES;
      info := sysinfo
      END;
    ENTERID(CP);
    NEW(CP,TYPES);
    WITH CP^ DO
      BEGIN newident(namep,'BOOLEAN'); IDTYPE := BOOLPTR; KLASS := TYPES;
      info := sysinfo
      END;
    ENTERID(CP);
    NEW(CP,TYPES);
    WITH CP^ DO
      BEGIN newident(namep,'STRING'); IDTYPE := STRGPTR; KLASS := TYPES;
      info := sysinfo + [nonstandard];
      END;
    ENTERID(CP);
    NEW(CP,TYPES);
    WITH CP^ DO
      BEGIN newident(namep,'TEXT'); IDTYPE := TEXTPTR; KLASS := TYPES;
      info := sysinfo
      END;
    ENTERID(CP);
    NEW(CP,KONST);
    WITH CP^ DO
      BEGIN
      newident(namep,'MAXINT'); IDTYPE := INTPTR;
      KLASS := KONST;
      info := sysinfo;
      with VALUES do
	begin intval := true; ival := MAXINT end;
      END;
    ENTERID(CP);
    NEW(CP,KONST);
    WITH CP^ DO
      BEGIN
      newident(namep,'MININT'); IDTYPE := INTPTR;
      KLASS := KONST;
      info := sysinfo + [nonstandard];
      with VALUES do
	begin intval := true; ival := MININT end;
      END;
    ENTERID(CP);
    CP1 := NIL;
    FOR I := 0 TO 1 DO
      BEGIN
	NEW(CP,KONST);
	WITH CP^ DO
	  BEGIN
	    IDTYPE := BOOLPTR;
	    IF I = 0 THEN newident(namep,'FALSE')
	    ELSE newident(namep,'TRUE');
	    NEXT := CP1; KLASS := KONST;
	    with VALUES do begin intval := true; IVAL := I end;
	    info := sysinfo
	  END;
	ENTERID(CP); CP1 := CP
      END;
    BOOLPTR^.FCONST := CP;
    NEW(CP,KONST);
    WITH CP^ DO
      BEGIN newident(namep,'NIL'); IDTYPE := ANYPTRPTR;
	NEXT := NIL; KLASS := KONST;
	with values do
	  begin intval := true; ival := nilvalue end;
	info := sysinfo;
      END;
    ENTERID(CP);
    new(cp,types);
    with cp^ do
      begin
      newident(namep,'ANYPTR'); idtype := anyptrptr; next := nil;
      klass := types;
      info := sysinfo + [nonstandard,modcalreq,sysprogreq];
      end;
    enterid(cp);
    new(ioresultptr, vars);
    with ioresultptr^ do
      begin
      newident(namep, 'IORESULT'); idtype := intptr; next := nil;
      klass := vars;
      info := sysinfo + [nonstandard,ucsdreq,sysprogreq,modcalreq];
      globalptr := sysglobalptr;
      vlev := 1; vaddr := -22; vtype := localvar;
      end;
    enterid(ioresultptr);
    END (*ENTSTDNAMES*) ;

  PROCEDURE ENTUNDECL;
    var zip: alphaptr;
    BEGIN
    newident(zip,'*undecl*');
    NEW(UTYPPTR,TYPES);
    WITH UTYPPTR^ DO BEGIN
      namep := zip; IDTYPE := NIL;
      KLASS := TYPES; info := sysinfo  END;
    NEW(UCSTPTR,KONST);
    WITH UCSTPTR^ DO BEGIN
      namep := zip; IDTYPE := NIL; NEXT := NIL; KLASS := KONST;
      values.intval := true; VALUES.IVAL := 0; info := sysinfo END;
    NEW(UVARPTR,VARS,localvar);
    WITH UVARPTR^ DO BEGIN
      namep := zip; IDTYPE := NIL; NEXT := NIL; KLASS := VARS; globalptr := NIL;
      VLEV := 0; VADDR := 0; vtype := localvar; info := sysinfo END;
    NEW(UFLDPTR,FIELD,false);
    WITH UFLDPTR^ DO BEGIN
      namep := zip; IDTYPE := NIL; NEXT := NIL; FLDADDR := 0;
      fispackd := false; KLASS := FIELD; info := sysinfo END;
    NEW(UPRCPTR,prox,DECLARED);
    WITH UPRCPTR^ DO BEGIN
      namep := zip; IDTYPE := NIL; FORWDECL := FALSE; extdecl := false;
      NEXT := NIL; paramlc := 0; PFLEV := 0; inscope := false;
      KLASS := prox; ismodulebody := false;
      isexported := false;
      PFDECKIND := DECLARED; info := sysinfo; isrefed := false; END;
    NEW(UFCTPTR,FUNC,DECLARED);
    WITH UFCTPTR^ DO BEGIN
      namep := zip; IDTYPE := NIL; FORWDECL := FALSE; extdecl := false;
      NEXT := NIL; paramlc := 0; PFLEV := 0; KLASS := FUNC;
      pfaddr := 0; PFDECKIND := DECLARED; info := sysinfo;
      isexported := false; isrefed := false; inscope := false;
      END;
    END (*ENTUNDECL*) ;

  PROCEDURE ENTSPCPROCS;
    const spc1st = spabs;               {special procedure indices}
	  spclast = spfillchar;
    VAR LCP: CTP; I: spkeys;
	ISFUNC: BOOLEAN;
	NA: ARRAY [spc1st..spclast] OF ALPHAPTR;

    procedure fillna;
      begin
      newident(NA[spabs       ],'ABS');
      newident(NA[spchr       ],'CHR');
      newident(NA[spodd       ],'ODD');
      newident(NA[spord       ],'ORD');
      newident(NA[spround     ],'ROUND');
      newident(NA[sptrunc     ],'TRUNC');
      newident(NA[spsqr       ],'SQR');
      newident(NA[sppred      ],'PRED');
      newident(NA[spsucc      ],'SUCC');
      newident(NA[sphex       ],'HEX');
      newident(NA[spoctal     ],'OCTAL');
      newident(NA[spbinary    ],'BINARY');
      newident(NA[spnew       ],'NEW');
      newident(NA[spdispose   ],'DISPOSE');
      newident(NA[spaddr      ],'ADDR');
      newident(NA[spsizeof    ],'SIZEOF');
      newident(NA[spcall      ],'CALL');
      newident(NA[sppage      ],'PAGE');
      newident(NA[spoverprint ],'OVERPRINT');
      newident(NA[spprompt    ],'PROMPT');
      newident(NA[spwrite     ],'WRITE');
      newident(NA[spwriteln   ],'WRITELN');
      newident(NA[spread      ],'READ');
      newident(NA[spreadln    ],'READLN');
      newident(NA[spclose     ],'CLOSE');
      newident(NA[spreset     ],'RESET');
      newident(NA[sprewrite   ],'REWRITE');
      newident(NA[spappend    ],'APPEND');
      newident(NA[spreaddir   ],'READDIR');
      newident(NA[spwritedir  ],'WRITEDIR');
      newident(NA[spstrread   ],'STRREAD');
      newident(NA[spstrwrite  ],'STRWRITE');
      newident(NA[spstrmove   ],'STRMOVE');
      newident(NA[spopen      ],'OPEN');
      newident(NA[spseek      ],'SEEK');
      newident(NA[spposition  ],'POSITION');
      newident(NA[spmaxpos    ],'MAXPOS');
      newident(NA[splinepos   ],'LINEPOS');
      newident(NA[speoln      ],'EOLN');
      newident(NA[speof       ],'EOF');
      newident(NA[sphalt      ],'HALT');
      newident(NA[spstrlen    ],'STRLEN');
      newident(NA[spstrmax    ],'STRMAX');
      newident(NA[spsetstrlen ],'SETSTRLEN');
      newident(NA[sppack      ],'PACK');
      newident(NA[spunpack    ],'UNPACK');
      newident(NA[spunitread  ],'UNITREAD');
      newident(NA[spunitwrite ],'UNITWRITE');
      newident(NA[spblockread ],'BLOCKREAD');
      newident(NA[spblockwrite],'BLOCKWRITE');
      newident(NA[splength    ],'LENGTH');
      newident(NA[spconcat    ],'CONCAT');
      newident(NA[spmoveleft  ],'MOVELEFT');
      newident(NA[spmoveright ],'MOVERIGHT');
      newident(NA[spscan      ],'SCAN');
      newident(NA[spgotoxy    ],'GOTOXY');
      newident(NA[spfillchar  ],'FILLCHAR');
      end;  (* fillna *)

    BEGIN fillna;
    FOR I := spc1st TO spclast DO
      BEGIN
      ISFUNC := I IN
	[spabs,spchr,spodd,spord,spround,
	 sptrunc,spsqr,sppred,spsucc,sphex,
	 spoctal,spbinary,spaddr,splength,
	 spstrlen,spstrmax,spconcat,spsizeof,
	 spblockread,spblockwrite,spscan,speof,
	 speoln,spposition,spmaxpos,splinepos];
      IF ISFUNC THEN NEW(LCP,FUNC,SPECIAL)
      ELSE NEW(LCP,prox,SPECIAL);
      WITH LCP^ DO
	BEGIN NAMEP := NA[I]; NEXT := NIL;
	if I <> spconcat then IDTYPE := NIL
	else
	  begin new(IDTYPE,arrays,true,true);
	  IDTYPE^:=strgptr^; IDTYPE^.maxleng:=strglgth;
	  idtype^.unpacksize := strglgth+1;
	  end;
	IF ISFUNC THEN KLASS := FUNC ELSE KLASS := prox;
	PFDECKIND := SPECIAL; SPKEY := I;
	if (i in [spunitread,spunitwrite,
		  spblockread,spblockwrite,
		  splength,spconcat,spgotoxy,
		  spmoveright,spmoveleft,
		  spscan,spfillchar]) then
	  info := sysinfo + [nonstandard,ucsdreq]
	else if (i in [spsizeof]) then
	  info := sysinfo + [nonstandard,ucsdreq,
			    modcalreq,sysprogreq]
	else if (i in [spoverprint,spprompt,
		       spstrread,spstrwrite,
		       spreaddir,spwritedir,
		       spappend,splinepos,
		       spstrmove,spseek,spposition,
		       spmaxpos,splinepos,sphalt,
		       spstrmax,spsetstrlen,
		       spopen,spclose,spstrlen,
		       sphex,spoctal,spbinary]) then
	  info := sysinfo + [nonstandard]
	else if (i in [spcall,spaddr]) then
	  info := sysinfo + [nonstandard,modcalreq,sysprogreq]
	else info := sysinfo;
	END;
      ENTERID(LCP)
      END;
    END (*ENTSPCPROCS*) ;

  PROCEDURE ENTSTDPROCS;
    const std1st = spmark;              {standard procedure indices}
	  stdlast = spunitwait;
    VAR LCP,PARAM: CTP; FTYPE,MAXSTRINGP: STP;
	I: spkeys; ISFUNC: BOOLEAN;
	NA: ARRAY [std1st..stdlast] OF ALPHAPTR;

    procedure makeparm (typ: stp; kind: vartype);
      { sets up a parameter record. Call in right-to-left order }
      var parm: ctp;
      begin
      new(parm,vars,refparm);
      with parm^ do
	begin namep := nil; idtype := typ;
	next := param; info := sysinfo;
	klass := vars; vtype := kind;
	globalptr := NIL;
	end;
      param := parm;
      end;

    procedure fillna;
      begin
      newident(NA[spmemavail  ],'MEMAVAIL');
      newident(NA[sppos       ],'POS');
      newident(NA[spinsert    ],'INSERT');
      newident(NA[spdelete    ],'DELETE');
      newident(NA[spcopy      ],'COPY');
      newident(NA[spstr       ],'STR');
      newident(NA[spunitclear ],'UNITCLEAR');
      newident(NA[spunitbusy  ],'UNITBUSY');
      newident(NA[spunitwait  ],'UNITWAIT');
      newident(NA[spescape    ],'ESCAPE');
      newident(NA[spesccode   ],'ESCAPECODE');
      newident(NA[spnewwords  ],'NEWWORDS');
      newident(NA[spmark      ],'MARK');
      newident(NA[sprelease   ],'RELEASE');
      newident(NA[spsin       ],'SIN');
      newident(NA[spcos       ],'COS');
      newident(NA[spexp       ],'EXP');
      newident(NA[spln        ],'LN');
      newident(NA[spsqrt      ],'SQRT');
      newident(NA[sparctan    ],'ARCTAN');
      newident(NA[spget       ],'GET');
      newident(NA[spput       ],'PUT');
      newident(NA[spstrrpt    ],'STRRPT');
      newident(NA[spstrpos    ],'STRPOS');
      newident(NA[spstrappend ],'STRAPPEND');
      newident(NA[spltrim     ],'STRLTRIM');
      newident(NA[sprtrim     ],'STRRTRIM');
      newident(NA[spstrinsert ],'STRINSERT');
      newident(NA[spstrdelete ],'STRDELETE');
      end;

    BEGIN (*ENTSTDPROCS*)
    fillna;
    new(maxstringp,arrays,true,true);
    maxstringp^ := strgptr^;
    maxstringp^.maxleng := strglgth;
    maxstringp^.unpacksize := strglgth+1;
    FOR I := std1st TO stdlast DO
      BEGIN
      ISFUNC := I IN
	[spesccode,spmemavail,spstrpos,sppos,
	 spstrrpt,spcopy,spstr,spltrim,sprtrim,
	 spunitbusy,spsin,spcos,spexp,spln,
	 spsqrt,sparctan];
      IF ISFUNC THEN NEW(LCP,FUNC,STANDARD)
      ELSE NEW(LCP,prox,STANDARD);
      FTYPE := NIL; PARAM := NIL;
      CASE I OF
	spmark:         {var anyptr}
	  makeparm(anyptrptr,refparm);
	sprelease:      {anyptr}
	  makeparm(anyptrptr,valparm);
	spunitbusy:     {bool func of integer}
	  begin ftype := boolptr; makeparm(intptr,valparm); end;
	spunitclear,
	spunitwait:
	  makeparm(intptr,valparm);
	spescape:       {integer}
	  makeparm(shortintptr,valparm);
	spesccode,
	spmemavail:     {integer fcn}
	  ftype := intptr;
	spsin,spcos,
	spexp,spln,
	spsqrt,sparctan: {real func of real}
	  begin ftype := realptr; makeparm(realptr,valparm) end;
	spget,spput:        {var anyfile}
	  makeparm(anyfileptr,refparm);
	spnewwords:     {var anyptr, integer}
	  begin makeparm(intptr,valparm); makeparm(anyptrptr,refparm) end;
	spstrdelete,
	spdelete:       {var string, integer, integer}
	  begin makeparm(intptr,valparm);
	  makeparm(intptr,valparm);
	  makeparm(strgptr,refparm);{no max len}
	  end;
	spstrinsert,
	spinsert:       {string, var string, integer}
	  begin makeparm(intptr,valparm);
	  makeparm(strgptr,strparm);
	  makeparm(maxstringp,cvalparm);
	  end;
	spstrpos,
	sppos:          {integer func of string, string}
	  begin ftype := intptr;
	  makeparm(maxstringp,cvalparm);
	  makeparm(maxstringp,cvalparm);
	  end;
	spstrrpt:       {string fcn of string, integer}
	  begin ftype := maxstringp;
	  makeparm(intptr,valparm);
	  makeparm(maxstringp,cvalparm);
	  end;
	spstr,
	spcopy:         {string fcn of string,int,int}
	  begin ftype := maxstringp;
	  makeparm(intptr,valparm);
	  makeparm(intptr,valparm);
	  makeparm(maxstringp,cvalparm);
	  end;
	spstrappend:    {var string, string}
	  begin makeparm(maxstringp,cvalparm);
	  makeparm(strgptr,strparm);
	  end;
	spltrim,sprtrim: {string fcn of string}
	  begin ftype := maxstringp;
	  makeparm(maxstringp,cvalparm);
	  end;
	END; {case}
      WITH LCP^ DO
	BEGIN NAMEP := NA[I]; IDTYPE := FTYPE;
	NEXT := PARAM;
	IF ISFUNC THEN KLASS := FUNC ELSE KLASS := prox;
	PFDECKIND := STANDARD; SPKEY := I;
	if (i in [spescape,spesccode]) then
	  info := sysinfo + [nonstandard,sysprogreq]
	else if (i in [sppos,spinsert,
		       spdelete,spcopy,
		       spunitclear,spunitbusy,
		       spunitwait]) then
	  info := sysinfo + [nonstandard,ucsdreq]
	else if (i in [spmark,sprelease,
		       spstrrpt,spstrpos,
		       spstrappend,spltrim,
		       sprtrim,spstrinsert,spstr,
		       spstrdelete]) then
	  info := sysinfo + [nonstandard]
	else if i = spmemavail then
	  info := sysinfo + [nonstandard,ucsdreq,modcalreq]
	else if i = spnewwords then
	  info := sysinfo + [nonstandard,modcalreq]
	else info := sysinfo;
	END;
      ENTERID(LCP);
      END;
    END (*ENTSTDPROCS*) ;

  PROCEDURE INITSCALARS;
    BEGIN
    tables := false; gcallmode := abscall; gcopyright := '';
    totalerrors:=0; totalwarnings := 0;
    putcode:=true; uminus := false;
    inbody := false; indefinesection := false;
    FWPTR := NIL;
    gshortcircuit := false;
    LC := initlc; DP := TRUE;
    refilesize := refiledefault; defilesize := defiledefault;
    refvolname := ''; defvolname := '';
    oldDP := true; importexportext := false;
    linenumber := 0; SCREENDOTS := 0; STARTDOTS := 0;
    PRTERR := TRUE; BPTONLINE := FALSE; DEBUGGING := FALSE;
    GRANGECHECK := TRUE; GIOCHECK := TRUE; stdpasc := false;
    saveconst := true; govflcheck := true; gstackcheck := true;
    ucsd := false; modcal := false; sysprog := false;
    warn := true;
    $IF MC68020$
      float := flt_on;
    $END$
    $IF not MC68020$
      float := flt_off;
    $END$
    switch_strpos := false; strpos_warn := true;
    maxsearchfiles := 0; maxoverlays := 0;
    beforefirsttoken := true; syntxerr := false;
    heapdispose := false; gtemplist := listnone;
    systemglobals := 'SYSGLOBALS';
    sysglobalptr := addr(systemglobals);
    float_flag := 'FLTPTHDW';
    sawinput := false; sawoutput := false;
    sawkeyboard := false; sawlisting := false;
    disdef.level := -1; aliasok := false;
    uniquenum := 0; listabort := false;
    allow_packed := false;
    temp_put := false;
    END; (*INITSCALARS*)

  PROCEDURE INITSETS;
    BEGIN
    CONSTBEGSYS := [ADDOP,INTCONST,REALCONST,STRINGCONST,IDENT,
		    lbrack,lparent,notsy];
    SIMPTYPEBEGSYS := [addop,intconst,realconst,stringconst,ident,LPARENT];
    TYPEDELS := [ARRAYSY,RECORDSY,SETSY,FILESY];
    TYPEBEGSYS := [ARROW,PACKEDSY,procsy] + TYPEDELS + SIMPTYPEBEGSYS;
    BLOCKBEGSYS := [LABELSY,CONSTSY,TYPESY,VARSY,
	PROCSY,FUNCSY,BEGINSY,modulesy,importsy,
	forwardsy,externlsy];
    modulebegsys := blockbegsys + [importsy,exportsy,implmtsy];
    SELECTSYS := [ARROW,PERIOD,LBRACK];
    FACBEGSYS := [INTCONST,REALCONST,STRINGCONST,IDENT,LPARENT,LBRACK,NOTSY];
    STATBEGSYS := [BEGINSY,GOTOSY,IFSY,WHILESY,REPEATSY,FORSY,WITHSY,CASESY,
		   trysy];
    END (*INITSETS*) ;

  procedure initpowertable;
    var i: integer;
    begin
    power_table[0] := 1;
    for i := 1 to bitsperword-2 do
      power_table[i] := power_table[i-1]*2;
    end;

  BEGIN (*INIT*)

  initdate;
  userinfo^.gotcode := false;

  setstrlen(timestring,0);
  i := 1;
  if globaltime.hour < 10 then
    strwrite(timestring,i,i,'0');
  strwrite(timestring,i,i,globaltime.hour:1,':');
  if globaltime.minute < 10 then
    strwrite(timestring,i,i,'0');
  strwrite(timestring,i,i,globaltime.minute:1,':');
  seconds := globaltime.centisecond div 100;
  if seconds < 10 then
    strwrite(timestring,i,i,'0');
  strwrite(timestring,i,i,seconds:1);
  WRITELN(OUTPUT,compilername,
    ' [Rev ',crevno,' ',crevid.month:2,'/',crevid.day:2,
    '/',crevid.year:2,']',todaysdate:12,' ',timestring);
  writeln(output);
  writeln(output,copyright1);
  writeln(output,'':14,copyright2);
  writeln(output);
  compioinit; bodyanalyzerinit;
  INITSCALARS; INITSETS; initpowertable;
  LEVEL := 0; TOP := 0; linelevel := 0;
  levelatstart := 0; linlevatstart := 0;
  WITH DISPLAY[0] DO
    BEGIN OCCUR := BLOCKscope; FNAME := NIL;
    FFILE := NIL; FLABEL := NIL; fmodule := nil;
    available_module := nil;
    END;
  sysinfo := [predeclared];                {std attribute}
  ENTSTDTYPES;   ENTUNDECL;
  INSYMBOL; { must not access option flags
	      before this call to insymbol }
  ENTSTDNAMES;   ENTSPCPROCS;   ENTSTDPROCS;
  LEVEL := 1; TOP := 1;
  WITH DISPLAY[1] DO
    BEGIN OCCUR := BLOCKscope; FNAME := NIL;
    FFILE := NIL; FLABEL := NIL; fmodule := nil;
    available_module := nil;
    END;
  display_ok_to_import := 2;

  codegeninit;    { process $def or $ref before initializing code files }

  if maxsearchfiles = 0 then
    begin
    newbytes(searchlistptr,(122*searchdefault));
    maxsearchfiles := searchdefault;
    searchfilestop := 1;
    searchlistptr^[1] := syslibrary;
    end;

  if maxoverlays = 0 then
    begin
    newbytes(overlaylistptr,(16*overlaydefault));
    maxoverlays := overlaydefault;
    overlaytop := 0;
    end;

  beforefirsttoken := false;
  FOR I := 1 TO 8 DO WRITELN(OUTPUT);
  WRITE(OUTPUT,'<    0>');
  NEW(OUTERBLOCK,prox,DECLARED);
  WITH OUTERBLOCK^ DO
    BEGIN NEXT := NIL; paramlc := 0;
      newident(namep,'PROGRAM'); IDTYPE := NIL; KLASS := prox;
      PFDECKIND := DECLARED; PFLEV := 0; ismodulebody := false;
      FORWDECL := FALSE; extdecl := false; inscope := false;
      alias := false; othername := nil; info := [];
    END;
  sysinfo := [];           {std attributes for user names}
  END (*COMPINIT*) ;

@


55.1
log
@Automatic bump of revision number for PWS version 3.25A
@
text
@@


54.1
log
@Automatic bump of revision number for PWS version 3.24
@
text
@@


53.1
log
@Automatic bump of revision number for PWS version 3.24B
@
text
@@


52.1
log
@Automatic bump of revision number for PWS version 3.24A
@
text
@@


51.1
log
@Automatic bump of revision number for PWS version 3.24d
@
text
@@


50.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


49.1
log
@Automatic bump of revision number for PWS version 3.24b
@
text
@@


48.1
log
@Automatic bump of revision number for PWS version 3.24a
@
text
@@


47.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


46.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


45.1
log
@Automatic bump of revision number for PWS version 3.23C
@
text
@@


44.1
log
@Automatic bump of revision number for PWS version 3.23B
@
text
@@


43.1
log
@Automatic bump of revision number for PWS version 3.23aA
@
text
@@


42.1
log
@Automatic bump of revision number for PWS version 3.23e
@
text
@@


41.1
log
@Automatic bump of revision number for PWS version 3.23d
@
text
@@


40.2
log
@

         Set temp_put to false in initscalars.
@
text
@@


40.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@d562 1
@


39.1
log
@Automatic bump of revision number for PWS version 3.23b
@
text
@@


38.1
log
@Automatic bump of revision number for PWS version 3.23a
@
text
@@


37.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


36.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


35.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


34.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


33.1
log
@Automatic bump of revision number for PWS version 3.22D
@
text
@@


32.1
log
@Automatic bump of revision number for PWS version 3.22C
@
text
@@


31.1
log
@Automatic bump of revision number for PWS version 3.22B
@
text
@@


30.1
log
@Automatic bump of revision number for PWS version 3.22A
@
text
@@


29.1
log
@Automatic bump of revision number for PWS version 3.22b
@
text
@@


28.1
log
@Automatic bump of revision number for PWS version 3.3b
@
text
@@


27.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


26.3
log
@
Comment from auto synch of clock fix:
date: 88/03/02 17:19:29;  author: quist;  state: Exp;  lines added/del: 3/2
SYSDATE fixes, RDQ
@
text
@@


26.2
log
@
Comment from auto synch of clock fix:
date: 88/03/02 09:09:35;  author: bayes;  state: Exp;  lines added/del: 0/0
Automatic bump of revision number for PWS version 3.2Y
@
text
@d19 2
a20 1
      if (month in [1..12]) and (day>0) and (year<100) then
d28 1
a28 1
	todaysdate[8] := chr(year div 10 + ord('0'));
@


26.1
log
@Automatic bump of revision number for PWS version 3.3 Synch
@
text
@@


24.1
log
@Automatic bump of revision number for PWS version 3.2
@
text
@@


23.2
log
@Pws2unix automatic delta on Sun Aug 30 14:43:47 MDT 1987
@
text
@@


23.1
log
@Automatic bump of revision number for PWS version 3.2P
@
text
@d609 1
a609 1
  writeln(output,'':5,copyright1);
@


22.1
log
@Automatic bump of revision number for PWS version 3.2N
@
text
@@


21.1
log
@Automatic bump of revision number for PWS version 3.2M
@
text
@@


20.1
log
@Automatic bump of revision number for PWS version 3.2L
@
text
@@


19.1
log
@Automatic bump of revision number for PWS version 3.2K
@
text
@@


18.1
log
@Automatic bump of revision number for PWS version 3.2J
@
text
@@


17.1
log
@Automatic bump of revision number for PWS version 3.2I+
@
text
@@


16.1
log
@Automatic bump of revision number for PWS version 3.2I
@
text
@@


15.1
log
@Automatic bump of revision number for PWS version 3.2H
@
text
@@


14.1
log
@Automatic bump of revision number for PWS version 3.2G
@
text
@@


13.1
log
@Automatic bump of revision number for PWS version 3.2F
@
text
@@


12.1
log
@Automatic bump of revision number for PWS version 3.2E
@
text
@@


11.1
log
@Automatic bump of revision number for PWS version 3.2D
@
text
@@


10.1
log
@Automatic bump of revision number for PWS version 3.2C
@
text
@@


9.1
log
@Automatic bump of revision number for PWS version 3.2B
@
text
@@


8.1
log
@Automatic bump of revision number for PWS version 3.2A
@
text
@@


7.1
log
@Automatic bump of revision number for PWS version 3.2l
@
text
@@


6.1
log
@Automatic bump of revision number for PWS version 3.2k
@
text
@@


5.1
log
@Automatic bump of revision number for PWS version 3.2j
@
text
@@


4.1
log
@Automatic bump of revision number for PWS version 3.2i
@
text
@@


3.1
log
@Automatic bump of revision number for PWS version 3.2h
@
text
@@


2.1
log
@Auto bump rev number to 2.1 for sys 3.2e.
@
text
@@


1.1
log
@Initial revision
@
text
@@
