10 ! 4380A Test Program
20 ! Do not use TAB, only spaces
30 ! Working June 17, 2003
40 PRINTER IS PRT ! sets external printer in 4395A
50 COM @Na,Arcvr,Brcvr,Term, Src
60 Src=0     ! Source
70 Arcvr=0   ! A Top Receiver
80 Brcvr=0   ! B Bottom Receiver
90 Term=0    ! Termination
100 ASSIGN @Na TO 800   ! 4395A in internal Ibasic
110 ! ON KEY LABELS
120 Loop:LOOP
130 ON KEY 1 LABEL "Source" CALL Incsrc
140 ON KEY 2 LABEL "Arcv" CALL A_rec
150 ON KEY 3 LABEL "Brcv" CALL B_rec
160 ON KEY 4 LABEL "Term" CALL Term
170 ON KEY 5 LABEL "QUIT" GOTO Quit
180 END LOOP 
190 ! OFF KEY LABELS
200 Quit: !
210 STOP
220 Func=0    ! Cal Port
230 Mode=1   ! Open
240 END
250 !
260 SUB Bpo(Func,Mode)
270 COM @Na,Arcvr,Brcvr,Term, Src
280 Portdata=Func*16+BINAND(Mode,15)
290 OUTPUT @Na;"OUT8IO ";128+32+16
300 OUTPUT @Na;"OUT8IO ";128+Portdata
310 OUTPUT @Na;"OUT8IO ";Portdata
320 OUTPUT @Na;"OUT8IO ";128+32+16
330 SUBEND !
340 !
350 Incsrc:SUB Incsrc
360 COM @Na,Arcvr,Brcvr,Term, Src
370   Src=Src+1
380   IF Src=8 THEN Src=0
390   Func=1
400   Mode=Src
410 CALL Bpo(Func,Mode)
420 SUBEND !
430 !
440 SUB A_rec
450 COM @Na,Arcvr,Brcvr,Term, Src
460   Arcvr=Arcvr+1
470   IF Arcvr=4 THEN Arcvr=0
480   Func=2  ! set both receivers
490   Mode=4*Arcvr+Brcvr
500 CALL Bpo(Func,Mode)
510 SUBEND
520 !
530 SUB B_rec
540 COM @Na,Arcvr,Brcvr,Term, Src
550   Brcvr=Brcvr+1
560   IF Brcvr=4 THEN Brcvr=0
570   Func=2  ! set both receivers
580   Mode=4*Arcvr+Brcvr
590 CALL Bpo(Func,Mode)
600 SUBEND !
610 !
620 SUB Term
630 COM @Na,Arcvr,Brcvr,Term, Src
640   Term=Term+1
650   IF Termr=4 THEN Term=0
660   Func=0  ! set Termination port
670   Mode=4*Arcvr+Brcvr
680 CALL Bpo(Func,Term)
690 SUBEND !