require "[][]" delimiters;
define CrLf = [('15&'12)];
define CR = [(null&'15)];
define LF = [(null&'12)];
define TAB = [(null & '11)];
define FF = [(null & '14)];
define Bell = [(null & '7)];
define BackSpace = [(null & '10)];
define ! = [comment];

define xwd(L,R) = [  ! for making up halfwords into full word;
      (((L) lsh 18) lor ((R) land '777777))];
define lh(X) = [ ((X) lsh -18) ];
define rh(X) = [ ((X) land '777777)];

! external names used by loader are restricted to 6 characters. Thus
  if we wish to have a name longer than 6 characters we may have to
  define a shorter (6 or less character) name. We use
  the following LoaderAlias macro to define the short name;

define LoaderAlias(LongName, ShortName) =
  [ assignc ShortName = ScanC(cvps(ShortName),""," ","I");
    define LongName = [ShortName]
   ];

! at point of definition of LoaderAlias name the following
  macro may be used as a comment. It will cause an error 
  message if the names given here are inconsistent with the original
  LoaderAlias;

define LoaderAliasIs(LongName,ShortName) =
  [ assignc ShortName = ScanC(cvps(ShortName),""," ","I");
    ifcr (declaration(LongName) land check!type(define)) neq
         check!type(define) thenc
       require CrLf&"Missing LoaderAlias definition for "&
               cvps(LongName) message;
    elsec ifcr not Equ(cvms(LongName),cvps(ShortName)) thenc
             require CrLf&"LoaderAlias inconsistency for "&
                     cvps(LongName) message;
          endc
    endc
  ];
! special stuff if this is a library entry;
ifcr declaration(library!entry) = 0 thenc
   define library!entry = [false];
endc
! Library routines from LIBRAR.REL or HLIBRA.REL
    LIBRAR.REL made by compiling:
          TYPERE.SAI
          READCA.SAI
          NEWLIN.SAI
          INTEOF.SAI
          REALEO.SAI
          STREOF.SAI
          STRIN.SAI
          TINIT.SAI
          IOPKG.SAI
          DEFAU.SAI
          SPLIT.SAI
          FILEEX.SAI
          DATES.SAI
          FILSCN.SAI
          EOFTRU.FAI
          LOWERC.SAI
          UPPERC.SAI
          TRIM.SAI
          RELALL.SAI
          CEIL.SAI
          GETPPN.SAI
    then using FUDGE2 to make the library.
    The object files in library should be in same order as
    corresponding source files above;

define ReadCompilerSwitch (SwitchChar, SwitchVal) =
  [ require "<><>" delimiters;
    assignc SwitchChar = cvps(SwitchChar) land '137;
    ifcr (SwitchChar leq "@") or (SwitchChar geq "Z") thenc
       require "Invalid argument To ReadCompilerSwitch-"
                 &SwitchChar message;
       # #
    endc

    redefine !!Mac!Aux = cvms(compiler!banner);
    ifcr cvms(!!Mac!Aux)[inf for 1] neq """" thenc
       require CrLf&"String constant following first BEGIN is too long."
               &CrLf&"Potential problems in Std.Hdr" &CrLf Message;
    endc
    redefine SwitchVal = <>;
    redefine !!Mac!Cnt = 1;
    redefine !!Switch!Str = ScanC(cvms(!!Mac!Aux),SwitchChar,Null,
                                      "INS");
    ifcr length(cvms(!!Mac!Aux)) = length(cvms(!!Switch!Str)) thenc
         require CrLf&"Invalid argument to ReadCompilerSwitch "&
            SwitchChar&CrLf message;
         # #
    endc
    whilec < !!Mac!Cnt neq 0 > doc
      <
         redefine !!Mac!Aux = cvms(!!Mac!Aux)[
                       length(cvms(!!Switch!Str))+2 to inf];
         redefine !!Next!Str = ScanC(cvms(!!Mac!Aux),SwitchChar,null,
                                     "INS");
         ifcr length(cvms(!!Next!Str)) neq length(cvms(!!Mac!Aux)) thenc
            redefine !!Switch!Str = cvms(!!Next!Str);
         elsec
            redefine !!Mac!Cnt = length(cvms(!!Switch!Str));
            whilec <!!Mac!Cnt neq 0 > doc
               < redefine SwitchVal = cvms(!!Switch!Str)
                                         [!!Mac!Cnt for 1] &
                                      cvms(SwitchVal);
                 ifcr cvms(!!Switch!Str)[!!Mac!Cnt-1 for 1] leq '52 thenc
                     redefine !!Mac!Cnt = 0;
                     redefine !!Next!Str = <>;
                     redefine !!Mac!Aux = <>;
                     redefine !!Switch!Str = <>;
                 elsec
                     redefine !!Mac!Cnt = !!Mac!Cnt - 1;
                 endc
               > endc
         endc
      > endc
   
     require unstack!delimiters;
  ];
external simple integer procedure openin(string fname;
    reference boolean eof; integer mode(0));

external simple integer procedure openout(string fname;
    integer mode(0));

external simple boolean procedure file!exists(string fname);
external simple boolean procedure filescan(string fname;
    reference string dev,name,ext,ppn;boolean wild (false));

external simple string procedure trim(string arg);

external simple string procedure uppercase(string arg);
external simple string procedure lowercase(string arg);
external simple integer procedure ceil( real x);
external simple integer procedure floor (real x);

ifcr not library!entry then
   readcompilerswitch(h,!!MM!!!!); ! reentrant compilation?;
   ifcr !!MM!!!! thenc
      require "CS:hlibrary.rel" library;
   elsec
      require "CS:library.rel" library;
   endc
endc

! close all files on exit from main block;
external simple procedure r!e!l!a!l!l;

ifcr not library!entry then
   cleanup r!e!l!a!l!l;
endc

! John Shopiro's SWITCH.INI reader and switch processor;
external simple boolean procedure default!switches
    (reference string switch!text; string prog!name,
     option!name (null));

external procedure split!switches
    (string switch!text; reference string array switch!names,
     switch!values);
! a call to the GETPPN UUO to return the PPN of the running job;
external string procedure GetPPN;
! pseudo - ALGOL-W like I/O;
define writeon = [print];
define cwriteon = [cprint];
define write(a,b,c,d,e,f,g,h,i,j) = 
  [
  begin
    print(CrLf);
    forlc x = (a,b,c,d,e,f,g,h,i,j) doc
      [ ifcr length(cvps(x)) neq 0 thenc
          print(x);
        endc
      ]
     endc
  end
  ];

define cwrite(chan,a,b,c,d,e,f,g,h,i,j) =
  [ begin
       cprint(chan,CrLf);
       forlc x = (a,b,c,d,e,f,g,h,i,j) doc
         [ ifcr length(cvps(x)) neq 0 thenc
             cprint(chan,x);
           endc
         ]
        endc
    end
  ];

define readon(a,b,c,d,e,f,g,h,i,j) =
  [
   begin
      ifcr !R!E!A!D = 0 thenc
         redefine !r!e!a!d = 1;
         require !T!I!N!I!T initialization;
      endc

      forlc x = (a,b,c,d,e,f,g,h,i,j) doc
         [ ifcr length(cvps(x)) neq 0 thenc
              !C!R!E!A!D!O!N (!T!T!Y,X);
           endc
         ]
        endc
   end
  ];

define creadon(chan,a,b,c,d,e,f,g,h,i,j) =
  [
   begin
      forlc x = (a,b,c,d,e,f,g,h,i,j) doc
         [ ifcr length(cvps(x)) neq 0 thenc
              !C!R!E!A!D!O!N (chan,X);
           endc
         ]
        endc
   end
  ];
define read(a,b,c,d,e,f,g,h,i,j) = [
   begin
      ifcr !R!E!A!D = 0 thenc
         redefine !r!e!a!d = 1;
         require !t!i!n!i!t initialization;
      endc

      newline(!t!t!y);
      forlc x = (a,b,c,d,e,f,g,h,i,j) doc
        [ ifcr length(cvps(x)) neq 0 thenc
             !c!r!e!a!d!o!n(!t!t!y,x);
          endc
        ]
       endc
   end
 ];
define cread(chan,a,b,c,d,e,f,g,h,i,j) =
  [
   begin
      newline(chan);
      require "[][]" delimiters;
      forlc !x = (a,b,c,d,e,f,g,h,i,j) doc
         [ ifcr length(cvps(!x)) neq 0 thenc
              !C!R!E!A!D!O!N (chan,!x);
           endc
         ]
        endc
      require unstack!delimiters;
   end
  ];

define !c!r!e!a!d!o!n(chan,x) =
 [
   ifcr (expr!type(x) land check!type(integer)) thenc
      x ← inteof(chan);
   elsec ifcr (expr!type(x) land check!type(real)) thenc
      x ← realeof(chan);
   elsec ifcr (expr!type(x) land check!type(string)) thenc
      x ← streof(chan);
   elsec
      require cvps(x)&" has improper data type for READ. "&CrLf message;
   endc endc endc
 ];
external procedure newline(integer chan);
external integer procedure inteof(integer chan);
external real procedure realeof(integer chan);
external string procedure streof(integer chan);
external integer !t!t!y;
external integer !t!e!o!f;
external simple procedure !t!i!n!i!t;
define !R!E!A!D = 0;

! Jon Shopiro's Record Typing routines;
! Source is in TYPERE.SAI[170,161];
external simple integer procedure TypeRec
       ( record!pointer ( any!class ) thisRec );

define RecordIs ( thisRec, classId ) = [( TypeRec ( thisRec ) = classId )];