home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / CATLOG / NUMBERIT.LBR / NUMBERIT.AZM / NUMBERIT.ASM
Assembly Source File  |  2000-06-30  |  10KB  |  333 lines
  1.     ORG 0100H ;STANDARD CP/M ORIGIN
  2.     LXI SP,STACK
  3. I10:    ;PRINT "This program will create empty file names like -.001"
  4.     JMP I10B
  5. I10A: DB 84,104,105,115,32,112,114,111,103,114,97,109,32,119,105
  6.     DB 108,108,32,99,114,101,97,116,101,32,101,109,112,116,121
  7.     DB 32,102,105,108,101,32,110,97,109,101,115,32,108,105,107
  8.     DB 101,32,45,46,48,48,49
  9. I10B:LXI H,I10A
  10.     LXI D,52
  11.     LXI B,2
  12.     CALL PSTR
  13.     CALL PLNE
  14. I20:    ;PRINT "that are useful for disk catalog programs.  The file will"
  15.     JMP I20B
  16. I20A: DB 116,104,97,116,32,97,114,101,32,117,115,101,102,117,108
  17.     DB 32,102,111,114,32,100,105,115,107,32,99,97,116,97,108
  18.     DB 111,103,32,112,114,111,103,114,97,109,115,46,32,32,84
  19.     DB 104,101,32,102,105,108,101,32,119,105,108,108
  20. I20B:LXI H,I20A
  21.     LXI D,57
  22.     LXI B,2
  23.     CALL PSTR
  24.     CALL PLNE
  25. I30:    ;PRINT "take up 0K and the extension will be incremented automatically"
  26.     JMP I30B
  27. I30A: DB 116,97,107,101,32,117,112,32,48,75,32,97,110,100,32
  28.     DB 116,104,101,32,101,120,116,101,110,115,105,111,110,32,119
  29.     DB 105,108,108,32,98,101,32,105,110,99,114,101,109,101,110
  30.     DB 116,101,100,32,97,117,116,111,109,97,116,105,99,97,108
  31.     DB 108,121
  32. I30B:LXI H,I30A
  33.     LXI D,62
  34.     LXI B,2
  35.     CALL PSTR
  36.     CALL PLNE
  37. I40:    ;PRINT "Between file creations, a disk reset is done to ensure no"
  38.     JMP I40B
  39. I40A: DB 66,101,116,119,101,101,110,32,102,105,108,101,32,99,114
  40.     DB 101,97,116,105,111,110,115,44,32,97,32,100,105,115,107
  41.     DB 32,114,101,115,101,116,32,105,115,32,100,111,110,101,32
  42.     DB 116,111,32,101,110,115,117,114,101,32,110,111
  43. I40B:LXI H,I40A
  44.     LXI D,57
  45.     LXI B,2
  46.     CALL PSTR
  47.     CALL PLNE
  48. I50:    ;PRINT "BDOS errors occur"
  49.     JMP I50B
  50. I50A: DB 66,68,79,83,32,101,114,114,111,114,115,32,111,99,99
  51.     DB 117,114
  52. I50B:LXI H,I50A
  53.     LXI D,17
  54.     LXI B,2
  55.     CALL PSTR
  56.     CALL PLNE
  57. I60:    ;PRINT "Thanks to Bruce Tonkin for BCBC Basic Compiler..."
  58.     JMP I60B
  59. I60A: DB 84,104,97,110,107,115,32,116,111,32,66,114,117,99,101
  60.     DB 32,84,111,110,107,105,110,32,102,111,114,32,66,67,66
  61.     DB 67,32,66,97,115,105,99,32,67,111,109,112,105,108,101
  62.     DB 114,46,46,46
  63. I60B:LXI H,I60A
  64.     LXI D,49
  65.     LXI B,2
  66.     CALL PSTR
  67.     CALL PLNE
  68. I70:    ;PRINT "                       Pierre Kerr, Ottawa Nov 1986"
  69.     JMP I70B
  70. I70A: DB 32,32,32,32,32,32,32,32,32,32,32,32,32,32,32
  71.     DB 32,32,32,32,32,32,32,32,80,105,101,114,114,101,32
  72.     DB 75,101,114,114,44,32,79,116,116,97,119,97,32,78,111
  73.     DB 118,32,49,57,56,54
  74. I70B:LXI H,I70A
  75.     LXI D,51
  76.     LXI B,2
  77.     CALL PSTR
  78.     CALL PLNE
  79. I80:    ;P$="."
  80.     LHLD ZP$
  81.     MVI A,46!MOV M,A
  82.     LXI H, 1 !SHLD ZP$+2
  83. I90:    ;PRINT:PRINT "Enter the filename including disk drive ID (EG. B:-DATA) ";
  84.     LXI B,2
  85.     CALL PLNE
  86.     JMP I90B
  87. I90A: DB 69,110,116,101,114,32,116,104,101,32,102,105,108,101,110
  88.     DB 97,109,101,32,105,110,99,108,117,100,105,110,103,32,100
  89.     DB 105,115,107,32,100,114,105,118,101,32,73,68,32,40,69
  90.     DB 71,46,32,66,58,45,68,65,84,65,41,32
  91. I90B:LXI H,I90A
  92.     LXI D,57
  93.     LXI B,2
  94.     CALL PSTR
  95. I100:    ;INPUT FIN$
  96.     LHLD ZFIN$
  97.     XCHG
  98.     CALL GETSTR!SHLD ZFIN$+2
  99. I110:    ;REM Since BCBC doesn't allow FIN$=C$+"." we need to define P$="."
  100. I120:    ;C$=FIN$+P$
  101.     LHLD ZFIN$+2!PUSH H!POP B
  102.     LHLD ZC$!XCHG
  103.     LHLD ZFIN$
  104.     CALL STRMV
  105.     LHLD ZFIN$+2!SHLD ZC$+2
  106.     LHLD ZP$+2!PUSH H!POP B
  107.     LHLD ZC$!XCHG!LHLD ZC$+2!DAD D!XCHG
  108.     LHLD ZP$!CALL STRMV
  109.     LHLD ZP$+2!XCHG!LHLD ZC$+2!DAD D
  110.     SHLD ZC$+2
  111. I130:    ;PRINT:PRINT "Now enter the starting value for the extension "
  112.     LXI B,2
  113.     CALL PLNE
  114.     JMP I130B
  115. I130A: DB 78,111,119,32,101,110,116,101,114,32,116,104,101,32,115
  116.     DB 116,97,114,116,105,110,103,32,118,97,108,117,101,32,102
  117.     DB 111,114,32,116,104,101,32,101,120,116,101,110,115,105,111
  118.     DB 110,32
  119. I130B:LXI H,I130A
  120.     LXI D,47
  121.     LXI B,2
  122.     CALL PSTR
  123.     CALL PLNE
  124. I140:    ;INPUT EXT
  125.     CALL GETNUM
  126.     SHLD ZEXT
  127. I150:    ;PRINT "To stop enter a CNTRL-C "
  128.     JMP I150B
  129. I150A: DB 84,111,32,115,116,111,112,32,101,110,116,101,114,32,97
  130.     DB 32,67,78,84,82,76,45,67,32
  131. I150B:LXI H,I150A
  132.     LXI D,24
  133.     LXI B,2
  134.     CALL PSTR
  135.     CALL PLNE
  136. I160:    ;REM   Make up the file name
  137. I170:    ;REM Note: it's always a good idea to keep statements VERY simple in BCBC
  138. I180:    ;   A$=STR$(EXT)
  139.     LXI D,ZA$!LHLD ZEXT!CALL STR
  140. I190:    ;   B$=RIGHT$(A$,3)
  141.     LXI H,3
  142.     SHLD ZB$+2
  143.     PUSH H!PUSH H!LHLD ZA$!XCHG!LHLD ZA$+2!DAD D
  144.     POP D!MOV A,D!CMA!MOV D,A!MOV A,E!CMA!MOV E,A
  145.     INX D!DAD D!XCHG!LHLD ZB$!XCHG!POP B
  146.     CALL STRMV
  147. I200:    ;   FI$=C$+B$
  148.     LHLD ZC$+2!PUSH H!POP B
  149.     LHLD ZFI$!XCHG
  150.     LHLD ZC$
  151.     CALL STRMV
  152.     LHLD ZC$+2!SHLD ZFI$+2
  153.     LHLD ZB$+2!PUSH H!POP B
  154.     LHLD ZFI$!XCHG!LHLD ZFI$+2!DAD D!XCHG
  155.     LHLD ZB$!CALL STRMV
  156.     LHLD ZB$+2!XCHG!LHLD ZFI$+2!DAD D
  157.     SHLD ZFI$+2
  158. I210:    ;PRINT "Creating ";:PRINT FI$:PRINT "Type RETURN to proceed or CNTRL-C to QUIT"
  159.     JMP I210B
  160. I210A: DB 67,114,101,97,116,105,110,103,32
  161. I210B:LXI H,I210A
  162.     LXI D,9
  163.     LXI B,2
  164.     CALL PSTR
  165.     LHLD ZFI$+2!XCHG
  166.     LHLD ZFI$
  167.     LXI B,2
  168.     CALL PSTR
  169.     CALL PLNE
  170.     JMP I210D
  171. I210C: DB 84,121,112,101,32,82,69,84,85,82,78,32,116,111,32
  172.     DB 112,114,111,99,101,101,100,32,111,114,32,67,78,84,82
  173.     DB 76,45,67,32,116,111,32,81,85,73,84
  174. I210D:LXI H,I210C
  175.     LXI D,41
  176.     LXI B,2
  177.     CALL PSTR
  178.     CALL PLNE
  179. I220:    ;   INPUT T$
  180.     LHLD ZT$
  181.     XCHG
  182.     CALL GETSTR!SHLD ZT$+2
  183. I230:    ;REM    Insert Inline ASM to do a disk reset
  184. I240:    ;#ASM
  185. I250:    ;MVI   C,13
  186.  MVI   C,13
  187. I260:    ;CALL  5
  188.  CALL  5
  189. I270:    ;#ENDASM
  190. I280:    ;  OPEN 1,FI$
  191.     LXI D,FCB1
  192.     LHLD ZFI$+2!MOV B,L!LHLD ZFI$!CALL ROPEN
  193. I290:    ;  EXT=EXT+1
  194.     LHLD ZEXT
  195.     XCHG
  196.     LXI H, 1 
  197.     DAD D
  198.     SHLD ZEXT
  199. I300:    ;GOTO 160
  200.     JMP I160
  201. I310:    ;END
  202.     JMP 000H
  203.     CALL 0000H
  204. FCB1: DB    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  205. FCB2: DB    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  206. FCB3: DB    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  207. PSTR:    MOV    A,D! ORA A! JNZ PLOOP! MOV A,E! ORA A! RZ
  208. PLOOP:    PUSH    D! PUSH B! MOV E,M! PUSH H! PUSH PSW
  209.     CALL    0005H
  210.     POP    PSW! POP H! POP B! POP D! INX H! DCX D! MOV A,E! ORA A
  211.     JNZ    PLOOP
  212.     MOV    A,D! ORA A! JNZ PLOOP
  213.     RET
  214. PLNE:    PUSH    B! MVI E,13
  215.     CALL    0005! POP B! PUSH B! MVI E,10
  216.     CALL    0005! POP B! RET
  217. DECDIG:    MVI    A,'0'-1
  218. DECLP:    INR    A! DAD B! JC DECLP
  219.     STAX    D! INX D! MOV A,B! CMA
  220.     MOV    B,A! MOV A,C! CMA
  221.     MOV    C,A! INX B! DAD B! RET
  222. GETNUM:    LXI    D,SAREA! LXI H,0000H! LXI B,0
  223. IPLP:    PUSH    B! MVI C,01H! PUSH D! PUSH H! CALL 0005H
  224.     POP    H! POP D! POP B! STAX D! INX D! INX H! INX B
  225.     CPI    13! JZ IPDONE! CPI 10! JZ IPDONE! CPI 3! JZ 0000H
  226.     CPI    8! CZ IPBS
  227.     JMP    IPLP
  228. IPBS:    DCX    B! DCX B! MOV A,B! RAL! JC IPBS2
  229.     DCX    H! DCX H! DCX D! DCX D! PUSH D! PUSH H! PUSH B! MVI C,2
  230.     MVI    E,32! CALL 0005H! MVI C,2! MVI E,8! CALL 0005H
  231.     POP    B! POP H! POP D! RET
  232. IPBS2:    INX    B! DCX H! DCX D! PUSH B! PUSH D! PUSH H! MVI C,2! MVI E,32
  233.     CALL    0005H! POP H! POP D! POP B! RET
  234. IPDONE:    LXI    D,SAREA! LXI H,0000H! PUSH H!
  235. IP2:    LDAX    D! INX D! CPI '-'! JZ IP3
  236.     CPI    '0'! JC IPST! CPI '9'+1! JNC IP2
  237.     SUI    '0'! MOV B,H! MOV C,L! DAD H! DAD H! DAD B
  238.     DAD    H! ADD L! MOV L,A! JMP IP2
  239. IP3:    POP    B! INX B! PUSH B! JMP IP2
  240. IPST:    POP    B! MOV A,C! ORA A! JZ IPST2
  241.     MOV    A,H! CMA! MOV H,A! MOV A,L! CMA! MOV L,A
  242.     INX    H
  243. IPST2:    PUSH    H! MVI E,10! MVI C,2! CALL 0005H
  244.     MVI    E,13! MVI C,2! CALL 0005H! POP H! RET
  245. GETSTR:    LXI    H,0! LXI B,0
  246. STRLP:    PUSH    B! MVI C,01H! PUSH D! PUSH H! CALL 0005H
  247.     POP    H! POP D! POP B! CPI 13! JZ SQUIT! CPI 3! JZ 0000H
  248.     STAX    D! INX D! INX H! INX B! CPI 8! CZ SBS! JMP STRLP
  249. SQUIT:    MVI    E,10! MVI C,2! PUSH H
  250.     CALL    0005H! POP H! RET
  251. SBS:    DCX    B! DCX B! MOV A,B! RAL! JC SBS2
  252.     DCX    D! DCX D! DCX H! DCX H! PUSH B! PUSH D! PUSH H! MVI C,2!
  253.     MVI    E,32! CALL 0005H! MVI C,2! MVI E,8! CALL 0005H
  254.     POP    H! POP D! POP B! RET
  255. SBS2:    INX    B! DCX D! DCX H! PUSH B! PUSH D! PUSH H! MVI C,2! MVI E,32
  256.     CALL    0005H! POP H! POP D! POP B! RET
  257. ROPEN:    xchg!    shld SAREA! xchg! shld SAREA+2! push b! mvi b,36! mvi a,0
  258. ROPEN1:    stax d! inx d! dcr b! cmp b! jnz ROPEN1! lhld sarea! xchg! inx d
  259.     mvi    b,11
  260. ROPEN2:    mvi    a,32! stax d! inx d! dcr b! mov a,b! ora a! jnz ROPEN2
  261.     lhld    SAREA! xchg! lhld SAREA+2! pop b
  262.     inx    h! mov a,m! dcx h! cpi ':'! jnz ROPEN3
  263.     mov    a,m! sui 64! stax d! inx h! inx h! dcr b! dcr b
  264. ROPEN3:    inx    d! mov a,b! ora a! jz ROPEN6! mov a,m! cpi '.'! cz ROPEN4
  265.     stax    d! dcr b! inx h! jmp ROPEN3
  266. ROPEN4:    push    h! lhld SAREA! lxi d,9! dad d! xchg! pop h! inx h
  267.     dcr    b! mov a,b! ora a! jz ROPEN5! mov a,m! ret
  268. ROPEN5:    pop    h
  269. ROPEN6:    lhld    SAREA! XCHG
  270.     MVI    C,15! PUSH D! CALL 0005
  271.     POP    D! INR A! ORA A! JZ FCREAT! RET
  272. FCREAT:    MVI    C,22! CALL 0005! INR A! ORA A! RNZ
  273.     MVI    C,9! LXI D,FERR! CALL 0005! JMP 0
  274. FERR:    DB    'FILE CREATION ERROR: NO DIRECTORY SPACE AVAILABLE.',13,10,'$'
  275. RGET:    PUSH    B! PUSH D! PUSH H! MOV H,B! MOV L,C! SHLD SAREA
  276.     POP    H! POP D! POP B! PUSH B! PUSH D! PUSH H
  277.     LXI    H,33! DAD D! XCHG! POP H
  278.     MOV    A,L! STAX D! INX D! MOV A,H! STAX D! INX D
  279.     MVI    A,0! STAX D! POP B! POP D
  280.     PUSH    B! MVI C,26! CALL 0005
  281.     POP    D! MVI C,33! CALL 0005! ORA A! JNZ GETERR
  282.     RET
  283. GETERR:    LHLD    SAREA! MVI B,128
  284. GETER1:    MVI    A,0! MOV M,A! DCR B! MOV A,B! ORA A! RZ! INX H! JMP GETER1
  285. RPUT:    PUSH    B! PUSH D! PUSH H
  286.     LXI    H,33! DAD D! XCHG! POP H
  287.     MOV    A,L! STAX D! INX D! MOV A,H! STAX D! INX D
  288.     MVI    A,0! STAX D! POP B! POP D
  289.     PUSH    B! MVI C,26! CALL 0005
  290.     POP    D! MVI C,34! CALL 0005! RET
  291. FCLOS:    MVI    C,16! CALL 0005! INR A! ORA A! RNZ
  292.     MVI    C,9! LXI D,FCERR! CALL 0005! JMP 0
  293. FCERR:    DB    'FILE CLOSE ERROR REPORTED BY CP/M.',0DH,0AH,'$'
  294. STR:    PUSH    D! LDAX D! MOV C,A! INX D! LDAX D! MOV D,A! MOV E,C
  295.     MOV    A,H! ANI 080H! JZ STR2
  296.     MOV    A,H! CMA! MOV H,A! MOV A,L! CMA! MOV L,A! INX H
  297.     MVI    A,'-'
  298.     STAX    D
  299.     JMP    STR3
  300. STR2:    MVI    A,'+'
  301.     STAX    D
  302. STR3:    INX    D
  303.     MOV    A,H! ANI 07FH! MOV H,A
  304.     LXI    B,-10000! CALL DECDIG
  305.     LXI    B,-1000! CALL DECDIG
  306.     LXI    B,-100! CALL DECDIG
  307.     LXI    B,-10! CALL DECDIG
  308.     MOV    A,L! ORI '0'! STAX D
  309.     LXI    H,0006H! POP D! INX D! INX D! MOV A,L! STAX D! INX D
  310.     MOV    A,H! STAX D! RET
  311. STRMV:    MOV    A,B! ORA A! JNZ STRMV1
  312.     MOV    A,C! ORA A! RZ
  313. STRMV1:    MOV    A,M! STAX D! INX D! INX H! DCX B! JMP STRMV
  314. ZP$: DW STACK+257,0
  315. ZFIN$: DW STACK+337,0
  316. ZC$: DW STACK+417,0
  317. ZEXT: DW 0
  318. ZA$: DW STACK+497,0
  319. ZB$: DW STACK+577,0
  320. ZFI$: DW STACK+657,0
  321. ZT$: DW STACK+737,0
  322.     DS 64
  323. STACK:
  324. SAREA: DW 0
  325.     END
  326.  DW 0
  327. ZA$: DW STACK+497,0
  328. ZB$: DW STACK+577,0
  329. ZFI$: DW STACK+657,0
  330. ZT$: DW STACK+737,0
  331.     DS 64
  332. STACK:
  333. SAREA: D