: 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]
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 [<can more...] NEWVM1
[SYNCADR] GOTO 5 LCTX [4 UPSIZE 8 OLS] DEFMAXID
CHMS.INIT ;
: WRI_8OLS 8 OLS ;
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] ;
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 NEWJREC
C LOADOBJ FINDOID C BR- DD SET_X11 ;
: SET_X11 PrioQueNUM 2 Channels !NCHAN GOTO OLS ;
:: : SET_INT [int oid] C HIPRIO PUSH ! VALINT 4 '' OLSI POP NEWDREC ;
: OLSI VALINT OLS ;
:: : GET_INT [OID] TODATA ILS ;
:: : TODATA [OID] C LOADOBJ C HIPRIO FINDOID PrioQueNUM
3 Channels !NCHAN 0 GOTO ;
:: : SET_STR [A L OID] C HIPRIO
PUSH ! LENSTR ! ADRSTR LENSTR '' OLSS POP NEWDREC ;
: OLSS ADRSTR LENSTR DO DWS1 D ;
ACT VAR BYTE_STR
:: : PRINT_STR '' PRIS ! BYTE_STR ACCESS_STR ;
:: : COPY2BUF_STR '' C2BUF ! BYTE_STR ACCESS_STR ;
:: : ACCESS_STR [OID] TODATA LENVMEM 0 GOTO DO BYTE_STR ;
: PRIS IBS TOB ;
: C2BUF IBS ABUF !TB !1+ ABUF ;
: DD_ROOT
OIDV OLS 0 OLS 0 OLS 0 OLS SZ_HDROBJ HSIZE+ OLS [val]
SZ_HDROBJ OLS [his]
W_NULLBLK [W_NULLBLK] DATWR ;
LONG VAR SIZE_X
: DATWRROOT -1 OLS -1 OLS 0 OLS 4 OLS 0 OLS ;
: DATWRINT -1 OLS -1 OLS 4 OLS 4 OLS VALINT OLS ;
: DATWRSTR -1 OLS -1 OLS LENSTR OLS LENSTR OLS ADRSTR LENSTR DO DWS1 D ;
: DWS1 [A] C @B OBS 1+ ;
: NEWOBJ1 [] SIZE_ROOT ! SIZE_X NEWOBJ3 ;
: NEWOBJ3 '' DD_ROOT ! WRI_DATA
NEWID C ! OIDV SIZE_X C2 D.NEWOBJ [OID] ;
9 VALUE LCH
LCH LONG VCTR CLONEHDR VAR DATCH LONG VAR LENVMEM1
:: : CLONE [OID] C HIPRIO
C LOADOBJ FINDOID PrioQueNUM C PUSH 2 Channels !NCHAN 0 GOTO
CLONE1 []
'' CC_ROOT ! WRI_DATA NEWID C 0 ! CLONEHDR SZ_HDROBJ HSIZE+ C2 D.NEWOBJ
[OID] POP 3 Channels C ! DATCH !NCHAN LENVMEM C ! LENVMEM1
C2 [OID_NEW LEN OID_NEW] CLONE_DATA [OID_NEW] ;
: CLONE1
ILS 1 ! CLONEHDR [BHR] ILS 2 ! CLONEHDR [KH]
ILS 3 ! CLONEHDR [TRC] 0 4 ! CLONEHDR
SZ_HDROBJ 5 ! CLONEHDR -1 6 ! CLONEHDR
-1 7 ! CLONEHDR 0 8 ! CLONEHDR
0 9 ! CLONEHDR ;
: CCR1 [N] C CLONEHDR OLS 1+ ;
: CC_ROOT 0 LCH 1+ DO CCR1 D ;
: CLONE_DATA [LEN OID] '' COPY_DATA E2 NEWDREC [] ;
: COPY_DATA [] DATCH NCHAN LENVMEM1 DO_IOBSCC DD ;
:: 0 VALUE N_TRSC
[Запись новых данных, запись в журнал]
: NEWDREC [SIZED PROC OID] N_VAL N_TRSC C3 NEWJREC FINDOID
PrioQueNUM [SIZE PROC N] C PUSH
2 Channels !NCHAN
[SIZED PROC] ! WRI_DATA NEWVM1 G_VAL C OLS [ADR_DATA]
[перечитать канал данных]
GOTO POP 3 Channels LCTX [] ;
[новая запись в журнал. На вх: номер транз. и адрес из заголовка]
: NEWJREC [addr_hdr TRANS OID] C LOADOBJ FINDOID PrioQueNUM
[. TRANS N] C PUSH 4 Channels
!NCHAN JRECLEN UPSIZE OLS POP NCHAN PUSH 2 Channels !NCHAN
C GOTO ILS POP !NCHAN
E2 OWS OLS W_DATIME [] ;
B10
[Запись текущего времени]
: W_DATIME 1979 OWS 12 OBS 31 OBS TMGET TMS ;
: TMS [num] N2T GBR E2 GBR E2 GBR E2 OBS OBS OBS 100 * OWS ;
B16
[просмотр журнала объекта]
[Переключиться на журнал]
: OBJ.J [OID]
C LOADOBJ FINDOID PrioQueNUM 4 Channels !NCHAN ;
: JVIEW [oid] CR ."Updated data:"
OBJ.J LENVMEM JRECLEN / D 0 GOTO DO JVIEW1 ;
: JVIEW1 CR ."Trans= " ILS .D SP
IWS BR N_BHR ."Behav.=" N_VAL ."AddrVal=" N_KH ."Knowhow="
ELSE ."?????? =" ILS SP .D SP JDATAV1 ;
: JDATAV1 S( BASE@ ) B10 IWS IBS IBS 2 TON #. TOB 2 TON #. TOB 4 TON
SP SP #: POS2 #: POS2 #. POS2 # IWS 4 TON TOB ;
: POS2 [B] IBS 2 TON TOB ;
[Определить размер объекта в памяти = заголовок + данные]
: SIZEMEMOBJ [N] C PrioQueOID BR0 T0 SMEMO1 [0/size] ;
: SMEMO1 3 Channels !NCHAN LENVMEM HSIZE+ HSIZE+ SZ_HDROBJ + [size] ;
PROGRAM $M3
[Выполнение действий (knowhow)]
FIX 1000 BYTE VCTR BUFTXT [Буфер для текста действий]
FIX LONG VAR ABUF
: BEGABUF 0 ' BUFTXT ! ABUF ;
: RUNCMD [OID_KH] BEGABUF "KH$" S2BUF N2BUF ABUF BEGABUF ABUF E2 C2 -
TEXEC ;
: MAKECMD [OID_KH] BEGABUF ": KH$" S2BUF C N2BUF # ABUF !TB !1+ ABUF
COPY2BUF_STR " ; " S2BUF
ABUF BEGABUF ABUF E2 C2 - TEXEC ;
: S2BUF [A L] DO S2BUF1 D ;
: S2BUF1 C @B ABUF !TB !1+ ABUF 1+ ;
: N2BUF [N] 8 DO CTN-SB D 8 [C1 .. Cn n] DO CTB ;
: CTN-SB [N] C 0F & #0 + E2 -4 SHT [C N'] ;
: CTB ABUF !TB !1+ ABUF ;
LONG VAR OIDK
: NEW_VOC "PROGRAM $KH_VOC" TEXEC ;
: RUN_KH [OID_KH] NEW_VOC C MAKECMD RUNCMD ;
PROGRAM $LS_CASH
[ Каналы: 1 - Header M.Obj 2 - Header D.Obj 3 - M.Data 4 - D.History ]
[Считаем, что все объекты -- стабильные]
: LOADOBJ [OID] C FINDOID [искали в кэше] C BR- LOADOBJ-1 DD ;
: LOADOBJ-1 D [OID] [Ищем в каталоге БД объект] [C] LOADOBJ1 [LOADOBJ2]
LenPrioQue 1- HIPRIO1 [] ;
: LOADOBJ1 6 LOADOBJ3 ;
[открыть дисковый объект в кэше]
: LOADOBJ3 [OID NDIRCH] EL_FIND [OID 1/0] IF0 O_NOTFND [Нет такого объекта]
C LenPrioQue 1- ! PrioQueOID [Занесли в кэш идентификатор объекта]
ILS [OID ADDR_MEM] [получили адрес размещения в дисковой памяти]
LenPrioQue 1- PrioQueNUM
[получили номер отведенной для работы с объектом группы каналов]
[OID ADDR_MEM NUM]
C 2 Channels [OID ADDR_MEM NUM CHANOBJ]
NCHAN NBASECH - !NCHAN [получили номер базового канала]
C3 GOTO LCTX [OID ADDR_MEM NUM] [загрузили заголовок дискового объекта]
E2D [O N]
C 4 Channels [OID NUM CHANHIST] [получили канал для истории]
G_HIS ILS
[O N C HISTORY] [HISTORY д.б. <>0]
GOTO NCHAN E2 LCTX [Открыли историю в канале] !NCHAN [O N]
C 3 Channels G_VAL ILS GOTO LCTX [временно открыли канал данных
напрямую с жесткого диска]
[LOADDM]
NOP [Здесь нужно установиться на объект в памяти и канал данных перекл. на него]
DD [] ;
VAR NCHANDAT
VAR NCHANOBJ LONG VAR LENDAT
: COPY_DAT1 [] NCHANOBJ 0 GOTOC [NCHANOBJ] NCHAN 0 GOTO 8 DO_IOBSCC D 14 OLS
0 OLS 10 GOTOC NCHAN 4 DO_IOBSCC DD -1 OLS -1 OLS LENDAT OLS LENDAT OLS
COPY_DAT ;
: GOTOC [NCHAN n] C2 S( NCHAN ) !NCHAN GOTO [NCHAN] ;
: COPY_DAT [] NCHANDAT NCHAN [SRC_CH DST_CH]
C2 !NCHAN LENVMEM [SRC_CH DST_CH LEN] 0 GOTO DO_IOBSCC DD ;
DB.NEW