Return to fpMacs.l CVS log

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

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

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

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