Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	TITLE	%META2 SUPPORT PACKAGE -- MICHAEL GREEN
	ENTRY	%BLOCK,%LOOK,%SET,%CHECK,%LIST,%BEGIN,%END
	ENTRY	%RESET,%COPYL,%COPYI,%ERROR,%TYPE,%STR,%LEN
	ENTRY	%GEN,%UNTIL,%TST,%PUSH,%POP,%ID,%NUM,%CLEAR
	ENTRY	%SCAN,%GETNM,%PUTNM,%XLEN,%XBLK,%GET,%PUT
	ENTRY	%LEVEL,%SYMB,%XSYMB,%BLEVL,%CLEVL,%FIN
	ENTRY	%MAKND,%SETRE,%CALND,%DMPTR,%CPYDC,%MARK
	EXTERN	%MESS1,%MESS2
	SEARCH JOBDAT

%RESET:	0
	JRST	RESET-1
	0
	SETOM	CCLSW
	MOVE	%RESET+2
	MOVEM	%RESET
	OPEN	3,CCLD
	JRST	RESET
	INBUF	3,2
	HRRZ	.JBFF
	MOVEM	JOBFFS
	JRST	.+4
	AOS	%RESET
RESET:	SETZM	CCLSW
	CALL	[SIXBIT/RESET/]
	MOVE	P,[IOWD ^D512,PDL]
	MOVE	STK1,[IOWD ^D128,HOLD]
	MOVE	STK2,[IOWD ^D512,TREE]
	MOVEM	STK1,SAVSTK
	MOVEM	STK2,SAVSTK+1
	SETZM	%MARK
	SETZM	ERRLN
	HRLZI	F,SUCCES
	MOVE	BUFFPT,[POINT 7,SCANBF]
	OPEN	TTYD
	HALT
ASKOUT:	SKIPLE	CCLSW
	JRST	ASKCOM
	SKIPE	CCLSW
	JRST	RDCCL
	MOVEI	015
	PUSHJ	P,TTYOUT
	MOVEI	012
	PUSHJ	P,TTYOUT
	MOVEI	"*"
	PUSHJ	P,TTYOUT
	PUSHJ	P,FORCET
ASKCOM:	MOVE	1,[POINT 7,%MESS1]
	ILDB	1
	CAIE	":"
	JRST	.-2
	ILDB	1
	MOVEM	1,CCLMSG
	PUSHJ	P,IODEV
	CAIE	"_"
	JRST	IODEVR
	MOVEM	DEV,OTPUTD+1
	MOVEM	FILE,OTPUTF
	SKIPN	EXT
	HLLZ	EXT,%MESS2
	HLLZM	EXT,OTPUTF+1
	SETZM	OTPUTF+2
	SETZM	OTPUTF+3
	OPEN	2,OTPUTD
	JRST	NOOPNO
	ENTER	2,OTPUTF
	JRST	NOENTR
ASKIN:	MOVE	1,[POINT 7,%MESS1]
	ILDB	1
	CAIE	":"
	JRST	.-2
	ILDB	1
	MOVEM	1,CCLMSG
	PUSHJ	P,IODEV
	CAIE	012
	JRST	IODEVR
	MOVEM	DEV,INPUTD+1
	MOVEM	FILE,INPUTF
	HLLZM	EXT,INPUTF+1
	SETZM	INPUTF+2
	SETZM	INPUTF+3
	OPEN	1,INPUTD
	JRST	NOOPNI
	LOOKUP	1,INPUTF
	JRST	NOLOOK
	SKIPN	CCLSW
	JRST	ASKCON
	MOVEI	0
	IDPB	CCLMSG
	MOVE	1,[POINT 7,%MESS1]
	ILDB	1
	JUMPE	.+3
	PUSHJ	P,TTYOUT
	JRST	.-3
	PUSHJ	P,FORCET
ASKCON:	SETZM	SCANBF
	SETZM	STACKA
	MOVE	[XWD STACKA,STACKA+1]
	BLT	STACKA+3*^D64*^D16-1
	SETZM	SAVEBF
	MOVE	[XWD STACKL,STACK]
	BLT	STACK+2
	SETZM	%LIST
	MOVE	[POINT 7,DICT]
	MOVEM	DICTCH
	SETOM	SCANPT
	SETOM	DICTPT
	SETOM	CURRNT
	SETZM	BLOCKI
	SETZM	BLOCKN
	SETZM	BLOCKP
	SETZM	BLOCK
	JRST	@%RESET
NOOPNI:	PUSHJ	P,%TYPE
	ASCIZ	/?CAN NOT OPEN INPUT DEVICE/
	JRST	RESET
NOLOOK:	PUSHJ	P,%TYPE
	ASCIZ	/?NO INPUT FILE FOUND/
	JRST	RESET
NOOPNO:	PUSHJ	P,%TYPE
	ASCIZ	/?CAN NOT OPEN OUTPUT DEVICE/
	JRST	RESET
NOENTR:	PUSHJ	P,%TYPE
	ASCIZ	/?CAN NOT CREATE OUTPUT FILE/
	JRST	RESET

IODEV:	SETZ	DEV,
	SETZ	FILE,
	SETZ	EXT,
LOOKNM:	SETZ	NAME,
	PUSHJ	P,TTYIN
	IDPB	CCLMSG
	CAIN	015
	JRST	LOOKNM+1
	CAIGE	"0"
	JRST	DELIM
	CAIG	"9"
	JRST	PACKNM
	CAIGE	"A"
	JRST	DELIM
	CAIG	"Z"
	JRST	PACKNM
	CAIGE	141
	JRST	DELIM
	CAIG	172
	JRST	PACKNM+1
IODEVR:	PUSHJ	P,%TYPE
	ASCIZ	/?ILLEGAL COMMAND/
	JRST	RESET
PACKNM:	XORI	40
	ANDI	77
	TLNE	NAME,770000
	JRST	LOOKNM+1
	LSH	NAME,6
	OR	NAME,
	JRST	LOOKNM+1
DELIM:	JUMPE	NAME,.+5
	TLNE	NAME,770000
	JRST	.+3
	LSH	NAME,6
	JRST	.-3
	CAIN	":"
	JRST	STRDEV
	CAIN	"."
	JRST	STRFIL
	CAIN	"_"
	JRST	.+5
	CAIN	"!"
	JRST	RUN
	CAIE	012
	JRST	IODEVR
	JUMPE	FILE,.+2
	SKIPA	EXT,NAME
	MOVE	FILE,NAME
	JUMPN	DEV,.+2
	HRLZI	DEV,(SIXBIT/DSK/)
	POPJ	P,
STRFIL:	JUMPN	FILE,IODEVR
	SKIPN	FILE,NAME
	JRST	IODEVR
	JRST	LOOKNM
STRDEV:	JUMPN	DEV,IODEVR
	SKIPN	DEV,NAME
	JRST	IODEVR
	JRST	LOOKNM

RDCCL:	SETZM	CCLINF+2
	SETZM	CCLINF+3
	MOVE	2,[POINT 7,%MESS1]
	MOVEI	0,0
	ILDB	1,2
	CAIN	1,":"
	JRST	SIXPAK
	ROT	1,-6
	ROTC	0,6
	TRC	0,40
	CAIGE	0,10000
	JRST	.-7
	JRST	.+5
SIXPAK:	CAIL	0,10000
	JRST	.+3
	LSH	0,6
	JRST	.-3
	MOVEM	CCLINF
	MOVSM	TMPLST
	MOVE	[XWD 2,TMPLST]
	CALL	[SIXBIT/TMPCOR/]
	JRST	NOTMP
	MOVE	[POINT 7,TMPBUF]
	MOVEM	CCLTMP
	JRST	ASKCOM
NOTMP:	SETZM	CCLTMP
	MOVEI	(SIXBIT/TMP/)
	MOVSM	CCLINF+1
	CALL	[SIXBIT/PJOB/]
	IDIVI	^D10
	LSHC	1,-6
	IDIVI	^D10
	LSHC	1,-6
	IDIVI	^D10
	LSHC	1,-6
	OR	2,[SIXBIT/000   /]
	HLLM	2,CCLINF
	LOOKUP	3,CCLINF
	JRST	RESET
	JRST	ASKCOM

CCLIN:	SKIPE	CCLTMP
	JRST	TMPFET
	SOSG	CCLINB+2
	JRST	CCLING
	ILDB	CCLINB+1
	JUMPE	CCLIN+2
	POPJ	P,
CCLING:	IN	3,
	JRST	CCLIN+4
	STATO	3,740000
	JRST	ENDCCL
CCLRDR:	PUSHJ	P,%TYPE
	ASCIZ	/?COMMAND READ ERROR/
	JRST	RESET

TMPFET:	ILDB	CCLTMP
	JUMPE	.+2
	POPJ	P,
	CALL	[SIXBIT/EXIT/]

TTYIN:	SKIPE	CCLSW
	JRST	CCLIN
	SOSG	TTYINB+2
	JRST	TTYING
	ILDB	TTYINB+1
	JUMPE	TTYIN+2
	POPJ	P,
TTYING:	IN
	JRST	TTYIN+4
	HALT
TTYOUT:	CAIN	032
	POPJ	P,
	SOSG	TTYOTB+2
	JRST	TTYOTP
	IDPB	TTYOTB+1
	POPJ	P,
TTYOTP:	OUT
	JRST	TTYOUT+4
	HALT

%TYPE:	MOVEI	(^D36B5+7B11)
	HRLM	(P)
	ILDB	(P)
	JUMPE	TYPEEX
	PUSHJ	P,TTYOUT
	JRST	%TYPE+2
TYPEEX:	MOVEI	015
	PUSHJ	P,TTYOUT
	MOVEI	012
	PUSHJ	P,TTYOUT
	OUT
	AOSA	TTYOTB+2
	HALT
	AOS	(P)
	POPJ	P,

FORCET:	OUT
	AOSA	TTYOTB+2
	HALT
	POPJ	P,

TTYD:	XWD	0,1
	SIXBIT	/TTY/
	XWD	TTYOTB,TTYINB
TTYINB:	BLOCK	3
TTYOTB:	BLOCK	3

INPUTD:	XWD	0,0
	SIXBIT	/   /
	XWD	0,INPUTB
INPUTF:	BLOCK	4
INPUTB:	BLOCK	3

OTPUTD:	XWD	0,0
	SIXBIT	/   /
	XWD	OTPUTB,0
OTPUTF:	BLOCK	4
OTPUTB:	BLOCK	3

CCLD:	XWD	0,0
	SIXBIT	/DSK/
	XWD	0,CCLINB
CCLINB:	BLOCK	3
CCLINF:	BLOCK	4
CCLSW:	BLOCK	1
CCLMSG:	BLOCK	1
CCLTMP:	BLOCK	1
TMPLST:	BLOCK	1
	IOWD	^D63,TMPBUF
TMPBUF:	BLOCK	^D64

%FIN:	RELEAS	0,
	RELEAS	1,
	RELEAS	2,
	SKIPN	CCLSW
	JRST	RESET
	MOVE	JOBFFS
	HRRM	.JBFF
	MOVEI	1
	MOVEM	CCLSW
	JRST	RESET+2

JOBFFS:	BLOCK	1

ENDCCL:	CLOSE	3,
	SETZM	CCLINF
	SETZM	CCLINF+3
	RENAME	3,CCLINF
	JRST	CCLRDR
	CALL	[SIXBIT/EXIT/]

RUN:	MOVEM	NAME,RUNBLK+1
	SKIPE	CCLTMP
	JRST	.+6
	CLOSE	3,
	SETZM	CCLINF
	SETZM	CCLINF+3
	RENAME	3,CCLINF
	JRST	CCLRDR
	MOVSI	1
	HRRI	RUNBLK
	CALL	[SIXBIT/RUN/]
	HALT

RUNBLK:	SIXBIT	/SYS/
	SIXBIT	/      /
	EXP	0,0,0,0

NAME=	6
DEV=	7
FILE=	10
EXT=	11

%ERROR:	PUSHJ	P,%TYPE
	ASCIZ	/?FATAL SYNTAX ERROR/
	SKIPN	ERRLN
	JRST	FATAL
	PUSHJ	P,%TYPE
	ASCII	/  IN LINE /
ERRLN:	EXP	0,0
FATAL:	PUSHJ	P,%TYPE
	ASCIZ	/  DETECTED AT:/
	MOVEI	1
	MOVEM	%LIST
	PUSHJ	P,%UNTIL+1
	BYTE	(7) 015,012,0
	JUMPGE	F,%FIN
	PUSHJ	P,%UNTIL+1
	BYTE	(7) 015,012,0
	JUMPGE	F,%FIN
	PUSHJ	P,%UNTIL+1
	BYTE	(7) 015,012,0
	JRST	%FIN

INPUT:	SETZM	INPUTX
	SOSG	INPUTB+2
	JRST	INPUTG
	IBP	INPUTB+1
	MOVE	@INPUTB+1
	TRNN	1
	JRST	.+4
	MOVEM	ERRLN
	SETOM	INPUTX
	JRST	INPUT+1
	AOSG	INPUTX
	JRST	INPUT+1
	LDB	INPUTB+1
	JUMPE	INPUT
	POPJ	P,
INPUTG:	IN	1,
	JRST	INPUT+3
	STATO	1,020000
	JRST	INPUTE
	MOVEI	032
	POPJ	P,
INPUTE:	PUSHJ	P,%TYPE
	ASCIZ	/?INPUT ERROR/
	JRST	%FIN
INPUTX:	0

OUTPUT:	SOSG	OTPUTB+2
	JRST	OTPUTP
	IDPB	OTPUTB+1
	POPJ	P,
OTPUTP:	OUT	2,
	JRST	OUTPUT+2
	PUSHJ	P,%TYPE
	ASCIZ	/?OUTPUT ERROR/
	JRST	%FIN

GETINP:	ILDB	CHAR
	JUMPE	.+4
	SKIPLE	%LIST
	PUSHJ	P,TTYOUT
	POPJ	P,
	PUSHJ	P,INPUT
	SKIPE	%LIST
	PUSHJ	P,TTYOUT
	DPB	CHAR
	MOVE	TEMP1,CHAR
	MOVEI	TEMP2,0
	IDPB	TEMP2,TEMP1
	CAME	TEMP1,[POINT 7,SCANBF+^D64-1,^D34]
	POPJ	P,
	PUSHJ	P,%TYPE
	ASCIZ	/?BUFFER OVERFLOW/
	JRST	FATAL

%COPYL:	MOVEI	(^D36B5+7B11)
	HRLM	(P)
	ILDB	(P)
	JUMPN	.+3
	AOS	(P)
	POPJ	P,
	PUSHJ	P,OUTPUT
	JRST	%COPYL+2

%LEN:	MOVE	TEMP1,[POINT 7,SAVEBF]
	MOVEI	0
LENLOP:	ILDB	1,TEMP1
	JUMPE	1,EDITNM
	CAIN	1,177
	JRST	LENLOP
	AOJA	LENLOP

%COPYI:	MOVE	TEMP1,[POINT 7,SAVEBF]
	ILDB	TEMP1
	JUMPE	.+3
	PUSHJ	P,OUTPUT
	JRST	%COPYI+1
	POPJ	P,

DELETE:	TLNE	F,BACKUP
	SKIPA	CHAR,BUFFPT
	MOVE	CHAR,[POINT 7,SCANBF]
DELETL:	PUSHJ	P,GETINP
	CAIN	" "
	JRST	DELETL
	CAIGE	011
	JRST	TSTSUC
	CAIG	015
	JRST	DELETL

TSTSUC:	MOVE	BUFFPT,CHAR
	IBP	BUFFPT
	IBP	BUFFPT
	IBP	BUFFPT
	IBP	BUFFPT
	SOJ	BUFFPT,
	TLNE	F,NDELET
	JRST	TSTNDL
	TLZ	F,BACKUP
	MOVE	TEMP1,[POINT 7,SCANBF]
	CAMN	CHAR,[POINT 7,SCANBF,6]
	POPJ	P,
	LDB	CHAR
	SKIPA
TSTREP:	ILDB	CHAR
	IDPB	TEMP1
	JUMPN	TSTREP
	POPJ	P,
TSTNDL:	TLO	F,BACKUP
	POPJ	P,

MATCH:	MOVE	TEMP1,[POINT 7,SAVEBF]
	TLNE	F,NDELET
	SKIPA	TEMP2,BUFFPT
	MOVE	TEMP2,[POINT 7,SCANBF]
MATCHL:	ILDB	TEMP2
	CAMN	TEMP2,CHAR
	JRST	MATCHE
	CAIN	177
	JRST	MATCHL
	IDPB	TEMP1
	CAME	TEMP1,[POINT 7,SAVEBF+^D32-1,^D34]
	JRST	MATCHL
	PUSHJ	P,%TYPE
	ASCIZ	/?SYMBOL TOO LONG/
	JRST	FATAL
MATCHE:	MOVEI	0
	IDPB	TEMP1
	TLO	F,SUCCES
	JRST	TSTSUC

%GEN:	MOVEI	"$"
	PUSHJ	P,OUTPUT
	HLRZ	-1(P)
	ADD	@(P)
	AOS	(P)
EDITNM:	IDIVI	^D10
	HRLM	1,(P)
	JUMPE	.+2
	PUSHJ	P,EDITNM
	HLRZ	(P)
	ADDI	"0"
	PUSHJ	P,OUTPUT
	POPJ	P,

%UNTIL:	PUSHJ	P,DELETE
	MOVEI	(^D36B5+7B11)
	HRLM	(P)
	TLNE	F,BACKUP
	SKIPA	CHAR,BUFFPT
	MOVE	CHAR,[POINT 7,SCANBF]
	TLZ	F,SUCCES
UNTILL:	MOVE	TEMP4,(P)
	ILDB	TEMP3,TEMP4
	JUMPE	TEMP3,TSTEXT
	PUSHJ	P,GETINP
	CAIN	032
	JRST	TSTQUT
	CAIE	(TEMP3)
	JRST	.-4
	MOVE	TEMP5,CHAR
UNTILM:	ILDB	TEMP3,TEMP4
	JUMPE	TEMP3,TSTEXX
	PUSHJ	P,GETINP
	CAIN	032
	JRST	TSTQUT
	CAIN	(TEMP3)
	JRST	UNTILM
	MOVE	CHAR,TEMP5
	JRST	UNTILL
TSTEXX:	MOVEM	TEMP4,(P)
	JRST	TSTEXT

%TST:	PUSHJ	P,DELETE
	MOVEI	(^D36B5+7B11)
	HRLM	(P)
	TLNE	F,BACKUP
	SKIPA	CHAR,BUFFPT
	MOVE	CHAR,[POINT 7,SCANBF]
	TLZ	F,SUCCES
TSTLOP:	ILDB	TEMP3,(P)
	JUMPE	TEMP3,TSTEXT
	PUSHJ	P,GETINP
	CAIN	(TEMP3)
	JRST	TSTLOP
	CAIE	TEMP3," "
	JRST	TSTQUT
	CAIGE	011
	JRST	TSTQUT
	CAIG	015
	JRST	TSTLOP
TSTQUT:	ILDB	(P)
	JUMPN	.-1
	AOS	(P)
	POPJ	P,
TSTEXT:	AOS	(P)
	TLO	F,SUCCES
	IBP	CHAR
	JRST	TSTSUC

%NUM:	PUSHJ	P,DELETE
	TLNE	F,BACKUP
	SKIPA	CHAR,BUFFPT
	MOVE	CHAR,[POINT 7,SCANBF]
	TLZ	F,SUCCES
	PUSHJ	P,GETINP
	CAIGE	"0"
	POPJ	P,
	CAILE	"9"
	POPJ	P,
NUMLOP:	PUSHJ	P,GETINP
	CAIGE	"0"
	JRST	MATCH
	CAILE	"9"
	JRST	MATCH
	JRST	NUMLOP

%PUT:	POP	P,TEMP2
	EXCH	TEMP2,(P)
	MOVE	TEMP1,@(P)
	AOS	(P)
	SOJL	TEMP2,STKERR
	IMULI	TEMP2,^D16
	ADD	TEMP2,STACKL-1(TEMP1)
	CAMLE	TEMP2,STACK-1(TEMP1)
	JRST	STKERR
	TLZE	F,SCATEN
	JRST	PUSHED
	JRST	PUSHOK

STKERR:	PUSHJ	P,%TYPE
	ASCIZ	/?STACK LIMIT ERROR/
	JRST	FATAL

%PUSH:	MOVE	TEMP1,@(P)
	AOS	(P)
	MOVE	TEMP2,STACK-1(TEMP1)
	TLZE	F,SCATEN
	JRST	PUSHED
	MOVEI	TEMP3,^D16
	ADDM	TEMP3,STACK-1(TEMP1)
	CAME	TEMP2,STACKU-1(TEMP1)
	JRST	PUSHOK
STKOVF:	PUSHJ	P,%TYPE
	ASCIZ	/?STACK OVERFLOW/
	JRST	FATAL
PUSHED:	SUBI	TEMP2,^D16
	CAMGE	TEMP2,STACKL-1(TEMP1)
	JRST	STKERR
	ILDB	TEMP2
	JUMPN	.-1
	IBP	TEMP2
	IBP	TEMP2
	IBP	TEMP2
	IBP	TEMP2
	SOJ	TEMP2,
PUSHOK:	MOVE	TEMP3,TEMP2
	ADDI	TEMP3,^D16
	JUMPL	TEMP1,PUSHL
	MOVE	TEMP1,[POINT 7,SAVEBF]
	ILDB	TEMP1
	IDPB	TEMP2
	CAMN	TEMP2,TEMP3
	JRST	STKOVF
	JUMPN	.-4
	POPJ	P,
PUSHL:	MOVEI	(^D36B5+7B11)
	HRLM	(P)
	ILDB	(P)
	IDPB	TEMP2
	CAMN	TEMP2,TEMP3
	JRST	STKOVF
	JUMPN	.-4
	AOS	(P)
	POPJ	P,

%POP:	MOVE	TEMP1,@(P)
	AOS	(P)
	MOVE	TEMP2,STACK-1(TEMP1)
	CAME	TEMP2,STACKL-1(TEMP1)
	JRST	POPOK
	SETZM	SAVEBF
	POPJ	P,
%GET:	POP	P,TEMP2
	EXCH	TEMP2,(P)
	MOVE	TEMP1,@(P)
	AOS	(P)
	SOJL	TEMP2,STKERR
	IMULI	TEMP2,^D16
	ADD	TEMP2,STACKL-1(TEMP1)
	CAMLE	TEMP2,STACK-1(TEMP1)
	JRST	STKERR
	JRST	POPCPY
POPOK:	SUBI	TEMP2,^D16
	MOVEM	TEMP2,STACK-1(TEMP1)
POPCPY:	MOVE	TEMP1,[POINT 7,SAVEBF]
	ILDB	TEMP2
	IDPB	TEMP1
	JUMPN	.-2
	POPJ	P,

%LEVEL:	MOVE	TEMP1,@(P)
	AOS	(P)
	MOVE	TEMP2,STACK-1(TEMP1)
	SUB	TEMP2,STACKL-1(TEMP1)
	ANDI	TEMP2,777760
	LSH	TEMP2,-4
	EXCH	TEMP2,(P)
	JRST	(TEMP2)

%ID:	PUSHJ	P,DELETE
	TLNE	F,BACKUP
	SKIPA	CHAR,BUFFPT
	MOVE	CHAR,[POINT 7,SCANBF]
	TLZ	F,SUCCES
	PUSHJ	P,GETINP
	CAIGE	"A"
	POPJ	P,
	CAIG	"Z"
	JRST	IDLOOP
	CAIGE	141
	POPJ	P,
	CAILE	172
	POPJ	P,
IDLOOP:	PUSHJ	P,GETINP
	CAIGE	"0"
	JRST	MATCH
	CAIG	"9"
	JRST	IDLOOP
	CAIGE	"A"
	JRST	MATCH
	CAIG	"Z"
	JRST	IDLOOP
	CAIGE	141
	JRST	MATCH
	CAIG	172
	JRST	IDLOOP
	JRST	MATCH

%STR:	PUSHJ	P,DELETE
	TLNE	F,BACKUP
	SKIPA	CHAR,BUFFPT
	MOVE	CHAR,[POINT 7,SCANBF]
	TLZ	F,SUCCES
	PUSHJ	P,GETINP
	CAIE	042
	POPJ	P,
	MOVEI	"\"
	DPB	CHAR
STRLOP:	PUSHJ	P,GETINP
	CAIN	"\"
	JRST	STRERR
	CAIE	042
	JRST	STRLOP
	MOVE	TEMP3,CHAR
	PUSHJ	P,GETINP
	CAIN	042
	JRST	STRSUB
	MOVEI	"\"
	DPB	TEMP3
	JRST	MATCH
STRSUB:	MOVEI	177
	DPB	CHAR
	JRST	STRLOP
STRERR:	PUSHJ	P,%TYPE
	ASCIZ	/?"\" FATAL ERROR/
	JRST	FATAL

%BEGIN:	AOS	TEMP1,BLOCKP
	CAIGE	TEMP1,^D16
	JRST	BEGINC
	PUSHJ	P,%TYPE
	ASCIZ	/?TOO MANY LEVELS/
	JRST	FATAL
BEGINC:	AOS	TEMP2,BLOCKN
	MOVEM	TEMP2,BLOCK(TEMP1)
	MOVE	TEMP2,DICTCH
	MOVEM	TEMP2,DICTCH(TEMP1)
	MOVE	TEMP2,DICTPT
	MOVEM	TEMP2,DICTPT(TEMP1)
	SETZM	BLOCKI(TEMP1)
	POPJ	P,

%END:	SOSL	TEMP1,BLOCKP
	JRST	ENDC
	PUSHJ	P,%TYPE
	ASCIZ	/?TOO MANY .END S/
	JRST	FATAL
ENDC:	MOVE	TEMP2,DICTCH+1(TEMP1)
	MOVEM	TEMP2,DICTCH
	MOVE	TEMP2,DICTPT+1(TEMP1)
	MOVEM	TEMP2,DICTPT
	CAMGE	TEMP2,CURRNT
	SETOM	CURRNT
	POPJ	P,

%SET:	SKIPL	TEMP1,CURRNT
	JRST	SETOK
	PUSHJ	P,%TYPE
	ASCIZ	/?NO LOOKUP PERFORMED/
	JRST	FATAL
SETOK:	MOVSI	TEMP2,400000
	MOVE	TEMP3,@(P)
	AOS	(P)
	ROT	TEMP2,(TEMP3)
	ORM	TEMP2,FLAGS(TEMP1)
	POPJ	P,

%CHECK:	TLZ	F,SUCCES
	SKIPGE	TEMP1,CURRNT
	JRST	%SET+2
	MOVSI	TEMP2,400000
	MOVE	TEMP3,@(P)
	AOS	(P)
	ROT	TEMP2,(TEMP3)
	TDNE	TEMP2,FLAGS(TEMP1)
	TLO	F,SUCCES
	POPJ	P,

%BLOCK:	SKIPA
	JRST	CBLOCK
	SKIPGE	TEMP1,CURRNT
	JRST	%SET+2
	HLRZ	CONTEX(TEMP1)
	JRST	EDITNM
CBLOCK:	MOVE	TEMP1,BLOCKP
	MOVE	BLOCK(TEMP1)
	JRST	EDITNM

%CLEAR:	SKIPGE	TEMP1,CURRNT
	JRST	%SET+2
	MOVSI	TEMP2,400000
	MOVE	TEMP3,@(P)
	AOS	(P)
	ROT	TEMP2,(TEMP3)
	ANDCAM	TEMP2,FLAGS(TEMP1)
	POPJ	P,

%LOOK:	TLZ	F,SUCCES
	MOVE	TEMP4,@(P)
	AOS	(P)
	SKIPGE	TEMP1,DICTPT
	JRST	NOFIND
LOOKLP:	JUMPG	TEMP4,CHARSU
	HLRZ	TEMP2,CONTEX(TEMP1)
	MOVE	TEMP3,BLOCKP
	CAME	TEMP2,BLOCK(TEMP3)
	JRST	LOOKSK
CHARSU:	MOVE	TEMP2,SYMBOL(TEMP1)
	MOVE	TEMP3,[POINT 7,SAVEBF]
CHARLP:	ILDB	CHAR,TEMP2
	ILDB	TEMP3
	CAIE	(CHAR)
	JRST	LOOKSK
	JUMPN	CHARLP
	MOVEM	TEMP1,CURRNT
	TLO	F,SUCCES
	POPJ	P,
LOOKSK:	SOJGE	TEMP1,LOOKLP
NOFIND:	CAIE	TEMP4,0
	CAIN	TEMP4,1
	POPJ	P,
	AOS	TEMP1,DICTPT
	CAIGE	TEMP1,^D256
	JRST	WILLFT
FULL:	PUSHJ	P,%TYPE
	ASCIZ	/?DICTIONARY FULL/
	JRST	FATAL
WILLFT:	MOVE	TEMP2,BLOCKP
	AOS	TEMP3,BLOCKI(TEMP2)
	HRRM	TEMP3,CONTEX(TEMP1)
	SETZM	FLAGS(TEMP1)
	MOVE	TEMP2,BLOCK(TEMP2)
	HRLM	TEMP2,CONTEX(TEMP1)
	MOVE	TEMP2,DICTCH
	MOVEM	TEMP2,SYMBOL(TEMP1)
	MOVE	TEMP3,[POINT 7,SAVEBF]
INSLOP:	CAMN	TEMP2,[POINT 7,DICT+^D512-1,^D34]
	JRST	FULL
	ILDB	CHAR,TEMP3
	IDPB	CHAR,TEMP2
	JUMPN	CHAR,INSLOP
	MOVEM	TEMP2,DICTCH
	MOVEM	TEMP1,CURRNT
	TLO	F,SUCCES
	POPJ	P,

%SCAN:	MOVE	TEMP4,@(P)
	AOS	(P)
	JUMPN	TEMP4,NSTART
	MOVE	TEMP1,DICTPT
	MOVEM	TEMP1,SCANPT
	SETOM	CURRNT
	POPJ	P,
NSTART:	CAIE	TEMP4,1
	POPJ	P,
	SETOM	CURRNT
	TLZ	F,SUCCES
	SKIPGE	TEMP1,SCANPT
	POPJ	P,
	SOS	SCANPT
	MOVE	TEMP2,BLOCKP
	HLRZ	TEMP3,CONTEX(TEMP1)
	CAME	TEMP3,BLOCK(TEMP2)
	POPJ	P,
	MOVEM	TEMP1,CURRNT
	TLO	F,SUCCES
	MOVE	TEMP2,SYMBOL(TEMP1)
	JRST	POPCPY

%XLEN:	PUSH	P,(P)
	MOVE	TEMP3,[POINT 7,SAVEBF]
	SETZM	-1(P)
XLENL:	ILDB	TEMP1,TEMP3
	JUMPE	TEMP1,XLENX
	CAIN	TEMP1,177
	JRST	XLENL
	AOS	-1(P)
	JRST	XLENL
XLENX:	POPJ	P,

%XBLK:	SKIPA
	JRST	XBLKX
	SKIPGE	TEMP1,CURRNT
	JRST	%SET+2
	HLRZ	TEMP2,CONTEX(TEMP1)
	PUSH	P,(P)
	MOVEM	TEMP2,-1(P)
	POPJ	P,
XBLKX:	PUSH	P,(P)
	MOVE	TEMP1,BLOCKP
	MOVE	TEMP1,BLOCK(TEMP1)
	MOVEM	TEMP1,-1(P)
	POPJ	P,

%PUTNM:	POP	P,TEMP1
	EXCH	TEMP1,(P)
	MOVE	TEMP3,[POINT 7,SAVEBF]
	JUMPGE	TEMP1,.+4
	MOVM	TEMP1,TEMP1
	MOVEI	TEMP2,"-"
	IDPB	TEMP2,TEMP3
	PUSHJ	P,PUTNMA
	SETZ	TEMP2,
	JRST	STOREA
PUTNMA:	IDIVI	TEMP1,^D10
	HRLM	TEMP2,(P)
	JUMPE	TEMP1,.+2
	PUSHJ	P,PUTNMA
	HLRZ	TEMP2,(P)
	ADDI	TEMP2,"0"
STOREA:	IDPB	TEMP2,TEMP3
	POPJ	P,

%GETNM:	PUSH	P,(P)
	MOVE	TEMP3,[POINT 7,SAVEBF]
	SETZ	TEMP2,
	MOVEI	TEMP1,1
	MOVEM	TEMP1,-1(P)
	ILDB	TEMP1,TEMP3
	CAIE	TEMP1,"-"
	JRST	.+3
	SETOM	-1(P)
	ILDB	TEMP1,TEMP3
	JUMPE	TEMP1,.+2
GETNML:	CAILE	TEMP1,"9"
	POPJ	P,
	CAIGE	TEMP1,"0"
	POPJ	P,
	SUBI	TEMP1,"0"
	IMULI	TEMP2,^D10
	ADDI	TEMP2,(TEMP1)
	ILDB	TEMP1,TEMP3
	JUMPN	TEMP1,GETNML
	IMULM	TEMP2,-1(P)
	POPJ	P,

%SYMB:	SKIPGE	TEMP1,CURRNT
	JRST	%SET+2
	HRRZ	CONTEX(TEMP1)
	JRST	EDITNM

%XSYMB:	SKIPGE	TEMP1,CURRNT
	JRST	%SET+2
	HRRZ	TEMP2,CONTEX(TEMP1)
	EXCH	TEMP2,(P)
	JRST	(TEMP2)

%CLEVL:	SKIPA
	JRST	CLEVLA
	MOVE	TEMP1,BLOCKP
	EXCH	TEMP1,(P)
	JRST	(TEMP1)
CLEVLA:	MOVE	BLOCKP
	JRST	EDITNM

%BLEVL:	SKIPA
	JRST	BLEVLA
	SKIPGE	TEMP1,CURRNT
	JRST	%SET+2
	HLRZ	TEMP1,CONTEX(TEMP1)
	MOVE	TEMP2,BLOCKP
	CAME	TEMP1,BLOCK(TEMP2)
	SOJGE	TEMP2,.-1
	EXCH	TEMP2,(P)
	JRST	(TEMP2)
BLEVLA:	SKIPGE	TEMP1,CURRNT
	JRST	%SET+2
	HLRZ	TEMP1,CONTEX(TEMP1)
	MOVE	TEMP2,BLOCKP
	CAME	TEMP1,BLOCK(TEMP2)
	SOJGE	TEMP2,.-1
	MOVE	TEMP2
	JRST	EDITNM

%MAKND:	HRRZ	TEMP1,@(P)
	PUSH	STK2,TEMP1
	HRRZ	TEMP1,STK2
	HLRZ	TEMP2,@(P)
	PUSH	STK2,TEMP2
	AOS	(P)
	JUMPE	TEMP2,.+4
	POP	STK1,TEMP3
	PUSH	STK2,TEMP3
	SOJG	TEMP2,.-2
	PUSH	STK1,TEMP1
	POPJ	P,

%SETRE:	MOVE	STK1,SAVSTK
	MOVE	STK2,SAVSTK+1
	SETZM	%MARK
	POPJ	P,

%DMPTR:	TLO	F,SUCCES
	CAME	STK1,[IOWD ^D128,HOLD]
	JRST	DMPTR
	PUSHJ	%TYPE
	ASCIZ	/?NO TREE/
	JRST	FATAL
DMPTR:	POP	STK1,TEMP1
	PUSH	P,SAVSTK
	PUSH	P,SAVSTK+1
	MOVEM	STK1,SAVSTK
	MOVEM	STK2,SAVSTK+1
	PUSH	P,%MARK
	MOVEM	TEMP1,%MARK
	PUSHJ	P,@(TEMP1)
	POP	P,%MARK
	POP	P,SAVSTK+1
	POP	P,SAVSTK
	MOVE	STK1,SAVSTK
	MOVE	STK2,SAVSTK+1
	POPJ	P,

%CALND:	TLO	F,SUCCES
	HRRZ	TEMP1,@(P)
	MOVE	TEMP2,%MARK
	ADD	TEMP2,1(TEMP2)
	SUB	TEMP2,TEMP1
	HLL	TEMP2,@(P)
	MOVE	TEMP1,2(TEMP2)
	AOS	(P)
	JUMPGE	TEMP2,RECURS
	EXCH	TEMP1,(P)
	JRST	(TEMP1)
RECURS:	CAIG	TEMP1,777777
	JUMPG	TEMP1,CALLVL
	TLNE	TEMP1,40
	JRST	.+3
	MOVE	TEMP2,TEMP1
	JRST	POPCPY
	HRRZM	TEMP1,CURRNT
	MOVE	TEMP2,SYMBOL(TEMP1)
	JRST	POPCPY
CALLVL:	PUSH	P,%MARK
	MOVEM	TEMP1,%MARK
	PUSHJ	P,@(TEMP1)
	POP	P,%MARK
	POPJ	P,

%CPYDC:	SKIPA	TEMP1,[POINT 7,SAVEBF]
	JRST	CPYDCT
	MOVNI	TEMP2,5
	ILDB	TEMP3,TEMP1
	JUMPE	TEMP3,.+2
	SOJA	TEMP2,.-2
	IDIVI	TEMP2,5
	HRLZI	TEMP2,(TEMP2)
	HRRI	TEMP2,SAVEBF
	HRRZI	TEMP1,1(STK2)
	HRLI	TEMP1,(POINT 7,0)
	PUSH	STK1,TEMP1
	PUSH	STK2,(TEMP2)
	AOBJN	TEMP2,.-1
	POPJ	P,
CPYDCT:	SKIPGE	TEMP1,CURRNT
	JRST	%SET+2
	PUSH	STK1,CURRNT
	HRROS	(STK1)
	POPJ	P,

SCATEN=	040000
BACKUP=	100000
NDELET=	200000
SUCCES=	400000
P=	17
F=	16
TEMP1=	13
TEMP2=	14
TEMP3=	15
TEMP4=	11
TEMP5=	10
BUFFPT=	5
CHAR=	12
STK1=	4
STK2=	3

HOLD:	BLOCK	^D128
TREE:	BLOCK	^D512
%MARK:	BLOCK	1
SAVSTK:	BLOCK	2

SCANBF:	BLOCK	^D64
SAVEBF:	BLOCK	^D32

STACK:	BLOCK	3
STACKL:	POINT	7,STACKA+0*^D64*^D16-1,^D34
STACKU:	POINT	7,STACKA+1*^D64*^D16-1,^D34
	POINT	7,STACKA+2*^D64*^D16-1,^D34
	POINT	7,STACKA+3*^D64*^D16-1,^D34
STACKA:	BLOCK	3*^D64*^D16

PDL:	BLOCK	^D512

%LIST:	BLOCK	1
DICTPT:	BLOCK	^D16
DICTCH:	BLOCK	^D16
CURRNT:	BLOCK	1
BLOCKI:	BLOCK	^D16
BLOCK:	BLOCK	^D16
BLOCKP:	BLOCK	1
BLOCKN:	BLOCK	1
SCANPT:	BLOCK	1

FLAGS:	BLOCK	^D256
CONTEX:	BLOCK	^D256
SYMBOL:	BLOCK	^D256
DICT:	BLOCK	^D512

	END