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