image of READY prompt

Wang2200.org

Listing of file='bscsim' on disk='vmedia/bsc_host.wvd.zip'

# Sector 7, program filename = 'bscsim'
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 90
   :   $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 %^     Check keyboard
   :   $IF OFF  /001,170
   :   GOSUB '99("KEYIN"," ",0)
0100   GOSUB '99("PSA","Please choose.",0)
0110   GOSUB '210(2,"Key    Action")
0120   FOR X=1TO K9
   :    GOSUB '210(X+2,K1$(X))
   :    PRINT AT(X+2,59);BOX(1,20);BOX(1,5);
   :   NEXT X
0130   GOSUB '99("KEYIN",K$(),1)
0140   FOR X=0 TO K9
   :   GOSUB '210(X+2," ")
   :   PRINT AT(X+2,59);BOX(-1,-20);BOX(-1,-5);
   :   NEXT X
0150   ON K1 GOSUB 180,190,200
   :    ELSE GOTO 160
   :   GOTO 100
0160   GOSUB '99("PSA","Key space to stop.",0)
0170   RETURN
0180 REM printer on/off
   :   GOSUB '99("PRINTER"," ",P9+1)
   :   RETURN
0190 REM --- LIST
   :   LIST HEX(03),D 1310,
   :   RETURN
0200   GOSUB '99("PSA","Press RUN to exit.",0)
   :   GOSUB '99("KEYIN", HEX(82),1)
   :   IF K=1 THEN LOAD RUN  "@MENU"
   :   RETURN
0210 REM %^'150  tx 1 BCC-type sequence
   : REM %      NOTE !!!!
   : REM This sub inserts syncs
0220 REM -- ARG1  [text]
0230 REM    Passed to TC board in O$()
0240 REM    bytes    meaning
0250 REM    1         '00' = no BCC     '01' = calc BCC
0260 REM    2,3       2-byte count of length of data
0270 REM    4 ... n   data per char count in bytes 2,3
0280 REM -- ARG2  [crt mnemonic]
0290 REM -- ARG3  [options, eg "R"=wait for reply]
0300 REM
0310 DEFFN'150(O$(),Y1$,O3$)
0320 REM set up data
   :   S2,S1=6
   :   S=LEN(O$())+S1
   :   MAT COPY -O$()<,S-S1> TO -O$()<,S>
   :   S1=401
0330   IF S1>S THEN 340
   :   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 330
0340   STR(O$(),,S2)=HEX(01)&BIN(S-3,2)&HEX(323232)
0350 REM  wait for idle, transmit, display,optional wait
   :   GOSUB 420
   :   GOSUB '32("T")
   :   GOSUB '200(HEX(84),Y1$,STR(O$(),7))
   :   IF POS("R"=O3$) > 0 THEN GOSUB '99("RECEIVE"," ",T9)
   :   RETURN
0360 DEFFN'152(Y$,D2$,O3$)
   : REM %'152  tx a data link control sequence
0370   D1=LEN(Y$)+7
   :   D1$()=HEX(00)&BIN(D1-3,2)&HEX(323232)&Y$&HEX(FF)
0380   GOSUB 420
0390   GOSUB '32("D")
0400   GOSUB '200(HEX(84),D2$,STR(D1$(),4))
   :   IF O3$="R" THEN GOSUB '99("RECEIVE"," ",T9)
   :   RETURN
0410 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
0420 REM wait for idle status
   :   GOSUB '50
   :   IF S$<>HEX(00) THEN 420
   :   RETURN
0430 REM %^CRT disp
0440   DEFFN '200(T0$,T1$,H$)
   : REM %'200  hex data
   :   T2$=" "
0450   $TRAN(H$,HEX(32FD32FE))R
0460   X=POS(H$=32)
   :   IF X<1 THEN 470
   :   STR(H$,X)=STR(H$,X+1)
   :   GOTO 460
0470   X=LEN(H$)
   :   HEXUNPACK STR(H$,,X) TO T2$
0490 DEFFN '205 (T0$,T1$,T2$)
   : REM %'205  disp 1 line
0500   Y$=HEX(0000)
   :   PRINTUSING TO Y$,T3$,T0$,T1$,T2$;
0510 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));
0520   $TRAN(Y$,HEX(3E843C5F3C83))R
   :   IF P9>0 THEN $GIO #2 (A000 400D)Y$<3,Y$>
   :   RETURN
0530 DEFFN '210(O0,Y3$)
   : REM %'210  post msg
0540   PRINT HEX(06);AT(O0,60,20);
   :   $GIO /005(A000)Y3$<,LEN(Y3$)>
   :   RETURN
0550 REM %^
0560 DEFFN '98(X1$,X2$(),X3)
0570   MAT SEARCH X2$(),=STR(X1$,,X3) TO B$ STEP X3
   :   X3=FNV(X3)
   :   RETURN
0580 DEFFN '99(M1$,M2$(),M3)
   : REM %'99   Misc chores
   :   $UNPACK(D=HEX(012C)) M1$ TO Y$,M1$()
   :   M1$=Y$
0590   MAT SEARCH M$(),=M1$ TO B$ STEP 8
   :   ON FNV(8)+1 GOSUB 600,610,620,630,640,660,780,820,830,840,890,900,910,9
     20,930,1050,1070
   :   RETURN
0600 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
0610 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
0620 REM --- BID
   :   GOSUB '99("ENQ"," ",0)
   :   GOSUB '99("RECEIVE"," "  ,T9)
   :   IF R1$="ACK0" THEN RETURN
   :   GOSUB '99("NOTE,err","Bid failure",0)
   :   GOSUB '99("PAUSE"," ",2)
   : REM GOSUB '99("EOT"," ",0)
   :   GOTO 620
0630 REM --- ACK
   :   GOSUB '99(R1$(A2+3),M2$(),0)
   :   A2=MOD(A2+1,2)
   :   IF E1=2 THEN A2=0
   :   RETURN
0640 REM --- FOX msg
   :   M9=M3
   :   M1=0
0650   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 650
0660 REM --- ID rx dl sequence
0670   E1=0
0680   Y0$="  _"
0690   I$=STR(R$(),3+POS(STR(R$(),4)<>32))
0700   R1= 2+POS(C1$=I$)
   :   R1$=R1$(R1)
0710   ON R1 GOSUB ,720,740, , , , , ,750,760
   :   RETURN
0720 REM R1= 02 junk
   :   IF STR(I$,,A0)<> A0$ THEN 730
   :       GOSUB '161("ACK0", "IDACK")
   :       RETURN
0730   IF STR(I$,,B0)=B0$ THEN GOSUB '161("ENQ","IDENQ")
   :   RETURN
0740 REM R1=03 DLE sequence
   :   R1=2+POS(C2$=STR(I$,2))
   :   R1$=R1$(R1)
   :   RETURN
0750 REM SOH = fall thru to STX
0760 REM STX = text block or TTD
   :   Y0$=HEX(202083)
   :   IF STR(I$,,2)=HEX(022D) THEN 770
   :   GOSUB '99("ETB/ETX"," ",0)
   :   RETURN
0770   GOSUB '161("TTD","TTD")
   :   RETURN
0780 REM --- RECEIVE
   :   T=M3
   : REM Loop until block rx or iter ctr zeroes
   :   T=M3
0790   R$()=" "
   :   GOSUB '50
   :   IF S$=HEX(03) THEN GOSUB '32("R")
   :   R=VAL(R0$(5),2)
0800   IF R>0THEN 810
   :     T=T-1
   :     IF T>0THEN 790
   :       GOSUB '161("T/O","T/O")
   :       RETURN
0810 REM blk in, get ctrl seq & disp
   :   E1=0
   :   GOSUB '99("ID"," ",0)
   :   T1$=R1$&E1$(E1+1)
   :   GOSUB '200(Y0$,T1$,I$)
   :   RETURN
0820 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
0830 REM --- ABEND
   :   M2$()=M2$()&" (Fatal Error)"
   :   GOSUB '205 ("!!!","ABEND",M2$())
   :   GOSUB '99("NOTE","System error = ##",ERR+.1)
   :   STOP "ERR" #
   :   RETURN
0840 REM --- KEYIN
0850   K,K1=0
   :   $IF ON /001, 860
   :   IF M3=0 THEN 880
0860   K=2
   :   KEYIN K$,,870
   :   K=1
0870   K1=POS(STR(M2$(),,LEN(M2$()))=K$)
0880   RETURN
0890 REM ---PSA
   :   Y3$=HEX(07020404000E8B0204020F20)&M2$()
   :   GOSUB '210(0,Y3$)
   :   RETURN
0900 REM --- CONVERT
   :   Y$=HEX(0000)
   :   PRINTUSING TO Y$,M2$(),M3;
   :   M2$()=STR(Y$,3)
   :   RETURN
0910 REM --- NOTE
   :   IF M3<>0 THEN GOSUB '99("CONVERT",M2$(),M3)
   :   GOSUB '205(" ", M1$(1),M2$())
   :   RETURN
0920 REM --- PRINTER
   :   P9=MOD(M3,2)
   :   $PACK(F=HEX(000BA004)) K1$(1) FROM O0$(P9+1)
   :   RETURN
0930 REM %--- SEND
   :   GOSUB '98(M1$(1),"NOBCC XLATE ASIS",6)
   :   ON X3+1 GOSUB 950,940,950,970
   :   RETURN
0940 REM -- NOBCC
   :   GOSUB '152(M2$(),M1$(2),M1$(3))
   :   RETURN
0950 REM --XLATE
   :   B9=LEN(M2$())
   :   M2$()=M2$()&HEX(00FF)
   :   B=1
0960   N=POS(STR(M2$(),B)>"\AF")-1
   :   IF N=0 THEN 980
   :   $TRAN(STR(M2$(),B,N),T1$())
   :   B=B+N
   :   IF B<=B9 THEN 960
   :   STR(M2$(),B9+1)=" "
0970 REM -- ASIS
   :   GOSUB '150(M2$(),M1$(2),M1$(3))
   :   RETURN
0980   N=(POS(STR(M2$(),B)<"\B0")-1)/2
0990   STR(M2$(),B,2*N)=AND ALL(7F)
1000   HEXPACK STR(M2$(),B,N) FROM STR(M2$(),B,2*N)
1010   B=B+N
1020   STR(M2$(),B)=STR(M2$(),B+N)
1030   B9=B9-N
1040   GOTO 960
1050 REM --- BADREPLY
   :   GOSUB '98(M2$(),"QUIT   PROMPT DISPLAYIGNORE",7)
   :   IF X3>0 THEN B1=X3
   :   IF X3>0 OR B1=4 THEN RETURN
   :   M2$()=M2$() & " was an unexected response"
   :   GOSUB '99("NOTE,?????",M2$(),0)
   :   IF B1>2 THEN RETURN
1060   IF B1 = 1 THEN STOP #
   :   GOSUB '99("PSA","Touch a key",0)
   :   GOSUB '99("KEYIN"," ",1)
   :   RETURN
1070 REM --- BEGIN
1080   A2=0
   :   C2=2
   :   F1$(1)="?"
1090   M1=0
1100 REM --- NUMBER OF ITER IN WAIT LOOP
   :   T9=500
1110   SELECT PRINT 005 (80)
   :   PRINT HEX(0F0603)
1120   GOSUB '99 ("BADREPLY","DISPLAY",0)
1130 REM get permission
   : REM connect
   : REM dump anything on line
   : REM jump to main loop
   :   GOSUB 100
   :   GOSUB '32("C")
   :   GOSUB '99("RECEIVE"," ",1)
   :   GOSUB '33
1140 DEFFN '1 "RENUMBER 0010 -8999 TO 0010 STEP10";HEX(0D)
1150 DEFFN '2HEX(B0B282)
1160 DEFFN '3HEX(B0B383)
1170 %DEFFN '5 "RENUMBER5000-8999 TO 5000";HEX(0D)
1180 DEFFN'16"SCRATCHT";HEX(22);"bscsim";HEX(223A);"SAVE T()";HEX(22);"bscsim
      ";HEX(220D)
1190 DEFFN'20"PRINTSPACEK*1024-SPACE";HEX(0D)
1200 DEFFN '17 "PRINTHEX(0603)";HEX(3A);"LISTSD 0900,9999";HEX(0D)
1210 DEFFN '21 "PRINTHEX(0603)";HEX(3A);"LISTSD1700,8999";HEX(0D)
1220 DEFFN '26 HEX(B2B683)
1230 DEFFN '126 "    "
1240 DEFFN '127 "REM "
1250 REM %^
1260 DEFFN '33
   : RETURN  CLEAR  ALL
   : REM %^'33  ============= MAIN LOOP
1270 REM loop in idle mode until there's something to do
   :   GOSUB '99("RECEIVE"," ",0)
   :   GOSUB '98(R1$,"T/O ENQ",4)
   :   ON X3 GOSUB 1300,1360
   :   GOTO 1270
1300 REM %^send
1301   REM ---- wait till receive done
   :   IF U$<>"DONE" THEN RETURN
   :   U$=" "
1302   GOSUB '99 ("PRINTER"," ",1)
1310   GOSUB '99("BID"," ",0)
1320   GOSUB '99("FOX"," ",05)
1330   GOSUB '99("SEND,XLATE,done,REPLY","\B0\B2\82Doney-done-done.\B0\B3\83",
     0)
1340   GOSUB '99("SEND,NOBCC,HANG,-",HEX(02F1F2F3),0)
1350   RETURN
1360 REM %^rx
1361   IF U$="DONE" THEN STOP "DONE"
   :   U=0
1370 REM rx 1st enq
   :   A2=0
   :   GOSUB '99("PRINTER"," ",1)
1380   U=U+1
   :   IF U<5 THEN 1382
   :   GOSUB '99("SEND,NOBCC,DUMMY",HEX(32),0)
1381   GOSUB '99("RECEIVE"," ",T9)
   : GOTO 1381
1382   GOSUB '99("ACK"," ",0)
1390   GOSUB '99("RECEIVE"," ",T9)
1400   ON R1 GOTO 1410,1420,1430,1440,1450,1460,1470,1480,1490,1500,1510,1520,
     1530,1540,1550,1560,1570,1580
1410 REM -- T/O
   :   GOTO 1390
1420 REM -- JUNK
   :   GOSUB '99("NAK"," ",0)
   :   GOTO 1390
1430 REM -- ACK0
   :   GOSUB '99("BADREPLY",R1$,0)
   :   RETURN
1440 REM -- ACK1
   :   GOSUB '99("BADREPLY",R1$,0)
   :   RETURN
1450 REM -- WACK
   :   GOSUB '99("BADREPLY",R1$,0)
   :   RETURN
1460 REM -- DEOT
   :   GOSUB '99("BADREPLY",R1$,0)
   :   RETURN
1470 REM -- RVI
   :   GOSUB '99("BADREPLY",R1$,0)
   :   RETURN
1480 REM -- EOT
   :    U$="DONE"
   :   RETURN
1490 REM -- SOH
   :   GOTO 1380
1500 REM -- STX
   :   GOTO 1380
1510 REM -- NAK
   :   GOSUB '99("BADREPLY",R1$,0)
   :   RETURN
1520 REM -- ENQ
   :   A2=MOD(A2+1,2)
   :   GOTO 1380
1530 REM -- ETX
   :   GOSUB '99("ABEND","Program bug",0)
   :   RETURN
1540 REM -- ETB
   :   GOSUB '99("BADREPLY",R1$,0)
   :   RETURN
1550 REM -- ITB
   :   GOSUB '99("BADREPLY",R1$,0)
   :   RETURN
1560 REM -- ESC
   :   GOSUB '99("BADREPLY",R1$,0)
   :   RETURN
1570 REM -- SYN
   :   GOSUB '99("BADREPLY",R1$,0)
   :   RETURN
1580 REM -- TTD
   :   GOSUB '99("NAK"," ",0)
   :   GOTO 1390