Return to fpMacs.l CVS log

Up to [CSRG BSD Unix] / 43BSD / ucb / fp

Annotation of 43BSD/ucb/fp/fpMacs.l, revision 1.1

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-fpMacs.l "@(#)fpMacs.l      5.1 (Berkeley) 5/31/85")
        !            10: 
        !            11: (declare
        !            12:   (macros t)
        !            13:   (special ptport infile))
        !            14: 
        !            15: 
        !            16: (eval-when (compile eval load)
        !            17: 
        !            18:   (setq whiteSpace ''(9 10 32))
        !            19:   (setq blankOrTab ''(9 32))
        !            20:   (setq CR 10)
        !            21:   (setq BLANK 32)
        !            22:   (setq lAngle '|<|)
        !            23:   (setq rAngle '|>|)
        !            24:   
        !            25:   (setq funcForms
        !            26:        ''(alpha$fp
        !            27:           insert$fp
        !            28:           constant$fp
        !            29:           condit$fp
        !            30:           constr$fp
        !            31:           compos$fp
        !            32:           while$fp
        !            33:           ti$fp))
        !            34:   
        !            35:   (setq multiAdicFns
        !            36:        ''(select$fp
        !            37:           tl$fp
        !            38:           tlr$fp
        !            39:           id$fp
        !            40:           atom$fp
        !            41:           null$fp
        !            42:           reverse$fp
        !            43:           distl$fp
        !            44:           distr$fp
        !            45:           length$fp
        !            46:           apndl$fp
        !            47:           apndr$fp
        !            48:           rotl$fp
        !            49:           rotr$fp
        !            50:           trans$fp
        !            51:           first$fp
        !            52:           last$fp
        !            53:           front$fp
        !            54:           pick$fp
        !            55:           concat$fp
        !            56:           pair$fp
        !            57:           split$fp))
        !            58:   
        !            59:   (setq dyadFns
        !            60:        ''(plus$fp
        !            61:           sub$fp
        !            62:           times$fp
        !            63:           div$fp
        !            64:           and$fp
        !            65:           or$fp
        !            66:           xor$fp
        !            67:           not$fp
        !            68:           lt$fp
        !            69:           le$fp
        !            70:           eq$fp
        !            71:           ge$fp
        !            72:           gt$fp
        !            73:           ne$fp))
        !            74:   
        !            75:   
        !            76:   (setq libFns
        !            77:        ''(sin$fp
        !            78:           asin$fp
        !            79:           cos$fp
        !            80:           acos$fp
        !            81:           log$fp
        !            82:           exp$fp
        !            83:           mod$fp))
        !            84:   
        !            85:   (setq miscFns
        !            86:        ''(iota$fp))
        !            87:   )
        !            88: 
        !            89: 
        !            90: (defmacro Tyi nil
        !            91:   `(let ((z (tyi)))
        !            92:        (cond ((and (null infile) ptport) (tyo z ptport))
        !            93:              (t z))))
        !            94: 
        !            95: (defmacro peekc nil
        !            96:        `(tyipeek infile))
        !            97: 
        !            98: (defmacro Getc nil
        !            99:   `(let ((piport infile))
        !           100:        (prog (c)
        !           101:              (cond ((eq 'eof$$ (setq c (readc piport 'eof$$)))
        !           102:                     (*throw 'parse$err 'eof$$))
        !           103:                    (t (setq c (car (exploden c)))
        !           104:                       (cond
        !           105:                        ((not (and (null in_buf) (memq c #.whiteSpace)))
        !           106:                         (setq in_buf (cons c in_buf))))))
        !           107:              (cond ((and (null infile) ptport)
        !           108:                     (cond
        !           109:                      ((not (and (null in_buf) (memq c #.whiteSpace)))
        !           110:                       (tyo c ptport)))))
        !           111:              (return c))))
        !           112: 
        !           113: (defmacro Read nil
        !           114:   `(let ((z (read)))
        !           115:        (prog nil
        !           116:              (cond ((and (null infile) ptport (not (listp z))) (patom z ptport)))
        !           117:              (cond ((and (null infile) ptport (not (listp z)))
        !           118:                     (do
        !           119:                      ((c (tyipeek) (tyipeek)))
        !           120:                      ((or (and (eq c #.CR) (Tyi) t)
        !           121:                           (null (memq c #.blankOrTab))))
        !           122:                      (Tyi))))
        !           123:              
        !           124:              (return z))))
        !           125: 
        !           126: (defmacro find (flg lst)
        !           127:   `(cond ((atom ,lst) (eq ,flg ,lst))
        !           128:         ((not (listp ,lst)) nil)
        !           129:         (t (memq ,flg ,lst))))
        !           130: 
        !           131: 
        !           132: ; we want top-level size, not total number of arguments
        !           133: 
        !           134: (defmacro size (x)
        !           135:   `(cond ((atom ,x) 1)
        !           136:         (t (length ,x))))
        !           137: 
        !           138: (defmacro twop (x)
        !           139:   `(eq 2 ,x))
        !           140: 
        !           141: 
        !           142: ;; Special macros to help out tree insert
        !           143: 
        !           144: (defmacro treeIns (fn input Len)
        !           145:   `(cond ((zerop ,Len) (unitTreeInsert ,fn))
        !           146:         ((onep ,Len) (car ,input))
        !           147:         ((twop ,Len) (funcall ,fn  ,input))
        !           148:         (t (treeInsWithLen ,fn ,input ,Len))))
        !           149: 
        !           150: 
        !           151: (defmacro unitTreeInsert (fn)
        !           152:   `(let ((ufn (get 'u-fnc ,fn)))
        !           153:        (cond (ufn  (funcall ufn))
        !           154:              (t (bottom)))))
        !           155: 
        !           156: 
        !           157: (putprop 'fpMacs t 'loaded)
        !           158: 

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.