.TITLE CC002 .ident /X01.03/ .NLIST BEX .ENABL LC, GBL .LIST MEB ; ; C COMPILER ; PREPROCESSOR (EVALUATOR FOR #IF) ; ; VERSION X01 ; ; MARTIN MINOW 25-NOV-82 ; ; EDIT HISTORY ; 01 25-Nov-82 MM Hand translated MPEXPR.C ; 02 27-Dec-82 MM Undefined symbol == 0 (tracks Unix C) ; 03 06-Jan-83 MM Typo .IF NE RSX .MCALL CALL .MCALL CALLR .MCALL RETURN .IFF .MACRO CALL ARG1,ARG2 .IF B ARG2 JSR PC,ARG1 .IFF JSR ARG1,ARG2 .ENDC .ENDM CALL .MACRO CALLR ARG1 JMP ARG1 .ENDM .MACRO RETURN ARG1 .IF B ARG1 RTS PC .IFF RTS ARG1 .ENDC .ENDM RETURN .ENDC .globl ifeval .psect er002 err01: .asciz "Ill-formed #if expression" err02: .asciz "Bad #if query syntax" err03: .asciz "Divide by zero in #if expression" err04: .asciz "Missing ')' in #if expression" err05: .asciz "Illegal character constant in #if expression" err06: .asciz "Syntax error in #if expression" ;02 .even .macro fail msg mov msg,r0 jmp iffail .endm fail ; ; Note: ungetc assumes that spnor sets the line pointer BEYOND ; the end of line, so sequences such as ; call spnor ; ungetc ; call spnor ; continue to return "end of line" ; ; This is a bit of a hack, but, what the hell, it's getting ; pretty late and nobody reads this stuff anyways. ; .macro ungetc dec r5 ; back up line pointer .endm ungetc debug = 0 .macro log message,?loc,?exit .if ne debug mov r0,-(sp) mov #loc,r0 call ccerr mov r5,r0 call ccerr mov (sp)+,r0 br exit loc: .asciz message .even exit: .endc .endm log .macro regs reg .if gt debug-1 mov r1,-(sp) ror r1 call regdmp rol r1 ; restore carry mov (sp)+,r1 .if nb reg mov reg,reg ; Set condition codes, preserving C bit .endc .endc .endm regs .macro skip why log ; Only if you're desperate call spnor regs r0 ; Only if you're really desperate .endm .macro logreg what regs log .endm .psect cc002 ;+ ; ** IFEVAL ; ; Evaluate an expression. ; ; Input: ; R5 -> start of string ; BEND (end of string -- hidden) ; Output: ; R2 Result ; ; Registers: ; R0, R1 Temps (R1 for multiply-divide ; R2 Current value ; R3, R4 Unused ; R5 Input pointer. ; ; Yes friends, this is a crude recursive-descent expression evaluator. ; taken without much thought or consideration from MPEXPR.C. ; Errors are handled by stuffing the error code in R0 and jumping to ; IFFAIL which fixes up the stack. ; ; Before calling ifeval, all #define'd symbols have been expanded. ; ; Limitation: The C ||, &&, and "? :" are fully evaluated. Thus, ; you can't write something like ; #if (foo == 0) ? bar : 10 / foo ; as your program will get a syntax error. Fix it if you dare. ; ; ; The code assumes it can "unget" a character by decrementing R5 ; and that a null byte follows the line. ; ifeval: call query ; Compile expression skip <"ifeval after query"> bcs 10$ ; ok exit at end of line fail #err01 ; parse messup 10$: log <"normal return"> return ; ; Algorithms are given in BNF. Note syntax: ; :== separates result from its expansion. ; || separates choices. ; {{ }} encloses optionally repeated elements. ; ; Query is explained in detail -- other routines aren't to save my ; fingers and sanity. ; ; :== || ? : ; query: log <"at query"> call lor ; Result or value to test if ? skip <"query after lor"> cmp r0,#'? ; Query? beq 10$ ; Br if so. ungetc ; Rescan this character later return ; result is value. 10$: mov r2,-(sp) ; Save test value for later ; Strictly speaking, we should really ; evaluate only the "true" or "false" ; expression. We evaluate both. call query ; Get "if query is true" value skip <"after 2nd query call"> cmp r0,#': ; Colon separates and beq 20$ ; Gotcha fail #err02 ; Sorry. 20$: mov r2,-(sp) ; Push result call query ; One more time for mov (sp)+,r0 ; Reget . Note: ; r0 has ; r2 has tst (sp)+ ; Evaluate query itself. beq 30$ ; Branch if false, r2 has result mov r0,r2 ; Return value 30$: return ; Done ; ; :== {{ '||' }} ; lor: log <"at lor"> call land 10$: skip <"lor loop"> cmp r0,#'| ; Followed by '||'? bne 30$ ; No way cmpb (r5)+,#'| ; Check out second '|' bne 20$ ; Br if followed by one '|' mov r2,-(sp) ; Save left hand value call land ; Evaluate another term bis (sp)+,r2 ; Or 'em together beq 10$ ; FALSE, go for another term mov #1,r2 ; || returns one or zero br 10$ ; Go for more. 20$: ungetc ; Here after reading two char's after expr. 30$: ungetc ; Here after reading one char after expr. return ; ; :== {{ && }} ; land: log <"at land"> call bor 10$: skip <"land loop"> cmp r0,#'& bne 30$ cmpb (r5)+,#'& bne 20$ mov r2,-(sp) call bor mov r2,r0 ; result to a temp clr r2 ; assume zero result tst (sp)+ ; left-hand side? beq 10$ ; is zero, onward tst r0 ; right-hand side? beq 10$ ; is zero, onward inc r2 ; && is true, result is one br 10$ ; onward 20$: ungetc 30$: ungetc return ; ; ::= {{ | }} ; bor: log <"at bor"> call bxor 10$: skip <"bor loop"> cmp r0,#'| bne 20$ cmpb (r5),#'| ; Must not be followed by || beq 20$ ; Exit if so. mov r2,-(sp) ; Save left side call bxor ; Evaluate right side bis (sp)+,r2 br 10$ 20$: ungetc return ; ; :== {{ ^ }} ; bxor: log <"at bxor"> call band 10$: skip <"bxor loop"> cmpb r0,#'^ bne 20$ mov r2,-(sp) call band mov (sp),-(sp) ; Evaluate xor the hard way bic r2,2(sp) bic (sp)+,r2 bis (sp)+,r2 br 10$ 20$: ungetc return ; ; :== {{ & }} ; band: log <"at band"> call eql 10$: skip <"band loop"> cmp r0,#'& bne 20$ cmpb (r5),#'& beq 20$ ; Not if followed by && mov r2,-(sp) call eql com (sp) ; And the hard way bic (sp)+,r2 br 10$ 20$: ungetc return ; ; :== {{ }} ; eql: log <"at eql"> call relat 10$: call eqrel ; Subroutine 'cause it's ugly bmi 30$ ; Not relation if -1 mov r2,-(sp) ; Push left-hand side mov r0,-(sp) ; Push relation call relat ; Get right-hand side mov r2,r0 clr r2 ; Assume not-equal result tst (sp)+ ; relation? bne 20$ ; Br if != test wanted cmp (sp)+,r0 ; if (left == right) bne 10$ ; (br if they're unequal) inc r2 ; result is 1. br 10$ ; and go on 20$: cmp (sp)+,r0 ; if (left != right) beq 10$ ; (br if they're equal) inc r2 ; result is 1. br 10$ ; and go on. 30$: return ; ; :== '=' || '==' || '!=' ; eqrel: skip <"eqrel"> cmp r0,#'= bne 20$ ; not == cmpb (r5)+,#'= ; is it = or ==? beq 10$ ; br if == ungetc ; back up 10$: clr r0 ; return zero for == return 20$: cmp r0,#'! ; Is it != bne 40$ ; No way. cmpb (r5)+,#'= ; Well? bne 30$ ; !foo, exit. mov #1,r0 ; return one for != return ; 30$: ungetc ; Backup twice for !foo 40$: ungetc ; Backup once if not ! or = mov #-1,r0 ; Return -1 (set N bit, too) return ; ; :== {{ }} ; relat: log <"at relat"> call shift 10$: call relop ; Return handler location or NULL beq 30$ ; Not a relop mov r2,-(sp) ; Left side mov r0,-(sp) ; Relation call shift ; Get right side mov r2,r0 ; Save right side clr r2 ; Assume zero result. jmp @(sp)+ ; Do it. LSS = . ; left < right cmp (sp)+,r0 bge 10$ ; Br if >= br 20$ LEQ = . ; left <= right cmp (sp)+,r0 bgt 10$ ; Br if > br 20$ GEQ = . cmp (sp)+,r0 blt 10$ br 20$ GTR = . cmp (sp)+,r0 ble 10$ ;;br 20$ 20$: inc r2 br 10$ 30$: return ; ; :== '<' || '<=' || '>=' || '>' ; relop: skip <"relop"> cmp r0,#'< bne 20$ cmpb (r5)+,#'= ;03 bne 10$ mov #LEQ,r0 return 10$: ungetc mov #LSS,r0 return 20$: cmp r0,#'> bne 40$ cmpb (r5)+,#'= bne 30$ mov #GEQ,r0 return 30$: ungetc mov #GTR,r0 return 40$: ungetc clr r0 return ; ; :== {{ }} ; :== '<<' || '>>' ; shift: log <"at shift"> call primary 10$: skip <"shift loop"> cmp r0,#'< beq 20$ cmp r0,#'> bne 80$ 20$: cmpb (r5)+,r0 ; >> or << ? bne 70$ ; No, isn't a shift mov r0,-(sp) ; Push shift op. mov r2,-(sp) ; Push left side call primary ; Get right side mov r2,r0 ; Save it. mov (sp)+,r2 ; Left side cmp (sp)+,#'> ; Right shift? beq 60$ ; Br if so. br 40$ ; Left shift, enter at test. 30$: asl r2 ; Shift left once 40$: dec r0 ; More? bge 30$ ; Yes. br 10$ 50$: asr r2 ; Shift right once 60$: dec r0 ; More? bge 50$ ; Yes br 10$ 70$: ungetc ; ' return ; ; :== {{ }} ; :== '+' || '-' ; primary: log <"at primary"> call term 10$: skip <"primary loop"> cmp r0,#'+ beq 20$ cmp r0,#'- bne 40$ 20$: mov r0,-(sp) mov r2,-(sp) call term mov r2,r0 mov (sp)+,r2 cmp (sp)+,#'- beq 30$ add r0,r2 br 10$ 30$: sub r0,r2 br 10$ 40$: ungetc return ; ; :== {{ }} ; :== '*' || '/' || '%' ; term: log <"at term"> call unary 10$: skip <"term loop"> cmp r0,#'* beq 20$ cmp r0,#'/ beq 20$ cmp r0,#'% ; modulus bne 60$ ; not a mulop 20$: mov r2,-(sp) ; left side (numerator) mov r0,-(sp) ; operator call unary ; get denomenator mov (sp)+,r0 ; get back op mov (sp),r1 ; numerator to r1 (don't pop) mov r2,(sp) ; "push" denomenator cmp r0,#'* ; mul? beq 40$ ; do it. tst (sp) ; Divide and mod have problems with zero beq 70$ ; urk. cmp r0,#'/ ; divide? beq 30$ ; do it. clr r0 ; Clear high word call $divr0 ; br 50$ ; R1 has remainder 30$: clr r0 call $divr0 mov r0,r1 ; R1 has quotient br 50$ 40$: call $mulr1 50$: mov r1,r2 tst (sp)+ ; Drop temp br 10$ 60$: ungetc return 70$: fail #err03 ; ; :== || ; :== '!' || '' || '-' ; unary: log <"at unary"> skip <"unary"> cmp r0,#'! beq 10$ cmp r0,#0176 ; Just paranoid about tilde's beq 10$ cmp r0,#'- bne 50$ ; not a unary 10$: mov r0,-(sp) ; stack the op call unary ; again mov (sp)+,r0 ; reget the op cmp r0,#'! ; logical not? bne 30$ clr r0 ; yes, assume "no" tst r2 ; well bne 20$ ; no it is inc r0 ; yes it is 20$: mov r0,r2 ; get value return 30$: cmp r0,#0176 ; TILDE? bne 40$ com r2 ; yes return 40$: neg r2 return 50$: ungetc callr factor ; ; :== || '(' ')' ; factor: log <"at factor"> skip <"factor"> cmp r0,#'( bne 10$ call query ; from the top skip <"factor after (query)"> cmp r0,#') beq 20$ ; match fail #err04 10$: ungetc call const 20$: return ; ; :== || '' ; :== '\' ; || '\' ; || const: log <"at const"> skip <"const"> cmp r0,#'' ; character? beq 10$ ; go for it ungetc callr number 10$: movb (r5)+,r0 ; the character cmp r0,#'' ; '' is illegal beq 70$ cmp r0,#'\ ; backslash is funny bne 40$ movb (r5)+,r0 ; next byte beq 70$ ; end of line test cmpb r0,#'0 ; digit? blo 20$ ; nope cmpb r0,#'7 ; octal digit? bhi 20$ ; nope call octal ; yep br 50$ ; check for terminating ' and exit. 20$: mov #esctab,r2 ; Search for funny escape char's 30$: cmpb (r2)+,r0 ; Found? beq 60$ ; yep. tstb (r2)+ ; nope, at end? bne 30$ ; not yet ; ; Not a funny escape (such as '\n'). The result is in r0 ; 40$: mov r0,r2 ; ; We have a character (in r2), check for a closing quote. ; 50$: cmpb (r5)+,#'' bne 70$ return ; ; Here when we have a character from the escape table. ; Get its actual value ; 60$: movb (r2),r2 br 50$ ; ; Trouble. ; 70$: fail #err05 ; ; The escape table contains internal values for all \ escapes ; esctab: .byte 'n,012 .byte 'r,015 .byte 't,011 .byte 'b,010 .byte 'f,014 .byte 'e,033 ; .byte 0,0 ; end of the table .even ; ; digit string. Even 0xFFF ; number: log <"at number"> skip <"number"> cmpb r0,#'9 ; digit? bhi 30$ ; not a number cmpb r0,#'0 ; digit? blo 30$ ; not a number bne 20$ ; decimal. ; ; octal or hex ; movb (r5)+,r0 ; next digit tells. cmpb r0,#'x ; hex? beq 10$ ; yep cmpb r0,#'X ; hex again? beq 10$ ; still yep. ungetc callr octal 10$: callr hex 20$: ungetc callr decimal ; ; Not a number. Undefined symbols have zero value. ; (This follows Unix C.) ; 30$: ;02+ call oksid ; Can it start an ID? bcs 50$ ; Sorry about that 40$: movb (r5)+,r0 ; Get the next one call okid ; Is it a valid id? bcc 40$ ; Keep 'em coming clr r2 ; Return zero value ungetc ; Back up the scanner return ; All done 50$: ;02- fail #err06 ; ; Number converters, result to r2 ; octal: log <"at octal"> clr r2 10$: movb (r5)+,r0 cmp r0,#'0 blo 20$ cmp r0,#'9 ; Unix misfeature bhi 20$ sub #'0,r0 asl r2 asl r2 asl r2 add r0,r2 br 10$ 20$: ungetc return hex: log <"at hex"> clr r2 10$: movb (r5)+,r0 cmp r0,#'0 blo 30$ cmp r0,#'9 blos 20$ bic #040,r0 ; mash to upper case cmp r0,#'A blo 30$ cmp r0,#'F bhi 30$ sub #'A-'9-1,r0 20$: sub #'0,r0 asl r2 asl r2 asl r2 asl r2 add r0,r2 br 10$ 30$: ungetc return decimal: log <"at decimal"> clr r2 10$: movb (r5)+,r0 cmp r0,#'0 blo 20$ cmp r0,#'9 bhi 20$ sub #'0,r0 asl r2 ; Multiply by 10 add r2,r0 ; + asl r2 asl r2 ; + + br 10$ 20$: ungetc return ; ; No more. ; .end