Pascal on the 99/4A

[Rhodanaj]

11 minutes ago, Vorticon said:

Pretty simple really.

I will experiment with it 🙂 I did read already about a variant record, but had no idea how to make or use one.

 

I also love to make programs in Visual Basic, it's so versatile!

If I wasn't able to create Pcode Tool, then I would never have bothered with UCSD Pascal again. My way of programming is by do it step by step. Check it and go to the next step.

To do this by switching between the editor and the compiler would be too irritating...

It took me years to complete the tool, but every step was a great fun to do! When it was not for @globeron then I would not even be back on this forum and made some good improvements at my program 🙂

 

I'm still amazed at the strength of the Pcode environment itself. I create the program text with my tool, go to the TI emulator. Type X and then i=ass and then my Assembler program is immediately converted and linked to the Pascal program. ass.text is:

A#9:2ASS

#9:2ASS

 

L#9:1PAS

#9:2ASS

 

 

#9:3EXE.CODE

 

When ready I type X and i=rn and the program runs. This way I can very quick make a program step by step and correct it when I did forget the ';' once again.... 🙂

Being able to re-capture the input and output of Pcode is a terribly powerful tool!

 

 

[Rhodanaj]

11 minutes ago, apersson850 said:

 

byte = 0.255;
bytearray = packed array[0..1] of byte;
chararray = packed array[0..1] of char;
quad = record
  case integer of
    1: (int: integer);
    2: (ptr: ^integer);
    3: (byteptr: ^bytearray);
    4: (charptr: ^chararray);
end; (* quad *)

Now, this makes a lot more sence to me !!!

Now I  start to understand this Peek, Poke and variant record 😊! 

Thank you !!

Edited January 25 by Rhodanaj

[apersson850]

Good.

 

Here's an extract of that 4000 line program I mentioned above (I just checked - it's actually 4001 lines!). There are some variant records there too. They are to accomodate a linked list of items that are partially different (pipepart) and file storage of different items in the same file (file_fix).

The code extract is from Turbo Pascal 4.0, but the same design works on the 99/4A too, with very small changes. Note that extended is set the same as real. Extended was a real data type designed specifically to use the math co-processor (80287) which was installed in the PC AT with 80286 CPU this program was developed on. The original program was developed on the TI 99/4A and contained the same functionality.

You can't type cast a constant like I do in this program either, but that's a minor thing to change.

 

const
   bell: char = #7;
   lf: char = #10;       (* Printer control codes *)
   ff: char = #12;
   cr: char = #13;
   maxstandard = 50;     (* Max allowed number of pipe dimensions *)
   height_default = 0;  (* Number of useful lines on a printer paper *)
   prdefault = 'PRN';    (* Default printer device *)
   filedefault = 'ej lagrad';   (* Default file name for pipe systems *)
   namestandard = 'standard.txt';   (* Default pipe info file names *)
   namecost1    = 'costgalv.txt';
   namecost2    = 'costblk2.txt';
   namecost3    = 'costblk3.txt';

type
   extended = real;
   pipelink = ^pipepart;
   pipetype = (branch,main,special_branch,special_main);
   datetype = record
      month,
      date,
      year: word;
   end; (* datetype *)

   plant_type = record
      customer,              (* Name *)
      contact,               (* Person *)
      plantname: string;
      created,               (* Date when created *)
      updated: datetype;     (* Date when last changed *)
      dust,                  (* Dust separator pressure *)
      maxspeed,              (* In main pipe *)
      startspeed,            (* In first branch *)
      totps,
      motor: extended;       (* Power requirement *)
      totflow: longint;      (* Total air flow, m3/h *)
      next: pipelink;
   end; (* plant type *)

   (* The bendarray holds the number of bends of different types (15, 30,
      45, 60, 75 and 90 degrees). *)
   bendarray = array [0..5] of integer;
   pipepart = record
      id,                    (* Id # of pipe *)
      level,                 (* (Sub)system level. Used by fetch_data *)
      diameter,
      position: integer;     (* Of data in standard array *)
      bend: bendarray;       (* Number of different bends *)
      pipelength,
      totvolume,
      airspeed,
      equlength,             (* Equivalent straight length *)
      ps: extended;          (* Static ppressure *)
      prev,                  (* Pointer to previous pipe in list *)
      next,                  (* Next pipe in list *)
      mainstart,             (* Start of subsystem *)
      inserted: pipelink;    (* Pointer to pipe where subsystem is inserted *)
      case pipekind : pipetype of
         special_branch,
         branch: (p020,      (* Subpressure at inlet *)
                  r20,       (* Pipe resistance *)
                  p20,       (* Subpressure at main pipe *)
                  volume: extended);
         special_main,
         main:   (r,         (* Main pipe resistance *)
                  ks: extended); (* Unit resistance *)
   end; (* pipepart *)

   (* Bend_value_array holds the equivalent straight length for the different
      kinds of bends. *)
   bend_value_array = array [0..5] of extended;
   stand_type = record       (* Standard pipe information *)
      dimension: integer;    (* mm *)
      area,                  (* m^2 *)
      k20: extended;         (* Pipe resistance *)
      bendequ: bend_value_array;  (* Equivalent straight length for bends *)
   end; (* stand type *)
   stand_file = file of stand_type;

   stand_array = array[0..maxstandard] of stand_type;
     (* Array with standard diameters and pipe data *)

   (* Type declarations for material cost information *)
   metal_type = (galvanized,black2,black3);
   cost_type = record
      length_cost,
      conn_cost,
      junc_1_cost,
      junc_2_cost: extended;
      bend_cost: array [0..5] of extended;
   end; (* cost type *)
   cost_array = array [metal_type,0..maxstandard] of cost_type;

   (* Special data types used to allow storage of plant_type and pipepart data
      in the same file. *)
   pl_data_type = record
      x1,
      x2,
      x3,
      x4,
      x5: extended;
      x6: longint;
      date1,
      date2: datetype;
   end;
   file_fix = record
      case integer of
         0: (line: string);
         1: (plant_data: pl_data_type);
         2: (pipe: pipepart);
   end; (* file fix *)
   fixtype = file of file_fix;

 

Edited January 25 by apersson850

[Geoff Oltmans]

Here's another dumb p-system question. Presumably all graphics and sounds extensions were done after the fact or was there a standard library or API in the p-system for that? 

[+Vorticon]

3 hours ago, Geoff Oltmans said:

Here's another dumb p-system question. Presumably all graphics and sounds extensions were done after the fact or was there a standard library or API in the p-system for that? 

I doubt they were incorporated into the p-system since each platform has a different set of capabilities and thus would have impeded portability.

[apersson850]

3 hours ago, Geoff Oltmans said:

Presumably all graphics and sounds extensions were done after the fact or was there a standard library or API in the p-system for that? 

I don't know too much about sound. Sound is pretty difficult, because the sound hardware in various machines tend to be very different.

But for screen output it was definitely a standard built into the system. Early systems were only concerned with text output, as their hardware supported nothing else. But already there we had a system with standard output commands (write/writeln) being the same in all machines, then a BIOS layer underneath. The BIOS was different for different machines. It's the good old concept of a hardware driver.

Back then the same computer was also often equipped with different types of terminals. Early on, the system got the SETUP utility, which stored data in SYSTEM.MISCINFO. That data defined which character to send to the terminal do do backspace, delete, line feed and similar stuff. There was also the itrinsic gotoxy, which sends screen output to a certain position. If you bought a system like the one for the 99/4A it was already written. But in the adaptable system, there were instructions how you should compile your own gotoxy for the terminal at hand.

 

When the computers supported graphic output the approach of the p-system was the turtlegraphics unit. To begin with what you could do was dependent on the system you had. Resolution of the physical screen defined how many logical pixels you could draw across the screen. But the later implementations were hardware independent, providing a standard interface to enable/disable graphic mode, aspect ratios to make sure a square drawn looked like a square, not a rectangle and provided scaling so a line 100 logical pixels long had the same length on different hardware.

In the adaptable systems there were then instructions about how procedures to draw/clear a pixel and to draw a straight line should handle arguments and return results. If you did that you could more or less run the p-system and exectue a graphics program, written on a different machine's p-system and still get the same result on your homebrew computer. As long as there was a p-machine emulator available for your CPU, the two computers don't even have to have the same kind of CPU.

 

So there was definitely a standard interface for graphics in the system.

[+Vorticon]

OK here's the complete date setting program. It displays the current system date and prompts for a current date then writes the date to RAM and updates the root disk with the new date. I borrowed several elements from @apersson850's code set but with heavy modifications to meet my needs. It was surprisingly arduous to make the date entry validation idiot-proof, although in the end I'm probably going to be the only idiot using this code in practical terms! 😁

Now that's a lot of code just to set the date, but it's a lot faster than invoking the Filer using the REDIRECT method. 

 

PROGRAM SETDATE;
USES MISC;
CONST
 DATELOC = 13840; {RAM LOCATION OF SYSTEM DATE}
 DIGIT = '0123456789';

TYPE
 BYTE = 0..255;

 DUAL = RECORD
  CASE BOOLEAN OF
   TRUE : (INT: INTEGER);
   FALSE : (PTR : ^INTEGER);
  END; {DUAL}
  
 BYTEWORD = RECORD
  CASE BOOLEAN OF
   TRUE : (VALUE : INTEGER);
   FALSE : (BYTES : PACKED ARRAY[1..2] OF BYTE);
  END;
  
 DIRTYPE = RECORD
  FILL1 : PACKED ARRAY[0..255] OF CHAR; (* SECTOR 0 *)
  FILL2 : PACKED ARRAY[0..255] OF CHAR; (* SECTOR 1 *)
  FILL3 : PACKED ARRAY[0..255] OF CHAR; (* SECTOR 2 *)
  FILL4 : PACKED ARRAY[0..255] OF CHAR; (* SECTOR 3 *)
  FILL5 : PACKED ARRAY[0..19] OF CHAR; (* SECTOR 4, PASCAL DIRECTORY *)
  DLASTBOOT : INTEGER;
  FILL6 : PACKED ARRAY[0..489] OF CHAR; (* SECTORS 4 AND 5 *)
 END;

VAR
 WORD : BYTEWORD;
 YEAR, MONTH, DAY, I, IPOS, STRINGL : INTEGER;
 MONTHNAME, MSTRING, DATE : STRING;
 VALID : BOOLEAN;
 DIRECTORY : DIRTYPE;

PROCEDURE POKE(ADDR, VALUE : INTEGER);
VAR
 LOC : DUAL;

BEGIN {POKE}
 LOC.INT := ADDR;
 LOC.PTR^ := VALUE;
END; {POKE}

FUNCTION PEEK(ADDR : INTEGER) : INTEGER;
VAR
 LOC : DUAL;
 
BEGIN {PEEK}
 LOC.INT := ADDR;
 PEEK := LOC.PTR^;
END; {PEEK}

FUNCTION STR2INT(INSTRING : STRING) : INTEGER;
{CONVERTS A STRING TO AN INTEGER
 NO STRING VALIDATION IS DONE!}
VAR
 FIRSTDIGIT, LASTDIGIT, I, ACCUM : INTEGER;
 NEGATIVE : BOOLEAN;
 
BEGIN {STR2INT}
 NEGATIVE := FALSE;
 {CHECK IF NEGATIVE NUMBER}
 IF INSTRING[1] = '-' THEN
  NEGATIVE := TRUE;
  
 {CONVERT TO INTEGER}
 IF NEGATIVE THEN
  BEGIN
   FIRSTDIGIT := 2;
   LASTDIGIT := LENGTH(INSTRING) - 1
  END
 ELSE
  BEGIN
   FIRSTDIGIT := 1;
   LASTDIGIT := LENGTH(INSTRING)
  END;
  
 ACCUM := 0;
 FOR I := FIRSTDIGIT TO LASTDIGIT DO
  ACCUM := ACCUM * 10 + (ORD(INSTRING[I]) - 48);
 IF NEGATIVE THEN ACCUM := -ACCUM;
 STR2INT := ACCUM;
END; {STR2INT}

BEGIN {SETDATE}
 MONTHNAME := 'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
 
 {GET SYSTEM DATE}
 WORD.VALUE := PEEK(DATELOC);
 YEAR := WORD.BYTES[1] DIV 2;
 WORD.VALUE := WORD.VALUE * 16;
 DAY := ORD((ODD(WORD.BYTES[1])) AND (ODD(31)));
 MONTH := WORD.BYTES[2] DIV 16;
 MSTRING := COPY(MONTHNAME,MONTH * 3 - 2, 3);
 WRITELN('SYSTEM DATE: ',DAY,'-',MSTRING,'-',YEAR);
 
 {ENTER CURRENT DATE}
 WRITELN('CURRENT DATE:', CHR(7));
 REPEAT
  VALID := TRUE;
  GOTOXY(13,2);
  WRITE('                               ');
  GOTOXY(13,2);
  READLN(DATE);
  IF DATE = '' THEN
   EXIT(PROGRAM);
   
  {PARSE DAY}
  IPOS := BREAK(DATE, DIGIT);
  IF (IPOS > 1) OR (IPOS = 0) THEN
   VALID := FALSE
  ELSE
   BEGIN
    I := SPAN(DATE, DIGIT);
    IF (I = 0) THEN
     VALID := FALSE
    ELSE
     IF (I > 2) AND (NOT(ORD(DATE[2]) IN [48..57])) THEN
      VALID := FALSE
     ELSE
      BEGIN
       MSTRING := COPY(DATE, 1, I-1);
       DAY := STR2INT(MSTRING);
       IF NOT(DAY IN [1..31]) THEN
        VALID := FALSE 
      END;
   END;
   
  IF LENGTH(DATE) < I + 5 THEN
   VALID := FALSE;
   
  {PARSE MONTH}
  IF VALID THEN
   BEGIN
    IF (DATE[I + 4] <> '-') OR (DATE[I] <> '-') THEN
     VALID := FALSE
    ELSE
     BEGIN
      MSTRING := COPY(DATE, I + 1, 3);
      IPOS := I + 5;
      I := POS(MSTRING, MONTHNAME);
      IF I = 0 THEN
       VALID := FALSE
      ELSE
       MONTH := (I + 3) DIV 3
     END;
   END;
   
   {PARSE YEAR}
   IF VALID THEN
    BEGIN
     STRINGL := LENGTH(DATE);
     IF (STRINGL < IPOS) OR ((STRINGL - IPOS) > 1) THEN
      VALID := FALSE
     ELSE
      BEGIN
       STRINGL := STRINGL - IPOS + 1;
       MSTRING := COPY(DATE, IPOS, STRINGL);
       FOR I := 1 TO STRINGL DO
        IF NOT(ORD(MSTRING[I]) IN [48..57]) THEN
         VALID := FALSE;
       IF VALID THEN
        BEGIN
         YEAR := STR2INT(MSTRING);
         IF NOT(YEAR IN [0..99]) THEN
          VALID := FALSE
        END;
      END;
    END;
  IF NOT(VALID) THEN
   BEGIN
    GOTOXY(22,2);
    WRITE(' INVALID DATE!',CHR(7));
   END;
 UNTIL VALID;

 {UPDATE SYSTEM DATE IN RAM}
 I := (YEAR * 512) + (DAY * 16) + MONTH;
 POKE(DATELOC, I);
 
 {UPDATE ROOT DISK WITH DATE}
 UNITREAD(4,DIRECTORY,SIZEOF(DIRECTORY),0);
 DIRECTORY.DLASTBOOT := I;
 UNITWRITE(4,DIRECTORY,SIZEOF(DIRECTORY),0);
END.

 

[+retroclouds]

I’m following this thread with the most interest. And have a question to its implementation on the TI-99/4a.

Normally the p-code card takes control as soon as the computer is turned on -if the card switch is toggled on-, unless a particular memory location has a magic value. Is that assumption correct? 

The one thing I don’t like about the p-code card is exactly this behaviour. So I was wondering if there are other ways to prevent the DSR from taking over without turning the card switch off. 

Was thinking about another DSR or cartridge with autostart that pokes the magic value. But perhaps there are better options?

[JasonACT]

57 minutes ago, retroclouds said:

Normally the p-code card takes control as soon as the computer is turned on -if the card switch is toggled on-, unless a particular memory location has a magic value. Is that assumption correct? 

You mean the characters "NO" at location >38FA 

[+TheBF]

7 hours ago, Vorticon said:

It was surprisingly arduous to make the date entry validation idiot-proof

 

"It is impossible to make anything idiot proof, because idiots are too ingenious"

 

                                                                                      Murphy's Law of Engineering

 

[apersson850]

12 hours ago, JasonACT said:

You mean the characters "NO" at location >38FA 

While running it says '99' (and '4A' in the following word). If the p-system halts and needs to be rebooted the value is 'GO'.
Since the p-system takes over by never leaving the power-up routing (and that's why it has to have the highest CRU base address), you could of course poke something into >38FA to prevent it from starting.

But the easiest is by far flipping the switch, provided we assume a human is making the decision.

 

Moot point, really, since of course you want to run the p-system! 😃

Edited January 27 by apersson850

[apersson850]

13 hours ago, Vorticon said:

Now that's a lot of code just to set the date...

 

 DIRTYPE = RECORD
  FILL1 : PACKED ARRAY[0..255] OF CHAR; (* SECTOR 0 *)
  FILL2 : PACKED ARRAY[0..255] OF CHAR; (* SECTOR 1 *)
  FILL3 : PACKED ARRAY[0..255] OF CHAR; (* SECTOR 2 *)
  FILL4 : PACKED ARRAY[0..255] OF CHAR; (* SECTOR 3 *)
  FILL5 : PACKED ARRAY[0..19] OF CHAR; (* SECTOR 4, PASCAL DIRECTORY *)
  DLASTBOOT : INTEGER;
  FILL6 : PACKED ARRAY[0..489] OF CHAR; (* SECTORS 4 AND 5 *)
 END;

 

You can unitwrite directly to sector 4 and 5, thus no need for that large a buffer. When I did it, I wanted to write into an unused sector before the p-system's directory.

[+Vorticon]

17 hours ago, apersson850 said:

You can unitwrite directly to sector 4 and 5, thus no need for that large a buffer. When I did it, I wanted to write into an unused sector before the p-system's directory.

I wondered about that but was not sure if the whole block of 6 sectors needed to be modified as at the same time. I'll make the change.

[+Vorticon]

Well what do you know... A typo! Psuedo instead of Pseudo. Somebody slipped up at TI 😄

 

[apersson850]

I've never noticed. Good you can use patch to edit such things directly in the code file. They don't have checksums.

[+Vorticon]

I have attached a disk image with the EDITOR/FILER/COMPILER and a SYSTEM.STARTUP file which sets PRINTER: to PIO and REMIN/OUT to 2400bps 8N1 then reads the system date and prompts you for a new date if applicable. It's essentially a modified MODRS232 file with the SETDATE program added to it. I tested it on real hardware and everything works at it should. Only requires a base system. Source code below.

Spoiler

(*$R- *)       (* Turn off range checking *)

PROGRAM INITSTATE;
USES MISC,
{$U COMMANDIO.CODE}
COMMANDIO;

(* This program is a modified version of the MODRS232                   *
 * utility program and sets the PRINTER: to PIO and REMIN/REMOUT:  to   *
 * 8-N-1. Also prompts for the date and sets it.                        *
 * Run SETLTYPE after compilation to change type to 9900.               *)

   const
      rddata  = -30720;
      rdstat  = -30718;
      wrtdata = -29696;
      wrtaddr = -29694;
      wrtenab =  16384;
      pabtbl  =  10716;  (* hex 29dc *)
      maxlen  =     43;
      DATELOC = 13840; {RAM LOCATION OF SYSTEM DATE}
      DIGIT = '0123456789';


   type
      byte = 0..255;

      DUAL = record
         case boolean of
         true: (int: integer);
         false:(ptr:^integer);
         end;

      BYTEWORD = RECORD
       CASE BOOLEAN OF
       TRUE : (VALUE : INTEGER);
       FALSE : (BYTES : PACKED ARRAY[1..2] OF BYTE);
      END;

      DIRTYPE = RECORD
       FILL1 : PACKED ARRAY[0..19] OF CHAR; (* SECTOR 4, PASCAL DIRECTORY *)
       DLASTBOOT : INTEGER;
       FILL2 : PACKED ARRAY[0..489] OF CHAR; (* SECTORS 4 AND 5 *)
      END;

   var
      cpuaddr: DUAL;
      curlen,period,vdpaddr: integer;
      savevdpaddr: integer;
      ch: char;
      unitno: integer;
      i,j: integer;
      pabname:string[43];
      action, date : string;
      err : boolean;
      WORD : BYTEWORD;
      YEAR, MONTH, DAY, IPOS, STRINGL : INTEGER;
      MONTHNAME, MSTRING : STRING;
      VALID : BOOLEAN;
      DIRECTORY : DIRTYPE;

PROCEDURE POKE(ADDR, VALUE : INTEGER);
VAR
 LOC : DUAL;

BEGIN {POKE}
 LOC.INT := ADDR;
 LOC.PTR^ := VALUE;
END; {POKE}

FUNCTION PEEK(ADDR : INTEGER) : INTEGER;
VAR
 LOC : DUAL;

BEGIN {PEEK}
 LOC.INT := ADDR;
 PEEK := LOC.PTR^;
END; {PEEK}

FUNCTION STR2INT(INSTRING : STRING) : INTEGER;
{CONVERTS A STRING TO AN INTEGER
 NO STRING VALIDATION IS DONE!}
VAR
 FIRSTDIGIT, LASTDIGIT, I, ACCUM : INTEGER;
 NEGATIVE : BOOLEAN;

BEGIN {STR2INT}
 NEGATIVE := FALSE;
 {CHECK IF NEGATIVE NUMBER}
 IF INSTRING[1] = '-' THEN
  NEGATIVE := TRUE;

 {CONVERT TO INTEGER}
 IF NEGATIVE THEN
  BEGIN
   FIRSTDIGIT := 2;
   LASTDIGIT := LENGTH(INSTRING) - 1
  END
 ELSE
  BEGIN
   FIRSTDIGIT := 1;
   LASTDIGIT := LENGTH(INSTRING)
  END;

 ACCUM := 0;
 FOR I := FIRSTDIGIT TO LASTDIGIT DO
  ACCUM := ACCUM * 10 + (ORD(INSTRING[I]) - 48);
 IF NEGATIVE THEN ACCUM := -ACCUM;
 STR2INT := ACCUM;
END; {STR2INT}


procedure swapbyte(var x:integer);

(* This procedure takes a word and reverses the order of the bytes *)

   type
      byteword = record
         case boolean of
         true: (addr:integer);
         false:(bytes: packed array[1..2] of byte);
         end;

   var
      word:  byteword;
      tbyte: byte;

   begin
      with word do
         begin
         addr := x;
         tbyte := bytes[1];
         bytes[1] := bytes[2];
         bytes[2] := tbyte;
         x := addr;
         end;  (* with statement *)
      end;  (* procedure *)

   procedure wrtvdpaddr (vdpaddr : integer);

   (* This procedure initializes the VDP ram chip to read/write from the *
    * address passed in the parameter vdpaddr.  *)

      begin
      cpuaddr.int := wrtaddr;
      swapbyte( vdpaddr );
      cpuaddr.ptr^ := vdpaddr;
      swapbyte( vdpaddr );
      cpuaddr.ptr^ := vdpaddr;
      end;  (* procedure *)

   function rdvdp (var vdpaddr : integer) : integer;

   (* This function reads a byte of data from the VDP ram address specified *
    * in the parameter vdpaddr.  *)

      begin
      wrtvdpaddr( vdpaddr );
      cpuaddr.int := rddata;
      rdvdp := cpuaddr.ptr^ div 256;  (* Right justify byte in word *)
      vdpaddr := vdpaddr + 1;
      end;  (* procedure *)

   procedure wrtvdp( var vdpaddr : integer;
                         data    : integer);

   (* This procedure writes the byte of data passed in the parameter *
    * data to the VDP ram address specified in vdpaddr.  *)

      var
         temp : integer;

      begin
      temp := vdpaddr + wrtenab;  (* Write enable the address *)
      wrtvdpaddr(temp);
      cpuaddr.int := wrtdata;
      cpuaddr.ptr^ := data * 256; (* Left justify byte in word and write *)
      vdpaddr := vdpaddr + 1;
      end;  (* procedure *)

   begin (* main program *)
    unitno := 6; (* select PRINTER: *)
    pabname := 'PIO';
    for j := 1 to 2 do
     begin
      cpuaddr.int := pabtbl + unitno * 2;
      vdpaddr := cpuaddr.ptr^ + 17;
      savevdpaddr := vdpaddr;

      period := 0;
      for i := 1 to length(pabname) do
       begin
        if (period = 0) and (pabname[i] = '.') then
         period := i - 1;
        if pabname[i] in ['a'..'z'] then
         pabname[i] := chr(ord(pabname[i])-32);
       end;  (* for loop *)

      if period = 0 then
       period := length(pabname);
      vdpaddr := savevdpaddr-17;
      for i := 1 to 2 do
       wrtvdp(vdpaddr,0);
      wrtvdp(vdpaddr, period);
      for i := 1 to 3 do
       wrtvdp(vdpaddr, 0);
      vdpaddr := savevdpaddr;
      for i := 0 to length(pabname) do
       wrtvdp(vdpaddr, ord(pabname[i]));
      unitclear(unitno);

      unitno := 7; (* select REMIN/REMOUT: *)
      pabname := 'RS232/1.BA=2400.DA=8.PA=N.EC';
     end;

  GOTOXY(1,2);
  WRITELN;
  writeln('PRINTER: PIO');
  writeln('REMIN/REMOUT: RS232/1.BA=2400.DA=8.PA=N.EC');
  writeln;


  (* prompt for the date and set it *)
 MONTHNAME := 'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';

 {GET SYSTEM DATE}
 WORD.VALUE := PEEK(DATELOC);
 YEAR := WORD.BYTES[1] DIV 2;
 WORD.VALUE := WORD.VALUE * 16;
 DAY := ORD((ODD(WORD.BYTES[1])) AND (ODD(31)));
 MONTH := WORD.BYTES[2] DIV 16;
 MSTRING := COPY(MONTHNAME,MONTH * 3 - 2, 3);
 WRITELN('SYSTEM DATE: ',DAY,'-',MSTRING,'-',YEAR);

 {ENTER CURRENT DATE}
 WRITELN('CURRENT DATE:', CHR(7));
 REPEAT
  VALID := TRUE;
  GOTOXY(13,7);
  WRITE('                               ');
  GOTOXY(13,7);
  READLN(DATE);
  IF DATE = '' THEN
   EXIT(PROGRAM);

  {PARSE DAY}
  IPOS := BREAK(DATE, DIGIT);
  IF (IPOS > 1) OR (IPOS = 0) THEN
   VALID := FALSE
  ELSE
   BEGIN
    I := SPAN(DATE, DIGIT);
    IF (I = 0) THEN
     VALID := FALSE
    ELSE
     IF (I > 2) AND (NOT(ORD(DATE[2]) IN [48..57])) THEN
      VALID := FALSE
     ELSE
      BEGIN
       MSTRING := COPY(DATE, 1, I-1);
       DAY := STR2INT(MSTRING);
       IF NOT(DAY IN [1..31]) THEN
        VALID := FALSE 
      END;
   END;

  IF LENGTH(DATE) < I + 5 THEN
   VALID := FALSE;

  {PARSE MONTH}
  IF VALID THEN
   BEGIN
    IF (DATE[I + 4] <> '-') OR (DATE[I] <> '-') THEN
     VALID := FALSE
    ELSE
     BEGIN
      MSTRING := COPY(DATE, I + 1, 3);
      IPOS := I + 5;
      I := POS(MSTRING, MONTHNAME);
      IF I = 0 THEN
       VALID := FALSE
      ELSE
       MONTH := (I + 3) DIV 3
     END;
   END;

   {PARSE YEAR}
   IF VALID THEN
    BEGIN
     STRINGL := LENGTH(DATE);
     IF (STRINGL < IPOS) OR ((STRINGL - IPOS) > 1) THEN
      VALID := FALSE
     ELSE
      BEGIN
       STRINGL := STRINGL - IPOS + 1;
       MSTRING := COPY(DATE, IPOS, STRINGL);
       FOR I := 1 TO STRINGL DO
        IF NOT(ORD(MSTRING[I]) IN [48..57]) THEN
         VALID := FALSE;
       IF VALID THEN
        BEGIN
         YEAR := STR2INT(MSTRING);
         IF NOT(YEAR IN [0..99]) THEN
          VALID := FALSE
        END;
      END;
    END;
  IF NOT(VALID) THEN
   BEGIN
    GOTOXY(22,7);
    WRITE(' INVALID DATE!',CHR(7));
   END;
 UNTIL VALID;

 {UPDATE SYSTEM DATE IN RAM}
 I := (YEAR * 512) + (DAY * 16) + MONTH;
 POKE(DATELOC, I);

 {UPDATE ROOT DISK WITH DATE}
 UNITREAD(4,DIRECTORY,SIZEOF(DIRECTORY),2);
 DIRECTORY.DLASTBOOT := I;
 UNITWRITE(4,DIRECTORY,SIZEOF(DIRECTORY),2);
END.




T

 

 

EDITOR-COM.dsk

[+Vorticon]

A little vintage computer porn 😊 Geek Nirvana...

 

[apersson850]

Haha, cool to see some technical pornography!

 

I'd like to point out a general memory related observation here.

The program @Vorticon wrote set the date and stuff uses a large buffer for the directory. In that particular program it doesn't matter, since it is what it is and doesn't have to grow substantially larger. But as a general note this information on memory use could be good to know about.

 

Variables and the stack

We usually say that Pascal (or rather the p-system, but I'll call it Pascal in this post) has only one stack. Unlike Forth which has two. Forth splits data used for calculations and data used to return from subroutines on different stacks. Pascal stores everything on the same stack.

The division of things on two stacks in Forth means that it's easy to know which data type is stored where. In Pascal, when a procedure is called, an activation record is created and pushed on the stack. This record contains five words with various links. A return link to the caller and pointers to the activation records of the caller and lexical parent are som of them. Then comes all local data in the called procedure and on top of that is then the parameters to the procedure pushed.

By storing a pointer to the activation record in R9, the PME can access all local variables by indexing from that pointer and traverse links to variables above itself by traversing links through the activation record. The PME also has a global data frame pointer in R14, to speed up access of global variables.

The fact that space for a procedure's local data is created when the procedure is called and then disposed on exit from the procedure implies that the creation of large buffers are better done on procedure level, rather than in the main program. If it's in the main program, it's global data and such data will occupy space as long as the program is executing. If it's a variable in a procedure, it will only live as long as it's actually used.

 

Variables on the heap

But what if you want the variable to be accesible globally but not occupy space when it's not used?

Then your answer is the heap. The heap is a memory area separate from the stack. On the stack, things are allocated and removed in a first in-last out order. But on the heap it's allocation and disposal in any order. The p-system version IV.x does include a true heap, so this is literally the way it works. In older systems it was more an alternative stack, a bit like Forth's design. But here it's more flexible.

Now you can declare a pointer to a large buffer as a global variable, instead of the buffer itself. The pointer will only use one word of memory. But when you execute the statement new(bufpointer), a space for the buffer will be allocated on the heap and you can access the buffer via bufpointer^. When you're done with it you do dispose(bufpointer) and the space is released back to the system again. Still, bufpointer and hence bufpointer^ are globally accessible.

 

Memory allocation strategy

If you now design your program in a clever way, you only allocate space for things when needed. Either on the stack or on the heap. Both of these memory areas are in the 24 K RAM part of your computer's memory. Thus if at the same time either the stack is big and the heap is small, or vice versa, you can have space for variables with a total size of more then 24 Kbytes but still manage.

But what about the code? If the heap and stack fills the memory sometimes, where does the code go?

Well, p-systems usually either have an internal code pool, which is then in between the heap and stack, or an external one, which is in some other memory segment. We frequently find the 99/4A being a bit odd, and it doesn't let us down here either. Thus it has both. There is an internal code pool in the 24 K RAM, between heap and stack as usual, and then also an external code pool in VDP RAM between the screen data and disk buffer. The one in VDP is the primary one. As long as your program fits there, it will run there, leaving all of the 24 K RAM for data. Just keep your compiled programs small enough to fit in the primary code pool and you have a good space for data.

But what if your program doesn't fit? You may want to write a program that's 16 Kbytes long. Then it must go to the secondary code pool and leaves not too much left over there for data. Meanwhile, the primary code pool is empty, since your program doesn't fit in there.

 

Segmented software

The answer to this is segments. By splitting your program up in segments, the p-system doesn't have to load the whole program in one big chunk. A segment will be loaded from disk when it's called. If needed, it will be removed from memory when it's not in use, if it's necessary to call another segment and both can't fit in the same time.

You get the most out of this if you can divide your program into parts that are clearly separate from each other. Here's a list of some possible program parts that are likely to be candidates for segments, since you will probably be able to only have the main program and one more segment running at the same time.

 

Program with

• Startup code
• Data entry code
• Computation code
• Result inspction on screen
• Result formatting and output on printer
• Store/read data on disk
• Program setup code, like printer definitions, pagelength settings

 

If you make the procedures called for these various tasks segment procedure, then they'll only be in memory when needed. If each part is so large that it's subject to separate compilation, then you'll make units of them, and units will automatically become individual segments. Still, you can use separate segment declarations inside the implementation part of a unit, if the different parts of it are still to big to be segments by themselves.

 

The program from which I took the global data declarations and posted above has the following declarations in the beginning of the main program:

program dust_buster;

uses
  various system units,
  dustglobal,
  dust_entry,
  dust_show,
  dust_io,
  dust_change,
  dust_print,
  dust_back;

System units are things like commandio and my own extrascreen. They are utilities and not really a part of the program's logic.

dustglobal holds all global data declarations. They are in a separate unit, since they are referenced by all the other units too, not just by the main program.

dust_entry handles data input from the keyboard.

dust_show displays the data on the screen.

dust_io handles disk in/output.

dust_change allows traversing data and do changes on the screen.

dust_print formats and handles data for printout.

dust_back is a backdoor into changing settings for printer, backup data file, some global report settings and similar stuff.

 

The result of this segmentation is that in spite of the program being quite large, only about one quarter of it needs to be in memory at the same time. Also all local variables (and there are only local variables) in the other units are also allocated only when needed. The main data structure in dustglobal is a linked list, where each list item also is allocated when needed only.

This is the main reason I liked Pascal so much on the 99/4A. It was, and is, that only environment where this kind of memory management is supported from start. You can do similar things in other languages, but you have to invent them yourself. The only effort here is some planning (and that you have to do in other languages as well) and the effort to type in segment in some places.

[Rhodanaj]

On 1/27/2024 at 11:27 PM, Vorticon said:

A little vintage computer porn

A little modern computer porn from me .... Nothing is hidden ... 😊

In 2006 I got the computer game 'Sacred Gold' as a gift, but when I wanted to play it, the video card became to hot and the computer crashed...

To play this game I had to remove one side of the computer housing and place a chamber ventilator in frond of it to cool the video card. This was working very fine!

When I got a new computer ( = motherboard ) I wanted to try it with no housing around it and this was working very good too. This is now my 3th motherboard withoud housing around it and I never got trouble with them.

[+Vorticon]

Saw this on Amazon https://a.co/d/5933hsy which is kind of weird as it seems to be a new offering. Who still uses UCSD Pascal in the modern era???

Great stocking stuffer for @apersson850 😁

[apersson850]

Well, you could still be a guru, even if you have retired from actually using your magic skills.

Since I work with a company that manufactures book making machinery, maybe we should make a thousand of them...

[+Vorticon]

The Linker manual states that variables passed to assembly language procedures/functions are placed on the stack as a pointers to the variables. I assume this means that the stack will contain a memory location containing the value of a variable? And are variables always stored in expansion RAM or do they also exist in VDP RAM?

[Rhodanaj]

The stack pointer points to the memory location of the variable in the Pascal program.

I ones needed the contents of an array in assembly language, but the manual told me that you cannot link an array to assembly language.

I then created an integer in Pascal, in which I put the length of the array and directly below that, the array itself. I then attach the integer to the assembler. In assembler i got the address of this integer and then I could also access the data after this address.

See this test program:

Quote

Program ARR;
var
  DAT_COUNT: integer;
  DAT: array[1..10] of INTEGER;
  DAT2: array[1..10] of INTEGER;
  X: INTEGER;

PROCEDURE GET_ARRAY(VAR DAT_COUNT : INTEGER); EXTERNAL;

BEGIN 
    DAT_COUNT := 10;
    FOR X := 1 TO DAT_COUNT DO
      BEGIN
        DAT[X] := X+64;
      END;
    GET_ARRAY(DAT_COUNT);
    FOR X := 1 TO 10 DO
      BEGIN
        WRITELN(DAT[X],'  ',DAT2[X]);
      END;
END.  
 

and

Quote

  .PROC   GETARRAY,1

  MOV *R10+,@ARRAY   ; ARRAY = ADDRESS IN PASCAL OF DAT_COUNT
  BLWP     @BEGIN
  B       *R11     ; EINDE

 

BEGIN   .WORD MYWS,START
ARRAY  .WORD
MYWS    .BLOCK 20H

START
     MOV @ARRAY,R10   ; R10 = ADDRESS IN PASCAL OF ARR
     MOV *R10+,R7     ; CONTENS OF DAT_COUNT TO R7 = IS ALSO LENGTH OF ARRAY 
     INC  R10         ; INFO ABOUT ARRAY ?
     MOV R10,R3       ; START ADDRESS OF ARRAY IN R3 
     MOV R3,R4
     AI R4,20         ; START ADDRESS OF ARRAY2 IN R4 = R3 + LENGTH OF ARRAY
L1 MOV *R3+,*R4+   ; MOVE CONTENT OF ARRAY1 TO ARRAY2
     DEC R7
     JNE L1

 

    RTWP            
   .END
 

 

[+Vorticon]

41 minutes ago, Rhodanaj said:

The stack pointer points to the memory location of the variable in the Pascal program.

I ones needed the contents of an array in assembly language, but the manual told me that you cannot link an array to assembly language.

I then created an integer in Pascal, in which I put the length of the array and directly below that, the array itself. I then attach the integer to the assembler. In assembler i got the address of this integer and then I could also access the data after this address.

See this test program:

and

 

Actually you can access arrays, but always by reference. When you use an array as a parameter, a pointer to that array is put on the stack which you can then use to access the array elements from assembly.

[apersson850]

Assuming you have these two declarations, then the first one will get one integer and one real value on the stack.

The second one will get two pointers.

procedure dothis(x: integer; y: real); external;
procedure dothat(var x: integer; var y: real); external;

But if you have these two declarations, both procedures will get pointers to an array and a string.

type
  table = array[0..10] of integer;

procedure dothis(x: table; y: string); external;
procedure dothat(var x: table; var y: string); external;

Some larger items than integers and reals aren't sent by value, only by reference. But sets, long integers and strings can be sent by value. Section 3.2.1 in the Linker manual lists some of the conventions here.

The compiler does the same with Pascal procedures. It's up to the procedure's code to make sure that a parameter by value isn't changed, in spite of you knowing where it is (via the pointer). When compiling Pascal programs, the compiler will take care of that by providing the called procedure with a pointer to a separate copy of the variable. If you change the variable sent to you, something you can do, it's the local copy that's updated, so no change will be sent back to the caller. When the procedure returns, the local storage is discarded.

 

What is complicated is to figure out where the data is if you do this kind of call.

const
  happy = 'I am happy since I have a 99/4A';

type
  table = array[0..10] of integer;

var
  list: table;

procedure dothis(x: table; y: string); external;

begin
  dothis(list,happy);
end.

The reason for that is that it's tricky to figure out where in the segment's global constant pool the definition of happy is stored. Your assembly routine will get a segment-relative constant pool pointer to try to understand. It's easier to find if the value is in a string variable.

Hence in such a case it's easier to do like this, where you let the compiler do the work to find the data for you.

const
  happy = 'I am happy since I have a 99/4A';

type
  table = array[0..10] of integer;

var
  list: table;
  dummy: string;

procedure dothis(x: table; y: string); external;

begin
  dummy := happy;
  dothis(list,dummy);
end.

 

Edited February 5 by apersson850