.TITLE LEVELS
;0001 STEVE ILLENCIK	REPUBLIC BUILDINGS CORP VAN WERT, OHIO
;0001			-CONVERT TO AN INTERATIVE PROGRAM SIMILIAR
;0001			 TO DEMO AND WILL ACCEPT DEMO COMMANDS.
;0002 STEVE ILLENCIK
;0002			-ADD ADDITIONAL INFORMATION TO OUTPUT:
;0002			 LEVEL TIME FACTOR, CPU USAGE COUNTER, AND
;0002			 JOB ALLOCATION FACTOR.
;R1   STEVE ILLENCIK	-ADD REMAINING TASK QUANTUM TO OUTPUT.
;R1			 QUANTUM NORMALLY = 0 SO DELETE.
	.MCALL	DIR$,FSRSZ$,QIOW$,EXIT$,CALL,RETURN,EXIT$S
	.MCALL	WAIT$,MRKT$S,WTSE$S,GTIM$S,ALTP$S,RUN$,GSSW$
	.MCALL GMCR$,MRKT$,GTSK$S,ASTX$S,SETF$S	;0001
	FSRSZ$	1
NM:	.BLKB	100		;OUPUT BUFFER SIZE
SPACE:	.BLKW	1
; I/O STATUS BUFFER
IOSB:	.BLKW	2
INTRVL:	.WORD	1		;0001 INTERVAL IN SECONDS BETWEEN DISPLAYS
INTUNT:	.WORD	2		;0001 INTERVAL TIME TO BE MEASURED IN SEC.
CNT1:	.BLKW	2
ESC = 033			;0001 TERMINAL CURSOR CONTROL CHARACTER
EH  = 110			;0001 ASCII 'H'  HOME
EJ  = 112			;0001 ASCII 'J'  CLEAR TO END OF SCREEN
EY  = 131			;0001 ASCII 'Y'  ADDRESS FORM UP LEFT
EK  = 113			;0001 ASCII 'K'  ERASE TO END OF LINE
BUZBUF:	.ASCIZ	<7><7><7><7>
BUZEND:	.EVEN
TIMBUF:	.BLKW	8.
	.EVEN
CLIR:	.RAD50	/CLI/
HED:	.ASCII <ESC><EY><040><040>/***  CURRENT TASK STATUS  ****  /
TIMMSG:	.BLKB	20.
TIM1:	.ASCII	/    PDP-11 IAS SYSTEM/
TIMME:	.EVEN
LEVCT:	.BLKB	20
UICP:	.BLKW	300
UICG:	.BLKW	300
CPU:	.BLKW	500
STD:	.BLKW	500			;SYSTEM TASK DIRECTORY
;R1	JQTM:	.BLKW	500		;REAMINING JOB TIME QUANTUM
JAF:	.BLKB	250			;0002 JOB ALLOCATION FACTOR
LEVTF:	.BLKW	10			;0002 TIME FACTORS PER LEVEL
	.EVEN
SPAC:	.ASCII	/  /
	.EVEN
COUNT:	.BLKB	1
	.EVEN
HDBUF:	.ASCII	/LEVEL #/
HDBE:	.EVEN
LEVEL:	.BLKW	1
HDBUF2:	.ASCII <11>/TIME FACT /		;0002
HDBE2:	.EVEN				;0002
LEVAF:	.BLKW	1			;0002
LEVAFA:	.BLKW	1			;0002
NAME:	.BLKW	500
	.EVEN
TERM:	.BLKW	500
	.EVEN
TER:	.BLKW	2
	.EVEN
CLRS:	.ASCII <ESC><EH><ESC><EJ>		;0001
CLRSC=.-CLRS					;0001
NEWTIM:	.ASCII <ESC><EY><040><112>		;0001
NTIME:	.BLKB 8.				;0001
NWTIME=.-NEWTIM					;0001
CLRT:	.ASCII <ESC><EY><041><040>		;0001
	.ASCII <ESC><EJ>			;0001 CLEAR ALL TASKS 
CLRTS=.-CLRT
CREST:	.ASCII <ESC><EY><041><040>	;0002 CURSOR REST POSITION
CRES=.-CREST
	.EVEN
; LOCAL MACROS
;
	.MACRO	INH0
	MOV	PS.EXP,-(SP)
	BIS	#140,PS.EXP
	.ENDM INH0
	DSW=0
BUZZ:	QIOW$	IO.WVB,1,1,,,,<BUZBUF,BUZEND-BUZBUF,>
HEAD1:	QIOW$	IO.WVB,1,1,,,,<HDBUF,HDBE-HDBUF,044>
NUM:	QIOW$	IO.WVB,1,1,,,,<LEVEL,2,000>
HEAD2:	QIOW$	IO.WLB,1,1,,,,<HDBUF2,HDBE2-HDBUF2,000>
NUM2:	QIOW$	IO.WLB,1,1,,,,<LEVAFA,2,53>
NAM:	QIOW$	IO.WVB,1,1,,,,<NM,100,40>
	BUFCTR=NAM + Q.IOPL+2
HEAD:	QIOW$	IO.WVB,1,1,,,,<HED,TIMME-HED,040>
CLRSCR:	QIOW$	IO.WLB,1,1,,,,<CLRS,CLRSC>		;0001
CRTIM:	QIOW$	IO.WLB,1,1,,,,<NEWTIM,NWTIME>
CLRTSK:	QIOW$	IO.WLB,1,1,,,,<CLRT,CLRTS>
REST:	QIOW$	IO.WLB,1,1,,,,<CREST,CRES>	;SEND CURSOR TO REST
	.EVEN
BUFSIZ=64.*8.				;0001
DSBUF:	.BLKB	BUFSIZ			;0001
BUFEND:	.WORD	0			;0001
TSFLG:	.BYTE	0			;0001
	.EVEN
EXFLG:	.WORD	0			;0001 CTRL 'C' EXIT  FLAG
UIFLG:	.WORD	0			;0001 UNSOLICITED INPUT FLAG
	.EVEN
;
GETTYP:	QIOW$	SF.GSC,1,1,,IOSB,,<TC.TTP>		;0001
ATTDPB:	QIOW$	IO.ATA,1,1,,,,<CCAST,UIAST>		;0001
DETDPB:	QIOW$	IO.DET,1,1			;0001
;
; GET MCR COMMAND LINE AND DPB
;
GETMCR:	GMCR$
;
; COMMAND DECODER MACRO
;
;   BYTE   00	FIRST CHARACTER OF COMMAND
;   BYTE   01	SPARE - USED BY SOME  COMMAND PROCESSORS
;   WORD   01	ADDRESS OF COMMAND PROCESSOR
;
	.MACRO	COMAND	NAME,RTN,SPARE		;0001
	.BYTE	''NAME,SPARE			;0001
	.WORD	RTN				;0001
	.ENDM	COMAND				;0001
	.EVEN
;
; COMMAND TABLE
;
CMDTBL:
	COMAND	C,CMDC		;0001 C - CLEAR SCREEN
	COMAND	I,CMDI		;0001 I - SET DISPLAY INTERVAL TIME
	COMAND	U,CMDU		;0001 U - SET DISPLAY INTERVAL UNITS
	COMAND	X,EXIT		;0001 X - EXIT
	.WORD	0		;TERMINATOR
	.EVEN
;
READTT:	QIOW$	IO.RLB!TF.TMO,1,1,,IOSB,,<GETMCR+2,32.,0>
;
; MARK TIME MACRO
;
MKTDPB:	MRKT$	2,0,0		;0001 MARK TIME DPB
NLEV:	.WORD	0
	.EVEN
;***********************************************************************
.PAGE
START:
	DIR$	#GETTYP		;0001 GET TERMINAL TYPE
	BCC	1$		;0001 C BIT NOT SET
	JMP	EXIT		;0001 C BIT SET - LUN NOT ASSIGNED
1$:	CMPB	IOSB,#IE.IFC	;0001 FUNCTION NOT RECOGNIZED
	BEQ	2$		;0001 JMP IF SO, ASSUME AS BUILT
	CMPB	IOSB+2,#T.VT52	;0001 IS IT A VT52
	BEQ	2$		;0001 YES
	CMPB	IOSB+2,#T.VT55	;0001 A VT55?
	BEQ	2$		;0001 YES
	JMP	EXIT		;0001 NOT A VALID  TYPE
2$:	GTSK$S	#DSBUF		;0001 GET TASK SIZE
	MOV	DSBUF+G.TSTS,BUFEND	;0001 REMEMBER END OF BUFFER
	SUB	#10.,BUFEND	;0001 SUB ONE ATL BUFFER ENTRY
	CLRB	TSFLG		;0001 ASSUME REALTIME TASK
	MOV	.CRTSK,R0	;0001 GET ATL ADDRESS
	BIT	#AF.IA,A.TF(R0)	;0001 T/S OR REAL
	BEQ	25$		;0001 REALTIME
	INCB	TSFLG		;0001 TIMESHARE
25$:	DIR$	#ATTDPB		;0001 ATTACH TERMINAL
	GTIM$S	#TIMBUF		;GET CURRENT TIME PARAM
	MOV	#TIMMSG,R0	;POINT TO CONVERSION BUFFER
	MOV	R0,R3
	MOV	#TIMBUF,R1	;POINT TO TIME PARAMETERS
	CALL	$DAT		;CONVERT DATE
	MOVB	#' ,(R0)+	;INSERT A SPACE
	MOV	#3,R2		;CONVERT TO HOURS MIN AND SEC
	CALL	$TIM		;CONVERT TO ASCII
	DIR$	#CLRSCR		;HOME AND CLEAR SCREEN
	DIR$	#HEAD		;PRINT HEADER LINE
;+
; MARK TIME INTERVAL
;-
 
MKT:	MOV	INTRVL,MKTDPB+M.KTMG	;0001
	MOV	INTUNT,MKTDPB+M.KTUN	;0001 SET INTERVAL TIME UNITS
	BEQ	5$			;0001 NO INTERVAL
	DIR$	#MKTDPB			;0001 MARK TIME DIRECTIVE
5$:	JMP	LEVELS			;0001 PROCESS
WAIT:	DIR$	#REST			;0002 SEND CURSOR TO REST
	TST	INTRVL			;0001 PROCESS COMPLETE WAIT?
	BEQ	10$
	WTSE$S	#2			;0001 WAIT FOR SWITCH 2
10$:	TST	EXFLG			;0001 TEST FOR CTRL-C
	BNE	EXIT
	TST	UIFLG			;0001 TEST UNSOLICITED INPUT
	BEQ	MKT
STOP:
	CLR	UIFLG			;0001 CLEAR UI FLAG
	DIR$	#READTT			;0001 READ TERMINAL INPUT
	CMPB	IOSB,#IE.EOF		;0001 CHECK FOR CTRL 'Z'
	BEQ	EXIT			;0001
	CMPB	IOSB,#IS.TMO		;0001 CHECK FOR COMPLETE LINE
	BEQ	MKT
	JMP	COMAND
;+
; X COMMAND - EXIT
;-
 
EXIT:
	DIR$	#DETDPB		;0001 DETACH DPB
	EXIT$S			;0001 EXIT
LEVELS:
	MOV	.UTLNO,NLEV	;GET NUMBER OF TIMESHARING LEVELS
	INC	NLEV		;ADD 1 AND STORE IN NLEV
	INH0
	CMP	.DLTNO,#0	;ANY DEVICES IN USE ???
	BEQ	START1		;NO -- GO ON
	MOV	.DLTBA,R0	;GET DEVICE LOAD TABLE ADDRESS
	CMPB	DV.ST(R0),#1	;IS LOAD REQUEST PENDING???
	BNE	START1		;NO LOAD PENDING
	CALL	..ENB0		;ENABLE TASK SWITCHING
	DIR$	#BUZZ		;BUZZ THE TERMINAL
	JMP	WAIT		;AND WAIT
START1:
	GTIM$S	#TIMBUF		;GET CURRENT TIME PARAM
	MOV	#NTIME,R0	;POINT TO TIME BUFFER
	MOV	#TIMBUF+6,R1	;POINT TO TIME PARAMETERS
	MOV	R0,R3		;
	MOV	#3,R2		;CONVERT TO HOURS, MIN AND SEC
	CALL	$TIM		;CONVERT TO ASCII
	DIR$	#CRTIM		;OUTPUT NEW TIME
	DIR$	#CLRTSK		;CLEAR OLD TASK
	MOV	.UTLHD,R0	;GET UTL LISTHEAD
	MOV	#0,R4
	MOV	#0,R1
	MOVB	#0,COUNT	;CLEAR COUNTER
LEV:	;INH0			;INIHIBIT TASK SWITCHING
	INC	R1		;MOVE LEVEL # TO R1
	CMP	R1,NLEV
	BMI	LEV1
	JMP	EDEQ		;END OF ALL LEVELS	NOW GO PRINT
LEV1:	MOV	R1,LEVEL	;SAVE IN LEVEL
	MOV	Z.NL(R0),R5		;SAVE NEXT LEVEL IN R5
	MOV	Z.FJ(R0),R2	;SAVE FIRST UJN ADDRESS
	MOV	Z.LJ(R0),R3	;SAVE LAST UJN ADDRESS
	MOVB	Z.TF(R0),LEVTF-1(R1)	;0002 SAVE LEVEL TF
	TSTB	Z.NE(R0)	;TEST NUMBER ENTRIES
	BEQ	NEXT3		;LEVEL EMPTY
	MOV	R2,R0		;PUT FIRST UJN ADD IN R0
DEQ:
	CMP	J.JB(R0),CLIR	;IS THIS A CLI
	BNE	DEQ1		;NO... GO ON
	CMP	R0,R3		;IS THIS THE LAST UJN
	BEQ	NEXT3		;YES  GO TO NEXT LEVEL
	MOV	@R0,R0		;NO GO TO NEXT NODE
	JMP	DEQ
DEQ1:	MOV	J.JB(R0),NAME(R4)		;GET JOB NAME
	MOV	J.JB+2(R0),NAME+2(R4)
	MOV	J.TA(R0),TERM(R4)		;SAVE TERMINAL NODE ADDRESS
	MOVB	J.PC(R0),UICP(R4)		;SAVE PROGRAMMER CODE
	MOVB	J.GC(R0),UICG(R4)		;SAVE GROUP CODE
	MOV	J.AC+2(R0),CPU(R4)		;SAVE CPU TIME
;R1	MOV	J.QU(R0),JQTM(R4)		;REMAINING JOB QUANTUM
	MOVB	J.SD(R0),JAF(R4)		;0002 ALLOCATION FACT
	MOV	J.AT(R0),R2
	MOV	A.TD(R2),STD(R4)		;SAVE STD ENTRY
	ADD	#1,COUNT
	ADD	#4,R4
	CMP	R0,R3		;IS THIS LAST UJN
	BEQ	NEXT3		;YES, GO TO NEXT3
	CMP	#100,R4		;MORE THAN 8 ENTRIES ??
	BMI	NEXT3		;YES BRANCH OUT
	MOV	@R0,R0		;NO, GET NEXT LINK
	JMP	DEQ		;AND GET NEXT NAME
NEXT2:	
NEXT3:	MOVB	COUNT,LEVCT(R1)	;SAVE # OF UJNS
	MOVB	#0,COUNT	;CLEAR COUNT
	MOV	R5,R0		;GET NEXT LEVEL
	JMP	LEV		;GO TO NEXT LEVEL
EDEQ:	;ENABLE TASK SWITCHING
	CALL	..ENB0
	MOV	#0,R1		;CLEAR R1
	MOV	R4,CNT1	;SAVE MAC BUFFER COUNT IN R4
	MOV	#0,R4		;START AT BEGINNING OF BUFFER
EDEQ1:	INC	R1		;ADVANCE LEVEL POINTER
	CMP	R1,NLEV		;LAST LEVEL ????
	BMI	DEQ2		;YES GO WAIT
	JMP	WAIT
.PAGE
;+
;	PRINT LEVEL NO.
;-
DEQ2:	MOV	R1,LEVEL	;SET UP LEVEL
	MOV	#0,R5		;CLEAR R5
	MOVB	LEVCT(R1),R5	;PUT UJN COUNT IN R5
	CMP	#0,R5		;NO ENTRIES THIS LEVEL ???
	BEQ	EDEQ1		;RIGHT GO TO NEXT LEVEL
	ADD	#60,LEVEL	;CHANGE LEVEL # TO ASCII
	DIR$	#HEAD1		;PRINT HEADER LINE
	DIR$	#NUM
	MOV	R1,R3		;SAVE OFF R1 IN R3
	MOVB	LEVTF-1(R3),R1	;GET LEVEL TIME FACTOR AND
	MOV	R1,LEVAF	;CONVERT TO WORD
	MOV	LEVAF,R1	;0002 CONVERT ALLOC FACT TO ASCII
	MOV	#LEVAFA,R0	;0002
	MOV	#0,R2		;0002
	JSR	PC,$CBDMG	;0002
	DIR$	#HEAD2		;0002 PRINT
	DIR$	#NUM2		;0002
;+
;	PRINT JOB NODE NUMBER
;-
PRI:	MOV	#NM,R0		;PLACE ASCII ADDRESS IN R0
	MOV	NAME(R4),R1	;GET FIRST HALF OF RAD50 NAME
	JSR	PC,$C5TA	;CHANGE TO ASCII
	MOV	NAME+2(R4),R1	;GET SECOND HALF
	JSR	PC,$C5TA	;CHANGE SECOND HALF
	MOVB	#11,@R0		;INSERT A TAB
	ADD	#1,R0		;AND INCREMENT
;+
;	PRINT TERMINAL NUMBER
;-
	MOV	TERM(R4),R2	;GET TERMINAL NODE ADDRESS
	MOVB	I.TT(R2),R1	;PLACE TERM # IN R1
	MOV	#0,R2		;CLEAR R2
	JSR	PC,$CBOMG	;CHANGE TERM # TO OCTAL
	MOVB	#11,@R0		;INSERT A TAB
	ADD	#1,R0		;AND INCREMENT
;+
;	PRINT UIC
;-
	MOV	R0,SPACE
	MOVB	#133,@R0
	ADD	#1,R0
	MOV	UICG(R4),R1	;PUT BINARY GROUP CODE IN R1
	MOV	#0,R2		;CLEAR R2
	JSR	PC,$CBOMG	;ADD TO LINE
	MOVB	#54,@R0
	ADD	#1,R0
	MOV	UICP(R4),R1	;PUT BINARY PROG CODE IN R1
	MOV	#0,R2		;CLEAR R2
	JSR	PC,$CBOMG	;ADD TO LIST
	MOVB	#135,@R0
	ADD	#1,R0
	ADD	#7,SPACE
	CMP	SPACE,R0
	BMI	PRI0
	MOVB	#11,@R0
	ADD	#1,R0
PRI0:	MOVB	#11,@R0		;INSERT A TAB
	ADD	#1,R0		;AND INCREMENT
;+
;	PRINT CPU TIME
;-
	MOV	CPU(R4),R1	;GET READY TO CONVERT CPU TIME
	MOV	#0,R2
	JSR	PC,$CBDMG	;CONVERT
	MOVB	#11,@R0		;INSERT A TAB
	ADD	#1,R0		;AND INCREMENT
;+
;	PRINT JOB NAME
;-
	MOV	STD(R4),R2	;GET SYSTEM TASK DIR ADDRESS
	MOV	S.TN(R2),R1	;GET FIRST TASK NAME
	JSR	PC,$C5TA	;AND CONVERT
	MOV	STD(R4),R2	;GET ADDRESS
	MOV	S.TN + 2(R2),R1	;AND SECOND HALF
	JSR	PC,$C5TA	;AND CONVERT
	MOVB	#11,@R0		;INSERT A TAB
	ADD	#1,R0		;AND INCREMENT
;+
;	REMAINING TASK QUANTUM
;-
;R1	MOV	JQTM(R4),R1	;GET QUANTUM
;R1	MOV	#0,R2
;R1	JSR	PC,$CBDMG	;CONVERT
;R1	MOVB	#11,@R0		;INSERT A TAB
;R1	ADD	#1,R0		;AND INCREMENT
;+
;	PRINT JOB ALLOCATION FACTOR
;-
	MOVB	JAF(R4),R1	;0002 GET FACTOR
	MOV	#0,R2
	JSR	PC,$CBDMG	;0002 CONVERT TO DECIMAL
	SUB	#NM,R0
	MOV	R0,BUFCTR
;+
; P R I N T
;-
	DIR$	#NAM
;	MRKT$S	#2,#1,#2
;	WTSE$S	#2
PRI1:	ADD	#4,R4		;GO  TO NEXT NAME
;	CMP	CNT1,R4	;DOES POINTER EXCEED COUNT ???
	CMP	#CNT1,R4	;SJI CHANGE
	BGE	5$		;0001
	JMP	WAIT		;SKIP IF END
5$:	SUB	#1,R5		;REDUCE COUNT BY ONE
	BEQ	NEXT		;IF NO MORE UJN THEN GO TO NEXT LEV
	JMP	PRI		;MORE LEFT PRINT AGAIN
NEXT:	MOV	R3,R1		;RESTORE R1
NEXT1:	JMP	EDEQ1		;NEXT LEVEL
.PAGE
;+
; CHECK FOR  UNSOLICITED INPUT
;-
CCAST:	INC	EXFLG			;SHO EXIT REQUIRED
	BR	ASTCOM			;GO TO COMMON CODE
UIAST:	INC	UIFLG			;SHO INPUT SEEN
ASTCOM:	SETF$S	#2			;WAKE UP TASK
	ASTX$S
;+
; HERE IS THE COMMAND DECODER. WHILE LEVELS IS RUNNING IT USES UNSOLICITED
; INPUT AST'S TO DETECT COMMANDS.  COMMANDS ARE RECOGNIZED BY THE
; FIRST LETTER AND THE DISPATCHER JUMPS TO THE APPROPRIATE HANDLER.
; R1 CONTAINS THE FIRST NON-BLANK CHARACTER AFTER THE COMMAND.
; THE DECODER IS DRIVEN BY THE TABLE AT 'CMDTBL'.
;-
 
COMAND:	MOV	#GETMCR+2,R1	;GET INPUT BUFFER
	CLR	UIFLG		;0001 CLEAR INPUT  FLAG
	MOV	IOSB+2,R0	;GET LENGTH OF COMMAND
	BEQ	35$		;IGNORE IF ZERO LENGTH
	ADD	R1,R0		;POINT PAST COMMAND
	MOVB	#40,(R0)+	;PLANT TERMINATOR
10$:	CMPB	(R1)+,#40	;FOUND A SPACE YET?
	BNE	10$		;LOOP IF NOT
20$:	CMPB	(R1)+,#40	;STILL LOOKING AT SPACES?
	BEQ	20$		;LOOP IF SO
	DEC	R1		;BACK OVER NON-SPACE
	MOV	#CMDTBL,R0	;GET COMMAND TABLE
30$:	CMPB	GETMCR+2,(R0)	;THIS THE RIGHT COMMAND?
	BEQ	40$		;J IF SO
	CMP	(R0)+,(R0)+	;ELSE SKIP TO NEXT ENTRY
	TST	(R0)		;AT THE END YET?
	BNE	30$		;LOOP IF NOT
35$:	JMP	WAIT		;IGNORE IF ILLEGAL
40$:	JMP	@2(R0)		;DISPATCH FOR COMMAND
;+
; I COMMAND - SET NUMBER OF SECONDS BETWEEN UPDATING DISPLAY
;		IF VALUE IS ZERO, UPDATE DISPLAY CONTINUOUSLY
;-
 
CMDI:	MOV	R1,R0		;COPY BUFF POINTER
	CALL	$CDTB		;CONVERT DECIMAL NUMBER
	MOV	R1,INTRVL	;SET UP
	JMP	WAIT		;AND GO AGAIN
;+
; C COMMAND - CLEAR SCREEN
;-
 
CMDC:	DIR$	#CLRSCR			;0001 HOME AND CLEAR SCREEN
	DIR$	#HEAD			;0001 RESTORE HEADER
	JMP	WAIT
;+
; U COMMAND - CHANGE INTERVAL UNITS
;-
 
CMDU:	MOV	R1,R0
	CMP	R0,#1		;0001 CHECK FOR VALID INTERVAL UNITS
	BLT	10$		;0001
	CMP	R0,#4		;0001 CHECK FOR VALID UNITS
	BGT	10$
	CALL	$CDTB		;0001
	MOV	R1,INTUNT	;0001
10$:	JMP	WAIT		;0001
	.END	START