******************************************************************
*** ***
*** comp.binaries.cbm is a moderated binaries- ***
*** only newsgroup (no discussion or ***
*** crossposting allowed) for Commodore 8-bits ***
*** ***
*** For information on comp.binaries.cbm visit ***
***
http://www.floodgap.com/comp.binaries.cbm/ ***
*** ***
*** This file is available via mailing list at ***
***
http://lists.trikaliotis.net/listinfo/comp-binaries-cbm/ ***
*** to list subscribers ***
*** Allow time for submission to be received ***
*** ***
******************************************************************
* One from the Vault is a collection of frequently requested, useful or just
plain interesting past posts sent to comp.binaries.cbm, as archived by the
moderators. If you have a request, please send it to the address in the
headers. In addition to being selected and reposted by moderation staff,
some of these postings are regularly posted on Mondays and Fridays on a
rotating schedule.
Take care when replying to these messages, as many were posted years ago.
From: Andre Fachat <a.fachat@legrelle.physik.tu-chemnitz.de>
Reply-to: Andre Fachat <a.fachat@legrelle.physik.tu-chemnitz.de> >X-Original-Posting-Date: 20 Sep 1998 14:34:51 GMT
This is the PET IEEE488 interface routines, implemented in BASIC!
I used it to test my PC IEEE488 interface.
It lacks the timeout handling, though.
[ This one is very interesting for people who want to dissect Commodore
serial bus timing -- have a blast. ;-) -- Cameron Kaiser ]
Andre
petieee ==0401==
900 print"device:";:input dv
1000 a0 = 0:rem init
1005 ef = 0:rem set status
1010 rem dv = 9:rem device 8
1015 v = 0:rem verbose
1019 rem goto 1100
1020 gosub 10100: rem listen device dv
1030 ac = 96 + 15:rem secaddr $6f
1040 gosub 12000: rem seclisten
1050 ac = asc("m")
1060 gosub 13000: rem iecout
1070 gosub 12400:rem unlisten
1090 rem end
1100 gosub 10000: rem talk
1110 ac = 96 + 15:rem secaddr $6f
1120 gosub 12100: rem sectalk
1130 gosub 14000: rem iecin
1140 printchr$(ac);
1150 if ef = 0 then 1130
1160 gosub 12300:rem untalk
1200 end
10000 rem talk
10001 if v then print "talk ";dv
10010 ac=64:goto 10115
10100 rem listen
10101 if v then print "listen ";dv
10110 ac=32
10115 bt = ac
10200 poke 59456,peek(59456) or 2: rem nrfd hi
10210 poke 59425,60:rem ndac hi
10220 if a0 = 0 then 10270
10230 poke 59409,52:rem set eoi
10240 gosub 11000:rem byte out
10250 a0 = 0
10260 poke 59409, 60:rem reset eoi
10270 a5 = bt or dv
10275 rem print "by=";by;", dv=";dv;", a5=";a5
10280 ac = peek(59456):if ac < 128 then 10280
10290 poke 59456, ac and 251
11000 rem byte out
11001 if v then print "byte out ";a5
11010 poke 59427,60 :rem dav hi
11020 ac = peek(59456)
11030 if (ac and 65) = 65 then 19000:rem device not pesent
11040 poke 59426, 255-a5:rem set data byte
11050 if (peek(59456) and 64) = 0 then 11050
11060 poke 59427, 52:rem dav lo
11070 if (peek(59456) and 1)= 0 then 11070
11080 poke 59427, 60:rem dav hi
11090 poke 59426, 255:rem data lines high
11100 return
12000 rem seclisten
12001 if v then print "seclisten";ac
12020 a5 = ac
12030 gosub 11000
12040 poke 59456, peek(59456) or 4:rem atn hi
12050 return
12100 rem sectalk
12101 if v then print "sectalk ";ac
12110 a5 = ac
12120 gosub 11000
12130 gosub 12200
12140 goto 12040
12200 rem nrfd/ndac lo
12210 poke 59456, peek(59456)and 253: rem nrfd lo
12220 poke 59425, 52:rem ndac lo
12230 return
12300 rem untalk
12301 if v then print "untalk"
12310 poke 59456, peek(59456) and 251:rem atn lo
12320 ac = 95
12330 goto 12420
12400 rem unlisten
12401 if v then print "unlisten"
12410 ac = 63
12420 gosub 10115
12430 goto 12040
13000 rem iecout
13010 if a0 > 127 then 13040
13020 a0 = a0-1:if a0 < 0 then a0 = 255
13030 goto 13070
13040 by = ac
13050 gosub 11000
13060 ac = by
13070 a5 = ac
13080 return
14000 rem iecin
14010 poke 59425, 52:rem ndac lo
14020 poke 59456, peek(59456) or 2: rem nrfd hi
14030 if peek(59456) > 127 then 14030:rem wait dav lo
14040 poke 59456, peek(59456) and 253: rem nrfd lo
14050 if (peek(59408) and 64) = 64 then 14070
14060 ef = ef or 64: rem set eoi flag
14070 ac = 255-peek(59424): rem data byte
14080 by = ac
14090 poke 59425, 60:rem ndac hi
14100 if peek(59456) < 128 then 14100:rem wait dav hi
14110 poke 59425, 52:rem ndac lo
14120 return
19000 rem device not present
19010 print "device not present error"
19020 end
begin 400 petieee
M`006!(0#F2)$159)0T4Z(CLZA2!$5@`H!.@#03`@LB`P.H\@24Y)5`!`!.T# M148@LB`P.H\@4T54(%-405154P!;!/(#CR`@1%8@/2`Y.E)%32!$159)0T4@ M.`!O!/<#5B"R(#`ZCR!615)"3U-%`'\$^P./($=/5$\@,3$P,`"?!/P#C2`Q M,#$P,#H@CR!,25-414X@1$5624-%($16`+X$!@1!0R"R(#DV(*H@,34ZCR!3 M14-!1$12("0V1@#7!!`$C2`Q,C`P,#H@CR!314-,25-414X`YP0:!$%#(+(@ MQB@B32(I`/T$)`2-(#$S,#`P.B"/($E%0T]55``4!2X$C2`Q,C0P,#J/(%5. M3$E35$5.`!X%0@2/($5.1``R!4P$C2`Q,#`P,#H@CR!404Q+`%$%5@1!0R"R M(#DV(*H@,34ZCR!314-!1$12("0V1@!H!6`$C2`Q,C$P,#H@CR!314-404Q+ M`'T%:@2-(#$T,#`P.B"/($E%0TE.`(D%=`29QRA!0RD[`)T%?@2+($5&(+(@ M,""G(#$Q,S``L@6(!(T@,3(S,#`ZCR!53E1!3$L`N`6P!(``PP40)X\@5$%, M2P#:!1$GBR!6(*<@F2`B5$%,2R`B.T16`.P%&B=!0[(V-#J)(#$P,3$U`/D% M=">/($Q)4U1%3@`2!G4GBR!6(*<@F2`B3$E35$5.("([1%8`'`9^)T%#LC,R M`"@&@R="5""R($%#`$P&V">7(#4Y-#4V+,(H-3DT-38I(+`@,CH@CR!.4D9$ M($A)`&4&XB>7(#4Y-#(U+#8P.H\@3D1!0R!(20!Z!NPGBR!!,""R(#`@IR`Q M,#(W,`"3!O8GER`U.30P.2PU,CJ/(%-%5"!%3TD`J@8`*(T@,3$P,#`ZCR!" M651%($]55`"U!@HH03`@LB`P`-$&%"B7(#4Y-#`Y+"`V,#J/(%)%4T54($5/ M20#B!AXH034@LB!"5""P($16``T'(RB/(%!224Y4(")"63TB.T)9.R(L($16 M/2([1%8[(BP@034](CM!-0`R!R@H04,@LB#"*#4Y-#4V*3J+($%#(+,@,3(X M(*<@,3`R.#``2`<R*)<@-3DT-38L($%#(*\@,C4Q`%<'^"J/($)95$4@3U54 M`'('^2J+(%8@IR"9(")"651%($]55"`B.T$U`(L'`BN7(#4Y-#(W+#8P(#J/ M($1!5B!(20"=!PPK04,@LB#"*#4Y-#4V*0#.!Q8KBR`H04,@KR`V-2D@LB`V M-2"G(#$Y,#`P.H\@1$5624-%($Y/5"!015-%3E0`\@<@*Y<@-3DT,C8L(#(U M-:M!-3J/(%-%5"!$051!($)95$4`%`@J*XL@*,(H-3DT-38I(*\@-C0I(+(@ M,""G(#$Q,#4P`"T(-"N7(#4Y-#(W+"`U,CJ/($1!5B!,3P!-"#XKBR`HPB@U M.30U-BD@KR`Q*;(@,""G(#$Q,#<P`&8(2"N7(#4Y-#(W+"`V,#J/($1!5B!( M20")"%(KER`U.30R-BP@,C4U.H\@1$%402!,24Y%4R!(24=(`(\(7"N.`)\( MX"Z/(%-%0TQ)4U1%3@"Z".$NBR!6(*<@F2`B4T5#3$E35$5.(CM!0P#&"/0N M034@LB!!0P#2"/XNC2`Q,3`P,`#U"`@OER`U.30U-BP@
PB@U.30U-BD@L"`T M.H\@051.($A)`/L($B^.``D)1"^/(%-%0U1!3$L`(PE%+XL@5B"G()D@(E-% M0U1!3$L@(CM!0P`O"4XO034@LB!!0P`["5@OC2`Q,3`P,`!'"6(OC2`Q,C(P M,`!3"6POB2`Q,C`T,`!F":@OCR!.4D9$+TY$04,@3$\`C`FR+Y<@-3DT-38L M(,(H-3DT-38IKR`R-3,Z((\@3E)&1"!,3P"F";POER`U.30R-2P@-3(ZCR!. M1$%#($Q/`*P)QB^.`+D)##"/(%5.5$%,2P#."0TPBR!6(*<@F2`B54Y404Q+ M(@#S"18PER`U.30U-BP@
PB@U.30U-BD@KR`R-3$ZCR!!5$X@3$\`_PD@,$%# M(+(@.34`"PHJ,(D@,3(T,C``&@IP,(\@54Y,25-414X`,0IQ,(L@5B"G()D@ M(E5.3$E35$5.(@`]"GHP04,@LB`V,P!)"H0PC2`Q,#$Q-0!5"HXPB2`Q,C`T M,`!B"L@RCR!)14-/550`>0K2,HL@03`@L2`Q,C<@IR`Q,S`T,`";"MPR03`@ MLB!!,*LQ.HL@03`@LR`P(*<@03`@LB`R-34`IPKF,HD@,3,P-S``LPKP,D)9 M(+(@04,`OPKZ,HT@,3$P,#``RPH$,T%#(+(@0ED`UPH.,T$U(+(@04,`W0H8 M,XX`Z0JP-H\@245#24X``PNZ-I<@-3DT,C4L(#4R.H\@3D1!0R!,3P`H"\0V MER`U.30U-BP@
PB@U.30U-BD@L"`R.B"/($Y21D0@2$D`5`O.-HL@
PB@U.30U M-BD@L2`Q,C<@IR`Q-#`S,#J/(%=!250@1$%6("!,3P!["]@VER`U.30U-BP@
MPB@U.30U-BD@KR`R-3,Z((\@3E)&1"!,3P">"^(VBR`
HPB@U.30P."D@KR`V M-"D@LB`V-""G(#$T,#<P`+\+[#9%1B"R($5&(+`@-C0Z((\@4T54($5/22!& M3$%'`.(+]C9!0R"R(#(U-:O"*#4Y-#(T*3H@CR!$051!($)95$4`[@L`-T)9 M(+(@04,`"`P*-Y<@-3DT,C4L(#8P.H\@3D1!0R!(20`S#!0WBR#"*#4Y-#4V M*2"S(#$R.""G(#$T,3`P.H\@5T%)5"!$058@2$D`30P>-Y<@-3DT,C4L(#4R M.H\@3D1!0R!,3P!3#"@WC@!L##A*CR!$159)0T4@3D]4(%!215-%3E0`C0Q" F2ID@(D1%5DE#12!.3U0@4%)%4T5.5"!%4E)/4B(`DPQ,2H``````
`
end
--
Email address may be invalid. Use "fachat AT physik DOT tu-chemnitz DOT de" ------Fight SPAM - join CAUCE
http://www.cauce.org------Thanks, spammers... Andre Fachat, Institute of physics, Technische Universität Chemnitz, FRG
http://www.tu-chemnitz.de/~fachat
--
Cameron Kaiser *
ckaiser@floodgap.com * posting with a Commodore 128
Floodgap Systems:
http://www.floodgap.com/
personal page:
http://www.cameronkaiser.com/
--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)