home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol025 / dbunit.1 < prev    next >
Text File  |  1984-04-29  |  8KB  |  232 lines
  1. (* L #5:DBUNIT.LST.TEXT*) {make sure you leave plenty of room for the listing}
  2. (*$S+*)
  3. UNIT DBUNIT; (*version 1.2 - 5 Feb, 1980*)
  4.   (*Copyright 1980 Kenneth L. Bowles. All rights reserved. Permission
  5.     is hereby granted to use this material for any non-commercial 
  6.     purpose*)
  7. INTERFACE
  8. CONST
  9.   LASTWRKINDEX=20;
  10.   LONGINTSIZE=14;
  11.   SETSIZE=47;
  12.   NAMESTRSIZE=30;
  13.   LASTFILENUM=4;
  14.   
  15. TYPE
  16.   BYTE=0..255;
  17.   DBWRKINDEX=0..LASTWRKINDEX;
  18.   DBERRTYPE=0..100; (*not a scalar to conserve symbols*)
  19.   DBFILENUM=0..LASTFILENUM;
  20.   DBFIELDTYPES=(GROUPF, STRINGF, BYTEF, INTEGERF, LONGINTF,
  21.                 ADDRCOUPLEF, SETF, PICF, TEXTF);
  22.                 
  23.   DBLEVELTYPE=(NONET, GROUPT, RECORDT, FIELDT);
  24.   DBFINDRULE=(ASCENDING, DESCENDING, RANDOM);
  25.   
  26.   FILETYPE=FILE; (*compiler won't acccept 'file' as parameter type*)
  27.   
  28.   FLDDESCRIPTOR=
  29.     PACKED RECORD
  30.       OVERLINK:BYTE;
  31.       SWITCHES:BYTE; (*bit 0 = tagged; bit 1 = fixedwidth *)
  32.       MAXWIDTH:INTEGER;
  33.       USECOUNT:BYTE;
  34.       FLDTYPE:DBFIELDTYPES;
  35.       FLDREF:INTEGER; (*points to descriptor of FLDTYPE; =0 IF NOT GROUPF*)
  36.       (*following may get moved to Layout later*)
  37.       ROW:BYTE;
  38.       DATACOL:BYTE;
  39.       LABELCOL:BYTE;
  40.       CONTROLBITS:BYTE;
  41.       NAME:STRING[1]  (*generally will be expanded out of rangechecking*)
  42.     END;
  43.   FLDDESPTR=^FLDDESCRIPTOR;
  44.   
  45.  
  46. VAR
  47.   DBTYPECHECK:BOOLEAN; (*if false can't use fixed length records*)
  48.   DEBUGGING:BOOLEAN;
  49.   F0,F1,F2,F3,F4:FILETYPE;
  50.   
  51.   DBMAIL:
  52.     RECORD CASE DBMAILTYPE: DBFIELDTYPES OF
  53.       GROUPF: ( ); (*TO BE DEFINED*)
  54.       STRINGF: (STRG:STRING[255]);
  55.       BYTEF: (BYT:BYTE);
  56.       INTEGERF: (INT:INTEGER);
  57.       LONGINTF: (LINT:INTEGER[LONGINTSIZE]);
  58.       ADDRCOUPLE:(PGE:INTEGER;
  59.                   GRP:INTEGER;
  60.                   REC:INTEGER);
  61.       SETF: (SETT:PACKED ARRAY[0..SETSIZE] OF BOOLEAN);
  62.       PICF: ( ); (* PICTURES TO BE DEFINED *)
  63.       TEXTF: (TXT: PACKED ARRAY[0..255] OF CHAR)
  64.     END (*DBMAIL*);
  65.     
  66.   DBIORESULT:INTEGER;
  67.   DBTRACESET:SET OF DBERRTYPE;
  68.     
  69. (*TRAVERSAL PRIMITIVES*)
  70.   FUNCTION DBHOME(WI:DBWRKINDEX):DBERRTYPE;
  71.   FUNCTION DBHEAD(WI:DBWRKINDEX):DBERRTYPE;
  72.   FUNCTION DBNEXT(WI:DBWRKINDEX):DBERRTYPE;
  73.   FUNCTION DBTAIL(WI:DBWRKINDEX):DBERRTYPE;
  74.   FUNCTION DBSEEK(WI:DBWRKINDEX; WHICHITEM:INTEGER):DBERRTYPE;
  75.   FUNCTION DBDESCEND(WI:DBWRKINDEX):DBERRTYPE;
  76.   FUNCTION DBASCEND(WI:DBWRKINDEX):DBERRTYPE;
  77.   FUNCTION DBFINDREC(WI:DBWRKINDEX; RULE:DBFINDRULE; FIELDNUM:INTEGER;
  78.                      KEY:STRING; VAR RECNUM:INTEGER;
  79.                      VAR FOUND:BOOLEAN):DBERRTYPE;
  80.   
  81. (*DATA TRANSFER PRIMITIVES*)
  82.   FUNCTION DBCOPY(SOURCE,DESTINATION:DBWRKINDEX):DBERRTYPE;
  83.   FUNCTION DBEMPTYITEM(DESTINATION:DBWRKINDEX; LVL:DBLEVELTYPE;
  84.                                                TAG:INTEGER):DBERRTYPE;
  85.   FUNCTION DBDELETE(DESTINATION:DBWRKINDEX):DBERRTYPE;
  86.   FUNCTION DBBLANK(DESTINATION:DBWRKINDEX):DBERRTYPE;
  87.   FUNCTION DBREPLACE(SOURCE,DESTINATION:DBWRKINDEX):DBERRTYPE;
  88.   FUNCTION DBRESERVE(DESTINATION:DBWRKINDEX):DBERRTYPE;
  89.   FUNCTION DBGET(SOURCE:DBWRKINDEX):DBERRTYPE;
  90.   FUNCTION DBPUT(DESTINATION:DBWRKINDEX):DBERRTYPE;
  91.  
  92. (*SUPPORT PRIMITIVES*)
  93.   FUNCTION DBWRITEFIELD(VAR FID:TEXT; SOURCE:DBWRKINDEX):DBERRTYPE;
  94.   PROCEDURE DBGETDESCRIPTOR(LEVEL:DBLEVELTYPE; 
  95.                             DESCRIPTORNUM:INTEGER;
  96.                             VAR PTR:FLDDESPTR);
  97.   FUNCTION DBTAG(NAME:STRING; SOURCE:DBWRKINDEX; VAR ITEMNUM:INTEGER):DBERRTYPE;
  98.   
  99. (*WORKAREA PRIMITIVES*)
  100.   FUNCTION DBWRKOPEN(WI:DBWRKINDEX; SIZE:INTEGER):DBERRTYPE;
  101.   FUNCTION DBWRKCLOSE(WI:DBWRKINDEX):DBERRTYPE;
  102.   PROCEDURE ZEROWORKAREA(WI:DBWRKINDEX);
  103.  
  104. (*FILE PRIMITIVES*)
  105.   FUNCTION DBFOPEN(FNUM:DBFILENUM; TITLE:STRING):DBERRTYPE;
  106.   FUNCTION DBFCLOSE(FNUM:DBFILENUM):DBERRTYPE;
  107.   FUNCTION DBFCREATE(FNUM:DBFILENUM; WASCRATCH:DBWRKINDEX;
  108.                                      SPEXTITLE,NEWTITLE:STRING):DBERRTYPE;
  109.   FUNCTION DBFREMOVE(FNUM:DBFILENUM):DBERRTYPE;
  110.   FUNCTION DBGETPAGE(FNUM:DBFILENUM; DESTINATION:DBWRKINDEX;
  111.                                      PAGENUM:INTEGER):DBERRTYPE;
  112.   FUNCTION DBPUTPAGE(FNUM:DBFILENUM; SOURCE:DBWRKINDEX;
  113.                                      PAGENUM:INTEGER):DBERRTYPE;
  114.  
  115. (*DESCRIPTOR INITIALIZING PRIMITIVES*)
  116.   FUNCTION DBGROUPINIT(FNUM:DBFILENUM; VAR GROUPNUM:INTEGER;
  117.                                               GROUPNAME:STRING):DBERRTYPE;
  118.   FUNCTION DBGROUPRELEASE(GROUPNUM:INTEGER):DBERRTYPE;
  119.   
  120. (*INITIALIZATION*)
  121.   PROCEDURE DBINITIALIZE;
  122.   
  123. (*ORDERLY TERMINATION*)
  124.   FUNCTION DBCLOSEDOWN:DBERRTYPE;
  125.   
  126. (*ERROR REPORTING AND DIAGNOSTICS*)
  127.   PROCEDURE DBSHOWERROR(S:STRING; ERRNUM:DBERRTYPE);
  128.   PROCEDURE DBITEMINFO(WI:DBWRKINDEX; VAR LEVEL:DBLEVELTYPE;
  129.            VAR ITEMNUM,OFFSET,DESCRIPTORNUM:INTEGER; VAR NAME:STRING);
  130.   
  131. (**************************************************************)
  132. IMPLEMENTATION
  133. CONST
  134.   PAGELASTBYTE=4095;
  135.   LASTSPECIALGROUP=6;
  136.   LASTWRKSTACKSLOT=9;
  137.   LASTGROUPDESCRIPTOR=255;
  138.   LASTRECDESCRIPTOR=255;
  139.   LASTFIELDDESCRIPTOR=255;
  140.   LINKESCAPE=240;
  141.   DBNUL=0;
  142.   ONEITEMRECLINK=6;
  143.   
  144. TYPE
  145.   PAGEPTR=0..PAGELASTBYTE;
  146.   PAGETYPE=PACKED ARRAY[PAGEPTR] OF BYTE;
  147.   
  148.   (*work area information block - WIB *)
  149.   WIBENTRY=
  150.     RECORD
  151.       OFFSET:PAGEPTR;
  152.       LEVEL:DBLEVELTYPE;
  153.       DESCRIPTORNUM:INTEGER;
  154.       ITEMNUM:INTEGER;
  155.     END;
  156.   TOSRANGE=0..LASTWRKSTACKSLOT;
  157.   WIBTYPE=ARRAY[TOSRANGE] OF WIBENTRY;
  158.   WIBPTR=^WIBTYPE;
  159.   
  160.   (*following are dummy types used for heap allocation of workareas*)
  161.   WATYPE=PACKED ARRAY[0..63] OF BYTE; (* WA will be multiple of these*)
  162.   WAPTR=^WATYPE;
  163.   ONEWORDPTR=^INTEGER;
  164.   REFLIST=ARRAY[0..0] OF INTEGER; (*index with range checking off*)
  165.   
  166.   (*fixed layout parts of descriptors*)
  167.   GRPDESCRIPTOR=
  168.     PACKED RECORD
  169.       OVERLINK:BYTE; (*descriptor longer than 240 bytes not allowed*)
  170.       SWITCHES:BYTE; (*packed array gets allocated in whole words*)
  171.                      (*bit 0 = tagged; bit 1 = linked *)
  172.       RECLINK:BYTE;
  173.       FILLER:BYTE;
  174.       RECNUM:REFLIST;
  175.       (*expand here with additional recnum's*)
  176.     END;
  177.   GRPDESPTR=^GRPDESCRIPTOR;
  178.   
  179.   RECDESCRIPTOR=
  180.     PACKED RECORD
  181.       OVERLINK:BYTE;
  182.       SWITCHES:BYTE; (*bit 0 = tagged; bit 1 = fixed width; bit 2 = sparse *)
  183.       SIZE:INTEGER;
  184.       FIRSTLITEMNUM:BYTE; (*set to 1 more than last fixed itemnumber if
  185.                             there are only fixed fields in the record*)
  186.       USECOUNT:BYTE;
  187.       LAYOUT:BYTE; (*on a large system this could be declared TAG*)
  188.       LASTFLDLINK:BYTE; (*points to name field, indirect upper bound of
  189.                             FLDREF array*)
  190.       FLDREF:ARRAY [0..0] OF
  191.                PACKED RECORD
  192.                  FDNUM: 0..LASTFIELDDESCRIPTOR;
  193.                  FLDOFFSET:BYTE; (*for fixed size fields; =0 for linked*)
  194.                END;
  195.       (*expand here with additional fldref's*)
  196.     END;
  197.   RECDESPTR=^RECDESCRIPTOR;
  198.  
  199.   CRACKSWTYPE=  (*for accessing individual switch control bits*)
  200.     PACKED RECORD
  201.       CASE BOOLEAN OF
  202.         TRUE:(BL:BYTE; BH:BYTE);
  203.         FALSE:(A:PACKED ARRAY[0..15] OF BOOLEAN);
  204.       END (*CRACKSWTYPE*);
  205.  
  206. VAR
  207.   HEAPMARKER:ONEWORDPTR;
  208.   OPENFILES: PACKED ARRAY[0..LASTFILENUM] OF BOOLEAN;
  209.   
  210.   (*page numbers of fixed numbered groups at beginning of file*)
  211.   SPECIALGROUPPAGE: ARRAY[0..LASTSPECIALGROUP] OF INTEGER;
  212.   
  213.   (*all access to workareas flows via WRKTABLE*)
  214.   WRKTABLE: ARRAY[DBWRKINDEX] OF
  215.     RECORD
  216.       TOS: TOSRANGE; (*top of stack*)
  217.       WIB: WIBPTR; (*points to stack of offsets in WIB; NIL if none allocated*)
  218.       WSIZE: INTEGER; (*size of Workarea in bytes*)
  219.       SPACEINUSE: INTEGER; (*initially 0*)
  220.       WA: WAPTR  (*the workarea itself*)
  221.     END;
  222.       
  223.   (*all access to on-line descriptors is via these arrays*)
  224.   ACTIVEGROUPS: ARRAY[0..LASTGROUPDESCRIPTOR] OF GRPDESPTR;
  225.   ACTIVERECORDS: ARRAY[0..LASTRECDESCRIPTOR] OF RECDESPTR;
  226.   ACTIVEFIELDS: ARRAY[0..LASTFIELDDESCRIPTOR] OF FLDDESPTR;
  227.   
  228.   (*Lower and Upper bound for tracing*)
  229.   TRACELB,TRACEUB:INTEGER;
  230.   
  231.       
  232.