Source Code

Loader Version ALPHA78L (BASIC)

2 WIDTH20,16,1:DEFINTH-Z:DEFSTRA-G:MA=253:GOTO6
4 WIDTH′COM0:′,255:SAVE′COM0:(68N1F)′,A:CLOSE:END
6 D1=′SunMonTueWedThuFriSat′:D2=′JanFebMarAprMayJunJulAugSepOctNovDec′
8 INPUT′Day (0=SUNDAY) ′,A:IFA=′C′THENPCOPY3ELSEIFA<>′′THENDAY=VAL(A)+1
10 DEFFNDT=MID$(D1,(DAY-1)*3+1,3)+′ ′+MID$(DATE$,4,2)+′ ′+MID$(D2,(VAL(LEFT$(DATE$,2))-1)*3+1,3)+′ ′+RIGHT$(DATE$,2)+′ ′+LEFT$(TIME$,5):DEFFN Y=A=′Y′ORA=′y′:PRINTFNDT;
12 PM=PM+1:PRINT:PRINT′SETUP Partition′;STR$(PM)
14 INPUT′Title (max 19 chars)′,A:J=LEN(A):IFJ>19THEN14ELSEIFJ=0THENIFPM=1THENA=′Order′:PRINTA ELSECLS:PM=PM-1:GOTO28
16 H$(PM)=A+SPACE$(19-LEN(A))
18 INPUT′Max lines(1:253)′,ML(PM):IFML(PM)>MA ORML(PM)<1THEN18
20 INPUT′Order Ref (Y/N)?′,A:IFFNY THENSF(PM)=8ELSESF(PM)=0
22 INPUT′Auto t/f  (Y/N)?′,A:IFFNY THENSF(PM)=SF(PM)OR1
24 INPUT′Access Code ′,SA(PM):IFSA(PM)<1000ORSA(PM)>9999THEN24
26 INPUT′Password ′,PW$(PM):IFLEN(PW$(PM))<>5THEN26ELSEIFPM<7THEN12
28 INPUT′Phone (max 16 chars)′,P$:J=LEN(P$):IFJ>16THEN28
30 INPUT′Max TOS (5:40) ′,A:TM=VAL(A):IFTM<5ORTM>40THENIFA=′′THENTM=20:GOTO34ELSE30
32 PRINT′300/1200/2400bps′:INPUT′Speed Code(2/4/5) ′,RU
34 IFPEEK(1204)-3THENPOKE127,PEEK(127)OR160
36 DEFFIL32,0:O=27*(PM+1)+50*(TM+1)
38 FORI=1TOPM:PUT%I,O,SF(I),SA(I),ML(I),PW$(I)+H$(I):O=O+12*(ML(I)+1):NEXT
40 POKE126,128:J=355:POKEJ+2,10:POKEJ+3,1:J=PEEK(J)*256+PEEK(J+1):POKEJ,51:POKE126,0
42 LPRINT′ELECTRONIC ORDER ENTRY′:LPRINT′      Configured′:LPRINT′  ′;FNDT
44 PUT%0,PM,1,TM,O,RU,CHR$(LEN(P$))+P$:CLEAR200,O:MEMSET3012:DEFINTH-Z:DEFSTRA-G
46 FORI=2640TO3011:READJ:POKEI,J:NEXTI:DEFFIL27,0:GET%0,PM,J,TM,RO,RU,P$:P$=MID$(P$,2,ASC(P$))
48 FORI=1TOPM:DEFFIL32,0:GET%I,O,SF,SA,ML,H$:DEFFIL27,0:PUT%I,O,SF,SA,0,MID$(H$,6):DEFFIL12,O:PUT%0,ML,0,0,LEFT$(H$,5):LPRINT:LPRINT′***** PARTITION′;STR$(I):LPRINTMID$(H$,6):LPRINT′Max Lines′;STR$(ML):GOSUB52:LPRINT′Access Code′;STR$(SA):NEXT
50 LPRINT:LPRINT′– ′P$:LPRINT′Max′;STR$(TM);′ TOS lines′:LPRINT′Please keep safely′:POKE127,PEEK(127)AND95:PRINT′Configured.′:IFPEEK(1204)=3THENENDELSELOAD′′,R
52 IF(8ANDSF)=8THENLPRINT′Order Ref′
54 IF(1ANDSF)=1THENLPRINT′Auto t/f′
56 RETURN
58 DATA255,10,76,238,2,238,1,255,10,78,230,7,193,65,44,44,79,141,17,128,10,42,252,139,10,39,33,79,254,10,76,111,2,167,3,57,141,0,141,0,230,0,196,15,88,193,9,35,2,192,9,27,8,230,0,196,15,27,8,57,254,10,64
60 DATA79,230,3,92,247,10,66,255,10,176,54,134,12,139,4,141,29,38,252,50,76,122,10,66,39,195,54,134,8,254,10,78,246,0,0,225,0,38,230,141,5,38,245,50,32,175,124,10,177,38,3,124,10,176,8,74,57,0,0,0,0,0,0
62 DATA0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,254,4,181,111,10,57,254,4,181,111,10,99,10,57,0,0,0,0,0,0,0,0,0,128,5,254,10,235,166,0,238,1,255,11,14,206,10,235,167,7,111,5,111,6,134,8,167,8
64 DATA182,0,0,108,36,38,2,108,35,22,132,128,168,5,167,5,104,6,105,5,36,12,166,9,168,5,167,5,166,10,168,6,167,6,23,73,106,8,38,225,106,7,38,208,238,2,134,2,167,0,134,10,167,1,134,240,167,2,57,134,18,183,10
66 DATA242,127,10,243,122,10,243,38,251,122,10,242,38,246,57,182,0,0,124,11,93,38,3,124,11,92,57,167,0,8,124,10,67,57,127,10,67,134,3,183,10,66,206,10,200,141,224,141,234,141,220,141,230,141,216,141,214,54,141,52,141,41,141
68 DATA41,141,205,132,64,68,68,68,27,51,27,141,207,122,10,68,39,5,122,10,66,38,215,254,10,235,182,10,67,167,0,134,10,167,1,134,200,167,2,57,141,0,141,164,132,15,27,141,171,141,157,72,72,72,72,22,57

Order Entry Version ALPHA78 (BASIC)

2 CLEAR256:WIDTH20,16:DEFINTH-Z:DEFSTRA-G:C=′′:A=′′:CRC=′′:HMAX=15:F1=′###′:F(0)=′#####′:F(1)=′####C′:CR=CHR$(13):CH=CHR$(1):CI=CHR$(26):CE=CHR$(4):EL=CHR$(5):BS=CHR$(8):CL=CHR$(29):CO=CHR$(22):ONERRORGOTO6:TITLE′alPHa78′:GOTO8
4 WIDTH′COM0:′,255:SAVE′COM0:(68N1F)′,A:CLOSE:END
6 IFERR=53THENSOUND20,1:RESUMEELSEONERRORGOTO0
8 DEFFNKN=C>=′0′ANDC<=′9′:DEFFNKB=C=BS ORC=CL:DEFFNKK=C=CHR$(9)ORC=CHR$(12):DEFFNU(I,J)=I*VAL(MID$(CP,J+2,1)):DEFFNCV=MID$(A,2,ASC(A))
10 E(0)=′ Q=′:E(1)=′ R=′:EP(0)=′  ′:EP(1)=′ R′:EP(2)=′C ′:EP(3)=′CR′:EC(0)=′′:EC(1)=′′:EC(2)=′C′:EC(3)=′C′
12 DEFUSR=2640:D1=′SunMonTueWedThuFriSat′:D2=′JanFebMarAprMayJunJulAugSepOctNovDec′:D(0)=′′:D(1)=′<Mod′:GH=′    PIP Code  ′:J=2795:I=VARPTR(A):GOSUB156:I=VARPTR(CRC):GOSUB156:GOSUB152:CLOSE:EXEC2787:IFPEEK(1204)=2THENPOKE125,4
14 DEFFNDT=MID$(D1,(DAY-1)*3+1,3)+′ ′+MID$(DATE$,4,2)+′ ′+MID$(D2,(VAL(LEFT$(DATE$,2))-1)*3+1,3)+′ ′+RIGHT$(DATE$,2)+′ ′+LEFT$(TIME$,5)
16 GOSUB158:CLS:PRINTH$:ST=2780:IFPEEK(ST)THEN124ELSEHD=-1:PRINTSTRING$(3,133)′‚′STRING$(15,133);:IFN>0THEN26ELSEPRINT:PRINT′   †PIP-Code   Qty′;
18 IF(8ANDSF)=0THEN32ELSEL=11:LOCATEL,0
20 PRINTCO;:C=INPUT$(1):IFFNKB THENIFL=11THEN20ELSEL=L-1:H$=LEFT$(H$,L):PRINTBS;:GOTO20
22 IFC=CR THENH$=H$+SPACE$(19-LEN(H$)):DEFFIL27,0:PUT%PC,O,SF,SA,0,H$:DEFFIL12,O:LOCATE1,2:GOTO32
24 IF(L=19)OR((ASC(C)<32)OR(ASC(C)>126))THEN20ELSEPRINTC;EL;:H$=LEFT$(H$,L)+C:L=L+1:GOTO20
26 M=N:GOSUB170:PRINT:PRINTUSINGF1;N;:PRINT′†′B;E(1ANDTF);MID$(STR$(QTY),2);EC(TF);:GOTO32
28 GOSUB152:IFHD THENHD=0:LPRINT:LPRINT′EDIT ′;H$:LPRINTFNDT:LPRINTGH′Qty′
30 GOSUB172:LPRINTUSINGF1;M;:LPRINT′ ′B;:IFI=2THENLPRINT′<Erased′ELSELPRINTUSINGF(0)+EP(TF)+D(I);QTY
32 PRINT:PRINTUSINGF1;N+1;:PRINT′†′CI;:H=CSRLIN:'Next line
34 L=0:A=STRING$(8,′0′):LOCATE4,H:PRINTEL;:IFN=MAX THEN PRINT′full!′;:LOCATE4,H
36 PRINTCO;:C=INPUT$(1):IFFNKK THENIFL=0THENIFN=0THEN36ELSE88ELSE34ELSEIFFNKB THENIFL=0THEN36ELSEL=L-1:PRINTBS;:IFL=2THENPRINTBS;:GOTO36ELSE36ELSEIFL=7THENSOUND20,1:GOTO36
38 IFL=0THENIFC=′ ′THEN48ELSEIFC=CHR$(11)THEN44
40 IFFNKN THENPRINTC;:L=L+1:MID$(A,L+1,1)=C:IFL=3THENPRINT′-′;:GOTO36ELSEIFL=7THENM=USR(VARPTR(A)):IFM>0THENCP=A:GOTO62ELSESOUND20,1:GOTO36ELSE36
42 IFL=0ORC<′A′ORC>′Z′THEN36ELSECP=′ ′+STRING$(6-L,′0′)+MID$(A,2,L)+C:IFASC(C)=65+(FNU(8,1)+FNU(6,2)+FNU(4,3)+FNU(5,4)+FNU(3,5))MOD26THENLOCATE4,H:PRINTCP;:M=USR(VARPTR(CP)):GOTO62ELSESOUND20,1:GOTO36
44 LOCATE0,H:PRINT′Partition ′EL;CO;:C=INPUT$(1):IFNOTFNKN THENIFN=0ANDC=CR THENLOCATE0,H:PRINT′Loading′EL;:A=′(68N1F)′:GOSUB166:GOTO174ELSEIFC=′!′THEN180ELSE60
46 I=VAL(C):IFI>PM OR(I=0ANDNP=0)THEN60ELSEPRINTC;:IFI=0THENPUT%0,MAX,NP,0:GOTO16ELSEPC=I:DEFFIL27,0:PUT%0,PM,PC:GOTO16
48 LOCATE0,H:PRINTFNDT;:C=INKEY$:IFC=′′THEN48ELSEIFC<>CHR$(11)THEN60
50 L=0:LOCATE14,H:A=′  :  ′:PRINTA;:LOCATE14,H
52 PRINTCO;:C=INPUT$(1):IFFNKN THENIFL=5THEN52ELSEPRINTC;:L=L+1:MID$(A,L,1)=C:IFL=2THENL=3:PRINT′:′;
54 IFFNKK THENIFL=0THEN60ELSE50ELSEIFFNKB THENIFL=0THEN52ELSEL=L-1:PRINTCL;:IFL=2THENL=1:PRINTCL;
56 IFC=CR ANDL=5THEN58ELSE52
58 IFVAL(LEFT$(A,2))>23ORVAL(RIGHT$(A,2))>59THENSOUND20,1:GOTO50ELSETIME$=A+′:00′
60 LOCATE0,H-1:GOTO32
62 IFM>N THENIFM<=MAX THEN72ELSESOUND20,1:LOCATE0,H-1:GOTO32
64 GOSUB170:A=MID$(STR$(QTY),2):L=LEN(A):'Code in use
66 LOCATE0,H:PRINTUSINGF1;M;:PRINT′Ž′B;E(1ANDTF);A;EC(TF);
68 PRINTCO;:C=INPUT$(1):IFFNKB THENIF(2ANDTF)=0THEN76ELSETF=2XORTF:L=L+1:GOTO76ELSEIFFNKK THENLOCATE0,H-1:GOTO32
70 SOUND20,1:GOTO68
72 TF=1ANDSF:L=0:A=′1′:PRINTE(TF)A;CL;:'Get Qty
74 PRINTCO;:C=INPUT$(1):IFFNKN THENIFL=4THENSOUND20,1:GOTO74ELSEPRINTC;:A=LEFT$(A,L)+C:L=L+1:GOTO74
76 IFFNKB THENIFL=0THENTF=1XORTF:LOCATE12,H:PRINTE(1ANDTF);:GOTO74ELSEL=L-1:A=LEFT$(A,L):PRINTBS;:GOTO74
78 IFFNKK THENIFL=0THENLOCATE0,H-1:GOTO32ELSELOCATE15,H:PRINTEL;:L=0:A=′′:GOTO74
80 IFC=′C′ORC=′c′ORC=CR THENQTY=VAL(A)ELSE74
82 IFQTY=0THENIFM>N THENSOUND20,1:GOTO74ELSELOCATE12,H:PRINT′Erased′EL;:N=N-1:FORI=M TON:GET%I+1,B:PUT%I,B:NEXTI:PUT%0,MAX,N:I=2:GOTO28
84 IFC<>CR THENTF=2ORTF:PRINT′C′;
86 PUT%M,QTY,TF,CP:IFM>N THENN=N+1:PUT%0,MAX,N,0:I=0:GOTO28ELSEI=1:GOTO28
88 CLS:PRINTH$:PRINT′1 Review    3 Send′:PRINT′2 Print     4 Void′:PRINT′5 Dial&Send′;:GOSUB154:IFC<′1′ORC>′5′THEN16ELSELOCATE0,1:PRINTUSINGF1;N;:PRINT′ lines′CI:ONVAL(C)GOTO90,94,102,100,104
90 PRINT′[SPACE BAR] to go œ′;:M=0
92 M=M+1:IFM>N THEN16ELSEGOSUB170:PRINT:PRINTUSINGF1;M;:PRINT′:′B;E(1ANDTF);MID$(STR$(QTY),2);EC(TF);:GOSUB154:IFC=′ ′THEN92ELSE16
94 M=0:HD=-1:PRINT:PRINT′Press [TAB] to stop′;:GOSUB150:LPRINT:LPRINT′LIST ′H$:LPRINTFNDT:LPRINTGH′Qty′
96 M=M+1:IFM>N THENLPRINT′End′:GOTO16ELSEC=INKEY$:IFFNKK THENLPRINT′***′N-M+1′ more lines′:GOTO16
98 GOSUB170:LPRINTUSING F1;M;:LPRINT′ ′B;:LPRINTUSINGF(0)+EP(TF);QTY:GOTO96
100 PRINT′Press [SHIFT]+[HOME]to erase file′;:GOSUB154:IFC=CHR$(11)THENGOSUB150:LPRINT:LPRINTH$:LPRINTFNDT:LPRINT′*** Void.′:PUT%0,MAX,0,N:GOTO16ELSE16
102 IFP$<>′′THENP$=′D′
104 LOCATE0,2:PRINT′– ′P$;EL:PRINT′Switch off to stop′EL;:GOSUB160:LOCATE0,2:PRINT′Trying to send′;EL:CA=CHR$(99)+CHR$(193):CN=CHR$(92)+CHR$(61):CW=CHR$(165)+CHR$(102):CB=STRING$(2,154):E%=0:GOSUB150
106 GOSUB142:A=′A4′+STR$(SA)+PW$:IF(8ANDSF)=8THENA=A+RIGHT$(H$,8)ELSEA=A+SPACE$(8)
108 GOSUB138:A=′′:POKE2628,N:I=R1:J=2908:GOSUB156:M=1:LOCATE0,2:PRINT′Sending line′;CHR$(5)
110 IFM<=N THENLOCATE13,2:PRINTSTR$(M);:EXEC2926:GOSUB138:M=M+3:GOTO110
112 DEFFIL50,OT:L=0:PUT%0,L:A=CHR$(0):GOSUB120:POKEST,254
114 GOSUB144:IFE%THEN122ELSEC=LEFT$(A,1):A=MID$(A,2):IFC=CE THENGOSUB120:POKEST,255:GOTO114
116 J=ASC(A):POKEST,J+1:LOCATE0,2:PRINT′Checked′;STR$(J);EL;:IFC=′ ′THEN114
118 L=L+1:LOCATE11,1:PRINTUSINGF1+′ TOS′;L;:PUT%0,L:IFL>TM THEN114ELSEPUT%L,C+A:GOTO114
120 GET%0,J:PUT%0,J,FNDT+CHR$(LEN(A))+A:RETURN
122 CLOSE:LOCATE0,2:PRINT′Done with Phone′EL
124 GOSUB150:DEFFIL50,OT:GET%0,L,A:LPRINT:LPRINT′SENT ′H$:LPRINTLEFT$(A,19):J=PEEK(ST):IFJ=254THENLPRINT′Outcome unknown′:POKEST,0:RUN
126 A=MID$(A,20):A=FNCV:IFJ=255THENLPRINTMID$(A,2)ELSELPRINT′Reply cutoff @ line′;STR$(J-1)
128 LPRINTSTR$(N)′ lines′;:J=ASC(A):IFJ THENLPRINT′,′STR$(J-1)′ TOS′;
130 I=0:LPRINT′.′:IFL>0THENLPRINTGH′Ord  TOS′
132 IFI<L ANDI<TM THENI=I+1:GET%I,A:M=ASC(MID$(A,2)):DEFFIL12,O:GOSUB170:DEFFIL50,OT:LPRINTUSINGF1;M;:LPRINT′ ′B;:LPRINTUSINGF((2ANDTF)/2);QTY;:LPRINT′ ′MID$(A,4,4)′ ′LEFT$(A,1);MID$(A,8):GOTO132
134 J=L-I:IFJ THENLPRINT′***′STR$(J)′ more TOS′
136 DEFFIL12,O:PUT%0,MAX,0,N:POKEST,0:RUN
138 EXEC2806:PRINT#2,A;CRC;:C=INPUT$(LOF(1),1):C=INPUT$(1,1):'Tx
140 C=RIGHT$(C,1)+INPUT$(1,1):IFC=CA THENSWAPCA,CN:RETURNELSEIFC=CW THENSWAPCA,CN ELSEIFC=CN THEN138ELSEIFC=CB THENRUNELSE140
142 GOSUB144:IFE%THENRETURNELSELPRINTA:GOTO142
144 J=100:PRINT#2,CN;:'Rx
146 IFEOF(1)THENIFJ THENJ=J-1:GOTO146ELSE144ELSEJ=LOF(1):EXEC2888:IFJ<LOF(1)THEN146
148 A=INPUT$(J,1):EXEC2806:IFJ>2ANDCRC=STRING$(2,0)THENSWAPCA,CN:A=LEFT$(A,J-2):E%=0:RETURNELSEIFE%THEN144ELSEIFA=CN THENE%=1:RETURNELSE144
150 IFPEEK(1204)-5THENPOKE127,PEEK(127)OR160:RETURN
152 POKE127,PEEK(127)AND95:RETURN:'print off
154 C=INKEY$:IFC=′′THEN154ELSERETURN
156 POKEJ,I\256:J=J+1:POKEJ,I MOD256:J=J+1:RETURN
158 DEFFIL27,0:GET%0,PM,PC,TM,RO,RU,A:P$=FNCV:OT=27*(PM+1):GET%PC,O,SF,SA,I,H$:J=2624:I=O+PEEK(1442)*256+PEEK(1443):GOSUB156:R1=I+12:DEFFIL12,O:GET%0,MAX,N,NP,PW$:RETURN
160 A=′(′+RIGHT$(STR$(RU),1)+′8N1F)′:IFP$=′′THENGOSUB168:RETURN
162 GOSUB168:FORI=1TO200:NEXTI:PRINT#2,′ATX0′P$;CR;
164 INPUT#1,C:LOCATE0,2:PRINTC;EL;:IFLEFT$(C,7)=′CONNECT′THENRETURNELSE164
166 GOSUB168:PRINT#2,CHR$(27);C;CHR$(13);:RETURN
168 B=′COM0:′:OPEN′O′,2,B+A:OPEN′I′,1,B:WIDTHB,255:RETURN
170 GET%M,QTY,TF,CP
172 IFRIGHT$(CP,1)>′9′THENB=CP:RETURNELSEB=MID$(CP,2,3)+′-′+RIGHT$(CP,4):RETURN
174 J=66:PRINT#2,EL;
176 IFEOF(1)THENIFJ THENJ=J-1:GOTO176ELSE174ELSEIFINPUT$(1,1)<>CHR$(2)THEN176
178 C=INPUT$(1,1):IFFNKN THENTF=ASC(C)AND3:A=INPUT$(8,1):QTY=VAL(INPUT$(5,1)):N=N+1:PUT%N,QTY,TF,A:PUT%0,MAX,N,0:LOCATE8,H:PRINTN;:PRINT#2,CHR$(6);:GOTO178ELSEIFC=CHR$(3)THENRUNELSE178
180 CLS:PRINT′300/1200/2400bps′:DEFFIL27,0:INPUT′Speed Code(2/4/5) ′,RU:PUT%0,PM,PC,TM,RO,RU
182 PRINTP$:INPUT′Phone ′,P$:L=LEN(P$):IFL>16THEN182ELSEPUT%0,PM,PC,TM,RO,RU,CHR$(L)+P$:DEFFIL12,O
184 PRINTSA:INPUT′Access Code ′,SA:IFSA<1000ORSA>9999THEN180
186 INPUT′Password ′,PW$:IFLEN(PW$)<>5THEN184
188 PUT%0,MAX,N,NP,PW$:DEFFIL27,0:PUT%PC,O,SF,SA:RUN

Utilities (6301 Assembler)

; HX20 subroutine to validate Check Digit & search for matching PIP Code
; To call from BASIC--
;	M% = USR( VARPTR( PIP$ )) where PIP$ holds 6 digits in ASCII
; On return M = 0 if the Check Digit is incorrect
;	      = Next Record Number if no match found
;	      = Record Number containing PIP$ if match found
; NOTE: The address of the first byte of record 0 of the RAM file must
;	be placed in A40 before calling this subroutine.
;	Maximum number of records is 254.
A40		ds	2	; Preset -> RAM File Origin
A42		ds	1	; Loop Counter
A43		ds	1	; w/s Tx String Length 
A44		ds	1	; w/s Tx Record counter
A4C		ds	2	; -> HX20 BASIC WORKSPACE
A4E		ds	2	; -> PIP$
; *** Entry Point USR0 ***
A50 FF 0A 4C	stx	0A4C	; Save Index Register
A53 EE 02	ldx	x.2	; -> DOPE VECTOR(PIP$)
A55 EE 01	ldx	x.1	; -> PIP$
A57 FF 0A 4E	stx	0A4E
; Bypass check digit verification if not a PIP Code--
A5A E6 05	lda	b,x.5
A5C C1 41	cmp	b,='A'
A5E 2C 2C	bge	0A8C	; 6th byte not numeric
; Verify check digit--
A60 4F		clr	a
A61 8D 15	bsr	0A78
A63 8D 13	bsr	0A78
A65 8D 11	bsr	0A78
; Divide sum of digits by ten & test remainder--
A67 80 0A	sub	a,=0A
A69 2A FC	bpl	0A67
A6B 8B 0A	add	a,=0A
A6D 27 1D	beq	0A8C	; Check Digit is correct
A6F 4F		clr	a
; Setup result & return--
A70 FE 0A 4C	ldx	0A4C	; -> Basic Workspace
A73 6F 02	clr	x.2
A75 A7 03	sta	a,x.3
A77 39		rts
; Subroutine to process next two bytes of PIP$--
A78 E6 00	lda	b,X.0	; Next Character
A7A C4 0F	and	b,=0F	; Convert to Binary
A7C 58		asl	b	;  x2
A7D C1 09	cmp	b,=09
A7F 23 02	bls	0A83
A81 C0 09	sub	b,=09
A83 1B		aba
A84 08		inx
A85 E6 00	lda	b,X.0	; Next Character
A87 C4 0F	and	b,=0F	; Convert to Binary
A89 1B		aba
A8A 08		inx
A8B 39		rts
; Search RAM File for PIP$--
A8C FE 0A 40	ldx	0A40	; -> RAM File origin
A8F 4F		clr	a	; M=0
A90 E6 03	lda	b,x.3	; N
A92 5C		inc	b
A93 F7 0A 42	sta	b,0A42	; Loop Counter=N+1
A96 FF 0A B0	stx	0AB0	; pointer
A99 36		psh	a
A9A 86 0A	lda	a,=0a
A9C 8B 04	add	a,4
A9E 8D 1D	bsr	0ABD	; advance pointer
AA0 26 FC	bne	0A9E
AA2 32		pul	a
AA3 4C		inc	a	; M=M+1
AA4 7A 0A 42	dec	0A42
AA7 27 C7	beq	0A70	; end of RAM file
AA9 36		psh	a
AAA 86 06	lda	a,=6	; counter=6 bytes
AAC FE 0A 4E	ldx	0A4E	; -> PIP$
AAF F6 00 00	lda	b,xxxx	; Next RAM file byte
AB2 E1 00	cmp	b,x.0
AB4 26 E6	bne	0A9C	; to next RAM file record
AB6 8D 05	bsr	0ABD	; advance pointer
AB8 26 F5	bne	0AAF	; test next byte
; Match found--
ABA 32		pul	a	; M
ABB 20 B3	bra	0A70
; Subroutine to advance pointer--
ABD 7C 0A B1	inc	0AB1	; Low Order Byte
AC0 26 03	bne	0AC5
AC2 7C 0A B0	inc	0AB0	; High Order Byte
AC5 08		inx
AC6 4A		dec	a
AC7 39		rts
AC8		ds	14h	; Tx Buffer
ADC		ds	1	; System Status:
				;   0	  = Normal
				;   1:253 = Tx Done, Rx Busy
				;   254   = Tx Done, waiting for Rx
				;   255   = Tx Done, Rx Done
; *** Entry Point EXEC 2781 *** Remove Program Protection
ADD FE 04 B5	ldx	04B5
AE0 6F 0A	clr	x.10
AE2 39		rts
; *** Entry Point EXEC 2787 *** Apply Program Protection
AE3 FE 04 B5	ldx	04B5
AE6 6F 0A	clr	x.10
AE8 63 0A	com	x.10
AEA 39		rts
AEB		ds	2	; Preset -> VARPTR(A)
AED		ds	2	; Preset -> VARPTR(CRC)
AEF		ds	1	; spare (MSG line count)
AF0		ds	2	; w/s: CRC Accumulator
AF2		ds	1	; w/s: Byte Counter
AF3		ds	1	; w/s: Bit Counter
AF4		dw	8005h	; Generating Polynomial
; *** Entry Point EXEC 2806 *** Calculate CRC of string A
AF6 FE 0A EB	ldx	0AEB	; -> Dope Vector(A)
AF9 A6 00	lda	a,x.0	; =LEN(A)
AFB EE 01	ldx	x.1	; -> A
AFD FF 0B 0E	stx	0B0E	; Initialize Pointer
B00 CE 0A EB	ldx	=0AEB	; Setup Index Base
B03 A7 07	sta	a,x.7	; Initialize Byte Counter
B05 6F 05	clr	x.5
B07 6F 06	clr	x.6	; Clear CRC workspace
; Process next byte--
B09 86 08	lda	a,=8
B0B A7 08	sta	a,x.8	; Initialize Bit Counter
B0D B6 xx xx	lda	a,xxxx	; Pickup next byte
B10 6C 24	inc	x.24	; increment pointer (low order byte)
B12 26 02	bne	0B16
B14 6C 23	inc	x.23	; increment pointer (high order byte)
; Process next bit--
B16 16		tab		; save data byte in Reg B
B17 84 80	and	a,=80h
B19 A8 05	eor	a,x.5
B1B A7 05	sta	a,x.5
B1D 68 06	asl	x.6	; left shift CRC low order byte
B1F 69 05	rol	x.5	; left rotate CRC high order byte
B21 24 0C	bcc	0B2F
B23 A6 09	lda	a,x.9
B25 A8 05	eor	a,x.5
B27 A7 05	sta	a,x.5
B29 A6 0A	lda	a,x.a
B2B A8 06	eor	a,x.6
B2D A7 06	sta	a,x.6
B2F 17		tba		; recover data byte
B30 49		rol	a	; rotate left
B31 6A 08	dec	x.8	; Bit Counter
B33 26 E1	bne	0B16	; onto next bit
B35 6A 07	dec	x.7	; Byte Counter
B37 26 D0	bne	0B09	; onto next byte
; Setup CRC Target--
B39 EE 02	ldx	x.2	; -> Dope Vector(CRC)
B3B 86 02	lda	a,=2
B3D A7 00	sta	a,x.0	; Length=2
B3F 86 0A	lda	a,=0Ah
B41 A7 01	sta	a,x.1	; String Address high order byte
B43 86 F0	lda	a,=F0h
B45 A7 02	sta	a,x.2	; String Address low order byte
B47 39		rts
; *** Entry Point EXEC 2888 *** Delay Loop
B48 86 12	lda	a,=12h	; 2 char interval at 300 baud
B4A B7 0A F2	sta	a,0AF2
B4D 7F 0A F3	clr	0AF3
B50 7A 0A F3	dec	0AF3	; inner loop = 3.77msec
B53 26 FB	bne	0B50
B55 7A 0A F2	dec	0AF2
B58 26 F6	bne	0B50
B5A 39		rts
; Subroutine: RAM Byte -> A
B5B B6 00 00	lda	a,xxxx
B5E 7C 0B 5D	inc	0B5D	; Low Order Byte
B61 26 03	bne	0B66
B63 7C 0B 5C	inc	0B5C	; Low Order Byte
B66 39		rts
; Subroutine: A -> buffer
B67 A7 00	sta	a,x.0
B69 08		inx
B6A 7C 0A 43	inc	0A43	; byte count
B6D 39		rts
; *** Entry Point EXEC 2926 *** Setup next Tx Buffer
B6E 7F 0A 43	clr	0A43	; byte count
B71 86 04	lda	a,=4	; 4 records per Tx block
B73 B7 0A 42	sta	a,0A42	; loop counter
B76 CE 0A C8	ldx	=0AC8	; -> Tx Buffer
; Pack next record into 5 bytes--
B79 8D E0	bsr	0B5B	; Qty 1st byte
B7B 8D EA	bsr	0B67
B7D 8D DC	bsr	0B5B	; Qty 2nd byte
B7F 8D E6	bsr	0B67
B81 8D D8	bsr	0B5B	; TF 1st byte
B83 8D D6	bsr	0B5B	; TF 2nd byte
B85 36		psh	a
B86 8D 32	bsr	0BBA	; PIP Code 1st byte
B88 8D 29	bsr	0BB3	; PIP Code 2nd & 3rd bytes
B8A 8D 27	bsr	0BB3	; PIP Code 4th & 5th bytes
B8C 8D CD	bsr	0B5B	; PIP Code 6th byte
B8E 84 40	and	a,=40
B90 44		lsr	a
B91 44		lsr	a
B92 44		lsr	a
B93 1B		aba
B94 33		pul	b
B95 1B		aba
B96 8D CF	bsr	0B67
B98 7A 0A 44	dec	0A44	; record count
B9B 27 05	beq	0BA2	; all N records done
B9D 7A 0A 42	dec	0A42
BA0 26 D7	bne	0B79	; pack next record
; Setup Dope Vector(A) & return--
BA2 FE 0A EB	ldx	0AEB	; -> Dope Vector(A)
BA5 B6 0A 43	lda	a,0A43
BA8 A7 00	sta	a,x.0	; Length
BAA 86 0A	lda	a,=0A
BAC A7 01	sta	a,x.1
BAE 86 C8	lda	a,=C8
BB0 A7 02	sta	a,x.2
BB2 39		rts
; Pickup & pack next two RAM bytes--
BB3 8D A6	bsr	0B5B	; next byte -> A
BB5 84 0F	and	a,=0f
BB7 1B		aba
BB8 8D AD	bsr	0B67	; 2 digits into Tx buffer
; Pack next RAM byte into top of B--
BBA 8D 9F	bsr	0B5B	; next byte -> A
BBC 48		asl	a
BBD 48		asl	a
BBE 48		asl	a
BBF 48		asl	a
BC0 16		tab
BC1 39		rts
BC2		end

The HX20 Archive

HRS Bulletin December 1985

Philip Harris alPHa brochure