PDP-10.its/bin/mbprog/assem.fbin

'<PCODE "5ASSEM">

<OR <LOOKUP "COMPILE" <ROOT>> <PACKAGE "CODING" "IC">> 

<OR <GASSIGNED? ONLY-FAST-OUTPUT> <SETG ONLY-FAST-OUTPUT <>>> 

<BLOAT 17000 500 10 500 10> 

<BLOCK (<ROOT>)> 

ASSEMBLY-OPSYS 

GLUE 

TMP 

<COND (<LOOKUP "COMPILE" <ROOT>> <REMOVE "TITLE" <ROOT>> <SETG ENTRY <FUNCTION (
"TUPLE" X) <1 .X>>>) (ELSE <OR <LOOKUP "TITLE" <ROOT>> <INSERT "TITLE" <ROOT>>>)
> 

<ENDBLOCK> 

<SETG MOB <GET MUDDLE OBLIST>> 

<BLOCK (,MOB)> 

$TLOSE 

NUMPRI 

<ENDBLOCK!- > 

<BLOCK (,MOB <ROOT>)> 

<OR <GASSIGNED? $TLOSE> <SETG $TLOSE <SQUOTA <SQUOZE!-RSUBRS "$TLOSE">>>> 

<OR <GASSIGNED? NUMPRI> <SETG NUMPRI <SQUOTA <SQUOZE!-RSUBRS "NUMPRI">>>> 

<GDECL (NUMPRI) FIX (MUDDLE) FIX> 

<ENDBLOCK> 

<GDECL (MOB) OBLIST> 

<COND (<LOOKUP "COMPILE" <ROOT>> <NEWTYPE <OR <LOOKUP "MUDREF" <1 .OBLIST>> <
INSERT "MUDREF" <1 .OBLIST>>> WORD> <NEWTYPE <OR <LOOKUP "OPCODE" <1 .OBLIST>> <
INSERT "OPCODE" <1 .OBLIST>>> WORD>) (ELSE <REMOVE "MUDREF" <1 .OBLIST>> <REMOVE
"OPCODE" <1 .OBLIST>> <EXTERNAL "OP">)> 

<SETG NO-OPS <PROG (TT) <OR <AND <SET TT <LOOKUP "COMPILE" <ROOT>>> <GASSIGNED? 
.TT>> <NOT <LOOKUP "HRRZ" <GET OP!-PACKAGE OBLIST>>>>>> 

<COND (<NOT ,NO-OPS> <SET READ-TABLE <IVECTOR 128 '0>> <PUT .READ-TABLE <+ <
ASCII !\`> 1> !\ >)> 

<PUTREST <REST .OBLIST> (,MOB !<REST .OBLIST 2!>)> 

<OR <LOOKUP "COMPILE" <ROOT>> <EVAL <PARSE 
"<MAPF <> #FUNCTION ((X) <INSERT <REMOVE .X> <GET OP!-PACKAGE OBLIST>>)
			  '(*INSERT ARG SQUOZE END)>">>> 

<NEWTYPE ADDRESS WORD> 

<NEWTYPE ICL WORD> 

<NEWTYPE CNST WORD> 

<NEWTYPE MCL WORD> 

<NEWTYPE PCL WORD> 

<ENTRY ASSEMBLE ASSEMBLE1 FILE-ASSEMBLE> 

<SET <ENTRY MESSAGE-CHANNEL> "TTY:"> 

<SET <ENTRY LINE-CHANNEL> <>> 

<SET <ENTRY MAKE-SYM-TABLE> <>> 

<SET <ENTRY QUICK-FORMAT> T> 

<OR <ASSIGNED? GLUE> <SET GLUE T>> 

<SETG ATOSQ  %<RSUBR!- '[ %<PCODE!- "5ASSEM" 0> ATOSQ #DECL ("VALUE" ANY <
PRIMTYPE WORD>) ASSEMBLE CER CER EPRINT CMESS GLUE MAKE-SYM-TABLE LINE-CHANNEL 
MESSAGE-CHANNEL OBLIST OP!-PACKAGE %<RGLOC MOB T> DEFAULT (LIST) GEOF (ANY) 
MORE-INSTS TITLE-STATEMENT DONT-LIST-N (FIX) "DONE IN" "SECONDS" QUICK-FORMAT 
"READ" (<LIST [REST <OR ATOM OBLIST>]>) REOF %<RGLOC MUDDLE T> "PRINTB" "PRINT" 
"ETMP.TMP" "_ETMP_ >" ASSEMBLY-OPSYS "ATMP" "TMP" "_ATMP_" ">" "TTY:" %<RGLOC 
OUTCHAN T> TITLE SETG FREEZE PUT GVAL QUOTE AND <ASSIGNED? GLUE> .GLUE OUTCHAN 
":<" ".NBIN" TO " " "NBIN" "BINARY" CODE-LIST MESS-CHAN ILNTH MCLNTH FIXES IMPS 
PHRED!-TMP MCS PQS NAMED SUB-ENTS IND GLOB-SYM (<LIST [REST FIX]>) EOF INTRS T 
POS- POS SWAP FULL (BITS) UNRESOLVED COUNT HERE %<RGLOC REL-M T> %<TYPE-W 
ADDRESS WORD> (ADDRESS) <END> "	" "								"
 ";" "CONSTANTS BEGIN AT LOCATION" "CONSTANTS END AT LOCATION" "LABEL" 
"AT LOCATION" "MULTIPLY DEFINED LABEL" %<TYPE-C ADDRESS WORD> ![TMP 
ICC!-CC!-PACKAGE CC!-PACKAGE!] "UNDEFINED SYMBOL" "USED AT" WORD "BAD SYMBOL" %<
TYPE-C MUDREF WORD> %<TYPE-C CNST WORD> %<TYPE-C MCL WORD> %<TYPE-C ICL WORD> %<
TYPE-C PCL WORD> "EMPTY FORM AT LOCATION" "SPLICING MACRO NOT AT TOP LEVEL" 
"EMPTY LIST USED AT" "EMPTY VECTOR USED AT" %<TYPE-W CNST WORD> %<RGLOC REL-R T>
 "UNRECOGNIZED ITEM" %<TYPE-C OPCODE WORD> "ITEMS UNRESOLVED AFTER SECOND PASS" 
%<RGLOC ONLY-FAST-OUTPUT T> RSUBR "BINARY FIXUPS BEING MISUSED" %<TYPE-W MUDREF 
WORD> "BAD BINARY FIXUPS HACK" ADD-TO-FIXUPS 
"**************
ASSEMBLY ERROR -- " "**************
" "BAD TYPE-CODE" ANY %<RGLOC NUMPRI T> "SWAPPED TYPE-CODE OF NEWTYPE" 
"USE TYPE-WORD" %<TYPE-W OPCODE WORD> $TLOSE %<RGLOC $TLOSE T> MOVEI A* ACALL 
MCALL* ACALL* %<TYPE-W ICL WORD> FOO %<TYPE-W PCL WORD> %<TYPE-W MCL WORD> 
"BAD OR MULTIPLE TITLE OF" "TITLE: " "ILLEGAL INTERNAL-ENTRY" "INTERNAL-ENTRY" 
"ILLEGAL SUB-ENTRY" "SUB-ENTRY" "DECLARE OUT OF PLACE" %<RGLOC REL-AB T> LDB (
74560) DPB #SPLICE (<SKIPGE INTFLG> <JSR LCKINT>) %<RGLOC DSAVAC-UV T> TEMPLATE 
SAVACS* ![#BITS *140600000000* #BITS *060600000000* #BITS *000600000000*!] 
INCHAN "Is this assembly for " "?
" %<RGLOC ASSEMBLY-OPSYS T> "Is this assembly for" ") " "?  Answer 1, 2, or 3
" ITS "YyTt" "BAD INSERT FILE NAME" "BAD CHAR IN SIXBIT" %<RGLOC REL-TB T> PUSH 
POP MOVE MOVEM]>> 
<AND <ASSIGNED? GLUE> .GLUE <PUT ,ATOSQ PGLUE ![716177407 -1 -1 -1 -1 -1 -1 -1 
-1 -262144 0!]>> 


<SETG ASSEMBLE %<RSUBR-ENTRY '[ATOSQ ASSEMBLE #DECL ("VALUE" LIST ANY "OPTIONAL"
<OR LIST OBLIST> <OR CHANNEL FALSE> ANY ANY ANY)] 16>> 

<SETG ASSEMBLE1 %<RSUBR-ENTRY '[ATOSQ ASSEMBLE1 #DECL ("VALUE" ANY ANY 
"OPTIONAL" <OR LIST OBLIST> <OR CHANNEL FALSE> ANY ANY ANY)] 309>> 

<SETG FILE-ASSEMBLE %<RSUBR-ENTRY '[ATOSQ FILE-ASSEMBLE #DECL ("VALUE" <OR 
CHANNEL FALSE LIST> STRING "OPTIONAL" <OR FALSE STRING> ANY "TUPLE" ANY)] 545>> 

<SETG DO-ASSEMB %<RSUBR-ENTRY '[ATOSQ DO-ASSEMB #DECL ("VALUE" <LIST <OR ATOM 
RSUBR>> LIST ANY ANY ANY ANY ANY FIX)] 1209>> 

<SETG MAKE-B-FIXUPS %<RSUBR-ENTRY '[ATOSQ MAKE-B-FIXUPS #DECL ("VALUE" UVECTOR <
LIST [REST <OR MUDREF FIX>]>)] 2883>> 

<SETG BITCHECK %<RSUBR-ENTRY '[ATOSQ BITCHECK #DECL ("VALUE" <OR FALSE <LIST [
REST FIX]>> FIX <LIST FIX [REST FIX]>)] 2941>> 

<SETG BITVEC %<RSUBR-ENTRY '[ATOSQ BITVEC #DECL ("VALUE" <LIST FIX [REST FIX]> 
FIX FIX <LIST FIX [REST FIX]>)] 3011>> 

<SETG ADD-TO-B-FIXUPS %<RSUBR-ENTRY '[ATOSQ ADD-TO-B-FIXUPS #DECL ("VALUE" ANY 
ANY FIX ANY ANY)] 3106>> 

<SETG ADD-TO-FIXUPS %<RSUBR-ENTRY '[ATOSQ ADD-TO-FIXUPS #DECL ("VALUE" ANY ATOM 
FIX ANY ANY)] 3291>> 

<SETG ADD-SYM %<RSUBR-ENTRY '[ATOSQ ADD-SYM #DECL ("VALUE" <LIST FIX [REST FIX]>
<LIST FIX [REST FIX]> ANY FIX)] 3482>> 

"KLUDGE TO MAKE $TMUMBLES FIX UP CORRECTLY" 

<MAPF <> #FUNCTION ((X "AUX" ATM) <COND (<SET ATM <LOOKUP <STRING "$T" <SPNAME .
X>> <GET MUDDLE OBLIST>>> <PUT .ATM ADD-TO-FIXUPS $TLOSE>)>) <ALLTYPES>> 

<SETG CER %<RSUBR-ENTRY '[ATOSQ CER #DECL ("VALUE" ANY "TUPLE" ANY)] 3533>> 

<SETG CMESS %<RSUBR-ENTRY '[ATOSQ CMESS #DECL ("VALUE" ATOM ANY "TUPLE" TUPLE)] 
3581>> 

<SETG QUOTER %<RSUBR-ENTRY '[ATOSQ QUOTER #DECL ("VALUE" FIX ANY ATOM ATOM <
PRIMTYPE WORD>)] 3632>> 

<SETG REL-M <CHTYPE <PUTBITS 0 <BITS 18 18> 13> ADDRESS>> 

<SETG REL-R <CHTYPE <PUTBITS 0 <BITS 18 18> 14> ADDRESS>> 

<SETG REL-AB <CHTYPE <PUTBITS 0 <BITS 18 18> 9> ADDRESS>> 

<SETG REL-TB <CHTYPE <PUTBITS 0 <BITS 18 18> 10> ADDRESS>> 

"THE FOLLOWING ARE IN OP, BUT MAYBE DEFINED HERE" 

<OR <LOOKUP "COMPILE" <ROOT>> <BLOCK (<MOBLIST OP!-PACKAGE> <ROOT>)>> 

TITLE 

PSEUDO 

INTERNAL-ENTRY 

SUB-ENTRY 

DECLARE 

MQUOTE 

IQUOTE 

PQUOTE 

CQUOTE 

ARG 

GETYP 

PUTYP 

MCALL 

ACALL 

SYMDEF 

TYPE-CODE 

TYPE-WORD 

INTGO 

DSAVAC 

IFOPSYS 

*INSERT 

SIXBIT 

SQUOZE 

STACK 

BYTE 

DPUSH 

DPOP 

DMOVE 

DMOVEM 

SYMDEF? 

UNDEF? 

IF-NEEDED 

<OR <LOOKUP "COMPILE" <ROOT>> <ENDBLOCK>> 

"HERE IS THE DEFINITION FOR SOME OF THE KLUDGES" 

<SETG TYPE-CODE %<RSUBR-ENTRY '[ATOSQ TYPE-CODE #DECL ("VALUE" <OR FIX OPCODE> 
ANY)] 3717>> 

<SETG TYPE-WORD %<RSUBR-ENTRY '[ATOSQ TYPE-WORD #DECL ("VALUE" <OR ADDRESS FIX <
VECTOR FORM [REST FORM]>> ANY "OPTIONAL" FIX)] 3782>> 

<SETG MCALL %<RSUBR-ENTRY '[ATOSQ MCALL #DECL ("VALUE" <OR FORM SPLICE> ANY ANY)
] 3895>> 

<SETG ACALL %<RSUBR-ENTRY '[ATOSQ ACALL #DECL ("VALUE" FORM ANY ANY)] 4000>> 

<SETG UNDEF? %<RSUBR-ENTRY '[ATOSQ UNDEF? #DECL ("VALUE" <OR ATOM FALSE> ANY)] 
4060>> 

<SETG IF-NEEDED %<RSUBR-ENTRY '[ATOSQ IF-NEEDED #DECL ("VALUE" SPLICE ANY "ARGS"
ANY)] 4097>> 

<SETG IQUOTE %<RSUBR-ENTRY '[ATOSQ IQUOTE #DECL ("VALUE" FIX ANY "OPTIONAL" ANY)
] 4127>> 

<SETG PQUOTE %<RSUBR-ENTRY '[ATOSQ PQUOTE #DECL ("VALUE" FIX ANY)] 4227>> 

<SETG CQUOTE %<RSUBR-ENTRY '[ATOSQ CQUOTE #DECL ("VALUE" FIX ANY)] 4258>> 

<SETG MQUOTE %<RSUBR-ENTRY '[ATOSQ MQUOTE #DECL ("VALUE" FIX ANY)] 4279>> 

<SETG PSEUDO %<RSUBR-ENTRY '[ATOSQ PSEUDO #DECL ("VALUE" SPLICE "TUPLE" ANY)] 
4294>> 

<SETG TITLE %<RSUBR-ENTRY '[ATOSQ TITLE #DECL ("VALUE" SPLICE ANY "OPTIONAL" ANY
)] 4320>> 

<SETG INTERNAL-ENTRY %<RSUBR-ENTRY '[ATOSQ INTERNAL-ENTRY #DECL ("VALUE" SPLICE 
ANY ANY)] 4424>> 

<SETG SUB-ENTRY %<RSUBR-ENTRY '[ATOSQ SUB-ENTRY #DECL ("VALUE" SPLICE ANY 
"OPTIONAL" "QUOTE" ANY)] 4483>> 

<SETG DECLARE %<RSUBR-ENTRY '[ATOSQ DECLARE #DECL ("VALUE" SPLICE "QUOTE" ANY)] 
4593>> 

<SETG ARG %<RSUBR-ENTRY '[ATOSQ ARG #DECL ("VALUE" <PRIMTYPE WORD> FIX)] 4632>> 

<SETG GETYP %<RSUBR-ENTRY '[ATOSQ GETYP #DECL ("VALUE" FORM "QUOTE" ANY "ARGS" 
ANY)] 4650>> 

<SETG PUTYP %<RSUBR-ENTRY '[ATOSQ PUTYP #DECL ("VALUE" FORM "QUOTE" ANY "ARGS" 
ANY)] 4695>> 

<SETG SYMDEF %<RSUBR-ENTRY '[ATOSQ SYMDEF #DECL ("VALUE" SPLICE ANY ANY)] 4740>> 

<SETG INTGO %<RSUBR-ENTRY '[ATOSQ INTGO #DECL ("VALUE" !<SPLICE [2 !<FORM [2 
ATOM]!>]!>)] 4770>> 

<SETG DSAVAC %<RSUBR-ENTRY '[ATOSQ DSAVAC #DECL ("VALUE" FORM "TUPLE" ANY)] 4778
>> 

<SETG CONV-3 %<RSUBR-ENTRY '[ATOSQ CONV-3 #DECL ("VALUE" FIX <UVECTOR [REST FIX]
>)] 5007>> 

<SETG CONV-AC %<RSUBR-ENTRY '[ATOSQ CONV-AC #DECL ("VALUE" ANY <OR ATOM FIX>)] 
5036>> 

<SETG IFOPSYS %<RSUBR-ENTRY '[ATOSQ IFOPSYS #DECL ("VALUE" SPLICE "ARGS" <LIST [
REST <OR ATOM LIST>]>)] 5061>> 

<SETG GOPSYS %<RSUBR-ENTRY '[ATOSQ GOPSYS #DECL ("VALUE" <OR ATOM LIST> <OR ATOM
LIST>)] 5285>> 

<SETG YES/NO %<RSUBR-ENTRY '[ATOSQ YES/NO #DECL ("VALUE" <OR ATOM FALSE>)] 5318>
> 

<SETG GNUM %<RSUBR-ENTRY '[ATOSQ GNUM #DECL ("VALUE" FIX)] 5342>> 

<SETG *INSERT %<RSUBR-ENTRY '[ATOSQ *INSERT #DECL ("VALUE" SPLICE STRING)] 5351>
> 

<SETG SIXBIT %<RSUBR-ENTRY '[ATOSQ SIXBIT #DECL ("VALUE" <OR FIX OPCODE> STRING)
] 5424>> 

<SETG SQUOZE %<RSUBR-ENTRY '[ATOSQ SQUOZE #DECL ("VALUE" <OR FALSE OPCODE> 
STRING "OPTIONAL" <PRIMTYPE WORD> ANY)] 5485>> 

<SETG STACK %<RSUBR-ENTRY '[ATOSQ STACK #DECL ("VALUE" SPLICE "TUPLE" ANY)] 5584
>> 

<SETG BYTE %<RSUBR-ENTRY '[ATOSQ BYTE #DECL ("VALUE" <VECTOR FORM [REST FORM]> 
ANY ANY "ARGS" ANY)] 5653>> 

<SETG SYMDEF? %<RSUBR-ENTRY '[ATOSQ SYMDEF? #DECL ("VALUE" ANY ANY)] 5714>> 

<SETG DPUSH %<RSUBR-ENTRY '[ATOSQ DPUSH #DECL ("VALUE" SPLICE "ARGS" ANY)] 5739>
> 

<SETG DPOP %<RSUBR-ENTRY '[ATOSQ DPOP #DECL ("VALUE" SPLICE "ARGS" ANY)] 5803>> 

<SETG DMOVE %<RSUBR-ENTRY '[ATOSQ DMOVE #DECL ("VALUE" SPLICE "ARGS" ANY)] 5867>
> 

<SETG DMOVEM %<RSUBR-ENTRY '[ATOSQ DMOVEM #DECL ("VALUE" SPLICE "ARGS" ANY)] 
5936>> 

<COND (<NOT ,NO-OPS> <UNASSIGN READ-TABLE>)> 

<OR <LOOKUP "COMPILE" <ROOT>> <ENDPACKAGE>>