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;