Pascal on the 99/4A

[Lisias]

Wait the GROMs for a 30 year old card are still being protected as special code?

 

You have to be kidding right? How much money would they lose vs the cost of a suit?

I don't know! :-)

 

All I know is what's written on the README.txt on the Classic99's source code.

 

I also found a mention that some "retro computer enthusiast" got a permission to distribute some TIi's ROMs, so it fits.

 

If the guy is overreacting, or he's really protecting his permission, I honestly don't know.

 

ADDENDUM:

 

I talked to a friend of mine, and she explained that Corporations are almost induced to sue any known infringements in order to protect the TRADEMARK, not the product. Old and obsolete products doesn't worths anything in money, but they still have the company's trademark on it. It happens that a trademark can be lost if the owner doesn't sue anyone and everybody that uses it without permission (and, sometimes, even with the permission).

 

I found this about the case: http://www.inta.org/TrademarkBasics/FactSheets/Pages/LossofTrademarkRightsFactSheet.aspx

Edited January 2, 2015 by Lisias

[Tursi]

You guys.... "the guy" is right here. DUH.

 

So point the first: I took the trouble to get permission from TI to include the ROMs with Classic99. They are embedded in the executable - as some of you have known for over a decade. TI's condition was that I include the copyright mentions and limitations that I do.

 

The reason I took the raw files out of the executable was because two people, separated by time and space, saw fit to publish means to download my emulator, extract the ROMs from the ZIP, delete the rest, and run MESS. In my eyes, that's rude and I don't have to support it.

 

You can get the ROMs from all over the place. Don't need me!

[+OLD CS1]

Don't need me!

 

You under-estimate your value around here, sir. heheheheh

[+Ksarul]

I definitely agree with that one, OLD CS1! Tursi is of major importance to the TI community! Even when he isn't an obvious part of something--he's often right in the thick of it, making new TI goodness come to fruition. I for one am really glad he's here!

[Tursi]

I meant nobody needs me to get access to TI ROMs, they were just being lazy and rude.

 

Although at least the second guy asked, although he got offensive when I said no. The first guy just went ahead and published it in an O'Reilly book back in 2005, never even contacted me. That was a combination of flattering and annoying, but I still changed the archive.

[Lisias]

Sorry to bring this to the forum. I was cautelous about this issue because I already saw good sites and products being taken down for minor "offenses" - as a spanish ZX Spectrum site that was taken down for publishing screenshots of Spectrum games. (yeah, don't ask - I never understood what happened there).

About the ROMs, I almost agree with you : they're (almost of them) available elsewhere. It's perfectly possible to download them, rename them and then repopulate the ROMs directory in order to rebuild the executable.

But at least the UCSD Pascal GROMs wasn't so easy to find for me. Ok, perhaps I spent the week looking on the wrong sites, but all I managed to get was the DSR's ROM on whtech. I found this weird, as the disks and manuals are openly redistributed here - so why not the GROMs?

Funny enough, I realized I already had that GROMs when I found an old Classic 99' source package. :-)

Sorry to bother you with this matter.

[Tursi]

It's no bother, but that's why it is what it is.

[+dhe]

Turbo Pasc'99. Back in the day, I was really excited about this product, as I did a lot of Turbo Pascal Programming in College. I was in pretty close contact with Larry Connors at the time (he lived about an hour and a half drive away) who at the time was going to Germany about once every couple of years. At one of the TI Fest/Fairs in Germany he spoke with the developers and become the sole US Distributor. I purchased a copy of the software as soon as it was available (I'm think $60ish in late 80's dollars). Unfortunately the US manual had lots of room for improvement. I went through and did a lot of fixes for the manuals and gave that to Larry. Unfortunately no v2 of the manual ever happened. About the time Barry Boone got a hold of the source code and made some patches. Unfortunately, I never found out what those patches and fixes was, and the only thing Larry had was a copy of the source code. The source code was a lot like the archiver source code. Very dense assembler code with no comments.

 

At that time, the developers of Turbo Pasc'99 had a number of extra packages that they planned on releasing. I think, sound and graphics was one. I spoke to Wolfgang at one of the fairs and he thought he might have had the German additional packages. He said the guys that developed the software disappeared not to long after creating the packages.

 

This package had the potential to be as professionally done as Fortran for the 4a. The hardwork was already done, it just needed a little bit more to refine the docs, some tutorials, additional memory support and translation of the additional packages manual.

 

Dan

[+Ksarul]

At least one of the additional packages was released for TurboPasc99, as well as a book on programming with it (in German--I have the book). The German distributing company (WiPosoft) got into trouble with the Munich Kripo (Criminal Police) for software piracy and went insolvent--the programmers disappeared in the aftermath of that debacle. . .

[lucien2]

At that time, the developers of Turbo Pasc'99 had a number of extra packages that they planned on releasing. I think, sound and graphics was one.

Since you can easily mix pascal with assembly, you can add sound and graphics yourself.

With only 2 small assembly routines to read/write a byte to VDP, I implemented GCHAR, COLOR, CHAR and HCHAR: http://atariage.com/forums/topic/185137-bricks-demo/page-3?do=findComment&comment=2609401

[+mizapf]

But at least the UCSD Pascal GROMs wasn't so easy to find for me. Ok, perhaps I spent the week looking on the wrong sites, but all I managed to get was the DSR's ROM on whtech. I found this weird, as the disks and manuals are openly redistributed here - so why not the GROMs?

 

I admit it is not really obvious, but all (G)ROMs you need can be found in ti99_complete.zip on WHTech. Of course, you should not download them if you don't own the real hardware.

[+dhe]

Did anyone ever get the UCSD Pascal GROMS to run from the HSGPL card?

[+mizapf]

This should be pretty impossible as far as I can tell. The GROMs in the P-Code card are accessed via special GROM ports at 5BFC/E and 5FFC/E with a dedicated GROM select line on the card.

[Lisias]

Did anyone ever get the UCSD Pascal GROMS to run from the HSGPL card?

 

 

This should be pretty impossible as far as I can tell. The GROMs in the P-Code card are accessed via special GROM ports at 5BFC/E and 5FFC/E with a dedicated GROM select line on the card.

 

Impossible? Not. But very hard.

 

One need to dissassemble the DSR ROM's module, then change all references from the UCSD Card GROM address to the HSGPL ones, then probably relocate the code to run on some other address (as the Command Module one) with a new banking mechanism (those handling code must replace the original one, by the way) or, alternativelly, relocate it to run on the 32KB memory area (but this will waste precious RAM).

 

There're people doing similar work on other platforms - but granted, it's not trivial work. Far from it.

[+mizapf]

Hmmm ... would "unfeasible by reasonable efforts" be a better wording?

[apersson850]

Whichever. It's not feasible at least. Moving the code on the p-code card to 32 K RAM is very impossible, since all that memory is required to be available to the p-system as RAM, not for hosting it's own code.

The other part is of pretty impossible. It can be done, sure, but there's not only code in ROM that's referencing the address ports for GROM on the p-code card. There's also assembly code stored on the p-code card, in GROM, code that's transferred to RAM on bootup. Either for speed reasons (the inner part of the p-code interpreter runs in 16-bit RAM at 8300H) or because it has to be available also when the p-code card is disabled to allow access to other cards in the expansion box.

 

I had a look at Turbo Pasc 99, but it was very rudimentary compared to the UCSD implementation. Lower cost, of course, but since I already had the p-code system at the time when Turbo Pasc 99 became available, there was no point in leaving the p-code system for an inferior one.

[apersson850]

Speaking of memory, I found this document in one of my old computers. It describes the code I used to install RAM-disks with the 99/4A p-system. Thus it was possible to run things like the Pascal compiler from RAM-disk, not floppies. Due to the extensive segmentation of the compiler, having it on RAM cut the compile time by 50%.

 

The code is attached.

 

ramdisk.pdf

[apersson850]

Oh, cool. Good job! I have no clue on where one would start to write the code for that, would you mind sharing what you've written? And what did you write it in?

 

Sorry, I never noticed this question. The dformat program I wrote is a mix of Pascal and assembly. You use it just like you use the original dformat program that's supplied with the p-system.

[apersson850]

I just realized that code can be posted in this format as well. This is the content of the ramdisk.pdf I posted above.

 

 

This is the rather general installation utility which I use to enable my RAMdisk in the p-system.
There is one external function in the program. It’s listed after the program.
The unit extrascreen provides additional input support from the keyboard (among other things), but the routines used in this program are fairly obvious. Besides, I think the unit is available at the wht pages, or whatever they are called.

Due to the fact that the listings were 15 years old, and difficult to scan, extensive editing has been done with this text. Hopefully, there are no serious errors, but if you find any, let me know!

Anders Persson


	Created at Jan 28, Thu, 15:14,32
	RAMDISK:DISKINSTAL.TEXT

Program ram_disk_installation;
  (* Used to install one or two RAMdisks for use with the p-system *)
  (* A-DATA 880128 *)

uses
  extrascreen,
  misc;

const
  disk_kind = 11376;	(* Address to unit I/O procedure pointer table for
* blocked devices. *)

type
  loc_type = record
    occupied: boolean;
    addr: integer;
  end; (* loc type *)
  loc_arr_type = array[1..2,1..2] of loc_type;
  addr_arr = array[0..32] of integer;
  addr_type = ^addr_arr;

var
  pcb_address;	(* Address in VDP RAM of Peripheral Control Block *)
  base,	(* CRU base of RAM disk *)
  device_no,	(* I/O unit number *)
  loc: integer;
  continue: boolean;
  pcb_pointer,
  kind_pointer: addr_type;
  locations: loc_arr_type;


function find_entry_addr(cru_base: integer): integer;	external;
 (* Returns the entry address of the sector R/W subprogram on the RAM disk in
    question. This requires bit I/O (CRU access), which must be done in
    assembly language. *)

function baseaddress: integer;
 (* Lets the user input the CRU base address of the RAMdisk in being installed. *)

var
  good: boolean;
  ch: char;
  line: string;

begin (* baseaddress *)
  gotoxy(0,5);
  writeln(‘Give the CRU base address of your’);
  write(‘RAMdisk (in hex, please).’);

  repeat
    gotoxy(0,7);
    write(‘Address? ‘,chr(141));
    validstring(line,4,[‘0’..’9’,’A’..’F’,’a’..’f’];
    (* Check the address for validity. All valid CRU base addresses look
       like 1x00, where x is a hex digit in the range 0..F. *)
    if length(line)=4 then
      good := (line[1]=’1’) and (line[3]=’0’) and (line[4]=’0’)
    else
      good := false;
  until good;

  (* Convert the characters to an integer *)
  upper_case(line,line);
  ch := line[2];
  if ch>’9’ then
    ch := chr(ord(ch)-7);
  baseaddress := 4096+(ord(ch)-48)*256;
end; (* baseaddress *)

procedure heading;
 (* Writes the heading when the program starts *)

begin
  page(output);
  gotoxy(5,0);
  write(‘RAMdisk installation’);
  gotoxy(0,2);
  writeln(‘A tool for the TI 99/4A p-system by’);
  write(‘Anders Persson, Sweden.’);
end; (* heading *)

function in_as_unit: integer;
 (* Asks the user about the I/O unit number to use for the RAMdisk. *)

var
  temp: integer;

begin (* in as unit *)
  gotoxy(0,9);
  writeln(‘The RAMdisk may be installed as unit’);
  write(‘#11: or #12:.’);

  repeat
    gotoxy(0,11);
    write(‘Unit #? ‘,chr(141));
    temp := validint(2,[‘1’,’2’]);
  until temp in [11,12];
  in_as_unit := temp;
end; (* in as unit *)


function pcb_location: integer;
 (* Lets the user select the character pattern table or the sprite motion
    table as the destination for the peripheral control block. *)

var
  choice: integer;

begin (* pcb location *)
  gotoxy(0,13);
  writeln(‘The peripheral control block can be’);
  writeln(‘placed in the character pattern table or’);
  writeln(‘in the sprite motion table.’);
  writeln(‘Select one alternative.’);
  writeln(‘1 – Character pattern table’);
  writeln(‘2 – Sprite motion table’);

  repeat
    repeat
      choice := bufscan;
    until choice<>-1;
    choice := choice-48;
  until choice in [1,2];
  pcb_location := choice;
end; (* pcb location *)

function overwrite(unitno: integer): boolean;
 (* Asks for permission to reload the same logical device number *)

var
  ch: char;

begin (* overwrite *)
  gotoxy(0,13);
  writeln(‘Unit #’,unitno,’ is already installed.’);
  write(‘Overwrite?`’);

  repeat
    gotoxy(11,14);
    write(chr(141));
    read(ch);
  until ch in ['Y',’y’,’N’,’n’];
  overwrite := ch in [‘Y’,’y’];
end; (* overwrite *)


procedure init_tables
 (* Initiates tables. Determines already occupied pcb locations to avoid
    collisions if this program is used to install two RAMdisks. *)
  (var pcb_pointer,
       kind_pointer: addr_type;
   var locations: loc_arr_type);

const
  addr1 = 2010;	(* PCB addresses in Character Pattern Table *)
  addr2 = 2029;
  addr3 = 3418;	(* PCB addresses in Sprite Motion Table *)
  addr4 = 3437;
  (* Addresses of unit description tables in the BIOS data area. *)
  base_device_kind = 11296;
  base_pcb_loc = 10716;

var
  i,
  temp: integer;

  
  procedure mark_occupied
   (* Determines occupied pcb locations *)
    (    used: integer;
     var locations: loc_arr_type);


  var
  i,
  j: integer;

  begin (* mark occupied *)
    for i := 1 to 2 do
      for j := 1 to 2 do
        with locations[i,j] do
          if addr=used then
            occupied := true;
  end; (* mark occupied *)


begin (* init tables *)
  (* Fix to load pointers with desired values. *)
  temp := base_device_kind;
  moveleft(temp,kind_pointer,2);
  temp := base_pcb_loc;
  moveleft(temp,pcb_pointer,2);

  fillchar(locations, sizeof(locations),chr(0));
  locations[1,1].addr := addr2;
  locations[1,2].addr := addr1;
  locations[2,1].addr := addr4;
  locations[2,2].addr := addr3;

  (* Mark occupied locations if the I/O devices are active *)
  for i := 11 to 12 do
    if kind_pointer^[i]<>0 then
      mark_occupied(pcb_pointer^[i],locations);
end; (* init tables *)


function pcb_addr_in_vdp
 (* Determines the address in VDP RAM where the pcb should be loaded. *)
  (    loc: integer;	(* Pattern vs. Motion tables *)
       pcb_pointer: addr_type;
   var locations: loc_arr_type): integer;

var
  i: integer;
  found: boolean;

begin (* pcb addr in vdp *)
  (* If the device was already active, use the previous PCB location. *)
  if loc=0 then
    pcb_addr_in_vdp := pcb_pointer^[device_no]
  else
  begin
    (* This is somewhat overkill for the current task, but easy to expand
       upon. *)
    found := false;
    i := 1;
    while (i<=2) and not found do
      with locations[loc,i] do
        if not occupied then
        begin
          found := true;
          pcb_addr_in_vdp := addr;
          occupied := true;
        end
        else
          i := i+1;
  end; (* if-else *)
end; (* pcb addr in vdp *)

procedure make_pcb
 (* Makes a Peripheral Control Block, and loads it into VDP RAM *)
  (    cru_base,
       pcb_addr: integer);

const
  (* This procedure requires access to VDP RAM, which in turn requires
     knowledge of the addresses used for mapping in the VDP itself. *)
  rddata = -30720;
  rdstat = -30718;
  wrtdata = -29696;
  wrtaddr = -29694;
  wrtenab = 16384;

type
  byte = 0..255;
  window = record
    case boolean of
      true: (int: integer);
      false: (ptr: ^integer);
  end; (* window *)

  buf_type = packed array[0..19] of char;

var
  temp,
  i: integer;
  pcb: buf_type;


  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 *)
  end; (* swapbyte *)


  procedure wrtvdpaddr(vdpaddr: integer);
   (* This procedure initializes the VDP RAM chip to read/write from the
      address passed in the parameter vdpaddr. *)

  var
    cpuaddr: window;

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


  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
    cpuaddr: window;
    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; (* wrtvdp *)

begin (* make pcb *)
  (* Set up the Peripheral Control Block. *)
  fillchar(pcb,sizeof(pcb),chr(0));
  pcb[2] := chr(1);	(* Character count (to the first period, if any). *)
  pcb[6] := chr(1);	(* Version number *)
  pcb[7] := chr(10);	(* Link offset *)
  pcb[10] := chr(63);	(* Buffer address in PAB (MSByte) *)
  pcb[17] := chr(1);	(* Name length byte in PAB *)
  pcb[18] := chr(16);	(* Name of sector R/W subprogram *)
  moveleft(cru_base,pcb[4],2);	(* Load CRU base *)
  temp := find_entry_addr(cru_base);
  moveleft(temp,pcb[0],2);	(* Load entry address *)

  (* Now, move the whole thing to VDP RAM *)
  for i := 0 to 18 do
    wrtvdp(pcb_addr,ord(pcb[i]));
end; (* make pcb *)


procedure sys_software
 (* Tells the system that all system software (compiler, editor etc.) is
    located on the RAMdisk. Usually it is, and if not, the system locates
    the files upon next invocation anyway. *)
  (    device_no: integer);

const
  sys_info_address = 14370;	(* Address of system file info block *)
  sys_name = ':SYSTEM.';
  link_name = 'LINKER';
  filer_name = 'FILER';
  ed_name = 'EDITOR';
  comp_name = 'COMPILER';
  assm_name = 'ASSMBLER';

type
  name_type = string[23];
  sys_rec_type = record
    linker,            (* Note that the files are given in the reverse order *)
    filer,             (* compared to actual memory locations. This is due *)
    editor,            (* to the compiler allocation strategy. *)
    compiler,
    assembler: name_type;
  end; (* sys rec type *)
  info_type = ^sys_rec_type;

var
  sys_soft_info: info_type;
  temp: integer;
  str_no,
  sys_prefix: string;

begin (* sys software *)
  str(device_no,str_no);
  sys_prefix := concat('#',str_no,sys_name);
  temp := sys_info_address;
  moveleft(temp, sys_soft_info,2);

  with sys_soft_info^ do
  begin
    linker := concat(sys_prefix,link_name);
    filer := concat(sys_prefix,filer_name);
    editor := concat(sys_prefix,ed_name);
    compiler := concat(sys_prefix,comp_name);
    assembler := concat(sys_prefix,assm_name);
  end; (* with *)
end; (* sys software *)

begin
  heading;
  init_tables(pcb_pointer,kind_pointer,locations);
  base := baseaddress;
  device_no := in_as_unit;
  (* See if the device already exists. *)
  if kind_pointer^[device_no]=0 then
  begin
    continue := true;
    loc := pcb_location;
  end
  else
  begin
    continue := overwrite(device_no);
    loc := 0;
  end;

  if continue then
  begin
    pcb_address := pcb_addr_in_vdp(loc,pcb_pointer,locations);
    make_pcb(base,pcb_address);
    pcb_pointer^[device_no] := pcb_address;
    kind_pointer^[device_no] := disk_kind;
(*$I-*)
    unitclear(device_no);
    if ioresult=0 then
    begin
      sys_software(device_no);
      gotoxy(0,22);
      write('RAMdisk installed');
    end;
(*$I+*)
  end;
end.

  


	Created at Jan 28, Thu, 15:16.05
	TIMING:DISKASM.TEXT

;-----------------------------------
;
; Support for RAMdisk installation utility
;
; function find_entry_addr(CRU_base: integer): integer;
;
; Returns the entry address of the sector R/W subprogram on the card with the
; given CRU base address.
; Returns zero if the subprogram can’t be found.
;
; A-DATA 880127
;

SP	.EQU	10

	.FUNC	FIND_ENTRY_ADDR,1

PCODE	.EQU	1F00H

	MOV	R12,R7	;Save R121
	LI	R12,PCODE	;Disable p-code card
	SBZ	0
	MOV	*SP+,R12	;Enable the RAM disk
	SBO	0

	MOV	@400AH,R2	;Subprogram link
	JEQ	UNABLE	;No subprograms?
SEARCH	C	$4(R2),@RWPRGM	;Look for R/W subprogram
	JEQ	FOUND
	MOV	*R2,R2	;Look at next entry
	JNE	SEARCH	;If there is any…

UNABLE	CLR	*SP	;Return zero if nothing found
PASCAL	SBZ	0	;Back to host; Disable the RAM disk
	LI	R12,PCODE	;Enable the p-code card again
	SBO	0
	MOV	R7,R12
	B	*R11

FOUND	MOV	@2(R2),*SP	;Return entry address
	JMP	PASCAL

RWPRGM	.WORD	0110H	;Sector R/W program

	.END

 

 

Edited February 17, 2015 by apersson850

[apersson850]

Here's the code of the Pascal part of the disk formatter. An assembly procedure is also required, but I don't have that in this format now.

I notice now that the tabs in the code spreads it out more than it should.

 

 

program dformat;
 (* Disk formatter utility by A-DATA 851228 *)
 
uses
  extrascreen;
  
var
  sdtable: array [1..2] of string;
  
procedure asmformat(var errcode: integer;
                    drive, tracks, sides, density: integer;
			          		var buffer); external;
 (* Low level formatter procedure *)

procedure handle_format;
 var
	unitno,
	tracks,
	sides,
	density,
	drive,
	errcode: integer;
	ok:	boolean;
	ch: char;
	
	procedure format(var errcode: integer;
									 drive, tracks, sides, density: integer);
	(* Higher level formatter *)

	type
		buftype = packed array[0..4095] of integer;
		
	var
		buffer: buftype;
		
	begin (* format *)
	  asmformat(errcode,drive,tracks,sides,density,buffer);
	end; (* format *)
	
	function sdconv(ch:char; var ok:boolean):integer;
		(* Converts 's' and 'd' to 1 and 2 *)
	
	begin
		ok := false;
		case ch of
		  'S','s':begin
								sdconv := 1;
								ok := true;
							end;
			'D','d':begin
								sdconv := 2;
								ok := true;
							end;
		end; (* case *)
		if not ok then
		  writeln(chr(7),'  ERROR - Response must be S or D');
	end; (* sdconv *)
	
	function unit_to_drive(unitno:integer):integer;
	
	begin
	  case unitno of
			4: unit_to_drive := 1;
			5: unit_to_drive := 2;
			9: unit_to_drive := 3;
		 10: unit_to_drive := 4;
		end; (* case *)
	end; (* unit_to_drive *)
	
	procedure error_report(code:integer);
	
	begin
		case code of
			6: begin
					 writeln(chr(7));
					 writeln('  ERROR - Can''t find unit/diskette');
				 end;
			7: begin
					 writeln(chr(7));
					 writeln('  ERROR - Unable to format');
				 end;
		 52: begin
					 writeln(chr(7));
					 writeln('  ERROR - Diskette write protected');
				 end;
		end; (* case *)
	end; (* error_report *)
	
	procedure write_info(unitno,tracks,newsides,newdensity:integer);
		(* Creates a disk head on the formatted disk *)
		
	type
	  nametype  = packed array[0..9] of char;
		byte      = 0..255;
		dinfotype = packed record
			diskname   :nametype;
			disksize   :integer;
			valider    :packed array[0..3] of char;
			trackonside:byte;
			sides,
			density    :byte;
			fill1      :packed array[20..55]of char;
			allocation :packed array[0..199] of char;
			headpoint  :packed array[0..127] of integer;
		end; (* dinfotype *)
		
		finfotype = packed record
			filename  :nametype;
			fill1			:integer;
			status,
			maxrecord :byte;
			used			:integer;
			eofoffset,
			recl			:byte;
			sectused	:integer;
			fill2			:packed array[20..27] of char;
			cluster		:packed array[0..227] of char;
			fill3			:packed array[0..255] of char;
		end; (* finfotype *)
		
		var
			diskinfo:dinfotype;
			fileinfo:finfotype;
			
			procedure swapbyte(var x:integer);
			 (* Takes a word and swaps 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 (* swapbyte *)
			  with word do
				begin
					addr := x;
					tbyte := bytes[1];
					bytes[1] := bytes[2];
					bytes[2] := tbyte;
					x := addr;
				end; (* with *)
			end; (* swapbyte *)
			
		begin (* writeinfo *)
			with diskinfo do
			begin
				diskname := 'PASCAL    ';
				disksize := tracks*newsides*9*newdensity;
				valider := ' DSK';
				valider[0] := chr(9*newdensity);
				trackonside := tracks;
				protection := ' ';
				density := newdensity;
				sides := newsides;
				fillchar(fill1,sizeof(fill1),chr(0));
				fillchar(allocation,sizeof(allocation),chr(255));
				fillchar(headpoint,sizeof(headpoint),chr(0));
				headpoint[0] := 2;
			end; (* with *)
			unitwrite(unitno,diskinfo,512,0);
			
			with fileinfo do
			begin
				filename := 'PASCAL    ';
				fill1 := 0;
				maxrecord := 2;
				status := 0; (* Display/Fixed *)
				used := diskinfo.disksize-3;
				recl := 128;
				eofoffset := 0;
				sectused := maxrecord*used;
				swapbyte(sectused);
				fillchar(fill2,sizeof(fill2),chr(0));
				fillchar(cluster,sizeof(cluster),chr(0));
				cluster[0] := chr(3);
				cluster[1] := chr((used-1) mod 16)*16);
				cluster[2] := chr((used-1) div 16);
				fillchar(fill3,sizeof(fill3),chr(0));
			end; (* with *)
			unitwrite(unitno,fileinfo,512,1);
		end; (* writeinfo *)
			
	begin (* handle_format *)
	  repeat
			page(output);
			writeln('D I S K  F O R M A T  U T I L I T Y');
			gotoxy(30,1);
			writeln('A-DATA 85');
			
			repeat
				writeln;
				writeln('Enter the number of the unit');
				write('holding the diskette (4,5,9,10). ');
				unitno := validint(2,digit);
				writeln;
				ok := unitno i [4,5,9,10];
				if not ok then
					writeln(chr(7),'  ERROR - Unit must be 4,5,9,or 10');
			until ok;
			
			repeat
				writeln;
				writeln('How many tracks do you want');
				write('on a side (normally 40)? ');
				tracks := validint(2,digit);
				writeln;
				ok := tracks in [1..99];
				if not ok then
					writeln(chr(7),'  ERROR - Tracks must be from 1 to 99');
			until ok;
			
			repeat
				writeln;
				writeln('Format diskette as single sided (S)');
				write('or double sided (D)? ');
				read(ch);
				writeln;
				sides := sdconv(ch,ok);
			until ok;
			
			writeln;
			writeln('You have selected:');
			writeln('  Unti number ',unitno);
			writeln('  Tracks per side ',tracks);
			writeln('  ',sdtable[sides],' sided');
			writeln('  ',sdtable[density],' density');
			
			repeat
				writeln;
				write('Ready to format the disk (Y/N)? ');
				read(ch);
				writeln;
			until ch in ['Y','y','N','n'];
			
			if ch in ['Y','y']then
			begin
			  drive := unit_to_drive(unitno);
				format(errcode,drive,tracks,sides,density);
				error_report(errcode);
				if errcode=0 then
					writeinfo(unitno,tracks,sides,density);
			end;
			
			repeat
				writeln;
				write('Format another disk (Y/N)? ');
				read(ch);
				writeln;
			until ch in ['Y','y','N','n'];
		until ch in ['N','n'];
	end; (* handle_format *)
		
begin (* main *)
	sdtable[1] := 'Single';
	sdtable[2] := 'Double';
	handle_format;
end.
			

 

 

Edited February 17, 2015 by apersson850

[+Lee Stewart]

For easier topic browsing, you can use spoiler tags to surround long code segments: The opening tag ( replace the “” with [] ) is “spoiler”. The closing tag is “/spoiler”.

 

Though I hadn’t noticed before, it looks like the “Code” BBC does not wrap lines.

 

...lee

[apersson850]

Hmm, is there a timeout for editing a post? Seems I can't fix that any longer, or I'm even thicker than my kids think...

[+Lee Stewart]

Hmm, is there a timeout for editing a post? Seems I can't fix that any longer, or I'm even thicker than my kids think...

 

That is strange. I don't think there is a time limit on editing a post. Perhaps something happening on the website is temporarily screwing up edits. Maybe @Albert will chime in ere long.

 

...lee

[Rod Van Orden]

Hello all!

I have been reviewing the UCSD p-system once again. I have managed to get some success

running under Classic-99. This was the result of placing the ROMS and GROM file references

into the right places. The main command menu lines come up under Classic-99 V365.

H for halt brings you back to the TI Powerup Screen and out of the p-system. There are some

Other things it will do. However, the big problem I am having now is with the disk images.

The system tries to look for this information on DSK1. And all I receive is error messages

saying the files can not be located. The files in question are:

 

SYSTEM.EDITOR

SYSTEM.FILER

SYSTEM.COMPILER

SYSTEM.ASSMBLER

SYSTEM.LINKER

 

This information is supposed to be in the DSK files downloaded from the site. However, I have

used every tool I've got to try to extract these System Files from the DSK files. And I have

not met with any success. I think I have been mixing apples and oranges with the file formats.

 

Does anyone out there in Pascal land have any suggestions? I do have the original diskettes

packed away in a safe and dry place. I have all four disks (the fourth one is the Utility

Diskette with the 11 utilities. After I set up a new desktop computer, I will try generating

disk images of all. As I recall these originals are all SSSD. But I think the file formats

aren't exactly right for DSK images. I am looking for suggestions.........

 

Rod Van Orden

San Diego, California

[+mizapf]

Can't help you with Classic 99; I can only say that UCSD Pascal is working in MESS with all disk images.