• One From The Vault: PET IEEE code in BASIC (ASCII PROGRAM LISTING)

    From Cameron Kaiser@21:1/5 to All on Mon Jan 11 18:40:02 2021
    ******************************************************************
    *** ***
    *** 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)