; GT40 BCPL run time system.
; Jim Darby, June 1988.

; Constants about machine.

COREND	= 8.*1024.	; First unusable word
WIDTH	= 1024.		; Height of display
HEIGHT	= 768.		; Width of display

; Address of registers.

DPC     = 172000        ; VT40 Program counter
DSR     = 172002        ; VT40 Status register
XSR     = 172004        ; X status register
YSR     = 172006        ; Y status register

; Recommended mnemomics

CHAR    = 100000        ; Character mode
SHORTV  = 104000        ; Short vector mode
LONGV   = 110000        ; Long vector mode
POINT   = 114000        ; Point mode
GRAPHX  = 120000        ; Graphplot X mode
GRAPHY  = 124000        ; Graphplot Y mode
RELATV  = 130000        ; Relative point mode

INT0    = 2000          ; Intensity modes
INT1    = 2200
INT2    = 2400
INT3    = 2600
INT4    = 3000
INT5    = 3200
INT6    = 3400
INT7    = 3600

LPOFF   = 100           ; Light pen off
LPON    = 140           ; and on

BLKOFF  = 20            ; Blink off
BLKON   = 30            ; and on

LINE0   = 4             ; Solid line
LINE1   = 5             ; Long dash
LINE2   = 6             ; Short dash
LINE3   = 7             ; Dot dash

DJMP    = 160000        ; Display jump
DNOP    = 164000        ; Display NOP

STATSA  = 170000        ; Load status A
DSTOP   = 173400        ; Display stop and interrupt

SINON   = 1400          ; Stop interrupt on
SINOFF  = 1000          ; Stop interrupt off
LPLITE  = 200           ; Light pen hit on
LPDARK  = 300           ; and off

ITAL0   = 40            ; Italics off
ITAL1   = 60            ; and on

SYNC    = 4             ; Halt and resume in Sync

STATSB  = 174000        ; Load status B
INCR    = 100           ; Graphplot increment

INTX    = 40000         ; Intensify vector or point
MAXX    = 1777          ; Max delta-x
MAXY    = 1377          ; Max delta-y

MINUSX  = 20000         ; -ve delta-x
MINUSY  = 20000         ; -ve delta-y

MAXSX   = 17600         ; Max delta-x in short mode
MAXSY   = 77            ; Max delta-y

MISVX   = 20000         ; -ve delta-x
MISVY   = 100           ; -ve delta-y

        .PSECT

;       Create the world.

	MOV	#COREND-2,SP	; Set up stack
	MOV	#INTR,@#320	; Set up INTR routine

;       Scan to find HRG.

        CLR     R0              ; Highest global
        MOV     #PROG,R1        ; To look at program

HRGLOOK:

        MOV     (R1),R2         ; Length in words
        BEQ     FILLGLOB        ; End?

        ASL     R2              ; Now in words
        ADD     R2,R1           ; Point to next
        MOV     -2(R1),R2       ; Pick up HRG
        CMP     R0,R2           ; New highest?
        BPL     HRGLOOK         ; No, check next
        MOV     R2,R0           ; Yeap, fill in
        BR      HRGLOOK
        
;       As a side effect we have found then end of the program.
;       Set up G and P registers.

FILLGLOB:

        MOV     R1,R4           ; R4 is G
        ADD     #2,R4           ; Don't corrupt zero word
	INC	R0		; Don't forget zero word.
        ASL     R0              ; in bytes now
        MOV     R4,R5           ; Set up P
        ADD     R0,R5
        MOV     R5,INITP        ; Need to save, bo-ho.
                
;       Now fill them

        MOV     #PROG,R0
        
FILLOOP:

        MOV     (R0),R1         ; Get length
        BEQ     RUN             ; All filled, can run
        ASL     R1              ; into bytes
        MOV     R0,R2           ; Save base
        ADD     R1,R0           ; Move on
        MOV     R0,R1           ; Now scan
        SUB     #2,R1
        
DOSECT: MOV     -(R1),R3
        BEQ     FILLOOP         ; Done this section
        ADD     R2,R3           ; Relocate
        MOV     -(R1),R5        ; Pick up GN
        ASL     R5              ; Convert to GV addr
        ADD     R4,R5
        MOV     R3,(R5)         ; And fill it
        BR      DOSECT
        
RUN:    MOV     INITP,R5        ; Set up P reg
        JSR     PC,@2(R4)
        .WORD   4
        HALT
        
INTR:	INC     INTRS           ; another interrupt found
        RTI                     ; All done.

INTRS:  .WORD   0               ; Interrupts up spout
INITP:  .WORD   0               ; Saved inital P

PROG:
	.WORD	<PEND-PROG>/2

MULT:	MOV	R1,-(SP)	; R0 := R0 * R1
	BPL	M1
	NEG	R1
M1:	CLR	R3		; Result built in R3
M2:	ROR	R1
	BCC	M3
	ADD	R0,R3
M3:	ASL	R0
	TST	R1
	BNE	M2	
	MOV	R3,R0
	MOV	(SP)+,R1
	BPL	RETURN
	NEG	R0
	BR	RETURN

DIVIDE:	JSR	PC,DODIV
	BR	RETURN
	
REM:	JSR	PC,DODIV
	MOV	R1,R0
	BR	RETURN
	
DODIV:	MOV	R0,-(SP)	; R0 := R0/R1; R1 := R0 REM R1
	BPL	D1
	NEG	R0
D1:	MOV	R1,-(SP)
	BPL	D2
	NEG	R1
D2:	MOV	#21,R3
	CLR	R2
D3:	ROL	R2
	CMP	R1,R2
	BHI	D4
	SUB	R1,R2
	SEC
D4:	ROL	R0
	DEC	R3
	BGT	D3
	TST	(SP)+
	BPL	D5
	NEG	R0
	NEG	R2
D5:	TST	(SP)+
	BPL	D6
	NEG	R0
D6:	MOV	R2,R1
	RTS	PC
	
LSHIFT:	DEC	R1		; R0 := R0 << R1
	BMI	RETURN
	ASL	R0
	BR	LSHIFT

RSHIFT:	DEC	R1		; R0 := R0 >> R1
	BMI	RETURN	
	CLC
	ROR	R0
	BR	RSHIFT
	

RETURN:	ADD	#2,(SP)		; Skip frame size
	RTS	PC		; and return

	.WORD	0		; End of init list
	.WORD	4.,MULT-PROG,
	.WORD	5.,DIVIDE-PROG
	.WORD	6,REM-PROG
	.WORD	7.,LSHIFT-PROG
	.WORD	8.,RSHIFT-PROG
	.WORD	8.		; Highest global
PEND:
        .END