TITLE	KMON   %20A	12-MAR-79
SUBTTL   DEC MONITOR FOR "AID"   A KOTOK	N PAPPAS D NIXON



;COPYRIGHT (C) 1973,1978,1979 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

	VCUSTOM==0
	VAID==20		;VERSION NUMBER
	VUPDATE==1		;MINOR VERSION NUMBER
	VEDIT==32		;EDIT NUMBER

;IFN SEG2SW,<KMON USES TWO SEGMENT FEATURE>
IFDEF TWOSEG,<IFNDEF SEG2SW,<SEG2SW==1>>
IFNDEF SEG2SW,<SEG2SW==0>
IFN SEG2SW,<PURESW==1>
;IFN PURESW,<IMPURE AREA IS INITIALISED FROM HISEG>
IFNDEF PURESW,<PURESW==1>

	LOC <.JBVER=137>
	<VCUSTOM>B2+<VAID>B11+<VUPDATE>B17+VEDIT

	LOC	124
	EXP	REE
	RELOC 0


;ENTRIES TO/FROM MONITOR FOR TRANSFER OF CONTROL

INTERN MONENT			;NORMAL MONITOR ENTRY
INTERN KILL			;MONITOR ENTRY ON FATAL ERROR
EXTERN INTBEG			;ENTRY TO INTERPRETER ON INITIALIZATION

;AC DEFINITIONS

A=0
B=1
C=2
D=3
E=4
F=5
PP=17			;USED FOR PUSH POP

	MLON

IFN PURESW,<
IFN SEG2SW,<	TWOSEGMENTS
	RELOC	400000>
IFE SEG2SW,<	HISEG>>
SUBTTL	REVISION HISTORY

;START OF VERSION 20A
;32	ADD DATE75 HACK
SUBTTL	DEC MONITOR FOR "AID"
;COLD START ROUTINE
INTERN START
EXTERN .JBFF,.JBREL,.JBOPC

START:	CALLI 0			;RESET ALL IO
	MOVE	B,[XWD LBEG,LBEG+1]	;START OF DATA
	SETZM	LBEG		;ZERO FIRST WORD
	BLT	B,LEND-1	;AND REST
	MOVE	B,[XWD PH1C,S79.01]
	BLT	B,P75.08
	MOVE	B,[XWD OPENB,INITB]
	BLT	B,INITB+2
	MOVE	B,[XWD PH2C,S86]
	BLT	B,SR1+1
	MOVE	B,[XWD PH3C,P92]
	BLT	B,S80+1
	MOVE	B,[JRST S5460A]
	MOVEM	B,S54.60+1
	MOVE	B,[XWD 41000,SK11]
	MOVEM	B,SK11
	SETZ	B,
	CALLI	B,27	;MAKE RUN TIME ONLY FOR AID
	MOVEM	B,STTIME	;TIME WHEN STARTED
	MOVE	PP,[XWD -20,PLIST]
	MOVEM PP,PLIST		;SET UP PUSH-DOWN LIST
	INIT 1		;INITIALIZE CONSOLE
	SIXBIT /TTY/
	XWD OB,IB
	HALT START
	MOVEI A,BUF1		;TTY OUT SETUP
	MOVEM A,.JBFF
	OUTBUF 1
	OUTPUT			;DUMMY OUTPUT
	MOVEI E,GRTNG		;TYPE GREETING (IN DDT MODE)
	CALLI E,3
	JRST INTBEG		;GO TO INTERPRETER

GRTNG:	ASCIZ /
AID 20A(32) AT YOUR SERVICE ...

/
;DUMMY ERROR EXIT FROM INTERPRETER

KILL:	HALT START

;HERE FOR REENTER
REE:	TTCALL	12,0
	SETOM	RIF
	JRSTF	@.JBOPC

;NORMAL MONITOR ENTRY FROM INTERPRETER
;B CONTAINS REQUEST TYPE
;A AND C MAY BE CLOBBERED, EVIDENTLY.  ALSO G.

MONENT:	MOVE PP,PLIST		;RESTORE MONITOR PUSH-DOWN LIST
	CAIL B,L.ETSW		;CHECK FOR WITHIN LIMIT
	HALT START
	PUSHJ PP,@ENTSW(B)	;DISPATCH TO ROUTINE
MONEXIT:CALLI B,23		;NEED SPACE
	IDIVI B,^D1000
	IDIVI B,^D60
	IDIVI	B,^D60
	MOVEM B+1,MIN
	MOVEM B,HR
	 SETZ	B,
	 CALLI	B,27
	SUB	B,STTIME	;SUBTRACT STARTING TIME
	IDIVI	B,^D10
	MOVEM	B,SECOND 
MONEX1:	JRST @INTENT		;RETURN TO MONITOR


ENTSW:	JRST SU			;SWITCH TO USER
	JRST GBUF		;GET A BUFFER
	JRST MONEXIT		;RETURN A BUFFER
	JRST TU			;TRANSMIT BUFFER TO STATION
	JRST TLSU		;TL AND SU
	JRST MONEXIT		;BREAK POINT
	JRST MONEXIT		;REQUEST DISK
	JRST DCONT		;CONTINUE DISK ACTION
	JRST DCOMP		;DISK ACTION COMPLETE
	JRST MORCOR		;GET ANOTHER BLK OF CORE
	JRST MORCI		;IMPERATIVE MORE CORE
	JRST SENDFF		;MAKE UP AND SEND FORMFEED
	HALT MONEXIT		;GET USER OFF
	JRST RCOR		;RETURN BLOCKS OF CORE
	HALT MONEXIT		;PAUSE FOR E SECONDS
L.ETSW==.-ENTSW+1		;LENGTH OF THE SWITCH
;ROUTINES TO EXPAND/CONTRACT CORE

RCOR:	MOVNI A,2000		;DECREASE CORE BY 1K
	JRST MORCI1

MORCOR:
MORCI:	MOVEI A,2000		;IMPERATIVE MORE CORE,DONT CHECK
MORCI1:	ADD A,.JBREL
	SETOI B,		;SUCCESS FLAG
	CALLI A,11	;TRY TO GET IT
	SETZI B,		;FAILED.  SET FLAG
	JRST MONEX1

;UTILITY ROUTINES FOR TTY IO

SETUP:	MOVE A,[POINT 7,BUF1+2,34]
	MOVEM A,BUF1+1		;POINTER TO BEGINNING OF BUFFER
	MOVEI C,15		;CR IN NEXT-TO-LAST BYTE
	DPB C,[POINT 7,BUF1+3+^D18-1,27]
	POPJ PP,

GETCH:	ILDB C,BUF1+1		;GET CHARACTER
	MOVE A,BUF1+1
	ILDB D,A		;AND LOOK AHEAD ONE CHARACTER
	POPJ PP,
;TRANSMIT BUFFER AND SWITCH TO USER

TLSU:	PUSHJ PP,TU		;TRANSMIT BUFFER,FALL INTO SU

;SWITCH TO USER (I.E., READ A LINE OF INPUT)

SU:	MOVE A,[XWD 21,BUF1+1]	;TYPE "*"
	MOVEM A,BUF1+1
	SETZM BUF1+3		;CLEAR FIRST WRD OF BFR
	MOVEI C,"*"
	IDPB C,OB+1
	OUTPUT
	PUSHJ PP,GBUF		;GET A FREE BUFFER
	HRRZM E,.JBFF
	INBUF 1			;SET UP AS INPUT BFR
	INPUT			;READ LINE FROM TTY
	MOVNI	C,1		;SET FOR CURRENT JOB
	GETLCH	C		;GET LINE CHARACTERISTICS
	SETZ	B,		;SET FOR NO CONVERSION
	TLNN	C,(1B13)	;TEST FOR LOWER CASE INPUT FLAG ON
	MOVEI	B,40		;NO, CONVERT LOWER CASE TO UPPER
	CLOSE	1		;CLOSE INPUT SIDE
	MOVSI C,(ASCII/
/)
	MOVEM C,BUF1+3+^D16	;INSERT CARRIAGE RETURN AFTER BUFFER
	SETZM (E)		;CLEAR LINK WORD (NEEDED??)
	PUSHJ PP,SETUP		;SET UP FOR SCAN
	PUSHJ PP,GETCH		;CHECK FOR LEADING "*"
	CAIN	C,32
	JRST	SU
	CAIN C,"*"
	JRST SUXRET		;DONT CONVERT IT
	JRST SULP6	
SULP: 	SKIPE	EFG
	JRST	SULP1	
	PUSHJ PP,GETCH		;GET CHAR & LOOK AHEAD
SULP6:	CAIN	D,15
	JRST	SULP3	
SULP4:	CAIN C,"*"
	JRST XEXP
	CAIE	C,"%"
	CAIN	C,"#"
	TRC	C,6	;EXCHANGE CHARACTERS
	CAIL C,"A"
	CAILE C,"Z"
	JRST .+2
	ADDI	C,(B)		;CONVERT TO LOWER CASE
	CAIN	C,"^"		;LET UP ARROW BE EXPONENTIATION (RPG)
	MOVEI	C,"*"		;...
	CAIN	C,"_"		;LET LEFT ARROW BE UNDERSCORE
	MOVEI	C,"^"		;...
	CAIN D,"="
	JRST XGELE
SUXRET:	DPB C,1(E)
	CAIE C,15		;CARRIAGE RETURN?
	JRST SULP		;NO, GO FOR MORE
	MOVSI A,400000
	MOVEM A,2(E)		;TTY FLAG (FOR JOSS USE)
	JRST MONEXIT		;BACK TO JOSS

XEXP:	SKIPE	FORMFG
	JRST	.+3 
	CAIN D,15		;TRAILING *?
	JRST	CLEAR		;CLEAR OUT LINE
	CAIN D,"*"
	JRST XX
XEXP2:	MOVEI	C,"&"
	JRST	SUXRET

CLEAR:	PUSHJ	PP,GBUF		;ZERO INPUT BUFFER
	PUSHJ	PP,SETUP	;SET UP BUFFER PNTR.
	MOVEI	C,1		;ONLY ONE WORD
	MOVEM	C,BUF1+2	;SET IT TO BE SO
	MOVSI	C,64240		;CR-LF
	MOVEM	C,BUF1+3	;FAKE NOTHING SEEN
	MOVEI	C,CR
	MOVEI	D,LF
	JRST	SULP		;SCAN AS IF BLANK LINE

XGELE:	CAIN C,74
	HRROI C,"\"
	CAIN C,76
	HRROI C,"@"
	JUMPGE C,SUXRET
XXSPAC:	MOVEI D," "
	DPB D,A
	JRST SUXRET
XX:	SKIPE	FORMFG
	JRST	XEXP2
	JRST	XXSPAC

SULP3:	CAIE	C,")"		;PARENTHETICAL DO?
	JRST	SULP7		;NO
	LDB	D,[POINT 7,BUF1+3,6]	;GET FIRST CHAR.
	CAIE	D,"("		;CHECK AGAIN
	JRST	SULP7		;IT ISN'T
	MOVE	D,BUF1+1	;SAVE BYTE POINTER
	MOVEM	D,SAVPTR	;FOR LATER
SULP7:	MOVEI	D,15		;JUST IN CASE
	CAIE	C,"*"
	SKIPE	FORMFG
	JRST	SULP4
	CAIE	C,":"
	CAIN	C,"."
	JRST	SULP4
	SETOM	EFG1
	SETOM	EFG
	MOVEI	D,"."
	JRST	SULP4

SULP1:	SKIPN	EFG1
	JRST	SULP5
	MOVEI	C,"."
	MOVEI	D,15
	SETZM	EFG1
	IBP	1(E)
	JRST	SULP4

SULP5:	SETZM	EFG
	SKIPN	SAVPTR		;PARENTHETICAL DO
	JRST	SULP8		;NO
	LDB	C,BUF1+1	;GET "."
	LDB	D,SAVPTR	;GET ")"
	DPB	C,SAVPTR	;SWAP THEM
	DPB	D,BUF1+1	;ABOUT
	SETZM	SAVPTR		;BUT ONLY ONCE
SULP8:	PUSHJ	PP,GETCH
	MOVEI	C,15
	MOVEI	D,12
	JRST	SULP4	
;TRANSMIT BUFFER TO USER

TU:	PUSHJ PP,SETUP
	MOVEI F,1
TULOOP:	PUSHJ PP,GETCH		;GET CHAR & LOOK AHEAD
	JUMPE C,TUSRT3		;DONE ON NULL FROM JOSS
	CAIE	C,"#"
	CAIN	C,"%"
	TRC	C,6		;EXCHANGE CHARACTERS
	CAIN D," "		;FOLLOWING SPACE?
	JRST TUSPC		;YES
	CAIN	C,"^"		;UNDERSCORE?
	MOVEI	C,"_"		;YUP, REPLACE BY LEFT ARROW
	CAIN C,"*"
	MOVEI C,"^"		;EXPON & NO ROOM FOR "**"
TUSRET:	CAIN	C,"&"
	MOVEI	C,"*"
	DPB C,1(E)
	CAIE C,15
TUSRT2:	AOJA F,TULOOP
	MOVEI C,12
	IDPB C,1(E)
TUSRT3:	MOVE A,1(E)		;FUDGE OUTPUT BUFFER
	MOVEM A,OB+1
	MOVE A,[XWD 21,BUF1+1]
	MOVEM A,1(E)
	OUTPUT
	POPJ PP,

TUSPC:	CAIN C," "              ;TWO SPACES?
	JRST CHKTAB
	CAIN C,"\"
	HRROI C,74
	CAIN C,"@"
	HRROI C,76
	CAIN C,"*"
	JRST	TUSRET-1
	JUMPGE C,TUSRET
	MOVEI D,"="
	JUMPL C,.+2
	MOVEI D,"*"
	DPB C,1(E)
	IDPB D,1(E)
	AOJA F,TUSRT2

CHKTAB:	TRNN F,7		;ONE-SPACE TAB?
	JRST TUSRT2		;YES, IGNORE IT
	AOJA F,.+1
CHKTB1:	TRNN F,7		;END OF TAB?
	JRST TAB		;YES, GO INSERT TAB
	ILDB C,0
	CAIN C," "		;SPACE NEXT?
	AOJA F,CHKTB1		;YES, KEEP LOOKING
	MOVEM A,BUF1+1		;NO TAB
	ILDB D,A
	AOJA F,TULOOP+1
TAB:	MOVEI C,11		;INSERT TAB A& NULLS
	DPB C,BUF1+1
	MOVEI C,0
	IDPB C,BUF1+1
	CAME A,BUF1+1
	JRST .-2
	AOJA F,TULOOP


;GET A FREE BUFFER AND CLEAR TO 0'S

GBUF:	MOVEI E,BUF1		;BUFFER ADDRESS
	MOVSI A,(E)		;CLEAR IT
	HRRI A,1(E)
	SETZM (E)
	BLT A,3+^D18-1(E)
	POPJ PP,


SENDFF:	PUSHJ	PP,SETPAG
	JRST	MONEXIT

SETPAG:	PUSHJ	PP,GBUF		;GET A CLEAN BUFFER.
	PUSHJ	PP,SETUP	;INIT POINTER.
	MOVEI	C,FF		;SET UP FORMFEED
	PUSHJ	PP,TUSRT3-1	;AND TYPE IT OUT.
	MOVEI	B,1	;RESET LINE COUNTER(ITMLST ONLY)
	MOVEM	B,LINE
	POPJ	PP,	;RETURN TO INTERPRETER

FF==14
;SIMULATION OF JOSS DISK ROUTINES

DCONT:	HRRZ B,ACTION		;GET REQUEST
	CAILE B,5		;LEGAL?
	HALT START		;NO
	EXCH B,ACTION		;GET & RESET FIRST-TIME FLAG
	JRST .+1(B)
	HALT START
	JRST DDREAD
	JRST DDWRI
	JRST DDDEL
	JRST	ITMLST
	JRST DDOPEN

DDREAD:	TLNN B,1		;FIRST TIME?
	JRST DDRCNT		;NO
	PUSHJ PP,DDLOOK		;DO LOOKUP
	JRST DDLFAL		;NOT THERE
	INBUF 1,1
DDRCNT:	INPUT 1,		;READ A BLOCK
	MOVEI A,3		;NOT DONE FLAG
	STATZ 1,20000		;CHECK END OF FILE BIT
	JRST .+3		;ON
	SKIPLE DB+2		;CHECK BUFFER COUNT FOR END OF FILE
	JRST DDCHK		;NO
	MOVEI A,4		;YES.  SAY SO
	MOVSI B,(136B7)	;AND MAKE BFR LOOK EMPTY
	MOVEM B,BFR+1
DDCHK:	STATZ 1,740000		;ERRORS?
	MOVEI A,^D12		;YES.  SAY SO.
DDEXIT:	MOVEM A,RESULT		;TELL JOSS WHAT HAPPENED
	JRST MONEXIT

DDWRI:	TLNN B,1		;FIRST TIME TO WRITE?
	JRST DDWCNT
	PUSHJ PP,DDLOOK		;ALREADY THERE?
	JRST DDWRI2		;NO, SO OK
	MOVEI A,^D15		;YES, DONT ALLOW WRITE
	MOVE B,DDLK2		;GET DEVICE NAME
	CALLI B,4		;DEVCHR
	TLNE B,4		;IS IT A DIRECTORY DEVICE
	JRST DDEXIT

DDWRI2:	MOVEI A,1		;SUCCESS FLAG
	HLLZS	DIREN+1
	SETZM	DIREN+2		;MAKE SURE OF DATE.
	ENTER 1,DIREN
	MOVEI A,^D11		;TELL JOSS ABOUT ENTER FAIL
	OUTBUF 1,1		;SETUP OUTPUT BUFFER
	OUTPUT 1,		;DUMMY OUTPUT
	JRST DDEXIT

DDWCNT:	MOVEI 1,177		;SET TO WRITE 177 WORDS
	ADDM 1,DB+1
	OUTPUT 1,
DDCHK2:	MOVEI A,1		;SUCCESS FLAG
	SKIPE FLAG
	MOVEI A,2
	JRST DDCHK

DDLFAL:	MOVEI A,^D8		;LOOKUP FAIL
	JRST DDEXIT
DDOPEN:	MOVEI A,^D14		;OPEN ALWAYS SUCCEEDS
	JRST DDEXIT

DDDEL:	PUSHJ PP,DDLOOK		;LOOKUP BEFORE DELETING
	JRST DDLFAL		;AIN'T NONE
	SETZM DIREN		;SET UP FOR RENAME/DELETE
	MOVEI A,5
	RENAME 1,DIREN
	MOVEI A,^D12		;COULDNT DO IT
	JRST DDEXIT

DCOMP:	RELEAS 1,		;DISC ACTION COMPLETE
	JRST MONEXIT		;CLOSE FILE AND RETURN

;CONVERT FILE NAME AND DO LOOKUP

DDLOOK:	SKIPN C,KEY		;CONVERT FILE KEY TO SIXBIT DEVICE NAME
	MOVE C,[ASCII /DSK/]
	MOVEI A,6
DDLK1:	LSH C,1
	TLNE C,770000
	TLC C,400000
	LSHC C-1,6
	SOJG A,DDLK1
	MOVEM C-1,DDLK2
	MOVEI A,BFR-2		;SET UP FOR INBUF,OUTBUF
	MOVEM A,.JBFF
	MOVE A,FILE
	PUSHJ PP,CONVRT
	TLO A+2,616100
	MOVEM A+2,DIREN
	MOVE A,PROG
	PUSHJ PP,CONVRT
	TRC A+2,720000
	HRLZM A+2,DIREN+1
	OPEN	1,INITB
	HALT	.-1
	LOOKUP 1,DIREN
	POPJ PP,
	AOS (PP)
	POPJ PP,

;CONVERT DECIMAL NUMBER NNNN IN A TO SIXBIT FORM IN A+2

CONVRT: MOVSI C,440000
	IDIVI A,12
	ROTC A+1,-6
	JUMPGE B,CONVRT+1
	TDO A+2,[EXP 202020202020]
	POPJ PP,
; PRINT ITEM-LIST

ITMLST:	PUSHJ	PP,GBUF		;GET A CLEAN BUFFER
	PUSHJ	PP,SETUP	;INIT POINTER
	MOVE	A,HDPTR		;PRINT HEADING
	PUSHJ	PP,HDLOP	;PRINT 1ST LINE OF HEADING
	PUSHJ	PP,GBUF
	PUSHJ	PP,SETUP
	MOVE	A,HDPTR2
	PUSHJ	PP,HDLOP	;AND 2ND LINE OF HEADING

	SETZM	PROG
	HRREI	A,^D-26		;WILL LOOK FOR 25 ITEMS
	MOVEM	A,TESTIT
KLOP:	AOS	PROG
	AOSL	TESTIT
	JRST	DDCHK2		;DONE WITH ITEMS
	PUSHJ	PP,DDLOOK	;DO A LOOKUP
	JRST	KLOP		;DOESN'T EXIST, TRY NEXT ONE.
	PUSHJ	PP,LNPNT	;EXISTS, TELL ABOUT IT.
	AOS	B,LINE	;BUMP LINE COUNT.
	CAILE	B,PSIZE
	PUSHJ	PP,SETPAG	;SEND A FORMFEED.
	JRST	KLOP		;SEE WHAT'S NEXT.


HDLOP:	ILDB	A+1,A		;PICK UP TEXT A POINTS AT
	IDPB	A+1,1(E)	;AND PUT IT IN BUFFER.
	JUMPN	A+1,HDLOP
	JRST	TUSRT3		;PRINTS AND DOES POPJ.


PSIZE==^D54	;LINES PER PAGE.
LNPNT:	PUSHJ	PP,GBUF		;GET A CLEAN BUFFER
	PUSHJ	PP,SETUP	;INIT POINTER
	MOVE	A,PROG		;GET ITEM NUMBER
	PUSHJ	PP,NUMPNT	;CONVERT AND DEPOSIT IT.
	MOVNI	A,SPACNM	;WILL PUT IN THIS MANY SPACES
SPLOP:	MOVEI	A+1,40
	IDPB	A+1,1(E)
	AOJL	A,SPLOP
	LDB	A,[POINT 12,DIREN+2,35]		;GET LOW 12 BITS OF DATE
	LDB	A+1,[POINT 3,DIREN+1,20]	;GET HIGH 3 BITS OF DATE
	DPB	A+1,[POINT 3,A,23]		;MERGE THE TWO PARTS
	IDIVI	A,^D31	
	MOVE	C,A
	MOVE	A,A+1
	ADDI	A,1
	PUSHJ	PP,NUMPNT	;PRINT DAY

	MOVE	A,C
	IDIVI	A,^D12
	MOVE	C,MONPTR
	ADD	C,A+1		;GET TABLE ENTRY FOR THE MONTH
	HRREI	D,^D-5
PNTMON:	ILDB	B,C
	IDPB	B,1(E)		;PRINT "-MONTH-"
	AOJL	D,PNTMON
	ADDI	A,^D64
	PUSHJ	PP,NUMPNT	;PRINT YEAR
	MOVEI	A,CR
	IDPB	A,1(E)
	MOVEI	A,LF
	IDPB	A,1(E)		;END RECORD
	JRST	TUSRT3		;OUTPUT AND RETURN
				;WILL POPJ BACK TO THE LOOKUP LOOP!


CR==15
LF==12
SPACNM==12

MONPTR:POINT 7,MONLST-1,34

MONLST:	ASCII /-JAN-/
	ASCII /-FEB-/
	ASCII /-MAR-/
	ASCII /-APR-/
	ASCII /-MAY-/
	ASCII /-JUN-/
	ASCII /-JUL-/
	ASCII /-AUG-/
	ASCII /-SEP-/
	ASCII /-OCT-/
	ASCII /-NOV-/
	ASCII /-DEC-/



HDPTR:	POINT 7,.,34
	ASCIZ /    ITEM-LIST
/
HDPTR2:	POINT	7,.,34
	ASCIZ /ITEM         DATE
/
; THIS ROUTINE CONVERTS A NUMBER TO A TWO DIGIT DECIMAL AND INSERTS
; THE CHARACTERS IN THE TTY OUTPUT BUFFER. NUMBER IS IN A.

NUMPNT:	IDIVI	A,12
	ADDI	A+1,60
	PUSH	PP,A+1		;SAVE LOW DIGIT
	JUMPN	A,NOTZER
	MOVEI	A,40		; THERE IS NO FIRST DIGIT
	JRST	DONNUM
NOTZER:	IDIVI	A,12
	MOVEI	A,60(A+1)
DONNUM:	IDPB	A,1(E)		;FIRST CHARACTER
	POP	PP,A
	IDPB	A,1(E)		;SECOND DIGIT
	POPJ	PP,



;DUMP THE LITTERALS IN THE HIGH SEGMENT
	LIT

	SUBTTL IMPURE AREA OF AID

	RA=1
	ASF=3
	ASGN=2
	INTERNAL	P75.08
	INTERNAL	S79.01,P84.97,P90.04,P90.05,P91.03,P91.06
	INTERNAL	S83.99,S83.98,S83.97,S54.97,AS
	INTERNAL	S83.96,S83.95,S84.99,S84.98,S84.97


PH1C:
	DEC	8;		MAX:SET AND RESET BY S79
	DEC	200000000;	A LE 2.10*(-2)
	MOVEI	ASF,0
	MOVEI	ASF,0;		RESTORE ASF
	HRLZI	ASGN,0;		RESTORE SIGN
	HRLZI	ASGN,0;		RESTORE SIGN AND SF
	ASHC	RA,0;		SCALE AT 35
	HRLZI	ASGN,0;		RESTORE ASGN

OPENB:	EXP	10
	Z
	XWD	DB,DB

PH2C:	Z
	JRST	S86A
	Z
	JRST	P75A
	Z
	JRST	P78A
	Z
	JRST	P82A
	Z
	JRST	P77A
	Z
	JRST	P81A
	Z
	JRST	P80A

	Z
	JRST	S87A
	Z
	JRST	S75A
	Z
	JRST	S82A
	Z
	JRST	P76A
	Z
	JRST	S5450A

	Z
	JRST	P8530A

	Z
	JRST	S5455A
	Z
	JRST	S79A
	Z
	JRST	SR1A

PH3C:	Z
	JRST	P92A
	Z
	JRST	P93A
	Z;
	JRST	S61X;
	Z;
	JRST	S62X;
	Z;
	JRST	ERRX;
	Z
	JRST	S78A
	Z
	JRST	S83A
	Z
	JRST	S84A
	Z
	JRST	S81A
	Z
	JRST	S76A
	Z
	JRST	S77A
	Z
	JRST	P91A
	Z
	JRST	P79A
	Z
	JRST	P83A
	Z
	JRST	P84A
	Z
	JRST	P85A
	Z
	JRST	P90A
	Z
	JRST	P94A
	Z
	JRST	S80A


IFN PURESW,<
IFN SEG2SW,<RELOC>
IFE SEG2SW,< LOC 140 >>

LBEG:		;FIRST DATA WORD TO BE ZEROED
SXX:	BLOCK 1
S83.99:	BLOCK 1
S83.98:	BLOCK 1
S83.97:	BLOCK 1
S83.96:	BLOCK 1
S83.95:	BLOCK 1
S84.99:	BLOCK 1
S84.98:	BLOCK 1
S84.97:	BLOCK 1
INTERN	BFR, BUF1, BFRP,SAVPTR,SXX,LBEG
INTERN	TEMP, TESTIT,FORMFG,EFG,EFG1 
INTERN	INITB, DDLK2, T7.9, COMEBA, CT14, USERS 
INTERN	HR, MIN, SECOND
INTERN	IB, OB, DB, PLIST
INTERN	ACTION, FILE, FLAG, KEY, NAME, PROG
INTERN	 RESULT, RPN, TYPE 
S79.01:
S54.97:	BLOCK 1;		MAX:SET AND RESET BY S79
P84.97:	BLOCK 1	;		A LE 2.10*(-2)
P90.04:
	BLOCK 1
P91.06:	BLOCK 1
P91.03:	BLOCK 1
P90.05:	BLOCK 1
AS:	BLOCK 1
P75.08:	BLOCK 1

;FLAG AND COUNT CELLS FOR INTERPRETER TO USE
INTERN T7.9,COMEBACK,CT14,HR,MIN,SECOND,USERS

T7.9:	BLOCK 1			;COUNT OF ARITH OPERATIONS
COMEBA:	BLOCK 1			;COMEBACK FLAG
				;WHEN SET, INTERP CALLS MONITOR
CT14:	BLOCK 1			;COUNT OF STATEMENTS INTERPRETED
USERS:	BLOCK 1			;NO OF USERS ON (?)
HR:	BLOCK 1			;TIME OF DAY, HOUR PART
MIN:	BLOCK 1			;TIME OF DAY, MINUTE PART
SECOND:	BLOCK 1			;TIME OF DAY, SECOND PART

INTERN ACTION,BFR,BFRP,FILE,FLAG,KEY,NAME,PROG,RESULT,RPN,TYPE
INTERN STTIME

ACTION:	BLOCK 1
FILE:	BLOCK 1
FLAG:	BLOCK 1
KEY:	BLOCK 1
NAME:	BLOCK 1
PROG:	BLOCK 1
RESULT:	BLOCK 1
RPN:	BLOCK 1
TYPE:	BLOCK 1
IB:	BLOCK	3		;TTY BUFFER HEADERS
OB:	BLOCK	3
DB:	BLOCK	3		;DISK BUFFER HEADER
PLIST:	BLOCK 1
	BLOCK	20

SAVPTR:	BLOCK 1	;FOR PARENTHETICAL DO'S
EFG1:	BLOCK 1
STTIME:	BLOCK 1
EFG:	BLOCK 1
FORMFG:	BLOCK 1
TESTIT:	BLOCK 1

INITB:	BLOCK 1
DDLK2:	BLOCK 2
DIREN:	BLOCK 4
	BLOCK 2	;THESE TWO BLOCKS ARE NECESSARY
			;WITHOUT THEN THE DIRECTORY HEADER WILL BE FOULED
		;UP AND THE ERROR RETURN ON A LOOKUP WILL BE TAKEN

BFR:	BLOCK	^D15
BUF1:   BLOCK	3+^D18          ;JOSS TTY BUFFER
	BLOCK	177+BFR-.
BFRP:	BLOCK	1		;END OF DRM BUFFER
	BLOCK 1			;DUMMY 200'TH DATA WORD


TEMP:	BLOCK 1
EXTERN	S86A,P75A,P78A,P82A,P77A,P81A,P80A,S87A,S5460A
EXTERN	S75A,S82A,P76A,S5450A,P8530A,S5455A,S79A,SR1A
INTERN	S86,P75,P78,P82,P77,P81,P80
INTERN	S87,S75,S82,P76,S54.50,P85.30,S54.55,S79,SR1
S86:	BLOCK 2
P75:	BLOCK 2
P78:	BLOCK 2
P82:	BLOCK 2
P77:	BLOCK 2
P81:	BLOCK 2
P80:	BLOCK 2

S87:	BLOCK 2
S75:	BLOCK 2
S82:	BLOCK 2
P76:	BLOCK 2
S54.50:	BLOCK 2

P85.30:	BLOCK 2

S54.55:	BLOCK 2
S79:	BLOCK 2
SR1:	BLOCK 2

INTERN	P79.90,P79.91,P79.92,P79.89,P79.85,P79.86
INTERN	P79.87,P79.88,P80.97,P80.98,P80.99,P81.80
INTERN	P81.81,P81.82,P81.99,P82.80,P82.81,P82.82
INTERN	P82.90,P82.91,P82.92,P82.84,P83.94,P83.95
INTERN	P83.96,P83.97,P83.98,P83.99,P85.99,P85.98
INTERN	S75.93,S54.60,S54.98,S54.99,S80.98,S80.99
INTERN	S81.98,S85,S85.80,S85.81,S85.90,S85.95
INTERN	S85B,S85C,S85A,S85Y,S85M
P79.90:	BLOCK 1
P79.91:	BLOCK 1
P79.92:	BLOCK 1
P79.89:	BLOCK 1		;TEMP STORE
P79.85:	BLOCK 1		;RG
P79.86:	BLOCK 1		;RH
P79.87:	BLOCK 1		;RI
P79.88:	BLOCK 1		;RJ
P80.97:	BLOCK 1
P80.98:	BLOCK 1
P80.99:	BLOCK 1
P81.80:	BLOCK 1
P81.81:	BLOCK 1
P81.82:	BLOCK 1
P81.99:	BLOCK 1		;STORE FOR SIGN OF ARG
P82.80:	BLOCK 1
P82.81:	BLOCK 1
P82.82:	BLOCK 1
P82.90:	BLOCK 1
P82.91:	BLOCK 1
P82.92:	BLOCK 1
P82.84:	BLOCK 1 		; TEMP STORE FOR X(B-1)
P83.94:	BLOCK 1
P83.95:	BLOCK 1
P83.96:	BLOCK 1
P83.97:	BLOCK 1
P83.98:	BLOCK 1
P83.99:	BLOCK 1
P85.99:	BLOCK 1		;***TEMP STORE
P85.98:	BLOCK 1		;***ADJUSTED QUADRANT
S75.93:	BLOCK 1		;TEMP STORE FOR SF
S54.60:	BLOCK 1
	BLOCK 1	;	JRST	S5460A
S54.98:	BLOCK 1		;SAVE "PWR" REGISTER
S54.99:	BLOCK 1		;BYTE POINTER TEMPORARY STORE
S80.98:	BLOCK 1		;TEMP STORE FOR N1
S80.99:	BLOCK 1		;TEMP. STORE FOR PTR
S81.98:	BLOCK 1
S85:	BLOCK 1
S85.80:	BLOCK 1		;CONVERT MONTH,DAY,YR,TENS AND UNITS OF # RECS.
S85.81:	BLOCK 1		;PUT OUT SLASH
S85.90:	BLOCK 1		;DEPOSIT 3 SPACES
S85.95:	BLOCK 1		;PUT OUT NAME OR RPN
S85B:	BLOCK 1		;PTR TO OUTPUT BFR
S85C:	BLOCK 1		;LOCN OF USER DICT
S85A:	BLOCK 1		;ITEM #
S85Y:	BLOCK 1		;YEAR
S85M:	BLOCK 1		;MONTH
INTERN	SK1,SK2,SK3,SK4,SK5,SK6
INTERN	SK7,SK8,SK9,SK10,SK11,PK1
INTERN	PK2,PK3,PK4,PK5,PK6,PK7
INTERN	PK8,PK9,PK10,PK11,PK12,PK13
INTERN	PK14,PK15,PK16,PK17,PK18,PK19
INTERN	PK20,PK21,PK22,PK23,PK24,PK25
INTERN	PK26,PK27,PK28,PK29,PK30,PK31
INTERN	PK32,PK33,PK34,PK35,PK36,PK37
INTERN	PK38,PK39,PK40,T48,T49,T49X,JWSPDL
INTERN	SPARE,VEND


	SUBTTL;	STRING KRAPPIES
SK1:	BLOCK 1;	S54	POINTER TO LAST 'IF'
SK2:	BLOCK 1;	S54	POINTER TO LAST QUOTE-MARK
SK3:	BLOCK 1;	S54	INDEX OF BYTE BEFORE LAST 'IF'
SK4:	BLOCK 1;	S54	OUTPUT-POINTER HIDEOUT
SK5:	BLOCK 1;	S54	OUTPUT-BYTE-COUNT HIDEOUT
SK6:	BLOCK 1;	S52	ZERO IF NULL LINE
SK7:	BLOCK 1;	S52	POINTER TO LAST NON-BLANK BYTE
SK8:	BLOCK 1;
SK9:	BLOCK 1;
SK10:	BLOCK 1;
SK11:	BLOCK 1	;	XWD	41000,SK11;
	BLOCK	4;


	SUBTTL;	PROCESSOR KRAPPIES
PK1:	BLOCK 1;	P51	B1-REG. HIDEOUT
PK2:	BLOCK 1;	P51	B-REG. HIDEOUT
PK3:	BLOCK 1;	P51	B2-REG. HIDEOUT
PK4:	BLOCK 1;	P51	DIGITS TO LEFT OF DOT(SANS LEADING ZEROES)
PK5:	BLOCK 1;	P51	DIGITS TO RIGHT OF DOT
PK6:	BLOCK 1;	P51	NR. OF DIGITS
PK7:	BLOCK 1;	P55	BYTE-PTR. HIDEOUT
PK8:	BLOCK 1;	P56,P57	ADDRESS OF TREE TRUNK
PK9:	BLOCK 1;
PK10:	BLOCK 1;	P60,P64	HEIGHT OF TREE
PK11:	BLOCK 1;	P60	DESCRIPTOR HIDEOUT
PK12:	BLOCK 1;	P41,P44	DITTO
PK13:	BLOCK 1;	P41	BYTE-POINTER HIDEOUT
PK14:	BLOCK 1;	P40	DESCRIPTOR HIDEOUT
PK15:	BLOCK 1;	P39	S/MAGNITUDE OF ROV INCREMENT
PK16:	BLOCK 1;	P39	EXPONENT OF INC
PK17:	BLOCK 1;	P39	SIGN OF INC.
PK18:	BLOCK 1;	SP17/18	COMPARATOR FOR MAX/MIN
PK19:	BLOCK 1;	V1	TYPE OF RHS
PK20:	BLOCK 1;	V1	S/MAG. OF RHS
PK21:	BLOCK 1;	V1	EXP. OF RHS
PK22:	BLOCK 1;	P73	PART INDEX
PK23:	BLOCK 1;	P73	PART INDEX
PK24:	BLOCK 1;
PK25:	BLOCK 1;	V2,X51	CELL REQUIREMENTS
PK26:	BLOCK 1;
PK27:	BLOCK 1;	V2	USED VARIOUSLY
PK28:	BLOCK 1;
PK29:	BLOCK 1;	P71	PTR. TO FOR-CLAUSE
PK30:	BLOCK 1;	P71
PK31:	BLOCK 1;	P71
	PK32:	BLOCK 1;	P71
PK33:	BLOCK 1;	P71
PK34:	BLOCK 1;	P71
PK35:	BLOCK 1;	X52	1 TO ADVANCE STEP
PK36:	BLOCK 1;	P38	OBJECT-OF-DISCOURSE DESCRIPTOR
PK37:	BLOCK 1;
PK38:	BLOCK 1;
PK39:	BLOCK 1;	V3
PK40:	BLOCK 1;	V3
	SUBTTL	T48,T49,T49X -- SCRATCH TABLES
;	T48 IS USED VARIOUSLY FOR FORMULAS, ARRAYS, ...
T48:	BLOCK	13;
;	T49 IS USED MAINLY FOR ARRAYS - CONTAINS HEADERS
T49:	BLOCK	13;
;	T49X LIKE T49 BUT CONTAINS PREDECESSORS
T49X:	BLOCK 	13;
	BLOCK	10;	T48 MAY REQUIRE 40 SLOTS AT TIMES!
	SUBTTL	JWSPDL  --  PDP-6 PUSHDOWN STACK
	INTERNAL T61
T61:	BLOCK 1
JWSPDL:	BLOCK	24;
SPARE:






	INTERNAL	S62,S61,ERR,S78,S83,S84,S81,S76,S77
	INTERNAL	S80,P91,P79,P83,P84,P85,P90,P94
	EXTERNAL	P93A,P92A
	INTERNAL	P92,P93
	EXTERNAL	S62X,S61X,ERRX,S78A,S83A,S84A,S81A,S76A,S77A
	EXTERNAL	S80A,P91A,P79A,P83A,P84A,P85A,P90A,P94A
	SUBTTL	ENTRIES FOR JSR ROUTINES
P92:	BLOCK 2
P93:	BLOCK 2
S61:	BLOCK 2;
S62:	BLOCK 2;
ERR:	BLOCK 2;
S78:	BLOCK 2
S83:	BLOCK 2
S84:	BLOCK 2
S81:	BLOCK 2
S76:	BLOCK 2
S77:	BLOCK 2
P91:	BLOCK 2
P79:	BLOCK 2
P83:	BLOCK 2
P84:	BLOCK 2
P85:	BLOCK 2
P90:	BLOCK 2
P94:	BLOCK 2
S80:	BLOCK 2

	BLOCK 20
	SUBTTL;	USER'S BLOCK
	DEFINE	U(P)<INTERN P
P:	BLOCK 1>

U(INTENT);
USER0=INTENT		;***FIRST LOC OF USER AREA
U(SEQ);
U(INITIALS);
U(JOBNO);
U(PAGNO);
U(ONTIME);
U(COMTIM);
U(SPARE1);
U(SPARE2);
U(SPARE3);
U(SPARE4);
U(SPARE5);
U(RISIG)

U(UBUF);

U(ME);

U(RETURN);

U(WIDTH)

U(SIZE)

U(SPACE);

U(LINE);

U(USIZE);

U(UTIME);

U(UUSERS);

U(UMIN);

U(UMIN1);

U(USEC);

U(UCR);

U(UA1);

U(UA);

U(UA2);

U(UB1);

U(UB);

U(UB2);

U(UACL);

U(UDS);

U(UPS);

U(UCP);

U(UCC);

U(U0)

U(U1);

U(U2);

U(U3);

U(U4);

U(U5);

U(U6);

U(U7);

U(U8);

U(FPDL);

U(LEVEL)

U(US0);

	BLOCK	21;

	U(US1);

	BLOCK	26;

U(US2);

	BLOCK	26;

U(US3);

	BLOCK	5;

U(US4);

	BLOCK	10;

U(US5);

U(US6);

U(US7);

U(UP0);

U(UP1);

U(UP2);

U(UP3);

U(UP4);

U(UP5);

U(UP6);

U(UP7);

U(UP8);

U(UP9);

U(UP10);

U(UP11);

U(UP12);

	BLOCK	12;

U(UX1);

U(UX2);

U(UX3);

U(UX4);

U(TRUE);

	BLOCK 1

U(FALSE);

	BLOCK 1

U(PARTS);
	BLOCK 1

U(FORMS);

	BLOCK 1

U(MODE);

U(BASE)

U(JPDL);

U(JD);

U(U24);

U(U25);

U(CPI);

U(CSI);

U(CSA);

U(UDF1);

U(UDF2);

U(UBFR);

U(UFILE);

U(UKEY);

U(UNAME);

U(UITEM);

U(V);

	BLOCK	^D103;

VEND:	BLOCK	INTENT+^D1023-.;

	SYN	RISIG,RIF;
INTERN LEND,PH1C,PH2C,PH3C,OPENB
LEND:	END	START