.TITLE PDP11 LOGO

	FOO==VERNF
	VERN==%FNAM2
	FOO==VERNF
	.STITL CONFIGURATION PARAMTERS
	.IF1
	.PRINT /0=>FULL 1=>NO DEBUG 2=>QUERY
ASSSW=/
	.TTYMAC FLAG
	ASSSW=FLAG
	.ENDM

	.IFZ ASSSW
	DEBUG==1
	DISASS==1
	GCDBUG==1
	MNUSRS==10.
	MNSLTS==5
	.ENDC

	.IFZ <ASSSW-1>
	DEBUG==0
	DISASS==0
	GCDBUG==1	;ZERO LATER, BUT DOESN'T WORK YET
	MNUSRS==4
	MNSLTS==2
	.ENDC

	.IFZ <ASSSW-2>
	.MACR SETFLG FLG
	.PRINT /FLG=/
	.TTYMAC FLAG
	FLG==FLAG
	.ENDM
	.ENDM

	SETFLG DEBUG
	SETFLG DISASS
	SETFLG GCDBUG
	SETFLG MNUSRS
	SETFLG MNSLTS
	.ENDC
	.ENDC

	.MACR FOR FLG
	.XLIST
	.IFNZ FLG
	.LIST
	.ENDM

	.MACR ENDC FLG
	.XLIST
	.IFZ FLG
	.LIST
	.ENDC
	.LIST
	.ENDM

	.STITL SYSTEM PARAMETERS

A=%0
B=%1
C=%2
D=%3
E=%4
F=%5
U=%5
P=%6
SP=%6
PC=%7



ERROR=TRAP

RUG=100000	;DONT CHANGE THE S.A., RADIA!!
SKPRET==EMT

;DEVICE INFORMATION

;CONSOLE SWITCHES
SWB=177570	;CONSOLE SWITCH DATA
;CONSOLE TELETYPE
;BREAK LEVEL 4
TKBRV=60	;CONSOLE KEYBOARD BREAK VECTOR
TKS=177560	;CONSOLE KEYBOARD STATUS
TKB=177562	;CONSOLE KEYBOARD DATA
TPBRV=64	;CONSOLE PRINTER BREAK VECTOR
TPS=177564	;CONSOLE PRINTER STATUS
TPB=177566	;CONSOLE PRINTER DATA
;DM11
;BREAK LEVEL 5
DMRBRV=310	;DM11 RECEIVER BREAK VECTOR
DMTBRV=314	;DM11 TRANSMITTER BREAK VECTOR
DMCSR=175000	;DM11 CONTROL AND STATUS REGISTER
DMBAR=175002	;DM11 BUFFER ACTIVE REGISTER
DMBCR=175004	;DM11 BREAK CONTROL REGISTER
DMTBR=175006	;DM11 TABLE BASE REGISTER
;PROGRAMMABLE CLOCK
;BREAK LEVEL 6
PCBRV=104	;PROGRAMMABLE CLOCK BREAK VECTOR
PCS=172540	;PROGRAMMABLE CLOCK STATUS
PCSTBF=172542	;PROGRAMMABLE CLOCK SET BUFFER
PCCNT=172544	;PROGRAMMABLE CLOCK COUNTER
;RF11/RS11 DISK
;BREAK LEVEL 5
DSKBRV=204	;DISK BREAK VECTOR
DSKS=177460	;DISK STATUS REGISTER
DSKDBR=177472	;DISK DATA REGISTER
DSKWC=177462	;DISK WORD COUNT
DSKCA=177464	;DISK CURRENT ADDRESS
DSKA=177466	;DISK ADDRESS
DSKAE=177470	;DISK EXTENDED ADDRESS
DSKMT=177474	;DISK MAINTENCE(WELL...)
DSKSG=177476	;DISK SEGMENT
;TK DISPLAY
;BREAK LEVEL 7?
DISBRV=270	;DISPLAY BREAK VECTOR
NGCSR=164040	;DISPLAY CONTROL AND STATUS REGISTER
NGREL=164042	;DISPLAY RELOCATION REGISTER
;DC11 HIGH SPEED LIN INTERFACE
;BREAK LEVEL 5
DCRBRV=300	;RECIEVE BREAK VECTOR
DCRS=174000	;RECIEVE STATUS WORD
DCRB=174002	;RECIEVE BUFFER
DCTBRV=304	;TRANSMIT BREAK VECTOR
DCTS=174004	;TRANSMIT STATUS
DCTB=174006	;TRANSMIT BUFFER
;POWER FAIL
PFBRV=24
;BUS ERRORS
BEBRV=4
;TRAPS
TRPBRV=34
EMTBRV=30
IOTBRV=20
BPTBRV=14
PWFBRV=24
;EAE REGISTERS
DIVIDE=177300
AC=177302
MQ=177304
MULTIP=177306
SR=177310
EAESR==177311
NORMAL=177312
LGS=177314
ARS=177316
SIPRBT==2
MQZ==10
;PSSESOR STATUS
PS=177776
	.STITL ALLOCATION PARAMETERS

SYPDLL==100
TMPDLL==20
PPDLL==600
SPDLL==600
DBUFL==400
DDIRBL==400

DTIBFL==2000
DEDBFL==2000
DDIRL==2000

DWRTEC==103
DREADC==105
DWRTCC==107

FRTRCF==1
SWTRCF==2
SPTRCF==4
GCTRCF==10

FRSCED==1	;FLUSHED DUE TO SCEDULEING
FRDSKW==3	;HANGING ON DISK
FRTYIW==4	;HANGING ON TYI OF CHAR
FRTYOW==5	;HANGING ON FULL TYO BUFFER
FRRAND==6	;HANGING FOR "UNKNOWN" REASON
FRNEWU==7	;HANGING BECUASE HAVE NOT YET BEEN INITIALIZED
FRTYIH==10	;HANGING ON LINE INPUT
	.STITL MACROS
	.MACR PUSH AA
	MOV AA,-(P)
	JSR PC,PPUSHT
	.ENDM

	.MACR POP AA
	MOV (P)+,AA
	JSR PC,PPOPT
	.ENDM

	.MACR PUSHS AA
	JSR PC,SPUSHT
	MOV AA,@S
	.ENDM

	.MACR POPS AA
	MOV @S,AA
	JSR PC,SPOPT
	.ENDM

	.MACR SPUSH AA
	MOV AA,-(P)
	.ENDM

	.MACR SPOP AA
	MOV (P)+,AA
	.ENDM

	.MACR SPUSHS AA
	SUB #2,S
	MOV AA,@S
	.ENDM

	.MACR SPOPS AA
	MOV @S,AA
	ADD #2,S
	.ENDM

	.MACR TEXT AA
	.XLIST
	.ASCII \AA\
	.BYTE 0
	.EVEN
	.LIST
	.ENDM

	.MACR PRTXT AA
	.XLIST
	JSR PC,ERTAS
	TEXT ^\AA\
	.LIST
	.ENDM


	.MACR PRCR
	JSR PC,.CRLF
	.ENDM

	.MACR SPACE
	JSR PC,.SPACE
	.ENDM

	.MACR TIMER A
	JSR PC,.TIME
	.ENDM

	.MACR UNTIME A
	JSR E,.UTIME
	A
	.ENDM

	.MACR UTIMER A
	JSR PC,.TIME
	.ENDM

	.MACR UUNTIM A
	MOV #A,.+20
	ADD USER,.+12
	JSR E,.UTIME
	0
	.ENDM
	.MACR REPT1 A,B
	.XLIST
	.REPT A
	B
	.ENDR
	.LIST
	.ENDM
	.MACR REPT2 A,B,C
	.XLIST
	.REPT A
	B
	C
	.ENDR
	.LIST
	.ENDM


	.MACR NOP NUM
	.XLIST
	.IFG NUM
	BR .+<NUM*2>
	NOP <NUM-1>
	.ENDC
	.LIST
	.ENDM

	.MACR EXCH LOC1,LOC2
	MOV	LOC1,EXCH1
	MOV	LOC2,LOC1
	MOV	EXCH1,LOC2
	.ENDM

	.MACR PAD A,B
	.PRINT \A B\
	.ENDM
.STITL TRAP VECTORS


;TRAP VECTORS
;UNUSED VECTORS
.=0
	REPT2 100,.+2,IOT	;GO TO 2ND WORD OF VECTOR AND DIE

	.=TRPBRV
	ERRBK	;TRAP IS USED FOR ERRORS
	0

	.=TKBRV
	TKBRK	;CONSOLE TTY KEYBOARD
	200	;IS ON BR4

	.=TPBRV
	TPBRK	;CONSOLE TTY PRINTER
	200	;IS ON BR4

	.=PCBRV
	CLKBRK	;PROGRAMMABLE CLOCK
	300	;IS ON BR6

	.=DSKBRV
	DSKBRK	;FIXED HEAD DISK
	300	;IS ON BR5, INT ROUTINE RUNS ON LEVEL 6

	.=DISBRV
	DISBRK	;DISPLAY
	240	;???????????

	.=DMRBRV
	DMRBRK	;DM11 RECEIVE
	240	;?

	.=DMTBRV
	DMTBRK	;DM11 TRANSMIT
	240	;?

	.=IOTBRV
	IOTBRK
	340

	.=EMTBRV
	EMTBK
	340

	.=DCRBRV	;DC11 RECIEVE
	DCRBRK
	240

	.=DCTBRV	;DC11 TRANSMIT
	DCTBRK
	240
	.STITL SYSTEM VARIABLES(ONE COPY)


	.=400
	JMP START
	.=.+SYPDLL	;SYSTEM PDL
SPDLP:	.	;SYSTEM PDL POINTER
PAT:
PATCH:	.=.+200	;PATCH AREA
PATEND:
	.=770
LVERNF:	VERNF
.=<.!377>+1
	DMCA=.-NFDMTY
	.=.+40	;DM11 CURRENT ADDRESS
	DMWC=.-NFDMTY
	.=.+40	;DM11 -BYTE COUNT
	.=.+40	;DM11 BIT ASSEMBLY TABLE
	.=.+40	;UNUSED
DMTT:	.=.+200	;DM11 TUMBLE TABLE

TKBRK:	MOV TKB,CHI
	BIC #177600,CHI
	CMP CHI,BRKCHR
	BNE TKBRK1
	MOV	PC,BRAKE
TKBRK1:	RTI
TPBRK:	HALT
DISBRK:	HALT
DMRBRK:	HALT
DMTBRK:	HALT

TMPDLP:	TMPDL
TMPDL:	.=.+<TMPDLL*2>
ELAPSE:	0
	0
USER:	-1
ULAST:	0	;LAST USER WHO WAS RUN
NULTIM:	0
	0
TIME:	0	;TIME IN 1/100 TH'S OF A SEC
	0	;FROM START OF SYSTEM RUN
QUANT:	4	;UQUANT SET FRCM THIS
UQUANT:	0	;TIME IN 1/100THS USER SHOULD RUN
NRABLU:	0	;NUMBER OF USERS WITH FLSADR=0
NSWPU:	0	;NUMBER OF USERS ASSIGNED TO SLOTS BUT NOT YET IN
NINU:	0	;   "    "    "      "      "   "   AND ALREADY IN
PUSPSL:	0	;PREFERED USER SLOT TO SWAP
PUSRSP:	0	;PREFERED USER TO SWAP OUT
SWPLEP:	SWPLST	;PLACE TOO PUT NEXT REQ
SWPLST:	.=.+<MNSLTS*2>+2	;LIST OF SWAP REQUESTS
MSWPOR:	.=.+<16*MNSLTS*2>	;MOBY SWAP IN AND OUT BLOCKS
SYSWPR:	.=.+<16*MNUSRS>	;10 DISK REQUEST BLOCKS FOR GENERAL USE
DSKCRB:	0	;CURRENT DISK REQUEST
SLOTST:	.=.+<MNSLTS*4>	;WORD 1 = SLOT USER
			;WORD 2 = NEG, USER COMING IN; 1, USER JUST IN, >1 USER IN A WHILE
	0	;SO END TEST ALWAYS WORKS
	0

DKRTYS:	0	;# OF DISK RETRYS
CORTOP:	0	;FIRST NON-EX LOCATION
NUNODE:	0	;NUMBER OF NODES PER USER
NUSERS:	1	;NUMBER OF USERS
NSLOTS:	1	;NUMBER OF IN CORE SLOTS
NUSER2:	2
FOO==0
	.MACR MSWF
	MSWPOR+FOO
FOO==FOO+34
	.ENDM
SLTCAD:	REPT2 MNSLTS,MSWF,0
USWCNT:	0	;NEGATIVE LENGTH OF USER SLOT
USLENT:	0	;LENGHT OF SLOT IN BYTES
DUSECT:	0	;COUNT OF SYSTEM DISK USAGES MOD 256
DSKDST:	20000	;DISK OFFSET( NO USER OR SYSTEM CRAP BEFORE HERE)
	2
DCLRUS:	20000	;ADDRESS OF CLEAR USER IMAGE
	2
DCRBFS:	40000	;ADDRESS OF RECIEVE BUFFERS
	2
DCTBFS:	42000	;ADDRESS OF TRANSMIT BUFFERS
	2
DSKRND:	140000	;START OF RANDOM USER STORAGE
	2
SNXTDB:	100000	;NEXT BLOCK AVAILABLE
	2
SDSKAD:	100000	;BASE OF SYSTEM DISK BLOCKS
	2
SDBITB:	1	;SYSTEM DISK BIT TABLE
	REPT1 7,0
SDBITE:	100000
SFLAGS:	0	;RANDOM SYSTEM FLAGS
LOCKUS:	-1	;INDEX OF USER LOCKED IN CORE
GCLOCK:	-1	;USER USING GARBAGE COLLLECTOR IS LOCKED IN
CRMES:	.BYTE 15,0	;CR FOR ERTAP
RWWSW:	0
BRKCHR:	0	;THE BREAK CHAR FOR TODAY!
JDCSW:	0
;DISPLAY SYSTEM VARIABLES
DLEN==400	;LENGTH OF EACH DISPLAY LIST (IN BYTES)
DPDLL==60	;LENGTH OF EACH DISPLAY PDL (IN BYTES)
TLEN==20	;LENGTH OF EACH TURTLE LIST (IN BYTES)
SDPDLL==60*3	;TOTAL LENGTH OF DISPLAY PDL AREA (IN BYTES)
SDLEN==400*3	;TOTAL LENGTH OF DISPLAY LIST AREA (IN BYTES)
STLEN==20*3	;TOTAL LENGTH OF TURTLE LIST AREA (IN BYTES)

DCONS:		;USER DISPLAY CONSOLE TABLE
	.BYTE	0
	.BYTE	1
	.BYTE	2
	REPT1 5,.BYTE -1
SDISBT:		;EACH ENTRY HAS A 1 IN THE NTH BIT OVER
	.BYTE	1,2,4
	.EVEN

SDPDLP:		;DISPLAY PDL POINTER TABLE
	<DPDL-DISREL>+<DPDLL*<0+1>>
	<DPDL-DISREL>+<DPDLL*<1+1>>
	<DPDL-DISREL>+<DPDLL*<2+1>>
STLIST:		;TURTLE DISPLAY LIST  AREA TABLE
	REPT1	3,TLIST+<TLEN*.RPCNT>

;DISPLAY TEMPORARIES
;THESE MUST BE IN THIS ORDER
NEWX:	.WORD 0,0	;NEWX IS A TEMPORARY STORAGE FOR ROUTINES
;			LIKE SETXY. IT CONTAINS WHAT CURX WILL BE SET
;			TO IF THE ROUTINE DOESN'T
;			ENCOUNTER A FATAL ERROR
NEWY:	.WORD 0,0	;LIKE NEWX
;END OF ORDER
TUT:	0	;TURTLE TOP.  POINTS TO TOP OF TURTLE DISPLAY LIST
SNPTEM:	0	;USED BY GARBAGE COLLECTOR


EXCH1:	0
.CSRET==-127.
GCMKL:	TOPS
	TOPS1
	GCP1
	GCP2
	GCPREV
	0
	.STITL SYSTEM VARIABLES (ONE COPY PER USER)

UBLK=.
FLSRES:	0	;REASON USER NOT RUNNING
FLSADR:	0	;ADDRESS TO START AT AFTER FLUSH
UACA:	0
UACB:	0
UACC:	0
UACD:	0
UACE:	0
TIMUSD:	0
	0
UPC:	0	;PROGRAM COUNTER
UTTY:	0
BRAKE:	0
;DO NOT CHANGE THE ORDER BELOW
USWPAD:	.=.+4	;BEGINNING OF SWAP AREA
DTYIBF:	.=.+4	;BEGINING OF TYI BUFFER ON DISK
DEDTBF:	.=.+4	;BEGINNG OF EDIT BUFFER
DHDDIR:	.=.+4	;BEGINING OF DISK DIRECTORY(OF HOME DISK)
UNXTDB:	.=.+4	;NEXT DISK BLOCK AWAILABLE
UDSKAD:	.=.+4	;RANDOM DISK STORAGE AREA

LUBLK==.-UBLK
L==LUBLK

	.=.+<MNUSRS-1*LUBLK>
	;NODE TYPES
SFUN==000000
INFIX==10000
UFUN==20000
UVAR==30000
TYP1==40000
;THE FOLLOWING TYPES ARE NEEDED IN THIS ORDER BY THE CONVERT ROUTINES
SSTR==70000	;NOT VALID TOKEN TYPE
SNP==100000
ATOM==110000
SNUM==120000	;NOT A VALID TOKEN TYPE
LNUM==130000
LSTR==140000
RNUM==150000
LIST==170000
SENT==LIST
;END OF ORDER

	;BINDING TYPES
FBIND==20000
VBIND==30000
SFBIND==120000	;SWAPPED OUT FUNCTION BINDING
SVBIND==130000	;SWAPPED OUT  VARIABLE BINDING


	;SOE FLAGS SEE OLE MACRO STUFF
VNAF==2000

	;READ FLAGS SEE DTBL:
DOTF==400	;IN LEFT HALF
	;EVAL FLAGS - PUSHED BY PEVAL
PTLPF==1	;PREVIOUS TOKEN WAS LEFT PAREN
RTF==2	;REPEAT TOKEN
CRF==4	;CURRENT TOKEN IS CR
EDITF==10	;EDIT FLAG
TOF==20	;TO FLAG
IFF==40	;IF FLAG
TPTF==400	;THIS PROCEDURE TRACED FLAG	;MUST BE IN LEFT HALF

	;EVAL FLAGS2 - NOT PUSHED
TESTF==1
TRACEF==2
PQF==4		;PRINT QUOTE FLAG - FOR PRSTR
DPQF=10	;DONT " " "
MMF==20	;MULTIPLE MAKE FLAG
ERRF==40	;ERROR FLAG
DSAMFL==1000	;DISK ALMOST FULL
PPNAIF==2000	;P PDL NOT ALL THE WAY IN
SPNAIF==4000	;S PDL NOT ALL THE WAY IN

	;TEMP FLAGS IN TFLAGS
TF6==1
TF1==100	
TF2==200
TF3==400
TF4==10000
TF5==20000

	;FLAGS IN LEFT HALF OF 1ST NODE OF SWAPPED PROC LIST
; TPTF==400	DEFINED ABOVE
	.STITL USER VARIABLES

UVBLK=.
;BELOW RELATIVE TO BASE OF SLOT WHEN USER NOT RUNNING
UAB:	NODESP-SLOT1	;BASE OF CURRENT USER'S NODE SPACE
S:	IS-SLOT1
UPDLP:	IP-SLOT1	;USER PDL POINTER(ONLY WHEN USER NOT RUNNING)
SPOPL:	IS-SLOT1
SPUSHL:	IS-SLOT1-524
SSWPAD:	IS-SLOT1-400+4-2
SPBASE:	IS-SLOT1
SPRBAO:	IS-SLOT1	;SAME FOR S  :   S-SPRBAO = REL ADDR OF TOP THING ON S PDL
PPOPL:	IP-SLOT1
PPUSHL:	IP-SLOT1-524
PSWPAD:	IP-SLOT1-400+4-2
PPBASE:	IP-SLOT1
PRBAO:	IP-SLOT1	;PDL REL BASE ADDR OFFSET
SUHCT:	UHCT-SLOT1	;START OF USER HASH CODE TABLE
GCBITS:	DBUF-SLOT1
BASEUS:	0	;BASE OF USER SLOT(MUST BE LAST RELOCATED)
UVREND=.	;END OF VARIABLES TO BE RELOCATED
;BELOW ARE NOT RELATIVE
UAC:	0	;EAE AC
UMQ:	0	;EAE MQ
USR:	0	;EAE STATUS REGISTER
RELA==1
RELB==2
RELC==4
RELD==10
RELE==20
ACRELF:	0
NNGC:	0	;NUMBER OF NODES GARBAGE COLLECTED
ERRINA:	-1	;ADDRESS OF SWAPED IN ERROE ROUTINE
SSAVEA:	0	;PLACE S PDL SAVED WHEN MARKING SWAPED OUT PDL
	0
FREE:	SOFN	;START OF FREE NODES
TOPS:	0	;GC MARK FROM HERE IF NON 0
TOPS1:	0	;   "
GCP1:	0
GCP2:	0
GCPREV:	0
	;THE FOLLOWING ARE PUSHED BY PEVAL
CPP:	0	;CURRENT PROCEDURE POINTER
CPSN:	0	;C.P. SWAP NO.
CLN:	0	;CURRENT LINE NO.
CLP:	0	;CURRENT LINE POINTER - GOOD IF CPSN'S AGREE
CLGN:	0	;CURRENT LINE GENERATION NO.
CTN:	0	;CURRENT TOKEN NO.
CTP:	0	;CURRENT TOKEN POINTER
FUNLEV:	0	;FUNCTION LEVEL
IFLEV:	0	;IF LEVEL
FLAGS:	0	;FLAG WORD
CSPDLP:	0	;CURRENT S PDL PTR AFTER LAST PEVAL PUSH
CPDLP:	0	;CURRENT PDL PTR AFTER LAST PEVAL PUSH
	;END OF PEVAL PUSHES EXCEPT REL. S, CO AND CO+2 ARE ALSO PUSHED

	;THE FOLLOWING ARE PUSHED (SOMETIMES) BY EVAL
CO:	0	;CURRENT OPERATOR
	0
NOR:	0	;NO. OF OPERANDS STILL NEEDED BEFORE CO CAN BE EXECUTED
	;END OF EVAL PUSHES
COF:	0	;CURRENT OPERATOR FLAGS
LO:	0	;LAST OPERATOR
	0
CT:	0	;CURRENT TOKEN
	0	; "
RDFLAG:	0	;FOR READ
LISTBD:	0	;LIST BUILD DEPTH
PSTOPR:	0	;RETURN ADDR FOR PSTOP
UNGRAB:	0	;FOR .GRAB. PUTTING A NODE ADDR HERE MEANS THAT IT
		;WILL BE THE NEXT GRABBED.  GC WILL MARK FROM "UNGRAB"
		;USE WITH CAUTION!!
TEMP:	0
TFLAGS:	0	;TEMP FLAGS (ALL TFN'S SHOULD EVENTALLY POINT HERE)
NCHR:	0	;FOR BLST
TOPRNM:	0	;PTR TO UOE OF PROC. BEING "TO"'ED
FNLLP:	0	;FIRST NODE OF LIST OF LINE POINTERS (FOR "TO")
FLAGS2:	0	;EVAL FLAGS - NOT PUSHED BY PEVAL
ALTL:	0	;TEST LINE POINTER
LINENO:	0	;FOR TEST MODE
CHI:	0	;FOR TYI
PRMTCH:	'?	;PROMPT CHAR
GNCN:	0	;"GET NEXT CHAR" NODE
	0
NBKTS:	0	;FOR RDSTR
PCHR:	TYO	;PLACE WHERE OUTPUT CHARS GO (TYO, BLST, ...)
DBITTB:	.=.+40
DBITBE=.-2


;VARIABLES AND CONSTANTS FOR DISPLAY SYSTEM

;THESE MUST BE IN THIS ORDER
DORBEG==.	;MARKS BEGINNING OF THESE VARIABLES
CURX:	.WORD 0,0	;CURX = CURRENT X POSITION
;			THE FIREST WORD IS THE INTEGER PART
;			THE SECOND WORD IS THE FRACTION PART
CURY:	.WORD 0,0	;CURY = CURRENT Y POSITION
CURA:	0	;CURA = THE CURRENT ANGLE
OLDX:	0	;CONTAINS CURX AT THE TIME OF LAST NEW SNAP
OLDY:	0	;CONTAINS CURY AT THE TIME OF LAST NEW SNAP
OLDIR:	.BYTE 0	;CONTAINS DIREC WHEN DR.LIN LAST CALLED
DFLAGS:	.BYTE 0
	.EVEN

DOREND==.	;MARKS END OF THESE VARIABLES
;END OF ORDER

STB:	0	;STATIC AREA BOTTOM
STT:	0	;STATIC AREA TOP.POINTS TO TOP OF STATIC DISPLAY AREA
DYB:	0	;DYNAMIC BOTTOM.  POINTS TO BOT OF DY AREA
DYR:	0	;ROVING POINTER USED BY DISPLAY STORAGE ALLOCATIN ROUTINES
DYT:	0	;POINTER TO DYNAMIC AREA TOP
TUB:	0	;POINTER TO TURTLE AREA BOTTOM
SNLIST:	0	;POINTER TO SNAP LIST
SNABOT:	0	;BOTTOM OF CURRENT SNAP
SINA:	0	;CONTAINS SIN OF THE CURENT ANGLE
COSA:	0	;CONTAINS COS OF THE CURENT ANGLE
DIREC:	0	;CONTAINS DIRECTION CODE FRO CURRENT ANGLE
BYCNT:	0	;KEEPS TRACK OF LAST BIT IN DISPLAY LIST
PUSHJT:	0	;DISPLAY PUSHJ TO TURTLE
DISBIT:	0	;HAS A BIT SET CORRESPONDING TO DISPLAY SLOT


;THIS MUST BE AT THE END
MAXELN==60
ERRBUF:	.=.+MAXELN
LUVBLK==.-UVBLK


;DISPLAY COMMANDS
ADDX==150000
ADDY==144000
ADDXY==ADDX!ADDY
DPUSHJ==100000
DPOP==140200
DPOPJ==140100
DSTOP==140400
DRSTXY==143000	;RESET X AND Y TO 0

TURSIZ==4	;THE SIZE OF THE TURTLE

;FLAGS USED FOR DFLAGS
PENUF==1
HOOKF==2
HIDETF==4
TURTF==10
TEMF==20
	.STITL SYSTEM OBLIST

VARIABLE==4	;FOR VARIABLE NUMBER OF ARGUMENTS
$==-1	;DEFAULT INDICATOR IN OLE
YINFIX==20	;"YES INFIX" FLAG FOR OLE
;ARGUMENT TYPES
; 0 ==== ANYTHING
ANYT==0
ATOMT==1
WORDT==ATOMT	;A WORD IS THE SAME AS AN ATOM
NUMT==2
SENTT==4
SNAPT==10
LISTT==20
ANSLT==ATOMT+NUMT+SENTT+LISTT	;ALL BUT SNAP

;SOE FIELDS		1.==RIGHT BYTE (EVEN ADDR) 2.==LEFT BYTE
	;		1.1==RIGHT BIT  2.8==LEFT BIT
	;1.1-1.8 INPUT TYPE ACCEPTABLE BY THIS PROCEDURE
	;2.1-2.2 "STANDARD" NO. OF INPUT ARGS
	;2.3 VNAF 1==CAN TAKE "ANY" NO. OF ARGS
	;2.5 INFIX 1==THIS IS AN INFIX PROCEDURE
	;2.6-2.8 PRECEDENCE

	.MACR NGPTWO A
	.XLIST
	NGP2=NGP2*2
	FOO==A
	.IFLE NGP2-FOO
	NGPTWO A
	.ENDC
	.LIST
	.ENDM




;****************************************************
;MACRO TO DEFINE SYSTEM OBLIST ELEMENTS
;THE PARAMETERS ARE:
;1)	THE PRINT NAME
;2)	THE NAME OF THE POINTER TO THE OBLIST ELEMENT.
;	THIS PARAMETER CAN BE $ IF YOU DON'T CARE ABOUT THE
;	NAME, OR IF YOU WANT THE NAME TO BE $PNAME
;3)	THE ADDRESS OF THE PROGRAM
;	THIS PARAMETER CAN BE $ IF THE NAME OF THE PROGRAM
;	IS THE SAME AS THE PRINT NAME
;4)	THE PRECEDENCE.  A NUMBER FROM 0-7
;5)	THE TYPE OF PERMISSIBLE ARGUMENTS
;	IF IT CAN TAKE MORE THAN ONE KIND OF ARGUMENT
;	ADD UP ALL THE KINDS.  EG NUMT+LISTT+ATOMT
;6)	THE STANDARD NUMBER OF ARGUMENTS + THE SYMBOL "VARIABLE"
;	IF IT CAN ALSO TAKE A VARIABLE NUMBER OF ARGUMENTS
;7)	THE SYMBOL "YINFIX" IF THIS IS AN INFIX OPERATOR

;
;IMPORTANT IMPORTANT IMPORTANT IMPORTANT IMPORTANT IMPORTANT IMPORTANT

;ANY PARAMETER THAT YOU WANT TO BE 0 YOU CAN LEAVE OUT
;ANY PARAMETER YOU DON'T CARE ABOUT YOU CAN LEAVE OUT.



.MACR OLE PNAME,OBNAME,ADDR,PRECED,ARGTYP,NUMARG,QINFIX
	.XLIST
	OBX0=OBSTRT-.	;CHECK TO SEE THAT THE OBLIST DOESN'T
			;OVERWRITE THE OBLIST ELEMENTS
	.IF2
	.IFNDF OBNAME
	OBNAME=0	;TO AVOID UNDEFINED SYMBOL ERROR
	.ENDC
	.ENDC
	.IFG	OBX0
	OBADD2	;POINTER TO OBLIST ELEMENT
	OBADD1=.
	.=OBADD2
	.IFL OBNAME+0	;$ HAS BEEN DEFINED TO BE -1
	$'PNAME=.
	.ENDC
	.IFGE OBNAME+0
	$'OBNAME=.
	.ENDC


	.BYTE ARGTYP+0
	OBX1=NUMARG+0
	OBX2=PRECED+0*40
	.BYTE QINFIX+OBX1+OBX2

	.IFL ADDR+0
	PNAME	;ADDRESS OF PROGRAM
	.ENDC
	.IFGE ADDR+0
	ADDR+0
	.ENDC

	TEXT ^\PNAME\

	OBADD2=.
	.=OBADD1
	.ENDC

	.IFLE	OBX0
	.LIST
	********
	NUMOBS IS LESS THAN THE NUMBER OF SYSTEM OBLIST ELEMENTS.
	THEREFORE, YOU ARE OVERWRITING THE SYSTEM OBLIST
	********
	.XLIST
	.ENDC
	.LIST
.ENDM
	.MACR CDM A
A==<.-SOBLSU>/2
	.ENDM
;THE SYSTEM OBLIST
	;ADD ITEMS (EXCEPT FOR SPECIAL CHAR ITEMS) ALPHABETICALLY.


;****
NUMOBS==91.	;THE NUMBER OF OBLIST ELEMENTS
;****	WHENEVER YOU ADD AN OBLIST ELEMENT, MAKE SURE YOU INCREMENT
;****	NUMOBS !!!!!!
SOOMX:	2+SOBLSU	;2 > THAN HIGHEST ADDR USED IN SYS OBLIST
	NGP2==1
	NGPTWO SOBLSU-SOBLST+2
SOBP2:	NGP2	;( SMALLEST POWER OF 2 >= NUMOBS )*2
OBADD1=.
OBADD2=.+<2*NUMOBS>
OBSTRT=OBADD2	;WHERE THE SYSTEM OBLIST ELEMENTS START

SOBLST:	OLE AND,$
	OLE BACK,$,$,2,NUMT,1
	OLE BUTFIRST,$,$,2,ANYT,1
	OLE BUTLAST,$,$,2,ANYT,1
	OLE COUNT,$,$,2,ANYT,1
	OLE CTF,$,CLRSTF,2
	OLE DIFFERENCE,$,DIFF,2,NUMT,2
	OLE DISPLAY,$,$,2,LISTT+SNAPT,1
	OLE DO,$,$,2,,1
	OLE EDIT,$,$,2
	OLE ELSE,$,$,2
	OLE EMPTYP,$,$,2,ANYT,1
	OLE END,$,$,2
	OLE EQUAL,$,$,2,NUMT,2
	OLE ERASETRACE,$,ETRACE,2,,1
	OLE FIRST,$,$,2,ANYT,1
	OLE FORWARD,$,$,2,NUMT,1
	OLE FPRINT,$,$,2,,1+VARIABLE
	OLE FPUT,$,$,2,,2+VARIABLE
	OLE GO,$,$,2,NUMT,1
	OLE GREATER,$,GREATR,2,NUMT,2
	OLE HEADING,$,$,2
	OLE HERE,$,$,2
	OLE HIDETURTLE,$,$,2
	OLE HOME,$,$,2
	OLE IF,$,$,2,WORDT,1
	OLE KILLDISPLAY,$,$,2
	OLE LAMPOFF,LPOFF,$,2
	OLE LAMPON,LPON,$,2
	OLE LAST,$,$,2,ANYT,1
	OLE LEFT,$,$,2,NUMT,1
	OLE LESS,$,$,2,NUMT,2
	OLE LEVEL,$,FLEV,2
	OLE LIST,$,LIST.P,2,,2+VARIABLE
	OLE LISTP,$,$,2,,1
	OLE LPUT,$,$,2,,2+VARIABLE
	OLE MAKE,$,$,2,,2
	OLE MOD,$,$,2,NUMT,2
	OLE NEWSNAP,$,$,2
	OLE NUMBERP,$,NUMBP,2,ANYT,1
	OLE OF,$
	OLE OUTPUT,$,$,2,0,1
	OLE PENDOWN,$,$,2
	OLE PENUP,$,$,2
	OLE PRINT,$,$,2,ANSLT,1+VARIABLE
	OLE PRODUCT,$,PROD,2,NUMT,2+VARIABLE
	OLE QUOTIENT,$,DIVDE,2,NUMT,2
	OLE REQUEST,$,RQUEST,2
	OLE RIGHT,$,$,2,NUMT,1
	OLE RUG,$,RUNRUG
	OLE SENTENCE,$,$,2,ANYT,2+VARIABLE
	OLE SETHEADING,$,$,2,NUMT,1
	OLE SETTURTLE,$,$,2,SENTT,1
	OLE SETX,$,$,2,NUMT,1
	OLE SETXY,$,$,2,NUMT,2
	OLE SETY,$,$,2,NUMT,1
	OLE SHOW,$,$,2,,1
	OLE SHOWTURTLE,$,$,2
	OLE SNAP,$,$,2
	OLE STARTDISPLAY,$,$,2
	OLE STF,$,SETSTF,2
	OLE STOP,$,$,2
	OLE SUM,$,$,2,NUMT,2+VARIABLE
	OLE THEN,$,$,2
	OLE TO,$,$,2
	OLE TOOT,$,$,2,NUMT,1
	OLE TRACE,$,$,2,,1
	OLE TYPE,$,$,2,ANSLT,1+VARIABLE
	OLE VERSION,$,VERSN,2
	OLE WIPE,$,$,2,ATOMT+NUMT,1
	OLE WIPECLEAN,$,$,2
	OLE WORD,$,$,2,ANYT,2+VARIABLE
	OLE WORDP,$,$,2,ANYT,1
	OLE XCOR,$,$,2
SOBLSU:	OLE YCOR,$,$,2	;MUST BE ON LAST ENTRY BEFORE SINGLE CHAR ENTRIES
	OLE ^\!\,LLPAR,LLPAR,1,ANYT,1
	CDM HAS$
	OLE ^\#\,PROC,PROC,6,ATOMT,1
	CDM LP$
	OLE ^\(\,LPAR,LPAR,1,,1
	CDM RP$
	OLE ^\)\,RPAR,RPAR,1
	CDM PRD$
	OLE ^\*\,STAR,PROD,5,NUMT,2+VARIABLE,YINFIX
	CDM PLU$
	OLE ^\+\,PLUS,SUM,4,NUMT,2+VARIABLE,YINFIX
	OLE ^\+.\,UPLUS,UPLUS,6,NUMT,1
	CDM MIN$
	OLE ^\-\,MINUS,DIFF,4,NUMT,2,YINFIX
	OLE ^\-.\,UMINS,UMINS,6,NUMT,1
	CDM DIV$
	OLE ^\/\,SLSH,DIVDE,5,NUMT,2,YINFIX
	CDM DOTS$
	OLE ^\:\,DOTS,DOTS,6,ATOMT,1
	CDM LSS$
	OLE ^\<\,LESS,LESS,3,NUMT,2,YINFIX
	CDM EQL$
	OLE ^\=\,EQUAL,EQUAL,3,NUMT,2,YINFIX
	CDM GTR$
	OLE ^\>\,GRTR,GREATR,3,NUMT,2,YINFIX
	CDM BKSL$
;	OLE ^/^/,BKSL,MOD,5,NUMT,2,YINFIX

.=OBADD2

	.STITLE	DISPATCH TABLE (ENGLISH)
;FLAGS--
;FSF -- SPECIAL ON INPUT
;FOF -- SPECIAL ON OUTPUT
;FQF -- QUOTING CHARACTER
;SEPF -- SEPARATOR CHARACTER
;WSF -- WORD SEPARATOR
;NNUMF -- NOT A NUMBER
;OPERF -- OPERATOR

	;FLAGS--BYTE ONE		NUMBER--BYTE TWO
;	FSF FOF FQF SEPF WSF NNUMF OPERF	#
;^@	.   .   .   .    .   NNUMF .    	.
;^A	.   .   .   .    .   NNUMF .    	.
;^B	.   FOF .   .    .   NNUMF .    	0
;^C	FSF .   .   .    .   NNUMF .    	0
;^D	FSF .   .   .    .   NNUMF .    	2
;^E	.   .   .   .    .   NNUMF .    	.
;^F	.   .   .   .    .   NNUMF .    	.
;^G	FSF FOF .   .    .   NNUMF .    	4
;^H	.   FOF .   .    .   NNUMF .    	2
;^I	.   FOF .   SEPF WSF NNUMF .    	10
;^J	.   FOF .   SEPF WSF NNUMF .    	12
;^K	.   FOF .   SEPF WSF NNUMF .    	14
;^L	.   FOF .   SEPF WSF NNUMF .    	16
;^M	FSF FOF .   SEPF WSF NNUMF .    	6
;^N	FSF .   .   .    .   NNUMF .    	10
;^O	.   .   .   .    .   NNUMF .    	.
;^P	.   .   .   .    .   NNUMF .    	.
;^Q	FSF .   .   .    .   NNUMF .    	12
;^R	FSF .   .   .    .   NNUMF .    	14
;^S	FSF .   .   .    .   NNUMF .    	16
;^T	.   .   .   .    .   NNUMF .    	.
;^U	.   .   .   .    .   NNUMF .    	.
;^V	.   .   .   .    .   NNUMF .    	.
;^W	FSF .   .   .    .   NNUMF .    	20
;^X	FSF .   .   .    .   NNUMF .    	22
;^Y	FSF .   .   .    .   NNUMF .    	24
;^Z	FSF .   .   .    .   NNUMF .    	26
;^[	.   .   .   .    .   NNUMF .    	.
;^\	.   .   .   .    .   NNUMF .    	.
;^]	.   .   .   .    .   NNUMF .    	.
;^^	.   .   .   .    .   NNUMF .    	.
;^_	.   .   .   .    .   NNUMF .    	.

;SP	.   .   .   SEPF WSF NNUMF .    	.
;!	.   .   .   .    .   NNUMF .    	.
;"	.   .   .   SEPF .   NNUMF .    	.
;#	.   .   .   SEPF .   NNUMF OPERF	HAS$
;$	.   .   .   .    .   NNUMF .    	.
;%	.   .   .   .    .   NNUMF .    	.
;&	.   .   .   .    .   NNUMF .    	.
;'	.   .   .   SEPF .   NNUMF .    	.
;(	.   .   .   SEPF .   NNUMF OPERF	LP$
;)	.   .   .   SEPF .   NNUMF OPERF	RP$
;*	.   .   .   SEPF .   NNUMF OPERF	PRD$
;+	.   .   .   SEPF .   NNUMF OPERF	PLU$
;,	.   .   .   .    .   NNUMF .    	.
;-	.   .   .   SEPF .   NNUMF OPERF	MIN$
;.	.   .   .   .    .   NNUMF .    	.
;/	.   .   .   SEPF .   NNUMF OPERF	DIV$
;0	.   .   .   .    .   .     .    	.
;1	.   .   .   .    .   .     .    	.
;2	.   .   .   .    .   .     .    	.
;3	.   .   .   .    .   .     .    	.
;4	.   .   .   .    .   .     .    	.
;5	.   .   .   .    .   .     .    	.
;6	.   .   .   .    .   .     .    	.
;7	.   .   .   .    .   .     .    	.
;8.	.   .   .   .    .   .     .    	.
;9.	.   .   .   .    .   .     .    	.
;:	.   .   .   SEPF .   NNUMF OPERF	DOTS$
;;	.   .   .   SEPF .   NNUMF .    	.
;<	.   .   .   SEPF .   NNUMF OPERF	LSS$
;=	.   .   .   SEPF .   NNUMF OPERF	EQL$
;>	.   .   .   SEPF .   NNUMF OPERF	GTR$
;?	.   .   .   .    .   NNUMF .    	.

;@	.   .   .   .    .   NNUMF .    	.
;A	.   .   .   .    .   NNUMF .    	.
;B	.   .   .   .    .   NNUMF .    	.
;C	.   .   .   .    .   NNUMF .    	.
;D	.   .   .   .    .   NNUMF .    	.
;E	.   .   .   .    .   NNUMF .    	.
;F	.   .   .   .    .   NNUMF .    	.
;G	.   .   .   .    .   NNUMF .    	.
;H	.   .   .   .    .   NNUMF .    	.
;I	.   .   .   .    .   NNUMF .    	.
;J	.   .   .   .    .   NNUMF .    	.
;K	.   .   .   .    .   NNUMF .    	.
;L	.   .   .   .    .   NNUMF .    	.
;M	.   .   .   .    .   NNUMF .    	.
;N	.   .   .   .    .   NNUMF .    	.
;O	.   .   .   .    .   NNUMF .    	.
;P	.   .   .   .    .   NNUMF .    	.
;Q	.   .   .   .    .   NNUMF .    	.
;R	.   .   .   .    .   NNUMF .    	.
;S	.   .   .   .    .   NNUMF .    	.
;T	.   .   .   .    .   NNUMF .    	.
;U	.   .   .   .    .   NNUMF .    	.
;V	.   .   .   .    .   NNUMF .    	.
;W	.   .   .   .    .   NNUMF .    	.
;X	.   .   .   .    .   NNUMF .    	.
;Y	.   .   .   .    .   NNUMF .    	.
;Z	.   .   .   .    .   NNUMF .    	.
;[	.   .   FQF SEPF WSF NNUMF .    	0
;\	.   .   .   .    .   NNUMF .    	.
;]	.   .   FQF SEPF WSF NNUMF .    	2
;^	.   .   .   SEPF .   NNUMF OPERF	BKSL$
;_	.   .   .   SEPF .   NNUMF .    	.

;`	.   .   .   .    .   NNUMF .    	.
;a	.   .   .   .    .   NNUMF .    	.
;b	.   .   .   .    .   NNUMF .    	.
;c	.   .   .   .    .   NNUMF .    	.
;d	.   .   .   .    .   NNUMF .    	.
;e	.   .   .   .    .   NNUMF .    	.
;f	.   .   .   .    .   NNUMF .    	.
;g	.   .   .   .    .   NNUMF .    	.
;h	.   .   .   .    .   NNUMF .    	.
;i	.   .   .   .    .   NNUMF .    	.
;j	.   .   .   .    .   NNUMF .    	.
;k	.   .   .   .    .   NNUMF .    	.
;l	.   .   .   .    .   NNUMF .    	.
;m	.   .   .   .    .   NNUMF .    	.
;n	.   .   .   .    .   NNUMF .    	.
;o	.   .   .   .    .   NNUMF .    	.
;p	.   .   .   .    .   NNUMF .    	.
;q	.   .   .   .    .   NNUMF .    	.
;r	.   .   .   .    .   NNUMF .    	.
;s	.   .   .   .    .   NNUMF .    	.
;t	.   .   .   .    .   NNUMF .    	.
;u	.   .   .   .    .   NNUMF .    	.
;v	.   .   .   .    .   NNUMF .    	.
;w	.   .   .   .    .   NNUMF .    	.
;x	.   .   .   .    .   NNUMF .    	.
;y	.   .   .   .    .   NNUMF .    	.
;z	.   .   .   .    .   NNUMF .    	.
;{	.   .   .   .    .   NNUMF .    	.
;|	.   .   .   .    .   NNUMF .    	.
;}	.   .   .   .    .   NNUMF .    	.
;~	.   .   .   .    .   NNUMF .    	.
;RBO	FSF .   .   .    .   NNUMF .    	30

	.STITLE SYSTEM DISPATCH TABLE (BYTE ONE)

;FLAG DEFINITIONS
FSF==200	;SPECIAL INPUT
FOF==100	;SPECIAL OUTPUT
FQF==20		;QUOTING
SEPF==4		;SEPARATOR
WSF==2		;WORD SEPARATOR
NNUMF==40	;NOT A NUMBER
OPERF==10	;OPERATOR

DTBL:
.BYTE	NNUMF,NNUMF		;^@	;^A
.BYTE	FOF!NNUMF,FSF!NNUMF	;^B	ECHOES AS BLANK	;^C	COPYS NEXT CHARACTER
.BYTE	FSF!NNUMF,NNUMF		;^D	DELETES NEXT CHARACTER	;^E
.BYTE	NNUMF,FSF!FOF!NNUMF	;^F	;^G	BREAK
.BYTE	FOF!NNUMF,FOF!SEPF!WSF!NNUMF	;^H	BACKSPACE	;^I	TABULATE
.BYTE	FOF!SEPF!WSF!NNUMF,FOF!SEPF!WSF!NNUMF	;^J	LINE FEED	;^K	TABULATE VERTICALLY
.BYTE	FOF!SEPF!WSF!NNUMF,FSF!FOF!SEPF!WSF!NNUMF	;^L	FORM FEED	;^M	CARRIAGE RETURN	ECHOES AS CARRIAGE RETURN LINE FEED
.BYTE	FSF!NNUMF,NNUMF		;^N	GET NEXT WORD	;^O
.BYTE	NNUMF,FSF!NNUMF		;^P	;^Q	SUPER-QUOTE
.BYTE	FSF!NNUMF,FSF!NNUMF	;^R	COPY REST OF LINE	;^S	SKIP NEXT WORD
.BYTE	NNUMF,NNUMF		;^T	;^U
.BYTE	NNUMF,FSF!NNUMF		;^V	;^W	ERASE LAST WORD
.BYTE	FSF!NNUMF,FSF!NNUMF	;^X	CLARIFY INPUT	;^Y	EDIT PREVIOUS LINE
.BYTE	FSF!NNUMF,NNUMF		;^Z	DESTROY INPUT BUFFER	;^[	MAYBE ALTMODE
.BYTE	NNUMF,NNUMF		;^\	;^]
.BYTE	NNUMF,NNUMF		;^^	;^_	WELL, ANY BETTER IDEAS FOR THEM?
.BYTE	SEPF!WSF!NNUMF,NNUMF	;SP	;!	?????
.BYTE	SEPF!NNUMF,SEPF!NNUMF!OPERF	;"	;#	ACTION OF
.BYTE	NNUMF,NNUMF		;$	;%
.BYTE	NNUMF,NNUMF!OPERF	;&	;'	(MAYBE LE)
.BYTE	SEPF!NNUMF!OPERF,SEPF!NNUMF!OPERF	;(	ARITHMETIC GROUPING	;)	DITTO
.BYTE	SEPF!NNUMF!OPERF,SEPF!NNUMF!OPERF	;*	MULTIPLY	;+	ADD
.BYTE	NNUMF,SEPF!NNUMF!OPERF	;,	;-	SUBTRACT
.BYTE	NNUMF,SEPF!NNUMF!OPERF	;.	;/	DIVIDE
.BYTE	0,0	;0	;1
.BYTE	0,0	;2	;3
.BYTE	0,0	;4	;5
.BYTE	0,0	;6	;7
.BYTE	0,0	;8.	;9.
.BYTE	SEPF!NNUMF!OPERF,SEPF!NNUMF	;:	THING OF	;;	PROPERTY OF
.BYTE	SEPF!NNUMF!OPERF,SEPF!NNUMF!OPERF	;<	;=
.BYTE	SEPF!NNUMF!OPERF,NNUMF	;>	;?
.BYTE	NNUMF,NNUMF		;@	;A
.BYTE	NNUMF,NNUMF		;B	;C
.BYTE	NNUMF,NNUMF		;D	;E
.BYTE	NNUMF,NNUMF		;F	;G
.BYTE	NNUMF,NNUMF		;H	;I
.BYTE	NNUMF,NNUMF		;J	;K
.BYTE	NNUMF,NNUMF		;L	;M
.BYTE	NNUMF,NNUMF		;N	;O
.BYTE	NNUMF,NNUMF		;P	;Q
.BYTE	NNUMF,NNUMF		;R	;S
.BYTE	NNUMF,NNUMF		;T	;U
.BYTE	NNUMF,NNUMF		;V	;W
.BYTE	NNUMF,NNUMF		;X	;Y
.BYTE	NNUMF,FQF!SEPF!WSF!NNUMF	;Z	;[
.BYTE	NNUMF,FQF!SEPF!WSF!NNUMF	;\	LOGICAL OR	;]
.BYTE	SEPF!NNUMF!OPERF,SEPF!NNUMF	;^	EXPONENTIATE, MAYBE	;_	MAKE
.BYTE	NNUMF,NNUMF		;`	GRAVE ACCENT. LOOK THAT UP ON YOUR TELTERM.	;a	LOWER CASE
.BYTE	NNUMF,NNUMF		;b	LOWER CASE	;c	LOWER CASE
.BYTE	NNUMF,NNUMF		;d	LOWER CASE	;e	LOWER CASE
.BYTE	NNUMF,NNUMF		;f	LOWER CASE	;g	LOWER CASE
.BYTE	NNUMF,NNUMF		;h	LOWER CASE	;i	LOWER CASE
.BYTE	NNUMF,NNUMF		;j	LOWER CASE	;k	LOWER CASE
.BYTE	NNUMF,NNUMF		;l	LOWER CASE	;m	LOWER CASE
.BYTE	NNUMF,NNUMF		;n	LOWER CASE	;o	LOWER CASE
.BYTE	NNUMF,NNUMF		;p	LOWER CASE	;q	LOWER CASE
.BYTE	NNUMF,NNUMF		;r	LOWER CASE	;s	LOWER CASE
.BYTE	NNUMF,NNUMF		;t	LOWER CASE	;u	LOWER CASE
.BYTE	NNUMF,NNUMF		;v	LOWER CASE	;w	LOWER CASE
.BYTE	NNUMF,NNUMF		;x	LOWER CASE	;y	LOWER CASE
.BYTE	NNUMF,NNUMF		;Z	LOWER CASE	;LEFT BRACE
.BYTE	NNUMF,NNUMF		;VERTICAL BAR	;RIGHT BRACE
.BYTE	NNUMF,FSF!NNUMF		;TILDE	;RUBOUT

	.STITLE SYSTEM DISPATCH TABLE (BYTE TWO)
;NUMBERS POINT TO OTHER TABLES
;$ POINTS TO SYSTEM OBLIST

DTBL2:
.BYTE	0,0		;^@				;^A
.BYTE	0,0		;^B	ECHOES AS BLANK		;^C	COPYS NEXT CHARACTER
.BYTE	2,0		;^D	DELETES NEXT CHARACTER	;^E
.BYTE	0,4		;^F				;^G	BREAK
.BYTE	2,10		;^H	BACKSPACE		;^I	TABULATE
.BYTE	12,14		;^J	LINE FEED		;^K	TABULATE VERTICALLY
.BYTE	16,6		;^L	FORM FEED		;^M	CARRIAGE RETURN	ECHOES AS CARRIAGE RETURN LINE FEED
.BYTE	10,0		;^N	GET NEXT WORD		;^O
.BYTE	0,12		;^P				;^Q	SUPER-QUOTE
.BYTE	14,16		;^R				;^S	SKIP NEXT WORD
.BYTE	0,0		;^T	;^U
.BYTE	0,20		;^V	;^W	ERASE LAST WORD
.BYTE	22,24		;^X	CLARIFY INPUT	;^Y
.BYTE	26,0		;^Z	DESTROY INPUT BUFFER	;^[	MAYBE ALTMODE
.BYTE	0,0		;^\	;^]
.BYTE	0,0		;^^	;^_	WELL, ANY BETTER IDEAS FOR THEM?
.BYTE	0,0		;SP	;!	?????
.BYTE	0,HAS$		;"	;#	ACTION OF
.BYTE	0,0		;$	;%
.BYTE	0,0		;&	;'	(MAYBE LE)
.BYTE	LP$,RP$		;(	ARITHMETIC GROUPING	;)	DITTO
.BYTE	PRD$,PLU$	;*	MULTIPLY	;+	ADD
.BYTE	0,MIN$		;,	;-	SUBTRACT
.BYTE	0,DIV$		;.	;/	DIVIDE
.BYTE	0,0		;0	;1
.BYTE	0,0		;2	;3
.BYTE	0,0		;4	;5
.BYTE	0,0		;6	;7
.BYTE	0,0		;8.	;9.
.BYTE	DOTS$,0		;:	THING OF	;;	PROPERTY OF
.BYTE	LSS$,EQL$	;<	;=
.BYTE	GTR$,0		;>	;?
.BYTE	0,0		;@	;A
.BYTE	0,0		;B	;C
.BYTE	0,0		;D	;E
.BYTE	0,0		;F	;G
.BYTE	0,0		;H	;I
.BYTE	0,0		;J	;K
.BYTE	0,0		;L	;M
.BYTE	0,0		;N	;O
.BYTE	0,0		;P	;Q
.BYTE	0,0		;R	;S
.BYTE	0,0		;T	;U
.BYTE	0,0		;V	;W
.BYTE	0,0		;X	;Y
.BYTE	0,0		;Z	;[
.BYTE	0,2		;\	LOGICAL OR	;]
.BYTE	BKSL$,0		;^	TEMPORARILY MODULO (MAYBE EXPONENTIATE)	;_	MAKE
.BYTE	0,0		;`	GRAVE ACCENT. LOOK THAT UP ON YOUR TELTERM.	;a	LOWER CASE
.BYTE	0,0		;b	LOWER CASE	;c	LOWER CASE
.BYTE	0,0		;d	LOWER CASE	;e	LOWER CASE
.BYTE	0,0		;f	LOWER CASE	;g	LOWER CASE
.BYTE	0,0		;h	LOWER CASE	;i	LOWER CASE
.BYTE	0,0		;j	LOWER CASE	;k	LOWER CASE
.BYTE	0,0		;l	LOWER CASE	;m	LOWER CASE
.BYTE	0,0		;n	LOWER CASE	;o	LOWER CASE
.BYTE	0,0		;p	LOWER CASE	;q	LOWER CASE
.BYTE	0,0		;r	LOWER CASE	;s	LOWER CASE
.BYTE	0,0		;t	LOWER CASE	;u	LOWER CASE
.BYTE	0,0		;v	LOWER CASE	;w	LOWER CASE
.BYTE	0,0		;x	LOWER CASE	;y	LOWER CASE
.BYTE	0,0		;z	LOWER CASE	;{	OPEN BRACE
.BYTE	0,0		;|	VERTICAL BAR, MAYBE OR, MAYBE XOR	;}	CLOSE BRACE
.BYTE	0,30		;~	TILDE, LOGICAL NOT	;RBO	RUBOUT????
	.STITL LOSS CHECKING ROUTINES

IOTBRK:	INC #-4
LOSSCT=.-2
	BGT LOSER
	SPUSH A
	SPUSH USER
	MOV #-1,USER
	PRCR
	PRTXT ^/BAD TRAP--VECTOR /
	MOV 6(SP),A
	SUB #4,A	;MAKE IT REAL
	CMP #BEBRV,A	;IS IT A BUS ERROR?
	BEQ BUSSER
	JSR PC,PRON
	PRTXT ^/ TRAPPED FROM /
	MOV 12(SP),A
	JSR PC,PRON
	PRCR
	SPOP USER
	SPOP A
	ADD #4,SP
	RTI
EMTBRK:	HALT
BUSSER:	PRTXT ^/BUSS ERROR!!!/
LOSER:	PRTXT ^/I GIVE UP!!/
	HALT
	BR .-2
	.STITL DISK STARTER



DSKSRT:	MOV #DCRDRB,A	;CHECK FOR DC11 RECIEVE FIRST
	TST 14(A)
	BNE DSKSGO
	MOV #SYSWPR,A	;NEXT LOOK AT SYSTEM REQUESTS
DSKSR1:	TSTB 14(A)	;IS THE FUNCTION NON ZERO?
	BNE DSKSGO	;FOUND A REQUEST, GO DO IT
	ADD #16,A	;LOOK AT NEXT BLOCK
	CMP #16*MNUSRS+SYSWPR,A	;LAST BLOCK?
	BGT DSKSR1
	MOV SWPLST,A	;MOOBY SWAP OUT REQS?
	BNE DSKSGO
	CLR DSKS
	RTS PC	;NO DISK REQUESTS EXTANT, BETTER LUCK NEXT TIME

DSKSGO:	MOV A,DSKCRB	;ADDRESS OF BLOCK ABOUT TO BE SERVICED
	MOV (A),B
	BEQ .+4	;BRANCH IF NO
	JSR PC,(B)	;RUN START ROUTINE
DSKSG1:	TST (A)+
	MOV #DSKWC,B	;START OF DISK I/O WORDS
	MOV (A)+,(B)+	;WORD COUNT
	MOV (A)+,(B)	;CORE ADDRESS
	ADD #2,(B)+	;GODFORSAKEN DEC!!!!!
	MOV (A)+,(B)+	;LOW ORDER DISK ADDRESS
	MOV (A)+,(B)+	;HIGH "      "     "
	TST (A)+	;GO PAST UNUSED WORD
	MOVB (A),DSKS	;SET FUCTION, ENABLE INTERUPT, GO!!
	RTS PC


DPROVK:	SPUSH PS
	MOV #340,PS
	CMP #200,DSKS	;IF THE INTERUPT IS OFF AND THE DISK IS READY
	BNE DSKSG2	;PROVOKE IT; OTHERWISE LEAVE IT FOR SOMEONE ELSE
	SPUSH A
	SPUSH B
	JSR PC,DSKSRT
	SPOP B
	SPOP A
DSKSG2:	SPOP PS
	RTS PC
.STITL DISK REQUEST BLOCK GRABBER

SYDRBG:	SPUSH PS	;SAVE OLD PROSSESOR LEVEL
	MOV #340,PS	;LOCK OUT INTERUPTS
	MOV #SYSWPR,A	;LOOK FOR A FREE SYSTEM DISK REQUEST BLOCK
SDRBG1:	TST 14(A)	;IS IT FREE?
	BEQ SDRBG2
	ADD #16,A	;LOOK AT NEXT ONE
	CMP #16*MNUSRS+SYSWPR,A	;ANY MORE?
	BGT SDRBG1	;YES, SEE IF FREE
	SPOP PS	;NO MORE, WE HAVE LOST BIG
	WAIT	;THIS WILL PROBABLY NOT DO ANY GOOD
	BR SYDRBG	;AND CERTAINLY WON'T UNLESS OUR PRIORITY IS <5
SDRBG2:	MOV DUSECT,14(A)	;LABEL BLOCK AS IN USE, BUT NO REQUEST
	INCB DUSECT+1	;SO PEOPLE CAN DISTINGUISH
	SPOP PS	;YOU CAN INTERUPT NOW.
	RTS PC


;USER ROUTINE TO FLUSH UNTIL DISK REQUEST POINTED TO BY A DONE

DSKWA2:	ADD #14,A
DSKWAI:	MOV USER,U
	MOV (A),B
DSKWA1:	CMP B,(A)
	BEQ DNDONE
	JSR PC,RUNME
	RTS PC
DNDONE:	MOV #FRDSKW,FLSRES(U)
	JSR PC,FLUSH
	BR DSKWA1

UBLKGR:	MOV #DBITTB,A	;USERS BIT TABLE ADDR
	MOV #DBITBE,B
	MOV #UNXTDB,D	;POINTER TO ADDR OF NEXT AWAILABLE BLOCK
	ADD USER,D
	MOV #DBITBE,E	;END OF USERS BIT TABLE
	CLR F	;DISK ISN'T NEARLY FULL
	BIT #DSAMFL,FLAGS2	;IS THE DISK ALLMOST FULL?
	BEQ .+4	;NO
	INC F	;YES
	JSR PC,BLKGRB	;GO DO GOOD THINGS
	RTS PC	;DISK REALLY FULL
	TST F	;IS DISK NEARLY FULL?
	BEQ UBLKG1	;NO, SKIP RETURN
	BIS #DSAMFL,FLAGS2	;YES WARN THE WORLD.
UBLKG1:	JMP SRET	;WIN ANYWAY, SKIP RETURN

UBLKFR:	MOV #DBITTB,E
	MOV USER,B
	MOV UDSKAD(B),D
	JSR PC,BLKFRE
	BIC #DSAMFL,FLAGS2	;DISK NOW SURELY HAS A FREE BLOCK
	RTS PC

;GRABS A DISK BLOCK AND A REQUEST BLOCK
;REQUEST BLOCK ADDR RETURNS IN A
;DISK BLOCK ADDR RETURNS IN B AND C
;ARGS:  BEGINNING OF BIT TABLE IN A
;END OF BIT TABLE IN B
;ADDR OF NEXT BLOCK WORDS IN D
;DISK ALMOST FULL FLAG IN F
BLKGRB:	CLR C
BLKGR3:	MOV #1,E
BLKGR2:	BIT E,(A)	;IS THIS BLOCK FREE?
	BEQ BLKGR5	;YES, PRAISE THE LORD!
	INC C	;NO, TRY THE NEXT BLOCK
	ASL E
	BCC BLKGR2	;NO OVERFLOW?
	TST (A)+	;NEXT WORD
	CMP A,B	;AT END OF THE TABLE
	BLE BLKGR3	;CONTINUE
	TST F	;NO BLOCK AVAILABLE, ARE WE REAL FULL?
	BEQ BLKGR4	;NO, BUT CLOSE
	RTS PC	;YES, VERY FULL
BLKGR4:	INC F	;DISK ALMOST FULL
	BR BLKGR6
BLKGR5:	BIS E,(A)	;THAT BLOCK IS NO LONGER FREE
	CLR F	;AND THE DISK  ISN'T NEARLY FULL
BLKGR6:	JSR PC,SYDRBG	;GET A DISK REQUEST BLOCK
	MOV #-200,2(A)	;ALL BLOCKS ARE THIS LONG
	MOV (D),6(A)	;NEXT AVAILABLE BLOCK
	MOV 2(D),10(A)
	SPUSH (D)
	SPUSH 2(D)
	SWAB C	;MULTIPLY BY 200
	ASR C
	BIC #100000,C
	MOV 6(D),2(D)	;LOW ORDER BASE ADDR
	ADD 4(D),C	;LOW ORDER BASE ADDR
	ADC 2(D)
	MOV C,(D)
	SPOP C
	SPOP B
	JMP SRET

;FREES THE DISK BLOCK WHOSE LOW ORDER ADDR IS IN C
;BASE OF THIS DISK SPACE IS IN D
;ADDRESS OF THE APPRPRIATE BIT TABLE IS IN E
BLKFRE:	SUB D,C	;RELOCATE DISK ADDR RELATIVE TO ZERO
	MOV #1,B
	BIT #177,C
	BEQ .+4
	HALT
BLKFR1:	BIT #3777,C	;IS ADDR DIVISABLE BY 20*200?
	BEQ BLKFR2	;YES
	SUB #200,C	;NO, TRY TO MAKE IT BE
	ASL B	;AND GET "REMAINDER" IN B
	BR BLKFR1
BLKFR2:	SWAB C	;DIVIDE BY 400
	ASR C	;BY 2
	ASR C	;BY 2=>DIVIDED BY 400*2*2=2000=4000/2
	ADD C,E	;GET POINTER INTO BIT TABLE
	BIC B,(E)	;AND FREE THE BLOCK
	RTS PC
	.STITL DISK INTERUPT ROUTINE


DSKBRK:	SPUSH A
	SPUSH B
	BIT #100000,DSKS	;ANY ERROR BITS SET?
	BNE DSKLOS	;BITE   THE BAG!
	MOV DSKCRB,A	;POINTER TO FUNCTION WORD
	CLR 14(A)	;REQUEST HAS BEEN SERVICED
	MOV (A),B
	BEQ .+4	;NO
	JSR PC,(B)	;YES, GO DO IT
	CLR (A)
DSKRTY:	JSR PC,DSKSRT	;LOOK FOR SOMETHING ELSE TO DO
DSKRET:	SPOP B
	SPOP A
	RTI

DSKLOS:	HALT	;DISK LOST BIG
	MOV #400,DSKS	;POWER CLEAR IT
	HALT	;GIVE IT A CHANCE
	BR DSKRTY	;TRY AGAIN(EVENTUALLY)
	.STITL SCHEDUALER


RUNME:	TST USER
	BGE RUNME1
RUNME2:	RTS PC	;SYSTEM CALLED RUNME
RUNME1:	TST FLSADR(U)	;IF HE WANTS TO RUN HE SHOULD JSR HERE
	BEQ RUNME2	;IF FLSADR IS ZERO, JUST KEEP RUNNING HIM
	MOV #-1,USER	;SYSTEM IS NOW USER
	JSR PC,UACSAV	;STORE HIS ACS
	CLR FLSADR(U)	;GUY IS NOW RUNABLE
	CLR FLSRES(U)
	INC NRABLU
	SPOP UPC(U)	;HE SHOULD START AFTER THE JSR PC,RUNME
NEXTU1:	MOV #SLOTST,A	;TRY TO RUN USER IN U
NEXTU2:	CMP U,(A)+	;IS HE ASSIGNED A SLOT IN CORE?
	BNE NEXTU3	;NOT THIS ONE, ANYWAY
	TST (A)	;IS HE ALL THE WAY IN?
	BLT NEXTUS	;NO CAN'T RUN HIM YET
	BEQ NEXTU3
	CMP #FRNEWU,FLSRES(U)
	BNE NEXT14
	MOV #UGO,FLSADR(U)
	TST RWWSW
	BNE NEXT15
	MOV SLTCAD-SLOTST-2(A),C
	MOV #16,D
	JMP NEXT11
NEXT14:	CLR FLSRES(U)
	JMP RUNUSR



;CALL TO GET INDEX OF NEXT USER TO RUN

NEXTUS:	SUB #LUBLK,ULAST	;COUNT BACKWARDS
	BGE .+10	;DON'T GO NEG
	MOV #<MNUSRS-1>*LUBLK,ULAST	;LAST POSSIBLE USER INDEX
	MOV ULAST,U	;SEE IF THIS IS A GOOD GUY TO RUN
NEXT15:	CMP #FRTYIH,FLSRES(U)
	BEQ NEXTUS
	TST FLSADR(U)	;IF FLSADR IS ZERO, RUNABLE(???)
	BEQ NEXTU1	;RUN HIM.
	BLT NEXTUS	;NEG=>NON EX USER
	MOV U,USER	;USER IS NOW USER
	JSR PC,UACRES	;RESTORE HIS ACS
	JMP @FLSADR(U)	;SEE IF HE SHOULD REALLY RUN



NEXTU3:	TST (A)+	;EXTANT CORE SLOT?
	BNE NEXTU2	;YES, CHECK NEXT ONE
	MOV PUSPSL,A	;SEE IF THERE IS A PREFERED SLOT
	BGT NEXTU6
	MOV #SLOTST,A
NEXTU4:	TST (A)+
	TST (A)+
	BLT NEXTU4
	BEQ NEXTUS
	CMP #1,-2(A)
	BEQ NEXTU4	;GUY HASN'T RUN YET, DON'T SWAP HIM OUT
	MOV -2(A),B	;USER THAT MAY BE SWAPED OUT
	CMP B,LOCKUS	;IS HE LOCKED IN?
	BEQ NEXTU4	;YES, DON'T BOTHER HIM
	CMP B,GCLOCK
	BEQ NEXTU4
	TST NSWPU	;ARE THERE USERS BEING SWAPED?
	BEQ NEXTU6	;NO, SWAP ONE
	CMP NINU,#1	;IS THERE ONLY ONE USER IN CORE?
	BEQ NEXTUS	;YES, RUN HIM
NEXTU6:	CLR PUSPSL	;IF THERE WAS A PREFERED SLOT, WE ARE DOING IT
	TST -(A)
	MOV -2(A),B	;FOUND A GOOD SLOT, USER TO SWAP OUT INTO B
	MOV U,-2(A)	;NEW OCCUPANT OF SLOT

	FOR DEBUG
	BIT #SWTRCF,SFLAGS	;TRACE SWAPS?
	BEQ NEXTU5
	SPUSH A
	PRTXT ^/SWAPPING: /
	MOV B,A
	JSR PC,PRON
	SPACE
	MOV U,A	;USER WHO IS COMING IN
	JSR PC,PRON
	SPACE
	MOV (P),A
	SUB #SLOTST+2,A
	ASR A
	ASR A
	JSR PC,PRON	;SLOT
	SPACE
	MOV TIME,A
	JSR PC,PRON
	PRCR
	SPOP A
	.ENDC
	ENDC DEBUG

NEXTU5:	CLR D
	MOV SLTCAD-SLOTST-2(A),C	;MOBY SWAP OUT BLOCK FOR THIS SLOT
	MOV #SWPOST,(C)+	;SWAP OUT USER START ROUTINE
	MOV USWCNT,(C)+	;WORD COUNT OF A USER SLOT
	MOV SLTCAD-SLOTST(A),(C)+	;SLOT CORE ADDRESS
	MOV USWPAD(B),(C)+	;LOW ORDER SWAP OUT ADDR OF U TO SWAP OUT
	MOV USWPAD+2(B),(C)+	;HIGH OORDER
	TST (C)+	;WASTED WORD
	MOV #DWRTEC,(C)+	;DISK WRITE COMMAND
NEXT11:	DEC NINU	;ONE LESS IN CORE
	INC NSWPU	;ONE MORE MOVING AROUND
	MOV #SWPIST,(C)+	;SWAP IN USER START ROUTINE
	MOV USWCNT,(C)+	;SLOT WORD COUT
	MOV SLTCAD-SLOTST(A),(C)+	;SLOT CORE ADDRESS
	CMP #FRNEWU,FLSRES(U)
	BNE NEXT12
	MOV DCLRUS,(C)+
	MOV DCLRUS+2,(C)+
	MOV #UGO,FLSADR(U)
	MOV UDSKAD(U),UNXTDB(U)
	MOV UDSKAD+2(U),UNXTDB+2(U)
	BR NEXT13
NEXT12:	MOV USWPAD(U),(C)+	;  "    "   
	MOV USWPAD+2(U),(C)+	;USER ADDRESS ON DISK
NEXT13:	MOV A,(C)+	;ADDRESS OF PLACE TO ZAP TO 1 WHEN DONE
	MOV #DREADC,(C)	;READ FROM DISK
	SUB #32,C	;BEGINING OF MOOBY SWAP REQ PAIR
	ADD D,C
	SPUSH PS
	MOV #340,PS	;NO INTS!
	MOV C,@SWPLEP
	ADD #2,SWPLEP
	SPOP PS
	MOV #-1,(A)	;NOT IN YET
	BR NEXT10

NEXTU7:	MOV #-1,USER	;FLUSH ENTERS HERE, SYSTEM NOW USER
	MOV #SLOTST,A	;SEE IF THIS SUPER FLUSHED GUY IS IN CORE
NEXTU8:	CMP U,(A)+
	BNE NEXTU9	;NOT HERE.
	TST (A)+	;IS HE REALLY IN?
	BLE NEXT10	;NO, NOT REALLY
	CMP #FRDSKW,FLSRES	;IF JUST HUNG ON DISK
	BEQ NEXT10	;FORGET HIM
	MOV A,PUSPSL	;HE IS PREFERED OUT
	MOV U,PUSRSP
	BR NEXT10
NEXTU9:	TST (A)+
	BNE NEXTU8
NEXT10:	JMP NEXTUS

FLUSH:	TST USER
	BGE FLUSH4
	RTS PC
FLUSH4:	JSR PC,UACSAV	;STOP USER; STORE HIS ACS
	MOV AC,UAC
	MOV MQ,UMQ
	MOV SR,USR
	MOV FLSADR(U),A
	SPOP FLSADR(U)	;SAVE PC
	TST A	;IS THIS GUY ALREADY STOPED?
	BNE NEXTU7	;GO TRY ANOTHER GUY
	UUNTIM TIMUSD
	MOV #-1,USER
	TIMER NULTIM
	TST FLSRES(U)
	BNE .+10
	MOV #FRRAND,FLSRES(U)
	DEC NRABLU
	MOV P,UPDLP	;SAVE USER'S POINTER
	MOV SPDLP,P	;SYSTEM PDL

	FOR DEBUG
	BIT #FRTRCF,SFLAGS
	BEQ FLUSH3
	PRTXT ^/FLUSHING USER /
	MOV U,A
	JSR PC,PRON
	SPACE
	MOV TIME,A
	JSR PC,PRON
	PRCR
	.ENDC
	ENDC DEBUG

FLUSH3:	MOV #UVBLK,A
	MOV BASEUS,B	;TO BLT OUT USER VARIABLES
FLUSH1:	SUB B,(A)+	;UNRELOCATE A POINTER
	CMP #UVREND,A	;END OF VARS TO BE UNRELOCATED?
	BGT FLUSH1	;GO DO ANOTHER
	MOV #UVBLK,A	;SET UP FOR BLT
	MOV ACRELF,C
	BEQ FLUSH2
	MOV U,D
	ADD #UACA-2,D	;POINTER TO USERS ACS
FLUSH5:	TST (D)+	;NEXT AC TO MAYBE RELOCATE
	TST C
	BEQ FLUSH2	;NO MORE TO RELOCATE
	CLC
	ROR C
	BCC FLUSH5	;DON'T RELOCATE THIS ONE
	SUB B,(D)
	BR FLUSH5
FLUSH2:	MOV (A)+,(B)+	;ONE AT A TIME, KIDDIES!
	CMP #UVBLK+LUVBLK-MAXELN,A	;DONE?
	BGT FLUSH2
	JMP NEXTUS
;RUNUSR, THE "MAIN LOOP"

RUNUSR:	CMP U,PUSRSP	;AM I THE GUY THEY WANT OUT?
	BNE .+6	;BRANCH IF NO
	CLR PUSPSL	;I DON'T WANT TO GO!
	INC (A)	;INDICATE THAT THIS GUY HAS BEEN RUN
	MOV SLTCAD-SLOTST(A),D	;SLOT ADDRESS THIS GUY IS IN
	TST (D)+	;REALLY RIGHT NOW
	MOV D,B	;BASE OF SLOT
	MOV #UVBLK,C	;BASE OF USER VARIABLES
RUNUS1:	MOV (B)+,(C)+	;BLTTTTTTTTTTTT!
	CMP #UVBLK+LUVBLK,C
	BGT RUNUS1
	MOV #UVBLK,C	;TO RELOCATE VARIABLES
RUNUS2:	ADD D,(C)+	;ADD BASE OF SLOT
	CMP #UVREND-2,C
	BGT RUNUS2
	MOV D,BASEUS
	MOV ACRELF,A
	BEQ RUNUS5
	MOV U,B
	ADD #UACA-2,B
RUNUS6:	TST (B)+
	TST A
	BEQ RUNUS5
	CLC
	ROR A
	BCC RUNUS6
	ADD D,(B)
	BR RUNUS6
RUNUS5:
	FOR DEBUG
	BIT #FRTRCF,SFLAGS
	BEQ RUNUS4
	PRTXT ^/STARTING USER /
	MOV U,A
	JSR PC,PRON
	SPACE
	MOV TIME,A
	JSR PC,PRON
	PRCR
	.ENDC
	ENDC DEBUG

RUNUS4:	MOV P,SPDLP	;SAVE SYSTEM PDL POINTER
	MOV UPDLP,P	;GET USER PDL POINTER
	MOV U,USER	;NOW HE'S REALLY THE GUY
	SPUSH UPC(U)	;PLACE TO START USER
	MOV QUANT,UQUANT	;RUN FOR 3 1/100TH'S????
	UNTIME NULTIM
	UTIMER TIMUSD
	MOV UAC,AC
	MOV UMQ,MQ
	MOV USR,SR
	JMP UACRES	;RESTORE USER ACS AND START USER


SCHEDP:	TST UQUANT	;SEE IF IT'S TIME TO FLUSH
	BLE .+4	;NOT YET
	RTS PC
	SPUSH U
	MOV USER,U
	MOV #FRSCED,FLSRES(U)
	JSR PC,FLUSH
	JSR PC,RUNME
	SPOP U
	RTS PC
.STITL CLOCK BREAK ROUTINE

CLKBRK:	SPUSH A
	SPUSH B
	ADD #200,TIME
	ADC TIME+2
	DEC UQUANT
	TSTB DSKS	;IS THE DISK BUSY?
	BGE .+6	;YES
	JSR PC,DSKSRT
	CMP #13183.,TIME+2	;IS IT MIDNIGHT?
	BLE DATEC	;YES, CHANGE THE DATE
CLKBR1:	JMP	@#CLKBR2
CLKBR2:	SPOP B
	SPOP A
	RTI


CLKBDM:	BIT	#7777,TIME	;EVERY 4 BRKS (=<4*128>/10,000 SECS)
	BNE	CLKBR2	;1/20 < T < 1/21 SECS
	JSR	PC,DMSQ
	JSR	PC,TI2Q
	BR	CLKBR2

DATEC:	CLR TIME+2	;TIME IS NOW ZERO
	INC RDAY	;CHANGE THE DAY
	MOV RMONTH,A
	CMPB RDAY,DMON(A)
	BLE CLKBR1	;NOT ON A MONTH BOUNDARY
	INC RMONTH
	MOV #1,RDAY
	CMP #12,RMONTH
	BLE CLKBR1
	INC RYEAR
	MOV #1,RMONTH
	BR CLKBR1

RDAY:	0
RMONTH:	0
RYEAR:	0
DMON:	.BYTE 31.,28.,31.,30.,31.,30.,31.,31.,30.,31.,30.,31.
	.STITL	SWAP START+STOP ROUTINES

SWPOST:	MOV #SWPOSP,(A)	;SWAP OUT USER START, SET UP STOP
	RTS PC

SWPOSP:	TST (P)+	;FLUSH RETURN, WE'RE NOT GOING BACK THAT WAY
	ADD #16,A	;POINT TO SWAP IN BLOCK
	JSR PC,DSKSGO	;START DISK ON THAT
	JMP DSKRET	;AND RETURN FROM INTERUPT

SWPIST:	MOV #SWPISP,(A)	;SWAP IN START, SET UP STOP
	RTS PC

SWPISP:	CLR UQUANT	;SCHED REAL SOON
	MOV 12(A),B	;FLAG
	MOV #1,(B)	;THIS GUY IS IN AND NOT RUN YET
	SUB #2,SWPLEP
	SPUSH A
	MOV #SWPLST+2,A
	MOV #SWPLST,B
	MOV (A)+,(B)+
	BNE .-2
	INC NINU	;ONE MORE GUY IN
	DEC NSWPU	;ONE LESS GUY MOVING
	SPOP A
	RTS PC
	.STITL MISC ROUTINES

ACSAV:	MOV E,-(P)
	MOV D,-(P)
	MOV C,-(P)
	MOV B,-(P)
	MOV A,-(P)
	JMP (F)

ACRES:	TST (P)+
	MOV (P)+,A
	MOV (P)+,B
	MOV (P)+,C
	MOV (P)+,D
	MOV (P)+,E
	RTS F

UACSAV:	MOV A,UACA(U)
	MOV B,UACB(U)
	MOV C,UACC(U)
	MOV D,UACD(U)
	MOV E,UACE(U)
	RTS PC

UACRES:	MOV UACA(U),A
	MOV UACB(U),B
	MOV UACC(U),C
	MOV UACD(U),D
	MOV UACE(U),E
	RTS PC



PPUSHT:	CMP P,PPUSHL
	BLOS .+4
	RTS PC
	BIT #177000,P	;IS IT THE SYSYTEM PDL?
	BNE .+4
	RTS PC	;YES, IGNORE
	JMP PPSWPO	;PDL REALLY OVERFLOWED

PPOPT:	CMP P,PPOPL
	BHIS .+4
	RTS PC
	JMP PPSWPI

SPUSHT:	SUB #2,S
	CMP S,SPUSHL
	BLOS .+4
	RTS PC
	JMP SPSWPO

SPOPT:	ADD #2,S
	CMP S,SPOPL
	BHI .+4
	RTS PC
	JMP SPSWPI

.SPACE:	PRTXT ^\ \
	RTS PC

.CRLF:	JMP	@#.+4
	JSR PC,ERTAP
	CRMES
	RTS PC

CRLF:	MOV	#15,D
	JMP	TYO
	.STITL P AND S PDL SWAP OUTERS

PPSWPO:	JSR F,ACSAV	;TIME TO WORK!

	FOR DEBUG
	BIT #SPTRCF,SFLAGS
	BEQ PPSWP1
	SUB #100,PPUSHL	;SO IT DOESN'T OVERFLOW AGAIN
	PRTXT ^/SWAPPING OUT P PDL /
	MOV P,A
	SUB A,PRBAO
	NEG A
	JSR PC,PRON
	PRCR
	ADD #100,PPUSHL
	.ENDC
	ENDC DEBUG

PPSWP1:	JSR PC,UBLKGR	;GET ALL THE GOOD STUFF WE NEED
	HALT	;WHAT, NO DISK SPACE
	HALT	;STOP, YOU STUPID MACHINE
	SPUSH B	;SAVE ADDRESS
	MOV PSWPAD,4(A)	;PLACE WHERE PDL IS
	MOVB #DWRTEC,14(A)	;WRITE IT ONTO THE RIGHT PLACE
	JSR PC,DSKWA2	;FLUSH UNTIL IT IS REALLY OUT
	MOV BASEUS,A
	ADD #PDLINK+4-SLOT1,A	;GIVING US THE LINK ADDRESS+4 FOR THIS GUY
	MOV C,-(A)	;HIGH ORDER PART
	SPOP -(A)	;LOW ORDER PART
	BIT #PPNAIF,FLAGS2	;WAS THE PDL NOT ALL THE WAY IN ANYWAY?
	BNE .+10	;PART ALREADY OUT
	SUB #54,PPOPL	;NONE OUT BEFORE, CHANGE LIMIT
	BIS #PPNAIF,FLAGS2	;CERTAINLY NOT ALL IN NOW
	MOV PSWPAD,B	;ADDRESS-2 PDL SWAPED FROM
	MOV (B),-(A)	;MOVE WORDS UP
	MOV -(B),-(A)
	CMP B,P
	BGE .-4
	ADD #374,P	;PDL HAS MOVED!
	ADD #374,PRBAO
	JSR F,ACRES	;ALL DONE!
	RTS PC


SPSWPO:	JSR F,ACSAV	;TIME TO WORK!

	FOR DEBUG
	BIT #SPTRCF,SFLAGS
	BEQ SPSWP1
	PRTXT ^/SWAPING OUT S PDL /
	MOV S,A
	SUB A,SPRBAO
	NEG A
	JSR PC,PRON
	PRCR
	.ENDC
	ENDC DEBUG

SPSWP1:	JSR PC,UBLKGR	;GET ALL THE GOOD STUFF WE NEED
	HALT	;WHAT, NO DISK SPACE
	HALT	;STOP, YOU STUPID MACHINE
	SPUSH B	;SAVE ADDRESS
	MOV SSWPAD,4(A)	;PLACE WHERE PDL IS
	MOVB #DWRTEC,14(A)	;WRITE IT ONTO THE RIGHT PLACE
	JSR PC,DSKWA2	;FLUSH UNTIL IT IS REALLY OUT
	MOV BASEUS,A
	ADD #SDLINK+4-SLOT1,A	;GIVING US THE LINK ADDRESS+4 FOR THIS GUY
	MOV C,-(A)	;HIGH ORDER PART
	SPOP -(A)	;LOW ORDER PART
	BIT #SPNAIF,FLAGS2	;WAS THE PDL NOT ALL THE WAY IN ANYWAY?
	BNE .+10	;PART ALREADY OUT
	SUB #54,SPOPL	;NONE OUT BEFORE, CHANGE LIMIT
	BIS #SPNAIF,FLAGS2	;CERTAINLY NOT ALL IN NOW
	MOV SSWPAD,B	;ADDRESS-2 PDL SWAPED FROM
	MOV (B),-(A)	;MOVE WORDS UP
	MOV -(B),-(A)
	CMP B,S
	BGE .-6
	ADD #374,S	;PDL HAS MOVED!
	ADD #374,SPRBAO
	JSR F,ACRES	;ALL DONE!
	RTS PC

	.STITL P AND S PDL SWAPER INERS
PPSWPI:	BIT #PPNAIF,FLAGS2	;IS THE PDL ALL THE WAY IN?
	BNE .+4	;NO (PRAISE THE LORD!)
	HALT
	JSR F,ACSAV

	FOR DEBUG
	BIT #SPTRCF,SFLAGS
	BEQ PSWPI1
	PRTXT ^/SWAPING IN P PDL /
	MOV P,A
	SUB A,PRBAO
	NEG A
	JSR PC,PRON
	PRCR
	.ENDC
	ENDC DEBUG

PSWPI1:	MOV PSWPAD,A
	MOV A,B
	ADD #374,A
	MOV (A),(B)
	MOV -(A),-(B)
	CMP A,P
	BGT .-4
	SUB #374,P
	SUB #374,PRBAO
	JSR PC,SYDRBG
	TST (A)+
	MOV #-200,(A)+
	MOV PSWPAD,(A)+
	MOV PPBASE,E
	MOV (E)+,C
	MOV C,(A)+
	MOV (E),(A)+
	TST (A)+
	MOVB #DREADC,(A)
	JSR PC,DSKWAI
	MOV PPBASE,D
	TST (D)+
	BNE PSWPI2
	TST (D)
	BNE PSWPI2
	BIC #PPNAIF,FLAGS2	;IF BOTH LINKS ARE ZERO NOW, THERE IS NO MORE PDL ON DISK
	ADD #54,PPOPL
PSWPI2:	JSR PC,UBLKFR
	JSR F,ACRES
	RTS PC

SPSWPI:	BIT #SPNAIF,FLAGS2	;IS THE PDL ALL THE WAY IN?
	BNE .+4	;NO (PRAISE THE LORD!)
	HALT
	JSR F,ACSAV

	FOR DEBUG
	BIT #SPTRCF,SFLAGS
	BEQ SSWPI1
	PRTXT ^/SWAPING IN S PDL /
	MOV S,A
	SUB A,SPRBAO
	NEG A
	JSR PC,PRON
	PRCR
	.ENDC
	ENDC DEBUG

SSWPI1:	MOV SSWPAD,A
	MOV A,B
	MOV (A),(B)
	ADD #374,A
	MOV (A),(B)
	MOV -(A),-(B)
	CMP A,S
	BGT .-6
	SUB #374,S
	SUB #374,SPRBAO
	JSR PC,SYDRBG
	TST (A)+
	MOV #-200,(A)+
	MOV SSWPAD,(A)+
	MOV SPBASE,E
	MOV (E)+,C
	MOV C,(A)+
	MOV (E),(A)+
	TST (A)+
	MOVB #DREADC,(A)
	JSR PC,DSKWAI
	MOV SPBASE,D
	TST (D)+
	BNE SSWPI2
	TST (D)
	BNE SSWPI2
	BIC #SPNAIF,FLAGS2	;IF BOTH LINKS ARE ZERO NOW, THERE IS NO MORE PDL ON DISK
	ADD #54,SPOPL
SSWPI2:	JSR PC,UBLKFR
	JSR F,ACRES
	RTS PC



.IFZ 105

SWAPER:	CLR A
SWAP1:	PUSH A
	PUSHS A
	INC A
	CMP A,B
	BGT SWAP2
	BR SWAP1
SWAP2:	POP C
	POPS D
	DEC A
	CMP A,D
	BEQ .+4
	HALT
	CMP A,C
	BEQ .+4
	HALT
	TST A
	BEQ SWAPER
	BR SWAP2
.ENDC
	.STITL TIMER ROUTINES

.TIME:	SPUSH A
	SPUSH B
	SPUSH C
	SPUSH D
	SPUSH PS
	MOV #340,PS
	JSR PC,GTIME
	JSR PC,URELTM
	MOV TMPDLP,D
	MOV (A),(D)+
	MOV -(A),(D)+
	MOV D,TMPDLP
	CLR (A)+
	CLR (A)
	JSR PC,RELTIM
	SPOP PS
	SPOP D
	SPOP C
	SPOP B
	SPOP A
	RTS PC

.UTIME:	SPUSH A
	SPUSH B
	SPUSH C
	SPUSH D
	SPUSH PS
	MOV #340,PS
	JSR PC,GTIME
	JSR PC,URELTM
	MOV (E)+,A
	ADD ELAPSE,(A)+
	ADC (A)
	ADD ELAPSE+2,(A)
	MOV TMPDLP,D
	MOV -(D),ELAPSE
	MOV -(D),ELAPSE+2
	MOV D,TMPDLP
	JSR PC,RELTIM
	SPOP PS
	SPOP D
	SPOP C
	SPOP B
	SPOP A
	RTS E

URELTM:	MOV #ELAPSE,A
	ADD B,(A)+
	ADC (A)
	ADD C,(A)
	RTS PC

RELTIM:	MOV #ELAPSE,A
	SUB B,(A)+
	SBC (A)
	SUB C,(A)
	RTS PC


GTIME:	MOV PCCNT,B
	ADD #200,B
	TSTB PCS
	BGE .+6
	MOV #200,B
	MOV TIME+2,C
	ADD TIME,B
	ADC C
	RTS PC

	.STITL COMMUNICATE WITH MAIN MACHINE

RJLSW:	0	;NON-ZERO=> ACTIVATE COMMUNICATE LINK
REDY10:	0	;NON-ZERO=>10 IS READY
SYSMES:	0	;NUMBER OF MESSAGES WAITING FOR THE SYSTEM
	.MACR EXCHA X,Y
	MOV X,A
	MOV Y,X
	MOV A,Y
	.ENDM

;LOGIN STRING
LOGMES:	.BYTE 'Z-100,'S-100,'S-100,'_-100
	.ASCII /R11LOGO/
	.BYTE 33
	.ASCII /U11HERE/
	.BYTE 'K-100,0
	.EVEN

;RECIEVE VARIABLES
RBPOIN:	0
DCRBIP:	DCRBF1-2	;INITIAL POINTER
DCRACF:	0	;ACKNOWLEDGE FLAG
DCRCKS:	0	;CHECKSUM OF INCOMING WORDS
DCRMID:	0	;ID # SENT WITH MESSAGE
DCRWCT:	0	;WORD COUNT OF CURRENT MESSAGE
DCRPRB:	0	;"PARITY" BITS FOR INCOMING WORD
DCRWBL:	0	;BUILD RECIEVED WORD HERE

DCRLST:	.=.+40	;MESSAGES WAITNING TO BE PICKED UP

DCRDRB:	.WORD 0,-400,DCRBF2-2,0,0,0,0	;DISK REQUEST BLOCK


;TRANSMIT VARIABLES
TBPOIN:	0
DCTSMS:	.=.+20	;SMALL (1 OR 2 CHAR)MESSAGES TO BE SENT
DCTBST:	.=.+40	;MESSAGES WAITING TO BE SENT
;BUFFERS
DCRBF1:	.=.+100	;RECIEVE BUFFER 1
DCRBF2:	.=.+100	;   "      "    2

;DC11 PDLS
	.=.+20
	RLOGIN
RPDLP:	.-2
	.=.+20
	TLOGIN
TPDLP:	.-2

;RECIEVE INTERUPT ROUTINES

DCRBRK:	SPUSH A
	EXCHA RPDLP,P	;SET UP RECIEVE PDL
	MOV DCRB,A	;GET CHAR FROM LINE
	RTS PC	;RESUME PROCESSING

RFLUSH:	EXCHA RPDLP,P	;RESTORE PDL
	SPOP A
	RTI

RLOGIN:	BIS #100,DCTS	;WAKE UP TRANSMIT ROUTINE
	JSR PC,RFLUSH	;GET NEXT CHAR
	CMP #140,A	;IS IT SYNC?
	BNE RLOGIN	;NO, WAIT FOR THE 10 TO WAKE UP
	INC REDY10	;10 IS READY TO COMMUNICATE

RECLOP:	JSR PC,RFLUSH	;GET THE NEXT CHAR OFF THE LINE
	SUB #140,A	;IS IT CONTROL CHAR?
	BLT RECLOP	;NO (THIS SHOULDN'T HAPPEN)
	CMP #10,A	;IS IT TOO BIG?
	BLE RECLOP	;YUP (THIS SHOULD HAPPEN EVEN LESS!!)
	ASL A
	JMP @RECTAB(A)	;DO THE CONTROL CHAR

RECTAB:	RECLOP	;NULL, SYNC(WHATEVER YOU WANT TO CALL IT)
	STPREC	;STOP!
	ACTREC	;WELL?????
	RECLOP	;???
	RECLOP	;????
	ACKREC	;ACKNOWLEDGEMENT OF TRANSMITTED MESSAGE
	NAKREC	;NEGATIVE, PLEASE SEND AGAIN
	DATA	;DATA BLOCK COMES NEXT

STPREC:ACTREC:	BR RECLOP

NAKREC:	MOV #-1,DCRACF	;FOR NAK
	BR ACKRC1
ACKREC:	CLR DCRACF
ACKRC1:	JSR PC,GBITCH	;GET NUMBER OF MESSAGE BEING "ACK"ED
	BR RECLOP	;LOSE!
	CMP #20,A	;IS IT TOO BIG?
	BLE RECLOP
	ASL A
	MOV DCRACF,DCTBST(A)	;TELL TRANSMIT ROUTINES ACK OR NAK
	BR RECLOP

DATA:	CLR DCRCKS	;CLEAR CHECKSUM
	JSR PC,GWORD	;GET A WORD OFF THE LINE
	JMP RECLOP	;BAD PARITY IN WORD, CAN'T WIN
	MOVB DCRWBL+1,DCRMID	;SENDERS ID # FOR THIS DATA
	MOVB A,DCRWCT	;NUMBER OF WORDS FOLLOWING, INC. CHECKSUM
	MOV DCRBIP,RBPOIN	;POINTER TO CURRENT BUFFER
DATA1:	ADD #2,RBPOIN	;POINT TO NEXT WORD
	JSR PC,GWORD
	BR NODATA	;PARITY ERROR IN WORD
	MOV A,@RBPOIN	;SAVE WORD
	DEC DCRWCT	;IS IT THE LAST ONE(CHECKSUM)?
	BGT DATA1	;NO
	TST DCRCKS	;SHOULD BE ZERO
	BNE NODATA	;NO SUCH LUCK
	TST DCRDRB+14	;HAS THE LAST MESSAGE MADE IT TO THE DISK?
	BNE NODATA	;NO, CAN'T KEEP THIS MESSAGE
	SPUSH B
	MOV #DCRLST,B
	TST (B)+	;IS THIS RECIEVE BUFFER FREE?
	BNE .-2	;NO
	TST -(B)	;FOUND A FREE ONE
	CMP #DCRLST+40,B	;IS IT REALLY ONE?
	BGE NODATA	;NO PLACE TO PUT MESSAGE
	EXCHA DCRBIP,DCRDRB+4	;EXCH BUFFER USAGE
	TST (A)+
	MOV (A),A	;THIS IS THE MESSAGE ID
	MOV A,(B)	;SO THE USER CAN FIND IT
	BIT #177400,A	;IS THIS MESSAGE FOR THE SYSTEM?
	BNE .+6	;NO
	INC SYSMES	;TELL THE SYSTEM IT HAS A MESSAGE
	SUB #DCRLST,B
	ASL B
	ASL B
	ASL B
	ASL B
	ADD DCRBFS,B
	MOV B,DCRDRB+6
	MOV DCRBFS+2,DCRDRB+10	;DISK ADDRESS OF BUFFER
	MOV #DCTSMS,A	;FIND A SMALL MESSAGE SLOT
	TST (A)+
	BNE .-2
	MOV #<145_10>,B
	BIS DCRMID,B
	ADD #40,B
	SWAB B
	MOV B,-(A)
	SPOP B
	JMP RECLOP

NODATA:	JMP RECLOP

;GET 16 BIT WORD OFF THE LINE
;6 BITS, 6 BITS, 2 PARITY+4 BITS (PPBBBB)
;3 333 222 222 111 111
GWORD:	JSR PC,GBITCH	;GET A BINARY CHAR
	RTS PC	;BAD CHAR, LOSE
	MOV A,DCRWBL	;STATRT BUILDING WORD	0 000 000 000 BBB BBB
	JSR PC,GBITCH
	RTS PC	;BAD CHAR
	SWAB A				;	0 0BB BBB B00 000 000
	ASR A				;	0 00B BBB BB0 000 000
	ASR A				;	0 000 BBB BBB 000 000
	BIS A,DCRWBL			;	0 000 222 222 111 111
	JSR PC,GBITCH
DCRRTS:	RTS PC	;BAD CHAR
	ASL A				;	0 000 000 00B BBB BB0
	ASL A				;	0 000 000 0BB BBB B00
	ASL A				;	0 000 000 BBB BBB 000
	ASL A				;	0 000 00B BBB BB0 000
	BISB A,DCRWBL+1			;	BB BB0 000
	SWAB A				;	B BBB 000 000 000 0BB
	MOVB A,DCRPRB			;	00 000 0BB
	SPUSH B
	MOV DCRWBL,A
	JSR PC,BITCNT	;GET NUMBER OF BITS IN THE WORD
	BIC #177774,B	;MOD 4
	COM B		;AND COMPLEMENTED
	CMP B,DCRPRB	;IS IT THE SAME AS WAS SENT ON THE LINE?
	BNE GWORDB	;NO, HAVE GOT BAD WORD
	ADD A,DCRCKS	;YES, ADD TO CHECKSUM
	SPOP B
	JMP SRET
GWORDB:	SPOP B
	RTS PC

;GET 6 BITS OFF THE LINE
GBITCH:	JSR PC,RFLUSH
	SUB #40,A
	BIT #177700,A
	BNE DCRRTS
	JMP SRET

BITCNT:	SPUSH A
	CLR B
	BR BITCT2
BITCT1:	INC B
BITCT2:	ASL A
	BCS BITCT1
	BNE BITCT2
	SPOP A
	RTS PC

;TRANSMIT INTERUPT ROUTINES

DCTBRK:	SPUSH A
	EXCHA TPDLP,P
	RTS PC

TFLUSH:	MOV A,DCTB
T1FLSH:	EXCHA TPDLP,P
	SPOP A
	RTI

TLOGIN:	MOV #'Z-100,A
	JSR PC,TFLUSH
	MOV #LOGMES,TBPOIN
LOGSEN:	MOVB @TBPOIN,A
	BEQ LOGDNE
	INC TBPOIN
	BIC #100,DCTS	;DON'T CARE IF NO ECHO
	JSR PC,TFLUSH
	BR LOGSEN
LOGDNE:	BIC #100,DCTS	;PUT IT TO SLEEP
	JSR PC,T1FLSH
	TST REDY10
	BEQ LOGDNE
;FALL IN HERE WHEN 10 IS READY TO RECIEVE
.STITL	INITIALIZE THE WORLD!
START:	RESET
	MOV SPDLP,P	;SET UP SYSTEM PDL
	CLR TIME
	MOV #200,PCSTBF	;EVERY 128/10000 TH'S
	MOV #113,PCS
	TST RJLSW
	BEQ NODC11
	MOV #121,DCRS
	MOV #121,DCTS
	MOV #'Z-100,DCTB
NODC11:	MOV #CORCHK,BEBRV	;WHERE TO GO ON MEM TRAP
	MOV #LOGEND,A	;LAST LOCATION WITH CRAP IN IT
	ADD #200,A
	TST (A)	;IS IT REALLY THERE?
	BR .-6	;LOOP ENDED BY MEM TRAP
CORCHK:	BIC #377,A
	MOV #BEBRV+2,BEBRV
	MOV A,CORTOP
	SUB #22000+SLOT1,A	;FUDGE AREA (NOW RADIA CAN FIT DDT THERE!)
	CLR B
	MOV #MQ+2,C
	MOV A,-(C)	;MOVE A TO MQ
	CLR -(C)	;CLEAR HIGH ORDER(AC)
	MOV NSLOTS,-(C)	;DIVIDE
	MOV MQ,B	;GET RESULT
	CMP B,#MSLTLN
	BLO .+6
	MOV #MSLTLN,B
	BIC #37,B
	MOV #SLOT1-2,A	;BEGINING OF SLOT-2 (FOR DISK)
	MOV #SLTCAD+2,C	;ADDRESS OF SLOT
	MOV NSLOTS,D
	MOV D,NINU	;NUMBER OF USERS IN CORE NOW.
	CLR E
SLTAL1:	MOV A,(C)+	;ADDRESS OF THIS SLOT
	ADD B,A	;NEXT ONE
	MOV E,SLOTST-SLTCAD-4(C)	;USER OF THIS SLOT
	MOV #1,SLOTST-SLTCAD-2(C)	;JUST SWAPED IN
	ADD #LUBLK,E	;NEXT USER
	TST (C)+
	DEC D
	BGT SLTAL1	;DO THIS NSLOTS TIMES
	MOV B,USLENT
	ASR B
	MOV B,A	;SAVE A POSITIVE WORD COUNT
	NEG B
	MOV B,USWCNT
	MOV #3,A
	MOV #-1,B	;SIE OF DISK IN A AND B
	SUB DSKRND,B	;MINUS RANDOM SYSTEM STORAGE
	SUB DSKRND+2,B
	MOV #MQ+2,C
	MOV B,-(C)
	MOV A,-(C)
	MOV NUSERS,-(C)	;DIVIDE AMOUNT OF DISK BY # OF USERS
	MOV #-1,A	;FULL ALOCATION
	TST AC
	BNE .+6
	MOV MQ,A	;AMOUNT OF DISK PER USER
DALOC2:	ADD USWCNT,A	;ADD NEGATIVE WORD COUNT TO AMOUNT OF DISK
	SUB #DTIBFL+DEDBFL+DDIRL,A	;SUBTRACT FIXED BUFFERS
	BGT DALOC3	;RESULT <15 BITS
	MOV #77777,A	;MAKE IT 15 BITS
DALOC3:	BIC #377,A	;TO GET # OF WORDS OF RANDOM STORAGE
	MOV A,E	;SAVE THAT QUANT IN E FOR (MUCH) LATER
	SWAB A
	MOV A,B
	ASL A	;NUMBER OF BLOCKS (200 WORDS) NOW IN A
	ASR B
	ASR B
	ASR B	;NUMBER OF BLOCKS/20 NOW IN B
	MOV #DBITTB,C	;SET UP TO INIT DISK BIT TABLE
DALOC5:	DEC B	;20 BLOCKS (=1 WORD IN TABLE)AT A TIME
	BLT DALOC4	;ALL DONE 
	CLR (C)+
	BR DALOC5
DALOC4:	CLR (C)	;ONLY SOME BITS ON IN THIS WORD
	COM (C)
	MOV #1,D
	BIC #177760,A	;# OF WORDS MOD 20
DALOC6:	DEC A
	BLT DALOC7
	BIC D,(C)
	ASL D
	BR DALOC6
DALOC7:	TST (C)+
	CMP C,#DBITBE
	BGT DALOC8
	MOV #-1,(C)
	BR DALOC7
DALOC8:	BIS #1,DBITTB	;FIRST BLOCK TO BE USED
	BIS #100000,DBITBE	;IMPOSSIBLE TO GO OFF TOP
	MOV E,D
	MOV #3,A
	MOV #-1,B


	MOV #MNUSRS,E
	MOV #LUBLK*<MNUSRS>,U
UVINIT:	SUB #LUBLK,U	;FOR NEXT GUY DOWN
	MOV #-1,FLSADR(U)	;INDICATE THAT THIS GUY ISN'T REALLY HERE
	CLR FLSRES(U)
	DEC E
	CMP E,NUSERS	;MAYBE HE REALLY IS HERE
	BGE UVINIT	;NOPE!
	CLR FLSADR(U)
	MOV #FRNEWU,FLSRES(U)
	MOV #UDSKAD+4,C
	ADD U,C
	SUB D,B	;AMOUNT OF RANDOM STORAGE
	SBC A
	MOV A,-(C)	;HIGH ORDER RANDOM STORAGE ADDR
	MOV B,-(C)	;LOW ORDER
	MOV A,-(C)	;HIGH ORDER RANDOM STORAGE ADDR
	MOV B,-(C)	;LOW ORDER
	SUB #DDIRL,B
	SBC A
	MOV A,-(C)	;HIGH DISK DIR
	MOV B,-(C)	;LOW
	SUB #DEDBFL,B
	SBC A
	MOV A,-(C)
	MOV B,-(C)
	SUB #DTIBFL,B
	SBC A
	MOV A,-(C)
	MOV B,-(C)
	ADD USWCNT,B
	BCS .+4
	DEC A
	MOV A,-(C)
	MOV B,-(C)
	TST E
	BGT UVINIT
	MOV #SLOT1,D
	MOV #SOFN,B
	MOV #ASOFN-SLOT1,C
	ADD D,C
	ADD USLENT,D	;LAST AVAILABLE WORD ADDR
	CLR LINENO
INIT1:	INC B
	BIT #10000,B
	BNE INIT2
	MOV B,(C)+
	CLR (C)+
	CMP D,C
	BHI INIT1
INIT2:	CLR (C)+
	CLR @C
	ADD #SOFN,B
	MOV B,NUNODE	;NUMBER OF NODES PER USER
	MOV #UVBLK,A	;TO INITIALIZE USER VARIABLES IN SWAPPED OUT USERS
	MOV #SLOT1,B	;SET UP FOR BLT
SETUVS:	MOV (A)+,(B)+	;BLLLLLLLLLLLLLLLLLT
	CMP #UVBLK+LUVBLK,A
	BGT SETUVS
	TST RWWSW
	BNE STARTF
	JSR PC,SYDRBG	;GET A SYSTEM DISK REQUEST BLOCK
	CLR (A)+	;NO START ROUTINE
	MOV USWCNT,(A)+	;LENGTH OF A USER SLOT
	MOV #SLOT1-2,(A)+	;SWAP OUT SLOT1
	MOV DCLRUS,(A)+	;GETS PUT INTO THE CLEAR USER PLACE
	MOV DCLRUS+2,(A)+
	TST (A)+
	MOVB #DWRTEC,(A)
STARTF:	MOV	NUSERS,NUSER2
	ASL	NUSER2
	TST	JDCSW
	BNE	ITINIT
	MOV #UTYO,TYO+2
	MOV #UTYI,TYI+2
	MOV #3,BRKCHR
	JMP NEXTUS
ITINIT:	JMP TINIT

UGO:	JSR PC,RUNME
	PRTXT ^/11LOGO /
	MOV LVERNF,A
	JSR PC,PRDN
	PRCR
RSTART:
	MOV SALTL,ALTL
	MOV #100,TKS	;ENABLE INTERRUPTS FOR TYI
TEST1:
MLOOP:	JSR PC,SCHEDP
	TST	BRAKE(U)
	BEQ	MLOOP1
	JSR	PC,BRAKR	;BREAK
	JMP ERTLN
MLOOP1:	JSR PC,GETSTR
	JSR PC,MREAD
	JSR PC,EVLINE
	ERROR+WDW	;WHAT SHOULD I DOO WITH (S)
	BR MLOOP
WSTART:	MOV #IP,P	;USE WITH CAUTION!!
	BR RSTART
RUNRUG:	3
	BR .+2	;RUG  SHOULD RETURN HERE IF $P'ED
	BR .+2
	JMP NORT
	.STITL GET A STRING

GSTR9:	MOV CLN,B
	JSR PC,GTLINE
	ERROR+LDE	;LINE ..(B).. DOESN'T EXIST
	MOV C,A
	BR GSTR8
GETSTR:	TST FUNLEV	;ARE WE IN A PROC
	BEQ GSTR0	;NO
	BIT #ERRF,FLAGS2	;ERROR, MAYBE
	BNE GSTR0	;YES
	MOV CLP,B	;NO, GET THIS NODE OF LLP
	BEQ GSTR9
	JSR PC,.LOAD
	BIT #7777,A	;IS IT LAST NODE
	BNE GSTR8
	SPUSH A	;"STOP" POPS 5 WORDS
	SPUSH A
	SPUSH A
	SPUSH A
	JMP PSTOP
GSTR8:	MOV A,CLP
	MOV A,B
	JSR PC,.LOAD
	JSR PC,.LOAD	;OK, GET FIRST NODE OF LINE, = LINE #
	MOV B,CLN
	MOV A,CTP	;IN CASE THERE IS; NO GENERATION #
	MOV A,C
	JSR PC,.LOADC	;GET SECOND NODE
	CLR CLGN	; IF TYPE = SNUM, IT IS GEN #
	MOV A,C
	BIC #7777,C
	CMP #SNUM,C
	BNE GSTR6
	MOV B,CLGN	;IT IS
	MOV A,CTP
;FALLS THROUGH

;FALLS IN
GSTR6:	BIS #LIST,CTP
	SPUSHS CTP
	BIT #TRACEF,FLAGS2
	BEQ GSTRT
	PRCR
	PRTXT ^\ #\
	MOV CPP,B
	JSR PC,PPNAME	;PRINT PNAME
	PRTXT ^\  LINE \
	MOV CLN,A
	JSR PC,PRDN
	PRCR
	JSR PC,PRLN
	BR GSTRT


GSTR0:	BIT #TESTF,FLAGS2
	BEQ GSTR1
	MOV ALTL,A
	MOV (A)+,B
	BEQ DONE
	MOV A,ALTL
	PUSHS B
	PRCR
	PRTXT ^/TEST LINE /
	INC LINENO
	MOV LINENO,A
	JSR PC,PRDN
	PRCR
	JSR PC,PRLN
	CLR FLAGS
	CLR CO
	CLR CO+2
	CLR NOR
GSTRT:	RTS PC
	POP A	;GET RETURN ADDR
	PUSH #1
	JMP @A
GSTR1:	JSR PC,RDSTR
	BR GSTRT
DONE:	PRTXT ^/ALL DONE!/
	PRCR
	SPOP A	;CROCK!!!
	JMP RSTART	;BLECTCH?
	.STITL READ A STRING - PTR ON S
RDSTR1:	PRCR
RDSTR:	CLR NBKTS
	CLR	BRAKE
	MOV PRMTCH,D
	BEQ RDSTR9
	JSR PC,TYO
RDSTR9:	JSR	PC,RLINE
	JSR PC,BLSTI
RDSTR2:	JSR PC,TYI
	TST	BRAKE
	BEQ	.+10
	JSR	PC,BRAKR
	BR	RDSTR7
	CMP BRKCHR,D	;BREAK TYPED?
	BEQ RDSTR7	;YES
	TST NBKTS	;IN A LIST?
	BGT RDSTR3	;YES
	CMP #15,D	;CR?
	BEQ RDSTR4
RDSTR3:	CMP #'[,D
	BNE RDSTR6
	INC NBKTS
RDSTR6:	CMP #'],D
	BNE RDSTR5
	DEC NBKTS
RDSTR5:	JSR PC,BLST
	BR RDSTR2
RDSTR4:	JSR PC,BLSTF
	BR RDSTR	;NO CHARS TYPED
	PUSHS TOPS
	CLR TOPS
	RTS PC
RDSTR7:	JSR PC,BLSTF
	BR RDSTR1
	JSR PC,FRELST
	BR RDSTR1
RQUEST:	PUSH PRMTCH
	MOV #'<,PRMTCH
	JSR PC,RDSTR
	POP PRMTCH
	JMP ORT
	.STITL MORE READ ROUTINES!!!
MREAD:	TST FUNLEV	;ARE WE IN PROC?
	BEQ MRD1	;NO
	BIT #ERRF,FLAGS2	;YES, BUT ERROR?
	BNE MRD1	;YES
	RTS PC	;NO
MRD1:	BIT #TESTF,FLAGS2
	BNE MRD2
	JMP READ	;CONVERT CHAR STRING TO TOKEN LIST
MRD2:	RTS PC


RLINE:	TST USER
	BLT RLINE1
	TST	JDCSW
	BEQ	RLINE1
	PUSH	U
	MOV	USER,U
	MOV	#FRTYIH,FLSRES(U)
	JSR	PC,FLUSH	;RETURNS WHEN LINE DONE
	JSR	PC,RUNME
	POP	U
RLINE1:	RTS	PC
	.STITL EVAL 1 LINES
EVLINE:	TST TOPRNM
	BNE EVLI4
EVLI6:	JSR PC,IGNT	;EVALUATES 1 LINES ON S
EVLI1:	BIT #CRF,FLAGS
	BNE EVLI2
	JSR PC,EVAL
	BR EVLI3	;NO OUTPUT, OK
	RTS PC
EVLI3:	BIT #CRF,FLAGS
	BNE EVLI2
	JSR PC,GNT
	BIS #RTF,FLAGS
	BR EVLI1
EVLI4:	MOV @S,B
	JSR PC,.LOAD
	MOV A,D
	BIC #7777,A
	CMP #SNUM,A
	BEQ EVLI5	;AN SNUM
	CMP #LNUM,A
	BNE EVLI6	;NOT EVEN A NUMBER
	JSR PC,.LOAD	;AN LNUM, SEE IF TOO BIG
	BIT #7777,A
	BNE EVLI7	;TOO BIG
	BIC #170000,D	;MAKE IT INTO AN SNUM
	ADD D,A
	JSR PC,GRBAD
	MOV C,@S
EVLI5:	JSR PC,ADLN
	POPS A
EVLI2:	SKPRET
EVLI7:	ERROR+LNTB	;LINE # TOO BIG
	.STITL GET NEXT TOKEN

GNT:	BIT #RTF,FLAGS	;IS REPEAT TOKEN FLAG SET?
	BEQ GNT1
	BIC #RTF,FLAGS	;YES
	MOV CT,A
	MOV CT+2,B
	BNE GNT6
	CMP #SFUN,A
	BNE GNT6
	BIS #CRF,FLAGS
GNT6:	RTS PC
GNT1:	BIC #PTLPF,FLAGS
	CMP #$LLPAR,CT+2	;IS CT "("
	BEQ GNT3
	CMP #$LPAR,CT+2
	BNE .+8.
GNT3:	BIS #PTLPF,FLAGS	;YES, SET PTLPF
	MOV CT,B	;GET LINK TO NEXT TOKEN
	MOV B,CTP
	BIT #7777,B
	BEQ GNT2	;ANY TOKENS LEFT
	JSR PC,.LOAD	;YES
GNT4:	MOV A,CT
	MOV B,CT+2
	RTS PC
GNT2:	BIT #CRF,FLAGS
	BNE GNT5
	BIS #CRF,FLAGS
	MOV #SFUN,A
	CLR B
	BR GNT4
GNT5:	ERROR+OOT	;OUT OF TOKENS
IGNT:	POPS B
	BIT #7777,B
	BEQ IGNT1
	BIC #CRF,FLAGS
	JSR PC,.LOAD
IGNT2:	MOV A,CT
	MOV B,CT+2
	BIS #RTF,FLAGS
	MOV #1,CTN
	RTS PC
IGNT1:	BIS #CRF,FLAGS
	MOV #SFUN,A
	CLR B
	BR IGNT2
TYO:	JMP @#STYO
STYO:	TSTB TPS
	BPL .-4
	MOV D,TPB
	RTS PC
UTYO:	TSTB TPS
	BPL .-4
	MOVB D,TPB
	CMP #15,D
	BNE UTYOR
	MOV #12,D
	JSR PC,TYO
	MOV #15,D
UTYOR:	RTS PC
TYOT:	0
	0
CH:	0
TYI:	JMP @#STYI
STYI:	WAIT
	TSTB TKS
	BPL STYI
	MOVB TKB,D
	BIC #177200,D
	BR STYO
UTYI:	WAIT
	TST CHI
	BEQ UTYI
	MOVB CHI,D
	CLR	CHI
	BIC #177600,D
	BR TYO
	.STITL	GARBAGE COLLECTOR
NNODES==4096.
GCBTL== NNODES/8./2.*2.+2.	;GARBAGE COLLECT BIT TABLE LENGTH

MARKN:	SPUSH A	;MARK NODE(B)
	SPUSH B
	MOV B,A
	BIC #170000,A
	BIC #177770,B
	MOVB BMT(B),B
	ASR A
	ASR A
	ASR A
	ADD GCBITS,A
	BISB B,(A)
	SPOP B
	SPOP A
	RTS PC

BMT:	.BYTE 1,2,4,10,20,40,100,200
	.IFNZ GCDBUG
LMT:	DMK	;SYSTEM FUNCTION
	DMK	;INFIX (SYSTEM FUNCTION)
	DMK	;USER FUNCTION
	DMK	;VARIABLE BINDING
	GCDIE	;UNUSED
	GCDIE	;UNUSED
	GCDIE	;UNUSED
	DMK	;SHORT STRING
	MKSNP	;SNAP
	DMK	;ATOM
	DMK	;SHORT NUMBER
	GCMARK	;LONG NUMBEB
	GCMARK	;LONG STRING
	GCDIE	;TBA
	GCMARK	;SENTENCE
	GCMARK	;LIST
	.ENDC


MARKL:	CMP	B,#SNP	;IS LIST A SNAP?
	BLOS	MKL0	;NO
	CMP	B,#<SNP+10000>
	BLO	MKSNPL	;YES
MKL0:	PUSH A	;MARK LIST
	SPUSH B	;NODE ADDS IN B
	SPUSH C
	.IFNZ GCDBUG
	SPUSH D
	.ENDC
	MOV B,A
MKL1:	MOV A,C
	BIT #7777,C	;IS THERE ANOTHER NODE
	BEQ MKL3
	MOV C,B	;YES, MARK IT
	JSR PC, MARKN
	JSR PC,.LOADC	;GET IT

	.IFNZ GCDBUG
	MOV A,D
	SWAB D
	BIC #177417,D
	ASR D
	ASR D
	ASR D	;ALL THIS GIVES YOU THE TYPE*2
	JMP @LMT(D)	;WHICH YOU MIGHT MARK ON

DMK:	BR MKL1
GCDIE:	HALT
GCMARK:	JSR PC,MARKL
	BR MKL1
	.ENDC
MKSNPL:	EXCH	SNPTEM,C	;B POINTS TO SNAP
	JSR	PC,MKDC
	MOV	SNPTEM,C	;RESTORE C
	BR	MKL0
MKSNP:	JSR	PC,MKDC	;ONLY MARKS THE DISPLAY CODE
	JSR	PC,MKL0	;ALSO NEED TO MARK THE NODES
	BR	MKL1

	.IFZ GCDBUG
	BIC #7777,A
	CMP #100000,A
	BLO MKL1
	BEQ MKSNP
	CMP #120000,A
	BLOS MKL1
	JSR PC,MARKL
	BR MKL1
	.ENDC

MKL3:	.IFNZ GCDBUG
	SPOP D
	.ENDC
	SPOP C
	SPOP B
	POP A
	RTS PC

.GCOLL:	JSR F,ACSAV
	PUSH ACRELF
	MOV USER,U
.GCOL2:	TST GCLOCK	;IS SOMEONE ELSE GC'ING?
	BLT .GCOL3	;NO, GO AHEAD
	JSR PC,FLUSH	;WAIT
	BR .GCOL2
.GCOL3:	MOV U,GCLOCK
	JSR PC,RUNME
	MOV GCBITS,A	;GARBAGE COLLECT
	MOV #GCBTL/2-1,B	;CLEAR BIT TABLE
	MOV #1,(A)+	;ALWAYS PROTECT NODE ZERO
.GCOL1:	CLR (A)+
	DEC B
	BGT .GCOL1
	PUSHS	SNLIST	;PROTECT THESE LOSERS
	SPUSHS	#TRUE
	SPUSHS	#FALSE

	MOV #RELE,ACRELF
	MOV #HCC,F	;NUMBER OF HASH CODE ELEMENTS
	MOV SUHCT,E	;ADDRESS OF HASH TABLE
MKUOBL:	DEC F
	BLT MKTPS
	MOV (E)+,D	;GET A HASH CODE ELEMENT
MKUOBI:	MOV D,C
	BEQ MKUOBL	;NO MORE
	MOV D,B	;MARK THE NODE
	JSR PC,MARKN
	JSR PC,.LOADC
	MOV A,D
	MOV B,C
	JSR PC,MARKN	;MARK NODE POINTED TO BY THIS ONE
	JSR PC,.LOADC	;THEN GET IT
	JSR PC,MARKL	;SHOULD BE PNAME POINTER NODE
	MOV A,C
MKUOE:	BIT #7777,C	;ONE OTHER NODE?
	BEQ MKUOBI	;NO
	MOV C,B	;YES
	JSR PC,MARKN	;MARK IT
	JSR PC,.LOADC
	MOV	C,SNPTEM	;SAVE IN CASE VBIND IS SNAP
	MOV A,C
	BIC #7777,A
	CMP #FBIND,A
	BEQ MKFB	;FUNCTION BINDING
	CMP #VBIND,A
	BEQ MKVB	;VARIABLE BINDING
	CMP #SFBIND,A
	BEQ MKSFB	;SWAPPED FB
	CMP #SVBIND,A
	BEQ MKSVB	;SWAPPED VB
	HALT	;BUG
MKVB:	JSR PC,MARKL
	BR MKUOE
MKFB:	JSR PC,MARKL
	BR MKUOE
MKSVB:	BR MKUOE
MKSFB:	JSR PC,MARKL
	BR MKUOE


MKTPS:	MOV #GCMKL,F
MKRNDM:	MOV (F)+,B	;POINTER TO POINTER
	BEQ MKSPDL	;LAST ONE
	MOV (B),B	;REAL NODE ADDRESS
	BEQ MKRNDM	;NOTHING THERE
	JSR PC,MARKL
	BR MKRNDM
MKSPDL:	MOV SPBASE,E
MKSP1:	MOV -(E),B	;GET A S PDL WORD
	CMP E,S	;END OF S PDL?
	BLT MKSP2	;YES
	JSR PC,MARKL	;MARK S PDL WORD
	BR MKSP1
MKSP2:	MOV SPBASE,A
	TST (A)+
	BNE MKSP3	;THERE I S PDL ON DISK, GO MARK IT
	TST (A)
	BEQ MKSP4
MKSP3:	JSR PC,UBLKGR
	HALT
	HALT
	MOV B,SSAVEA
	MOV C,SSAVEA+2	;PLACE TO SAVE S PDL
	MOV SSWPAD,4(A)
	MOVB #DWRTEC,14(A)	;WRITE OUT CURRENT S PDL
	JSR PC,DSKWA2
MKSP8:	MOV SPBASE,B
	TST (B)+	;IS @HERE ANODHER BLOCK ON DHSK?
	BNE MKSP5	;YES
	TST (B)
	BEQ MKSP6	;NO
MKSP5:	JSR PC,SYDRBG	;PREPARE TO SWAP IN BLOCK
	CLR (A)+
	MOV #-200,(A)+
	MOV SSWPAD,(A)+
	MOV SPBASE,B
	MOV (B)+,(A)+
	MOV (B)+,(A)+
	TST (A)+
	MOVB #DREADC,(A)
	JSR PC,DSKWAI
	MOV #200,F
	MOV SPBASE,E
MKSP7:	MOV -(E),B	;M
RK THIS PIECE OF S PDL
	JSR PC,MARKL
	DEC F
	BGT MKSP7
	BR MKSP8
MKSP6:	JSR PC,SYDRBG	;PREPARE TO SWAP CURBENT PDLBACK
	CLR (A)+
	MOV #-200,(A)+
	MOV SSWPAD,(A)+
	MOV SSAVEA,(A)+
	MOV SSAVEA+2,(A)+
	TST (A)+
	MOVB #DREADC,(A)
	JSR PC,DSKWAI
	MOV SSAVEA,C
	JSR PC,UBLKFR
MKSP4:


	JSR PC,DSGCF
	ADD	#6,S	;GET RID OF 3 GUYS PUSHED BEFORE

		;OK NOW RETURN ALL IN MARKED NODES
		;RA ADDS OF LIT MAP
		;RB NODE ADDS
		;RC ACTUAL ADDER OF NODE
		;RD BIT MAP
	;RE POINT TO LIST OF FREE STORAGE RECYCLES NODES
		;START COLLECTING AT LUNN(LOWEST UNPROTECTED NODE #)
	CLR E
	CLR NNGC
	CLR B	;NODE ZERO
	MOV UAB,C	;NODE ZERO ADDRESS
	MOV NUNODE,F	;NUMBER OF NODES
	MOV GCBITS,A	;BIT TABLE ADDR
	MOV (A)+,D
	SEC
	ROR D

GCRT2:	BCS GCRT3
	MOV E,(C)+	;WE HAVE A NODE, LINK IN 1ST WORD
	CLR (C)+	;CLEAR SECOND
	MOV B,E	;NEW FREE STORAGE HEAD NODE
	INC NNGC
	BR GCRT4
GCRT3:	ADD #4,C
GCRT4:	INC B
	DEC F
	BLE GCRT5
	CLC
	ROR D
	BNE GCRT2
	MOV (A)+,D	;GET NEXT WORD OF BIT MAP
	SEC
	ROR D
	BR GCRT2
GCRT5:	MOV E,FREE	;YES

	MOV #-1,GCLOCK
	POP ACRELF
	JSR F,ACRES
	RTS PC