TITLE   RPN Compiler by Doug Jones
;-------------------------------
; This compiler supports the following operators:
;
;   Ennn - enter the decimal integer nnn
;   P    - decimal print
;   +    - add
;   -    - subtract
;   *    - multiply
;   /    - divide
;   B    - print in an odd base
;
; All letters may be upper or lower case
;-------------------------------
        USE     "/group/22c018/hawk.macs"

; linkage for external procedures in the monitor
        EXT     DSPCH,DSPST,DSPDEC,TIMES,DIVIDE
PDSPCH: W       DSPCH
PDSPST: W       DSPST
PDSPDEC:W       DSPDEC
PTIMES:	W	TIMES
PDIVIDE:W	DIVIDE

; linkage for other external procedures
        EXT     ODDPR
PODDPR:	W	ODDPR

; space for compiled code
	COMMON	CODE,#1000
PCODE:	W	CODE

;-------------------------------
        INT     COMPIL
COMPIL:                 ; procedure to compile one line of calculator input
                        ; expects R3 = pointer to line
                        ; returns R3 = pointer to compiled code
			; in case of error, returns null.
			; wipes out R4-10
        MOVE    R8,R1           ; save return address
        MOVE    R9,R3           ; save pointer to command string
	LOAD	R4,PCODE	; setup pointer to compiled code
	LEA	R3,PROLOGUE
	JSR	R1,CPCODE	; copy prologue into place
LOOP:
        LOADS   R3,R9
        EXTB    R3,R3,R9        ; get a character
        BZR     NONNULL
	LEA	R3,EPILOGUE	;   if character is null
	JSR	R1,CPCODE	; copy epilogue into place
	LOAD	R3,PCODE	; setup value for normal return
        JUMPS   R8              ; normal return

NONNULL:
        LEA     R5,JUMPTAB
        ADDSL   R3,R5,2         ; index by char into jumptab
        LOADS   R3,R3           ; get jump table entry
        JUMPS   R3              ; and go process the entry

;-------------------------------
; code to generate for entry and exit from calculator
PROLOGUE:
	MOVE	R8,R1		; save return address
	MOVE	R9,R2		; save stack pointer
	CLR	R10		; make constant zero
	H	0

; in generated code between prologue and epilogue,
;   R2 - calculator stack pointer
;   R8 - calculator return address
;   R9 - base stack pointer
;   R10 - the constant zero

EPILOGUE:
	MOVE	R2,R9		; restore stack pointer
	JUMPS	R8		; return
	H	0

;-------------------------------
; alternate run-time error handlers used when epilogue not executed
BADRADIX:
	LEA	R3,ERBADRX
	BR	ERRCOM
UNDERFLOW:
	LEA     R3,ERUNDER
ERRCOM:	LOAD    R1,PDSPST
	JSRS    R1,R1           ; output error message prefix
	MOVE	R2,R9
	JUMPS	R8		; abnormal return from compiled code
ERUNDER:ASCII	"Calculator Stack Underflow",0
ERBADRX:ASCII	"Bad radix on odd-base print command",0

;-------------------------------
; jump table with one entry for each ASCII code
; because the table is complete, no bounds checking is needed
        ALIGN   4
JUMPTAB:
	W       ERROR,ERROR,ERROR,ERROR,ERROR,ERROR,ERROR,ERROR ; control
	W       ERROR,ERROR,ERROR,ERROR,ERROR,ERROR,ERROR,ERROR ;  chars
	W       ERROR,ERROR,ERROR,ERROR,ERROR,ERROR,ERROR,ERROR ; control
	W       ERROR,ERROR,ERROR,ERROR,ERROR,ERROR,ERROR,ERROR ;  chars
	W       SPACE,ERROR,ERROR,ERROR,ERROR,ERROR,ERROR,ERROR ;  !"#$%&'
	W       ERROR,ERROR,MULT, PLUS, ERROR,MINUS,ERROR,DIV   ; ()*+,-./
	W       DIGIT,DIGIT,DIGIT,DIGIT,DIGIT,DIGIT,DIGIT,DIGIT ; 01234567
	W       DIGIT,DIGIT,ERROR,ERROR,ERROR,ERROR,ERROR,ERROR ; 89:;<=>?
	W       ERROR,ERROR,BASE ,ERROR,ERROR,ENTER,ERROR,ERROR ; @ABCDEFG
	W       ERROR,ERROR,ERROR,ERROR,ERROR,ERROR,ERROR,ERROR ; HIJKLMNO
	W       PRINT,ERROR,ERROR,ERROR,ERROR,ERROR,ERROR,ERROR ; PQRSTUVW
	W       ERROR,ERROR,ERROR,ERROR,ERROR,ERROR,ERROR,ERROR ; XYZ[\]^_
	W       ERROR,ERROR,BASE ,ERROR,ERROR,ENTER,ERROR,ERROR ; `abcdefg
	W       ERROR,ERROR,ERROR,ERROR,ERROR,ERROR,ERROR,ERROR ; hijklmno
	W       PRINT,ERROR,ERROR,ERROR,ERROR,ERROR,ERROR,ERROR ; pqrstuvw
	W       ERROR,ERROR,ERROR,ERROR,ERROR,ERROR,ERROR,ERROR ; xyz{|}~

;-------------------------------
;
; Each of the following cases handles one calculator command.
; These cases are not procedures!  The code for Each calculator command
; ends by advancing the input pointer and going to the loop top!
;
; Register usage on entry and exit from each case:
;
; R4 -- pointer to next spot in compiler code buffer
; R8 -- saved return address for compiler procedure as a whole
; R9 -- input pointer; points to current calculator command
;
;-------------------------------
SPACE:
	ADDSI   R9,1            ; advance pointer into command string
	JUMP    LOOP
;-------------------------------
ERROR:
	LEA     R3,ERMSG1
	LOAD    R1,PDSPST
	JSRS    R1,R1           ; output error message prefix
	LOADS   R3,R9
	EXTB    R3,R3,R9        ; get the character
	LOAD    R1,PDSPCH
	JSRS    R1,R1           ; output it
	LEA     R3,ERMSG2
	LOAD    R1,PDSPST
	JSRS    R1,R1           ; output error message suffix
	CLR	R3		; setup abnormal return code
	JUMPS	R8

ERMSG1: ASCII   "Error '",0
ERMSG2: ASCII   "' ",0
	ALIGN   2

;-------------------------------
MULT:
	LEA	R3,CODEMUL
	JSR	R1,CPCODE	; copy multiply code into place
	ADDSI   R9,1            ; advance pointer into command string
	JUMP    LOOP
;-------------------------------
CODEMUL:
	JSR	R1,R10,PROCMUL
	H	0
;-------------------------------
PROCMUL:			; multiply proc called by compiled code	
	MOVE	R11,R1		; save return address
	ADDSI   R2,-4           ; pop the stack
	CMP     R2,R9           ; check for underflow!
	BGT     MULOK
	JUMP    UNDERFLOW       ;   complain if underflow
MULOK:	LOADS   R3,R2           ; get old (popped) stack top
	LOAD    R4,R2,-4        ; get item below it (current top item)
	LOAD	R1,PTIMES
	JSRS	R1,R1		;   multiply them
	STORE   R3,R2,-4        ; put the result back on top of the stack
	JUMPS	R11

;-------------------------------
PLUS:
	LEA	R3,CODEPLUS
	JSR	R1,CPCODE	; copy add code into place
	ADDSI   R9,1            ; advance pointer into command string
	JUMP    LOOP
;-------------------------------
CODEPLUS:
	JSR	R1,R10,PROCPLUS
	H	0
;-------------------------------
PROCPLUS:
	ADDSI   R2,-4           ; pop the stack
	CMP     R2,R9           ; check for underflow!
	BGT     PLUSOK
	JUMP    UNDERFLOW       ;   complain if underflow
PLUSOK:	LOADS   R3,R2           ; get old (popped) stack top
	LOAD    R4,R2,-4        ; get item below it (current top item)
	ADD     R4,R4,R3        ;   add them
	STORE   R4,R2,-4        ; put the result back on top of the stack
	JUMPS   R1

;-------------------------------
MINUS:
	LEA	R3,CODEMINUS
	JSR	R1,CPCODE	; copy subtract code into place
	ADDSI   R9,1            ; advance pointer into command string
	JUMP    LOOP
;-------------------------------
CODEMINUS:
	JSR	R1,R10,PROCMINUS
	H	0
;-------------------------------
PROCMINUS:
	ADDSI   R2,-4           ; pop the stack
	CMP     R2,R9           ; check for underflow!
	BGT     MINUSOK
	JUMP    UNDERFLOW       ;   complain if underflow
MINUSOK:LOADS   R3,R2           ; get old (popped) stack top
	LOAD    R4,R2,-4        ; get item below it (current top item)
	SUB     R4,R4,R3        ;   subtract them
	STORE   R4,R2,-4        ; put the result back on top of the stack
	JUMPS   R1

;-------------------------------
DIV:
	LEA	R3,CODEDIV
	JSR	R1,CPCODE	; copy divide code into place
	ADDSI   R9,1            ; advance pointer into command string
	JUMP    LOOP
;-------------------------------
CODEDIV:
	JSR	R1,R10,PROCDIV
	H	0
;-------------------------------
PROCDIV:
	MOVE	R12,R1		; save return adress
	ADDSI   R2,-4           ; pop the stack
	CMP     R2,R9           ; check for underflow!
	BGT     DIVOK
	JUMP    UNDERFLOW       ;   complain if underflow
DIVOK:	LIS	R11,1		; set default sign of result
	LOADSCC R4,R2           ; get old (popped) stack top
	BNR	DIVP1
	NEG	R4,R4		;   negate if negative
	NEG	R11,R11		;   and complement sign of result
DIVP1:
	LOADCC  R3,R2,-4        ; get item below it (current top item)
	BNR	DIVP2
	NEG	R3,R3		;   negate if negative
	NEG	R11,R11		;   and complement sign of result
DIVP2:
	LOAD	R1,PDIVIDE
	JSRS	R1,R1		;   divide
	TESTR	R11		; test sign result should have
	BNR	DIVP3
	NEG	R3,R3		;   negate result if should be negative
DIVP3:
	STORE   R3,R2,-4        ; put the result back on top of the stack
	JUMPS	R12

;-------------------------------
DIGIT: 
	LOADS   R10,R9          ; the character needs getting again
	EXTB    R10,R10,R9      ;   so get it (known to be a digit)
	ADDI    R10,-"0"        ;   convert it to an integer
	LOAD	R11,CODEDIG1	; get prototype LIS instruction
	ADD	R10,R11,R10	; make the correct LIS instruction
	LOADS	R6,R4
	STUFFH	R6,R10,R4	; store halfword (LIS instruction)
	STORES	R6,R4
	ADDSI	R4,2		; advance code pointer
	LEA	R3,CODEDIG2
	JSR	R1,CPCODE	; copy digit code into place
	ADDSI   R9,1            ; advance pointer into command string
	JUMP    LOOP
;-------------------------------
	ALIGN	4
CODEDIG1:
	LIS	R3,0		; low 8 bits will be modified
;-------------------------------
CODEDIG2:
	JSR	R1,R10,PROCDIGIT
	H	0
;-------------------------------
PROCDIGIT:	
	CMP     R2,R9           ; check for empty stack!
	BGT     DIGITOK
	JUMP    UNDERFLOW       ;   complain if empty
DIGITOK:LOAD    R4,R2,-4        ; item on stack top
	ADDSL   R4,R4,2         ; multiply stack top by 5
	ADDSL   R4,R3,1         ; multiply by 2 and add digit
	STORE   R4,R2,-4        ; return to stack top
	JUMPS	R1

;-------------------------------
BASE:
	LEA	R3,CODEBASE
	JSR	R1,CPCODE	; copy base code into place
	ADDSI   R9,1            ; advance pointer into command string
	JUMP    LOOP
;-------------------------------
CODEBASE:
	JSR	R1,R10,PROCBASE
	H	0
;-------------------------------
PROCBASE:
	MOVE	R11,R1		; save return address
	ADDSI   R2,-4           ; pop the stack
	CMP     R2,R9           ; check for underflow!
	BGT     BASEOK
	JUMP    UNDERFLOW       ;   complain if underflow
BASEOK:	LOADS   R4,R2           ; get old (popped) stack top
	CMPI	R4,2		; test for minimum legal radix
	BLT	BASEBAD
	CMPI	R4,36		; test for maximum legal radix
	BLE	BASEOK1
BASEBAD:JUMP	BADRADIX
BASEOK1:LOAD    R3,R2,-4        ; get item below it (current top item)
	LOAD	R1,PODDPR
	JSRS	R1,R1		;   print number in odd base
	ADDSI   R2,-4           ; finish popping the stack
	JUMPS	R11

;-------------------------------
ENTER:
	LEA	R3,CODEENTER
	JSR	R1,CPCODE	; copy enter code into place
	ADDSI   R9,1            ; advance pointer into command string
	JUMP    LOOP
;-------------------------------
CODEENTER:
	STORES  0,R2            ; push zero
	ADDSI   R2,4
	H	0

;-------------------------------
PRINT:
	LEA	R3,CODEPRINT
	JSR	R1,CPCODE	; copy enter code into place
	ADDSI   R9,1            ; advance pointer into command string
	JUMP    LOOP
;-------------------------------
CODEPRINT:
	JSR	R1,R10,PROCPRINT
	H	0
;-------------------------------
PROCPRINT:
	MOVE	R11,R1
	CMP     R2,R9           ; check for empty stack!
	BGT     PRINTOK
	JUMP    UNDERFLOW       ;   complain if empty
PRINTOK:ADDSI   R2,-4           ; pop
	LOADSCC R3,R2           ; check sign
	BNR     PRINTP
	LIS     R3,"-"          ; if negative
	LOAD    R1,PDSPCH
	JSRS    R1,R1           ;   print - first
	LOADS   R3,R2           ; then recover the number
	NEG	R3,R3		;   and negate it
PRINTP:
	CLR     R4
	LOAD    R1,PDSPDEC
	JSRS    R1,R1           ; print in field width zero
	LIS     R3," "
	LOAD    R1,PDSPCH
	JSRS    R1,R1           ; print trailing blank
	JUMPS	R11

;-------------------------------
CPCODE:				; copy code to code buffer
				; expects R3 - source pointer
				; expects R4 - dest pointer
				; uses R3,R5-6, updates R4
				; code string is null terminated
CPCLP:
	LOADS	R5,R3
	EXTH	R5,R5,R3	; fetch halfword
	BZS	CPCQT		;   quit on null
	LOADS	R6,R4
	STUFFH	R6,R5,R4	; store halfword
	STORES	R6,R4
	ADDSI	R3,2		; bump counters
	ADDSI	R4,2
	BR	CPCLP
CPCQT:
	JUMPS	R1		; return

	END