Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-02 - 43,50272/meta2.mac
There are 2 other files named meta2.mac in the archive. Click here to see a list.
00050		TITLE	%META2 SUPPORT PACKAGE -- MICHAEL GREEN
00100		ENTRY	%BLOCK,%LOOK,%SET,%CHECK,%LIST,%BEGIN,%END
00150		ENTRY	%RESET,%COPYL,%COPYI,%ERROR,%TYPE,%STR,%LEN
00200		ENTRY	%GEN,%UNTIL,%TST,%PUSH,%POP,%ID,%NUM,%CLEAR
00250		ENTRY	%SCAN,%GETNM,%PUTNM,%XLEN,%XBLK,%GET,%PUT
00300		ENTRY	%LEVEL,%SYMB,%XSYMB,%BLEVL,%CLEVL,%FIN
00350		ENTRY	%MAKND,%SETRE,%CALND,%DMPTR,%CPYDC,%MARK
00400		EXTERN	JOBFF,%MESS1,%MESS2
00450	
00500	%RESET:	0
00550		JRST	RESET-1
00600		0
00650		SETOM	CCLSW
00700		MOVE	%RESET+2
00750		MOVEM	%RESET
00800		OPEN	3,CCLD
00850		JRST	RESET
00900		INBUF	3,2
00950		HRRZ	JOBFF
01000		MOVEM	JOBFFS
01050		JRST	.+4
01100		AOS	%RESET
01150	RESET:	SETZM	CCLSW
01200		CALL	[SIXBIT/RESET/]
01250		MOVE	P,[IOWD ^D512,PDL]
01300		MOVE	STK1,[IOWD ^D128,HOLD]
01350		MOVE	STK2,[IOWD ^D512,TREE]
01400		MOVEM	STK1,SAVSTK
01450		MOVEM	STK2,SAVSTK+1
01500		SETZM	%MARK
01550		SETZM	ERRLN
01600		HRLZI	F,SUCCES
01650		MOVE	BUFFPT,[POINT 7,SCANBF]
01700		OPEN	TTYD
01750		HALT
01800	ASKOUT:	SKIPLE	CCLSW
01850		JRST	ASKCOM
01900		SKIPE	CCLSW
01950		JRST	RDCCL
02000		MOVEI	015
02050		PUSHJ	P,TTYOUT
02100		MOVEI	012
02150		PUSHJ	P,TTYOUT
02200		MOVEI	"*"
02250		PUSHJ	P,TTYOUT
02300		PUSHJ	P,FORCET
02350	ASKCOM:	MOVE	1,[POINT 7,%MESS1]
02400		ILDB	1
02450		CAIE	":"
02500		JRST	.-2
02550		ILDB	1
02600		MOVEM	1,CCLMSG
02650		PUSHJ	P,IODEV
02700		CAIE	"_"
02750		JRST	IODEVR
02800		MOVEM	DEV,OTPUTD+1
02850		MOVEM	FILE,OTPUTF
02900		SKIPN	EXT
02950		HLLZ	EXT,%MESS2
03000		HLLZM	EXT,OTPUTF+1
03050		SETZM	OTPUTF+2
03100		SETZM	OTPUTF+3
03150		OPEN	2,OTPUTD
03200		JRST	NOOPNO
03250		ENTER	2,OTPUTF
03300		JRST	NOENTR
03350	ASKIN:	MOVE	1,[POINT 7,%MESS1]
03400		ILDB	1
03450		CAIE	":"
03500		JRST	.-2
03550		ILDB	1
03600		MOVEM	1,CCLMSG
03650		PUSHJ	P,IODEV
03700		CAIE	012
03750		JRST	IODEVR
03800		MOVEM	DEV,INPUTD+1
03850		MOVEM	FILE,INPUTF
03900		HLLZM	EXT,INPUTF+1
03950		SETZM	INPUTF+2
04000		SETZM	INPUTF+3
04050		OPEN	1,INPUTD
04100		JRST	NOOPNI
04150		LOOKUP	1,INPUTF
04200		JRST	NOLOOK
04250		SKIPN	CCLSW
04300		JRST	ASKCON
04350		MOVEI	0
04400		IDPB	CCLMSG
04450		MOVE	1,[POINT 7,%MESS1]
04500		ILDB	1
04550		JUMPE	.+3
04600		PUSHJ	P,TTYOUT
04650		JRST	.-3
04700		PUSHJ	P,FORCET
04750	ASKCON:	SETZM	SCANBF
04800		SETZM	STACKA
04850		MOVE	[XWD STACKA,STACKA+1]
04900		BLT	STACKA+3*^D64*^D16-1
04950		SETZM	SAVEBF
05000		MOVE	[XWD STACKL,STACK]
05050		BLT	STACK+2
05100		SETZM	%LIST
05150		MOVE	[POINT 7,DICT]
05200		MOVEM	DICTCH
05250		SETOM	SCANPT
05300		SETOM	DICTPT
05350		SETOM	CURRNT
05400		SETZM	BLOCKI
05450		SETZM	BLOCKN
05500		SETZM	BLOCKP
05550		SETZM	BLOCK
05600		JRST	@%RESET
05650	NOOPNI:	PUSHJ	P,%TYPE
05700		ASCIZ	/?CAN NOT OPEN INPUT DEVICE/
05750		JRST	RESET
05800	NOLOOK:	PUSHJ	P,%TYPE
05850		ASCIZ	/?NO INPUT FILE FOUND/
05900		JRST	RESET
05950	NOOPNO:	PUSHJ	P,%TYPE
06000		ASCIZ	/?CAN NOT OPEN OUTPUT DEVICE/
06050		JRST	RESET
06100	NOENTR:	PUSHJ	P,%TYPE
06150		ASCIZ	/?CAN NOT CREATE OUTPUT FILE/
06200		JRST	RESET
06250	
06300	IODEV:	SETZ	DEV,
06350		SETZ	FILE,
06400		SETZ	EXT,
06450	LOOKNM:	SETZ	NAME,
06500		PUSHJ	P,TTYIN
06550		IDPB	CCLMSG
06600		CAIN	015
06650		JRST	LOOKNM+1
06700		CAIGE	"0"
06750		JRST	DELIM
06800		CAIG	"9"
06850		JRST	PACKNM
06900		CAIGE	"A"
06950		JRST	DELIM
07000		CAIG	"Z"
07050		JRST	PACKNM
07100		CAIGE	141
07150		JRST	DELIM
07200		CAIG	172
07250		JRST	PACKNM+1
07300	IODEVR:	PUSHJ	P,%TYPE
07350		ASCIZ	/?ILLEGAL COMMAND/
07400		JRST	RESET
07450	PACKNM:	XORI	40
07500		ANDI	77
07550		TLNE	NAME,770000
07600		JRST	LOOKNM+1
07650		LSH	NAME,6
07700		OR	NAME,
07750		JRST	LOOKNM+1
07800	DELIM:	JUMPE	NAME,.+5
07850		TLNE	NAME,770000
07900		JRST	.+3
07950		LSH	NAME,6
08000		JRST	.-3
08050		CAIN	":"
08100		JRST	STRDEV
08150		CAIN	"."
08200		JRST	STRFIL
08250		CAIN	"_"
08300		JRST	.+5
08350		CAIN	"!"
08400		JRST	RUN
08450		CAIE	012
08500		JRST	IODEVR
08550		JUMPE	FILE,.+2
08600		SKIPA	EXT,NAME
08650		MOVE	FILE,NAME
08700		JUMPN	DEV,.+2
08750		HRLZI	DEV,(SIXBIT/DSK/)
08800		POPJ	P,
08850	STRFIL:	JUMPN	FILE,IODEVR
08900		SKIPN	FILE,NAME
08950		JRST	IODEVR
09000		JRST	LOOKNM
09050	STRDEV:	JUMPN	DEV,IODEVR
09100		SKIPN	DEV,NAME
09150		JRST	IODEVR
09200		JRST	LOOKNM
09250	
09300	RDCCL:	SETZM	CCLINF+2
09350		SETZM	CCLINF+3
09400		MOVE	2,[POINT 7,%MESS1]
09450		MOVEI	0,0
09500		ILDB	1,2
09550		CAIN	1,":"
09600		JRST	SIXPAK
09650		ROT	1,-6
09700		ROTC	0,6
09750		TRC	0,40
09800		CAIGE	0,10000
09850		JRST	.-7
09900		JRST	.+5
09950	SIXPAK:	CAIL	0,10000
10000		JRST	.+3
10050		LSH	0,6
10100		JRST	.-3
10150		MOVEM	CCLINF
10200		MOVSM	TMPLST
10250		MOVE	[XWD 2,TMPLST]
10300		CALL	[SIXBIT/TMPCOR/]
10350		JRST	NOTMP
10400		MOVE	[POINT 7,TMPBUF]
10450		MOVEM	CCLTMP
10500		JRST	ASKCOM
10550	NOTMP:	SETZM	CCLTMP
10600		MOVEI	(SIXBIT/TMP/)
10650		MOVSM	CCLINF+1
10700		CALL	[SIXBIT/PJOB/]
10750		IDIVI	^D10
10800		LSHC	1,-6
10850		IDIVI	^D10
10900		LSHC	1,-6
10950		IDIVI	^D10
11000		LSHC	1,-6
11050		OR	2,[SIXBIT/000   /]
11100		HLLM	2,CCLINF
11150		LOOKUP	3,CCLINF
11200		JRST	RESET
11250		JRST	ASKCOM
11300	
11350	CCLIN:	SKIPE	CCLTMP
11400		JRST	TMPFET
11450		SOSG	CCLINB+2
11500		JRST	CCLING
11550		ILDB	CCLINB+1
11600		JUMPE	CCLIN+2
11650		POPJ	P,
11700	CCLING:	IN	3,
11750		JRST	CCLIN+4
11800		STATO	3,740000
11850		JRST	ENDCCL
11900	CCLRDR:	PUSHJ	P,%TYPE
11950		ASCIZ	/?COMMAND READ ERROR/
12000		JRST	RESET
12050	
12100	TMPFET:	ILDB	CCLTMP
12150		JUMPE	.+2
12200		POPJ	P,
12250		CALL	[SIXBIT/EXIT/]
12300	
12350	TTYIN:	SKIPE	CCLSW
12400		JRST	CCLIN
12450		SOSG	TTYINB+2
12500		JRST	TTYING
12550		ILDB	TTYINB+1
12600		JUMPE	TTYIN+2
12650		POPJ	P,
12700	TTYING:	IN
12750		JRST	TTYIN+4
12800		HALT
12850	TTYOUT:	CAIN	032
12900		POPJ	P,
12950		SOSG	TTYOTB+2
13000		JRST	TTYOTP
13050		IDPB	TTYOTB+1
13100		POPJ	P,
13150	TTYOTP:	OUT
13200		JRST	TTYOUT+4
13250		HALT
13300	
13350	%TYPE:	MOVEI	(^D36B5+7B11)
13400		HRLM	(P)
13450		ILDB	(P)
13500		JUMPE	TYPEEX
13550		PUSHJ	P,TTYOUT
13600		JRST	%TYPE+2
13650	TYPEEX:	MOVEI	015
13700		PUSHJ	P,TTYOUT
13750		MOVEI	012
13800		PUSHJ	P,TTYOUT
13850		OUT
13900		AOSA	TTYOTB+2
13950		HALT
14000		AOS	(P)
14050		POPJ	P,
14100	
14150	FORCET:	OUT
14200		AOSA	TTYOTB+2
14250		HALT
14300		POPJ	P,
14350	
14400	TTYD:	XWD	0,1
14450		SIXBIT	/TTY/
14500		XWD	TTYOTB,TTYINB
14550	TTYINB:	BLOCK	3
14600	TTYOTB:	BLOCK	3
14650	
14700	INPUTD:	XWD	0,0
14750		SIXBIT	/   /
14800		XWD	0,INPUTB
14850	INPUTF:	BLOCK	4
14900	INPUTB:	BLOCK	3
14950	
15000	OTPUTD:	XWD	0,0
15050		SIXBIT	/   /
15100		XWD	OTPUTB,0
15150	OTPUTF:	BLOCK	4
15200	OTPUTB:	BLOCK	3
15250	
15300	CCLD:	XWD	0,0
15350		SIXBIT	/DSK/
15400		XWD	0,CCLINB
15450	CCLINB:	BLOCK	3
15500	CCLINF:	BLOCK	4
15550	CCLSW:	BLOCK	1
15600	CCLMSG:	BLOCK	1
15650	CCLTMP:	BLOCK	1
15700	TMPLST:	BLOCK	1
15750		IOWD	^D63,TMPBUF
15800	TMPBUF:	BLOCK	^D64
15850	
15900	%FIN:	RELEAS	0,
15950		RELEAS	1,
16000		RELEAS	2,
16050		SKIPN	CCLSW
16100		JRST	RESET
16150		MOVE	JOBFFS
16200		HRRM	JOBFF
16250		MOVEI	1
16300		MOVEM	CCLSW
16350		JRST	RESET+2
16400	
16450	JOBFFS:	BLOCK	1
16500	
16550	ENDCCL:	CLOSE	3,
16600		SETZM	CCLINF
16650		SETZM	CCLINF+3
16700		RENAME	3,CCLINF
16750		JRST	CCLRDR
16800		CALL	[SIXBIT/EXIT/]
16850	
16900	RUN:	MOVEM	NAME,RUNBLK+1
16950		SKIPE	CCLTMP
17000		JRST	.+6
17050		CLOSE	3,
17100		SETZM	CCLINF
17150		SETZM	CCLINF+3
17200		RENAME	3,CCLINF
17250		JRST	CCLRDR
17300		MOVSI	1
17350		HRRI	RUNBLK
17400		CALL	[SIXBIT/RUN/]
17450		HALT
17500	
17550	RUNBLK:	SIXBIT	/SYS/
17600		SIXBIT	/      /
17650		EXP	0,0,0,0
17700	
17750	NAME=	6
17800	DEV=	7
17850	FILE=	10
17900	EXT=	11
17950	
18000	%ERROR:	PUSHJ	P,%TYPE
18050		ASCIZ	/?FATAL SYNTAX ERROR/
18100		SKIPN	ERRLN
18150		JRST	FATAL
18200		PUSHJ	P,%TYPE
18250		ASCII	/  IN LINE /
18300	ERRLN:	EXP	0,0
18350	FATAL:	PUSHJ	P,%TYPE
18400		ASCIZ	/  DETECTED AT:/
18450		MOVEI	1
18500		MOVEM	%LIST
18550		PUSHJ	P,%UNTIL+1
18600		BYTE	(7) 015,012,0
18650		JUMPGE	F,%FIN
18700		PUSHJ	P,%UNTIL+1
18750		BYTE	(7) 015,012,0
18800		JUMPGE	F,%FIN
18850		PUSHJ	P,%UNTIL+1
18900		BYTE	(7) 015,012,0
18950		JRST	%FIN
19000	
19050	INPUT:	SETZM	INPUTX
19100		SOSG	INPUTB+2
19150		JRST	INPUTG
19200		IBP	INPUTB+1
19250		MOVE	@INPUTB+1
19300		TRNN	1
19350		JRST	.+4
19400		MOVEM	ERRLN
19450		SETOM	INPUTX
19500		JRST	INPUT+1
19550		AOSG	INPUTX
19600		JRST	INPUT+1
19650		LDB	INPUTB+1
19700		JUMPE	INPUT
19750		POPJ	P,
19800	INPUTG:	IN	1,
19850		JRST	INPUT+3
19900		STATO	1,020000
19950		JRST	INPUTE
20000		MOVEI	032
20050		POPJ	P,
20100	INPUTE:	PUSHJ	P,%TYPE
20150		ASCIZ	/?INPUT ERROR/
20200		JRST	%FIN
20250	INPUTX:	0
20300	
20350	OUTPUT:	SOSG	OTPUTB+2
20400		JRST	OTPUTP
20450		IDPB	OTPUTB+1
20500		POPJ	P,
20550	OTPUTP:	OUT	2,
20600		JRST	OUTPUT+2
20650		PUSHJ	P,%TYPE
20700		ASCIZ	/?OUTPUT ERROR/
20750		JRST	%FIN
20800	
20850	GETINP:	ILDB	CHAR
20900		JUMPE	.+4
20950		SKIPLE	%LIST
21000		PUSHJ	P,TTYOUT
21050		POPJ	P,
21100		PUSHJ	P,INPUT
21150		SKIPE	%LIST
21200		PUSHJ	P,TTYOUT
21250		DPB	CHAR
21300		MOVE	TEMP1,CHAR
21350		MOVEI	TEMP2,0
21400		IDPB	TEMP2,TEMP1
21450		CAME	TEMP1,[POINT 7,SCANBF+^D64-1,^D34]
21500		POPJ	P,
21550		PUSHJ	P,%TYPE
21600		ASCIZ	/?BUFFER OVERFLOW/
21650		JRST	FATAL
21700	
21750	%COPYL:	MOVEI	(^D36B5+7B11)
21800		HRLM	(P)
21850		ILDB	(P)
21900		JUMPN	.+3
21950		AOS	(P)
22000		POPJ	P,
22050		PUSHJ	P,OUTPUT
22100		JRST	%COPYL+2
22150	
22200	%LEN:	MOVE	TEMP1,[POINT 7,SAVEBF]
22250		MOVEI	0
22300	LENLOP:	ILDB	1,TEMP1
22350		JUMPE	1,EDITNM
22400		CAIN	1,177
22450		JRST	LENLOP
22500		AOJA	LENLOP
22550	
22600	%COPYI:	MOVE	TEMP1,[POINT 7,SAVEBF]
22650		ILDB	TEMP1
22700		JUMPE	.+3
22750		PUSHJ	P,OUTPUT
22800		JRST	%COPYI+1
22850		POPJ	P,
22900	
22950	DELETE:	TLNE	F,BACKUP
23000		SKIPA	CHAR,BUFFPT
23050		MOVE	CHAR,[POINT 7,SCANBF]
23100	DELETL:	PUSHJ	P,GETINP
23150		CAIN	" "
23200		JRST	DELETL
23250		CAIGE	011
23300		JRST	TSTSUC
23350		CAIG	015
23400		JRST	DELETL
23450	
23500	TSTSUC:	MOVE	BUFFPT,CHAR
23550		IBP	BUFFPT
23600		IBP	BUFFPT
23650		IBP	BUFFPT
23700		IBP	BUFFPT
23750		SOJ	BUFFPT,
23800		TLNE	F,NDELET
23850		JRST	TSTNDL
23900		TLZ	F,BACKUP
23950		MOVE	TEMP1,[POINT 7,SCANBF]
24000		CAMN	CHAR,[POINT 7,SCANBF,6]
24050		POPJ	P,
24100		LDB	CHAR
24150		SKIPA
24200	TSTREP:	ILDB	CHAR
24250		IDPB	TEMP1
24300		JUMPN	TSTREP
24350		POPJ	P,
24400	TSTNDL:	TLO	F,BACKUP
24450		POPJ	P,
24500	
24550	MATCH:	MOVE	TEMP1,[POINT 7,SAVEBF]
24600		TLNE	F,NDELET
24650		SKIPA	TEMP2,BUFFPT
24700		MOVE	TEMP2,[POINT 7,SCANBF]
24750	MATCHL:	ILDB	TEMP2
24800		CAMN	TEMP2,CHAR
24850		JRST	MATCHE
24900		CAIN	177
24950		JRST	MATCHL
25000		IDPB	TEMP1
25050		CAME	TEMP1,[POINT 7,SAVEBF+^D32-1,^D34]
25100		JRST	MATCHL
25150		PUSHJ	P,%TYPE
25200		ASCIZ	/?SYMBOL TOO LONG/
25250		JRST	FATAL
25300	MATCHE:	MOVEI	0
25350		IDPB	TEMP1
25400		TLO	F,SUCCES
25450		JRST	TSTSUC
25500	
25550	%GEN:	MOVEI	"$"
25600		PUSHJ	P,OUTPUT
25650		HLRZ	-1(P)
25700		ADD	@(P)
25750		AOS	(P)
25800	EDITNM:	IDIVI	^D10
25850		HRLM	1,(P)
25900		JUMPE	.+2
25950		PUSHJ	P,EDITNM
26000		HLRZ	(P)
26050		ADDI	"0"
26100		PUSHJ	P,OUTPUT
26150		POPJ	P,
26200	
26250	%UNTIL:	PUSHJ	P,DELETE
26300		MOVEI	(^D36B5+7B11)
26350		HRLM	(P)
26400		TLNE	F,BACKUP
26450		SKIPA	CHAR,BUFFPT
26500		MOVE	CHAR,[POINT 7,SCANBF]
26550		TLZ	F,SUCCES
26600	UNTILL:	MOVE	TEMP4,(P)
26650		ILDB	TEMP3,TEMP4
26700		JUMPE	TEMP3,TSTEXT
26750		PUSHJ	P,GETINP
26800		CAIN	032
26850		JRST	TSTQUT
26900		CAIE	(TEMP3)
26950		JRST	.-4
27000		MOVE	TEMP5,CHAR
27050	UNTILM:	ILDB	TEMP3,TEMP4
27100		JUMPE	TEMP3,TSTEXX
27150		PUSHJ	P,GETINP
27200		CAIN	032
27250		JRST	TSTQUT
27300		CAIN	(TEMP3)
27350		JRST	UNTILM
27400		MOVE	CHAR,TEMP5
27450		JRST	UNTILL
27500	TSTEXX:	MOVEM	TEMP4,(P)
27550		JRST	TSTEXT
27600	
27650	%TST:	PUSHJ	P,DELETE
27700		MOVEI	(^D36B5+7B11)
27750		HRLM	(P)
27800		TLNE	F,BACKUP
27850		SKIPA	CHAR,BUFFPT
27900		MOVE	CHAR,[POINT 7,SCANBF]
27950		TLZ	F,SUCCES
28000	TSTLOP:	ILDB	TEMP3,(P)
28050		JUMPE	TEMP3,TSTEXT
28100		PUSHJ	P,GETINP
28150		CAIN	(TEMP3)
28200		JRST	TSTLOP
28250		CAIE	TEMP3," "
28300		JRST	TSTQUT
28350		CAIGE	011
28400		JRST	TSTQUT
28450		CAIG	015
28500		JRST	TSTLOP
28550	TSTQUT:	ILDB	(P)
28600		JUMPN	.-1
28650		AOS	(P)
28700		POPJ	P,
28750	TSTEXT:	AOS	(P)
28800		TLO	F,SUCCES
28850		IBP	CHAR
28900		JRST	TSTSUC
28950	
29000	%NUM:	PUSHJ	P,DELETE
29050		TLNE	F,BACKUP
29100		SKIPA	CHAR,BUFFPT
29150		MOVE	CHAR,[POINT 7,SCANBF]
29200		TLZ	F,SUCCES
29250		PUSHJ	P,GETINP
29300		CAIGE	"0"
29350		POPJ	P,
29400		CAILE	"9"
29450		POPJ	P,
29500	NUMLOP:	PUSHJ	P,GETINP
29550		CAIGE	"0"
29600		JRST	MATCH
29650		CAILE	"9"
29700		JRST	MATCH
29750		JRST	NUMLOP
29800	
29850	%PUT:	POP	P,TEMP2
29900		EXCH	TEMP2,(P)
29950		MOVE	TEMP1,@(P)
30000		AOS	(P)
30050		SOJL	TEMP2,STKERR
30100		IMULI	TEMP2,^D16
30150		ADD	TEMP2,STACKL-1(TEMP1)
30200		CAMLE	TEMP2,STACK-1(TEMP1)
30250		JRST	STKERR
30300		TLZE	F,SCATEN
30350		JRST	PUSHED
30400		JRST	PUSHOK
30450	
30500	STKERR:	PUSHJ	P,%TYPE
30550		ASCIZ	/?STACK LIMIT ERROR/
30600		JRST	FATAL
30650	
30700	%PUSH:	MOVE	TEMP1,@(P)
30750		AOS	(P)
30800		MOVE	TEMP2,STACK-1(TEMP1)
30850		TLZE	F,SCATEN
30900		JRST	PUSHED
30950		MOVEI	TEMP3,^D16
31000		ADDM	TEMP3,STACK-1(TEMP1)
31050		CAME	TEMP2,STACKU-1(TEMP1)
31100		JRST	PUSHOK
31150	STKOVF:	PUSHJ	P,%TYPE
31200		ASCIZ	/?STACK OVERFLOW/
31250		JRST	FATAL
31300	PUSHED:	SUBI	TEMP2,^D16
31350		CAMGE	TEMP2,STACKL-1(TEMP1)
31400		JRST	STKERR
31450		ILDB	TEMP2
31500		JUMPN	.-1
31550		IBP	TEMP2
31600		IBP	TEMP2
31650		IBP	TEMP2
31700		IBP	TEMP2
31750		SOJ	TEMP2,
31800	PUSHOK:	MOVE	TEMP3,TEMP2
31850		ADDI	TEMP3,^D16
31900		JUMPL	TEMP1,PUSHL
31950		MOVE	TEMP1,[POINT 7,SAVEBF]
32000		ILDB	TEMP1
32050		IDPB	TEMP2
32100		CAMN	TEMP2,TEMP3
32150		JRST	STKOVF
32200		JUMPN	.-4
32250		POPJ	P,
32300	PUSHL:	MOVEI	(^D36B5+7B11)
32350		HRLM	(P)
32400		ILDB	(P)
32450		IDPB	TEMP2
32500		CAMN	TEMP2,TEMP3
32550		JRST	STKOVF
32600		JUMPN	.-4
32650		AOS	(P)
32700		POPJ	P,
32750	
32800	%POP:	MOVE	TEMP1,@(P)
32850		AOS	(P)
32900		MOVE	TEMP2,STACK-1(TEMP1)
32950		CAME	TEMP2,STACKL-1(TEMP1)
33000		JRST	POPOK
33050		SETZM	SAVEBF
33100		POPJ	P,
33150	%GET:	POP	P,TEMP2
33200		EXCH	TEMP2,(P)
33250		MOVE	TEMP1,@(P)
33300		AOS	(P)
33350		SOJL	TEMP2,STKERR
33400		IMULI	TEMP2,^D16
33450		ADD	TEMP2,STACKL-1(TEMP1)
33500		CAMLE	TEMP2,STACK-1(TEMP1)
33550		JRST	STKERR
33600		JRST	POPCPY
33650	POPOK:	SUBI	TEMP2,^D16
33700		MOVEM	TEMP2,STACK-1(TEMP1)
33750	POPCPY:	MOVE	TEMP1,[POINT 7,SAVEBF]
33800		ILDB	TEMP2
33850		IDPB	TEMP1
33900		JUMPN	.-2
33950		POPJ	P,
34000	
34050	%LEVEL:	MOVE	TEMP1,@(P)
34100		AOS	(P)
34150		MOVE	TEMP2,STACK-1(TEMP1)
34200		SUB	TEMP2,STACKL-1(TEMP1)
34250		ANDI	TEMP2,777760
34300		LSH	TEMP2,-4
34350		EXCH	TEMP2,(P)
34400		JRST	(TEMP2)
34450	
34500	%ID:	PUSHJ	P,DELETE
34550		TLNE	F,BACKUP
34600		SKIPA	CHAR,BUFFPT
34650		MOVE	CHAR,[POINT 7,SCANBF]
34700		TLZ	F,SUCCES
34750		PUSHJ	P,GETINP
34800		CAIGE	"A"
34850		POPJ	P,
34900		CAIG	"Z"
34950		JRST	IDLOOP
35000		CAIGE	141
35050		POPJ	P,
35100		CAILE	172
35150		POPJ	P,
35200	IDLOOP:	PUSHJ	P,GETINP
35250		CAIGE	"0"
35300		JRST	MATCH
35350		CAIG	"9"
35400		JRST	IDLOOP
35450		CAIGE	"A"
35500		JRST	MATCH
35550		CAIG	"Z"
35600		JRST	IDLOOP
35650		CAIGE	141
35700		JRST	MATCH
35750		CAIG	172
35800		JRST	IDLOOP
35850		JRST	MATCH
35900	
35950	%STR:	PUSHJ	P,DELETE
36000		TLNE	F,BACKUP
36050		SKIPA	CHAR,BUFFPT
36100		MOVE	CHAR,[POINT 7,SCANBF]
36150		TLZ	F,SUCCES
36200		PUSHJ	P,GETINP
36250		CAIE	042
36300		POPJ	P,
36350		MOVEI	"\"
36400		DPB	CHAR
36450	STRLOP:	PUSHJ	P,GETINP
36500		CAIN	"\"
36550		JRST	STRERR
36600		CAIE	042
36650		JRST	STRLOP
36700		MOVE	TEMP3,CHAR
36750		PUSHJ	P,GETINP
36800		CAIN	042
36850		JRST	STRSUB
36900		MOVEI	"\"
36950		DPB	TEMP3
37000		JRST	MATCH
37050	STRSUB:	MOVEI	177
37100		DPB	CHAR
37150		JRST	STRLOP
37200	STRERR:	PUSHJ	P,%TYPE
37250		ASCIZ	/?"\" FATAL ERROR/
37300		JRST	FATAL
37350	
37400	%BEGIN:	AOS	TEMP1,BLOCKP
37450		CAIGE	TEMP1,^D16
37500		JRST	BEGINC
37550		PUSHJ	P,%TYPE
37600		ASCIZ	/?TOO MANY LEVELS/
37650		JRST	FATAL
37700	BEGINC:	AOS	TEMP2,BLOCKN
37750		MOVEM	TEMP2,BLOCK(TEMP1)
37800		MOVE	TEMP2,DICTCH
37850		MOVEM	TEMP2,DICTCH(TEMP1)
37900		MOVE	TEMP2,DICTPT
37950		MOVEM	TEMP2,DICTPT(TEMP1)
38000		SETZM	BLOCKI(TEMP1)
38050		POPJ	P,
38100	
38150	%END:	SOSL	TEMP1,BLOCKP
38200		JRST	ENDC
38250		PUSHJ	P,%TYPE
38300		ASCIZ	/?TOO MANY .END S/
38350		JRST	FATAL
38400	ENDC:	MOVE	TEMP2,DICTCH+1(TEMP1)
38450		MOVEM	TEMP2,DICTCH
38500		MOVE	TEMP2,DICTPT+1(TEMP1)
38550		MOVEM	TEMP2,DICTPT
38600		CAMGE	TEMP2,CURRNT
38650		SETOM	CURRNT
38700		POPJ	P,
38750	
38800	%SET:	SKIPL	TEMP1,CURRNT
38850		JRST	SETOK
38900		PUSHJ	P,%TYPE
38950		ASCIZ	/?NO LOOKUP PERFORMED/
39000		JRST	FATAL
39050	SETOK:	MOVSI	TEMP2,400000
39100		MOVE	TEMP3,@(P)
39150		AOS	(P)
39200		ROT	TEMP2,(TEMP3)
39250		ORM	TEMP2,FLAGS(TEMP1)
39300		POPJ	P,
39350	
39400	%CHECK:	TLZ	F,SUCCES
39450		SKIPGE	TEMP1,CURRNT
39500		JRST	%SET+2
39550		MOVSI	TEMP2,400000
39600		MOVE	TEMP3,@(P)
39650		AOS	(P)
39700		ROT	TEMP2,(TEMP3)
39750		TDNE	TEMP2,FLAGS(TEMP1)
39800		TLO	F,SUCCES
39850		POPJ	P,
39900	
39950	%BLOCK:	SKIPA
40000		JRST	CBLOCK
40050		SKIPGE	TEMP1,CURRNT
40100		JRST	%SET+2
40150		HLRZ	CONTEX(TEMP1)
40200		JRST	EDITNM
40250	CBLOCK:	MOVE	TEMP1,BLOCKP
40300		MOVE	BLOCK(TEMP1)
40350		JRST	EDITNM
40400	
40450	%CLEAR:	SKIPGE	TEMP1,CURRNT
40500		JRST	%SET+2
40550		MOVSI	TEMP2,400000
40600		MOVE	TEMP3,@(P)
40650		AOS	(P)
40700		ROT	TEMP2,(TEMP3)
40750		ANDCAM	TEMP2,FLAGS(TEMP1)
40800		POPJ	P,
40850	
40900	%LOOK:	TLZ	F,SUCCES
40950		MOVE	TEMP4,@(P)
41000		AOS	(P)
41050		SKIPGE	TEMP1,DICTPT
41100		JRST	NOFIND
41150	LOOKLP:	JUMPG	TEMP4,CHARSU
41200		HLRZ	TEMP2,CONTEX(TEMP1)
41250		MOVE	TEMP3,BLOCKP
41300		CAME	TEMP2,BLOCK(TEMP3)
41350		JRST	LOOKSK
41400	CHARSU:	MOVE	TEMP2,SYMBOL(TEMP1)
41450		MOVE	TEMP3,[POINT 7,SAVEBF]
41500	CHARLP:	ILDB	CHAR,TEMP2
41550		ILDB	TEMP3
41600		CAIE	(CHAR)
41650		JRST	LOOKSK
41700		JUMPN	CHARLP
41750		MOVEM	TEMP1,CURRNT
41800		TLO	F,SUCCES
41850		POPJ	P,
41900	LOOKSK:	SOJGE	TEMP1,LOOKLP
41950	NOFIND:	CAIE	TEMP4,0
42000		CAIN	TEMP4,1
42050		POPJ	P,
42100		AOS	TEMP1,DICTPT
42150		CAIGE	TEMP1,^D256
42200		JRST	WILLFT
42250	FULL:	PUSHJ	P,%TYPE
42300		ASCIZ	/?DICTIONARY FULL/
42350		JRST	FATAL
42400	WILLFT:	MOVE	TEMP2,BLOCKP
42450		AOS	TEMP3,BLOCKI(TEMP2)
42500		HRRM	TEMP3,CONTEX(TEMP1)
42550		SETZM	FLAGS(TEMP1)
42600		MOVE	TEMP2,BLOCK(TEMP2)
42650		HRLM	TEMP2,CONTEX(TEMP1)
42700		MOVE	TEMP2,DICTCH
42750		MOVEM	TEMP2,SYMBOL(TEMP1)
42800		MOVE	TEMP3,[POINT 7,SAVEBF]
42850	INSLOP:	CAMN	TEMP2,[POINT 7,DICT+^D512-1,^D34]
42900		JRST	FULL
42950		ILDB	CHAR,TEMP3
43000		IDPB	CHAR,TEMP2
43050		JUMPN	CHAR,INSLOP
43100		MOVEM	TEMP2,DICTCH
43150		MOVEM	TEMP1,CURRNT
43200		TLO	F,SUCCES
43250		POPJ	P,
43300	
43350	%SCAN:	MOVE	TEMP4,@(P)
43400		AOS	(P)
43450		JUMPN	TEMP4,NSTART
43500		MOVE	TEMP1,DICTPT
43550		MOVEM	TEMP1,SCANPT
43600		SETOM	CURRNT
43650		POPJ	P,
43700	NSTART:	CAIE	TEMP4,1
43750		POPJ	P,
43800		SETOM	CURRNT
43850		TLZ	F,SUCCES
43900		SKIPGE	TEMP1,SCANPT
43950		POPJ	P,
44000		SOS	SCANPT
44050		MOVE	TEMP2,BLOCKP
44100		HLRZ	TEMP3,CONTEX(TEMP1)
44150		CAME	TEMP3,BLOCK(TEMP2)
44200		POPJ	P,
44250		MOVEM	TEMP1,CURRNT
44300		TLO	F,SUCCES
44350		MOVE	TEMP2,SYMBOL(TEMP1)
44400		JRST	POPCPY
44450	
44500	%XLEN:	PUSH	P,(P)
44550		MOVE	TEMP3,[POINT 7,SAVEBF]
44600		SETZM	-1(P)
44650	XLENL:	ILDB	TEMP1,TEMP3
44700		JUMPE	TEMP1,XLENX
44750		CAIN	TEMP1,177
44800		JRST	XLENL
44850		AOS	-1(P)
44900		JRST	XLENL
44950	XLENX:	POPJ	P,
45000	
45050	%XBLK:	SKIPA
45100		JRST	XBLKX
45150		SKIPGE	TEMP1,CURRNT
45200		JRST	%SET+2
45250		HLRZ	TEMP2,CONTEX(TEMP1)
45300		PUSH	P,(P)
45350		MOVEM	TEMP2,-1(P)
45400		POPJ	P,
45450	XBLKX:	PUSH	P,(P)
45500		MOVE	TEMP1,BLOCKP
45550		MOVE	TEMP1,BLOCK(TEMP1)
45600		MOVEM	TEMP1,-1(P)
45650		POPJ	P,
45700	
45750	%PUTNM:	POP	P,TEMP1
45800		EXCH	TEMP1,(P)
45850		MOVE	TEMP3,[POINT 7,SAVEBF]
45900		JUMPGE	TEMP1,.+4
45950		MOVM	TEMP1,TEMP1
46000		MOVEI	TEMP2,"-"
46050		IDPB	TEMP2,TEMP3
46100		PUSHJ	P,PUTNMA
46150		SETZ	TEMP2,
46200		JRST	STOREA
46250	PUTNMA:	IDIVI	TEMP1,^D10
46300		HRLM	TEMP2,(P)
46350		JUMPE	TEMP1,.+2
46400		PUSHJ	P,PUTNMA
46450		HLRZ	TEMP2,(P)
46500		ADDI	TEMP2,"0"
46550	STOREA:	IDPB	TEMP2,TEMP3
46600		POPJ	P,
46650	
46700	%GETNM:	PUSH	P,(P)
46750		MOVE	TEMP3,[POINT 7,SAVEBF]
46800		SETZ	TEMP2,
46850		MOVEI	TEMP1,1
46900		MOVEM	TEMP1,-1(P)
46950		ILDB	TEMP1,TEMP3
47000		CAIE	TEMP1,"-"
47050		JRST	.+3
47100		SETOM	-1(P)
47150		ILDB	TEMP1,TEMP3
47200		JUMPE	TEMP1,.+2
47250	GETNML:	CAILE	TEMP1,"9"
47300		POPJ	P,
47350		CAIGE	TEMP1,"0"
47400		POPJ	P,
47450		SUBI	TEMP1,"0"
47500		IMULI	TEMP2,^D10
47550		ADDI	TEMP2,(TEMP1)
47600		ILDB	TEMP1,TEMP3
47650		JUMPN	TEMP1,GETNML
47700		IMULM	TEMP2,-1(P)
47750		POPJ	P,
47800	
47850	%SYMB:	SKIPGE	TEMP1,CURRNT
47900		JRST	%SET+2
47950		HRRZ	CONTEX(TEMP1)
48000		JRST	EDITNM
48050	
48100	%XSYMB:	SKIPGE	TEMP1,CURRNT
48150		JRST	%SET+2
48200		HRRZ	TEMP2,CONTEX(TEMP1)
48250		EXCH	TEMP2,(P)
48300		JRST	(TEMP2)
48350	
48400	%CLEVL:	SKIPA
48450		JRST	CLEVLA
48500		MOVE	TEMP1,BLOCKP
48550		EXCH	TEMP1,(P)
48600		JRST	(TEMP1)
48650	CLEVLA:	MOVE	BLOCKP
48700		JRST	EDITNM
48750	
48800	%BLEVL:	SKIPA
48850		JRST	BLEVLA
48900		SKIPGE	TEMP1,CURRNT
48950		JRST	%SET+2
49000		HLRZ	TEMP1,CONTEX(TEMP1)
49050		MOVE	TEMP2,BLOCKP
49100		CAME	TEMP1,BLOCK(TEMP2)
49150		SOJGE	TEMP2,.-1
49200		EXCH	TEMP2,(P)
49250		JRST	(TEMP2)
49300	BLEVLA:	SKIPGE	TEMP1,CURRNT
49350		JRST	%SET+2
49400		HLRZ	TEMP1,CONTEX(TEMP1)
49450		MOVE	TEMP2,BLOCKP
49500		CAME	TEMP1,BLOCK(TEMP2)
49550		SOJGE	TEMP2,.-1
49600		MOVE	TEMP2
49650		JRST	EDITNM
49700	
49750	%MAKND:	HRRZ	TEMP1,@(P)
49800		PUSH	STK2,TEMP1
49850		HRRZ	TEMP1,STK2
49900		HLRZ	TEMP2,@(P)
49950		PUSH	STK2,TEMP2
50000		AOS	(P)
50050		JUMPE	TEMP2,.+4
50100		POP	STK1,TEMP3
50150		PUSH	STK2,TEMP3
50200		SOJG	TEMP2,.-2
50250		PUSH	STK1,TEMP1
50300		POPJ	P,
50350	
50400	%SETRE:	MOVE	STK1,SAVSTK
50450		MOVE	STK2,SAVSTK+1
50500		SETZM	%MARK
50550		POPJ	P,
50600	
50650	%DMPTR:	TLO	F,SUCCES
50700		CAME	STK1,[IOWD ^D128,HOLD]
50750		JRST	DMPTR
50800		PUSHJ	%TYPE
50850		ASCIZ	/?NO TREE/
50900		JRST	FATAL
50950	DMPTR:	POP	STK1,TEMP1
51000		PUSH	P,SAVSTK
51050		PUSH	P,SAVSTK+1
51100		MOVEM	STK1,SAVSTK
51150		MOVEM	STK2,SAVSTK+1
51200		PUSH	P,%MARK
51250		MOVEM	TEMP1,%MARK
51300		PUSHJ	P,@(TEMP1)
51350		POP	P,%MARK
51400		POP	P,SAVSTK+1
51450		POP	P,SAVSTK
51500		MOVE	STK1,SAVSTK
51550		MOVE	STK2,SAVSTK+1
51600		POPJ	P,
51650	
51700	%CALND:	TLO	F,SUCCES
51750		HRRZ	TEMP1,@(P)
51800		MOVE	TEMP2,%MARK
51850		ADD	TEMP2,1(TEMP2)
51900		SUB	TEMP2,TEMP1
51950		HLL	TEMP2,@(P)
52000		MOVE	TEMP1,2(TEMP2)
52050		AOS	(P)
52100		JUMPGE	TEMP2,RECURS
52150		EXCH	TEMP1,(P)
52200		JRST	(TEMP1)
52250	RECURS:	CAIG	TEMP1,777777
52300		JUMPG	TEMP1,CALLVL
52350		TLNE	TEMP1,40
52400		JRST	.+3
52450		MOVE	TEMP2,TEMP1
52500		JRST	POPCPY
52550		HRRZM	TEMP1,CURRNT
52600		MOVE	TEMP2,SYMBOL(TEMP1)
52650		JRST	POPCPY
52700	CALLVL:	PUSH	P,%MARK
52750		MOVEM	TEMP1,%MARK
52800		PUSHJ	P,@(TEMP1)
52850		POP	P,%MARK
52900		POPJ	P,
52950	
53000	%CPYDC:	SKIPA	TEMP1,[POINT 7,SAVEBF]
53050		JRST	CPYDCT
53100		MOVNI	TEMP2,5
53150		ILDB	TEMP3,TEMP1
53200		JUMPE	TEMP3,.+2
53250		SOJA	TEMP2,.-2
53300		IDIVI	TEMP2,5
53350		HRLZI	TEMP2,(TEMP2)
53400		HRRI	TEMP2,SAVEBF
53450		HRRZI	TEMP1,1(STK2)
53500		HRLI	TEMP1,(POINT 7,0)
53550		PUSH	STK1,TEMP1
53600		PUSH	STK2,(TEMP2)
53650		AOBJN	TEMP2,.-1
53700		POPJ	P,
53750	CPYDCT:	SKIPGE	TEMP1,CURRNT
53800		JRST	%SET+2
53850		PUSH	STK1,CURRNT
53900		HRROS	(STK1)
53950		POPJ	P,
54000	
54050	SCATEN=	040000
54100	BACKUP=	100000
54150	NDELET=	200000
54200	SUCCES=	400000
54250	P=	17
54300	F=	16
54350	TEMP1=	13
54400	TEMP2=	14
54450	TEMP3=	15
54500	TEMP4=	11
54550	TEMP5=	10
54600	BUFFPT=	5
54650	CHAR=	12
54700	STK1=	4
54750	STK2=	3
54800	
54850	HOLD:	BLOCK	^D128
54900	TREE:	BLOCK	^D512
54950	%MARK:	BLOCK	1
55000	SAVSTK:	BLOCK	2
55050	
55100	SCANBF:	BLOCK	^D64
55150	SAVEBF:	BLOCK	^D32
55200	
55250	STACK:	BLOCK	3
55300	STACKL:	POINT	7,STACKA+0*^D64*^D16-1,^D34
55350	STACKU:	POINT	7,STACKA+1*^D64*^D16-1,^D34
55400		POINT	7,STACKA+2*^D64*^D16-1,^D34
55450		POINT	7,STACKA+3*^D64*^D16-1,^D34
55500	STACKA:	BLOCK	3*^D64*^D16
55550	
55600	PDL:	BLOCK	^D512
55650	
55700	%LIST:	BLOCK	1
55750	DICTPT:	BLOCK	^D16
55800	DICTCH:	BLOCK	^D16
55850	CURRNT:	BLOCK	1
55900	BLOCKI:	BLOCK	^D16
55950	BLOCK:	BLOCK	^D16
56000	BLOCKP:	BLOCK	1
56050	BLOCKN:	BLOCK	1
56100	SCANPT:	BLOCK	1
56150	
56200	FLAGS:	BLOCK	^D256
56250	CONTEX:	BLOCK	^D256
56300	SYMBOL:	BLOCK	^D256
56350	DICT:	BLOCK	^D512
56400	
56450		END