/* Output from p2c 1.21alpha-07.Dec.93, the Pascal-to-C translator */ /* From input file "delmod.p" */ #include /* delila module library Dr. Thomas D. Schneider National Institutes of Health National Cancer Institute Center for Cancer Research Nanobiology Program Molecular Information Theory Group Frederick, Maryland 21702-1201 toms@ncifcrf.gov permanent email: toms@alum.mit.edu (use only if first address fails) http://www.ccrnp.ncifcrf.gov/~toms/ Thomas Schneider and Gary Stormo */ /* end of program */ /* begin module version */ #define version 7.72 /*of delmod.p 2007 Jul 23*/ /* 2007 Jul 23: 7.72: cleanup 2007 Jun 22: 7.71: "The piece name in the book" - ignore dotted names 2005 Sep 15: 7.70: linelength increased, brline protected 2005 Sep 13: 7.69: spelling correction: asterisk 2005 Jun 23: 7.68: orderseed is now outside timeseed package 2004 Sep 8: 7.67: upgrade skipblanks to match prgmod 2004 Aug 4: 7.66: upgrade cleardna documentation 2004 Jul 27: 7.65: bug: "The piece name in the book: ... does not match the inst file name ..." The inst file name was all dots. used variable p instead of p1 of for loop. fixed. 2004 Jul 18: 7.64: dircomplement/dirhomologous handled 2003 Jan 13: 7.63: getocp must handle mapunit 2003 Jan 13: 7.61: bworg and bwchr wrote to 'book' instead of thefile 2003 May 3: 7.60: ex0bk description improved. 2002 Sep 5: 7.59: cleanup 2001 Mar 16: 7.58: clearname has a var variable! 2001 Mar 15: 7.57: improve getocp documentation about how to initialize 2000 Nov 21: 7.56: improve getocp documentation about how to initialize 2000 Nov 16: 7.55: make it skip quotes in proc.align. 2000 Nov 16: 7.54: fix reading of name and set instructions in proc. align 2000 Jul 30: 7.53: use gpc time modules! 2000 Jul 30: 7.52: no basic longer source of time functions. 2000 Jul 23: 7.51: update documentation 2000 Jul 23: 7.50: gut showfreedna - incompatable with gpcc 2000 Jun 26: 7.49: introduce iwgetsimple 2000 Jun 26: 7.48: writeline to write lineptr type 2000 Jun 26: 7.47: upgrade iwget to control return 2000 Jun 26: 7.46: upgrade iworgchr to include open booleans 2000 Apr 19: 7.43: duplicate parts in bworg removed (it's in bworgkey) 2000 Mar 22: 7.42: bug in getbase: now does circular grabs for safety. 2000 Feb 18: 7.40: final solution to y2k problem: date call with formatting 1999 Dec 13: 7.38: Solve y2k bug for 10 years (see getdatetime) 1999 July 24: 7.37: adjust maxminalignment for first base alignment 1999 July 13: 7.33: revamp getbase and putbase to work from length of dna parts rather than dnamax. This solves bugs in delila. 1999 May 5: 7.14: added crash function 1999 April 28: 7.11: iwget same function taken from search. 1999 April 27: 7.09: fixed equalname: need to set i initially 1999 Mar 13: 6.99: brpiece assumes that one starts at the word 'piece'. This means that it now reads the complete object. 1999 Mar 9: 6.95: brpiece and other read routines give change in line number in the file that they read. This allows delila to use these routines. MANY programs will have to be changed... but it's not a hard change. 1999 Mar 4: strings were added so that the program compiles 1999 Mar 4: timeseed dates were corrected 1998 Aug 1: getocp has to set 1998 Jan 26: namelength set to 100 to allow long names 1998 Jan 4: dnamax set to 10 million for faster scans 1997 April 22: Year 2000 date solved; program accepts old format AND new format */ /* end module version */ /* begin module describe.delmod */ /* name delmod: delila module library synopsis delmod(book: in, output: out) files book: any book from the delila system, or an empty file. output: the version of delmod is printed along with test results if the book is not empty. Successful compilation and running of the program indicates that the modules are correct. description Delmod is a collection of modules used by delila system programs. The easiest way to obtain a list of the modules is to run the module program using delmod for both sin and modlib (with dummy files for the other input). There are a number of information modules, indicated by names beginning with 'info.'. There are also a number of packages of modules that pickup other modules. These begin with 'package.'. You should note that some modules are constants, others types, etc. These must remain in their proper location to allow compilation. The delmod program will report the current date and time in the standard Delila format. The delmod program will read a delila book if the 'book' file is not empty and report some information about it. examples You can use an empty file for book or a good book to use to test delmod is ex0bk. To do this, get the ex0bk file (see link below) and then rename it 'book'. see also module.p {The module program is use to transfer modules from this library to other programs.} {Example book for testing:} ex0bk {Other module libraries:} prgmod.p matmod.p {General discussion on compiling Delila programs:} http://www.lecb.ncifcrf.gov/~toms/delila.html#How.To.Compile {Time modules may be moved into this module library, but the ultimate source is now in three places, not here: } timesun.p timep2c.p timegpc.p author Thomas D. Schneider and Gary D. Stormo bugs technical notes */ /* end module describe.delmod */ /* packages of modules ******************************************************/ /* begin module info.package */ /* information on packages of modules package.getpiece picks up procedure getpiece and the procedures it requires. this allows one to scan a book and detect pieces. the user must still specify const, type, var and procedures to pickup bases from the pieces. package.getocp picks up procedure getocp and the procedures it requires. this allows one to scan a book and detect organisms, chromosomes and pieces. the user must still specify const, type, var and procedures to pickup bases from the pieces. package.nextbase this package allows a programmer to pull out bases from a book with little programming effort (at the expense of flexability). see documentation in module info.nextbase. package.bwrite these routines allow one to write out parts of a book, without worry (for the most part) on the structure of the book. package.iwrite picks up procedures that allow one to easily write delila instructions. the typical use is as output from a book searching program. note: module copylines is required above this package. package.align picks up procedure align and the procedures it uses. it does not pick up the other align procedures. align (and associated procedures, if pickedup) allow one to read a book and instructions for the book concurrently. the pieces of the book are returned along with the aligning base (in internal coordinates). package.datetime interfaces to the system clock. these make date and time calls system independent. THIS PACKAGE IS NOW TO BE TAKEN FROM ONE OF THE TIME PROGRAMS: timesun.p, timegpc.p timep2c.p package.primitive this is a package of primitive programming functions that many programs will use. it includes a halt function and line copying functions. */ /* end module info.package */ /* begin module package.brpiece */ /* ************************************************************************ */ /* begin module book.basis */ /* end module book.basis */ /* begin module book.getto */ /* end module book.getto */ /* begin module book.skipstar */ /* end module book.skipstar */ /* begin module book.brreanum */ /* end module book.brreanum */ /* begin module book.brnumber */ /* end module book.brnumber */ /* begin module book.brname */ /* end module book.brname */ /* begin module book.brline */ /* end module book.brline */ /* begin module book.brdirect */ /* end module book.brdirect */ /* begin module book.brconfig */ /* end module book.brconfig */ /* begin module book.brnotenumber */ /* end module book.brnotenumber */ /* begin module book.brnote */ /* end module book.brnote */ /* begin module book.brheader */ /* end module book.brheader */ /* begin module book.copyheader */ /* end module book.copyheader */ /* begin module book.brpiekey */ /* end module book.brpiekey */ /* begin module book.brdna */ /* end module book.brdna */ /* begin module book.brpiece */ /* end module book.brpiece */ /* begin module book.brinit */ /* end module book.brinit */ /* ************************************************************************ */ /* end module package.brpiece */ /* begin module package.getpiece */ /* ************************************************************************ */ /* begin module package.brpiece */ /* end module package.brpiece */ /* begin module book.getpiece */ /* end module book.getpiece */ /* ************************************************************************ */ /* end module package.getpiece */ /* begin module package.getocp */ /* ************************************************************************ */ /* begin module package.brpiece */ /* end module package.brpiece */ /* begin module book.brorgkey */ /* end module book.brorgkey */ /* begin module book.brchrkey */ /* end module book.brchrkey */ /* begin module book.getocp */ /* end module book.getocp */ /* ************************************************************************ */ /* end module package.getocp */ /* begin module package.nextbase */ /* ************************************************************************ */ /* begin module package.getpiece */ /* end module package.getpiece */ /* begin module book.stepbase */ /* end module book.stepbase */ /* begin module nextbase */ /* end module nextbase */ /* ************************************************************************ */ /* end module package.nextbase */ /* begin module package.bwrite */ /****************************************************************************/ /* this is a package of procedures for writing books, by gary stormo, aug 17, 1982 */ /* begin module book.bwbasics */ /* end module book.bwbasics */ /* begin module book.bworg */ /* end module book.bworg */ /* begin module book.bwchr */ /* end module book.bwchr */ /* begin module book.bwdna */ /* end module book.bwdna */ /* begin module book.bwpie */ /* end module book.bwpie */ /* begin module book.bwref */ /* end module book.bwref */ /* begin module book.bwgen */ /* end module book.bwgen */ /* begin module book.bwtra */ /* end module book.bwtra */ /* begin module book.bwmar */ /* end module book.bwmar */ /****************************************************************************/ /* end module package.bwrite */ /* begin module package.iwrite */ /* ************************************************************************ */ /* begin module book.iwcombk */ /* end module book.iwcombk */ /* begin module book.iwname */ /* end module book.iwname */ /* begin module book.iworg */ /* end module book.iworg */ /* begin module book.iwchr */ /* end module book.iwchr */ /* begin module book.iwpie */ /* end module book.iwpie */ /* begin module book.iworgchr */ /* end module book.iworgchr */ /* begin module book.iwget */ /* end module book.iwget */ /* begin module book.iwget2 */ /* end module book.iwget2 */ /* begin module book.iwgetsimple */ /* end module book.iwgetsimple */ /* ************************************************************************ */ /* end module package.iwrite */ /* begin module LOCKED.package.datetime */ /* ************************************************************************ */ /* as of 2000 July 30, the source of package.datetime is now the timeXXX.p programs */ /* begin module getdatetime */ /* end module getdatetime */ /* begin module readdatetime */ /* end module readdatetime */ /* begin module writedatetime */ /* end module writedatetime */ /* begin module timeseed */ /* end module timeseed */ /*[[*/ /* begin module limitdate */ /* end module limitdate */ /*]]*/ /* ************************************************************************ */ /* end module LOCKED.package.datetime */ /* begin module package.primitive */ /* ************************************************************************ */ /* begin module halt */ /* end module halt */ /* begin module copyaline */ /* end module copyaline */ /* begin module copylines */ /* end module copylines */ /* ************************************************************************ */ /* end module package.primitive */ /* begin module package.align */ /* ************************************************************************ */ /* begin module package.getpiece */ /* end module package.getpiece */ /* begin module findblank */ /* end module findblank */ /* begin module findnonblank */ /* end module findnonblank */ /* begin module align.align */ /* end module align.align */ /* ************************************************************************ */ /* end module package.align */ /* begin module book.const ***************************************************/ /* constants needed for book manipulations */ #define dnamax 1024 /* length of dna arrays */ #define namelength 100 /* maximum key name length */ #define linelength 200 /* maximum line readable in book */ /* end module book.const */ /* begin module datetime.const */ #define datetimearraylength 19 /* length of dataarray for dates, It is just long enough to include the 4 digit year - solving the year 2000 problem: 1980/06/09 18:49:11 123456789 123456789 1 2 */ /* end module datetime.const version = 'cdatemod.p 1.19 1999Dec13'; */ /* trigger definitions follow to make program compilable. The prgmod.p program has the triggers */ /* module filler.const */ #define fillermax 50 /* the size of the filler array for a string */ /* module filler.const from prgmod.p 4.20 */ /* begin module interact.const */ /* begin module string.const */ #define maxstring 2000 /* the maximum string */ /* end module string.const version = 4.86; (@ of prgmod.p 2004 Sep 8 */ /* end module interact.const version = 4.86; (@ of prgmod.p 2004 Sep 8 */ /* begin module datetime.type */ /* array for dates */ typedef Char datetimearray[datetimearraylength]; /* end module datetime.type version = 'cdatemod.p 1.19 1999Dec13'; */ /* begin module base.type */ /* define the four nucleotide bases */ typedef enum { a, c, g, t } base; /* end module base.type version = 4.86; (@ of prgmod.p 2004 Sep 8 */ /* begin module book.type ****************/ /* types needed for book manipulations */ typedef long chset[5]; /* types defined in book definition */ typedef Char alpha[namelength]; /* this is not alfa */ /* name is a left justified string with blanks following the characters */ typedef struct name { alpha letters; /* zero means an unspecified structure */ char length; } name; typedef struct line { /* a line of characters */ Char letters[linelength]; uchar length; struct line *next; } line; typedef enum { plus, minus, dircomplement, dirhomologous } direction; typedef enum { linear, circular } configuration; typedef enum { on, off } state; typedef struct header { /* header of key */ name keynam; /* key name of structure */ line *fulnam; /* full name of structure */ /* note key */ line *note; } header; /* begin module base.type */ /* end module base.type */ /* sequence types */ typedef short dnarange; /* p2c: delmod.p, line 495: * Note: Field width for seq assumes enum base has 4 elements [105] */ typedef uchar seq[(dnamax + 3) / 4]; typedef struct dnastring { seq part; dnarange length; struct dnastring *next; } dnastring; typedef struct orgkey { /* organism key */ header hea; /* genetic map units */ line *mapunit; } orgkey; typedef struct chrkey { /* chromosome key */ header hea; double mapbeg; /* number of genetic map beginning */ /* number of genetic map ending */ double mapend; } chrkey; typedef struct piekey { /* piece key */ header hea; double mapbeg; /* genetic map beginning */ configuration coocon; /* configruation (circular/linear) */ direction coodir; /* direction (+/-) relative to genetic map */ long coobeg; /* beginning nucleotide */ long cooend; /* ending nucleotide */ configuration piecon; /* configruation (circular/linear) */ direction piedir; /* direction (+/-) relative to coordinates */ long piebeg; /* beginning nucleotide */ long pieend; /* ending nucleotide */ } piekey; typedef struct piece { piekey key; dnastring *dna; } piece; typedef struct reference { name pienam; /* name of piece referred to */ double mapbeg; /* genetic map beginning */ direction refdir; /* direction relative to coordinates */ long refbeg; /* beginning nucleotide */ long refend; /* ending nucleotide */ } reference; typedef struct genkey { /* gene key */ header hea; reference ref; } genkey; typedef struct trakey { /* transcript key */ header hea; reference ref; } trakey; typedef struct markey { /* marker key */ header hea; reference ref; state sta; line *phenotype; struct marker *next; } markey; typedef struct marker { markey key; dnastring *dna; } marker; /* end module book.type version = 1.01; (@ of testtime.p 1997 Jan 11 */ /* begin module amino.type */ typedef Char aminoacid[3]; /* end module amino.type */ /* trigger definitions follow to make program compilable. The prgmod.p program has the triggers */ /* begin module interact.type */ /* begin module string.type */ /* pointer to a string */ typedef struct string { /* a string of characters */ Char letters[maxstring]; /* the letters in the string */ long length; /* the number of characters in the string */ long current; /* the letter we are working on */ Char *next; /* the next string in a series */ } string; /* end module string.type version = 4.86; (@ of prgmod.p 2004 Sep 8 */ /* end module interact.type version = 4.86; (@ of prgmod.p 2004 Sep 8 */ /* module filler.type */ /* the following is an array used to fill a string. it is convenient to have it much shorter than the maxstring, so that it is easy to fill the string using procedure fillstring. the user must declare the value of constant fillermax. */ typedef Char filler[fillermax]; /* module filler.type from prgmod.p 4.20 */ /* module trigger.type */ typedef struct trigger { /* an object to be searched for */ string seek; /* the characters looked for */ long state_; /* how close to triggering we are */ boolean skip; /* trigger not found- skip the line */ /* the trigger was found */ boolean found; } trigger; /* module trigger.type from prgmod.p 4.20 */ Static _TEXT book; /* for testing delmods */ /* begin module book.var */ /* ************************************************************************ */ /* global variables needed for book manipulations */ /* free storage: */ Static line *freeline; /* unused lines */ Static dnastring *freedna; /* unused dnas */ Static boolean readnumber; /* whether to read a number from the notes, or to read in the notes */ Static long number; /* the number of the item just read */ Static boolean numbered; /* true when the item just read is numbered */ Static boolean skipunnum; /* a control variable to allow skipping of un-numbered items in the book */ /* ************************************************************************ */ /* end module book.var */ /* ************************************************************************ */ /* primitive procedures and functions for everyday use */ /* begin module crash */ Static Void crash() { /* Crash the program by trying to open a nonexistant file. This allows tracing by the dbx program. To use: insert call into the halt program or whereever a traceable stop is desired. */ _TEXT bogus; /* boghous internal file */ bogus.f = NULL; *bogus.name = '\0'; printf(" program crash.\n"); if (*bogus.name != '\0') bogus.f = fopen(bogus.name, "r"); else rewind(bogus.f); if (bogus.f == NULL) _EscIO2(FileNotFound, bogus.name); RESETBUF(bogus.f, Char); fclose(bogus.f); } Static jmp_buf _JL1; /* end module crash */ /* begin module halt */ Static Void halt() { /* stop the program. the procedure performs a goto to the end of the program. you must have a label: label 1; declared, and also the end of the program must have this label: 1: end. examples are in the module libraries. this is the only goto in the delila system. */ printf(" program halt.\n"); longjmp(_JL1, 1); } /* end module halt version = 4.86; (@ of prgmod.p 2004 Sep 8 */ /* begin module skipblanks */ /* 2003 July 31: tab is considered a blank character */ Static boolean isblank(c_) Char c_; { /* is the character c blank or tab? */ return (c_ == ' ' || c_ == '\t'); } Static Void skipblanks(thefile) _TEXT *thefile; { /* skip over blanks until a non-blank, or end of line, is found */ while (isblank(P_peek(thefile->f)) & (!P_eoln(thefile->f))) getc(thefile->f); } Static Void skipnonblanks(thefile) _TEXT *thefile; { /* skip over nonblanks until a blank, or end of line, is found */ while ((!isblank(P_peek(thefile->f))) & (!P_eoln(thefile->f))) getc(thefile->f); } Static Void skipcolumn(thefile) _TEXT *thefile; { /* skip over a data column */ skipblanks(thefile); skipnonblanks(thefile); } /* end module skipblanks version = 4.86; (@ of prgmod.p 2004 Sep 8 */ /* begin module copyaline */ Static Void copyaline(fin, fout) _TEXT *fin, *fout; { /* copy a line from file fin to file fout */ while (!P_eoln(fin->f)) { putc(P_peek(fin->f), fout->f); getc(fin->f); } fscanf(fin->f, "%*[^\n]"); getc(fin->f); putc('\n', fout->f); } /* copyaline */ /* end module copyaline version = 4.86; (@ of prgmod.p 2004 Sep 8 */ /* begin module copylines */ Static long copylines(fin, fout, n) _TEXT *fin, *fout; long n; { /* copy n lines of file fin to file fout. the actual number of lines copied is returned. */ long index = 0; /* the current line number */ while (!BUFEOF(fin->f) && index < n) { copyaline(fin, fout); index++; } return index; } /* copylines */ /* end module copylines version = 4.86; (@ of prgmod.p 2004 Sep 8 */ /* begin module missparam */ Static Void missparam(param) _TEXT *param; { /* look at param to see if the next parameter is missing this is useful when reading in a series of parameters. use it just before readln of each parameter.*/ if (BUFEOF(param->f)) { printf(" missing parameter\n"); halt(); } } /* missparam */ /* end module missparam */ /* This module is commented out for the moment, since strings are not (yet) defined in delmod. But the module program can pick it up perfectly well, since it doesn't know about this kind of comment!! (* begin module isnamestring *) function isnamestring(n: name; s: string): boolean; (* is the delila-type name n the same as the string s? *) var c: integer; (* index to n and s *) done: boolean; (* done checking *) begin (* write(output,'isnamestring s(',s.length:1,'):'); writestring(output,s); write(output,', n(',n.length:1,'):'); for c := 1 to n.length do write(output,n.letters[c]); writeln(output); *) if n.length = s.length then begin c := 1; done := false; while not done do begin (* writeln(output,' ',s.letters[c],' ' ,n.letters[c]); *) if s.letters[c] = n.letters[c] then begin c := succ(c); if c > s.length then begin isnamestring := true; done := true end end else begin isnamestring := false; done := true end end end else isnamestring := false; end; (* end module isnamestring *) */ /*****************************************************************************/ /* dating procedures *********************************************************/ /*****************************************************************************/ /* begin module getdatetime */ Static Void getdatetime(adatetime) Char *adatetime; { /* Get the date and time into a single array from the system clock. adatetime contains the date: 1980/06/09 18:49:11 ye mo da ho mi se (year, month, day, hour, minute, second) This version works after translation of the pascal by p2c to C and then compiling with gcc. */ Char adate[11], atime[11]; /* adate, atime: alfa; (* ie, packed array[1..10] of char; *) This old method won't work, since the last digit gets cut off! */ Char month[3]; long index; /* index for times */ /* 1 12345678901 adate[13-DEC-1999] atime[17:39:44.00] */ VAXdate(adate); VAXtime(atime); /* writeln(output,'br: adate[',adate,'] atime[',atime,']'); */ /* transfer the year */ for (index = 1; index <= 4; index++) adatetime[index-1] = adate[index+6]; adatetime[4] = '/'; for (index = 4; index <= 6; index++) month[index-4] = adate[index-1]; if (!strncmp(month, "JAN", 3)) { adatetime[5] = '0'; adatetime[6] = '1'; } else if (!strncmp(month, "FEB", 3)) { adatetime[5] = '0'; adatetime[6] = '2'; } else if (!strncmp(month, "MAR", 3)) { adatetime[5] = '0'; adatetime[6] = '3'; } else if (!strncmp(month, "APR", 3)) { adatetime[5] = '0'; adatetime[6] = '4'; } else if (!strncmp(month, "MAY", 3)) { adatetime[5] = '0'; adatetime[6] = '5'; } else if (!strncmp(month, "JUN", 3)) { adatetime[5] = '0'; adatetime[6] = '6'; } else if (!strncmp(month, "JUL", 3)) { adatetime[5] = '0'; adatetime[6] = '7'; } else if (!strncmp(month, "AUG", 3)) { adatetime[5] = '0'; adatetime[6] = '8'; } else if (!strncmp(month, "SEP", 3)) { adatetime[5] = '0'; adatetime[6] = '9'; } else if (!strncmp(month, "OCT", 3)) { adatetime[5] = '1'; adatetime[6] = '0'; } else if (!strncmp(month, "NOV", 3)) { adatetime[5] = '1'; adatetime[6] = '1'; } else if (!strncmp(month, "DEC", 3)) { adatetime[5] = '1'; adatetime[6] = '2'; } adatetime[7] = '/'; for (index = 7; index <= 8; index++) adatetime[index+1] = adate[index-7]; /* replace blanks with spaces in dates */ if (adatetime[5] == ' ') adatetime[5] = '0'; if (adatetime[8] == ' ') adatetime[8] = '0'; adatetime[10] = ' '; for (index = 10; index <= 17; index++) adatetime[index+1] = atime[index-10]; for (index = 19; index <= datetimearraylength + 1; index++) adatetime[index] = ' '; } /* end module getdatetime version = 'cdatemod.p 1.19 1999Dec13'; */ /*****************************************************************************/ /* begin module oldgetdatetime */ /* This old module contains methods for converting dates, but it is messy compared to the new one installed on 2000 Feb 18. XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX X THE ROUTINE IS NEUTRALIZED BY A COMMENT TO PREVENT THE COMPLER FROM X X SEEING THE NOW "UNSAFE" datetime(adate) CALL. X XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX procedure oldgetdatetime(var adatetime: datetimearray); (* get the date and time into a single array from the system clock *) (* this procedure works on the pascal compiler of a Pyramid 90x computer *) (* adatetime contains the date: 1980/06/09 18:49:11 ye mo da ho mi se (year, month, day, hour, minute, second) *) var adate, atime: alfa; (* ie, packed array[1..10] of char; *) (* (* the month array is only used on computers where month is expreessed in characters *) month: packed array[1..3] of char; *) index: integer; (* index for times *) begin (* clear *) for index:=1 to 20 do adatetime[index]:='?'; date(adate); time(atime); (* use the following line to determine the characters returned by the date and functions. Comment out the line when this routine is in normal use *) (* writeln(output,'getdatetime: adate[',adate,'] atime[',atime,']'); *) (* Unix was not (as of 1997 Mar 16) supplying the "19", so we put it in ourselves: adatetime[1]:='1'; adatetime[2]:='9'; However, even by 1999 Dec 13 Sun Pascal is *still* not Y2K compliant, as shown by this code: writeln(output,'adate: "',adate,'"'); gives: adate: "12/13/99 " adate: "12/13/99 " atime: "16:57:46 " Here is a workaround that will last 10 years: *) (* Have we passed y2k? *) if ((adate[7]='9') and (adate[8]='9')) then begin adatetime[1]:='1'; adatetime[2]:='9'; end else begin adatetime[1]:='2'; adatetime[2]:='0'; end; (* year *) for index:=1 to 2 do adatetime[index+2]:=adate[index+6]; adatetime[3+2]:='/'; (* month *) for index:=4 to 5 do adatetime[index+2]:=adate[index-3]; adatetime[6+2]:='/'; (* day *) for index:=7 to 8 do adatetime[index+2]:=adate[index-6+3]; if adatetime[7+2] = ' ' then adatetime[7+2] := '0'; (* safety *) adatetime[9+2]:=' '; (* time *) for index:=10 to 17 do adatetime[index+2]:=atime[index-9]; (* writeln(output,'final result: ',adatetime); *) (* Suddenly on 1997 January 11 this no longer worked under UNIX!!! (* year *) for index:=1 to 2 do adatetime[index]:=adate[index+7]; adatetime[3]:='/'; (* month *) for index:=4 to 6 do month[index-3]:=adate[index]; if month='Jan' then begin adatetime[4]:='0'; adatetime[5]:='1' end else if month='Feb' then begin adatetime[4]:='0'; adatetime[5]:='2' end else if month='Mar' then begin adatetime[4]:='0'; adatetime[5]:='3' end else if month='Apr' then begin adatetime[4]:='0'; adatetime[5]:='4' end else if month='May' then begin adatetime[4]:='0'; adatetime[5]:='5' end else if month='Jun' then begin adatetime[4]:='0'; adatetime[5]:='6' end else if month='Jul' then begin adatetime[4]:='0'; adatetime[5]:='7' end else if month='Aug' then begin adatetime[4]:='0'; adatetime[5]:='8' end else if month='Sep' then begin adatetime[4]:='0'; adatetime[5]:='9' end else if month='Oct' then begin adatetime[4]:='1'; adatetime[5]:='0' end else if month='Nov' then begin adatetime[4]:='1'; adatetime[5]:='1' end else if month='Dec' then begin adatetime[4]:='1'; adatetime[5]:='2' end; adatetime[6]:='/'; (* day *) for index:=7 to 8 do adatetime[index]:=adate[index-6]; if adatetime[7] = ' ' then adatetime[7] := '0'; (* safety *) adatetime[9]:=' '; *) end; */ /* end module oldgetdatetime version = 1.01; (@ of testtime.p 1997 Jan 11 */ /* begin module readdatetime */ Static Void readdatetime(thefile, adatetime) _TEXT *thefile; Char *adatetime; { /* read the date and time from the file */ long index; /* to the udatetime */ /* the following is an unpacked date time array, to avoid reading into a packed array. reading into a packed array is not transportable */ Char udatetime[datetimearraylength]; for (index = 0; index < datetimearraylength; index++) { udatetime[index] = getc(thefile->f); if (udatetime[index] == '\n') udatetime[index] = ' '; } memcpy(adatetime, udatetime, sizeof(datetimearray)); if (adatetime[2] == '/' && adatetime[11] == ':') printf(" old datetime (only 2 year digits) read: %.*s\n", datetimearraylength, adatetime); /* p2c: delmod.p, line 969: Note: * Format for packed-array-of-char will work only if width < length [321] */ /* if (adatetime[3]<>'/') or (adatetime[12]<>':') then begin writeln(output,' bad date time read: ',adatetime:1); halt end; for index:=18 to datetimearraylength do adatetime[index]:=' ' */ } /* end module readdatetime version = 'cdatemod.p 1.19 1999Dec13'; */ /* begin module writedatetime */ Static Void writedatetime(thefile, adatetime) _TEXT *thefile; Char *adatetime; { /* expand the date and time out and print in the file */ long index; /* index of datetime */ for (index = 0; index < datetimearraylength; index++) putc(adatetime[index], thefile->f); } /* end module writedatetime version = 'cdatemod.p 1.19 1999Dec13'; */ /* begin module timeseed */ Static Void addtoseed(seed, power, c_) double *seed, *power; Char c_; { /* add the digit represented by c to the seed at the power position */ long n; /* the character represented by c */ *power /= 10; /* writeln(output,'addtoseed, c = ',c); writeln(output,'addtoseed, ord(c) = ',ord(c)); */ switch (c_) { case ' ': printf("timeseed: error in datetime\n"); halt(); break; case '0': n = 0; break; case '1': n = 1; break; case '2': n = 2; break; case '3': n = 3; break; case '4': n = 4; break; case '5': n = 5; break; case '6': n = 6; break; case '7': n = 7; break; case '8': n = 8; break; case '9': n = 9; break; } /*writeln(output,'timeseed number is [',n:1,']'); (@ debug */ *seed += *power * n; } /* addtoseed */ Static Void makeseed(adatetime, seed) Char *adatetime; double *seed; { /* convert adatetime to a real number in seed, reversed order */ double power = 1.0; /* a digit of the seed such as 0.01 */ *seed = 0.0; addtoseed(seed, &power, adatetime[18]); addtoseed(seed, &power, adatetime[17]); /* : */ addtoseed(seed, &power, adatetime[15]); addtoseed(seed, &power, adatetime[14]); /* : */ addtoseed(seed, &power, adatetime[12]); addtoseed(seed, &power, adatetime[11]); /* */ addtoseed(seed, &power, adatetime[9]); addtoseed(seed, &power, adatetime[8]); /* / */ addtoseed(seed, &power, adatetime[6]); addtoseed(seed, &power, adatetime[5]); /* / */ addtoseed(seed, &power, adatetime[3]); addtoseed(seed, &power, adatetime[2]); } Static Void orderseed(adatetime, seed) Char *adatetime; double *seed; { /* convert adatetime to a real number in seed, normal order */ double power = 1.0; /* a digit of the seed such as 0.01 */ *seed = 0.0; addtoseed(seed, &power, adatetime[2]); addtoseed(seed, &power, adatetime[3]); addtoseed(seed, &power, adatetime[5]); addtoseed(seed, &power, adatetime[6]); /* / */ addtoseed(seed, &power, adatetime[8]); addtoseed(seed, &power, adatetime[9]); /* / */ addtoseed(seed, &power, adatetime[11]); addtoseed(seed, &power, adatetime[12]); /* */ addtoseed(seed, &power, adatetime[14]); addtoseed(seed, &power, adatetime[15]); /* : */ addtoseed(seed, &power, adatetime[17]); addtoseed(seed, &power, adatetime[18]); } Static Void timeseed(seed) double *seed; { /* read the computer date and time. reverse the order of the digits and put a decimal point in front. this gives a fraction between zero and one that varies quite quickly, and is always unique (if the computer has sufficient accuracy). it is to be used as a seed to a random number generator. */ datetimearray adatetime; /* a date and time */ getdatetime(adatetime); /* writeln(output,'timeseed: adatetime: ',adatetime); */ makeseed(adatetime, seed); } /* timeseed */ /* p2c: delmod.p, line 1092: * Warning: Redeclaration of function orderseed [270] */ /* end module timeseed version = 'cdatemod.p 1.19 1999Dec13'; */ /* begin module orderseed */ Static Void orderseed(adatetime, seed) Char *adatetime; double *seed; { /* convert adatetime to a real number in seed, normal order */ double power = 1.0; /* a digit of the seed such as 0.01 */ *seed = 0.0; addtoseed(seed, &power, adatetime[2]); addtoseed(seed, &power, adatetime[3]); addtoseed(seed, &power, adatetime[5]); addtoseed(seed, &power, adatetime[6]); /* / */ addtoseed(seed, &power, adatetime[8]); addtoseed(seed, &power, adatetime[9]); /* / */ addtoseed(seed, &power, adatetime[11]); addtoseed(seed, &power, adatetime[12]); /* */ addtoseed(seed, &power, adatetime[14]); addtoseed(seed, &power, adatetime[15]); /* : */ addtoseed(seed, &power, adatetime[17]); addtoseed(seed, &power, adatetime[18]); } /* end module orderseed version = 1.15; (@ of timegpc.p 2000 Oct 11 */ /*[[*/ /* begin module limitdate */ Static Void limitdate(a_, b, c_, d, limitdatetime_) Char a_, b, c_, d; Char *limitdatetime_; { /* test whether the current time is before the limit. If it is later, halt the program */ datetimearray limitdatetime, adatetime; /* a date and time */ double Dday; /* the critical day */ double now; /* this very moment */ memcpy(limitdatetime, limitdatetime_, sizeof(datetimearray)); getdatetime(adatetime); orderseed(adatetime, &now); if (limitdatetime[0] != ' ' || limitdatetime[1] != ' ' || limitdatetime[2] != ' ' || limitdatetime[3] != ' ') halt(); limitdatetime[0] = a_; limitdatetime[1] = b; limitdatetime[2] = c_; limitdatetime[3] = d; orderseed(limitdatetime, &Dday); /* writeln(output,'now: ',now:20:8); writeln(output,'Dday: ',Dday:20:8); */ if (now > Dday) { /* writeln(output,'This program expired on ',limitdatetime); leave no clues */ halt(); } } /* end module limitdate version = 'cdatemod.p 1.19 1999Dec13'; */ /*]]*/ /* ************************************************************************ */ /* ************************************************************************ */ /* ************************************************************************ */ /* begin module book.basis */ /* procedures needed for book manipulations */ /* get procedures should be used for all linked lists of records */ Static Void getline(l) line **l; { /* obtain a line from the free line list or by making a new one */ if (freeline != NULL) { *l = freeline; freeline = freeline->next; } else *l = (line *)Malloc(sizeof(line)); (*l)->length = 0; (*l)->next = NULL; } Static Void getdna(l) dnastring **l; { if (freedna != NULL) { *l = freedna; freedna = freedna->next; } else *l = (dnastring *)Malloc(sizeof(dnastring)); (*l)->length = 0; (*l)->next = NULL; } /* clear procedures should be called each time the records are no longer needed failure to do this may result in a stack overflow. */ Static Void clearline(l) line **l; { /* return a line to the free line list */ line *lptr; if (*l == NULL) return; lptr = *l; *l = (*l)->next; lptr->next = freeline; freeline = lptr; } Static Void writeline(afile, l, carriagereturn) _TEXT *afile; line *l; boolean carriagereturn; { /* write a line to a file, with carriage return if carriagereturn is true. */ long index; /* index to characters in l */ long FORLIM; FORLIM = l->length; for (index = 0; index < FORLIM; index++) putc(l->letters[index], afile->f); if (carriagereturn) putc('\n', afile->f); } Static Void showfreedna() { /* show the freedna list */ long counter = 0; /* count of freedna list */ dnastring *l; /* pointer into freedna list */ l = freedna; while (l != NULL) { counter++; printf("%ld", counter); printf(", length = %d\n", l->length); /* This is illegal according to gpc because one cannot write a pointer to a text file. It can be unearthed for debugging. write(output, ', pointer id: ',l:1); */ l = l->next; } } Static Void cleardna(l) dnastring **l; { /* clear the dna strutures to the free list */ dnastring *lptr; if (*l == NULL) return; lptr = *l; *l = (*l)->next; lptr->next = freedna; freedna = lptr; } Static Void clearheader(h) header *h; { /* clear the header h (remove lines to free storage) */ clearline(&h->fulnam); while (h->note != NULL) clearline(&h->note); } Static Void clearpiece(p) piece **p; { /* clear the dna of the piece */ while ((*p)->dna != NULL) cleardna(&(*p)->dna); clearheader(&(*p)->key.hea); } Static base chartobase(ch) Char ch; { /* convert a character into a base */ base Result; switch (ch) { case 'a': Result = a; break; case 'c': Result = c; break; case 'g': Result = g; break; case 't': Result = t; break; } return Result; } Static Char basetochar(ba) base ba; { /* convert a base into a character */ Char Result; switch (ba) { case a: Result = 'a'; break; case c: Result = 'c'; break; case g: Result = 'g'; break; case t: Result = 't'; break; } return Result; } Static base complement(ba) base ba; { /* take the complement of ba */ base Result; switch (ba) { case a: Result = t; break; case c: Result = g; break; case g: Result = c; break; case t: Result = a; break; } return Result; } Static Char chomplement(b) Char b; { /* create the character complement of base b. I must be getting hungry! */ return (basetochar(complement(chartobase(b)))); } Static long pietoint(p, pie) long p; piece *pie; { /* p is a coordinate on the piece. we want to transform p into a number from 1 to n: an internal coordinate system for easy manipulation of piece coordinates */ /* Note: the dirhomologous and dircomplement are treated as plus and minus directions, which MIGHT NOT BE RIGHT! */ long i; /* an intermediate value */ piekey *WITH; WITH = &pie->key; switch (WITH->piedir) { case dirhomologous: case plus: if (p >= WITH->piebeg) i = p - WITH->piebeg + 1; else i = p - WITH->coobeg + WITH->cooend - WITH->piebeg + 2; break; case dircomplement: case minus: if (p <= WITH->piebeg) i = WITH->piebeg - p + 1; else i = WITH->cooend - p + WITH->piebeg - WITH->coobeg + 2; break; } return i; } Static long inttopie(i, pie) long i; piece *pie; { /* i is in the range 1 to some maximum. it is an internal coordinate system for the program. we want to do a coordinate transformation to obtain a value in the range of the piece called pie: i=1 corresponds to piebeg and i=its maximum corresponds to pieend */ /* Note: the dirhomologous and dircomplement are treated as plus and minus directions, which MIGHT NOT BE RIGHT! */ long p; /* an intermediate value */ piekey *WITH; WITH = &pie->key; switch (WITH->piedir) { case dirhomologous: case plus: p = WITH->piebeg + i - 1; if (p > WITH->cooend) { if (WITH->coocon == circular) p += WITH->coobeg - WITH->cooend - 1; } break; case dircomplement: case minus: p = WITH->piebeg - i + 1; if (p < WITH->coobeg) { if (WITH->coocon == circular) p += WITH->cooend - WITH->coobeg + 1; } break; } return p; } Static long piecelength(pie) piece *pie; { /* return the length of the dna in pie */ return (pietoint(pie->key.pieend, pie)); } /* end module book.basis */ /* begin module book.name */ Static Void clearname(n) name *n; { /* clear the name n */ long i; /* index to piece name */ n->length = 0; for (i = 0; i < namelength; i++) n->letters[i] = ' '; } Static Void writename(f, n) _TEXT *f; name n; { /* write the name n to file f */ long i; /* index to piece name */ for (i = 0; i < n.length; i++) putc(n.letters[i], f->f); } Static Void copyname(a_, b) name a_, *b; { /* copy name a to name b */ long i; /* index to piece name */ for (i = 0; i < a_.length; i++) b->letters[i] = a_.letters[i]; b->length = a_.length; } Static boolean equalname(a_, b) name a_, b; { /* is name a equal to name b? */ long i = 1; /* index to piece name */ boolean same = true; /* temporary variable to hold the answer */ /* what optimism!! */ if (b.length != a_.length) return false; while (same && i <= a_.length) { same = (b.letters[i-1] == a_.letters[i-1]); i++; /* p2c: delmod.p: Note: Eliminated unused assignment statement [338] */ } return same; } /* end module book.name */ /* begin module book.other */ /* other useful dna, line and name manipulating functions */ /* begin module book.name */ /* end module book.name */ Static Void emptydna(l) dnastring **l; { /* empty all of the dna in l onto the freedna list */ while (*l != NULL) cleardna(l); } Static Void emptyline(l) line **l; { /* empty all of the line in l onto the freeline list */ while (*l != NULL) clearline(l); } Static Void copyline(fromline, toline) line *fromline, **toline; { /* copy a set of lines */ line *f, *t_; /* internal pointers */ /* destroy previous to line */ emptyline(toline); if (fromline == NULL) return; getline(toline); f = fromline; t_ = *toline; while (f != NULL) { memcpy(t_->letters, f->letters, (long)linelength); t_->length = f->length; f = f->next; if (f != NULL) { getline(&t_->next); t_ = t_->next; } else t_->next = NULL; } } Static Void copydna(fromdna, todna) dnastring **fromdna, **todna; { /* copy a set of dna */ dnastring *adna, *memdna; /* destroy previous to dna */ while (*todna != NULL) cleardna(todna); adna = *fromdna; if (adna == NULL) return; getdna(&memdna); *todna = memdna; while (adna != NULL) { memcpy(memdna->part, adna->part, sizeof(seq)); memdna->length = adna->length; adna = adna->next; if (adna != NULL) { getdna(&memdna->next); memdna = memdna->next; } else memdna->next = NULL; } } Static Void copypiece(Apiece, Bpiece) piece *Apiece, **Bpiece; { /* copy the pice a to piece b */ (*Bpiece)->key.hea.keynam = Apiece->key.hea.keynam; copyline(Apiece->key.hea.fulnam, &(*Bpiece)->key.hea.fulnam); copyline(Apiece->key.hea.note, &(*Bpiece)->key.hea.note); (*Bpiece)->key.mapbeg = Apiece->key.mapbeg; (*Bpiece)->key.coocon = Apiece->key.coocon; (*Bpiece)->key.coodir = Apiece->key.coodir; (*Bpiece)->key.coobeg = Apiece->key.coobeg; (*Bpiece)->key.cooend = Apiece->key.cooend; (*Bpiece)->key.piecon = Apiece->key.piecon; (*Bpiece)->key.piedir = Apiece->key.piedir; (*Bpiece)->key.piebeg = Apiece->key.piebeg; (*Bpiece)->key.pieend = Apiece->key.pieend; copydna(&Apiece->dna, &(*Bpiece)->dna); } Static boolean between(a_, b, c_) long a_, b, c_; { /* is b between a and c? */ /* this is an inclusive between */ return (a_ <= b && b <= c_ || c_ <= b && b <= a_); } Static boolean within(pie, p) piece *pie; long p; { /* is p (external coordinates) within the piece pie? */ /* note 1: if coocon is linear then piecon must be linear. note 2: does the piece not go over the coordinate boundaries? note 3: if coocon is circular and piecon is circular, then one has the entire piece, so we can ask if p is within the coordinate system. */ boolean Result; piekey *WITH; WITH = &pie->key; switch (WITH->coocon) { case linear: /* note 1 */ Result = between(WITH->piebeg, p, WITH->pieend); break; case circular: switch (WITH->piecon) { case linear: switch (WITH->piedir) { case dirhomologous: case plus: /* handle case, may not be right */ if (WITH->pieend >= WITH->piebeg) /* note 2 */ Result = between(WITH->piebeg, p, WITH->pieend); else Result = between(WITH->piebeg, p, WITH->cooend) | between(WITH->coobeg, p, WITH->pieend); break; case dircomplement: case minus: /* handle case, may not be right */ if (WITH->pieend <= WITH->piebeg) /* note 2 */ Result = between(WITH->piebeg, p, WITH->pieend); else Result = between(WITH->piebeg, p, WITH->coobeg) | between(WITH->cooend, p, WITH->pieend); break; } break; case circular: Result = between(WITH->coobeg, p, WITH->cooend); /* note 3 */ break; } break; } return Result; } Static boolean withininternal(pie, p) piece *pie; long p; { /* Is the internal position p inside the piece pie? */ return ((p >= 1) & (p <= piecelength(pie))); } /* end module book.other */ /* ******************************************************************************** In this section are old versions of getbase. (* OLDbegin module book.getbase *) This version was from before 1999 June function getbase(position: integer; pie: pieceptr):base; (* get a base from the nth position (internal coordinates) of the piece. no protection is made against positions outside the piece *) var workdna: dnaptr; p: integer; (* the last base of the dna part *) begin workdna:=pie^.dna; p:=dnamax; while position>p do begin p:=p+dnamax; workdna:=workdna^.next end; getbase:=workdna^.part[position-(p-dnamax)] end; (* OLDend module book.getbase *) (* ANOTHER OLD begin module book.getbase *) This version was until march 22, when the lister program showed a bomb for grabbing a circle in libdef.test: title "version = 1.08 of libdef.inst 1999 June 11 Testing Delila"; organism E.xamples; chromosome E.xamples; piece CIRCULAR; name "get all;"; get all piece; function getbase(position: integer; pie: pieceptr):base; (* get a base from the position (internal coordinates) of the piece. Protection is made against positions outside the piece. *) var workdna: dnaptr; (* pointer to the dna part of pie *) p: integer; (* current count of bases into the workdna *) spot: integer; (* the last base of the dna part *) begin (* writeln(output,'NEW getbase: position=',position:1,'^^^^^^^^^^^^^^^^^^^^'); *) if position < 0 then begin writeln(output,'error in getbase: request position (= ', position:1, ') before end of piece'); halt end; workdna:=pie^.dna; p:=workdna^.length; while position > p do begin (* writeln(output,' workdna^.length=',workdna^.length:1); *) workdna := workdna^.next; p := p + workdna^.length; end; (* writeln(output,'p=',p:1); *) if workdna = nil then begin writeln(output,'error in getbase: request off end of piece'); halt end else begin spot := workdna^.length - (p-position); (* writeln(output,'spot=',spot:1); showdnasegment(output,workdna, spot); *) if (spot <= 0) then begin writeln(output,'error in getbase, spot (= ',spot:1, ') must be positive'); halt end; if (spot > workdna^.length) then begin writeln(output,'error in getbase, spot (=',spot:1, ') must be less than length (=',workdna^.length:1,')'); halt end; (* writeln(output,'base = ', workdna^.part[spot]); *) getbase:=workdna^.part[spot] end end; (* ANOTHER OLD end module book.getbase *) ******************************************************************************** */ /* begin module book.getbase */ Static base getbase(position, pie) long position; piece *pie; { /* Get a base from the position (internal coordinates) of the piece. Protection is made against positions outside the piece. In the case of circles it would be convenient to wrap around when requests are off the end. So the routine will do a modular wrap for positions outside the range 1 to the length. This is a new feature as of 2000 March 22. */ dnastring *workdna; /* pointer to the dna part of pie */ long p; /* current count of bases into the workdna */ long spot; /* the last base of the dna part */ long thelength; /* the length of the piece */ /* writeln(output,'NEW getbase: position=',position:1,'^^^^^^^^^^^^^^^^^^^^'); */ /* handle cases of position out of range by circular wrapping */ thelength = piecelength(pie); while (position < 1) position += thelength; while (position > thelength) position -= thelength; workdna = pie->dna; p = workdna->length; while (position > p) { /* writeln(output,' workdna^.length=',workdna^.length:1); */ workdna = workdna->next; if (workdna == NULL) { printf("error in function getbase!\n"); halt(); } p += workdna->length; } /* writeln(output,'p=',p:1); */ if (true) { spot = workdna->length - p + position; /* writeln(output,'spot=',spot:1); showdnasegment(output,workdna, spot); */ if (spot <= 0) { printf("error in getbase, spot (= %ld) must be positive\n", spot); halt(); } if (spot > workdna->length) { printf("error in getbase, spot (=%ld) must be less than length (=%d)\n", spot, workdna->length); halt(); } /* writeln(output,'base = ', workdna^.part[spot]); */ return ((base)P_getbits_UB(workdna->part, spot - 1, 1, 3)); } printf("error in getbase: request off end of piece\n"); halt(); } /* end module book.getbase */ /* begin module fixpiececoordinate */ Static Void fixpiececoordinate(pie, excess, coordinateside) piece **pie; long excess; direction coordinateside; { /* Fix the piece coordinates for insertions or deletions. Coordinateside is the end of the coordinate system that gets changed */ piekey *WITH; /* writeln(output,'fixpiececoordinate: excess = ',excess:1); */ WITH = &(*pie)->key; switch (coordinateside) { case minus: switch (WITH->piedir) { case minus: /* piedir minus coordinateside minus */ WITH->pieend -= excess; WITH->coobeg -= excess; break; case plus: /* piedir plus coordinateside minus */ WITH->piebeg -= excess; WITH->coobeg -= excess; break; } break; case plus: switch (WITH->piedir) { case minus: /* piedir minus coordinateside plus */ WITH->piebeg += excess; WITH->cooend += excess; break; case plus: /* piedir plus coordinateside plus */ WITH->pieend += excess; WITH->cooend += excess; break; } break; } } /* end module fixpiececoordinate */ /* begin module book.putbase */ Static Void putbase(b, position, pie, coordinateside) base b; long position; piece **pie; direction coordinateside; { /* put a base b into the nth position (internal coordinates) of the piece. Protection is made against positions outside the piece. NEW: * If the base is before coordinate 1, the program halts. * If the base is after the end of the sequence, extra space is made, and the coordinate system is changed on the coordinate side given. */ long excess; /* the implied insertion size */ dnastring *workdna; /* working dna segment */ long p; /* the last base of the dna part or current length */ long pielength; /* current length of the piece */ long TEMP; /* z: integer; (* index to the piece for debuging stuff *) */ pielength = piecelength(*pie); /* writeln(output,'putbase =================================='); write (output,'putbase: b = ',basetochar(b),', pielength=',pielength:1); writeln(output,', position=',position:1); */ if (position < 1) { printf( "putbase: can not put bases before the start of the piece (position < 1)\n"); printf("Program error! Please report it to toms@ncifcrf.gov.\n"); halt(); } workdna = (*pie)->dna; if (position > pielength) { /* add to end of piece */ /* writeln(output,'putbase: INCREMENT WORKDNA'); */ /* since position > pielength, excess is always positive */ excess = position - pielength; fixpiececoordinate(pie, excess, coordinateside); /* writeln(output,'putbase: excess=',excess:1); */ /* find the last segment */ p = workdna->length; while (workdna->next != NULL) { /* writeln(output,'looping'); */ workdna = workdna->next; p += workdna->length; } /* writeln(output,'USED SPACE is p=',p:1); */ if (workdna->length + excess <= dnamax) { /* fill into the available segment */ /* writeln(output,'NO NEW SEGMENTS NEEDED'); */ workdna->length += excess; /* insert into the current piece */ /* showsegments(output,pie^.dna); ;writeln(output,'putbase: p=',p:1); ;writeln(output,'putbase: dnamax=',dnamax:1); ;writeln(output,'putbase: position=',position:1); ;writeln(output,'=========================================='); */ TEMP = workdna->length - 1; P_clrbits_B(workdna->part, TEMP, 1, 3); P_putbits_UB(workdna->part, TEMP, (int)b, 1, 3); return; } /* make the rest of the last segment useable by increasing its length up to dnamax, first increment p: */ p += dnamax - workdna->length; workdna->length = dnamax; /* build enough segments to accommodate the new sequence */ while (p < position) { /* writeln(output,' start adding segment, p = ',p:1,'--------------++++++++++'); */ /* now make a new segment: */ p += dnamax; getdna(&workdna->next); workdna = workdna->next; workdna->length = dnamax; /* make it all available to fill */ /* for z := 1 to dnamax do workdna^.part[z] := x; writeln(output,'----------add segment, p = ',p:1); */ } /* put the base in at the end */ workdna->length = dnamax - p + position; /* ;writeln(output,'placement, workdna^.length = ',workdna^.length:1); showsegments(output,pie^.dna); */ TEMP = workdna->length - 1; P_clrbits_B(workdna->part, TEMP, 1, 3); P_putbits_UB(workdna->part, TEMP, (int)b, 1, 3); return; } /* ;writeln(output,'putbase: final workdna^.length=',workdna^.length:1); */ /* add new segments */ /* write(output,'NEW SEGMENTS NEEDED:'); write(output,' p =',p:1); write(output,' excess =',excess:1); writeln(output); */ /* writeln(output,'putbase: NO EXCESS'); */ /* locate segment in which to put the base */ p = workdna->length; while (position > p) { /* writeln(output,'THE PLACE =============!! p = ',p:1); */ if (workdna->next != NULL) workdna = workdna->next; p += workdna->length; /* only count the filled part */ /* writeln(output,'FINAL =============== p = ',p:1); writeln(output,'FINAL =============== position=',position:1); writeln(output,'FINAL =============== (position > p)=', (position > p)); writeln(output,'FINAL =============== (workdna^.next <> nil)=', (workdna^.next <> nil)); ;writeln(output,'putbase: about to smash: workdna^.length=',workdna^.length:1); */ /* ;writeln(output,'putbase: after smash: workdna^.length=',workdna^.length:1); */ /* writeln(output,'base ',b,' placed into ', workdna^.length - (p-position):1); showdnasegment(output,workdna, workdna^.length); writeln(output); */ } TEMP = workdna->length - p + position - 1; P_clrbits_B(workdna->part, TEMP, 1, 3); P_putbits_UB(workdna->part, TEMP, (int)b, 1, 3); } /* end module book.putbase */ /* begin module book.stepbase */ Static base stepbase(startdna, dna, d) dnastring *startdna, **dna; dnarange *d; { /* advance d by one base in dna and then return the base at the new d. (this means that one should initialize d to zero) if we go past the last base, we restart at startdna. note: d is not the number of the base... it is used as a record for stepbase. do not mess with it, and do not use it to find out what base you are on. use a separate counter. */ long TEMP; if (*d != dnamax && *d != (*dna)->length) { (*d)++; TEMP = *d - 1; return ((base)P_getbits_UB((*dna)->part, TEMP, 1, 3)); } *d = 1; *dna = (*dna)->next; if (*dna == NULL) *dna = startdna; TEMP = *d - 1; return ((base)P_getbits_UB((*dna)->part, TEMP, 1, 3)); } /* end module book.stepbase */ /* procedures needed to read books *******************************************/ /* begin module book.getto */ Static Char getto(thefile, theline, ch) _TEXT *thefile; long *theline; long *ch; { /* search the file for a character in the first line which is a member of the set ch. Note: on 1999 March 10 the definition of this function was cleaned up. Instead of putting thefile on the line AFTER the charcter ch has been found, it puts thefile ON the line. Other routines like brdna and brpiece have to move to the next line themselves. This makes getto give the OBJECT. */ Char achar = ' '; /* a character in thefile */ boolean done = false; /* done finding achar */ while (!done) { if (BUFEOF(thefile->f)) { done = true; break; } achar = P_peek(thefile->f); if (P_inset(achar, ch)) { done = true; break; } fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; } if (P_inset(achar, ch)) return achar; else { return ' '; /* The old method - while (not(achar in ch)) and (not eof(thefile)) do begin readln(thefile,achar); theline := succ(theline) end; if (achar in ch) then getto:=achar else getto:=' ' */ } } /* end module book.getto */ /* begin module book.skipstar */ Static Void skipstar(thefile) _TEXT *thefile; { /* skip start of line (or star = '*'). */ if (BUFEOF(thefile->f)) { printf(" procedure skipstar: end of book found\n"); halt(); return; } if (P_peek(thefile->f) != '*') { printf(" procedure skipstar: bad book\n"); printf(" \"*\" expected as first character on the line, but \"%c\" was found\n", P_peek(thefile->f)); halt(); } getc(thefile->f); /* skip the star */ if (P_peek(thefile->f) != ' ') { /* skip the blank */ printf(" procedure skipstar: bad book\n"); printf(" \"* \" expected on a line but \"*%c\" was found\n", P_peek(thefile->f)); halt(); } getc(thefile->f); } /* skipstar */ /* end module book.skipstar */ /* read book variables ****************************************************/ /* these procedure read attributes from the book. they are all prefixed by b to indicate this. */ /* begin module book.brreanum */ Static Void brreanum(thefile, theline, reanum) _TEXT *thefile; long *theline; double *reanum; { /* read a real number from the file */ skipstar(thefile); fscanf(thefile->f, "%lg%*[^\n]", reanum); getc(thefile->f); (*theline)++; } /* end module book.brreanum */ /* begin module book.brnumber */ Static Void brnumber(thefile, theline, num) _TEXT *thefile; long *theline, *num; { /* read a number from the file */ skipstar(thefile); fscanf(thefile->f, "%ld%*[^\n]", num); getc(thefile->f); (*theline)++; } /* end module book.brnumber */ /* begin module book.brname */ Static Void brname(thefile, theline, nam) _TEXT *thefile; long *theline; name *nam; { /* read a name from the file */ long i; /* an index to the name */ Char c_; /* a character read */ skipstar(thefile); nam->length = 0; do { nam->length++; c_ = getc(thefile->f); if (c_ == '\n') c_ = ' '; nam->letters[nam->length - 1] = c_; } while (!(P_eoln(thefile->f) || nam->length >= namelength || nam->letters[nam->length - 1] == ' ')); if (nam->letters[nam->length - 1] == ' ') nam->length--; if (nam->length < namelength) { for (i = nam->length; i < namelength; i++) nam->letters[i] = ' '; } fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; } /* brname */ /* end module book.brname */ /* begin module book.brline */ Static Void brline(thefile, theline, l) _TEXT *thefile; long *theline; line **l; { /* read a line from the file */ long i = 0; Char acharacter; skipstar(thefile); /* protection added 2005 Sep 15 */ while (!P_eoln(thefile->f) && i < linelength) { i++; acharacter = getc(thefile->f); if (acharacter == '\n') acharacter = ' '; (*l)->letters[i-1] = acharacter; } /* protection added 2005 Sep 15 */ if (!P_eoln(thefile->f)) { printf("***********************************************\n"); printf("* WARNING: brline: book line length exceeded\n"); printf("* linelength > %ld characters\n", (long)linelength); printf("* Only %ld characters read from book\n", (long)linelength); printf("***********************************************\n"); } (*l)->length = i; (*l)->next = NULL; fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; } /* end module book.brline */ /* begin module book.brdirect */ Static Void brdirect(thefile, theline, direct) _TEXT *thefile; long *theline; direction *direct; { /* read a direction */ Char ch; skipstar(thefile); fscanf(thefile->f, "%c%*[^\n]", &ch); getc(thefile->f); if (ch == '\n') ch = ' '; (*theline)++; if (ch == '+') *direct = plus; else *direct = minus; } /* end module book.brdirect */ /* begin module book.brconfig */ Static Void brconfig(thefile, theline, config) _TEXT *thefile; long *theline; configuration *config; { /* read a configuration */ Char ch; skipstar(thefile); fscanf(thefile->f, "%c%*[^\n]", &ch); getc(thefile->f); if (ch == '\n') ch = ' '; (*theline)++; if (ch == 'l') *config = linear; else *config = circular; } /* end module book.brconfig */ /* begin module book.brstate */ Static Void brstate(thefile, theline, sta) _TEXT *thefile; long *theline; state *sta; { /* read a state */ Char ch; skipstar(thefile); ch = getc(thefile->f); if (ch == '\n') ch = ' '; fscanf(thefile->f, "%c%*[^\n]", &ch); getc(thefile->f); if (ch == '\n') ch = ' '; (*theline)++; if (ch == 'n') *sta = on; else *sta = off; } /* end module book.brstate */ /* begin module book.brnotenumber */ Static Void brnotenumber(thefile, theline, note) _TEXT *thefile; long *theline; line **note; { /* book note reading to obtain the number of the object. the procedure returns the value of the number as a global. (this is not such a good practice, but we are stuck with it for now.) */ *note = NULL; numbered = false; number = 0; /* force number to zero if there is no number at all */ /* the next character is n or * depending on whether there are notes */ if (P_peek(thefile->f) != 'n') return; fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; if (P_peek(thefile->f) != 'n') { skipstar(thefile); if (!P_eoln(thefile->f)) { if (P_peek(thefile->f) == '#') { numbered = true; getc(thefile->f); /* move past the number symbol */ fscanf(thefile->f, "%ld", &number); } } do { fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; } while (P_peek(thefile->f) != 'n'); fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; return; } fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; } /* brnotenumber */ /* end module book.brnotenumber */ /* begin module book.brnote */ Static Void brnote(thefile, theline, note) _TEXT *thefile; long *theline; line **note; { /* read note key */ line *newnote; /* the new note */ line *previousnote; /* the last line of the notes */ *note = NULL; if (P_peek(thefile->f) != 'n') /* enter note */ return; fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; if (P_peek(thefile->f) != 'n') { /* abort null note (n/n) */ getline(note); newnote = *note; while (P_peek(thefile->f) != 'n') { /* wait until end of note */ brline(thefile, theline, &newnote); previousnote = newnote; /* get next note */ getline(&newnote->next); newnote = newnote->next; } /* last note was not used, so: */ clearline(&newnote); previousnote->next = NULL; fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; return; } fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; } /* brnote */ /* end module book.brnote */ /* begin module book.brheader */ Static Void brheader(thefile, theline, hea) _TEXT *thefile; long *theline; header *hea; { /* read the header of a key. */ fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); /* move past the object name - new definition 1999 Mar 13 */ (*theline)++; /*bbb*/ /* read key name */ brname(thefile, theline, &hea->keynam); /* read full name */ getline(&hea->fulnam); brline(thefile, theline, &hea->fulnam); /* read note key */ if (readnumber) brnotenumber(thefile, theline, &hea->note); else brnote(thefile, theline, &hea->note); } /* end module book.brheader */ /* begin module book.copyheader */ Static Void copyheader(fromhea, tohea) header fromhea, *tohea; { /* copy the header fromhea into tohea. Note that the linked objects are NOT copied, but merely pointed to. */ memcpy(tohea->keynam.letters, fromhea.keynam.letters, sizeof(alpha)); tohea->keynam.length = fromhea.keynam.length; tohea->note = fromhea.note; tohea->fulnam = fromhea.fulnam; } /* end module book.copyheader version = 5.62; (@ of search.p 1993 January 9 */ /* begin module book.brorgkey */ Static Void brorgkey(thefile, theline, org) _TEXT *thefile; long *theline; orgkey *org; { /* read organism key */ /*bbb*/ brheader(thefile, theline, &org->hea); getline(&org->mapunit); brline(thefile, theline, &org->mapunit); } /* end module book.brorgkey */ /* begin module book.brchrkey */ Static Void brchrkey(thefile, theline, chr) _TEXT *thefile; long *theline; chrkey *chr; { /* read chromosome key */ /*bbb*/ brheader(thefile, theline, &chr->hea); brreanum(thefile, theline, &chr->mapbeg); brreanum(thefile, theline, &chr->mapend); } /* end module book.brchrkey */ /* begin module book.brpiekey */ Static Void brpiekey(thefile, theline, pie) _TEXT *thefile; long *theline; piekey *pie; { /* read piece key, track the line number */ brheader(thefile, theline, &pie->hea); brreanum(thefile, theline, &pie->mapbeg); brconfig(thefile, theline, &pie->coocon); brdirect(thefile, theline, &pie->coodir); brnumber(thefile, theline, &pie->coobeg); brnumber(thefile, theline, &pie->cooend); brconfig(thefile, theline, &pie->piecon); brdirect(thefile, theline, &pie->piedir); brnumber(thefile, theline, &pie->piebeg); brnumber(thefile, theline, &pie->pieend); } /* end module book.brpiekey */ /* begin module book.brdna */ Static Void brdna(thefile, theline, dna) _TEXT *thefile; long *theline; dnastring **dna; { /* read in dna from thefile, track the line */ /* note: if the dna were circularized, by linking the last dnastring to the first, then the cleardna routine could not clear properly, and would loop forever... there is no reason to do that, since a simple mod function will allow one to access the circle. */ Char ch; dnastring *workdna; long SET[5]; long TEMP; getdna(dna); workdna = *dna; ch = getto(thefile, theline, P_addset(P_expset(SET, 0L), 'd')); fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); (*theline)++; ch = getc(thefile->f); /* skipstar */ if (ch == '\n') ch = ' '; while (ch == '*') { ch = getc(thefile->f); /* skip blank */ if (ch == '\n') ch = ' '; do { ch = getc(thefile->f); if (ch == '\n') ch = ' '; if (ch == 't' || ch == 'g' || ch == 'c' || ch == 'a') { if (workdna->length == dnamax) { getdna(&workdna->next); workdna = workdna->next; } workdna->length++; TEMP = workdna->length - 1; P_clrbits_B(workdna->part, TEMP, 1, 3); P_putbits_UB(workdna->part, TEMP, (int)chartobase(ch), 1, 3); } } while (!P_eoln(thefile->f)); fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); /* go to next line */ (*theline)++; ch = getc(thefile->f); /* ch is either '*' or 'd' */ if (ch == '\n') ch = ' '; } fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); /* read past the d */ (*theline)++; } /* end module book.brdna */ /* begin module book.brpiece */ Static Void brpiece(thefile, theline, pie) _TEXT *thefile; long *theline; piece **pie; { /* read in a piece, change theline to reflect the lines traversed */ /* readln(thefile); (* move past the word 'piece' - new definition 1999 Mar 13 *) theline := succ(theline); (* BUG: was below! *) bbb*/ brpiekey(thefile, theline, &(*pie)->key); if (numbered || !skipunnum) brdna(thefile, theline, &(*pie)->dna); fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); /* move past the word 'piece' - new definition 1999 Mar 13 */ (*theline)++; } /* end module book.brpiece */ /* begin module book.getpiece */ Static Void getpiece(thefile, theline, pie) _TEXT *thefile; long *theline; piece **pie; { /* move to and read in the next piece in the book */ Char ch; long SET[5]; ch = getto(thefile, theline, P_addset(P_expset(SET, 0L), 'p')); /* get to the next p(iece) in the book */ if (ch != ' ') { brpiece(thefile, theline, pie); /* 1999 june 2: removed this: ch:=getto(thefile,theline,['p']); (* read to end of p *) */ /* bbb - now done in brpiece readln(thefile); (* read past piece *) theline := succ(theline); */ } else clearpiece(pie); } /* end module book.getpiece */ /* begin module book.getocp */ Static Void getocp(thefile, theline, org, orgchange, orgopen, chr, chrchange, chropen, pie, piechange, pieopen) _TEXT *thefile; long *theline; orgkey *org; boolean *orgchange, *orgopen; chrkey *chr; boolean *chrchange, *chropen; piece **pie; boolean *piechange, *pieopen; { /* Get the next piece and its organism and chromosome keys. The three change variables indicate whether or not a new organism, chromosome or piece name was found. If a piece is not found, then pieopen will be false. orgopen, chropen and pieopen are used by getocp to tell when it has entered an organism, chromosome or piece. All booleans should be set to false initially. There should be one triplet for each book read. It is important to initialize ALL variables, including pie: orgchange := false; orgopen := false; chrchange := false; chropen := false; piechange := false; pieopen := false; pie := nil; theline := 0; 1999 June 2 The book reading routines now treat data objects more precisely. Rather than test for eof, the endo of book occurs when pieopen is returned as false. A book reading loop now looks like this: repeat getocp(book, theline, org, orgchange, orgopen, chr, chrchange, chropen, pie, piechange, pieopen); writeln(output,'pieopen: ',pieopen); if pieopen then begin writeln(output,'piece at line: ',theline:1); end; until not pieopen; */ Char ch = 'a'; chrkey newchr; orgkey neworg; piece *newpie; long SET[5]; while (ch != 'p' && ch != ' ') { P_addset(P_expset(SET, 0L), 'o'); P_addset(SET, 'c'); ch = getto(thefile, theline, P_addset(SET, 'p')); if (ch == ' ') { *pieopen = false; break; } switch (ch) { case 'o': if (*orgopen) { fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); /* move past the word 'organism' - new definition 1999 Mar 13 */ *orgopen = false; /* close organism */ } else { brorgkey(thefile, theline, &neworg); if (strncmp(neworg.hea.keynam.letters, org->hea.keynam.letters, sizeof(alpha)) && neworg.hea.keynam.length != org->hea.keynam.length) { /* writeln(output,'--------orgchanged!'); write (output,'--------old org:"', org.hea.keynam.letters); writeln(output, '" ', org.hea.keynam.length:1); write (output,'--------new org:"',neworg.hea.keynam.letters); writeln(output, '" ',neworg.hea.keynam.length:1); */ /*ccc*/ *orgchange = true; copyheader(neworg.hea, &org->hea); /* move the mapunit over to the org! */ org->mapunit = neworg.mapunit; clearline(&neworg.mapunit); } else *orgchange = false; *orgopen = true; } break; case 'c': if (*chropen) { fscanf(thefile->f, "%*[^\n]"); getc(thefile->f); /* move past the word 'chromosome' - new definition 1999 Mar 13 */ *chropen = false; /* close chromosome */ } else { brchrkey(thefile, theline, &newchr); if (strncmp(newchr.hea.keynam.letters, chr->hea.keynam.letters, sizeof(alpha)) && newchr.hea.keynam.length != chr->hea.keynam.length) { /* writeln(output,'--------chrchanged!'); write (output,'--------old chr:"', chr.hea.keynam.letters); writeln(output, '" ', chr.hea.keynam.length:1); write (output,'--------new chr:"',newchr.hea.keynam.letters); writeln(output, '" ',newchr.hea.keynam.length:1); */ *chrchange = true; copyheader(newchr.hea, &chr->hea); /* move the map range over to the chr! */ chr->mapbeg = newchr.mapbeg; chr->mapend = newchr.mapend; } else *chrchange = false; *chropen = true; } break; case 'p': if (*pieopen) { *pieopen = false; /* close last piece */ ch = 'a'; /* prevent falling out of the loop */ } else { newpie = (piece *)Malloc(sizeof(piece)); brpiece(thefile, theline, &newpie); if (*pie == NULL) *piechange = true; else { if (strncmp(newpie->key.hea.keynam.letters, (*pie)->key.hea.keynam.letters, sizeof(alpha)) && newpie->key.hea.keynam.length != (*pie)->key.hea.keynam.length) *piechange = true; else *piechange = false; } *pieopen = true; /* we always have to switch over to the new piece, because although the name may be the same, the DNA sequence could be different. That is, the book may contain two pieces with the same name, and we want to be sure to search the new one, not the old one. */ if (*pie != NULL) { clearpiece(pie); /* save the links */ Free(*pie); /* close up shop */ } *pie = newpie; } break; } } } /* origin: search version = 6.39 */ /* end module book.getocp */ /* begin module book.brinit */ Static Void brinit(book, theline) _TEXT *book; long *theline; { /* check that the book is ok to read, and set up the global variables for br routines */ /* halt if the book is bad (first word is 'halt') or the first character is not * */ if (*book->name != '\0') { if (book->f != NULL) book->f = freopen(book->name, "r", book->f); else book->f = fopen(book->name, "r"); } else rewind(book->f); if (book->f == NULL) _EscIO2(FileNotFound, book->name); RESETBUF(book->f, Char); if (!BUFEOF(book->f)) { /* check for the date line */ if (P_peek(book->f) != '*') { if (P_peek(book->f) != 'h') printf(" this is not the first line of a book:\n"); else printf(" bad book:\n"); putchar(' '); while (!(P_eoln(book->f) | BUFEOF(book->f))) { putchar(P_peek(book->f)); getc(book->f); } putchar('\n'); halt(); } } else { printf(" book is empty\n"); halt(); } /* initialize free storage */ freeline = NULL; freedna = NULL; readnumber = true; /* usually we read in numbers for items */ number = 0; /* arbitrary value */ numbered = false; /* the piece has no number (none yet read in) */ skipunnum = false; *theline = 1; } /* brinit */ /* end module book.brinit */ /* the procedures needed to do book writing *********************************/ /* original version 81/11/17 by gary stormo */ /* begin module book.bwbasics */ Static Void bwstartline(book) _TEXT *book; { /* start a line of output to the book */ fprintf(book->f, "* "); } Static Void bwline(book, l) _TEXT *book; line *l; { /* write a line to the book */ long i, FORLIM; if (l == NULL) return; bwstartline(book); if (l->length != 0) { FORLIM = l->length; for (i = 0; i < FORLIM; i++) putc(l->letters[i], book->f); } putc('\n', book->f); } Static Void bwtext(book, lines) _TEXT *book; line *lines; { /* write a set of lines to the book */ line *l = lines; while (l != NULL) { bwline(book, l); l = l->next; } } Static Void bwnote(book, note) _TEXT *book; line *note; { /* writes the notes pointed to by 'note' to 'book' */ if (note == NULL) return; fprintf(book->f, "note\n"); bwtext(book, note); fprintf(book->f, "note\n"); } Static Void bwnumber(book, num) _TEXT *book; long num; { /* write a number to the book */ bwstartline(book); fprintf(book->f, "%ld\n", num); /* pascal will expand the field as far as needed */ } Static Void bwreanum(book, reanum) _TEXT *book; double reanum; { /* write a real number to the book */ bwstartline(book); fprintf(book->f, "%1.2f\n", reanum); /* pascal will expand the field */ } Static Void bwstate(book, sta) _TEXT *book; state sta; { /* write a state to the book */ bwstartline(book); switch (sta) { case on: fprintf(book->f, "on\n"); break; case off: fprintf(book->f, "off\n"); break; } } Static Void bwname(book, nam) _TEXT *book; name nam; { /* write a name to the book */ long i; bwstartline(book); for (i = 0; i < nam.length; i++) putc(nam.letters[i], book->f); putc('\n', book->f); } Static Void bwdirect(book, direct) _TEXT *book; direction direct; { /* write a direction to the book */ bwstartline(book); switch (direct) { case dirhomologous: case plus: /* handle case, may not be right */ fprintf(book->f, "+\n"); break; case dircomplement: case minus: /* handle case, may not be right */ fprintf(book->f, "-\n"); break; } } Static Void bwconfig(book, config) _TEXT *book; configuration config; { /* write a configuration to the book */ bwstartline(book); switch (config) { case linear: fprintf(book->f, "linear\n"); break; case circular: fprintf(book->f, "circular\n"); break; } } Static Void bwheader(book, hea) _TEXT *book; header hea; { /* write a key header to the book */ bwname(book, hea.keynam); bwline(book, hea.fulnam); bwnote(book, hea.note); } Static Void bworgkey(book, org) _TEXT *book; orgkey org; { /* write the organism key */ bwheader(book, org.hea); bwline(book, org.mapunit); } Static Void bwchrkey(book, chr) _TEXT *book; chrkey chr; { /* write the chromosome key */ bwheader(book, chr.hea); bwreanum(book, chr.mapbeg); bwreanum(book, chr.mapend); } /* end module book.bwbasics */ /* begin module book.bworg */ Static Void bworg(thefile, org, chropen, orgopen) _TEXT *thefile; orgkey org; boolean *chropen, *orgopen; { /* this writes the organism key 'org' to 'thefile', and returns 'orgopen' as true. if there is already a chromosome or organism open they are closed. */ if (*chropen) { fprintf(thefile->f, "chromosome\n"); *chropen = false; } if (*orgopen) fprintf(thefile->f, "organism\n"); fprintf(thefile->f, "organism\n"); bworgkey(thefile, org); *orgopen = true; } /* end module book.bworg */ /* begin module book.bwchr */ Static Void bwchr(thefile, chr, chropen) _TEXT *thefile; chrkey chr; boolean *chropen; { /* write the chromosome key 'chr' to 'thefile' and return chropen as true. if a chromosome is already open it is closed. */ if (*chropen) fprintf(thefile->f, "chromosome\n"); fprintf(thefile->f, "chromosome\n"); bwchrkey(thefile, chr); *chropen = true; } /* end module book.bwchr */ /* begin module book.bwdna */ Static Void bwdna(thefile, d) _TEXT *thefile; dnastring *d; { /* write the dna pointed to by 'd' to 'thefile' */ long i; /* index to the sequence */ long l; /* index to the number of bases on the line */ boolean newline = true; /* true when a new line should be started */ long FORLIM; fprintf(thefile->f, "dna\n"); while (d != NULL) { FORLIM = d->length; for (i = 1; i <= FORLIM; i++) { if (newline) { bwstartline(thefile); l = 0; newline = false; } fputc(basetochar((base)P_getbits_UB(d->part, i - 1, 1, 3)), thefile->f); l++; if (l % 60 == 0 || i == d->length && d->next == NULL) { /* end of line */ putc('\n', thefile->f); newline = true; } /* p2c: delmod.p, line 2725: * Note: Using % for possibly-negative arguments [317] */ /* last base */ } d = d->next; } if (!newline) /* last base */ putc('\n', thefile->f); fprintf(thefile->f, "dna\n"); } /* end module book.bwdna */ /* begin module book.bwpie */ Static Void bwpie(thefile, pie) _TEXT *thefile; piece *pie; { /* writes the information pointed to by 'pie' to 'thefile' */ fprintf(thefile->f, "piece\n"); bwheader(thefile, pie->key.hea); bwstartline(thefile); fprintf(thefile->f, "%1.2f\n", pie->key.mapbeg); bwstartline(thefile); if (pie->key.coocon == circular) fprintf(thefile->f, "circular\n"); else fprintf(thefile->f, "linear\n"); bwstartline(thefile); if (pie->key.coodir == plus) fprintf(thefile->f, "+\n"); else fprintf(thefile->f, "-\n"); bwstartline(thefile); fprintf(thefile->f, "%ld\n", pie->key.coobeg); bwstartline(thefile); fprintf(thefile->f, "%ld\n", pie->key.cooend); bwstartline(thefile); if (pie->key.piecon == circular) fprintf(thefile->f, "circular\n"); else fprintf(thefile->f, "linear\n"); bwstartline(thefile); if (pie->key.piedir == plus) fprintf(thefile->f, "+\n"); else fprintf(thefile->f, "-\n"); bwstartline(thefile); fprintf(thefile->f, "%ld\n", pie->key.piebeg); bwstartline(thefile); fprintf(thefile->f, "%ld\n", pie->key.pieend); bwdna(thefile, pie->dna); fprintf(thefile->f, "piece\n"); } /* end module book.bwpie */ /* begin module book.bwref */ Static Void bwref(book, ref) _TEXT *book; reference ref; { /* write a key reference to the book */ bwname(book, ref.pienam); bwreanum(book, ref.mapbeg); bwdirect(book, ref.refdir); bwnumber(book, ref.refbeg); bwnumber(book, ref.refend); } /* end module book.bwref */ /* begin module book.bwgen */ Static Void bwgen(thefile, gene) _TEXT *thefile; genkey gene; { /* this proecdure writes to 'thefile' the information in 'gene', properly formatted; */ fprintf(thefile->f, "gene\n"); bwheader(thefile, gene.hea); bwref(thefile, gene.ref); fprintf(thefile->f, "gene\n"); } /* end module book.bwgen */ /* begin module book.bwtra */ Static Void bwtra(thefile, trans) _TEXT *thefile; trakey trans; { /* this proecdure writes to 'thefile' the information in 'trans', properly formatted; */ fprintf(thefile->f, "transcript\n"); bwheader(thefile, trans.hea); bwref(thefile, trans.ref); fprintf(thefile->f, "transcript\n"); } /* end module book.bwtra */ /* begin module book.bwmar */ Static Void bwmar(thefile, mark) _TEXT *thefile; marker mark; { /* this proecdure writes to 'thefile' the information in 'mark', properly formatted; */ long i, FORLIM; fprintf(thefile->f, "marker\n"); bwheader(thefile, mark.key.hea); bwref(thefile, mark.key.ref); bwstate(thefile, mark.key.sta); bwstartline(thefile); FORLIM = mark.key.phenotype->length; for (i = 0; i < FORLIM; i++) putc(mark.key.phenotype->letters[i], thefile->f); putc('\n', thefile->f); bwdna(thefile, mark.dna); fprintf(thefile->f, "marker\n"); } /* end module book.bwmar */ /* delila instruction writing routines ***************************************/ /* this set of routines allows one to write delila instructions. the types are found in book.type */ /* begin module book.iwcombk */ Static Void iwcombk(book, afile) _TEXT *book, *afile; { /* make a comment in the file that says the name of the book */ fprintf(afile->f, "(* "); if (*book->name != '\0') { if (book->f != NULL) book->f = freopen(book->name, "r", book->f); else book->f = fopen(book->name, "r"); } else rewind(book->f); if (book->f == NULL) _EscIO2(FileNotFound, book->name); RESETBUF(book->f, Char); if (copylines(book, afile, 1L) == 0) { printf(" book is empty, can not write comment for instructions\n"); halt(); } fprintf(afile->f, "*)\n"); } /* end module book.iwcombk */ /* begin module book.iwname */ Static Void iwname(thefile, thename) _TEXT *thefile; name thename; { /* write the name to the file */ long c_; for (c_ = 0; c_ < thename.length; c_++) putc(thename.letters[c_], thefile->f); } /* end module book.iwname */ /* begin module book.iworg */ Static Void iworg(afile, org) _TEXT *afile; orgkey org; { /* write an organism specification. no writeln is done to allow write orgchr to do this. */ fprintf(afile->f, "organism "); iwname(afile, org.hea.keynam); putc(';', afile->f); } /* end module book.iworg */ /* begin module book.iwchr */ Static Void iwchr(afile, chr) _TEXT *afile; chrkey chr; { /* write an chromosome specification. no writeln is done to allow write orgchr to do this. */ fprintf(afile->f, "chromosome "); iwname(afile, chr.hea.keynam); putc(';', afile->f); } /* end module book.iwchr */ /* begin module book.iwpie */ Static Void iwpie(afile, pie) _TEXT *afile; piekey pie; { /* write a piece specification */ fprintf(afile->f, "piece "); iwname(afile, pie.hea.keynam); fprintf(afile->f, ";\n"); } /* end module book.iwpie */ /* begin module book.iworgchr */ Static Void iworgchr(afile, org, orgchange, orgopen, chr, chrchange, chropen) _TEXT *afile; orgkey org; boolean orgchange, orgopen; chrkey chr; boolean chrchange, chropen; { /* write both organism and chromosome specifications, based on whether the organism or chromosome changed (orgchange and chrchange) and whether they are currently open (orgopen, chropen). See getocp in the br routines. */ if (orgchange && orgopen) iworg(afile, org); if (orgchange && chrchange && orgopen && chropen) putc(' ', afile->f); if (chrchange && chropen) iwchr(afile, chr); if (orgchange && orgopen || chrchange && chropen) putc('\n', afile->f); } /* Local variables for iwget: */ struct LOC_iwget { _TEXT *afile; piece *pie; long pieceplace, insttype; } ; /* Local variables for iwposition: */ struct LOC_iwposition { struct LOC_iwget *LINK; } ; Local Void iwrelative(relative, LINK) long relative; struct LOC_iwposition *LINK; { if (relative >= 0) fprintf(LINK->LINK->afile->f, " +%ld", relative); else if (relative < 0) fprintf(LINK->LINK->afile->f, " %ld", relative); } Local Void iwposition(relative, sameallowed, LINK) long relative; boolean sameallowed; struct LOC_iwget *LINK; { /* write the */ struct LOC_iwposition V; V.LINK = LINK; if (LINK->insttype == 1 && sameallowed) fprintf(LINK->afile->f, " same"); else fprintf(LINK->afile->f, " %ld", LINK->pieceplace); switch (LINK->pie->key.piedir) { case plus: iwrelative(relative, &V); break; case minus: iwrelative(-relative, &V); break; } } /* end module book.iworgchr */ /* begin module book.iwget */ Static Void iwget(afile_, pie_, fromplace, pieceplace_, toplace, flip, insttype_, carriagereturn) _TEXT *afile_; piece *pie_; long fromplace, pieceplace_, toplace; boolean flip; long insttype_; boolean carriagereturn; { /* print a get delila instruction in the orientation of pie, from fromplace to toplace pieceplace. +/- direction; If flip is false, the piece direction is as on the piece, if it is true, the it is the opposite direction. insttype: instruction type. insttype=1 means the form get from p -/+f to same +/-t dir +/-; insttype=2 means the form get from p1 -/+f to p2 +/-t dir +/-; where p, p1 and p2 are locations carriagereturn: if true, add a carriage return to the end of the line. */ struct LOC_iwget V; V.afile = afile_; V.pie = pie_; V.pieceplace = pieceplace_; V.insttype = insttype_; fprintf(V.afile->f, "get from"); iwposition(fromplace, false, &V); fprintf(V.afile->f, " to"); iwposition(toplace, true, &V); fprintf(V.afile->f, " direction"); switch (V.pie->key.piedir) { case dirhomologous: case plus: /* handle case, may not be right */ switch (flip) { case false: fprintf(V.afile->f, " +"); break; case true: fprintf(V.afile->f, " -"); break; } break; case dircomplement: case minus: /* handle case, may not be right */ switch (flip) { case false: fprintf(V.afile->f, " -"); break; case true: fprintf(V.afile->f, " +"); break; } break; } putc(';', V.afile->f); if (carriagereturn) putc('\n', V.afile->f); } /* Local variables for iwget2: */ struct LOC_iwget2 { _TEXT *afile; piece *pie; } ; /* Local variables for iwposition_: */ struct LOC_iwposition_ { struct LOC_iwget2 *LINK; } ; Local Void iwrelative_(relative, LINK) long relative; struct LOC_iwposition_ *LINK; { if (relative >= 0) fprintf(LINK->LINK->afile->f, " +%ld", relative); else if (relative < 0) fprintf(LINK->LINK->afile->f, " %ld", relative); } Local Void iwposition_(place, relative, LINK) long place, relative; struct LOC_iwget2 *LINK; { struct LOC_iwposition_ V; V.LINK = LINK; fprintf(LINK->afile->f, " %ld", place); switch (LINK->pie->key.piedir) { case plus: iwrelative_(relative, &V); break; case minus: iwrelative_(-relative, &V); break; } } /* end module book.iwget */ /* begin module book.iwget2 */ Static Void iwget2(afile_, pie_, fromplace, place1, toplace, place2, flip, carriagereturn) _TEXT *afile_; piece *pie_; long fromplace, place1, toplace, place2; boolean flip, carriagereturn; { /* print a get Delila instruction in the orientation of pie, The form of the instructions is: get from place1 +/-fromplace to place2 +/-toplace direction +/-; If flip is false, the piece direction is as on the piece, if it is true, the it is the opposite direction. carriagereturn: if true, add a carriage return to the end of the line. */ struct LOC_iwget2 V; V.afile = afile_; V.pie = pie_; fprintf(V.afile->f, "get from"); iwposition_(place1, fromplace, &V); fprintf(V.afile->f, " to"); iwposition_(place2, toplace, &V); fprintf(V.afile->f, " direction"); switch (V.pie->key.piedir) { case dirhomologous: case plus: /* handle case, may not be right */ switch (flip) { case false: fprintf(V.afile->f, " +"); break; case true: fprintf(V.afile->f, " -"); break; } break; case dircomplement: case minus: /* handle case, may not be right */ switch (flip) { case false: fprintf(V.afile->f, " -"); break; case true: fprintf(V.afile->f, " +"); break; } break; } putc(';', V.afile->f); if (carriagereturn) putc('\n', V.afile->f); } /* end module book.iwget2 */ /* begin module book.iwgetsimple */ Static Void iwgetsimple(afile, pie, fromplace, toplace, flip, carriagereturn) _TEXT *afile; piece *pie; long fromplace, toplace; boolean flip, carriagereturn; { /* iwget */ /* print a get delila instruction in the orientation of pie, from fromplace to toplace pieceplace. +/- direction; If flip is false, the piece direction is as on the piece, if it is true, the it is the opposite direction. Format: get from [pieceplace+fromplace] to [pieceplace+ toplace] +/- direction; where [] means to precompute the value. carriagereturn: if true, add a carriage return to the end of the line. */ fprintf(afile->f, "get from"); fprintf(afile->f, " %ld", fromplace); fprintf(afile->f, " to"); fprintf(afile->f, " %ld", toplace); fprintf(afile->f, " direction"); switch (pie->key.piedir) { case dirhomologous: case plus: /* handle case, may not be right */ switch (flip) { case false: fprintf(afile->f, " +"); break; case true: fprintf(afile->f, " -"); break; } break; case dircomplement: case minus: /* handle case, may not be right */ switch (flip) { case false: fprintf(afile->f, " -"); break; case true: fprintf(afile->f, " +"); break; } break; } putc(';', afile->f); if (carriagereturn) putc('\n', afile->f); } /* end module book.iwgetsimple */ /* modules for book alignment ************************************************/ /* begin module findblank */ Static Void findblank(afile) _TEXT *afile; { /* read a file to find the next blank character */ Char ch; do { ch = getc(afile->f); if (ch == '\n') ch = ' '; } while (ch != ' '); } /* end module findblank */ /* begin module findnonblank */ Static Void findnonblank(afile, ch) _TEXT *afile; Char *ch; { /* find the next non blank character in a file, return it in ch. */ *ch = ' '; while (!BUFEOF(afile->f) && *ch == ' ') { *ch = getc(afile->f); if (*ch == '\n') *ch = ' '; if (P_eoln(afile->f)) { fscanf(afile->f, "%*[^\n]"); getc(afile->f); } } } #define maximumrange 500 /* end module findnonblank */ /* begin module oldalign.align */ Static Void oldalign(inst, book, theline, pie, length, alignedbase) _TEXT *inst, *book; long *theline; piece **pie; long *length, *alignedbase; { /* documentation on align is in module info.align and delman.use.aligned.books */ /* if the alignment point is more than this distance from the piece ends, the program halts in an attempt to catch the alignment bug... 1991 Jan 11 It appears that the rewrite of the code has removed the bug, but the check will be kept. */ Char ch; /* a character in inst */ boolean comment; /* true means we are inside a comment */ boolean done = false; /* done finding an aligning get */ long thebase; /* the base read in */ name *WITH; if (BUFEOF(book->f)) /* if there is still more to the book ... */ return; getpiece(book, theline, pie); /* read in the piece */ if (BUFEOF(book->f)) /* if we found a piece ... */ return; *length = pietoint((*pie)->key.pieend, *pie); /* calculate piece length */ /* now find inst the next occurance of 'get' */ while (!done) { if (BUFEOF(inst->f)) { /* no instructions? */ *alignedbase = 1; /* simply align by the first base */ done = true; break; } if (P_peek(inst->f) == '(') { /* skip comment */ getc(inst->f); if (P_peek(inst->f) == '*') comment = true; /*if comment then write(output,'COMMENT: (');*/ while (comment) { if (BUFEOF(inst->f)) { printf(" in procedure align:\n"); printf(" an instruction comment does not end!\n"); halt(); } /*write(output,inst^);*/ getc(inst->f); if (P_peek(inst->f) == '*') { getc(inst->f); /*if inst^ = ')' then writeln(output,'*)');*/ if (P_peek(inst->f) == ')') comment = false; } } } if (P_peek(inst->f) == 'g') { getc(inst->f); if (P_peek(inst->f) == 'e') { getc(inst->f); if (P_peek(inst->f) == 't') { getc(inst->f); if (P_peek(inst->f) == ' ') { findnonblank(inst, &ch); /* get to "from" */ findblank(inst); /* get past "from" */ fscanf(inst->f, "%ld", &thebase); /* read in the alignedbase */ /*writeln(output,'thebase=',thebase:1);*/ *alignedbase = pietoint(thebase, *pie); done = true; } } } } getc(inst->f); /* move along now */ } if (*alignedbase > -maximumrange && *alignedbase <= *length + maximumrange) return; printf(" in procedure align:\n"); printf(" read in base was %ld\n", thebase); printf(" in internal coordinates: %ld\n", *alignedbase); printf(" maximum range was %ld\n", (long)maximumrange); printf(" piece length was %ld\n", *length); WITH = &(*pie)->key.hea.keynam; /* p2c: delmod.p, line 3170: Note: * Format for packed-array-of-char will work only if width < length [321] */ printf(" piece name: %.*s\n", WITH->length, WITH->letters); printf(" piece number: %ld\n", number); printf(" aligned base is too far away... see the code\n"); halt(); } #undef maximumrange /* end module oldalign.align */ /* begin module interact.clearstring */ /* begin module clearstring */ Static Void clearstring(ribbon) string *ribbon; { /* empty the string */ long index; /* to the ribbon */ for (index = 0; index < maxstring; index++) ribbon->letters[index] = ' '; ribbon->length = 0; ribbon->current = 0; } /* clearstring */ Static Void initializestring(ribbon) string *ribbon; { /* start the string with a nil pointer. This routine should be called before doing linked list work. This allows the standard string routines to clear the string without killing the pointer. */ clearstring(ribbon); ribbon->next = NULL; } /* initializestring */ /* end module clearstring version = 4.86; (@ of prgmod.p 2004 Sep 8 */ /* end module interact.clearstring version = 4.86; (@ of prgmod.p 2004 Sep 8 */ /* begin module filler.fillstring */ Static Void fillstring(s, a_) string *s; Char *a_; { /* this procedure makes it reasonably easy to fill the string s with characters. one calls the procedure as: */ /* 1 2 3 4 5 */ /* 12345678901234567890123456789012345678901234567890 */ /* fillstring(s, 'this-is-the-string '); the two comments make it easy to line the characters up. also, for this example, it was assumed that the length of filler as defined by the constant fillermax was 50. */ long length = fillermax; /* of the string without trailing blanks */ long index; /* of s */ clearstring(s); while (length > 1 && a_[length-1] == ' ') length--; if (length == 1 && a_[length-1] == ' ') { printf("fillstring: the string is empty\n"); halt(); } for (index = 0; index < length; index++) s->letters[index] = a_[index]; s->length = length; s->current = 1; } /* fillstring */ /* end module filler.fillstring version = 4.86; (@ of prgmod.p 2004 Sep 8 */ /* begin module filler.filltrigger */ Static Void filltrigger(t_, a_) trigger *t_; Char *a_; { /* fill the trigger t */ fillstring(&t_->seek, a_); } /* fillstring */ /* end module filler.filltrigger version = 4.86; (@ of prgmod.p 2004 Sep 8 */ /* begin module trigger.proc */ /* this module allows one to scan a series of characters, as from an array or a file, and to "trigger" or detect a simple string in the series. the advantage of the trigger is that several triggers can "observe" a stream of characters at once, each looking for a different thing. some other modules required: interact.const, interact.type */ Static Void resettrigger(t_) trigger *t_; { /* reset the trigger to ground state */ t_->state_ = 0; t_->skip = false; t_->found = false; } /* resettrigger */ Static Void testfortrigger(ch, t_) Char ch; trigger *t_; { /* look at the character ch. if it is part of the trigger (at the current trigger state), then the trigger state goes higher. if it is not part of the trigger then the trigger state is reset, skip is true and one should skip onward to find the trigger. if the trigger is found, found is true. 1996 Sep 12: Bug found! In the case of a trigger "ab", the program used to miss it for situations like "aab". This was because at the first a it would step up. Then it would see the second a and recognize that was not part of ab. It would fail to realize that it could be the start of a new one. The code now accounts for that possibility. */ t_->state_++; /* writestring(list,seek); writeln(list,'testfortrigger seek.letters[',state:1,']:', seek.letters[state],' ch:',ch); */ if (t_->seek.letters[t_->state_ - 1] == ch) { t_->skip = false; if (t_->state_ == t_->seek.length) t_->found = true; else t_->found = false; return; } /* it failed. But wait! It could be the beginning of a NEW trigger string! */ if (t_->seek.letters[0] == ch) { t_->state_ = 1; t_->skip = false; t_->found = false; return; } t_->state_ = 0; t_->skip = true; t_->found = false; /* reset trigger */ } /* testfortrigger */ #define maximumrange 10000 /* if the alignment point is more than this distance from the piece ends, the program halts in an attempt to catch the alignment bug... 1991 Jan 11 It appears that the rewrite of the code has removed the bug, but the check will be kept. */ #define semicolon ';' /* end of delila instruction */ /* Local variables for align: */ struct LOC_align { _TEXT *inst; Char ch; /* a character in inst */ trigger endcomment; /* trigger to find '*-)' (ignore the dash!) */ trigger endcurly; /* trigger to find comments: '}' */ } ; /* a dot '.' has been found in the name - ignore the rest of the name - for comparisons with mutations. */ /* procedure rd(var f: text; var ch: char); (* read ch from f allowing inspection of the result *) begin read(f,ch); write(output,ch); write(list,ch); write(output,'<',ch,'>'); end; procedure rdln(var f: text); (* readln f allowing inspection of the result *) begin readln(f); writeln(output); writeln(list); end; */ Local Void skipcomment(f, LINK) _TEXT *f; struct LOC_align *LINK; { /* skip an entire comment */ boolean comment = true; /* true means we are inside a comment */ /* skip to end of comment */ resettrigger(&LINK->endcomment); while (comment) { if (BUFEOF(f->f)) { printf("A comment does not end!\n"); halt(); } if (P_eoln(f->f)) { fscanf(f->f, "%*[^\n]"); getc(f->f); continue; } /* rdln(f) */ LINK->ch = getc(f->f); if (LINK->ch == '\n') LINK->ch = ' '; testfortrigger(LINK->ch, &LINK->endcomment); if (LINK->endcomment.found) { comment = false; /*write(output,'<'); rd(f,ch); write(output,'>');*/ } } } Local Void skipcurly(f, LINK) _TEXT *f; struct LOC_align *LINK; { /* skip an entire comment made by {}*/ boolean comment = true; /* true means we are inside a comment */ /* skip to end of comment */ resettrigger(&LINK->endcurly); while (comment) { if (BUFEOF(f->f)) { printf("A comment does not end!\n"); halt(); } if (P_eoln(f->f)) { fscanf(f->f, "%*[^\n]"); getc(f->f); continue; } /* rdln(f) */ LINK->ch = getc(f->f); if (LINK->ch == '\n') LINK->ch = ' '; testfortrigger(LINK->ch, &LINK->endcurly); if (LINK->endcurly.found) { comment = false; /*write(output,'<'); rd(f,ch); write(output,'>');*/ } } } Local Void skipquote(quote, LINK) trigger quote; struct LOC_align *LINK; { /* skip an entire quote of either the ' or " persuasion */ Char kind; /* the kind of quote, ' or " */ kind = quote.seek.letters[0]; /*writeln(output,'skipquote ',kind);*/ do { findnonblank(LINK->inst, &LINK->ch); /* get to the quote */ } while (!((LINK->ch == kind) | BUFEOF(LINK->inst->f))); if (LINK->ch != kind) { printf("end of quote starting with %c not found\n", kind); halt(); } } /* end module trigger.proc version = 4.86; (@ of prgmod.p 2004 Sep 8 */ /* begin module align.align */ Static Void align(inst_, book, theline, pie, length, alignedbase) _TEXT *inst_, *book; long *theline; piece **pie; long *length, *alignedbase; { /* documentation on align is in module info.align and delman.use.aligned.books. 1996 Sep 12: The routine now uses the trigger functions found in prgmod. The bug in the oldalign routine (that it misses the end of comments that end in a series of asterisks) has been fixed. It now checks that the piece corresponds to the book. */ struct LOC_align V; long p; /* index to a piece name */ long p1; /* another index to a piece name */ boolean done = false; /* done finding an aligning get */ long thebase; /* the base read in */ boolean indefault = false; /* true when within a default statement. These can contain the word 'piece', which must be ignored. */ trigger gettrigger; /* trigger to find 'get' */ trigger defaulttrigger; /* trigger to find 'default' */ trigger nametrigger; /* trigger to find 'name' */ trigger piecetrigger; /* trigger to find 'piece' */ trigger settrigger; /* trigger to find 'set' */ trigger begincomment; /* trigger to find '(-*' (ignore the dash!) */ trigger begincurly; /* trigger to find comments: '{' */ trigger quote1trigger; /* trigger to find single quote ' */ trigger quote2trigger; /* trigger to find double quote " */ boolean dotteddone; name *WITH; V.inst = inst_; filltrigger(&defaulttrigger, "default "); filltrigger(&gettrigger, "get "); filltrigger(&nametrigger, "name "); filltrigger(&piecetrigger, "piece "); filltrigger(&settrigger, "set "); filltrigger(&begincomment, "(* "); filltrigger(&V.endcomment, "*) "); filltrigger(&begincurly, "{ "); filltrigger(&V.endcurly, "} "); filltrigger("e1trigger, "' "); filltrigger("e2trigger, "\" "); resettrigger(&defaulttrigger); resettrigger(&gettrigger); resettrigger(&nametrigger); resettrigger(&piecetrigger); resettrigger(&settrigger); resettrigger(&begincomment); resettrigger(&begincurly); resettrigger("e1trigger); resettrigger("e2trigger); if (BUFEOF(book->f)) /* if there is still more to the book ... */ return; getpiece(book, theline, pie); /* read in the piece */ if (BUFEOF(book->f)) /* if we found a piece ... */ return; *length = pietoint((*pie)->key.pieend, *pie); /* calculate piece length */ /* now find in inst the next occurance of 'get' */ while (!done) { if (BUFEOF(V.inst->f)) { /* no instructions? */ *alignedbase = 1; /* simply align by the first base */ done = true; break; } if (P_eoln(V.inst->f)) { fscanf(V.inst->f, "%*[^\n]"); getc(V.inst->f); continue; } /*then rdln(inst)*/ V.ch = getc(V.inst->f); if (V.ch == '\n') V.ch = ' '; testfortrigger(V.ch, &begincomment); testfortrigger(V.ch, &begincurly); if (begincomment.found || begincurly.found) { if (V.ch == '*') { skipcomment(V.inst, &V); resettrigger(&begincomment); } else { resettrigger(&begincurly); skipcurly(V.inst, &V); } continue; } testfortrigger(V.ch, &gettrigger); if (gettrigger.found) { findnonblank(V.inst, &V.ch); /* get to "from" */ findblank(V.inst); /* get past "from" */ fscanf(V.inst->f, "%ld", &thebase); /* read in the alignedbase */ /*writeln(output);writeln(output,'thebase = ',thebase:1);*/ *alignedbase = pietoint(thebase, *pie); /*writeln(output,'alignedbase=',alignedbase:1);*/ done = true; } testfortrigger(V.ch, "e1trigger); if (quote1trigger.found) skipquote(quote1trigger, &V); testfortrigger(V.ch, "e2trigger); if (quote2trigger.found) skipquote(quote2trigger, &V); testfortrigger(V.ch, &defaulttrigger); if (defaulttrigger.found) { indefault = true; resettrigger(&defaulttrigger); } if (V.ch == semicolon) indefault = false; testfortrigger(V.ch, &settrigger); if (settrigger.found) { indefault = true; resettrigger(&settrigger); } if (V.ch == semicolon) indefault = false; /* check that piece names are correct */ testfortrigger(V.ch, &piecetrigger); if (indefault) continue; if (!piecetrigger.found) continue; skipblanks(V.inst); /* get to name */ WITH = &(*pie)->key.hea.keynam; /* for p := 1 to length do begin */ /* 2007 Jun 22: replace loop with while so that we can drop out when dotted names are detected. */ p = 1; dotteddone = false; while (!dotteddone) { if (P_eoln(V.inst->f)) { dotteddone = true; break; } V.ch = getc(V.inst->f); if (V.ch == '\n') V.ch = ' '; /* ignore names after a dot */ /* if ch = '.' then writeln(output,'inst dotteddone'); */ if (V.ch == '.') dotteddone = true; if (WITH->letters[p-1] == '.') dotteddone = true; /* if ch = '.' then writeln(output,'book dotteddone'); writeln(output,'BUBBa ch = ',ch,' ',p:1); */ /*zzz*/ if (WITH->letters[p-1] != V.ch && !dotteddone && V.ch != ';') { printf("The piece name in the book: \n"); /* p2c: delmod.p, line 3566: Note: * Format for packed-array-of-char will work only if width < length [321] */ printf("%.*s\n", WITH->length, WITH->letters); printf("does not match the inst file piece name:\n"); /* write the letters that matched: */ for (p1 = 0; p1 <= p - 2; p1++) putchar(WITH->letters[p1]); /* write the offending letter: */ putchar(V.ch); /* get the rest of the name and show it: */ done = P_eoln(V.inst->f); while (!done) { done = P_eoln(V.inst->f); if (done) break; V.ch = getc(V.inst->f); if (V.ch == '\n') V.ch = ' '; if (V.ch == ' ' || V.ch == ';') done = true; if (!done) putchar(V.ch); } putchar('\n'); /* mark the first letter that does not match: */ for (p1 = 1; p1 < p; p1++) putchar(' '); printf("^\n"); halt(); } p++; if (p > WITH->length) { dotteddone = true; /* we are not inside a comment */ } } } /*rd(inst,ch);*/ if (*alignedbase > -maximumrange && *alignedbase <= *length + maximumrange) return; printf(" In procedure align:\n"); printf(" read in base was %ld\n", thebase); printf(" in internal coordinates: %ld\n", *alignedbase); printf(" maximum range was %ld\n", (long)maximumrange); printf(" piece length was %ld\n", *length); WITH = &(*pie)->key.hea.keynam; /* p2c: delmod.p, line 3613: Note: * Format for packed-array-of-char will work only if width < length [321] */ printf(" piece name: %.*s\n", WITH->length, WITH->letters); printf(" piece number: %ld\n", number); printf(" aligned base is too far away... see the code\n"); halt(); } #undef maximumrange #undef semicolon #define maximumrange 500 /* end module align.align */ /* begin module align.maxminalignment */ Static Void maxminalignment(inst, book, theline, fromparam, toparam, alignmenttype) _TEXT *inst, *book; long *theline, *fromparam, *toparam; Char alignmenttype; { /* prescan the book to find the range over which the pieces of the book are spread, relative to the aligned base. the procedure uses the same variables that align does (so it can call align itself), and it returns the range in fromparam and toparam. alignmenttype: 'f' means alignment by First internal coordinate base, 'b' means alignment by Book, 'i' means alignment by Instructions. */ /* the maximum size aligned piece; this will presumably catch the alignment bug */ long distance; /* a distance to the aligned base */ piece *pie; long length, alignedbase; pie = (piece *)Malloc(sizeof(piece)); /* set an initial range for the two bounds */ *fromparam = LONG_MAX; *toparam = -LONG_MAX; if (*book->name != '\0') { if (book->f != NULL) book->f = freopen(book->name, "r", book->f); else book->f = fopen(book->name, "r"); } else rewind(book->f); if (book->f == NULL) _EscIO2(FileNotFound, book->name); RESETBUF(book->f, Char); if (*inst->name != '\0') { if (inst->f != NULL) inst->f = freopen(inst->name, "r", inst->f); else inst->f = fopen(inst->name, "r"); } else rewind(inst->f); if (inst->f == NULL) _EscIO2(FileNotFound, inst->name); RESETBUF(inst->f, Char); while (!BUFEOF(book->f)) { switch (alignmenttype) { case 'i': align(inst, book, theline, &pie, &length, &alignedbase); break; case 'b': case 'f': getpiece(book, theline, &pie); /* read in the piece */ length = piecelength(pie); break; } if (BUFEOF(book->f)) break; switch (alignmenttype) { case 'f': /* force alignment on first base */ alignedbase = 0; *fromparam = 1; distance = length - alignedbase; if (*toparam < distance) *toparam = distance; break; case 'i': /* use the alignedbase from the book */ distance = 1 - alignedbase; if (*fromparam > distance) *fromparam = distance; distance = length - alignedbase; if (*toparam < distance) *toparam = distance; break; case 'b': /* use the internal book */ alignedbase = pietoint(0L, pie); distance = 1 - alignedbase; if (*fromparam > distance) *fromparam = distance; distance = length - alignedbase; if (*toparam < distance) *toparam = distance; break; } clearpiece(&pie); } if (*toparam - *fromparam > maximumrange) { printf(" in procedure maxminalignment:\n"); printf(" alignedbase = %ld\n", alignedbase); printf(" fromparameter = %ld\n", *fromparam); printf(" toparameter = %ld\n", *toparam); printf(" this exceeds the maximum range allowed (%ld)\n", (long)maximumrange); printf(" see notes in the procedure. \n"); /* notes: if you desired this range, increase 'maximumrange'. otherwise, this may indicate a bug - either: 1) locate the bug (and tell tom schneider, please...) 2) reduce the size of the fragments, from one or the other end until the bombing is stopped. */ halt(); } /* make the book readable again */ if (*book->name != '\0') { if (book->f != NULL) book->f = freopen(book->name, "r", book->f); else book->f = fopen(book->name, "r"); } else rewind(book->f); if (book->f == NULL) _EscIO2(FileNotFound, book->name); RESETBUF(book->f, Char); if (*inst->name != '\0') { if (inst->f != NULL) inst->f = freopen(inst->name, "r", inst->f); else inst->f = fopen(inst->name, "r"); } else rewind(inst->f); if (inst->f == NULL) _EscIO2(FileNotFound, inst->name); RESETBUF(inst->f, Char); Free(pie); } #undef maximumrange /* end module align.maxminalignment */ /* begin module align.withinalignment */ Static boolean withinalignment(alignedposition, alignedbase, length) long alignedposition, alignedbase, length; { /* this function tells one if an aligned position, relative to an aligned base in a piece of some length is within the piece. */ long p; /* the position on the piece */ p = alignedposition + alignedbase; return (p > 0 && p <= length); } /* end module align.withinalignment */ /* amino acid procedures ****************************************************/ /* this is a set of procedures that deal with amino acids. they require the book reading routines. */ /* begin module amino.getaminoacid */ Static Void getaminoacid(position, pie, aa) long position; piece *pie; Char *aa; { /* get the amino acid corresponding to a codon starting in pie at position. the amino acid is blank (' ') if it is outside a linear piece. amb = amber nonsense (uag) och = ochre nonsense (uaa) opa = opal nonsense (uga) */ base b0, b1, b2; /* bases that correspond to the amino acid */ long length; /* length of the piece */ boolean done = false; /* flag for out of bounds test */ length = pietoint(pie->key.pieend, pie); /* deal with position out of the piece */ if (position < 1 || position > length - 2) { switch (pie->key.piecon) { case linear: /* ignore out of bounds requests */ memcpy(aa, " ", sizeof(aminoacid)); done = true; break; case circular: /* modify the local copy of position to be within the circle. */ while (position < 1) position += length; while (position > length) position -= length; b0 = getbase(position, pie); /* step through the codon, making sure to stay on the circle. */ position++; if (position > length) position = 1; b1 = getbase(position, pie); position++; if (position > length) position = 1; b2 = getbase(position, pie); break; } } else { b0 = getbase(position, pie); b1 = getbase(position + 1, pie); b2 = getbase(position + 2, pie); } /* pick up the bases at the position */ if (done) return; switch (b0) { case t: switch (b1) { case t: switch (b2) { case t: memcpy(aa, "phe", sizeof(aminoacid)); break; case c: memcpy(aa, "phe", sizeof(aminoacid)); break; case a: memcpy(aa, "leu", sizeof(aminoacid)); break; case g: memcpy(aa, "leu", sizeof(aminoacid)); break; } break; case c: switch (b2) { case t: memcpy(aa, "ser", sizeof(aminoacid)); break; case c: memcpy(aa, "ser", sizeof(aminoacid)); break; case a: memcpy(aa, "ser", sizeof(aminoacid)); break; case g: memcpy(aa, "ser", sizeof(aminoacid)); break; } break; case a: switch (b2) { case t: memcpy(aa, "tyr", sizeof(aminoacid)); break; case c: memcpy(aa, "tyr", sizeof(aminoacid)); break; case a: memcpy(aa, "och", sizeof(aminoacid)); break; case g: memcpy(aa, "amb", sizeof(aminoacid)); break; } break; case g: switch (b2) { case t: memcpy(aa, "cys", sizeof(aminoacid)); break; case c: memcpy(aa, "cys", sizeof(aminoacid)); break; case a: memcpy(aa, "opa", sizeof(aminoacid)); break; case g: memcpy(aa, "trp", sizeof(aminoacid)); break; } break; } break; case c: switch (b1) { case t: switch (b2) { case t: memcpy(aa, "leu", sizeof(aminoacid)); break; case c: memcpy(aa, "leu", sizeof(aminoacid)); break; case a: memcpy(aa, "leu", sizeof(aminoacid)); break; case g: memcpy(aa, "leu", sizeof(aminoacid)); break; } break; case c: switch (b2) { case t: memcpy(aa, "pro", sizeof(aminoacid)); break; case c: memcpy(aa, "pro", sizeof(aminoacid)); break; case a: memcpy(aa, "pro", sizeof(aminoacid)); break; case g: memcpy(aa, "pro", sizeof(aminoacid)); break; } break; case a: switch (b2) { case t: memcpy(aa, "his", sizeof(aminoacid)); break; case c: memcpy(aa, "his", sizeof(aminoacid)); break; case a: memcpy(aa, "gln", sizeof(aminoacid)); break; case g: memcpy(aa, "gln", sizeof(aminoacid)); break; } break; case g: switch (b2) { case t: memcpy(aa, "arg", sizeof(aminoacid)); break; case c: memcpy(aa, "arg", sizeof(aminoacid)); break; case a: memcpy(aa, "arg", sizeof(aminoacid)); break; case g: memcpy(aa, "arg", sizeof(aminoacid)); break; } break; } break; case a: switch (b1) { case t: switch (b2) { case t: memcpy(aa, "ile", sizeof(aminoacid)); break; case c: memcpy(aa, "ile", sizeof(aminoacid)); break; case a: memcpy(aa, "ile", sizeof(aminoacid)); break; case g: memcpy(aa, "met", sizeof(aminoacid)); break; } break; case c: switch (b2) { case t: memcpy(aa, "thr", sizeof(aminoacid)); break; case c: memcpy(aa, "thr", sizeof(aminoacid)); break; case a: memcpy(aa, "thr", sizeof(aminoacid)); break; case g: memcpy(aa, "thr", sizeof(aminoacid)); break; } break; case a: switch (b2) { case t: memcpy(aa, "asn", sizeof(aminoacid)); break; case c: memcpy(aa, "asn", sizeof(aminoacid)); break; case a: memcpy(aa, "lys", sizeof(aminoacid)); break; case g: memcpy(aa, "lys", sizeof(aminoacid)); break; } break; case g: switch (b2) { case t: memcpy(aa, "ser", sizeof(aminoacid)); break; case c: memcpy(aa, "ser", sizeof(aminoacid)); break; case a: memcpy(aa, "arg", sizeof(aminoacid)); break; case g: memcpy(aa, "arg", sizeof(aminoacid)); break; } break; } break; case g: switch (b1) { case t: switch (b2) { case t: memcpy(aa, "val", sizeof(aminoacid)); break; case c: memcpy(aa, "val", sizeof(aminoacid)); break; case a: memcpy(aa, "val", sizeof(aminoacid)); break; case g: memcpy(aa, "val", sizeof(aminoacid)); break; } break; case c: switch (b2) { case t: memcpy(aa, "ala", sizeof(aminoacid)); break; case c: memcpy(aa, "ala", sizeof(aminoacid)); break; case a: memcpy(aa, "ala", sizeof(aminoacid)); break; case g: memcpy(aa, "ala", sizeof(aminoacid)); break; } break; case a: switch (b2) { case t: memcpy(aa, "asp", sizeof(aminoacid)); break; case c: memcpy(aa, "asp", sizeof(aminoacid)); break; case a: memcpy(aa, "glu", sizeof(aminoacid)); break; case g: memcpy(aa, "glu", sizeof(aminoacid)); break; } break; case g: switch (b2) { case t: memcpy(aa, "gly", sizeof(aminoacid)); break; case c: memcpy(aa, "gly", sizeof(aminoacid)); break; case a: memcpy(aa, "gly", sizeof(aminoacid)); break; case g: memcpy(aa, "gly", sizeof(aminoacid)); break; } break; } break; } } /* end module amino.getaminoacid */ /* begin module basepair */ Static boolean basepair(xseq, yseq, x, y, guallowed) piece *xseq, *yseq; long x, y; boolean guallowed; { /* does xseq basepair to yseq at x to y? allow gu pair if guallowed is true. a series of if-then statements are used for speed. */ base bx, by; /* bases in the sequences */ bx = getbase(x, xseq); by = getbase(y, yseq); if (bx == complement(by)) return true; else if (guallowed) { if (bx == g && by == t) return true; else if (bx == t && by == g) return true; else return false; } else return false; } /* end module basepair */ /* begin module freeenergy */ /* this module contains: moveendsin: a procedure to find the core of a helix, where the core is the part that contributes the energy. gu pairs and single base pairs are removed from both ends. freeenergy: a function that uses moveendsin and then calculates the free energy of the core in kcal. */ Static Void moveendsin(x5bound, x3bound, xpiece, y5bound, y3bound, ypiece) long *x5bound, *x3bound; piece *xpiece; long *y5bound, *y3bound; piece *ypiece; { /* move the ends of the helix in. gu pairs contribute no energy, nor do single base pairs surrounded by gu pairs. these are removed. */ /* move the bounds inward to the first occurance of base pairing. since a single base pair provides no energy, the successive position is also required to pair. the energy beyond these bounds is zero. */ /* move one end in, decrease x3bound, increase y5bound note 1: x3bound cannot go below succ(x5bound) because the call to getbase would object to looking before the x5" end. the x5 bound is brought up in the second while loop. */ while (((getbase(*x3bound, xpiece) != complement(getbase(*y5bound, ypiece))) | (getbase(*x3bound - 1, xpiece) != complement(getbase(*y5bound + 1, ypiece)))) && *x3bound > *x5bound + 1) { (*x3bound)--; (*y5bound)++; } /* move the other end in, increase x5bound, decrease y3bound note 2: for efficiency,x5bound can stop incrementation when it passes x3bound */ while (((getbase(*x5bound, xpiece) != complement(getbase(*y3bound, ypiece))) | (getbase(*x5bound + 1, xpiece) != complement(getbase(*y3bound - 1, ypiece)))) && *x5bound < *x3bound) { (*x5bound)++; (*y3bound)--; } } /* moveendsin */ /* Local variables for freeenergy: */ struct LOC_freeenergy { piece *xpiece, *ypiece; long x5, y3; /* 5 and 3 prime ends on x and y pieces */ base x5b, x3b; /* the bounds of energy calculation */ double energy; /* the current total energy */ long bulgebases; /* the number of bases involved in a bulge */ boolean bulging; /* flag for continuing a bulge after a single match */ } ; Local Void readofftable(LINK) struct LOC_freeenergy *LINK; { /* create a 4 by 4 table based on table 1 in tinoco et al. we know at this point that both base pairs complement, so only one pair is used. */ double deltag; /* temporary curve */ switch (LINK->x5b) { case a: switch (LINK->x3b) { case a: deltag = -1.2; break; case c: deltag = -2.2; break; case g: deltag = -2.2; break; case t: deltag = -1.8; break; } break; case c: switch (LINK->x3b) { case a: deltag = -2.2; break; case c: deltag = -5.0; break; case g: deltag = -3.2; break; case t: deltag = -2.2; break; } break; case g: switch (LINK->x3b) { case a: deltag = -2.2; break; case c: deltag = -5.0; break; case g: deltag = -5.0; break; case t: deltag = -2.2; break; } break; case t: switch (LINK->x3b) { case a: deltag = -1.8; break; case c: deltag = -2.2; break; case g: deltag = -2.2; break; case t: deltag = -1.2; break; } break; } LINK->energy += deltag; } Local Void gupair(LINK) struct LOC_freeenergy *LINK; { /* in the tinoco paper, one pairing has exceptional energy: gu/ug */ LINK->energy -= 0.3; } Local Void continuebulge(LINK) struct LOC_freeenergy *LINK; { /* the interior loop bulge continues */ LINK->bulgebases += 2; } Local Void beginbulge(LINK) struct LOC_freeenergy *LINK; { /* begin a bulge, of the interior loop kind */ if (!LINK->bulging) { LINK->bulgebases = 2; LINK->bulging = true; } else { /* only a single base matches, so it is to be ignored */ continuebulge(LINK); } } Local Void endbulge(LINK) struct LOC_freeenergy *LINK; { /* close the bulge by recording its energy */ /* perhaps it is only a single match */ if (getbase(LINK->x5 - 1, LINK->xpiece) != complement(getbase(LINK->y3 + 1, LINK->ypiece))) { /* it is really the end of a bulge */ continuebulge(LINK); /* the single match is to be ignored */ return; } if (2 <= LINK->bulgebases && LINK->bulgebases <= 6) LINK->energy += 2.0; else if (7 <= LINK->bulgebases && LINK->bulgebases <= 20) LINK->energy += 3.0; else { LINK->energy += 1.0 + 2.0 * log((double)LINK->bulgebases) / log(10.0); /* bulgebases > 20 */ } LINK->bulging = false; } Static double freeenergy(x5start, x3start, xpiece_, y5start, y3start, ypiece_) long x5start, x3start; piece *xpiece_; long y5start, y3start; piece *ypiece_; { /* evaluate the free energy of the pairing (x3start, y5start) to (x5start, y3start). interior loops are evaluated only for the case where both sides are equal in length. the units of the energy returned are kcalorie. based on tinoco et al nature new biology vol 246 pp 40-41, 1973. internal coordinates (1 to n) are used. gu pairs are eliminated from the ends by calling moveendsin. */ struct LOC_freeenergy V; long x3, y5; base y5b, y3b; /* the bases corresponding to the above */ long x5bound, x3bound, y5bound, y3bound; V.xpiece = xpiece_; V.ypiece = ypiece_; /* test consistency of input */ if (x5start - x3start != y5start - y3start) { printf(" function freeenergy:\n"); printf(" the supplied ends are not consistent with a helix.\n"); halt(); } x5bound = x5start; x3bound = x3start; y5bound = y5start; y3bound = y3start; moveendsin(&x5bound, &x3bound, V.xpiece, &y5bound, &y3bound, V.ypiece); /* set external energy to zero */ V.energy = 0.0; /* no bulges yet */ V.bulging = false; if (x5bound >= x3bound) return V.energy; /* within this if, the range is bounded by base pairs */ x3 = x3bound; y5 = y5bound; V.x5 = x3 - 1; V.y3 = y5 + 1; /* these points (x,y/5,3) now define a dinucleotide pair between x and y. now we must scan the the dinucleotide across to the other bound. */ do { /* convert positons to bases */ V.x5b = getbase(V.x5, V.xpiece); V.x3b = getbase(x3, V.xpiece); y5b = getbase(y5, V.ypiece); y3b = getbase(V.y3, V.ypiece); if ((V.x3b == complement(y5b)) & (V.x5b == complement(y3b))) /* everybody pairs */ readofftable(&V); else if (y5b == g && y3b == t && V.x3b == t && V.x5b == g) /* a special case */ gupair(&V); else if ((V.x5b != complement(y3b)) & (V.x3b != complement(y5b))) /* nobody pairs */ continuebulge(&V); else if (V.x3b == complement(y5b)) /* the first two pair */ beginbulge(&V); else if (V.x5b == complement(y3b)) /* the last two pair */ endbulge(&V); else halt(); x3--; y5++; V.x5--; V.y3++; /*if debugging then writeln(output,energy:4:1); */ } while (V.x5 >= x5bound); return V.energy; } /* freeenergy */ /* end module freeenergy version = 'delmod 6.17 84 apr 12 tds/gds'; */ /* begin module lowestenergy */ Static double lowestenergy(s) piece *s; { /* find the lowest possible energy of pairing to sequence s by calculating the energy for pairing of s to its complement */ double Result; piece *cs; /* complement of s */ long slength; /* lengths of s and cs */ long p; /* position */ slength = piecelength(s); /* see if the assumption noted below is true: */ if (slength > dnamax) { printf(" in function lowestenergy: length of s > dnamax (%ld > %ld).\n", slength, (long)dnamax); printf(" shorten s or increase dnamax.\n"); halt(); } /* make complement of s */ cs = (piece *)Malloc(sizeof(piece)); clearpiece(&cs); cs->key = s->key; cs->dna = (dnastring *)Malloc(sizeof(dnastring)); /* assumption: that this will hold the entire piece... */ cs->dna->next = NULL; for (p = 1; p <= slength; p++) { P_clrbits_B(cs->dna->part, slength - p, 1, 3); P_putbits_UB(cs->dna->part, slength - p, (int)complement(getbase(p, s)), 1, 3); } /* find the energy of pairing */ Result = freeenergy(1L, slength, s, 1L, slength, cs); /* if debugging then writeln(output,' lowest energy:', freeenergy(1,slength,s,1,slength,cs):10:3);*/ /* clean up */ clearpiece(&cs); Free(cs); return Result; } /* end module lowestenergy */ /* begin module info.nextbase */ /* nextbase: book reading routines that return one base at a time the nextbase routines allow a programmer to access a delila library without having to know any details of the library interface routines. the routines are most efficient for reading a book of sequences sequentially, that is, one base at a time. for random access, the user should learn how to use the other routines in the book modules. your program must contain several things: 1) the book reading routines must be inserted into your program. they are the modules book.const, book.type, book.var, and package.nextbase. 2) you must declare the several variables used by the two routines of nextbase. fortunately, you need not know how they are used inside the routines. 3) you must use the routine initnextbase to initilize variables used by the routine nextbase. 4) once these things are set up, all you need to do is call function nextbase, which will returns the next base. 5) if you want characters returned call acharacter:= basetochar(nextbase(....)); other useful functions are contained in the book reading package. */ /* end module info.nextbase */ /* begin module nextbase */ Static Void initnextbase(book, pie, lastbase, endofbook, theline) _TEXT *book; piece **pie; boolean *lastbase, *endofbook; long *theline; { /* initialize variables for function nextbase. book is the book to be read, pie is the piece, lastbase is the flag that is true when we are at the last base of a piece, and endofbook is true if we are at the end of the book (see nextbase). theline records the current line number in the book. */ piece *WITH; header *WITH1; brinit(book, theline); *pie = (piece *)Malloc(sizeof(piece)); WITH = *pie; WITH1 = &WITH->key.hea; WITH1->fulnam = NULL; WITH1->note = NULL; WITH->dna = NULL; *lastbase = true; /* this will trigger reading of the next piece */ if (BUFEOF(book->f)) *endofbook = true; else *endofbook = false; } Static base nextbase(book, theline, pie, dnalink, dnalinkspot, dnaspot, length, lastbase, endofbook) _TEXT *book; long *theline; piece **pie; dnastring **dnalink; dnarange *dnalinkspot; long *dnaspot, *length; boolean *lastbase, *endofbook; { /* the book being read */ /* current line number of the book */ /* the next variables can be ignored */ /* the piece */ /* the current link we are on */ /* the spot in the dnalink */ /* these are useful to the general user: */ /* integer in 1 to length, which base this is */ /* length of this piece */ /* true if the base was the last one on the piece. */ /* true when we have reached the end of the book */ /* the user simply declares variables for book, pie, dnalink, dnalinkspot (of the appropriate type) note: you can convert the valuespot to published coordinates by pubcoords:= inttopie(dnaspot,pie); warning: if the end of the book has been reached, then endofbook is true, but the value returned by the function has no meaning. */ base Result; if (*endofbook) return Result; if (!*lastbase) { Result = stepbase((*pie)->dna, dnalink, dnalinkspot); (*dnaspot)++; if (*dnaspot == *length) *lastbase = true; return Result; } else { clearpiece(pie); getpiece(book, theline, pie); if (!BUFEOF(book->f)) { *dnalink = (*pie)->dna; *dnalinkspot = 0; *dnaspot = 0; *length = piecelength(*pie); *lastbase = false; *endofbook = false; return (nextbase(book, theline, pie, dnalink, dnalinkspot, dnaspot, length, lastbase, endofbook)); } else { /* we are no longer at the last base */ *endofbook = true; /* we have reached the end of the book */ *lastbase = false; return a; /* a fake value */ } } /* we are at the last base of the previous piece */ return Result; } /* end module nextbase */ /* begin module info.book.br.routines */ /* information about the book reading (br) routines these types, constants, variables, procedures, and functions make it relatively easy to read the books as defined in: 'organism and recognition class library definition: a dna sequence data base' the routines use several global variables. (we plan to eliminate this.) readnumber: when an item (eg a piece) is read its notes are investigated. if readnumber is false, then the notes are read in line by line. if readnumber is true, then the notes are not available, because they are investigated for a number of the item: number: if there is a number in the notes, this variable contains the value, and the variable: numbered: is true (otherwise it is false). skipunnum: if set to false, the next item is read in. if skipunnum is true and an item is not numbered then the read routines will continue looking for a numbered item (skip unnumbered items). in this way one can select and read only the numbered items. other global variables are: freeline, freedna since these are used by the br routines, the user should not use these names. procedures: procedure getdatetime(var adatetime: datetimearray); get the date and time into a single array from the system clock procedure readdatetime (var thefile: text; var adatetime: datetimearray); read the date and time from the file procedure writedatetime(var thefile: text; adatetime: datetimearray); expand the date and time out and print in the file procedure brinit(var book: text); initializes a book file. it is required before any book reads. procedure getpiece(var book: text; var theline: integer; var pie: pieceptr); returns a pointer to the next piece in the book, or eof(book) is true when there is none. theline tracks the line number. procedure clearpiece(var pie: pieceptr); returns the dna of a piece to free storage. it should be used when a piece is no longer needed. procedure getocp(var thefile: text; var theline: integer; var org: orgkey; var orgchange: boolean; var orgopen: boolean; var chr: chrkey; var chrchange: boolean; var chropen: boolean; var pie: pieceptr; var pieopen: boolean); get the next piece and its organism and chromosome keys. orgchange and chrchange indicate whether or not a new organism or chromosome was found. if a piece is not found, then eof(book) will be true. orgopen, chropen and pieopen are used by getocp to tell when it has entered an organism, chromosome or piece. they should be set to false initially. there should be one triplet for each book read. theline tracks the line number. functions: function pietoint(p: integer; pie: pieceptr): integer; converts a number in piece coordinates to a convenient internal coordinate system: piebeg becomes 1 and pieend becomes the length of the piece. function inttopie(i: integer; pie: pieceptr):integer; the inverse of pietoint. function getbase(i: integer; pie: pieceptr):base; returns the base at a given internal coordinate. function stepbase(startdna: dnaptr; var dna: dnaptr; var d: integer): base; advance d by one base in dna and then return the base at the new d. (this means that one should initialize d to zero) if we go past the last base, we restart at startdna. function basetochar(ba:base):char; converts a type base to a character. function chartobase(ch:char):base; the inverse of basetochar. function complement(ba:base):base; returns the complement of a base. function piecelength(pie: pieceptr): integer; return the length of the dna in pie dnamax is a constant which determines the size of each dnastring. for most uses, 3000 works fine. under some circumstances, other values can be used, for example when a program will usually use far less than 3000 bases. to calculate the number of bases, one can start with how many machine words one wants to use per dna string. for 100 words on a machine with 60 bits per word: (60 bits/word)*(1base/2bits)*100 words=3000 bases */ /* end module info.book.br.routines */ /* begin module info.book.br.dependencies */ /* dependencies between book reading (br) routines the first word is the name of a procedure. the other words on the line are the procedures, functions or (package)s that the procedure calls or uses. this set is useful for designing packages of procedures. (note: this is a condensed set. not all actual calls are noted, if one of the procedures called uses a lower procedure. most of these are in module basis. the purpose of this module is to aid in construction, not to document the structure.) basis (const) (type) (var) halt getbase basis stepbase basis getto basis skipstar basis brreanum skipstar brnumber skipstar brname skipstar brline skipstar brdirect skipstar brconfig skipstar brstate skipstar brnotenumber brnote brline brheader brname brline brnotenumber brnote brorgkey brheader brline brchrkey brheader brreanum brpiekey brheader brreanum brconfig brdirect brnumber brdna getto brpiece brpiekey brdna getpiece getto brpiece getocp getto brorgkey brchrkey brpiece brinit copyheader */ /* end module info.book.br.dependencies */ /* begin module info.align */ /* sequence alignment routines align reads a set of delila instructions (inst), and the book created by delila from those instructions (book). it returns the next piece in the book (pie), the length of the piece (length) in bases, and a number somewhere between 1 and length which can be used to align all the pieces of the book (alignbedbase). if no piece is found, then eof(book) is true, otherwise the piece is returned. if the instruction file has fewer get instructions than pieces in the book, then align will halt. the instructions are assumed to have a rigid format: 1. each get starts on a new line. 2. a "g" as the first character of a line is always a get. 3. all gets are in the form: get from # ... (where # is an integer) 4. the # is picked up as the number for aligning, and is converted to internal coordinates (see br routines), in the range 1 to length, inclusive. there are two other procedures in this package. one finds the minimum and maximum range of the pieces in the book relative to the aligned base. the other tests a position in 'aligned space' for inclusion in a particular piece. these procedures make it possible to scan in the space of aligned pieces rather than in the space of each piece. for example, it allows one to list aligned pieces by running a for loop: for index:=fromparam to toparam do if withinalignment(index,alignedbase,length) then write(afile,basetochar(getbase(index+alignedbase,thepiece))) else write(afile,' ') */ /* end module info.align */ /* begin module demo.nextbase */ Static Void demonextbase(book, fout) _TEXT *book, *fout; { /* demonstration of the use of the nextbase routines */ /* these variables are all defined in nextbase */ piece *pie; dnastring *dnalink; dnarange dnalinkspot; long dnaspot, length; boolean lastbase, endofbook; long theline; /* this variable is needed to catch the value of nextbase, so that we can check that we have not reached the end of the book. */ Char character; initnextbase(book, &pie, &lastbase, &endofbook, &theline); theline = 0; fprintf(fout->f, " demonstration of package.nextbase\n"); fprintf(fout->f, " the bases of the book are given, followed by two numbers:\n"); fprintf(fout->f, " the first is the internal coordinate of the base.\n"); fprintf(fout->f, " the second is the published coordinate of the base.\n"); while (!endofbook) { character = basetochar(nextbase(book, &theline, &pie, &dnalink, &dnalinkspot, &dnaspot, &length, &lastbase, &endofbook)); if (!endofbook) fprintf(fout->f, " %c %3ld %3ld\n", character, dnaspot, inttopie(dnaspot, pie)); if (lastbase) fprintf(fout->f, " end of a piece %ld bp long at line %ld of the book\n", length, theline); } } /* demonextbase */ /* end module demo.nextbase */ /* begin module demo.time */ Static Void demotime(fout) _TEXT *fout; { /* write the time to file fout */ datetimearray dateandtime; /* the date and time */ double seed; /* a seed for a random number generater, made from the date and time written backwards */ getdatetime(dateandtime); fprintf(fout->f, "\nThe date and time is: \n"); writedatetime(fout, dateandtime); fprintf(fout->f, " <- This should be the current time and date.\n"); fprintf(fout->f, "1980/06/09 18:49:11"); fprintf(fout->f, " <- Times and dates should look like this\n"); fprintf(fout->f, "year mo da ho mi se <- with parts in these positions\n\n"); timeseed(&seed); fprintf(fout->f, "A timeseed is %16.14f\n", seed); fprintf(fout->f, "Timeseeds can be used to start random number generators.\n"); } /* demotime */ /* end module demo.time version = 1.15; (@ of timegpc.p 2000 Oct 11 */ /* begin module delilamodules.themain */ Static Void themain() { /* the main procedure of the program */ _TEXT TEMP; printf(" delila modules %4.2f\n", version); if (*book.name != '\0') { if (book.f != NULL) book.f = freopen(book.name, "r", book.f); else book.f = fopen(book.name, "r"); } else rewind(book.f); if (book.f == NULL) _EscIO2(FileNotFound, book.name); RESETBUF(book.f, Char); if (BUFEOF(book.f)) printf( " if you provide delmod with a book, then the nextbase routines will be tested.\n"); else { TEMP.f = stdout; *TEMP.name = '\0'; demonextbase(&book, &TEMP); } TEMP.f = stdout; *TEMP.name = '\0'; demotime(&TEMP); } /* end module delilamodules.themain */ main(argc, argv) int argc; Char *argv[]; { PASCAL_MAIN(argc, argv); if (setjmp(_JL1)) goto _L1; book.f = NULL; strcpy(book.name, "book"); themain(); _L1: if (book.f != NULL) fclose(book.f); exit(EXIT_SUCCESS); } /* delmod */ /* End. */