General Category > Programming

A little Pascal programming…

<< < (2/2)

AMSDOS:

--- Quote from: the graveborn on 11:14, 26 July 19 ---
On that topic, do you know if the Z80 in the Amstrad CPC supports the IX (#DDxx) instructions? (If you don't know, I'll perform an experiment to determine if it does or doesn't.) I ask as I discovered that the Z80 in the Amstrad CPC seems not to support the bit (#CBxx) instructions. (I'm using the tables here for reference.)


--- End quote ---


I'm not sure if I could provide a satisfactory answer, Index Registers are available through the INLINE M/C Command, Hisoft Pascal manages it a little differently compared to when used from BASIC or Assembly depending on how variables are defined (Globally, Locally or from a Procedure Statement or Function) which are outlined in one of the Appendixes of the Manual. If you're looking at the Index Registers from a Bit Instruction perspective (DDCB), then I can't help with that.  :'(

the graveborn:
The following is my solution to the "Reverse Vowels" problem posed by Programming Praxis, and is known to run on an emulated (using Arnold 1.7.8 ) Amstrad CPC 6128 on both CP/M Plus 1.0 (my solution compiled using HiSoft Pascal for CP/M-80) and AmsDOS (my solution compiled using HiSoft Pascal Amstrad CPC464).

Whilst solving this problem I learnt that, unlike Metrowerks CodeWarrior IDE 2.1 (Discover Programming Edition), the compiler that I'd usually use when using the Pascal programming language, HiSoft Pascal for CP/M-80 doesn't support a SET being a CONST - generating the compile-time error 13 ("Constant expected."); and that HiSoft' doesn't support the name of a source code file that is included using the (*$F <Filename>.PAS*) compiler directive containing lowercase letters in the non-suffix part of the name of that file - generating the compile-time error "No Source File: <FILENAME>.PAS" - as is illustrated by the following table:

Name of included source code fileGenerates compile-time error<Filename>.pasYes<Filename>.PASYes<FILENAME>.pasNo<FILENAME>.PASNo
I also learnt that Metrowerks' supports the conditional exclusion of source code using the (*$IFNOTC DEFINED __MWERKS__*) and (*$ENDC*) compiler directives.

(I'm just trying to solve the problems posed by the aforementioned 'site whilst I try to get a job (and I've solved this problem in particular to investigate using dynamic memory in HiSoft' - dynamic memory in HiSoft' seems to be a lot less sophisticated than in Metrowerks', but that lack of sophistication may have its advantage, and I'll most likely try to investigate that in my solution to another problem...); I'm well-aware that my solutions are far from the best - but, in my defence, I don't have any traditional qualifications in computer science :/ )

PP190604.pas:


--- Code: ---(* Programming Praxis *)
(* "Reverse Vowels" (4th of June, 2019) *)

PROGRAM PP190604;

CONST
 kMaximumNumberOfCharactersPerStringNode = 5;

TYPE
 tZeroOrPositiveInteger = 0..MAXINT;
 tStringNode = RECORD
  mPreviousNode, mNextNode : ^tStringNode;
  mLengthOfString : tZeroOrPositiveInteger;
  mString : ARRAY [ 1..kMaximumNumberOfCharactersPerStringNode ] OF CHAR
 END;

VAR
 originalHeapState : ^tStringNode;

 firstChar : BOOLEAN;
 firstNode, currentNode : ^tStringNode;
 c : CHAR;

 headNode : ^tStringNode;
 headIndex : tZeroOrPositiveInteger;
 tailNode : ^tStringNode;
 tailIndex : tZeroOrPositiveInteger;
 vowels : SET OF CHAR;
 newHeadVowel, newTailVowel : CHAR;

 i : 1..MAXINT;

(*$F SETMODE2.PAS*)

(*$F OS      .PAS*)

FUNCTION fEnd:BOOLEAN;
VAR
 b : BOOLEAN;
BEGIN
 b := FALSE;
 IF headNode = NIL THEN
  b := TRUE
 ELSE IF tailNode = NIL THEN
  b := TRUE
 ELSE IF headNode = tailNode THEN
  b := headIndex >= tailIndex;
 fEnd := b
END;

(*$F LOWRCASE.PAS*)

PROCEDURE pIncrementHeadIndex;
BEGIN
 headIndex := headIndex + 1;
 IF headIndex > headNode^.mLengthOfString THEN BEGIN
  headNode := headNode^.mNextNode;
  headIndex := 1
 END
END;

PROCEDURE pDecrementTailIndex;
BEGIN
 tailIndex := tailIndex - 1;
 IF tailIndex = 0 THEN BEGIN
  tailNode := tailNode^.mPreviousNode;
  IF tailNode <> NIL THEN
   tailIndex := tailNode^.mLengthOfString
 END
END;

(*$F UPPRCASE.PAS*)

BEGIN
 MARK( originalHeapState );

 pChangeScreenMode;
 IF fOSIsCPM THEN
  WRITELN;
 WRITE( 'Please enter a string; this program will then reverse the vowels in' );
 WRITE( ' that string,' );
 WRITELN( 'maintaining the original capitalisation of the vowels.' );
 WRITELN;
 WRITE( 'Your input: ' );
 firstChar := TRUE;
 NEW( firstNode );
 currentNode := firstNode;
 currentNode^.mPreviousNode := NIL;
 currentNode^.mNextNode := NIL;
 currentNode^.mLengthOfString := 0;
 REPEAT
  READ( c );
  IF NOT firstChar THEN BEGIN
   IF currentNode^.mLengthOfString = kMaximumNumberOfCharactersPerStringNode
   THEN BEGIN
    NEW( currentNode^.mNextNode );
    currentNode^.mNextNode^.mPreviousNode := currentNode;
    currentNode := currentNode^.mNextNode;
    currentNode^.mNextNode := NIL;
    currentNode^.mLengthOfString := 0
   END;
   currentNode^.mLengthOfString := currentNode^.mLengthOfString + 1;
   currentNode^.mString[ currentNode^.mLengthOfString ] := c
  END;
  firstChar := FALSE
 UNTIL EOLN;

 headNode := firstNode;
 headIndex := 1;
 tailNode := currentNode;
 tailIndex := tailNode^.mLengthOfString;
 vowels := [ 'a', 'e', 'i', 'o', 'u' ];
 WHILE NOT fEnd DO BEGIN
  IF NOT ( fToLowercase( headNode^.mString[ headIndex ] ) IN vowels ) THEN
   pIncrementHeadIndex;
  IF NOT ( fToLowercase( tailNode^.mString[ tailIndex ] ) IN vowels ) THEN
   pDecrementTailIndex;
  IF NOT fEnd THEN
   IF ( fToLowercase( headNode^.mString[ headIndex ] ) IN vowels )
   AND ( fToLowercase( tailNode^.mString[ tailIndex ] ) IN vowels ) THEN BEGIN
    newHeadVowel := tailNode^.mString[ tailIndex ];
    IF fIsLowercase( headNode^.mString[ headIndex ] ) THEN
     newHeadVowel := fToLowercase( newHeadVowel )
    ELSE
     newHeadVowel := fToUppercase( newHeadVowel );
    newTailVowel := headNode^.mString[ headIndex ];
    IF fIsUppercase( tailNode^.mString[ tailIndex ] ) THEN
     newTailVowel := fToUppercase( newTailVowel )
    ELSE
     newTailVowel := fToLowercase( newTailVowel );
    headNode^.mString[ headIndex ] := newHeadVowel;
    tailNode^.mString[ tailIndex ] := newTailVowel;
    pIncrementHeadIndex;
    pDecrementTailIndex
   END
 END;

 WRITELN;
 WRITE( 'This program''s output: ' );
 currentNode := firstNode;
 REPEAT
  i := 1;
  WHILE i <= currentNode^.mLengthOfString DO BEGIN
   WRITE( currentNode^.mString[ i ] );
   i := i + 1
  END;
  currentNode := currentNode^.mNextNode
 UNTIL currentNode = NIL;
 WRITELN;

 RELEASE( originalHeapState )
END.
--- End code ---

SetMode2.pas:

Spoiler: ShowHide
CP/M Plus 1.0:


--- Code: ---PROCEDURE pChangeScreenMode;
BEGIN
END;
--- End code ---

AmsDOS:


--- Code: ---PROCEDURE pChangeScreenMode;
BEGIN
 RA := CHR( 2 );
 USER( #BC0E )
END;
--- End code ---


OS.pas:

Spoiler: ShowHide
CP/M Plus 1.0:


--- Code: ---FUNCTION fOSIsAMSDOS : BOOLEAN;
BEGIN
 fOSIsAMSDOS := FALSE
END;

FUNCTION fOSIsCPM : BOOLEAN;
BEGIN
 fOSIsCPM := TRUE
END;
--- End code ---

AmsDOS:


--- Code: ---FUNCTION fOSIsAMSDOS : BOOLEAN;
BEGIN
 fOSIsAMSDOS := TRUE
END;

FUNCTION fOSIsCPM : BOOLEAN;
BEGIN
 fOSIsCPM := FALSE
END;
--- End code ---


Lowrcase.pas:

Spoiler: ShowHide

--- Code: ---FUNCTION fIsLowercase( p : CHAR ) : BOOLEAN;
BEGIN
 fIsLowercase := p IN [ 'a'..'z' ]
END;

FUNCTION fToLowercase( p : CHAR ) : CHAR;
VAR
 i : INTEGER;
BEGIN
 IF p IN [ 'A'..'Z' ] THEN BEGIN
  i := ORD( p ) - ORD( 'A' );
  i := i + ORD( 'a' );
  p := CHR( i )
 END;
 fToLowercase := p
END;
--- End code ---


Upprcase.pas:

Spoiler: ShowHide

--- Code: ---FUNCTION fIsUppercase( p : CHAR ) : BOOLEAN;
BEGIN
 fIsUppercase := p IN [ 'A'..'Z' ]
END;

FUNCTION fToUppercase( p : CHAR ) : CHAR;
VAR
 i : INTEGER;
BEGIN
 IF p IN [ 'a'..'z' ] THEN BEGIN
  i := ORD( p ) - ORD( 'a' );
  i := i + ORD( 'A' );
  p := CHR( i )
 END;
 fToUppercase := p
END;
--- End code ---

SRS:
I like to QUICKHACK ;)
Eat LOCOMOTIVE, Programming Praxis

--- Code: ---10 REM Reverse Vowels by SRS 05.03.2020
20 MODE 2
30 PRINT "Please enter a string; this program will then reverse the vowels in that string,":PRINT "maintaining the original capitalisation of the vowels."
40 PRINT
50 INPUT"Your String:",s$
60 FOR i=LEN(s$) TO 1 STEP -1:c$=MID$(s$,i,1):IF INSTR("aeiouAEIOU",c$) THEN rv$=rv$+c$
70 NEXT
80 FOR i=1 TO LEN(s$):c$=MID$(s$,i,1):IF INSTR("aeiou",c$) THEN rs$=rs$+LOWER$(LEFT$(rv$,1)):rv$=RIGHT$(rv$,LEN(rv$)-1):GOTO 110
90 IF INSTR("AEIOU",c$) THEN rs$=rs$+UPPER$((LEFT$(rv$,1))):rv$=RIGHT$(rv$,LEN(rv$)-1):GOTO 110
100 rs$=rs$+c$
110 NEXT
120 PRINT "My Output: ";rs$
--- End code ---

the graveborn:
The following is my solution to the "Fizzbuzz" problem posed by Programming Praxis, and is known to run on an emulated (using Arnold 1.7. 8) Amstrad CPC 6128 on both CP/M Plus 1.0 (my solution compiled using HiSoft Pascal for CP/M-80) and AMSDOS (my solution compiled using HiSoft Pascal Amstrad CPC464); as I often do when I try to solve problems posed by Project Euler, I began by programming a prototype of my solution in the slower-to-execute(than the programming languages I typically program in)but-faster-to-program-in Python programming language - on this occassion, because I (correctly, as it transpires) suspected that the output (233,168, as it transpires) for the maximum input (1,000) would exceed the maximum value (32,767) able to be stored in an INTEGER in HiSoft' - the Python programming language's built-in "big integers" are very helpful for that kind of prototyping.

(I'm just trying to solve the problems posed by the aforementioned 'site whilst I try to get a job (and I've solved this problem in particular to try to program an error-tolerant sub-routine for getting integers from the user, for potential future projects...); I'm well-aware that my solutions are far from the best - but, in my defense, I don't have any traditional qualifications in computer science :/ )

investigation.py:


--- Code: ---def check_type_is_int( p ):
   if not isinstance( p, int ):
      s = str( type( p ))
      index_a = s.find( "'" )
      index_b = s.rfind( "'" )
      s = s[ index_a + 1 : index_b ]
      if s[ 0 ].lower() not in "aeiou":
         s = "a `" + s
      else:
         s = "an `" + s
      raise TypeError( "`p` is " + s + "`, not an `int`" )

def check_value_is_not_lower_than_minimum( value, minimum ):
   check_type_is_int( value )
   check_type_is_int( minimum )
   if value < minimum:
      raise ValueError( "`value` (" + str( value ) + ") < `minimum` (" + str( minimum ) + ')' )

def fizzbuzz_sequence( limit ):
   check_value_is_not_lower_than_minimum( limit, 1 )
   print "The fizzbuzz sequence for the range [ 1, " + str( limit ) + " ] is:"
   print
   for i in xrange( 1, limit + 1 ):
      s = '\t' + str( i ) + " - "
      fizz_or_buzz = False
      if i % 3 == 0:
         s = s + "Fizz"
         fizz_or_buzz = True
      if i % 5 == 0:
         s = s + "Buzz"
         fizz_or_buzz = True
      if not fizz_or_buzz:
         s = s + str( i )
      print s

def get_fizzbuzz_sum( limit ):
   check_value_is_not_lower_than_minimum( limit, 2 )
   result = 0
   for i in xrange( 1, limit ):
      if ( i % 3 == 0 ) or ( i % 5 == 0 ):
         result += i
   return result

def get_number_of_digits( p ):
   check_type_is_int( p )
   if p == 0:
      result = 1
   else:
      if p < 0:
         p *= -1
      result = 0
      while p > 0:
         p /= 10
         result += 1
   return result

def fizzbuzz_sum( limit ):
   result = get_fizzbuzz_sum( limit )
   print "The sum of all of the multiples of 3 or 5 below " + str( limit ) + " is " + str( result ) + '.'
   print
   result = get_number_of_digits( result )
   s1 = ""
   s2 = "is"
   if result != 1:
      s1 = 's'
      s2 = "are"
   print str( result ) + " digit" + s1 + ' ' + s2 + " needed to store the sum of the multiples of 3 or 5 below " + str( limit ) + '.'

print
fizzbuzz_sequence( 25 )
print
fizzbuzz_sum( 10 )
print
fizzbuzz_sum( 1000 )
print
--- End code ---

PP210323.pas:


--- Code: ---(* Programming Praxis *)
(* "Fizzbuzz" (23rd of March, 2021) *)

PROGRAM PP210323;

LABEL
 0;

CONST
 kRIFUDebug = FALSE;

 (*$F CONST   .PAS*)

TYPE

 (*$F TYPE    .PAS*)

VAR
 option : 0..2;
 errorOccurred, anythingRead : BOOLEAN;
 i : INTEGER;
 limit : 0..kLimit;

 (*$F TIMINGV .PAS*)

(*$F SETMODE2.PAS*)
(*$F OS      .PAS*)
(*$F RIFU    .PAS*)

PROCEDURE pReadNothingFromUser;
VAR
 c : CHAR;
BEGIN
 REPEAT
  READ( c )
 UNTIL EOLN
END;

(*$F SEQUENCE.PAS*)
(*$F TIMINGS .PAS*)
(*$F SUM     .PAS*)

BEGIN
 pChangeScreenMode;
 IF fOSIsCPM THEN
  WRITELN;
 0:option := 0;
 REPEAT
  WRITELN( 'Please enter whether you want to...' );
  WRITELN( ' 1. enumerate the fizzbuzz sequence' );
  WRITELN( ' 2. sum all of the multiples of 3 or 5' );
  WRITELN( '...below a given number, and press the Return key.' );
  WRITELN;
  WRITE( '(Or enter nothing and press the Return key to exit this program.)' );
  WRITELN;
  WRITELN;
  WRITE( 'Your input: ' );
  pReadIntegerFromUser( errorOccurred, anythingRead, i );
  IF anythingRead THEN BEGIN
   IF NOT errorOccurred THEN
    errorOccurred := ( i < 1 ) OR ( i > 2 );
   IF NOT errorOccurred THEN
    option := i
   ELSE BEGIN
    WRITELN;
    WRITELN( 'Sorry, an error occurred: your input was neither 1 nor 2.' );
    WRITELN;
    WRITE( 'Please press the Return key to try again.' );
    pReadNothingFromUser;
    WRITELN
   END
  END
 UNTIL NOT errorOccurred;

 IF option <> 0 THEN
  REPEAT
   WRITELN;
   WRITE( 'Please enter an integer in the range ( 1, 1000 ] and press the ' );
   WRITE( 'Return key; this program will then ' );
   CASE option OF
    1:WRITE( 'enumerate the fizzbuzz sequence' );
    2:WRITE( 'sum all of the multiples of 3 or 5' )
   END;
   WRITELN( ' below that integer.' );
   WRITELN;
   WRITE( '(Or enter nothing and press the Return key to return to the ' );
   WRITELN( 'previous option.)' );
   WRITELN;
   WRITE( 'Your input: ' );
   pReadIntegerFromUser( errorOccurred, anythingRead, i );
   IF anythingRead THEN BEGIN
     IF NOT errorOccurred THEN
      errorOccurred := ( i <= 1 ) OR ( i > 1000 );
     IF NOT errorOccurred THEN
      limit := i
     ELSE BEGIN
      WRITELN;
      WRITE( 'Sorry, an error occurred: your input was not an integer in ' );
      WRITELN( 'the range ( 1, ' );
      WRITELN( '1000 ].' );
      WRITELN;
      WRITE( 'Please press the Return key to try again.' );
      pReadNothingFromUser
     END
    END
   ELSE
    BEGIN
     WRITELN;
     GOTO 0
    END
  UNTIL NOT errorOccurred;

 IF option <> 0 THEN BEGIN
  WRITELN;
  CASE option OF
   1:pSequence( limit - 1 );
   2:BEGIN
    pStartTiming;
    pSum( limit );
    pStopTiming;
    IF fOSIsAMSDOS THEN BEGIN
     WRITELN;
     WRITE( 'To sum all of the multiples of 3 or 5 below ', limit:0, ' ' );
     WRITE( 'took ', fSeconds:0, ' second' );
     IF fSeconds <> 1 THEN
      WRITE( 's' );
     WRITELN( '.' )
    END
   END
  END
 END
END.
--- End code ---

const.pas:


--- Code: ---kLimit = 1000;
kLimitPlusOne = 1001;
--- End code ---

type.pas:


--- Code: ---tLimit = 1..kLimit;
tLimitPlusOne = 1..kLimitPlusOne;
--- End code ---

RIFU.pas:


--- Code: ---PROCEDURE pReadIntegerFromUser( VAR pErrorOccurred, pAnythingRead : BOOLEAN;
                                VAR pInteger : INTEGER );
TYPE
 tDigit = 0..9;
 tCharSet = SET OF CHAR;
VAR
 digits : ARRAY [ 1..5 ] OF tDigit;
 sign : CHAR;

 PROCEDURE pLeftShiftArrayOfDigits;
 VAR
  i : 1..5;
 BEGIN
  FOR i := 5 DOWNTO 2 DO
   digits[ i ] := digits[ i - 1 ];
  digits[ 1 ] := 0
 END;

 FUNCTION fOutOfRange( pSign : tCharSet; pDigitAtIndex1 : tDigit ) : BOOLEAN;
 LABEL
  0;
 VAR
  result : BOOLEAN;
  range : ARRAY [ 1..5 ] OF tDigit;
  i : 0..5;
 BEGIN
  result := FALSE;
  IF sign IN pSign THEN BEGIN
   range[ 5 ] := 3;
   range[ 4 ] := 2;
   range[ 3 ] := 7;
   range[ 2 ] := 6;
   range[ 1 ] := pDigitAtIndex1;
   FOR i := 5 DOWNTO 1 DO
    IF digits[ i ] < range[ i ] THEN
     GOTO 0
    ELSE
     IF digits[ i ] > range[ i ] THEN BEGIN
      result := TRUE;
      GOTO 0
     END
  END;
  0:fOutOfRange := result
 END;

 FUNCTION fTooLow : BOOLEAN;
 BEGIN
  fTooLow := fOutOfRange( [ '-' ], 8 )
 END;

 FUNCTION fTooHigh : BOOLEAN;
 BEGIN
  fTooHigh := fOutOfRange( [ ' ', '+' ], 7 )
 END;

 FUNCTION fArrayOfDigitsToInteger : INTEGER;
 VAR
  result : INTEGER;
  multiplier : 1..10000;
  i : 1..6;
  intermediate : INTEGER;
 BEGIN
  result := 0;
  multiplier := 1;
  FOR i := 1 TO 5 DO BEGIN
   IF i <> 1 THEN
    multiplier := multiplier * 10;
   intermediate := digits[ i ] * multiplier;
   IF sign = '-' THEN
    intermediate := intermediate * ( -1 );
   result := result + intermediate
  END;
  fArrayOfDigitsToInteger := result
 END;

 PROCEDURE pInner;
 LABEL
  0, 1;
 VAR
  c : CHAR;
  validChar, anyDigitEncountered : BOOLEAN;
  numberOfDigits : 0..5;
  i : 1..6;
  endOfLine, firstChar, blankLineWritten : BOOLEAN;

  FUNCTION fSign : BOOLEAN;
  VAR
   result : BOOLEAN;
  BEGIN
   result := TRUE;
   IF c IN [ '+', '-' ] THEN BEGIN
    validChar := TRUE;
    IF sign <> ' ' THEN BEGIN
      result := FALSE;
      IF kRIFUDebug THEN
       WRITELN( 'fSign - sign <> '' ''' )
     END
    ELSE
     IF anyDigitEncountered THEN BEGIN
       result := FALSE;
       IF kRIFUDebug THEN
        WRITELN( 'fSign - anyDigitEncountered = TRUE' )
      END
     ELSE
      sign := c
   END;
   fSign := result
  END;

  FUNCTION fDigit0 : BOOLEAN;
  VAR
   result : BOOLEAN;
  BEGIN
   result := TRUE;
   IF c = '0' THEN BEGIN
    validChar := TRUE;
    anyDigitEncountered := TRUE;
    IF numberOfDigits > 0 THEN
     IF numberOfDigits = 5 THEN BEGIN
       result := FALSE;
       IF kRIFUDebug THEN
        WRITELN( 'fDigit0 - numberOfDigits > 5' )
      END
     ELSE
      BEGIN
       pLeftShiftArrayOfDigits;
       digits[ 1 ] := 0;
       numberOfDigits := numberOfDigits + 1
      END
   END;
   fDigit0 := result
  END;

  FUNCTION fDigits1To9 : BOOLEAN;
  VAR
   result : BOOLEAN;
  BEGIN
   result := TRUE;
   IF c IN [ '1'..'9' ] THEN BEGIN
    validChar := TRUE;
    anyDigitEncountered := TRUE;
    IF numberOfDigits = 5 THEN BEGIN
      result := FALSE;
      IF kRIFUDebug THEN
       WRITELN( 'fDigits1To9 - numberOfDigits > 5' )
     END
    ELSE
     BEGIN
      IF numberOfDigits > 0 THEN
       pLeftShiftArrayOfDigits;
      digits[ 1 ] := ORD( c ) - ORD( '0' );
      numberOfDigits := numberOfDigits + 1
     END
   END;
   fDigits1To9 := result
  END;

 BEGIN
  pErrorOccurred := FALSE;
  pAnythingRead := FALSE;
  FOR i := 1 TO 5 DO
   digits[ i ] := 0;
  sign := ' ';
  anyDigitEncountered := FALSE;
  numberOfDigits := 0;
  firstChar := TRUE;
  blankLineWritten := FALSE;

  REPEAT
   READ( c );
   endOfLine := EOLN;
   IF NOT firstChar THEN BEGIN
    pAnythingRead := TRUE;
    IF kRIFUDebug THEN BEGIN
     IF NOT blankLineWritten THEN BEGIN
      WRITELN;
      blankLineWritten := TRUE
     END;
     WRITELN( 'pInner - c = ''', c, '''' )
    END;
    validChar := FALSE;
    IF NOT fSign THEN
     GOTO 0;
    IF NOT fDigit0 THEN
     GOTO 0;
    IF NOT fDigits1To9 THEN
     GOTO 0;
    IF NOT validChar THEN BEGIN
     IF kRIFUDebug THEN
      WRITELN( 'pInner - validChar = FALSE' );
     GOTO 0
    END
   END;
   firstChar := FALSE
  UNTIL endOfLine;

  IF pAnythingRead AND NOT anyDigitEncountered THEN BEGIN
   IF kRIFUDebug THEN
    WRITELN( 'pInner - pAnythingRead = TRUE AND anyDigitEncountered = FALSE' );
   GOTO 0
  END;
  IF fTooLow THEN BEGIN
   IF kRIFUDebug THEN
    WRITELN( 'pInner - fTooLow = TRUE' );
   GOTO 0
  END;
  IF fTooHigh THEN BEGIN
   IF kRIFUDebug THEN
    WRITELN( 'pInner - fTooHigh = TRUE' );
   GOTO 0
  END;
  GOTO 1;
  0:pErrorOccurred := TRUE;
  IF NOT endOfLine THEN
   REPEAT
    READ( c );
    IF kRIFUDebug THEN
     WRITELN( 'pInner - (discarding) c = ''', c, '''' )
   UNTIL EOLN;
  1:IF NOT pErrorOccurred THEN
   pInteger := fArrayOfDigitsToInteger
 END;

BEGIN
 pInner
END;
--- End code ---

Sequence.pas:


--- Code: ---PROCEDURE pSequence( limit : tLimit );
VAR
 i : tLimitPlusOne;
 fizzOrBuzz : BOOLEAN;
BEGIN
 WRITE( 'The fizzbuzz sequence for the range [ 1, ', limit:0, ' ] is: ' );
 FOR i := 1 TO limit DO BEGIN
  IF i > 1 THEN
   WRITE( ', ' );
  fizzOrBuzz := FALSE;
  IF i MOD 3 = 0 THEN BEGIN
   WRITE( 'Fizz' );
   fizzOrBuzz := TRUE
  END;
  IF i MOD 5 = 0 THEN BEGIN
   WRITE( 'Buzz' );
   fizzOrBuzz := TRUE
  END;
  IF NOT fizzOrBuzz THEN
   WRITE( i:0 )
 END;
 WRITELN( '.' )
END;
--- End code ---

TimingV.pas (CP/M):



TimingV.pas (AMSDOS):


--- Code: ---seconds : 0..MAXINT;
--- End code ---

TimingS.pas (CP/M):


--- Code: ---PROCEDURE pStartTiming;
BEGIN
END;

FUNCTION fSeconds : INTEGER;
BEGIN
 fSeconds := -1
END;

PROCEDURE pStopTiming;
BEGIN
END;
--- End code ---

TimingS.pas (AMSDOS):


--- Code: ---PROCEDURE pTimedMessage;
VAR
 ignored : INTEGER;
BEGIN
 WRITELN( 'Please wait...' );
 WRITELN;
 ignored := REMAIN( 2 )
END;

PROCEDURE pIncrementSeconds;
BEGIN
 seconds := seconds + 1
END;

PROCEDURE pStartTiming;
BEGIN
 AFTER( 5 * 50, 2, pTimedMessage );
 seconds := 0;
 EVERY( 50, 3, pIncrementSeconds )
END;

FUNCTION fSeconds : INTEGER;
BEGIN
 fSeconds := seconds
END;

PROCEDURE pStopTiming;
VAR
 ignored : INTEGER;
BEGIN
 ignored := REMAIN( 2 );
 ignored := REMAIN( 3 )
END;
--- End code ---

Sum.pas:


--- Code: ---PROCEDURE pSum( limit : tLimit );

CONST
 kMaximumIndex = 6;

TYPE
 tZeroOrPositiveInteger = 0..MAXINT;
 tIndex = 1..6;

VAR
 digits : ARRAY [ 1..6 ] OF 0..18;
 i : 1..7;
 k : tLimit;
 digitWritten : BOOLEAN;

PROCEDURE (* Increase *) pOuter( p : tZeroOrPositiveInteger );
VAR
 index : 0..kMaximumIndex;
 digit : 0..9;

PROCEDURE (* Increase *) pInner( p : tIndex );
BEGIN
 IF digits[ p ] >= 10 THEN BEGIN
  digits[ p ] := digits[ p ] MOD 10;
  digits[ p - 1 ] := digits[ p - 1 ] + 1;
  pInner( p - 1 )
 END
END;

BEGIN
 index := kMaximumIndex;
 WHILE p > 0 DO BEGIN
  digit := p MOD 10;
  p := p DIV 10;
  digits[ index ] := digits[ index ] + digit;
  pInner( index );
  index := index - 1
 END
END;

BEGIN
 FOR i := 1 TO kMaximumIndex DO
  digits[ i ] := 0;
 FOR k := 1 TO limit - 1 DO
  IF ( k MOD 3 = 0 ) OR ( k MOD 5 = 0 ) THEN
   pOuter( k );
 WRITE( 'The sum of all of the multiples of 3 or 5 below ', limit:0, ' is ' );
 digitWritten := FALSE;
 FOR i := 1 TO kMaximumIndex - 1 DO
  IF ( digits[ i ] <> 0 ) OR digitWritten THEN BEGIN
   WRITE( digits[ i ]:0 );
   digitWritten := TRUE
  END;
 WRITELN( digits[ kMaximumIndex ]:0, '.' )
END;
--- End code ---

Navigation

[0] Message Index

[*] Previous page

Go to full version
Powered by SMFPacks Reactions Mod
Powered by SMFPacks Alerts Pro Mod
Powered by SMFPacks Mentions Pro Mod