├── .gitignore ├── README.md ├── original ├── Pascal-F Verifer 1986.sit └── README.md └── src ├── CPC1 ├── BUGS ├── ERMSG-TXT ├── P1X-CMP.p ├── P1X-CMP00.i ├── P1X-CMP03.i ├── P1X-PAS00.i ├── P1X-PAS01.i ├── P1X-PAS02.i ├── P1X-PAS03.i ├── P1X-PAS04.i ├── P1X-PAS05.i ├── P1X-PAS06.i ├── P1X-PAS07.i ├── P1X-PAS08.i ├── P1X-PAS09.i ├── P1X-PAS10.i ├── P1X-PAS11.i ├── P1X-PAS12.i ├── P1X-PAS13.i ├── P1X-PAS14.i ├── P1X-UNIX00.i ├── P1X-UNIX01.i ├── P1X-UNIX02.i ├── P1X-UNIX03.i ├── P1X-VER.p ├── P1X-VER00.h ├── P1X-VER00.i ├── P1X-VER01.h ├── P1X-VER02.i ├── P1X-VER03.i ├── P1X-VER05.i ├── P1X-VER07.i ├── README ├── TODO.txt ├── analyzer1.p ├── datprint.p ├── intprint.p ├── makefile └── varprint.p ├── CPC2 ├── BUGS ├── finddiag.sh ├── makefile ├── mergemsgs ├── p2.p ├── p2alias.i ├── p2augment.i ├── p2block.i ├── p2bound.i ├── p2build.i ├── p2call.i ├── p2case.i ├── p2consts.i ├── p2defs.i ├── p2dummies.i ├── p2dump.i ├── p2enforce.i ├── p2errors.i ├── p2errtext ├── p2expr.i ├── p2icall.i ├── p2iconst.h ├── p2jcommon.i ├── p2jgen.i ├── p2junit.i ├── p2jvars.i ├── p2loop.i ├── p2looper.i ├── p2main.i ├── p2rdata.i ├── p2recurse.i ├── p2routine.i ├── p2select.i ├── p2setused.i ├── p2spec.i ├── p2stmt.i ├── p2tables.i ├── p2tprint.i ├── p2trinvar.i ├── p2trmain.i ├── p2trshare.i ├── p2trutil.i ├── p2trvar.i ├── p2util.i ├── p2varfile.i ├── p2vars.i ├── p2wait.i ├── source.h ├── source.p └── sourcetest.p ├── CPC3 ├── PIPEIN.c ├── PIPEOUT.c ├── README ├── changed.p ├── charin.p ├── direct.c ├── env.p ├── error.p ├── finish.p ├── global.h ├── init.p ├── jsort.h ├── jsort.p ├── main.p ├── makefile ├── output.p ├── parse.p ├── pascaliodefs.h ├── path.p ├── string.p ├── table.p └── unixio.c ├── CPC4 ├── TODO.txt ├── autosimp.lisp ├── builtin.lisp ├── ccvms.sh ├── clispcompat.lisp ├── comp.lisp ├── compile.lisp ├── debug.lisp ├── defmac.lisp ├── diffs.lisp ├── divmod.lisp ├── dosimp.lisp ├── e.lisp ├── eform.lisp ├── enode.lisp ├── eventtran.lisp ├── fixes.lisp ├── generic.lisp ├── hunkshell.lisp ├── macros.lisp ├── main.lisp ├── makefile ├── makemono.lisp ├── makex.lisp ├── map.lisp ├── match.lisp ├── need.lisp ├── newsimp.lisp ├── newsplit.lisp ├── normalize.lisp ├── pform.lisp ├── pipeopen.c ├── pp.lisp ├── princ.lisp ├── print.lisp ├── progvn.lisp ├── putrules ├── rule.lisp ├── ruleprep.lisp ├── setup.lisp ├── simp.lisp ├── syssem.lisp ├── tests.lisp ├── timer.lisp ├── traceaids.lisp ├── type.lisp ├── typee.lisp ├── types.lisp ├── z.lisp └── ze.lisp ├── CPC5 ├── getrules.c ├── getrules.p ├── jcode.y ├── jexample ├── jsort.sh ├── jver.c ├── lex.c ├── main.c ├── makefile ├── pasver.sh ├── putrules.sh └── ver1.sh ├── CPC6 ├── makefile ├── mkrulebld.l ├── mkveriflib.l └── rulebase ├── Design ├── README.md ├── bold.c ├── cpci1.mm ├── cpci1.pdf ├── cpci2.mm ├── cpci2.pdf ├── cpci3.mm ├── cpci3.pdf ├── cpci4.mm ├── cpci4.pdf ├── cpci5.mm ├── cpci5.pdf ├── cpci6.mm ├── cpci6.pdf ├── icode.mm ├── icode.pdf ├── icodechg.mm ├── icodechg.pdf ├── installbm.mm ├── installbm.pdf ├── intro.mm ├── intro.pdf ├── irdprop.mm ├── irdprop.pdf ├── jcode.mm ├── jcode.pdf ├── jnotes.mm ├── jnotes.pdf ├── jtovc.mm ├── jtovc.pdf ├── makefile ├── makelp ├── pascal-f.y ├── practical.mm ├── practical.pdf ├── restrict.mm ├── restrict.pdf ├── safemulti.mm ├── safemulti.pdf ├── scott.mm └── scott.pdf ├── Examples ├── actuate2.pf ├── actuator.h ├── angle1.pf ├── bubble.pf ├── bufutil.pf ├── circle.pf ├── defnd.pf ├── engine1.pf ├── fibs.pf ├── stacktype.pf ├── stepdrive.pf └── time.pf ├── Manual ├── fixer.sno ├── manpage.m ├── manual00.m ├── manual01.m ├── manual02.m ├── manual10.m ├── manual20.m ├── manual21.m ├── manual30.m ├── manual40.m ├── manual50.m ├── manual51.m ├── manual52.m ├── manual53.m ├── manual60.m ├── manual61.m ├── manual70.m ├── manual71.m ├── manual72.m ├── manual73.m ├── manual80.m ├── manual90.m ├── oldmm.c └── pager.c ├── Test cases ├── README ├── alias1.pf ├── field1.pf ├── function1.pf ├── incdec1.pf ├── null.pf ├── recurse1.pf ├── recurse3.pf ├── skew1.pf ├── specvar1.pf ├── stack.pf ├── value1.pf └── with1.pf ├── Test ├── canonize ├── makefile ├── numberer ├── regress.sh └── testdrive.sh ├── Util ├── casefix.c ├── deltaall ├── execlisp.c ├── exgen.c ├── makefile ├── makelp ├── mergemsgs ├── mktest ├── mkversions ├── mover ├── mvtest ├── picfix.py ├── printlp ├── putundersccs ├── pvmake.sh ├── readable.c ├── regress.sh ├── rerelease ├── rmtest ├── rmunder.c ├── srdiff ├── tcopy.c ├── unpage.c ├── unsent └── vertest.sh └── work ├── README.md ├── temporaryrulebase.lisp └── temporaryrulebaseprooflog.txt /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | *.o 3 | pasf-* 4 | pasv-* 5 | intprint 6 | varprint 7 | analyzer1 8 | pascmp 9 | pasver1 10 | errs 11 | src/bin 12 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # pasv 2 | The Pascal-F Verifier 3 | 4 | The Pascal-F Veriifer is an early proof-of-correctness system. 5 | It was developed between 1982 and 1985 and works on a dialect 6 | of Pascal used for real-time programming. 7 | 8 | It ran on UNIX 4.x BSD on early VAX and Sun systems in the 1980s. 9 | The plan is to bring it back to life as a milestone in the history 10 | of program verification. 11 | 12 | The manual is here: 13 | 14 | http://www.animats.com/papers/verifier/verifiermanual.pdf 15 | 16 | ## Current status (1 FEB 2017) 17 | 18 | ### Pass one (CPC1) 19 | Converted to Free Pascal and working. 20 | 21 | ### Pass two (CPC2) 22 | 23 | Converted to Free Pascal and working. 24 | 25 | ### Pass 3, Pascal part (CPC3) 26 | 27 | Conversion not started. This program runs the LISP theorem prover 28 | in a subprocess, so the theorem prover is being converted first. 29 | 30 | ### Pass 3, theorem prover in LISP (CPC4) 31 | 32 | Partially converted to GNU Common LISP. The built-in theories of the Oppen-Nelson simplifier 33 | appear to be working, but added rewrite rules are not working yet. 34 | 35 | ## Original copyright notice 36 | 37 | Permission is hereby given to modify or use, but not for profit, 38 | any or all of this program provided that this copyright notice 39 | is included: 40 | 41 | Copyright 1985 42 | 43 | Ford Motor Company 44 | 45 | The American Road 46 | 47 | Dearborn, Michigan 48121 48 | 49 | This work was supported by the Long Range Research Program of 50 | the Ford Motor Company, and was carried out at Ford Scientific 51 | Research Labs in Dearborn, Michigan and Ford Aerospace and 52 | Communications Corporation's Western Development Laboratories 53 | in Palo Alto, California. 54 | -------------------------------------------------------------------------------- /original/Pascal-F Verifer 1986.sit: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/John-Nagle/pasv/04fa44aaabc46b2e231ab83f96b8857dc5977754/original/Pascal-F Verifer 1986.sit -------------------------------------------------------------------------------- /original/README.md: -------------------------------------------------------------------------------- 1 | # Original sources 2 | These are the original sources for the Pascal-F verifier, 3 | as stored in 1986. The file is in Macintosh Stuffit format. 4 | It can be unpacked under Linux with the "unar" program. 5 | -------------------------------------------------------------------------------- /src/CPC1/BUGS: -------------------------------------------------------------------------------- 1 | 1. Offsets of fields of packed records are all zero. [FIXED] 2 | 2. Sizes of fields of packed records are rounded up to byte sizes [FIXED] 3 | 3. Sizes of array items are counts of elements, not numbers of bits. [FIXED] 4 | 4. "packed" applied to arrays seems to do nothing. [FRL TO FIX] 5 | 5. Variant records are not represented in the varfile. 6 | 6. Unpacked record as component of packed type may not work. [APPEARS OK] 7 | 7. Sets with base types not starting at 0 mishandled in expressions.[DISABLED] 8 | 8. PROOF/EXTRA code turnoff is not fully implemented [FIXED] 9 | 9. Assertion failure for WITH [FIXED] 10 | 10. Pointer out of range for structured constants. [FIXED] 11 | 11. Semicolon not allowed after last INVARIANT [FIXED] 12 | 12. Overly long identifiers are not detected. [FIXED] 13 | 13. Code generated by ENTRY, etc. not contiguous with routine block code[FIXED] 14 | 14. Non-interrupt signals are listed as devices in the varfile. [FIXED] 15 | 15. Icode document out of date for ASERT and VDECL operators 16 | 16. Procedure names are null-filled in the varfile [FIXED] 17 | 17. Compiler version calls genline and thus fails [FIXED] 18 | 18. VALUE constants of record form cause compiler blowup 19 | 19. Comment start not illegal in comment 20 | 20. DEFINED of record or array generates icode with wrong size 21 | 21. FOR variable which is procedure param not detected 22 | -------------------------------------------------------------------------------- /src/CPC1/P1X-CMP.p: -------------------------------------------------------------------------------- 1 | {$I P1X-PAS00.i} 2 | {$I P1X-CMP00.i} 3 | {$I P1X-UNIX00.i} 4 | {$I P1X-PAS01.i} 5 | {$I P1X-UNIX01.i} 6 | {$I P1X-PAS02.i} 7 | {$I P1X-UNIX02.i} 8 | {$I P1X-PAS03.i} 9 | {$I P1X-CMP03.i} 10 | {$I P1X-UNIX03.i} 11 | {$I P1X-PAS04.i} 12 | {$I P1X-PAS05.i} 13 | {$I P1X-PAS06.i} 14 | {$I P1X-PAS07.i} 15 | {$I P1X-PAS08.i} 16 | {$I P1X-PAS09.i} 17 | {$I P1X-PAS10.i} 18 | {$I P1X-PAS11.i} 19 | {$I P1X-PAS12.i} 20 | {$I P1X-PAS13.i} 21 | {$I P1X-PAS14.i} 22 | -------------------------------------------------------------------------------- /src/CPC1/P1X-CMP00.i: -------------------------------------------------------------------------------- 1 | { 2 | P1X-CMP00.i 3 | 4 | Compiler-only constants; not part of the Verifier 5 | } 6 | verifier = false; { this is compiler, not verifier } 7 | -------------------------------------------------------------------------------- /src/CPC1/P1X-CMP03.i: -------------------------------------------------------------------------------- 1 | { 2 | Dummy procedures to simulate routines in verifier 3 | 4 | These routines are not called when the program is generated 5 | with verifier=false. 6 | } 7 | procedure varfilegen(dlev: disprange); 8 | begin 9 | assert(false); { unreachable } 10 | end {varfilegen}; 11 | procedure paramfilegen(routine: itp; blktype: unittype); 12 | begin 13 | assert(false); { unreachable } 14 | end {paramfilegen}; 15 | procedure genlineid; 16 | begin 17 | assert(false); { unreachable } 18 | end {genlineid}; 19 | procedure writesrcfile; 20 | begin 21 | assert(false); { unreachable } 22 | end {writesrcfile}; 23 | procedure vinitialize; 24 | begin 25 | assert(false); { unreachable } 26 | end {vinitialize}; 27 | procedure stampid(fp: itp); 28 | begin 29 | assert(false); { unreachable } 30 | end {stampid}; 31 | procedure writefilfile(s: pathname); 32 | begin 33 | assert(false); { unreachable } 34 | end {writefilfile}; 35 | procedure vdataconst(vaddr:longint; vtype:stp; vfile: longint; vline: longint); 36 | begin 37 | assert(false); { unreachable } 38 | end {vdataconst}; 39 | -------------------------------------------------------------------------------- /src/CPC1/P1X-PAS00.i: -------------------------------------------------------------------------------- 1 | { ** add symbol table output to this version ** } 2 | 3 | { ************************************************* 4 | * * 5 | * * 6 | * ENGINE CONTROL ALGORITHM * 7 | * PROGRAMMING LANGUAGE * 8 | * * 9 | * COMPILER - PASS 1 * 10 | * * 11 | * * 12 | ************************************************* } 13 | 14 | { 15 | Permission is hereby given to modify or use, but not for profit, 16 | any or all of this program provided that this copyright notice 17 | is included: 18 | 19 | Copyright 1985 20 | 21 | Ford Motor Company 22 | The American Road 23 | Dearborn, Michigan 48121 24 | 25 | This work was supported by the Long Range Research Program of 26 | the Ford Motor Company, and was carried out at Ford Scientific 27 | Research Labs in Dearborn, Michigan and Ford Aerospace and 28 | Communications Corporation's Western Development Laboratories 29 | in Palo Alto, California. 30 | } 31 | program firstpass(input,output); 32 | Uses sysutils, math; { Free Pascal } 33 | 34 | 35 | 36 | {constants} 37 | {*********} 38 | const 39 | alfaleng = 15; {max length of identifier} 40 | strlen = 80; {max length of string} 41 | strlen1 = 79; 42 | mbuf = 120; {size of source buffer } 43 | compilerversion= 'Pascal-F v 1.8(12/13/82)'; {last modified by NELSON,E. } 44 | { ** THIS VERSION OUTPUTS THE SYMBOL TABLE ** } 45 | { ** Must use IOE4NR, not GTE4NR.REL with this } 46 | 47 | {addressing characteristics} 48 | {**************************} 49 | maxlevel = 15; {maximum lex level} 50 | notyetimpl = 398; {error msg number} 51 | maxdis = 32; {maximum depth of display (lexlev + with)} 52 | maxdis1 = 31; 53 | 54 | nrkeywords = 62; { number of built-in keywords } 55 | kywdlen = 10; {maximum length of a keyword} 56 | 57 | nrbuiltin = 19; {number of builtin procedures and functions} 58 | nrbuiltin1 = 18 ; {nrbuiltin-1} 59 | 60 | 61 | {************TARGET MACHINE DEPENDENT STUFF FOLLOWS:**************} 62 | bitsau = 8; { bits in addressable unit } 63 | auword = 2; { addressable units in a 'preferred' size word } 64 | bitswd = 16 { bitsau*auword}; { bits in a 'preferred' size word } 65 | maxlit = bitswd; { bits in largest literal } 66 | sfdmax = 5; {used by GETF[ get_directory] } 67 | numlimit = 65536; { 2 ** word size of machine } 68 | maxtargint = 32767; { largest signed intgr in target machine} 69 | mintargint = -32768; {smallest signed integer } 70 | 71 | 72 | { the constants minfix, maxfix and stdpcn are } 73 | { used as defaults for error recovery } 74 | maxfix = 32768.0; 75 | minfix = -32768.0; 76 | stdpcn = 1.0; 77 | fixsiz=2; {size of fixed point variable in bytes} 78 | 79 | 80 | maxset = 16; { maximum number of elements in any set } 81 | 82 | 83 | maxprio = 15; {maximum allowed priority level for a monitor} 84 | maxsignal = 127; { max number of signals which can be declared } 85 | 86 | {constants which define error numbers} 87 | {************************************} 88 | fxptsyntx = 60; {incorrect syntax for FIXED declaration} 89 | fxptrange = 61; {invalid range for FIXED type} 90 | fxptprcsn = 62; {invalid precision for FIXED type} 91 | { 92 | Constants for verifier language extensions 93 | } 94 | maxargs = 31; { Max args for any operator } 95 | maxinseq = maxargs; { Max count for any SEQ operator } 96 | illegaladdress = 999999; { used as address of EXTRA vars in compiler } 97 | vmodestackmax = 25; { max depth for calls: f(f(f(f)))) forms } 98 | enforce = true; { if true, verifier restrictions enforced } 99 | vtypeserialmax = 50000; { maximum number of declared types } 100 | -------------------------------------------------------------------------------- /src/CPC1/P1X-UNIX00.i: -------------------------------------------------------------------------------- 1 | { 2 | UNIX constants 3 | } 4 | filestackmax = 10; { maximum include depth } 5 | pathnamemax = 60; { chars in path name } 6 | errortextfile = 'ERMSG-TXT'; { error message text file } 7 | lstfilename = 'pasf-list'; { listing for human } 8 | intfilename = 'pasf-icode'; { icode for verify or compile } 9 | datfilename = 'pasf-data'; { rdata constants } 10 | symfilename = 'pasf-symbols'; { interpreter symbols } 11 | -------------------------------------------------------------------------------- /src/CPC1/P1X-UNIX01.i: -------------------------------------------------------------------------------- 1 | { 2 | UNIX-only type definitions 3 | 4 | Used for both verifier and compiler 5 | } 6 | { 7 | filestate -- state of a source file 8 | } 9 | filestate = (unopened, opened); 10 | { 11 | filename -- name string for a file 12 | } 13 | pathname = array [1..pathnamemax] of char; 14 | { 15 | fileitem -- one for each source file being read 16 | } 17 | fileitem = record 18 | infile: text; { the file itself } 19 | fname: pathname; { file name string } 20 | linenumber: longint; { current position in file } 21 | filenumber: longint; { serial of this file } 22 | state: filestate; { state of this file } 23 | end; 24 | -------------------------------------------------------------------------------- /src/CPC1/P1X-UNIX02.i: -------------------------------------------------------------------------------- 1 | { 2 | UNIX-only variables 3 | 4 | Required for both verifier and compiler 5 | } 6 | filestack: array [1..filestackmax] of fileitem; { stack for include files } 7 | filestackdepth: 0..filestackmax; { depth into above } 8 | fileserial: longint; { serial number of files } 9 | currentarg: longint; { next arg to read on call } 10 | validkeyletters: set of char; { allowed option letters } 11 | -------------------------------------------------------------------------------- /src/CPC1/P1X-VER.p: -------------------------------------------------------------------------------- 1 | {$I P1X-PAS00.i} 2 | {$I P1X-VER00.i} 3 | {$I P1X-UNIX00.i} 4 | {$I P1X-VER00.h} 5 | {$I P1X-PAS01.i} 6 | {$I P1X-UNIX01.i} 7 | {$I P1X-VER01.h} 8 | {$I P1X-PAS02.i} 9 | {$I P1X-UNIX02.i} 10 | {$I P1X-VER02.i} 11 | {$I P1X-PAS03.i} 12 | {$I P1X-UNIX03.i} 13 | {$I P1X-PAS04.i} 14 | {$I P1X-PAS05.i} 15 | {$I P1X-PAS06.i} 16 | {$I P1X-PAS07.i} 17 | {$I P1X-VER07.i} 18 | {$I P1X-PAS08.i} 19 | {$I P1X-PAS09.i} 20 | {$I P1X-PAS10.i} 21 | {$I P1X-PAS11.i} 22 | {$I P1X-PAS12.i} 23 | {$I P1X-PAS13.i} 24 | {$I P1X-PAS14.i} 25 | -------------------------------------------------------------------------------- /src/CPC1/P1X-VER00.h: -------------------------------------------------------------------------------- 1 | { 2 | Constant definitions used by verifier. 3 | 4 | These definitions are part of both pass 1 and pass 2. 5 | } 6 | targetintegermin = -32768; { smallest target machine integer } 7 | targetintegermax = 32767; { largest target machine integer } 8 | { -2**31 to 2**31-1 } 9 | targetnumbermin = -2147483647; { smallest target machine anything } 10 | targetnumbermax = 2147483647; { largest target machine anything } 11 | 12 | precisionmin = -20; { minimum precision value } 13 | precisionmax = 20; { maximum precision value } 14 | addressmin = -524287; { smallest address in bits for 64K } 15 | addressmax = 524288; { largest address } 16 | identifiermax = 15; { max length of identifier } 17 | 18 | blockmax = 10000; { max blocks per program } 19 | symbolmax = 50000; { max symbols per program } 20 | itemmax = 9; { max record depth } 21 | filesmax = 50; { max different source files } 22 | linemax = 30000; { max lines per file } 23 | linetextmax = 120; { max chars per line (=mbuf) } 24 | -------------------------------------------------------------------------------- /src/CPC1/P1X-VER00.i: -------------------------------------------------------------------------------- 1 | { 2 | VER00 -- Verifier-only constants 3 | 4 | not part of the compiler 5 | } 6 | verifier = true; { verifier, not compiler } 7 | -------------------------------------------------------------------------------- /src/CPC1/P1X-VER02.i: -------------------------------------------------------------------------------- 1 | { 2 | VER02 -- verifier variables 3 | } 4 | varfile: file of varitem; { variables file for pass 2 } 5 | srcfile: file of sourceline; { source lines for later passes } 6 | filfile: text; { file of file names read } 7 | srcitem: sourceline; { source line for source file } 8 | srcserial: longint; { ties source lines to icode } 9 | { 10 | Verifier data initialization procedures 11 | } 12 | procedure vinitialize; 13 | begin 14 | assign(varfile,'pasf-vars'); 15 | rewrite(varfile); { ***TEMP*** } 16 | assign(srcfile,'pasf-source'); 17 | rewrite(srcfile); { ***TEMP*** } 18 | assign(filfile,'pasf-files'); 19 | rewrite(filfile); { ***TEMP*** } 20 | srcserial := 0; { at line zero in file } 21 | end {vinitialize}; 22 | { 23 | stampid -- stamp ident with line number 24 | } 25 | procedure stampid(fp: itp); { pointer to id to stamp } 26 | begin 27 | with fp^ do begin { using id node } 28 | fileser := lastfilenumber; { later emitted to varfile } 29 | lineser := lastlinenumber; { later emitted to varfile } 30 | end; 31 | end {stampid}; 32 | { 33 | writesrcfile -- generate source-line file 34 | 35 | This file is used for the generation of error messages by 36 | later passes of the Verifier. 37 | } 38 | procedure writesrcfile; 39 | begin 40 | srcserial := srcserial + 1; { increment line in file } 41 | srcitem.lineid.linenumber := lastlinenumber; { within-file number } 42 | srcitem.lineid.filenumber := lastfilenumber; { file serial } 43 | srcitem.linetext := bline; { move line to buffer } 44 | write(srcfile,srcitem); { write source line for pass 2} 45 | end {writesrcfile}; 46 | { 47 | writefilfile -- generate file of file names 48 | 49 | This file is used to identify the file numbers used in the source 50 | line file. 51 | } 52 | procedure writefilfile(s: pathname); { file path name } 53 | begin 54 | writeln(filfile, s); { write file name to file } 55 | end {writefilfile}; 56 | -------------------------------------------------------------------------------- /src/CPC1/P1X-VER03.i: -------------------------------------------------------------------------------- 1 | 2 | -------------------------------------------------------------------------------- /src/CPC1/P1X-VER05.i: -------------------------------------------------------------------------------- 1 | { MOVED TO VER06 } 2 | -------------------------------------------------------------------------------- /src/CPC1/README: -------------------------------------------------------------------------------- 1 | This is Pass 1 of the Pascal-F Verifier. It is compiled as one giant compile 2 | and takes some time to compile on a SUN. 3 | -------------------------------------------------------------------------------- /src/CPC1/TODO.txt: -------------------------------------------------------------------------------- 1 | TODO (2017) for CPC1 2 | 3 | 1. Make "intprint" recognize stnbr and block items, at least. 4 | -------------------------------------------------------------------------------- /src/CPC1/datprint.p: -------------------------------------------------------------------------------- 1 | { 2 | datprint -- print constant data file from pass one of 3 | Pascal-F compiler. 4 | } 5 | program datprint(output); 6 | const datname = 'pasf-data'; { file name to read } 7 | var i,n: integer; { address and data } 8 | dat: file of integer; { file to read } 9 | begin 10 | n := 0; { clear byte counter } 11 | reset(dat, datname); { open input file } 12 | while not eof(dat) do begin { for all records } 13 | read(dat,n); { read item } 14 | writeln(i:8,'.',n:8); { address and value } 15 | i := i + 1; { count bytes } 16 | end; 17 | end. 18 | 19 | -------------------------------------------------------------------------------- /src/CPC1/makefile: -------------------------------------------------------------------------------- 1 | # Makefile for verifier pass one 2 | # 3 | # Version 1.6 of 2/6/86 4 | # Revised January 2017 for Free Pascal 5 | # 6 | SOURCE=.. 7 | DEST=../bin 8 | PASS1=$(SOURCE)/cpc1/src 9 | POPTIONS=-gl -Co -Cr 10 | # 11 | # make with no arguments makes pasver1. 12 | # make install makes and installs pasver1 13 | # make all makes pasver1 and testtools 14 | # 15 | default: pasver1 16 | # 17 | # install pasver1 in DEST 18 | # 19 | install: pasver1 20 | -rm -f $(DEST)/pasver1.old 21 | -mv $(DEST)/pasver1 $(DEST)/pasver1.old 22 | ln pasver1 $(DEST) 23 | # 24 | # make everything including test tools 25 | # 26 | all: pasver1 pascmp analyzer1 varprint intprint 27 | # 28 | # Verifier Pass One 29 | # 30 | pasver1: P1X-VER.p P1X-PAS00.i P1X-VER00.i P1X-UNIX00.i P1X-VER00.h \ 31 | P1X-PAS01.i P1X-UNIX01.i P1X-VER01.h P1X-PAS02.i P1X-UNIX02.i \ 32 | P1X-VER02.i P1X-PAS03.i P1X-UNIX03.i P1X-PAS04.i P1X-PAS05.i \ 33 | P1X-PAS06.i P1X-VER07.i P1X-PAS07.i P1X-PAS08.i P1X-PAS09.i \ 34 | P1X-PAS10.i P1X-PAS11.i P1X-PAS12.i P1X-PAS13.i P1X-PAS14.i 35 | fpc $(POPTIONS) P1X-VER.p | tee errs 36 | rm -f pasver1 37 | mv P1X-VER pasver1 38 | chmod 555 pasver1 39 | # 40 | # Compiler Pass One 41 | # 42 | pascmp: P1X-CMP.p \ 43 | P1X-PAS00.i P1X-CMP00.i P1X-UNIX00.i P1X-PAS01.i P1X-UNIX01.i \ 44 | P1X-PAS02.i P1X-UNIX02.i P1X-PAS03.i P1X-CMP03.i P1X-UNIX03.i \ 45 | P1X-PAS04.i P1X-PAS05.i P1X-PAS06.i P1X-PAS07.i P1X-PAS08.i \ 46 | P1X-PAS09.i P1X-PAS10.i P1X-PAS11.i P1X-PAS12.i P1X-PAS13.i P1X-PAS14.i 47 | fpc $(POPTIONS) P1X-CMP.p | tee errs 48 | rm -f pascmp 49 | mv P1X-CMP pascmp 50 | chmod 555 pascmp 51 | # 52 | # Verifier Pass One Output Analyzer 53 | # 54 | analyzer1: analyzer1.p P1X-VER00.h P1X-VER01.h 55 | rm -f analyzer1 56 | fpc $(POPTIONS) analyzer1.p | tee errs 57 | chmod 555 analyzer1 58 | # 59 | # Compiler Icode Printer 60 | # 61 | intprint: intprint.p 62 | rm -f intprint 63 | fpc $(POPTIONS) intprint.p | tee errs 64 | chmod 555 intprint 65 | # 66 | # Verifier Dictionary Printer 67 | # 68 | varprint: varprint.p P1X-VER00.h P1X-VER01.h 69 | rm -f varprint 70 | fpc $(POPTIONS) varprint.p | tee errs 71 | chmod 555 varprint 72 | 73 | # 74 | # Everything Maker 75 | # 76 | all: pasver1 pascmp analyzer1 intprint varprint 77 | -------------------------------------------------------------------------------- /src/CPC1/varprint.p: -------------------------------------------------------------------------------- 1 | { 2 | printvars -- print variable item file produced by 3 | Verifier pass 1. 4 | } 5 | program printvars(output); 6 | const 7 | {$I P1X-VER00.h} 8 | type 9 | {$I P1X-VER01.h} 10 | var 11 | f: file of varitem; { input file } 12 | vitem: varitem; { working item } 13 | begin 14 | assign(f,'pasf-vars'); 15 | reset(f); { get file } 16 | while not eof(f) do begin { until eof } 17 | read(f,vitem); { read one item } 18 | { ***DEBUG VERSION*** } 19 | write( 20 | ' ':vitem.itemdepth,' ':vitem.itemdepth, { indentation } 21 | vitem.itemdepth:2, ' ',vitem.itemname, 22 | ' {', 23 | vitem.vrsource.filenumber:1, ':', vitem.vrsource.linenumber:1, 24 | '}', { line number } 25 | ' (',vitem.loc.relocation:1); 26 | if vitem.loc.relocation in [stackaddr, paramaddr, routineaddr] then 27 | write('[',vitem.loc.blockn:1,']'); 28 | write(',',vitem.loc.address:1,': ',vitem.size:1,' bits) '); 29 | if vitem.form in [numericdata, arraydata, setdata] then begin 30 | write(vitem.minvalue:1,'..',vitem.maxvalue:1); 31 | if vitem.scale <> 0 then write('/',vitem.scale:1); 32 | write(' '); 33 | end; 34 | if vitem.recordname[1] <> ' ' then write(vitem.recordname,' '); 35 | if vitem.recordnum <> 0 then write('(#',vitem.recordnum:1,') '); 36 | if vitem.form <> numericdata then write(vitem.form,' '); 37 | if vitem.by <> bynothing then write(vitem.by); 38 | writeln; 39 | end; 40 | end. 41 | -------------------------------------------------------------------------------- /src/CPC2/BUGS: -------------------------------------------------------------------------------- 1 | 1. Miscinfo is not placed in tree item [FIXED] 2 | 2. 'fxlt' is duplicated in intprint name table [FIXED] 3 | 3. Addresses of refer are not converted to bits [FIXED] 4 | 4. At 15 procedures, programunittype will overflow. [FIXED] 5 | 5. VALUE clause unimplemented in varfile (pass 1) [FIXED] 6 | 6. At 31 statements in a block, arg array in node will overflow 7 | 7. param addressing for VAR arguments is totally incorrect [FIXED] 8 | 8. Trouble with record where first elt is array [FIXED] 9 | 9. Non-callable routines get internal error [FIXED] 10 | 10. Anonomous types cause assertion failure [FIXED] 11 | 11. Need name entries in varfile for modules, main programs. [FIXED] 12 | 12. WITH of record with 1 entry causes type clash error msg [FIXED] 13 | 13. FORWARD declarations throw block count off 14 | 14. Unset var errors appear for VALUE variables and hardware [FIXED] 15 | 15. new! / defined! args to genjexpr are ignored [FIXED] 16 | 16. On structure component assignment, entire struct "defined!" [FIXED] 17 | 17. Generates long-case defined! expressions for param defined [FIXED] 18 | 18. Incorrect Jcode for x.old in entry/exit for callee [FIXED] 19 | 19. Pass I should check for missing } in comments. [FIXED] 20 | 20. Illegal vars in entry/exit declarations not caught [FIXED] 21 | 21. x.old and x should be synonomous when x does not change [NO] 22 | 22. Type associated with REFER is not from object referred to [FIXED] 23 | 23. Field names in (selectr!.. ) should not be decorated [FIXED] 24 | 24. Need unique name generation for type names in pass 1 [FIXED] 25 | 25. movem operator size field is incorrectly interpreted [FIXED] 26 | 26. defnd operator size field is misinterpreted 27 | 27. Subscripts in selectors passed by VAR should be .old values [FIXED] 28 | 28. Anonomous record types cause assertion failure [FIXED] 29 | 29. FOR loop exit condition may not match implementation 30 | 30. Still have problems with record with one field at calls. 31 | 31. Loop operator jcode template is incorrect [FIXED] 32 | 32. Invariant scope detection is too restrictive [FIXED] 33 | 33. Side effect detection is overly restrictive 34 | 34. Diagnostic for use of wrong kind of fn in assertion is poor [FIXED] 35 | 35. Dominator routine used too early, from noteref in pass 2a. [FIXED] 36 | 36. INIT of module from non-main-program fails [FIXED] 37 | 37. LOOP operator Jcode is unsound [FIXED] 38 | 38. Producing type of rule function in type info is unsound [FIXED] 39 | 39. New form array replacement definedness must be generated [FIXED] 40 | 40. Signal implementation is incompatible with new pass 1. [FIXED] 41 | 41. Jcode for SUMMARY does not include NEW. 42 | -------------------------------------------------------------------------------- /src/CPC2/finddiag.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | # 3 | # Diagnostic Extractor 4 | # 5 | # Finds calls to "badnode" and "internalerror" in pass 2 of 6 | # the verifier and constructs a file of the numbers and the 7 | # associated comments. 8 | # Version 1.5 of 1/14/83 9 | # 10 | rm -f FINDBAD? 11 | cat $* | grep "badnode *(" > FINDBAD1 12 | cat $* | grep "internalerror *(" >> FINDBAD1 13 | # Extract calls to internalerror and badnode with comments 14 | cat FINDBAD1 | sed \ 15 | -e "s/.*internalerror *(//" \ 16 | -e "s/.*badnode *(.*, *\([0123456789][0123456789]* *\))/\1)/" \ 17 | -e "s/)[; ]*{ */ /" \ 18 | -e "s/[} ]*$//" > FINDBAD2 19 | # Sort into numeric order 20 | grep "^[0123456789]" FINDBAD2 | sort -n | uniq > FINDBAD3 21 | # Remove duplicates by number for misuse of number check 22 | sort -n -u FINDBAD3 > FINDBAD4 23 | # Locate duplicate numbers 24 | if cmp FINDBAD3 FINDBAD4 25 | then : 26 | else echo "finddiag: SAME ERROR NUMBER USED TWICE" >&2 27 | diff FINDBAD3 FINDBAD4 28 | fi 29 | cat FINDBAD3 30 | 31 | -------------------------------------------------------------------------------- /src/CPC2/makefile: -------------------------------------------------------------------------------- 1 | 2 | # 3 | # Makefile for Verifier pass two 4 | # 5 | # Version 1.31 of 2/6/86 6 | # Revised for Free Pascal in 2017. 7 | # 8 | DEST=../bin 9 | SOURCE=.. 10 | PASS1=$(SOURCE)/CPC1 11 | PASS2=$(SOURCE)/CPC2 12 | POPTIONS=-gl -Co -Cr 13 | # 14 | # make with no arguments makes pasver2 15 | # make install makes and installs pasver2 16 | # make all is equivalent to make 17 | # 18 | all: pasver2 19 | # 20 | # install pasver2 in DEST 21 | # 22 | install: pasver2 23 | -rm -f $(DEST)/pasver2.old 24 | -mv $(DEST)/pasver2 $(DEST)/pasver2.old 25 | cp pasver2 $(DEST)/pasver2 26 | # 27 | P2SRC=p2consts.i p2iconst.h $(PASS1)/P1X-VER00.h $(PASS1)/P1X-VER01.h p2defs.i p2vars.i \ 28 | p2tables.i p2tprint.i p2errors.i p2util.i p2block.i p2varfile.i \ 29 | p2enforce.i p2build.i p2augment.i p2jgen.i p2jvars.i \ 30 | p2select.i p2bound.i p2call.i p2expr.i p2stmt.i p2junit.i \ 31 | p2rdata.i p2loop.i p2routine.i p2dump.i p2alias.i p2spec.i \ 32 | p2trmain.i p2trutil.i p2trinvar.i p2trvar.i \ 33 | p2case.i p2wait.i p2icall.i p2jcommon.i p2recurse.i \ 34 | p2trshare.i p2main.i p2.p 35 | # 36 | pasver2: $(P2SRC) 37 | rm -f pasver2 38 | fpc $(POPTIONS) p2.p | tee errs 39 | mv p2 pasver2 40 | chmod 555 pasver2 41 | # 42 | # 43 | # Utility programs -- not part of pasver2 proper 44 | # 45 | # 46 | # Mergemsgs -- merges messages from REQUIREs with source 47 | # 48 | mergemsgs: $(PASS2)/s.mergemsgs 49 | get $(PASS2)/s.mergemsgs 50 | chmod 755 mergemsgs 51 | # 52 | # Finddiag -- finds all internal error msgs and makes doc 53 | # 54 | finddiag: $(PASS2)/s.finddiag.sh 55 | get $(PASS2)/s.finddiag.sh 56 | rm -f finddiag 57 | mv finddiag.sh finddiag 58 | chmod 555 finddiag 59 | # 60 | internalerrs.m: $(P2SRC) finddiag 61 | cat $(P2SRC) | finddiag > internalerrs.m 62 | -------------------------------------------------------------------------------- /src/CPC2/mergemsgs: -------------------------------------------------------------------------------- 1 | 2 | # Message merge merges messages found in jcode with given source 3 | # 4 | # Usage is mergemsgs source jcode 5 | # 6 | # Version 1.9 of 4/2/82 7 | # 8 | grep "(\/" ${2} | sed -e "s/^.*(\/ //" -e "s/\/).*$//" -e "s/^{[a-zA-Z0-9\-]*\.pf:/ /" -e "s/}/.1 | /" > MSGS 9 | awk '{printf("%4d. %s\n", 1+(n++), $0 ); }' ${1} > SOURCE 10 | cat SOURCE MSGS | sort -n | sed -e "s/^.*\.1 | / /" 11 | -------------------------------------------------------------------------------- /src/CPC2/p2.p: -------------------------------------------------------------------------------- 1 | { ************************************************* 2 | * * 3 | * * 4 | * The Pascal-F Verifier * 5 | * * 6 | * DECOMPILER - PASS 2 * 7 | * * 8 | * * 9 | ************************************************* } 10 | 11 | { 12 | Permission is hereby given to modify or use, but not for profit, 13 | any or all of this program provided that this copyright notice 14 | is included: 15 | 16 | Copyright 1985 17 | 18 | Ford Motor Company 19 | The American Road 20 | Dearborn, Michigan 48121 21 | 22 | This work was supported by the Long Range Research Program of 23 | the Ford Motor Company, and was carried out at Ford Scientific 24 | Research Labs in Dearborn, Michigan and Ford Aerospace and 25 | Communications Corporation's Western Development Laboratories 26 | in Palo Alto, California. 27 | } 28 | {$MODESWITCH NESTEDPROCVARS} 29 | {$I p2consts.i} 30 | {$I p2iconst.h} 31 | {$I ../CPC1/P1X-VER00.h} 32 | type 33 | {$I ../CPC1/P1X-VER01.h} 34 | {$I p2defs.i} 35 | {$I p2vars.i} 36 | {$I p2tables.i} 37 | {$I p2tprint.i} 38 | {$I p2errors.i} 39 | {$I p2util.i} 40 | {$I p2dump.i} 41 | {$I p2varfile.i} 42 | {$I p2block.i} 43 | {$I p2enforce.i} 44 | {$I p2build.i} 45 | {$I p2augment.i} 46 | {$I p2spec.i} 47 | {$I p2trutil.i} 48 | {$I p2trvar.i} 49 | {$I p2trinvar.i} 50 | {$I p2trshare.i} 51 | {$I p2trmain.i} 52 | {$I p2jgen.i} 53 | {$I p2rdata.i} 54 | {$I p2jvars.i} 55 | {$I p2select.i} 56 | {$I p2jcommon.i} 57 | {$I p2bound.i} 58 | {$I p2alias.i} 59 | {$I p2routine.i} 60 | {$I p2recurse.i} 61 | {$I p2call.i} 62 | {$I p2icall.i} 63 | {$I p2expr.i} 64 | {$I p2case.i} 65 | {$I p2wait.i} 66 | {$I p2loop.i} 67 | {$I p2stmt.i} 68 | {$I p2junit.i} 69 | {$I p2main.i} 70 | -------------------------------------------------------------------------------- /src/CPC2/p2consts.i: -------------------------------------------------------------------------------- 1 | { ************************************************* 2 | * * 3 | * * 4 | * ENGINE CONTROL ALGORITHM * 5 | * PROGRAMMING LANGUAGE * 6 | * * 7 | * VERIFIER - PASS 2 * 8 | * * 9 | * * 10 | ************************************************** } 11 | 12 | 13 | program passtwo(output); 14 | uses sysutils; { for Free Pascal } 15 | const 16 | compilerversion = 'Pascal-F version xxx on 4/13/1981'; {last modified by NELSON E. } 17 | { 18 | Table sizing constants 19 | } 20 | maxarg=31; { max args for any icode op } 21 | maxlexlev = 15; { maximum lexical nesting depth } 22 | maxcalldepth = 25; { a calls b calls c ... limit } 23 | maxselstack = 15; { a.b.c[e].f ... limit } 24 | maxsubstack = 100; { max args to routine, incl. globals } 25 | maxrecordtypes = 250; { max record types per junit } 26 | maxfilepath = 60; { max chars in file pathname } 27 | maxtempid = 10000; { max TEMPnn per junit } 28 | maxlabelid = 10000; { max labels per junit } 29 | maxtimestamp = 25000; { max time ticks per verification } 30 | maxpin = 1000; { max junits } 31 | { 32 | derived sizes 33 | } 34 | blockdepthmax = maxlexlev; { size of block stack } 35 | scopedepthmax = maxlexlev; { size of scope stack } 36 | oldargsmax = maxsubstack; { size of old args table } 37 | temptabmax = maxsubstack; { size of TEMPs usage table } 38 | subconstmax = maxselstack; { size of constant subscript table } 39 | recindexmax = maxrecordtypes; { size of record index table } 40 | { 41 | Types of program units 42 | } 43 | mainprogunit = 0; { main program } 44 | procunit = 1; { non-exported procedure/function } 45 | exportedprocunit = 2; { exported procedure/function } 46 | moduleunit = 3; { module } 47 | monitorunit = 4; { monitor } 48 | unittypemax = 4; { max of this type } 49 | { 50 | Load types 51 | } 52 | internalload = 0; { local to this compilation } 53 | externalload = 1; { non-local } 54 | loadtypemax = 1; { max of this type } 55 | 56 | {machine dependent data structure parameters:} 57 | bytesize = 8; 58 | wordsize = 16; 59 | numlimit = 65536; { 2 ** wordsize of machine. - for forming complements} 60 | bitaddressmax = 524287; { maximum address in bits } 61 | bitsperadrunit = 8; { bits per addressing unit (byte) } 62 | rtempmax = 10; { max nesting depth for with statements } 63 | { 64 | Misc. constants 65 | } 66 | minchar = #0; { for Free Pascal } 67 | NUL = minchar; { ASCII } 68 | tempstring1 = 'TEMP'; { base of dummy names } 69 | tempstring2 = '~~'; { tail of dummy name } 70 | nulltid = 0; { null temp id } 71 | { constants of type priority } 72 | maxpriority = 7; { highest priority value } 73 | nopriority = -1; { if priority irrelevant } 74 | backgroundpriority = 0; { background task } 75 | unknownpriority = -2; { no priority known yet } 76 | { constants of type sharedinfo } 77 | unknownshared = -2; { no sharing info yet } 78 | isshared = -1; { definitely shared variable } 79 | { 80 | Jcode formatting constants 81 | } 82 | jlinelengthmax = 1000; { absolute maximum line length } 83 | jlinelengthbreak = 64; { beyond here break if possible} 84 | jlineindent = 8; { indent for continuations } 85 | jlinecomment = 40; { indent for comments } 86 | -------------------------------------------------------------------------------- /src/CPC2/p2dummies.i: -------------------------------------------------------------------------------- 1 | procedure WHATdummies; const WHAT = '@(#)p2dummies.i 2.1'; begin SINK := WHAT; end; { Version 2.1 of 10/12/82 } 2 | { 3 | Dummy Code to make Berkeley Pascal Compiler happy 4 | } 5 | procedure initdummy; { totally useless procedure } 6 | { 7 | dummy1 -- never-called procedure for unneeded code 8 | } 9 | procedure dummy1; { never called } 10 | begin 11 | { 12 | Code to call procedures which exist solely to provide a place 13 | to put WHAT strings. 14 | } 15 | WHATalias; 16 | WHATblock; 17 | WHATbound; 18 | WHATbuild; 19 | WHATcall; 20 | WHATdump; 21 | WHATexpr; 22 | WHATjgen; 23 | WHATjunit; 24 | WHATjvars; 25 | WHATmain; 26 | WHATselect; 27 | WHATsetused; 28 | WHATstmt; 29 | WHATtables; 30 | WHATtprint; 31 | WHATutil; 32 | WHATvarfile; 33 | { 34 | Code to reference objects read or written with file I/O, for 35 | which compiler generates spurious "field not referenced" messages. 36 | } 37 | end {dummy1}; 38 | begin {initdummy}; 39 | zzz := 1; 40 | if zzz = 0 then dummy1; { never executed but generated } 41 | end {initdummy}; 42 | -------------------------------------------------------------------------------- /src/CPC2/p2errtext: -------------------------------------------------------------------------------- 1 | 1 INTERNAL COMPILER OR VERIFIER ERROR: icode argument stack underflow 2 | 2 TABLE OVERFLOW: icode argument stack overflow 3 | 6 INTERNAL COMPILER OR VERIFIER ERROR: scope number tally is off 4 | 7 INTERNAL COMPILER OR VERIFIER ERROR: block stack is off 5 | 9 INTERNAL COMPILER OR VERIFIER ERROR: floating point unimplemented 6 | 10 INTERNAL VERIFIER ERROR: icode node allocation error 7 | 11 INTERNAL COMPILER OR VERIFIER ERROR: varfile format error - (depth) 8 | 12 MACHINE ADDRESS RECOGNITION ERROR: variable address lookup failed 9 | 13 MACHINE ADDRESS RECOGNITION ERROR: field address lookup failed 10 | 14 VARIABLE OVERLAP ERROR: variables overlap in memory 11 | 15 INTERNAL VERIFIER ERROR: arg count table bad 12 | 21 TABLE OVERFLOW: "scopedepthmax" limit exceeded 13 | 22 INTERNAL COMPILER OR VERIFIER ERROR: extra END in icode 14 | 23 INTERNAL COMPILER OR VERIFIER ERROR: scope in address out of range 15 | 31 INTERNAL COMPILER OR VERIFIER ERROR: unimplemented icode op 16 | 33 INTERNAL VERIFIER ERROR: arg count wrong in tables 17 | 34 MACHINE ADDRESS RECOGNITION ERROR: no relevant array at given address 18 | 36 INTERNAL TYPE CHECKING ERROR: do not know type of index object 19 | 37 MACHINE ADDRESS RECOGNITION ERROR: cannot find relevant array 20 | 38 INTERNAL TYPE CHECKING ERROR: node not properly typed 21 | 39 TABLE OVERFLOW: "rtempmax" limit exceeded 22 | 40 MACHINE ADDRESS RECOGNITION ERROR: cannot find associated WITH 23 | 41 INTERNAL COMPILER OR VERIFIER ERROR: bad non-value 24 | 42 INTERNAL TYPE CHECKING ERROR: machine type clash 25 | 43 TABLE OVERFLOW: "rtempmax" limit exceeded 26 | 44 MACHINE ADDRESS RECOGNITION ERROR: routine unidentified 27 | 45 CALL ERROR: call to non-routine 28 | 46 CALL ERROR: too many arguments in call 29 | 47 CALL ERROR: too few arguments in call 30 | 48 MACHINE ADDRESS RECOGNITION ERROR: expected pointerdata 31 | 49 INTERNAL COMPILER OR VERIFIER ERROR: need val, have stmt 32 | 50 INTERNAL COMPILER OR VERIFIER ERROR: not pointer at ref arg 33 | 51 INTERNAL COMPILER OR VERIFIER ERROR: literal too big 34 | 52 INTERNAL COMPILER OR VERIFIER ERROR: literal too small 35 | 53 INTERNAL COMPILER OR VERIFIER ERROR: ref arg not passed by ref 36 | 54 INTERNAL COMPILER OR VERIFIER ERROR: literal 0 when disallowed 37 | 55 MACHINE ADDRESS RECOGNITION ERROR: "data" ambiguous 38 | 56 MACHINE ADDRESS RECOGNITION ERROR: address lookup fail 39 | 57 MACHINE ADDRESS RECOGNITION ERROR: address/size lookup fail 40 | 70 INTERNAL TYPE CHECKING ERROR: first var nil 41 | 71 INTERNAL TYPE CHECKING ERROR: second var nil 42 | 72 INTERNAL TYPE CHECKING ERROR: only one has child 43 | 73 INTERNAL TYPE CHECKING ERROR: only one has sibling 44 | 75 INTERNAL TYPE CHECKING ERROR: type clash (form) 45 | 76 INTERNAL TYPE CHECKING ERROR: type clash (size) 46 | 77 INTERNAL TYPE CHECKING ERROR: type clash (scale) 47 | 78 INTERNAL TYPE CHECKING ERROR: type clash (min value) 48 | 79 INTERNAL TYPE CHECKING ERROR: type clash (max value) 49 | 81 INTERNAL TYPE CHECKING ERROR: bound clash (max value) 50 | 101 UNIMPLEMENTED 51 | 102 INTERNAL COMPILER OR VERIFIER ERROR: non-statement misplaced 52 | 103 INTERNAL COMPILER OR VERIFIER ERROR: expected VDECL 53 | 104 INTERNAL VERIFIER ERROR: report 54 | 106 INTERNAL COMPILER OR VERIFIER ERROR: not SEQ or VDECL 55 | 118 INTERNAL COMPILER OR VERIFIER ERROR: no higher node 56 | 119 INTERNAL COMPILER OR VERIFIER ERROR: not record 57 | -------------------------------------------------------------------------------- /src/CPC2/p2icall.i: -------------------------------------------------------------------------------- 1 | procedure WHATicall; const WHAT = '@(#)p2icall.i 2.1'; begin SINK := WHAT; end; { Version 2.1 of 10/12/82 } 2 | { 3 | icall operator - used for INIT statement 4 | 5 | REQUIRE module variable not defined before each INIT 6 | REQUIRE invariants of blocks crossed outward 7 | REQUIRE blocks crossed inward to be initialized 8 | NEW module variable as defined after INIT 9 | NEW all changed variables after INIT of module 10 | } 11 | procedure opicall(p: ptn); { icall node } 12 | var callee: blocknodep; { monitor/module being called } 13 | caller: blocknodep; { calling block } 14 | r: refnodep; { for ref chaining } 15 | { 16 | explaininitentry -- generate explaination for ENTRY condition 17 | after an INIT 18 | 19 | (entry assertion of xxx.pf:25) 20 | } 21 | procedure explaininitentry(pa: ptn); { assertion to explain } 22 | begin 23 | gensubcode(pa^.disp); { entry or invariant } 24 | genstring15(' of "'); 25 | genstring15(p^.vtype^.vardata.itemname); { name of callee } 26 | genchar('"'); 27 | genchar(' '); 28 | genlineid(pa^.linen); { location } 29 | end {explaininitentry}; 30 | begin 31 | caller := lastblockp; { caller is always current } 32 | with p^ do begin { using given node } 33 | assert(code = icallop); { must be init operation } 34 | callee := vtype^.blockdata; { get callee block } 35 | end; { With } 36 | if not callee^.blhasbody then begin { if no body of callee } 37 | diag(p^.linen, { INIT disallowed } 38 | 'INIT useless - no code in monitor/module initialization part'); 39 | end; 40 | requireblkinit(p^.linen,callee,false); { REQUIRE block not init } 41 | { 42 | Generate REQUIRE statements for module invariants outward 43 | to the callee 44 | } 45 | requireinvariants(p, callee); { gen for caller->callee } 46 | { 47 | Generate REQUIRE statements for initialization of blocks 48 | being entered. 49 | } 50 | requireinit(p, callee); { gen for dominator->callee } 51 | genspecrequires(p,callee^.blassertions,[initentrysubcode],@explaininitentry); 52 | { END INPUT PROCESSING -- BEGIN OUTPUT PROCESSING } 53 | genstring15('NEW'); { begin NEW } 54 | genspace; 55 | genchar('('); { open var list } 56 | genname(callee^.blvarnode); { name of module } 57 | r := callee^.blrefs; { get ref list } 58 | while r <> nil do begin { for ref list } 59 | with r^ do begin { using this ref } 60 | if r^.refkind in [setref, initref] then begin { if changed } 61 | if visible(r^.refvar,caller) then begin { and visible } 62 | genspace; { space between NEW args } 63 | genname(refvar); { add to NEW list } 64 | { force NEW! at use } 65 | setsubstitute(refvar, false, 0, genwithnew); 66 | end; { end visible } 67 | end; { end changed } 68 | r := r^.refnext; { chain onward } 69 | end; { end With } 70 | end; { end ref chaining } 71 | genchar(')'); { finish NEW list } 72 | genspace; { space before assertion } 73 | genstring15('(and!'); { begin conjunction } 74 | genspace; 75 | { INIT part EXIT assertions } 76 | genconjunction(callee^.blassertions,[initexitsubcode]); 77 | genspace; 78 | { (defined! new! ) } 79 | gendataid(callee^.blvarnode,0,genwithnew,genwithdef); 80 | genchar(')'); { finish AND } 81 | clearallsubstitutes; { clear NEW! flag on vars } 82 | if comments then begin { if commentary } 83 | gencomment(p^.linen); { location of init } 84 | genstring15('INIT of'); 85 | genchar(' '); 86 | genstring15(callee^.blvarnode^.vardata.itemname); 87 | end; 88 | genline; { finish NEW } 89 | end {opicall}; 90 | -------------------------------------------------------------------------------- /src/CPC2/p2iconst.h: -------------------------------------------------------------------------------- 1 | { 2 | Icode Operators 3 | 4 | Must match Pass One 5 | } 6 | stnumop = 0; 7 | xchop = 1; 8 | delop = 2; 9 | fixop = 3; 10 | monitop = 4; 11 | identop = 5; 12 | procop = 6; 13 | endop = 7; 14 | nullop = 8; 15 | referop = 9; 16 | stolop = 10; 17 | storop = 11; 18 | stofop = 12; 19 | succop = 16; 20 | predop = 17; 21 | uceqop = 24; 22 | ucneop = 25; 23 | ucgtop = 26; 24 | ucleop = 27; 25 | ucgeop = 28; 26 | ucltop = 29; 27 | umaxop = 30; 28 | uminop = 31; 29 | iaddop = 32; 30 | isubop = 33; 31 | imulop = 34; 32 | idivop = 35; 33 | imodop = 36; 34 | inegop = 40; 35 | iabsop = 41; 36 | ioddop = 42; 37 | ceilop = 44; 38 | floorop = 45; 39 | saddop = 48; 40 | ssubop = 49; 41 | smulop = 50; 42 | sdivop = 51; 43 | resclop = 53; 44 | iceqop = 56; 45 | icneop = 57; 46 | icgtop = 58; 47 | icleop = 59; 48 | icgeop = 60; 49 | icltop = 61; 50 | imaxop = 62; 51 | iminop = 63; 52 | faddop = 64; 53 | fsubop = 65; 54 | fmulop = 66; 55 | fdivop = 67; 56 | fnegop = 72; 57 | fabsop = 73; 58 | floatop = 74; 59 | truncop = 75; 60 | roundop = 76; 61 | fxeqop = 80; 62 | fxneop = 81; 63 | fxgtop = 82; 64 | fxleop = 83; 65 | fxgeop = 84; 66 | fxltop = 85; 67 | fxmaxop = 86; 68 | fxminop = 87; 69 | fceqop = 88; 70 | fcneop = 89; 71 | fcgtop = 90; 72 | fcleop = 91; 73 | fcgeop = 92; 74 | fcltop = 93; 75 | fmaxop = 94; 76 | fminop = 95; 77 | notop = 96; 78 | eqvop = 104; 79 | xorop = 105; 80 | nimpop = 106; 81 | rimpop = 107; 82 | impop = 108; 83 | nrimpop = 109; 84 | orop = 110; 85 | andop = 111; 86 | complop = 112; 87 | unionop = 113; 88 | interop = 114; 89 | sdiffop = 115; 90 | sgensop = 117; 91 | sadelop = 118; 92 | emptyop = 119; 93 | sceqop = 120; 94 | scneop = 121; 95 | scgtop = 122; 96 | scleop = 123; 97 | scgeop = 124; 98 | scltop = 125; 99 | inop = 126; 100 | sanyop = 127; 101 | signlop = 130; 102 | fieldop = 131; 103 | ofsetop = 132; 104 | indirop = 133; 105 | indexop = 134; 106 | movemop = 135; 107 | invokop = 138; 108 | rtempop = 140; 109 | dtempop = 141; 110 | ifop = 144; 111 | caseop = 145; 112 | entryop = 146; 113 | loopop = 147; 114 | exitop = 148; 115 | forop = 149; 116 | blockop = 150; 117 | xhndlop = 151; 118 | seqop = 152; 119 | waitop = 154; 120 | sendop = 155; 121 | tsigop = 156; 122 | lockop = 157; 123 | enablop = 158; 124 | isgnlop = 159; 125 | litscop = 160; 126 | literop = 162; 127 | rdataop = 163; 128 | litdop = 164; 129 | raiseop = 165; 130 | vceqop = 168; 131 | vcneop = 169; 132 | vcgtop = 170; 133 | vcleop = 171; 134 | vcgeop = 172; 135 | vcltop = 173; 136 | dvadop = 174; 137 | varblop = 176; 138 | paramop = 192; 139 | callop = 208; 140 | icallop = 224; 141 | defarop = 244; 142 | fcallop = 245; { generated within pass 2 } 143 | vinitop = 246; 144 | measop = 247; 145 | depthop = 248; 146 | defndop = 249; 147 | oldop = 250; 148 | vdefnop = 251; 149 | vdeclop = 252; 150 | vheadop = 253; 151 | asertop = 254; 152 | linenop = 255; 153 | { 154 | subcodes for ASERT operator 155 | } 156 | assertsubcode = 1; 157 | statesubcode = 2; 158 | summarysubcode = 3; 159 | entrysubcode = 11; 160 | exitsubcode = 12; 161 | effectsubcode = 13; 162 | invariantsubcode= 14; { INVARIANT of monitor/module } 163 | entryexitsubcode= 15; { INVARIANT of procedure/function } 164 | initentrysubcode= 16; { ENTRY of module/monitor } 165 | initexitsubcode = 17; { EXIT of module/monitor } 166 | -------------------------------------------------------------------------------- /src/CPC2/p2looper.i: -------------------------------------------------------------------------------- 1 | { OBSOLETE - code moved to p2aloop. } 2 | -------------------------------------------------------------------------------- /src/CPC2/p2recurse.i: -------------------------------------------------------------------------------- 1 | procedure WHATrecurse; const WHAT = '@(#)p2recurse.i 2.1'; begin SINK := WHAT; end; { Version 2.1 of 10/12/82 } 2 | { 3 | Recursion checking -- check that recursive procedures terminate 4 | } 5 | { 6 | entrydepthcheck -- check DEPTH at entry to recursive procedure 7 | 8 | The DEPTH clause must have a value greater than zero at entry 9 | to the procedure; in addition, the value must be saved for 10 | later use at calls to other recursive routines. 11 | } 12 | procedure entrydepthcheck(b: blocknodep); { relevant block } 13 | var i: 1..4; { for indentation } 14 | begin 15 | with b^ do begin { using given block } 16 | if blrecursive <> (bldepthexpr <> nil) then begin { if missing/extra } 17 | usererrorstart(blvarnode^.vardata.vrsource);{ start message } 18 | if blrecursive then begin { if missing DEPTH for recurse } 19 | write(output,'No DEPTH statement for recursive routine') 20 | end else begin { if extra DEPTH } 21 | write(output,'DEPTH not needed for nonrecursive routine'); 22 | bldepthexpr := nil; { drop DEPTH expression } 23 | end; 24 | usererrorend; { finish off error message } 25 | end; { end missing/extra DEPTH } 26 | if bldepthexpr <> nil then begin { if DEPTH present } 27 | assert(bldepthexpr^.code = depthop);{ must be depth operator } 28 | safeexpr(bldepthexpr^.arg[1]); { must be OK to evaluate } 29 | { constrain to 0..32767 } 30 | requirecompat(bldepthexpr,cardinalvarnode,u15,bldepthexpr^.arg[1]); 31 | { now save for calls } 32 | assert(blockdepthtid = 0); { only once per junit } 33 | blockdepthtid := nexttemp; { assign temp number } 34 | { save expr value } 35 | gentempasg(blockdepthtid,cardinalvarnode,bldepthexpr^.arg[1],true); 36 | end; { end DEPTH present } 37 | end; { end With } 38 | end {entrydepthcheck}; 39 | { 40 | calldepthcheck -- check DEPTH relationship at call 41 | } 42 | procedure calldepthcheck(caller: blocknodep; { calling routine } 43 | p: ptn); { call node } 44 | var callee: blocknodep; { must have block } 45 | i: 1..4; { for indentation } 46 | begin 47 | with p^ do begin { using caller node } 48 | callee := vtype^.blockdata; { relevant block } 49 | if (caller^.bldepthexpr <> nil) and 50 | (callee^.bldepthexpr <> nil) then begin { if recursive } 51 | genstring15('REQUIRE'); { REQUIRE depth relation } 52 | genspace; 53 | genstring15('(lti!'); { callee <= caller } 54 | genspace; 55 | genjexpr(callee^.bldepthexpr^.arg[1]);{ callee DEPTH } 56 | genspace; 57 | { caller DEPTH } 58 | gendataid(nil,blockdepthtid,genwithoutnew,genwithoutdef); 59 | genchar(')'); { close lti } 60 | genspace; 61 | genmsgstart(p^.linen); { callee DEPTH < caller } 62 | { reproduce expression } 63 | genmexpr1(callee^.bldepthexpr^.arg[1],relationaloperator); 64 | genchar(' '); 65 | genchar('<'); 66 | genchar(' '); 67 | genstring15('"caller DEPTH"'); 68 | for i := 1 to 4 do genchar(' '); { 4 spaces } 69 | genstring15('(DEPTH'); { (DEPTH check for call of "xxx") } 70 | genstring15(' check for'); 71 | genstring15(' call of "'); 72 | genstring15(callee^.blvarnode^.vardata.itemname); 73 | genstring15('")'); 74 | genmsgend; 75 | genline; 76 | end; 77 | end; { end With } 78 | end {calldepthcheck}; 79 | -------------------------------------------------------------------------------- /src/CPC2/p2setused.i: -------------------------------------------------------------------------------- 1 | 2 | Obsolete - broken into four parts. 3 | -------------------------------------------------------------------------------- /src/CPC2/p2tprint.i: -------------------------------------------------------------------------------- 1 | procedure WHATtprint; const WHAT = '@(#)p2tprint.i 2.1'; begin SINK := WHAT; end; { Version 2.1 of 10/12/82 } 2 | { 3 | treeprint -- print the code tree for one procedure 4 | } 5 | procedure treeprint(p: ptn; indent: longint); 6 | const tabstop = 12; { where to end indentation } 7 | var i: longint; { for indentation } 8 | begin 9 | for i := 1 to indent do write(dbg,' ');{ indent 1 space per indent } 10 | if p = nil then begin { if nil node } 11 | writeln(dbg,'null'); { so state } 12 | end else begin { if not nil } 13 | with p^ do begin { using the node } 14 | write(dbg,optab[code].opname); { name of operator } 15 | for i := indent to tabstop do write(dbg,' '); { align numbers } 16 | write(dbg,linen.linenumber:4,'.'); { source line number } 17 | write(dbg,size:7,segnr:7, disp:7); 18 | if scalefactor <> nil then begin { if fixed point constant } 19 | write(dbg,' ('); 20 | write(dbg,'FIXED POINT CONSTANT'); { ***UNIMPLEMENTED***} 21 | write(dbg,')'); 22 | end; 23 | if mtype <> xxx then begin { if result type meaningful } 24 | ////write(dbg,' ',mtype:5);{ type of result } 25 | end else write(dbg,' '); { align } 26 | if vtype <> nil then begin { if variable entry present } 27 | write(dbg,' ',vtype^.vardata.itemname); { write name } 28 | ////write(dbg,' ',vtype^.vardata.form); { write kind } 29 | end; 30 | writeln(dbg); { finish this item } 31 | for i := 1 to nrarg do { for indicated number of args } 32 | treeprint(arg[i],indent+1); { print subtree } 33 | end; { end WITH } 34 | end; { end not nil } 35 | end {treeprint}; 36 | 37 | -------------------------------------------------------------------------------- /src/CPC2/p2vars.i: -------------------------------------------------------------------------------- 1 | var 2 | SINK: packed array [1..40] of char; { for dummy WHAT string replacements } 3 | 4 | tree: ptn; { root of icode tree } 5 | vartree: varnodep; { root of variable tree } 6 | blockhead, blocktail: blocknodep; { pointers to block chain } 7 | 8 | {Miscellaneous variables} 9 | {***********************} 10 | 11 | namesize: longint; {length of current procedure name} 12 | name: array[1..15] of char; {current procedure name} 13 | programloadtype: loadtype; {internal/external indicator} 14 | seriouserror: boolean; {true if badnode or internalerror} 15 | fatalerror: boolean; {fatal error has occured} 16 | usererrors: longint; {non-internal errors} 17 | gencnt: 0..jlinelengthmax; {position on jcode line } 18 | firstline: lineinfo; {first line number in routine} 19 | currentblockp: blocknodep; {pointer to current block info } 20 | lastblockp: blocknodep; {pointer to last block info } 21 | nodesallocated: longint; {count of allocated nodes} 22 | lastsourcefile: longint; {last file number printed in diag} 23 | srcbuf: sourceline; {last source line printed} 24 | labelserial: labelid; {label counter for jcode labels} 25 | tempserial: tempid; {last TEMP$ number} 26 | clockserial: timestamp; {last clock tick} 27 | lastrdataaddr: longint; {current byte addr in constant data } 28 | lastrdatabyte: byte; {current byte read at lastrdataaddr} 29 | blockdepthtid: tempid; {TEMP number of DEPTH expression} 30 | zeroexpr: ptn; {dummy icode node for zero constant} 31 | trueexpr: ptn; {dummy icode node for true} 32 | cardinalvarnode: varnodep; {dummy varnode for 0..32767 type } 33 | booleanvarnode: varnodep; {dummy varnode for boolean } 34 | sideeffectinthisstmt: boolean; {true if side effect in current stmt} 35 | lastfilepath: record {last file pathname cache} 36 | lppath: filepath; {the pathname} 37 | lpfnum: longint; {its number} 38 | lpsize: 0..maxfilepath; {its lengt} 39 | end; 40 | {Files used in pass2} 41 | {*******************} 42 | {switches to control output from pass2: 43 | debug: generate tree dump (pascal.dbg) char d 44 | } 45 | 46 | debugg: boolean; 47 | comments: boolean; { comments desired in jcode? } 48 | 49 | { 50 | Files read by second pass 51 | } 52 | int: file of byte; { file of intermediate code} 53 | dat: file of byte; { intermediate home for data and case tables} 54 | vars: file of varitem; { variable definitions } 55 | src: file of sourceline; { file of source lines} 56 | { 57 | Files written by second pass 58 | } 59 | jcd: text; { jcode } 60 | dbg: text; { debug print } 61 | { 62 | constant tables 63 | } 64 | optab: array [byte] of optabitem; { operator table } 65 | mttab: array [machinetype] of mttabitem;{ machine type table } 66 | nulllineinfo: lineinfo; { null line number for genlineid } 67 | { 68 | Scope information -- used in interpretation of 69 | VARBL, FIELD, and PARAM `levels', which are relative 70 | to the static procedure nest. 71 | } 72 | scopestack: array [0..scopedepthmax] of record{ procedure stack } 73 | scopepin: longint; { procedure number this lev } 74 | nonscopes: longint; { nested non-scopes (modules) } 75 | end; 76 | scopedepth: 0..scopedepthmax; { current nesting depth } 77 | blockdepth: 0..blockdepthmax; { depth into block stack } 78 | blocksequence: longint; { scope serial number } 79 | { 80 | WITH information -- state of enclosing WITH statements 81 | } 82 | rtemptab: array [0..rtempmax] of ptn; { values from WITH clauses } 83 | 84 | { 85 | Substitution information -- used for actual/formal binding, etc. 86 | } 87 | sbtop: substituteposition; { size of subtab table } 88 | sbtab: array [1..maxsubstack] of subitem; { substitutions table } 89 | { 90 | Record type number information -- used to distinguish record types 91 | } 92 | rectab: recindextab; { record type table } 93 | -------------------------------------------------------------------------------- /src/CPC2/source.h: -------------------------------------------------------------------------------- 1 | { 2 | Source Line Retrieval Routines 3 | } 4 | { 5 | initsourceprint -- initialize source line printer 6 | 7 | Must be called before calling printsourceline. 8 | } 9 | procedure initsourceprint; { no arguments } 10 | external; 11 | { 12 | printsourceline -- print desired source line 13 | } 14 | procedure printsourceline(var f: text; { output file } 15 | n: integer); { desired line } 16 | external; 17 | -------------------------------------------------------------------------------- /src/CPC2/source.p: -------------------------------------------------------------------------------- 1 | const 2 | filefilename = 'pasf-files'; { name of file of files } 3 | sourcefilename = 'pasf-source'; { name of source file } 4 | {$I ../CPC1/P1X-VER00.h } 5 | type 6 | {$I ../CPC1/P1X-VER01.h } 7 | { 8 | print routines for printing source files 9 | } 10 | var 11 | lastsourcefile: longint; { last source file printed } 12 | lastsourceline: longint; { last source line printed } 13 | src: file of sourceline; { file of source statements } 14 | 15 | {$I source.h} 16 | 17 | procedure WHATsource; const WHAT = '@(#)source.p 1.2'; begin writeln(WHAT); end; { Version 1.2 of 11/24/81 } 18 | { 19 | initsourceprint -- initialize source printer 20 | } 21 | procedure initsourceprint; 22 | begin 23 | lastsourcefile := 0; { files not open } 24 | lastsourceline := 0; { at line 0 } 25 | end {initsourceprint}; 26 | { 27 | printsourcefile -- print source file name 28 | } 29 | procedure printsourcefile(var f: text; { output file } 30 | n: longint); { file number } 31 | var fnames: text; { file of file names } 32 | i: longint; { for line loop } 33 | ch: char; { for copying } 34 | begin 35 | if n <> lastsourcefile then begin { if new source file } 36 | assign(fnames, filefilename); 37 | reset(fnames); { open file name file } 38 | for i := 1 to n-1 do readln(fnames); { skip n-1 lines } 39 | while not (eoln(fnames) or eof(fnames)) do begin { for one line } 40 | read(fnames,ch); 41 | write(f,ch); { copy name to output } 42 | end; 43 | writeln(f); { finish line } 44 | lastsourcefile := n; { remember last file printed } 45 | end; 46 | end {printsourcefile}; 47 | { 48 | printsourceline -- print desired line from source line file 49 | 50 | Standard Pascal Dumb Non-Random-Access Version 51 | } 52 | procedure printsourceline(var f: text; { output file } 53 | n: integer); { desired line } 54 | var i,j: longint; 55 | srcbuf: sourceline; { source line record } 56 | begin 57 | if n <= 0 then begin { if no such line } 58 | writeln('*** Error on unknown source line ***'); 59 | end else if lastsourceline <> n then begin { if new line } 60 | { see if rewind requried } 61 | if (lastsourceline = 0) or (lastsourceline > n) then begin 62 | assign(src, sourcefilename); 63 | reset(src); { rewind file } 64 | lastsourceline := 0; { now open at line 0 } 65 | end; 66 | while lastsourceline < n do begin { read up to desired line } 67 | read(src,srcbuf); { read next record } 68 | lastsourceline := lastsourceline + 1; { keep position counter } 69 | end; 70 | printsourcefile(f,srcbuf.lineid.filenumber);{ print file name involved } 71 | write(f,srcbuf.lineid.linenumber:4,'. '); { line number } 72 | i := linetextmax; { find last nonblank } 73 | while (i>1) and (srcbuf.linetext[i] = ' ') do i := i-1; 74 | for j := 1 to i do write(f,srcbuf.linetext[j]); { print line } 75 | writeln(f); { finish line } 76 | lastsourceline := n; { avoid double printing } 77 | end; 78 | end {printsource}; 79 | -------------------------------------------------------------------------------- /src/CPC2/sourcetest.p: -------------------------------------------------------------------------------- 1 | program sourcetest(output); 2 | {$I source.h } 3 | begin 4 | initsourceprint; { initialize } 5 | printsourceline(output,25); { print line 25 } 6 | printsourceline(output,50); { print line 50 } 7 | end. 8 | -------------------------------------------------------------------------------- /src/CPC3/PIPEIN.c: -------------------------------------------------------------------------------- 1 | /* deleted */ 2 | -------------------------------------------------------------------------------- /src/CPC3/PIPEOUT.c: -------------------------------------------------------------------------------- 1 | /* deleted */ 2 | -------------------------------------------------------------------------------- /src/CPC3/README: -------------------------------------------------------------------------------- 1 | This is CPCI 3 of the Pascal-F Verifier, the path tracer and verification 2 | condition generator. 3 | Generating this on the SUN requires some painful kludges. We wanted to have 4 | the ability to read and write pipes in Pascal, a facility not normally 5 | available in the language. So we have some subroutines which make this 6 | possible. But these subroutines need a .h file which defines the Pascal-F 7 | I/O tables, and SUN doesn't provide that file. So the file has been adapted 8 | from the 4.1BSD file, which is slightly different. I'm not happy about this, 9 | because I had to guess at the table format after examining some parts of 10 | the Pascal library with adb. So if pipe I/O trouble is experienced, this 11 | mechanism is probably faulty. 12 | -------------------------------------------------------------------------------- /src/CPC3/direct.c: -------------------------------------------------------------------------------- 1 | /* this file is no longer used */ 2 | -------------------------------------------------------------------------------- /src/CPC3/env.p: -------------------------------------------------------------------------------- 1 | #include "global.h" 2 | 3 | procedure WriteEnvId; 4 | begin 5 | writeln('env.p 1.6') end; 6 | 7 | function AllocateEnv; 8 | var 9 | NewNext: integer; (* The value of NextEnv after allocation *) 10 | j: EnvIndex; 11 | begin 12 | (* See if there is room for a new environment *) 13 | NewNext := NextEnv + EnvLength; 14 | if NewNext > EnvPoolSize then begin 15 | writeln('environment overflow'); 16 | Abort end; 17 | 18 | (* Clear the new environment *) 19 | if NewNext-1 >= NextEnv then (* avoid compiler bug *) 20 | for j := NextEnv to NewNext-1 do 21 | EnvPool[j] := 0; 22 | 23 | (* Return it. *) 24 | AllocateEnv := NextEnv; 25 | NextEnv := NewNext end; 26 | 27 | procedure CopyEnv; 28 | var X: VariableIndex; 29 | begin 30 | for X := 0 to EnvLength-1 do 31 | EnvPool[Cpy+X] := EnvPool[Org+X] end; 32 | -------------------------------------------------------------------------------- /src/CPC3/error.p: -------------------------------------------------------------------------------- 1 | #include "global.h" 2 | 3 | procedure WriteErrorId; 4 | begin 5 | writeln('error.p 1.5') end; 6 | 7 | procedure Abort; 8 | begin 9 | write ('Internal system error '); 10 | if CurrentClass = EndFile then 11 | writeln('vcg [eof]') 12 | else 13 | writeln('vcg [', StatementLine:1, '.', CurrentChar, '] '); 14 | 15 | halt end; 16 | 17 | procedure SyntaxError; 18 | begin 19 | writeln('syntax'); 20 | Abort end; 21 | -------------------------------------------------------------------------------- /src/CPC3/init.p: -------------------------------------------------------------------------------- 1 | #include "global.h" 2 | 3 | procedure WriteInitId; 4 | begin 5 | writeln('init.p 1.10') end; 6 | 7 | procedure InitAlphaString; 8 | (* Input: none. 9 | * Output: AlphaString. 10 | * Effect: Machine-independent initialization of AlphaString 11 | *) 12 | begin 13 | AlphaString[ 0] := '0'; 14 | AlphaString[ 1] := '1'; 15 | AlphaString[ 2] := '2'; 16 | AlphaString[ 3] := '3'; 17 | AlphaString[ 4] := '4'; 18 | AlphaString[ 5] := '5'; 19 | AlphaString[ 6] := '6'; 20 | AlphaString[ 7] := '7'; 21 | AlphaString[ 8] := '8'; 22 | AlphaString[ 9] := '9'; 23 | AlphaString[10] := 'A'; 24 | AlphaString[11] := 'B'; 25 | AlphaString[12] := 'C'; 26 | AlphaString[13] := 'D'; 27 | AlphaString[14] := 'E'; 28 | AlphaString[15] := 'F'; 29 | AlphaString[16] := 'G'; 30 | AlphaString[17] := 'H'; 31 | AlphaString[18] := 'I'; 32 | AlphaString[19] := 'J'; 33 | AlphaString[20] := 'K'; 34 | AlphaString[21] := 'L'; 35 | AlphaString[22] := 'M'; 36 | AlphaString[23] := 'N'; 37 | AlphaString[24] := 'O'; 38 | AlphaString[25] := 'P'; 39 | AlphaString[26] := 'Q'; 40 | AlphaString[27] := 'R'; 41 | AlphaString[28] := 'S'; 42 | AlphaString[29] := 'T'; 43 | AlphaString[30] := 'U'; 44 | AlphaString[31] := 'V'; 45 | AlphaString[32] := 'W'; 46 | AlphaString[33] := 'X'; 47 | AlphaString[34] := 'Y'; 48 | AlphaString[35] := 'Z'; 49 | AlphaString[36] := 'a'; 50 | AlphaString[37] := 'b'; 51 | AlphaString[38] := 'c'; 52 | AlphaString[39] := 'd'; 53 | AlphaString[40] := 'e'; 54 | AlphaString[41] := 'f'; 55 | AlphaString[42] := 'g'; 56 | AlphaString[43] := 'h'; 57 | AlphaString[44] := 'i'; 58 | AlphaString[45] := 'j'; 59 | AlphaString[46] := 'k'; 60 | AlphaString[47] := 'l'; 61 | AlphaString[48] := 'm'; 62 | AlphaString[49] := 'n'; 63 | AlphaString[50] := 'o'; 64 | AlphaString[51] := 'p'; 65 | AlphaString[52] := 'q'; 66 | AlphaString[53] := 'r'; 67 | AlphaString[54] := 's'; 68 | AlphaString[55] := 't'; 69 | AlphaString[56] := 'u'; 70 | AlphaString[57] := 'v'; 71 | AlphaString[58] := 'w'; 72 | AlphaString[59] := 'x'; 73 | AlphaString[60] := 'y'; 74 | AlphaString[61] := 'z'; 75 | AlphaString[62] := '.'; 76 | AlphaString[63] := '_'; 77 | AlphaString[64] := '~' end; 78 | 79 | procedure InitGlobal; 80 | begin 81 | (* "constants" *) 82 | InitAlphaString; 83 | Dirty := false; 84 | DelimiterSet := ['(', ')', ' ', '$', '!', ':', '@', '+','-','/']; 85 | NextString := 1; 86 | 87 | QuoteBoolean := StringCreate('(boolean)/)'); 88 | QuoteTrue := StringCreate('(true!)/)'); 89 | NullString := StringCreate('/)'); 90 | QuoteNew := StringCreate('new/)'); 91 | QuoteDefined := StringCreate('defined/)'); 92 | 93 | EndString := 'END'; 94 | 95 | InitKeywordTable; (* Note -- InitKeyword table uses NullString *) 96 | NextStringBase := NextString; 97 | InitVariableTable; 98 | InitTP; 99 | RequireList := nil; 100 | 101 | (* Serially reused variable *) 102 | InitVariableTable end; 103 | 104 | procedure InitUnit; 105 | begin 106 | LineCount := 0; 107 | StatementLine := 1; 108 | NextEnv := 1; 109 | NextString := NextStringBase; 110 | MaxLabelBucket := 0; 111 | InitReadChar; 112 | InitPointerName; 113 | end; 114 | -------------------------------------------------------------------------------- /src/CPC3/jsort.h: -------------------------------------------------------------------------------- 1 | (* The following two declarations are used to bring in library routines to 2 | * do direct access I/O on text files. 3 | *) 4 | 5 | procedure OurSeek(var f: text; n: FilePosition); 6 | (* This routine moves f^ to the place returned by OurTell *) 7 | external; 8 | 9 | function OurTell(var f: text): FilePosition; 10 | (* This routine returns the position of f^ in f. *) 11 | external; 12 | -------------------------------------------------------------------------------- /src/CPC3/main.p: -------------------------------------------------------------------------------- 1 | { ************************************************* 2 | * * 3 | * * 4 | * The Pascal-F Verifier * 5 | * * 6 | * Verification Condition Generator * 7 | * * 8 | * Pass 3 * 9 | * * 10 | ************************************************* } 11 | 12 | { 13 | Permission is hereby given to modify or use, but not for profit, 14 | any or all of this program provided that this copyright notice 15 | is included: 16 | 17 | Copyright 1985 18 | 19 | Ford Motor Company 20 | The American Road 21 | Dearborn, Michigan 48121 22 | 23 | This work was supported by the Long Range Research Program of 24 | the Ford Motor Company, and was carried out at Ford Scientific 25 | Research Labs in Dearborn, Michigan and Ford Aerospace and 26 | Communications Corporation's Western Development Laboratories 27 | in Palo Alto, California. 28 | } 29 | program VerifyJcode(output, p3jcode, history, newhistory); 30 | #include "global.h" 31 | 32 | procedure WriteMainId; 33 | begin 34 | writeln('main.p 1.8') end; 35 | 36 | procedure WriteEveryId; 37 | begin 38 | writeln(GlobalId); 39 | WriteChangedId; 40 | WriteCharinId; 41 | WriteEnvId; 42 | WriteErrorId; 43 | WriteFinishId; 44 | WriteInitId; 45 | WriteMainId; 46 | WriteOutputId; 47 | WriteParseId; 48 | WritePathId; 49 | WriteStringId; 50 | WriteTableId; 51 | WriteUnixioId end; 52 | 53 | begin 54 | if argc = 1 then 55 | WriteEveryId 56 | else begin 57 | InitGlobal; 58 | VerifyChangedUnits end end. 59 | -------------------------------------------------------------------------------- /src/CPC3/makefile: -------------------------------------------------------------------------------- 1 | 2 | # 3 | # Makefile for pass 3 of verifier 4 | # 5 | # Version 1.9 of 2/6/86 6 | # Revised January 2017 for Free Pascal 7 | # 8 | # Programs of pass 3 are 9 | # 10 | # pass3a -- the jsort program which sorts jcode 11 | # pass3b -- the control program for passes 3 and 4 12 | # pass3c -- the verification condition generator 13 | # 14 | SOURCE = .. 15 | DEST=../bin 16 | PFLAGS = -I/usr/include/pascal -c -g -C 17 | CFLAGS = -I/usr/src/lib/libpc -c -g 18 | PASS3 = $(SOURCE)/CPC3/src 19 | POPTIONS=-gl -Co -Cr 20 | # 21 | # make with no arguments makes pasver3c and pasver3a 22 | # make install makes and installs pasver3c and pasver3a 23 | # make all is the same as make with no arguments 24 | # 25 | pofiles = charin.o env.o error.o finish.o init.o output.o parse.o \ 26 | path.o string.o table.o changed.o 27 | sfiles = global.h charin.p env.p error.p finish.p init.p output.p parse.p \ 28 | path.p string.p table.p main.p changed.p unixio.c 29 | 30 | all: pasver3c pasver3a 31 | install: pasver3c pasver3a 32 | -rm -f $(DEST)/pasver3a.old 33 | -mv $(DEST)/pasver3a $(DEST)/pasver3a.old 34 | ln pasver3a $(DEST) 35 | -rm -f $(DEST)/pasver3c.old 36 | -mv $(DEST)/pasver3c $(DEST)/pasver3c.old 37 | ln pasver3c $(DEST) 38 | 39 | pasver3c: main.o unixio.o $(pofiles) 40 | pc main.o unixio.o $(pofiles) 41 | rm -f pasver3c 42 | mv a.out pasver3c 43 | chmod 555 pasver3c 44 | 45 | source: $(sfiles) 46 | 47 | pasver3a: jsort.p jsort.h 48 | rm -f pasver3a 49 | fpc $(POPTIONS) jsort.p | tee errs 50 | mv jsort pasver3a 51 | chmod 555 pasver3a 52 | 53 | unixio.o: pascaliodefs.h 54 | $(pofiles): global.h 55 | main.o: global.h main.p; $(PC) $(PFLAGS) -w main.p 56 | 57 | 58 | -------------------------------------------------------------------------------- /src/CPC3/pascaliodefs.h: -------------------------------------------------------------------------------- 1 | /* Copyright (c) 1979 Regents of the University of California */ 2 | 3 | /* static char sccsid[] = "@(#)iorec.h 1.1 8/27/80"; */ 4 | /* 5 | This is a part of the Pascal library, but is lifted from the 6 | 4.2BSD sources and moved to the SUNs. It ought to be in the 7 | include libraries for the SUNs, but it isn't. This allows 8 | us to compile unixio.c, which contains our seek, tell, and 9 | pipe interfaces. 10 | */ 11 | #include 12 | #define NAMSIZ 76 13 | 14 | struct iorec { 15 | char *fileptr; /* ptr to file window */ 16 | long lcount; /* number of lines printed */ 17 | long llimit; /* maximum number of text lines */ 18 | FILE *fbuf; /* FILE ptr */ 19 | struct iorec *fchain; /* chain to next file */ 20 | long *flev; /* ptr to associated file variable */ 21 | char *pfname; /* ptr to name of file */ 22 | short funit; /* file status flags */ 23 | short funitno; /* unit number */ 24 | long size; /* size of elements in the file */ 25 | char fname[NAMSIZ]; /* name of associated UNIX file */ 26 | char buf[BUFSIZ]; /* I/O buffer */ 27 | char window[1]; /* file window element */ 28 | }; 29 | 30 | /* 31 | * unit flags 32 | */ 33 | #define SPEOLN 0x100 /* 1 => pseudo EOLN char read at EOF */ 34 | #define FDEF 0x080 /* 1 => reserved file name */ 35 | #define FTEXT 0x040 /* 1 => text file, process EOLN */ 36 | #define FWRITE 0x020 /* 1 => open for writing */ 37 | #define FREAD 0x010 /* 1 => open for reading */ 38 | #define TEMP 0x008 /* 1 => temporary file */ 39 | #define SYNC 0x004 /* 1 => window is out of sync */ 40 | #define EOLN 0x002 /* 1 => at end of line */ 41 | #define EOFF 0x001 /* 1 => at end of file */ 42 | /* 43 | Externals 44 | */ 45 | extern struct iorec *GETNAME(); /* library */ 46 | struct iorec *_actfile[_NFILE];/* indexed by open descriptor */ 47 | -------------------------------------------------------------------------------- /src/CPC3/string.p: -------------------------------------------------------------------------------- 1 | #include "global.h" 2 | 3 | procedure WriteStringId; 4 | begin 5 | writeln('string.p 1.5') end; 6 | 7 | procedure PutStringPool; 8 | begin 9 | if NextString = StringPoolSize then begin 10 | writeln('string overflow'); 11 | Abort end 12 | else begin 13 | StringPool[NextString] := C; 14 | NextString := NextString + 1 end end; 15 | 16 | procedure PutStringEnd; 17 | begin 18 | PutStringPool('/'); 19 | PutStringPool(')') end; 20 | 21 | function StringEqual; 22 | var Result: (Yes, No, Unsure); 23 | begin 24 | Result := Unsure; 25 | repeat 26 | if StringPool[A] <> StringPool[B] then 27 | Result := No 28 | else begin 29 | if StringPool[A] = '/' then 30 | if (StringPool[A+1] = ')') and (StringPool[B+1] = ')') then 31 | Result := Yes end; 32 | A := A + 1; 33 | B := B + 1 34 | until Result <> Unsure; 35 | StringEqual := Result = Yes end; 36 | 37 | 38 | function StringCreate; 39 | var X: 1..ShortStringLength; 40 | begin 41 | StringCreate := NextString; 42 | X := 1; 43 | PutStringPool(S[1]); (* So that S[X-1] does not overflow *) 44 | repeat 45 | X := X + 1; 46 | PutStringPool(S[X]) 47 | until (S[X-1] = '/') and (S[X]=')') end; 48 | 49 | procedure ShortAppend; 50 | var NotUsed: StringIndex; 51 | begin 52 | NotUsed := StringCreate(S); 53 | NextString := NextString - 2 end; 54 | 55 | procedure StringCopy; 56 | begin 57 | PutStringPool(StringPool[A]); 58 | repeat 59 | A := A + 1; 60 | PutStringPool(StringPool[A]); 61 | until (StringPool[NextString-2] = '/') and 62 | (StringPool[NextString-1] = ')') end; 63 | 64 | procedure StringAppend; 65 | begin 66 | StringCopy(A); 67 | NextString := NextString - 2 end; 68 | -------------------------------------------------------------------------------- /src/CPC3/unixio.c: -------------------------------------------------------------------------------- 1 | #include "pascaliodefs.h" 2 | 3 | /* This file contains extensions to the Pascal libarary to allow 4 | * access to Unix I/O primitives not found in Standard Pascal 5 | */ 6 | 7 | WriteUnixioId() 8 | { printf("unixio.c 1.8"); 9 | } 10 | 11 | 12 | /* 13 | * PerrorC(msg1,msg2) prints the messages and the error message 14 | * representing the current value of "errno". 15 | */ 16 | PerrorC(msg1,msg2) 17 | char msg1[], msg2[]; 18 | { 19 | char ss[100]; /* working string */ 20 | perror(sprintf(ss,"%s%s",msg1,msg2)); /* edit error msg */ 21 | } 22 | /* 23 | pipein -- open a pipe for reading, given open descriptor 24 | */ 25 | pipein(filep, fdesc) 26 | register struct iorec *filep; 27 | long fdesc; 28 | { 29 | char ss[50]; /* for filename */ 30 | if (_actfile[fdesc]) /* if already open */ 31 | { 32 | fprintf(stderr,"pipein: descriptor %d already open.\n",fdesc); 33 | return; 34 | } 35 | sprintf(ss,"pipe_input_%d",fdesc); /* name of file */ 36 | filep = GETNAME(filep, ss, (long) strlen(ss), (long) 0); 37 | filep->fbuf = fdopen((int) fdesc, "r"); 38 | if (filep->fbuf == NULL) { 39 | PerrorC("Could not open ", filep->pfname); 40 | return; 41 | } 42 | filep->funit |= (SYNC | FREAD | EOLN); /* set unit flags */ 43 | filep->funitno = fdesc; /* set file descriptor */ 44 | _actfile[fdesc] = filep; /* set back pointer */ 45 | setbuf(filep->fbuf, &filep->buf[0]); 46 | } 47 | /* 48 | pipeout -- open a pipe for writing, given open descriptor 49 | */ 50 | pipeout(filep, fdesc) 51 | register struct iorec *filep; 52 | long fdesc; 53 | { 54 | char ss[50]; /* for filename */ 55 | if (_actfile[fdesc]) /* if already open */ 56 | { 57 | fprintf(stderr,"pipeout: descriptor %d already open.\n",fdesc); 58 | return; 59 | } 60 | sprintf(ss,"pipe_output_%d",fdesc); /* name of file */ 61 | filep = GETNAME (filep, ss, (long) strlen(ss), (long) 0); 62 | filep->fbuf = fdopen((int)fdesc, "w"); 63 | if (filep->fbuf == NULL) { 64 | PerrorC("Could not create ",filep->pfname); 65 | return; 66 | } 67 | 68 | filep->funit |= (EOFF | FWRITE); 69 | filep->funitno = fdesc; /* set file descriptor */ 70 | _actfile[fdesc] = filep; /* set back pointer */ 71 | setbuf(filep->fbuf, &filep->buf[0]); 72 | } 73 | -------------------------------------------------------------------------------- /src/CPC4/autosimp.lisp: -------------------------------------------------------------------------------- 1 | "@(#)autosimp.l 2.1" 2 | 3 | ; load and execute simplifier. 4 | (defun autostart nil 5 | (sstatus load-search-path (|/usr/p/frl/cpc4.d|)) 6 | (patom '|Loading simplifier...|) (terpr) 7 | (load 'setup) 8 | (setq startarg 3) 9 | (main)) 10 | 11 | (setq user-top-level 'autostart) 12 | -------------------------------------------------------------------------------- /src/CPC4/ccvms.sh: -------------------------------------------------------------------------------- 1 | 2 | # 3 | # ccvms -- perform c compile, generating VMS object if 4 | # running under Eunice 5 | # 6 | # Required only for files to be read in with cfasl 7 | # in Lisp. 8 | # 9 | # Force VMS outputs under Eunice; no action under Unix 10 | # 11 | AS_IMAGE=/bin/vmsas 12 | LD_IMAGE=/bin/vmsld 13 | export AS_IMAGE 14 | export LD_IMAGE 15 | # Do the compile 16 | cc $* 17 | -------------------------------------------------------------------------------- /src/CPC4/comp.lisp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/John-Nagle/pasv/04fa44aaabc46b2e231ab83f96b8857dc5977754/src/CPC4/comp.lisp -------------------------------------------------------------------------------- /src/CPC4/compile.lisp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/John-Nagle/pasv/04fa44aaabc46b2e231ab83f96b8857dc5977754/src/CPC4/compile.lisp -------------------------------------------------------------------------------- /src/CPC4/debug.lisp: -------------------------------------------------------------------------------- 1 | "@(#)debug.l 2.6" 2 | 3 | ;;;============================================================================ 4 | ;;; simpdebug is a macro, that if redefined, will cause debug code 5 | ;;; to be included in the simplifier. 6 | 7 | ;;;;(declare (load 'need.o) (load 'defmac.o) (macros t)) 8 | (declarespecial special 9 | rareevents 10 | errport) 11 | (needs-macros) 12 | 13 | ;;;;(defmacro simpdebug (x) (comment "debug code is not present")) 14 | (defmacro simpdebug (x) `,x) ; debug on 15 | ; 16 | ; internalerror -- called if an internal error is detected 17 | ; 18 | (defun internalerror (msg) 19 | (patom "INTERNAL ERROR IN VERIFIER THEOREM PROVER" errport) 20 | (terpri errport) 21 | (patom "Message: " errport) 22 | (patom msg errport) 23 | (terpri errport) 24 | (break "for internal debugging - exit with ctl-D.")) 25 | ; 26 | ; rareevent -- tally rare events 27 | ; 28 | ; This routine is often traced when debugging performance problems. 29 | ; 30 | (defun rareevent (event) 31 | (prog (tal) 32 | (setq tal (assoc event rareevents)) ; check if on list 33 | (cond (tal (rplacd tal (+ (cdr tal) 1))) ; tally if in list 34 | (t (setq rareevents (cons (cons event 1) rareevents)))) 35 | )) 36 | ; 37 | ; dumprareevents -- dump the rare event list 38 | ; 39 | (defun dumprareevents nil 40 | (mapcar 'dumprareevent rareevents) 41 | nil) 42 | (defun dumprareevent (tal) 43 | (patom (car tal)) ; event name 44 | (patom ": ") ; event count 45 | (patom (cdr tal)) ; event count 46 | (terpri)) 47 | (setq rareevents nil) ; initialize 48 | -------------------------------------------------------------------------------- /src/CPC4/diffs.lisp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/John-Nagle/pasv/04fa44aaabc46b2e231ab83f96b8857dc5977754/src/CPC4/diffs.lisp -------------------------------------------------------------------------------- /src/CPC4/divmod.lisp: -------------------------------------------------------------------------------- 1 | ;;; Moved to builtin.l 2 | -------------------------------------------------------------------------------- /src/CPC4/dosimp.lisp: -------------------------------------------------------------------------------- 1 | "@(#)dosimp.l 2.1" 2 | 3 | ; Load-and-go simplifier 4 | (load 'setup) 5 | ;;; Execute the simplifier on expressions read from standard input 6 | (def dosimp (lambda nil 7 | (print '> ) 8 | (do conj nil nil (not (setq conj (read))) 9 | (setq thm (simp conj)) 10 | (pp thm) 11 | (print '> ) 12 | ) 13 | ) 14 | ) 15 | (dosimp) 16 | -------------------------------------------------------------------------------- /src/CPC4/eform.lisp: -------------------------------------------------------------------------------- 1 | ; 2 | ; Eform -- enode form to list form conversion 3 | ; 4 | ; Version 1.2 of 12/17/82 5 | 6 | ;;;(declare 7 | ;;; (load 'need.o) (load 'defmac.o) (load 'hunkshell.o) (load 'enode.o) 8 | ;;; (load 'debug.o) (load 'princ.o) (load 'map.o)) 9 | 10 | ;;; (needs-macros) 11 | 12 | (declarespecial 13 | eformlist 14 | enodelist 15 | falsenode 16 | quotednodelist ; a list of dotted pairs of the form (f . n), where f 17 | ; is an enode representing a function, and n is an 18 | ; integer. The pair indicates that the n'th argument of 19 | ; f is implicitly quoted. Only one postition of any 20 | ; function can be implicitly quoted. 21 | ruledepth 22 | truenode 23 | zfunctionnodes 24 | zgenode 25 | zgtnode 26 | zmultnode 27 | ) 28 | ;;;============================================================================ 29 | ;;; eform 30 | 31 | (defun eform (node) ((lambda (eformlist) (cdr (eform2 (eroot node)))) nil)) 32 | 33 | (defun eform2 (root) 34 | (prog (pair temp) 35 | (and (eq root (eroot truenode)) (return '(1 . true))) 36 | (and (eq root (eroot falsenode)) (return '(1 . false))) 37 | (and (setq pair (assq root eformlist)) (return (cdr pair))) 38 | (setq pair (cons root (cons 200000 'printerror))) 39 | (setq eformlist (cons pair eformlist)) 40 | (setq temp (eform3 root 200000 'printerror)) 41 | (cond ((> (car temp) 199999) 42 | (setq eformlist (delq pair eformlist))) 43 | (t (rplacd pair temp))) 44 | (return temp))) 45 | 46 | (defun eform3 (finish oldsize oldform) 47 | (prog (form x) 48 | (setq x (eqclass finish)) 49 | a (setq form (eform4 x)) 50 | (cond ((numberp (cdr form)) (return form)) 51 | ((> oldsize (car form)) (setq oldsize (car form)) 52 | (setq oldform (cdr form)))) 53 | (and (eq x finish) (return (cons oldsize oldform))) 54 | (setq x (eqclass x)) 55 | (go a))) 56 | 57 | (defun eform4 (node) 58 | (prog (form) 59 | (setq form (esuccessors node)) 60 | (return (cond ((econgruent node) '(200000 . printerror)) 61 | ((eprinttag node) '(200000 . printerror)) 62 | ((atomp form) (cons 1 form)) 63 | ((eq (eroot (car form)) (eroot zgenode)) 64 | (ppzge (cadr form) (caddr form) nil)) 65 | ((eq (eroot (car form)) (eroot zgtnode)) 66 | (ppzge (cadr form) (caddr form) t)) 67 | ((eq (eroot (car form)) (eroot zmultnode)) 68 | (ppzmult (cadr form) (caddr form))) 69 | ((and (memq (car form) zfunctionnodes) 70 | (zterm node)) 71 | (ppzterm node)) 72 | ((assq (car form) quotednodelist) 73 | (eform7 (eform5 form 0 nil 74 | (cdr (assq (car form) 75 | quotednodelist))))) 76 | (t (eform7 (eform5 form 0 nil -1))))))) 77 | 78 | (defun eform5 (l size form n) 79 | (prog (pair) 80 | (or l (return (cons size form))) 81 | (setq pair (cond ((= n 0) (eform4 (car l))) 82 | (t (eform2 (eroot (car l)))))) 83 | (and (> (car pair) 199999) (return pair)) 84 | (return (eform5 (cdr l) (+ size (car pair)) 85 | (cons (cdr pair) form) (1- n))))) 86 | 87 | (defun eform7 (pair) 88 | (cond ((> (car pair) 199999) pair) (t (rplacd pair (nreverse (cdr pair)))))) 89 | -------------------------------------------------------------------------------- /src/CPC4/enode.lisp: -------------------------------------------------------------------------------- 1 | "@(#)enode.l 2.5" 2 | 3 | ;;; This file contains macros used to define and manipulate enodes 4 | 5 | ;;;(declare (macros t) 6 | ;;; (load 'need.o) 7 | ;;; (load 'defmac.o) 8 | ;;; (load 'hunkshell.o)) 9 | 10 | ;;; (needs-macros) 11 | 12 | ;;; An enode is a node in a graph that represents an equivalence 13 | ;;; class of forms. Enodes are the fundamental data structure 14 | ;;; used by the simplifier. 15 | 16 | (hunkshell enode 17 | eroot ; The representative node of the equivalence class that 18 | ; contains this node 19 | 20 | eqclass ; Field used to circularly link all the nodes of an 21 | ; equivalence class 22 | 23 | esuccessors ; If this field is an atom, this node represents that 24 | ; atom. If this field is a list, the list contains 25 | ; enodes reprenenting operands in a expression. 26 | 27 | eslength ; If esuccessors is an atom, this field is nil. If 28 | ; esuccessors is a list, this field is the length 29 | ; of that list. 30 | 31 | epredecessors ; A list containing every enode that has this node 32 | ; as a successor. There are no duplicates in 33 | ; predecessor lists. 34 | 35 | econgruent ; If two or more nodes are congruent, all but one 36 | ; has t in its congruent field. 37 | 38 | edemon ; List of partial matches (nodedemons) waiting for 39 | ; this enode to be merged. 40 | 41 | emergedemon ; A list of dotten pairs of the form (n . f), where n 42 | ; is an enode and f is a function. f is called when 43 | ; this enode becomes equivalent to n. 44 | 45 | epattern ; List of patterns whose leftmost symbol is the print 46 | ; name of this atomic node. 47 | 48 | zfield ; If non-nil, this equivalence class represents an 49 | ; arithmetic term. 50 | 51 | eqlength ; Size of equivalence class containing this node. Only 52 | ; valid in root nodes. 53 | 54 | enumber ; A unique integer used for diagnostic purposes. 55 | 56 | eavail ; All allocated enodes are linked through this field. 57 | 58 | eheight ; Used to control pattern matching. 59 | 60 | etype ; Individual provers may store information here. 61 | 62 | eprinttag ; Controls printing. 63 | 64 | edatatype ; Type of data in node 65 | 66 | etypewait ; Queue of transactions waiting for type change 67 | ) 68 | 69 | ; 70 | ; Utility functions for enodes 71 | ; 72 | (defsmac zterm (node) (car (zfield node))) 73 | 74 | (defsmac findzterm (node) 75 | (and (zfield (eroot node)) (zterm (eroot node)))) 76 | 77 | ;;;;(defmac isenode (x) (and (hunkp x) (= (hunksize x) 18))) 78 | (defun isenode (x) (equal (type-of x) 'enode)) 79 | 80 | ;;;============================================================================ 81 | ;;; mapeqclass is used to cycle through an equivalence class and 82 | ;;; do something to every member of the class. f should be an expression 83 | ;;; with 'x' as a free variable. For every enode in the class containing 84 | ;;; l, x is lambda-bound to that enode and f is evaluated. The macro then 85 | ;;; evaulates r and returns the value. (When r is evaluated, x is bound to l.)) 86 | 87 | (defsmac mapeqclass 88 | (f r l) 89 | (prog (x finish) 90 | (setq finish l) 91 | (setq x finish) 92 | a f 93 | (setq x (eqclass x)) 94 | (and (eq x finish) (return r)) 95 | (go a))) 96 | 97 | ;;; mapclass is similar to mapeqclass. The difference is that instead 98 | ;;; of the entire class, only the portion of a class from start to finish 99 | ;;; has f applied to it. The argument r is discarded (not even evaluated). 100 | 101 | (defsmac mapclass 102 | (f r start finish) 103 | (prog (x finishx) 104 | (setq x start) 105 | (setq finishx finish) 106 | a f 107 | (and (eq x finishx) (return nil)) 108 | (setq x (eqclass x)) 109 | (go a))) 110 | 111 | -------------------------------------------------------------------------------- /src/CPC4/generic.lisp: -------------------------------------------------------------------------------- 1 | ; 2 | ; Generic Functions 3 | ; 4 | ; Generic functions are functions whose semantics are type-dependent. 5 | ; 6 | ;;;(declare 7 | ;;; (load 'need.o) (load 'defmac.o) (load 'hunkshell.o) (load 'enode.o)) 8 | (declarespecial 9 | dalltruedef 10 | boolsymand 11 | boolsymeq 12 | boolsymimplies 13 | boolsymnot 14 | boolsymor 15 | booleantype 16 | universaltype 17 | ) 18 | ; 19 | ; dalltruedef -- demon for alltrue 20 | ; 21 | ; 22 | ; if n is boolean 23 | ; (alltrue! n) == X 24 | ; if n is array 25 | ; (alltrue! n) == (allarraytrue! n lowboundofx highboundofx) 26 | ; if n is record 27 | ; (alltrue! n) == (and! (alltrue! (selectr! n field1)) ...) 28 | ; 29 | ; Note that the forms more complex than the original are asserted with 30 | ; propagate, while those less complex are asserted with emerge. 31 | ; In the case of records, we have no other choice, because 32 | ; we cannot emerge forms containing propositional operators. 33 | ; For simple variables and arrays, the choice is made to optimize 34 | ; performance. 35 | ; 36 | ; There is no danger of looping here because the generated forms 37 | ; always have simpler types than the input form, so eventually 38 | ; the process must terminate. 39 | ; 40 | (defunobj dalltruedef (node matchlist lab pattern) 41 | (prog (n ntype) 42 | (and (dtwait 'dalltruedef node matchlist lab pattern) (return)) ; typ ck 43 | (setq n (cdr (assq 'n matchlist))) 44 | (setq ntype (getdatatype n)) ; type of n 45 | (cond ((eq (car ntype) (car booleantype)) ; if boolean 46 | (emerge node (enode n)) ; node = n 47 | (return)) ; done 48 | ((and (eq (car ntype) 'array) ; if array 49 | (eq (caadr ntype) 'subrange); and subscript subrange 50 | (cadadr ntype) ; and low bound nonnil 51 | (caddadr ntype)) ; and high bound nonnil 52 | (propagate (list boolsymeq node ; node = arraytrue(node lo hi) 53 | (list 'arraytrue! 54 | n 55 | (cadadr ntype) 56 | (caddadr ntype)))) 57 | (return)) 58 | ((eq (car ntype) 'record) ; if record, big conjunction 59 | (propagate 60 | (booleanequality node 61 | (conjunction 62 | (mapcar 63 | '(lambda (term) 64 | (list 'alltrue! 65 | (list 'selectr! n (car term)) 66 | ) 67 | ) 68 | (cddr ntype))))) ; list of fields 69 | (return)) 70 | (t (return)) ; otherwise no semantics 71 | ))) 72 | ; 73 | ; conjunction -- form conjunction of list of terms 74 | ; 75 | (defun conjunction (lst) 76 | (cond ((null lst) 'true) ; true if none 77 | ((null (cdr lst)) ; if last elt 78 | (car lst)) ; just element 79 | (t (list boolsymand ; otherwise build conjunction 80 | (car lst) 81 | (conjunction (cdr lst)))))) ; otherwise recurse 82 | ; 83 | ; dalltrueselect -- alltrue of select of record/array 84 | ; 85 | ; If the entire object is defined, then any portion of it is defined. 86 | ; 87 | ; alltrue(x) implies alltrue(selectr(x)) 88 | ; alltrue(x) implies alltrue(selecta(x)) 89 | ; 90 | (defunobj dalltrueselect (node matchlist lab pattern) 91 | (prog (a i) 92 | (setq a (cdr (assq 'a matchlist))) 93 | (setq i (cdr (assq 'i matchlist))) 94 | (propagate 95 | (list 'boolsymimplies 96 | (list 'alltrue! a) 97 | node)) 98 | )) 99 | ; 100 | ; initialization 101 | ; 102 | (defun initgeneric () 103 | (makedemon '(alltrue! n) dalltruedef '(n)) 104 | (makedemon '(alltrue! (selectr! a i)) dalltrueselect '(a i)) 105 | (makedemon '(alltrue! (selecta! a i)) dalltrueselect '(a i)) 106 | ) 107 | -------------------------------------------------------------------------------- /src/CPC4/hunkshell.lisp: -------------------------------------------------------------------------------- 1 | "@(#)hunkshell.l 2.2" 2 | 3 | ;;;============================================================================ 4 | ;;; hunkshell 5 | ;;; 6 | ;;; hunkshell simulates record structures using hunks. 7 | ;;; 8 | ;;; For example a node of a sparse matrix of rational numbers might 9 | ;;; contain fields for a numerator, a denominator, fields for its row 10 | ;;; and column, and links to the nodes above and to the left of it. 11 | ;;; We could use the call 12 | ;;; 13 | ;;; (hunkshell matrix-node num den row col up left) 14 | ;;; 15 | ;;; to "define a new type" matrix-node with six components named num, den, 16 | ;;; row, col, up, and left. (Of course no new data type is actually added 17 | ;;; to lisp.) The effect of the call to hunkshell is to define thirteen macros, 18 | ;;; one for creating matrix-nodes, and two for accessing and updating each of 19 | ;;; the six fields. The creation macro is called alloc-matrix-node; a call to 20 | ;;; it returns a hunk that can hold six values. 21 | ;;; In general, the name of the allocation macro is always "alloc-" 22 | ;;; concatenated with the first argument to hunkshell. For each field, 23 | ;;; its corresponding access macro is just the field name; for instance, 24 | ;;; (num x) accesses the num field of x. For each field, the update macro 25 | ;;; is x concatenated with the field name; thus (xnum x y) would update 26 | ;;; the num field of x to y. 27 | 28 | ;;;;(declare (macros t)) 29 | 30 | ;;; OBSOLETE - will not work in Common LISP. Macros syntax has changed. 31 | 32 | ;;;(defun hunkshell macro (l) 33 | ;;; (progn (setq l (cdr l)) 34 | ;;; (cons 'progn 35 | ;;; (cons ''compile 36 | ;;; (cons (define-alloc (car l) (length (cdr l))) 37 | ;;; (append (define-accesses (cdr l) 0) 38 | ;;; (define-updates (cdr l) 0))))))) 39 | 40 | 41 | ;;;(defun define-alloc (name shelllen) 42 | ;;; (list 'defun (concat 'alloc- name) 'macro '(app) 43 | ;;; (list 'quote (list 'makhunk shelllen)))) 44 | 45 | ;;;(defun define-accesses (l n) 46 | ;;; (and l (cons (define-access (car l) n) 47 | ;;; (define-accesses (cdr l) (1+ n))))) 48 | 49 | ;;;(defun define-updates (l n) 50 | ;;; (and l (cons (define-update (car l) n) 51 | ;;; (define-updates (cdr l) (1+ n))))) 52 | 53 | ;;;(defun define-access (name num) 54 | ;;; (list 'defun name 'macro '(app) 55 | ;;; (list 'cons (list 'quote 'cxr) (list 'cons num '(cdr app))))) 56 | 57 | ;;;(defun define-update (name num) 58 | ;;; (list 'defun (concat 'x name) 'macro '(app) 59 | ;;; (list 'list ''rplacx num '(cadr app) '(caddr app)))) 60 | 61 | ; New Common LISP version, using structures instead of hunks. 62 | (defmacro hunkshell (hunkname &rest fields) 63 | (append 64 | (list 'progn 65 | `(defstruct 66 | (,hunkname (:conc-name nil) (:constructor ,(concat 'alloc- hunkname))) ; gen structs, allocator, and access fns 67 | ,@fields)) 68 | (define-updates hunkname fields))) ; gen update fns 69 | 70 | (defun define-updates (hunkname fields) 71 | (map 'list #'(lambda (field) (define-update hunkname field)) fields)) 72 | 73 | ;;;;(defun define-update (hunkname field) ; gen one update function 74 | ;;;; `(defmacro ,(concat 'x field) (recvar newval) (quote (setf (,field recvar) newval)))) 75 | 76 | 77 | (defun define-update (hunkname field) ; gen one update function 78 | `(defun ,(concat 'x field) (recvar newval) 79 | (setf (,field recvar) newval))) 80 | 81 | ;;; We want the above to generate (defmacro xwest (r v) `(setf (west ,r) ,v)) 82 | ;;; Above ought to be a macro, but right now it's a function. Works. 83 | 84 | 85 | -------------------------------------------------------------------------------- /src/CPC4/macros.lisp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/John-Nagle/pasv/04fa44aaabc46b2e231ab83f96b8857dc5977754/src/CPC4/macros.lisp -------------------------------------------------------------------------------- /src/CPC4/makefile: -------------------------------------------------------------------------------- 1 | # 2 | # ************************************************* 3 | # * * 4 | # * The Pascal-F Verifier * 5 | # * * 6 | # * Theorem Prover - Pass 4 * 7 | # * * 8 | # * * 9 | # ************************************************* } 10 | # 11 | #{ 12 | # Permission is hereby given to modify or use, but not for profit, 13 | # any or all of this program provided that this copyright notice 14 | # is included: 15 | # 16 | # Copyright 1985 17 | # 18 | # Ford Motor Company 19 | # The American Road 20 | # Dearborn, Michigan 48121 21 | # 22 | # This work was supported by the Long Range Research Program of 23 | # the Ford Motor Company, and was carried out at Ford Scientific 24 | # Research Labs in Dearborn, Michigan and Ford Aerospace and 25 | # Communications Corporation's Western Development Laboratories 26 | # in Palo Alto, California. 27 | #} 28 | # 29 | # Version 2.26 of 2/24/86 30 | # 31 | # pasver4 -- the simplifier 32 | # 33 | SOURCE = .. 34 | DEST=../bin 35 | PASS4 = $(SOURCE)/CPC4/src 36 | LISPINCL=/usr/local/src/cmd/lisp/franz/h 37 | # 38 | # make with no arguments makes pasver4 39 | # make install makes and installs pasver4 40 | # 41 | 42 | # default rules 43 | l = liszt 44 | .SUFFIXES: 45 | .SUFFIXES: .o .l 46 | .l.o: ; $l $*.l 47 | 48 | o = debug.o defmac.o e.o enode.o hunkshell.o main.o map.o pform.o \ 49 | pp.o princ.o setup.o ruleprep.o z.o ze.o need.o pipeopen.o \ 50 | timer.o newsplit.o newsimp.o normalize.o builtin.o eventtran.o \ 51 | type.o typee.o eform.o generic.o 52 | 53 | all: pasver4 54 | install: pasver4 55 | -rm -f $(DEST)/pasver4.old 56 | -mv $(DEST)/pasver4 $(DEST)/pasver4.old 57 | ln pasver4 $(DEST) 58 | obj: $o 59 | 60 | source: debug.l defmac.l e.l enode.l hunkshell.l map.l pform.l pp.l \ 61 | princ.l setup.l ruleprep.l z.l ze.l main.l need.l pipeopen.c \ 62 | makemono.l match.l progvn.l newsplit.l \ 63 | newsimp.l normalize.l builtin.l eventttran.l type.l typee.l \ 64 | eform.l generic.l 65 | 66 | # monolithic simplifier made by dumping lisp 67 | pasver4: $o makemono.l fixes.l 68 | rm -f pasver4 69 | lisp $DIR/newdatabase 26 | case $? in 27 | 0) ;; 28 | *) echo "Trouble processing database $LIB"; exit 1 ;; 29 | esac 30 | # Check for old database 31 | if test -r $DIR/ruledatabase 32 | then # check for change to existing DEFN, which invalidates history 33 | diff $DIR/ruledatabase $DIR/newdatabase > $DIR/rulediffs 34 | grep -s '^<.*DEFN' $DIR/rulediffs 35 | case $? in 36 | 1) echo "No definitions altered or deleted." ;; 37 | *) echo "Definition altered or deleted - will reverify entire program." 38 | rm -f $DIR/history ;; 39 | esac 40 | fi 41 | echo "Installing new database in $DIR" 42 | mv $DIR/newdatabase $DIR/ruledatabase 43 | -------------------------------------------------------------------------------- /src/CPC4/rule.lisp: -------------------------------------------------------------------------------- 1 | ;;; UNUSED FILE 2 | ;;; Rule Insertion 3 | ;;; Version 1.3 of 10/14/82 4 | ;;; 5 | (declare (special freevariables ruletag instantiatetag)) 6 | ; 7 | ; addrule -- add a new rule 8 | ; 9 | (defun addrule (pattern formula variables) 10 | (prog (freevariables f) 11 | (setq freevariables variables) 12 | (setq f (prepattern pattern)) 13 | (rplacd (last f) (ncons (list 'applyrule nil formula))) 14 | (ifexists nil nil nil f))) 15 | 16 | (defunobj applyrule (node pmatchlist lab pattern) 17 | ((lambda (ruletag instantiatetag) 18 | (setq pattern (instantiate pattern)) 19 | (cond (instantiatetag) 20 | (t (propagate pattern)))) 21 | t nil)) 22 | 23 | -------------------------------------------------------------------------------- /src/CPC4/setup.lisp: -------------------------------------------------------------------------------- 1 | ;"@(#)setup.l 2.15" 2 | ;"@(#)setup.l 2.1" 3 | 4 | ;;; 5 | ;;; Load theorem prover 6 | ;;; 7 | 8 | ; needs-macros is called in every file that uses macros. 9 | ; It is also defined as a macro that expands to a comment in every 10 | ; file that uses macros. Thus, if all the macros have been expanded 11 | ; at compile time, the function is not called. However, if uncompiled 12 | ; functions are being loaded, they will call this function, which 13 | ; will load in all the macro files. 14 | 15 | ;;;;(declare (special macros-loaded)) ;;; Not Common LISP 16 | (setq macros-loaded nil) 17 | ;;;; 18 | 19 | (defun needs-macros () 20 | (and (not macros-loaded) 21 | (setq macros-loaded t) 22 | (mapc 'load '(clispcompat.lisp defmac.lisp hunkshell.lisp debug.lisp enode.lisp map.lisp princ.lisp progvn.lisp match.lisp)))) 23 | 24 | (needs-macros) ; bring in all needed macros 25 | 26 | 27 | 28 | ; Clear the translink table so that franz-top-level will use 29 | ; the newly defined print 30 | ;;;;(sstatus translink nil) ;;; Not Common LISP 31 | 32 | ; Control how deep rule instantiation will go 33 | (setq eheightmax 1) ; only 1 rule deep 34 | (setq pheightmax 4) 35 | 36 | ; load the theorem prover 37 | (load "pp.lisp") 38 | (*ppinit 72) 39 | (load "pform.lisp") 40 | (load "z.lisp") 41 | (initz) 42 | 43 | (load "ze.lisp") 44 | (load "e.lisp") 45 | (load "eform.lisp") 46 | (load "newsimp.lisp") 47 | (load "main.lisp") 48 | (load "newsplit.lisp") 49 | (load "normalize.lisp") 50 | (load "builtin.lisp") 51 | (load "generic.lisp") 52 | (load "timer.lisp") 53 | (load "ruleprep.lisp") 54 | (load "eventtran.lisp") 55 | (load "type.lisp") 56 | (load "typee.lisp") 57 | (load "fixes.lisp") ;;; ***TEMP** these functions won't compile right on SUNs! 58 | ;;;;(cfasl 'pipeopen.o '_Lpipeopen 'pipeopen '"function" '"") 59 | 60 | (setq quotednamelist nil) 61 | (setq constantnames '(nil true false omega)) 62 | (setq functionnames '(addi! subi! muli! divi! modi! storea! selecta! storer! 63 | selectr!)) 64 | (setq predicatenames '(lei! gei! lti! gti!)) 65 | (definearithmetic '(addi! subi! muli! gei! gti! lei! lti!)) 66 | (defineboolean) 67 | (definejsyntax) 68 | (simpinit) 69 | (setq prinlevel nil) ;; no summarizing - will break VCG if set 70 | (setq prinlength nil) 71 | ;;;(sstatus translink on) ; ***NOT SURE ABOUT THIS*** 72 | -------------------------------------------------------------------------------- /src/CPC4/simp.lisp: -------------------------------------------------------------------------------- 1 | "@(#)simp.l 2.1" 2 | ; OBSOLETE - code moved to newsimp and normalize 3 | -------------------------------------------------------------------------------- /src/CPC4/timer.lisp: -------------------------------------------------------------------------------- 1 | ;;;(declare 2 | ;;; (load 'need.o) (load 'princ.o) (load 'map.o)) 3 | 4 | ;;;(needs-macros) 5 | 6 | (declarespecial time-list ; a list of functions being charged 7 | time-stack; a list of function names that is used to 8 | ; keep track of who should currently be charged 9 | time-last ; when the function currently being charged, 10 | ; which is (car time-stack) began being charged. 11 | ) 12 | 13 | ; This module is used to figure out where lisp programs are spending 14 | ; their time by using the Lister trace package. The following calls 15 | ; are used: 16 | ; 17 | ; (time-divide '(f1 f2 ... )) 18 | ; 19 | ; This function is used to declare certain functions "special" to the 20 | ; timer. Whenever a special function is entered, runtime is charged 21 | ; to that function until that function is left, except for time during 22 | ; which that function calls another special function. Time not charged 23 | ; to any special function is charged to "other". time-divide should 24 | ; be called only once, before any other part of this package is called. 25 | ; 26 | ; (time-start) 27 | ; 28 | ; This function zeroes all the accounts. 29 | ; 30 | ; (time-print p) 31 | ; 32 | ; This function prints elapsed times on port p. If time-print is called 33 | ; outside a special function, the "other" account is updated. 34 | 35 | (defun time-update () 36 | ; this function charges to the account on the top of the stack all time 37 | ; spent since the last call to time-update 38 | 39 | (prog (acct curtime) 40 | (setq acct (car time-stack)) ; the account to be charged 41 | (setq curtime (ptime)) ; the last tick to be charged to that account 42 | 43 | (putprop acct 44 | (mapcar '+ (get acct 'time) (mapcar '- curtime time-last)) 45 | 'time) 46 | 47 | (setq time-last curtime) 48 | (return nil))) 49 | 50 | (defun time-in (func arg) 51 | ; this function is called when a function is entered. 52 | ; begin charging that function 53 | 54 | (time-update) 55 | (putprop func (1+ (get func 'count)) 'count) 56 | (setq time-stack (cons func time-stack))) 57 | 58 | (defun time-out (func arg) 59 | ; this function is called when a function is left. 60 | ; stop charging that function and begin charging the previous one 61 | 62 | (time-update) 63 | (setq time-stack (cdr time-stack))) 64 | 65 | (defun time-divide (l) 66 | ; Have the tracing package calls time-in and time-out for functions whose 67 | ; names are in l. 68 | (eval 69 | (cons 'trace 70 | (mapcar '(lambda (x) 71 | (cons x 72 | '(traceenter time-in traceexit time-out))) l))) 73 | 74 | ; The above must be done before the following destructive update 75 | 76 | (setq time-list (nconc l '(other))) 77 | (setq time-stack (ncons 'other)) 78 | (setq time-last (ptime)) 79 | (time-start)) 80 | 81 | (defun time-start () 82 | ; clear all the accounts 83 | (mapcone (progn (putprop x '(0 0) 'time) (putprop x 0 'count)) 84 | time-list)) 85 | 86 | (defun print-sec (s p) 87 | ; translate s, which is expressed in units of 1/60 seconds to units 88 | ; of seconds (with two decimal digits) and print the translation on port p 89 | (print (/ s 60) p) 90 | (patom '|.| p) 91 | (setq s (/ (* (mod s 60) 100) 60)) 92 | (print (/ s 10) p) 93 | (print (mod s 10) p)) 94 | 95 | (defun time-print (p) 96 | ; print out all the time accumulated in accounts on port p 97 | (time-update) 98 | (patom '|Time spent in| p) 99 | (terpr p) 100 | (mapcone (prog (time) 101 | (patom '| | p) 102 | (patom x p) 103 | (patom '|: | p) 104 | (setq time (get x 'time)) 105 | (print-sec (car time) p) 106 | (patom '| \ | p) 107 | (print-sec (cadr time) p) 108 | 109 | (patom '| sec. | p) 110 | 111 | ; also output call count 112 | (print (get x 'count) p) 113 | (patom'| calls| p) 114 | (terpr p)) 115 | 116 | time-list)) 117 | -------------------------------------------------------------------------------- /src/CPC4/types.lisp: -------------------------------------------------------------------------------- 1 | ; 2 | ; Type machinery 3 | ; 4 | (declare (special 5 | getftype 6 | begin-decl 7 | end-decl 8 | popdecl 9 | errport 10 | )) 11 | ; 12 | ; getdtype -- get D-type of object 13 | ; 14 | ; The D-type of an object is the type of its definedness part. 15 | ; This is a structure with booleans in place of all the variable parts. 16 | ; 17 | (defun getdtype (var-type) 18 | (cond ((atomp var-type) (break "INTERNAL ERROR - bad type decl")) 19 | ((eqstring (car var-type) 'array) ; if array 20 | (list (car var-type) ; array 21 | (cadr var-type) ; subscript type 22 | (getdtype (caddr var-type)))) ; data type 23 | ((eqstring (car var-type) 'record) ; if record 24 | (append 25 | (list (car var-type) ; 'record 26 | (cadr var-type)) ; type name 27 | (mapcar 'getftype (cddr var-type)))) 28 | (t '(boolean)))) ; if simple type 29 | ; 30 | ; getftype -- get D-type of record field expression 31 | ; 32 | ; A field expression is a two element list of field name and type. 33 | ; 34 | (defun getftype (fieldexpr) 35 | (list (car fieldexpr) (getdtype (cadr fieldexpr)))) 36 | ; 37 | ; vartype -- return type of variable or function name, given 38 | ; only the name. 39 | ; 40 | ; Names are decorated by adding to the end of the name as follows: 41 | ; 42 | ; xxxx! built-in function, no type 43 | ; xxxxv01 variable, value reference 44 | ; xxxxd01 variable, definedness reference 45 | ; xxxx user function (no decoration) 46 | ; 47 | (defun vartype (varname) 48 | (prog (xname xletters xtype plainname vdflag) 49 | (cond ((atomp varname) (return nil))) ; does not apply to atom 50 | (setq xname (car varname)) ; get fn atom or var atom 51 | (cond ((not (atomp xname)) (return nil))); not atom, inapplicable 52 | (setq xletters (reverse (explode xname))); get letters of name 53 | (cond ((eqstring (car xletters) '!) (return nil)) ; built in fn 54 | ((null (cdr varname)) ; if variable, not fn call 55 | ; Simple variable case. 56 | ; Name NEW count must not be 00 - indicates no NEW in VCG 57 | (and (eqstring (car xletters) '|0|) 58 | (eqstring (cadr xletters) '|0|) 59 | (break "-- INTERNAL ERROR in prover - name ends in 00")) 60 | ; Look up undecorated part of decorated name 61 | (setq vdflag (caddr xletters)) ; v or d 62 | ; basename 63 | (setq plainname (implode (reverse (cdddr xletters)))) 64 | ) 65 | (t 66 | ; Function case 67 | (setq vdflag 'v) ; Always value part of fns 68 | (setq plainname xname) ; fn names are undecorated 69 | )) 70 | (setq xtype (get plainname ; now get the type 71 | (cond ((eqstring vdflag 'v) 'vtype) ; if v, get value type 72 | ((eqstring vdflag 'd) 'dtype) ; if d, get def type 73 | (t nil)))) ; otherwise fails 74 | (and (null xtype) 75 | (break 76 | "-- INTERNAL ERROR in prover - undeclared variable")) 77 | (return xtype))) ; return result 78 | ; 79 | ; begin-decl -- begin a J-unit of declarations 80 | ; 81 | (defun begin-decl () 82 | (pushcontext 'decl)) 83 | ; 84 | ; end-decl -- end a J-unit of declarations 85 | ; 86 | ; This function is called to remove all declarations inserted since 87 | ; the last call to begin-decl. 88 | ; 89 | (defun end-decl () 90 | (popcontext 'decl)) 91 | ; 92 | ; popdecl -- called by popcontext to remove a declaration from 93 | ; a property list. 94 | ; 95 | (defunobj popdecl (x) 96 | (remprop x 'dtype) 97 | (remprop x 'vtype)) 98 | ; 99 | ; vardecl -- declare a variable 100 | ; 101 | (defun vardecl (var-name var-type) 102 | ; This function is called to declare a variable that appears in VCs. 103 | ; We trust the caller not to declare a variable more than once in the 104 | ; same j-unit. 105 | ; We check, though, that the user does not define the same function 106 | ; as an interpreted function in a rule and in the program. 107 | (cond ((and (get var-name 'defn) (not (equal var-type '(module)))) 108 | (patom '|FATAL ERROR - "| errport) 109 | (patom var-name errport) 110 | (patom 111 | '|" is both a non-rule function and a rule DEFN.| 112 | errport) 113 | (terpri errport) 114 | (exit 1))) 115 | (putprop var-name var-type 'vtype) ; type of V part 116 | (putprop var-name (getdtype var-type) 'dtype) ; type of D part 117 | (pushcontext (cons popdecl var-name))) 118 | -------------------------------------------------------------------------------- /src/CPC5/getrules.c: -------------------------------------------------------------------------------- 1 | /* 2 | getevents -- extracts EVENT entries from Boyer-Moore library 3 | file. 4 | Version 1.7 of 12/12/85 5 | */ 6 | #include 7 | /* 8 | copyevent -- event has been found - copy it to output 9 | 10 | An event is an expression with balanced parentheses. 11 | */ 12 | copyevent() 13 | { int parens = 0; /* parens seen */ 14 | char ch = 0; /* working char */ 15 | char lastch; /* previous char */ 16 | int didout = 0; /* true if did output */ 17 | for (;;) /* until parens balance */ 18 | { lastch = ch; /* previous char */ 19 | ch = getchar(); /* get next char */ 20 | if (ch == '\n') ch = ' '; /* newline to space */ 21 | if (lastch == ' ' && ch == ' ') continue; /* remove multiple spaces */ 22 | if (ch == '(') parens++; /* if (, inc */ 23 | if (ch == EOF) /* if EOF */ 24 | { fprintf(stderr,"Missing ) at EOF.");/* bad, not balanced */ 25 | exit(1); /* fails */ 26 | } 27 | if (parens) /* if within parens */ 28 | { putchar(ch); /* output this char */ 29 | didout = 1; /* note output */ 30 | } 31 | if (ch == ')') parens--; /* if ), dec */ 32 | if (parens == 0) /* if balanced */ 33 | { if (didout) putchar('\n'); /* finish line */ 34 | return; /* and continue */ 35 | } 36 | } /* end event loop */ 37 | } 38 | #define EVENTLEV 2 /* look for event at this lev */ 39 | main() 40 | { char ch = ' '; /* working char */ 41 | char *keypnt; /* scan pointer */ 42 | short parens = 0; /* parenthesis level */ 43 | for (;;) /* forever */ 44 | { if (ch == 0) ch = EOF; /* null is EOF */ 45 | if (ch == EOF) break; /* handle EOF */ 46 | if (ch == '(') /* if left paren */ 47 | { parens++; /* adjust level */ 48 | ch = getchar(); /* on to next char */ 49 | continue; /* and try again */ 50 | } 51 | if (ch == ')') /* if right paren */ 52 | { if (parens <= 0) /* unbalanced */ 53 | { fprintf(stderr,"Extra ) in library.\n"); 54 | exit(1); /* fails */ 55 | } 56 | parens--; /* count down */ 57 | ch = getchar(); /* on to next char */ 58 | continue; /* and try again */ 59 | } 60 | if (parens != EVENTLEV) /* consider only at lev */ 61 | { 62 | ch = getchar(); /* on to next char */ 63 | continue; /* and try again */ 64 | } 65 | if (ch != ' ') /* if not beginning keypnt */ 66 | { 67 | ch = getchar(); /* get a char */ 68 | continue; /* try again */ 69 | } 70 | /* Start looking for the key word. */ 71 | keypnt = " event "; /* begin scan */ 72 | for (;;) /* check for EVENT */ 73 | { 74 | if (*keypnt++ != ch) 75 | break; /* if not EVENT word */ 76 | if (*keypnt == 0) /* if EVENT word OK */ 77 | { copyevent(); /* copy the event */ 78 | ch = getchar(); /* get next char */ 79 | break; /* out of EVENT state */ 80 | } 81 | ch = getchar(); /* get next char */ 82 | } /* end event scan loop */ 83 | } /* end after newline */ 84 | if (ch == EOF) /* normal exit */ 85 | { printf("STOP\n"); /* finish file */ 86 | exit(0); /* exit */ 87 | } 88 | } 89 | -------------------------------------------------------------------------------- /src/CPC5/getrules.p: -------------------------------------------------------------------------------- 1 | program getrules(input,output); 2 | (* 3 | getrules -- extracts EVENT entries from Boyer-Moore library 4 | file. 5 | Version 1.5 of 12/31/82 6 | *) 7 | const keylength = 6; (* length of key *) 8 | var ch: char; (* working char *) 9 | EOL, EOF: char; (* constants *) 10 | keypos: 0..keylength; (* position in key *) 11 | key: array [1..keylength] of char; (* key to search for *) 12 | endfile, notkey: boolean; (* flags for main *) 13 | (* 14 | getchar -- get character from input 15 | *) 16 | function getchar: char; 17 | var chr: char; (* working char *) 18 | begin 19 | if eof then getchar := EOF (* EOF case *) 20 | else if eoln then begin (* if end of line *) 21 | readln; (* go to next line *) 22 | getchar := EOL; (* return EOL *) 23 | end else begin read(chr); getchar := chr; end;(* otherwise return char *) 24 | end {getchar}; 25 | (* 26 | copyevent -- event has been found - copy it to output 27 | The entire event appears on one line, with level 1 lists 28 | quoted. 29 | *) 30 | procedure copyevent; 31 | var parens: integer; (* parens seen *) 32 | ch: char; (* working character *) 33 | begin 34 | parens := 0; (* parens seen *) 35 | ch := EOF; (* working char *) 36 | repeat 37 | ch := getchar; (* get next char *) 38 | while ch = EOL do ch := getchar; (* ignore newlines *) 39 | if ch = '(' then parens := parens + 1; (* handle paren count *) 40 | if ch = ')' then parens := parens - 1; (* handle paren count *) 41 | if ch = EOF then (* if EOF *) 42 | begin message('Missing ) at EOF.');(* bad, not balanced *) 43 | halt; (* fails *) 44 | end; 45 | write(ch); (* output this char *) 46 | until parens <= 0; (* continue if unbalanced *) 47 | writeln; 48 | end (* copyevent *); 49 | (* 50 | Main program 51 | *) 52 | begin 53 | EOL := chr(10); (* newline *) 54 | EOF := chr(4); (* EOT *) 55 | key := 'EVENT '; (* look for line with this *) 56 | endfile := false; (* not at EOF yet *) 57 | while not endfile do begin (* until EOF *) 58 | begin 59 | while (ch <> EOL) and (not endfile) do ch := getchar; (* skip to EOL *) 60 | if ch = EOL then begin (* if start of line *) 61 | keypos := 0; (* begin string search *) 62 | notkey := false; (* no key try yet *) 63 | repeat (* search for key *) 64 | if keypos = keylength then begin(* if key matched *) 65 | copyevent; (* copy the event *) 66 | notkey := true; (* and skip out *) 67 | end else begin (* if not matched yet *) 68 | ch := getchar; (* get next char *) 69 | keypos := keypos + 1; (* on to next key slot *) 70 | if key[keypos] <> ch then notkey := true; 71 | end; 72 | until notkey; (* until key success or fail *) 73 | end (* end event scan loop *) 74 | end; (* end after newline *) 75 | endfile := endfile or eof; (* note EOF state *) 76 | end; (* end outer loop *) 77 | writeln('STOP'); (* finish file *) 78 | end. 79 | -------------------------------------------------------------------------------- /src/CPC5/jsort.sh: -------------------------------------------------------------------------------- 1 | # This script has been obsoleted by the Pascal program jsort.p 2 | -------------------------------------------------------------------------------- /src/CPC5/main.c: -------------------------------------------------------------------------------- 1 | int errcount; 2 | 3 | main() 4 | { errcount = 0; 5 | yyparse(); 6 | if (errcount) printf("%d syntax errors in jcode\n", errcount); 7 | exit(errcount < 256 ? errcount : 255); 8 | } 9 | 10 | yyerror(s) 11 | char *s; 12 | { extern int yyline; 13 | printf("%d: %s near \"", yyline, s); 14 | print_window(); 15 | printf("\"\n"); 16 | errcount += 1; 17 | } 18 | -------------------------------------------------------------------------------- /src/CPC5/makefile: -------------------------------------------------------------------------------- 1 | 2 | SOURCE=.. 3 | DEST=../bin 4 | PASS5=$(SOURCE)/cpc5/src 5 | # 6 | # Makefile for Verifier utility programs 7 | # 8 | # Version 1.17 of 2/6/86 9 | # 10 | # pasver - the main program of the Verifier (a shell procedure) 11 | # putrules- the utility which moves rules from Boyer-Moore to Verifier 12 | # getrules- a program used by putrules to scan databases. There 13 | # are both C and Pascal versions of getrules; the 14 | # C version is much faster but less portable. 15 | # pasver3b- the main program of the VCG pass; runs vcg and simplifier. 16 | # jcheck - jcode syntax checker 17 | # 18 | # 19 | all: pasver pasver3b putrules getrules jcheck 20 | install: pasver pasver3b putrules getrules jcheck 21 | -rm -f $(DEST)/pasver.old $(DEST)/pasver3b.old $(DEST)/putrules.old \ 22 | $(DEST)/getrules.old $(DEST)/jcheck.old 23 | -mv $(DEST)/pasver $(DEST)/pasver.old 24 | -mv $(DEST)/pasver3b $(DEST)/pasver3b.old 25 | -mv $(DEST)/putrules $(DEST)/putrules.old 26 | -mv $(DEST)/getrules $(DEST)/getrules.old 27 | -mv $(DEST)/jcheck $(DEST)/jcheck.old 28 | ln pasver $(DEST) 29 | ln pasver3b $(DEST) 30 | ln putrules $(DEST) 31 | ln getrules $(DEST) 32 | ln jcheck $(DEST) 33 | # 34 | pasver: pasver.sh; rm -f pasver; cp pasver.sh pasver; chmod 555 pasver 35 | # 36 | pasver3b: jver.c 37 | cc -O jver.c 38 | rm -f pasver3b 39 | mv a.out pasver3b 40 | chmod 555 pasver3b 41 | # 42 | putrules: putrules.sh getrules 43 | rm -f putrules 44 | cp putrules.sh putrules 45 | chmod 555 putrules 46 | # 47 | # getrules -- using C version 48 | # 49 | getrules: getrules.c 50 | cc -O -o getrules getrules.c 51 | chmod 555 getrules 52 | # 53 | # jcheck 54 | # 55 | jcheck: main.o lex.o y.tab.o 56 | cc main.o y.tab.o lex.o 57 | rm -f jcheck 58 | mv a.out jcheck 59 | chmod 555 jcheck 60 | 61 | lex.o: lex.c ; cc -c -O lex.c 62 | main.o: main.c ; cc -c -O main.c 63 | y.tab.c: jcode.y; yacc jcode.y 64 | y.tab.o: y.tab.c; cc -c -O y.tab.c 65 | # 66 | # SCCS dependencies 67 | # 68 | pasver.sh: $(PASS5)/s.pasver.sh; get $(PASS5)/s.pasver.sh 69 | putrules.sh: $(PASS5)/s.putrules.sh; get $(PASS5)/s.putrules.sh 70 | jver.c: $(PASS5)/s.jver.c; get $(PASS5)/s.jver.c 71 | getrules.c: $(PASS5)/s.getrules.c; get $(PASS5)/s.getrules.c 72 | getrules.p: $(PASS5)/s.getrules.p; get $(PASS5)/s.getrules.p 73 | jcode.y: $(PASS5)/s.jcode.y; get $(PASS5)/s.jcode.y 74 | main.c: $(PASS5)/s.main.c; get $(PASS5)/s.main.c 75 | lex.c: $(PASS5)/s.lex.c; get $(PASS5)/s.lex.c 76 | -------------------------------------------------------------------------------- /src/CPC5/pasver.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | #@(#)pasver.sh 1.10 3 | # 4 | # Pascal-F Verifier 5 | # 6 | # Control Program (pasver) 7 | # 8 | # Version 1.10 of 12/10/85 9 | # 10 | # check arguments 11 | # 12 | case $# in 13 | 0) echo "Call: " `basename $0` ' [] ' 14 | exit 1;; 15 | *) ;; 16 | esac 17 | # 18 | # Scan for flags 19 | # 20 | # -d1 Pass 1 debug on 21 | # -d2 Pass 2 debug on 22 | # -d3 Pass 3 (theorem prover and VCG) debug on 23 | # -dvcg VCG logging only on 24 | # -d All debug on 25 | # -f Attempt to prove named routine only (UNIMPL) 26 | # 27 | DEBUG1= 28 | DEBUG2= 29 | DEBUG3= 30 | DEBUGVCG= 31 | DEBUGTHM= 32 | SINGLE= 33 | VCDUMP=p3-vcdump 34 | VCLOG=p3-vcs 35 | for ARG do 36 | case $ARG in 37 | -d1) DEBUG1=-d;; 38 | -d2) DEBUG2=-d;; 39 | -dvcg) DEBUGVCG=$VCLOG;; 40 | -d3) DEBUGTHM=$VCDUMP; DEBUGVCG=$VCLOG;; 41 | -d) DEBUG1=-d 42 | DEBUG2=-d 43 | DEBUGVCG=$VCLOG 44 | DEBUGTHM=$VCDUMP;; 45 | -f*) SINGLE=$ARG;; 46 | -*) echo "Illegal flag: $ARG"; exit 1;; 47 | *) FILE=$ARG;; 48 | esac 49 | done 50 | 51 | case $FILE in 52 | *.pf) ;; 53 | *) echo "File name ${FILE} does not end in .pf" 54 | exit 1 ;; 55 | esac 56 | 57 | if test ! -r $FILE 58 | then echo 'cannot read' $FILE 59 | exit 1 60 | fi 61 | 62 | # if $FILE is of form name.pf, create working directory of 63 | # the form name_d (if necessary), and clean it out (if necessary). 64 | # 65 | workdir=`basename $FILE .pf`_d 66 | mkdir $workdir 2> /dev/null 67 | cd $workdir 68 | rm -f pasf.lp pas-* p2a-* p3-* 69 | 70 | # Execute pass 1 in calling directory 71 | # 72 | cd .. 73 | echo "Pass 1:" 74 | if pasver1 $DEBUG1 $FILE 75 | then : nothing 76 | else echo 'Pass 1 error abort.' 77 | rm pasf-* 78 | exit 1 79 | fi 80 | 81 | # Move files created by pass 1 to working directory 82 | # 83 | cd $workdir 84 | mv ../pasf-* . 85 | 86 | # Execute pass 2 in the working directory 87 | # 88 | echo "Pass 2:" 89 | if pasver2 $DEBUG2 90 | then : nothing 91 | else echo 'Pass 2 error abort.' 92 | exit 1 93 | fi 94 | # Check output of pass 2 95 | # 96 | if test -r p2jcode 97 | then : nothing 98 | else echo 'Pass 2 detected errors.' 99 | exit 1 100 | fi 101 | if jcheck history 111 | fi 112 | 113 | # Execute pass 3 components 114 | # 115 | echo "Pass 3:" 116 | pasver3a 117 | pasver3b $DEBUGVCG $DEBUGTHM | tee p3-diags 118 | 119 | # Save the status returned by pasver3b -- 120 | # (This only works because tee returns a zero.) 121 | rc=$? 122 | 123 | mv newhistory history 124 | exit $rc 125 | -------------------------------------------------------------------------------- /src/CPC5/putrules.sh: -------------------------------------------------------------------------------- 1 | 2 | # 3 | # putrules -- shell procedure to install new rules file for 4 | # given program being verified 5 | # 6 | # Call is newrules BoyerMooreLib VerifierWorkingDir 7 | # 8 | # If a definition has been altered or deleted in the rule file, 9 | # then we have to assume that verifications against the previous 10 | # database are no longer valid and we delete the history file. 11 | # 12 | LIB=$1 13 | DIR=$2 14 | # Check file status 15 | if test ! -r $LIB 16 | then echo "Cannot read $LIB" ; exit 1 17 | fi 18 | if test ! -d $DIR 19 | then echo "$DIR not a directory." exit 1 20 | fi 21 | # Clean up directory 22 | rm -f $DIR/rulediffs $DIR/newdatabase 23 | # Create new database 24 | echo "Processing database $LIB" 25 | getrules < $LIB | sort > $DIR/newdatabase 26 | case $? in 27 | 0) ;; 28 | *) echo "Trouble processing database $LIB"; exit 1 ;; 29 | esac 30 | # Check for old database 31 | if test -r $DIR/ruledatabase 32 | then # check for change to existing DEFN, which invalidates history 33 | diff $DIR/ruledatabase $DIR/newdatabase > $DIR/rulediffs 34 | grep -s '^<.*DEFN' $DIR/rulediffs 35 | case $? in 36 | 1) echo "No definitions altered or deleted." ;; 37 | *) echo "Definition altered or deleted - will reverify entire program." 38 | rm -f $DIR/history ;; 39 | esac 40 | fi 41 | echo "Installing new database in $DIR" 42 | mv $DIR/newdatabase $DIR/ruledatabase 43 | -------------------------------------------------------------------------------- /src/CPC5/ver1.sh: -------------------------------------------------------------------------------- 1 | # This file has been obsoleted by the file pasver.sh 2 | -------------------------------------------------------------------------------- /src/CPC6/makefile: -------------------------------------------------------------------------------- 1 | # 2 | # Makefile for Pascal-F Rule Builder (Franz Lisp version) 3 | # 4 | # Version 1.3 of 2/24/86 5 | # 6 | SOURCE=.. 7 | CPC6=$(SOURCE)/cpc6 8 | 9 | THM=thm 10 | # 11 | # Build the rulebuilder, given the rule base. 12 | # 13 | rulebuilder: verifier.lib verifier.lisp mkrulebld.l 14 | $(THM) < mkrulebld.l 15 | rm -f rulebuilder 16 | mv savedlisp rulebuilder 17 | chmod 555 rulebuilder 18 | # 19 | # Prove the rule base. 20 | # 21 | verifier.lib: 22 | $(THM) < mkveriflib.l 23 | verifier.lisp: 24 | 25 | # 26 | # SCCS dependencies 27 | # 28 | mkrulebld.l: $(CPC6)/src/s.mkrulebld.l ; get $(CPC6)/src/s.mkrulebld.l 29 | mkveriflib.l: $(CPC6)/src/s.mkveriflib.l ; get $(CPC6)/src/s.mkveriflib.l 30 | -------------------------------------------------------------------------------- /src/Design/README.md: -------------------------------------------------------------------------------- 1 | # Internal design documents 2 | 3 | The PDF files can be made from the ".mm" files with the makefile. This requires GNU "groff". 4 | -------------------------------------------------------------------------------- /src/Design/bold.c: -------------------------------------------------------------------------------- 1 | 2 | /* 3 | Overprint N times 4 | */ 5 | #include 6 | #define OVERPRINTS 5 /* times to overprint */ 7 | #define LINEL 250 /* max line length */ 8 | char line[LINEL]; /* working line */ 9 | int linel; /* pos in line */ 10 | /* 11 | get a line, return EOF or \n 12 | */ 13 | char getline() 14 | { 15 | char ch; /* working char */ 16 | linel = 0; /* chars in line */ 17 | for (;;) 18 | { ch = getchar(); /* get next char */ 19 | if (ch == '\n') break; /* done */ 20 | if (ch == EOF) break; /* done */ 21 | if (linel >= LINEL) /* if line too long */ 22 | { fprintf(stderr,"Line too long.\n"); /* so state */ 23 | exit(1); /* fails */ 24 | } 25 | line[linel++] = ch; /* save char */ 26 | } 27 | return(ch); /* return EOF or char */ 28 | } 29 | 30 | main() 31 | { int i; 32 | while (getline() != EOF) /* while not EOF */ 33 | { for (i = 0; i < OVERPRINTS; i++) /* for overstrikes */ 34 | { fwrite(line,linel,1,stdout); /* write the line */ 35 | putchar('\r'); /* begin overprint */ 36 | } 37 | putchar('\n'); /* finish the line */ 38 | } 39 | } 40 | -------------------------------------------------------------------------------- /src/Design/cpci1.mm: -------------------------------------------------------------------------------- 1 | .nr Hc 2 2 | .nr Hs 9 3 | .nr Hb 9 4 | .nr Ej 0 5 | .rm ul 6 | .rm cu 7 | .ND "2/7/83" 8 | .TL 9 | Pascal-F Verifier Internal Design Document 10 | 11 | CPCI #1 -- Syntactic Processing 12 | .AF "FACC / Palo Alto" 13 | .AU "Scott D. Johnson" 14 | .AU "John Nagle" 15 | .PF "'Draft 1.3'CPCI #1 -- Syntactic Processing'2/7/83'" 16 | .MT 4 17 | .SA 1 18 | .H 1 "Introduction" 19 | Phase 1 of the Pascal-F Verifier is a modified version of the 20 | Pascal-F compiler. 21 | Much of the same source text is used in both systems. 22 | The source text is divided into the sections given below. 23 | Both the first pass of the Verifier and a modified first pass of the 24 | compiler can be made from these files. 25 | The first pass of the compiler is built by compiling P1X-CMP.p; 26 | the first pass of the Verifier is built by compiling P1X-VER.p. 27 | The modified first pass of the 28 | compiler accepts the syntax defined in the Verifier manual but discards 29 | all verifier-only items. 30 | .H 1 "Source files" 31 | .VL 22 2 32 | .LI "ERMSG-TXT" 33 | Error message text. The program looks for this file in 34 | /usr/p/frl/bin.d/ERMSG-TXT when looking up error messages. 35 | Used both by the compiler and the Verifier. 36 | .LI "P1X-CMP.p" 37 | Main for compiler; consists only of includes. 38 | .LI "P1X-PAS00.i" 39 | Compiler/verifier common files. 40 | .LI "P1X-PAS01.i" 41 | .LI "P1X-PAS02.i" 42 | .LI "P1X-PAS03.i" 43 | .LI "P1X-PAS04.i" 44 | .LI "P1X-PAS05.i" 45 | .LI "P1X-PAS06.i" 46 | .LI "P1X-PAS07.i" 47 | .LI "P1X-PAS08.i" 48 | .LI "P1X-PAS09.i" 49 | .LI "P1X-PAS10.i" 50 | .LI "P1X-PAS11.i" 51 | .LI "P1X-PAS12.i" 52 | .LI "P1X-PAS13.i" 53 | .LI "P1X-PAS14.i" 54 | .LI "P1X-UNIX00.i" 55 | Unix-only files, used by both compiler and Verifier when running on UNIX. 56 | .LI "P1X-UNIX01.i" 57 | .LI "P1X-UNIX02.i" 58 | .LI "P1X-UNIX03.i" 59 | .LI "P1X-VER.p" 60 | Verifier main program; consists only of includes. 61 | .LI "P1X-VER00.h" 62 | Verifier definitions file for constants. 63 | This file is also used by pass 2 of the Verifier. 64 | .LI "P1X-VER00.i" 65 | Verifier constants not needed in pass 2. 66 | .LI "P1X-VER01.h" 67 | Verifier definitions file for types. 68 | This file is also used by pass 2 of the Verifier. 69 | .LI "P1X-VER02.i" 70 | Verifier variables. 71 | .LI "P1X-VER07.i" 72 | Code added for verifier use is here, where entire procedures and functions 73 | were added. The primary addition is the symbol table output processor, 74 | which produces the file "pasf-vars". 75 | .LE 76 | .H 1 "Inputs and outputs" 77 | .H 2 "Input files" 78 | The only input file is the source program. Includes are understood with 79 | Pascal-F include syntax but with UNIX pathnames in the include form. 80 | .H 2 "Output files" 81 | .VL 22 2 82 | .LI "pasf-data" 83 | VALUE clause constant values; always produced. 84 | .LI "pasf-files" 85 | List of files included; used with pasf-source to get the names of files 86 | for diagnostics. This is a text file. 87 | .LI "pasf-icode" 88 | The ICODE (or RCODE) file; used by both the compiler and the verifier. 89 | .LI "pasf-source" 90 | Source code in a format for random access lookup; 91 | produced only by Verifier and used by pass 2 to produce diagnostics. 92 | .LI "pasf-symbols" 93 | Symbol table for compiler; produced by both versions. 94 | .LI "pasf-vars" 95 | Variable file for verifier; produced only by Verifier version. 96 | .LE 97 | -------------------------------------------------------------------------------- /src/Design/cpci1.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/John-Nagle/pasv/04fa44aaabc46b2e231ab83f96b8857dc5977754/src/Design/cpci1.pdf -------------------------------------------------------------------------------- /src/Design/cpci2.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/John-Nagle/pasv/04fa44aaabc46b2e231ab83f96b8857dc5977754/src/Design/cpci2.pdf -------------------------------------------------------------------------------- /src/Design/cpci3.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/John-Nagle/pasv/04fa44aaabc46b2e231ab83f96b8857dc5977754/src/Design/cpci3.pdf -------------------------------------------------------------------------------- /src/Design/cpci4.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/John-Nagle/pasv/04fa44aaabc46b2e231ab83f96b8857dc5977754/src/Design/cpci4.pdf -------------------------------------------------------------------------------- /src/Design/cpci5.mm: -------------------------------------------------------------------------------- 1 | .nr Hc 2 2 | .nr Hs 9 3 | .nr Hb 9 4 | .nr Ej 0 5 | .nr Pt 0 6 | .rm ul 7 | .rm cu 8 | .TL 9 | Pascal-F Verifier Internal Design Document 10 | 11 | CPCI #5 -- Main Control Program and Other Utilities 12 | .AF "FACC / Palo Alto" 13 | .AU "John Nagle" JBN "" "Software Technology" 14 | .PH "''Pascal-F Verifier Design'Page \\\\nP'" 15 | .PF "'Draft 1.2'CPCI #5 -- Main Control Program'2/7/83'" 16 | .MT 4 17 | .SA 1 18 | .H 1 "Introduction" 19 | CPCI #5 is a collection of small parts of the Verifier. Each of the 20 | programs here is quite small and is documented with comments in the 21 | source text. Here, only an overview is provided. 22 | .H 1 "Pasver" 23 | The main control program is the program invoked when the user types 24 | .DS 25 | pasver 26 | .DE 27 | and is a UNIX Bourne shell procedure. It loads, in order, the 28 | programs 29 | .B pasver1, 30 | .B pasver2, 31 | .B jcheck, 32 | and 33 | .B jver. 34 | The use of 35 | .B pasver 36 | is described in the Verifier manual. 37 | .H 1 "Jcheck" 38 | Jcheck is a syntax checker for the internal form 39 | .B jcode 40 | emitted by 41 | .B pasver2 42 | and read by 43 | .B jver. 44 | It has no other function than to catch internal errors in 45 | .B pasver2. 46 | Although it has no function other than internal error trapping, it is always 47 | run, just as a safety measure. 48 | .H 1 "Putrules" 49 | Putrules is a Bourne shell procedure for moving rules from a Boyer-Moore 50 | knowledge base to a Verifier database. 51 | The use of 52 | .B putrules 53 | is described in the Verifier manual. 54 | It invokes 55 | .B getrules. 56 | .H 1 "Getrules" 57 | .B Getrules 58 | is a program which does the work of scanning a Boyer-Moore database 59 | and finding all Boyer-Moore events. Events are copied to the output; other 60 | items in the database are ignored. 61 | There are two versions of 62 | .B getrules, 63 | one in C and one in Pascal. They function identically but the C version is 64 | about 10 times as fast. 65 | -------------------------------------------------------------------------------- /src/Design/cpci5.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/John-Nagle/pasv/04fa44aaabc46b2e231ab83f96b8857dc5977754/src/Design/cpci5.pdf -------------------------------------------------------------------------------- /src/Design/cpci6.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/John-Nagle/pasv/04fa44aaabc46b2e231ab83f96b8857dc5977754/src/Design/cpci6.pdf -------------------------------------------------------------------------------- /src/Design/icode.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/John-Nagle/pasv/04fa44aaabc46b2e231ab83f96b8857dc5977754/src/Design/icode.pdf -------------------------------------------------------------------------------- /src/Design/icodechg.mm: -------------------------------------------------------------------------------- 1 | .nr Hc 2 2 | .nr Hs 9 3 | .nr Hb 9 4 | .nr Ej 0 5 | .nr Pt 0 6 | .rm ul 7 | .rm cu 8 | .TL 9 | Pascal-F Verifier Internal Design Document 10 | 11 | Icode Changes by Compiler Level 12 | .AF "FACC / Palo Alto" 13 | .AU "John Nagle" JBN "" "Software Technology" 14 | .PH "''Pascal-F Verifier Design'Page \\\\nP'" 15 | .PF "'Draft 1.2'Icode Changes by Compiler Level'4/6/83'" 16 | .MT 4 17 | .SA 1 18 | .HU "Introduction" 19 | From time to time, Ed Nelson at Ford Motor 20 | Scientific Research Lab releases a new version of 21 | the Pascal-F compiler. This usually contains undocumented changes in the 22 | format of the intermediate code produced by Pass 1. This document 23 | covers the undocumented changes found by comparing versions of the compiler. 24 | .HU "Changes found between versions 1.5c to 1.8" 25 | .AL 26 | .LI 27 | The offset argument of the FIELD operator is now a word rather than a byte. 28 | .LI 29 | The temporary number of an RTEMP is now a word rather than a byte. 30 | .LI 31 | The temporary number of an DTEMP is now a word rather than a byte. 32 | .LI 33 | The routine number of the CALL operator is now a word rather than a byte, 34 | and that field is now last. 35 | .LI 36 | The INVOK operator now takes a word rather than a byte, but is unimplemented. 37 | .LI 38 | The ENABL operator now generates a REFER before the signal rather than 39 | referencing the signal directly. 40 | .LI 41 | The count of cases for the CASE statement is now a word rather than a byte. 42 | .LE 43 | -------------------------------------------------------------------------------- /src/Design/icodechg.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/John-Nagle/pasv/04fa44aaabc46b2e231ab83f96b8857dc5977754/src/Design/icodechg.pdf -------------------------------------------------------------------------------- /src/Design/installbm.mm: -------------------------------------------------------------------------------- 1 | .nr Hc 2 2 | .nr Hs 9 3 | .nr Hb 9 4 | .nr Ej 2 5 | .nr Pt 0 6 | .rm ul 7 | .rm cu 8 | .TL 9 | Pascal-F Verifier Internal Design Document 10 | 11 | Changes required to run Boyer-Moore Theorem Prover 12 | on stock Version 4 TOPS-20. 13 | .AF "FACC / Palo Alto" 14 | .AU "John Nagle" JBN "" "Software Technology" 15 | .PH "''Pascal-F Verifier Design'Page \\\\nP'" 16 | .PF "'Draft 1.3'CPCI #6 -- Theorem Prover Installation'2/17/83'" 17 | .MT 4 18 | .SA 1 19 | Assuming that INTERLISP was not previously available, the following 20 | changes appeared to be required: 21 | .AL 22 | .LI 23 | The file LISP.SAV must be renamed LISP.EXE. 24 | .LI 25 | The same change applies to other executable files. 26 | .LI 27 | To run MAKESYSOUT, it is necessary to change MAKESYSOUT 28 | so that LISP is invoked with "RUN LISP" instead of 29 | just "LISP". 30 | .LI 31 | The file TOPS20.RELEASE must be created. I put a 32 | "3", in here, matching SRI, even though our system runs 33 | version 4. This may be questionable. 34 | .LI 35 | The file CLAUSIFY.COM had to be filled with a null readable 36 | LISP makefile before MAKESYSOUT would run. I used 37 | .DS 38 | (CAR NIL) 39 | STOP 40 | .DE 41 | which worked. 42 | .LI 43 | The prover, when compiling a DEFN, sends the message output of 44 | the INTERLISP compiler to the device "NIL:". This device apparently 45 | is non-standard. It does not exist on 46 | our system. 47 | .LE 48 | -------------------------------------------------------------------------------- /src/Design/installbm.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/John-Nagle/pasv/04fa44aaabc46b2e231ab83f96b8857dc5977754/src/Design/installbm.pdf -------------------------------------------------------------------------------- /src/Design/intro.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/John-Nagle/pasv/04fa44aaabc46b2e231ab83f96b8857dc5977754/src/Design/intro.pdf -------------------------------------------------------------------------------- /src/Design/irdprop.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/John-Nagle/pasv/04fa44aaabc46b2e231ab83f96b8857dc5977754/src/Design/irdprop.pdf -------------------------------------------------------------------------------- /src/Design/jcode.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/John-Nagle/pasv/04fa44aaabc46b2e231ab83f96b8857dc5977754/src/Design/jcode.pdf -------------------------------------------------------------------------------- /src/Design/jnotes.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/John-Nagle/pasv/04fa44aaabc46b2e231ab83f96b8857dc5977754/src/Design/jnotes.pdf -------------------------------------------------------------------------------- /src/Design/jtovc.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/John-Nagle/pasv/04fa44aaabc46b2e231ab83f96b8857dc5977754/src/Design/jtovc.pdf -------------------------------------------------------------------------------- /src/Design/makefile: -------------------------------------------------------------------------------- 1 | # Makefile for verifier internal documentation 2 | # 3 | # John Nagle 4 | # January, 2017 5 | # 6 | # Currently uses "groff" to make PDF files. 7 | # 8 | TARGET=. 9 | GROFF=groff 10 | GOPTIONS=-m mm -Tpdf -Kutf8 11 | PICFIXCMD=python3 ../Util/picfix.py -t 4 12 | 13 | %.pdf: %.mm $(DEPS) 14 | $(GROFF) $(GOPTIONS) $< > $(TARGET)/$@ 15 | #### $(PICFIXCMD) $< | $(GROFF) $(GOPTIONS) > $(TARGET)/$@ 16 | 17 | all: cpci1.pdf cpci1.pdf cpci2.pdf cpci3.pdf cpci4.pdf cpci5.pdf cpci6.pdf \ 18 | icode.pdf icodechg.pdf installbm.pdf intro.pdf irdprop.pdf \ 19 | jcode.pdf jnotes.pdf jtovc.pdf practical.pdf restrict.pdf \ 20 | safemulti.pdf scott.pdf 21 | 22 | cpci1.pdf: cpci1.mm 23 | 24 | cpci2.pdf: cpci2.mm 25 | 26 | cpci3.pdf: cpci3.mm 27 | 28 | cpci4.pdf: cpci4.mm 29 | 30 | cpci5.pdf: cpci5.mm 31 | 32 | cpci6.pdf: cpci6.mm 33 | 34 | icode.pdf: icode.mm 35 | 36 | icodechg.pdf: icode.mm 37 | 38 | installlbm.pdf: installlbm.mm 39 | 40 | intro.pdf: intro.mm 41 | 42 | irdprop.pdf: irdprop.mm 43 | 44 | jcode.pdf: jcode.mm 45 | 46 | jnotes.pdf: jnotes.mm 47 | 48 | jtovc.pdf: jtovc.mm 49 | 50 | practical.pdf: practical.mm 51 | 52 | restrict.pdf: restrict.mm 53 | 54 | safemulti.pdf: safemulti.mm 55 | 56 | scott.pdf: scott.mm 57 | -------------------------------------------------------------------------------- /src/Design/makelp: -------------------------------------------------------------------------------- 1 | for FILE do 2 | get s.$FILE.m 3 | nroff -mm -Tlp $FILE.m > $FILE.lp 4 | done 5 | -------------------------------------------------------------------------------- /src/Design/practical.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/John-Nagle/pasv/04fa44aaabc46b2e231ab83f96b8857dc5977754/src/Design/practical.pdf -------------------------------------------------------------------------------- /src/Design/restrict.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/John-Nagle/pasv/04fa44aaabc46b2e231ab83f96b8857dc5977754/src/Design/restrict.pdf -------------------------------------------------------------------------------- /src/Design/safemulti.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/John-Nagle/pasv/04fa44aaabc46b2e231ab83f96b8857dc5977754/src/Design/safemulti.pdf -------------------------------------------------------------------------------- /src/Design/scott.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/John-Nagle/pasv/04fa44aaabc46b2e231ab83f96b8857dc5977754/src/Design/scott.pdf -------------------------------------------------------------------------------- /src/Examples/actuator.h: -------------------------------------------------------------------------------- 1 | { All type declarations follow } 2 | type 3 | message = packed array [1..5] of char; 4 | act_name = packed array[1..13] of char; 5 | const 6 | current = 3B; { channel 3 A/D W/DMA } 7 | batt_volts = 2; { channel 1 A/D W/DMA } 8 | egr_vent = 2B; { HS02 } 9 | egr_press = 3B; { HS03 } 10 | therm_air_dmp = 4B; { HS05 } 11 | can_prg_sig = 6B; { HS06 } 12 | fuel_pmp = 7B; { HS07 } 13 | time_int = 17B; { INT #2 } 14 | off = 0; { HS0 off command } 15 | on = 20B; { HS0 on command } 16 | { Actuator errors } 17 | short = 1; 18 | noise = 2; 19 | normal = 3; 20 | stuck = 4; 21 | open = 5; 22 | 23 | { New const } 24 | no_samples = 4; 25 | sample_time = 500; { 500 microsecond sample period } 26 | end_sample = 127; { size of amps sample - compiler limit } 27 | one_millisec = 417; 28 | twen_mil_delay = 8334; { 20 millisec delay } 29 | forty_millisec = 16667; 30 | fifty_usec_dly = 21; { ?????? 200 us. A/D switching time ????? } 31 | two_hund_udly = 209; { reduce when sample loop is optimized } 32 | LF = chr(12B); { ASCII line feed } 33 | CR = chr(15B); { ASCII carriage return } 34 | 35 | msg1 ='SHORT'; 36 | msg2 ='NOISE'; 37 | msg3 ='NORML'; 38 | msg4 ='STUCK'; 39 | msg5 ='OPEN '; 40 | msg6 ='EGR VENT '; 41 | msg7 ='EGR PRESSURE '; 42 | msg8 ='THERM DUMP '; 43 | msg9 ='THERM BYPASS '; 44 | msg10='CANISTER PRGE'; 45 | msg11='FUEL PUMP '; 46 | msg12='TEST ERROR '; 47 | msg13='SYSTEM O.K. '; 48 | 49 | {EECIV interrupt Mask bit map Vector address} 50 | spare = 2B; {300} 51 | hsi1 = 20B; {302} 52 | ad_done = 200B; {304} 53 | hs02 = 10B; {306} 54 | clk_ovf = 100B; {310} 55 | hs01 = 4B; {312} 56 | hsi0 = 40B; {314} 57 | hsi_in_avail = 1B; {316} 58 | 59 | var 60 | actuator :0..fuel_pmp; 61 | sample_start, 62 | short_cntr, 63 | any_offset, 64 | amps_prev, 65 | time_dif, 66 | test_group :integer; 67 | amps :array [1..end_sample] of integer; {debug - should be 200 limit} 68 | errors :array [0..fuel_pmp] of 0..open; {should be short..open} 69 | prev_error :array [0..fuel_pmp] of 0..open; { should be short..open } 70 | max_current, 71 | volts, 72 | epsilon, 73 | old_data, 74 | neg_slope, { counts when slope < 0 for normal detect } 75 | prev_theta, { previous value of theta } 76 | prev_sigh, { previous value of sigh } 77 | noise_cnt, { counter for noise in amps sample space } 78 | theta, { used to calculate slope and proj_point } 79 | sigh, { used to calculate slope and proj_point } 80 | slope, { slope of small portion of amps trace } 81 | last_i, { posn of amp array that is to be removed from 82 | the rolling point predictor } 83 | calc_l, { calculated inductance } 84 | exp_l, { expected unloaded inductance } 85 | proj_point, { projected point } 86 | open_cntr, { counter for open actuator conditions } 87 | 88 | { Fixed point problem fixers } 89 | point5_x_exp_l, 90 | point2_x_pr_p : integer; 91 | point05_prev_i: integer; 92 | point2_x_amppr: integer; 93 | 94 | j :1..5; { message pointer } 95 | m :1..13; { message pointer } 96 | exp_i :array [1..end_sample] of integer; 97 | i :1..end_sample; { debug - should be 200 limit } 98 | error :short..open; 99 | short_mes :message; 100 | noise_mes :message; 101 | norm_mes :message; 102 | stk_mes :message; 103 | open_mes :message; 104 | 105 | egr :act_name; 106 | egr_p :act_name; 107 | thrm_dmp :act_name; 108 | thrm_byp :act_name; 109 | can_prg :act_name; 110 | fyool_pump :act_name; 111 | tst_err :act_name; 112 | sys_cool :act_name; 113 | sys_ok :boolean; 114 | a :integer; { debug var } 115 | sample_stop: 1..end_sample; 116 | k :integer; 117 | -------------------------------------------------------------------------------- /src/Examples/angle1.pf: -------------------------------------------------------------------------------- 1 | program angle; 2 | type angle = 0..359; { angle in degrees } 3 | { 4 | anglesub - absolute difference between two angles. 5 | } 6 | procedure anglediff(a,b: angle; var diff: angle); 7 | begin 8 | if a > b then 9 | diff := b - a 10 | else 11 | diff := a - b; 12 | if diff > 180 then diff := 360 - diff; 13 | end {anglediff}; 14 | begin 15 | {no main program} 16 | end. 17 | -------------------------------------------------------------------------------- /src/Examples/bubble.pf: -------------------------------------------------------------------------------- 1 | program bubble; 2 | { 3 | The Bubble Sort -- A Classic Verification Example 4 | } 5 | const lim = 100; 6 | maxint = 32767; { max cardinal } 7 | type tableix = 0..lim; 8 | cardinal = 0..maxint; 9 | table = array [tableix] of cardinal; 10 | { 11 | Rule functions 12 | } 13 | rule function ordered(a: table; i: tableix; j: tableix): boolean; begin end; 14 | rule function arraymin(a: table; i: tableix; j: tableix): cardinal; begin end; 15 | rule function arraymax(a: table; i: tableix; j: tableix): cardinal; begin end; 16 | { 17 | sort -- sort array, returning sorted array 18 | } 19 | procedure sort(a: table); 20 | var i,j: tableix; { loop indices } 21 | t: cardinal; { holder for swap } 22 | begin 23 | for i := lim downto 1 do begin { outer loop } 24 | state(defined(i), { outer invariant } 25 | ordered(a,i,lim), 26 | (i < lim) implies (arraymax(a,0,i) <= arraymin(a,i+1,lim))); 27 | for j := 0 to i - 1 do begin { inner loop } 28 | state(defined(i), defined(j), { inner invariant } 29 | ordered(a,i,lim), 30 | (i < lim) implies (arraymax(a,0,i) <= arraymin(a,i+1,lim)), 31 | (j > 0) implies (arraymax(a,0,j-1) <= a[j])); 32 | if a[j] > a[j+1] then begin { if out of order } 33 | t := a[j]; { swap } 34 | a[j] := a[j+1]; 35 | assert((i < lim) implies (arraymax(a,0,i) 36 | <= arraymin(a,i+1,lim))); 37 | assert(ordered(a,i,lim)); { ordered not destroyed } 38 | assert(ordered(a,i+1,lim)); { ordered still true within } 39 | a[j+1] := t; 40 | assert(ordered(a,i+1,lim)); { ordered still true within } 41 | { cases } 42 | assert(not (j > (i - 1))); { not wrong way } 43 | assert((j = (i - 1)) implies (ordered(a,i,lim))); 44 | assert((j < (i - 1)) implies (ordered(a,i,lim))); 45 | assert(ordered(a,i,lim)); { ordered still holds } 46 | end; 47 | end; { end inner loop } 48 | assert(ordered(a,i,lim)); { ordered not destroyed } 49 | assert(a[i-1] <= a[i]); { ordered at a[i] } 50 | end; { end outer loop } 51 | end {sort}; 52 | {dummy main} 53 | begin end. 54 | -------------------------------------------------------------------------------- /src/Examples/bufutil.pf: -------------------------------------------------------------------------------- 1 | program bufutil; 2 | { 3 | Circular Buffering Module Version 1.2 of 1/14/83 4 | } 5 | monitor buflib priority 5; 6 | exports bufget, bufput, bufinit, buffer; 7 | const bufsize = 20; 8 | type bufindex = 1..20; { position in buffer } 9 | bufarray = array [bufindex] of char; 10 | buffer = record { buffer structure } 11 | bufin: bufindex; { next position to insert } 12 | bufout: bufindex; { next position to read } 13 | bufcount: 0..bufsize; { chars in buffer } 14 | buf: bufarray; { the buffer itself } 15 | end; 16 | { 17 | bufvalid -- buffer valid predicate 18 | } 19 | proof function bufvalid(b: buffer): boolean; 20 | invariant defined(b); { the buffer is always defined } 21 | { buffer sanity } 22 | ((b.bufout + b.bufcount) = b.bufin) 23 | or 24 | ((b.bufout + b.bufcount - bufsize) = b.bufin); 25 | begin 26 | end {bufvalid}; 27 | { 28 | bufput -- put in buffer 29 | } 30 | function bufput(var b: buffer; { the buffer } 31 | ch: char) { char to insert } 32 | : boolean; { returns true if insert OK } 33 | invariant bufvalid(b); { buffer remains valid } 34 | begin 35 | if b.bufcount < bufsize then begin { if buffer not full } 36 | b.bufcount := b.bufcount + 1; { increment buffer count } 37 | b.buf[b.bufin] := ch; { store char in buffer } 38 | assert(defined(b.buf,1,bufsize));{ array still defined } 39 | if b.bufin = bufsize then { if at max } 40 | b.bufin := 1 { reset to start } 41 | else b.bufin := b.bufin + 1; { otherwise increment } 42 | bufput := true; { success } 43 | end else begin { if full } 44 | bufput := false; { insert fails } 45 | end; 46 | end {bufput}; 47 | { 48 | bufget -- get from buffer 49 | } 50 | function bufget(var b: buffer; { the buffer } 51 | var ch: char) { char returned } 52 | : boolean; { true if successful } 53 | invariant bufvalid(b); { buffer remains valid } 54 | exit return implies defined(ch); { char only if not empty } 55 | begin 56 | if b.bufcount > 0 then begin { if buffer not empty } 57 | b.bufcount := b.bufcount - 1; { decrement buffer count } 58 | assert(defined(b)); { still all defined } 59 | ch := b.buf[b.bufout]; { get char from buffer } 60 | if b.bufout = bufsize then { if at max } 61 | b.bufout := 1 { reset to start } 62 | else b.bufout := b.bufout + 1; { otherwise increment } 63 | bufget := true; { success } 64 | end else bufget := false; { fails if empty } 65 | end {bufget}; 66 | { 67 | bufinit -- buffer initialization 68 | } 69 | procedure bufinit(var b: buffer); { buffer to be initialized } 70 | exit bufvalid(b); { valid at exit } 71 | var i: bufindex; 72 | begin 73 | for i := 1 to 20 do begin { clear to spaces } 74 | b.buf[i] := ' '; 75 | assert(defined(b.buf,1,i-1)); { still defined up to i-1 } 76 | state(defined(i), 77 | defined(b.buf,1,i)); 78 | end; 79 | b.bufout := 1; { start at 1 } 80 | b.bufin := 1; { end at 1 } 81 | b.bufcount := 0; { length 0 } 82 | end {buflib} 83 | begin {buflib} 84 | end {bufutil}; 85 | var stat: boolean; { status from routines above } 86 | ch: char; { working char } 87 | var b: buffer; { the buffer } 88 | begin {main} 89 | bufinit(b); { initialize the buffer } 90 | init bufutil; 91 | stat := bufput('x'); 92 | stat := bufget(ch); { get a char } 93 | if stat then begin { if we got a char } 94 | end; 95 | end. 96 | -------------------------------------------------------------------------------- /src/Examples/circle.pf: -------------------------------------------------------------------------------- 1 | program circle; 2 | { 3 | Circular Buffering Module Version 1.9 of 1/5/83 4 | } 5 | monitor circlebuf priority 5; 6 | exports bufget, bufput; 7 | const bufsize = 20; 8 | type bufindex = 1..20; { position in buffer } 9 | bufarray = array [bufindex] of char; 10 | buffer = record { buffer structure } 11 | bufin: bufindex; { next position to insert } 12 | bufout: bufindex; { next position to read } 13 | bufcount: 0..bufsize; { chars in buffer } 14 | buf: bufarray; { the buffer itself } 15 | end; 16 | var b: buffer; { the buffer } 17 | invariant defined(b); { the buffer is always defined } 18 | { buffer sanity } 19 | ((b.bufout + b.bufcount) = b.bufin) 20 | or 21 | ((b.bufout + b.bufcount - bufsize) = b.bufin); 22 | { 23 | bufput -- put in buffer 24 | } 25 | function bufput(ch: char) { char to insert } 26 | : boolean; { returns true if insert OK } 27 | begin 28 | if b.bufcount < bufsize then begin { if buffer not full } 29 | b.bufcount := b.bufcount + 1; { increment buffer count } 30 | b.buf[b.bufin] := ch; { store char in buffer } 31 | assert(defined(b.buf,1,bufsize));{ array still defined } 32 | if b.bufin = bufsize then { if at max } 33 | b.bufin := 1 { reset to start } 34 | else b.bufin := b.bufin + 1; { otherwise increment } 35 | bufput := true; { success } 36 | end else begin { if full } 37 | bufput := false; { insert fails } 38 | end; 39 | end {bufput}; 40 | { 41 | bufget -- get from buffer 42 | } 43 | function bufget(var ch: char) { char returned } 44 | : boolean; { true if successful } 45 | exit return implies defined(ch); { char only if not empty } 46 | begin 47 | if b.bufcount > 0 then begin { if buffer not empty } 48 | b.bufcount := b.bufcount - 1; { decrement buffer count } 49 | assert(defined(b)); { still all defined } 50 | ch := b.buf[b.bufout]; { get char from buffer } 51 | if b.bufout = bufsize then { if at max } 52 | b.bufout := 1 { reset to start } 53 | else b.bufout := b.bufout + 1; { otherwise increment } 54 | bufget := true; { success } 55 | end else bufget := false; { fails if empty } 56 | end {bufget}; 57 | { 58 | buffer initialization block 59 | } 60 | var i: bufindex; 61 | begin 62 | for i := 1 to 20 do begin { clear to spaces } 63 | b.buf[i] := ' '; 64 | assert(defined(b.buf,1,i-1)); { still defined up to i-1 } 65 | state(defined(i), 66 | defined(b.buf,1,i)); 67 | end; 68 | b.bufout := 1; { start at 1 } 69 | b.bufin := 1; { end at 1 } 70 | b.bufcount := 0; { length 0 } 71 | end {circlebuf}; 72 | var stat: boolean; { status from routines above } 73 | ch: char; { working char } 74 | begin {main} 75 | init circlebuf; 76 | stat := bufput('x'); 77 | stat := bufget(ch); { get a char } 78 | if stat then begin { if we got a char } 79 | end; 80 | end. 81 | -------------------------------------------------------------------------------- /src/Examples/defnd.pf: -------------------------------------------------------------------------------- 1 | { 2 | Definedness test -- difficult cases 3 | } 4 | program defnd; 5 | const bufsize = 100; { size of each buffer } 6 | buffers = 20; { number of buffers } 7 | type bufix = 1..bufsize; 8 | bufnum = 1..buffers; 9 | type buf = record { circular buffer } 10 | bufstart: bufix; { next data } 11 | bufend: bufix; { end data } 12 | bufcount: 0..bufsize; { count of data } 13 | buffer: array [bufix] of char; { data itself } 14 | end; 15 | buftab = array [1..buffers] of buf; 16 | var b: buftab; { the buffers } 17 | var i: bufnum; 18 | { 19 | initialization 20 | } 21 | { 22 | initbuffer -- initializes one buffer 23 | } 24 | procedure initbuffer(var bf: buf); { buffer to init } 25 | exit defined(bf); { at exit, this row defined } 26 | var j: bufix; 27 | begin 28 | with bf do begin { for this buffer } 29 | for j := 1 to bufsize do begin 30 | buffer[j] := ' '; { clear to spaces } 31 | assert(defined(buffer,1,j-1)); { still defined to j-1 } 32 | state(defined(i), defined(j), 33 | defined(buffer,1,j)); 34 | end; 35 | assert(defined(buffer)); { buffer now defined } 36 | bufstart := 1; { clear start position } 37 | bufend := 1; { clear end position } 38 | bufcount := 0; { clear count } 39 | end; { of With } 40 | end {initbuffer}; 41 | { 42 | main program 43 | } 44 | begin 45 | for i := 1 to buffers do begin { for all buffers } 46 | initbuffer(b[i]); { init this buffer } 47 | assert(defined(b,1,i-1)); { still defined } 48 | state(defined(i), 49 | defined(b,1,i)); 50 | end; 51 | assert(defined(b)); { a very strong statement } 52 | end. 53 | -------------------------------------------------------------------------------- /src/Examples/fibs.pf: -------------------------------------------------------------------------------- 1 | program fibtest; 2 | {This is a program whose exewcution depends on 3 | a property of a fibbonocci series } 4 | const iceil = 31; 5 | var i: Integer; 6 | n: 0..9; 7 | ceiling: extra 0..16383; 8 | 9 | procedure fib( var f: integer; a,b:integer ); 10 | ENTRY a>=0; b>=0; n<9; b<=a; 11 | a <= ceiling; 12 | EXIT n > n.old; 13 | f <= ceiling * 2; 14 | n <= 9; 15 | defined(f); 16 | DEPTH 10-n; 17 | INVARIANT 18 | (n = 0) implies (ceiling = iceil); { ceiling = iceil * 2**n } 19 | (n = 1) implies (ceiling = 2*iceil); 20 | (n = 2) implies (ceiling = 4*iceil); 21 | (n = 3) implies (ceiling = 8*iceil); 22 | (n = 4) implies (ceiling = 16*iceil); 23 | (n = 5) implies (ceiling = 32*iceil); 24 | (n = 6) implies (ceiling = 64*iceil); 25 | (n = 7) implies (ceiling = 128*iceil); 26 | (n = 8) implies (ceiling = 256*iceil); 27 | (n = 9) implies (ceiling = 512*iceil); 28 | (n = 0) or (n = 1) or (n = 2) or (n = 3) or (n = 4) or 29 | (n = 5) or (n = 6) or (n = 7) or (n = 8) or (n = 9); 30 | begin 31 | n:=n+1; 32 | proof ceiling := ceiling * 2; 33 | if n = 9 then 34 | f := a 35 | else 36 | fib( f, a+b, a); 37 | end; 38 | 39 | 40 | begin 41 | n:=0; 42 | proof ceiling := iceil; 43 | fib(i, 3, 0); 44 | end. 45 | 46 | -------------------------------------------------------------------------------- /src/Examples/stacktype.pf: -------------------------------------------------------------------------------- 1 | { 2 | A simple type manager 3 | } 4 | program stacktype; { Version 1.3 } 5 | const stackmax = 10; 6 | type stack = record { stack of integers } 7 | stktop: 0..stackmax; 8 | stkdata: array [0..stackmax] of integer;{ element 0 is never used } 9 | end; 10 | { 11 | Push 12 | } 13 | procedure push(var s: stack; { stack } 14 | item: integer); { item to push } 15 | entry 16 | defined(s.stktop); 17 | s.stktop >= 0; 18 | s.stktop < stackmax; 19 | exit 20 | defined(s.stktop); 21 | s.stktop = s.stktop.old + 1; 22 | s.stktop > 0; 23 | s.stktop <= stackmax; 24 | defined(s.stkdata[s.stktop]); 25 | var lev: 1..stackmax; { working index } 26 | begin 27 | lev := s.stktop + 1; { new item loc } 28 | s.stkdata[lev] := item; { insert new item } 29 | s.stktop := lev; { update depth } 30 | end {push}; 31 | { 32 | Pop 33 | } 34 | procedure pop(var s: stack; { stack } 35 | var item: integer); { item returned } 36 | var lev: 0..stackmax; { working index } 37 | exit 38 | defined(s.stktop); 39 | s.stktop >= 0; 40 | s.stktop < stackmax; 41 | s.stktop = s.stktop.old - 1; 42 | defined(item); 43 | entry 44 | defined(s.stktop); 45 | s.stktop > 0; 46 | s.stktop <= stackmax; 47 | defined(s.stkdata[s.stktop]); 48 | begin 49 | lev := s.stktop; { top level } 50 | item := s.stkdata[lev]; { return top item } 51 | s.stktop := lev - 1; { update depth } 52 | end {pop}; 53 | { 54 | Initstack 55 | } 56 | procedure initstack(var s: stack); { stack to be cleared } 57 | exit defined(s.stktop); 58 | s.stktop = 0; 59 | begin 60 | s.stktop := 0; { clear } 61 | end {initstack}; 62 | { 63 | Test procedure 64 | 65 | Does various pushes, pops, and initstacks. 66 | } 67 | procedure test; 68 | var stk1, stk2: stack; 69 | n: integer; 70 | begin 71 | initstack(stk1); 72 | n := 25; 73 | push(stk1,n); 74 | initstack(stk2); 75 | pop(stk1,n); 76 | push(stk2,n); 77 | pop(stk2,n); 78 | end {test}; 79 | begin {main} 80 | end. 81 | -------------------------------------------------------------------------------- /src/Manual/fixer.sno: -------------------------------------------------------------------------------- 1 | start line = syspit /f(end) 2 | line ".DP" /f(copy) 3 | syspot = line 4 | more line = syspit /f(end) 5 | line ".DE" /s(copy) 6 | line "." /s(iscmd) 7 | fix line *a* ' ' = a '\0' /s(fix) 8 | fixtab line *a* ' ' = a '\0\0\0\0\0\0\0\0' /s(fixtab) 9 | iscmd syspot = line /(more) 10 | 11 | copy syspot = line /(start) 12 | 13 | end line = line 14 | -------------------------------------------------------------------------------- /src/Manual/manpage.m: -------------------------------------------------------------------------------- 1 | .SK 2 | .SP 4 3 | .de hu \" heading for manual page section 4 | .SP 5 | .ps -2 6 | .in 0 7 | .nf 8 | .ft B 9 | \\$1 10 | .ft P 11 | .fi 12 | .ps +2 13 | .in 4 14 | .. 15 | .hu "NAME" 16 | pasver - Pascal-F verifier 17 | .hu "SYNOPSIS" 18 | .B "pasver \c" 19 | [\c 20 | .B "-d\c" 21 | ] [file] 22 | .hu "DESCRIPTION" 23 | .I "pasver" 24 | examines Pascal-F programs and attempts to prove the absence 25 | of certain types of run-time errors. 26 | When invoked with file names as arguments, 27 | .I "pasver" initiates verification of the Pascal-F program identified by 28 | the 29 | .I "file" 30 | argument. This name must end in ``.pf''. 31 | A directory will be created for the many scratch files used during the 32 | verification. This directory will be created in ``.'', and will 33 | have the name of the file being verified, with the ``.pf'' changed to 34 | ``.d''. If a directory by that name already exists, the verifier will 35 | expect it to contain results from a previous verification attempt. 36 | Reverifications are much faster than original verifications. 37 | .P 0 38 | The 39 | .B "-d" 40 | flag enables all internal debug output, which is extensive. 41 | The 42 | .B -d1 turns on pass one debug output only, 43 | .B -d2 turns on pass two debug output, 44 | and 45 | .B -d3 turns on debug output from pass 3 and the theorem prover. 46 | The flag 47 | .B -dvcg causes a log of all verification conditions to be generated. 48 | .hu "FILES" 49 | .I Pasver invokes 50 | .I pasver1, 51 | .I pasver2, 52 | .I vcg, 53 | .and 54 | .I simplifier, all of which are searched for by path name. 55 | .hu "SEE ALSO" 56 | .I "Pascal-F Verifier User's Manual" 57 | by S. Johnson and J. Nagle. 58 | .in 0 59 | .SK 60 | -------------------------------------------------------------------------------- /src/Manual/manual00.m: -------------------------------------------------------------------------------- 1 | \" This set of mm macro commands defines a book-like format. 2 | \" The usual headings, H1 to H4, are used, but the results are 3 | \" as follows. 4 | \" .H 1 indicates a chapter heading. Each chapter starts on a new 5 | \" page, a large chapter heading is printed, and the chapter heading 6 | \" becomes the running heading. 7 | \" .H 2 starts a new page. 8 | \" Lower level headings are simply in boldface, and become smaller 9 | \" in size as heading level decreases. 10 | \" 11 | \" Page numbers are of the form "chapter-page". No page numbers 12 | \" appear until the first heading is printed. 13 | \" 14 | \" No title page is produced by these commands. 15 | \" J. Nagle December, 1980 16 | \" Macro version 2.4 of 3/7/86 17 | \" 18 | .nr Hc 0 \" All headings are left-justified 19 | .nr Hb 7 \" Break after all headings 20 | .nr Hs 7 \" Space after all headings 21 | .nr Hu 1 \" Heading level for HU 22 | .nr Cl 7 \" Save all headings for table of contents 23 | .nr Pt 0 \" Block style of paragraphs 24 | .ds HF 3 3 3 3 3 3 3 \" All headings in boldface 25 | .SA 1 \" Right justify 26 | .nr Ej 0 \" Page ejects will be handled in escape macros 27 | .de DP \" DP displays are for representing computer programs 28 | .DS 29 | .ps -1p \" Drop point size one point 30 | .ft L \" DP displays are non-filled monospace 31 | .. 32 | .de HX \" Before-heading user processing 33 | .\"tms commented out 34 | .\"tm " BEFORE: \\n(.s PT" 35 | .ds }0 \" no automatic heading mark 36 | .if \\$1=1 \{ \" H 1 - chapter heading, 2 lines on new page 37 | .PH " " \" cancel outstanding page heading 38 | .rs \" force spacing to work 39 | .bp \" start new page 40 | .nr P 1 \" reset page number 41 | .ps 14p \" will print "Chapter N" in 14 point 42 | .sp 2 \" skip two lines 43 | .B "Chapter \\n(H1" \" print "Chapter N" 44 | .ps \" pop point size 45 | .sp 24p \" two blank lines 46 | .PH "''\\$3''" \" chapter title becomes running heading 47 | .ps 22p\} \" chapter title in 22 point 48 | .if \\$1=2 \{\ 49 | .bp \" H 2 - new page 50 | .ps 18p\} 51 | .if \\$1=3 .ps 16p \" H 3 - 14-point headings 52 | .if \\$1>3 .ps 14p \" H 4 and below - 12-point headings 53 | .vs \\n(.s+2p \" set vertical spacing 2 pts above type size 54 | .\"tm "HEADING \\$1, \\n(.s PT: \\$3" 55 | .. 56 | .de HZ \" After-heading user processing 57 | .ps \\n(:Pp \" Back to previous point size 58 | .vs \\n(.sp+2p \" Back to previous vertical size 59 | .if \\$1=1 \{ \" chapter heading handling 60 | .sp 96p \" white space after chapter heading 61 | .PF "''\\n(H1\-\\\\\\\\nP\ \ 'Communications Corporation'" 62 | .EF "'''\(fs Ford Aerospace &'" 63 | .OF "'''\(fs Ford Aerospace &'"\} 64 | .\"tm " AFTER: \\n(.s PT" 65 | .. 66 | .PH " " 67 | .PF " " 68 | .S 12 69 | .\"tm "POINT SIZE AT START = \n(.s " 70 | -------------------------------------------------------------------------------- /src/Manual/manual01.m: -------------------------------------------------------------------------------- 1 | \& 2 | .P 3 | .SK 4 | .S 36 5 | .DS 6 | 7 | 8 | 9 | .B "Pascal-F Verifier" 10 | .B "User's Manual" 11 | 12 | .S 14 13 | 14 | .B "Version 2" 15 | 16 | 17 | 18 | 19 | by Scott D. Johnson and John Nagle 20 | .DE 21 | .S 12 22 | .SK 23 | -------------------------------------------------------------------------------- /src/Manual/manual02.m: -------------------------------------------------------------------------------- 1 | .SK 2 | .S 30 3 | .DS 4 | 5 | 6 | 7 | .B "Pascal-F Verifier" 8 | .B "User's Manual" 9 | 10 | .S 14 11 | 12 | .B "Version 2" 13 | 14 | 15 | 16 | 17 | by Scott D. Johnson and John Nagle 18 | .DE 19 | .S 12 20 | .sp 10 21 | .DS 22 | \(sf 23 | .B "Ford Aerospace &" 24 | .B "Communications Corporation" 25 | Western Development 26 | Laboratories Division 27 | 28 | 3939 Fabian Way 29 | Palo Alto, California 94303 30 | .DE 31 | .S 12 32 | .SK 33 | .S 12 34 | \& 35 | .sp 30 36 | .S 10 37 | .P 38 | Permission is hereby given to modify or use, but not for profit, 39 | any or all of this program provided that this copyright notice 40 | is included: 41 | .DS 42 | .B 43 | 44 | Copyright 19\n(yr 45 | 46 | Ford Motor Company 47 | The American Road 48 | Dearborn, Michigan 48121 49 | 50 | .R 51 | .DE 52 | .P 53 | This work was supported by the Long Range Research Program of 54 | the Ford Motor Company, and was carried out at Ford Scientific 55 | Research Labs in Dearborn, Michigan and Ford Aerospace and 56 | Communications Corporation's Western Development Laboratories 57 | in Palo Alto, California. 58 | .P 59 | Printing of \n(mo/\n(dy/\n(yr. 60 | .S 12 61 | .SK 62 | .S 12 63 | \& 64 | .sp 10 65 | .S 10 66 | This is the user's manual for the second release of the Pascal-F 67 | Verifier. 68 | The current version of the system operates on 69 | VAX and SUN systems running Berkeley UNIX. 70 | .P 71 | Comments and trouble reports should be addressed to 72 | .DS 73 | 74 | Division Software Technology and Support 75 | Mail Station X20 76 | Ford Aerospace and Communications Corporation 77 | 3939 Fabian Way 78 | Palo Alto, CA 94303. 79 | .DE 80 | or 81 | .DS 82 | verifier@FORD-WDL1.ARPA 83 | .DE 84 | on the Internet. 85 | .S 12 86 | -------------------------------------------------------------------------------- /src/Manual/manual20.m: -------------------------------------------------------------------------------- 1 | .H 1 "Writing verifiable Pascal-F" 2 | Programs to be verified must in a sense be 3 | ``understood'' 4 | by the 5 | Verifier, for which it 6 | needs a substantial amount of help from the programmer. 7 | Most of this help is supplied in the form of special statements 8 | embedded in the text of the program. These statements are meaningless to the 9 | Pascal-F compiler (though the compiler will recognize and ignore them), 10 | but to the Verifier they supply information about how the program works. 11 | -------------------------------------------------------------------------------- /src/Manual/manual50.m: -------------------------------------------------------------------------------- 1 | .H 1 "Examples" 2 | The examples in this chapter are designed to aid the user in learning to 3 | use the Verifier. For the first example, a square root calculation, 4 | verification conditions have been generated by hand and informal proofs 5 | given. 6 | This example is intended to give the user some insight into how the 7 | Verifier examines programs. 8 | .P 9 | The second example, a set of routines for managing a circular buffer, 10 | shows the use of the verifier to verify only absence of run-time errors, 11 | and the maintenance of a simple invariant. It is useful to note 12 | how few assertions were required. This example has been passed by the 13 | Verifier in the form shown. 14 | .P 15 | The third example, a very simple-minded engine control program, 16 | is intended to illustrate the use of assertions and proof variables in 17 | constructing a verifiable Pascal-F program. It also illustrates means 18 | of programming within the restrictions required for 19 | a reliable and verifiable multi-process program. This example also has 20 | been passed by the Verifier. 21 | -------------------------------------------------------------------------------- /src/Manual/manual60.m: -------------------------------------------------------------------------------- 1 | .H 1 "Rules" 2 | It is possible to prove quite complex things about programs with the 3 | Verifier. 4 | In order to accomplish this, the user must define 5 | .I "rule functions" 6 | which represent the properties to be proven and must prove rules 7 | about them using the 8 | .I "rule builder." 9 | We will illustrate this with a simple example, going into considerable 10 | detail on how to go about doing such things. 11 | -------------------------------------------------------------------------------- /src/Manual/manual70.m: -------------------------------------------------------------------------------- 1 | .H 1 "The rule builder" 2 | In the previous chapter, the concept of 3 | verification using 4 | .I rules 5 | was introduced. 6 | These rules must be created by the user and proven with machine assistance. 7 | The rule builder is a tool used with the Verifier proper to construct 8 | sound new rules and thus provide the Verifier with more knowledge. 9 | -------------------------------------------------------------------------------- /src/Manual/pager.c: -------------------------------------------------------------------------------- 1 | /* 2 | pager -- break printout into pages 3 | 4 | Printouts are broken into pages every 66 lines. 5 | A form feed is added at the beginning of each page 6 | after the first. 7 | 8 | Version 1.1 of 1/6/83 9 | */ 10 | #include 11 | int line = 0; /* current line number */ 12 | int needff = 0; /* FF needed */ 13 | int needlf = 0; /* LFs needed */ 14 | char ch; 15 | #define FF 014 /* form feed */ 16 | #define PAGESIZE 66 /* lines per page */ 17 | main() 18 | { for (;;) 19 | { ch = getchar(); /* get next char */ 20 | if (ch == EOF) break; /* done */ 21 | if (ch == '\n') /* if newline */ 22 | { line++; /* count lines */ 23 | needlf++; /* add to LFs needed */ 24 | if (line >= PAGESIZE) /* if page end reached */ 25 | { needff = 1; 26 | line = 0; 27 | needlf = 0; 28 | } /* set FF, no LF */ 29 | continue; /* on to next char */ 30 | } 31 | if (needff) /* if form feed needed */ 32 | { putchar('\n'); 33 | putchar(FF); 34 | needff = 0; 35 | } /* handle it */ 36 | while (needlf) /* while LFs needed */ 37 | { putchar('\n'); /* LF */ 38 | needlf--; /* decrement */ 39 | } 40 | putchar(ch); /* finally put out char */ 41 | } 42 | } 43 | -------------------------------------------------------------------------------- /src/Test cases/README: -------------------------------------------------------------------------------- 1 | Test cases README Version 1.2 of 1/14/82 2 | 3 | This directory is to contain only test programs for the Verifier 4 | suitable for testing with the test driver. Such test cases need merely 5 | contain the word "ERROR" on each line which is expected to be printed 6 | when the verifier prints lines in error, and the word ERROR (upper case 7 | only) must not be used in any other context. 8 | The shell procedure "vertestdrive" will use test cases conforming 9 | to these rules. 10 | -------------------------------------------------------------------------------- /src/Test cases/alias1.pf: -------------------------------------------------------------------------------- 1 | { TESTSUITE test program 2 | Aliasing Error Test Version 1.2 of 1/14/82 3 | } 4 | program alias1; 5 | var tab1, tab2: array [0..10] of integer; 6 | x,y: 0..10; 7 | procedure proc1(i: integer; var j: integer); 8 | begin 9 | j := tab2[i-1]; 10 | end {proc1}; 11 | { 12 | swap -- swap arguments 13 | } 14 | procedure swap(var i,j: integer); 15 | var temp: integer; 16 | begin 17 | temp := i; 18 | i := j; 19 | j := temp; 20 | end {swap}; 21 | begin 22 | x := 1; y := 2; 23 | proc1(10, tab1[10]); { OK } 24 | proc1(10, tab2[10]); { ERROR } 25 | swap(tab1[x], tab1[y]); { OK } 26 | swap(tab1[x], tab1[x]); { ERROR } 27 | end. 28 | -------------------------------------------------------------------------------- /src/Test cases/field1.pf: -------------------------------------------------------------------------------- 1 | { 2 | Nested record test Version 1.4 of 1/15/82 3 | 4 | Records with one field create special problems in decoding icode. 5 | } 6 | program field1; 7 | type 8 | rec1 = record 9 | f1: char; 10 | end; 11 | 12 | rec2 = record 13 | f2: rec1; 14 | end; 15 | 16 | rec3 = record 17 | f3: rec2; 18 | end; 19 | 20 | rec4 = array [1..10] of rec3; 21 | 22 | rec5 = record 23 | f5: rec4; 24 | end; 25 | 26 | rec6 = record 27 | f6: rec5; 28 | end; 29 | var 30 | a,b: rec6; 31 | c: rec3; 32 | begin 33 | c.f3.f2.f1 := 'z'; 34 | a.f6.f5[3].f3.f2.f1 := c.f3.f2.f1; 35 | assert(a.f6.f5[3].f3.f2.f1 = 'z'); 36 | end. 37 | -------------------------------------------------------------------------------- /src/Test cases/function1.pf: -------------------------------------------------------------------------------- 1 | { 2 | function1 -- part of verifier test suite 3 | 4 | Version 1.2 of 7/7/82 5 | } 6 | program function1; 7 | var i: integer; 8 | tab: array[1..100] of integer; 9 | { 10 | successor - add one to input 11 | } 12 | function successor(n: integer): integer; 13 | entry n < 32767; 14 | exit return = n.old + 1; 15 | begin 16 | successor := n + 1; 17 | end; 18 | begin 19 | i := 25; 20 | tab[i+5] := 3; 21 | i := successor(tab[i + 5]); 22 | assert(i = 4); 23 | end. 24 | -------------------------------------------------------------------------------- /src/Test cases/incdec1.pf: -------------------------------------------------------------------------------- 1 | program incdec1; { Version 1.5 of 1/15/82 } 2 | const minint = -32768; 3 | maxint = +32767; 4 | { 5 | inc -- increment 6 | } 7 | procedure inc(var n: integer); 8 | entry n >= minint; 9 | n <= maxint - 1; 10 | defined(n); 11 | exit n >= minint + 1; 12 | n <= maxint; 13 | n = n.old + 1; 14 | defined(n); 15 | begin 16 | n := n + 1; 17 | end {inc}; 18 | { 19 | dec -- decrement 20 | } 21 | procedure dec(var n: integer); 22 | entry n >= minint + 1; 23 | n <= maxint; 24 | defined(n); 25 | exit n >= minint; 26 | n <= maxint - 1; 27 | n = n.old - 1; 28 | defined(n); 29 | begin 30 | n := n - 1; 31 | end {dec}; 32 | { 33 | test -- test inc and dec 34 | } 35 | procedure test(x: integer); 36 | var hold: extra integer; 37 | entry x < maxint; x >= minint; 38 | begin 39 | proof hold := x; { save original value of x } 40 | inc(x); 41 | dec(x); 42 | assert(x = hold); { inc then dec = no chng } 43 | end {test}; 44 | begin 45 | end. 46 | -------------------------------------------------------------------------------- /src/Test cases/null.pf: -------------------------------------------------------------------------------- 1 | { Version 1.2 of 1/14/82 } 2 | program null; 3 | begin 4 | end. 5 | 6 | -------------------------------------------------------------------------------- /src/Test cases/recurse1.pf: -------------------------------------------------------------------------------- 1 | program recurse1; 2 | 3 | procedure p1(n: integer); 4 | procedure p2(nx: integer); 5 | depth nx+1; 6 | entry nx > 0; 7 | nx <= 1000; 8 | begin 9 | if nx > 1 then p1(nx-1); 10 | end {p2}; 11 | depth n; 12 | entry n >= 0; 13 | n < 1000; 14 | begin 15 | if n > 2 then p2(n-2); 16 | end {p1}; 17 | begin 18 | p1(20); 19 | end. 20 | -------------------------------------------------------------------------------- /src/Test cases/recurse3.pf: -------------------------------------------------------------------------------- 1 | { 2 | Test for recursion detector Version 1.1 of 3/18/82 3 | } 4 | program recurse3; 5 | procedure p0; 6 | begin 7 | end; 8 | procedure p1; 9 | depth 0; 10 | procedure p2; { ERROR: no DEPTH statement for recursive routine } 11 | procedure p3; 12 | depth 0; 13 | begin {p3} 14 | p1; 15 | end; 16 | begin {p2} 17 | p3; 18 | end; 19 | begin {p1} 20 | p2; 21 | end; 22 | begin 23 | p0; 24 | p1; 25 | end. 26 | 27 | -------------------------------------------------------------------------------- /src/Test cases/skew1.pf: -------------------------------------------------------------------------------- 1 | { 2 | Check for VAR arg set/used processing 3 | 4 | Version 1.3 of 1/15/82 5 | } 6 | program skew1; 7 | var i1,j1,k1,l1,m1: integer; 8 | i2,j2,k2,l2,m2: integer; { ERROR -- l2, m2 used but not set } 9 | sink: integer; 10 | { 11 | assigns 1 to all variables if lev is big enough 12 | } 13 | procedure skew1(lev: integer; var a,b,c,d,e: integer); 14 | var x: integer; 15 | begin 16 | e := 1; 17 | if lev > 0 then 18 | skew1(lev-1, x, a, b, c, d); 19 | end {skew1}; 20 | { 21 | incorrect version of skew1 22 | } 23 | procedure skew2(lev: integer; var a,b,c,d,e: integer);{ ERROR -- d, e useless } 24 | var x: integer; 25 | begin 26 | c := 1; 27 | if lev > 0 then 28 | skew2(lev-1, x, a, b, c, d); 29 | end {skew2}; 30 | begin 31 | skew1(5,i1,j1,k1,l1,m1); 32 | skew2(5,i2,j2,k2,l2,m2); 33 | sink := i1 + j1 + k1 + l1 + m1; 34 | sink := i2 + j2 + k2 + l2 + m2; 35 | end. 36 | -------------------------------------------------------------------------------- /src/Test cases/specvar1.pf: -------------------------------------------------------------------------------- 1 | program specvar1; 2 | type array1 = array [1..10] of char; 3 | rec1 = record 4 | f1: integer; 5 | f2: array1; 6 | end; 7 | var p,q: boolean; 8 | procedure p1(var a,b,c: integer; tab: array1; 9 | var rec: rec1); 10 | entry (a + b) > c; 11 | exit c > 0; 12 | (a + b) > c; { ERROR: a needs a .old suffix } 13 | (c > 0) implies p; 14 | p implies (q implies p); { ERROR: q not a param } 15 | p.old implies (q implies p.old); { ERROR: q not a param } 16 | tab[3].old = 'a'; 17 | rec.f1 = 25; 18 | rec.f1.old = 25; 19 | rec.f2[3] = tab[3].old; 20 | begin 21 | rec.f1 := rec.f1; 22 | if a > b then begin 23 | c := b; 24 | b := a; 25 | assert(a > c); 26 | end else begin 27 | c := a; 28 | b := a; 29 | p := true; 30 | assert(b > c); 31 | end; 32 | end {p1}; 33 | begin 34 | end. 35 | 36 | 37 | -------------------------------------------------------------------------------- /src/Test cases/stack.pf: -------------------------------------------------------------------------------- 1 | { 2 | A traditional verification 3 | 4 | Version 1.3 of 3/15/82 5 | } 6 | program pushpop; 7 | const lim = 10; { size of stack } 8 | var stkpos: 0..lim; { top of stack pointer } 9 | stack: array [0..lim] of integer; { the stack itself } 10 | { 11 | push 12 | } 13 | procedure push(item: integer); 14 | entry 15 | stkpos < lim; { must have room left } 16 | exit stkpos = stkpos.old + 1; 17 | stkpos > 0; 18 | stack[stkpos] = item.old; 19 | defined(stack[stkpos]); 20 | begin 21 | stkpos := stkpos + 1; 22 | stack[stkpos] := item; 23 | end {push}; 24 | { 25 | pop 26 | } 27 | procedure pop(var item: integer); 28 | entry stkpos > 0; { must not be empty } 29 | defined(stack[stkpos]); 30 | exit stkpos = stkpos.old - 1; 31 | stkpos < lim; 32 | item = stack[stkpos.old].old; 33 | begin 34 | item := stack[stkpos]; 35 | stkpos := stkpos - 1; 36 | end {pop}; 37 | { 38 | initstack -- clears stack 39 | } 40 | procedure initstack; 41 | exit stkpos = 0; 42 | begin 43 | stkpos := 0; { reset stack depth } 44 | end {initstack}; 45 | { 46 | Test of push and pop 47 | The object is to prove that pop cannot fail after the push. 48 | } 49 | procedure test; 50 | var n: integer; 51 | exit defined(stack[1]) = defined(stack[1]); { indicate don't care } 52 | begin 53 | n := 100; 54 | initstack; 55 | push(n); 56 | pop(n); 57 | end; 58 | begin { main } 59 | end. 60 | 61 | -------------------------------------------------------------------------------- /src/Test cases/value1.pf: -------------------------------------------------------------------------------- 1 | { 2 | VALUE clause test Version 1.2 of 5/11/82 3 | } 4 | program value1; 5 | value x = integer(1); 6 | type tab = array[1..10] of integer; 7 | trec = record 8 | f1: integer; 9 | f2: char; 10 | end; 11 | value itab = tab(10,20,30,40,50,60,70,80,90,100); 12 | itrec = trec(99,'a'); 13 | var i: 1..10; 14 | j: integer; 15 | c: char; 16 | begin 17 | j := x; 18 | i := 5; 19 | j := itab[i]; 20 | assert(j = 50); 21 | end. 22 | -------------------------------------------------------------------------------- /src/Test cases/with1.pf: -------------------------------------------------------------------------------- 1 | { 2 | WITH frozen variable test Version 1.1 of 1/15/82 3 | } 4 | program with1; 5 | type rc = record 6 | f: integer; 7 | g: char; 8 | end; 9 | var j,k: integer; 10 | i: 1..10; 11 | tab: array [1..10] of rc; 12 | begin 13 | i := 5; 14 | tab[i].f := 1; 15 | with tab[i] do begin 16 | j := f; 17 | i := i + 1; { ERROR } 18 | end; 19 | end. 20 | -------------------------------------------------------------------------------- /src/Test/canonize: -------------------------------------------------------------------------------- 1 | 2 | # Filter for canonizing files prior to comparison 3 | # Converts tabs to spaces and compresses out multiple spaces 4 | # Beginning and trailing spaces are removed 5 | # 6 | # Version 1.2 of 3/3/86 7 | # 8 | sed -e "s/ / /g" -e "s/ */ /g" -e "s/^ *//" -e "s/ *$//" <&0 >&1 9 | 10 | -------------------------------------------------------------------------------- /src/Test/makefile: -------------------------------------------------------------------------------- 1 | 2 | # 3 | # Makefile for verifier test utilities 4 | # 5 | # Version 1.2 of 3/3/86 6 | # 7 | SOURCE=.. 8 | TEST=$(SOURCE)/test 9 | # 10 | regress: regress.sh 11 | rm -f regress 12 | cp regress.sh regress 13 | chmod 555 regress 14 | vertestdrive: testdrive.sh 15 | rm -f vertestdrive 16 | cp testdrive.sh vertestdrive 17 | chmod 555 vertestdrive 18 | # 19 | # SCCS dependencies 20 | # 21 | regress.sh: $(TEST)/src/s.regress.sh ; get $(TEST)/src/s.regress.sh 22 | testdrive.sh: $(TEST)/src/s.testdrive.sh ; get $(TEST)/src/s.testdrive.sh 23 | -------------------------------------------------------------------------------- /src/Test/numberer: -------------------------------------------------------------------------------- 1 | : Filter for putting line numbers on files 2 | : 3 | : Version 1.2 of 3/3/86 4 | : 5 | awk '{printf("%5d. %s\n", 1+(n++), $0 ); }' <&0 >&1 6 | -------------------------------------------------------------------------------- /src/Test/regress.sh: -------------------------------------------------------------------------------- 1 | 2 | # Verififer regression test Version 1.6 of 3/3/86 3 | # 4 | # The directory REGRESS is created. 5 | # The test results are in REGRESS/RESULTS 6 | TESTS=../../test/cases 7 | # 8 | set -e 9 | rm -f -r REGRESS 10 | mkdir REGRESS 11 | cd REGRESS 12 | get $TESTS 13 | rm -f msgs 14 | vertestdrive *.pf >> RESULTS 2> RESULTS 15 | echo "Regression tests complete." 16 | -------------------------------------------------------------------------------- /src/Test/testdrive.sh: -------------------------------------------------------------------------------- 1 | 2 | : Verifier Test Driver 3 | : 4 | : Operates on test programs which have been prepared by 5 | : placing the word "ERROR" on any line which should be printed in an 6 | : error message. 7 | : 8 | : Usage is simply 9 | : 10 | : testdrive programs 11 | : 12 | : but it is nice to start in an empty directory with nothing but copies 13 | : of the test programs, since the verifier creates working directories 14 | : and for testing one probably does not want a reverification. 15 | : 16 | : Any test failure stops the test cycle. 17 | : 18 | : The verifier must print the line in error for the test driver to work 19 | : correctly, since the driver matches the lines printed with the source 20 | : file. 21 | : 22 | : Version 1.9 of 3/3/86 23 | : 24 | for SOURCE 25 | do 26 | echo "${SOURCE}:" 27 | rm -f VERTEST1 VERTEST2 VERTEST3 VERTESTDIAGS 28 | : Create file of expected error messages 29 | numberer < ${SOURCE} | grep "ERROR" | canonize > VERTEST2 30 | : Find out if any errors expected 31 | if `test -s VERTEST2` 32 | then 33 | echo " Expecting errors." 34 | else 35 | echo " Errors not expected." 36 | fi 37 | : Run the verifier 38 | pasver ${SOURCE} >> VERTESTDIAGS 2>> VERTESTDIAGS 39 | STATUS=${?} 40 | echo " Verifier exit status ${STATUS}" 41 | : Create file of actual error messages 42 | grep "^ *[123456789][0123456789]*\. " VERTESTDIAGS | canonize > VERTEST1 43 | if `test -s VERTEST2` 44 | then 45 | : Errors expected difference expected diags with actual diags 46 | sort -u -n VERTEST1 > VERTEST3 47 | diff VERTEST2 VERTEST3 > VERTEST4 48 | else 49 | : Errors not expected Diags file should be empty 50 | cp VERTEST1 VERTEST4 51 | if `test ${STATUS} -ne 0` 52 | then 53 | echo "Bad exit status from verifier" 54 | exit 1 55 | fi 56 | fi 57 | : 58 | : Check file of extra/missing diags 59 | : 60 | if `test -s VERTEST4` 61 | then 62 | echo "****** TEST ${SOURCE} FAILED ******" 63 | echo "" 64 | cat VERTEST4 65 | exit 1 66 | else 67 | echo " Test case ${SOURCE} OK." 68 | echo "" 69 | fi 70 | done 71 | echo "All test cases produced expected results." 72 | exit 0 73 | -------------------------------------------------------------------------------- /src/Util/casefix.c: -------------------------------------------------------------------------------- 1 | /* 2 | Case-fixing program for Pascal programs 3 | 4 | Translates everything outside quotes and comments to lower case. 5 | Also removes underscores in program text. 6 | 7 | Version 1.7 of 2/4/81. 8 | 9 | This is a finite-state transducer, and should handle 10 | all valid Pascal programs correctly. 11 | 12 | */ 13 | #include 14 | main() 15 | { 16 | char ch; /* char just read */ 17 | int state; /* size of input line so far */ 18 | state = 0; /* initialize */ 19 | while(1) 20 | { ch = getchar(); /* get next char */ 21 | switch(state){ /* get into current state */ 22 | case 0: {switch(ch){ /* state 0: normal text */ 23 | case '(': { state = 1; break;}/* possible comment start */ 24 | case '\'': { state = 3; break;}/* quoted string constant start */ 25 | case '{': { state = 2; break;}/* comment start */ 26 | default: { break; } /* all others */ 27 | } break; } 28 | case 1: {switch(ch){ /* state 1: possible comment start */ 29 | case '*': { state = 2; break;}/* comment start */ 30 | case '{': { state = 2; break;}/* comment start */ 31 | case '\'': { state = 3; break;}/* quoted string constant start */ 32 | default: { state = 0; break;}/* not comment start */ 33 | } break; } 34 | case 2: {switch(ch){ /* state 2: inside comment */ 35 | case '}': { state = 0; break;}/* comment end */ 36 | case '*': { state = 5; break;}/* possible comment end */ 37 | default: { break;}; /* all others */ 38 | } break;} 39 | case 3: {switch(ch){ /* state 3: inside quote */ 40 | case '\'': { state = 4; break;}/* possible end of quote */ 41 | default: { break; } /* all others */ 42 | } break; } 43 | case 4: {switch(ch){ /* state 4: possible end of quote */ 44 | case '\'': { state = 3; break;}/* double quote within quote string */ 45 | default: { state = 0; break;}/* all others */ 46 | } break; } 47 | case 5: {switch(ch){ /* state 5: possible comment end */ 48 | case ')': { state = 0; break;}/* comment end */ 49 | case '}': { state = 0; break;}/* comment end */ 50 | case '*': { state = 5; break;}/* possible comment end */ 51 | default: { state = 2; break;}/* all others */ 52 | } break; } 53 | } /* end transducer states */ 54 | if (ch == EOF) break; /* end of input */ 55 | if (state == 0) /* if in state zero */ 56 | { if (ch >= 'A' && ch <= 'Z') /* if upper-case character */ 57 | { ch = ch + ('a' - 'A'); } /* convert to lower case */ 58 | if (ch != '_') /* if not an underscore */ 59 | { putchar(ch); } /* put char out */ 60 | } else /* end in program text */ 61 | { putchar(ch); } /* otherwise always just copy */ 62 | } /* end main loop */ 63 | exit(0); /* exit, flushing buffers */ 64 | } 65 | -------------------------------------------------------------------------------- /src/Util/deltaall: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | # Generate delta command for all files with p files in given directory 3 | # Version 1.5 of 2/9/82 4 | set -e 5 | CMD=`(echo $1/p.* | sed -n -e '/\*/d' -e 'H' -e '$g' -e '$s/\n/ /g' -e '$p' | sed -e 's/\/p\./\/s./g' -e 's/^/delta /' )` 6 | echo $CMD 7 | exec $CMD 8 | -------------------------------------------------------------------------------- /src/Util/execlisp.c: -------------------------------------------------------------------------------- 1 | /* lisp command interface 2 | 3 | Prepend the line: 4 | 5 | #! 6 | 7 | where is a complete pathname to this program, 8 | to a lisp program. Change the mode of the lisp program to 9 | so that it is executable, and the file will be executed directly 10 | by the shell, in much the same way shell scripts are. 11 | */ 12 | 13 | char what_string[] = "@(#)execlisp.c 1.2"; 14 | 15 | main(argc, argv) 16 | int argc; 17 | char *argv[]; 18 | 19 | { int fd; /* file descriptor */ 20 | int j; /* loop counter */ 21 | char c; /* character buffer */ 22 | 23 | /* argv[1] is the file to be executed. Open the file and 24 | * discard the first line of the file, which directed exec 25 | * to this program (since lisp will not know what to do with it). 26 | */ 27 | fd = open(argv[1], 0); 28 | check(fd, "open"); 29 | do 30 | check(read(fd, &c, 1), "read"); 31 | while (c != '\n'); 32 | 33 | close(0); 34 | check(dup(fd), "dup"); 35 | 36 | /* delete argv[1] from the argument list */ 37 | for(j=1; j+1 2 | #define getput putchar(getchar()) 3 | 4 | char what_string[] = "@(#)exgen.c 1.1 "; 5 | 6 | /* This program reads from its standard input a series of 7 | * Pascal routine defintions. It writes on its standard 8 | * output a series of external declarations meant to be put in 9 | * a Pascal .h file. 10 | * 11 | * The program expects syntactically correct Pascal; it leaves syntax 12 | * checking to the compiler. Routine definitions are recognized by the 13 | * word "procedure" or "function" in column one; the program is not bright 14 | * enough to ignore these words if they appear in the first column of 15 | * a comment. 16 | * 17 | * If the program contains internal routines that should not be 18 | * exported, those routines should be indented. 19 | */ 20 | main() 21 | { char c, last_c, *keyword, *printkey; 22 | int in_args; 23 | 24 | c = getchar(); 25 | while(c != EOF) 26 | { /* c is the first character of a line */ 27 | keyword = (c == 'p') ? "procedure" : "function"; 28 | printkey = keyword; 29 | for (;;) 30 | { if (c == *keyword++) 31 | { if (*keyword == '\0') 32 | goto read_key; 33 | else 34 | { c = getchar(); 35 | if (c==EOF) 36 | goto early_eof; 37 | continue; 38 | } } 39 | else goto discard_line; 40 | } 41 | 42 | read_key: 43 | { printf(printkey); 44 | /* read and print the arguments to the routine. in_arg = 1 45 | * means we are between the parens of the argument. 46 | */ 47 | in_args = 0; 48 | c = getput; 49 | while(! (c == ';' && in_args == 0)) 50 | { /* the body of this loop gets the character after the construct 51 | * begun by c. 52 | */ 53 | switch(c) 54 | { 55 | default: 56 | c = getput; 57 | break; 58 | 59 | case '(': 60 | c = getput; 61 | if (c == '*') 62 | { /* read past a comment */ 63 | last_c = getput; 64 | for(;;) 65 | { c = getput; 66 | if (c == EOF) 67 | goto early_eof; 68 | if (last_c == '*' && c == ')') 69 | break; 70 | else 71 | last_c = c; 72 | } } 73 | else 74 | in_args = 1; 75 | break; 76 | 77 | case ')': 78 | c = getput; 79 | in_args = 0; 80 | break; 81 | 82 | case '{': 83 | do c = getput; while (!(c == '}' || c == EOF)); 84 | if (c == EOF) 85 | goto early_eof; 86 | else 87 | c = getput; 88 | break; 89 | 90 | case EOF: 91 | goto early_eof; 92 | break; 93 | } } 94 | 95 | printf(" external;\n"); 96 | } 97 | 98 | discard_line: 99 | { while (! (c=='\n' || c==EOF)) 100 | c = getchar(); 101 | if (c == EOF) 102 | goto early_eof; 103 | else 104 | c = getchar(); 105 | } } 106 | 107 | exit(0); 108 | 109 | early_eof: 110 | { fprintf(stderr, "early eof\n"); 111 | exit(1); 112 | } } 113 | -------------------------------------------------------------------------------- /src/Util/makefile: -------------------------------------------------------------------------------- 1 | 2 | # 3 | # Make file for support routines for verifier 4 | # 5 | # Nothing here is required for normal operation of the Verifier 6 | # 7 | # Version 1.4 of 3/3/86 8 | SOURCE=.. 9 | BINSRC=$(SOURCE)/util/src 10 | all: regress vertest 11 | # 12 | # Utilities for regression testing 13 | # 14 | regress: regress.sh 15 | rm -f regress 16 | ln regress.sh regress 17 | chmod 555 regress 18 | vertest: vertest.sh 19 | rm -f vertest 20 | ln vertest.sh vertest 21 | chmod 555 vertest 22 | # 23 | # SCCS dependencies 24 | # 25 | regress.sh: $(BINSRC)/s.regress.sh ; get $(BINSRC)/s.regress.sh 26 | vertest.sh: $(BINSRC)/s.vertest.sh ; get $(BINSRC)/s.vertest.sh 27 | -------------------------------------------------------------------------------- /src/Util/makelp: -------------------------------------------------------------------------------- 1 | for FILE do 2 | get s.$FILE.m 3 | nroff -mm -Tlp $FILE.m > $FILE.lp 4 | done 5 | -------------------------------------------------------------------------------- /src/Util/mergemsgs: -------------------------------------------------------------------------------- 1 | 2 | # Message merge merges messages found in jcode with given source 3 | # 4 | # Usage is mergemsgs source jcode 5 | # 6 | # Version 1.9 of 4/2/82 7 | # 8 | grep "(\/" ${2} | sed -e "s/^.*(\/ //" -e "s/\/).*$//" -e "s/^{[a-zA-Z0-9\-]*\.pf:/ /" -e "s/}/.1 | /" > MSGS 9 | awk '{printf("%4d. %s\n", 1+(n++), $0 ); }' ${1} > SOURCE 10 | cat SOURCE MSGS | sort -n | sed -e "s/^.*\.1 | / /" 11 | -------------------------------------------------------------------------------- /src/Util/mktest: -------------------------------------------------------------------------------- 1 | if make ${1?'usage: mktest make-name [bin-name]'} 2 | then mv $1 $HOME/bintest/${2-$1} 3 | fi 4 | -------------------------------------------------------------------------------- /src/Util/mkversions: -------------------------------------------------------------------------------- 1 | # Shell script to make versions of theorem prover "public" 2 | 3 | ln THM thm 4 | ln BOOTSTRAP bootstrap 5 | ln PROVEALL proveall 6 | 7 | rehash 8 | 9 | mktest thm 10 | mktest bootstrap 11 | mktest proveall 12 | 13 | mvtest thm 14 | mvtest bootstrap 15 | mvtest proveall 16 | 17 | rehash 18 | -------------------------------------------------------------------------------- /src/Util/mover: -------------------------------------------------------------------------------- 1 | 2 | : Move entire directory hierarchy from arg1 to arg2 3 | cd $1; tar cf - . | (cd $2; tar xpvf -) 4 | -------------------------------------------------------------------------------- /src/Util/mvtest: -------------------------------------------------------------------------------- 1 | mv -f $HOME/bintest/$1 /usr/p/frl/bin/$1 2 | -------------------------------------------------------------------------------- /src/Util/printlp: -------------------------------------------------------------------------------- 1 | 2 | # printlp -- print documents in .lp format 3 | # 4 | # Version 1.2 of 7/7/82 5 | # 6 | # Indents document for printing on line printer 7 | # 8 | sed -e "s/^/ /" $* | lpr 9 | -------------------------------------------------------------------------------- /src/Util/putundersccs: -------------------------------------------------------------------------------- 1 | : 2 | : Puts files under SCCS control 3 | : then removes the original file. 4 | : 5 | : J. Nagle 3 Mar 81 6 | for FILE do 7 | admin -i$FILE s.$FILE 8 | case $? in 9 | 0) ;; 10 | *) exit $? 11 | esac 12 | rm -f $FILE 13 | done 14 | -------------------------------------------------------------------------------- /src/Util/pvmake.sh: -------------------------------------------------------------------------------- 1 | 2 | # 3 | # pvmake -- make verifier component if necessary 4 | # 5 | # 6 | # pvmake component sourcedir destdir 7 | # 8 | # Go to source directory 9 | echo "\`$1':" 10 | DIR=`pwd` 11 | cd $2 12 | # Get makefile if necessary 13 | if test ! -r makefile 14 | then 15 | get src/s.makefile 16 | fi 17 | # Do the indicated make 18 | if make $1 19 | then 20 | echo "\`$1' generated." 21 | cd $DIR 22 | rm -f $3/$1 23 | ln $2/$1 $3 24 | else 25 | echo "\`$1' -- make FAILED." 26 | exit 1 27 | fi 28 | -------------------------------------------------------------------------------- /src/Util/readable.c: -------------------------------------------------------------------------------- 1 | #include /* new I/O package */ 2 | main () 3 | /* readable.c 1.2 of 2/23/95. */ 4 | { 5 | char ch; 6 | ch = getchar(); /* get first character */ 7 | while (ch != EOF) /* while not eof do */ 8 | { 9 | outchar (ch); /* output char */ 10 | ch = getchar (); /* get next char */ 11 | } 12 | putchar('\n'); /* end with final newline */ 13 | exit(0); /* normal exit */ 14 | } 15 | outchar (outch) char outch; /* edit char in C representation */ 16 | { 17 | int outval; /* value of char as an integer */ 18 | outval = 0177 & outch; /* outval = ord(outch) */ 19 | if (outval < 040 || outval > 0177) /* if outside graphics */ 20 | { 21 | 22 | printf ("<0%o>", outval); 23 | if (outval == '\n' || outval == '\r') 24 | /* handle end of line */ 25 | { 26 | putchar ('\r'); 27 | putchar ('\n'); 28 | } /* with CR LF */ 29 | } 30 | else 31 | putchar (outch); /* otherwise put as given */ 32 | 33 | } 34 | 35 | -------------------------------------------------------------------------------- /src/Util/regress.sh: -------------------------------------------------------------------------------- 1 | 2 | # Verififer regression test Version 1.6 of 3/3/86 3 | # 4 | # The directory REGRESS is created. 5 | # The test results are in REGRESS/RESULTS 6 | TESTS=../../test/cases 7 | # 8 | set -e 9 | rm -f -r REGRESS 10 | mkdir REGRESS 11 | cd REGRESS 12 | get $TESTS 13 | rm -f msgs 14 | vertestdrive *.pf >> RESULTS 2> RESULTS 15 | echo "Regression tests complete." 16 | -------------------------------------------------------------------------------- /src/Util/rerelease: -------------------------------------------------------------------------------- 1 | # Script file to release new theorem prover environments from 2 | # existing THM sysout. (I.e., updates CODE1, DATA1, and library 3 | # files.) 4 | 5 | rminode $thm/BOOTSTRAP $thm/PROVEALL 6 | rmtest proveall 7 | rmtest bootstrap 8 | thm < $thm/scripts.d/rerelease1 >& $thm/scripts.d/rerelease.log 9 | mkversions 10 | -------------------------------------------------------------------------------- /src/Util/rmtest: -------------------------------------------------------------------------------- 1 | rm $HOME/bintest/$1 2 | -------------------------------------------------------------------------------- /src/Util/rmunder.c: -------------------------------------------------------------------------------- 1 | /* 2 | Filter for underscore removal for names in Pascal programs 3 | 4 | Removes underscores in program text, but not comments and 5 | strings. 6 | 7 | Version 1.1 of 8/27/82. 8 | 9 | This is a finite-state transducer, and should handle 10 | all valid Pascal programs correctly. 11 | 12 | */ 13 | #include 14 | main() 15 | { 16 | char ch; /* char just read */ 17 | int state; /* size of input line so far */ 18 | state = 0; /* initialize */ 19 | while(1) 20 | { ch = getchar(); /* get next char */ 21 | switch(state){ /* get into current state */ 22 | case 0: {switch(ch){ /* state 0: normal text */ 23 | case '(': { state = 1; break;}/* possible comment start */ 24 | case '\'': { state = 3; break;}/* quoted string constant start */ 25 | case '{': { state = 2; break;}/* comment start */ 26 | default: { break; } /* all others */ 27 | } break; } 28 | case 1: {switch(ch){ /* state 1: possible comment start */ 29 | case '*': { state = 2; break;}/* comment start */ 30 | case '{': { state = 2; break;}/* comment start */ 31 | case '\'': { state = 3; break;}/* quoted string constant start */ 32 | default: { state = 0; break;}/* not comment start */ 33 | } break; } 34 | case 2: {switch(ch){ /* state 2: inside comment */ 35 | case '}': { state = 0; break;}/* comment end */ 36 | case '*': { state = 5; break;}/* possible comment end */ 37 | default: { break;}; /* all others */ 38 | } break;} 39 | case 3: {switch(ch){ /* state 3: inside quote */ 40 | case '\'': { state = 4; break;}/* possible end of quote */ 41 | default: { break; } /* all others */ 42 | } break; } 43 | case 4: {switch(ch){ /* state 4: possible end of quote */ 44 | case '\'': { state = 3; break;}/* double quote within quote string */ 45 | default: { state = 0; break;}/* all others */ 46 | } break; } 47 | case 5: {switch(ch){ /* state 5: possible comment end */ 48 | case ')': { state = 0; break;}/* comment end */ 49 | case '}': { state = 0; break;}/* comment end */ 50 | case '*': { state = 5; break;}/* possible comment end */ 51 | default: { state = 2; break;}/* all others */ 52 | } break; } 53 | } /* end transducer states */ 54 | if (ch == EOF) break; /* end of input */ 55 | if (state == 0) /* if in state zero */ 56 | { if (ch >= 'A' && ch <= 'Z') /* if upper-case character */ 57 | { ch = ch + ('a' - 'A'); } /* convert to lower case */ 58 | if (ch != '_') /* if not an underscore */ 59 | { putchar(ch); } /* put char out */ 60 | } else /* end in program text */ 61 | { putchar(ch); } /* otherwise always just copy */ 62 | } /* end main loop */ 63 | exit(0); /* exit, flushing buffers */ 64 | } 65 | -------------------------------------------------------------------------------- /src/Util/srdiff: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | # 3 | # SCCS identification: @(#)srdiff 1.1 of 6/15/82 4 | # 5 | # srdiff: display differences between various combinations 6 | # of SCCS and checked-out files. 7 | # 8 | # Use: 9 | # srdiff [ -rn.m.k.l [ -rn.m.k.l ]] s.file 10 | # 11 | # If no sids are supplied, compare default release against checked 12 | # out file in current directory. If 1 is supplied, compare 13 | # checked out version against specified release. If 2 are supplied 14 | # compare the specified releases. 15 | 16 | # Set up execution environment: 17 | export PATH 18 | PATH="$PATH:/usr/public" 19 | 20 | # Set up temp file name: 21 | tempfile=/tmp/srd$$ 22 | 23 | # Handle interrupts: 24 | trap "rm -f $tempfile; exit 1" 1 2 15 25 | 26 | # Look for options: 27 | case $1 in 28 | -* ) 29 | sid_old=$1; shift ;; 30 | 31 | * ) 32 | sid_old="" ;; 33 | esac 34 | 35 | case $1 in 36 | -* ) 37 | sid_new=$1; shift ;; 38 | 39 | * ) 40 | sid_new="" ;; 41 | esac 42 | 43 | # Check argument accessibility: 44 | if [ ! -r "$1" ] 45 | then 46 | echo "File $1 not readable" 47 | exit 1 48 | fi 49 | 50 | # If we were given two SCCS sids as flags, then run diff on the 51 | # specified releases. Otherwise run diff on a gotten version of 52 | # the argument SCCS file (assumed to be in the current directory) 53 | # and the specified release of the SCCS file. Note that a null sid 54 | # implies the most recent (and default) release. 55 | if [ "$sid_new" = "" ] 56 | then 57 | # We have to compare against a checked-out file: 58 | 59 | # Get the name of the checked-out file: 60 | # (The second line strips off a leading "s.".) 61 | cmp_vs=`basename $1` 62 | cmp_vs=`expr $cmp_vs : '^s\.\(.*\)$'` 63 | if [ "$cmp_vs" = "" ] 64 | then 65 | echo "$1 not an SCCS file" 66 | exit 1 67 | fi 68 | 69 | if [ ! -r $cmp_vs ] 70 | then 71 | echo "File $cmp_vs not readable" 72 | exit 1 73 | fi 74 | 75 | # Look for ID keywords in the checked-out file. If there are any, 76 | # arrange to supply the "-k" flag to "get" later on: 77 | if [ `grep -c '%.%' $cmp_vs` -gt 0 ] 78 | then 79 | kflag=-k 80 | else 81 | kflag="" 82 | fi 83 | 84 | else 85 | # We must compare two releases of the SCCS file: 86 | cmp_vs=$tempfile 87 | kflag=-k 88 | get -s -p $kflag $sid_new $1 > $tempfile 89 | fi 90 | 91 | get $sid_old $kflag -s -p $1 | diff - $cmp_vs 92 | 93 | rm -f $tempfile 94 | exit 0 95 | -------------------------------------------------------------------------------- /src/Util/tcopy.c: -------------------------------------------------------------------------------- 1 | /* 2 | tcopy -- tape copy program 3 | 4 | Copies arbitrary tapes, any block size up to a maximum. 5 | Copying is terminated by an EOF mark. 6 | 7 | Version 1.5 of 7/17/81 8 | */ 9 | #define MAXBYTES 5000 /* size limit of copy */ 10 | #include 11 | int optiond = 0; /* if -d keyletter */ 12 | int optionv = 0; /* if -v keyletter */ 13 | long blockno = 0; /* block number */ 14 | char buf[MAXBYTES+2]; /* working buffer */ 15 | /* 16 | main program 17 | */ 18 | main(argc,argv) 19 | int argc; 20 | char *argv[]; 21 | { 22 | int inod; /* input open descriptors */ 23 | int outod; /* output open descriptor */ 24 | 25 | int fargn = 0; /* number of file args */ 26 | char *fargs[2]; /* address of file args */ 27 | int arg; /* current arg being processed */ 28 | 29 | char key; /* current keyletter */ 30 | 31 | for (arg = 1; arg < argc; arg++) /* scan arguments */ 32 | { if (argv[arg][0] == '-') /* if keyletter */ 33 | { key = argv[arg][1]; /* get keyletter */ 34 | switch (key) { /* fan out on keyletter */ 35 | case 'd': { optiond++; break;}/* debug */ 36 | case 'v': { optionv++; break;}/* print block counts */ 37 | default: { /* unknown keyletter */ 38 | fprintf(stderr,"Bad option: -%c\n",key); /* diagnose */ 39 | exit(-1); 40 | } 41 | } /* end switch */ 42 | } /* end keyletter processing */ 43 | else /* not keyletter, must be file */ 44 | { 45 | if (fargn > 1) /* if too many file args */ 46 | { fprintf(stderr,"Too many file args\n"); /* so state */ 47 | exit(-1); /* error exit */ 48 | } 49 | fargs[fargn++] = argv[arg]; /* remember file arg */ 50 | } /* end file arg */ 51 | } /* end arg processing */ 52 | if (fargn != 2) /* if not two file args */ 53 | { fprintf(stderr,"Usage: tcopy \n"); 54 | exit(-1); /* error */ 55 | } 56 | inod = open(fargs[0],0); /* open arg 1 for reading */ 57 | if (inod < 0) /* if open failed */ 58 | { fprintf(stderr,"Cannot open %s.\n",fargs[0]); /* so state */ 59 | exit(-1); /* fails */ 60 | } 61 | outod = open(fargs[1],1); /* open arg 2 for writing */ 62 | if (outod < 0) /* if open failed */ 63 | { fprintf(stderr,"Cannot open %s. \n",fargs[0]); /* so state */ 64 | exit(-1); /* fails */ 65 | } 66 | docopy(inod,outod); /* do the copy */ 67 | if (blockno == 0) exit(1); /* zero-length copy */ 68 | exit(0); /* normal completion */ 69 | } 70 | /* 71 | docopy -- perform the tape copy 72 | */ 73 | docopy(in,out) 74 | int in,out; /* open descriptors */ 75 | { int rdstat; /* read status */ 76 | int wrstat; /* write status */ 77 | while(1) /* copy until done */ 78 | { rdstat = read(in,buf,sizeof(buf)); /* read block */ 79 | if (rdstat == 0) break; /* normal EOF */ 80 | blockno++; /* read something, count it */ 81 | if (rdstat < 0) /* if error */ 82 | { fprintf(stderr,"Read error (status %d) on block %D.\n", 83 | rdstat,blockno); 84 | exit(-1); /* fails */ 85 | } 86 | if (rdstat > sizeof(buf)-2) /* if oversize block */ 87 | { fprintf(stderr,"Block %D is too big for tcopy - limit %d bytes.\n", 88 | blockno,sizeof(buf)-2); /* msg */ 89 | exit(-1); /* fails */ 90 | } 91 | if (optiond) /* if debugging */ 92 | { printf("Block %D: %d bytes.\n",blockno, rdstat); /* print info */} 93 | wrstat = write(out,buf,rdstat); /* write the block */ 94 | if (wrstat < 0) /* if write error */ 95 | { fprintf(stderr,"Write error (status %d) on block %D.\n", 96 | wrstat,blockno); 97 | exit(-1); /* fails */ 98 | } 99 | } 100 | if (optionv) /* if verbose mode */ 101 | { printf("%D blocks copied.\n",blockno); } 102 | } 103 | -------------------------------------------------------------------------------- /src/Util/unsent: -------------------------------------------------------------------------------- 1 | 2 | # 3 | # Pending outgoing mail printer 4 | # 5 | # Finds outgoing mail of current user not yet sent and prints headers. 6 | # 7 | # version 1.3 of 9/30/82 8 | SPOOL=/usr/spool/unetmail/* 9 | # Examine all files in spool file 10 | for FILE in $SPOOL 11 | # If file is readable 12 | do 13 | if test -r $FILE 14 | # Find out if file is from current user 15 | then if grep -s "From: ${USER}\@" $FILE 16 | # If so, print its mail headers 17 | then head $FILE | grep ": " 18 | echo "" 19 | fi 20 | fi 21 | done 22 | -------------------------------------------------------------------------------- /src/Util/vertest.sh: -------------------------------------------------------------------------------- 1 | 2 | : Verifier Test Driver 3 | : 4 | : Operates on test programs which have been prepared by 5 | : placing the word "ERROR" on any line which should be printed in an 6 | : error message. 7 | : 8 | : Usage is simply 9 | : 10 | : testdrive programs 11 | : 12 | : but it is nice to start in an empty directory with nothing but copies 13 | : of the test programs, since the verifier creates working directories 14 | : and for testing one probably does not want a reverification. 15 | : 16 | : Any test failure stops the test cycle. 17 | : 18 | : The verifier must print the line in error for the test driver to work 19 | : correctly, since the driver matches the lines printed with the source 20 | : file. 21 | : 22 | : Version 1.8 of 4/30/82 23 | : 24 | for SOURCE 25 | do 26 | echo "${SOURCE}:" 27 | rm -f VERTEST1 VERTEST2 VERTEST3 VERTESTDIAGS 28 | : Create file of expected error messages 29 | numberer < ${SOURCE} | grep "ERROR" | canonize > VERTEST2 30 | : Find out if any errors expected 31 | if `test -s VERTEST2` 32 | then 33 | echo " Expecting errors." 34 | else 35 | echo " Errors not expected." 36 | fi 37 | : Run the verifier 38 | pasver ${SOURCE} >> VERTESTDIAGS 2>> VERTESTDIAGS 39 | STATUS=${?} 40 | echo " Verifier exit status ${STATUS}" 41 | : Create file of actual error messages 42 | grep "^ *[123456789][0123456789]*\. " VERTESTDIAGS | canonize > VERTEST1 43 | if `test -s VERTEST2` 44 | then 45 | : Errors expected difference expected diags with actual diags 46 | sort -u -n VERTEST1 > VERTEST3 47 | diff VERTEST2 VERTEST3 > VERTEST4 48 | else 49 | : Errors not expected Diags file should be empty 50 | cp VERTEST1 VERTEST4 51 | if `test ${STATUS} -ne 0` 52 | then 53 | echo "Bad exit status from verifier" 54 | exit 1 55 | fi 56 | fi 57 | : 58 | : Check file of extra/missing diags 59 | : 60 | if `test -s VERTEST4` 61 | then 62 | echo "****** TEST ${SOURCE} FAILED ******" 63 | echo "" 64 | cat VERTEST4 65 | exit 1 66 | else 67 | echo " Test case ${SOURCE} OK." 68 | echo "" 69 | fi 70 | done 71 | echo "All test cases produced expected results." 72 | exit 0 73 | -------------------------------------------------------------------------------- /src/work/README.md: -------------------------------------------------------------------------------- 1 | # Work in progress on verifier 2 | 3 | # temporary rule base 4 | 5 | In the years since the Verifier has written, the syntax accepted by the Boyer-Moore theorem prover was 6 | changed slightly. 7 | 8 | 1. The accessor list in ADD-SHELL cannot be ommtted, but can be "()", the empty list, for shells that 9 | have no accessors. That's an easy fix. 10 | 11 | 2. "!" is no longer allowed in symbols. This is a big problem, because the verifier uses "!" on all 12 | its built-ins to avoid name clashes. 13 | 14 | With those two fixes, the verifier's rule base will go through nqthm successfully, but it's not 15 | usable with the verifier until a solution is found for the "!" syntax problem. 16 | --------------------------------------------------------------------------------