![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to runFp.l CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / ucb / fp|
Return to runFp.l CVS log | Up to [CSRG BSD Unix] / 43BSD / ucb / fp |
1.1 root 1: ; FP interpreter/compiler
2: ; Copyright (c) 1982 Scott B. Baden
3: ; Berkeley, California
4: ;
5: ; Copyright (c) 1982 Regents of the University of California.
6: ; All rights reserved. The Berkeley software License Agreement
7: ; specifies the terms and conditions for redistribution.
8: ;
9: (setq SCCS-runFp.l "@(#)runFp.l 5.1 (Berkeley) 5/31/85")
10:
11: ; FASL (or load if no object files exist) then run FP.
12: ; also set up user-top-level to 'runFp'.
13:
14: (include specials.l)
15:
16: (declare
17: (localf make_chset setup init addHelp initHelp)
18: (special user-top-level))
19:
20: (sstatus translink on)
21:
22: (mapcar 'load
23: '(fpMain handlers scanner parser codeGen primFp utils fpPP fpMeasures))
24:
25:
26: (defun runFp nil
27: (cond ((null (make_chset))
28: (patom "Illegal Character set")
29: (terpri)
30: (exit))
31:
32: (t
33: (setup) ; set up FP syntax funnies
34: (init)
35: (Tyi)
36: (msg N "FP, v. 4.2, (4/28/83)" N (B 6))))
37:
38: (setq user-top-level 'res_fp) ; from now on just resume FP--
39: ; no need for extensive initializations
40:
41: (signal 2 'break-resp)
42: (fpMain nil t)) ; invoke fp, exit to shell when done
43:
44: (defun res_fp nil ; restart fp after infinite recursion,
45: ; simpler initializatin than runFp.
46: (signal 2 'break-resp)
47: (msg N (B 6))
48: (setq in_def nil infile nil outfile nil fn_name 'tmp$$ in_buf nil)
49: (setq level 0)
50: (fpMain nil t))
51:
52:
53: (defun make_chset nil
54: (putprop 'fonts "+-,>!%&*/:=@{}()[]?~TF;#" 'asc)
55: (cond ((null (setq rsrvd (get 'fonts char_set))))
56: (t (setq e_rsrvd (explodec rsrvd)))))
57:
58:
59: (defun setup nil
60: (setq newreadtable (makereadtable nil))
61: (let ((readtable newreadtable))
62: (mapcar '(lambda (z) (setsyntax z 66)) (exploden rsrvd))
63: (setsyntax #/< 'macro 'readit))
64:
65: (setsyntax #/< 'macro 'readit))
66:
67:
68: (defun init nil
69: ; these are the only chars which may delimit numbers
70: ; (select operator)
71:
72: (setq num_delim$ '(#/, #/] #/@ #/: #/} 41 59 32 9 10 #/-))
73:
74: (setq timeIt nil)
75: (setq char_set (concat 'scan$ char_set))
76: (setq in_def nil)
77: (setq infile nil)
78: (setq outfile nil)
79: (setq fn_name 'tmp$$)
80: (setq in_buf nil)
81: (setq level 0) ; initialize level to 0
82: (setq TracedFns nil) ; just to make sure TracedFns is defined
83: (setq DynTraceFlg nil) ; default of no dynamic tracing
84:
85:
86:
87: ; These are the builtin function names
88:
89: (setq builtins
90: '(
91: out ; output fn - for debug only
92: tl ; left tail
93: id ; id
94: atom ; atom
95: eq ; equal
96: not ; not
97: and ; and
98: or ; or
99: xor ; xor
100: null ; null
101: iota ; counting sequence generator
102: ; (library functions)
103: sin
104: asin
105: cos
106: acos
107: log ; natural
108: exp
109: mod
110: ; (unary origin)
111: first ; the first element
112: last ; the last element
113: front ; all except last
114: pick ; get nth element
115: concat ; concat
116: pair ; makes pairs
117: split ; splits into two
118: reverse ; reverse
119: distl ; distribute left
120: distr ; distribute right
121: length ; length
122: trans ; transpose
123: while ; while
124: apndl ; append left
125: apndr ; append right
126: tlr ; right tail
127: rotl ; rotate left
128: rotr)) ; rotate right
129:
130: (initStats)
131: (initHelp))
132:
133: (defun addHelp (text cmd)
134: (putprop 'helpCmd text cmd))
135:
136: (defun initHelp nil
137: (addHelp "fsave <file> Same as csave except without pretty-printing" 'fsave)
138: (addHelp "cload <file> Load Lisp code from a file (may be compiled)" 'cload)
139: (addHelp "csave <file> Output Lisp code for all user-defined fns" 'csave)
140: (addHelp "debug on/off Turn debugger output on/off" 'debug)
141: (addHelp "lisp Exit to the lisp system (return with '^D')" 'help)
142: (addHelp "help This text" 'help)
143: (addHelp "script open/close/append [file] Open or close a script-file" 'script)
144: (addHelp "timer on/off Turn timer on/off" 'timing)
145: (addHelp "trace on/off <fn1> ... Start/Stop exec trace of <fn1> ..." 'trace)
146: (addHelp "stats on/off/reset/print [file] collect and output dynamic stats" 'stats)
147: (addHelp "fns List all functions" 'fns)
148: (addHelp "delete <fn1> ... Delete <fn1> ..." 'delete)
149: (addHelp "pfn <fn1> ... Print source text of <fn1> ..." 'pfn)
150: (addHelp "save <file> Save defined fns in <file>" 'save)
151: (addHelp "load <file> Redirect input from <file>" 'load)
152: )
153:
154:
155: (setq user-top-level 'runFp)
156: (setq char_set 'asc) ; set to the type of character set
157: ; desired at the moment only ascii (asc)
158: ; supported (no APL at this time).
159:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.