Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-04 - decus/20-0115/twosid.bli
There are 2 other files named twosid.bli in the archive. Click here to see a list.
00100	MODULE TWOSID(VERSION=1(1),STACK)=BEGIN
00200	
00300	! .MEM to be able to use two sides of the paper (.LFT and .RGT)
00400	%(Revision History:
00500	0	28 Feb 77	Creation
00600	1	16 Mar 77	Allow /RIGHT:n
00700	)%
00800	
00900	MACHOP	IN=#56,OUTPUT=#67,OPEN=#50,CLOSE=#70,LOOKUP=#76,ENTER=#77,JRST=#254,
01000	% 1%	TTCALL=#51, CALLI=#47;
01100	MACRO HALT(nil)=JRST(4,0)$,
01200	% 1%	?RESET.(nil)=CALLI(0)$,
01300	% 1%	?EXIT.(nil)=CALLI(0,10)$,
01400	% 1%	complain(str)=(TTCALL(3,PLIT ASCIZ str);  HALT())$,
01500		INCHWL(adr)=TTCALL(4,adr)$,
01600	
01700	% 1%	thenb=THEN BEGIN$,  elseb=END ELSE BEGIN$,  fi=END$,
01800	% 1%	loop=DO BEGIN$,  repeat=END$;
01900	
02000	REGISTER ch;	!The current character
02100	
02200	OWN hI:hR:hL[3],	!Buffer headers
02300		io[4],		!For lookups and enters
02400	% 1%	right;		!For switch value /RIGHT:n
02500	
02600	BIND	pt=1,ct=2,	!Within buffer header
02700		LF=#12,FF=#14,CR=#15,	!Special characters
02800		I=0,R=1,L=2;	!I/O channels
02900	
03000	ROUTINE getchr=		!Get a character from input
03100		BEGIN
03200		WHILE (hI[ct]_.hI[ct]-1) LSS 0
03300		    loop IFSKIP IN(I)
03400			thenb CLOSE(I);
03500			    CLOSE(R);
03600			    CLOSE(L);
03700			    ?EXIT.();
03800			fi;
03900		    repeat;
04000		ch_SCANI(hI[pt])
04100		END;
04200	
04300	ROUTINE putchR=
04400		BEGIN
04500		IF (hR[ct]_.hR[ct]-1) LEQ 0
04600		    thenb OUTPUT(R)
04700		    fi;
04800		REPLACEI(hR[pt],.ch)
04900		END;
05000	
05100	ROUTINE putchL=
05200		BEGIN
05300		IF (hL[ct]_.hL[ct]-1) LEQ 0
05400		    thenb OUTPUT(L)
05500		    fi;
05600		REPLACEI(hL[pt],.ch)
05700		END;
05800	
05900	ROUTINE overL=	% 1 %	!Space over /RIGHT distance
06000		BEGIN REGISTER j;
06100		j_.ch;  ch_" ";
06200		DECR i FROM .right TO 1 DO
06300		    putchL();
06400		ch_.j
06500		END;
06600	
06700	ROUTINE overR=	% 1 %	!Space over /RIGHT distance
06800		BEGIN REGISTER j;
06900		j_.ch;  ch_" ";
07000		DECR i FROM .right TO 1 DO
07100		    putchR();
07200		ch_.j
07300		END;
07400	
07500	ROUTINE pageR=
07600		loop getchr();
07700	% 1%	    IF ..hR[pt] EQL #12		!Line feed
07800	% 1%		thenb IF .ch GEQ " "	!then printable
07900	% 1%		    thenb overR();
08000	% 1%		fi; fi;
08100		    putchR();
08200		repeat WHILE .ch NEQ FF;
08300	
08400	ROUTINE pageL=
08500		loop getchr();
08600	% 1%	    IF ..hL[pt] EQL #12		!Line feed
08700	% 1%		thenb IF .ch GEQ " "	!followed by printable
08800	% 1%		    thenb overL();
08900	% 1%		fi; fi;
09000		    putchL();
09100		repeat WHILE .ch NEQ FF;
     
00100	% 1% OWN	filptr,filnam,	!Temp pointer, space for name
00200	% 1%	savechar;	!Char causing scanning to end
00300	
00400	% 1% BIND	sxbt=PLIT(16:0,16,17,18,19,20,21,22,23,24,25,7:0,
00500	% 1%		33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,
00600	% 1%		48,49,50,51,52,53,54,55,56,57,58,5:0);
00700	
00800	ROUTINE getsixbit=	% 1 %	!Get a sixbit word
00900		BEGIN REGISTER t;
01000		filnam_0;
01100		filptr_filnam<36,6>;
01200		WHILE 1 DO
01300		    BEGIN
01400		    TTCALL(4,t);	!Get character
01500		    IF .t GEQ #140
01600			THEN t_.t-#40;
01700		    IF .t LSS #40
01800			THEN RETURN (savechar_.t; .filnam);
01900		    IF .sxbt[.t-#40] EQL 0
02000			THEN RETURN (savechar_.t; .filnam);
02100		    REPLACEI(filptr,.sxbt[.t-#40]);
02200		    END;
02300		END;
02400	
02500	ROUTINE getnum=		% 1 %	!Get value, number
02600		BEGIN REGISTER t;
02700		filnam_0;
02800		WHILE (TTCALL(4,t);  "0" LEQ .t AND .t LEQ "9")
02900		    DO filnam_.filnam*10+.t-"0";
03000		.filnam
03100		END;
03200	
03300	ROUTINE file=		% 1 %	!Get a file name
03400		getsixbit();
03500	
03600	ROUTINE ext(def)=	% 1 %	!Get a file extension, default def
03700		IF .savechar EQL "."
03800		    THEN getsixbit()
03900		    ELSE .def;
04000	
04100	ROUTINE switch(val)=	% 1 %	!Get switch, i.e. val, and numer. value
04200		IF .savechar EQL "/"
04300		    THEN BEGIN
04400			IF getsixbit()^(-30) EQL .val^(-30)
04500			    THEN IF .savechar EQL ":"
04600				THEN RETURN getnum();
04700			complain('?? Error in switch or value');
04800			END
04900		    ELSE -1;
05000	
05100	ROUTINE getlf=		% 1 %	!Get to end of input line
05200		WHILE 1 DO
05300		    BEGIN
05400		    IF #12 LEQ .savechar
05500			THEN IF .savechar LEQ #14
05600			    THEN RETURN;
05700		    IF .savechar EQL #33
05800			THEN RETURN;
05900		    TTCALL(4,savechar);
06000		    END;
     
00100		?RESET.();
00200		io[0]_0;io[1]_SIXBIT'DSK';io[2]_hI<0,0>;
00300		IFSKIP OPEN(I,io)
00400		    thenb elseb complain('?? DSK cannot be opened'); fi;
00500		io[0]_0;io[1]_SIXBIT'DSK';io[2]_hR^18;
00600		IFSKIP OPEN(R,io)
00700		    thenb elseb complain('?? DSK cannot be opened'); fi;
00800		io[0]_0;io[1]_SIXBIT'DSK';io[2]_hL^18;
00900		IFSKIP OPEN(L,io)
01000		    thenb elseb complain('?? DSK cannot be opened'); fi;
01100	
01200	% 1%	TTCALL(1,PLIT "*");
01300	
01400	% 1%	io[0]_3;io[1]_0;io[2]_file();io[3]_ext(SIXBIT'HEX');
01500	% 1%	IFSKIP LOOKUP(I,io) thenb elseb complain('?? Cannot find input file'); fi;
01600	% 1%	io[1]_0;  io[3]_SIXBIT'RGT';
01700	% 1%	IFSKIP ENTER(R,io) thenb elseb complain('?? Cannot ENTER .RGT file'); fi;
01800	% 1%	io[1]_0;  io[3]_SIXBIT'LFT';
01900	% 1%	IFSKIP ENTER(L,io) thenb elseb complain('?? Cannot ENTER .LFT file'); fi;
02000	% 1%	right_switch(SIXBIT 'RIGHT');
02100	% 1%	getlf();		!End up the input line
02200	
02300		WHILE 1
02400		    loop pageR();
02500			pageL();
02600		    repeat;
02700	
02800		END ELUDOM;