Topspeed_JPI/TS-V3/MODBASE/BYTEFIDD.LST

Listing:

    1  IMPLEMENTATION MODULE ByteFiddler;
    2  (*
    3   *  REPERTOIRE
    4   *  Release 1.6
    5   *  By Charles Bradford and Cole Brecheen
    6   *  (c) Copyright 1985-1992 PMI
    7   *  Green Bay, Wisconsin
    8   *  All rights reserved
    9   *  (414) 468-6040
   10   *
   11   *  $Header:   D:/logfiles/mods/bytefidd.mov   1.5   10 Mar 1991 15:25:24   coleb  $
   12   *
   13   *)
   14  
   15  
   16  IMPORT ErrorManager;
   17  IMPORT LowLevel;
   18  IMPORT SYSTEM;
   19  
   20  
   21  VAR
   22    Initialized : BOOLEAN;
   23  
   24    PROCEDURE Init();
   25      BEGIN
   26        IF Initialized THEN
   27          RETURN;
   28        ELSE
   29          Initialized := TRUE;
   30        END;
   31        ErrorManager.Init();
*****        ^ not supported yet
*****                     ^ not supported yet
*****                          ^ not supported yet
   32        LowLevel.Init();
*****        ^ not supported yet
*****                 ^ not supported yet
*****                      ^ not supported yet
   33      END Init;
*****          ^ not supported yet
   34  
   35    TYPE
   36      BitRange = [0..15];
   37      WordConverter =
   38        RECORD
   39          CASE : BOOLEAN OF
*****          ^ not supported yet
*****                         ^ 'POINTER' expected
   40            TRUE :
   41            x : SYSTEM.WORD;
   42          | FALSE :
   43            lo, hi : CHAR;
   44          END;
   45        END;
   46  
   47      LongConverter =
   48        RECORD
   49          CASE : BOOLEAN OF
   50            TRUE: long: LONGINT;
   51          | FALSE: locard, hicard: CARDINAL;
   52          END;
   53        END;
   54  
   55  
   56    PROCEDURE BitRangeToInt(TheSet : BITSET; LowBit, HighBit : CARDINAL;
   57      VAR answer : CARDINAL);
   58        (*BitRangeToInt lets us specify the bits that store the
   59        value in which we're interested, and it loads that value
   60        into the last parameter in the list.*)
   61      BEGIN
   62        LowLevel.ShiftLeft(TheSet, 15-HighBit);
   63      (*Assumes bit 15 is most significant.*)
   64        LowLevel.ShiftRight(TheSet, LowBit+(15-HighBit));
   65        answer := CARDINAL(TheSet);
   66      END BitRangeToInt;
   67  
   68  
   69    PROCEDURE BytesToWord(lobyte, hibyte : CARDINAL) : CARDINAL;
   70      (*Takes two bytes and stores them in a single word. The
   71      last byte in the parameter list is most significant.*)
   72      VAR
   73        conv : WordConverter;
   74      BEGIN
   75        conv.lo := CHR(lobyte);
   76        conv.hi := CHR(hibyte);
   77        RETURN (CARDINAL(conv.x));
   78      END BytesToWord;
   79  
   80  
   81    PROCEDURE CardinalToDate(TheInt : CARDINAL; VAR month, day, year :
   82        CARDINAL);
   83      VAR
   84        TheSet : BITSET;
   85      BEGIN
   86        (*CardinalToDate*)
   87        TheSet := BITSET(TheInt);
   88  (*
   89  Diagnostics.diagB( 'TheDate', TheSet );
   90  *)
   91        BitRangeToInt(TheSet, 0, 4, day);
   92        BitRangeToInt(TheSet, 5, 8, month);
   93        BitRangeToInt(TheSet, 9, 15, year);
   94        INC(year, 80);
   95      END CardinalToDate;
   96  
   97  
   98    PROCEDURE CardinalToTime(TheCardinal : CARDINAL; VAR hours,
   99        minutes, seconds : CARDINAL);
  100      VAR
  101        TheSet : BITSET;
  102      BEGIN
  103        (*CardinalToTime*)
  104        TheSet := BITSET(TheCardinal);
  105  (*
  106  Diagnostics.diagB( 'TheTime', TheSet );
  107  *)
  108        BitRangeToInt(TheSet, 11, 15, hours);
  109        BitRangeToInt(TheSet, 5, 10, minutes);
  110        BitRangeToInt(TheSet, 0, 4, seconds);
  111        seconds := seconds*2;
  112          (*We double seconds because the operating system stores
  113          this value in two-second increments.*)
  114      END CardinalToTime;
  115  
  116  
  117    PROCEDURE DateToCardinal(month, day, year : CARDINAL) : CARDINAL;
  118      CONST
  119        msg = 'Invalid date';
  120      VAR
  121        BitSet1, BitSet2 : BITSET;
  122        buf : BitRange;
  123      BEGIN
  124        (*DateToCardinal*)
  125        IF year>1900 THEN
  126          year := year-1900;
  127        END;
  128        IF ((year>=80) AND (year<=199)) THEN
  129          year := year-80;
  130        ELSE
  131  (*
  132  Diagnostics.diagC( 'year', year );
  133  *)
  134          ErrorManager.WARN(msg);
  135        END;
  136        IF ((month<1) OR (month>12)) THEN
  137  (*
  138  Diagnostics.diagC( 'month', month );
  139  *)
  140          ErrorManager.WARN(msg);
  141        END;
  142        IF ((day<1) OR (day>31)) THEN
  143  (*
  144  Diagnostics.diagC( 'day', day );
  145  *)
  146          ErrorManager.WARN(msg);
  147        END;
  148        BitSet2 := BITSET(0);
  149        BitSet1 := BITSET(day);
  150        FOR buf := 0 TO 15 DO
  151          IF buf IN BitSet1 THEN
  152            INCL(BitSet2, buf);
  153          END;
  154        END;
  155        BitSet1 := BITSET(month);
  156        FOR buf := 0 TO 15 DO
  157          IF buf IN BitSet1 THEN
  158            INCL(BitSet2, buf+5);
  159          END;
  160        END;
  161        BitSet1 := BITSET(year);
  162        FOR buf := 0 TO 15 DO
  163          IF buf IN BitSet1 THEN
  164            INCL(BitSet2, buf+9);
  165          END;
  166        END;
  167        RETURN CARDINAL(BitSet2);
  168      END DateToCardinal;
  169  
  170  
  171    PROCEDURE HighByte( TheCard: CARDINAL ): CHAR;
  172      VAR
  173        tmp: WordConverter;
  174      BEGIN
  175        tmp.x := SYSTEM.WORD(TheCard);
  176        RETURN tmp.hi;
  177      END HighByte;
  178  
  179    PROCEDURE HighCard( TheLong: LONGINT ): CARDINAL;
  180      VAR
  181        tmp: LongConverter;
  182      BEGIN
  183        tmp.long := TheLong;
  184        RETURN tmp.hicard;
  185      END HighCard;
  186  
  187  
  188    PROCEDURE LowByte( TheCard: CARDINAL ): CHAR;
  189      VAR
  190        tmp: WordConverter;
  191      BEGIN
  192        tmp.x := SYSTEM.WORD(TheCard);
  193        RETURN tmp.lo;
  194      END LowByte;
  195  
  196    PROCEDURE LowCard( TheLong: LONGINT ): CARDINAL;
  197      VAR
  198        tmp: LongConverter;
  199      BEGIN
  200        tmp.long := TheLong;
  201        RETURN tmp.locard;
  202      END LowCard;
  203  
  204  
  205    PROCEDURE PeekChar( TheAdr: SYSTEM.ADDRESS ): CHAR;
  206      VAR
  207        tmp: LowLevel.Address8086;
  208      BEGIN
  209        tmp.a := TheAdr;
  210        RETURN tmp.b^;
  211      END PeekChar;
  212  
  213  
  214    PROCEDURE PokeChar( TheChar: CHAR; TheAdr: SYSTEM.ADDRESS );
  215      VAR
  216        tmp: LowLevel.Address8086;
  217      BEGIN
  218        tmp.a := TheAdr;
  219        tmp.b^ := TheChar;
  220      END PokeChar;
  221  
  222  
  223    PROCEDURE Size( VAR AnyObject: ARRAY OF SYSTEM.BYTE ): CARDINAL;
  224      BEGIN
  225        RETURN HIGH(AnyObject) + 1;
  226      END Size;
  227  
  228  
  229    PROCEDURE swap(VAR TheWord : SYSTEM.WORD);
  230  (*Reverses the order of the high and low bytes in TheWord.*)
  231      VAR
  232        conv : WordConverter;
  233        tmp : CHAR;
  234      BEGIN
  235        conv.x := TheWord;
  236        tmp := conv.hi;
  237        conv.hi := conv.lo;
  238        conv.lo := tmp;
  239        TheWord := conv.x;
  240      END swap;
  241  
  242  
  243    PROCEDURE TimeToCardinal(hours, minutes, seconds : CARDINAL) : CARDINAL;
  244      CONST
  245        msg = 'Invalid time';
  246      VAR
  247        BitSet1, BitSet2 : BITSET;
  248        buf : BitRange;
  249      BEGIN
  250        (*TimeToCardinal*)
  251        IF (hours>23) THEN
  252  (*
  253  Diagnostics.diagC( 'hours', hours );
  254  *)
  255          ErrorManager.WARN(msg);
  256        END;
  257        IF (minutes>59) THEN
  258  (*
  259  Diagnostics.diagC( 'minutes', minutes );
  260  *)
  261          ErrorManager.WARN(msg);
  262        END;
  263        IF (seconds>59) THEN
  264  (*
  265  Diagnostics.diagC( 'seconds', seconds );
  266  *)
  267          ErrorManager.WARN(msg);
  268        END;
  269        BitSet2 := BITSET(0);
  270        BitSet1 := BITSET(seconds DIV 2);
  271        FOR buf := 0 TO 15 DO
  272          IF buf IN BitSet1 THEN
  273            INCL(BitSet2, buf);
  274          END;
  275        END;
  276        BitSet1 := BITSET(minutes);
  277        FOR buf := 0 TO 15 DO
  278          IF buf IN BitSet1 THEN
  279            INCL(BitSet2, buf+5);
  280          END;
  281        END;
  282        BitSet1 := BITSET(hours);
  283        FOR buf := 0 TO 15 DO
  284          IF buf IN BitSet1 THEN
  285            INCL(BitSet2, buf+11);
  286          END;
  287        END;
  288        RETURN CARDINAL(BitSet2);
  289      END TimeToCardinal;
  290  
  291  BEGIN
  292    Initialized := FALSE;
  293    Init();
  294  END ByteFiddler.

    9 errors