COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE FAKTNX - Fake TENEX JSYS's for PUPGAT
C00014 ENDMK
C⊗;
	TITLE FAKTNX - Fake TENEX JSYS's for PUPGAT

	.LIBRARY TVRLIB.REL[SUB,SYS]

	↓A←1
	↓B←2
	↓C←3
	↓P←17

.TIME↑:	MOVEI A,215
	PEEK A,
	PEEK A,
	PUSH P,B
	MULI A,=100		;Convert from tics to msec
	DIVI A,=6
	POP P,B
	POPJ P,


.GETAB↑:PUSH P,B
	HRRZ B,A
	HLRZ A,A
	CAMN B,PUPPAR
	  JRST[	CAIE A,2
		  JRST XGETAB
	BRETZA:	SETZ A,
		JRST POPJB1 ]
	CAIN B,ROUTAB
	  AOJA A,[
		PUSH P,B
		PUSHJ P,HSHROU
		POP P,B
		JRST POPJB1 ]
	CAMN B,ENTFLG
	  JRST BRETZA
XGETAB:	OUTSTR[ASCIZ/?
Unsimulated GETAB. /]
	POP P,B
DOHALT:	POP P,(P)
	JRST 4,@1(P)

.OPRFN↑:CAMN A,[SIXBIT/PUPROU/]
	  JRST[	OUTSTR[ASCIZ/Routine table update request.
/]↔		POPJ P,	]
	OUTSTR[ASCIZ/?
Unsimualted OPRFN. /]
	JRST DOHALT

.DISMS↑:INTMSK [0]
	PUSH P,B
	MULI A,6		;Convert from msec to tics
	DIVI A,=100
	POP P,B
	SKIPE A			;Don't wait if zero time given!
	SKIPE WAKFLG		;Have we been woken?
	  JRST[	SETZM WAKFLG	;  Yes, don't sleep
		INTMSK[-1]
		POPJ P,]
	CLKINT (A)
	IMSTW [-1]
	POPJ P,

WAKFLG↑:0

.PUPI↑:	PUSH P,C
	PUSH P,B
	MOVE C,A
	TLZ A,(1B0+1B1)
	SKIPL A
	CAILE A,17
	  PUSHJ P,ILGJFN
	TLNN C,(1B0)		;Wait?
	  JRST PUPI2		;  Yes, that's OK
	PUSHJ P,ARBCHN
	  MTAPE 0,[10]
	  JRST[	MOVEI A,PUPX3
		JRST PUPI3 ]
PUPI2:	MOVE A,[IN B]
	DPB C,[POINT 4,A,12]
	MOVN B,B
	HRR B,(P)
	SOS B
	SETZ C,
	XCT A
	AOSA -2(P)
	  MOVEI A,-1		;Fictious error code
PUPI3:	POP P,B
	POP P,C
	POPJ P,

.PUPO↑:	PUSH P,C
	PUSH P,B
	LDB C,[POINT 16,(B),15]
	ADDI C,3
	LSH C,-2
	MOVN C,C
	HRL B,C
	SETZ C,
	TLZ A,(1B1)		;Flush bit meaning compute checksum
	SKIPL A
	CAILE A,17
	  PUSHJ P,ILGJFN
	LSH A,=18+5
	IOR A,[OUT B]
	SOS B
	XCT A
	AOSA -2(P)
	  MOVEI A,-1	;Fictious error code
	POP P,B
	POP P,C
	POPJ P,

POPJB1:	POP P,B
SKPRET:	AOS (P)
CPOPJ:	POPJ P,

.PUPNM↑:TLCE B,(1B2)
	TLNE B,-1
	  POPJ P,
	MOVEM A,FAKJFN
	PUSH P,1(B)	;Socket number
	PUSH P,(B)
	HRRZS (P)	;Just host number
	HLRZ B,(B)
	PUSH P,B
	PUSH P,[8]
	PUSH P,FAKEOP
	PUSHJ P,WRINT↑
	MOVEI A,"#"
	XCT FAKEOP
;	POP P,B
;	PUSH P,B
	PUSH P,[8]
	PUSH P,FAKEOP
	PUSHJ P,WRINT↑
	MOVEI A,"#"
	XCT FAKEOP
;	POP P,B
;	PUSH P,B
	PUSH P,[8]
	PUSH P,FAKEOP
	PUSHJ P,WRINT↑
	MOVEI A,"#"
	XCT FAKEOP
	JRST FPOPJ1

.SOUT↑:	MOVEM A,FAKJFN
	TLC B,-1
	TLCN B,-1
	HRLI B,(<POINT 7,0>)
	PUSH P,B
	PUSH P,FAKEOP
	PUSHJ P,WRASCZ↑
	TLNN B,6077		;Look like a byte pointer?
	TLNN B,1700
	  JRST FPOPJ		;  No, just return JFN
	SETZ A,			;Null terminate string
	PUSH P,FAKJFN
	IDPB A,FAKJFN
	POP P,A
	POPJ P,

.NOUT↑:	MOVEM A,FAKJFN
	PUSH P,B
	PUSH P,C
	ANDI C,77
	EXCH C,(P)
	PUSH P,FAKEOP
	PUSHJ P,WRINT↑
FPOPJ1:	MOVE A,FAKJFN
	AOS (P)
	POPJ P,

.ODTIM↑:MOVEM A,FAKJFN
	ACCTIM A,
	PUSH P,A
	PUSH P,FAKEOP
	PUSHJ P,WRDAYT↑
	JRST FPOPJ

.BOUT↑:	MOVEM A,FAKJFN
	MOVE A,B
	XCT FAKEOP
FPOPJ:	MOVE A,FAKJFN
	POPJ P,

.JFNS↑:	MOVEM A,FAKJFN
	JUMPL B,ILGJFN
	CAILE B,17
	  JRST ILGJFN
	SETZ A,
	SLEEP A,
	HRRZ A,JOBJDA↑(B)
	JUMPE A,CPOPJ
	PEEK A,
	PUSH P,A
	PUSH P,A
	PUSH P,FAKEOP
	PUSHJ P,WRSIX↑
	MOVEI A,":"
	XCT FAKEOP
	POP P,A
	HLRZ A,A
	CAIE A,'DSK'
	CAIN A,'UDP'
	  POPJ P,
	HRRZ A,JOBJDA↑(B)
	ADDI A,11
	PEEK A,
	PUSH P,A
	PUSH P,FAKEOP
	PUSHJ P,WRSIX
	MOVEI A,"."
	XCT FAKEOP
	HRRZ A,JOBJDA↑(B)
	ADDI A,12
	PEEK A,
	PUSHJ P,SIXHLF
	MOVEI A,"["
	XCT FAKEOP
	HRRZ A,JOBJDA↑(B)
	ADDI A,14
	PEEK A,
	PUSH P,A
	PUSHJ P,SIXHLF
	MOVEI A,","
	XCT FAKEOP
	POP P,A
	MOVS A,A
	PUSHJ P,SIXHLF
	MOVEI A,"]"
	XCT FAKEOP
	JRST FPOPJ

SIXHLF:	PUSH P,0
	PUSH P,A
	HLLZS (P)
	PUSH P,FAKEOP
	PUSHJ P,WRSIX
	POP P,0
	POPJ P,

ILGJFN:	OUTSTR[ASCIZ/Illegal JFN for simulator.
/]↔	JRST 4,.

TIME↑←←<PUSHJ P,.TIME>
GETAB↑←←<PUSHJ P,.GETAB>
HALTF↑←←<EXIT 1,>
OPRFN↑←←<PUSHJ P,.OPRFN>
RUNTM↑←←<RUNTIM A,>
DISMS↑←←<PUSHJ P,.DISMS>
PUPI↑←←<PUSHJ P,.PUPI>
PUPO↑←←<PUSHJ P,.PUPO>
PUPNM↑←←<PUSHJ P,.PUPNM>
SOUT↑←←<PUSHJ P,.SOUT>
NOUT↑←←<PUSHJ P,.NOUT>
BOUT↑←←<PUSHJ P,.BOUT>
PBOUT↑←←<OUTCHR B>
ODTIM↑←←<PUSHJ P,.ODTIM>
JFNS↑←←<PUSHJ P,.JFNS>
erstr↑←←<jfcl>
dirst↑←←<jfcl>
dobe↑←←<jfcl>
cfibf↑←←<clrbfi>


ARBCHN↑:PUSH P,@(P)
	AOS -1(P)
	DPB C,[POINT 4,(P),12]
	XCT (P)
	SKIPA
	AOS -1(P)
	POP P,(P)
	POPJ P,

GETCHN↑:SETZ C,
	SLEEP C,		;Make sure JOBJDA is current.
	MOVSI C,-20
	SKIPE JOBJDA↑(C)
	AOBJN C,.-1
	JUMPL C,[HRRZ C,C
		 AOS (P)
		 POPJ P,]
	SETO C,
	POPJ P,

FAKEOP:	PUSHJ P,FAKER

FAKER:	PUSH P,B
	MOVE B,FAKJFN
	CAIL B,0
	CAILE B,17
	  JRST FAKER2
FAKER1:	outstr[asciz/Only JFN simulator currently can output to is a string or TTY
/]↔	exit 1,
	JRST FAKER9
FAKER2:	CAMN B,[-2]
	  JRST[	OUTCHR A
		JRST FAKER9]
	TLNN B,6077		;Look like a byte pointer?
	TLNN B,1700		;Look like a byte pointer?
	JRST FAKER1
	IDPB A,FAKJFN
FAKER9:	POP P,B
	POPJ P,

FAKJFN:	-1

%UFTPM↑: OUTSTR[ASCIZ/Illegal user UUO. /]
	 POP P,(P)
	 JRST 4,@1(P)

;Fake GETAB entries and related GENSYMmed garbage
	.TEMP←←0
	FOR X IN (PUPPAR,ENTFLG,PUPX3) <
.TEMP←←.TEMP+1
X↑:	.TEMP
>;FOR

BEGIN HSHROU
tac←a
tac1←b

↑hshrou:
	jumpe tac,[
	direct:	move tac,nettab
		popj p,]
	cain tac,@nettab
	  jrst direct
PUPRO1:	PUSH P,TAC		;Save on stack
	IDIVi TAC,ROUSIZ		;Hash the network number
	PUSH P,[-1]		;Push a flag
PUPRO2:	LDB TAC,ROUNET		;Is this the network number we want?
	CAMN TAC,-1(P)
	  JRST PUPRO3		;  Yes, use it
	JUMPE TAC,PUPRO4	;Not accessable if slot is empty
	SOJGE TAC1,PUPRO2	;Try next slot, but watch for wraparound
	MOVEi TAC1,ROUSIZ	;Start again from other end of table
	AOSG (P)		;Check for hash table overflow.
	  SOJA TAC1,PUPRO2
	AOSE SNTCTY		;Have we complained yet?
	  JRST PUPRO4		;  Yes, take a failure return
	MOVEI TAC,[SIXBIT/CTY/↔[ASCIZ/Routing table overflow.  Fix ROUTAB in FAKTNX/]]
	TTYMES TAC,
	   JFCL
	JRST PUPRO4
;	---
PUPRO3:
	POP P,TAC		;Flush stack
	AOS -1(P)		;Assume success
	LDB TAC,ROUGTW		;Return gateway to use
	HRLZM TAC,(P)		;Set host number
	LDB TAC,ROUINT		;Internal network number
	MOVE TAC,NETTAB(TAC)
	DPB TAC,[POINT 10,(P),9]	;Set network number, broadcast, accessibilty
	POP P,TAC
	POPJ P,

PUPRO4:	POP P,(P)
	POP P,A
	movsi a,-1
	POPJ P,

↑ROUNET: POINT 8,routab(TAC1),7		;Target-net
↑ROUGTW: POINT 8,routab(TAC1),23	;Gateway-net
↑ROUINT: POINT 0,routab(TAC1),35	;Internal net number (currently only EtherNet here)

NETTAB:	1B1+44		;SU-Net

;TENEX routing table looks like this
;B0	Inaccessable
;B1	Can't broadcast
;B2:9	Gateway network
;B10:17	Gateway host

ROUCLR↑:SETZM ROUTAB
	MOVE A,[XWD ROUTAB,ROUTAB+1]
	BLT A,ROUTAB+ROUSIZ-1
	POPJ P,

ROUADD↑:PUSH P,A
	PUSH P,B
	HRRZ A,A
	PUSHJ P,PUPRO1		;Hash network number
	POP P,A
	SETZM @ROUNET		;Start with fresh entry
	TRNE A,-1		;Directly connected?
	  JRST ROUAD2
	HLRZ A,A		;Get gateway address
	DPB A,ROUGTW
ROUAD2:
printx If more than one network, must fix here.
;	DPB A,ROUINT
	POP P,A
	DPB A,ROUNET		;Now, set network number
	POPJ P,


BEND HSHROU

PUPROU↑:-77,,ROUTAB

	IOWD ROUSIZ,ROUTAB	;Must precede actual routing table
ROUTAB:	BLOCK =67+1		;Should be prime + 1
ROUSIZ←←.-ROUTAB-1		;(Extra word to absorb overflow by ROUADD)

SNTCTY:	-1			;Send only one message if table overflows
	END