.IIF	NDF	RSX	RSX	=	0	;Assume RT11	02 +
	.TITLE	AS0
	.ident	/V02.15/	;AS MASTER VERSION FOR LINK & TKB
	.ENABL	LC,GBL
	.LIST	MEB,CND
	.NLIST	BEX						;02 -
;
; AS
; ROOT SEGMENT
;
; VERSION X01
;
; DAVID G. CONROY	24-MAY-78
;
; Edit history
; 01 17-Jul-79 MM	Added null trailed string test for GCMR scan
; 02 28-Aug-79 MM	Added RT11 support
; 03 15-Jan-80 MM	Globals have new bits in gsd
; 04 04-Mar-80 MM	Includes Conroy's updates of 11-Jun-79
; 05 30-Jun-80 MM	Added $error
; 06 30-Dec-80 RBD	Added exit with status. Real hack. Any call to
;			'MSG' causes 'error' exit status, calls to
;			$MSG/FMSG cause 'severe' exit status.
; 07 16-Feb-81 RBD	Added EXIT$S just in case
; 08 26-Feb-81 MM	Added .ident
; 09 26-Feb-82 RBD	Added patch level message, binary tree UST changes,
;			 master version number for this (root) module.
; 10 01-Mar-82		.OBJ files do not have FD.CR attributes!!
; 11 29-Jul-82 NWE	Added support for emission of ISDs for DEBUG-16
; 12 31-Jul-82 MM	Added NOTE subroutine for debug message.
; 13 07-Aug-82 MM	Hashed symbol tables
; 14 08-Jan-83 MM	Move idbuf to root for RT11
; 15 18-MAR-83 RBD	This is sick.  Add guard word between XSTAT and
;			IDBUF to prevent something (???) from wiping out the
;			exit status in XSTAT.  I didn't bother to track it
;			down!
;
;*********************************					;09+
;*  VERSION NUMBER MESSAGE TEXT  *
;*********************************
PLEVEL::
	.BYTE	11,11,11,11,11		;5 TABS
	.ASCII	"/ Decus AS Version V02.15, assembly date:  "
ASDATE::
	.ASCIZ	"Sun Feb 28 12:00:00 1982"
PLSIZE == .-PLEVEL
	.EVEN								;09-

	.GLOBL	AS
	.GLOBL	MSG

	.GLOBL	SFILE
	.GLOBL	OFILE
	.GLOBL	LFILE
.IF NE	RSX							;02
	.GLOBL	FMSG
	.GLOBL	GMCR
	.GLOBL	ARGV
	.GLOBL	ARGVND
	.GLOBL	ARGVPT
	.GLOBL	WFLAG
.ENDC
	.GLOBL	BFLAG
	.GLOBL	GFLAG
	.GLOBL	NFLAG
	.GLOBL	DFLAG
	.GLOBL	LFLAG
	.GLOBL	SFLAG						;11
	.GLOBL	TITLE
	.GLOBL	IDENT						;08
	.GLOBL	IDBUF						;14
.IF NE	RSX							;02
	.MCALL	CALL
	.MCALL	CALLR
	.MCALL	RETURN
	.MCALL	FDBDF$
	.MCALL	FDAT$A
	.MCALL	FDOP$A
	.MCALL	FSRSZ$
	.MCALL	GMCR$
	.MCALL	EXST$S						;06
	.MCALL	EXIT$S						;07
	.MCALL	QIO$
	.MCALL	WTSE$S
	.MCALL	DIR$

	FSRSZ$	3
.IFF
	.MCALL	.PRINT, .EXIT,	.SETTOP				;09
.ENDC								;02 -

;
; EQUIVALENCES
; USED BY THE ENTIRE ASSEMBLER
;
; USER SYMBOL TABLE TREE NODE						;09+
;

S.L	==	0		;LINK					;13+
S.V	==	2		;VALUE
S.T	==	4		;TYPE
S.F	==	6		;FLAGS
S.N	==	10		;ADDRESS OF KEY STRING			;09+
S.U	==	12		;UNIQUE TAG FOR RELATIVE TYPES		;09-
				;(S.U is not in the pst (keywords)
S.SIZE	==	14		;Symbol table node size			;13-

SF.GBL	==	000001		;GLOBAL
SF.MDF	==	000002		;MULTIPLY DEFINED
SF.ASG	==	000004		;DEFINED BY ASSIGNMENT
;
; PSECTION TABLE ENTRY
; This is the old symbol table format with
; the name included within the symbol table node itself.

P.L	==	0		;LOCATION
P.F	==	2		;FLAGS (IN S.T SO SYM MACRO WORKS)
P.FUZZ	==	4		;SAVE FOR FUZZ VALUE
P.N	==	6		;START OF NAME
P.SIZE	==	P.N+8.		;SIZE OF PSECTION TABLE ENTRY

PF.HI	==	001		;HIGH SPEED MEMORY
PF.LIB	==	002		;LIBRARY PSECTION
PF.OVR	==	004		;OVERLAID PSECTION
PF.BT3	==	010		;BIT 3 (FOR .ASECTS)			;03
PF.RO	==	020		;READ ONLY
PF.REL	==	040		;RELOCATION
PF.GBL	==	100		;GLOBAL SCOPE
PF.D	==	200		;D SPACE

;
; FB TABLE ENTRY
; NO NEED TO BE SAME LENGTH; NEVER SEARCHED BY LOOKUP
;

F.T	==	0		;FB TYPE
F.N	==	1		;FB NUMBER (0 <= F.N <= 9)
F.V	==	2		;FB VALUE
F.SIZE	==	4		;SIZE OF AN FB TABLE ENTRY

;
; LISTING MODE.
;

LM.N	==	0		;NONE
LM.S	==	1		;SOURCE
LM.A	==	2		;ADDRESS
LM.B	==	3		;BYTES
LM.W	==	4		;WORDS

;
; COMPLEX LEXIC TOKENS
; ALL HIGHER THAN HIGHEST 8 BIT CHARACTER
;

ID	==	400		;IDENTIFIER TOKEN
CON	==	401		;CONSTANT TOKEN
SL	==	402		;SHIFT LEFT '<<'
SR	==	403		;SHIFT RIGHT '>>'
TLAB	==	404		;TEMPORARY LABEL

;
; MISC.
;

PCREL	==	100000		;PC RELATIVE TYPE FLAG
SYREL	==	040000		;SYMBOL RELATIVE TYPE FLAG

;
; OPCODE TYPES
;

ST.UND	==	0		;UNDEFINED
ST.ABS	==	1		;ABSOLUTE
ST.REG	==	2		;REGISTER
ST.ASC	==	3		;.ASCII
ST.ASZ	==	4		;.ASCIZ
ST.WRD	==	5		;.WORD
ST.BYT	==	6		;.BYTE
ST.EVN	==	7		;.EVEN
ST.ODD	==	10		;.ODD
ST.BKW	==	11		;.BLKW
ST.BKB	==	12		;.BLKB
ST.GBL	==	13		;.GLOBL
ST.ENT	==	14		;.ENTRY
ST.PST	==	15		;.PSECT
ST.SOP	==	16		;SINGLE OP
ST.DOP	==	17		;DOUBLE OP
ST.JSR	==	20		;JSR, XOR
ST.BR	==	21		;BRANCH
ST.RTS	==	22		;RTS
ST.INH	==	23		;HALT, WAIT, ...
ST.MRK	==	24		;MARK
ST.SOB	==	25		;SOB
ST.EMT	==	26		;EMT, TRAP
ST.MUL	==	27		;MUL, DIV, ASH, ASHC
ST.LIM	==	30		;.LIMIT
ST.FLD	==	31		;FPP LOAD			;03+
ST.FST	==	32		;FPP STORE
ST.FL2	==	33		;.FLT2
ST.FL4	==	34		;.FLT4
ST.REL	==	36		;RELOCATABLE			;03-
ST.IDN	==	37		;.IDENT				;08

;
; GLOBAL DATA
;
.IF NE	RSX							;02
; DIRECTIVE BLOCKS
;

GMCR:	GMCR$			;GMCR DPB
	.WORD	0		;FORCE NULL TRAILER		;01
TI:	QIO$	IO.WLB,1,1,,,,<0,0,40>

SFILE:	FDBDF$			;SOURCE FILE DPB
	FDOP$A	2		;

OFILE:	FDBDF$			;OBJECT FILE DPB
	FDAT$A	R.VAR		;NO SLEW!
	FDOP$A	3		;

LFILE:	FDBDF$			;LISTING FILE FDB
	FDAT$A	R.VAR,FD.CR	;				;10
	FDOP$A	4		;

ARGV:	.BLKW	10.		;POINTERS TO THE ARGUMENTS
ARGVND:	.BLKW	1		;END MARK, SPACE FOR 0 WORD
ARGVPT:	.WORD	ARGV-2		;ARG POINTER (OPEN)

.IFF								;02 +
;								;09+
; ALLOC WORK AREA (RT11)
;
	.PSECT	ALDATA	OVR	GBL
	.BLKW	3

	.PSECT

FREMEM::
	.WORD	0		;FREE MEMORY BASE
FRETOP::
	.WORD	0		;FREE MEMORY TOP

; RT11 DIRECTIVE BLOCKS
;
	.GLOBL	CSIBLK, CMDLIN, DEFEXT, $ERROR,	XSTAT		;05/06
$ERROR:	.WORD	0						;05
CSIBLK:	.BLKW	39.		;PARSED COMMAND LINE
OBLK	==	CSIBLK+<0*5*2>	;OUTPUT .OBJ FILE NAME
LBLK	==	CSIBLK+<1*5*2>	;LIST   .LST FILE NAME
SBLK	==	CSIBLK+<3*5*2>	;SOURCE .S   FILE NAME
;
DEFEXT:	.RAD50	/S  /
	.RAD50	/OBJ/
	.RAD50	/LST/
	.RAD50	/.../
;
CMDLIN:	.BLKB	82.		;COMMAND LINE STORED HERE (WHY?)
	.EVEN
;
; Define data buffers.  The format is given in GETC0 and PUTC0.
; The order of entries is extremely important.
;
FDB$CH	==	0		;Channel number.  FDB points here
FDB$NM	==	FDB$CH-2	;File data block pointer in FDB block
FDB$NF	==	FDB$CH+2	;Number of bytes left in the buffer
FDB$FP	==	FDB$NF+2	;Address of the first free byte in the buffer
FDB$BL	==	FDB$FP+2	;Next block to read/write
FDB$BF	==	FDB$BL+2	;Buffer starts here

.MACRO	FDB	CHANNEL,NAME,BLK	;Set up an FDB
	.WORD	BLK		;Pointer to BLK
NAME::	.WORD	CHANNEL		;Channel number for NAME
	.WORD	0		;Free byte counter
	.WORD	0		;Free byte pointer
	.WORD	0		;Next block to get/put
	.BLKB	512.		;The actual record buffer
.ENDM	FDB
;
	FDB	0,OFILE,OBLK
	FDB	1,LFILE,LBLK
	FDB	3,SFILE,SBLK
.ENDC								;02 -

TITLE:	.BLKW	3		;FILE TITLE SET BY AS2		;11
IDENT:	.BLKW	2		;.IDENT VALUE			;08
XSTAT:	.BLKW	2		;EXIT STATUS			;06/15
IDBUF:	.BLKB	8.		;IDENTIFIER -- SHORT ID'S ARE NULL PADDED ;14
	.BYTE	0		;ALWAYS NULL-TERMINATE ID BUFFER	;14

BFLAG:	.BYTE	0		;-B	BRANCHES
GFLAG:	.BYTE	0		;-G	GLOBALS
LFLAG:	.BYTE	0		;-L	LISTING
NFLAG:	.BYTE	1		;-N	NO OBJECT CLEARS NFLAG	;02
DFLAG:	.BYTE	0		;-D	DELETE AFTER ASSEMBLY
sflag:	.byte	0		;-S	emit ISD symbols	;11
.IF NE	RSX							;02
WFLAG:	.BYTE	0		;PROCESSING A WILDCARD FLAG (OPEN)
MSG01:	.ASCII	'?AS-F-"'	;HEADER FOR FILE ERROR MESSAGE	;02
MSG01A:	.BLKB	80.		;REST OF MESSAGE GOES HERE	;02
.ENDC								;02
	.EVEN


;+
; ** AS - MAIN DRIVING ROUTINE
;
; THIS IS THE MAIN  DRIVING ROUTINE OF THE ASSEMBLER.  IT GETS
; AND PARSES ITS COMMAND LINE, THEN LOOPS AROUND GETTING FILES
; AND ASSEMBLING THEM.
;-

AS:
.IF EQ RSX
	MOV	#1,XSTAT	;ASSUME 'SUCCESS' STATUS	;06
.IFF
	MOV	#EX$SUC,XSTAT	;ASSUME 'SUCCESS' STATUS	;06
.ENDC
	CALL	GCML		;GET AND PARSE COMMAND LINE
	BCC	10$		;IF NO ERROR, PRESS ON		;06+
.IF EQ RSX
	MOV	#8.,XSTAT	;ERROR, SEVERE FAILURE
.IFF
	MOV	#EX$SEV,XSTAT	;ERROR, SEVERE FAILURE
.ENDC								;06-
	BR	20$

10$:
.IF EQ RSX

;								;09+
; INITIALIZE DYNAMIC MEMORY FOR $ALLOC
;
	MOV	@#50,R1		;Get start of free memory
	ADD	#3,R1		;Round high-water mark up to
	BIC	#1,R1		;first free location in memory
	MOV	R1,FREMEM	;Save for free-space allocation.
	.SETTOP	#-2		;Get top of free memory
	MOV	R0,FRETOP	;And save for alloc.
.ENDC

;
; FILL CURRENT DATE INTO VERSION NUMBER MESSAGE
;
	CALL	ADATE		;GET DATE STRING ADDRESS IN R0
	MOV	#ASDATE,R1	;R1 --> WHERE IT GOES
15$:	MOVB	(R0)+,(R1)+	;COPY IT
	BNE	15$						;09-

	CALL	OPEN		;GET A FILE TO ASSEMBLE
.IF NE	RSX							;02
	BCS	20$		;END OF FILES
.IFTF								;02
	CALL	ASEMBL		;ASSEMBLE IT
	CALL	CLOSE		;CLOSE IT OFF
.IFT								;02
	BR	10$		;AND DO IT AGAIN
.ENDC								;02

20$:
.IF NE	RSX							;02
	EXST$S	XSTAT		;DONE				;06
	EXIT$S			;JUST IN CASE			;07
.IFF								;02
	MOVB	XSTAT,@#53	;SET USER STATUS		;06
	.EXIT			;DONE				;02
.ENDC								;02

;+
; ** NOTE -- WRITE A MESSAGE TO THE TTY				;12+
;
; ENTRY:
;	R0 -> MESSAGE (.ASCIZ)
; RETURN, ALL REGISTERS PRESERVED.
;-

NOTE::
	MOV	R0,-(SP)		;GRAB A TEMP.
.IF NE	RSX
	MOV	R0,TI+Q.IOPL		;STUFF START ADDRESS
10$:	TSTB	(R0)+			;GET THE LENGTH
	BNE	10$			;
	DEC	R0			;DON'T COUNT EOS
	SUB	(SP),R0			;R0 HAS LENGTH
	MOV	R0,TI+Q.IOPL+2		;STUFF IT
	DIR$	#TI			;OUTPUT
	WTSE$S	#1			;WAIT 'TILL IT'S DONE
.IFF
	.PRINT	R0			;LOVE THAT RT11
.ENDC
	MOV	(SP)+,R0		;RESTORE REGISTERS
	RETURN				;AND EXIT.			;12-

;+
; ** MSG - WRITE A MESSAGE TO THE TI:
;
; INPUTS:
;	R5=POINTER TO MESSAGE STRING
;
; CAUSES EXIT WITH 'ERROR' STATUS
;
; USES:
;	R5
;-

MSG:
.IF NE	RSX							;02
	MOV	#EX$ERR,XSTAT	;MUST BE AN ERROR (HACK)	;06
	MOV	R5,TI+Q.IOPL	;SAVE POINTER TO MESSAGE
10$:	TSTB	(R5)+		;COMPUTE ITS LENGTH
	BNE	10$		;
	DEC	R5		;
	SUB	TI+Q.IOPL,R5	;
	MOV	R5,TI+Q.IOPL+2	;SET INTO TTY DPB
	DIR$	#TI		;WRITE IT OUT
	WTSE$S	#1		;
.IFF
	MOV	#4,XSTAT	;MUST BE AN ERROR (HACK)	;06
	MOV	R0,-(SP)	;SAVE R0
	.PRINT	R5		;PRINT IT
	MOV	(SP)+,R0	;RESTORE R0
.IFTF
	RETURN			;
.IFF
;
;+
; ** $MSG - ERROR MESSAGE WRITER FOR I/O LIBRARY
;
; CALLING THIS CAUSES 'SEVERE' EXIT STATUS
;
; INPUTS:
;	R0=POINTER TO ASCIZ STRING
;
; USES:
;	NOTHING
;

$MSG::	.PRINT	R0		;VERY SIMPLE
	MOV	#8.,XSTAT	;'SEVERE' STATUS		;06
	RETURN
.IFT								;02 -
;+
; ** FMSG - WRITE FILE I/O MESSAGES (RSX ONLY)
;
; INPUTS:
;	R4=POINTER TO FILE NAME STRING
;	R5=POINTER TO MESSAGE STRING
;
; CAUSES EXIT WITH 'SEVERE' STATUS
;
; USES:
;	R4, R5
;-

FMSG:	MOV	#EX$SEV,XSTAT	;'SEVERE' STATUS		;06
	MOV	R5,-(SP)	;SAVE MESSAGE POINTER
	MOV	#MSG01A,R5	;STANDARD HEADER		;02 +
10$:	MOVB	(R4)+,(R5)+	;COPY IN THE FILE NAME
	BNE	10$		;ALL OF IT
	DEC	R5		;UNCOPY THE NULL
	MOV	(SP)+,R4	;GET THE MESSAGE
20$:	MOVB	(R4)+,(R5)+	;COPY THE MESSAGE
	BNE	20$		;ALL OF IT, TOO
	MOV	#MSG01,R5	;LOCATE THE MESSAGE START
	CALL	MSG		;DO IT
	RETURN			;AND RETURN			;02 -
.ENDC
	.END	AS