Перевёл одну реализацию списков

Работы по ББЦБ (BlackBoxComponentBuilder) навсегда прекращены, т.к. A2OS - более интересный для наших задач вариант Оберон-подобной среды. В этом форуме хранятся темы про ББЦБ - пригодятся.
Закрыто
БудДен
Сообщения: 2839
Зарегистрирован: 07.10.18 14:01

Перевёл одну реализацию списков

Сообщение БудДен » 24.12.18 01:55

#blackboxcomponentbuilder #переводкода

https://gitlab.com/budden/nkp/blob/3107 ... Страниц.kp

Код: Выделить всё

MODULE КонтСписокНаВектореСтраниц;
(**
 Список на массиве с постраничной организацией хранения. 
 Имеется вектор страниц, содержащий страницы с элементами.
 Размер страницы равен размерСтраницы 
 Вектор страниц растёт квантами по шагРостаВектораСтраниц 

 Память, выделенная под структуру списка, не освобождается при уменьшении
 размера списка. Однако, элементы списка, к-рые при уменьшении длины
 списка выходят за пределы списка, списком не удерживаются. 
 
 Основано на ListLinear (С) Кушнир П.М. 
 Отличия от оригинала:
 - код переведён на русский язык
 - документация в формате ББ устранена, вместо
   этого прокомментирован исходный текст
 - в списке хранится ANYPTR, а не наследник специально созданного
   абстрактного типа ListItem
 - в оригинале при уменьшении длины списка элементы, вышедшие за пределы
   списка, удерживались списком (утечка памяти)
 - добавлена вставка, в т.ч. в конец
 - добавлено удаление с конца
 - процедура Яви, создающая список, всегда принимает длину списка.
 - питоно-образное форматирование

 (C) Кушнир П. М., Будяк Д.В
 лицензия = "Docu/BB-License"
**)

 CONST
  шагРостаВектораСтраниц = 16;
  размерСтраницы = 64;

 TYPE
  (** ЭлтСписка - то, что хранится в списке. Т.е., любая запись **)
  ЭлтСписка = ANYPTR; 

  Страница = POINTER TO ARRAY OF ЭлтСписка;

  ВекторСтраниц = POINTER TO ARRAY OF Страница;

  Список* = POINTER TO LIMITED RECORD
   длина-: INTEGER;
   векторСтраниц: ВекторСтраниц;
   используетсяСтраниц: INTEGER END;

 PROCEDURE ДобавьСтраницЕслиНадо (сп: Список; будетДлина: INTEGER);
 VAR
  i, count: INTEGER;
  векторСтраниц: ВекторСтраниц;
  ш : INTEGER;
 BEGIN
  count := (будетДлина DIV размерСтраницы + 1);
  IF count > LEN(сп.векторСтраниц) THEN
   ш := шагРостаВектораСтраниц;
   NEW(векторСтраниц, count DIV ш * ш + ш);
   FOR i := 0 TO LEN(сп.векторСтраниц) - 1 DO векторСтраниц[i] := сп.векторСтраниц[i] END;
   сп.векторСтраниц := векторСтраниц END;
  FOR i := сп.используетсяСтраниц TO count - 1 DO NEW(сп.векторСтраниц[i], размерСтраницы) END;
  IF count > сп.используетсяСтраниц THEN сп.используетсяСтраниц := count END
 END ДобавьСтраницЕслиНадо;

 PROCEDURE Яви* (длина: INTEGER): Список;
 VAR рез: Список;
 BEGIN
  NEW(рез);
  рез.используетсяСтраниц := 1;
  NEW(рез.векторСтраниц, шагРостаВектораСтраниц);
  NEW(рез.векторСтраниц[0], размерСтраницы);
  рез.длина := 0;
  IF длина > размерСтраницы THEN ДобавьСтраницЕслиНадо(рез, длина) END;
  RETURN рез END Яви;

 PROCEDURE На (сп: Список; и: INTEGER; элт: ЭлтСписка);
 BEGIN
  сп.векторСтраниц[и DIV размерСтраницы][и MOD размерСтраницы] := элт END На;

 PROCEDURE Дай (сп: Список; и: INTEGER): ЭлтСписка;
 BEGIN
  RETURN сп.векторСтраниц[и DIV размерСтраницы][и MOD размерСтраницы] END Дай;

 PROCEDURE ЗадайДлину (сп: Список; новаяДлина: INTEGER);
 VAR й:INTEGER;
 BEGIN
  IF новаяДлина < 0 THEN новаяДлина := 0 END;
  IF новаяДлина > размерСтраницы * сп.используетсяСтраниц THEN 
   ДобавьСтраницЕслиНадо(сп, новаяДлина) END;
  (* Отличие от оригинала *)
  FOR й := новаяДлина TO сп.длина - 1 DO
   На(сп, й, NIL) END;
  сп.длина := новаяДлина END ЗадайДлину;

 PROCEDURE (э: Список) ЗадайДлину* (длина: INTEGER), NEW;
 BEGIN
  ASSERT(длина > - 1, 20);
  ЗадайДлину(э, длина) END ЗадайДлину;

 PROCEDURE (э: Список) Дай* (и: INTEGER): ЭлтСписка, NEW;
 BEGIN
  ASSERT((и >= 0) & (и < э.длина), 20);
  RETURN Дай(э, и) END Дай;

 PROCEDURE (э: Список) На* (и: INTEGER; элт: ЭлтСписка), NEW;
 BEGIN
  ASSERT((и >= 0) & (и < э.длина), 20);
  На(э, и, элт) END На;

 PROCEDURE (э: Список) Удали* (и: INTEGER), NEW;
 VAR i: INTEGER;
 BEGIN
  ASSERT((и >= 0) & (и < э.длина), 20);
  FOR i := и + 1 TO э.длина - 1 DO
   На(э, i - 1, Дай(э, i)) END;
  ЗадайДлину(э, э.длина - 1) END Удали;

 PROCEDURE (э: Список) УдалиСКонца* (номерСКонцаСчитаяОт0: INTEGER), NEW;
 BEGIN
  э.Удали(э.длина - 1 - номерСКонцаСчитаяОт0) END УдалиСКонца;
 
 (** Элемент получит заданный индекс. 
     и = 0 - вставить в начало. и = э.длина - вставить в конец. 
     См. также ВставитьВКонец *)
 PROCEDURE (э: Список) Вставь* (и: INTEGER; элт: ЭлтСписка): ЭлтСписка, NEW;
 VAR i: INTEGER;
 BEGIN
  ASSERT((и >= 0) & (и <= э.длина), 20);
  ЗадайДлину(э, э.длина + 1);
  FOR i := э.длина - 1 TO и + 1 BY -1 DO
   На(э, i, Дай(э, i - 1)) END;
  На(э, и, элт);
  RETURN элт END Вставь;

 (* Если и = 0, то вставляет в конец списка. и = 1 - вставляет перед последним элементом и т.п. *)
 PROCEDURE (э: Список) ВставьВКонец* (и: INTEGER; элт: ЭлтСписка): ЭлтСписка, NEW;
 BEGIN
  RETURN э.Вставь(э.длина - и, элт) END ВставьВКонец;

END КонтСписокНаВектореСтраниц.
Ключевые слова потом можно перевести машинным переводом, пока это будет мешать.

БудДен
Сообщения: 2839
Зарегистрирован: 07.10.18 14:01

Re: Перевёл одну реализацию списков

Сообщение БудДен » 24.12.18 11:12

---
Последний раз редактировалось БудДен 24.12.18 11:13, всего редактировалось 1 раз.

БудДен
Сообщения: 2839
Зарегистрирован: 07.10.18 14:01

Re: Перевёл одну реализацию списков

Сообщение БудДен » 24.12.18 11:13

А вот оригинал:

Код: Выделить всё

MODULE ListsLinear;
(**
	project	= "BlackBox"
	subproject	= "Lists library"
	organization	= ""
	contributors	= "Кушнир П. М."
	version	= "System/Rsrc/About"
	copyright	= "System/Rsrc/About"
	license	= "Docu/BB-License"
	purpose	= ""
	changes	= "
	- 20110117, ТЕЭ, по анализатору закомментировал неиспользуемые...
	- ...
	"
	issues	= ""

**)

	

	(* IMPORT
		S := SYSTEM, Log; *)

	CONST
		dataSize = 16;
		strSize = 64;

	TYPE
		ListItem* = POINTER TO ABSTRACT RECORD END;

		Ptr = POINTER TO ARRAY OF ListItem;

		Data = POINTER TO ARRAY OF Ptr;

		List* = POINTER TO LIMITED RECORD
			len-: INTEGER;
			data: Data;
			dataLen: INTEGER
		END;

	VAR
		null-: Ptr;

	PROCEDURE Grow (s: List; len: INTEGER);
	VAR
		i, count: INTEGER;
		data: Data;
	BEGIN
		count := (len DIV strSize + 1);
		IF count > LEN(s.data) THEN
			NEW(data, count DIV dataSize * dataSize + dataSize);
			FOR i := 0 TO LEN(s.data) - 1 DO data[i] := s.data[i] END;
			s.data := data
		END;
		FOR i := s.dataLen TO count - 1 DO NEW(s.data[i], strSize) END;
		IF count > s.dataLen THEN s.dataLen := count END
	END Grow;

	PROCEDURE New (len: INTEGER): List;
	VAR res: List;
	BEGIN
		NEW(res);
		res.dataLen := 1;
		NEW(res.data, dataSize);
		NEW(res.data[0], strSize);
		res.len := 0;
		IF len > strSize THEN Grow(res, len) END;
		RETURN res
	END New;

	PROCEDURE Put (s: List; index: INTEGER; item: ListItem);
	VAR i(* , l *): INTEGER;
	BEGIN
		i := index;
		(* l := strSize - i MOD strSize; *)
		s.data[i DIV strSize][i MOD strSize] := item
	END Put;

	PROCEDURE Get (s: List; index: INTEGER): ListItem;
	VAR i(* , l *): INTEGER;
	BEGIN
		i := index;
		(* l := strSize - i MOD strSize; *)
		RETURN s.data[i DIV strSize][i MOD strSize]
	END Get;

	PROCEDURE SetLength (s: List; len: INTEGER);
		VAR i: INTEGER;
	BEGIN
		IF len < 0 THEN len := 0 END;
		IF len > strSize * s.dataLen THEN Grow(s, len) END;
		s.len := len
	END SetLength;

	PROCEDURE (l: List) SetLength* (length: INTEGER), NEW;
	BEGIN
		ASSERT(length > - 1, 20);
		SetLength(l, length)
	END SetLength;

	PROCEDURE (l: List) GetItem* (index: INTEGER): ListItem, NEW;
	BEGIN
		ASSERT((index >= 0) & (index < l.len), 20);
		RETURN Get(l, index)
	END GetItem;

	PROCEDURE (l: List) SetItem* (index: INTEGER; item: ListItem), NEW;
	BEGIN
		ASSERT((index >= 0) & (index < l.len), 20);
		Put(l, index, item)
	END SetItem;

	PROCEDURE (l: List) Remove* (index: INTEGER), NEW;
	VAR i: INTEGER;
	BEGIN
		ASSERT((index >= 0) & (index < l.len), 20);
		FOR i := index + 1 TO l.len - 1 DO
			Put(l, i - 1, Get(l, i))
		END;
		Put(l, l.len-1, NIL);
		SetLength(l, l.len - 1)
	END Remove;

	PROCEDURE NewList* (): List;
	VAR (* l: List; *)
	BEGIN
		RETURN New(0)
	END NewList;

	(* Тест *)

	PROCEDURE Init;
	BEGIN
		NEW(null, 1)
	END Init;

BEGIN
	Init
END ListsLinear.


Закрыто