.NLIST
;
; DEFINITIONS OF GCML MACROS
;
.MACRO GCMLD$ X
;
; GCML TABLE
;
G.CFDB=0		;POINTER TO COMMAND FDB(TERMINAL)
G.FFDB=2		;POINTER TO FILE FDB
G.CLUN=4		;LUN OF TERMINAL
G.FLUN=6		;LUN OF FILE CHANNEL
;
G.ERR=10		;ERROR RETURN BYTE
G.MODE=11		;MODE FLAGS BYTE
G.CMLD=12		;COMMAND LINE RETURN DESCRIPTOR
;     =14
G.PSDS=16		;USER PROMPT DESCRIPTOR
;     =20
G.LEVL=22		;CURRENT NEST LEVEL
G.MAXD=23		;MAXIMUM NEST LEVEL
G.PLIN=24		;POINTER TO PRESET LINES STRING IF ANY
G.PPTR=26		;PUSH DOWN LIST POINTER
G.RBUF=30		;POINTER TO LINE BUFFER
G.DPRM=32		;DEFAULT PROMPT
;
G.CMDF=40		;COMMAND PROCESSOR FLAGS AND SWITCHES
;
G.STAB=42		;START OF SYMBOL TABLE
	G.MAXS=26.	;MAXIMUM SYMBOLS ('A-'Z)
G.LABL=G.STAB+G.MAXS	;6 CHARACTER LABEL SAVE AREA
;
G.CMDV=<2+<G.MAXS/2>+1>&177776	;BYTES TO SAVE ON PUSHCLOSE(MUST BE EVEN)
			;SAVE FLAGS,HALF OF SYMTAB.
G.CMDT=2+G.MAXS+6	;COMMAND PROCESSOR TABLE
			;FLAGS+SYMBOLS+LABLE SEARCH
;
G.PDSA=G.CMDF+G.CMDT	;PUSH DOWN STACK START ADDRESS
G.PDSL=<6+<5*2>+G.CMDV> ;PUSH DOWN FRAME SIZE
;
; BIT DEFINITIONS
;
GE.COM=1		;COMMENTS ';' ARE ALLOWED
GE.IND=2		;INDIRECT '@' LINES ARE PROCESSED
GE.CLO=4		;CURRENT COMMAND INDIRECT FILE IS CLOSED BEFORE RETURN
GE.CMD=10		;COMMAND '.' LINES ARE PROCESSED
;
GE.IOR=-1		;I/O ERROR
GE.OPR=-2		;INDIRECT FILE OPEN ERROR
GE.BIF=-3		;BAD INPUT FILE
GE.MDE=-4		;MAX INDIRECT DEPTH EXCEEDED
GE.CER=-5		;ILLEGAL '.' COMMAND LINE
GE.EOF=-10.		;TOP LEVEL END OF FILE
;
; SWITCH BITS
GS.TRA=1		;/TA-TRACE ALL SWITCH
GS.DIS=200		;LINE DISPLAYED FLAG
GS.SKP=10000		;SKIPPING FLAG(RESET ON UNEXPECTED POPS)
GS.TRC=400		;/TR-TRACE THIS LEVEL
;
;
.MACRO GCMLD$ X
.ENDM
.ENDM
;
;
;
;
; TABLE GENERATING MACRO
;
.MACRO GCMLB$ CF,FF,CL,FL,MD,PT,UB,?PD,?UB1
;
.WORD	CF
.WORD	FF
.WORD	CL
.WORD	FL
;
.MCALL GCMLD$
GCMLD$
;
.BYTE	0,GE.COM!GE.IND!GE.CLO!GE.CMD	;ERROR AND MODE
.BLKW	4		;PROMPT AND COMMAND DESCRIPTORS
.BYTE	-1,MD			;CURRENT AND MAX DEPTHS
.WORD	0			;PRESET LINE POINTER
.WORD	PD		;PUSH DOWN POINTER
;
.IF NB,<UB>
.WORD UB
.IFF
.WORD UB1
.ENDC
;
$$$=.
.ASCII <15><12>
.IF NB ,<PT>
.ASCII /PT>/
.IFF
.ASCII /   >/
.ENDC
.=$$$+6
;
.WORD	0			;INDIRECT COMMAND PROCESSOR FLAGS
.BLKB	G.CMDT			;COMMAND PROCESSOR TABLE
;
PD:	.BLKB	<MD+1>*G.PDSL
;
.IF B <UB>
UB1:	.BLKB	82.
.ENDC
;
;
.ENDM	;GCMLB$
;
;
.MACRO GCML$	GD,PA,PL
	.MCALL LDR0$
	LDR0$	GD
	;.MCALL GCMLD$
;	GCMLD$	DEF$L
	.IIF NB,<PL>MOV	PL,G.PSDS+0(R0)
	.IIF NB,<PA>MOV PA,G.PSDS+2(R0)
	.IIF B <PA>	CLR	  G.PSDS+2(R0)
	CALL	.GCML1
.ENDM
.MACRO	RCML$	GD
	.MCALL LDR0$
	LDR0$	GD
	CALL	.GCML2
.ENDM
.MACRO	CCML$	GD
	.MCALL	LDR0$
	LDR0$	GD
	CALL	.GCML3
.ENDM
.MACRO  ECML$	GD
	.MCALL	LDR0$
	CALL	.GCML4
.ENDM
.MACRO	SCML$	GD,LP
	.MCALL LDR0$
	LDR0$	GD
;	GCMLD$	DEF$L
	MOV	LP,G.PLIN(R0)
.ENDM
;
	.LIST

	.TITLE DISIOR OPERATING SYSTEM SPECIFIC I/O ROUTINES
	.SBTTL FILE BLOCKS
;
;
;
	.MCALL FSRSZ$
	.MCALL FDBDF$,FDOP$A,FDRC$A,FDAT$A,FDBF$A,FDBK$A
	.MCALL OPEN$R,NMBLK$
;
;
; GET COMMAND FILE BLOCKS, AND BUFFERS
;
	GCMLD$		;DEFINE OFFSETS,ETC.
;
GTAB:	GCMLB$	CFDB,FFDB,0,0,5,DIS
;
; TERMINAL FDB
;
CFDB:	FDBDF$
	FDAT$A	R.VAR,FD.CR
	FDRC$A	,BUFFR,80.
	FDOP$A	CLUN,,DFCFDB
	FDBF$A	,,1
;
DFCFDB:	NMBLK$	CMD,CMD,,TI,0
;
BUFFR:	.BLKB	82.
;
;
; INDIRECT COMMAND FILE FDB
;
FFDB:	FDBDF$
	FDAT$A	R.VAR
	FDOP$A	FLUN
	FDBF$A	,,1
;
;
; LISTING FILE FDB
;
LFDB:	FDBDF$
	FDAT$A	R.VAR,FD.CR
	FDOP$A	LLUN,,DFLFDB
	FDBF$A	,,1
;
DFLFDB:	NMBLK$	DISASM,LST,,SY,0
;
;
; TASK DISK IMAGE FDB
;
TFDB:	FDBDF$
	FDRC$A	FD.RWM
	FDAT$A	R.FIX
	FDOP$A	TLUN,.DSPT,.FNB
	FDBK$A	VIRBUF,512.
	FDBF$A	,,1
;
VIRBUF:	.BLKB	512.
;
;
;
;
; FILE BUFFER RESERVATION
;
	FSRSZ$	3		;3 ACTIVE FILES
;
;
;LUN DEFINITION
;
FLUN=1		;INDIRECT COMMAND FILES
CLUN=6		;TERMINAL COMMAND LUN
TLUN=2		;TASK DISK IMAGE LUN
LLUN=5		;LISITNG LUN
;
; FILE NAME BLOCK FOR DISK TASK IMAGES
;
.FNB::
	NMBLK$
;
; DEFAULT FILE NAME BLOCK
;
.DFNB::
	NMBLK$	DISASM,TSK,,SY,0
;
;
; DATASET POINTER (FILLED BY DISCMD AT SAME TIME AS FILENAME BLOCK
;
DSP.DV==0
DSP.DI==4
DSP.FN==10
;
;
.DSPT::	.BLKW	6
;
; DEFAULT DATASET POINTER
;
.DFDSPT::
	.WORD DEVSZ,DEV
	.WORD 0,0		;IMPLY DEFAULT DIRECTORY
	.WORD FILSZ,FIL
;
DEV:	.ASCII /SY0:/
	DEVSZ=4
FIL:	.ASCII /DISASM.TSK/
	FILSZ=10.
	.EVEN
;

;
.SBTTL $GTCMD
;
; GET COMMAND LINE VIA SOOPER GCML
;
$GTCMD::
5$:
	GCML$	#GTAB		;GET ONE
	BCC	30$		;BR IF OK
;
	CMPB	#GE.EOF,G.ERR(R0);TOP LEVEL EOF?
	BNE	10$		;BR IF NOT
;
	SEC
	RETURN
;
;
10$:
	TYPMSG	#ERRGCM
	BR	5$		;TRY AGAIN
;
;
30$:
	ADD	#G.CMLD,R0	;POINT TO LINE DESCRIPTOR
	RETURN			;AND RETURN TO CALLER
;
	MSG ERRGCM,< GET COMMAND LINE ERROR>
;

.SBTTL $PUTLIN
;
; PUT LINE TO OUTPUT FILE
;
; INPUT: R1=BUF POINTER
;	R2=BYTE COUNT
	.MCALL OPEN$W,PUT$,CLOSE$
;
; PUT BUFFER FILL POINTER IS R0
;
$PUTBUF::
	MOV	#BUF,R1	;SET BUFFER POINTE
	MOV	R0,R2
	SUB	R1,R2	;SET BYTE COUNT
;
	CALL	$PUTLIN
;
	MOV	R1,R0	;RESET FILL POINTER
	RETURN
;
;
;
$PUTLIN::
	MOV	#LFDB,R0	;GET FILE REF
	TST	F.BDB(R0)	;IS IT OPEN?
	BNE	10$		;BR IF YES
  	MOV	R0,-(SP)
  	MOV	R1,-(SP)
  	MOV	R2,-(SP)
  	MOV	#DFLFDB+N.FNAM,R1	;GET FILENAME SECTION
	MOV	R1,R2
	MOV	#3,R0
12$:	CLR	(R2)+
	SOB	R0,12$
  	MOV	R1,-(SP)
	MOV	.DSPT+10,R1	;FETCH SIZE OF TASK STRING
  	MOV	#3,R2		;R0,R1
  	CLR	R0		;DIV R0,R1/R2
	DIV	R2,R0		;3 ASCII -> 1 RADIX
  	TST	R1		;ADD ONE BLOCK IF REMAINDER <> 0
  	BEQ	14$
  	INC	R0		;
14$:  	MOV	(SP)+,R1
  	MOV	#.FNB+N.FNAM,R2 ;GET TASKNAME STRING
20$:  	MOV	(R2)+,(R1)+	;COPY THE WHOLE STRING
	SOB	R0,20$		
  	MOV	(SP)+,R2
  	MOV	(SP)+,R1
  	MOV	(SP)+,R0
;
	OPEN$W			;OPEN IT FOR WRITING
	BCS	30$
;
10$:	PUT$	R0,R1,R2		;PUT THE LINE
;
	RETURN
;
;
30$:
	NOP
	RETURN
;
;
; CLOSE PRINT FILE FOR PRINTING
;
$CLOPRT::
	CLOSE$	#LFDB
	RETURN
;

.SBTTL $TYPMSG
;
; I: R1=STRING ADDRESS
;    R2=SIZE
;
$TYPMSG::
	PUT$	#CFDB,R1,R2
	RETURN
;
;
;
.SBTTL $INITL
;
; INITALIZE FILES SYSTEM AND OPEN COMMAND FDB
	.MCALL FINIT$,OPEN$R,EXIT$S
;
$INITL::
	FINIT$
	OPEN$R	#CFDB
;
	RETURN
;
.SBTTL $EXIT
;
; CLOSE PRINT FILE AND EXIT
;
$EXIT::
	CALL	$DEATSK
	CALL	$CLOPRT
	CLOSE$	#FFDB
	CLOSE$	#CFDB
;
	EXIT$S

.SBTTL $ACCTSK/$DEATSK ACCESS VIRTUAL TASK FILE
;
; OPEN FOR READ THE TASK FILE DESCRIBED IN THE
; FILENAME BLOCK .FNB.
;
$ACCTSK::
	OPEN$R	#TFDB
	BCS	10$
;
	NOP
	CLC
;
10$:
	RETURN
;
;
; DEACCESS THE VIRTUAL TASK FILE
;
$DEATSK::
	CLOSE$	#TFDB
	RETURN
;
;
;

.SBTTL $VGET GET WORD FROM VIRTUAL TASK
;
	.MCALL READ$,WAIT$
;
; INPUT: R5=VIRTUAL ADDRESS
;	.CRSEG=ADDRESS OF CURRENT SEGMENT TABLE ENTRY
;	.DLABL=OFFSET IN BYTES OF TASK V0 FROM FILE V0
;
; entry $VGET1:
; 	don't use info in segment descriptors while reading
;	segment structures
;
$VGET1::
	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	R4,-(SP)
	MOV	R5,R4
	CLR	R5
;
	ASHC	#-9.,R4		;SEPARATE BLOCK AND BYTE IN BLOCK
;
	ASH	#-<16.-9.>,R5	;RIGHT JUSTIFY
	BIC	#^C777,R5	;CLEAR OUT SIGN EXTEND
	MOV	R5,-(SP)	;SAVE BYTE-IN-BLOCK
  	CLR	R5
  	br	read	
$VGET::
	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	R4,-(SP)
	CLR	R4		;CLEAR HIGH ORDER ADDRESS
;
	MOV	.CRSEG,R3	;GET CURRENT SEGMENT DESCRIPTOR ADDR
;
	SUB	SGT.BA(R3),R5	;ADDRESS-BASE ADDRESS OF SEGMENT
	BCS	error		;BR IF OUT OF RANGE
	CMP	SGT.SZ(R3),R5	;VERIFY NOT TOO HIGH
	BLOS	error		;BR IF OUT OF RANGE OF SEGMENT
;
	MOV	R5,R4
	CLR	R5
	ADD	SGT.BB(R3),R4	;ADD BYTE OFFSET OF VIRTUAL ZERO fROM START OF FILE
	ADC	R5		;UNLIKELY CARRY
;
	ASHC	#-9.,R4		;SEPARATE BLOCK AND BYTE IN BLOCK
  	bic	#^C177,r4	;first 9. must be zero
;
	ASH	#-<16.-9.>,R5	;RIGHT JUSTIFY
	BIC	#^C777,R5	;CLEAR OUT SIGN EXTEND
	MOV	R5,-(SP)	;SAVE BYTE-IN-BLOCK
;
	MOV	SGT.BH(R3),R5	;GET HIGH ORDER ADDRESS OF SEGMENT
	ADD	SGT.BL(R3),R4	;ADD LOW ORDER ADDRESS
	ADC	R5		;AND CARRY
;
; get desired block
; 
read:	MOV	#TFDB,R0	;ADDRESS FILE D
	CMP	R4,.DBLOK+0	; IS THIS BLOCK ALREADY READ?
	BNE	10$		;NOPE
	CMP	R5,.DBLOK+2	; HOW ABOUT HIGH ORDER
	BEQ	20$		;YUP
10$:
	MOV	R4,F.BKVB+2(R0)	;SET LOW ORDER BLOCK NUMBER
	MOV	R5,F.BKVB+0(R0)	;SET HIGH ORDER BLOCK NUMBER
	MOV	R4,.DBLOK+0	;SAVE FOR LATER
	MOV	R5,.DBLOK+2
;
;
	READ$
	BCS	30$
	WAIT$			;GET BLOCK
	BCS	30$
;
20$:
	MOV	F.BKDS+2(R0),R5	;GET BUFFER ADDRESS
	ADD	(SP)+,R5	;PLUS BYTE-IN-BLOCK
;
	BIC	#1,R5		;ENSURE THIS IS AN EVEN ADDRESS
	MOV	(R5),R5		;GET WORD
	CLC
	BR	unsav
;
30$:
	TST	(SP)+		;POP BYTE OFFSET
error:
	SEC
unsav:
	MOV	(SP)+,R4
	MOV	(SP)+,R3
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RETURN			;INADDRESSABLE

	.SBTTL	GET CONTENTS OF VIRTUAL ADDRESS
;	R5 = VIRT ADDR
;	CALL	@.GETAD
;	R5 = CONTENTS
;	C = 0(INVALID ADDR)/1(VALID ADDR)
$MGET::
	MOV	R4,-(SP)	; SAVE R4
	MOV	R5,R4		; VIRT ADDR
	ASH	#-12.,R4	; BITS 1-3 = PAGE [0-7]
	BIC	#177761,R4	; 2*PAGE
	MOV	PDR(R4),-(SP)	; PDR(PAGE) TO STACK
	MOV	PAR(R4),-(SP)	; PAR(PAGE) TO STACK
	BIC	#160000,R5	; ADDR IN PAGE
	ADD	#60000,R5	; ADDR IN PAGE 3
	CLR	ADRER		; ADDRESS ERROR .SWITCH
	CALL	@#..SPD3	; USE PAGE 3 DESCRIPTOR
	MOV	(R5),R5		; MOVE CONTENTS
	CALL	@#..SPD3	; USE PAGE 3 DESCRIPTOR
	CMP	(SP)+,(SP)+	; CLEAN STACK
	MOV	(SP)+,R4	; RESTORE R4
	TST	ADRER		; TEST ERROR - C = 0
	BEQ	1$		; ADDRESS ERROR - C = 1
	SEC			; ADDRESS OKAY  - C = 0
1$:	RETURN
;
	.END