SCR #48
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
SCR #49
0 ( Introduction and load for DEMO data file. MVP-FORTH)
1 PAGE CR CR CR CR
2 ." ELEMENTS OF DATA BASE DESIGN " CR
3 ." by" CR
4 ." Glen B. Haydon" CR CR
5 ." This demonstration data system provides a pattern for the "
6 CR ." further development of any type of data base. " CR
7
8 : PROCEED
9 CR CR 9 SPACES ." Enter Y to load screens "
10 KEY 89 = IF 50 58 DDUP INDEX CR THRU THEN ;
11
12 PROCEED
13
14 EXIT
15
SCR #50
0 ( File development l of 2 MVP-FORTH)
1 VARIABLE REC# 0 REC# ! ( holds the current record number )
2 VARIABLE OPEN 0 OPEN ! ( points to the current file descript)
3
4 : LAYOUT ( --- bytes/rec-2, bytes/block-1 )
5 OPEN @ 4 + D@ ;
6
7 : READ ( n --- ) ( n-th record is made current )
8 0 MAX DUP OPEN @ 2+ @ < 0=
9 IF ." FILE ERROR " QUIT THEN REC# ! ;
10
11 : RECORD ( n --- address of n-th record )
12 LAYOUT */MOD OPEN @ @ + BLOCK + UPDATE ;
13
14 : ADDRESS ( --- address of the current record )
15 REC# @ RECORD ;
MOUNTAIN VIEW PRESS FORTH VERSION 1.01.03
SCR #51
0 ( File development 2 of 2 MVP-FORTH)
1 : DFIELD
2 CREATE OVER , + ( Create data field and leave count )
3 DOES> @ ADDRESS + ; ( Leave address )
4
5 : TFIELD
6 CREATE OVER , DUP , + ( Create text field and leave count )
7 DOES> D@ ADDRESS + SWAP ; ( Leave addr and count )
8
9 : FILE ( Create a named storage allocation)
10 CREATE , ( Origin block )
11 1+ , ( Number of records in file )
12 DUP 1024 OVER / * , ( # nunber of bytes per block )
13 , ( # bytes per record )
14 DOES> OPEN ! ; ( When file name used, point to )
15 ( its descriptor parameters. )
SCR #52
0 ( Serial Day 1 of 3 MVP-FORTH)
l : D/ ( d, u --- d )
2 SWAP OVER /MOD >R SWAP U/MOD SWAP DROP R> ;
3 : D* ( d, u --- d )
4 DUP ROT * ROT ROT U* ROT + ;
5 : $-N ( c --- d )
6 WORD 0 0 ROT CONVERT DDROP ;
7
8 : TO.SERIAL.DAY ( d, d, d, --- u )
9 ROT DUP 3 < IF 13 + SWAP 1 -
10 ELSE 1 + SWAP THEN
11 52 - 365.25 ROT D* 100 D/ DROP
12 SWAP 30.6001 ROT D* 10000 D/ DROP + + ;
13
14 : ?DATE ." ( MM/DD/YY ) "
15 QUERY 47 $-N 47 $-N BL $-N TO.SERIAL.DAY ;
SCR #53
0 ( Serial Day 2 of 3 MVP-FORTH)
1
2 : YEARS ( serial-day --- test-year )
3 0 100 D* 36525 D/ DROP ;
4
5 : DAYS/YEARS ( year --- days )
6 0 36525 D* 100 D/ DROP ;
7
8 : TEST.YEARS ( serial-day, test-year --- year, days )
9 DDUP DAYS/YEARS - DUP 123 <
10 IF DROP 1- SWAP OVER DAYS/YEARS -
11 ELSE ROT DROP
12 THEN SWAP 52 + SWAP ;
13
14 : MONTHS ( days --- days, test-month )
15 DUP 3267963. ROT D* 10000 D/ 10000 D/ DROP ;
MOUNTAIN VIEW PRESS FORTH VERSION 1.01.03
SCR #54
0 ( Serial Day 3 of 3 MVP-FORTH)
l : DAYS.TO.M/D/Y ( years, days --- years, days, months )
2 MONTHS SWAP OVER 30.6001 ROT D* 10000
3 D/ DROP - SWAP DUP 13 >
4 IF 13 - ROT 1+ ROT ROT ELSE 1- THEN ;
5 ?DUP
6 : OUT.DATE ( years, days, months --- )
7 100 * + 0 100 D* ROT 0 D+
8 <# # # 47 HOLD # # 47 HOLD # # #> TYPE ;
9
10 : CONV.SERIAL ( serial-day --- years, days, months )
11 DUP YEARS TEST.YEARS DAYS.TO.M/D/Y ;
12
13 : .DATE ( serial-day --- )
14 ?DUP
15 IF CONV.SERIAL OUT.DATE ELSE ." 00/00/00" THEN ; EXIT
SCR #55
0 ( Factors for ?$AMOUNT & .$AMOUNT MVP-FORTH)
1
2 : 0SCALE ( u --- ) 100 D* ;
3
4 : 1SCALE ( u --- ) 10 D* ;
5
6 : 2SCALE ( u --- ) ;
7
8 : 3SCALE ( u --- ) ." Input error " ;
9
10 CREATE NSCALE
11 ' 0SCALE CFA , ' 1SCALE CFA , ' 2SCALE CFA , ' 3SCALE ,
12
13
14
15
SCR #56
0 ( ?$AMOUNT & .$AMOUNT MVP-FORTH)
1
2 : SCALE ( d --- )
3 DPL @ 3 MIN 2 * NSCALE + @ EXECUTE ;
4
5 : ?$AMOUNT ( --- double-cents )
6 QUERY BL WORD NUMBER DPL @ 0<
7 ABORT" INPUT ERROR" SCALE ;
8
9 8 CONSTANT $SIZE
10
11 : .$AMOUNT ( double-cents --- )
12 ( Print $ amount right justified in #SIZE spaces )
13 SWAP OVER DUP D+- <# # # 46 HOLD #S ROT SIGN #>
14 36 EMIT DUP $SIZE SWAP - SPACES TYPE ;
15 EXIT
MOUNTAIN VIEW PRESS FORTH VERSION 1.01.03
SCR #57
0 ( DEMO File - Record Generation MVP-FORTH)
1 0 2 DFIELD TAG ( a tag )
2 30 TFIELD NAME ( item name )
3 2 DFIELD DAY ( the date )
4 4 DFIELD DOLLAR ( a dollar amount)
5 200 ( number of records) 0 ( starting block <1024>)
6 FILE DEMO
7 : !NAME ( wait for name then store it in record )
8 NAME 32 FILL QUERY 1 TEXT PAD COUNT
9 NAME ROT MIN CMOVE UPDATE ;
10 : .NAME ( print name field ) NAME TYPE ;
11 ( The rest follow in the same way. )
12 : !DAY ?DATE DAY ! UPDATE ; : .DAY DAY @ .DATE ;
13 : !DOLLAR ?$AMOUNT DOLLAR D! UPDATE ;
14 : .DOLLAR DOLLAR D@ .$AMOUNT ;
15 : .REC CR REC# @ 3 .R 2 SPACES .NAME .DAY 2 SPACES .DOLLAR ;
SCR #58
0 ( DEMO File - CLEAR.DATA, INPUT, OUTPUT MVP -FORTH)
1
2 ( Clear especiall tag in the 0 record in file )
3 : CLEAR.DATA 0 READ TAG 1024 0 FILL UPDATE ;
4
5 ( Example of formatting for input )
6 : INPUT 0 READ TAG @ 1+ UPDATE DUP TAG ! READ
7 CR CR ." ENTER NAME --> " !NAME
8 CR ." ENTER DATE -->" !DAY ( has a format prompt)
9 CR ." ENTER AMOUNT --> " !DOLLAR
10 .REC UPDATE FLUSH ; ( Save this record on disk )
11
12 ( List files 1 through the number in TAG of 0 record )
13 : OUTPUT 0 READ TAG @ DUP 0= IF CR CR ." Empty file "
14 DROP ELSE 1+ 1 DO FORTH I READ .REC LOOP THEN CR CR ;
15 EXIT
SCR #59
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
MOUNTAIN VIEW PRESS FORTH VERSION 1.01.03
COLD MVP-FORTH VERSION 1.01.03
DR1 OK
49 LOAD
ELEMENTS OF DATA BASE DESIGN
by
Glen B. Haydon
This demonstration data system provides a pattern for the
further development of any type of data base.
Enter Y to load screens
50 ( File development 1 of 2 MVP-FORTH)
51 ( File development 2 of 2 MVP-FORTH)
52 ( Serial Day l of 3 MVP-FORTH)
53 ( Serial Day 2 of 3 MVP-FORTH)
54 ( Serial Day 3 of 3 MVP-FORTH)
55 ( Factors for ?$AMOUNT & .$AMOUNT MVP-FORTH)
56 ( ?$AMOUNT & .$AMOUNT MVP-FORTH)
57 ( DEMO File - Record Generation MVP-FORTH)
58 ( DEMO File - CLEAR.DATA, INPUT, OUTPUT MVP-FORTH)
50 51 52 53 54 55 56 57 58 OK
DEMO OK
CLEAR.DATA OK
OUTPUT
Empty file
OK
INPUT
ENTER NAME --> EZNITH
ENTER DATE --> ( MM/DD/YY ) 4/21/81
ENTER AMOUNT --> 18.50
1 EZNITH 04/21/81 $ 18.50OK
!NAME ZENITH OK
.REC
1 ZENITH 04/21/81 $ 18.50OK
UPDATE FLUSH OK
INPUT
ENTER NAME --> IB
ENTER DATE --> ( MM/DD/YY ) 04/21/81
ENTER AMOUNT --> 60.
2 IBM 04/21/81 $ 60.00OK
INPUT
ENTER NAME --> DEC
ENTER DATE --> ( MM/DD/YY ) 4/21/81
ENTER AMOUNT --> 103.5
3 DEC 04/21/81 $ 103.50OK
DECIMAL OK
0 READ ADDRESS 144 DUMP DECIMAL
C7FA 3 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 .................
C80A 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 .................
C81A 0 0 0 0 0 0 0 0 5A 45 4E 49 54 48 20 20 .........ZENITH
C82A 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
C83A 20 20 20 20 20 20 E 2A 0 0 3A 7 0 0 49 42 .*..:..IB
C84A 4D 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 M
C85A 20 20 20 20 20 20 20 20 20 20 20 20 E 2A 0 0 .*..
C86A 70 17 0 0 44 45 43 20 20 20 20 20 20 20 20 20 p...DEC
C87A 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
OK
OK
OUTPUT
1 ZENITH 04/21/81 $ 18.50
2 IBM 04/21/81 $ 60.00
3 DEC 04/21/81 $ 103.50
OK
OK
OK
: STATEMENT CR CR 20 SPACES ." STATEMENT" CR CR OUTPUT
CR CR ." TOTAL VALUE " 33 SPACES 0 0 0 READ TAG @ 1+ 1
DO _ READ DOLLAR D@ D+ LOOP .$AMOUNT CR CR CR ; OK
OK
OK
STATEMENT
STATEMENT
1 ZENITH 04/21/81 $ 18.50
2 IBM 04/21/81 $ 60.00
3 DEC 04/21/81 $ 103.50
TOTAL VALUE $ 182.00
OK