10 REM > xs/s v1.10 15-Feb-1990
   20 REM Short Checksums
   30 REM (c) The Micro User
   40 REM v1.00 01-Feb 1988 by Steve Turnbull
   50 REM v1.10 15-Feb 1990 by J.G.Harston
   60 REM Runable on either side of Tube
   70 REM
   80 PROCinit:PROCassemble
   90 A$="*SAVE xs "+STR$~mcode%+" "+STR$~O%+" "+STR$~exec%+" "+STR$~load%
  100 IFwarn%:P%=&480:P%=FNwarn ELSE PRINTA$;:OSCLIA$:PRINT
  110 END
  120 DEFPROCinit
  130 DIM mcode% &400
  140 load%=&404
  150 warn%=0
  160 newl=&FFE7:wrch=&FFEE:byte=&FFF4
  170 rem=&F4:return=13:spc=32
  180 qts=ASC"""":colon=ASC":"
  190 comma=ASC",":Lbrk=ASC"["
  200 rbrk=ASC"]":mcom=ASC"\"
  210 Lcrc=&70:ocrc=&72:wcrc=&74
  220 Lptr=&76:crcptr=&78:Lnum=&7A
  230 LLen=&7C:Ltmp=&7D:txtptr=&7E
  240 nmbase=&80:Lonum=&81:hinum=&82
  250 Lowrk=&83:hiwrk=&84:qflg=&85
  260 codeflg=&86:savebyt=&87
  270 fldsize=&88:zflg=&89:Lend=&8A
  280 escflg=&FF:ENDPROC
  290 DEFPROCassemble
  300 FOR L%=4 TO 7 STEP 3
  310 P%=load%:O%=mcode%
  320 [OPT L%
  330 .exec%
  340  JMP check:BRK:BRK:BRK    \ Header identifies
  350  EQUB &42:EQUB copy-exec% \ this as 6502 code
  360  EQUB &10:EQUS "xs"
  370  EQUB &00:EQUS "1.10 (15 Feb 1990)"
  380 .copy
  390  EQUB 0:EQUS"(C)":EQUB 0
  400 .check
  410  JSR checkbasic
  420  LDA #0:STA codeflg:STA ocrc
  430  STA ocrc+1:STA Lptr
  440  LDA &18:STA Lptr+1
  450 .while BIT escflg:BMI escape
  460  LDY #1:LDA (Lptr),Y:BPL doline
  470  \ Termination code must not be in &480-&4FF
  480 .wayout
  490  LDA #end AND 255:STA &0B
  500  LDA #end DIV 256:STA &0C
  510  LDA #0:STA &0A   :\ ptra=><cr><endmarker>
  520  LDX #&7F
  530  OPT FNwarn
  540 .clearlp
  550  STA &480,X
  560  DEX:BPL clearlp  :\ Clear variables
  570  LDA &00:STA &02
  580  LDA &01:STA &03  :\ VARTOP=LOMEM
  590  RTS
  600 .end
  610  EQUB 13:EQUB &FF :\ <cr><endmarker>
  620 .escape
  630  JSR wayout:BRK:EQUB 17:EQUS "Escape":BRK
  640 .bad
  650  JSR wayout:BRK:BRK:EQUS "Bad program":BRK
  660  OPT FNwarn
  670 .rdbyte LDX #0:LDY #255:JSR byte:TXA:AND #63
  680 .ok RTS
  690 .checkbasic
  700  LDA #187:JSR rdbyte:STA Lptr
  710  LDA #252:JSR rdbyte:CMP Lptr:BEQ ok
  720  BRK:EQUB 249:EQUS "Not in BASIC":BRK
  730 .doline LDA #0:STA Lcrc:STA Lcrc+1
  740  STA qflg:TAY:LDA (Lptr),Y
  750  CMP #&0D:BNE bad:INY:LDA (Lptr),Y
  760  STA Lnum+1:INY:LDA (Lptr),Y
  770  STA Lnum:INY:LDA (Lptr),Y
  780  STA Lend:JSR prescan:CPY #5
  790  BCC display:LDY #4
  800 .skipspc LDA (Lptr),Y:CMP #spc
  810  BNE scan:INY:CPY LLen
  820  BEQ display:BNE skipspc
  830 .scan LDA (Lptr),Y:JSR dobyte
  840  INY:CPY LLen:BCC scan
  850 .display:LDX Lnum:LDY Lnum+1
  860  JSR pdec:LDA #spc:JSR wrch
  870  LDA #ASC"=":JSR wrch:LDA #spc
  880  JSR wrch:LDX Lcrc:LDY Lcrc+1
  890  JSR phex:LDA ocrc:JSR lastchk
  900  LDY LLen:CPY Lend:BEQ newline
  910  LDA #ASC"*":JSR wrch
  920 .newline JSR newl
  930 .update CLC:LDA Lptr:ADC Lend
  940  STA Lptr:BCC unwhile:INC Lptr+1
  950 .unwhile JMP while
  960 .prescan LDY Lend
  970 .psLoop DEY:LDA (Lptr),Y:CMP #spc
  980  BEQ psLoop:INY:STY LLen:RTS
  990 .dobyte STA savebyt:CMP #qts
 1000  BNE notqe:PHA:LDA qflg:EOR #&FF
 1010  STA qflg:PLA
 1020 .notqe BIT qflg:BMI skpcode
 1030  BIT codeflg:BMI jcode
 1040  JSR basic:JMP skpcode
 1050 .jcode JSR mcode
 1060 .skpcode LDA savebyt:CPY LLen
 1070  BEQ skipcrc:STY Ltmp:LDX Lcrc
 1080  LDY Lcrc+1:JSR docrc:STX Lcrc
 1090  STY Lcrc+1:LDX ocrc:LDY ocrc+1
 1100  JSR docrc:STX ocrc:STY ocrc+1
 1110  LDY Ltmp:.skipcrc RTS
 1120 .basic CMP #rem:BEQ skpline
 1130  CMP #Lbrk:BNE xbasic:LDA #&FF
 1140  STA codeflg:RTS
 1150 .skpline LDY LLen:.xbasic RTS
 1160 .mcode CMP #mcom:BEQ skipcom
 1170  CMP #rbrk:BNE xmcode:LDA #0
 1180  STA codeflg:.xmcode RTS
 1190 .skipcom LDA qflg:PHA:LDA #0
 1200  STA qflg
 1210 .skpLoop INY:LDA (Lptr),Y:CMP #qts
 1220  BNE skpchk:PHA:LDA qflg:EOR #&FF
 1230  STA qflg:PLA
 1240 .skpchk CPY LLen:BEQ skpexit
 1250  CMP #colon:BNE skpLoop:BIT qflg
 1260  BMI skpLoop
 1270 .skpexit PLA:STA qflg:LDA (Lptr),Y
 1280  STA savebyt:RTS
 1290 .docrc PHA:STX wcrc:STY wcrc+1
 1300  EOR wcrc+1:STA wcrc+1:LDX #7
 1310 .crclp BIT wcrc+1:CLC:BPL crcskp
 1320  LDA wcrc:EOR #&10:STA wcrc
 1330  LDA wcrc+1:EOR #&08:STA wcrc+1
 1340  SEC
 1350 .crcskp ROL wcrc:ROL wcrc+1:DEX
 1360  BPL crclp:LDX wcrc:LDY wcrc+1
 1370  PLA:RTS
 1380 .lastchk PHA:LDA #spc:JSR wrch
 1390  PLA:AND #&0F:TAX:LDA #&FF:PHA
 1400  TXA:JMP notz:.pdec LDA #10
 1410  BNE pnum:.phex LDA #16
 1420 .pnum STX Lonum:STY hinum
 1430  STA nmbase:LDA #4:STA fldsize
 1440  LDA #255:STA zflg
 1450 .nbit PHA:LDA #0:STA Lowrk
 1460  STA hiwrk:LDX #16
 1470 .next ASL Lonum:ROL hinum
 1480  ROL Lowrk:ROL hiwrk:LDA Lowrk:SEC
 1490  SBC nmbase:TAY:LDA hiwrk:SBC #0
 1500  BCC done:INC Lonum:STY Lowrk
 1510  STA hiwrk:.done DEX:BNE next
 1520  LDA Lowrk:DEC fldsize:BNE nbit
 1530 .out TAX:BNE notz:PLA:PHA:PHP:TXA
 1540  PLP:BMI notz:BIT zflg:BPL notz
 1550  LDA #spc:BNE digout
 1560 .notz LDX #0:STX zflg:CMP #10
 1570  BCC add:ADC #6:.add ADC #48
 1580 .digout JSR wrch:PLA:BPL out
 1590 .exit RTS
 1600 ]:NEXT:ENDPROC
 1610 DEFFNwarn:IFL%AND3:IFP%>&47F:IFP%<&500:PRINT"**** Warning: code overwritten on exit":warn%=warn%+1
 1620 =L%