Listing of file='bscsimx' on disk='vmedia/bsc_host.wvd.zip'
# Sector 393, program filename = 'bscsimx'
0010 REM BSC host emulator
: GOSUB '99("BEGIN"," ",0)
: DEFFNV(X)=INT((VAL(B$,2)+(X-1))/X)
0020 DEFFN '07
: LOAD T "bscinit"
0030 REM %'032 ========== Access TC board
: REM Always check keyboard 1st
0040 DEFFN '32(G$)
: GOSUB 130
: $GIO #1 (G$(POS("SRTDC"=G$)),R0$()) S$;R$();O$()<,S>;D1$()<,D1>;C0$()
: ERRORGOSUB '99 ("ABEND","TC Board problem.",0)
0050 RETURN
0060 REM %'050 Get status
: REM always ck DSR
0070 DEFFN'50
: GOSUB '32("S")
: IF S$=HEX(80) THEN 80
: IF F1$(1)<>"U" THEN GOSUB '99("NOTE,DSR","is up",0)
: F1$(1)="U"
: RETURN
0080 IF F1$(1)<>"D" THEN GOSUB '99("NOTE,DSR","is down",0)
: F1$(1)="D"
: GOTO 70
0090 REM --- RECEIVE
: T=T9
0100 R$()=" "
: GOSUB '50
: IF S$=HEX(03) THEN GOSUB '32("R")
: R=VAL(R0$(5),2)
0110 IF R>0THEN 120
: T=T-1
: IF T>0THEN 100
: GOSUB '161("T/O","T/O")
: RETURN
0120 REM blk in, get ctrl seq & disp
: GOSUB '99("ID"," ",0)
: GOSUB '200(Y0$,R1$,I$)
: RETURN
0130 REM %^ Check keyboard
: $IF OFF /001,210
: GOSUB '99("KEYIN"," ",0)
0140 GOSUB '99("PSA","Please choose.",0)
0150 GOSUB '210(2,"Key Action")
0160 FOR X=1TO K9
: GOSUB '210(X+2,K1$(X))
: PRINT AT(X+2,59);BOX(1,20);BOX(1,5);
: NEXT X
0170 GOSUB '99("KEYIN",K$(),1)
0180 FOR X=0 TO K9
: GOSUB '210(X+2," ")
: PRINT AT(X+2,59);BOX(-1,-20);BOX(-1,-5);
: NEXT X
0190 ON K1 GOSUB 220,230,240
: ELSE GOTO 200
: GOTO 140
0200 GOSUB '99("PSA","Key space to stop.",0)
0210 RETURN
0220 REM printer on/off
: GOSUB '99("PRINTER"," ",P9+1)
: RETURN
0230 REM --- LIST
: LIST HEX(03),D 1290,
: RETURN
0240 GOSUB '99("PSA","Press RUN to exit.",0)
: GOSUB '99("KEYIN", HEX(82),1)
: IF K=1 THEN LOAD RUN "@MENU"
: RETURN
0250 REM %^'150 tx 1 BCC-type sequence
: REM % NOTE !!!!
: REM This sub inserts syncs
0260 REM -- ARG1 [text]
0270 REM Passed to TC board in O$()
0280 REM bytes meaning
0290 REM 1 '00' = no BCC '01' = calc BCC
0300 REM 2,3 2-byte count of length of data
0310 REM 4 ... n data per char count in bytes 2,3
0320 REM -- ARG2 [crt mnemonic]
0330 REM -- ARG3 [options, eg "R"=wait for reply]
0340 REM
0350 DEFFN'150(O$(),Y1$,O3$)
0360 REM set up data
: S2,S1=6
: S=LEN(O$())+S1
: MAT COPY -O$()<,S-S1> TO -O$()<,S>
: S1=401
0370 IF S1>S THEN 380
: MAT COPY -O$()<S1,S-S1+1> TO -O$()<S1,S-S1+6>
: STR(O$(),S1,5)=HEX(FE323232FD)
: S=S+5
: S1=S1+400+5
: GOTO 370
0380 STR(O$(),,S2)=HEX(01)&BIN(S-3,2)&HEX(323232)
0390 REM wait for idle, transmit, display,optional wait
: GOSUB 460
: GOSUB '32("T")
: GOSUB '200(HEX(84),Y1$,STR(O$(),7))
: IF O3$="R" THEN GOSUB 90
: RETURN
0400 DEFFN'152(Y$,D2$,O3$)
: REM %'152 tx a data link control sequence
0410 D1=LEN(Y$)+7
: D1$()=HEX(00)&BIN(D1-3,2)&HEX(323232)&Y$&HEX(FF)
0420 GOSUB 460
0430 GOSUB '32("D")
0440 GOSUB '200(HEX(84),D2$,STR(D1$(),4))
: IF O3$="R" THEN GOSUB 90
: RETURN
0450 DEFFN '161(C$,R1$)
: REM get cntrl seq
: GOSUB '98(C$,R1$(),8)
: R1=X3
: IF R1=0 THEN GOSUB '99("ABEND","Invalid ctl seq.",0)
: RETURN
0460 REM wait for idle status
: GOSUB '50
: IF S$<>HEX(00) THEN 460
: RETURN
0470 REM %^CRT disp
0480 DEFFN '200(T0$,T1$,H$)
: REM %'200 hex data
: T2$=" "
0490 $TRAN(H$,HEX(32FD32FE))R
0500 X=POS(H$=32)
: IF X<1 THEN 510
: STR(H$,X)=STR(H$,X+1)
: GOTO 500
0510 X=LEN(H$)
: HEXUNPACK STR(H$,,X) TO T2$
0520 IF E1>0 THEN T2$=T2$&"[.."&E$(E1)&"]"
0530 DEFFN '205 (T0$,T1$,T2$)
: REM %'205 disp 1 line
0540 Y$=HEX(0000)
: PRINTUSING TO Y$,T3$,T0$,T1$,T2$;
0550 REM calc vert wrap
: C2=MOD(C2+1,24)
: PRINT AT(MOD(C2+1,24),0,55);HEX(8B);AT(C2,0);STR(Y$,3,VAL(Y$,2));
0560 $TRAN(Y$,HEX(3E843C5F3C83))R
: IF P9>0 THEN $GIO #2 (A000 400D)Y$<3,Y$>
: RETURN
0570 DEFFN '210(O0,Y3$)
: REM %'210 post msg
0580 PRINT HEX(06);AT(O0,60,20);
: $GIO /005(A000)Y3$<,LEN(Y3$)>
: RETURN
0590 REM %^
0600 DEFFN '98(X1$,X2$(),X3)
0610 MAT SEARCH X2$(),=STR(X1$,,X3) TO B$ STEP X3
: X3=FNV(X3)
: RETURN
0620 DEFFN '99(M1$,M2$(),M3)
: REM %'99 Misc chores
: $UNPACK(D=HEX(012C)) M1$ TO Y$,M1$()
: M1$=Y$
0630 MAT SEARCH M$(),=M1$ TO B$ STEP 8
: ON FNV(8)+1 GOSUB 640,650,660,670,680,700,820,830,840,850,900,910,920,9
30,940,1060
: RETURN
0640 REM --- if not listed, it's either a control char or a mistake
: GOSUB '161(M1$,R1$)
: IF R1>0 THEN GOSUB '152(C$(R1),R1$(R1),M2$())
: ELSE GOSUB '99("ABEND","Illegal arg",0)
: RETURN
0650 REM --- PAUSE
: W$=BIN(20 000 * MIN(3,ABS(M3)),2)
: IF M3>0 THEN GOSUB '99("NOTE,PAUSE","#.# seconds",M3)
: $GIO /005 (1211 4000, W$)
: RETURN
0660 REM --- BID
: GOSUB '99("ENQ"," ",0)
: GOSUB '99("RECEIVE"," " ,100)
: IF R1$="ACK0" THEN RETURN
: GOSUB '99("NOTE,err","Bid failure",0)
: GOSUB '99("PAUSE"," ",3)
: REM GOSUB '99("EOT"," ",0)
: GOTO 660
0670 REM --- ACK
: GOSUB '99(R1$(A2+3),M2$(),0)
: A2=MOD(A2+1,2)
: IF E1=2 THEN A2=0
: RETURN
0680 REM --- FOX msg
: M9=M3
: M1=0
0690 M1=M1+1
: GOSUB '99("CONVERT","\B0\B2\82Iter ####: The quick brown fox jumped ove
r the lazy dog's back.\B2\B6\83",M1)
: GOSUB '99("SEND,XLATE,FOX,Reply",M2$(),T9)
: IF M1<M9 THEN 690
0700 REM --- ID rx dl sequence
0710 E1=0
0720 Y0$=" _"
0730 I$=STR(R$(),3+POS(STR(R$(),4)<>32))
0740 R1= 2+POS(C1$=I$)
: R1$=R1$(R1)
0750 ON R1 GOSUB ,760,780, , , , , ,790,800
: RETURN
0760 REM R1= 02 junk
: IF STR(I$,,A0)<> A0$ THEN 770
: GOSUB '161("ACK0", "IDACK")
: RETURN
0770 IF STR(I$,,B0)=B0$ THEN GOSUB '161("ENQ","IDENQ")
: RETURN
0780 REM R1=03 DLE sequence
: R1=2+POS(C2$=STR(I$,2))
: R1$=R1$(R1)
: RETURN
0790 REM SOH = fall thru to STX
0800 REM STX = text block or TTD
: Y0$=HEX(202083)
: IF STR(I$,,2)=HEX(022D) THEN 810
: GOSUB '99("ETB/ETX"," ",0)
: RETURN
0810 GOSUB '161("TTD","TTD")
: RETURN
0820 REM --- RECEIVE
: T=M3
: GOSUB 100
: RETURN
0830 REM --- ETB/ETX
: REM E1 is flag (0=neither, 1=ETB, 2=ETX)
: FOR X=MAX(1,R-5) TO R
: E1=POS(HEX(2603)=R$(X))
: IF E1>0 THEN X=R
: NEXT X
: RETURN
0840 REM --- ABEND
: M2$()=M2$()&" (Fatal Error)"
: GOSUB '205 ("!!!","ABEND",M2$())
: GOSUB '99("NOTE","System error = ##",ERR+.1)
: STOP "ERR" #
: RETURN
0850 REM --- KEYIN
0860 K,K1=0
: $IF ON /001, 870
: IF M3=0 THEN 890
0870 K=2
: KEYIN K$,,880
: K=1
0880 K1=POS(STR(M2$(),,LEN(M2$()))=K$)
0890 RETURN
0900 REM ---PSA
: Y3$=HEX(07020404000E8B0204020F20)&M2$()
: GOSUB '210(0,Y3$)
: RETURN
0910 REM --- CONVERT
: Y$=HEX(0000)
: PRINTUSING TO Y$,M2$(),M3;
: M2$()=STR(Y$,3)
: RETURN
0920 REM --- NOTE
: IF M3<>0 THEN GOSUB '99("CONVERT",M2$(),M3)
: GOSUB '205(" ", M1$(1),M2$())
: RETURN
0930 REM --- PRINTER
: P9=MOD(M3,2)
: $PACK(F=HEX(000BA004)) K1$(1) FROM O0$(P9+1)
: RETURN
0940 REM %--- SEND
: GOSUB '98(M1$(1),"NOBCC XLATE ASIS",6)
: ON X3+1 GOSUB 960,950,960,980
: RETURN
0950 REM -- NOBCC
: GOSUB '152(M2$(),M1$(2),M1$(3))
: RETURN
0960 REM --XLATE
: B9=LEN(M2$())
: M2$()=M2$()&HEX(00FF)
: B=1
0970 N=POS(STR(M2$(),B)>"\AF")-1
: IF N=0 THEN 990
: $TRAN(STR(M2$(),B,N),T1$())
: B=B+N
: IF B<=B9 THEN 970
: STR(M2$(),B9+1)=" "
0980 REM -- ASIS
: GOSUB '150(M2$(),M1$(2),M1$(3))
: RETURN
0990 N=(POS(STR(M2$(),B)<"\B0")-1)/2
1000 STR(M2$(),B,2*N)=AND ALL(7F)
1010 HEXPACK STR(M2$(),B,N) FROM STR(M2$(),B,2*N)
1020 B=B+N
1030 STR(M2$(),B)=STR(M2$(),B+N)
1040 B9=B9-N
1050 GOTO 970
1060 REM --- BEGIN
1070 A2=0
: C2=2
: F1$(1)="?"
1080 M1=0
1090 REM --- NUMBER OF ITER IN WAIT LOOP
: T9=500
1100 SELECT PRINT 005 (80)
: PRINT HEX(0F0603)
1110 REM get permission
: REM connect
: REM dump anything on line
: REM jump to main loop
: GOSUB 140
: GOSUB '32("C")
: GOSUB '99("RECEIVE"," ",1)
: GOSUB '33
1120 DEFFN '1 "RENUMBER 0010 -8999 TO 0010 STEP10";HEX(0D)
1130 DEFFN '2HEX(B0B282)
1140 DEFFN '3HEX(B0B383)
1150 %DEFFN '5 "RENUMBER5000-8999 TO 5000";HEX(0D)
1160 DEFFN'16"SCRATCHT";HEX(22);"bscsimx";HEX(223A);"SAVE T()";HEX(22);"bscsim
x ";HEX(220D)
1170 DEFFN'20"PRINTSPACEK*1024-SPACE";HEX(0D)
1180 DEFFN '17 "PRINTHEX(0603)";HEX(3A);"LISTSD 0900,9999";HEX(0D)
1190 DEFFN '21 "PRINTHEX(0603)";HEX(3A);"LISTSD1700,8999";HEX(0D)
1200 DEFFN '26 HEX(B2B683)
1210 DEFFN '126 " "
1220 DEFFN '127 "REM "
1230 REM %^
1240 DEFFN '33
: RETURN CLEAR ALL
: REM %^'33 ============= MAIN LOOP
1250 REM idle see if there's anything to receive
1260 GOSUB '99("RECEIVE"," ",T9)
1270 IF R1$="T/O" THEN GOSUB 1280
: ELSE IF R1$="ENQ" THEN GOSUB 1340
: GOTO 1260
1280 REM %^send
: REM SEND NOTHING
: RETURN
1290 GOSUB '99("BID"," ",0)
1300 GOSUB '99("FOX"," ",05)
1310 GOSUB '99("SEND,XLATE,END,REPLY","\B0\B2\82END\B0\B3\83",0)
1320 GOSUB '99("SEND,NOBCC,HANG,-",HEX(02F1F2F3),0)
1330 RETURN
1340 REM %^rx
1350 REM rx 1st enq
: A2=0
1360 GOSUB '99("ACK"," ",0)
1370 GOSUB 90
1380 ON R1 GOTO 1390,1400,1410,1420,1430,1440,1450,1460,1470,1480,1490,1500,
1510,1520,1530,1540,1550,1560
1390 REM -- T/O
: GOTO 1370
1400 REM -- JUNK
: GOSUB '99("NAK"," ",0)
: GOTO 1370
1410 REM -- ACK0
: STOP "ACK0"#
1420 REM -- ACK1
: STOP "ACK1"#
1430 REM -- WACK
: STOP "WACK"#
1440 REM -- DEOT
: STOP "DEOT#"
1450 REM -- RVI
: STOP "RVI"#
1460 REM -- EOT
: RETURN
1470 REM -- SOH
: GOTO 1360
1480 REM -- STX
: GOTO 1360
1490 REM -- NAK
: STOP "NAK "#
1500 REM -- ENQ
: A2=MOD(A2+1,2)
: GOTO 1360
1510 REM -- ETX
: STOP "ETX "#
1520 REM -- ETB
: STOP "ETB "#
1530 REM -- ITB
: STOP "ITB "#
1540 REM -- ESC
: STOP "ESC "#
1550 REM -- SYN
: STOP "SYN "#
1560 REM -- TTD
: GOSUB '99("NAK"," ",0)
: GOTO 1370
: GOSUB 90
1570 GOTO 1380