perm filename RD[F,PMP] blob sn#008147 filedate 1972-08-14 generic text, type T, neo UTF8
00100	TITLE RD
00200	
00300	P←17 A←1 B←2 C←3 D←4 E←5 F←6
00400	G←7 H←10 J←11 J1←12 Q←13 T←14 T1←15 T2←16
00500	
00600	STRT:	CALLI
00700		INIT 1,10
00800		SIXBIT /DSK/
00900		DIB
01000		JRST 4,.
01100		MOVE P,[XWD -PDLEN,PDL-1]
01200		MOVEI A,LUP
01300		SETZM LUP
01400		FOR I←1,3 {SETZM LUP+I
01500	}
01600		MOVEI D,'TS1'
01700		HRLM D,LUP+1
01800		OUTSTR [ASCIZ /INPUT /]
01900		PUSHJ P,FNAM
02000		LOOKUP 1,LUP
02100		JRST NOLUP
03600		INBUF 1,2
03800		HRRZ A,JOBFF
03900		ADDI A,1
04000		TRZ A,1
04100		MOVEM A,FSTPNT#
04300		EXTERN JOBFF,JOBREL
05000		DEFINE CLR (Q,SIZ)
05100	{	SETZM Q
05200		MOVE A,[XWD Q,Q+1]
05300		BLT A,Q+SIZ}
05700	JRST PRT
     

00100	LUP:	BLOCK 4
00200	DIB:	BLOCK 3
00500	PDLEN←100
00600	PDL:	BLOCK PDLEN
01900	
     

00100	FNAM:	OUTSTR [ASCIZ/FILE = /]
00200		MOVEI B,
00300	FLOP1:	INCHWL C
00400		SUBI C,40
00500		CAIL C,100
00600		SUBI C,40
00700		CAIG C,17
00800		JRST FDON
00900		LSH B,6
01000		OR B,C
01100		JRST FLOP1
01200	FDON:	TLNE B,770000
01300		JRST .+4
01400		LSH B,6
01500		TLNN B,770000
01600		JRST .-2
01700		MOVEM B,(A)
01800		ADDI C,40
01900		CAIN C,15
02000		INCHWL C
02100	CPOPJ:	POPJ P,
03400	
03500	WRD:	SOSG DIB+2
03600		INPUT 1,
03700		ILDB B,DIB+1
03800		POPJ P,
03900	
04000	NOFST:	0
04100		PUSH P,A
04200		MOVE A,JOBREL
04300		ADDI A,1
04400		MOVEM A,FSTPNT
04500		ADDI A,1777
04600		CALLI A,11
04700		JRST NOCOR
05700		POPJ P,
05800	
30400	PRT:	INIT 5,1
30500		SIXBIT /LPT/
30600		XWD LOB,0
30700		JRST 4,.
30800		MOVE Q,JOBFF
30900		MOVEI T1,PRTBUF
31000		MOVEM T1,JOBFF
31100		OUTBUF 5,1
31200		JRST ST
31300		DEFINE PRTC (A)
31400	{	MOVEI T1,A
31500		PUSHJ P,PRT101}
31600		DEFINE PRTCRL
31700	{	PRTC (15)
31800		PRTC (12)}
31900	
37400	LOB:	BLOCK 3
37500	PRTBUF:	BLOCK 500
37600	
37700	  DEFINE PRTR $(ARG)
37800	{PRT$ARG: JUMPE T,PRTZER
37900		IDIVI T,ARG
38000		JUMPE T,.+4
38100		HRLM T1,(P)
38200		PUSHJ P,PRT$ARG
38300		HLRZ T1,(P)
38350		ADDI T1,60
38400	PRT$ARG$1: SOSG LOB+2
38500		OUTPUT 5,
38600		IDPB T1,LOB+1
38700		POPJ P,}
38800	PRTOCT:
38900		PRTR(10)
39000	PRTDEC:
39100		PRTR (12)
39150	PRTSIX:	JUMPE T,CPOPJ
39200		MOVEI T1,
39300		ROTC T,6
39500		JUMPE T1,PRTSIX
39600		ADDI T1,40
39700		PUSHJ P,PRT101
39800		JRST PRTSIX
39900	PRTASC:	HRLI T,440700
40000		ILDB T1,T
40100		JUMPE T1,CPOPJ
40200		PUSHJ P,PRT101
40300		JRST PRTASC+1
40400	PRTZER:	PRTC("0")
40500		POPJ P,
41800	
52000	NOLUP:	OUTSTR [ASCIZ /CAN'T FIND INPUT FILE
52100	/]
52200		JRST STRT
52300	NOCOR:	OUTSTR [ASCIZ /CAN'T GET ENOUGH CORE
52400	TYPE ANY KEY TO TRY AGAIN
52500	/]
52600		INCHRW
52700		JRST NOFST+2
52800	
     

00100	ST:	PUSHJ P,WRD
00200		MOVEM B,NWRD#
00300		SUBI B,1
00400		IDIVI B,=18
00450		ADDI B,1
00500		MOVEM B,NLWRD#
00600		MOVEI T,[ASCIZ /NWRD = /]
00700		PUSHJ P,PRTASC
00800		MOVE T,NWRD
00900		PUSHJ P,PRTOCT
01000		PRTC (<",">)
01100		MOVE T,NWRD
01200		PUSHJ P,PRTDEC
01300		PRTCRL
01400		PRTCRL
01500		PUSHJ P,WRD
01600		PUSHJ P,WRD
01700		PUSHJ P,WRD
01800		MOVE E,FSTPNT
01900		MOVEI F,-1(E)
02000	LOP1:	PUSHJ P,WRD
02100		CAMN B,[-1]
02200		JRST DON1
02300		TRNE B,-1
02400		ADD B,F
02500		MOVEM B,(E)
02600		AOJA E,LOP1
02700	DON1:	MOVEI T,[ASCIZ /  X    INGRF(X):
02800	/]
02900		PUSHJ P,PRTASC
03000		MOVEI G,2
03100	;*******************
03120	LOP2:	MOVE T,G
03140		PUSHJ P,PRTOCT
03160		PRTC (11)
03200		PUSHJ P,WRD
03300		CAMN B,[-1]
03400		JRST DON2
03500		TRNE B,-1
03600		ADD B,F
03700	LOP3:	HLRZ T,B
03800		PUSHJ P,PRTOCT
03900		TRNN B,-1
04000		JRST DON3
04100		PRTC (<",">)
04200		MOVE B,(B)
04300		JRST LOP3
04400	DON3:	PRTCRL
04500		AOJA G,LOP2
04530	DON2:	PRTCRL
04560		PRTCRL
04600		MOVEI T,[ASCIZ /  X    OUTGRF(X):
04700	/]
04800		PUSHJ P,PRTASC
04900		MOVEI G,2
05000	;*******************
05100	LOP4:	MOVE T,G
05200		PUSHJ P,PRTOCT
05300		PRTC (11)
05400		PUSHJ P,WRD
05500		CAMN B,[-1]
05600		JRST DON4
05700		TRNE B,-1
05800		ADD B,F
05900	LOP5:	HLRZ T,B
06000		PUSHJ P,PRTOCT
06100		TRNN B,-1
06200		JRST DON5
06300		PRTC (<",">)
06400		MOVE B,(B)
06500		JRST LOP5
06600	DON5:	PRTCRL
06700		AOJA G,LOP4
06730	DON4:	PRTCRL
06760		PRTCRL
06800		MOVEI T,[ASCIZ /        /]
06900		PUSHJ P,PRTASC
07000		MOVEI D,1
07100		MOVEI E,7
07200	LOP10:	PRTC (<60(D)>)
07400		PRTC (40)
07500		PRTC (<60(D)>)
07600		PRTC (40)
07700		PRTC (40)
07800		PRTC (<60(D)>)
07900		PRTC (40)
08000		PRTC (<60(D)>)
08100		PRTC (40)
08200		PRTC (40)
08300		ADDI D,1
08400		SOJG E,LOP10
08500		PRTCRL
08600		MOVEI E,10
08700	LOP11:	MOVEI T,[ASCIZ /1  4 5  0 /]
08800		PUSHJ P,PRTASC
08900		SOJG E,LOP11
09000		PRTCRL
09100		PRTCRL
09200	LOP12:	MOVE E,NWRD
09300		MOVE F,NLWRD
09400		MOVE G,FSTPNT
09500		PUSHJ P,WRD
09600		CAMN B,[XWD 400000,0]
09700		JRST DON10
09800		MOVEM B,(G)
09900		ADDI G,1
10000		SOJG F,.-5
10100		MOVE G,FSTPNT
10200		HRLI G,440200
10300	LOP13:	ILDB T,G
10400		MOVE T1,(T)["0"
10500			"1"
10600			"2"
10700			"."]
10800		PUSHJ P,PRT101
10850		TLNE G,40000
10900		TLNE G,30000
11000		SOJG E,LOP13
11100		PRTC (40)
11200		SOJG E,LOP13
11300		PRTCRL
11400		JRST LOP12
11500	DON10:	RELEAS 5,
11600		CALLI 12
11700	END STRT