Объектно-ориентированная СУБД (прототип)

BR+ LEAVE [addr nchan] D

GOTO DELTA2 S( NCHAN ) TOLOW POSIX [addr(i-1)] ;

:: : TOLOW LOWCH !NCHAN ;

[Пересчет адреса в адрес нижнего уровня: TEKADR(i) -> TEKADR(i-1)]

:: : DELTA2 SYNCADDR HSIZE + TEKADR TEKADR0 - + ;

:: : IBS EON OUTDATA OUTDATA# LAST?

TEKADR POSIX TEKADR++ S( NCHAN ) !NCHAN BSGOTO

NCHAN BR 0 IBS0 1 IBS1 [2 IBS2] ELSE UNKCH ;

:: : OBS EON OUTDATA OUTDATA# LAST?

TEKADR POSIX TEKADR++ S( NCHAN ) !NCHAN BSGOTO

NCHAN BR 0 OBS0 1 OBS1 [2 OBS2] ELSE UNKCH ;

: LAST? TEKADR BUSYLEN TEKADR0 + = IF0 LEAVE NEXTBLK ;

[переход для базового канала ]

: BSGOTO [ADDR] NCHAN BR 0 BSGOTO0 1 BSGOTO1 [2 BSGOTO2] ELSE UNKCH ;

: BSGOTO0 !TEKADR ;

: BSGOTO1 C !TEKADR HSIZE+ SPOS DATACH ;

[ : BSGOTO2 C !TEKADR HSIZE+ SPOS JOURCH ;]

0 %IF

: ADDR [PARAGRAF OFFSET] + [address] ; [Сейчас пгф=1 байту]

[Для файлов можно сделать неск. файлов и распределить по ним пространство]

%FI

: IBS0 TEKADR HSIZE+ MEMORY &0FF TEKADR++ ;

: IBS1 IB DATACH &0FF TEKADR++ ;

[: IBS2 IB JOURCH &0FF TEKADR++ ;]

: OBS0 &0FF TEKADR HSIZE+ ! MEMORY TEKADR++ ;

: OBS1 &0FF OB DATACH TEKADR++ ; [Запись байта]

[: OBS2 &0FF OB JOURCH TEKADR++ ;] [Запись байта]

:: : GOTO NCHAN NBASECH < BR+ BSGOTO VGOTO ;

: VGOTO TEKADR - @GOTO ;

[Переход по смещению]

:: : @GOTO C BRS @GOTO- D @GOTO+ ;

: @GOTO+ DO @GOTO1+ ;

: @GOTO- NEG DO @GOTO1- ;

: @GOTO1+

EON OUTDATA OUTDATA#

TEKADR TEKADR0 BUSYLEN + =

IF+ NEXTBLK TEKADR 1+ !TEKADR ;

: @GOTO1-

EON OUTDATA OUTDATA#

TEKADR TEKADR0 =

IF+ PREDBLK TEKADR 1- !TEKADR ;

: NEXTBLK CHGCTX IF+ SCTX NEXTADDR NOEXIST? !SYNCADDR RELCTX

TEKADR !TEKADR0 ;

: NOEXIST? [ADDR] C -1 = IF+ OUTDATA [ADDR] ;

[Pred, Next, BusyLen, Len]

:: : LCTX' [UPCH] PUSH TEKADR ILS ILS ILS ILS POP

NCHAN E2 !NCHAN !LOWCH !LEN !BUSYLEN !NEXTADDR !PREDADDR !SYNCADDR

0 !CHGCTX ;

[Грузить параметры канала]

:: : LCTX [newch] LCTX' 0 !TEKADR 0 !TEKADR0 ;

: RELCTX TEKADR0 TEKADR NCHAN SYNCADDR TOLOW GOTO LCTX !TEKADR !TEKADR0 ;

: PREDBLK CHGCTX IF+ SCTX PREDADDR NOEXIST? !SYNCADDR RELCTX

TEKADR BUSYLEN - !TEKADR0 ;

: IBSC [CHAN] S( NCHAN ) !NCHAN IBS ;

: ILSC S( NCHAN ) !NCHAN ILS ;

: OBSC [N CHAN] S( NCHAN ) !NCHAN OBS ;

: IOBSCC [SRC DST] C2 IBSC C2 OBSC ;

: DO_IOBSCC [SRC_CH DST_CH N] S( NCHAN )

C3 !NCHAN 0 GOTO DO IOBSCC [SRC DST] ;

: IWS IBS IBS SWB &0 ;

: ILS IWS IWS SETHI ; [SWW &0]

: OWS C OBS SWB OBS ;

: OLS C OWS SWW OWS ;

[Перейти к конечному блоку]

: GOTOENDBK NEXTADDR -1 = EX+ BUSYLEN TEKADR0 +

NEXTADDR !SYNCADDR RELCTX C !TEKADR0 !TEKADR ;

: GOBOTTOM RP GOTOENDBK BUSYLEN TEKADR0 + GOTO ;

: LENVMEM GOBOTTOM TEKADR [LEN] ; [длина виртуальной памяти]

: LASTADDR SYNCADDR LEN + HSIZE+ ;

: OBS-0 NCHAN BR 0 OBS00 1 OBS01 [2 OBS02] ELSE OBS0N ;

: OBS00 0 OBS0 ; : OBS01 0 OBS1 ; [: OBS02 0 OBS2 ;] : OBS0N 0 OBS ;

[Спецификация: Размер увеличивается на N байт. Если это невозможно,

возникает исключительная ситуация NOMEMORY.

После работы мы стоим в том же канале в начале выделенного пространства. ]

: UPSIZE [N] GOBOTTOM TEKADR E2 UPSIZE' GOTO [] ;

: UPSIZE' [N] GOBOTTOM LEN BUSYLEN - CALCOST [HARD SOFT] UPSIZEI

C BR0 D UPSIZEO ;

: CALCOST [N FREE] C2C2 <= BR+ COST1 COST2 [HARD SOFT] ;

: COST1 [N FREE] T0 E2 [0 N] ;

: COST2 [N FREE] C PUSH - POP [N-FREE FREE] ;

: UPSIZEI [N_SOFT] BUSYLEN + !BUSYLEN 1 !CHGCTX SCTX ;

: UPSIZEO [N_HARD] NCHAN BR 0 USO0 1 USO1 2 USO1 ELSE USON ;

: USO1 C GOBOTTOM TEKADR E2 DO OBS-0 [!TEKADR] BSGOTO

C BUSYLEN + !BUSYLEN LEN + !LEN 1 !CHGCTX SCTX ;

: USO0 NOMEMORY [Сюда можно вставить упаковку] ;

[Спецификация: увеличение размера (жестко, т.е. за счет нижнего уровня)]

: USON [N] SYNCADDR LASTADDR USON1 RELCTX [>] UPSIZE' ;

: USON1 S( NCHAN ) TOLOW BUSYLEN = BR+ USON_ADD USON_NEW ;

[Расширение увеличением длины фрагмента]

: USON_ADD C2 [N SYNCADDR N] UPSIZE' C BUSYLEN E2 - HSIZE - E2

[N LEN SYNCADDR] 3 *4 + GOTO OLS [N] [UPSIZEI] ;

[Расширение созданием нового фрагмента]

: USON_NEW C2 [N SYNCADDR N] [GOBOTTOM] C HSIZE+ UPSIZE'

[N SYNCADDR N] C2 -1 0 C4 TEKADR PUSH WRITECTX D 4+ GOTO POP OLS [N] ;

: WRITECTX [PRED NEXT BUSY LEN] C4 OLS C3 OLS C2 OLS C OLS DD DD ;

FIX VAR UPCONST 10 ! UPCONST [Этому числу байт кратно увеличение]

[Увеличение размера нижнего уровня]

[увеличение физического размера этого уровня]

: SCTX CHGCTX IF0 LEAVE 0 !CHGCTX NCHAN BR 0 NOP 1 SCTX1 [2 SCTX2]

3 NOP 4 NOP ELSE SCTXN ;

: SCTXN TEKADR NCHAN LEN BUSYLEN NEXTADDR

PREDADDR SYNCADDR TOLOW GOTO 4 DO OLS !NCHAN GOTO ;

: SAVEALL NOP ; [СОХРАНИТЬ ВЕСЬ КАНАЛ НА ПЕРВИЧНОМ УСТРОЙСТВЕ (ИСТОЧНИКЕ)]

: SCTX1 POS DATACH 8 SPOS DATACH BUSYLEN OL DATACH LEN OL DATACH SPOS DATACH ;

[

: SCTX2 POS JOURCH 8 SPOS JOURCH BUSYLEN OL JOURCH LEN OL JOURCH SPOS JOURCH ;

]

[Новая виртуальная память]

0 %IF

: NEWVM [N] TEKADR C2 HSIZE+ UPSIZE GOTO -1 -1 C3 C WRITECTX D ;

%FI

: NEWVM [N] C HSIZE+ UPSIZE TEKADR PUSH -1 -1 0 C4 WRITECTX DO OBS-0

POP [SYNCADR] ;

: END? NEXTADDR -1 = TEKADR BUSYLEN TEKADR0 + = & ;

: NEWVM1 [N] C HSIZE+ UPSIZE TEKADR PUSH -1 -1 E3 C WRITECTX WRI_DATA

POP [SYNCADR] ;

: LOADCH0 0 !NCHAN 0 !LOWCH 0 !TEKADR 0 !BUSYLEN

TOTMEMLEN !LEN 0 !TEKADR0 0 !SYNCADDR -1 !NEXTADDR -1 !PREDADDR ;

[ДЛЯ БАЗОВЫХ КАНАЛОВ LOWCH=NCHAN]

7.4 Система управления хранением объектов

PROGRAM $SOMS

B16

[СИСТЕМА УПРАВЛЕНИЯ ХРАНЕНИЕМ ОБЪЕКТОВ]

FIX LONG VAR MAXID

1 ! MAXID

: NEWID MAXID !1+ MAXID ;

: DEFMAXID 6 EL_MAX 1+ ! MAXID ;

[5 КАНАЛ = ОПЕРАТИВНАЯ ПАМЯТЬ; 6 КАНАЛ = ДИСКОВАЯ ПАМЯТЬ]

: L_SUHO 0 !NCHAN 0 GOTO 5 LCTX 1 !NCHAN 0 GOTO 6 LCTX ;

[создание структуры СУХО для ОП]

[9 -- Размер, занимаемый элементом списка]

LONG VAR SIZE_EL 8 ! SIZE_EL

[создать новый объект]

ACT VAR WRI_DATA

: M.NEWOBJ [SIZE OID] 0 E2 8 5 X.NEWOBJ [] ;

: D.NEWOBJ [SIZE OID] 1 E2 8 6 X.NEWOBJ [] ;

: X.NEWOBJ [SIZE LOWCH OID SIZE_EL DIR_CHAN] C PUSH S( NCHAN ) !NCHAN UPSIZE

[.. OID] OLS [basechan] !NCHAN NEWVM1 [SYNCADDR] POP !NCHAN OLS [] ;

:: : M.VIEW 5 !NCHAN CR ."RAM:" VIEW.OBJ' ;

:: : D.VIEW 6 !NCHAN CR ."HDD:" VIEW.OBJ' ;

:: : A.VIEW M.VIEW D.VIEW ;

: IC.VIEW [A L] SHR SHR E2 GOTO DO IC1.V ;

: IC1.V TEKADR CR .D #> TOB SP SP ILS .D ;

: VIEW.OBJ' 0 GOTO ILS D [Пропустили длину элемента]

CR ." OID ADDRESS" RP SHOWPAROBJ ;

: SHOWPAROBJ END? EX+ ILS C BR0 SPO1 SPO2 ;

: SPO1 D ILS D ;

: SPO2 CR .D SP ILS .D SP ;

: M.DEL [OID] 5 X.DEL ; : D.DEL [OID] 6 X.DEL ;

: A.DEL [OID] C M.DEL D.DEL ;

ACT VAR EL_AVAR

:: : X.DEL [OID NCHAN] EL_FIND [OID 1/0] IF+ EL_DEL D ;

[найти элемент в списке по ID и встать на след. за OID слово]

: EL_DEL -4 @GOTO 0 OLS ;

:: : EL_FIND [OID NCHAN] '' EL_COMPAR ! EL_AVAR EL_PEREBOR ;

: EL_PEREBOR !NCHAN 0 GOTO ILS D RP EL_FIND0 [OID 1/0] ;

: EL_FIND0 END? 0 E2 EX+ D ILS C BR0 D EL_AVAR ILS D ;

: EL_COMPAR [OUR_OID TEK_OID] C2 = C EX+ D ;

:: : EL_MAX [DIR-NCHAN] 0 E2 '' MAX ! EL_AVAR EL_PEREBOR D [OID] ;

:: : DB.NEW !1 MAXID WOPEN DATACH

-1 OL DATACH -1 OL DATACH 14 OL DATACH 14 OL DATACH

-1 OL DATACH -1 OL DATACH 4 OL DATACH 4 OL DATACH

8 OL DATACH CLOSE DATACH

[ WOPEN JOURCH

-1 OL JOURCH -1 OL JOURCH 14 OL JOURCH 14 OL JOURCH

-1 OL JOURCH -1 OL JOURCH 4 OL JOURCH 4 OL JOURCH

8 OL JOURCH CLOSE JOURCH ]

DB.OPEN ;

: DB.CLOSE CLOSE DATACH [CLOSE JOURCH] ;

: DB.OPEN -1 !!! CHDATA

[DATA]

OPEN DATACH 1 !NCHAN 0 !TEKADR 0 !TEKADR0 1 !LOWCH

IL DATACH !PREDADDR IL DATACH !NEXTADDR 0 !SYNCADDR

IL DATACH !BUSYLEN IL DATACH !LEN 6 LCTX

[RAM]

0 !NCHAN 0 !LOWCH 0 !TEKADR 0 !BUSYLEN

TOTMEMLEN !LEN 0 !TEKADR0 0 !SYNCADDR -1 !NEXTADDR -1 !PREDADDR

'' WRI_8OLS ! WRI_DATA [длина элемента каталога]

4 [

[SYNCADR] GOTO 5 LCTX [4 UPSIZE 8 OLS] DEFMAXID

CHMS.INIT ;

: WRI_8OLS 8 OLS ;

7.5 Система управления каналами

PROGRAM $CHMS

3 VALUE LENGRP [Вместимость уровня приоритетов]

4 VALUE QChannels

LENGRP 3 * 1+ VALUE LenPrioQue [длина очереди приоритетов. Очередь -- с 0]

: N2CH [N] QChannels * 0A + [NCHAN] ;

LenPrioQue 1+ N2CH 10 * LONG VCTR CHDATA [память параметров каналов]

[для каждого канала можно завести 16. различных параметров]

: CHMS.INIT 0 !!! PrioQueOID

0 LenPrioQue DO SETNQ D ;

: SETNQ C C ! PrioQueNUM C N2CH [NUM CHAN1]

[вычислили номер канала для очередного объекта кэша]

C C3 1 ! Channels

1+ C C3 2 ! Channels

1+ C C3 3 ! Channels

1+ C C3 4 ! Channels D 1+ ;

[при обращении к объекту нужно повысить его приоритет]

: HIPRIODD D HIPRIO ;

: HIPRIO [OID] FINDOID C BR- D HIPRIO1 ;

: HIPRIO1 [N] C LENGRP / D C IF+ 1- LENGRP * [N N'] E2 UPOID [] ;

[Новый объект добавляется на последн. поз-ю, а затем к нему примен. HIPRIO]

LenPrioQue LONG VCTR PrioQueOID [список OID]

LenPrioQue WORD VCTR PrioQueNUM [номера записей в массиве каналов]

LenPrioQue QChannels 2 WORD ARR Channels

[обменять в очереди с соседним вышестоящим]

: SWP2OBJ [N] C IF0 LEAVE C PrioQueOID C2 1- PrioQueOID

C3 ! PrioQueOID C2 1- ! PrioQueOID

C PrioQueNUM C2 1- PrioQueNUM C3 ! PrioQueNUM C2 1- ! PrioQueNUM 1- [N-1] ;

: SWP2OBJDD SWP2OBJ DD ;

: FINDOID [OID] 0 LenPrioQue DO CMPOID E2D C LenPrioQue = IF+ T-1 [-1/N] ;

: CMPOID [OID] C PrioQueOID [OID N OID(N)] C3 = EX+ 1+ ;

[Поднять объект от N_DOWN к N_UP в очереди]

: UPOID [N_UP N_DOWN ] C E3 - DO SWP2OBJ D [] ;

[Просмотр очереди (кэш объектов)]

: Q.VIEW 0 LenPrioQue

." M.Hdr D.Hdr M.Dat D.His"

DO QELVIEW D ;

: QELVIEW [n] CR C C 2 TON LENGRP / E2D BR0 #- #) TOB

C PrioQueOID ." OID=" .D C PrioQueNUM ." Num=" .

." Channels= " 1 QChannels DO PriNCH

DD 1+ ;

: PriNCH [NOID NCH] C2C2 Channels 4 TON SP SP 1+ [NOID NCH+1] ;

7.6 Работа с базовыми объектами

PROGRAM $SYSOBJS

B16

LONG VAR ADRSTR LONG VAR LENSTR

0 VALUE N_OID 4 VALUE N_BHR 8 VALUE N_KH

0C VALUE N_TRC 10 VALUE N_VAL 14 VALUE N_HIS

13 VALUE JRECLEN

: G_OID N_OID GOTO ; : W_OID G_OID OLS ;

: G_BHR N_BHR GOTO ; : W_BHR G_BHR OLS ;

: G_KH N_KH GOTO ; : W_KH G_KH OLS ;

: G_TRC N_TRC GOTO ; : W_TRC G_TRC OLS ;

: G_VAL N_VAL GOTO ; : W_VAL G_VAL OLS ;

: G_HIS N_HIS GOTO ; : W_HIS G_HIS OLS ;

18 VALUE SZ_HDROBJ

: W_NULLBLK -1 OLS -1 OLS 0 OLS 0 OLS ;

[Описание системных объектов]

ACT VAR DATWR

LONG VAR OIDV

LONG VAR VALINT

[**** ROOT ****]

SZ_HDROBJ HSIZE+ HSIZE+ 4+ VALUE SIZE_ROOT

:: : CLONE_ROOT '' DATWRROOT ! DATWR NEWOBJ1 ;

:: : CLONE_INT ! VALINT '' DATWRINT ! DATWR NEWOBJ1 ;

:: : CLONE_SET 4 CLONE_INT ;

:: : CLONE_SEQ 4 CLONE_INT ;

:: : CLONE_AGG 0C CLONE_INT ;

:: : CLONE_STR [A L] ! LENSTR ! ADRSTR '' DATWRSTR ! DATWR

LENSTR SIZE_ROOT + 4- ! SIZE_X NEWOBJ3 ;

:: : SET_BHR [OID_BHR OID] N_BHR E2 SET_X1 ;

:: : SET_KH [OID_KH OID] N_KH E2 SET_X1 ;

: SET_X1 [ADR OID] C2C2 N_TRSC E2