Oakland CPM Archive

home *** CD-ROM | disk | FTP | other *** search

/ Oakland CPM Archive / oakcpm.iso / cpm / basic / b-compil.lbr / BCBCLIB.SQC / BCBCLIB.SRC

Wrap

Text File | 1986-07-20 | 17.5 KB | 459 lines

1 ;PRINT A STRING: DE CONTAINS LENGTH (0-65535), HL POINTS TO STRING, ;BC CONTAINS BDOS FUNCTION CALL VALUE (2=CONSOLE, 5=LIST DEVICE) 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 2 ;PRINT A NUMBER: HL CONTAINS NUMBER, OUTPUT IS TO SAREA (IN MEMORY), ;THEN SAREA IS READ AND OUTPUT TO CONSOLE OR LIST DEVICE. PNUM: LXI D,SAREA! PUSH B! MOV A,H! ANI 080H JZ PNUM2 MOV A,H! CMA! MOV H,A! MOV A,L! CMA! MOV L,A! INX H MVI A,'-' STAX D JMP PNUM3 PNUM2: MVI A,'+' STAX D PNUM3: INX D 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 D,0006H! LXI H,SAREA POP B! JMP PSTR 3 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 4 ;ARITHMETIC ROUTINES ;HL = MOST RECENT OPERAND, DE = OLDEST OPERAND, A = OPCODE ;A=1 IS +; A=2 IS -; A=3 IS *; A=4 IS /; A=5 IS AND; ;A=6 IS OR; A=7 IS NOT; A=8 IS XOR; A=9 IS MOD ;INTEGER ADDITION 5 ARITH: DAD D! RET 6 ;INTEGER SUBTRACTION ARITH2: MOV A,H! CMA! MOV H,A MOV A,L! CMA! MOV L,A! INX H! DAD D! RET 7 ;INTEGER MULTIPLICATION ARITH3: LXI B,0000H ;PROCEDURE USED: OBTAIN (D*L+H*E) AS HIGH BYTE OF RESULT, THEN ADD L*E ;AS 16-BIT NUMBER TO THAT ANSWER. OVERFLOW IS NOT CHECKED. MULT ROUTINE ;RETURNS ANSWERS IN BC, WITH D AND C ORIGINALLY HOLDING THE TWO BYTES ;WHICH ARE TO BE MULTIPLIED. ;MULTIPLY D AND L NOW MOV C,L CALL MULT PUSH B! LXI B,0000H ;MULTIPLY H AND E NOW MOV C,H! MOV D,E CALL MULT! PUSH B! LXI B,0000H ;MULTIPLY L AND E NOW MOV C,L! CALL MULT ;ANSWER COMES BACK IN BC; NOW POP H TO RESTORE H*E IN H,THEN SHL 1 BYTE POP H! MOV H,L! MVI L,00H! DAD B ;INTERMEDIATE RESULT IN HL. NOW POP D AND SHL 1 BYTE FOR NEXT POP D! MOV D,E! MVI E,00H! DAD D ;THAT'S IT, FOLKS. WE NOW HAVE OUR ANSWER IN HL. RET ;AND HERE'S THE ROUTINE TO DO THE MULTIPLICATION: MULT: PUSH D! MVI E,09 MULT0: MOV A,C! RAR! MOV C,A! DCR E! JZ MULT2 MOV A,B! JNC MULT1 ADD D MULT1: RAR! MOV B,A! JMP MULT0 MULT2: POP D! RET ;HL = MOST RECENT OPERAND, DE = OLDEST OPERAND, A = OPCODE ;A=1 IS +; A=2 IS -; A=3 IS *; A=4 IS /; A=5 IS AND; ;A=6 IS OR; A=7 IS NOT; A=8 IS XOR 8 ;INTEGER DIVISION ARITH4: MOV A,H! ANI 080H! MOV B,A! MOV A,D! ANI 080H ;B HAS SIGN OF HL, A HAS SIGN OF DE CMP B! JZ DS0! ;IF WE TOOK THE JUMP TO DS0, THEN DE & HL HAVE THE SAME SIGN. IF NOT, ;DE AND HL HAVE DIFFERENT SIGNS. WE'LL NEED TO FIND OUT WHICH NUMBER ;IS NEGATIVE SO WE CAN CONVERT IT APPROPRIATELY MVI B,080H RAL! JNC DSA ;WE TOOK THAT LAST JUMP IF DE WAS POSITIVE. IF NOT, HL IS. DCX D! MOV A,D! CMA! MOV D,A! MOV A,E! CMA! MOV E,A JMP DS2 DSA: DCX H! MOV A,H! CMA! MOV H,A! MOV A,L! CMA! MOV L,A JMP DS2 DS0: ORA A! JZ DSTART ;DE AND HL HAVE THE SAME SIGN: NEGATIVE DCX D! MOV A,D! CMA! MOV D,A! MOV A,E! CMA! MOV E,A DCX H! MOV A,H! CMA! MOV H,A! MOV A,L! CMA! MOV L,A DSTART: LXI B,0 DS2: PUSH B! LXI B,0 ;AT THIS POINT, WE'VE PUSHED THE SIGN OF THE RESULT ONTO THE STACK, ;CLEARED THE BC REGISTER TO RECEIVE THE RESULT, AND KILLED THE SIGN BIT ;ON THE DE AND HL REGISTERS (DE WILL BE DIVIDED BY HL). WE CAN NOW ;CONTINUE UNDER THE ASSUMPTION THAT DE AND HL ARE BOTH POSITIVE. MOV B,D! MOV C,E! XCHG ;BC=DIVIDEND AND QUOTIENT, DE=DIVISOR MOV A,D! CMA! MOV D,A! MOV A,E! CMA! MOV E,A! INX D LXI H,0! MVI A,17 DV0: PUSH H! DAD D! JNC DV1! XTHL DV1: POP H! PUSH PSW! MOV A,C! RAL! MOV C,A MOV A,B! RAL! MOV B,A! MOV A,L! RAL! MOV L,A MOV A,H! RAL! MOV H,A! POP PSW! DCR A! JNZ DV0 ORA A! MOV A,H! RAR! MOV D,A! MOV A,L! RAR! MOV E,A ;DE NOW CONTAINS REMAINDER, BC CONTAINS QUOTIENT. WE'LL FIX THINGS ;UP NOW, AND PUT THE (POSSIBLY) SIGNED RESULT INTO HL. REMEMBER THAT ;THE REMAINDER IS RETURNED IN DE; WE MAY WANT TO USE IT LATER, EITHER ;TO RETURN THE REMAINDER OR TO FACILITATE MULTIPLE PRECISION DIVISION. POP H! MOV A,H! ORA A! JNZ DV2 LXI H,0 DAD B RET DV2: MOV A,B! CMA! MOV H,A! MOV A,C! CMA! MOV L,A! INX H! RET 9 ;LOGICAL AND ARITH5: MOV A,H! ANA D! MOV H,A! MOV A,L! ANA E! MOV L,A RET 10 ;LOGICAL OR ARITH6: MOV A,H! ORA D! MOV H,A! MOV A,L! ORA E! MOV L,A RET 11 ;LOGICAL NEGATION OF HL ARITH7║ MOV A,H! CMA! MOV H,A! MOV A,L! CMA! MOV L,A RET 12 ;LOGICAL XOR ARITH8: MOV A,H! XRA D! MOV H,A! MOV A,L! XRA E! MOV L,A RET 13 ;RETURN REMAINDER OF DIVISION (MOD OPERATION) ARITH9: CALL ARITH4! XCHG! RET 14 ;GET A NUMBER AS INPUT FROM THE CONSOLE 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 15 ;GET A STRING AS INPUT FROM THE CONSOLE, INTO A STRING'S LOCATION. ;DE POINTS TO STRING LOCATION, HL CONTAINS BYTE COUNT (LENGTH). 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 16 ;RESERVED FOR STRING COMPARISONS; <, <=, =, >, >=, <> ;IF V2$='=' THEN K3=1 ;IF V2$='<>' OR V3$='><' THEN K3=2 ;IF V2$='=<' OR V2$='<=' THEN K3=3 ;IF V2$='>=' OR V2$='=>' THEN K3=4 ;IF V2$='<' THEN K3=5:ELSE IF V2$='>' THEN K3=6 ;K3 PARAMETER IS PASSED IN THE A REGISTER ;DE=POINTER TO FIRST STRING'S POINTER, HL=POINTER TO SECOND STRING'S ;RETURN 0 IN A REGISTER IF COMPARISON IS FALSE, ANYTHING ELSE IF TRUE. ;CHECK FOR STRING EQUALITY SC: PUSH D! PUSH H! INX H! INX H! INX D! INX D ;FIRST, LET'S COMPARE THE STRING LENGTHS. IF THEY'RE NOT EQUAL, QUIT. LDAX D! MOV C,M! CMP C! JNZ SNE INX H! INX D! LDAX D! MOV B,M! CMP B! JNZ SNE POP H! POP D! PUSH B! MOV C,M! INX H! MOV B,M LXI H,0! DAD B! PUSH H! LDAX D! MOV L,A! INX D LDAX D! MOV H,A! XCHG! POP H! POP B ;NOW HL POINTS TO THE BEGINNING OF THE SECOND STRING, DE POINTS TO ;THE BEGINNING OF THE FIRST, AND BC CONTAINS THE STRING LENGTHS SC2: MOV A,B! ORA A! JNZ SC3 MOV A,C! ORA A! JZ SEQ SC3: PUSH B! MOV B,M! LDAX D! CMP B! JNZ SNE2 POP B! DCX B! INX H! INX D! JMP SC2 SEQ: MVI A,0FFH! RET SNE: POP B SNE2: POP B! MVI A,0! RET 17 ;NOW A COMPARISON FOR UNEQUAL STRINGS SC4: CALL SC! CMA! RET 18 ;NOW A COMPARISON FOR <: (DE < HL) ;PROCEDURE USED: GET THE STRING LENGTH OF DE AND STORE IT AT SAREA, ;THEN GET THE STRING LENGTH OF HL AND STORE IN SAREA+2. WE WILL USE ;THESE LENGTHS TO TELL US WHEN WE ARE DONE. THEN RETRIEVE THE ;CHARACTERS IN EACH STRING, ONE AT A TIME. IF THE CHARACTERS ARE THE ;SAME, DECREMENT THE LENGTHS STORED IN SAREA AND CHECK TO SEE IF ;EITHER STRING IS ENDED. IF ONE IS AND THE OTHER IS NOT, THE ONE THAT ;ISN'T DONE IS BIGGER. IF THE CHARACTERS DIFFER, THE STRING CONTAINING ;THE SMALLER IS LESS. THE CHECK FOR COMPLETION IS DONE AT THE BEGINNING ;OF THE LOOP, FOR OBVIOUS REASONS. SC5: PUSH D! PUSH H! INX H! INX H! INX D! INX D ;FIRST, GET THE STRING LENGTHS INTO SAREA AND SAREA+2. LDAX D! MOV C,A! INX D! LDAX D! MOV B,A! PUSH B MOV C,M! INX H! MOV B,M! LXI H,0! DAD B SHLD SAREA+2! POP H! SHLD SAREA ;THAT PUTS THE LENGTH OF DE INTO SAREA AND LENGTH OF HL INTO SAREA+2 ;OK, LENGTHS ARE STORED. NOW GET THE STRING ADDRESSES INTO DE & HL POP H! POP D! MOV C,M! INX H! MOV B,M LXI H,0! DAD B! PUSH H! LDAX D! MOV L,A! INX D LDAX D! MOV H,A! XCHG! POP H ;NOW HL POINTS TO THE BEGINNING OF THE SECOND STRING, DE POINTS TO ;THE BEGINNING OF THE FIRST. NOW WE CHECK FOR COMPLETION. SC6: PUSH D! PUSH H! LHLD SAREA! XCHG! LHLD SAREA+2 ;NOW DE CONTAINS THE NUMBER OF BYTES LEFT IN STRING POINTED TO BY DE ;AND HL CONTAINS THE NUMBER OF BYTES LEFT IN STRING POINTED TO BY HL ;IF DE IS 0 AND HL IS NOT, RETURN TRUE; IF HL IS 0 AND DE IS NOT, ;RETURN FALSE; IF NEITHER IS 0, CONTINUE COMPARISON; IF BOTH ARE 0, ;RETURN FALSE, BECAUSE STRINGS ARE THEN EQUAL. THE HL REGISTER IS THE ;MOST IMPORTANT ONE; IF IT IS 0, ALWAYS RETURN FALSE. MOV A,H! CMP L! JNZ SC6A ORA A! JZ SLTF ;OK, HL IS NON-ZERO. NOW WE CHECK DE. SC6A: MOV A,D! CMP E! JNZ SC7 ORA A! JZ SLTT ;OK, DE IS NON-ZERO. LET'S CHECK THE CHARACTERS. SC7: POP H! POP D! LDAX D! MOV B,M INX H! INX D! PUSH H LHLD SAREA+2! DCX H! SHLD SAREA+2! LHLD SAREA DCX H! SHLD SAREA! POP H CMP B! JC SLTT2! JNZ SLTF2 JMP SC6 SLTT: POP B! POP B SLTT2: MVI A,0FFH! RET SLTF: POP B! POP B SLTF2: MVI A,0! RET 19 ;NOW WE CHECK FOR >= SC8: CALL SC5! CMA! RET 20 ;THE ONLY TWO THINGS LEFT ARE > AND <=. LET'S TAKE <= FIRST. ;WE CAN CHECK FOR <= BY TESTING FOR <; IF TRUE, THEN RETURN TRUE. ;THEN WE CAN TEST FOR EQUALITY. IF TRUE, RETURN TRUE. ;OTHERWISE, RETURN FALSE. HERE WE GO. SC9: CALL SC5 ORA A! RNZ CALL SC! RET 21 ;OK, NOW WE'LL CHECK FOR > SCA: CALL SC9! CMA! RET ;INVALID OPCODES ARE IGNORED 22 ;RESERVED FOR NUMERIC COMPARISONS; <, <=, =, >, >=, <> ;FIRST ARGUMENT IS IN DE, LAST ONE IN HL: RETURN 0=FALSE, -1=TRUE IN A ;NUMERIC EQUALITY NC: MOV A,H! CMP D! JNZ NNE MOV A,L! CMP E! JNZ NNE NEQ: MVI A,0FFH! RET NNE: MVI A,00H! RET 23 ;NUMERIC INEQUALITY NC1: CALL NC! CMA! RET 24 ;NUMERIC < ;FIRST, LET'S LOOK AT THE SIGNS. IF DE IS NEGATIVE AND HL IS POSITIVE, ;RETURN TRUE. IF DE AND HL ARE BOTH NEGATIVE, COMPLEMENT ALL BITS IN ;BOTH AND COMPARE; IF DE IS POSITIVE AND HL IS NEGATIVE, RETURN FALSE; ;IF BOTH ARE POSITIVE, COMPARE. NC2: MOV A,D! ANI 080H! MOV B,A! MOV A,H! ANI 080H CMP B! JC NEQ ;THAT TAKES CARE OF THE CASE DE NEGATIVE AND HL POSITIVE. ;B CONTAINS SIGN OF DE, AND A CONTAINS SIGN OF HL ;THE LAST CHECK JUMPS TO THE 'RETURN TRUE' ROUTINE. NOW LET'S CHECK ;TO SEE IF DE POSITIVE AND HL NEGATIVE, FOR WHICH WE RETURN FALSE. MOV C,A! MOV A,B! CMP C! JC NNE ;WE HAVE LEFT THE SIGN OF DE IN A. ;THE A REGISTER NOW CONTAINS 128 ONLY IF HL AND DE ARE BOTH NEGATIVE, ;AND 0 ONLY IF BOTH ARE POSITIVE. LET'S SEE WHICH IS TRUE. ORA A! JZ NC2A MOV A,D! CMA! MOV D,A! MOV A,E! CMA! MOV E,A MOV A,H! CMA! MOV H,A! MOV A,L! CMA! MOV L,A ;NOW WE HAVE TWO UNSIGNED NUMBERS TO COMPARE. IF D<H, WE'RE DONE: ;RETURN TRUE. IF H<D, WE'RE DONE: RETURN FALSE. NC2A: MOV A,D! CMP H! JC NEQ! JNZ NNE ;IF E<L, RETURN TRUE. IF NOT, THEN EITHER DE=HL, OR L<E: RETURN FALSE. MOV A,E! CMP L! JC NEQ! MVI A,0! RET ;IF V2$='=' THEN K3=1 ;IF V2$='<>' OR V3$='><' THEN K3=2 ;IF V2$='=<' OR V2$='<=' THEN K3=3 ;IF V2$='>=' OR V2$='=>' THEN K3=4 ;IF V2$='<' THEN K3=5:ELSE IF V2$='>' THEN K3=6 25 ;NUMERIC >= NC3: CALL NC2! CMA! RET 26 ;NUMERIC > NC4: XCHG! JMP NC2 27 ;NUMERIC <= NC5: CALL NC4! CMA! RET 28 ;RESERVED FOR POKE AND PEEK, INCLUDING USE OF POKE, PEEK, AND VARPTR 29 ;RESERVED FOR RANDOM FILE I/O; OPEN, CLOSE, LSET, RSET, GET, AND PUT ;FOR OPEN STATEMENT, DE POINTS TO PROPOSED FCB, HL POINTS TO THE FILE ;NAME TO USE FOR THE PROPOSED OPEN FILE, AND B CONTAINS THE LENGTH OF ;THE PROPOSED FILE NAME. THIS ROUTINE WILL PARSE THE PROPOSED FILE ;NAME. IF THE FILE DOES NOT EXIST, IT WILL BE CREATED BY THIS ROUTINE. ;THE FIRST THING WE DO IS FILL OUT THE NAME PART OF THE PROPOSED FCB ;AFTER THE DRIVE LETTER WITH BLANKS, AND THE REST OF THE FCB WITH 0s. ;THEN WE CHECK TO SEE IF THE FILE NAME INCLUDES A DRIVE LETTER. 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 ;Now, we have set up the fcb. Does the name specify a drive letter? inx h! mov a,m! dcx h! cpi ':'! jnz ROPEN3 ;If not, we go to ROPEN3. Otherwise, we must perform the next line, ;which just puts the specified drive letter into the fcb. mov a,m! sui 64! stax d! inx h! inx h! dcr b! dcr b ;Now we move the file name into the fcb until we get a period. ;If we get a period, we will advance to the file type area and put ;the remaining characters beginning there. I do not check to see if ;there are only three characters to go into the fcb at this point. ROPEN3: inx d! mov a,b! ora a! jz ROPEN6! mov a,m! cpi '.'! cz ROPEN4 stax d! dcr b! inx h! jmp ROPEN3 ;If we hit here, there is a file type extension. I will return only if ;there is at least one character after the period. 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 ;If the file name was given with a period and no letters following, we ;will not return. Destroy the return address and continue. ROPEN5: pop h ;At last, we are ready to open the file. We'll restore the DE register ;pointer to the fcb and continue. ROPEN6: lhld SAREA! XCHG MVI C,15! PUSH D! CALL 0005 ;IF THE FILE DOES NOT EXIST, WE WILL CREATE IT. OTHERWISE, DONE. POP D! INR A! ORA A! JZ FCREAT! RET FCREAT: MVI C,22! CALL 0005! INR A! ORA A! RNZ ;WE CANNOT CREATE THE FILE. NO SPACE IS AVAILABLE. ABORT. MVI C,9! LXI D,FERR! CALL 0005! JMP 0 FERR: DB 'FILE CREATION ERROR: NO DIRECTORY SPACE AVAILABLE.',13,10,'$' ;ROUTINE TO GET A RANDOM RECORD. ON ENTRY, HL=RECORD NUMBER, ;DE POINTS TO FCB, BC POINTS TO DMA. 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 ;NOW HL CONTAINS THE RECORD NUMBER, DE POINTS TO WHERE TO PUT IT. MOV A,L! STAX D! INX D! MOV A,H! STAX D! INX D MVI A,0! STAX D! POP B! POP D ;NOW BC POINTS TO FCB, DE POINTS TO DMA. FIRST THING WE DO IS ;SET THE DMA ADDRESS APPROPRIATELY. PUSH B! MVI C,26! CALL 0005 ;NOW WE RESTORE DE AS THE FCB, AND CALL FOR A RANDOM READ POP D! MVI C,33! CALL 0005! ORA A! JNZ GETERR RET ;IN KEEPING WITH MICROSOFT, WE WILL FILL THE DMA WITH NULLS ON ERROR. ;AT SAREA, WE HAVE SAVED THE DMA FOR THIS EVENTUALITY. 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 ;ROUTINE TO WRITE A RECORD. ON ENTRY, HL CONTAINS THE RECORD NUMBER, ;DE POINTS TO THE FCB, AND BC POINTS TO THE DMA RPUT: PUSH B! PUSH D! PUSH H LXI H,33! DAD D! XCHG! POP H ;NOW HL CONTAINS THE RECORD NUMBER, DE POINTS TO WHERE TO PUT IT. MOV A,L! STAX D! INX D! MOV A,H! STAX D! INX D MVI A,0! STAX D! POP B! POP D ;NOW BC POINTS TO FCB, DE POINTS TO DMA. FIRST THING WE DO IS ;SET THE DMA ADDRESS APPROPRIATELY. PUSH B! MVI C,26! CALL 0005 ;NOW WE RESTORE DE AS THE FCB, AND CALL FOR A RANDOM WRITE. WE WILL ;GENEROUSLY ALLOW CP/M TO REPORT ANY SERIOUS ERRORS. POP D! MVI C,34! CALL 0005! RET ;ROUTINE TO CLOSE THE FILE. DE CONTAINS THE FCB ADDRESS. FCLOS: MVI C,16! CALL 0005! INR A! ORA A! RNZ ;IF THERE WAS AN ERROR HERE, WE SHOULD REPORT IT. MVI C,9! LXI D,FCERR! CALL 0005! JMP 0 FCERR: DB 'FILE CLOSE ERROR REPORTED BY CP/M.',0DH,0AH,'$' 30 ;RESERVED FOR SEQUENTIAL FILE I/O; OPEN, CLOSE, INPUT#, LINPUT#, PRINT# 31 ;RESERVED FOR VAL(,STR$(,MID$(,LEFT$(,RIGHT$(, ETC. ; ;VAL( ;ASCII TO BINARY CONVERSION. DE POINTS TO STRING, BC CONTAINS LENGTH, ;HL WILL CONTAIN SIGNED BINARY FORM OF NUMBER ON EXIT. NON-DIGITS WILL ;BE IGNORED FOR PURPOSES OF CONVERSION. I.E. 12G3F4=1234. ASCBIN: LXI H,0! PUSH H ASCB2: MOV A,B! ORA A! JNZ ASCB3 MOV A,C! ORA A! JZ ASCB4 ASCB3: LDAX D! DCX B! INX D! CPI '-'! CC ASCB5 CPI '0'! JC ASCB2 CPI '9'+1! JNC ASCB2 SUI '0'! PUSH D! PUSH H! POP D! DAD H! DAD H! DAD D! DAD H LXI D,0! MOV E,A! DAD D! POP D! JMP ASCB2 ASCB4: POP B! MOV A,B! ORA A! RZ MOV A,H! CMA! MOV H,A! MOV A,L! CMA! MOV L,A! INX H! RET ASCB5: POP H! MVI H,1! PUSH H! RET ; 32 ;STR$( ;SIGNED BINARY TO ASCII CONVERSION. DE POINTS TO STRING LOCATION WORD, ;HL CONTAINS SIGNED BINARY NUMBER TO CONVERT. STR: PUSH D! LDAX D! MOV C,A! INX D! LDAX D! MOV D,A! MOV E,C ;NOW DE POINTS TO THE BEGINNING OF THE TARGET STRING 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 33 ;MOVING A STRING IN MEMORY. DE=DEST., HL=SOURCE, BC=# BYTES. 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 34 ;EXPANSION AREA