;
; STANDARD HEADER FOR BCPL LIBRARY PROCEDURES.
;
; STACK OFFSETS
;
LINK=0			; RETURN LINK
OLDP=2			; OLD LOCAL FRAME
PNAM=4			; ADDRESS OF STRING
ARG1=6			; PARAMETERS
ARG2=10
ARG3=12
ARG4=14
ARG5=16
; 
; REGISTER DEFINITIONS
;
	T=R4
	P=R5
;
; MACRO DEFINITIONS
;
.MCALL	CALL,RETURN,FCSBT$,FDOF$L,QIOW$,QIOW$S,DIR$
	FDOF$L
	FCSBT$
.MACRO	PROC	NAME,N		; ENTRY FOR PROC NAME, GLOBAL N
	.PSECT	GLOBAL
	.RADIX	10
	.=GV+<2*N>
	.RADIX	8
	.WORD	G'N
	.PSECT	CONST
	.NCHR	LENGTH,NAME
S'N:	.WORD	LENGTH
	.ASCII	^NAME^
	.EVEN
	.PSECT	BCPLIB
G'N::	JSR	R1,ENTER
	.WORD	S'N
.ENDM	PROC
.MACRO	ENDPROC
	JMP	EXIT
.ENDM	ENDPROC
.MACRO	ERROR
	JSR	R0,@GV+4
	.WORD	26
.ENDM	ERROR
	.PSECT	GLOBAL,GBL,OVR
GV:
	.PSECT	BCPLIB
;
; BCPL LIBRARY CODE FOR PROC ENTRY AND EXIT.
; PROC CALL IS BY
; 	JSR	R0,ROUTINE
;	.WORD	N
; WHERE N = 2*M+6, M BEING NEW FRAME HEIGHT
; PROC ENTRY IS BY
;	JSR	R1,ENTER
;	.WORD	S6
; WHERE S6 = ADDRESS OF PROC NAME STRING
;
ENTER::	MOV	(R0)+,R2	; R0=LINK,R2=FRAME HEIGHT
	ADD	P,R2		; R2=NEW FRAME+6
	MOV	(R1)+,-(R2)	; STACK NAME
	MOV	P,-(R2)		; STACK OLD P
	MOV	R0,-(R2)	; STACK LINK
	MOV	R2,P		; SET NEW P
	CMP	(SP)+,(SP)+	; CLEAR JUNK OFF STACK
	MOV	R1,PC		; BACK TO PROC
;
; PROC EXIT IS JUST DONE BY
;	JMP	EXIT
;
EXIT::	MOV	(P)+,R1		; GET LINK
	MOV	(P),P		; RESET P
	MOV	R1,PC		; RETURN
;
; FUNCTION HEAP,
; TAKES ONE PARAMETER, AN INTEGER
; RETURNS A HEAPED VECTOR OF THIS SIZE
;
	PROC	HEAP,5
	MOV	ARG1(P),R0
	INC	R0
	CALL	HEAP
	ASR	R0
	ENDPROC
;
; ROUTINE UNHEAP
; TAKES ONE PARAMETER, A VECTOR
; RETURNS VECTOR TO FREE STORE
;
	PROC	UNHEAP,6
	MOV	ARG1(P),R0
	ASL	R0
	CALL	UNHEAP
	ENDPROC
;
; INITIALIZEIO
; THIS ROUTINE TAKES NO PARAMETERS.
; MUST BE CALLED BEFORE ANY IO OR HEAPING IS USED
;
	.MCALL	FINIT$
	PROC	INITIALIZEIO,8
	FINIT$
	ENDPROC
;
; OPENINPUT(DSPT,DFNB,SIZE)
; OPENS THE FILE DEFINED BY DSPT & DFNB WITH RECORD LENGTH 'SIZE'
; RETURNS THE VALUE OF THE FDB. EITHER OF THE DATASET POINTER OR
; THE DEFAULT FILE NAME BLOCK MAY BE ZERO.
;
	PROC	OPENINPUT,9
	CLR	R2		; INPUT
	BR	OP
;
; OPENOUTPUT(DSPT,DFNB,SIZE)
; AS OPENINPUT, BUT FILE IS OPENED FOR WRITING
;	
	PROC	OPENOUTPUT,10
	MOV	P,R2		; OUTPUT
OP:	MOV	ARG1(P),R0	; GET DSPT
	ASL	R0
	MOV	ARG2(P),R1	; GET DFNB
	ASL	R1
	CLR	R3
	MOV	ARG3(P),R4	; GET BUFFER SIZE
	CALL	OPEN		; OPEN THE FILE
	BCC	1$		; TEST IF OK
	ERROR
1$:	ASR	R0
	ENDPROC
;
; CLOSE(FDB)
; CLOSES THE FILE DEFINED BY FDB.
;
	PROC	CLOSE,11
	MOV	ARG1(P),R0
	ASL	R0
	CALL	CLOSE
	ENDPROC
;
; ENDOFFILE(FDB)
; DELIVERS A BOOLEAN RESULT IF ENDOF FILE HAS BEEN REACHED
;
	PROC	ENDOFFILE,12
	CLR	R0
	MOV	ARG1(P),R1
	ASL	R1
	CMPB	F.ERR(R1),#IE.EOF
	BNE	1$
	DEC	R0
1$:	ENDPROC
;
; READREC(FDB,BUFFER)
; READS NEXT RECORD INTO BUFFER
; RECORD FORMAT = BCPL STRING.
; RETURNS STRING
;
	.MCALL	GET$
	PROC	READREC,13
	MOV	ARG1(P),R0
	ASL	R0
	MOV	ARG2(P),R1
	INC	R1
	ASL	R1
	GET$	,R1
	BCC	2$
	CMPB	F.ERR(R0),#IE.EOF
	BEQ	1$
	ERROR
1$:	CLR	R0
	BR	3$
2$:	MOV	F.NRBD(R0),-(R1)
	MOV	R1,R0
	ASR	R0
3$:	ENDPROC
;
; WRITEREC(FDB,BUFFER)
; PUTS NEXT RECORD IN BUFFER TO FILE
;
	.MCALL	PUT$
	PROC	WRITEREC,14
	MOV	ARG1(P),R0
	ASL	R0
	MOV	ARG2(P),R1
	ASL	R1
	MOV	(R1)+,R2
	PUT$	,R1,R2
	BCC	1$
	ERROR
1$:	ENDPROC
;
; FUNCTION ANALYZE
; TAKES 1 PARAMETER, A STRING, AND RETURNS A CSI BLOCK
; ERROR IS CALLED IF THE STRING IS ILLEGAL.
;
	.MCALL	CSI$1
	PROC	ANALYZE,15
	MOV	#C.SIZE/2,R0
	CALL	HEAP
	MOV	ARG1(P),R1
	ASL	R1
	MOV	(R1)+,R2
	CSI$1	,R1,R2
	BCC	1$
	CALL	UNHEAP
	ERROR
1$:	ASR	R0
	ENDPROC
;
; FUCTION PARSEINPUT
; TAKES 2 PARAMETERS, AN INITIALIZED CSI BLOCK AND SWITCH TABLE
; RETURNS A DATASET DESCRIPTOR FOR INPUT SPEC.
; ERROR IS CALLED IF ILLEGAL SWITCH
;
	.MCALL	CSI$2
	PROC	PARSEINPUT,16
	MOV	ARG1(P),R0
	ASL	R0
	MOVB	#CS.INP,C.TYPR(R0)
	BR	PARSE
;
; PARSEOUTPUT
; EXACTLY AS FOR PARSEINPUT, BUT NEXT OUTPUT DSD RETURNED
; NOTE, RESULT=0 => NULL SPEC IN STRING
;
	PROC	PARSEOUTPUT,17
	MOV	ARG1(P),R0
	ASL	R0
	MOVB	#CS.OUT,C.TYPR(R0)
PARSE:	ASL	ARG2(P)
	MOV	ARG2(P),C.SWAD(R0)
	CALL	.CSI2
	BCC	1$
	ERROR
	BR	2$
1$:	BITB	#7,C.STAT(R0)
	BEQ	2$
	ADD	#C.DSDS,R0
	ASR	R0
	BR	3$
2$:	CLR	R0
3$:	ENDPROC
;
; FUNCTION LEVEL
; NO PARAMETERS, RETURNS CURRENT FRAME
;
	PROC	LEVEL,18
	MOV	OLDP(P),R0
	ASR	R0
	ENDPROC
;
; ROUTINE LONGJUMP 
; TAKES 2 PARAMETERS, FRAME & LABEL
;
	PROC	LONGJUMP,19
	ASL	ARG1(P)
	MOV	ARG1(P),OLDP(P)
	MOV	ARG2(P),(P)
	ENDPROC
;
; FUNCTION PACKSTRING
; 2 PARAMETERS, VECTOR & STRING
; PACKS VECTOR INTO STRING
; RETURNS STRING
;
	PROC	PACKSTRING,20
	CALL	SETREG
	BLE	2$
1$:	MOVB	(R1)+,(R2)+
	INC	R1
	SOB	R3,1$
	BIT	#1,R2
	BEQ	2$
	CLRB	(R2)
2$:	ENDPROC
;
; FUNCTION UNPACKSTRING
; 2 PARAMETERS, STRING & VECTOR
; UNPACKS STRING INTO VECTOR, RETURNS VECTOR
;
	PROC	UNPACKSTRING,21
	CALL	SETREG
	BLE	2$
	ADD	R3,R1
	ADD	R3,R2
	ADD	R3,R2
1$:	CLRB	-(R2)
	MOVB	-(R1),-(R2)
	SOB	R3,1$
2$:	ENDPROC
;
SETREG:	MOV	ARG1(P),R1
	ASL	R1
	MOV	ARG2(P),R2
	MOV	R2,R0
	ASL	R2
	MOV	(R1)+,R3
	MOV	R3,(R2)+
	RETURN
;
; READCOMMAND(PROMPT, BUFFER)
; FUNCTION TAKING 2 PARAMETERS, A PROMPT STRING
; AND A BUFFER
; RETURNS NEXT STRING FROM COMMAND INPUT, OR 0
; IF NONE. ERROR MAY BE GENERATED BY ILLEGAL
; INDIRECT FILES.
;
	.MCALL	GCMLB$,GCML$,RCML$
CMLBLK:	GCMLB$	1
	PROC	READCOMMAND,22
	MOV	ARG1(P),R1
	ASL	R1
	MOV	(R1),R2
	MOV	R2,-(SP)
	ADD	#2,R2
	MOV	#15!<400*12>,(R1)
	GCML$	#CMLBLK,R1,R2
	MOV	(SP)+,(R1)
	BCC	2$
	CMPB	G.ERR(R0),#GE.EOF
	BEQ	1$
	RCML$
	ERROR
1$:	CLR	R0
	BR	5$
2$:	MOV	ARG2(P),R0
	ASL	R0
	MOV	CMLBLK+G.CMLD+2,R1
	MOV	CMLBLK+G.CMLD,R2
	MOV	R2,(R0)+
	BEQ	4$
3$:	MOVB	(R1)+,(R0)+
	SOB	R2,3$
4$:	MOV	ARG2(P),R0
5$:	ENDPROC
;
; DEFAULT RUN TIME ERROR
;
	PROC	RTE,2
	MOV	OLDP(P),R0
	MOV	PNAM(R0),R0
	MOV	(R0)+,R1
	DIR$	#TASKNM
	DIR$	#ERRMESS
	QIOW$S	#IO.WVB,#1,#1,,,,<R0,R1,#'+>
	JMP	STOP
TASKNM:	QIOW$	IO.WVB,1,1,,,,<S0+2,6,'$>
ERRMES:	QIOW$	IO.WVB,1,1,,,,<ERRM,ERRL,0>
ERRM:	.ASCII	/ -- RUN TIME ERROR IN ROUTINE /
	ERRL=.-ERRM
	.EVEN
;
; PROGRAM ENTRY POINT
; WE ALLOCATE STORAGE, AND SET UP INITIAL P AND SP
; THE PROGRAM IS ENTERED AS A BCPL ROUTINE CALLED "MAINPROGRAM"
; 
	.MCALL	ALUN$S,EXIT$S,GTSK$S
GO:	MOV	SP,TOPCOR	; SET UP TOP OF STORE
	MOV	#1000,P		; INITIAL STACK BASE
	MOV	P,SP		; SET PROCESSOR STACK
	ALUN$S	#1,#"TI,#0	; SET UP LUN1 FOR MESSAGES
	GTSK$S	P		; GET TASK PARAMETERS
	MOV	#S0+2,R0	; ADDRESS OF MAIN PROGRAM NAME
	MOV	(P),R1		; FIRST WORD OF TASK NAME
	CALL	$C5TA		; CONVERT TO ASCII
	MOV	2(P),R1		; SECOND WORD OF NAME
	CALL	$C5TA		; CONVERT IT.
	JSR	R0,G0		; ENTER MAIN PROGRAM
	.WORD	6		; 
	CALL	ABORT		; TIDY UP OPEN FILES
	EXIT$S			; EXIT TO MCR
;
; DUMMY MAIN PROGRAM
;
	PROC	<      >,0
	JMP	G1		; GOTO START
STOP::	MOV	#1000,P		; RESET STACK
	ENDPROC
	.END	GO