C	PROGRAM CFT
C*** NTX(4096) IS IN FIELD 7
C*** LP(4096) IS IN FIELD 6
C*** LD(64,63) IS IN FIELD 5
C*** ITX(4096) IS IN FIELD 4
C
C	SS0: ENABLE FILE RECEPTION CONTROL CHARS 
C		[ SOH(A), STX(B), ETX(C), EOT(D) ]
C
C	SS1: ENABLE FILE TRANSMISION CONTROL CHARS
C		[ DC1(Q), DC2(R), DC3(S), DC4(T) ]
C
C	SS2: 0=> IPC=LF (CYBER)
C	     1=> IPC='> (TERAK)
C
C	SS5: ENABLE LINE PRINTER COPY
C
	COMMON IUSR
	DIMENSION IUSR(896)
	DIMENSION NDEV(2),NAME(4),IDEV(2),INAM(4)
C
SSKPDF LSF	6661
SOPDEF LPC	6666
SSKPDF DKSF	6401
SOPDEF DKRB	6406
SSKPDF DTSF	6411
SOPDEF DTLS	6416
C
SOPDEF DCAI	3400
SOPDEF TADI	1400
SOPDEF JMPI	5400
C
SOPDEF SHL	7413
SOPDEF LSR	7417
SOPDEF MQA	7501
SOPDEF MQL	7421
C
SOPDEF LINC	6141
SABSYM DSCI	1760
SABSYM XSKI	0221
SABSYM PDP	0002
C
C
SDTLS	/TRANSMIT <NUL> TO CYBER
C	/CYBER RESPONDS WITH *DEL*
1	CONTINUE
C*** PRESET DISPLAY MEMORY WITH EOL
	M=0
	LDN=0
	IDN=102
	DO 2 I=1,32
SJMS LDIN
	LDN=LDN+128
2	CONTINUE
	IDN=0
3	CONTINUE
	IY=IY
	M=M
	I=I
	IC=IC
	LI=LI
	LO=LO
4	CONTINUE
	IY0=-160
	LCY=IY0-16
	ICMAX=510
	LDMAX=20
	ITX=-1
	NTX=-1
	IPC=-10
	IPW=1
C
10	CONTINUE
C*** DISPLAY CURSOR
	CALL DISP9(IC,LCY,1920)
C*** RESET LINE DISPLAY
	IY=IY0
	LDO=LDN-1
C
C*** DISPLAY LOOP ********************
	DO 17 I=1,LDMAX
C*** NOW DO ONE LINE OF DISPLAY
C*** WHILE CHECKING FOR DKSF
SJMS DISP8
C
C	IF(LSF) PRINT LP(LO)
SJMS LPOT
C
C	IF(DTSF) JMS DTOT
SDTSF
SJMP \13
SJMS DTOT
13	CONTINUE
C*** SET UP FOR NEXT LINE 
	LDO=LDO-128
	IY=IY+16
17	CONTINUE
	GOTO 10
C
C*** DISP8: DISPLAY PATTERNS UNTIL=7777
C
18	CONTINUE
S6203
SCPAGE 2
SJMPI DISP8
SDISP8,0
C
C*** X-COORD=0
SDCA 1
C*** LOC(10)=LDO
STAD \LDO
SDCA 10
C*** MQR = IY
STAD \IY
SMQL		/SAVE IY IN MQ
S6251
19	CONTINUE
STADI 10	/AUTO INC
SDCA DSPT1
STAD DSPT1	/STOP WHEN PATTERN=7777
SIAC
SSNA CLA
	GOTO 18
C	IF(DKSF) GOTO 30
SDKSF
SSKP
SJMP \30
C*** ELSE, DISPLAY ANOTHER CHARACTOR
STADI 10	/SECOND PATTERN
SDCA DSPT2
SMQA		/GET Y CORD
SLINC
SDSCI		/DISPLAY CHAR
SDSPT1,0
SDSCI
SDSPT2,0
SXSKI
SXSKI		/TWO SPACES BETWEEN CHARS
SPDP
SCLA
	GOTO 19
C=====================
C
C
C*** CHAR RECIEVED FROM THE MODEM
30	CONTINUE
SDKRB
SAND (177
SDCA \M
C*** DO NOT TRANSMIT 'DEL' CHAR
C	IF(M<=0 OR M=127)GOTO 10
STAD \M
SSPA SNA
SJMP \10
SCIA
STAD (177
SSNA CLA
SJMP \10
C*** PUT M IN LP(LI);LI=LI+1
SJMS LPIN
C
STAD \M
STAD \IPC
SSNA CLA
SDCA \IPW	/CLEAR IPW IFF -M=IPC
	CONTINUE
	IF(M-10)32,45,32
32	IF(M- 8)33,47,33
33	IF(M-12)34,48,34
34	IF(M-13)35,46,35
35	IF(M-32)36,39,39
36	IF(M- 4)40,40,37
37	M=M-16
	IF(M   )10,10,38
38	IF(M- 4)50,50,10
C
C***	 8= BS	 9=TAB	10= LF	12= FF	13= CR
C	    47	    10	    45	    48	    46
C
C*** DISPLAY-ABLE CHARACTER:
39	CONTINUE
SJMS LDIN
	IDN=IDN+2
	IC=IC+10
	IF(IC-ICMAX)10,45,45
C
C=============================
C
C*** FILE CONTROL CHAR
40	CONTINUE
	IF(LSENS(0))10,10,401
401	CONTINUE
C	      A  B  C  D
	GOTO(41,10,10,44)M
C
C*** SOH: GET FILE NAMES AND OPEN FILES
C***	: RESET + REWIND OPEN FILES (A)
C
41	CONTINUE
	IF(NTX)411,411,10
411	CONTINUE
	IF(ITX)412,412,10
412	CONTINUE
C*** RESET OUTPUT POINTERS
	NLEN=0
	NTI=0
	NTO=0
C*** RESET INPUT POINTERS
	IBL=IBLK
	ITO=0
	IPW=1
C*** SS2: CYBER/TERAK SWITCH
C***	IPC IS PROMT CHAR FOR PDP12 FILE TRANSMISSION
	IPC=-10
	IF(ISENS(2))414,414,413
413	CONTINUE
	IPC=-62
414	CONTINUE
	IF(NTX)421,10,10
421	CONTINUE
C
	IF(ITX)422,10,10
422	CONTINUE
C*** GET NEW FILE NAMES
	CALL NAMES(NDEV,NAME,IDEV,INAM)
	IF(NAME)423,425,423
C*** OPEN NEW OUTPUT FILE
423	CONTINUE
	NBLK=MFILE(NDEV,NAME,NMAX)
	IF(NBLK)422,424,424
424	CONTINUE
	NTX=0
425	CONTINUE
	IF(INAM)426,428,426
426	CONTINUE
C*** OPEN NEW INPUT FILE
	IBLK=LFILE(IDEV,INAM,IMAX)
	IF(IBLK)422,427,427
427	CONTINUE
	ITX=0
428	CONTINUE
	GOTO 10
C
C*** EOT: CLOSE FILES		(D)
44	CONTINUE
	IF(ITX)441,441,10
441	CONTINUE
	ITX=-1
	IF(NTX)10,442,10
442	CONTINUE
C*** INSERT ^Z AT END OF FILE
	M=26
	NTX=2
	NT1=NTI+256
	GOTO 542
C
C==============================
C
C*** LINE FEED	   (NOTE: TABLE(10)=0,0)
45	CONTINUE
	LDN=LDN+128
455	CONTINUE
	IDN=0
	M=0
SJMS LDIN
C
C*** CARRIAGE RETURN
46	CONTINUE
	IDN=0
	IC=0
	GOTO 10
C
C*** BACKSPACE    (NOTE: TABLE(8)= 0,0)
47	CONTINUE
	IC=IC-10
	IF(IC)455,455,475
475	CONTINUE
	IDN=IDN-2
SJMS LDIN
	GOTO 10
C
C*** FORM FEED
48	CONTINUE
	LDN=0
	IDN=0
	IC=0
	M=0
	DO 485 I=1,32
SJMS LDIN
	LDN=LDN+128
485	CONTINUE
	GOTO 10
C
C=======================
C
C*** X-ON,X-OFF, TAPE-ON,TAPE-OFF
50	CONTINUE
	IF(LSENS(1))10,10,501
501	CONTINUE
C	      Q  R  S  T
	GOTO(51,52,53,54)M
C
C*** DC1: X-ON: START TRANSMIT	(Q)
51	CONTINUE
	IF(ITX)10,512,10
512	CONTINUE
	ITX=1
	GOTO 10
C
C*** DC2: TAPE: START RECORDING	(R)
52	CONTINUE
	IF(NTX)10,522,521
521	CONTINUE
C*** DELETE (SECOND) <DC2> FROM BUFFER
	NTI=NTI-1
522	CONTINUE
	NTX=1
	GOTO 10
C
C*** DC3: X-OFF: STOP TRANSMIT	(S)
53	CONTINUE
	IF(ITX)10,10,531
531	CONTINUE
	ITX=0
	GOTO 10
C
C*** DC4: STOP RECORD, BUFFEROUT (T)
54	CONTINUE
	IF(NTX)10,10,541
541	CONTINUE
C*** PUT <FF> IN FILE
	M=12
	NT1=NTI+1
	NTX=1
C
C*** COMMON ROUTINE WITH EOT:
C*** INSERT M,WRITE BLOCK BELOW NT1
542	CONTINUE
C*** OVERWRITE PREVIOUS CHAR(DC4 OR EOT)
	NTI=NTI-1
SJMS LPIN
C*** INSERT <LF>
	M=10
SJMS LPIN
C*** FIND END OF BLOCK
	NT1=LAND(NT1,-256)
	NB=LRS(NT1-NOT,8)
C*** SET NB=MIN(NB,NMAX-NLEN) : #BLOCKS TO WRITE
	NP=NMAX-NLEN
	IF(NB-NP)545,545,544
544	NB=NP
545	CONTINUE
	IF(NB)547,547,546
546	CONTINUE
C*** COMPUTE # OF PAGES
	NP=NB+NB
	NBL=NBLK+NLEN
STAD \NTO
SDCA NTO
SCPAGE 10
	CALL WRILE(NP,NBL)
S6271
SNTO,0
	NLEN=NLEN+NB
547	CONTINUE
	NTO=NT1
	NTX=1-NTX
	IF(NTX)548,10,10
548	CALL CFILE(NLEN)
	GOTO 10
C
C================================
C
C*** TRANSMIT OUTPUT TO DTTY ***
C
55	CONTINUE
SKRB
56	CONTINUE
SDTLS
SCLA
57	CONTINUE
SCPAGE 2
SJMPI DTOT
SDTOT,0	/		<-- DTOT IS HERE
SKSF
SSKP
SJMP \55	/TRANSMIT KEYBOARD INPUT
STAD \ITX
SSPA SNA CLA
SJMP \57
C
C*** RETURN IF STILL WAITING FOR PROMT
	IF(IPW)571,57,571
571	CONTINUE
C
C*** TRANSMIT FILE INPUT ***
C
	IF(ITO)58,58,580
58	CONTINUE
	ITO=0
SCPAGE 10
	CALL RFILE(16,IBL)
S6241
S0
	IBL=IBL+8
	ITP=-1
C*** ITP: -1 CHAR1; 0 CHAR2; 1 CHAR3
C*** UNPACK 1+2 AND PIECE TOGETHER 3
580	CONTINUE
	IF(ITP)581,582,583
581	CONTINUE
SJMS INXT
SCLL RTL;RTL
	IW3=0
	ITP=0
	ITO=ITO+1
	GOTO 59
582	CONTINUE
SJMS INXT
	IW3=IW3
	ITP=1
	GOTO 59
583	CONTINUE
STAD \IW3
SLSR; 7
SCLA
	ITP=-1
	ITO=ITO+1
59	CONTINUE
SLSR; 3
C***	IF(.NOT. EOF)GOTO 593
SMQA
SAND (177
STAD (-32	/CHECK FOR EOF [CONTROL Z]
SSZA CLA
	GOTO 593
C*** SKIP TO END OF BLOCK AND STOP TRANSMIT
	ITO=LAND(ITO,-256)+256
	ITX=0
	ITP=-1
593	CONTINUE
C*** IF(MQA=<CR>) WAIT FOR PROMT
SMQA
STAD (-10
SSNA CLA	/NON-ZERO SKIP=>IPW=0, NO WAIT
SIAC		/ZERO: IPW=1, WAIT FOR IPC
SDCA \IPW
C
C*** DON'T TRANSMIT NULL [000]
C***	IF(NUL)GOTO 57
SMQA
SAND (177
SSZA
	GOTO 56
	GOTO 57
C
C=============
SCPAGE 14
SITO,0
SINXT,0		/GET CHAR FROM BUFFER
STAD \ITO
SDCA ITO
S6241
STADI ITO
SLSR
S007
S6201
599	CONTINUE
SJMPI INXT
C
C===========================
SPAGE
C
C*** LDIN: LOAD DISPLAY PAT INTO FIELD 5
C
STABAD,TABLE
SIDN,0
SMAD,0
C
70	CONTINUE
SJMPI LDIN
SLDIN,0
	CONTINUE
STAD \LDN
STAD \IDN
SDCA IDN
STAD \M
SCLL RAL
STAD TABAD
	CONTINUE
SDCA MAD
STADI MAD
SINC MAD
S6251
SDCAI IDN
SINC IDN
S6201
STADI MAD
S6251
SDCAI IDN
C*** MARK END OF LINE
SINC IDN
SCMA
SDCAI IDN
S6201
	CONTINUE
	GOTO 70
C
C*** LPOT: 
C*** IF(LSF AND LI#LO) SEND LP(LO) TO LINE PRINTER
73	CONTINUE
SCPAGE 2
SJMPI LPOT
SLPOT,0
SLSF
SJMP \73
	IF(LI-LO)74,73,74
74	CONTINUE
C	LPC=LP(LO)
STAD \LO
SDCA LO
S6261
SSKP
SCPAGE 2
SLO,0
STADI LO
SLPC
SCLA
S6201
C	LO=LO+1 MOD 4096
SISZ \LO
SNOP
	GOTO 73
C
C*** LPIN: PUT [M] INTO LP BUFFER
C*** IF(NTX) PUT ALSO INTO NTX BUFFER
75	CONTINUE
SCPAGE 2
SJMPI LPIN
SLPIN,0
76	CONTINUE
STAD \LI
SDCA LI
STAD \M
S6261
SSKP
SCPAGE 2
SLI,0
SDCAI LI
S6201
C*** IF(.NOT. SNS 5)GOTO 77
SLINC
S0465	/SNS I 5
S0017	/COM
SPDP
SSMA CLA
	GOTO 77
SISZ \LI
77	CONTINUE
C*** IF(NTX>0)PUT M IN FIELD 7
STAD \NTX
SSPA SNA CLA
	GOTO 75
STAD \NTI
SDCA NTI
STAD \M
STAD (200
S6271
SSKP
SCPAGE 2
SNTI,0
SDCAI NTI
S6201
SISZ \NTI
SNOP
	GOTO 75
C
SLAP
SPAGE
STABLE, BLOCK 100 / OCTAL [0..31]
S0000;0000 / OCTAL 032 (SPACE)
S7500;0000 /!
S0070;0070 /"
S7714;1477 /#
S5721;4671 /$
S6462;2313 /%
S5126;0526 /&
S2000;0040 /'
S3600;0041 /(
S4100;0036 /)
S2050;0050 /*
S1010;1076 /+
S0500;0006 /,
S1010;1010 /-
S0300;0003 /.
S0402;2010 //
S4536;3651 /0
S2101;0177 /1
S4523;2151 /2
S4122;2651 /3
S2414;0477 /4
S5172;0651 /5
S1506;4225 /6
S4443;6050 /7
S5126;2651 /8
S5122;3651 /9
S6600;0066 /:
S6500;0066 /;
S2410;0042 /<
S2424;2424 /=
S4200;1024 />
S4020;2055 /? OCTAL: 077
C*** PAGE 2 OF TABLE
STAB2,4136;3555 /@ OCTAL: 100
S4477;7744 /A OCTAL: 101
S5177;2651 /B
S4136;2241 /C
S4177;3641 /D
S4577;4145 /E
S4477;4044 /F
S4136;2645 /G
S1077;7710 /H
S7741;0041 /I
S4142;4076 /J
S1077;4324 /K
S0177;0301 /L
S3077;7730 /M
S3077;7706 /N
S4177;7741 /O
S4477;3044 /P
S4276;0376 /Q
S4477;3146 /R
S5121;4651 /S
S4040;4077 /T
S0177;7701 /U
S0176;7402 /V
S0677;7701 /W
S1463;6314 /X
S0770;7007 /Y
S4543;6151 /Z
S7700;0041 /[
S1020;0204 /\ (SHIFT L)
S4100;0077 /] (SHIFT M) OCTAL: 135
S3710;0010 /^ OCTAL: 136
S0101;0101 /_ OCTAL: 137 UNDERLINE
S2040;0000 /' OCTAL: 140 ACCENT
S1513;0117 /A OCTAL: 141 LOWER CASE
S1177;0611 /B
S1106;0011 /C
S1106;7711 /D
S1506;0515 /E
S3704;2044 /F
S1106;0213 /G
S0477;0007 /H
S2700;0000 /I
S0102;0036 /J
S0477;0112 /K
S1700;0001 /L
S1417;0714 /M
S0417;0710 /N
S1106;0611 /O
S1217;0016 /P
S1204;0107 /Q
S0417;0410 /R
S1505;1215 /S
S3710;0010 /T
S0116;1601 /U
S0116;1402 /V
S0617;1701 /W
S0611;1106 /X
S0611;1004 /Y
S1311;1115 /Z
S3610;0041 /( OCTAL: 173 CURLY BRACKET
S6700;0000 /I OCTAL: 174 VERTICAL BAR
S4100;1036 /) OCTAL: 175 CURLY BRACKET
S2010;2010 /- OCTAL: 176 WAVEY LINE
S7777;7777 /  M=127: AUXILARY END OF LINE
STAB3,
SPAGE
SEAP
	END
$