Topspeed_JPI/TS-V3/INCLUDE/LIB.LST

Listing:

    1  (* Release 3.10 *)
    2  (*-------------------------------------------------------------------------*
    3  *                                                                          *
    4  *  LIB.DEF - Modula-2 miscellaneous library functions                      *
    5  *                                                                          *
    6  *  COPYRIGHT (C) 1987..1992 Clarion Software Corporation.                  *
    7  *  All Rights Reserved                                                     *
    8  *                                                                          *
    9  *--------------------------------------------------------------------------*)
   10  (* OS/2 MSDOS Version *)
   11  (*# call(o_a_copy => off) *)
   12  (*%F _fdata *)
   13  (*# call(seg_name => null) *)
   14  (*# data(seg_name => null) *)
   15  (*%E *)
   16  (*# module(implementation=>off) *)
   17  DEFINITION MODULE Lib;
   18  
   19  IMPORT SYSTEM;
   20  
   21  (* The following function determines whether objects are hierarchically related *)
   22  TYPE
   23  (*# save *)
   24  (*%T _fdata *)
   25  (*# data(near_ptr => off) *)
   26  (*%E *)
   27  (*%F _fdata *)
   28  (*# data(near_ptr => on) *)
   29  (*%E *)
   30      MTablePtr = POINTER TO MHeader;
*****                             ^ undeclared identifier
   31  (*# restore *)
   32      MHeader = RECORD
   33          Size: CARDINAL;
   34          Parent: MTablePtr;
   35      END;
*****      ^ not supported yet
   36  
   37  PROCEDURE IsOfClass(Child, Parent: MTablePtr): BOOLEAN;
   38  
   39  VAR
   40    NilStr : ARRAY [0..0] OF CHAR;
*****                       ^ not supported yet
*****                             ^ not supported yet
   41    RunTimeError: PROCEDURE(LONGCARD, CARDINAL, ARRAY OF CHAR);
*****                  ^ not supported yet
*****                            ^ undeclared identifier
*****                                      ^ not supported yet
*****                                                         ^ not supported yet
   42  
   43  TYPE
   44    CompareProc = PROCEDURE(CARDINAL, CARDINAL) : BOOLEAN;
*****                  ^ not supported yet
*****                            ^ not supported yet
*****                                      ^ not supported yet
*****                                                  ^ not supported yet
   45    SwapProc    = PROCEDURE(CARDINAL, CARDINAL);
*****                  ^ not supported yet
*****                            ^ not supported yet
*****                                      ^ not supported yet
   46  
   47  PROCEDURE QSort(N: CARDINAL; Less: CompareProc; Swap: SwapProc);
   48  PROCEDURE HSort(N: CARDINAL; Less: CompareProc; Swap: SwapProc);
   49  
   50  PROCEDURE RANDOM(Range: CARDINAL) : CARDINAL;
   51  PROCEDURE RAND() : REAL;
   52  PROCEDURE SEED(v:CARDINAL);
   53  PROCEDURE RANDOMIZE;
   54  
   55  PROCEDURE Execute (Name        : ARRAY OF CHAR; (* full name of program *)
*****                                            ^ not supported yet
   56                     CommandLine : ARRAY OF CHAR; (* command line for program *)
*****                                            ^ not supported yet
   57                     StoreAddr   : FarADDRESS;    (* storage to execute in, MSDOS only *)
*****                                   ^ undeclared identifier
   58                     StoreLen    : CARDINAL       (* length of store paragraphs, MSDOS only *)
   59                    ) : CARDINAL ;                (* DOS reply (0=OK) *)
   60  
   61  PROCEDURE OSErrorMessage ( N : CARDINAL ; VAR S : ARRAY OF CHAR );
*****                                                             ^ not supported yet
   62  PROCEDURE OSFatalError   ( S : ARRAY OF CHAR ; N : CARDINAL ) ;
*****                                          ^ not supported yet
   63  
   64  PROCEDURE Speaker(FreqHz,TimeMs: CARDINAL);
   65  
   66  TYPE
   67    ExecEnvType = ARRAY [0..31] OF ADDRESS;
*****                            ^ not supported yet
*****                                   ^ undeclared identifier
   68    ExecEnvPtr = POINTER TO ExecEnvType;
*****                            ^ not supported yet
   69  VAR
   70    ExecSearchPath: BOOLEAN;
   71  
   72  TYPE
   73  (*# save *)
   74  (*# data(near_ptr => off) *)
   75    CommandType = POINTER TO ARRAY[0..126] OF CHAR;
*****                                      ^ not supported yet
*****                                              ^ not supported yet
   76  (*# restore *)
   77  
   78  PROCEDURE Environment(N: CARDINAL) : CommandType;
   79  PROCEDURE EnvironmentFind(name: ARRAY OF CHAR;
*****                                           ^ not supported yet
   80                            VAR result: ARRAY OF CHAR );
*****                                                 ^ not supported yet
   81  PROCEDURE ParamStr(VAR S: ARRAY OF CHAR; N: CARDINAL);
*****                                     ^ not supported yet
   82  PROCEDURE ParamCount() : CARDINAL;
   83  
   84  PROCEDURE Exec ( command : ARRAY OF CHAR ; Params: ARRAY OF CHAR; Env: ExecEnvPtr): CARDINAL;
*****                                      ^ not supported yet
*****                                                              ^ not supported yet
   85  PROCEDURE ExecCmd ( command : ARRAY OF CHAR ): CARDINAL;
*****                                         ^ not supported yet
   86  
   87  PROCEDURE WrDosError ( ErrorNo : SHORTCARD ) ;
   88  PROCEDURE SysErrno(): CARDINAL;
   89  
   90  TYPE
   91    DayType = (Sunday,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday) ;
   92  
   93  PROCEDURE GetDate ( VAR Year,Month,Day : CARDINAL ;
   94                      VAR DayOfWeek : DayType ) ;
   95  PROCEDURE GetTime ( VAR Hrs,Mins,Secs,Hsecs : CARDINAL ) ;
   96  PROCEDURE SetDate ( Year,Month,Day : CARDINAL): BOOLEAN ;
   97  PROCEDURE SetTime ( Hrs,Mins,Secs,Hsecs : CARDINAL ): BOOLEAN ;
   98  
   99  PROCEDURE MakeAllPath(VAR Path: ARRAY OF CHAR; Drive, Dir, Name, Ext: ARRAY OF CHAR);
*****                                           ^ not supported yet
*****                                                                                 ^ not supported yet
  100  PROCEDURE SplitAllPath(Path: ARRAY OF CHAR; VAR Drive: ARRAY OF CHAR;
*****                                        ^ not supported yet
*****                                                                  ^ not supported yet
  101                      VAR Dir: ARRAY OF CHAR; VAR Name: ARRAY OF CHAR; VAR Ext: ARRAY OF CHAR);
*****                                        ^ not supported yet
*****                                                                 ^ not supported yet
*****                                                                                         ^ not supported yet
  102  
  103  (*# save *)
  104  (*%T _DLL *)
  105  (*# call(seg_name=>LibDLL) *)
  106  (*%E *)
  107  PROCEDURE AddFarAddr(A: FarADDRESS; increment: CARDINAL) : FarADDRESS;
*****                          ^ undeclared identifier
*****                                                             ^ undeclared identifier
  108  PROCEDURE SubFarAddr(A: FarADDRESS; decrement: CARDINAL) : FarADDRESS;
*****                          ^ undeclared identifier
*****                                                             ^ undeclared identifier
  109  PROCEDURE IncFarAddr(VAR A: FarADDRESS; increment: CARDINAL);
*****                              ^ undeclared identifier
  110  PROCEDURE DecFarAddr(VAR A: FarADDRESS; decrement: CARDINAL);
*****                              ^ undeclared identifier
  111  (*# restore *)
  112  
  113    TYPE
  114      A2                  = ARRAY[0..1] OF BYTE;
*****                                     ^ not supported yet
*****                                           ^ undeclared identifier
  115      A3                  = ARRAY[0..2] OF BYTE;
*****                                     ^ not supported yet
*****                                           ^ undeclared identifier
  116      A4                  = ARRAY[0..3] OF BYTE;
*****                                     ^ not supported yet
*****                                           ^ undeclared identifier
  117      _C8                 = ARRAY[0..7] OF BYTE;
*****                                     ^ not supported yet
*****                                           ^ undeclared identifier
  118  
  119  (*%T _fptr *)
  120  CONST
  121      AddAddr = AddFarAddr;
*****                ^ not supported yet
  122      SubAddr = SubFarAddr;
*****                ^ not supported yet
  123      IncAddr = IncFarAddr;
*****                ^ not supported yet
  124      DecAddr = DecFarAddr;
*****                ^ not supported yet
  125  (*%E *)
  126  
  127  (*# save,call(reg_saved=>(dx,si,di,ds,st1,st2))*)
  128    INLINE PROCEDURE QueryDosVersion():CARDINAL = _C8(0B8H,000H,030H,0CDH,021H,086H,0C4H,SYSTEM.Ret);
  129      (* Returns the DOS version number as a BCD number.  This makes       *)
  130      (* numerical comparisons easy.  Example:                             *)
  131      (*                                                                   *)
  132      (*  IF Lib.QueryDosVersion() >= 300H THEN                            *)
  133      (*                                                                   *)
  134      (* would test whether the program is running under a version of DOS  *)
  135      (* at or above 3.00.                                                 *)
  136  (*# restore *)
  137  
  138  (*# save, call( reg_param=>(ax,bx),
  139                  reg_saved=>(cx,dx,si,di,es,ds,st1,st2), inline=>on ) *)
  140  INLINE PROCEDURE AddNearAddr(A: NearADDRESS; increment: CARDINAL) : NearADDRESS=A3(03H, 0C3H, SYSTEM.Ret);
  141  
  142  (*# call( reg_param=>(ax,bx),
  143            reg_saved=>(cx,dx,si,di,es,ds,st1,st2), inline=>on ) *)
  144  INLINE PROCEDURE SubNearAddr(A: NearADDRESS; decrement: CARDINAL) : NearADDRESS=A3(2BH, 0C3H, SYSTEM.Ret);
  145  
  146  (*%T _fptr *)
  147  (*# call( reg_param=>(bx,es,ax),
  148            reg_saved=>(cx,dx,si,di,ds,st1,st2), inline=>on ) *)
  149  INLINE PROCEDURE IncNearAddr(VAR A: NearADDRESS; increment: CARDINAL)=A4(26H,01H, 07H, SYSTEM.Ret);
  150  
  151  (*# call( reg_param=>(bx,es,ax),
  152            reg_saved=>(cx,dx,si,di,ds,st1,st2), inline=>on ) *)
  153  INLINE PROCEDURE DecNearAddr(VAR A: NearADDRESS; decrement: CARDINAL)=A4(26H,29H, 07H, SYSTEM.Ret);
  154  (*%E *)
  155  
  156  (*%F _fptr *)
  157  (*# call( reg_param=>(bx,ax),
  158            reg_saved=>(cx,dx,si,di,ds,es,st1,st2), inline=>on ) *)
  159  INLINE PROCEDURE IncNearAddr(VAR A: NearADDRESS; increment: CARDINAL)=A3(01H, 07H, SYSTEM.Ret);
  160  
  161  (*# call( reg_param=>(bx,ax),
  162            reg_saved=>(cx,dx,si,di,ds,es,st1,st2), inline=>on ) *)
  163  INLINE PROCEDURE DecNearAddr(VAR A: NearADDRESS; decrement: CARDINAL)=A3(29H, 07H, SYSTEM.Ret);
  164  (*%E *)
  165  (*# restore *)
  166  
  167  (*%F _fptr *)
  168  (*# save,
  169      call( reg_param=>(ax,bx),
  170            reg_saved=>(cx,dx,si,di,es,ds,st1,st2), inline=>on )
  171  *)
  172  INLINE PROCEDURE AddAddr(A: ADDRESS; increment: CARDINAL) : ADDRESS=A3(03H, 0C3H, SYSTEM.Ret);
  173  
  174  (*# call( reg_param=>(ax,bx),
  175            reg_saved=>(cx,dx,si,di,es,ds,st1,st2), inline=>on ) *)
  176  INLINE PROCEDURE SubAddr(A: ADDRESS; decrement: CARDINAL) : ADDRESS=A3(2BH, 0C3H, SYSTEM.Ret);
  177  
  178  (*# call( reg_param=>(bx,ax),
  179            reg_saved=>(cx,dx,si,di,ds,es,st1,st2), inline=>on ) *)
  180  INLINE PROCEDURE IncAddr(VAR A: ADDRESS; increment: CARDINAL)=A3(01H, 07H, SYSTEM.Ret);
  181  
  182  (*# call( reg_param=>(bx,ax),
  183            reg_saved=>(cx,dx,si,di,ds,es,st1,st2), inline=>on ) *)
  184  INLINE PROCEDURE DecAddr(VAR A: ADDRESS; decrement: CARDINAL)=A3(29H, 07H, SYSTEM.Ret);
  185  (*# restore *)
  186  (*%E *)
  187  
  188  (*# save *)
  189  (*%T _fdata *)
  190  (*# call(seg_name=>SIG) *)
  191  (*%E *)
  192  PROCEDURE SetInProgramFlag(State: BOOLEAN);
  193  PROCEDURE GetInProgramFlag(): BOOLEAN;
  194  PROCEDURE EnableBreakCheck;
  195  PROCEDURE DisableBreakCheck;
  196  PROCEDURE Dos(VAR R: SYSTEM.Registers); (* INT 21H Function Call *)
  197  (*# restore *)
  198  
  199  PROCEDURE GetVector(Int:SHORTCARD):FarADDRESS;
  200    (* Returns the 32 bit address of the requested interrupt handler       *)
  201  
  202  PROCEDURE SetVector(Int:SHORTCARD;Vector:FarADDRESS);
  203    (* Sets the interrupt handler for the requested interrupt vector       *)
  204  
  205  PROCEDURE FatalError(S: ARRAY OF CHAR);
  206  
  207  (*# save *)
  208  (*%T _DLL *)
  209  (*# call(seg_name=>LibDLL) *)
  210  (*%E *)
  211  (*%F _fdata *)
  212  PROCEDURE NearMove    (Source,Dest:NearADDRESS;Count:CARDINAL);
  213  PROCEDURE NearFastMove(Source,Dest:NearADDRESS;Count:CARDINAL);
  214  PROCEDURE NearWordMove(Source,Dest:NearADDRESS;WordCount:CARDINAL);
  215  (*%E *)
  216  PROCEDURE Move    (Source,Dest:ADDRESS;Count:CARDINAL);
  217  PROCEDURE FastMove(Source,Dest:ADDRESS;Count:CARDINAL);
  218  PROCEDURE WordMove(Source,Dest:ADDRESS;WordCount:CARDINAL);
  219  
  220  PROCEDURE FarMove (Source,Dest:FarADDRESS;Count:CARDINAL);
  221  PROCEDURE FarFastMove(Source,Dest:FarADDRESS;Count:CARDINAL);
  222  PROCEDURE FarWordMove(Source,Dest:FarADDRESS;WordCount:CARDINAL);
  223  
  224  PROCEDURE Fill(Dest: ADDRESS; Count: CARDINAL; Value: BYTE);
  225  PROCEDURE FarFill(Dest: FarADDRESS; Count: CARDINAL; Value: BYTE);
  226  
  227  PROCEDURE WordFill(Dest: ADDRESS; WordCount: CARDINAL; Value: WORD);
  228  PROCEDURE FarWordFill(Dest: FarADDRESS; WordCount: CARDINAL; Value: WORD);
  229  
  230  PROCEDURE ScanR  (Dest: ADDRESS; Count: CARDINAL; Value: BYTE) : CARDINAL;
  231  PROCEDURE ScanL  (Dest: ADDRESS; Count: CARDINAL; Value: BYTE) : CARDINAL;
  232  PROCEDURE ScanNeR(Dest: ADDRESS; Count: CARDINAL; Value: BYTE) : CARDINAL;
  233  PROCEDURE ScanNeL(Dest: ADDRESS; Count: CARDINAL; Value: BYTE) : CARDINAL;
  234  
  235  PROCEDURE HashString(S: ARRAY OF CHAR; Range: CARDINAL) : CARDINAL;
  236  PROCEDURE Compare(Source,Dest: ADDRESS; Len: CARDINAL) : CARDINAL;
  237  
  238  PROCEDURE Terminate(P: PROC; VAR C: PROC);
  239  PROCEDURE SetReturnCode(code: SHORTCARD);
  240  
  241  
  242  TYPE
  243    CpuKind = (cpu_Unknown,cpu_V20,cpu_V30,cpu_8088,cpu_8086,
  244               cpu_80188,cpu_80186,
  245               cpu_80286,cpu_80386);
  246  
  247    FpuKind = (fpu_none,fpu_8087,fpu_80287,fpu_80387);
  248  
  249    CpuRec = RECORD
  250                cpu : CpuKind;
  251                fpu : FpuKind;
  252             END;
  253  
  254  PROCEDURE CpuId ( VAR r : CpuRec );
  255  
  256  (* MSDOS Only *)
  257  VAR
  258    PSP         : CARDINAL;
  259    CommandLine : CommandType;
  260    BreakChecks : BOOLEAN;
  261  
  262  PROCEDURE UserBreak;
  263  PROCEDURE Sound(FreqHz: CARDINAL);
  264  PROCEDURE NoSound;
  265  PROCEDURE Intr(VAR R: SYSTEM.Registers; I: CARDINAL);
  266  PROCEDURE Delay(Time: CARDINAL);
  267  
  268  TYPE
  269      TENBYTEREAL = ARRAY [0..9] OF BYTE;
  270      LongLabelRec = RECORD
  271          j_sp, j_ss, j_flag, j_cs, j_ip, j_bp, j_di, j_es, j_si, j_ds: CARDINAL;
  272          st1, st2: TENBYTEREAL;
  273      END;
  274      LongLabel = ARRAY [0..0] OF LongLabelRec;
  275  
  276  (*# save *)
  277  (*# call(reg_saved=>(ds,es,si,di,st1,st2), set_jmp=>on) *)
  278  PROCEDURE SetJmp (VAR Lbl: LongLabel) : CARDINAL;
  279  (*# restore *)
  280  
  281  (*# save *)
  282  (*# call(reg_saved=>(ax,bx,cx,dx,ds,es,si,di,st0,st1,st2,st3,st4,st5,st6)) *)
  283  PROCEDURE LongJmp(VAR Lbl: LongLabel; result: CARDINAL);
  284  (*# restore *)
  285  
  286  (* Protected mode features *)
  287  PROCEDURE AddressOK      ( A : ADDRESS ) : BOOLEAN;
  288  PROCEDURE SelectorLimit  ( S : CARDINAL ) : CARDINAL;
  289  PROCEDURE ProtectedMode  () : BOOLEAN;
  290  (*# restore *)
  291  END Lib.

   56 errors