9640 and 99/4A Assembler
                                                    Page 0001
0001                 *c99 x-optimizer v1.2/g
0002 0000   0000      REF XPOLL,XGETS,XPUTC,XPUTS,XDPUTS
0002 0000   0000      
0002 0000   0000      
0002 0000   0000      
0002 0000   0000      
0003 0000   0000      REF XLOCAT,XTSCRN
0003 0000   0000      
0004 0000   0000      REF XMSET,XMMOV,XMCPY,XSLEN,XSCHR
0004 0000   0000      
0004 0000   0000      
0004 0000   0000      
0004 0000   0000      
0005 0000   0000      REF XSCAT,XSCPY,XSNCPY,XSCMP,XSNCMP
0005 0000   0000      
0005 0000   0000      
0005 0000   0000      
0005 0000   0000      
0006 0000   0000      REF XVWTR,XVSBW,XVMBR,XVMBW
0006 0000   0000      
0006 0000   0000      
0006 0000   0000      
0007                 *c99 optimizer v4.3/g
0008                 *c99 v4.0 (c) 1985, 1987 Clint Pulley
0009 0000   0000      REF C$CIND,C$DIV,C$REM,C$ASR,C$ASL,C$EQ,C$NE,C$LT,C$LE
0009 0000   0000      
0009 0000   0000      
0009 0000   0000      
0009 0000   0000      
0009 0000   0000      
0009 0000   0000      
0009 0000   0000      
0009 0000   0000      
0010 0000   0000      REF C$GT,C$GE,C$ULT,C$ULE,C$UGT,C$UGE,C$LNEG,C$SWCH
0010 0000   0000      
0010 0000   0000      
0010 0000   0000      
0010 0000   0000      
0010 0000   0000      
0010 0000   0000      
0010 0000   0000      
0011 0000   0000      REF GETCHA,GETS,PUTCHA,PUTS,LOCATE,POLL,TSCRN,EXIT,C$CALL
0011 0000   0000      
0011 0000   0000      
0011 0000   0000      
0011 0000   0000      
0011 0000   0000      
0011 0000   0000      
0011 0000   0000      
0011 0000   0000      
0012                 */* DAY OF WEEK
0013                 ***
0014                 *** EXAMPLE TO TEST THE X-COMPILER/ASSEMBLER AND LINKER
0015                 *** FOR EM6809W AND THE TI99/4A
0016                 ***
0017                 *** FROM THE BOOK: "FLITSEND FORTH"
0018                 *** TRANSFORMED FROM FORTH TO C
0019                 **/
0020                 *
0021                 *int  daytable[12] = {31,28,31,30,31,30,31,31,30,31,30,31};
0022                 DAYTAB
0023 0000   001F      DATA 31,28,31,30,31,30,31,31
0023 0002   001C      
0023 0004   001F      
0023 0006   001E      
0023 0008   001F      
0023 000A   001E      
0023 000C   001F      
0023 000E   001F      
0024 0010   001E      DATA 30,31,30,31
0024 0012   001F      
0024 0014   001E      
0024 0016   001F      
0025                 *
0026                 *char *monthtable[12] =
9640 and 99/4A Assembler
                                                    Page 0002
0027                 MONTHT
0028                 *{
0029                 * "Januari",   "Februari", "March",    "April",
0030 0018   0030'     DATA C$2
0031 001A   0038'     DATA C$2+8
0032 001C   0041'     DATA C$2+17
0033 001E   0047'     DATA C$2+23
0034                 * "May",       "June",     "July",     "August",
0035 0020   004D'     DATA C$2+29
0036 0022   0051'     DATA C$2+33
0037 0024   0056'     DATA C$2+38
0038 0026   005B'     DATA C$2+43
0039                 * "September", "Oktober",  "November", "December"
0040 0028   0062'     DATA C$2+50
0041 002A   006C'     DATA C$2+60
0042 002C   0074'     DATA C$2+68
0043 002E   007D'     DATA C$2+77
0044                 *};
0045                 C$2
0046 0030   004A      BYTE 74,97,110,117,97,114,105,0,70,101,98,114
0047 003C   0075      BYTE 117,97,114,105,0,77,97,114,99,104,0,65
0048 0048   0070      BYTE 112,114,105,108,0,77,97,121,0,74,117,110
0049 0054   0065      BYTE 101,0,74,117,108,121,0,65,117,103,117,115
0050 0060   0074      BYTE 116,0,83,101,112,116,101,109,98,101,114,0
0051 006C   004F      BYTE 79,107,116,111,98,101,114,0,78,111,118,101
0052 0078   006D      BYTE 109,98,101,114,0,68,101,99,101,109,98,101
0053 0084   0072      BYTE 114,0
0054                  EVEN
0055                 *
0056                 *main()
0057 0086   0086      DEF MAIN
0058                 MAIN
0059                 *{
0060                 *
0061                 *int c;
0062                 *
0063                 *  do
0064 0086   064E      DECT 14
0065                 C$6
0066                 *  {
0067                 *    dow();
0068 0088   069C      BL *12
0069 008A   0138'     DATA DOW
0070                 *
0071                 *    puts("\n\n\n\n");
0072 008C   0205      LI 5,C$3
0072 008E   00F6'     
0073 0090   069C      BL *12
0074 0092   0000      DATA XPUTS
0075                 *    puts("PRESS <ENTER> TO \n");
0076 0094   0205      LI 5,C$3+5
0076 0096   00FB'     
0077 0098   069C      BL *12
0078 009A   0092'     DATA XPUTS
0079                 *    puts("INPUT A NEW DATE\n");
0080 009C   0205      LI 5,C$3+24
0080 009E   010E'     
0081 00A0   069C      BL *12
0082 00A2   009A'     DATA XPUTS
0083                 *    puts("PRESS <X> TO STOP\n");
0084 00A4   0205      LI 5,C$3+42
0084 00A6   0120'     
0085 00A8   069C      BL *12
0086 00AA   00A2'     DATA XPUTS
0087                 *
0088                 *    while(1)
0089                 C$7
0090                 *    {
0091                 *      if((c=poll(0))!=0) break;
0092 00AC   C20E      MOV 14,8
0093 00AE   068F      BL 15
0094 00B0   6208      S 8,8
0095 00B2   068F      BL 15
0096 00B4   069C      BL *12
0097 00B6   0000      DATA POLL
9640 and 99/4A Assembler
                                                    Page 0003
0098 00B8   05CE      INCT 14
0099 00BA   C27E      MOV *14+,9
0100 00BC   C648      MOV 8,*9
0101 00BE   068F      BL 15
0102 00C0   6208      S 8,8
0103 00C2   06A0      BL @C$NE
0103 00C4   0000      
0104 00C6   1602      JNE $+6
0105 00C8   0460      B @C$9
0105 00CA   00D0'     
0106 00CC   0460      B @C$8
0106 00CE   00D4'     
0107                 *    }
0108                 C$9
0109 00D0   0460      B @C$7
0109 00D2   00AC'     
0110                 C$8
0111                 *    puts("\n\n\n\n");
0112 00D4   0205      LI 5,C$3+61
0112 00D6   0133'     
0113 00D8   069C      BL *12
0114 00DA   00AA'     DATA XPUTS
0115                 *  }
0116                 *  while (c != 'X');
0117                 C$4
0118 00DC   C21E      MOV *14,8
0119 00DE   068F      BL 15
0120 00E0   0208      LI 8,88
0120 00E2   0058      
0121 00E4   06A0      BL @C$NE
0121 00E6   00C4'     
0122 00E8   1602      JNE $+6
0123 00EA   0460      B @C$5
0123 00EC   00F2'     
0124 00EE   0460      B @C$6
0124 00F0   0088'     
0125                 C$5
0126                 *}
0127 00F2   05CE      INCT 14
0128 00F4   045D      B *13
0129 00F6   000A     C$3 BYTE 10,10,10,10,0,80,82,69,83,83,32,60
0130 0102   0045      BYTE 69,78,84,69,82,62,32,84,79,32,10,0
0131 010E   0049      BYTE 73,78,80,85,84,32,65,32,78,69,87,32
0132 011A   0044      BYTE 68,65,84,69,10,0,80,82,69,83,83,32
0133 0126   003C      BYTE 60,88,62,32,84,79,32,83,84,79,80,10
0134 0132   0000      BYTE 0,10,10,10,10,0
0135                  EVEN
0136                 *
0137                 */* Calculate Day Of Week */
0138                 *dow()
0139                 DOW
0140                 *{
0141                 *int month, year, day;
0142                 *
0143                 *  while(1)
0144 0138   022E      AI 14,-6
0144 013A   FFFA      
0145                 C$11
0146                 *  {
0147                 *    puts("ENTR DAY OF MONTH (1-31)\n");
0148 013C   0205      LI 5,C$10
0148 013E   02C0'     
0149 0140   069C      BL *12
0150 0142   00DA'     DATA XPUTS
0151                 *    day=getint();
0152 0144   C20E      MOV 14,8
0153 0146   068F      BL 15
0154 0148   069C      BL *12
0155 014A   0352'     DATA GETINT
0156 014C   C27E      MOV *14+,9
0157 014E   C648      MOV 8,*9
0158                 *    if((day>=1)&&(day<=31)) break;
0159 0150   C21E      MOV *14,8
0160 0152   068F      BL 15
0161 0154   0208      LI 8,1
9640 and 99/4A Assembler
                                                    Page 0004
0161 0156   0001      
0162 0158   06A0      BL @C$GE
0162 015A   0000      
0163 015C   1602      JNE $+6
0164 015E   0460      B @C$14
0164 0160   0170'     
0165 0162   C21E      MOV *14,8
0166 0164   068F      BL 15
0167 0166   0208      LI 8,31
0167 0168   001F      
0168 016A   06A0      BL @C$LE
0168 016C   0000      
0169 016E   1602      JNE $+6
0170                 C$14
0171 0170   0460      B @C$13
0171 0172   0178'     
0172 0174   0460      B @C$12
0172 0176   017C'     
0173                 *  }
0174                 C$13
0175 0178   0460      B @C$11
0175 017A   013C'     
0176                 C$12
0177                 *  while(1)
0178                 C$15
0179                 *  {
0180                 *    puts("\n\nENTER MONTH (1-12)\n");
0181 017C   0205      LI 5,C$10+26
0181 017E   02DA'     
0182 0180   069C      BL *12
0183 0182   0142'     DATA XPUTS
0184                 *    month=getint();
0185 0184   C20E      MOV 14,8
0186 0186   0228      AI 8,4
0186 0188   0004      
0187 018A   068F      BL 15
0188 018C   069C      BL *12
0189 018E   0352'     DATA GETINT
0190 0190   C27E      MOV *14+,9
0191 0192   C648      MOV 8,*9
0192                 *    if((month>=1)&&(month<=12)) break;
0193 0194   C22E      MOV @4(14),8
0193 0196   0004      
0194 0198   068F      BL 15
0195 019A   0208      LI 8,1
0195 019C   0001      
0196 019E   06A0      BL @C$GE
0196 01A0   015A'     
0197 01A2   1602      JNE $+6
0198 01A4   0460      B @C$18
0198 01A6   01B8'     
0199 01A8   C22E      MOV @4(14),8
0199 01AA   0004      
0200 01AC   068F      BL 15
0201 01AE   0208      LI 8,12
0201 01B0   000C      
0202 01B2   06A0      BL @C$LE
0202 01B4   016C'     
0203 01B6   1602      JNE $+6
0204                 C$18
0205 01B8   0460      B @C$17
0205 01BA   01C0'     
0206 01BC   0460      B @C$16
0206 01BE   01C4'     
0207                 *  }
0208                 C$17
0209 01C0   0460      B @C$15
0209 01C2   017C'     
0210                 C$16
0211                 *  while(1)
0212                 C$19
0213                 *  {
0214                 *    puts("\n\nENTER YEAR (1582-DOOMSDAY)\n");
0215 01C4   0205      LI 5,C$10+48
0215 01C6   02F0'     
9640 and 99/4A Assembler
                                                    Page 0005
0216 01C8   069C      BL *12
0217 01CA   0182'     DATA XPUTS
0218                 *    year=getint();
0219 01CC   C20E      MOV 14,8
0220 01CE   05C8      INCT 8
0221 01D0   068F      BL 15
0222 01D2   069C      BL *12
0223 01D4   0352'     DATA GETINT
0224 01D6   C27E      MOV *14+,9
0225 01D8   C648      MOV 8,*9
0226                 *    if(year>=1582) break;
0227 01DA   C22E      MOV @2(14),8
0227 01DC   0002      
0228 01DE   068F      BL 15
0229 01E0   0208      LI 8,1582
0229 01E2   062E      
0230 01E4   06A0      BL @C$GE
0230 01E6   01A0'     
0231 01E8   1602      JNE $+6
0232 01EA   0460      B @C$21
0232 01EC   01F2'     
0233 01EE   0460      B @C$20
0233 01F0   01F6'     
0234                 *  }
0235                 C$21
0236 01F2   0460      B @C$19
0236 01F4   01C4'     
0237                 C$20
0238                 *  puts("\n\n\n\n");
0239 01F6   0205      LI 5,C$10+78
0239 01F8   030E'     
0240 01FA   069C      BL *12
0241 01FC   01CA'     DATA XPUTS
0242                 *
0243                 *  day = (jan1(year)+days(day,month,year))%7;
0244 01FE   C20E      MOV 14,8
0245 0200   068F      BL 15
0246 0202   C22E      MOV @4(14),8
0246 0204   0004      
0247 0206   068F      BL 15
0248 0208   069C      BL *12
0249 020A   0452'     DATA JAN1
0250 020C   05CE      INCT 14
0251 020E   068F      BL 15
0252 0210   C22E      MOV @4(14),8
0252 0212   0004      
0253 0214   068F      BL 15
0254 0216   C22E      MOV @10(14),8
0254 0218   000A      
0255 021A   068F      BL 15
0256 021C   C22E      MOV @10(14),8
0256 021E   000A      
0257 0220   068F      BL 15
0258 0222   069C      BL *12
0259 0224   055E'     DATA DAYS
0260 0226   022E      AI 14,6
0260 0228   0006      
0261 022A   A23E      A *14+,8
0262 022C   068F      BL 15
0263 022E   0208      LI 8,7
0263 0230   0007      
0264 0232   06A0      BL @C$REM
0264 0234   0000      
0265 0236   C27E      MOV *14+,9
0266 0238   C648      MOV 8,*9
0267                 *
0268                 *  switch(day)
0269 023A   C21E      MOV *14,8
0270 023C   0460      B @C$24
0270 023E   0298'     
0271                 *  {
0272                 *    case 0: puts("SUNDAY\n");   break;
0273                 C$25
0274 0240   0205      LI 5,C$10+83
0274 0242   0313'     
9640 and 99/4A Assembler
                                                    Page 0006
0275 0244   069C      BL *12
0276 0246   01FC'     DATA XPUTS
0277 0248   0460      B @C$23
0277 024A   02BA'     
0278                 *    case 1: puts("MONDAY\n");   break;
0279                 C$26
0280 024C   0205      LI 5,C$10+91
0280 024E   031B'     
0281 0250   069C      BL *12
0282 0252   0246'     DATA XPUTS
0283 0254   0460      B @C$23
0283 0256   02BA'     
0284                 *    case 2: puts("TUESDAY\n");  break;
0285                 C$27
0286 0258   0205      LI 5,C$10+99
0286 025A   0323'     
0287 025C   069C      BL *12
0288 025E   0252'     DATA XPUTS
0289 0260   0460      B @C$23
0289 0262   02BA'     
0290                 *    case 3: puts("WEDNESDAY\n");break;
0291                 C$28
0292 0264   0205      LI 5,C$10+108
0292 0266   032C'     
0293 0268   069C      BL *12
0294 026A   025E'     DATA XPUTS
0295 026C   0460      B @C$23
0295 026E   02BA'     
0296                 *    case 4: puts("THURSAY\n");  break;
0297                 C$29
0298 0270   0205      LI 5,C$10+119
0298 0272   0337'     
0299 0274   069C      BL *12
0300 0276   026A'     DATA XPUTS
0301 0278   0460      B @C$23
0301 027A   02BA'     
0302                 *    case 5: puts("FRIDAY\n");   break;
0303                 C$30
0304 027C   0205      LI 5,C$10+128
0304 027E   0340'     
0305 0280   069C      BL *12
0306 0282   0276'     DATA XPUTS
0307 0284   0460      B @C$23
0307 0286   02BA'     
0308                 *    case 6: puts("SATERDAY\n"); break;
0309                 C$31
0310 0288   0205      LI 5,C$10+136
0310 028A   0348'     
0311 028C   069C      BL *12
0312 028E   0282'     DATA XPUTS
0313 0290   0460      B @C$23
0313 0292   02BA'     
0314                 *  }
0315 0294   0460      B @C$23
0315 0296   02BA'     
0316                 C$24
0317 0298   06A0      BL @C$SWCH
0317 029A   0000      
0318 029C   0240'     DATA C$25,0
0318 029E   0000      
0319 02A0   024C'     DATA C$26,1
0319 02A2   0001      
0320 02A4   0258'     DATA C$27,2
0320 02A6   0002      
0321 02A8   0264'     DATA C$28,3
0321 02AA   0003      
0322 02AC   0270'     DATA C$29,4
0322 02AE   0004      
0323 02B0   027C'     DATA C$30,5
0323 02B2   0005      
0324 02B4   0288'     DATA C$31,6
0324 02B6   0006      
0325 02B8   0000      DATA 0
0326                 C$23
0327                 *}
9640 and 99/4A Assembler
                                                    Page 0007
0328 02BA   022E      AI 14,6
0328 02BC   0006      
0329 02BE   045D      B *13
0330 02C0   0045     C$10 BYTE 69,78,84,82,32,68,65,89,32,79,70,32
0331 02CC   004D      BYTE 77,79,78,84,72,32,40,49,45,51,49,41
0332 02D8   000A      BYTE 10,0,10,10,69,78,84,69,82,32,77,79
0333 02E4   004E      BYTE 78,84,72,32,40,49,45,49,50,41,10,0
0334 02F0   000A      BYTE 10,10,69,78,84,69,82,32,89,69,65,82
0335 02FC   0020      BYTE 32,40,49,53,56,50,45,68,79,79,77,83
0336 0308   0044      BYTE 68,65,89,41,10,0,10,10,10,10,0,83
0337 0314   0055      BYTE 85,78,68,65,89,10,0,77,79,78,68,65
0338 0320   0059      BYTE 89,10,0,84,85,69,83,68,65,89,10,0
0339 032C   0057      BYTE 87,69,68,78,69,83,68,65,89,10,0,84
0340 0338   0048      BYTE 72,85,82,83,65,89,10,0,70,82,73,68
0341 0344   0041      BYTE 65,89,10,0,83,65,84,69,82,68,65,89
0342 0350   000A      BYTE 10,0
0343                  EVEN
0344                 *
0345                 */* n=getint()
0346                 * * read a number
0347                 * */
0348                 *getint()
0349                 GETINT
0350                 *{
0351                 *  char str[40];
0352                 *
0353                 *  gets(str);
0354 0352   022E      AI 14,-40
0354 0354   FFD8      
0355 0356   C20E      MOV 14,8
0356 0358   068F      BL 15
0357 035A   069C      BL *12
0358 035C   0000      DATA GETS
0359 035E   05CE      INCT 14
0360                 *  return atoi(str);
0361 0360   C20E      MOV 14,8
0362 0362   068F      BL 15
0363 0364   069C      BL *12
0364 0366   0370'     DATA ATOI
0365 0368   05CE      INCT 14
0366 036A   022E      AI 14,40
0366 036C   0028      
0367 036E   045D      B *13
0368                 *}
0369                 *
0370                 */* n=atoi(s)
0371                 * * convert string to integer
0372                 * */
0373                 *atoi(s)  char *s;
0374                 ATOI
0375                 *{ 
0376                 *  int sign,n;
0377                 *
0378                 *  while(*s==' ')++s;
0379 0370   022E      AI 14,-4
0379 0372   FFFC      
0380                 C$34
0381 0374   C22E      MOV @6(14),8
0381 0376   0006      
0382 0378   D218      MOVB *8,8
0383 037A   0988      SRL 8,8
0384 037C   068F      BL 15
0385 037E   0208      LI 8,32
0385 0380   0020      
0386 0382   06A0      BL @C$EQ
0386 0384   0000      
0387 0386   1602      JNE $+6
0388 0388   0460      B @C$35
0388 038A   0394'     
0389 038C   05AE      INC @6(14)
0389 038E   0006      
0390 0390   0460      B @C$34
0390 0392   0374'     
0391                 C$35
0392                 *  sign=1;
9640 and 99/4A Assembler
                                                    Page 0008
0393 0394   0208      LI 8,1
0393 0396   0001      
0394 0398   CB88      MOV 8,@2(14)
0394 039A   0002      
0395                 *  if(*s=='-') { sign=-1; ++s; }
0396 039C   C22E      MOV @6(14),8
0396 039E   0006      
0397 03A0   D218      MOVB *8,8
0398 03A2   0988      SRL 8,8
0399 03A4   068F      BL 15
0400 03A6   0208      LI 8,45
0400 03A8   002D      
0401 03AA   06A0      BL @C$EQ
0401 03AC   0384'     
0402 03AE   1602      JNE $+6
0403 03B0   0460      B @C$36
0403 03B2   03C0'     
0404 03B4   0208      LI 8,-1
0404 03B6   FFFF      
0405 03B8   CB88      MOV 8,@2(14)
0405 03BA   0002      
0406 03BC   05AE      INC @6(14)
0406 03BE   0006      
0407                 *  if(*s=='+') ++s;
0408                 C$36
0409 03C0   C22E      MOV @6(14),8
0409 03C2   0006      
0410 03C4   D218      MOVB *8,8
0411 03C6   0988      SRL 8,8
0412 03C8   068F      BL 15
0413 03CA   0208      LI 8,43
0413 03CC   002B      
0414 03CE   06A0      BL @C$EQ
0414 03D0   03AC'     
0415 03D2   1602      JNE $+6
0416 03D4   0460      B @C$37
0416 03D6   03DC'     
0417 03D8   05AE      INC @6(14)
0417 03DA   0006      
0418                 *
0419                 *  n=0;
0420                 C$37
0421 03DC   6208      S 8,8
0422 03DE   C788      MOV 8,*14
0423                 *  while((*s>='0')&(*s<='9'))
0424                 C$38
0425 03E0   C22E      MOV @6(14),8
0425 03E2   0006      
0426 03E4   D218      MOVB *8,8
0427 03E6   0988      SRL 8,8
0428 03E8   068F      BL 15
0429 03EA   0208      LI 8,48
0429 03EC   0030      
0430 03EE   06A0      BL @C$GE
0430 03F0   01E6'     
0431 03F2   068F      BL 15
0432 03F4   C22E      MOV @8(14),8
0432 03F6   0008      
0433 03F8   D218      MOVB *8,8
0434 03FA   0988      SRL 8,8
0435 03FC   068F      BL 15
0436 03FE   0208      LI 8,57
0436 0400   0039      
0437 0402   06A0      BL @C$LE
0437 0404   01B4'     
0438 0406   055E      INV *14
0439 0408   423E      SZC *14+,8
0440 040A   1602      JNE $+6
0441 040C   0460      B @C$39
0441 040E   043E'     
0442                 *    n=10 * n + *(s++) - '0';
0443 0410   C20E      MOV 14,8
0444 0412   068F      BL 15
0445 0414   0208      LI 8,10
0445 0416   000A      
9640 and 99/4A Assembler
                                                    Page 0009
0446 0418   068F      BL 15
0447 041A   C22E      MOV @4(14),8
0447 041C   0004      
0448 041E   3A3E      MPY *14+,8
0449 0420   C209      MOV 9,8
0450 0422   068F      BL 15
0451 0424   C22E      MOV @10(14),8
0451 0426   000A      
0452 0428   05AE      INC @10(14)
0452 042A   000A      
0453 042C   D218      MOVB *8,8
0454 042E   0988      SRL 8,8
0455 0430   A23E      A *14+,8
0456 0432   0228      AI 8,-48
0456 0434   FFD0      
0457 0436   C27E      MOV *14+,9
0458 0438   C648      MOV 8,*9
0459 043A   0460      B @C$38
0459 043C   03E0'     
0460                 C$39
0461                 *
0462                 *  return(sign*n);
0463 043E   C22E      MOV @2(14),8
0463 0440   0002      
0464 0442   068F      BL 15
0465 0444   C22E      MOV @2(14),8
0465 0446   0002      
0466 0448   3A3E      MPY *14+,8
0467 044A   C209      MOV 9,8
0468 044C   022E      AI 14,4
0468 044E   0004      
0469 0450   045D      B *13
0470                 *}
0471                 *
0472                 */* day=jan1(year)
0473                 * * Calculates the day wich is the 1st of januari
0474                 * * with Zellers formula
0475                 * */
0476                 *jan1(year) int year;
0477                 JAN1
0478                 *{
0479                 *  int a,b,d;
0480                 *
0481                 *  a = (year-1)/100;
0482 0452   022E      AI 14,-6
0482 0454   FFFA      
0483 0456   C20E      MOV 14,8
0484 0458   0228      AI 8,4
0484 045A   0004      
0485 045C   068F      BL 15
0486 045E   C22E      MOV @10(14),8
0486 0460   000A      
0487 0462   0228      AI 8,-1
0487 0464   FFFF      
0488 0466   068F      BL 15
0489 0468   0208      LI 8,100
0489 046A   0064      
0490 046C   06A0      BL @C$DIV
0490 046E   0000      
0491 0470   C27E      MOV *14+,9
0492 0472   C648      MOV 8,*9
0493                 *  b = year-1-100*a;
0494 0474   C20E      MOV 14,8
0495 0476   05C8      INCT 8
0496 0478   068F      BL 15
0497 047A   C22E      MOV @10(14),8
0497 047C   000A      
0498 047E   0228      AI 8,-1
0498 0480   FFFF      
0499 0482   068F      BL 15
0500 0484   0208      LI 8,100
0500 0486   0064      
0501 0488   068F      BL 15
0502 048A   C22E      MOV @10(14),8
0502 048C   000A      
9640 and 99/4A Assembler
                                                    Page 0010
0503 048E   3A3E      MPY *14+,8
0504 0490   C209      MOV 9,8
0505 0492   623E      S *14+,8
0506 0494   0508      NEG 8
0507 0496   C27E      MOV *14+,9
0508 0498   C648      MOV 8,*9
0509                 *  d = 799+b+b/4+a/4-2*a;
0510 049A   C20E      MOV 14,8
0511 049C   068F      BL 15
0512 049E   0208      LI 8,799
0512 04A0   031F      
0513 04A2   A22E      A   @6-2(14),8
0513 04A4   0004      
0514 04A6   068F      BL 15
0515 04A8   C22E      MOV @6(14),8
0515 04AA   0006      
0516 04AC   068F      BL 15
0517 04AE   0208      LI 8,4
0517 04B0   0004      
0518 04B2   06A0      BL @C$DIV
0518 04B4   046E'     
0519 04B6   A23E      A *14+,8
0520 04B8   068F      BL 15
0521 04BA   C22E      MOV @8(14),8
0521 04BC   0008      
0522 04BE   068F      BL 15
0523 04C0   0208      LI 8,4
0523 04C2   0004      
0524 04C4   06A0      BL @C$DIV
0524 04C6   04B4'     
0525 04C8   A23E      A *14+,8
0526 04CA   068F      BL 15
0527 04CC   0208      LI 8,2
0527 04CE   0002      
0528 04D0   068F      BL 15
0529 04D2   C22E      MOV @10(14),8
0529 04D4   000A      
0530 04D6   3A3E      MPY *14+,8
0531 04D8   C209      MOV 9,8
0532 04DA   623E      S *14+,8
0533 04DC   0508      NEG 8
0534 04DE   C27E      MOV *14+,9
0535 04E0   C648      MOV 8,*9
0536                 *
0537                 *  return d%7;
0538 04E2   C21E      MOV *14,8
0539 04E4   068F      BL 15
0540 04E6   0208      LI 8,7
0540 04E8   0007      
0541 04EA   06A0      BL @C$REM
0541 04EC   0234'     
0542 04EE   022E      AI 14,6
0542 04F0   0006      
0543 04F2   045D      B *13
0544                 *}
0545                 *
0546                 */* leapyear(year)
0547                 * * check if an year is a leapyear
0548                 * */
0549                 *leapyear(year) int year;
0550                 LEAPYE
0551                 *{
0552                 *  return (((year%4  ==0) && !(year%100==0))
0553 04F4   C22E      MOV @2(14),8
0553 04F6   0002      
0554 04F8   068F      BL 15
0555 04FA   0208      LI 8,4
0555 04FC   0004      
0556 04FE   06A0      BL @C$REM
0556 0500   04EC'     
0557 0502   068F      BL 15
0558 0504   6208      S 8,8
0559 0506   06A0      BL @C$EQ
0559 0508   03D0'     
0560 050A   1602      JNE $+6
9640 and 99/4A Assembler
                                                    Page 0011
0561 050C   0460      B @C$42
0561 050E   0532'     
0562 0510   C22E      MOV @2(14),8
0562 0512   0002      
0563 0514   068F      BL 15
0564 0516   0208      LI 8,100
0564 0518   0064      
0565 051A   06A0      BL @C$REM
0565 051C   0500'     
0566 051E   068F      BL 15
0567 0520   6208      S 8,8
0568 0522   06A0      BL @C$EQ
0568 0524   0508'     
0569 0526   0748      ABS 8
0570 0528   1302      JEQ $+6
0571 052A   0460      B @C$42
0571 052C   0532'     
0572 052E   C20F      MOV 15,8
0573 0530   1001      JMP $+4
0574                 C$42
0575 0532   6208      S 8,8
0576                 *         ||(year%400==0) );
0577 0534   1302      JEQ $+6
0578 0536   0460      B @C$43
0578 0538   055A'     
0579 053A   C22E      MOV @2(14),8
0579 053C   0002      
0580 053E   068F      BL 15
0581 0540   0208      LI 8,400
0581 0542   0190      
0582 0544   06A0      BL @C$REM
0582 0546   051C'     
0583 0548   068F      BL 15
0584 054A   6208      S 8,8
0585 054C   06A0      BL @C$EQ
0585 054E   0524'     
0586 0550   1302      JEQ $+6
0587 0552   0460      B @C$43
0587 0554   055A'     
0588 0556   6208      S 8,8
0589 0558   1001      JMP $+4
0590                 C$43
0591 055A   C20F      MOV 15,8
0592 055C   045D      B *13
0593                 *}
0594                 *
0595                 */* days
0596                 * * calculate number of days till dd/mm/yyyy
0597                 * */
0598                 *days(day, month, year) int day,month,year;
0599                 DAYS
0600                 *{
0601                 *  int ix;
0602                 *
0603                 *  --day;
0604 055E   064E      DECT 14
0605 0560   062E      DEC @8(14)
0605 0562   0008      
0606                 *  --month;
0607 0564   062E      DEC @6(14)
0607 0566   0006      
0608                 *  for (ix=0; ix<month; ++ix)
0609 0568   6208      S 8,8
0610 056A   C788      MOV 8,*14
0611                 C$47
0612 056C   C21E      MOV *14,8
0613 056E   068F      BL 15
0614 0570   C22E      MOV @8(14),8
0614 0572   0008      
0615 0574   06A0      BL @C$LT
0615 0576   0000      
0616 0578   1602      JNE $+6
0617 057A   0460      B @C$46
0617 057C   05EA'     
0618 057E   0460      B @C$48
9640 and 99/4A Assembler
                                                    Page 0012
0618 0580   0588'     
0619                 C$45
0620 0582   059E      INC *14
0621 0584   0460      B @C$47
0621 0586   056C'     
0622                 C$48
0623                 *  {
0624                 *    day = day+daytable[ix];
0625 0588   C20E      MOV 14,8
0626 058A   0228      AI 8,8
0626 058C   0008      
0627 058E   068F      BL 15
0628 0590   C22E      MOV @10(14),8
0628 0592   000A      
0629 0594   068F      BL 15
0630 0596   0208      LI 8,DAYTAB
0630 0598   0000'     
0631 059A   068F      BL 15
0632 059C   C22E      MOV @6(14),8
0632 059E   0006      
0633 05A0   A208      A 8,8
0634 05A2   A23E      A *14+,8
0635 05A4   C218      MOV *8,8
0636 05A6   A23E      A *14+,8
0637 05A8   C27E      MOV *14+,9
0638 05AA   C648      MOV 8,*9
0639                 *    if ((ix==1) && leapyear(year)) day=day+1;
0640 05AC   C21E      MOV *14,8
0641 05AE   068F      BL 15
0642 05B0   0208      LI 8,1
0642 05B2   0001      
0643 05B4   06A0      BL @C$EQ
0643 05B6   054E'     
0644 05B8   1602      JNE $+6
0645 05BA   0460      B @C$50
0645 05BC   05CE'     
0646 05BE   C22E      MOV @4(14),8
0646 05C0   0004      
0647 05C2   068F      BL 15
0648 05C4   069C      BL *12
0649 05C6   04F4'     DATA LEAPYE
0650 05C8   05CE      INCT 14
0651 05CA   0748      ABS 8
0652 05CC   1602      JNE $+6
0653                 C$50
0654 05CE   0460      B @C$49
0654 05D0   05E6'     
0655 05D2   C20E      MOV 14,8
0656 05D4   0228      AI 8,8
0656 05D6   0008      
0657 05D8   068F      BL 15
0658 05DA   C22E      MOV @10(14),8
0658 05DC   000A      
0659 05DE   0228      AI 8,1
0659 05E0   0001      
0660 05E2   C27E      MOV *14+,9
0661 05E4   C648      MOV 8,*9
0662                 *  }
0663                 C$49
0664 05E6   0460      B @C$45
0664 05E8   0582'     
0665                 C$46
0666                 *  return day;
0667 05EA   C22E      MOV @8(14),8
0667 05EC   0008      
0668 05EE   05CE      INCT 14
0669 05F0   045D      B *13
0670                 *}
0671                  END
