Author: ctian Date: Sat Sep 15 17:13:11 2007 New Revision: 37

Added: trunk/asn.1/asn.1-domain.lisp trunk/asn.1/asn.1.tab trunk/asn.1/test/2.asn Modified: trunk/asn.1/asn.1.zb trunk/asn.1/ber.lisp trunk/asn.1/mib.lisp trunk/asn.1/oid.lisp trunk/asn.1/package.lisp trunk/asn.1/stream-test.lisp trunk/asn.1/test/1.asn Log: First release which can parse RFC1155

Added: trunk/asn.1/asn.1-domain.lisp ============================================================================== --- (empty file) +++ trunk/asn.1/asn.1-domain.lisp Sat Sep 15 17:13:11 2007 @@ -0,0 +1,354 @@ +;;; This file was generated by Zebu (Version 3.5.5) + +(IN-PACKAGE "ASN.1") +(REQUIRE "zebu-package") +(USE-PACKAGE "ZEBU") + +(DEFSTRUCT (OBJ-ID-COMPONENTS-LIST + (:INCLUDE KB-DOMAIN) + (:PRINT-FUNCTION + (LAMBDA + (ITEM STREAM LEVEL &AUX + (%R (OBJ-ID-COMPONENTS-LIST--LIST ITEM))) + (DECLARE (IGNORE LEVEL)) + (FORMAT STREAM + "~a" + (LET ((OBJ-ID-COMPONENTS+ %R)) + (IF (NULL OBJ-ID-COMPONENTS+) + "" + (ZEBU::KB-SEQUENCE-PRINT OBJ-ID-COMPONENTS+ + NIL + NIL))))))) + (-LIST NIL :TYPE (OR NULL KB-SEQUENCE))) + +(DEFSTRUCT (ASSIGNMENT-LIST + (:INCLUDE KB-DOMAIN) + (:PRINT-FUNCTION + (LAMBDA + (ITEM STREAM LEVEL &AUX + (%R (ASSIGNMENT-LIST--LIST ITEM))) + (DECLARE (IGNORE LEVEL)) + (FORMAT STREAM + "~a" + (LET ((ASSIGNMENT+ %R)) + (IF (NULL ASSIGNMENT+) + "" + (ZEBU::KB-SEQUENCE-PRINT ASSIGNMENT+ + NIL + NIL))))))) + (-LIST NIL :TYPE (OR NULL KB-SEQUENCE))) + +(DEFSTRUCT (ASSIGNMENT + (:INCLUDE KB-DOMAIN) + (:PRINT-FUNCTION + (LAMBDA + (ITEM STREAM LEVEL &AUX (%R (ASSIGNMENT--VALUE ITEM))) + (DECLARE (IGNORE LEVEL)) + (FORMAT STREAM + "~a" + (LET ((SPECIAL-ASSIGNMENT %R)) + (ZEBU::KB-SEQUENCE-PRINT SPECIAL-ASSIGNMENT + NIL + NIL)))))) + -TYPE + -VALUE) + +(DEFSTRUCT (MODULE-BODY + (:INCLUDE KB-DOMAIN) + (:PRINT-FUNCTION + (LAMBDA + (ITEM STREAM LEVEL &AUX (%R ITEM) + (%S (MODULE-BODY--ASSIGNMENT-LIST ITEM))) + (DECLARE (IGNORE LEVEL)) + (FORMAT STREAM + "~a ~a ~a" + (LET ((EXPORTS NIL)) + (ZEBU::KB-SEQUENCE-PRINT EXPORTS NIL NIL)) + NIL + %S)))) + -ASSIGNMENT-LIST) + +(DEFSTRUCT (MODULE-DEFINITION + (:INCLUDE KB-DOMAIN) + (:PRINT-FUNCTION + (LAMBDA + (ITEM STREAM LEVEL &AUX + (%R (MODULE-DEFINITION--IDENTIFIER ITEM)) + (%S (MODULE-DEFINITION--BODY ITEM))) + (DECLARE (IGNORE LEVEL)) + (FORMAT STREAM "~a DEFINITIONS::=BEGIN ~a END" %R %S)))) + -IDENTIFIER + -BODY) + +(DEFUN SYMBOL+,1$234 (SYMBOL) (MAKE-KB-SEQUENCE :FIRST SYMBOL)) + +(DEFUN SYMBOL+,1$235 (SYMBOL DUMMY SYMBOL+,1$) + (DECLARE (IGNORE DUMMY)) + (MAKE-KB-SEQUENCE :FIRST SYMBOL :REST SYMBOL+,1$)) + +(DEFUN ASSIGNMENT+236 (ASSIGNMENT) (MAKE-KB-SEQUENCE :FIRST ASSIGNMENT)) + +(DEFUN ASSIGNMENT+237 (ASSIGNMENT ASSIGNMENT+) + (MAKE-KB-SEQUENCE :FIRST ASSIGNMENT :REST ASSIGNMENT+)) + +(DEFUN OBJ-ID-COMPONENTS+238 (OBJ-ID-COMPONENTS) + (MAKE-KB-SEQUENCE :FIRST OBJ-ID-COMPONENTS)) + +(DEFUN OBJ-ID-COMPONENTS+239 (OBJ-ID-COMPONENTS OBJ-ID-COMPONENTS+) + (MAKE-KB-SEQUENCE :FIRST OBJ-ID-COMPONENTS :REST OBJ-ID-COMPONENTS+)) + +(DEFUN GARBAGE+240 (GARBAGE) (MAKE-KB-SEQUENCE :FIRST GARBAGE)) + +(DEFUN GARBAGE+241 (GARBAGE GARBAGE+) + (MAKE-KB-SEQUENCE :FIRST GARBAGE :REST GARBAGE+)) + +(DEFUN OBJ-ID-COMPONENTS-LIST242 (OBJ-ID-COMPONENTS+) + (MAKE-OBJ-ID-COMPONENTS-LIST :-LIST OBJ-ID-COMPONENTS+)) + +(DEFUN ASSIGNMENT243 (SPECIAL-ASSIGNMENT) + (MAKE-ASSIGNMENT :-TYPE :SPECIAL :-VALUE SPECIAL-ASSIGNMENT)) + +(DEFUN ASSIGNMENT244 (TYPE-ASSIGNMENT) + (MAKE-ASSIGNMENT :-TYPE :TYPE :-VALUE TYPE-ASSIGNMENT)) + +(DEFUN ASSIGNMENT245 (VALUE-ASSIGNMENT) + (MAKE-ASSIGNMENT :-TYPE :VALUE :-VALUE VALUE-ASSIGNMENT)) + +(DEFUN ASSIGNMENT-LIST246 (ASSIGNMENT+) + (MAKE-ASSIGNMENT-LIST :-LIST ASSIGNMENT+)) + +(DEFUN MODULE-BODY247 (EXPORTS IMPORTS ASSIGNMENT-LIST) + (MAKE-MODULE-BODY :-ASSIGNMENT-LIST ASSIGNMENT-LIST)) + +(DEFUN MODULE-DEFINITION248 + (MODULE-IDENTIFIER DUMMY DUMMY1 DUMMY2 MODULE-BODY DUMMY3) + (DECLARE (IGNORE DUMMY3 DUMMY2 DUMMY1 DUMMY)) + (MAKE-MODULE-DEFINITION :-IDENTIFIER + MODULE-IDENTIFIER + :-BODY + MODULE-BODY)) + + +(EVAL-WHEN (COMPILE) + (UNLESS (MEMBER "zebu-regex" *MODULES* :TEST #'EQUAL) + (WARN "Load the Zebu Compiler!"))) +(DECLAIM (SPECIAL ZEBU::*REGEX-GROUPS* ZEBU::*REGEX-GROUPINGS*)) +(DEFUN A-NUMBER + (STRING &OPTIONAL (ZEBU::START 0) (ZEBU::END (LENGTH STRING))) + (WHEN (PROGN + (SETF ZEBU::*REGEX-GROUPINGS* 1) + (BLOCK ZEBU::FINAL-RETURN + (BLOCK ZEBU::COMPARE + (LET ((ZEBU::INDEX ZEBU::START) (LENGTH ZEBU::END)) + (SETF (SVREF ZEBU::*REGEX-GROUPS* 0) + (LIST ZEBU::INDEX NIL)) + (LET ((ZEBU::OINDEX ZEBU::INDEX)) + (BLOCK ZEBU::COMPARE + (DO () + (NIL) + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000000001111111111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF (= 1 + (SBIT + ZEBU::RANGE + (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) + (RETURN-FROM ZEBU::COMPARE NIL))))) + (DO ((ZEBU::START ZEBU::INDEX (1- ZEBU::START))) + ((< ZEBU::START ZEBU::OINDEX) NIL) + (LET ((ZEBU::INDEX ZEBU::START)) + (BLOCK ZEBU::COMPARE + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000000001111111111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF (= 1 + (SBIT + ZEBU::RANGE + (CHAR-CODE + (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) + (RETURN-FROM ZEBU::COMPARE NIL))) + (SETF (CADR (SVREF ZEBU::*REGEX-GROUPS* 0)) + ZEBU::INDEX) + (RETURN-FROM ZEBU::FINAL-RETURN T))))))))) + (SECOND (SVREF ZEBU::*REGEX-GROUPS* 0)))) + +(DEFUN VALUE-REFERENCE + (STRING &OPTIONAL (ZEBU::START 0) (ZEBU::END (LENGTH STRING))) + (WHEN (PROGN + (SETF ZEBU::*REGEX-GROUPINGS* 1) + (BLOCK ZEBU::FINAL-RETURN + (BLOCK ZEBU::COMPARE + (LET ((ZEBU::INDEX ZEBU::START) (LENGTH ZEBU::END)) + (SETF (SVREF ZEBU::*REGEX-GROUPS* 0) + (LIST ZEBU::INDEX NIL)) + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000111111111111111111111111110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF (= 1 + (SBIT ZEBU::RANGE + (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) + (RETURN-FROM ZEBU::COMPARE NIL))) + (LET ((ZEBU::OINDEX ZEBU::INDEX)) + (BLOCK ZEBU::COMPARE + (DO () + (NIL) + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000001001111111111000000011111111111111111111111111000000111111111111111111111111110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF (= 1 + (SBIT + ZEBU::RANGE + (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) + (RETURN-FROM ZEBU::COMPARE NIL))))) + (DO ((ZEBU::START ZEBU::INDEX (1- ZEBU::START))) + ((< ZEBU::START ZEBU::OINDEX) NIL) + (LET ((ZEBU::INDEX ZEBU::START)) + (BLOCK ZEBU::COMPARE + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000001001111111111000000011111111111111111111111111000000111111111111111111111111110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF (= 1 + (SBIT + ZEBU::RANGE + (CHAR-CODE + (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) + (RETURN-FROM ZEBU::COMPARE NIL))) + (SETF (CADR (SVREF ZEBU::*REGEX-GROUPS* 0)) + ZEBU::INDEX) + (RETURN-FROM ZEBU::FINAL-RETURN T))))))))) + (SECOND (SVREF ZEBU::*REGEX-GROUPS* 0)))) + +(DEFUN TYPE-REFERENCE + (STRING &OPTIONAL (ZEBU::START 0) (ZEBU::END (LENGTH STRING))) + (WHEN (PROGN + (SETF ZEBU::*REGEX-GROUPINGS* 1) + (BLOCK ZEBU::FINAL-RETURN + (BLOCK ZEBU::COMPARE + (LET ((ZEBU::INDEX ZEBU::START) (LENGTH ZEBU::END)) + (SETF (SVREF ZEBU::*REGEX-GROUPS* 0) + (LIST ZEBU::INDEX NIL)) + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000000000000000000000000011111111111111111111111111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF (= 1 + (SBIT ZEBU::RANGE + (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) + (RETURN-FROM ZEBU::COMPARE NIL))) + (LET ((ZEBU::OINDEX ZEBU::INDEX)) + (BLOCK ZEBU::COMPARE + (DO () + (NIL) + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000001001111111111000000011111111111111111111111111000000111111111111111111111111110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF (= 1 + (SBIT + ZEBU::RANGE + (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) + (RETURN-FROM ZEBU::COMPARE NIL))))) + (DO ((ZEBU::START ZEBU::INDEX (1- ZEBU::START))) + ((< ZEBU::START ZEBU::OINDEX) NIL) + (LET ((ZEBU::INDEX ZEBU::START)) + (BLOCK ZEBU::COMPARE + (SETF (CADR (SVREF ZEBU::*REGEX-GROUPS* 0)) + ZEBU::INDEX) + (RETURN-FROM ZEBU::FINAL-RETURN T))))))))) + (SECOND (SVREF ZEBU::*REGEX-GROUPS* 0)))) + +(DEFUN MODULE-REFERENCE + (STRING &OPTIONAL (ZEBU::START 0) (ZEBU::END (LENGTH STRING))) + (WHEN (PROGN + (SETF ZEBU::*REGEX-GROUPINGS* 1) + (BLOCK ZEBU::FINAL-RETURN + (BLOCK ZEBU::COMPARE + (LET ((ZEBU::INDEX ZEBU::START) (LENGTH ZEBU::END)) + (SETF (SVREF ZEBU::*REGEX-GROUPS* 0) + (LIST ZEBU::INDEX NIL)) + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000000000000000000000000011111111111111111111111111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF (= 1 + (SBIT ZEBU::RANGE + (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) + (RETURN-FROM ZEBU::COMPARE NIL))) + (LET ((ZEBU::OINDEX ZEBU::INDEX)) + (BLOCK ZEBU::COMPARE + (DO () + (NIL) + (LET ((ZEBU::RANGE + #*0000000000000000000000000000000000000000000001001111111111000000011111111111111111111111111000000111111111111111111111111110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF (= 1 + (SBIT + ZEBU::RANGE + (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) + (RETURN-FROM ZEBU::COMPARE NIL))))) + (DO ((ZEBU::START ZEBU::INDEX (1- ZEBU::START))) + ((< ZEBU::START ZEBU::OINDEX) NIL) + (LET ((ZEBU::INDEX ZEBU::START)) + (BLOCK ZEBU::COMPARE + (SETF (CADR (SVREF ZEBU::*REGEX-GROUPS* 0)) + ZEBU::INDEX) + (RETURN-FROM ZEBU::FINAL-RETURN T))))))))) + (SECOND (SVREF ZEBU::*REGEX-GROUPS* 0)))) + +(DEFUN ANY-THING + (STRING &OPTIONAL (ZEBU::START 0) (ZEBU::END (LENGTH STRING))) + (WHEN (PROGN + (SETF ZEBU::*REGEX-GROUPINGS* 1) + (BLOCK ZEBU::FINAL-RETURN + (BLOCK ZEBU::COMPARE + (LET ((ZEBU::INDEX ZEBU::START) (LENGTH ZEBU::END)) + (SETF (SVREF ZEBU::*REGEX-GROUPS* 0) + (LIST ZEBU::INDEX NIL)) + (LET ((ZEBU::OINDEX ZEBU::INDEX)) + (BLOCK ZEBU::COMPARE + (DO () + (NIL) + (LET ((ZEBU::RANGE + #*1111111111111111111111111111111101111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF (= 1 + (SBIT + ZEBU::RANGE + (CHAR-CODE (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) + (RETURN-FROM ZEBU::COMPARE NIL))))) + (DO ((ZEBU::START ZEBU::INDEX (1- ZEBU::START))) + ((< ZEBU::START ZEBU::OINDEX) NIL) + (LET ((ZEBU::INDEX ZEBU::START)) + (BLOCK ZEBU::COMPARE + (LET ((ZEBU::RANGE + #*1111111111111111111111111111111101111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111)) + (IF (>= ZEBU::INDEX LENGTH) + (RETURN-FROM ZEBU::COMPARE NIL)) + (IF (= 1 + (SBIT + ZEBU::RANGE + (CHAR-CODE + (CHAR STRING ZEBU::INDEX)))) + (INCF ZEBU::INDEX) + (RETURN-FROM ZEBU::COMPARE NIL))) + (SETF (CADR (SVREF ZEBU::*REGEX-GROUPS* 0)) + ZEBU::INDEX) + (RETURN-FROM ZEBU::FINAL-RETURN T))))))))) + (SECOND (SVREF ZEBU::*REGEX-GROUPS* 0))))

Added: trunk/asn.1/asn.1.tab ============================================================================== --- (empty file) +++ trunk/asn.1/asn.1.tab Sat Sep 15 17:13:11 2007 @@ -0,0 +1,262 @@ + +(:FILE "/home/binghe/cl-net-snmp/asn.1/asn.1.zb" :NAME "ASN.1" :DOMAIN-FILE "asn.1-domain.lisp" :PACKAGE "ASN.1" :GRAMMAR "zebu-mg" :IDENTIFIER-START-CHARS "abcdefghijklmnopqrstuvwxyz" :IDENTIFIER-CONTINUE-CHARS "-abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890" :LEX-CATS ((A-NUMBER "[0-9]+") (VALUE-REFERENCE "[a-z][a-zA-Z0-9-]+") (TYPE-REFERENCE "[A-Z][a-zA-Z0-9-]*") (MODULE-REFERENCE "[A-Z][a-zA-Z0-9-]*") (ANY-THING "[^ ]+")) :DOMAIN (KB-DOMAIN :SUBTYPE (OBJ-ID-COMPONENTS-LIST :SLOTS ((-LIST KB-SEQUENCE))) :SUBTYPE (ASSIGNMENT-LIST :SLOTS ((-LIST KB-SEQUENCE))) :SUBTYPE (ASSIGNMENT :SLOTS (-TYPE -VALUE)) :SUBTYPE (MODULE-BODY :SLOTS (-ASSIGNMENT-LIST)) :SUBTYPE (MODULE-DEFINITION :SLOTS (-IDENTIFIER -BODY))) :DOMAIN-FILE "/home/binghe/cl-net-snmp/asn.1/asn.1-domain.lisp") +#75(ZEBU::THE-EMPTY-STRING ZEBU::AUGMENTED-START ZEBU::THE-END-G-SYMBOL MODULE-DEFINITION MODULE-IDENTIFIER "DEFINITIONS" "::=" "BEGIN" MODULE-BODY "END" MODULE-REFERENCE EXPORTS IMPORTS ASSIGNMENT-LIST "EXPORTS" SYMBOLS-EXPORTED ";" "ALL" SYMBOL+,1$ SYMBOL REFERENCE TYPE-REFERENCE VALUE-REFERENCE ASSIGNMENT+ ASSIGNMENT SPECIAL-ASSIGNMENT TYPE-ASSIGNMENT VALUE-ASSIGNMENT TYPE VALUE BUILTIN-TYPE OBJECT-IDENTIFIER-TYPE CHOICE-TYPE OCTET-STRING-TYPE INTEGER-TYPE TAGGED-TYPE "OBJECT" "IDENTIFIER" BUILTIN-VALUE OBJECT-IDENTIFIER-VALUE "{" OBJ-ID-COMPONENTS-LIST "}" OBJ-ID-COMPONENTS+ OBJ-ID-COMPONENTS NAME-AND-NUMBER-FORM NAME-FORM NUMBER-FORM IDENTIFIER "(" ")" A-NUMBER "OBJECT-TYPE" "MACRO" GARBAGE+ GARBAGE ANY-THING "CHOICE" "OCTET" "STRING" STRING-OPTIONS "SIZE" "INTEGER" ".." TAG "IMPLICIT" "EXPLICIT" "[" CLASS CLASS-NUMBER "]" "UNIVERSAL" "APPLICATION" "PRIVATE" "," ) + + +#35(5 6 7 9 10 14 16 17 21 22 36 37 40 42 48 49 50 51 52 53 56 57 58 59 61 62 63 65 66 67 70 71 72 73 74 ) + +#62((1 . 1)(3 . 6)(4 . 1)(8 . 3)(8 . 0)(11 . 3)(11 . 3)(11 . 0)(15 . 1)(15 . 0)(19 . 1)(12 . 1)(12 . 0)(20 . 1)(20 . 1)(13 . 1)(24 . 1)(24 . 1)(24 . 1)(26 . 3)(27 . 4)(28 . 1)(30 . 1)(30 . 1)(30 . 1)(30 . 1)(30 . 1)(31 . 2)(29 . 1)(38 . 1)(39 . 3)(41 . 1)(44 . 1)(44 . 1)(44 . 1)(45 . 4)(46 . 1)(47 . 1)(25 . 6)(55 . 1)(32 . 4)(33 . 3)(60 . 6)(60 . 0)(34 . 6)(35 . 2)(35 . 3)(35 . 3)(64 . 4)(69 . 1)(68 . 1)(68 . 1)(68 . 1)(68 . 0)(54 . 1)(54 . 2)(43 . 1)(43 . 2)(23 . 1)(23 . 2)(18 . 1)(18 . 3)) + +#104( +((10 :S 8)) +((2 :A 0)) +((5 :S 3)) +((6 :S 4)) +((7 :S 5)) +((9 :R 4) (14 :S 97) (21 :R 7) (22 :R 7) (52 :R 7)) +((9 :S 7)) +((2 :R 1)) +((5 :R 2)) +((21 :S 18) (22 :R 12) (52 :R 12)) +((21 :S 25) (22 :S 28) (52 :S 53)) +((9 :R 3)) +((16 :S 13)) +((21 :R 5) (22 :R 5) (52 :R 5)) +((16 :S 15)) +((21 :R 6) (22 :R 6) (52 :R 6)) +((16 :R 8)) +((16 :R 10) (74 :R 10)) +((21 :R 11) (22 :R 11) (52 :R 11)) +((16 :R 13) (74 :R 13)) +((16 :R 14) (74 :R 14)) +((9 :R 15)) +((9 :R 16) (21 :R 16) (22 :R 16) (52 :R 16)) +((9 :R 17) (21 :R 17) (22 :R 17) (52 :R 17)) +((9 :R 18) (21 :R 18) (22 :R 18) (52 :R 18)) +((6 :S 26)) +((36 :S 38) (57 :S 60) (58 :S 64) (62 :S 73) (67 :S 84)) +((9 :R 19) (21 :R 19) (22 :R 19) (52 :R 19)) +((36 :S 38) (57 :S 60) (58 :S 64) (62 :S 73) (67 :S 84)) +((6 :S 30)) +((40 :S 42)) +((9 :R 20) (21 :R 20) (22 :R 20) (52 :R 20)) +((6 :R 21) (9 :R 21) (21 :R 21) (22 :R 21) (52 :R 21)) +((6 :R 22) (9 :R 22) (21 :R 22) (22 :R 22) (52 :R 22)) +((6 :R 23) (9 :R 23) (21 :R 23) (22 :R 23) (52 :R 23)) +((6 :R 24) (9 :R 24) (21 :R 24) (22 :R 24) (52 :R 24)) +((6 :R 25) (9 :R 25) (21 :R 25) (22 :R 25) (52 :R 25)) +((6 :R 26) (9 :R 26) (21 :R 26) (22 :R 26) (52 :R 26)) +((37 :S 39)) +((6 :R 27) (9 :R 27) (21 :R 27) (22 :R 27) (52 :R 27)) +((9 :R 28) (21 :R 28) (22 :R 28) (52 :R 28)) +((9 :R 29) (21 :R 29) (22 :R 29) (52 :R 29)) +((48 :S 98) (51 :S 52)) +((42 :S 44)) +((9 :R 30) (21 :R 30) (22 :R 30) (52 :R 30)) +((42 :R 31)) +((42 :R 32) (48 :R 32) (51 :R 32)) +((42 :R 33) (48 :R 33) (51 :R 33)) +((42 :R 34) (48 :R 34) (51 :R 34)) +((51 :S 52)) +((50 :S 51)) +((42 :R 35) (48 :R 35) (51 :R 35)) +((42 :R 37) (48 :R 37) (50 :R 37) (51 :R 37)) +((53 :S 54)) +((6 :S 55)) +((7 :S 56)) +((56 :S 59)) +((9 :S 58)) +((9 :R 38) (21 :R 38) (22 :R 38) (52 :R 38)) +((9 :R 39) (42 :R 39) (56 :R 39)) +((40 :S 61)) +((56 :S 59)) +((42 :S 63)) +((6 :R 40) (9 :R 40) (21 :R 40) (22 :R 40) (52 :R 40)) +((59 :S 65)) +((6 :R 43) (9 :R 43) (21 :R 43) (22 :R 43) (49 :S 67) (52 :R 43)) +((6 :R 41) (9 :R 41) (21 :R 41) (22 :R 41) (52 :R 41)) +((61 :S 68)) +((49 :S 69)) +((51 :S 70)) +((50 :S 71)) +((50 :S 72)) +((6 :R 42) (9 :R 42) (21 :R 42) (22 :R 42) (52 :R 42)) +((49 :S 74)) +((51 :S 75)) +((63 :S 76)) +((51 :S 77)) +((50 :S 78)) +((6 :R 44) (9 :R 44) (21 :R 44) (22 :R 44) (52 :R 44)) +((6 :R 45) (9 :R 45) (21 :R 45) (22 :R 45) (52 :R 45)) +((36 :S 38) (57 :S 60) (58 :S 64) (62 :S 73) (67 :S 84)) +((6 :R 46) (9 :R 46) (21 :R 46) (22 :R 46) (52 :R 46)) +((36 :S 38) (57 :S 60) (58 :S 64) (62 :S 73) (67 :S 84)) +((6 :R 47) (9 :R 47) (21 :R 47) (22 :R 47) (52 :R 47)) +((51 :R 53) (71 :S 89) (72 :S 90) (73 :S 91)) +((51 :S 88)) +((70 :S 87)) +((36 :R 48) (57 :R 48) (58 :R 48) (62 :R 48) (65 :R 48) (66 :R 48) (67 :R 48)) +((70 :R 49)) +((51 :R 50)) +((51 :R 51)) +((51 :R 52)) +((9 :R 55) (42 :R 55)) +((42 :R 57)) +((9 :R 59)) +((21 :S 19) (22 :S 20)) +((16 :R 61)) +((16 :R 9) (17 :S 14) (21 :S 19) (22 :S 20)) +((42 :R 36) (48 :R 36) (49 :S 49) (51 :R 36)) +((9 :R 54) (42 :R 54) (56 :S 59)) +((42 :R 56) (48 :S 98) (51 :S 52)) +((9 :R 58) (21 :S 25) (22 :S 28) (52 :S 53)) +((16 :R 60) (74 :S 95)) +((36 :S 38) (57 :S 60) (58 :S 64) (62 :S 73) (65 :S 80) (66 :S 82) (67 :S 84))) + +#104( +((3 . 1)(4 . 2)) +() +() +() +() +((8 . 6)(11 . 9)) +() +() +() +((12 . 10)) +((13 . 11)(23 . 21)(24 . 101)(25 . 22)(26 . 23)(27 . 24)) +() +() +() +() +() +() +() +() +() +() +() +() +() +() +() +((28 . 27)(30 . 32)(31 . 33)(32 . 34)(33 . 35)(34 . 36)(35 . 37)(64 . 103)) +() +((28 . 29)(30 . 32)(31 . 33)(32 . 34)(33 . 35)(34 . 36)(35 . 37)(64 . 103)) +() +((29 . 31)(38 . 40)(39 . 41)) +() +() +() +() +() +() +() +() +() +() +() +((41 . 43)(43 . 45)(44 . 100)(45 . 46)(46 . 47)(47 . 48)) +() +() +() +() +() +() +((47 . 50)) +() +() +() +() +() +() +((54 . 57)(55 . 99)) +() +() +() +() +((54 . 62)(55 . 99)) +() +() +() +((60 . 66)) +() +() +() +() +() +() +() +() +() +() +() +() +() +() +((28 . 81)(30 . 32)(31 . 33)(32 . 34)(33 . 35)(34 . 36)(35 . 37)(64 . 103)) +() +((28 . 83)(30 . 32)(31 . 33)(32 . 34)(33 . 35)(34 . 36)(35 . 37)(64 . 103)) +() +((68 . 85)) +((69 . 86)) +() +() +() +() +() +() +() +() +() +((18 . 96)(19 . 102)(20 . 17)) +() +((15 . 12)(18 . 16)(19 . 102)(20 . 17)) +() +((54 . 92)(55 . 99)) +((43 . 93)(44 . 100)(45 . 46)(46 . 47)(47 . 48)) +((23 . 94)(24 . 101)(25 . 22)(26 . 23)(27 . 24)) +() +((28 . 79)(30 . 32)(31 . 33)(32 . 34)(33 . 35)(34 . 36)(35 . 37)(64 . 103))) +0 + +2 + +#37((MODULE-DEFINITION . #S(ZEBU::ZB-RULE :-NAME MODULE-DEFINITION :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (MODULE-IDENTIFIER "DEFINITIONS" "::=" "BEGIN" MODULE-BODY "END") :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE MODULE-DEFINITION :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL -IDENTIFIER :-VALUE MODULE-IDENTIFIER) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL -BODY :-VALUE MODULE-BODY))) :-BUILD-FN MODULE-DEFINITION248)))) +(MODULE-IDENTIFIER . #S(ZEBU::ZB-RULE :-NAME MODULE-IDENTIFIER :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (MODULE-REFERENCE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(MODULE-BODY . #S(ZEBU::ZB-RULE :-NAME MODULE-BODY :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (EXPORTS IMPORTS ASSIGNMENT-LIST) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE MODULE-BODY :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL -ASSIGNMENT-LIST :-VALUE ASSIGNMENT-LIST))) :-BUILD-FN MODULE-BODY247) #S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(EXPORTS . #S(ZEBU::ZB-RULE :-NAME EXPORTS :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("EXPORTS" SYMBOLS-EXPORTED ";") :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX ("EXPORTS" "ALL" ";") :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(SYMBOLS-EXPORTED . #S(ZEBU::ZB-RULE :-NAME SYMBOLS-EXPORTED :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (SYMBOL+,1$) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(SYMBOL . #S(ZEBU::ZB-RULE :-NAME SYMBOL :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (REFERENCE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(IMPORTS . #S(ZEBU::ZB-RULE :-NAME IMPORTS :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (TYPE-REFERENCE) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(REFERENCE . #S(ZEBU::ZB-RULE :-NAME REFERENCE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (TYPE-REFERENCE) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (VALUE-REFERENCE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(ASSIGNMENT-LIST . #S(ZEBU::ZB-RULE :-NAME ASSIGNMENT-LIST :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (ASSIGNMENT+) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE ASSIGNMENT-LIST :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL -LIST :-VALUE ASSIGNMENT+))) :-BUILD-FN ASSIGNMENT-LIST246)))) +(ASSIGNMENT . #S(ZEBU::ZB-RULE :-NAME ASSIGNMENT :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (SPECIAL-ASSIGNMENT) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE ASSIGNMENT :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL -TYPE :-VALUE :SPECIAL) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL -VALUE :-VALUE SPECIAL-ASSIGNMENT))) :-BUILD-FN ASSIGNMENT243) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (TYPE-ASSIGNMENT) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE ASSIGNMENT :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL -TYPE :-VALUE :TYPE) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL -VALUE :-VALUE TYPE-ASSIGNMENT))) :-BUILD-FN ASSIGNMENT244) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (VALUE-ASSIGNMENT) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE ASSIGNMENT :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL -TYPE :-VALUE :VALUE) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL -VALUE :-VALUE VALUE-ASSIGNMENT))) :-BUILD-FN ASSIGNMENT245)))) +(TYPE-ASSIGNMENT . #S(ZEBU::ZB-RULE :-NAME TYPE-ASSIGNMENT :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (TYPE-REFERENCE "::=" TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(VALUE-ASSIGNMENT . #S(ZEBU::ZB-RULE :-NAME VALUE-ASSIGNMENT :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (VALUE-REFERENCE TYPE "::=" VALUE) :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(TYPE . #S(ZEBU::ZB-RULE :-NAME TYPE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (BUILTIN-TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(BUILTIN-TYPE . #S(ZEBU::ZB-RULE :-NAME BUILTIN-TYPE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (OBJECT-IDENTIFIER-TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (CHOICE-TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (OCTET-STRING-TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (INTEGER-TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (TAGGED-TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(OBJECT-IDENTIFIER-TYPE . #S(ZEBU::ZB-RULE :-NAME OBJECT-IDENTIFIER-TYPE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("OBJECT" "IDENTIFIER") :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(VALUE . #S(ZEBU::ZB-RULE :-NAME VALUE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (BUILTIN-VALUE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(BUILTIN-VALUE . #S(ZEBU::ZB-RULE :-NAME BUILTIN-VALUE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (OBJECT-IDENTIFIER-VALUE) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(OBJECT-IDENTIFIER-VALUE . #S(ZEBU::ZB-RULE :-NAME OBJECT-IDENTIFIER-VALUE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("{" OBJ-ID-COMPONENTS-LIST "}") :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(OBJ-ID-COMPONENTS-LIST . #S(ZEBU::ZB-RULE :-NAME OBJ-ID-COMPONENTS-LIST :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (OBJ-ID-COMPONENTS+) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE OBJ-ID-COMPONENTS-LIST :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL -LIST :-VALUE OBJ-ID-COMPONENTS+))) :-BUILD-FN OBJ-ID-COMPONENTS-LIST242)))) +(OBJ-ID-COMPONENTS . #S(ZEBU::ZB-RULE :-NAME OBJ-ID-COMPONENTS :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (NAME-AND-NUMBER-FORM) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (NAME-FORM) :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (NUMBER-FORM) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(NAME-AND-NUMBER-FORM . #S(ZEBU::ZB-RULE :-NAME NAME-AND-NUMBER-FORM :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (IDENTIFIER "(" NUMBER-FORM ")") :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(NAME-FORM . #S(ZEBU::ZB-RULE :-NAME NAME-FORM :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (IDENTIFIER) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(NUMBER-FORM . #S(ZEBU::ZB-RULE :-NAME NUMBER-FORM :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (A-NUMBER) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(SPECIAL-ASSIGNMENT . #S(ZEBU::ZB-RULE :-NAME SPECIAL-ASSIGNMENT :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("OBJECT-TYPE" "MACRO" "::=" "BEGIN" GARBAGE+ "END") :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(GARBAGE . #S(ZEBU::ZB-RULE :-NAME GARBAGE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (ANY-THING) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(CHOICE-TYPE . #S(ZEBU::ZB-RULE :-NAME CHOICE-TYPE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("CHOICE" "{" GARBAGE+ "}") :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(OCTET-STRING-TYPE . #S(ZEBU::ZB-RULE :-NAME OCTET-STRING-TYPE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("OCTET" "STRING" STRING-OPTIONS) :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(STRING-OPTIONS . #S(ZEBU::ZB-RULE :-NAME STRING-OPTIONS :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("(" "SIZE" "(" A-NUMBER ")" ")") :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(INTEGER-TYPE . #S(ZEBU::ZB-RULE :-NAME INTEGER-TYPE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("INTEGER" "(" A-NUMBER ".." A-NUMBER ")") :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(TAGGED-TYPE . #S(ZEBU::ZB-RULE :-NAME TAGGED-TYPE :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (TAG TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (TAG "IMPLICIT" TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY*) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (TAG "EXPLICIT" TYPE) :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(TAG . #S(ZEBU::ZB-RULE :-NAME TAG :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("[" CLASS CLASS-NUMBER "]") :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(CLASS-NUMBER . #S(ZEBU::ZB-RULE :-NAME CLASS-NUMBER :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (A-NUMBER) :-SEMANTICS NIL :-BUILD-FN IDENTITY)))) +(CLASS . #S(ZEBU::ZB-RULE :-NAME CLASS :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX ("UNIVERSAL") :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX ("APPLICATION") :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX ("PRIVATE") :-SEMANTICS NIL :-BUILD-FN IDENTITY) #S(ZEBU::PRODUCTION-RHS :-SYNTAX NIL :-SEMANTICS NIL :-BUILD-FN IDENTITY*)))) +(GARBAGE+ . #S(ZEBU::ZB-RULE :-NAME GARBAGE+ :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (GARBAGE) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE GARBAGE))) :-BUILD-FN GARBAGE+240) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (GARBAGE GARBAGE+) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE GARBAGE) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL REST :-VALUE GARBAGE+))) :-BUILD-FN GARBAGE+241)))) +(OBJ-ID-COMPONENTS+ . #S(ZEBU::ZB-RULE :-NAME OBJ-ID-COMPONENTS+ :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (OBJ-ID-COMPONENTS) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE OBJ-ID-COMPONENTS))) :-BUILD-FN OBJ-ID-COMPONENTS+238) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (OBJ-ID-COMPONENTS OBJ-ID-COMPONENTS+) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE OBJ-ID-COMPONENTS) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL REST :-VALUE OBJ-ID-COMPONENTS+))) :-BUILD-FN OBJ-ID-COMPONENTS+239)))) +(ASSIGNMENT+ . #S(ZEBU::ZB-RULE :-NAME ASSIGNMENT+ :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (ASSIGNMENT) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE ASSIGNMENT))) :-BUILD-FN ASSIGNMENT+236) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (ASSIGNMENT ASSIGNMENT+) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE ASSIGNMENT) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL REST :-VALUE ASSIGNMENT+))) :-BUILD-FN ASSIGNMENT+237)))) +(SYMBOL+,1$ . #S(ZEBU::ZB-RULE :-NAME SYMBOL+,1$ :-PRODUCTIONS (#S(ZEBU::PRODUCTION-RHS :-SYNTAX (SYMBOL) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE SYMBOL))) :-BUILD-FN SYMBOL+,1$234) #S(ZEBU::PRODUCTION-RHS :-SYNTAX (SYMBOL "," SYMBOL+,1$) :-SEMANTICS #S(ZEBU::FEAT-TERM :-TYPE KB-SEQUENCE :-SLOTS (#S(ZEBU::LABEL-VALUE-PAIR :-LABEL FIRST :-VALUE SYMBOL) #S(ZEBU::LABEL-VALUE-PAIR :-LABEL REST :-VALUE SYMBOL+,1$))) :-BUILD-FN SYMBOL+,1$235)))) +) \ No newline at end of file

Modified: trunk/asn.1/asn.1.zb ============================================================================== --- trunk/asn.1/asn.1.zb (original) +++ trunk/asn.1/asn.1.zb Sat Sep 15 17:13:11 2007 @@ -1,29 +1,94 @@ ;;;; -*- Mode: Lisp -*-

-(:name "asn.1" - :domain-file "asn.1-domain" +(:name "ASN.1" + :domain-file "asn.1-domain.lisp" :package "ASN.1" :grammar "zebu-mg" :identifier-start-chars "abcdefghijklmnopqrstuvwxyz" :identifier-continue-chars "-abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890" - :lex-cats ((BSTRING "'[01]+'B") - (HSTRING "'([A-F0-9]+)'H")) - ) - -;; Domain definition - -Module-Definition := kb-domain: [(-identifier Module-Identifier) - (-body Module-Body)] ; - -;; Productions + :lex-cats (;;(BSTRING "'[01]+'B") + ;;(HSTRING "'([A-F0-9]+)'H") + (A-Number "[0-9]+") + (Value-Reference "[a-z][a-zA-Z0-9-]+") + (Type-Reference "[A-Z][a-zA-Z0-9-]*") + (Module-Reference "[A-Z][a-zA-Z0-9-]*") + (Any-Thing "[^ ]+"))) + +;; Domain Definitions + +Module-Definition := kb-domain: [(-identifier) (-body)]; +Module-Body := kb-domain: [(-assignment-list)]; +Assignment-List := kb-domain: [(-list kb-sequence)]; +Assignment := kb-domain: [(-type) (-value)]; +Obj-Id-Components-List := kb-domain: [(-list kb-sequence)];

+;; Rule Definitions Module-Definition --> Module-Identifier "DEFINITIONS" "::=" "BEGIN" Module-Body "END" { Module-Definition:[(-identifier Module-Identifier) (-body Module-Body)] };

-Module-Identifier --> Identifier; +Module-Identifier --> Module-Reference; + +Module-Body --> Exports Imports Assignment-List + { Module-Body:[(-assignment-list Assignment-List)] } + | ; + +Exports --> "EXPORTS" Symbols-Exported ";" | "EXPORTS" "ALL" ";" |; + +Symbols-Exported --> Symbol+ "," | ; + +Symbol --> Reference; + +Imports --> Type-Reference | ; + +Reference --> Type-Reference | Value-Reference; + +Assignment-List --> Assignment+ " " { Assignment-List:[(-list Assignment+)] }; + +Assignment --> Special-Assignment { Assignment:[(-type :special) (-value Special-Assignment)] } + | Type-Assignment { Assignment:[(-type :type) (-value Type-Assignment)] } + | Value-Assignment { Assignment:[(-type :value) (-value Value-Assignment)] }; + +Type-Assignment --> Type-Reference "::=" Type; +Value-Assignment --> Value-Reference Type "::=" Value; + +Type --> Builtin-Type; + +Builtin-Type --> Object-Identifier-Type + | Choice-Type + | Octet-String-Type + | Integer-Type + | Tagged-Type; + +Object-Identifier-Type --> "OBJECT" "IDENTIFIER"; + +Value --> Builtin-Value; + +Builtin-Value --> Object-Identifier-Value; + +Object-Identifier-Value --> "{" Obj-Id-Components-List "}"; + +Obj-Id-Components-List --> Obj-Id-Components+ " " + { Obj-Id-Components-List:[(-list Obj-Id-Components+)] }; + +Obj-Id-Components --> Name-And-Number-Form | Name-Form | Number-Form; + +Name-And-Number-Form --> Identifier "(" Number-Form ")"; +Name-Form --> Identifier; +Number-Form --> A-Number; + +Special-Assignment --> "OBJECT-TYPE" "MACRO" "::=" "BEGIN" Garbage+ " " "END"; +Garbage --> Any-Thing; + +Choice-Type --> "CHOICE" "{" Garbage+ " " "}"; +Octet-String-Type --> "OCTET" "STRING" String-Options; +String-Options --> "(" "SIZE" "(" A-Number ")" ")" |;

-Module-Body --> Identifier; +Integer-Type --> "INTEGER" "(" A-Number ".." A-Number ")"; +Tagged-Type --> Tag Type | Tag "IMPLICIT" Type | Tag "EXPLICIT" Type; +Tag --> "[" Class Class-Number "]"; +Class-Number --> A-Number; +Class --> "UNIVERSAL" | "APPLICATION" | "PRIVATE" |;

Modified: trunk/asn.1/ber.lisp ============================================================================== --- trunk/asn.1/ber.lisp (original) +++ trunk/asn.1/ber.lisp Sat Sep 15 17:13:11 2007 @@ -41,7 +41,7 @@ (type (integer 0) tags)) (assert (and (<= 0 class 3) (<= 0 p/c 1) (<= 0 tags))) (labels ((iter (n p acc) - (if (= n 0) acc + (if (zerop n) acc (multiple-value-bind (q r) (floor n 128) (iter q 1 (cons (logior (ash p 7) r) acc)))))) (if (< tags 31) @@ -52,14 +52,14 @@ (defun ber-decode-type (stream) "Decode BER Type Domain" (declare (type stream stream)) - (let ((byte (stream-read-byte stream)) + (let ((byte (read-byte stream)) (type-length 1)) (let ((class (ldb (byte 2 6) byte)) (p/c (ldb (byte 1 5) byte)) (tags (ldb (byte 5 0) byte))) (when (= tags 31) (setf tags (labels ((iter (acc) - (setf byte (stream-read-byte stream)) + (setf byte (read-byte stream)) (incf type-length) (let ((temp (logior (ash acc 7) (ldb (byte 7 0) byte)))) (if (= (ldb (byte 1 7) byte) 1) (iter temp) temp)))) @@ -88,7 +88,7 @@ (declare (type (integer 0) length)) (assert (<= 0 length (1- (expt 2 1008)))) (labels ((iter (n acc l) - (if (= n 0) (cons (mod (logior 128 l) 256) acc) + (if (zerop n) (cons (mod (logior 128 l) 256) acc) (multiple-value-bind (q r) (floor n 256) (iter q (cons r acc) (1+ l)))))) (if (< length 128) (list length) @@ -97,15 +97,15 @@ (defun ber-decode-length (stream) "Decode BER Length Domain" (declare (type stream stream)) - (let ((byte (stream-read-byte stream)) + (let ((byte (read-byte stream)) (length-length 1)) (let ((flag (ldb (byte 1 7) byte)) (l-or-n (ldb (byte 7 0) byte))) - (let ((res (if (= flag 0) l-or-n + (let ((res (if (zerop flag) l-or-n (let ((acc 0)) (dotimes (i l-or-n) (setf acc (logior (ash acc 8) - (stream-read-byte stream))) + (read-byte stream))) (incf length-length) acc))))) (values res length-length))))) @@ -125,7 +125,7 @@ (type integer length) (ignore type)) (dotimes (i length) - (stream-read-byte stream)) + (read-byte stream)) nil)

;;;;;;;;;;;;;;;;;;;;;;; @@ -137,7 +137,7 @@ (defmethod ber-encode ((value integer)) (assert (<= 0 value)) (labels ((iter (n acc l) - (if (= n 0) (values acc l) + (if (zerop n) (values acc l) (multiple-value-bind (q r) (floor n 256) (iter q (cons r acc) (1+ l)))))) (multiple-value-bind (v l) (iter value nil 0) @@ -151,7 +151,7 @@ (ignore type)) (labels ((iter (i acc) (if (= i length) acc - (iter (1+ i) (logior (ash acc 8) (stream-read-byte stream)))))) + (iter (1+ i) (logior (ash acc 8) (read-byte stream)))))) (iter 0 0)))

;;; OCTET STRING (:octet-string) @@ -166,7 +166,7 @@ (type integer length) (ignore type)) (let ((str (make-string length))) - (map-into str #'(lambda () (code-char (stream-read-byte stream)))))) + (map-into str #'(lambda () (code-char (read-byte stream))))))

;;; SEQUENCE (:sequence)

@@ -182,7 +182,7 @@ (type integer length) (ignore type)) (labels ((iter (length-left acc) - (if (= length-left 0) + (if (zerop length-left) (nreverse acc) (multiple-value-bind (sub-type sub-type-length) (ber-decode-type stream) @@ -205,7 +205,7 @@ (declare (type stream stream) (type integer length) (ignore type)) - (assert (= length 0)) + (assert (zerop length)) nil)

(eval-when (:load-toplevel :execute)

Modified: trunk/asn.1/mib.lisp ============================================================================== --- trunk/asn.1/mib.lisp (original) +++ trunk/asn.1/mib.lisp Sat Sep 15 17:13:11 2007 @@ -4,10 +4,6 @@

(in-package :asn.1)

-(defparameter *mib-tree* '(nil nil (1 ("iso") - (3 ("org") - (6 ("dod")))))) - (proclaim '(inline tree-id tree-name tree-object tree-nodes)) (defun tree-id (node) (car node)) (defun tree-name (node) (caadr node)) @@ -45,3 +41,37 @@ (defmethod print-object ((obj object-id) stream) (format stream "[~{.~A~}]" (oid-subids obj)))

+(defparameter *mib-tree* '(nil nil (1 ("iso") + (3 ("org") + (6 ("dod")))))) + +(defvar *mib-pathname-base* #p"/usr/share/snmp/mibs/") + +(defun mib-pathname (name &optional (base *mib-pathname-base*)) + (merge-pathnames (make-pathname :name name :type "txt") + base)) + +(defparameter *mibs-list* + '("RFC1155-SMI")) + +(defvar *asn.1-def* (merge-pathnames + (make-pathname :name "asn.1" :type "zb" + :directory '(:relative "asn.1")) + (asdf:component-pathname (asdf:find-system :net-snmp)))) + +(defparameter *asn.1-syntax* (merge-pathnames + (make-pathname :name "asn.1" :type "tab" + :directory '(:relative "asn.1")) + (asdf:component-pathname (asdf:find-system :net-snmp)))) + +(defun parse-mib (file) + (let ((zb:*comment-start* "--") + (zb:*comment-brackets* '(("/*" . "*/")))) + (zb:file-parser file :grammar (zb:find-grammar "ASN.1") :verbose nil))) + +(defun parse-oid-def (syntax-tree) + (let ((module (car syntax-tree))) + (let ((assignment-list (Assignment-List--list + (Module-Body--assignment-list + (Module-Definition--body module))))) + assignment-list)))

Modified: trunk/asn.1/oid.lisp ============================================================================== --- trunk/asn.1/oid.lisp (original) +++ trunk/asn.1/oid.lisp Sat Sep 15 17:13:11 2007 @@ -24,22 +24,22 @@ ;;; Note: defdelim and ddfn are copyed from ;;; Page 228 (Figure 17.4), Paul Graham's /On Lisp/.

-(eval-when (:compile-toplevel :load-toplevel :execute) - (defmacro defdelim (left right parms &body body) - `(ddfn ,left ,right #'(lambda ,parms ,@body))) - - (let ((rpar (get-macro-character #)))) - (defun ddfn (left right fn) - (set-macro-character right rpar) - (set-dispatch-macro-character ## left - #'(lambda (stream char-1 char-2) - (declare (ignore char-1 char-2)) - (apply fn - (read-delimited-list right stream t)))))) - - ;;; Object ID Reader Macro #{...} - (defdelim #{ #} (&rest args) - `(parse-oid (list ,@args)))) +;;;; (eval-when (:compile-toplevel :load-toplevel :execute) +;;;; (defmacro defdelim (left right parms &body body) +;;;; `(ddfn ,left ,right #'(lambda ,parms ,@body))) + +;;;; (let ((rpar (get-macro-character #)))) +;;;; (defun ddfn (left right fn) +;;;; (set-macro-character right rpar) +;;;; (set-dispatch-macro-character ## left +;;;; #'(lambda (stream char-1 char-2) +;;;; (declare (ignore char-1 char-2)) +;;;; (apply fn +;;;; (read-delimited-list right stream t)))))) + +;;;; ;;; Object ID Reader Macro #{...} +;;;; (defdelim #{ #} (&rest args) +;;;; `(parse-oid (list ,@args))))

;;; Note: oid-component, oid-component-length, list-prefix-p, oid-list->=, ;;; oid-list-< and oid-prefix-p are copyed from @@ -83,10 +83,10 @@

(defmethod ber-encode ((value object-id)) (labels ((number-get (n) - (if (= n 0) (values (list 0) 1) + (if (zerop n) (values (list 0) 1) (number-split n 0 nil 0))) (number-split (n p acc l) - (if (= n 0) (values acc l) + (if (zerop n) (values acc l) (multiple-value-bind (q r) (floor n 128) (number-split q 1 (cons (logior (ash p 7) r) acc) (1+ l))))) (iter (oids acc len) @@ -114,16 +114,17 @@ (declare (type stream stream) (type integer length) (ignore type)) - (if (= length 0) #{} + (if (zerop length) + (make-instance 'objet-id) (labels ((get-number (acc len) - (let* ((byte (stream-read-byte stream)) + (let* ((byte (read-byte stream)) (val (logior (ash acc 7) (logand byte 127)))) (if (< byte 128) (values val len) (get-number val (1+ len))))) (iter (left-length acc head-p) (declare (type integer left-length) (type list acc)) - (if (= left-length 0) (nreverse acc) + (if (zerop left-length) (nreverse acc) (multiple-value-bind (n l) (get-number 0 1) (if head-p (multiple-value-bind (q r) (floor n 40)

Modified: trunk/asn.1/package.lisp ============================================================================== --- trunk/asn.1/package.lisp (original) +++ trunk/asn.1/package.lisp Sat Sep 15 17:13:11 2007 @@ -2,6 +2,7 @@

(defpackage :asn.1 (:use :common-lisp - #+lispworks :stream)) + #+lispworks :stream + :zebu))

(in-package :asn.1)

Modified: trunk/asn.1/stream-test.lisp ============================================================================== --- trunk/asn.1/stream-test.lisp (original) +++ trunk/asn.1/stream-test.lisp Sat Sep 15 17:13:11 2007 @@ -1,5 +1,8 @@ (in-package :asn.1)

+(eval-when (:compile-toplevel :load-toplevel) + (clc:clc-require :zebu-compiler)) + (defclass ber-stream (fundamental-input-stream) ((sequence :type sequence :initarg :seq :reader ber-sequence) (length :type integer :accessor ber-length) @@ -22,3 +25,20 @@ x (ber-decode (make-instance 'ber-stream :seq code)) code code) x)) + +(defun mib-display (name &optional (lines 10)) + (let ((file (mib-pathname name))) + (with-open-file (s file :direction :input :element-type 'base-char) + (dotimes (i lines file) + (princ (read-line s)) + (fresh-line))))) + +(defun load-syntax (&optional (def *asn.1-def*) (syntax *asn.1-syntax*)) + (zb:zebu-compile-file def :output-file syntax) + (zb:zebu-load-file syntax)) + +(defun test-syntax (name) + (parse-mib (merge-pathnames + (make-pathname :name name :type "asn" + :directory '(:relative "asn.1" "test")) + (asdf:component-pathname (asdf:find-system :net-snmp)))))

Modified: trunk/asn.1/test/1.asn ============================================================================== --- trunk/asn.1/test/1.asn (original) +++ trunk/asn.1/test/1.asn Sat Sep 15 17:13:11 2007 @@ -1,4 +1,101 @@ -aAAA DEFINITIONS ::= -BEGIN - bBBB +RFC1155-SMI DEFINITIONS ::= BEGIN + +EXPORTS -- EVERYTHING + internet, directory, mgmt, + experimental, private, enterprises, + OBJECT-TYPE, ObjectName, ObjectSyntax, SimpleSyntax, + ApplicationSyntax, NetworkAddress, IpAddress, + Counter, Gauge, TimeTicks, Opaque; + + -- the path to the root + + internet OBJECT IDENTIFIER ::= { iso org(3) dod(6) 1 } + + directory OBJECT IDENTIFIER ::= { internet 1 } + + mgmt OBJECT IDENTIFIER ::= { internet 2 } + + experimental OBJECT IDENTIFIER ::= { internet 3 } + + private OBJECT IDENTIFIER ::= { internet 4 } + enterprises OBJECT IDENTIFIER ::= { private 1 } + + -- definition of object types + + + -- names of objects in the MIB + + ObjectName ::= OBJECT IDENTIFIER + + OBJECT-TYPE MACRO ::= + BEGIN + TYPE NOTATION ::= "SYNTAX" type (TYPE ObjectSyntax) + "ACCESS" Access + "STATUS" Status + VALUE NOTATION ::= value (VALUE ObjectName) + + Access ::= "read-only" + | "read-write" + | "write-only" + | "not-accessible" + Status ::= "mandatory" + | "optional" + | "obsolete" + END + + ObjectSyntax ::= + CHOICE { + simple + SimpleSyntax, + -- note that simple SEQUENCEs are not directly + -- mentioned here to keep things simple (i.e., + -- prevent mis-use). However, application-wide + -- types which are IMPLICITly encoded simple + -- SEQUENCEs may appear in the following CHOICE + + application-wide + ApplicationSyntax + } + + SimpleSyntax ::= + CHOICE { + number + INTEGER, + string + OCTET STRING, + object + OBJECT IDENTIFIER, + empty + NULL + } + + ApplicationSyntax ::= + CHOICE { + address + NetworkAddress, + counter + Counter, + gauge + Gauge, + ticks + TimeTicks, + arbitrary + Opaque + + -- other application-wide types, as they are + -- defined, will be added here + } + + -- application-wide types + + NetworkAddress ::= + CHOICE { + internet + IpAddress + } + + IpAddress ::= + [APPLICATION 0] -- in network-byte order + IMPLICIT OCTET STRING (SIZE (4)) + END

Added: trunk/asn.1/test/2.asn ============================================================================== --- (empty file) +++ trunk/asn.1/test/2.asn Sat Sep 15 17:13:11 2007 @@ -0,0 +1,119 @@ +RFC1155-SMI DEFINITIONS ::= BEGIN + +EXPORTS -- EVERYTHING + internet, directory, mgmt, + experimental, private, enterprises, + OBJECT-TYPE, ObjectName, ObjectSyntax, SimpleSyntax, + ApplicationSyntax, NetworkAddress, IpAddress, + Counter, Gauge, TimeTicks, Opaque; + + -- the path to the root + + internet OBJECT IDENTIFIER ::= { iso org(3) dod(6) 1 } + + directory OBJECT IDENTIFIER ::= { internet 1 } + + mgmt OBJECT IDENTIFIER ::= { internet 2 } + + experimental OBJECT IDENTIFIER ::= { internet 3 } + + private OBJECT IDENTIFIER ::= { internet 4 } + enterprises OBJECT IDENTIFIER ::= { private 1 } + + -- definition of object types + + OBJECT-TYPE MACRO ::= + BEGIN + TYPE NOTATION ::= "SYNTAX" type (TYPE ObjectSyntax) + "ACCESS" Access + "STATUS" Status + VALUE NOTATION ::= value (VALUE ObjectName) + + Access ::= "read-only" + | "read-write" + | "write-only" + | "not-accessible" + Status ::= "mandatory" + | "optional" + | "obsolete" + END + + -- names of objects in the MIB + + ObjectName ::= + OBJECT IDENTIFIER + + -- syntax of objects in the MIB + + ObjectSyntax ::= + CHOICE { + simple + SimpleSyntax, + -- note that simple SEQUENCEs are not directly + -- mentioned here to keep things simple (i.e., + -- prevent mis-use). However, application-wide + -- types which are IMPLICITly encoded simple + -- SEQUENCEs may appear in the following CHOICE + + application-wide + ApplicationSyntax + } + + SimpleSyntax ::= + CHOICE { + number + INTEGER, + string + OCTET STRING, + object + OBJECT IDENTIFIER, + empty + NULL + } + + ApplicationSyntax ::= + CHOICE { + address + NetworkAddress, + counter + Counter, + gauge + Gauge, + ticks + TimeTicks, + arbitrary + Opaque + + -- other application-wide types, as they are + -- defined, will be added here + } + + -- application-wide types + + NetworkAddress ::= + CHOICE { + internet + IpAddress + } + + IpAddress ::= + [APPLICATION 0] -- in network-byte order + IMPLICIT OCTET STRING (SIZE (4)) + + Counter ::= + [APPLICATION 1] + IMPLICIT INTEGER (0..4294967295) + + Gauge ::= + [APPLICATION 2] + IMPLICIT INTEGER (0..4294967295) + + TimeTicks ::= + [APPLICATION 3] + IMPLICIT INTEGER (0..4294967295) + + Opaque ::= + [APPLICATION 4] -- arbitrary ASN.1 value, + IMPLICIT OCTET STRING -- "double-wrapped" + + END