ORG 0100H ;STANDARD CP/M ORIGIN LXI SP,STACK I10: ;PRINT "This program will create empty file names like -.001" JMP I10B I10A: DB 84,104,105,115,32,112,114,111,103,114,97,109,32,119,105 DB 108,108,32,99,114,101,97,116,101,32,101,109,112,116,121 DB 32,102,105,108,101,32,110,97,109,101,115,32,108,105,107 DB 101,32,45,46,48,48,49 I10B:LXI H,I10A LXI D,52 LXI B,2 CALL PSTR CALL PLNE I20: ;PRINT "that are useful for disk catalog programs. The file will" JMP I20B I20A: DB 116,104,97,116,32,97,114,101,32,117,115,101,102,117,108 DB 32,102,111,114,32,100,105,115,107,32,99,97,116,97,108 DB 111,103,32,112,114,111,103,114,97,109,115,46,32,32,84 DB 104,101,32,102,105,108,101,32,119,105,108,108 I20B:LXI H,I20A LXI D,57 LXI B,2 CALL PSTR CALL PLNE I30: ;PRINT "take up 0K and the extension will be incremented automatically" JMP I30B I30A: DB 116,97,107,101,32,117,112,32,48,75,32,97,110,100,32 DB 116,104,101,32,101,120,116,101,110,115,105,111,110,32,119 DB 105,108,108,32,98,101,32,105,110,99,114,101,109,101,110 DB 116,101,100,32,97,117,116,111,109,97,116,105,99,97,108 DB 108,121 I30B:LXI H,I30A LXI D,62 LXI B,2 CALL PSTR CALL PLNE I40: ;PRINT "Between file creations, a disk reset is done to ensure no" JMP I40B I40A: DB 66,101,116,119,101,101,110,32,102,105,108,101,32,99,114 DB 101,97,116,105,111,110,115,44,32,97,32,100,105,115,107 DB 32,114,101,115,101,116,32,105,115,32,100,111,110,101,32 DB 116,111,32,101,110,115,117,114,101,32,110,111 I40B:LXI H,I40A LXI D,57 LXI B,2 CALL PSTR CALL PLNE I50: ;PRINT "BDOS errors occur" JMP I50B I50A: DB 66,68,79,83,32,101,114,114,111,114,115,32,111,99,99 DB 117,114 I50B:LXI H,I50A LXI D,17 LXI B,2 CALL PSTR CALL PLNE I60: ;PRINT "Thanks to Bruce Tonkin for BCBC Basic Compiler..." JMP I60B I60A: DB 84,104,97,110,107,115,32,116,111,32,66,114,117,99,101 DB 32,84,111,110,107,105,110,32,102,111,114,32,66,67,66 DB 67,32,66,97,115,105,99,32,67,111,109,112,105,108,101 DB 114,46,46,46 I60B:LXI H,I60A LXI D,49 LXI B,2 CALL PSTR CALL PLNE I70: ;PRINT " Pierre Kerr, Ottawa Nov 1986" JMP I70B I70A: DB 32,32,32,32,32,32,32,32,32,32,32,32,32,32,32 DB 32,32,32,32,32,32,32,32,80,105,101,114,114,101,32 DB 75,101,114,114,44,32,79,116,116,97,119,97,32,78,111 DB 118,32,49,57,56,54 I70B:LXI H,I70A LXI D,51 LXI B,2 CALL PSTR CALL PLNE I80: ;P$="." LHLD ZP$ MVI A,46!MOV M,A LXI H, 1 !SHLD ZP$+2 I90: ;PRINT:PRINT "Enter the filename including disk drive ID (EG. B:-DATA) "; LXI B,2 CALL PLNE JMP I90B I90A: DB 69,110,116,101,114,32,116,104,101,32,102,105,108,101,110 DB 97,109,101,32,105,110,99,108,117,100,105,110,103,32,100 DB 105,115,107,32,100,114,105,118,101,32,73,68,32,40,69 DB 71,46,32,66,58,45,68,65,84,65,41,32 I90B:LXI H,I90A LXI D,57 LXI B,2 CALL PSTR I100: ;INPUT FIN$ LHLD ZFIN$ XCHG CALL GETSTR!SHLD ZFIN$+2 I110: ;REM Since BCBC doesn't allow FIN$=C$+"." we need to define P$="." I120: ;C$=FIN$+P$ LHLD ZFIN$+2!PUSH H!POP B LHLD ZC$!XCHG LHLD ZFIN$ CALL STRMV LHLD ZFIN$+2!SHLD ZC$+2 LHLD ZP$+2!PUSH H!POP B LHLD ZC$!XCHG!LHLD ZC$+2!DAD D!XCHG LHLD ZP$!CALL STRMV LHLD ZP$+2!XCHG!LHLD ZC$+2!DAD D SHLD ZC$+2 I130: ;PRINT:PRINT "Now enter the starting value for the extension " LXI B,2 CALL PLNE JMP I130B I130A: DB 78,111,119,32,101,110,116,101,114,32,116,104,101,32,115 DB 116,97,114,116,105,110,103,32,118,97,108,117,101,32,102 DB 111,114,32,116,104,101,32,101,120,116,101,110,115,105,111 DB 110,32 I130B:LXI H,I130A LXI D,47 LXI B,2 CALL PSTR CALL PLNE I140: ;INPUT EXT CALL GETNUM SHLD ZEXT I150: ;PRINT "To stop enter a CNTRL-C " JMP I150B I150A: DB 84,111,32,115,116,111,112,32,101,110,116,101,114,32,97 DB 32,67,78,84,82,76,45,67,32 I150B:LXI H,I150A LXI D,24 LXI B,2 CALL PSTR CALL PLNE I160: ;REM Make up the file name I170: ;REM Note: it's always a good idea to keep statements VERY simple in BCBC I180: ; A$=STR$(EXT) LXI D,ZA$!LHLD ZEXT!CALL STR I190: ; B$=RIGHT$(A$,3) LXI H,3 SHLD ZB$+2 PUSH H!PUSH H!LHLD ZA$!XCHG!LHLD ZA$+2!DAD D POP D!MOV A,D!CMA!MOV D,A!MOV A,E!CMA!MOV E,A INX D!DAD D!XCHG!LHLD ZB$!XCHG!POP B CALL STRMV I200: ; FI$=C$+B$ LHLD ZC$+2!PUSH H!POP B LHLD ZFI$!XCHG LHLD ZC$ CALL STRMV LHLD ZC$+2!SHLD ZFI$+2 LHLD ZB$+2!PUSH H!POP B LHLD ZFI$!XCHG!LHLD ZFI$+2!DAD D!XCHG LHLD ZB$!CALL STRMV LHLD ZB$+2!XCHG!LHLD ZFI$+2!DAD D SHLD ZFI$+2 I210: ;PRINT "Creating ";:PRINT FI$:PRINT "Type RETURN to proceed or CNTRL-C to QUIT" JMP I210B I210A: DB 67,114,101,97,116,105,110,103,32 I210B:LXI H,I210A LXI D,9 LXI B,2 CALL PSTR LHLD ZFI$+2!XCHG LHLD ZFI$ LXI B,2 CALL PSTR CALL PLNE JMP I210D I210C: DB 84,121,112,101,32,82,69,84,85,82,78,32,116,111,32 DB 112,114,111,99,101,101,100,32,111,114,32,67,78,84,82 DB 76,45,67,32,116,111,32,81,85,73,84 I210D:LXI H,I210C LXI D,41 LXI B,2 CALL PSTR CALL PLNE I220: ; INPUT T$ LHLD ZT$ XCHG CALL GETSTR!SHLD ZT$+2 I230: ;REM Insert Inline ASM to do a disk reset I240: ;#ASM I250: ;MVI C,13 MVI C,13 I260: ;CALL 5 CALL 5 I270: ;#ENDASM I280: ; OPEN 1,FI$ LXI D,FCB1 LHLD ZFI$+2!MOV B,L!LHLD ZFI$!CALL ROPEN I290: ; EXT=EXT+1 LHLD ZEXT XCHG LXI H, 1 DAD D SHLD ZEXT I300: ;GOTO 160 JMP I160 I310: ;END JMP 000H CALL 0000H 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 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 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 PSTR: MOV A,D! ORA A! JNZ PLOOP! MOV A,E! ORA A! RZ PLOOP: PUSH D! PUSH B! MOV E,M! PUSH H! PUSH PSW CALL 0005H POP PSW! POP H! POP B! POP D! INX H! DCX D! MOV A,E! ORA A JNZ PLOOP MOV A,D! ORA A! JNZ PLOOP RET PLNE: PUSH B! MVI E,13 CALL 0005! POP B! PUSH B! MVI E,10 CALL 0005! POP B! RET DECDIG: MVI A,'0'-1 DECLP: INR A! DAD B! JC DECLP STAX D! INX D! MOV A,B! CMA MOV B,A! MOV A,C! CMA MOV C,A! INX B! DAD B! RET GETNUM: LXI D,SAREA! LXI H,0000H! LXI B,0 IPLP: PUSH B! MVI C,01H! PUSH D! PUSH H! CALL 0005H POP H! POP D! POP B! STAX D! INX D! INX H! INX B CPI 13! JZ IPDONE! CPI 10! JZ IPDONE! CPI 3! JZ 0000H CPI 8! CZ IPBS JMP IPLP IPBS: DCX B! DCX B! MOV A,B! RAL! JC IPBS2 DCX H! DCX H! DCX D! DCX D! PUSH D! PUSH H! PUSH B! MVI C,2 MVI E,32! CALL 0005H! MVI C,2! MVI E,8! CALL 0005H POP B! POP H! POP D! RET IPBS2: INX B! DCX H! DCX D! PUSH B! PUSH D! PUSH H! MVI C,2! MVI E,32 CALL 0005H! POP H! POP D! POP B! RET IPDONE: LXI D,SAREA! LXI H,0000H! PUSH H! IP2: LDAX D! INX D! CPI '-'! JZ IP3 CPI '0'! JC IPST! CPI '9'+1! JNC IP2 SUI '0'! MOV B,H! MOV C,L! DAD H! DAD H! DAD B DAD H! ADD L! MOV L,A! JMP IP2 IP3: POP B! INX B! PUSH B! JMP IP2 IPST: POP B! MOV A,C! ORA A! JZ IPST2 MOV A,H! CMA! MOV H,A! MOV A,L! CMA! MOV L,A INX H IPST2: PUSH H! MVI E,10! MVI C,2! CALL 0005H MVI E,13! MVI C,2! CALL 0005H! POP H! RET GETSTR: LXI H,0! LXI B,0 STRLP: PUSH B! MVI C,01H! PUSH D! PUSH H! CALL 0005H POP H! POP D! POP B! CPI 13! JZ SQUIT! CPI 3! JZ 0000H STAX D! INX D! INX H! INX B! CPI 8! CZ SBS! JMP STRLP SQUIT: MVI E,10! MVI C,2! PUSH H CALL 0005H! POP H! RET SBS: DCX B! DCX B! MOV A,B! RAL! JC SBS2 DCX D! DCX D! DCX H! DCX H! PUSH B! PUSH D! PUSH H! MVI C,2! MVI E,32! CALL 0005H! MVI C,2! MVI E,8! CALL 0005H POP H! POP D! POP B! RET SBS2: INX B! DCX D! DCX H! PUSH B! PUSH D! PUSH H! MVI C,2! MVI E,32 CALL 0005H! POP H! POP D! POP B! RET ROPEN: xchg! shld SAREA! xchg! shld SAREA+2! push b! mvi b,36! mvi a,0 ROPEN1: stax d! inx d! dcr b! cmp b! jnz ROPEN1! lhld sarea! xchg! inx d mvi b,11 ROPEN2: mvi a,32! stax d! inx d! dcr b! mov a,b! ora a! jnz ROPEN2 lhld SAREA! xchg! lhld SAREA+2! pop b inx h! mov a,m! dcx h! cpi ':'! jnz ROPEN3 mov a,m! sui 64! stax d! inx h! inx h! dcr b! dcr b ROPEN3: inx d! mov a,b! ora a! jz ROPEN6! mov a,m! cpi '.'! cz ROPEN4 stax d! dcr b! inx h! jmp ROPEN3 ROPEN4: push h! lhld SAREA! lxi d,9! dad d! xchg! pop h! inx h dcr b! mov a,b! ora a! jz ROPEN5! mov a,m! ret ROPEN5: pop h ROPEN6: lhld SAREA! XCHG MVI C,15! PUSH D! CALL 0005 POP D! INR A! ORA A! JZ FCREAT! RET FCREAT: MVI C,22! CALL 0005! INR A! ORA A! RNZ MVI C,9! LXI D,FERR! CALL 0005! JMP 0 FERR: DB 'FILE CREATION ERROR: NO DIRECTORY SPACE AVAILABLE.',13,10,'$' RGET: PUSH B! PUSH D! PUSH H! MOV H,B! MOV L,C! SHLD SAREA POP H! POP D! POP B! PUSH B! PUSH D! PUSH H LXI H,33! DAD D! XCHG! POP H MOV A,L! STAX D! INX D! MOV A,H! STAX D! INX D MVI A,0! STAX D! POP B! POP D PUSH B! MVI C,26! CALL 0005 POP D! MVI C,33! CALL 0005! ORA A! JNZ GETERR RET GETERR: LHLD SAREA! MVI B,128 GETER1: MVI A,0! MOV M,A! DCR B! MOV A,B! ORA A! RZ! INX H! JMP GETER1 RPUT: PUSH B! PUSH D! PUSH H LXI H,33! DAD D! XCHG! POP H MOV A,L! STAX D! INX D! MOV A,H! STAX D! INX D MVI A,0! STAX D! POP B! POP D PUSH B! MVI C,26! CALL 0005 POP D! MVI C,34! CALL 0005! RET FCLOS: MVI C,16! CALL 0005! INR A! ORA A! RNZ MVI C,9! LXI D,FCERR! CALL 0005! JMP 0 FCERR: DB 'FILE CLOSE ERROR REPORTED BY CP/M.',0DH,0AH,'$' STR: PUSH D! LDAX D! MOV C,A! INX D! LDAX D! MOV D,A! MOV E,C MOV A,H! ANI 080H! JZ STR2 MOV A,H! CMA! MOV H,A! MOV A,L! CMA! MOV L,A! INX H MVI A,'-' STAX D JMP STR3 STR2: MVI A,'+' STAX D STR3: INX D MOV A,H! ANI 07FH! MOV H,A LXI B,-10000! CALL DECDIG LXI B,-1000! CALL DECDIG LXI B,-100! CALL DECDIG LXI B,-10! CALL DECDIG MOV A,L! ORI '0'! STAX D LXI H,0006H! POP D! INX D! INX D! MOV A,L! STAX D! INX D MOV A,H! STAX D! RET STRMV: MOV A,B! ORA A! JNZ STRMV1 MOV A,C! ORA A! RZ STRMV1: MOV A,M! STAX D! INX D! INX H! DCX B! JMP STRMV ZP$: DW STACK+257,0 ZFIN$: DW STACK+337,0 ZC$: DW STACK+417,0 ZEXT: DW 0 ZA$: DW STACK+497,0 ZB$: DW STACK+577,0 ZFI$: DW STACK+657,0 ZT$: DW STACK+737,0 DS 64 STACK: SAREA: DW 0 END