perm filename GRUMP[X,AIL]4 blob sn#177053 filedate 1975-09-16 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00015 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	TITLE GRUMP
C00004 00003	LOAD2:	XWD	INTF,LD
C00009 00004	PROG:
C00012 00005	NAMEB:
C00013 00006		LDB W,IBUF+1
C00016 00007	TBYTES:	MOVEI A,11
C00019 00008	DECX:	TRZE F,OPTYPF
C00021 00009	BEGIN OPCODS
C00027 00010	POLFIX:
C00029 00011	F4LD:	PUSHJ P,WORD	SPECIAL FORMAT FOR F4
C00032 00012	ENDF4:	MOVEI T,[ASCIZ /STARTING ADDRESS/]
C00035 00013	DATAS:	PUSHJ P,WORD
C00038 00014	TDEC:	MOVEI A,11
C00039 00015	GET FILE SPEC FROM TTY LINE 
C00042 ENDMK
C⊗;
TITLE GRUMP
;PROGRAM TO PRINT OUT A REL FILE IN A READABLE FORMAT

↓P←17	;PDL
E←16	;COUNT, FOR INPUT (BY BLOCK)
A←15	;TEMP REGISTER
W←14	;WORDS READ ARE RETURNED HERE
T←13	;TEMP REGISTER
Q←12	;RETURN RELOCATION BITS HERE
R←11	;STORE RELOCATION BITS HERE
T1←10
T2←7
F←0	;FLAGS

HSW←←1	;HALF WORD FLAG
↓ LOADVR ←← 54	;LOADER VERSION NUMBER
OPTYPF←←2	;OPCODE HAS BEEN TYPED

BITTAB:	FOR I←0,20,1 <
	1⊗I>

;ROUTINE TO READ A WORD

WORD:	SOSG	IBUF+2	;ANY LEFT?
	JRST	WORD2	;NO
WORD1:	ILDB	W,IBUF+1	;YES, GET IT
	POPJ P,

WORD2:	INPUT 1,0	;READ A BLOCK
	STATZ 1,740000
	JRST	[MOVEI T,[ASCIZ /
INPUT ERROR
/]
		CALLI T,3
		CALLI 12]
	STATZ 1,20000
	CALLI 12	;EOF
	JRST WORD1

;READ A WORD WITH RELOCATI⊂ON

RWORD:	TRNN E,377777	;TEST FOR END OF BLOCK
	JRST LD	;GO DO NEXT BLOCK
RWORD1:	AOBJN E,RWORD2	;TEST FOR DATA WORD
	SKIPE	IDXFLG#	;ARE WE INDEX-BLOCKING?
	 JRST	 RWORD2	; YES, IGNORE RELOCATION
	PUSHJ P,WORD	;READ RELOCATION WORD
	MOVE R,W	;GET INTO RELOC REGISTER
	HRLI E,-22	;SET RELOCATION COUNT
RWORD2:	PUSHJ P,WORD
	SETZ	Q,		;ZERO RELOC BITS
	ROTC	R,2		;GET 2 NEW BITS
	POPJ P,
LOAD2:	XWD	INTF,LD
	XWD	POLFIX,PROG
	XWD	LINK,SYM
	XWD	ILLFMT,HISEG
	XWD	INDEX,ENTR
IFG (54-LOADVR),<
	XWD	PRGBK,HIGH
	XWD	LIBBK,NAMEB
LOAD3:	XWD	ILLFMT,STRT
>; VERSION NOT 54
IFGE (LOADVR-54),<
	XWD	ALGTP,HIGH
	XWD	PRGBK,NAMEB
LOAD3:	XWD	LIBBK,STRT
>;VERSION 54 OR HIGHER
DISPL←LOAD3-LOAD2

STPT:	RESET
	MOVSI	1,'DSK'
	MOVEM	1,DEVNAM

	outstr[asciz/File name:/]
	MOVE P,[XWD -40,PDL-1]
	push p,[sixbit/rel/]
	pushj p,getfil
	jrst STPT
	MOVE	1,DEVNAM
	MOVEM	1,DEV1
	INIT	1,14		;GET THE DISK, BUFFERED 36 BIT MODE
DEV1:	SIXBIT	/DSK/
	IBUF
	EXIT			;GIVE UP IF NOT THERE
	lookup 1,filnam
	jrst [ outstr[asciz/File not found.
/]↔	       jrst STPT ]
	move	[sixbit /dsk/]
	movem	DEVNAM
	push	p,[sixbit /gru/]
	outstr	[asciz /Output File (<crlf> for TTY:, default ext is .GRU) :/]
	pushj	p,getfil
	 jrst	 [move [sixbit /tty/]↔movem DEVNAM↔jrst .+1]
	MOVE	DEVNAM
	MOVEM	INIT2
ASK:	OUTSTR	[ASCIZ/Block types (<crlf> for all, ? for help) :/]
	INCHWL	1
	CAIN	1,15		;CR
	 JRST	[INCHWL	1	;SNARF THE LF
		MOVSI	F,-1	;WANT 'EM ALL
		JRST	INIT2A]
	CAIN	1,"?"
	 JRST	[OUTSTR	[ASCIZ/Add the numbers for the blocks desired.
     2 Program	    40 End	  1000 Polish	 20000 Algol
     4 Symbols	   100 Name	  2000 Link	 40000 Prg req
    10 Hiseg	   200 Start	  4000 Lvar	100000 Lib req
    20 Entry	   400 Int req	 10000 Index	200000 Fortran
/]
		CLRBFI
		JRST	ASK]
	MOVEI	2,0
BUILD:	LSH	2,3
	SUBI	1,"0"
	ADDI	2,(1)
	INCHWL	1
	CAIE	1,15
	 JRST	BUILD
	INCHWL	1
	MOVSI	F,(2)
INIT2A:

	INIT 2,0	;GET THE OUTPUT GOING
init2:	SIXBIT /DSK/
	XWD OBUF,0	;FOR OUTPUT
	calli	12	;Don't WAIT FOR IT

	ENTER	2,FILNAM
	jrst	[outstr	 [asciz /Can't enter file name/]↔calli 1,12]

LD:	MOVE	P,[XWD -40,PDL-1]
	SETZM	IDXFLG
	PUSHJ P,WORD	;SHOULD BE A BLOCK HEADER
	MOVNI E,400000(W)	;SET COUNT
	HLRZ A,W	;THE BLOCK TYPE
	CAIN	A,14	;INDEX BLOCK?
	 SETOM	IDXFLG	; YES, DENOTE IT
	CAILE A,DISPL*2+1	;CHECK LEGALITY
	JRST ILLFMA	;ILL FORMAT
	TSNN	F,BITTAB(A)	;DO WE WANT IT?
	 JRST	[IGNORE: PUSHJ	P,RWORD
			JRST	IGNORE]
	MOVE	T,BLKNAM(A)	;TITLE OF THIS BLOCK
	PUSHJ	P,OUTASC
	HLRZ	A,W		;BLOCK TYPE
	HRRZ T,LOAD2(A)	;GET THE DISPATCH ADDRESS
	CAILE A,DISPL	;RIGHT ONE?
	HLRZ T,LOAD2-DISPL-1(A)	;CORRECT ONE
	JRST @T		;AND AWAY WE GO

BLKNAM←.-1
	[ASCIZ	/PROGRAM
	LOCATION /]
	[ASCIZ	/SYMBOLS
/]
	[ASCIZ	/HISEG-TWOSEG BLOCK
/]
	[ASCIZ	/ENTRY BLOCK
/]
	[ASCIZ	/END BLOCK
/]
	[ASCIZ	/NAME BLOCK
/]
	[ASCIZ	/STARTING ADDRESS
/]
	[ASCIZ	/INTERNAL REQUEST
/]
	[ASCIZ	/POLISH FIXUPS
/]
	[ASCIZ	/LINK BLOCK
/]
	[ASCIZ	//]
	[ASCIZ	/INDEX BLOCK
/]
	[ASCIZ	/ALGOL BLOCK
	**** GRUMP CANNOT HANDLE THIS ****
/]
	[ASCIZ	/PROGRAM REQUEST
/]
	[ASCIZ	/LIBRARY REQUEST
/]
PROG:
PROG2:	PUSHJ P,RWORD	;GET A WORD WITH RELOC BITS
	PUSHJ P,HALVS	;PRINT IT
PROG1:	PUSHJ P,RWORD	;NOW THE PROGRAM MATERIAL
	PUSHJ P,THALFS	;PRINT WITH A TAB
	PUSHJ P,TBYTES
	PUSHJ P,TCODE
	PUSHJ	P,TCRLF
	JRST PROG1	;RWORD WILL GET US OUT OF THIS

STRT:
INTF:
HIGH:
LINK:
HISEG:
PROGC:	PUSHJ P,RWORD
	PUSHJ P,THALVS
	JRST PROGC


ENTR:
ENTR1:	PUSHJ P,RWORD
	PUSHJ P,TRAD50
	JRST ENTR1

INDEX:
INDB2:	PUSHJ	P,RWORD		;GET XWD 4,COUNT
	JUMPL	W,INDB5		;NEXT BLOCK PTR
	HRRZS	W
	PUSH	P,W		;SAVE COUNT
INDB3:	SOSGE	(P)		;COUNT DOWN
	JRST	INDB4
	PUSHJ	P,RWORD		;GET A RADIX 50
	PUSHJ	P,TRAD50
	JRST	INDB3		;UNTIL ALL OUT
INDB4:	POP	P,W
	MOVEI	T,[ASCIZ '		AT WORD/BLOCK ']
	PUSHJ	P,OUTASC
	PUSHJ	P,RWORD
	PUSHJ	P,THALVS
	JRST	INDB2
INDB5:	PUSH	P,W		;SAVE NEXT BLOCK
	MOVEI	T,[ASCIZ /	NEXT BLOCK AT /]
	PUSHJ	P,OUTASC
	POP	P,T
	HRRZS	T
	PUSHJ	P,OCP1
	PUSHJ	P,TCRLF
	JRST	INDB2

ALGTP:
	JRST	ILLFMT

PRGBK:
LIBBK:
PRGB2:	PUSHJ	P,RWORD		;GET A WORD
	PUSH	P,W		;SAVE NAME
	PUSHJ	P,RWORD		;GET PPN
	PUSH	P,W		;SAVE IT TOO
	PUSHJ	P,RWORD		;GET DEVICE
	MOVEI	A,11
	PUSHJ	P,OCHR
	JUMPE	W,NODEV	
	PUSHJ	P,OUTSIX
	MOVEI	A,":"
	PUSHJ	P,OCHR
NODEV:
	MOVE	W,-1(P)
	PUSHJ	P,OUTSIX		;ASSUME IT'S A FILE NAME
	MOVEI	T,[ASCIZ /.REL/]
	PUSHJ	P,OUTASC
	MOVE	W,(P)		;GET PPN
	JUMPE	W,NOPP1
	HLRZS	W			;P FIRST
	MOVEI	A,"["
	PUSHJ	P,OCHR
	PUSHJ	P,OUTSIX
	MOVEI	A,","
	PUSHJ	P,OCHR
NOPP1:	POP	P,W
	JUMPE	W,NOPPN

	HRRZS	W			;NOW PN
	PUSHJ	P,OUTSIX
	MOVEI	A,"]"
	PUSHJ	P,OCHR
NOPPN:	PUSHJ	P,TCRLF
	JRST	PRGB2


OUTSIX:	SETZM	SIXBK
	SETZM	SIXBK+1
	MOVE	T1,[POINT 6,W]
	MOVE	T2,[POINT 7,SIXBK]
	MOVEI	Q,6

SIX1:	ILDB	A,T1
	SKIPN	A
	SOJA	Q,SIX1
SIX2:	ADDI	A,40		;CONVERT TO ASCII
	IDPB	A,T2
	ILDB	A,T1
	SOJN	Q,SIX2
	MOVEI	T,SIXBK
	JRST	OUTASC
NAMEB:
	PUSHJ P,RWORD
	PUSHJ P,RAD50
	JRST PROGC

SYM:
SYM1:	PUSHJ P,RWORD
	MOVEM W,SVSYM#
	PUSHJ P,TRAD51
	PUSHJ P,SYMVAL
	JRST SYM1

SYMVAL:	LDB W,[POINT 4,SVSYM,3]
	CAIE W,14
	JRST	[PUSHJ P,RWORD
		JRST THALVS]
	PUSHJ P,RWORD
	TLZN W,400000	;CHECK ADDITIVE
	JRST PRLOC
	MOVEI T,[ASCIZ /	ADD /]
	PUSHJ P,OUTASC
	TLZN W,200000	;CHECK LEFT HALF
	JRST NOLFT
	MOVEI T,[ASCIZ /LEFT /]
	PUSHJ P,OUTASC
NOLFT:	TLZN W,100000	;CHECK SYMBOL TABLE FIXUP
	JRST PRLOC
	JRST RAD50
PRLOC:	JRST THALVS

	LDB W,IBUF+1
	JRST IFLP1
IFLP:	PUSHJ P,WORD
IFLP1:	PUSH P,W
	PUSHJ P,RAD51
	POP P,W
	PUSHJ P,THALVS
	JRST IFLP

OUTASC:	HRLI T,(<POINT 7,0>)
	JRST	.+2
	PUSHJ	P,OCHR
	ILDB	A,T
	JUMPN	A,.-2
	POPJ	P,

OCP:	SKIPA T1,[2]
OCP1:	MOVEI T1,6
OCP2:	LSH T,3
	LDB A,[POINT 3,T,17]
	ADDI A,"0"
	PUSHJ P,OCHR
	SOJG T1,OCP2
CPOPJ:	POPJ P,

THALFS:	MOVEI A,11
	PUSHJ P,OCHR
HALFS:	HLRZ T,W
	PUSHJ P,OCP1
	MOVEI A,"'"
	TRNE Q,2
	PUSHJ P,OCHR
	MOVEI A," "
	PUSHJ P,OCHR
	HRRZ T,W
	PUSHJ P,OCP1
	MOVEI A,"'"
	TRNE Q,1
	PUSHJ P,OCHR
	MOVEI A," "
	PUSHJ P,OCHR
	POPJ P,
THALVS:	MOVEI A,11
	PUSHJ P,OCHR
HALVS:	PUSHJ P,HALFS

TCRLF:	MOVEI	A,15
	PUSHJ	P,OCHR
	MOVEI	A,12
OCHR:	SOSG OBUF+2
	OUTPUT 2,0
	IDPB A,OBUF+1
	POPJ P,

TRAD51:	MOVEI A,11
	PUSHJ P,OCHR
RAD51:	LDB T,[POINT 4,W,3]
	LSH T,16
	PUSHJ P,OCP
	MOVEI A,40
	PUSHJ P,OCHR
	MOVE T,W
	TLZ T,740000
	MOVNI T1,6
	PUSHJ P,SP1
	JUMPE Q,CPOPJ
	MOVEI T,[ASCIZ / (/]
	PUSHJ P,OUTASC
	MOVEI A,"L"
	TRNE Q,2
	PUSHJ P,OCHR
	MOVEI A,"R"
	TRNE Q,1
	PUSHJ P,OCHR
	MOVEI A,")"
	JRST OCHR
SP1:	IDIVI T,50
	HRLM W,(P)
	AOSGE T1
	PUSHJ P,SP1
	HLRZ T,(P)
	JUMPE T,ADD40
	ADDI T,60-1
	CAILE T,71
	ADDI T,101-72
	CAILE T,132
	SUBI T,134-44
	CAIN T,43
	MOVEI T,56
	SKIPA A,T
ADD40:	MOVEI A,40(T)
	JRST OCHR

TRAD50:	MOVEI A,11
	PUSHJ P,OCHR
RAD50:	PUSHJ P,RAD51
	JRST	TCRLF

ILLFMA:
	TSNN	F,BITTAB+20
	 JRST	IGNORE
	CAIN A,400
	JRST F4LD
ILLFMT:	MOVEI T,[ASCIZ /
ILLEGAL FORMAT
/]
	PUSHJ P,OUTASC
	LDB W,IBUF+1
	JRST ILF2
ILF:	PUSHJ P,WORD
ILF2:	PUSH P,W
	PUSHJ P,RAD51
	POP P,W
	PUSHJ P,THALVS
	JRST ILF

TBYTES:	MOVEI A,11
	PUSHJ P,OCHR
BYTES:	PUSH P,W
	MOVEI T2,6
	JRST	.+3
BYTLP:	MOVEI	A,","
	PUSHJ	P,OCHR
	MOVEI T,0
	LSHC T,7
	SKIPL	CHRTAB(T)
	 JRST	[MOVEI	A,40
		PUSHJ	P,OCHR
		MOVEI	A,(T)
		PUSHJ	P,OCHR
		MOVEI	A,40
		PUSHJ	P,OCHR
		JRST	BYTCNT]
	MOVEI T1,3
	LSH T,11
	PUSHJ P,OCP2
BYTCNT:	SOJG	T2,BYTLP
	POP	P,W
	POPJ	P,

TCODE:	MOVEI A,11
	PUSHJ P,OCHR
CODE:	PUSH P,W
	LDB W,[POINT 9,W,8]	;GET OPCODE PART
	ANDCMI F,OPTYPF	;NOT TYPED YET
	MOVEI T1,0	;NUMBER OF BYTES TO SKIP
	MOVE T,BTAB	;GET POINTER TO START OF TABLE
DC1:	ILDB T2,T
	CAILE T2,40
	CAIL T2,73
	SOJGE T1,DC1	;SKIP REQUIRED NUMBER
	JUMPG T1,DC1	;BUT DO NOT COUNT LETTERS
	SUBI T2,40
	JUMPE T2,DECX	;A STOP CODE
	JUMPG T2,DC2	;A TRANSFER OR A LETTER

	DPB T2,[POINT 5,PNTRX,7]	;DEPOSIT POSITION FIELD OF TEST
	ANDCMI T2,-4
	ADDI T2,1	;GE SIZE
	DPB T2,[POINT 6,PNTRX,11]	;AND DEPOSIT
	LDB T1,PNTRX	;GET NUMBER TO SKIP
	JRST DC1	;AND DO IT

DC2:	HRREI T2,-33(T2)
	JUMPL T2,DECT	;GO PRINT
	IDIVI T2,3	;A TRANSFER, GET WORD AND BYTE NUMBER
	MOVE T1,BTAB(T1)	;GET CORRECT BYTE POINTER
	ADDI T1,(T2)	;AND ADD IN WORD NUMBER
	MOVE T,T1
	MOVEI T1,0	;SET SKIP TO 0
	JRST DC1

DECT:	TRO F,OPTYPF
	MOVEI A,133(T2)
	PUSHJ P,OCHR
	JRST DC1

CHRTAB:
	FOR I←0,37,1 <
	-1>		;ANYTHING LESS THAN SPACE
	FOR I←40,172,1 <
	0>		;SPACE THROUGH LOWERCASE Z
	FOR I←173,177,1 <
	-1>		;THE REST
DECX:	TRZE F,OPTYPF
	JRST DIDCOD	;AN OPCODE WAS TYPED
	LDB T,[POINT 9,(P),8]
	LSH T,11
	MOVEI T1,3
	PUSHJ P,OCP2	;PRINT AS A NUMBER
DIDCOD:	MOVEI A," "
	PUSHJ P,OCHR
	LDB T,[POINT 4,(P),12]	;GET AC FIELD
	JUMPE T,NOAC
	LSH T,14
	PUSHJ P,OCP	;GO PRINT IT
	MOVEI A,","
	PUSHJ P,OCHR	;AND A COMMA
NOAC:	LDB T,[POINT 1,(P),13]	;THE INDIRECT BIT
	JUMPE T,NOINDR
	MOVEI A,"@"
	PUSHJ P,OCHR
NOINDR:	HRRZ T,(P)	;GET ADDRESS FIELD
	PUSHJ P,OCP1	;PRINT IT
	MOVEI A,"'"
	TRNE Q,1
	PUSHJ P,OCHR	;IF RELOC, INDICATE IT
	LDB T,[POINT 4,(P),17]
	JUMPE T,NOIND	;NO INDEX FIELD
	MOVEI A,"("
	PUSHJ P,OCHR
	LSH T,14
	PUSHJ P,OCP
	MOVEI A,")"
	PUSHJ P,OCHR
NOIND:	POP P,W	;GET REGISTER BACK
	MOVEI T,[ASCIZ / (R)/]
	TRNE Q,2	;WAS LEFT HALF RELOC?
	JRST OUTASC	;GO PRINT
	POPJ P,		;NO, RETURN

PNTRX:	W
BTAB:	POINT 10,TBL
	POINT 10,TBL,9
	POINT 10,TBL,19
BEGIN OPCODS
XLIST
DEFINE P' (A)
<OUTP A&70/2+A&7-1
>
DEFINE G' (A)
<OUTP A+73
>
DEFINE T' (A)
<FOR Bε<A> <OUTP "B"-40
>>
DEFINE S' (Q)
<OUTP 40
>
DEFINE L' (A)
<IFGE CLOC+73-2000,<PRINTX OPTABLE TOO LONG>
A←←CLOC
>
DEFINE OUTP' (A)
<CLOC←←CLOC+1
>
DEFINE BYT9' (A)
<FOR B⊂(A) <B
>>

↑TBL:
BINRY←←0
CLOC←←0
BINC←←3

DEFINE TABLE <
BYT9 <P 63,G %UUO,G %FLO,G %HAK,G %ACCP,G %BOOLE,T H,G %HWT,T T,G %ACBM>
BYT9 <P 21,G %BD,T CON,P 11,G %OI,T S,P 01,G %Z,G %O>
BYT9 <L %BD,P 01,T BLK,G %IO,T DATA,L %IO,P 11,G %I,G %O,L %OI,P 1,G %O,G %I>
BYT9 <L %UUO,P 51,S,P 32,G %U40,G %U50,G %U60,P 21,G %U703,P 11,G %USET>
BYT9 <P 1,T LOOKU,G %P,T ENTE,G %R,L %USET,T USET,P 1,G %I,G %O>
BYT9 <L %U40,P 3,G %U47,T INI,G %T,S,T SPCWA,G %R,S,S,S,L %U47,T CALL>
BYT9 <P 1,S,G %I,L %U60,P 21,G %U603,P 1,T IN,G %BPUT,T OUT,L %BPUT>
BYT9 <P 11,T BU,L %F,T F,S,T PU,G %T,L %U50,P 3,T OPE,G %N,T TTYUU,G %O,S,S,S>
BYT9 <T RENAM,G %E,T I,G %N,T OU,G %T,L %U603,P 1,G %U6062,T STAT>
BYT9 <P 11,L %O,T O,S,L %Z,T Z,S,L %U6062,P 11,T S,G %U62,T G,L %U62>
BYT9 <T ETST,G %S,L %U703,P 2,T CLOS,G %E,T RELEA,G %S,T MTAP,G %E>
BYT9 <T UGET,G %F>

BYT9 <L %FLO,P 51,G %BYTE,T F,P 32,T AD,G %A,T SB,G %A,T MP,G %A,T DV>
BYT9 <L %A,P 21,G %LMB,T R,G %IMB,L %LMB,P 2,S,L %L,T L,S,L %M,T M,S,L %B>
BYT9 <T B,S,L %BYTE,P 32,S,S,S,P 3,T UF,G %A,T DF,G %N,T FS,G %C,T IB,L %P,T P,S>
BYT9 <T I,G %LD,L %LD,T LD,G %B,T I,G %DP,L %DP,T DP,G %B>

BYT9 <L %HAK,P 33,G %MV,L %MV,T MOV,G %MO,G %ML,G %DV,G %SH,G %H1>
BYT9 <G %JP,P 21,T ADD,G %IMB,T SU,L %BIMB,T B,L %IMB,P 2>
BYT9 <S,L %I,T I,S,G %M,G %B,L %MO,P 22,L %EIMS,T E,G %IMS,T S>
BYT9 <G %IMS,T N,G %IMS,T M,L %IMS,P 2,S,G %I,G %M,L %S,T S,S>
BYT9 <L %ML,P 21,T I,G %ML1,L %ML1,T MUL,G %IMB,L %DV,P 21,T I,G %DV1>
BYT9 <L %DV1,T DI,L %DV2,T V,G %IMB,L %H1,P 3,T EXC,G %S3,T BL,L %T>
BYT9 <T T,S,G %AO,L %AO,T AOBJ,G %AOB,T JRS,G %T,T JFC,G %L,T XC,G %T>
BYT9 <T CON,G %S,L %AOB,P 1,G %P,G %N,L %JP,P 3,G %PU,L %PU,T PUSH>
BYT9 <G %PUS,G %PO,L %PO,T POP,G %POP,T JS,L %R,T R,S,T JS,G %P>
BYT9 <T JS,L %PA,T A,S,T JR,G %PA,L %PUS,P 1,L %J,T J,S,S,L %POP>
BYT9 <P 1,S,G %J,L %SH,P 2,T A,G %S2,T ROT,G %S1,T L,L %S2,T S,L %S3>
BYT9 <T H,G %S1,P 21,T JFF,G %O,T FIX,S,L %S1,P 21,S,L %C,T C,S>

BYT9 <L %ACCP,P 42,T CA,G %CA1,G %SJ,T A,G %JS,T S,L %JS,T O,P 31>
BYT9 <T J,G %COMP,T S,G %COMP,L %CA1,P 31,T I,G %COMP,T M,G %COMP>
BYT9 <L %SJ,P 31,T JUM,G %PSJ,T SKI,L %PSJ,T P,L %COMP>
BYT9 <P 3,S,G %L,L %E,T E,S,T L,G %E,G %PA,T G,G %E,L %N,T N,S,T G,S>

BYT9 <L %HWT,P 51,G %HW1,P 21,T R,G %HW2,T L,L %HW2,T R,G %HW3,L %HW1>
BYT9 <P 21,T L,G %HW4,T R,L %HW4,T L,L %HW3,P 32,G %IMS,T Z,G %IMS,T O>
BYT9 <G %IMS,G %EIMS>

BYT9 <L %ACBM,P 31,G %AC1,P 1,T D,G %AC2,T S,G %AC2,L %AC1,P 1,T R>
BYT9 <G %AC2,T L,L %AC2,P 42,T N,G %EAN,T Z,G %EAN,T C,G %EAN,T O>
BYT9 <L %EAN,P 12,S,G %E,G %PA,G %N>

BYT9 <L %CB,T C,G %BIMB,L %BOOLE,P 24,G %ST,L %AN,T AND,G %B2,G %AN>
BYT9 <G %ST,G %AN,G %ST,T X,L %OR,T OR,G %B2,T I,G %OR,G %AN,T EQ>
BYT9 <G %DV2,G %ST,G %OR,G %ST,G %OR,G %OR,L %ST,T SET,L %B2>
BYT9 <P 24,T Z,G %IMB,G %IMB,L %CA,T C,G %TA,L %TM,T M,G %IMB,L %CM>
BYT9 <T C,G %TM,L %TA,T A,G %IMB,G %IMB,G %IMB,T C,G %BIMB,G %IMB,G %CA>
BYT9 <G %CA,G %CM,G %CM,G %CB,T O,G %IMB>>
TABLE
DEFINE OUTP (A)
<BINRY←←BINRY⊗12+A
BINC←←BINC-1
IFE BINC,<XLIST
BINRY⊗6
BINRY←←0
BINC←←3
>
CLOC←←CLOC+1
>
CLOC←←0
TABLE
REPEAT BINC,<BINRY←←BINRY⊗12>
IFN BINRY,<BINRY⊗6>

LIST
BEND
POLFIX:
	TLO F,HSW
RPOL:	PUSHJ P,RDHLF
	MOVEI T,ASCTAB(W)
	PUSHJ P,OUTASC
	MOVEI T,[ASCIZ / (R)/]
	TRNE Q,1
	PUSHJ P,OUTASC
	CAILE W,14
	JRST STROP
	CAILE W,2
	JRST RPOL1
	MOVE A,W
	PUSHJ P,RDHLF
	JUMPE A,HLFOP
	MOVE T1,W
	HRL T1,Q
	PUSHJ P,RDHLF
	HRLM T1,W
	LSH T1,-=17
	ANDI T1,2
	IOR Q,T1
	SOJE A,HLFOP
	PUSHJ P,TRAD50
	JRST RPOL
HLFOP:	PUSHJ P,THALVS
	JRST RPOL

RPOL1:	PUSHJ	P,TCRLF
	JRST RPOL

	ASCIZ / SMA/
	ASCIZ / SML/
	ASCIZ / SMR/
	ASCIZ /	SAL/
	ASCIZ /	SLH/
	ASCIZ /	SRH/
ASCTAB:	ASCIZ /	OPH/
	ASCIZ /	OPF/
	ASCIZ /	OPG/
	ASCIZ /	+/
	ASCIZ /	-/
	ASCIZ /	*/
	ASCIZ .	/.
	ASCIZ /	AND/
	ASCIZ /	OR/
	ASCIZ /	LSH/
	ASCIZ /	XOR/
	ASCIZ /	NOT/
	ASCIZ /	NEG/

STROP:	CAIGE W,-3
	JRST SYMSTR
	PUSHJ P,RDHLF
	PUSHJ P,THALVS
STOR1:	PUSHJ P,RWORD
	JRST ILLFMT

RDHLF:	TLON F,HSW
	JRST NORD
	PUSHJ P,RWORD
	TLZ F,HSW
	MOVEM W,SVHWD
	MOVEM Q,SVHWQ#
	HLRZS W
	LSH Q,-1
	POPJ P,
NORD:	HRRZ W,SVHWD#
	MOVE Q,SVHWQ
	ANDI Q,1
	POPJ P,

SYMSTR:	PUSHJ P,RDHLF
	HRL T1,W
	HRR T1,Q
	PUSHJ P,RDHLF
	HLL W,T1
	LSH T1,1
	ANDI T1,2
	IOR Q,T1
	PUSHJ P,TRAD51
	PUSHJ P,RDHLF
	HRL T1,W
	HRR T1,Q
	PUSHJ P,RDHLF
	HLL W,T1
	LSH T1,1
	ANDI T1,2
	IOR Q,T1
	PUSHJ P,TRAD50
	JRST STOR1
F4LD:	PUSHJ P,WORD	;SPECIAL FORMAT FOR F4
	HLRZ T,W	;GET LEFT HALF
	CAIE T,-1	;IS IT HEADER TYPE
	JRST NOHEAD	;NO, GO PROCESS A 'STANDARD' WORD
	CAMN W,[-2]
	JRST ENDF4
	LDB T,[POINT 6,W,23]	;GET HEADER TYPE
	ANDI W,7777
	JUMPE T,PROGL
	CAIN T,50
	JRST ABS
	CAIN T,31
	JRST MDLBL
	CAIN T,60
	JRST GLOB
	CAIN T,70
	JRST DATAS
	JRST ILLFMT
ABS:	MOVE T1,W
ABS1:	PUSHJ P,WORD
	PUSHJ P,THALVS
	SOJG T1,ABS1
	JRST F4LD

PROGL:	MOVEI T,[ASCIZ /PROGL
/]
PROGL1:	PUSHJ P,OUTASC
	PUSHJ P,TDEC
	MOVEI A," "
	PUSHJ P,OCHR
PROGL2:	PUSHJ P,WORD
	PUSHJ P,RAD50
	JRST F4LD

MDLBL:	MOVEI T,[ASCIZ /MDLBL
/]
	JRST PROGL1

GLOB:	MOVEI T,[ASCIZ /GLOBAL
	/]
	PUSHJ P,OUTASC
	JRST PROGL2

NOHEAD:	HLRZ T,W
	MOVEI A,11
	PUSHJ P,OCHR
	PUSHJ P,OCP1
	MOVEI A," "
	PUSHJ P,OCHR
	PUSHJ P,NOHD1
	JRST F4LD
NOHD1:	LDB A,[POINT 5,W,23]
	MOVEI T,0
	CAIN A,0
	MOVEI T,[ASCIZ /PLT /]
	CAIN A,1
	MOVEI T,[ASCIZ /ARRY REF /]
	CAIN A,6
	MOVEI T,[ASCIZ /GLSUB /]
	CAIN A,11
	MOVEI T,[ASCIZ /CONS /]
	CAIN A,20
	MOVEI T,[ASCIZ /SCALAR /]
	CAIN A,22
	MOVEI T,[ASCIZ /ARRAY /]
	CAIN A,26
	MOVEI T,[ASCIZ /PTMP /]
	CAIN A,27
	MOVEI T,[ASCIZ /TTMP /]
	CAIN A,31
	MOVEI T,[ASCIZ /MLT /]
	JUMPE T,ILLFMT
	PUSHJ P,OUTASC
	PUSH P,W
	ANDI W,7777
	PUSHJ P,DEC
	POP P,W
	MOVEI T,[ASCIZ /(D)/]
	TRNE W,400000
	PUSHJ P,OUTASC
	JRST	TCRLF
ENDF4:	MOVEI T,[ASCIZ /STARTING ADDRESS/]
	PUSHJ P,OUTASC
	PUSHJ P,WORD
	PUSHJ P,THALVS
	MOVEI T,[ASCIZ /TEMPS/]
	PUSHJ P,OUTASC
	PUSHJ P,WORD
	PUSHJ P,TDEC
	MOVEI T,[ASCIZ /
CONSTANTS/]
	PUSHJ P,OUTASC
	PUSHJ P,WORD
	PUSH P,W
	PUSHJ P,TDEC
	PUSHJ	P,TCRLF
	POP P,T1
	JUMPE T1,NOCON
CONP:	PUSHJ P,WORD
	PUSHJ P,THALVS
	SOJG T1,CONP
NOCON:	MOVEI T,[ASCIZ /GLOBAL SUBPROGRAMS/]
	PUSHJ P,OUTASC
	PUSHJ P,WORD
	PUSH P,W
	PUSHJ P,TDEC
	PUSHJ	P,TCRLF
	POP P,T2
	JUMPE T2,NOSUBS
SUBS1:	PUSHJ P,WORD
	PUSHJ P,TRAD50
	SOJG T2,SUBS1
NOSUBS:	MOVEI T,[ASCIZ /SCALARS
/]
	PUSHJ P,OUTASC
	PUSHJ P,WORD
	JUMPE W,NOSCAL
	MOVE T2,W
SCAL1:	PUSHJ P,WORD
	PUSH P,W
	PUSHJ P,WORD
	PUSHJ P,TRAD51
	POP P,W
	PUSHJ P,THALVS
	SUBI T2,1
	SOJG T2,SCAL1
NOSCAL:	MOVEI T,[ASCIZ /ARRAYS
/]
	PUSHJ P,OUTASC
	PUSHJ P,WORD
	JUMPE W,NOARY
	MOVE T2,W
ARAY1:	PUSHJ P,WORD
	PUSH P,W
	PUSHJ P,WORD
	PUSHJ P,TRAD51
	POP P,W
	PUSHJ P,THALVS
	SUBI T2,1
	SOJG T2,ARAY1
NOARY:	MOVEI T,[ASCIZ /ARRAY REFS
/]
	PUSHJ P,OUTASC
	PUSHJ P,WORD
	JUMPE W,NOREF
	MOVE T1,W
REF1:	PUSHJ P,WORD
	PUSHJ P,THALVS
	PUSHJ P,WORD
	PUSHJ P,THALVS
	SUBI T1,1
	SOJG T1,REF1
NOREF:	MOVEI T,[ASCIZ /VARIABLE AREA /]
	PUSHJ P,OUTASC
	PUSHJ P,WORD
	PUSHJ P,DEC
	PUSHJ	P,TCRLF
	MOVEI T,[ASCIZ /COMMON BLOCKS
/]
	PUSHJ P,OUTASC
	PUSHJ P,WORD
	JUMPE W,LD
	MOVE T2,W
CMB1:	PUSHJ P,WORD
	PUSHJ P,TRAD51
	PUSHJ P,WORD
	PUSHJ P,THALVS
	SUBI T2,2
	SOJG T2,CMB1
	JRST LD

DATAS:	PUSHJ P,WORD
	MOVEM W,N3#
	PUSHJ P,WORD
	MOVEM W,N2
	PUSHJ P,WORD
	MOVEM W,N1#
	MOVE T2,N3
	MOVEI T,[ASCIZ /DATA SEQUENCES
/]
	PUSHJ P,OUTASC
	JUMPN T2,NOSEQ
SEQ2:	PUSHJ P,WORD
	CAMN W,[MOVE 13,12]
	JRST CAD
	CAMN W,[PUSHJ 17,1]
	JRST DOINIT
	CAMN W,[PUSHJ 17,2]
	JRST DOADV
	CAMN W,[PUSHJ 17,0]
	JRST STOR
	HLRZ A,W
	CAIN A,(<IMULI 12,>)
	JRST MULTIP
	MOVEI T,0
	CAIN A,(<IMUL 12,>)
	MOVEI T,[ASCIZ /	MUL /]
	CAIN A,(<ADD 12,>)
	MOVEI T,[ASCIZ /	ADD /]
	JUMPE T,ILLFMT
	PUSHJ P,OUTASC
PNTR:	LDB A,[POINT 6,W,23]
	MOVEI T,[ASCIZ /CONST /]
	CAIN A,0
	MOVEI T,[ASCIZ /DOVT /]
	PUSHJ P,OUTASC
	ANDI W,7777
DO1:	PUSHJ P,DEC
	PUSHJ	P,TCRLF
COMSQ:	SOJG T2,SEQ2
NOSEQ:	MOVE T2,N2#
	MOVEI T,[ASCIZ /DATA ITEMS
/]
	PUSHJ P,OUTASC
	JUMPN T2,NOITEM
ITEM1:	PUSHJ P,WORD
	SUBI T2,(W)
	PUSH P,W
	PUSHJ P,THALVS
	EXCH T2,(P)
	HRRZS T2
	JUMPE T2,NOCNT
CNT2:	PUSHJ P,WORD
	MOVEI A,11
	PUSHJ P,OCHR
	PUSHJ P,THALVS
	SOJG T2,CNT2
NOCNT:	POP P,T2
	SOJG T2,ITEM1
	MOVEI T,[ASCIZ /DATA CONSTANTS
/]
	PUSHJ P,OUTASC
NOITEM:	MOVE T2,N1
	JUMPN T2,F4LD
SEQ1:	PUSHJ P,WORD
	PUSHJ P,THALVS
	SOJG T2,SEQ1
	JRST F4LD

CAD:	PUSHJ P,WORD
	MOVEI T,[ASCIZ /	CAD /]
	PUSHJ P,OUTASC
	JRST PNTR

DOINIT:	MOVEI T,[ASCIZ /	DOINIT /]
	PUSHJ P,OUTASC
	PUSHJ P,WORD
	JRST DO1

DOADV:	MOVEI T,[ASCIZ /	DOADV /]
	PUSHJ P,OUTASC
	PUSHJ P,WORD
	PUSH P,W
	HLRZS W
	PUSHJ P,DEC
	MOVEI A,","
	PUSHJ P,OCHR
	POP P,W
	HRRZS W
	JRST DO1

MULTIP:	MOVEI T,[ASCIZ /	IMULI /]
	PUSHJ P,OUTASC
	HRRZS W
	JRST DO1

STOR:	MOVEI T,[ASCIZ /	STORE /]
	PUSHJ P,OUTASC
	PUSHJ P,WORD
	PUSH P,W
	HLRZS W
	PUSHJ P,DEC
	MOVEI A,","
	PUSHJ P,OCHR
	POP P,W
	PUSHJ P,NOHD1
	JRST COMSQ

TDEC:	MOVEI A,11
	PUSHJ P,OCHR
DEC:	MOVE T,W
	PUSH P,W
	PUSHJ P,DEC1
	POP P,W
	POPJ P,

DEC1:	IDIVI T,12
	HRLM W,(P)
	SKIPE T
	PUSHJ P,DEC1
	HLRZ A,(P)
	ADDI A,"0"
	JRST OCHR

;GET FILE SPEC FROM TTY LINE 
begin getfil
	opdef go [jrst]
	define pop0j <popj p,>
	define pop2j <jrst[sub p,[2,,2]↔jrst @2(p)]>
	define pop3j <jrst[sub p,[3,,3]↔jrst @3(p)]>
	define arg2 <-1(p)>
↑getfil:
	SETZM FILNAM↔SETZM EXTION
	SETZM EXTION+1↔SETZM PPPN
	MOVE 4,[POINT 6,FILNAM,-1]↔MOVEI 2,6
	INCHWL 1↔CAIN 1,15↔GO[INCHWL↔POP2J]↔AOS(P)
	JRST L+1
L:	INCHWL 1
	CAILE 1,"z"↔POP2J
	CAIL 1,"a"↔SUBI 1,40		;CONVERT LOWER CASE
	CAIN 1,":"↔GO[MOVE 4,FILNAM↔MOVEM 4,DEVNAM↔SOS (P)↔GO GETFIL]
	CAIN 1,"."↔GO[MOVE 4,[POINT 6,EXTION,-1]↔MOVEI 2,3↔GO L]
	CAIN 1,"["↔GO[MOVE 4,[POINT 6,PPPN,-1]  ↔MOVEI 2,3↔GO L]
	CAIN 1,","↔GO[HLRZ PPPN
		      PUSHJ P,[PPJUST:	JUMPE [OUTSTR[ASCIZ/BAD P,PN
/]↔						CLRBFI↔SOS -1(P)↔POP3J]	
		   	 		TRNE 77↔POP0J↔LSH -6↔GO PPJUST]
		      HRLM PPPN↔MOVE 4,[POINT 6,PPPN,17]↔MOVEI 2,3↔GO L]
	CAIN 1,"]"↔GO[HRRZ PPPN↔PUSHJ P,PPJUST
		   HRRM PPPN↔INCHWL 1↔GO FINQ]
FINQ:	CAIN 1,15↔GO EOL			;END OF THE LINE.
	CAIN 1,12↔POP2J
	CAIG 1," "↔GO L	;IGNORE GARBAGE.
	SOJL 2,L↔SUBI 1,40↔IDPB 1,4↔GO L

EOL:	INCHWL 2
	SKIPN 2,EXTION↔MOVE 2,ARG2↔MOVEM 2,EXTION
	POP2J
BEND

DEVNAM:	0
FILNAM:	0	;FILE NAME.
EXTION:	0	;EXTENSION.
	0
PPPN:	0	;PROJECT-PROGRAMMER.
SIXBK:	BLOCK	2
OBUF:	BLOCK 3
IBUF:	BLOCK 3
	PDL:	BLOCK 40

END STPT