COMMENT ⊗   VALID 00017 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	PALX BINARY FILE FORMAT
C00004 00003	TITLE 11LOAD CONSOLE 11/40 LOADER
C00005 00004	MACROS - GETFIL,CRLF,HASPAR,D11CLR,D11RD,D11WR,D11WRB,D11MAC,D11CON
C00007 00005	MORE MACROS - CONC,CALLIT,CMD,SECOND
C00009 00006	BEG,PAT,BEGL,MAIN,COMMAND DISPATCH
C00012 00007	XTEND, BUCKY
C00014 00008	EXPLN, GORAID, XIT
C00015 00009	LDBIN - LOAD BINARY FILE SUBROUTINE, BYTOBP, FTCH11, STOR11
C00019 00010	LDSYMS, OLDSYMS - SUBROUTINES TO LOAD/OVERLAY SYMBOLS
C00023 00011	DDDT, DDT, DDTL, OVER, MERGE, NODDT, INSERT, ZR
C00026 00012	LOAD, DLOAD, WRBIN
C00030 00013	RAD50,RDB,RDW,GETNUM,OCTTYP,DECTYP
C00036 00014	FILSCN, LUPFL, ENTFL, INITFL, GETSIX, SIXTYP
C00045 00015	GET WORD FROM DKIC FILE INTO I
C00047 00016	
C00051 00017	LPDL←←30
C00053 ENDMK
C⊗;
;PALX BINARY FILE FORMAT
;
;B => BYTE, W => WORD (LOW BYTE THEN HIGH BYTE)
;
;	.
;	.
;	.
;****************
;*B	1
;*B	0	(ERROR IF NOT 0)
;*W	# BYTES OF DATA + 6	(6 => JUMP BLOCK)
;*W	ADDRESS			(JUMP ADDRESS)
;*B	DATA
;*	.
;*	.
;*	.
;*B	DATA
;*B	CHECKSUM (SUM FROM INITIAL 1 THROUGH CHECKSUM = 0 IN LOW 8 BITS)
;****************
;	REPEAT
;	.
;	.
;	.
;	2
;****************
;*	SIXBIT SYMBOL
;*	BITS,,VALUE
;****************
;	REPEAT
;	0
TITLE 11LOAD CONSOLE 11/40 LOADER

A←1
B←2
C←3
D←4
E←5
G←6
T←7
TT←10
I←11
J←12
K←13
L←14
M←15
N←16
P←17

DKIC←←1
DKOC←←2

NKCOR←←=28		;KL10 CONSOLE 11/40 HAS 2 MF11UPs = 28K WORDS
TOPCOR←←NKCOR*=1024*2-1	;HIGHEST BYTE ADDRESS IN CORE
DDTTOP←←100000
DDTBEG←←DDTTOP-22000
;MACROS - GETFIL,CRLF,HASPAR,D11CLR,D11RD,D11WR,D11WRB,D11MAC,D11CON

DEFINE GETFIL $ (LE,STR,LH,CH,BUF,BYTE)
<ZZ←←.
IFDIF <STR><><OUTSTR [ASCIZ /$STR$/]>
	PUSHJ P,FILSCN	;INPUT FILE SPECS
IFIDN <LE> <L> <LH,,LUP>
IFIDN <LE> <E> <LH,,ENT>
	JRST [	CRLF		;ALT TYPED
		JRST MAIN]
	JRST [	OUTSTR [ASCIZ /??	
/]				;GARBAGE TYPED
		CLRBFI
		JRST ZZ]
	INIT CH,10
	'DSK   '
IFIDN <LE> <E> <BUF,,> IFIDN <LE> <L> <BUF>
	JRST INITL
IFIDN <LE> <L> <LOOKUP CH,LUP
	JRST [	PUSHJ P,LUPFL
		JRST ZZ]>
IFIDN <LE> <E> <ENTER CH,ENT
	JRST [	PUSHJ P,ENTFL
		JRST ZZ]>
	MOVEI A,BYTE
	DPB A,[300600,,BUF+1]
>

DEFINE CRLF <
	OUTSTR [BYTE (7) 15,12]
>
;MORE MACROS - CONC,CALLIT,CMD,SECOND

DEFINE	CONC ! (A,B)
<A!B>

DEFINE	CBAR <0,>
DEFINE	CFOO ! (A,B,C)<DEFINE CBAR()<0,<B
C>>>
DEFINE	CBAZ(A)<CFOO(\CBAR,<A>)>

NLOSES←←0

DEFINE	CALLIT ! (FOO,ERR)<
IFDEF HICAL,<PRINTS /HICAL DEFINED TOO SOON
/>
	PUSHJ P,FOO
CONC(LL,\NLOSES)::
CBAZ([ASCIZ/ERR/])
NLOSES←←NLOSES+1
>

DEFINE	BAR1 <0,>
DEFINE	FOO1 ! (A,B,C)<DEFINE BAR1 <0,<B
C>>>
DEFINE	BAZ1(A)<FOO1(\BAR1,<A>)>
DEFINE	SECOND(A,B)<B>

DEFINE	CMD(CHR,TEXT)<
	"CHR"
	BAZ1(<OUTSTR [ASCIZ πCHR	TEXT
π]>)>

DEFINE	BAR2 <0,>
DEFINE	FOO2 ! (A,B,C)<DEFINE BAR2 <0,<B
C>>>
DEFINE	BAZ2(A)<FOO2(\BAR2,<A>)>

DEFINE	XCMD(NAME,TEXT)<
	SIXBIT /NAME/
	BAZ2(<OUTSTR [ASCIZ πNAME	TEXT
π]>)>
;BEG,PAT,BEGL,MAIN,COMMAND DISPATCH

PAT:
PATCH:	BLOCK 100

BEG:	JFCL		;IN CASE STARTED IN RPG MODE
	RESET
	MOVE P,[-LPDL,,PDL-1]
	MOVEI A,400000+<<TOPCOR+1>/4>-1
	CORE2 A,
	JRST 4,.
	PUSHJ P,ZR
	SETOM JMPBLF
	SETOM PROGSA
	SETOM DDTSA
	OUTSTR [ASCIZ /
TYPE ? FOR HELP/]
MAIN:
BEGL:	PTJOBX [0 ↔ 'DON   ']
	SETZM OVERLF
	MOVE P,[-LPDL,,PDL-1]
	RELEAS DKIC,
	CLOSE DKOC,
	RELEAS DKOC,
	OUTSTR [ASCIZ /
*/]
INBEG:	INCHRW A
	TRNE A,600
	JRST CMCMD		;CONTROL OR META BIT ON IN COMMAND
	CAIE A,15
	CAIN A,12
	JRST INBEG
	CAIL A,"a"
	CAILE A,"z"
	CAIA
	SUBI A,40
	MOVSI B,-NCMDS
CMDSL:	CAME A,CMDCTB(B)
	AOBJN B,CMDSL
	JUMPGE B,CMDHUH
	PUSHJ P,@CMDDTB(B)
	JRST BEGL

CMDHUH:	OUTSTR [ASCIZ /  ??/]
	JRST BEGL

CMCMD:	ANDI A,177
	CAIL A,"A"
	CAILE A,"Z"
	CAIA
	JRST CMCMD1
	CAIL A,"a"
	CAILE A,"z"
	JRST CMDHUH
	ANDCMI A,40
CMCMD1:	MOVSI B,-NCMCMD
CMCMDL:	CAME A,CMCMDT(B)
	AOBJN B,CMCMDL
	JUMPGE B,CMDHUH
	PUSHJ P,@CMCMDD(B)
	JRST BEGL

CMDCTB:	CMD(?,EXPLAIN THESE COMMANDS)
	CMD(N,LOAD WITHOUT DEBUGGER OR SYMBOLS)
	CMD(L,<LOAD PROGRAM (BINARY FILE) WITH DDT AND SYMBOLS>)
	CMD(D,JUST LOAD DDT)
	CMD(M,<MERGE (DON'T CLEAR CORE) ADDING SYMBOLS>)
;	CMD(I,<INSERT (DON'T CLEAR CORE) REPLACING SYMBOLS>)
	CMD(O,<OVERLAY (NO DDT, NO SYMBOLS, DON'T CLEAR CORE)>)
	CMD(H,<HAVE BUG, WILL UNRAVEL>)
	CMD(X,EXIT)
	CMD(A,SIMULATE BUCKY X)
	CMD(W,WRITE OUT BIN FILE)

NCMDS←←.-CMDCTB

CMDDTB:	EXPLN
	NODDT
	LOAD
	DDT
	MERGE
;	INSERT
	OVER
	GORAID
	XIT
	BUCKY
	WRBIN

CMCMDT:	"X"
NCMCMD←←.-CMCMDT

CMCMDD:	XTEND
;XTEND, BUCKY

BUCKY:	OUTSTR [ASCIZ /N EXTENDED COMMAND /]
	JRST XTEND6

XTEND:	OUTSTR [ASCIZ /TENDED COMMAND /]
XTEND6:	PUSHJ P,GETSIX		;GET SYL IN J SEP IN I
	CAIN I,175
	POPJ P,
	MOVEM I,SEP
	JUMPE J,CPOPJ
	MOVE A,J		;SIXBIT TO A
	MOVEI J,0
	TLNN K,770000		;K WAS BP INTO J USED BY GETSIX
	JRST XTEND1		;NAME IS 6 CHARS LONG
	MOVEI I,77
XTEND0:	IDPB I,K		;MAKE A MASK OF UNUSED BITS
	TLNE K,770000
	JRST XTEND0		;MORE BITS TO DO
XTEND1:	MOVSI B,-NXCMDS
XTEND2:	MOVE C,XCMDS(B)
	CAMN A,C
	JRST XTENDF		;EXACT MATCH
	ANDCAM J,C		;TURN OFF BITS IN NEW CANDIDATE NOT SPECIFIED IN A
	CAMN A,C
	JRST XTEND3		;PARTIAL MATCH
XTEND4:	AOBJN B,XTEND2
	JUMPL I,XTEND5		;FOUND EXACTLY ONE PARTIAL MATCH
	OUTSTR [ASCIZ /UNKNOWN COMMAND
/]
	POPJ P,

XTEND3:	JUMPL I,[OUTSTR [ASCIZ /AMBIGUOUS COMMAND
/]
		POPJ P,]
	TLO I,400000(B)		;INDICATE THERE HAS ALREADY BEEN A PARTIAL MATCH
	JRST XTEND4

XTEND5:	HLRZ B,I
	ANDI B,377777
XTENDF:	JRST @XCMDTB(B)

XCMDS:	XCMD(DDT,JUST LOAD DDT)
	XCMD(LOAD,LOAD WITH DDT)
NXCMDS←←.-XCMDS

XCMDTB:	DDDT
	DLOAD
;EXPLN, GORAID, XIT

EXPLN:	OUTSTR [ASCIZ /
/]
	SECOND (\BAR1)
	OUTSTR [ASCIZ /TYPE CNTL-META C TO RETURN TO COMMAND MODE
TYPE <ANY BUCKY> X TO ENTER EXTEND MODE COMMANDS:
/]
	SECOND (\BAR2)
	JRST BEGL

GORAID:	SKIPN A,JOBDDT↑
	JRST GORAI1
	JSR @-6(A)
	JRST BEGL

GORAI1:	OUTSTR [ASCIZ / - NO RAID/]
	JRST BEGL

XIT:	PTJOBX [0 ↔ SIXBIT /DON/]
	EXIT
;LDBIN - LOAD BINARY FILE SUBROUTINE, BYTOBP, FTCH11, STOR11

;LOAD BINARY FILE (RETURNS ON FINDING JUMP BLOCK)
;JUMP ADDRESS STORED IN JMPBLF
LDBIN:	SKIPN OVERLF		;DON'T CLOBBER STARTING ADDRESS IF OVERLAYING
	SETOM JMPBLF
LOWCAL:	IFN NLOSES,<PRINTS /LOWCAL DEFINED TOO LATE
/>
LDLP:	MOVEI K,0
LDLP1:	CALLIT(RDB,SEARCHING FOR 1 AT BEGINNING OF BLOCK)
	CAIE I,1
	JRST LDLP1
	CALLIT(RDB,READING BYTE AFTER INITIAL 1)
	JUMPN I,[	OUTSTR [ASCIZ /INITIAL 1 NOT FOLLOWED BY 0
/]
			JRST BEGL]
	CALLIT(RDW,READING NUMBER OF BYTES WORD)	;NUMBER OF BYTES OF DATA + 6
	CAIN I,6
	JRST JUMPB
	MOVEI A,-6(I)		;NUMBER OF BYTES OF DATA
	CALLIT(RDW,READING ADDRESS WORD)	;ADDRESS OF FIRST BYTE
	MOVE B,I		;ADDRESS OF FIRST BYTE IN BLOCK
	ADDI I,-1(A)		;ADDRESS OF LAST BYTE IN BLOCK
	CAIG I,TOPCOR
	CAILE B,TOPCOR
	JRST [	OUTSTR [ASCIZ /ATTEMPT TO LOAD FILE ABOVE TOP OF CORE
/]
		JRST BEGL]
LDLP1A:	PUSHJ P,BYTOBP
LDLP1B:	CALLIT(RDB,READING DATA BYTE)
	IDPB I,D
	SOJG A,LDLP1B
LDLP2E:	MOVEI B,LDLP
LDLP3:	CALLIT(RDB,READING CHECKSUM)
	TRNE K,377
	JRST [	OUTSTR [ASCIZ /CHECKSUM ERROR
/]
		JRST BEGL]
	JRST (B)

JUMPB:	CALLIT(RDW,READING JUMP BLOCK ADDRESS)
	SKIPN OVERLF		;DON'T CLOBBER STARTING ADDRESS IF OVERLAYING
	MOVEM I,JMPBLF
	MOVEI B,CPOPJ
	JRST LDLP3

;CONVERT BYTE ADDRESS IN B TO ILDB TYPE BYTE POINTER IN D
BYTOBP:	PUSH P,C
	MOVE C,B
	IDIVI C,4
	MOVE D,BYTOBT(D)
	ADDI D,(C)
	POP P,C
	POPJ P,

BYTOBT:	441000,,400000
	341000,,400000
	241000,,400000
	141000,,400000

;B HAS BYTE ADDRESS, C GETS WORD DATA
FTCH11:	PUSH P,D
	PUSH P,A
	PUSHJ P,BYTOBP
	ILDB C,D		;GET THE EVEN BYTE
	ILDB A,D		;GET THE ODD BYTE
	LSH A,8
	ADDI C,(A)
	POP P,A
	POP P,D
	POPJ P,

;A HAS WORD DATA, B HAS BYTE ADDRESS
STOR11:	PUSH P,D
	PUSH P,C
	PUSHJ P,BYTOBP
	IDPB A,D		;STORE LOW 8 BITS
	LDB C,[POINT 8,A,27]
	IDPB C,D		;STORE HIGH 8 BITS
	POP P,C
	POP P,D
	POPJ P,
;LDSYMS, OLDSYMS - SUBROUTINES TO LOAD/OVERLAY SYMBOLS

;OLSYMS:	D11TRA SMTOPR		;Overlay symbols
;	MOVE C,SMTOPR+1
;	JRST LDSYM3
LDSYMS:	MOVEI B,DDTBEG-2	;Load symbols (at end of old table)
	PUSHJ P,FTCH11		;GET POINTER TO FIRST WORD OF LAST SYMBOL INTO C
LDSYM3:	MOVEI B,DDTBEG-4
	MOVE A,PROGSA
	PUSHJ P,STOR11
	MOVEI G,(C)		;BYTE ADDRESS OF FIRST WORD OF LAST SYM
	SUBI C,DDTBEG-6
	IDIVI C,<=16*6+4>	;COMPUTE - NUMBER OF 16 SYM BLOCKS AWAY
	IMULI C,<=16*6+4>
	ADDI C,DDTBEG-6
;	LSH C,-1		;WORD ADDRESS
	IDIVI D,6		;- # SYMBOLS FROM END OF BLOCK
	MOVN D,D
	MOVEI E,1
	LSH E,-1(D)		;BIT FOR LAST SYMBOL
;	LSH G,-1		;WORD ADDRESS OF FIRST WORD OF LAST SYMBOL WRITTEN
	MOVEI D,(G)
	MOVEI B,-2(C)
	PUSH P,C
	PUSHJ P,FTCH11		;HALF-KILLED BITS
	MOVE M,C
	POP P,C
	ADDI B,2
	PUSH P,C
	PUSHJ P,FTCH11
	MOVE N,C		;REGISTER BITS
	POP P,C
LDSYM2:	CALLIT(RDB,SEARCHING FOR INITIAL 2)
	CAIE I,2
	JRST LDSYM2
SYML0:	LSH E,1
	TRNE E,200000		;DONE WITH THIS BLOCK OF 16?
	JRST SYMB		;YES
	SUBI D,3*2
SYML1:	CALLIT(RDB,READING SYMBOL NAME)
	JUMPE I,SYMDN
	PUSH P,I
	CALLIT(RDB,READING SYMBOL VALUE)
	EXCH I,(P)
	PUSHJ P,RAD50		;CONVERT I INTO T AND TT
	MOVEI B,(D)
	MOVE A,T
	PUSHJ P,STOR11
	ADDI B,2
	MOVE A,TT
	PUSHJ P,STOR11
	ADDI B,2
	POP P,I
	MOVE A,I
	PUSHJ P,STOR11
	TLNE I,4000		;REGISTER FLAG
	IORM E,N
	TLNE I,20000		;HALF-KILLED FLAG
	IORM E,M
	MOVEI G,(D)		;BYTE ADDRESS OF FIRST WORD OF LAST SYMBOL WRITTEN
	JRST SYML0

SYMB:	MOVEI B,-2(C)		;BYTE ADDRESS OF HALF KILLED WORD THIS BLOCK
	MOVE A,M
	PUSHJ P,STOR11
	ADDI B,2		;BYTE ADDRESS OF REGISTER WORD
	MOVE A,N
	PUSHJ P,STOR11
	MOVEI C,-2(D)		;BYTE ADDRESS OF REGISTER WORD OF NEXT BLOCK
	SETZB M,N
	MOVEI D,-10(C)		;BYTE ADDRESS OF FIRST SYMBOL OF NEXT BLOCK
	AOJA E,SYML1
HICAL:
SYMDN:	MOVEI B,-2(C)
	MOVE A,M
	PUSHJ P,STOR11
	ADDI B,2
	MOVE A,N
	PUSHJ P,STOR11
	OUTSTR [ASCIZ/SYMBOLS START AT /]
	MOVE D,G
	PUSHJ P,OCTTYP
	OUTSTR [ASCIZ/.
/]
	MOVEI B,DDTBEG-2
	MOVE A,G
	JRST STOR11
;DDDT, DDT, DDTL, OVER, MERGE, NODDT, INSERT, ZR

;JUST LOAD DDT
DDDT:	OUTCHR ["D"]
DDT:	OUTSTR [ASCIZ /DT ALONE
/]
	SETZM NOSYMS		;DDT ALONE GETS DDT SYMBOLS
DDTL:	INIT DKIC,10
	'DSK   '
	IBUF
	JRST 4,.
	MOVSI A,'DDT'
	MOVSI B,'BIN'
	MOVEI C,0
	MOVE D,[' KLSYS']
	LOOKUP DKIC,A
	JRST [	OUTSTR [ASCIZ /
DEBUGGER NOT FOUND???/]
		JRST BEGL]
	PUSHJ P,ZR		;ZERO CORE
	PUSHJ P,LDBIN
	MOVE A,JMPBLF
	MOVEM A,DDTSA
	SKIPN OVERLF
	MOVEM A,PROGSA
	SKIPN NOSYMS
	PUSHJ P,LDSYMS
	MOVEI A,340
	MOVEI B,DDTTOP-12	;STORE 340 IN DDTST
	PUSHJ P,STOR11
	POPJ P,



;OVERLAY BINARY WITHOUT DDT OR SYMBOLS
OVER:	OUTSTR [ASCIZ /VERLAY /]
	SETOM OVERLF
	JRST OVERE

;LOAD BINARY WITHOUT DDT OR SYMBOLS
NODDT:	OUTSTR [ASCIZ /ODDT /]
OVERE:	MOVEI A,0
	DSKPPN A,		;GET CURRENT DSK PPN
	MOVEM A,SAVPPN
	GETFIL (L,BIN FILE - ,'BIN',DKIC,IBUF,=36)
	SKIPN OVERLF		;DON'T CLEAR CORE FOR OVERLAY
	PUSHJ P,ZR		;ZERO CORE
	PUSHJ P,LDBIN		;LOAD BIN FILE AND RETURN
	MOVE A,JMPBLF
	SKIPN OVERLF
	MOVEM A,PROGSA
	POPJ P,

MERGE:	OUTSTR [ASCIZ /ERGE, ADDING SYMBOLS, /]
	SETOM OVERLF
	PUSHJ P,OVERE
	JRST LDSYMS		;LOAD SYMBOLS AND RETURN

;INSERT:	OUTSTR [ASCIZ /NSERT, REPLACING SYMBOLS, /]
;	SETOM OVERLF
;	PUSHJ P,OVERE
;	JRST OLSYMS		;OVERLAY SYMBOLS AND RETURN

ZR:	SETZM 400000
	MOVE A,[400000,,400001]
	BLT A,400000+<<TOPCOR+1>/4>-1
	POPJ P,
;LOAD, DLOAD, WRBIN

;LOAD WITH DDT AND SYMBOLS
DLOAD:	OUTCHR ["L"]
LOAD:	OUTSTR [ASCIZ /OAD /]
LOADE:	GETFIL (L,BIN FILE - ,'BIN',DKIC,IBUF,=36)
	IOPUSH DKIC,1		;SAVE ACROSS THE NEXT FEW CALLS
	JRST 4,.		;  FAILURE?
	SETOM NOSYMS		;DON'T WANT DDT'S SYMBOLS
	PUSHJ P,DDTL		;GET DDT IN CORE
	MOVE A,JMPBLF
	MOVEM A,DDTSA		;DDT'S STARTING ADDRESS
	IOPOP DKIC,1		;GET CHANNEL BACK
	JRST 4,.		;  FAILURE?
	PUSHJ P,LDBIN		;LOAD CODE PART OF BINARY FILE
	MOVE A,JMPBLF
	MOVEM A,PROGSA		;PROGRAM'S STARTING ADDRESS
	PUSHJ P,LDSYMS		;LOAD SYMBOLS INTO DEBUGGER
	MOVE A,DDTSA
	MOVEM A,JMPBLF		;START AT DEBUGGER FOR LOAD
	POPJ P,

WRBIN:	OUTSTR [ASCIZ /RITE /]
	GETFIL (E,BIN FILE - ,'BIN',DKOC,OBUF,=36)
	MOVE A,[-<TOPCOR+1>/4,,400000]
WRBIN1:	SKIPN (A)
	AOBJN A,WRBIN1
	JUMPGE A,WRBINE		;EMPTY CORE IMAGE
	MOVE B,A		;SAVE POINTER TO FIRST NON-ZERO WORD
	MOVEI A,400000+<<TOPCOR+1>/4>-1	;LAST WORD OF CORE IMAGE
WRBIN2:	SKIPN (A)
	SOJA A,WRBIN2
	SUBI A,-1(B)		;LENGTH OF BLOCK IN PDP10 WORDS
WRBIN3:	MOVE C,A
	CAIL A,40000/4
	MOVEI A,40000/4		;STUPID TCDP CANT LOAD MORE THAN 100000 BYTE BLOCKS
	SUB C,A
	PUSH P,C
	PUSHJ P,WRBLOK
	POP P,A			;AMOUNT LEFT TO DO
	JUMPN A,WRBIN3
WRBIND:	MOVEI K,0
	MOVEI I,1
	PUSHJ P,CPUT
	MOVEI I,0
	PUSHJ P,CPUT
	MOVEI I,6
	PUSHJ P,CPUT
	MOVEI I,0
	PUSHJ P,CPUT
	MOVE C,PROGSA
	PUSHJ P,WCPUT
	MOVN K,K
	LDB I,[POINT 8,K,35]
	PUSHJ P,PUT
	MOVEI I,0
	PUSHJ P,PUT
	RELEAS DKOC,
	POPJ P,

WRBINE:	OUTSTR [ASCIZ /EMPTY CORE IMAGE SAVED
/]
	JRST WRBIND

WRBLOK:	LSH A,2			;NUMBER OF BYTES OF DATA ...
	MOVE D,A
	MOVEI C,6(A)		; ... +6
	MOVEI K,0
	MOVEI I,1
	PUSHJ P,CPUT
	MOVEI I,0
	PUSHJ P,CPUT
	PUSHJ P,WCPUT
	MOVEI C,-400000(B)
	LSH C,2			;STARTING BYTE ADDRESS
	PUSHJ P,WCPUT
	HRLI B,441000		;MAKE BYTE POINTER TO DATA
WRBIN4:	ILDB I,B
	PUSHJ P,CPUT
	SOJG D,WRBIN4
	IBP B			;MAKE B POINT AT NEXT WORD IF AT END OF WORD
	MOVN K,K
	LDB I,[POINT 8,K,35]
	JRST PUT

WCPUT:	LDB I,[POINT 8,C,35]
	PUSHJ P,CPUT
	LDB I,[POINT 8,C,27]
CPUT:	ADD K,I
	JRST PUT
;RAD50,RDB,RDW,GETNUM,OCTTYP,DECTYP

;RAD50 CONVERTS SIXBIT IN I TO TWO RADIX 50 RIGHT ADJUSTED
;16 BIT BYTES IN T AND TT
RAD50:	SETZB T,TT
	MOVEI K,6
R50L:	MOVEI J,0
	ROTC I,6
	IMULI TT,50
	PUSHJ P,R50
	ADDI TT,(J)
	CAIE K,4
	SOJG K,R50L
	JUMPE K,CPOPJ
	EXCH T,TT
	SOJA K,R50L

R50:	CAILE J,72
	JRST POPJ1
	CAIN J,4
	JRST [MOVEI J,33 ↔ POPJ P,]
	CAIN J,16
	JRST [MOVEI J,34 ↔ POPJ P,]
	CAIGE J,41
	CAIGE J,32
	CAIGE J,20
	JRST POPJ1
	SUBI J,40
	JUMPGE J,CPOPJ
	ADDI J,40+16
	POPJ P,

;RDB READS A BYTE (I) AND ADDS IT INTO THE CHECKSUM (K)
RDB:	PUSHJ P,GETIN
	ADD K,I
	POPJ P,

;RDW READS TWO BYTES AND MAKES A WORD (LOW ORDER BYTE FIRST)
;USES RDB SO CHECKSUM IS COMPUTED
RDW:	PUSHJ P,RDB
RDW1:	PUSH P,I
	PUSHJ P,RDB
	LSH I,8
	IOR I,(P)
	SUB P,[1,,1]
	POPJ P,

;DIRECT RETURN IF GARBAGE TYPED, SKIP IF ALT, SKIP TWICE IF OK NUMBER (IN A)
;RETURNS DELIMITER IN B, NUMBER OF DIGITS IN C
GETNUM:	SETZM MINUSF
	MOVEI A,0
GETNM1:	INCHWL B
	CAIN B,"-"
	JRST [SETOM MINUSF ↔ JRST GETNM1]
	CAIN B,15
	JRST GETNM1
	CAIN B,12
	JRST GETNMX
	CAIN B,175
	JRST POPJ1
	CAIL B,"0"
	CAILE B,"7"
	POPJ P,
	LSH A,3
	ADDI A,-"0"(B)
	AOJA C,GETNM1

GETNMX:	SKIPGE MINUSF
	MOVNS A
POPJ2:	AOS (P)
	JRST POPJ1

OCTTYP:	PUSH P,G
	MOVEI G,10
	JRST DECTY

DECTYP:	PUSH P,G
	MOVEI G,=10
DECTY:	PUSH P,D
	PUSH P,E
	PUSHJ P,DECTY1
	POP P,E
	POP P,D
	POP P,G
	POPJ P,

DECTY1:	IDIVI D,(G)
	HRLM E,(P)
	SKIPE D
	PUSHJ P,DECTY1
	HLRZ E,(P)
	ADDI E,"0"
	OUTCHR E
	POPJ P,

LOSADR:
FOR N←0,NLOSES-1,1<CONC (LL,\N)
>
LOSTBL:	SECOND(\CBAR)
;FILSCN, LUPFL, ENTFL, INITFL, GETSIX, SIXTYP

;READ FILE SPECS FROM TTY INTO BLOCK - FILSCN
;WORD AFTER CALL IS DEFAULT EXTENSION,,BLK ADDRESS.
;DOESNT SKIP IF ALT MODE TYPED.
;SKIPS ONCE IF SYNTAX ERROR, TWICE IF OK.
FILSCN:	MOVE L,@(P)
	HLLZM L,1(L)	;SET UP DEFAULT EXTENSION
	AOS (P)
	MOVE I,SAVPPN
	MOVEM I,3(L)	;INITIALIZE TO CURRENT DSK PPN
	PUSHJ P,GETSIX	;SYMBOL IN J, SEPARATOR IN I
	CAIN I,175	;ALT MODE
	POPJ P,
	AOS (P)
	MOVEM J,(L)
	CAIN I,"."
	JRST FILSCX	;GET EXTENSION
	CAIN I,"["
	JRST FILSCP	;GET PPN
	CAIN I,12
POPJ1:	AOS (P)
CPOPJ:	POPJ P,

FILSCX:	PUSHJ P,GETSIX
	HLLZM J,1(L)
	CAIN I,12
	JRST POPJ1
	CAIE I,"["
	POPJ P,
FILSCP:	PUSHJ P,GETSIX
	JUMPE J,FILSP3
FILSP1:	TLNE J,77	;RIGHT ADJUST
	JRST FILSP2
	LSH J,-6
	JRST FILSP1

FILSP2:	HLLM J,3(L)	;STORE PROJ NUMBER
FILSP3:	CAIN I,","
	JRST FILSP4	;GET PROGRAMMER NAME
FILSP8:	CAIN I,"]"
	JRST FILSP5	;DONE
	CAIN I,12
	AOS (P)
	POPJ P,

FILSP4:	PUSHJ P,GETSIX
	JUMPE J,FILSP8
FILSP6:	TLNE J,77
	JRST FILSP7
	LSH J,-6
	JRST FILSP6

FILSP7:	HLRM J,3(L)
	JRST FILSP8

FILSP5:	PUSHJ P,GETSIX
	CAIN I,12
	JRST POPJ1
	JRST FILSP5

LUPFL:	OUTSTR [ASCIZ /LOOKUP FAILED - /]
	MOVEI L,LUP
FILNOU:	MOVE I,(L)
	PUSHJ P,SIXTYP
	OUTCHR ["."]
	MOVE I,1(L)
	PUSHJ P,SIXTY3
	OUTCHR ["["]
	MOVE I,3(L)
	PUSHJ P,SIXTY3
	OUTCHR [","]
	MOVS I,3(L)
	PUSHJ P,SIXTY3
	OUTSTR [ASCIZ /]
/]
	POPJ P,

ENTFL:	OUTSTR [ASCIZ /ENTER FAILED - /]
	MOVEI L,ENT
	JRST FILNOU

;GET SIXBIT SYLLABLE IN J WITH SEPARATOR IN I
GETSIX:	MOVE K,[440600,,J]
	MOVEI J,0
GETSX1:	INCHWL I
	CAIN I,15
	JRST GETSX1
	CAIL I,"0"
	CAILE I,"9"
	JRST GETSX2	;NOT NUM
	JRST GETSX3	;NUMBER
GETSX2:	CAIL I,"a"
	CAILE I,"z"
	JRST GETSX4	;NOT LOWER CASE
	JRST [	SUBI I,40	;LOWER CASE
		JRST GETSX3]
GETSX4:	CAIL I,"A"
	CAILE I,"Z"
	POPJ P,
GETSX3:	SUBI I,40
	TLNE K,770000
	IDPB I,K
	JRST GETSX1

;TYPE I IN SIXBIT (6 CHARS WORTH)
SIXTYP:	MOVE J,[440600,,I]
SIXTY1:	ILDB K,J
	ADDI K,40
	OUTCHR K
	TLNE J,770000
	JRST SIXTY1
	POPJ P,

;TYPE LEFT 3 CHARS OF I
SIXTY3:	MOVE J,[440600,,I]
SIXTY4:	ILDB K,J
	ADDI K,40
	OUTCHR K
	TLNE J,500000
	JRST SIXTY4
	POPJ P,

INITL:	OUTSTR [ASCIZ /CAN'T INIT DSK - LOSEY, LOSEY
/]
	JRST 4,.
;GET WORD FROM DKIC FILE INTO I
;SKIP RETURNS UNLESS EOF

ZZ←←0
DEFINE GETGEN $ (DKIC,GETIN,IBUF)
<
GETIN$R:SOSG IBUF+2
	IN DKIC,
	JRST GETIN$1
	STATZ DKIC,20000	;EOF?
	POPJ P,			;YES
	JRST 4,.		;NO
GETIN$1:ILDB I,IBUF+1
	JRST POPJ1

GETIN:	PUSHJ P,GETIN$R
	JRST GETEOF
	POPJ P,

GETIN$B:	PUSHJ P,GETIN
IFG ZZ,<JRST GTINB1>
IFE ZZ,<ZZ←←ZZ+1
GTINB1:	LSH I,=24
	ASH I,-=24
	POPJ P,>
>

GETGEN (DKIC,GETIN,IBUF)

GETEOF:	OUTSTR [ASCIZ /
EOF ON INPUT
/]
	CLOSE DKOC,
	MOVE T,P
EOF1:	HRRZ A,(T)
	CAIL A,LOWCAL
	CAIL A,HICAL
	SOJA T,EOF1
	MOVSI B,-NLOSES
EOF2:	CAME A,LOSADR(B)
	AOBJN B,EOF2
	JUMPGE B,[	OUTSTR [ASCIZ /LOSS NOT FOUND/]
			JRST 4,.]
	OUTSTR @LOSTBL(B)
	OUTSTR [ASCIZ /
/]
	JRST BEGL

PUT:	SOSG OBUF+2
	OUT DKOC,
	JRST PUT1
	JRST 4,.
PUT1:	IDPB I,OBUF+1
	POPJ P,
COMMENT ⊗
;THINGS HAVING TO DO WITH THE SIZE OF THE 11'S CORE:  SETSIZ

SETSIZ:	MOVE T,D
	IMULI T,=2048
	MOVEM T,HCOR
	SETZM LOWAD
	MOVEM T,HIAD
	LSH T,-1		;HCOR/2
	MOVEM T,HCOR2
	HRLM T,FILBPT+1
	SUBI T,1		;<HCOR-2>/2 (OREG)
	HRRM T,RDOREG
	HRRM T,WROREG
	SUBI T,1		;<HCOR-4>/2 (IREG)
	HRRM T,WRIREG
	HRRM T,RDIREG
	HRRM T,WRBOTH
	MOVE TT,T
	LSH TT,1
	HRRM TT,INIRTN+5
	SUBI T,1		;<HCOR-6>/2 (TTY FLAG)
	HRRM T,WR10FL
	HRRM T,RD10FL
	HRLM T,ZERCOR+1
	SUBI T,1		;<HCOR-10>/2 (Pristine symbol table top)
	HRRM T,SMTOPW
	HRRM T,SMTOPR
	SUBI T,6		;<HCOR-24>/2 (Initialization routine)
	TRO T,400000
	HRRM T,INIT11
	LSH T,1
	HRRM T,INIADR+1
	HRLM T,CLKVEC+1
	MOVE T,HCOR2
	SUBI T,14001		;<HCOR-30002>/2
	HRRM T,SYMADR
	SUBI T,1		;<HCOR-30004>/2
	HRRM T,STADR
	SUBI T,1
	LSH T,1			;HCOR-30006
	MOVEM T,SYMEND
	MOVE T,D
	MOVEI I,0
	MOVE J,[POINT 6,I]
	IDIVI T,=10
	ADDI T,'  0'
	IDPB T,J
	ADDI TT,'  0'
	IDPB TT,J
	MOVEI K,'  K'
	IDPB K,J
	MOVEM I,DDTEXT
	POPJ P,

HCOR:	0			;1st NXM address
HCOR2:	0			;HCOR/2
⊗
LPDL←←30
PDL:	BLOCK LPDL
SAVPPN:	0		;HAS CURRENT DSK PPN
LUP:	BLOCK 4
ENT:	BLOCK 4
IBUF:	BLOCK 3
OBUF:	BLOCK 3
JMPBLF:	-1
PROGSA:	-1		;PROGRAM'S STARTING ADDRESS
MINUSF:	0
LCHRET:	0		;-1 => JUST GOT CR
DDTSA:	0		;DDT'S STARTING ADDRESS
OVERLF:	0		;-1 FOR OVERLAY
NOSYMS:	0		;-1 FOR NO SYMS LOADED AT DDTL
WORD:	0
SEP:	0

END	BEG