Oppolzer - Informatik / Stanford Pascal Compiler

Home       Lebenslauf       Schwerpunkte       Kenntnisse       Seminare       Kunden       Projekte       Produkte       Blog       Stanford Pascal       Kontakt

The Stanford Pascal Compiler / Evolution Steps

Back to Compiler main page

Some Pascal/VS features added (DATETIME, HALT, CLOSE, TERMIN/TERMOUT)

I wanted to compile and run a program which I wrote for a former custumer of mine in the late 199x years. The program does speed computations for urban subway trains and computes informations for the signals there. The original program was written for IBMs Pascal/VS on VM/CMS. The program is still in use today and will be extended this year, but I converted it to ANSI C in 2001, because the customer moved off of the mainframe.

My idea was to get the program running on Hercules/VM and on Windows, too, and to check if the results are the same. The program uses floating point very much, so I thought this would be a good test case for the floating point instructions.

But the first obstacle was that the program contained some calls to standard functions that were available in Pascal/VS, but not in the "new" Stanford Pascal. See above: the problem functions were: DATETIME, HALT, CLOSE, TERMIN and TERMOUT.

I decided after a while that CLOSE should be added as a new CSP function to the compiler directly, because it is a good idea in my opinion to be able to close a file before the program ends. This was not possible up until now; files were only closed by the runtime implicitly during a new RESET or REWRITE or at the very end of the program. And: CLOSE is available on most compilers (Turbo Pascal etc.)

So I added a new CSP CLS, and extended PASMONN.ASS (on Hercules/VM) and PCINT.C (on Windows etc.) to support it.

The other functions are different; they should only be included on an "as needed" base. This can be done by writing an external module (I called it PASCALVS), where the functions are implemented. The functions need not be declared, when using them (undeclared procedures are supported since 01.2017). You will get warnings W184, if you dont, but the program will compile and run, anyway. You only need to add the PASCALVS module at run time; you can find it on the AWSTape (see Resources) - and the source code is shown below.

DATETIME / DATTIM10

DATETIME has the flaw that it returns only 2-digit years; I provided another procedure DATTIM10 which returns date and time as CHAR(10) arrays; the format is DD.MM.YYYY (european format).

DATETIME and DATTIM10 both use the existing "system" variables DATE and TIME; they both had the "problem", that they were only computed once at program start time.

I added two CSPs DAT and TIM, which, when called, ask the system for the actual date and time and refresh the system variables (which are at a fixed location in store). The CSPs DAT and TIM are called before every reference to DATE and TIME, so now you always get the actual date and time, when you call DATE, TIME, DATETIME or DATTIM10.

HALT

HALT is simply EXIT (8).

TERMIN / TERMOUT

TERMIN and TERMOUT had to be implemented differently, depending on the platform.

With PCINT (that is, Windows, OS/2, Linux), there is a "terminal" switch in the file control block (FCB), which is simply set to Y by both TERMIN and TERMOUT. This means that on OPEN the files are connected to stdin and stdout, respectively.

On CMS, the DDNAME is extracted from the FCB using the FILEFCB function, and then a command "FILEDEF ddname TERM" is issued using the function CMSX, which is defined in the Pascal Extension Library (PASLIBX.PAS).

The PASCALVS Source Code 




   module PASCALVS ;

   /************************************************/
   /*$A+                                           */
   /************************************************/
   /*                                              */
   /*   Modul PASCALVS                             */
   /*                                              */
   /*   enthaelt Funktionen, die im PASCAL/VS      */
   /*   Compiler vorhanden waren                   */
   /*                                              */
   /************************************************/


   type PLATFORM = ( PLATF_UNKNOWN , PLATF_INTEL , PLATF_MAINFRAME ) ;
        CHAR4 = array [ 1 .. 4 ] of CHAR ;
        CHAR8 = array [ 1 .. 8 ] of CHAR ;
        CHAR10 = array [ 1 .. 10 ] of CHAR ;
        CHAR80 = array [ 1 .. 80 ] of CHAR ;
        CHARPTR = -> CHAR ;

   static PLATF : PLATFORM ;


   procedure CMSX ( CMD : CHARPTR ; var RETCODE : INTEGER ) ;

      EXTERNAL ;


   local procedure CHECK_PLATFORM ;

      begin (* CHECK_PLATFORM *)
        if ORD ( 'A' ) = 65 then
          PLATF := PLATF_INTEL
        else
          PLATF := PLATF_MAINFRAME
      end (* CHECK_PLATFORM *) ;


   procedure HALT ;

      begin (* HALT *)
        EXIT ( 8 ) ;
      end (* HALT *) ;


   procedure DATETIME ( var DAT : CHAR8 ; var TIM : CHAR8 ) ;

      var DATX : CHAR10 ;

      begin (* DATETIME *)
        DATX := DATE ;
        DAT := 'MM/DD/YY' ;
        DAT [ 1 ] := DATX [ 4 ] ;
        DAT [ 2 ] := DATX [ 5 ] ;
        DAT [ 4 ] := DATX [ 1 ] ;
        DAT [ 5 ] := DATX [ 2 ] ;
        DAT [ 7 ] := DATX [ 9 ] ;
        DAT [ 8 ] := DATX [ 10 ] ;
        PACK ( TIME , 1 , TIM ) ;
      end (* DATETIME *) ;


   procedure DATTIM10 ( var DAT : CHAR10 ; var TIM : CHAR10 ) ;

      var DATX : CHAR10 ;

      begin (* DATTIM10 *)
        DATX := DATE ;
        DAT := 'DD.MM.YYYY' ;
        DAT [ 1 ] := DATX [ 4 ] ;
        DAT [ 2 ] := DATX [ 5 ] ;
        DAT [ 4 ] := DATX [ 1 ] ;
        DAT [ 5 ] := DATX [ 2 ] ;
        DAT [ 7 ] := DATX [ 7 ] ;
        DAT [ 8 ] := DATX [ 8 ] ;
        DAT [ 9 ] := DATX [ 9 ] ;
        DAT [ 10 ] := DATX [ 10 ] ;
        TIM := TIME ;
      end (* DATTIM10 *) ;


   procedure TERMIN ( var X : TEXT ) ;

      var FCB : VOIDPTR ;
          PDDN : -> CHAR8 ;
          PTERM : -> CHAR ;
          CMSCMD : CHAR80 ;
          CPT : -> CHAR ;
          RC : INTEGER ;

      begin (* TERMIN *)
        if PLATF = PLATF_UNKNOWN then
          CHECK_PLATFORM ;
        if PLATF = PLATF_INTEL then
          begin
            FCB := FILEFCB ( X ) ;
            PDDN := PTRADD ( FCB , 8 ) ;
            PTERM := PTRADD ( FCB , 279 ) ;
            PTERM -> := 'Y'
          end (* then *)
        else
          begin
            FCB := FILEFCB ( X ) ;
            CMSCMD := 'FILEDEF XXXXXXXX CLEAR #' ;
            CPT := PTRADD ( ADDR ( CMSCMD ) , 8 ) ;
            MEMCPY ( CPT , FCB , 8 ) ;
            CMSX ( ADDR ( CMSCMD ) , RC ) ;
            CMSCMD := 'FILEDEF XXXXXXXX TERMINAL (RECFM V #' ;
            MEMCPY ( CPT , FCB , 8 ) ;
            CMSX ( ADDR ( CMSCMD ) , RC ) ;
          end (* else *)
      end (* TERMIN *) ;


   procedure TERMOUT ( var X : TEXT ) ;

      var FCB : VOIDPTR ;
          PDDN : -> CHAR8 ;
          PTERM : -> CHAR ;
          CMSCMD : CHAR80 ;
          CPT : -> CHAR ;
          RC : INTEGER ;

      begin (* TERMOUT *)
        if PLATF = PLATF_UNKNOWN then
          CHECK_PLATFORM ;
        if PLATF = PLATF_INTEL then
          begin
            FCB := FILEFCB ( X ) ;
            PDDN := PTRADD ( FCB , 8 ) ;
            PTERM := PTRADD ( FCB , 279 ) ;
            PTERM -> := 'Y'
          end (* then *)
        else
          begin
            FCB := FILEFCB ( X ) ;
            CMSCMD := 'FILEDEF XXXXXXXX CLEAR #' ;
            CPT := PTRADD ( ADDR ( CMSCMD ) , 8 ) ;
            MEMCPY ( CPT , FCB , 8 ) ;
            CMSX ( ADDR ( CMSCMD ) , RC ) ;
            CMSCMD := 'FILEDEF XXXXXXXX TERMINAL (RECFM V #' ;
            MEMCPY ( CPT , FCB , 8 ) ;
            CMSX ( ADDR ( CMSCMD ) , RC ) ;
          end (* else *)
      end (* TERMOUT *) ;

   begin (* HAUPTPROGRAMM *)

   end (* HAUPTPROGRAMM *) .

Back to Compiler main page